;;; woman.el --- browse UN*X manual pages `wo (without) man'
-;; Copyright (C) 2000, 2002, 2003, 2004, 2005 Free Software Foundation, Inc.
+;; Copyright (C) 2000, 2001, 2002, 2003, 2004, 2005,
+;; 2006, 2007 Free Software Foundation, Inc.
;; Author: Francis J. Wright <F.J.Wright@qmul.ac.uk>
;; Maintainer: FSF
;; 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 2, or (at your option)
+;; the Free Software Foundation; either version 3, or (at your option)
;; any later version.
;; GNU Emacs is distributed in the hope that it will be useful,
;; man man_page_name
-;; Using the `word at point' as a topic suggestion
-;; ===============================================
+;; Using the word at point as the default topic
+;; ============================================
-;; By default, the `woman' command uses the word nearest to point in
-;; the current buffer as a suggestion for the topic to look up. The
-;; topic must be confirmed or edited in the minibuffer. This
-;; suggestion can be turned off, or `woman' can use the suggested
-;; topic without confirmation* if possible, by setting the user-option
-;; `woman-topic-at-point' to nil or t respectively. (Its default
-;; value is neither nil nor t, meaning ask for confirmation.)
+;; The `woman' command uses the word nearest to point in the current
+;; buffer as the default topic to look up if it matches the name of a
+;; manual page installed on the system. The default topic can also be
+;; used without confirmation by setting the user-option
+;; `woman-use-topic-at-point' to t; thanks to Benjamin Riefenstahl for
+;; suggesting this functionality.
-;; [* Thanks to Benjamin Riefenstahl for suggesting this
-;; functionality.]
-
-;; The variable `woman-topic-at-point' can be rebound locally, which
-;; may be useful to provide special private key bindings, e.g.
+;; The variable `woman-use-topic-at-point' can be rebound locally,
+;; which may be useful to provide special private key bindings, e.g.
;; (global-set-key "\C-cw"
;; (lambda ()
;; (interactive)
-;; (let ((woman-topic-at-point t))
+;; (let ((woman-use-topic-at-point t))
;; (woman)))))
;; code fragments, general interest, etc.:
;; Jari Aalto <jari.aalto@cs.tpu.fi>
;; Dean Andrews <dean@dra.com>
-;; Juanma Barranquero <barranquero@laley-actualidad.es>
+;; Juanma Barranquero <lekktu@gmail.com>
;; Karl Berry <kb@cs.umb.edu>
;; Jim Chapman <jchapman@netcomuk.co.uk>
;; Kin Cho <kin@neoscale.com>
(defvar woman-version "0.551 (beta)" "WoMan version information.")
(require 'man)
+(require 'button)
+(define-button-type 'WoMan-xref-man-page
+ :supertype 'Man-abstract-xref-man-page
+ 'func (lambda (arg)
+ (woman
+ ;; `woman' cannot deal with arguments that contain a
+ ;; section name, like close(2), so strip the section name.
+ (if (string-match Man-reference-regexp arg)
+ (substring arg 0 (match-end 1))
+ arg))))
+
(eval-when-compile ; to avoid compiler warnings
(require 'dired)
+ (require 'cl)
(require 'apropos))
(defun woman-mapcan (fn x)
(defun woman-Cyg-to-Win (file)
"Convert an absolute filename FILE from Cygwin to Windows form."
- ;; Code taken from w32-symlinks.el
- (if (eq (aref file 0) ?/)
- ;; Try to use Cygwin mount table via `cygpath.exe'.
- (condition-case nil
- (with-temp-buffer
- ;; cygpath -m file
- (call-process "cygpath" nil t nil "-m" file)
- (buffer-substring 1 (buffer-size)))
- (error
- ;; 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/
- (setq file (substring file (match-end 1))))
- (aset file 0 (aref file 1)) ; /x/ -> xx/
- (aset file 1 ?:)) ; xx/ -> x:/
- file))
- file))
+ ;; MANPATH_MAP conses are not converted since they presumably map
+ ;; Cygwin to Cygwin form.
+ (if (consp file)
+ file
+ ;; Code taken from w32-symlinks.el
+ (if (eq (aref file 0) ?/)
+ ;; Try to use Cygwin mount table via `cygpath.exe'.
+ (condition-case nil
+ (with-temp-buffer
+ ;; cygpath -m file
+ (call-process "cygpath" nil t nil "-m" file)
+ (buffer-substring 1 (buffer-size)))
+ (error
+ ;; Assume no `cygpath' program available.
+ ;; Hack /cygdrive/x/ or /x/ or (obsolete) //x/ to x:/
+ (when (string-match "\\`\\(/cygdrive\\|/\\)?/./" file)
+ (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:/
+ file))
+ file)))
\f
;;; User options:
: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)
(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
-contain the strings \"man\" and \".conf\" (in that order).
-If MANPATH is not set but a config file is found then it is parsed
-instead to provide a default value for `woman-manpath'."
+ "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
+`woman-manpath'."
:type '(repeat string)
:group 'woman-interface)
or
MANDATORY_MANPATH /usr/man
or
- OPTIONAL_MANPATH /usr/man"
+ OPTIONAL_MANPATH /usr/man
+or
+ MANPATH_MAP /opt/bin /opt/man"
;; Functionality suggested by Charles Curley.
(let ((path woman-man.conf-path)
file manpath)
(or (not (file-directory-p file))
(and
(setq file
- (directory-files file t "man.*\\.conf" t))
+ (directory-files file t "\\`man.*\\.conf[a-z]*\\'" t))
(file-readable-p (setq file (car file)))))
;; Parse the file -- if no MANPATH data ignore it:
(with-temp-buffer
(while (re-search-forward
;; `\(?: ... \)' is a "shy group"
"\
-^[ \t]*\\(?:MANDATORY_\\|OPTIONAL_\\)?MANPATH[ \t]+\\(\\S-+\\)" nil t)
- (setq manpath (cons (match-string 1) manpath)))
+^[ \t]*\\(?:\\(?:MANDATORY_\\|OPTIONAL_\\)?MANPATH[ \t]+\\(\\S-+\\)\\|\
+MANPATH_MAP[ \t]+\\(\\S-+\\)[ \t]+\\(\\S-+\\)\\)" nil t)
+ (add-to-list 'manpath
+ (if (match-beginning 1)
+ (match-string 1)
+ (cons (match-string 2)
+ (match-string 3)))))
manpath))
))
(setq path (cdr path)))
(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.
+ "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.
+Elements can also be a cons cell indicating a mapping from PATH
+to manual trees: if such an element's car is equal to a path
+element of the environment variable PATH, the cdr of the cons
+cell is included in the directory tree search.
+
If not set then the environment variable MANPATH is used. If no such
environment variable is found, the default list is determined by
consulting the man configuration file if found, which is determined by
The MANPATH environment variable may be set using DOS semi-colon-
separated or UN*X/Cygwin colon-separated syntax (but not mixed)."
- :type '(repeat string)
+ :type '(repeat (choice string (cons string string)))
:group 'woman-interface)
(defcustom woman-manpath-man-regexp "[Mm][Aa][Nn]"
(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\").
: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
: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
: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."
(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)
-(defcustom woman-topic-at-point-default 'confirm
- ;; `woman-topic-at-point' may be let-bound when woman is loaded, in
- ;; which case its global value does not get defined.
+(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-topic-at-point'."
+ "Default value for `woman-use-topic-at-point'."
:type '(choice (const :tag "Yes" t)
- (const :tag "No" nil)
- (other :tag "Confirm" confirm))
+ (const :tag "No" nil))
:group 'woman-interface)
-(defcustom woman-topic-at-point woman-topic-at-point-default
- "*Controls use by `woman' of `word at point' as a topic suggestion.
-If non-nil then the `woman' command uses the word at point as an
-initial topic suggestion when it reads a topic from the minibuffer; if
-t then the `woman' command uses the word at point WITHOUT
-INTERACTIVE CONFIRMATION if it exists as a topic. The default value
-is `confirm', meaning suggest a topic and ask for confirmation."
+(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)
- (other :tag "Confirm" confirm))
+ (const :tag "No" nil))
:group 'woman-interface)
(defvar woman-file-regexp nil
(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
(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'.
(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.
+ "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)
: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'
: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))
(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
(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))
(when woman-font-support
;; 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
"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\"."
Called both to generate and to check the cache!"
;; Must use substituted paths because values of env vars may change!
(list woman-cache-level
- (mapcar 'substitute-in-file-name woman-manpath)
+ (let (lst path)
+ (dolist (dir woman-manpath (nreverse lst))
+ (when (consp dir)
+ (unless path
+ (setq path
+ (split-string (getenv "PATH") path-separator t)))
+ (setq dir (and (member (car dir) path) (cdr dir))))
+ (when dir (add-to-list 'lst (substitute-in-file-name dir)))))
(mapcar 'substitute-in-file-name woman-path)))
(defun woman-read-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
+ (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)
(kill-buffer standard-output)
))))
-(defvar woman-topic-history nil "Topic read history.")
+(defvaralias 'woman-topic-history 'Man-topic-history)
(defvar woman-file-history nil "File-name read history.")
(defun woman-file-name (topic &optional re-cache)
"Get the name of the UN*X man-page file describing a chosen TOPIC.
-When `woman' is called interactively, the word at point may be used as
-the topic or initial topic suggestion, subject to the value of the
-user option `woman-topic-at-point'. Return nil if no file can be found.
-Optional argument RE-CACHE, if non-nil, forces the cache to be re-read."
+When `woman' is called interactively, the word at point may be
+automatically used as the topic, if the value of the user option
+`woman-use-topic-at-point' is non-nil. Return nil if no file can
+be found. Optional argument RE-CACHE, if non-nil, forces the
+cache to be re-read."
;; Handle the caching of the directory and topic lists:
(if (and (not re-cache)
(or
(let (files
(default (current-word)))
(or (stringp topic)
- (and (eq t
- (if (boundp 'woman-topic-at-point)
- woman-topic-at-point
- ;; Was let-bound when file loaded, so ...
- (setq woman-topic-at-point woman-topic-at-point-default)))
- (setq topic
- (or (current-word t) "")) ; only within or adjacent to word
- (assoc topic woman-topic-all-completions))
+ (and (if (boundp 'woman-use-topic-at-point)
+ woman-use-topic-at-point
+ ;; Was let-bound when file loaded, so ...
+ (setq woman-use-topic-at-point woman-use-topic-at-point-default))
+ (setq topic (or (current-word t) "")) ; only within or adjacent to word
+ (test-completion topic woman-topic-all-completions))
(setq topic
- (completing-read
- (if default
- (format "Manual entry (default `%s'): " default)
- "Manual entry: ")
- woman-topic-all-completions nil 1
- nil
- 'woman-topic-history
- ;; Default topic.
- (and woman-topic-at-point
- default))))
+ (let* ((word-at-point (current-word))
+ (default
+ (when (and word-at-point
+ (test-completion
+ word-at-point woman-topic-all-completions))
+ word-at-point)))
+ (completing-read
+ (if default
+ (format "Manual entry (default %s): " default)
+ "Manual entry: ")
+ woman-topic-all-completions nil 1
+ nil
+ 'woman-topic-history
+ default))))
;; Note that completing-read always returns a string.
(if (= (length topic) 0)
nil ; no topic, so no file!
;; 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)
- (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)))
+ (setq dir (and (member (car dir) path)
+ (cdr dir))))
(if (and dir (woman-file-readable-p dir))
;; NB: `parse-colon-path' creates null elements for
;; redundant (semi-)colons and trailing `/'s!
(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)))
\(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))
;; 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
"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])
(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
\f
;;; Major mode (Man) interface:
-(defvar woman-mode-map nil "Keymap for woman mode.")
-
-(unless woman-mode-map
- (setq woman-mode-map (make-sparse-keymap))
- (set-keymap-parent woman-mode-map Man-mode-map)
-
- (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))
+(defvar woman-mode-map
+ (let ((map (make-sparse-keymap)))
+ (set-keymap-parent 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)
+
+ ;; 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."
+ (interactive (list (Man-default-man-entry)))
+ (if (or (not topic)
+ (string= topic ""))
+ (error "No item under point")
+ (woman (if (string-match Man-reference-regexp topic)
+ (substring topic 0 (match-end 1))
+ topic))))
(defun woman-follow-word (event)
"Run WoMan with word under mouse as topic.
;; 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))
+ (let ((inhibit-read-only t))
+ (Man-highlight-references 'WoMan-xref-man-page))
(set-buffer-modified-p nil)
(run-mode-hooks 'woman-mode-hook))
(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)
;; Output the result:
(and (apropos-print t nil)
message
- (message message))))
+ (message "%s" message))))
(defun WoMan-getpage-in-background (topic)
(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
(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)))
(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
;; =============
;; conditionals and switch source requests:
(woman0-roff-buffer from)
+ ;; Check for macro sets that woman cannot handle. We can only
+ ;; because do this after processing source-switch directives.
+ (goto-char (point-min))
+ (let ((case-fold-search nil))
+ (unless (and (re-search-forward "^\\.SH[ \n]" (point-max) t)
+ (progn (goto-char (point-min))
+ (re-search-forward "^\\.TH[ \n]" (point-max) t))
+ (progn (goto-char (point-min))
+ (not (re-search-forward "^\\.\\([pnil]p\\|sh\\)[ \n]"
+ (point-max) t))))
+ (error "WoMan can only format man pages written with the usual `-man' macros")))
+
;; Process \k escapes BEFORE changing tab width (?):
(goto-char from)
(woman-mark-horizonal-position)
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
(woman0-search-regex
(concat woman0-search-regex-start woman0-search-regex-end))
woman0-rename-alist)
+ (set-marker-insertion-type woman0-if-to t)
(while (re-search-forward woman0-search-regex nil t)
(setq request (match-string 1))
(cond ((string= request "ig") (woman0-ig))
;; String delimiter can be any non-numeric character,
;; including a special character escape:
(looking-at "\\(\\\\(..\\|[^0-9]\\)\\(.*\\)\\1\\(.*\\)\\1\\'"))
- (let ((end1 (copy-marker (match-end 2)))) ; end of first string
+ (let ((end1 (copy-marker (match-end 2) t))) ; End of first string.
;; Delete 2nd and 3rd delimiters to avoid processing them:
(delete-region (match-end 3) woman0-if-to)
(delete-region (match-end 2) (match-beginning 3))
;; 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))
(error "File `%s' not found" name))
(beginning-of-line)
(woman-delete-line 1)
- (let ((from (point))
- (to (make-marker))
- (length (woman-insert-file-contents filename 0)))
- (set-marker to (+ from length))
+ (let* ((from (point))
+ (length (woman-insert-file-contents filename 0))
+ (to (copy-marker (+ from length) t)))
(woman-pre-process-region from to)
(set-marker to nil)
(goto-char from)
(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))
(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)))
(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
()
((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))))
))
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))
(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)))
))
;; Find font requests, paragraph macros and font escapes:
(re-search-forward
"^[.'][ \t]*\\(\\(\\ft\\)\\|\\(.P\\)\\)\\|\\(\\\\f\\)" nil 1)
- (let (font beg notfont)
+ (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")
(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))
+ (setq beg (match-beginning 0)
+ fescape t)
(woman-match-name))
(t (setq notfont t)))
(if notfont
;; Delete font control line or escape sequence:
(cond (beg (delete-region beg (point))
(if (eq font 'previous) (setq font previous-font))))
+ ;; Deal with things like \fB.cvsrc\fR at the start of a line.
+ ;; After removing the font control codes, this would
+ ;; otherwise match woman-request-regexp. The "\\&" which is
+ ;; inserted to prevent this is removed by woman2-process-escapes.
+ (and fescape
+ (looking-at woman-request-regexp)
+ (insert "\\&"))
(woman-set-face previous-pos (point) current-font)
(if beg
;; Explicit font control
(defsubst woman2-process-escapes-to-eol (&optional numeric)
"Process remaining escape sequences up to eol.
Handle numeric arguments specially if optional argument NUMERIC is non-nil."
- (woman2-process-escapes
- (save-excursion (end-of-line) (point-marker))
- numeric))
+ (woman2-process-escapes (copy-marker (line-end-position) t) numeric))
(defun woman2-nr (to)
".nr R +/-N M -- Assign +/-N (wrt to previous value, if any) to register R.
(woman-registers woman-registers)
fn request translations
tab-stop-list)
+ (set-marker-insertion-type to t)
;; ?roff does not squeeze multiple spaces, but does fill, so...
(fset 'canonically-space-region 'ignore)
;; Try to avoid spaces inheriting underlines from preceding text!
(unwind-protect
(while
;; Find next control line:
- (re-search-forward woman-request-regexp nil t)
- (cond
- ;; Construct woman function to call:
- ((setq fn (intern-soft
- (concat "woman2-"
- (setq request (match-string 1)))))
- ;; Delete request or macro name:
- (woman-delete-match 0))
- ;; Unrecognised request:
- ((prog1 nil
- ;; (WoMan-warn ".%s request ignored!" request)
- (WoMan-warn-ignored request "ignored!")
- ;; (setq fn 'woman2-LP)
- ;; AVOID LEAVING A BLANK LINE!
- ;; (setq fn 'woman2-format-paragraphs)
- ))
- ;; .LP assumes it is at eol and leaves a (blank) line,
- ;; so leave point at end of line before paragraph:
- ((or (looking-at "[ \t]*$") ; no argument
- woman-ignore) ; ignore all
- ;; (beginning-of-line) (kill-line)
- ;; AVOID LEAVING A BLANK LINE!
- (beginning-of-line) (woman-delete-line 1))
- (t (end-of-line) (insert ?\n))
- )
- (if (not (or fn
- (and (not (memq (following-char) '(?. ?')))
- (setq fn 'woman2-format-paragraphs))))
- ()
- ;; Find next control line:
- (set-marker to (woman-find-next-control-line))
- ;; Call the appropriate function:
- (funcall fn to)))
+ (re-search-forward woman-request-regexp nil t)
+ (cond
+ ;; Construct woman function to call:
+ ((setq fn (intern-soft
+ (concat "woman2-"
+ (setq request (match-string 1)))))
+ ;; Delete request or macro name:
+ (woman-delete-match 0))
+ ;; Unrecognised request:
+ ((prog1 nil
+ ;; (WoMan-warn ".%s request ignored!" request)
+ (WoMan-warn-ignored request "ignored!")
+ ;; (setq fn 'woman2-LP)
+ ;; AVOID LEAVING A BLANK LINE!
+ ;; (setq fn 'woman2-format-paragraphs)
+ ))
+ ;; .LP assumes it is at eol and leaves a (blank) line,
+ ;; so leave point at end of line before paragraph:
+ ((or (looking-at "[ \t]*$") ; no argument
+ woman-ignore) ; ignore all
+ ;; (beginning-of-line) (kill-line)
+ ;; AVOID LEAVING A BLANK LINE!
+ (beginning-of-line) (woman-delete-line 1))
+ (t (end-of-line) (insert ?\n))
+ )
+ (if (not (or fn
+ (and (not (memq (following-char) '(?. ?')))
+ (setq fn 'woman2-format-paragraphs))))
+ ()
+ ;; Find next control line:
+ (set-marker to (woman-find-next-control-line))
+ ;; Call the appropriate function:
+ (funcall fn to)))
(if (not (eobp)) ; This should not happen, but ...
- (woman2-format-paragraphs (point-max-marker) woman-left-margin))
+ (woman2-format-paragraphs (copy-marker (point-max) t)
+ woman-left-margin))
(fset 'canonically-space-region canonically-space-region)
(fset 'set-text-properties set-text-properties)
(fset 'insert-and-inherit insert-and-inherit)
(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)))
((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
(defun woman2-process-escapes (to &optional numeric)
"Process remaining escape sequences up to marker TO, preserving point.
Optional argument NUMERIC, if non-nil, means the argument is numeric."
+ (assert (and (markerp to) (marker-insertion-type to)))
;; The first two cases below could be merged (maybe)!
(let ((from (point)))
;; Discard zero width filler character used to hide leading dots
(delete-char -1)
(delete-char 1)
(looking-at "\\(.\\)\\(.*\\)\\1")
- (let ((to (make-marker)) from N c)
- (set-marker to (match-end 2))
- (delete-char 1)
- (setq from (point)
- N (woman-parse-numeric-arg))
- (setq c (if (< (point) to) (following-char) ?_))
+ (forward-char 1)
+ (let* ((to (match-end 2))
+ (from (match-beginning 0))
+ (N (woman-parse-numeric-arg))
+ (c (if (< (point) to) (following-char) ?_)))
(delete-region from to)
(delete-char 1)
- (set-marker to nil)
(insert (make-string N c))
))
(eolp)
(skip-syntax-forward " ")
(setq woman-leave-blank-lines 1))
- (beginning-of-line)
+ ;; This shouldn't happen, but in case it does (e.g. for
+ ;; badly-formatted manfiles with no terminating newline),
+ ;; avoid an infinite loop.
+ (unless (and (eolp) (eobp))
+ (beginning-of-line))
;; If a single short line then just leave it.
;; This is necessary to preserve some table layouts.
;; PROBABLY NOT NECESSARY WITH SQUEEZE MODIFICATION !!!!!
(let ((i (woman2-get-prevailing-indent 'leave-eol)))
(beginning-of-line)
(woman-leave-blank-lines) ; must be here,
- (woman2-tagged-paragraph to i))))
+ ;;
+ ;; The cvs.1 manpage contains some (possibly buggy) syntax that
+ ;; confuses woman, although the man program displays it ok.
+ ;; Most problems are caused by IP followed by another request on
+ ;; the next line. Without the following hack, the second request
+ ;; gets displayed raw in the output. Note that
+ ;; woman2-tagged-paragraph also contains a hack for similar
+ ;; issues (eg IP followed by SP).
+ ;;
+ ;; i) For IP followed by one or more IPs, we ignore all but the
+ ;; last (mimic man). The hack in w-t-p would only work for two
+ ;; consecutive IPs, and would use the first.
+ ;; ii) For IP followed by SP followed by one or more requests,
+ ;; do nothing. At least in cvs.1, there is usually another IP in
+ ;; there somewhere.
+ (unless (or (looking-at "^\\.IP")
+ (and (looking-at "^\\.sp")
+ (save-excursion
+ (and (zerop (forward-line 1))
+ (looking-at woman-request-regexp)))))
+ (woman2-tagged-paragraph to i)))))
(defun woman-find-next-control-line-carefully ()
"Find and return start of next control line, even if already there!"
(if (not (looking-at "\\s *$")) ; non-empty tag
(setq woman-leave-blank-lines nil))
- ;; Temporary hack for bash.1 and groff_mmse.7 until code is revised
- ;; to process all requests uniformly:
- (cond ((and (= (point) to) (looking-at "^[.'][ \t]*\\(PD\\|br\\|ta\\) *"))
- (if (string= (match-string 1) "br")
- (woman-delete-line 1)
- (woman-delete-match 0)
- (if (string= (match-string 1) "ta") ; for GetInt.3
- (woman2-ta to)
- (woman-set-interparagraph-distance)))
- (set-marker to (woman-find-next-control-line-carefully))
- ))
+ ;; Temporary hack for bash.1, cvs.1 and groff_mmse.7 until code is revised
+ ;; to process all requests uniformly.
+ ;; This hack deals with IP requests followed by other requests (eg
+ ;; SP) on the very next line. We skip over the SP, otherwise it gets
+ ;; inserted raw in the rendered output.
+ (cond ((and (= (point) to)
+ (looking-at "^[.'][ \t]*\\(PD\\|br\\|ta\\|sp\\) *"))
+ (if (member (match-string 1) '("br" "sp"))
+ (woman-delete-line 1)
+ (woman-delete-match 0)
+ (if (string= (match-string 1) "ta") ; for GetInt.3
+ (woman2-ta to)
+ (woman-set-interparagraph-distance)))
+ (set-marker to (woman-find-next-control-line-carefully))
+ ))
(let ((tag (point)))
(woman-reset-nospace)
;; 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 ???
))
))
(let ((i (woman-get-numeric-arg)))
(woman-delete-line) (or leave-eol (delete-char 1))
;; i = 0 if the argument was not a number
+ ;; FIXME should this be >= 0? How else to reset to 0 indent?
(if (> i 0) (setq woman-prevailing-indent i))))
woman-prevailing-indent)
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)
(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))
"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")
(provide 'woman)
-;;; arch-tag: eea35e90-552f-4712-a94b-d9ffd3db7651
+;; arch-tag: eea35e90-552f-4712-a94b-d9ffd3db7651
;;; woman.el ends here
HCoop / bpt / emacs.git / blobdiff