merging Emacs.app (NeXTstep port)
[bpt/emacs.git] / lisp / woman.el
index 595bb6c..99de62e 100644 (file)
 
 ;; This file is part of GNU Emacs.
 
-;; GNU Emacs is free software; you can redistribute it and/or modify
+;; GNU Emacs is free software: you can redistribute it and/or modify
 ;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 3, or (at your option)
-;; any later version.
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
 
 ;; GNU Emacs is distributed in the hope that it will be useful,
 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
@@ -23,9 +23,7 @@
 ;; GNU General Public License for more details.
 
 ;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs; see the file COPYING.  If not, write to the
-;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
+;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
 
 ;;; Commentary:
 
 
 ;; (By default, WoMan will automatically define the dired keys "W" and
 ;; "w" when it loads, but only if they are not already defined.  This
-;; behaviour is controlled by the user option `woman-dired-keys'.
+;; behavior is controlled by the user option `woman-dired-keys'.
 ;; Note that the `dired-x' (dired extra) package binds
 ;; `dired-copy-filename-as-kill' to the key "w" (as pointed out by Jim
 ;; Davidson), although "W" appears to be really unused.  The `dired-x'
 ;; The *WoMan-Log* buffer
 ;; ======================
 
-;; This is modelled on the byte-compiler.  It logs all files formatted
+;; This is modeled on the byte-compiler.  It logs all files formatted
 ;; by WoMan, and if WoMan finds anything that it cannot handle then it
 ;; writes a warning to this buffer.  If the variable `woman-show-log'
 ;; is non-nil (by default it is `nil') then WoMan automatically
@@ -502,7 +500,7 @@ As a special case, if PATHS is nil then replace it by calling
           ;; Assume no `cygpath' program available.
           ;; Hack /cygdrive/x/ or /x/ or (obsolete) //x/ to x:/
           (when (string-match "\\`\\(/cygdrive\\|/\\)?/./" file)
-            (if (match-string 1)               ; /cygdrive/x/ or //x/ -> /x/
+            (if (match-beginning 1)            ; /cygdrive/x/ or //x/ -> /x/
                 (setq file (substring file (match-end 1))))
             (aset file 0 (aref file 1))        ; /x/ -> xx/
             (aset file 1 ?:))          ; xx/ -> x:/
@@ -520,19 +518,19 @@ As a special case, if PATHS is nil then replace it by calling
   :group 'help)
 
 (defcustom woman-show-log nil
-  "*If non-nil then show the *WoMan-Log* buffer if appropriate.
+  "If non-nil then show the *WoMan-Log* buffer if appropriate.
 I.e. if any warning messages are written to it.  Default is nil."
   :type 'boolean
   :group 'woman)
 
 (defcustom woman-pre-format-hook nil
-  "*Hook run by WoMan immediately before formatting a buffer.
+  "Hook run by WoMan immediately before formatting a buffer.
 Change only via `Customization' or the function `add-hook'."
   :type 'hook
   :group 'woman)
 
 (defcustom woman-post-format-hook nil
-  "*Hook run by WoMan immediately after formatting a buffer.
+  "Hook run by WoMan immediately after formatting a buffer.
 Change only via `Customization' or the function `add-hook'."
   :type 'hook
   :group 'woman)
@@ -547,10 +545,12 @@ Change only via `Customization' or the function `add-hook'."
 
 (defcustom woman-man.conf-path
   (let ((path '("/usr/lib" "/etc")))
-    (if (eq system-type 'windows-nt)
-       (mapcar 'woman-Cyg-to-Win path)
-      path))
-  "*List of dirs to search and/or files to try for man config file.
+    (cond ((eq system-type 'windows-nt)
+          (mapcar 'woman-Cyg-to-Win path))
+         ((eq system-type 'darwin)
+          (cons "/usr/share/misc" path))
+         (t path)))
+  "List of dirs to search and/or files to try for man config file.
 A trailing separator (`/' for UNIX etc.) on directories is
 optional, and the filename is used if a directory specified is
 the first to start with \"man\" and has an extension starting
@@ -595,7 +595,7 @@ or
 MANPATH_MAP[ \t]+\\(\\S-+\\)[ \t]+\\(\\S-+\\)\\)" nil t)
                      (add-to-list 'manpath
                                   (if (match-beginning 1)
-                                      (match-string 1) 
+                                      (match-string 1)
                                     (cons (match-string 2)
                                           (match-string 3)))))
                    manpath))
@@ -603,10 +603,63 @@ MANPATH_MAP[ \t]+\\(\\S-+\\)[ \t]+\\(\\S-+\\)\\)" nil t)
       (setq path (cdr path)))
     (nreverse manpath)))
 
+;; Autoload so set-locale-environment can operate on it.
+;;;###autoload
+(defcustom woman-locale nil
+  "String specifying a manual page locale, or nil.
+If a manual page is available in the specified locale
+\(e.g. \"sv_SE.ISO8859-1\"), it will be offered in preference to the
+default version.  Normally, `set-locale-environment' sets this at startup."
+  :type '(choice string (const nil))
+  :group 'woman-interface
+  :version "23.1")
+
+;; FIXME Is this a sensible list of alternatives?
+(defun woman-expand-locale (locale)
+  "Expand a locale into a list suitable for man page lookup.
+Expands a locale of the form LANGUAGE_TERRITORY.CHARSET into the list:
+LANGUAGE_TERRITORY.CHARSET LANGUAGE_TERRITORY LANGUAGE.CHARSET LANGUAGE.
+The TERRITORY and CHARSET portions may be absent."
+  (string-match "\\([^._]*\\)\\(_[^.]*\\)?\\(\\..*\\)?" locale)
+  (let ((lang (match-string 1 locale))
+        (terr (match-string 2 locale))
+        (charset (match-string 3 locale)))
+    (delq nil (list locale
+                    (and charset terr (concat lang terr))
+                    (and charset terr (concat lang charset))
+                    (if (or charset terr) lang)))))
+
+(defun woman-manpath-add-locales (manpath)
+  "Add locale-specific subdirectories to the elements of MANPATH.
+MANPATH is a list of the form of `woman-manpath'.  Returns a list
+with those locale-specific subdirectories specified by the action
+of `woman-expand-locale' on `woman-locale' added, where they exist."
+  (if (zerop (length woman-locale))
+      manpath
+    (let ((subdirs (woman-expand-locale woman-locale))
+          lst dir)
+      (dolist (elem manpath (nreverse lst))
+        (dolist (sub subdirs)
+          (when (file-directory-p
+                 (setq dir
+                       ;; Use f-n-a-d because parse-colon-path does.
+                       (file-name-as-directory
+                        (expand-file-name sub (substitute-in-file-name
+                                               (if (consp elem)
+                                                   (cdr elem)
+                                                 elem))))))
+            (add-to-list 'lst (if (consp elem)
+                                  (cons (car elem) dir)
+                                dir))))
+        ;; Non-locale-specific has lowest precedence.
+        (add-to-list 'lst elem)))))
+
 (defcustom woman-manpath
-  (or (woman-parse-colon-path (getenv "MANPATH"))
+  ;; Locales could also be added in woman-expand-directory-path.
+  (or (woman-manpath-add-locales
+       (woman-parse-colon-path (getenv "MANPATH")))
       '("/usr/man" "/usr/share/man" "/usr/local/man"))
-  "*List of DIRECTORY TREES to search for UN*X manual files.
+  "List of DIRECTORY TREES to search for UN*X manual files.
 Each element should be the name of a directory that contains
 subdirectories of the form `man?', or more precisely subdirectories
 selected by the value of `woman-manpath-man-regexp'.  Non-directory
@@ -636,6 +689,7 @@ I recommend including drive letters explicitly, e.g.
 The MANPATH environment variable may be set using DOS semi-colon-
 separated or UN*X/Cygwin colon-separated syntax (but not mixed)."
   :type '(repeat (choice string (cons string string)))
+  :version "23.1"                    ; added woman-manpath-add-locales
   :group 'woman-interface)
 
 (defcustom woman-manpath-man-regexp "[Mm][Aa][Nn]"
@@ -649,7 +703,7 @@ Microsoft platforms.  Its purpose is to avoid `cat?', `.', `..', etc."
 
 (defcustom woman-path
   (if (eq system-type 'ms-dos) '("$DJDIR/info" "$DJDIR/man/cat[1-9onlp]"))
-  "*List of SPECIFIC DIRECTORIES to search for UN*X manual files.
+  "List of SPECIFIC DIRECTORIES to search for UN*X manual files.
 For example
 
   (\"/emacs/etc\").
@@ -676,7 +730,7 @@ drive letters explicitly."
   :group 'woman-interface)
 
 (defcustom woman-cache-level 2
-  "*The level of topic caching.
+  "The level of topic caching.
 1 - cache only the topic and directory lists
     (the only level before version 0.34 - only for compatibility);
 2 - cache also the directories for each topic
@@ -695,7 +749,7 @@ file `woman-cache-filename' for a change to take effect.
   :group 'woman-interface)
 
 (defcustom woman-cache-filename nil
-  "*The full pathname of the WoMan directory and topic cache file.
+  "The full pathname of the WoMan directory and topic cache file.
 It is used to save and restore the cache between sessions.  This is
 especially useful with remote-mounted man page files!  The default
 value of nil suppresses this action.  The `standard' non-nil
@@ -707,7 +761,7 @@ the `woman' command to update and re-write the cache."
   :group 'woman-interface)
 
 (defcustom woman-dired-keys t
-  "*List of `dired' mode keys to define to run WoMan on current file.
+  "List of `dired' mode keys to define to run WoMan on current file.
 E.g. '(\"w\" \"W\"), or any non-null atom to automatically define
 \"w\" and \"W\" if they are unbound, or nil to do nothing.
 Default is t."
@@ -719,20 +773,20 @@ Default is t."
 (defcustom woman-imenu-generic-expression
   '((nil "\n\\([A-Z].*\\)" 1) ; SECTION, but not TITLE
     ("*Subsections*" "^   \\([A-Z].*\\)" 1))
-  "*Imenu support for Sections and Subsections.
+  "Imenu support for Sections and Subsections.
 An alist with elements of the form (MENU-TITLE REGEXP INDEX) --
 see the documentation for `imenu-generic-expression'."
   :type 'sexp
   :group 'woman-interface)
 
 (defcustom woman-imenu nil
-  "*If non-nil then WoMan adds a Contents menu to the menubar.
+  "If non-nil then WoMan adds a Contents menu to the menubar.
 It does this by calling `imenu-add-to-menubar'.  Default is nil."
   :type 'boolean
   :group 'woman-interface)
 
 (defcustom woman-imenu-title "CONTENTS"
-  "*The title to use if WoMan adds a Contents menu to the menubar.
+  "The title to use if WoMan adds a Contents menu to the menubar.
 Default is \"CONTENTS\"."
   :type 'string
   :group 'woman-interface)
@@ -741,13 +795,13 @@ Default is \"CONTENTS\"."
   ;; `woman-use-topic-at-point' may be let-bound when woman is loaded,
   ;; in which case its global value does not get defined.
   ;; `woman-file-name' sets it to this value if it is unbound.
-  "*Default value for `woman-use-topic-at-point'."
+  "Default value for `woman-use-topic-at-point'."
   :type '(choice (const :tag "Yes" t)
                 (const :tag "No" nil))
   :group 'woman-interface)
 
 (defcustom woman-use-topic-at-point woman-use-topic-at-point-default
-  "*Control use of the word at point as the default topic.
+  "Control use of the word at point as the default topic.
 If non-nil the `woman' command uses the word at point automatically,
 without interactive confirmation, if it exists as a topic."
   :type '(choice (const :tag "Yes" t)
@@ -778,7 +832,7 @@ Used as :set cookie by Customize when customizing the user options
 
 (defcustom woman-uncompressed-file-regexp
   "\\.\\([0-9lmnt]\\w*\\)"             ; disallow no extension
-  "*Do not change this unless you are sure you know what you are doing!
+  "Do not change this unless you are sure you know what you are doing!
 Regexp used to select man source files (ignoring any compression extension).
 
 The SysV standard man pages use two character suffixes, and this is
@@ -793,7 +847,7 @@ MUST NOT end with any kind of string terminator such as $ or \\'."
 
 (defcustom woman-file-compression-regexp
   "\\.\\(g?z\\|bz2\\)\\'"
-  "*Do not change this unless you are sure you know what you are doing!
+  "Do not change this unless you are sure you know what you are doing!
 Regexp used to match compressed man file extensions for which
 decompressors are available and handled by auto-compression mode,
 e.g. \"\\\\.\\\\(g?z\\\\|bz2\\\\)\\\\'\" for `gzip' or `bzip2'.
@@ -808,8 +862,8 @@ Should begin with \\. and end with \\' and MUST NOT be optional."
 
 (defcustom woman-use-own-frame         ; window-system
   (or (and (fboundp 'display-graphic-p) (display-graphic-p)) ; Emacs 21
-      (memq window-system '(x w32)))   ; Emacs 20
-  "*If non-nil then use a dedicated frame for displaying WoMan windows.
+      (memq window-system '(x w32 ns)))        ; Emacs 20
+  "If non-nil then use a dedicated frame for displaying WoMan windows.
 Only useful when run on a graphic display such as X or MS-Windows."
   :type 'boolean
   :group 'woman-interface)
@@ -823,37 +877,37 @@ Only useful when run on a graphic display such as X or MS-Windows."
   :group 'woman)
 
 (defcustom woman-fill-column 65
-  "*Right margin for formatted text -- default is 65."
+  "Right margin for formatted text -- default is 65."
   :type 'integer
   :group 'woman-formatting)
 
 (defcustom woman-fill-frame nil
   ;; Based loosely on a suggestion by Theodore Jump:
-  "*If non-nil then most of the window width is used."
+  "If non-nil then most of the window width is used."
   :type 'boolean
   :group 'woman-formatting)
 
 (defcustom woman-default-indent 5
-  "*Default prevailing indent set by -man macros -- default is 5.
+  "Default prevailing indent set by -man macros -- default is 5.
 Set this variable to 7 to emulate GNU man formatting."
   :type 'integer
   :group 'woman-formatting)
 
 (defcustom woman-bold-headings t
-  "*If non-nil then embolden section and subsection headings.  Default is t.
+  "If non-nil then embolden section and subsection headings.  Default is t.
 Heading emboldening is NOT standard `man' behavior."
   :type 'boolean
   :group 'woman-formatting)
 
 (defcustom woman-ignore t
-  "*If non-nil then unrecognized requests etc. are ignored.  Default is t.
+  "If non-nil then unrecognized requests etc. are ignored.  Default is t.
 This gives the standard ?roff behavior.  If nil then they are left in
 the buffer, which may aid debugging."
   :type 'boolean
   :group 'woman-formatting)
 
 (defcustom woman-preserve-ascii t
-  "*If non-nil, preserve ASCII characters in the WoMan buffer.
+  "If non-nil, preserve ASCII characters in the WoMan buffer.
 Otherwise, to save time, some backslashes and spaces may be
 represented differently (as the values of the variables
 `woman-escaped-escape-char' and `woman-unpadded-space-char'
@@ -865,7 +919,7 @@ buffer text is searched, copied or saved to a file."
   :group 'woman-formatting)
 
 (defcustom woman-emulation 'nroff
-  "*WoMan emulation, currently either nroff or troff.  Default is nroff.
+  "WoMan emulation, currently either nroff or troff.  Default is nroff.
 Troff emulation is experimental and largely untested.
 \(Add groff later?)"
   :type '(choice (const nroff) (const troff))
@@ -884,7 +938,7 @@ Troff emulation is experimental and largely untested.
   (or (and (fboundp 'display-color-p) (display-color-p))
       (and (fboundp 'display-graphic-p) (display-graphic-p))
       (x-display-color-p))
-  "*If non-nil then WoMan assumes that face support is available.
+  "If non-nil then WoMan assumes that face support is available.
 It defaults to a non-nil value if the display supports either colors
 or different fonts."
   :type 'boolean
@@ -955,13 +1009,15 @@ This is usually either black or white."
   (let (symbol-fonts)
     ;; With NTEmacs 20.5, the PATTERN option to `x-list-fonts' does
     ;; not seem to work and fonts may be repeated, so ...
-    (while fonts
-      (and (string-match "-Symbol-" (car fonts))
-          (not (member (car fonts) symbol-fonts))
-          (setq symbol-fonts (cons (car fonts) symbol-fonts)))
-      (setq fonts (cdr fonts)))
+    (dolist (font fonts)
+      (and (string-match "-Symbol-" font)
+          (not (member font symbol-fonts))
+          (setq symbol-fonts (cons font symbol-fonts))))
     symbol-fonts))
 
+(declare-function x-list-fonts "xfaces.c"
+                 (pattern &optional face frame maximum width))
+
 (when woman-font-support
   (make-face 'woman-symbol)
 
@@ -969,12 +1025,12 @@ This is usually either black or white."
   ;; avoid unnecessarily upsetting the line spacing in NTEmacs 20.5!
 
   (defcustom woman-use-extended-font t
-    "*If non-nil then may use non-ASCII characters from the default font."
+    "If non-nil then may use non-ASCII characters from the default font."
     :type 'boolean
     :group 'woman-faces)
 
   (defcustom woman-use-symbol-font nil
-    "*If non-nil then may use the symbol font.
+    "If non-nil then may use the symbol font.
 It is off by default, mainly because it may change the line spacing
 \(in NTEmacs 20.5)."
     :type 'boolean
@@ -986,7 +1042,7 @@ It is off by default, mainly because it may change the line spacing
     "Symbol font(s), preferably same size as default when WoMan was loaded.")
 
   (defcustom woman-symbol-font (car woman-symbol-font-list)
-    "*A string describing the symbol font to use for special characters.
+    "A string describing the symbol font to use for special characters.
 It should be compatible with, and the same size as, the default text font.
 Under MS-Windows, the default is
   \"-*-Symbol-normal-r-*-*-*-*-96-96-p-*-ms-symbol\"."
@@ -1199,10 +1255,9 @@ Return t if the file exists, nil otherwise."
   "Save the directory and topic cache.
 It is saved to the file named by the variable `woman-cache-filename'."
   (if woman-cache-filename
-      (save-excursion                  ; to restore current buffer
+      (with-current-buffer (generate-new-buffer "WoMan tmp buffer")
        ;; Make a temporary buffer; name starting with space "hides" it.
-       (let ((standard-output
-              (set-buffer (generate-new-buffer "WoMan tmp buffer")))
+       (let ((standard-output (current-buffer))
              (backup-inhibited t))
          ;; (switch-to-buffer standard-output t) ; only for debugging
          (buffer-disable-undo standard-output)
@@ -1344,10 +1399,8 @@ Ignore any paths that are unreadable or not directories."
   ;; Allow each path to be a single string or a list of strings:
   (if (not (listp woman-manpath)) (setq woman-manpath (list woman-manpath)))
   (if (not (listp woman-path)) (setq woman-path (list woman-path)))
-  (let (dir head dirs path)
-    (while woman-manpath
-      (setq dir (car woman-manpath)
-           woman-manpath (cdr woman-manpath))
+  (let (head dirs path)
+    (dolist (dir woman-manpath)
       (when (consp dir)
        (unless path
          (setq path (split-string (getenv "PATH") path-separator t)))
@@ -1361,9 +1414,7 @@ Ignore any paths that are unreadable or not directories."
          (setq dir (woman-canonicalize-dir dir)
                dirs (nconc dirs (directory-files
                                  dir t woman-manpath-man-regexp)))))
-    (while woman-path
-      (setq dir (car woman-path)
-           woman-path (cdr woman-path))
+    (dolist (dir woman-path)
       (if (or (null dir)
              (null (setq dir (woman-canonicalize-dir dir)
                          head (file-name-directory dir)))
@@ -1455,22 +1506,20 @@ Also make each path-info component into a list.
 \(Note that this function changes the value of ALIST.)"
   ;; Replaces unreadably "optimized" O(n^2) implementation.
   ;; Instead we use sorting to merge stuff efficiently.  -- dak
-  (let (elt newalist)
+  (let (newalist)
     ;; Sort list into reverse order
     (setq alist (sort alist (lambda(x y) (string< (car y) (car x)))))
     ;; merge duplicate keys.
     (if (> woman-cache-level 1)
-       (while alist
-         (setq elt (pop alist))
+       (dolist (elt alist)
          (if (equal (car elt) (caar newalist))
              (unless (member (cdr elt) (cdar newalist))
                (setcdr (car newalist) (cons (cdr elt)
                                             (cdar newalist))))
            (setcdr elt (list (cdr elt)))
            (push elt newalist)))
-    ;; woman-cache-level = 1 => elements are single-element lists ...
-      (while alist
-       (setq elt (pop alist))
+      ;; woman-cache-level = 1 => elements are single-element lists ...
+      (dolist (elt alist)
        (unless (equal (car elt) (caar newalist))
          (push elt newalist))))
     newalist))
@@ -1496,10 +1545,9 @@ Also make each path-info component into a list.
        ;; Use cached path-info to locate files for each topic:
        (let ((path-info (cdr (assoc topic topics)))
              filename)
-         (while path-info
-           (setq dir (nth (car (car path-info)) path)
-                 filename (car (cdr (car path-info)))
-                 path-info (cdr path-info)
+         (dolist (elt path-info)
+           (setq dir (nth (car elt) path)
+                 filename (car (cdr elt))
                  files (nconc files
                               ;; Find the actual file name:
                               (if filename
@@ -1534,7 +1582,7 @@ Also make each path-info component into a list.
   "Define dired keys to run WoMan according to `woman-dired-keys'."
   (if woman-dired-keys
       (if (listp woman-dired-keys)
-         (mapcar 'woman-dired-define-key woman-dired-keys)
+         (mapc 'woman-dired-define-key woman-dired-keys)
        (woman-dired-define-key-maybe "w")
        (woman-dired-define-key-maybe "W")))
   (define-key-after (lookup-key dired-mode-map [menu-bar immediate])
@@ -1648,7 +1696,10 @@ Do not call directly!"
        (select-frame
         (or (and (frame-live-p woman-frame) woman-frame)
             (setq woman-frame (make-frame)))))
-    (switch-to-buffer (get-buffer-create bufname))
+    (set-buffer (get-buffer-create bufname))
+    (condition-case nil
+        (switch-to-buffer (current-buffer))
+      (error (pop-to-buffer (current-buffer))))
     (buffer-disable-undo)
     (setq buffer-read-only nil)
     (erase-buffer)                     ; NEEDED for reformat
@@ -1767,21 +1818,21 @@ Leave point at end of new text.  Return length of inserted text."
 \f
 ;;; Major mode (Man) interface:
 
-(defvar woman-mode-map nil "Keymap for woman mode.")
+(defvar woman-mode-map
+  (let ((map (make-sparse-keymap)))
+    (set-keymap-parent map Man-mode-map)
 
-(unless woman-mode-map
-  (setq woman-mode-map (make-sparse-keymap))
-  (set-keymap-parent woman-mode-map Man-mode-map)
+    (define-key map "R" 'woman-reformat-last-file)
+    (define-key map "w" 'woman)
+    (define-key map "\en" 'WoMan-next-manpage)
+    (define-key map "\ep" 'WoMan-previous-manpage)
+    (define-key map [M-mouse-2] 'woman-follow-word)
 
-  (define-key woman-mode-map "R" 'woman-reformat-last-file)
-  (define-key woman-mode-map "w" 'woman)
-  (define-key woman-mode-map "\en" 'WoMan-next-manpage)
-  (define-key woman-mode-map "\ep" 'WoMan-previous-manpage)
-  (define-key woman-mode-map [M-mouse-2] 'woman-follow-word)
-
-  ;; We don't need to call `man' when we are in `woman-mode'.
-  (define-key woman-mode-map [remap man] 'woman)
-  (define-key woman-mode-map [remap man-follow] 'woman-follow))
+    ;; We don't need to call `man' when we are in `woman-mode'.
+    (define-key map [remap man] 'woman)
+    (define-key map [remap man-follow] 'woman-follow)
+    map)
+  "Keymap for woman mode.")
 
 (defun woman-follow (topic)
   "Get a Un*x manual page of the item under point and put it in a buffer."
@@ -1916,7 +1967,7 @@ See `Man-mode' for additional details."
   ;; necessary to avoid re-installing the same imenu:
   (setq woman-imenu-done nil)
   (if woman-imenu (woman-imenu))
-  (let (buffer-read-only)
+  (let ((inhibit-read-only t))
     (Man-highlight-references 'WoMan-xref-man-page))
   (set-buffer-modified-p nil)
   (run-mode-hooks 'woman-mode-hook))
@@ -1953,14 +2004,10 @@ Optional argument REDRAW, if non-nil, forces mode line to be updated."
     (setq apropos-accumulator
          (apropos-internal "woman"
                            (lambda (symbol)
-                             (or (commandp symbol)
-                                 (user-variable-p symbol)))))
-    ;; Filter out any inhibited symbols:
-    (let ((tem apropos-accumulator))
-      (while tem
-       (if (get (car tem) 'apropos-inhibit)
-           (setq apropos-accumulator (delq (car tem) apropos-accumulator)))
-       (setq tem (cdr tem))))
+                             (and
+                              (or (commandp symbol)
+                                  (user-variable-p symbol))
+                              (not (get symbol 'apropos-inhibit))))))
     ;; Find documentation strings:
     (let ((p apropos-accumulator)
          doc symbol)
@@ -2091,17 +2138,14 @@ alist in `woman-buffer-alist' and return nil."
   (char-to-string woman-unpadded-space-char)
   "Internal string representation of unpadded space characters.")
 
-(defvar woman-syntax-table nil
+(defvar woman-syntax-table
+  (let ((st (make-syntax-table)))
+    ;; The following internal chars must NOT have whitespace syntax:
+    (modify-syntax-entry woman-unpadded-space-char "." st)
+    (modify-syntax-entry woman-escaped-escape-char "." st)
+    st)
   "Syntax table to support special characters used internally by WoMan.")
 
-(if woman-syntax-table
-    ()
-  (setq woman-syntax-table (make-syntax-table))
-  ;; The following internal chars must NOT have whitespace syntax:
-  (modify-syntax-entry woman-unpadded-space-char "." woman-syntax-table)
-  (modify-syntax-entry woman-escaped-escape-char "." woman-syntax-table)
-  )
-
 (defun woman-set-buffer-display-table ()
   "Set up a display table for a WoMan buffer.
 This display table is used for displaying internal special characters, but
@@ -2169,14 +2213,14 @@ To be called on original buffer and any .so insertions."
   (goto-char from)
   ;; .eo turns off escape character processing
   (while (re-search-forward "\\(\\\\[\\e]\\)\\|^\\.eo" to t) ; \\
-    (if (match-string 1)
+    (if (match-beginning 1)
        (replace-match woman-escaped-escape-string t t)
       (woman-delete-whole-line)
       ;; .ec turns on escape character processing (and sets the
       ;; escape character to its argument, if any, which I'm ignoring
       ;; for now!)
       (while (and (re-search-forward "\\(\\\\\\)\\|^\\.ec" to t) ; \
-                 (match-string 1))
+                 (match-beginning 1))
        (replace-match woman-escaped-escape-string t t))
       ;; ***** Need test for .ec arg and warning here! *****
       (woman-delete-whole-line)))
@@ -2190,15 +2234,13 @@ To be called on original buffer and any .so insertions."
 (defun woman-non-underline-faces ()
   "Prepare non-underlined versions of underlined faces."
   (let ((face-list (face-list)))
-    (while face-list
-      (let* ((face (car face-list))
-            (face-name (symbol-name face)))
+    (dolist (face face-list)
+      (let ((face-name (symbol-name face)))
        (if (and (string-match "\\`woman-" face-name)
                 (face-underline-p face))
            (let ((face-no-ul (intern (concat face-name "-no-ul"))))
              (copy-face face face-no-ul)
-             (set-face-underline-p face-no-ul nil))))
-      (setq face-list (cdr face-list)))))
+             (set-face-underline-p face-no-ul nil)))))))
 
 ;; Preprocessors
 ;; =============
@@ -2449,7 +2491,7 @@ Preserves location of `point'."
            to t)
       (let ((from (match-beginning 0))
            (delim (regexp-quote (match-string 1)))
-           (absolute (match-string 2)) ; absolute position?
+           (absolute (match-beginning 2)) ; absolute position?
            (N (woman-parse-numeric-arg)) ; distance
            to
            msg)                        ; for warning
@@ -2628,7 +2670,7 @@ If DELETE is non-nil then delete from point."
                       ;; Interpret bogus `el \}' as `el \{',
                       ;; especially for Tcl/Tk man pages:
                       "\\(\\\\{\\|el[ \t]*\\\\}\\)\\|\\(\n[.']\\)?[ \t]*\\\\}[ \t]*")
-                     (match-string 1))
+                     (match-beginning 1))
               (re-search-forward "\\\\}"))
             (delete-region (if delete from (match-beginning 0)) (point))
             (if (looking-at "^$") (delete-char 1))
@@ -2731,11 +2773,9 @@ If DELETE is non-nil then delete from point."
 (defun woman0-rename ()
   "Effect renaming required by .rn requests."
   ;; For now, do this backwards AFTER all macro expansion.
-  (while woman0-rename-alist
-    (let* ((new (car woman0-rename-alist))
-          (old (cdr new))
-          (new (car new)))
-      (setq woman0-rename-alist (cdr woman0-rename-alist))
+  (dolist (new woman0-rename-alist)
+    (let ((old (cdr new))
+          (new (car new)))
       (goto-char (point-min))
       (setq new (concat "^[.'][ \t]*" (regexp-quote new)))
       (setq old (concat "." old))
@@ -2752,7 +2792,7 @@ Replaces || by |, but | by \, where | denotes the internal escape."
   (let (start)
     (while (setq start (string-match woman-unescape-regex macro start))
       (setq macro
-           (if (match-string 1 macro)
+           (if (match-beginning 1)
                (replace-match "" t t macro 1)
              (replace-match "\\" t t macro))
            start (1+ start)))
@@ -2762,7 +2802,7 @@ Replaces || by |, but | by \, where | denotes the internal escape."
   "Process .de/am xx yy -- (re)define/append macro xx; end at `..'.
 \(Should be up to call of yy, which defaults to `.')
 Optional argument APPEND, if non-nil, means append macro."
-  ;; Modelled on woman-strings.  BEWARE: Processing of .am is a hack!
+  ;; Modeled on woman-strings.  BEWARE: Processing of .am is a hack!
   ;; Add support for .rm?
   ;; (skip-chars-forward " \t")
   (if (eolp)                           ; ignore if no argument
@@ -2875,7 +2915,7 @@ interpolated by `\*x' and `\*(xx' escapes."
   (while
       ;; Find .ds requests and \* escapes:
       (re-search-forward "\\(^[.'][ \t]*ds\\)\\|\\\\\\*" to t)
-    (cond ((match-string 1)            ; .ds
+    (cond ((match-beginning 1)         ; .ds
           (skip-chars-forward " \t")
           (if (eolp)                   ; ignore if no argument
               ()
@@ -3004,7 +3044,7 @@ Set NEWTEXT in face FACE if specified."
                 ((cadr replacement)    ; Use ASCII simulation
                  (woman-replace-match (cadr replacement)))))
        (WoMan-warn (concat "Special character "
-                           (if (match-string 1) "\\(%s" "\\[%s]")
+                           (if (match-beginning 1) "\\(%s" "\\[%s]")
                            " not interpolated!") name)
        (if woman-ignore (woman-delete-match 0))))
     ))
@@ -3016,8 +3056,7 @@ together with the corresponding glyphs from the default and symbol fonts.
 Useful for constructing the alist variable `woman-special-characters'."
   (interactive)
   (with-output-to-temp-buffer "*WoMan Extended Font Map*"
-    (save-excursion
-      (set-buffer standard-output)
+    (with-current-buffer standard-output
       (let ((i 32))
        (while (< i 256)
          (insert (format "\\%03o " i) (string i) " " (string i))
@@ -3238,7 +3277,7 @@ If optional arg CONCAT is non-nil then join arguments."
     (setq c (concat "\\(" c "\\)\\|^[.'][ \t]*hc"))
     (save-excursion
       (while (and (re-search-forward c nil t)
-                 (match-string 1))
+                 (match-beginning 1))
        (delete-char -1)))
     ))
 
@@ -3315,7 +3354,7 @@ If optional arg CONCAT is non-nil then join arguments."
         "^[.'][ \t]*\\(\\(\\ft\\)\\|\\(.P\\)\\)\\|\\(\\\\f\\)" nil 1)
       (let (font beg notfont fescape)
        ;; Match font indicator and leave point at end of sequence:
-       (cond ((match-string 2)
+       (cond ((match-beginning 2)
               ;; .ft request found
               (setq beg (match-beginning 0))
               (skip-chars-forward " \t")
@@ -3323,10 +3362,10 @@ If optional arg CONCAT is non-nil then join arguments."
                   (setq font previous-font)
                 (looking-at "[^ \t\n]+"))
               (forward-line))          ; end of control line and \n
-             ((match-string 3)
+             ((match-beginning 3)
               ;; Macro that resets font found
               (setq font 'default))
-             ((match-string 4)
+             ((match-beginning 4)
               ;; \f escape found
               (setq beg (match-beginning 0)
                      fescape t)
@@ -3760,7 +3799,7 @@ expression in parentheses.  Leaves point after the value."
       (while
          (and
           (setq to (re-search-forward "\\(\\\\c\\)?\n[.']" nil t))
-          (match-string 1)
+          (match-beginning 1)
           (looking-at "br"))
        (goto-char (match-beginning 0))
        (woman-delete-line 2)))
@@ -3810,10 +3849,9 @@ v alters page foot left; m alters page head center.
       (insert " -- ")
       (woman-forward-arg 'unquote 'concat)
       ;; Delete repeated arguments:
-      (if (string-match (buffer-substring here (point))
+      (if (string-equal (buffer-substring here (point))
                        (buffer-substring start here))
-         (delete-region here (point)))
-      ))
+         (delete-region here (point)))))
   ;; Embolden heading (point is at end of heading):
   (woman-set-face
    (save-excursion (beginning-of-line) (point)) (point) 'woman-bold)
@@ -3922,12 +3960,10 @@ Leave 1 blank line.  Format paragraphs upto TO."
                ((eq c ?\t)             ; skip
                 (if (eq (following-char) ?\t)
                     (forward-char)     ; both tabs, just skip
-                  (let ((i woman-tab-width))
-                    (while (> i 0)
-                      (if (eolp)
-                          (insert ?\ ) ; extend line
-                        (forward-char)) ; skip
-                      (setq i (1- i)))
+                  (dotimes (i woman-tab-width)
+                     (if (eolp)
+                         (insert ?\ )  ; extend line
+                       (forward-char)) ; skip
                     )))
                (t
                 (if (or (eq (following-char) ?\ ) ; overwrite OK
@@ -4314,7 +4350,7 @@ Format paragraphs upto TO.  Set prevailing indent to I."
                  ;; Necessary to avoid spaces inheriting underlines.
                  ;; Cannot simply delete (current-column) whitespace
                  ;; characters because some may be tabs!
-                 (while (> i 0) (insert ? ) (setq i (1- i)))))
+                 (insert-char ?\s i)))
           (goto-char to)               ; necessary ???
           ))
     ))
@@ -4470,9 +4506,7 @@ tab stop columns or pairs (COLUMN . TYPE) where TYPE is R or C."
                    n (- (if n (1- n) eol) (point))
                    tab (- tab (if (eq type ?C) (/ n 2) n))) )
          (setq n (- tab (current-column)))
-         (while (> n 0)
-           (insert ?\ )
-           (setq n (1- n))))
+         (insert-char ?\s n))
       (insert ?\ ))))
 
 (defun woman2-DT (to)
@@ -4573,8 +4607,7 @@ Format paragraphs upto TO."
 (defun WoMan-log-begin ()
   "Log the beginning of formatting in *WoMan-Log*."
   (let ((WoMan-current-buffer (buffer-name)))
-    (save-excursion
-      (set-buffer (get-buffer-create "*WoMan-Log*"))
+    (with-current-buffer (get-buffer-create "*WoMan-Log*")
       (or (eq major-mode 'view-mode) (view-mode 1))
       (setq buffer-read-only nil)
       (goto-char (point-max))
@@ -4617,8 +4650,7 @@ with the message."
   "Log a message STRING in *WoMan-Log*.
 If optional argument END is non-nil then make buffer read-only after
 logging the message."
-  (save-excursion
-    (set-buffer (get-buffer-create "*WoMan-Log*"))
+  (with-current-buffer (get-buffer-create "*WoMan-Log*")
     (setq buffer-read-only nil)
     (goto-char (point-max))
     (or end (insert "  "))  (insert string "\n")
@@ -4637,5 +4669,5 @@ logging the message."
 
 (provide 'woman)
 
-;;; arch-tag: eea35e90-552f-4712-a94b-d9ffd3db7651
+;; arch-tag: eea35e90-552f-4712-a94b-d9ffd3db7651
 ;;; woman.el ends here