comparison lisp/woman.el @ 84355:2276ead2dd45

Remove spurious * in docstrings. (woman-mini-help, woman-non-underline-faces, woman0-rename) (woman-topic-all-completions-merge, woman-file-name-all-completions) (woman-select-symbol-fonts, woman-expand-directory-path): Use dolist. (woman-write-directory-cache, woman-display-extended-fonts) (WoMan-log-begin, WoMan-log-1): Use with-current-buffer. (woman-really-find-file): Use pop-to-buffer if switch-to-buffer fails. (woman-mode): Use inhibit-read-only. (woman-negative-vertical-space): Use dotimes. (woman2-tagged-paragraph, woman-tab-to-tab-stop): Use insert-char.

84354:1c76edb8a1b6

  "Browse UNIX manual pages `wo (without) man'."
  :tag "WoMan"
  :group 'help)

(defcustom woman-show-log nil
  "*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.
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.
Change only via `Customization' or the function `add-hook'."
  :type 'hook
  :group 'woman)



(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.
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
with \".conf\".  If MANPATH is not set but a config file is found
then it is parsed instead to provide a default value for

    (nreverse manpath)))

(defcustom woman-manpath
  (or (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.
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
and unreadable files are ignored.

  :type 'string
  :group 'woman-interface)

(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.
For example

  (\"/emacs/etc\").

These directories are searched in addition to the directory trees

drive letters explicitly."
  :type '(repeat (choice string (const nil)))
  :group 'woman-interface)

(defcustom woman-cache-level 2
  "*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
    (faster, without using much more memory);
3 - cache also the actual filenames for each topic

		 (const :tag "Default" 2)
		 (const :tag "Maximal" 3))
  :group 'woman-interface)

(defcustom woman-cache-filename nil
  "*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
filename is \"~/.wmncach.el\".  Remember that a prefix argument forces
the `woman' command to update and re-write the cache."

		 (const :tag "~/.wmncach.el" "~/.wmncach.el")
		 file)
  :group 'woman-interface)

(defcustom woman-dired-keys t
  "*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."
  :type '(choice (const :tag "None" nil)
		 (repeat string)

  :group 'woman-interface)

(defcustom woman-imenu-generic-expression
  '((nil "\n\\([A-Z].*\\)" 1) ; SECTION, but not TITLE
    ("*Subsections*" "^   \\([A-Z].*\\)" 1))
  "*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.
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.
Default is \"CONTENTS\"."
  :type 'string
  :group 'woman-interface)

(defcustom woman-use-topic-at-point-default nil
  ;; `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'."
  :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.
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)
		 (const :tag "No" nil))
  :group 'woman-interface)

		     (substring woman-file-compression-regexp 0 -2)
		     "\\)?\\'"))))

(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!
Regexp used to select man source files (ignoring any compression extension).

The SysV standard man pages use two character suffixes, and this is
becoming more common in the GNU world.  For example, the man pages
in the ncurses package include `toe.1m', `form.3x', etc.

  :set 'set-woman-file-regexp
  :group 'woman-interface)

(defcustom woman-file-compression-regexp
  "\\.\\(g?z\\|bz2\\)\\'"
  "*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'.
Should begin with \\. and end with \\' and MUST NOT be optional."
  ;; Should be compatible with car of

  :group 'woman-interface)

(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.
Only useful when run on a graphic display such as X or MS-Windows."
  :type 'boolean
  :group 'woman-interface)



  "Formatting options for browsing UNIX manual pages `wo (without) man'."
  :tag "WoMan Formatting"
  :group 'woman)

(defcustom woman-fill-column 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."
  :type 'boolean
  :group 'woman-formatting)

(defcustom woman-default-indent 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.
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.
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.
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'
respectively) so that the buffer content is strictly wrong even though
it should display correctly.  This should be irrelevant unless the

  ;; This option should probably be removed!
  :type 'boolean
  :group 'woman-formatting)

(defcustom woman-emulation '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))
  :group 'woman-formatting)

(defcustom woman-fontify
  (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.
It defaults to a non-nil value if the display supports either colors
or different fonts."
  :type 'boolean
  :group 'woman-faces)

(defun woman-select-symbol-fonts (fonts)
  "Select symbol fonts from a list FONTS of font name strings."
  (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)))
    symbol-fonts))

(when woman-font-support
  (make-face 'woman-symbol)

  ;; Set the symbol font only if `woman-use-symbol-font' is true, to
  ;; 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."
    :type 'boolean
    :group 'woman-faces)

  (defcustom woman-use-symbol-font nil
    "*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
    :group 'woman-faces)

    (or (woman-select-symbol-fonts (x-list-fonts "*" 'default))
	(woman-select-symbol-fonts (x-list-fonts "*")))
    "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.
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\"."
    :type `(choice
	    ,@(mapcar (lambda (x) (list 'const x))

(defun woman-write-directory-cache ()
  "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
	;; Make a temporary buffer; name starting with space "hides" it.
	(let ((standard-output
	       (set-buffer (generate-new-buffer "WoMan tmp buffer")))
	      (backup-inhibited t))
	  ;; (switch-to-buffer standard-output t) ; only for debugging
	  (buffer-disable-undo standard-output)
	  (princ
	   ";;; WoMan directory and topic cache -- generated automatically\n")

WOMAN-PATH should be a list of specific manual directory regexps.
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))
      (when (consp dir)
	(unless path
	  (setq path (split-string (getenv "PATH") path-separator t)))
	(setq dir (and (member (car dir) path)
		       (cdr dir))))

	  ;; If does not actually matter here if dir ends with `/'.
	  ;; Need regexp "man" here to avoid "cat?", `.', `..', etc.
	  (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))
      (if (or (null dir)
	      (null (setq dir (woman-canonicalize-dir dir)
			  head (file-name-directory dir)))
	      (woman-file-readable-p head))
	  (setq dirs

The cdr of each alist element is the path-index / filename."
  ;; Support 3 levels of caching: each element of the alist `files'
  ;; will be a list of the first `woman-cache-level' elements of the
  ;; following list: (topic path-index filename).  This alist `files'
  ;; is re-processed by `woman-topic-all-completions-merge'.
  (let (dir files (path-index 0))	; indexing starts at zero
    (while path
      (setq dir (pop path))
      (if (woman-not-member dir path)	; use each directory only once!
	  (push (woman-topic-all-completions-1 dir path-index)
		files))

  "Merge the alist ALIST so that the keys are unique.
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)
    ;; 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))
	  (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))
	(unless (equal (car elt) (caar newalist))
	  (push elt newalist))))
    newalist))

(defun woman-file-name-all-completions (topic)

	dir files)
    (if (cdr (car topics))
	;; 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)
		  files (nconc files
			       ;; Find the actual file name:
			       (if filename
				   (list (concat dir "/" filename))
				 (directory-files dir t topic-regexp)

  (let ((WoMan-current-file filename))	; used for message logging
    (if woman-use-own-frame
	(select-frame
	 (or (and (frame-live-p woman-frame) woman-frame)
	     (setq woman-frame (make-frame)))))
    (switch-to-buffer (get-buffer-create bufname))
    (buffer-disable-undo)
    (setq buffer-read-only nil)
    (erase-buffer)			; NEEDED for reformat
    (woman-insert-file-contents filename compressed)
    ;; Set buffer's default directory to that of the file.

  ;; necessary when reformatting a file in its old buffer:
  (setq imenu--last-menubar-index-alist nil)
  ;; necessary to avoid re-installing the same imenu:
  (setq woman-imenu-done nil)
  (if woman-imenu (woman-imenu))
  (let (buffer-read-only)
    (Man-highlight-references 'WoMan-xref-man-page))
  (set-buffer-modified-p nil)
  (run-mode-hooks 'woman-mode-hook))

(defun woman-imenu (&optional redraw)

	  (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))))
    ;; Find documentation strings:
    (let ((p apropos-accumulator)
	  doc symbol)
      (while p
	(setcar p (list			; must have 3 elements:

    (woman-delete-match 0)))

(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)))
	(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)))))

;; Preprocessors
;; =============

;; This information is based on documentation for the man command by

  (woman-delete-whole-line))

(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))
      (goto-char (point-min))
      (setq new (concat "^[.'][ \t]*" (regexp-quote new)))
      (setq old (concat "." old))
      (while (re-search-forward new nil t)
	(replace-match old nil t)))))

All the octal codes in the ranges [32..127] and [160..255] are displayed
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)
      (let ((i 32))
	(while (< i 256)
	  (insert (format "\\%03o " i) (string i) " " (string i))
	  (put-text-property (1- (point)) (point)
			     'face 'woman-symbol)

		((eq c ?\ )		; skip
		 (forward-char))
		((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)))
		     )))
		(t
		 (if (or (eq (following-char) ?\ ) ; overwrite OK
			 overwritten) ; warning only once per ".sp -"
		     ()

		  (delete-char 1)
		  (delete-horizontal-space)
		  ;; 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)))))
	   (goto-char to)		; necessary ???
	   ))
    ))

(defun woman2-HP (to)

		    n (save-excursion
			(search-forward "\t" eol t))
		    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 ?\ ))))

(defun woman2-DT (to)
  ".DT -- Restore default tabs.  Format paragraphs upto TO.
\(Breaks, but should not.)"

(defvar WoMan-Log-header-point-max nil)

(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*"))
      (or (eq major-mode 'view-mode) (view-mode 1))
      (setq buffer-read-only nil)
      (goto-char (point-max))
      (insert "\n\^L\nFormatting "
	      (if (stringp WoMan-current-file)

(defun WoMan-log-1 (string &optional end)
  "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*"))
    (setq buffer-read-only nil)
    (goto-char (point-max))
    (or end (insert "  "))  (insert string "\n")
    (if end
	(setq buffer-read-only t)

	     )))))
  nil)					; for woman-file-readable-p etc.

(provide 'woman)

;;; arch-tag: eea35e90-552f-4712-a94b-d9ffd3db7651
;;; woman.el ends here

84355:2276ead2dd45

  "Browse UNIX manual pages `wo (without) man'."
  :tag "WoMan"
  :group 'help)

(defcustom woman-show-log nil
  "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.
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.
Change only via `Customization' or the function `add-hook'."
  :type 'hook
  :group 'woman)



(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.
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
with \".conf\".  If MANPATH is not set but a config file is found
then it is parsed instead to provide a default value for

    (nreverse manpath)))

(defcustom woman-manpath
  (or (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.
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
and unreadable files are ignored.

  :type 'string
  :group 'woman-interface)

(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.
For example

  (\"/emacs/etc\").

These directories are searched in addition to the directory trees

drive letters explicitly."
  :type '(repeat (choice string (const nil)))
  :group 'woman-interface)

(defcustom woman-cache-level 2
  "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
    (faster, without using much more memory);
3 - cache also the actual filenames for each topic

		 (const :tag "Default" 2)
		 (const :tag "Maximal" 3))
  :group 'woman-interface)

(defcustom woman-cache-filename nil
  "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
filename is \"~/.wmncach.el\".  Remember that a prefix argument forces
the `woman' command to update and re-write the cache."

		 (const :tag "~/.wmncach.el" "~/.wmncach.el")
		 file)
  :group 'woman-interface)

(defcustom woman-dired-keys t
  "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."
  :type '(choice (const :tag "None" nil)
		 (repeat string)

  :group 'woman-interface)

(defcustom woman-imenu-generic-expression
  '((nil "\n\\([A-Z].*\\)" 1) ; SECTION, but not TITLE
    ("*Subsections*" "^   \\([A-Z].*\\)" 1))
  "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.
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.
Default is \"CONTENTS\"."
  :type 'string
  :group 'woman-interface)

(defcustom woman-use-topic-at-point-default nil
  ;; `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'."
  :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.
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)
		 (const :tag "No" nil))
  :group 'woman-interface)

		     (substring woman-file-compression-regexp 0 -2)
		     "\\)?\\'"))))

(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!
Regexp used to select man source files (ignoring any compression extension).

The SysV standard man pages use two character suffixes, and this is
becoming more common in the GNU world.  For example, the man pages
in the ncurses package include `toe.1m', `form.3x', etc.

  :set 'set-woman-file-regexp
  :group 'woman-interface)

(defcustom woman-file-compression-regexp
  "\\.\\(g?z\\|bz2\\)\\'"
  "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'.
Should begin with \\. and end with \\' and MUST NOT be optional."
  ;; Should be compatible with car of

  :group 'woman-interface)

(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.
Only useful when run on a graphic display such as X or MS-Windows."
  :type 'boolean
  :group 'woman-interface)



  "Formatting options for browsing UNIX manual pages `wo (without) man'."
  :tag "WoMan Formatting"
  :group 'woman)

(defcustom woman-fill-column 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."
  :type 'boolean
  :group 'woman-formatting)

(defcustom woman-default-indent 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.
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.
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.
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'
respectively) so that the buffer content is strictly wrong even though
it should display correctly.  This should be irrelevant unless the

  ;; This option should probably be removed!
  :type 'boolean
  :group 'woman-formatting)

(defcustom woman-emulation '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))
  :group 'woman-formatting)

(defcustom woman-fontify
  (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.
It defaults to a non-nil value if the display supports either colors
or different fonts."
  :type 'boolean
  :group 'woman-faces)

(defun woman-select-symbol-fonts (fonts)
  "Select symbol fonts from a list FONTS of font name strings."
  (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 ...
    (dolist (font fonts)
      (and (string-match "-Symbol-" font)
	   (not (member font symbol-fonts))
	   (setq symbol-fonts (cons font symbol-fonts))))
    symbol-fonts))

(when woman-font-support
  (make-face 'woman-symbol)

  ;; Set the symbol font only if `woman-use-symbol-font' is true, to
  ;; 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."
    :type 'boolean
    :group 'woman-faces)

  (defcustom woman-use-symbol-font nil
    "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
    :group 'woman-faces)

    (or (woman-select-symbol-fonts (x-list-fonts "*" 'default))
	(woman-select-symbol-fonts (x-list-fonts "*")))
    "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.
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\"."
    :type `(choice
	    ,@(mapcar (lambda (x) (list 'const x))

(defun woman-write-directory-cache ()
  "Save the directory and topic cache.
It is saved to the file named by the variable `woman-cache-filename'."
  (if woman-cache-filename
      (with-current-buffer (generate-new-buffer "WoMan tmp buffer")
	;; Make a temporary buffer; name starting with space "hides" it.
	(let ((standard-output (current-buffer))
	      (backup-inhibited t))
	  ;; (switch-to-buffer standard-output t) ; only for debugging
	  (buffer-disable-undo standard-output)
	  (princ
	   ";;; WoMan directory and topic cache -- generated automatically\n")

WOMAN-PATH should be a list of specific manual directory regexps.
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 (head dirs path)
    (dolist (dir woman-manpath)
      (when (consp dir)
	(unless path
	  (setq path (split-string (getenv "PATH") path-separator t)))
	(setq dir (and (member (car dir) path)
		       (cdr dir))))

	  ;; If does not actually matter here if dir ends with `/'.
	  ;; Need regexp "man" here to avoid "cat?", `.', `..', etc.
	  (setq dir (woman-canonicalize-dir dir)
		dirs (nconc dirs (directory-files
				  dir t woman-manpath-man-regexp)))))
    (dolist (dir woman-path)
      (if (or (null dir)
	      (null (setq dir (woman-canonicalize-dir dir)
			  head (file-name-directory dir)))
	      (woman-file-readable-p head))
	  (setq dirs

The cdr of each alist element is the path-index / filename."
  ;; Support 3 levels of caching: each element of the alist `files'
  ;; will be a list of the first `woman-cache-level' elements of the
  ;; following list: (topic path-index filename).  This alist `files'
  ;; is re-processed by `woman-topic-all-completions-merge'.
  (let (files (path-index 0))	; indexing starts at zero
    (while path
      (setq dir (pop path))
      (if (woman-not-member dir path)	; use each directory only once!
	  (push (woman-topic-all-completions-1 dir path-index)
		files))

  "Merge the alist ALIST so that the keys are unique.
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 (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)
	(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 ...
      (dolist (elt alist)
	(unless (equal (car elt) (caar newalist))
	  (push elt newalist))))
    newalist))

(defun woman-file-name-all-completions (topic)

	dir files)
    (if (cdr (car topics))
	;; Use cached path-info to locate files for each topic:
	(let ((path-info (cdr (assoc topic topics)))
	      filename)
	  (dolist (elt path-info)
	    (setq dir (nth (car elt) path)
		  filename (car (cdr elt))
		  files (nconc files
			       ;; Find the actual file name:
			       (if filename
				   (list (concat dir "/" filename))
				 (directory-files dir t topic-regexp)

  (let ((WoMan-current-file filename))	; used for message logging
    (if woman-use-own-frame
	(select-frame
	 (or (and (frame-live-p woman-frame) woman-frame)
	     (setq woman-frame (make-frame)))))
    (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
    (woman-insert-file-contents filename compressed)
    ;; Set buffer's default directory to that of the file.

  ;; necessary when reformatting a file in its old buffer:
  (setq imenu--last-menubar-index-alist nil)
  ;; necessary to avoid re-installing the same imenu:
  (setq woman-imenu-done nil)
  (if woman-imenu (woman-imenu))
  (let ((inhibit-read-only t))
    (Man-highlight-references 'WoMan-xref-man-page))
  (set-buffer-modified-p nil)
  (run-mode-hooks 'woman-mode-hook))

(defun woman-imenu (&optional redraw)

	  (apropos-internal "woman"
			    (lambda (symbol)
			      (or (commandp symbol)
				  (user-variable-p symbol)))))
    ;; Filter out any inhibited symbols:
    (dolist (sym apropos-accumulator)
      (if (get sym 'apropos-inhibit)
          (setq apropos-accumulator (delq sym apropos-accumulator))))
    ;; Find documentation strings:
    (let ((p apropos-accumulator)
	  doc symbol)
      (while p
	(setcar p (list			; must have 3 elements:

    (woman-delete-match 0)))

(defun woman-non-underline-faces ()
  "Prepare non-underlined versions of underlined faces."
  (let ((face-list (face-list)))
    (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)))))))

;; Preprocessors
;; =============

;; This information is based on documentation for the man command by

  (woman-delete-whole-line))

(defun woman0-rename ()
  "Effect renaming required by .rn requests."
  ;; For now, do this backwards AFTER all macro expansion.
  (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))
      (while (re-search-forward new nil t)
	(replace-match old nil t)))))

All the octal codes in the ranges [32..127] and [160..255] are displayed
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*"
    (with-current-buffer standard-output
      (let ((i 32))
	(while (< i 256)
	  (insert (format "\\%03o " i) (string i) " " (string i))
	  (put-text-property (1- (point)) (point)
			     'face 'woman-symbol)

		((eq c ?\ )		; skip
		 (forward-char))
		((eq c ?\t)		; skip
		 (if (eq (following-char) ?\t)
		     (forward-char)	; both tabs, just skip
		   (dotimes (i woman-tab-width)
                     (if (eolp)
                         (insert ?\ )	; extend line
                       (forward-char)) ; skip
		     )))
		(t
		 (if (or (eq (following-char) ?\ ) ; overwrite OK
			 overwritten) ; warning only once per ".sp -"
		     ()

		  (delete-char 1)
		  (delete-horizontal-space)
		  ;; Necessary to avoid spaces inheriting underlines.
		  ;; Cannot simply delete (current-column) whitespace
		  ;; characters because some may be tabs!
		  (insert-char ?\s i)))
	   (goto-char to)		; necessary ???
	   ))
    ))

(defun woman2-HP (to)

		    n (save-excursion
			(search-forward "\t" eol t))
		    n (- (if n (1- n) eol) (point))
		    tab (- tab (if (eq type ?C) (/ n 2) n))) )
	  (setq n (- tab (current-column)))
	  (insert-char ?\s n))
      (insert ?\ ))))

(defun woman2-DT (to)
  ".DT -- Restore default tabs.  Format paragraphs upto TO.
\(Breaks, but should not.)"

(defvar WoMan-Log-header-point-max nil)

(defun WoMan-log-begin ()
  "Log the beginning of formatting in *WoMan-Log*."
  (let ((WoMan-current-buffer (buffer-name)))
    (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))
      (insert "\n\^L\nFormatting "
	      (if (stringp WoMan-current-file)

(defun WoMan-log-1 (string &optional end)
  "Log a message STRING in *WoMan-Log*.
If optional argument END is non-nil then make buffer read-only after
logging the message."
  (with-current-buffer (get-buffer-create "*WoMan-Log*")
    (setq buffer-read-only nil)
    (goto-char (point-max))
    (or end (insert "  "))  (insert string "\n")
    (if end
	(setq buffer-read-only t)

	     )))))
  nil)					; for woman-file-readable-p etc.

(provide 'woman)

;; arch-tag: eea35e90-552f-4712-a94b-d9ffd3db7651
;;; woman.el ends here