;;; woman.el --- browse UN*X manual pages `wo (without) man'
-;; Copyright (C) 2000 Free Software Foundation, Inc.
+;; Copyright (C) 2000, 2002, 2004, 2005 Free Software Foundation, Inc.
-;; Author: Francis J. Wright <F.J.Wright@Maths.QMW.ac.uk>
-;; Maintainer: Francis J. Wright <F.J.Wright@Maths.QMW.ac.uk>
-;; Keywords: help, man, UN*X, manual
-;; Adapted-By: Eli Zaretskii <eliz@is.elta.co.il>
+;; Author: Francis J. Wright <F.J.Wright@qmul.ac.uk>
+;; Maintainer: Francis J. Wright <F.J.Wright@qmul.ac.uk>
+;; Keywords: help, unix
+;; Adapted-By: Eli Zaretskii <eliz@gnu.org>
;; Version: see `woman-version'
-;; URL: http://centaur.maths.qmw.ac.uk/Emacs/WoMan/
+;; URL: http://centaur.maths.qmul.ac.uk/Emacs/WoMan/
;; This file is part of GNU Emacs.
;; Allow general delimiter in `\v', cf. `\h'.
;; Improve major-mode documentation.
;; Pre-process conditionals in macro bodies if possible for speed?
-;; Emulate some preprocessor support for tbl (.TS/.TE) and eqn (.EQ/.EN)
+;; Emulate more complete preprocessor support for tbl (.TS/.TE)
+;; Emulate some preprocessor support for eqn (.EQ/.EN)
;; Re-write filling and adjusting code!
;; Allow word wrap at comma (for long option lists)?
;; Buffer list handling not quite right.
;; Juanma Barranquero <barranquero@laley-actualidad.es>
;; Karl Berry <kb@cs.umb.edu>
;; Jim Chapman <jchapman@netcomuk.co.uk>
+;; Kin Cho <kin@neoscale.com>
;; Frederic Corne <frederic.corne@erli.fr>
;; Peter Craft <craft@alacritech.com>
;; Charles Curley <ccurley@trib.com>
;; Alexander Hinds <ahinds@thegrid.net>
;; Stefan Hornburg <sth@hacon.de>
;; Theodore Jump <tjump@cais.com>
+;; David Kastrup <dak@gnu.org>
;; Paul Kinnucan <paulk@mathworks.com>
;; Jonas Linde <jonas@init.se>
;; Andrew McRae <andrewm@optimation.co.nz>
;; Geoff Voelker <voelker@cs.washington.edu>
;; Eli Zaretskii <eliz@is.elta.co.il>
-(defvar woman-version "0.54 (beta)" "WoMan version information.")
-
;;; History:
;; For recent change log see end of file.
\f
;;; Code:
+(defvar woman-version "0.551 (beta)" "WoMan version information.")
+
(require 'man)
(eval-when-compile ; to avoid compiler warnings
(require 'dired)
"Return concatenated list of FN applied to successive `car' elements of X.
FN must return a list, cons or nil. Useful for splicing into a list."
;; Based on the Standard Lisp function MAPCAN but with args swapped!
- (and x (nconc (funcall fn (car x)) (woman-mapcan fn (cdr x)))))
+ ;; More concise implementation than the recursive one. -- dak
+ (apply #'nconc (mapcar fn x)))
-(defun woman-parse-colon-path (cd-path)
- "Explode a search path CD-PATH into a list of directory names.
+(defun woman-parse-colon-path (paths)
+ "Explode search path string PATHS into a list of directory names.
+Allow Cygwin colon-separated search paths on Microsoft platforms.
Replace null components by calling `woman-parse-man.conf'.
-Allow UN*X-style search paths on Microsoft platforms, i.e. allow path
-elements to be separated by colons and convert Cygwin-style drive
-specifiers `//x/' to `x:'."
+As a special case, if PATHS is nil then replace it by calling
+`woman-parse-man.conf'."
;; Based on suggestions by Jari Aalto and Eli Zaretskii.
- (mapcar
- (lambda (path) ; //a/b -> a:/b
- (when (and path (string-match "\\`//./" path))
- (setq path (substring path 1)) ; //a/b -> /a/b
- (aset path 0 (aref path 1)) ; /a/b -> aa/b
- (aset path 1 ?:)) ; aa/b -> a:/b
- path)
- (woman-mapcan ; splice into list...
- (lambda (path)
- ;; parse-colon-path returns nil for a null path component and
- ;; an empty substring of MANPATH denotes the default list...
- (if path (list path) (woman-parse-man.conf)))
- (if (and (memq system-type '(windows-nt ms-dos))
- (not (string-match ";" cd-path)))
- (let ((path-separator ":"))
- (parse-colon-path cd-path))
- (parse-colon-path cd-path)))))
+ ;; parse-colon-path returns nil for a null path component and
+ ;; an empty substring of MANPATH denotes the default list.
+ (if (memq system-type '(windows-nt ms-dos))
+ (cond ((null paths)
+ (mapcar 'woman-Cyg-to-Win (woman-parse-man.conf)))
+ ((string-match ";" paths)
+ ;; Assume DOS-style path-list...
+ (woman-mapcan ; splice list into list
+ (lambda (x)
+ (if x
+ (list x)
+ (mapcar 'woman-Cyg-to-Win (woman-parse-man.conf))))
+ (parse-colon-path paths)))
+ ((string-match "\\`[a-zA-Z]:" paths)
+ ;; Assume single DOS-style path...
+ paths)
+ (t
+ ;; Assume UNIX/Cygwin-style path-list...
+ (woman-mapcan ; splice list into list
+ (lambda (x)
+ (mapcar 'woman-Cyg-to-Win
+ (if x (list x) (woman-parse-man.conf))))
+ (let ((path-separator ":"))
+ (parse-colon-path paths)))))
+ ;; Assume host-default-style path-list...
+ (woman-mapcan ; splice list into list
+ (lambda (x) (if x (list x) (woman-parse-man.conf)))
+ (parse-colon-path (or paths "")))))
+
+(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))
\f
;;; User options:
:group 'woman)
(defcustom woman-man.conf-path
- '("/etc" "/etc/manpath.config" "/usr/local/lib")
+ (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.
-Default is '(\"/etc\" \"/usr/local/lib\") [for GNU/Linux, Cygwin resp.]
-A trailing separator (`/' for UNIX etc.) on directories is optional
-and the filename matched if a directory is specified is the first to
-contain the string \"man.conf\".
+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'."
:type '(repeat string)
:group 'woman-interface)
(defun woman-parse-man.conf ()
- "Parse if possible Linux-style configuration file for man command.
+ "Parse if possible configuration file for man command.
Used only if MANPATH is not set or contains null components.
Look in `woman-man.conf-path' and return a value for `woman-manpath'.
Concatenate data from all lines in the config file of the form
-
- MANPATH /usr/man
-
+ MANPATH /usr/man
or
-
- MANDATORY_MANPATH /usr/man"
+ MANDATORY_MANPATH /usr/man
+or
+ OPTIONAL_MANPATH /usr/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" t))
(file-readable-p (setq file (car file)))))
;; Parse the file -- if no MANPATH data ignore it:
(with-temp-buffer
(insert-file-contents file)
(while (re-search-forward
- "^[ \t]*\\(MANDATORY_\\)?MANPATH[ \t]+\\(\\S-+\\)" nil t)
- (setq manpath (cons (match-string 2) manpath)))
+ ;; `\(?: ... \)' is a "shy group"
+ "\
+^[ \t]*\\(?:MANDATORY_\\|OPTIONAL_\\)?MANPATH[ \t]+\\(\\S-+\\)" nil t)
+ (setq manpath (cons (match-string 1) manpath)))
manpath))
))
(setq path (cdr path)))
(nreverse manpath)))
(defcustom woman-manpath
- (let ((manpath (getenv "MANPATH")))
- (or
- (and manpath (woman-parse-colon-path manpath))
- (woman-parse-man.conf)
- '("/usr/man" "/usr/share/man" "/usr/local/man")
- ))
+ (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
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. By default this is
-either `/etc/man.config' or `/usr/local/lib/man.conf', which is
-determined by the user option `woman-man.conf-path'. An empty
-substring of MANPATH denotes the default list. Otherwise, the default
-value of this variable is
-
- (\"/usr/man\" \"/usr/local/man\").
+consulting the man configuration file if found, which is determined by
+the user option `woman-man.conf-path'. An empty substring of MANPATH
+denotes the default list.
Any environment variables (names must have the UN*X-style form $NAME,
-e.g. $HOME, $EMACSDATA, $EMACS_DIR) are evaluated first but each
+e.g. $HOME, $EMACSDATA, $emacs_dir) are evaluated first but each
element must evaluate to a SINGLE directory name. Trailing `/'s are
ignored. (Specific directories in `woman-path' are also searched.)
Microsoft platforms:
I recommend including drive letters explicitly, e.g.
- (\"C:/Cygnus/cygwin-b20/man\" \"C:/usr/man\" \"C:/usr/local/man\").
+ (\"C:/Cygwin/usr/man/\" \"C:/Cygwin/usr/local/man\").
The MANPATH environment variable may be set using DOS semi-colon-
-separated or UN*X / Cygwin colon-separated syntax (but not mixed)."
+separated or UN*X/Cygwin colon-separated syntax (but not mixed)."
:type '(repeat string)
:group 'woman-interface)
and unreadable files are ignored. The default value is nil.
Any environment variables (which must have the UN*X-style form $NAME,
-e.g. $HOME, $EMACSDATA, $EMACS_DIR) are evaluated first but each
+e.g. $HOME, $EMACSDATA, $emacs_dir) are evaluated first but each
element must evaluate to a SINGLE directory name (regexp, see above).
For example
- (\"$EMACSDATA\") [or equivalently (\"$EMACS_DIR/etc\")].
+ (\"$EMACSDATA\") [or equivalently (\"$emacs_dir/etc\")].
Trailing `/'s are discarded. (The directory trees in `woman-manpath'
are also searched.) On Microsoft platforms I recommend including
(defcustom woman-fill-frame nil
;; Based loosely on a suggestion by Theodore Jump:
- "*If non-nil then most of the frame 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.
-Set this variable to 7 to emulate Linux man formatting."
+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' behaviour."
+Heading emboldening is NOT standard `man' behavior."
:type 'boolean
:group 'woman-formatting)
(defcustom woman-ignore t
"*If non-nil then unrecognised requests etc. are ignored. Default is t.
-This gives the standard ?roff behaviour. If nil then they are left in
+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 nil
- "*If non-nil then preserve ASCII characters in the WoMan buffer.
-Otherwise, non-ASCII characters (that display as ASCII) may remain.
-This is irrelevant unless the buffer is to be saved to a file."
+(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
+buffer text is searched, copied or saved to a file."
+ ;; This option should probably be removed!
:type 'boolean
:group 'woman-formatting)
;; This is overkill! Troff uses just italic; Nroff uses just underline.
;; You should probably select either italic or underline as you prefer, but
;; not both, although italic and underline work together perfectly well!
-(defface woman-italic-face
- `((((background light)) (:italic t :underline t :foreground "red"))
- (((background dark)) (:italic t :underline t)))
+(defface woman-italic
+ `((((min-colors 88) (background light))
+ (:slant italic :underline t :foreground "red1"))
+ (((background light)) (:slant italic :underline t :foreground "red"))
+ (((background dark)) (:slant italic :underline t)))
"Face for italic font in man pages."
:group 'woman-faces)
+;; backward-compatibility alias
+(put 'woman-italic-face 'face-alias 'woman-italic)
-(defface woman-bold-face
- '((((background light)) (:bold t :foreground "blue"))
- (((background dark)) (:bold t :foreground "green2")))
+(defface woman-bold
+ '((((min-colors 88) (background light)) (:weight bold :foreground "blue1"))
+ (((background light)) (:weight bold :foreground "blue"))
+ (((background dark)) (:weight bold :foreground "green2")))
"Face for bold font in man pages."
:group 'woman-faces)
+;; backward-compatibility alias
+(put 'woman-bold-face 'face-alias 'woman-bold)
;; Brown is a good compromise: it is distinguishable from the default
;; but not enough so to make font errors look terrible. (Files that use
;; non-standard fonts seem to do so badly or in idiosyncratic ways!)
-(defface woman-unknown-face
+(defface woman-unknown
'((((background light)) (:foreground "brown"))
+ (((min-colors 88) (background dark)) (:foreground "cyan1"))
(((background dark)) (:foreground "cyan")))
"Face for all unknown fonts in man pages."
:group 'woman-faces)
+;; backward-compatibility alias
+(put 'woman-unknown-face 'face-alias 'woman-unknown)
-(defface woman-addition-face
+(defface woman-addition
'((t (:foreground "orange")))
- "Face for all additions made by WoMan to man pages.
-Default: foreground orange."
+ "Face for all WoMan additions to man pages."
:group 'woman-faces)
+;; backward-compatibility alias
+(put 'woman-addition-face 'face-alias 'woman-addition)
(defun woman-default-faces ()
- "Set foreground colours of italic and bold faces to their default values."
+ "Set foreground colors of italic and bold faces to their default values."
(interactive)
- (face-spec-set 'woman-italic-face
- (face-user-default-spec 'woman-italic-face))
- (face-spec-set 'woman-bold-face (face-user-default-spec 'woman-bold-face)))
+ (face-spec-set 'woman-italic (face-user-default-spec 'woman-italic))
+ (face-spec-set 'woman-bold (face-user-default-spec 'woman-bold)))
(defun woman-monochrome-faces ()
- "Set foreground colours of italic and bold faces to that of the default face.
+ "Set foreground colors of italic and bold faces to that of the default face.
This is usually either black or white."
(interactive)
- (set-face-foreground 'woman-italic-face 'unspecified)
- (set-face-foreground 'woman-bold-face 'unspecified))
+ (set-face-foreground 'woman-italic 'unspecified)
+ (set-face-foreground 'woman-bold 'unspecified))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Experimental font support, initially only for MS-Windows.
symbol-fonts))
(when woman-font-support
- (make-face 'woman-symbol-face)
+ (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!
Default is '(?n ?e ?o). Set via `woman-emulation'.")
\f
-;;; Button types:
-
-(define-button-type 'woman-xref
- 'action (lambda (button) (woman (button-label button)))
- 'help-echo "RET, mouse-2: display this man page")
-
-\f
;;; Specialized utility functions:
;;; Fast deletion without saving on the kill ring (cf. simple.el):
should be a topic string and non-nil RE-CACHE forces re-caching."
(interactive (list nil current-prefix-arg))
;; The following test is for non-interactive calls via gnudoit etc.
- (if (or (interactive-p) (not (stringp topic)) (string-match "\\S " topic))
+ (if (or (not (stringp topic)) (string-match "\\S " topic))
(let ((file-name (woman-file-name topic re-cache)))
(if file-name
(woman-find-file file-name)
;; Was let-bound when file loaded, so ...
(setq woman-topic-at-point woman-topic-at-point-default)))
(setq topic
- (current-word t)) ; only within or adjacent to word
+ (or (current-word t) "")) ; only within or adjacent to word
(assoc topic woman-topic-all-completions))
(setq topic
(completing-read
;; Initial input suggestion (was nil), with
;; cursor at left ready to kill suggestion!:
(and woman-topic-at-point
- (cons (current-word) 0)) ; nearest word
+ (cons (or (current-word) "") 0)) ; nearest word
'woman-topic-history)))
;; Note that completing-read always returns a string.
(if (= (length topic) 0)
;; including `.' and `..', so remove any trailing / !!!
(if (string= (substring dir -1) "/")
(setq dir (substring dir 0 -1)))
- (if (memq system-type '(windows-nt ms-dos)) ; what else?
+ (if (memq system-type '(windows-nt ms-dos cygwin)) ; what else?
;; Match capitalization used by `file-name-directory':
(setq dir (concat (file-name-directory dir)
(file-name-nondirectory dir))))
;; is re-processed by `woman-topic-all-completions-merge'.
(let (dir files (path-index 0)) ; indexing starts at zero
(while path
- (setq dir (car path)
- path (cdr path))
+ (setq dir (pop path))
(if (woman-not-member dir path) ; use each directory only once!
- (setq files
- (nconc files
- (woman-topic-all-completions-1 dir path-index))))
+ (push (woman-topic-all-completions-1 dir path-index)
+ files))
(setq path-index (1+ path-index)))
;; Uniquefy topics:
- (woman-topic-all-completions-merge files)))
+ ;; Concate all lists with a single nconc call to
+ ;; avoid retraversing the first lists repeatedly -- dak
+ (woman-topic-all-completions-merge
+ (apply #'nconc files))))
(defun woman-topic-all-completions-1 (dir path-index)
"Return an alist of the man topics in directory DIR with index PATH-INDEX.
;; unnecessary. So let us assume that `woman-file-regexp' will
;; filter out any directories, which probably should not be there
;; anyway, i.e. it is a user error!
- (mapcar
- (lambda (file)
- (cons
- (file-name-sans-extension
- (if (string-match woman-file-compression-regexp file)
- (file-name-sans-extension file)
- file))
- (if (> woman-cache-level 1)
- (cons
- path-index
- (if (> woman-cache-level 2)
- (cons file nil))))))
- (directory-files dir nil woman-file-regexp)))
+ ;;
+ ;; Don't sort files: we do that when merging, anyway. -- dak
+ (let (newlst (lst (directory-files dir nil woman-file-regexp t))
+ ;; Make an explicit regexp for stripping extension and
+ ;; compression extension: file-name-sans-extension is a
+ ;; far too costly function. -- dak
+ (ext (format "\\(\\.[^.\\/]*\\)?\\(%s\\)?\\'"
+ woman-file-compression-regexp)))
+ ;; Use a loop instead of mapcar in order to avoid the speed
+ ;; penalty of binding function arguments. -- dak
+ (dolist (file lst newlst)
+ (push
+ (cons
+ (if (string-match ext file)
+ (substring file 0 (match-beginning 0))
+ file)
+ (and (> woman-cache-level 1)
+ (cons
+ path-index
+ (and (> woman-cache-level 2)
+ (list file)))))
+ newlst))))
(defun woman-topic-all-completions-merge (alist)
"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.)"
- ;; Intended to be fast by avoiding recursion and list copying.
- (if (> woman-cache-level 1)
- (let ((newalist alist))
- (while newalist
- (let ((tail newalist) (topic (car (car newalist))))
- ;; Make the path-info into a list:
- (setcdr (car newalist) (list (cdr (car newalist))))
- (while tail
- (while (and tail (not (string= topic (car (car (cdr tail))))))
- (setq tail (cdr tail)))
- (if tail ; merge path-info into (car newalist)
- (let ((path-info (cdr (car (cdr tail)))))
- (if (member path-info (cdr (car newalist)))
- ()
- ;; Make the path-info into a list:
- (nconc (car newalist) (list path-info)))
- (setcdr tail (cdr (cdr tail))))
- ))
- (setq newalist (cdr newalist))))
- 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 (and alist (member (car alist) (cdr alist)))
- (setq alist (cdr alist)))
- (if alist
- (let ((newalist alist) cdr_alist)
- (while (setq cdr_alist (cdr alist))
- (if (not (member (car cdr_alist) (cdr cdr_alist)))
- (setq alist cdr_alist)
- (setcdr alist (cdr cdr_alist)))
- )
- newalist))))
+ (while alist
+ (setq elt (pop alist))
+ (unless (equal (car elt) (caar newalist))
+ (push elt newalist))))
+ newalist))
(defun woman-file-name-all-completions (topic)
"Return an alist of the files in all man directories that match TOPIC."
(defsubst woman-dired-define-key-maybe (key)
"If KEY is undefined in Dired, bind it to command `woman-dired-find-file'."
- (if (eq (lookup-key dired-mode-map key) 'undefined)
+ (if (or (eq (lookup-key dired-mode-map key) 'undefined)
+ (null (lookup-key dired-mode-map key)))
(woman-dired-define-key key)))
(defun woman-dired-define-keys ()
(goto-char (point-min))
(while (search-forward "__\b\b" nil t)
(backward-delete-char 4)
- (woman-set-face (point) (1+ (point)) 'woman-italic-face))
+ (woman-set-face (point) (1+ (point)) 'woman-italic))
(goto-char (point-min))
(while (search-forward "\b\b__" nil t)
(backward-delete-char 4)
- (woman-set-face (1- (point)) (point) 'woman-italic-face))))
+ (woman-set-face (1- (point)) (point) 'woman-italic))))
;; Interpret overprinting to indicate bold face:
(goto-char (point-min))
(while (re-search-forward "\\(.\\)\\(\\(\b+\\1\\)+\\)" nil t)
(woman-delete-match 2)
- (woman-set-face (1- (point)) (point) 'woman-bold-face))
+ (woman-set-face (1- (point)) (point) 'woman-bold))
;; Interpret underlining to indicate italic face:
;; (Must be AFTER emboldening to interpret bold _ correctly!)
(goto-char (point-min))
(while (search-forward "_\b" nil t)
(delete-char -2)
- (woman-set-face (point) (1+ (point)) 'woman-italic-face))
+ (woman-set-face (point) (1+ (point)) 'woman-italic))
;; Leave any other uninterpreted ^H's in the buffer for now! (They
;; might indicate composite special characters, which could be
(goto-char (point-min))
(forward-line)
(while (re-search-forward "^\\( \\)?\\([A-Z].*\\)" nil t)
- (woman-set-face (match-beginning 2) (match-end 2) 'woman-bold-face))))
+ (woman-set-face (match-beginning 2) (match-end 2) 'woman-bold))))
)
(defun woman-insert-file-contents (filename compressed)
Argument EVENT is the invoking mouse event."
(interactive "e") ; mouse event
(goto-char (posn-point (event-start event)))
- (woman (current-word t)))
+ (woman (or (current-word t) "")))
;; WoMan menu bar and pop-up menu:
-(easy-menu-define ; (SYMBOL MAPS DOC MENU)
- woman-menu
+(easy-menu-define
+ woman-menu ; (SYMBOL MAPS DOC MENU)
+ ;; That comment was moved after the symbol `woman-menu' to make
+ ;; find-function-search-for-symbol work. -- rost
woman-mode-map
"WoMan Menu"
`("WoMan"
(setq woman-imenu-done nil)
(if woman-imenu (woman-imenu))
(setq buffer-read-only nil)
- (WoMan-highlight-references)
+ (Man-highlight-references)
(setq buffer-read-only t)
(set-buffer-modified-p nil)))
(- (cadr time) (cadr WoMan-Man-start-time)))))
(message "Man formatting done in %d seconds" time)))
-(defun WoMan-highlight-references ()
- "Highlight the references (in the SEE ALSO section) on mouse-over."
- ;; Based on `Man-build-references-alist' in `man'.
- (when (Man-find-section Man-see-also-regexp)
- (forward-line 1)
- (let ((end (save-excursion
- (Man-next-section 1)
- (point))))
- (back-to-indentation)
- (while (re-search-forward Man-reference-regexp end t)
- ;; Highlight reference when mouse is over it.
- ;; (NB: WoMan does not hyphenate!)
- (make-text-button (match-beginning 1) (match-end 1)
- 'type 'woman-xref)))))
-
\f
;;; Buffer handling:
;; ***** Need test for .ec arg and warning here! *****
(woman-delete-whole-line)))
- ;; Delete comments .\"<anything>, \"<anything>, pre-processor
- ;; directives '\"<anything> (should give warning?) and null
- ;; requests. (However, should null . requests cause a break?)
+ ;; Delete comments .\"<anything>, \"<anything> and null requests.
+ ;; (However, should null . requests cause a break?)
(goto-char from)
(while (re-search-forward "^[.'][ \t]*\\(\\\\\".*\\)?\n\\|\\\\\".*" to t)
- (woman-delete-match 0))
- )
+ (woman-delete-match 0)))
(defun woman-non-underline-faces ()
"Prepare non-underlined versions of underlined faces."
(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
+;; Graeme W. Wilford <G.Wilford@ee.surrey.ac.uk>
+
+;; First, the environment variable $MANROFFSEQ is interrogated, and if
+;; not set then the initial line of the nroff file is parsed for a
+;; preprocessor string. To contain a valid preprocessor string, the
+;; first line must resemble
+;;
+;; '\" <string>
+;;
+;; where string can be any combination of the following letters that
+;; specify the sequence of preprocessors to run before nroff or
+;; troff/groff. Not all installations will have a full set of
+;; preprocessors. Some of the preprocessors and the letters used to
+;; designate them are: eqn (e), grap (g), pic (p), tbl (t), vgrind
+;; (v), refer (r). This option overrides the $MANROFFSEQ environment
+;; variable. zsoelim is always run as the very first preprocessor.
+
+(defvar woman-emulate-tbl nil
+ "True if WoMan should emulate the tbl preprocessor.
+This applies to text between .TE and .TS directives.
+Currently set only from '\" t in the first line of the source file.")
+
(defun woman-decode-region (from to)
"Decode the region between FROM and TO in UN*X man-page source format."
;; Suitable for use in format-alist.
;; Prepare non-underlined versions of underlined faces:
(woman-non-underline-faces)
- ;; Set font of `woman-symbol-face' to `woman-symbol-font' if
+ ;; Set font of `woman-symbol' face to `woman-symbol-font' if
;; `woman-symbol-font' is well defined.
(and woman-use-symbol-font
(stringp woman-symbol-font)
- (set-face-font 'woman-symbol-face woman-symbol-font
+ (set-face-font 'woman-symbol woman-symbol-font
(and (frame-live-p woman-frame) woman-frame)))
;; Set syntax and display tables:
;; Based loosely on a suggestion by Theodore Jump:
(if (or woman-fill-frame
(not (and (integerp woman-fill-column) (> woman-fill-column 0))))
- (setq woman-fill-column (- (frame-width) woman-default-indent)))
+ (setq woman-fill-column (- (window-width) woman-default-indent)))
+
+ ;; Check for preprocessor requests:
+ (goto-char from)
+ (if (looking-at "'\\\\\"[ \t]*\\([a-z]+\\)")
+ (let ((letters (append (match-string 1) nil)))
+ (if (memq ?t letters)
+ (setq woman-emulate-tbl t
+ letters (delete ?t letters)))
+ (if letters
+ (WoMan-warn "Unhandled preprocessor request letters %s"
+ (concat letters)))
+ (woman-delete-line 1)))
(woman-pre-process-region from nil)
;; Process ignore requests, macro definitions,
"^" "_")))
(cond (first
(replace-match repl nil t)
- (put-text-property (1- (point)) (point)
- 'face 'woman-addition-face)
+ (put-text-property (1- (point)) (point) 'face 'woman-addition)
(WoMan-warn
"Initial vertical motion escape \\%s simulated" esc)
(WoMan-log
(woman-strings to)
(goto-char from) ; necessary!
;; Strip font-change escapes:
- (while (re-search-forward "\\\\f\\((..\\|.\\)" to t)
+ (while (re-search-forward "\\\\f\\(\\[[^]]+\\]\\|(..\\|.\\)" to t)
(woman-delete-match 0))
(goto-char from) ; necessary!
(woman2-process-escapes to 'numeric))
\f
;;; Process strings:
+(defun woman-match-name ()
+ "Match and move over name of form: x, (xx or [xxx...].
+Applies to number registers, fonts, strings/macros/diversions, and
+special characters."
+ (cond ((= (following-char) ?\[ )
+ (forward-char)
+ (re-search-forward "[^]]+")
+ (forward-char)) ; skip closing ]
+ ((= (following-char) ?\( )
+ (forward-char)
+ (re-search-forward ".."))
+ (t (re-search-forward "."))))
+
(defun woman-strings (&optional to)
"Process ?roff string requests and escape sequences up to buffer position TO.
Strings are defined/updated by `.ds xx string' requests and
(woman-delete-line 1))
(t ; \*
(let ((beg (match-beginning 0)))
- (cond ((= (following-char) ?\( )
- (forward-char)
- (re-search-forward ".."))
- (t (re-search-forward ".")))
+ (woman-match-name)
(let* ((stringname (match-string 0))
(string (assoc stringname woman-string-alist)))
(cond (string
Set NEWTEXT in face FACE if specified."
(woman-delete-match 0)
(insert-before-markers newtext)
- (if face (put-text-property (1- (point)) (point)
- 'face 'woman-symbol-face))
+ (if face (put-text-property (1- (point)) (point) 'face 'woman-symbol))
t)
(defun woman-special-characters (to)
- "Process special character escapes \(xx up to buffer position TO.
+ "Process special character escapes \\(xx, \\[xxx] up to buffer position TO.
\(This must be done AFTER translation, which may use special characters.)"
- (while (re-search-forward "\\\\(\\(..\\)" to t)
- (let ((replacement
- (assoc (match-string-no-properties 1) woman-special-characters)))
- (if (and
+ (while (re-search-forward "\\\\\\(?:(\\(..\\)\\|\\[\\([[^]]+\\)\\]\\)" to t)
+ (let* ((name (or (match-string-no-properties 1)
+ (match-string-no-properties 2)))
+ (replacement (assoc name woman-special-characters)))
+ (unless
+ (and
replacement
(cond ((and (cddr replacement)
(if (nthcdr 3 replacement)
;; Need symbol font:
(if woman-use-symbol-font
(woman-replace-match (nth 2 replacement)
- 'woman-symbol-face))
+ 'woman-symbol))
;; Need extended font:
(if woman-use-extended-font
(woman-replace-match (nth 2 replacement))))))
((cadr replacement) ; Use ASCII simulation
(woman-replace-match (cadr replacement)))))
- ()
- (WoMan-warn "Special character \\(%s not interpolated!"
- (match-string-no-properties 1))
+ (WoMan-warn (concat "Special character "
+ (if (match-string 1) "\\(%s" "\\[%s]")
+ " not interpolated!") name)
(if woman-ignore (woman-delete-match 0))))
))
(while (< i 256)
(insert (format "\\%03o " i) (string i) " " (string i))
(put-text-property (1- (point)) (point)
- 'face 'woman-symbol-face)
+ 'face 'woman-symbol)
(insert " ")
(setq i (1+ i))
(when (= i 128) (setq i 160) (insert "\n"))
(defconst woman-font-alist
'(("R" . default)
- ("I" . woman-italic-face)
- ("B" . woman-bold-face)
+ ("I" . woman-italic)
+ ("B" . woman-bold)
("P" . previous)
("1" . default)
- ("2" . woman-italic-face)
- ("3" . woman-bold-face) ; used in bash.1
+ ("2" . woman-italic)
+ ("3" . woman-bold) ; used in bash.1
)
"Alist of ?roff font indicators and woman font variables and names.")
;; Paragraph .LP/PP/HP/IP/TP and font .B/.BI etc. macros reset font.
;; Should .SH/.SS reset font?
;; Font size setting macros (?) should reset font.
- (let ((woman-font-alist woman-font-alist) ; for local updating
+ (let ((font-alist woman-font-alist) ; for local updating
(previous-pos (point))
(previous-font 'default)
(current-font 'default))
((match-string 4)
;; \f escape found
(setq beg (match-beginning 0))
- (cond ((= (following-char) ?\( )
- (forward-char)
- (re-search-forward ".."))
- (t (re-search-forward ".")))
- )
+ (woman-match-name))
(t (setq notfont t)))
(if notfont
()
;; Get font name:
(or font
(let ((fontstring (match-string 0)))
- (setq font (assoc fontstring woman-font-alist)
- ;; NB: woman-font-alist contains VARIABLE NAMES.
+ (setq font (assoc fontstring font-alist)
+ ;; NB: font-alist contains VARIABLE NAMES.
font (if font
(cdr font)
(WoMan-warn "Unknown font %s." fontstring)
;; Output this message once only per call ...
- (setq woman-font-alist
- (cons (cons fontstring 'woman-unknown-face)
- woman-font-alist))
- 'woman-unknown-face)
+ (setq font-alist
+ (cons (cons fontstring 'woman-unknown)
+ font-alist))
+ 'woman-unknown)
)))
;; Delete font control line or escape sequence:
(cond (beg (delete-region beg (point))
(defun woman-get-next-char ()
"Return and delete next char in buffer, including special chars."
(if ;;(looking-at "\\\\(\\(..\\)")
- ;; Match special \(xx and strings \*x, \*(xx:
- (looking-at "\\\\\\((..\\|\\*\\((..\\|.\\)\\)")
+ ;; Match special \(xx and strings \*[xxx], \*(xx, \*x:
+ (looking-at "\\\\\\((..\\|\\*\\(\\[[^]]+\\]\\|(..\\|.\\)\\)")
(prog1 (match-string 0)
(woman-delete-match 0))
(prog1 (char-to-string (following-char))
;; currently needed to set match-end, even though
;; string-to-number returns 0 if number not parsed.
(string-to-number (match-string 0)))
- ((looking-at "\\\\n\\([-+]\\)?\\(\(\\(..\\)\\|\\(.\\)\\)")
+ ((looking-at "\\\\n\\([-+]\\)?\\(?:\
+\\[\\([^]]+\\)\\]\\|\(\\(..\\)\\|\\(.\\)\\)")
;; interpolate number register, maybe auto-incremented
(let* ((pm (match-string-no-properties 1))
- (name (or (match-string-no-properties 3)
+ (name (or (match-string-no-properties 2)
+ (match-string-no-properties 3)
(match-string-no-properties 4)))
(value (assoc name woman-registers)))
(if value
0) ; default to zero
))
((re-search-forward
- ;; Delimiter can be special char escape \(.. or
- ;; single normal char (usually '):
- "\\=\\\\w\\(\\\\(..\\|.\\)" nil t)
+ ;; Delimiter can be special char escape \[xxx],
+ ;; \(xx or single normal char (usually '):
+ "\\=\\\\w\\(\\\\\\[[^]]+\\]\\|\\\\(..\\|.\\)" nil t)
(let ((from (match-end 0))
(delim (regexp-quote (match-string 1))))
(if (re-search-forward delim nil t)
(defun woman2-PD (to)
".PD d -- Set the interparagraph distance to d.
Round to whole lines, default 1 line. Format paragraphs upto TO.
-(Breaks, but should not.)"
+\(Breaks, but should not.)"
;; .ie \\n[.$] .nr PD (v;\\$1)
;; .el .nr PD .4v>?\n[.V]
(woman-set-interparagraph-distance)
))
;; Embolden heading (point is at end of heading):
(woman-set-face
- (save-excursion (beginning-of-line) (point)) (point) 'woman-bold-face)
+ (save-excursion (beginning-of-line) (point)) (point) 'woman-bold)
(forward-line)
(delete-blank-lines)
(setq woman-left-margin woman-default-indent)
;; Optionally embolden heading (point is at beginning of heading):
(if woman-bold-headings
(woman-set-face
- (point) (save-excursion (end-of-line) (point)) 'woman-bold-face))
+ (point) (save-excursion (end-of-line) (point)) 'woman-bold))
(forward-line)
(setq woman-left-margin woman-default-indent
woman-nofill nil) ; fill output lines
(defun woman2-na (to)
".na -- No adjusting. Format paragraphs upto TO.
-(Breaks, but should not.)"
+\(Breaks, but should not.)"
(setq woman-adjust-previous woman-adjust
woman-justify-previous woman-justify
woman-adjust woman-adjust-left ; fill but do not adjust
(woman2-format-paragraphs to))
\f
+;;; Preliminary table support (.TS/.TE)
+
+(defun woman2-TS (to)
+ ".TS -- Start of table code for the tbl processor.
+Format paragraphs upto TO."
+ ;; This is a preliminary hack that seems to suffice for lilo.8.
+ (woman-delete-line 1) ; ignore any arguments
+ (when woman-emulate-tbl
+ ;; Assumes column separator is \t and intercolumn spacing is 3.
+ ;; The first line may optionally be a list of options terminated by
+ ;; a semicolon. Currently, just delete it:
+ (if (looking-at ".*;[ \t]*$") (woman-delete-line 1)) ;
+ ;; The following lines must specify the format of each line of the
+ ;; table and end with a period. Currently, just delete them:
+ (while (not (looking-at ".*\\.[ \t]*$")) (woman-delete-line 1))
+ (woman-delete-line 1)
+ ;; For each column, find its width and align it:
+ (let ((start (point)) (col 1))
+ (while (prog1 (search-forward "\t" to t) (goto-char start))
+ ;; Find current column width:
+ (while (< (point) to)
+ (when (search-forward "\t" to t)
+ (backward-char)
+ (if (> (current-column) col) (setq col (current-column))))
+ (forward-line))
+ ;; Align current column:
+ (goto-char start)
+ (setq col (+ col 3)) ; intercolumn space
+ (while (< (point) to)
+ (when (search-forward "\t" to t)
+ (delete-char -1)
+ (insert-char ?\ (- col (current-column))))
+ (forward-line))
+ (goto-char start))))
+ ;; Format table with no filling or adjusting (cf. woman2-nf):
+ (setq woman-nofill t)
+ (woman2-format-paragraphs to))
+
+(defalias 'woman2-TE 'woman2-fi)
+ ;; ".TE -- End of table code for the tbl processor."
+ ;; Turn filling and adjusting back on.
+
+\f
;;; WoMan message logging:
;; The basis for this logging code was shamelessly pirated from bytecomp.el
(provide 'woman)
-;; RECENT CHANGE LOG
-;; =================
-
-;; Changes in version 0.50 ([*] => user interface change)
-;; [*] Requires GNU Emacs 20.3+.
-;; [*] `defface' used to define faces.
-;; [*] Follow `see also' references with mouse-2 click.
-;; Number register increment support added (woman-registers).
-;; .j must be a NUMBER acceptable by .ad request.
-;; Very crude field support added.
-;; Vertical unit specifier `v' added to register handling.
-;; Improvement to local horizontal motion processing.
-;; Minor fix to handle negative numeric arguments.
-;; Handle horizontal motion escapes `\h' better.
-;; Allow arbitrary delimiters in `.if', inc. special character escapes.
-;; Allow `\n' within `.if' string comparisons.
-;; Allow arbitrary delimiters in `\w', inc. special character escapes.
-;; Processing of `\h' moved much later -- after indenting etc!
-
-;; Changes in version 0.51 ([*] => user interface change)
-;; [*] Improved handling of underlined faces (mainly for "italics").
-;; [*] Allow environment variables in directory path elements.
-;; Display of pre-formatted files improved.
-;; [*] Unintentional interaction with standard Man mode reduced.
-;; [*] bzip2 decompression support added. All decompression now
-;; works by turning on `auto-compression-mode' to decompress the
-;; file if necessary, rather than decompressing explicitly.
-;; Filename and compression regexps are now customizable user
-;; options.
-
-;; Changes in version 0.52 ([*] => user interface change)
-;; Speeded up handling of underlined faces (mainly for "italics").
-;; [*] WoMan formatting time display and log added. Emacs `man'
-;; formatting time display advice added. (This suggests that
-;; WoMan formatting is faster than Emacs `man' *formatting*,
-;; i.e. when man is not using `catman' caching. E.g. `woman
-;; bash' takes 27s whereas `man bash' takes 35s and for smaller
-;; files `woman' can be relatively much faster than `man'.)
-;; [*] Experimental support for non-ASCII characters from the
-;; default and symbol fonts added, initially only for MS-Windows.
-;; NOTE: It is off by default, mainly because it may increase the
-;; line spacing; customize `woman-use-symbols' to `on' to use it.
-;; Pad character handling for .fc fixed.
-;; Tested: see `woman.status'.
-
-;; Changes in version 0.53 ([*] => user interface change)
-;; [*] Customization option to use a separate frame for WoMan windows.
-;; [*] Experimental option to emulate nroff (default) or troff (not tested).
-;; [*] Separation of extended and symbol font options.
-;; Only symbol font size 16 seems to work, and only with Win 95, not NT!
-;; [*] `Advanced' sub-menu containing:
-;; `View Source' option;
-;; `Show Log' option;
-;; `Extended Font' toggle and reformat;
-;; `Symbol Font' toggle and reformat;
-;; `Font Map' option;
-;; `Emulation' radio buttons.
-;; [*] Support for man config file added for default manpath.
-
-;; Changes in version 0.54
-;; Revised for distribution with Emacs 21.
-;; Comment order and doc strings changed substantially.
-;; MS-DOS support added (by Eli Zaretskii).
-;; checkdoc run: no real errors.
-;; woman topic interface speeded up.
-
+;;; arch-tag: eea35e90-552f-4712-a94b-d9ffd3db7651
;;; woman.el ends here
HCoop / bpt / emacs.git / blobdiff