X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/1edbbf8a47461567f8fabf28c17bf2a25e561474..ae48944514a529eb78caff789171393fa6c82287:/lisp/woman.el diff --git a/lisp/woman.el b/lisp/woman.el index 1fa337e852..5ecc474430 100644 --- a/lisp/woman.el +++ b/lisp/woman.el @@ -1,13 +1,13 @@ ;;; woman.el --- browse UN*X manual pages `wo (without) man' -;; Copyright (C) 2000 Free Software Foundation, Inc. +;; Copyright (C) 2000, 2002, 2003, 2004, 2005 Free Software Foundation, Inc. -;; Author: Francis J. Wright -;; Maintainer: Francis J. Wright -;; Keywords: help, man, UN*X, manual -;; Adapted-By: Eli Zaretskii -;; Version: see `woman-version' -;; URL: http://centaur.maths.qmw.ac.uk/Emacs/ +;; Author: Francis J. Wright +;; Maintainer: Francis J. Wright +;; Keywords: help, unix +;; Adapted-By: Eli Zaretskii +;; Version: see `woman-version' +;; URL: http://centaur.maths.qmul.ac.uk/Emacs/WoMan/ ;; This file is part of GNU Emacs. @@ -23,8 +23,8 @@ ;; You should have received a copy of the GNU General Public License ;; along with GNU Emacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. +;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, +;; Boston, MA 02110-1301, USA. ;;; Commentary: @@ -337,7 +337,8 @@ ;; 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. @@ -386,6 +387,7 @@ ;; Juanma Barranquero ;; Karl Berry ;; Jim Chapman +;; Kin Cho ;; Frederic Corne ;; Peter Craft ;; Charles Curley @@ -400,6 +402,7 @@ ;; Alexander Hinds ;; Stefan Hornburg ;; Theodore Jump +;; David Kastrup ;; Paul Kinnucan ;; Jonas Linde ;; Andrew McRae @@ -417,8 +420,7 @@ ;; Paul A. Thompson ;; Arrigo Triulzi ;; Geoff Voelker - -(defvar woman-version "0.54 (beta)" "WoMan version information.") +;; Eli Zaretskii ;;; History: ;; For recent change log see end of file. @@ -426,43 +428,76 @@ ;;; Code: +(defvar woman-version "0.551 (beta)" "WoMan version information.") + (require 'man) (eval-when-compile ; to avoid compiler warnings (require 'dired) (require 'apropos)) (defun woman-mapcan (fn x) - "Return concatenated list of FN applied to successive CAR elements of X. + "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))))) - -(defun woman-parse-colon-path (cd-path) - "Explode a search path CD-PATH into a list of directory names. -If the platform is Microsoft Windows and no path contains `\\' then -assume a Cygwin-style colon-separated search path and convert any -leading drive specifier `//X/' to `X:', otherwise assume paths -separated by `path-separator'." - ;; Based on a suggestion by Jari Aalto. - (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 (cons path nil) (woman-parse-man.conf))) - (if (and (memq system-type '(windows-nt ms-dos)) - (not (or (string-match ";" cd-path) - (string-match "\\\\" cd-path)))) - (let ((path-separator ":")) - (mapcar - (lambda (path) ; //a/b -> a:/b - (cond ((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) - (parse-colon-path cd-path))) - (parse-colon-path cd-path)))) + ;; More concise implementation than the recursive one. -- dak + (apply #'nconc (mapcar fn x))) + +(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'. +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. + ;; 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)) ;;; User options: @@ -501,22 +536,29 @@ Change only via `Customization' or the function `add-hook'." :group 'woman) (defcustom woman-man.conf-path - '("/etc" "/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 man config file if found. (Used only if MANPATH is not set.) + "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 +or + OPTIONAL_MANPATH /usr/man" ;; Functionality suggested by Charles Curley. (let ((path woman-man.conf-path) file manpath) @@ -528,13 +570,15 @@ MANPATH /usr/man" (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]*MANPATH[ \t]+\\(\\S-+\\)" nil t) + ;; `\(?: ... \)' is a "shy group" + "\ +^[ \t]*\\(?:MANDATORY_\\|OPTIONAL_\\)?MANPATH[ \t]+\\(\\S-+\\)" nil t) (setq manpath (cons (match-string 1) manpath))) manpath)) )) @@ -542,12 +586,8 @@ MANPATH /usr/man" (nreverse manpath))) (defcustom woman-manpath - (let ((manpath (getenv "MANPATH"))) - (or - (and manpath (woman-parse-colon-path manpath)) - (woman-parse-man.conf) - '("/usr/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 @@ -556,26 +596,22 @@ and unreadable files are ignored. 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) @@ -604,11 +640,11 @@ string is expanded into a list of matching directories. Non-directory 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 @@ -752,9 +788,9 @@ Should begin with \\. and end with \\' and MUST NOT be optional." :set 'set-woman-file-regexp :group 'woman-interface) -(defcustom woman-use-own-frame - (or (and (fboundp 'display-graphic-p) (display-graphic-p)) - (memq window-system '(x w32))) +(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 @@ -775,33 +811,38 @@ Only useful when run on a graphic display such as X or MS-Windows." (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 + "*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 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) @@ -831,52 +872,64 @@ or different fonts." :type 'boolean :group 'woman-faces) -(defface woman-italic-face - `((t (:italic t :underline t :foreground "red"))) - "Face for italic font in man pages. -Default: italic, underlined, foreground red. -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!" +;; 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 + `((((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) - -(defface woman-bold-face - '((t (:bold t :foreground "blue"))) - "Face for bold font in man pages. -Default: bold, foreground blue." +;; backward-compatibility alias +(put 'woman-italic-face 'face-alias 'woman-italic) + +(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) - -(defface woman-unknown-face - '((t (:foreground "brown"))) - "Face for all unknown fonts in man pages. -Default: foreground brown. -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!)" +;; 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 + '((((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-colour-faces () - "Set foreground colours of italic and bold faces to red and blue." +(defun woman-default-faces () + "Set foreground colors of italic and bold faces to their default values." (interactive) - (set-face-foreground 'woman-italic-face "Red") - (set-face-foreground 'woman-bold-face "Blue")) + (face-spec-set 'woman-italic (face-user-default-spec 'woman-italic)) + (face-spec-set 'woman-bold (face-user-default-spec 'woman-bold))) -(defun woman-black-faces () - "Set foreground colours of italic and bold faces both to black." +(defun woman-monochrome-faces () + "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 "Black") - (set-face-foreground 'woman-bold-face "Black")) + (set-face-foreground 'woman-italic 'unspecified) + (set-face-foreground 'woman-bold 'unspecified)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Experimental font support, initially only for MS-Windows. (defconst woman-font-support - (eq window-system 'w32) ; Support X later! + (eq window-system 'w32) ; Support X later! "If non-nil then non-ASCII characters and symbol font supported.") (defun woman-select-symbol-fonts (fonts) @@ -892,7 +945,7 @@ Default: foreground orange." 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! @@ -982,18 +1035,6 @@ Set by `.ns' request; reset by any output or `.rs' request") "Set `woman-nospace' to nil." (setq woman-nospace nil)) -(defconst woman-mode-line-format - ;; This is essentially the Man-mode format with page numbers removed - ;; and line numbers added. (Online documents do not have pages, but - ;; they do have lines!) - '("-" mode-line-mule-info mode-line-modified - mode-line-frame-identification mode-line-buffer-identification - " " global-mode-string - " %[(WoMan" mode-line-process minor-mode-alist ")%]--" - (line-number-mode "L%l--") - (-3 . "%p") "-%-") - "Mode line format for WoMan buffer.") - (defconst woman-request-regexp "^[.'][ \t]*\\(\\S +\\) *" ;; Was "^\\.[ \t]*\\([a-z0-9]+\\) *" but cvs.1 uses a macro named ;; "`" and CGI.man uses a macro named "''"! @@ -1090,7 +1131,7 @@ Used non-interactively, arguments are optional: if given then TOPIC 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) @@ -1188,7 +1229,7 @@ Optional argument RE-CACHE, if non-nil, forces the cache to be re-read." ;; 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 @@ -1197,7 +1238,7 @@ Optional argument RE-CACHE, if non-nil, forces the cache to be re-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) @@ -1307,7 +1348,7 @@ Any UN*X-style environment variables are evaluated first." ;; 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)))) @@ -1327,82 +1368,76 @@ The cdr of each alist element is the path-index / filename." ;; 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))) - -(defsubst woman-list-n (n &rest args) - "Return a list of at most the first N of the arguments ARGS. -Treats N < 1 as if N = 1." - (if (< n (length args)) - (setcdr (nthcdr (1- n) args) nil)) - args) + ;; 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 files in directory DIR with index PATH-INDEX. -The `cdr' of each alist element is the path-index / filename." - ;; *** NEED case-fold-search t HERE ??? - (let ((old (directory-files dir nil woman-file-regexp)) - new file) - ;; Convert list to alist of non-directory files: - (while old - (setq file (car old) - old (cdr old)) - (if (file-directory-p file) - () - (setq new (cons - (woman-list-n - woman-cache-level - (file-name-sans-extension - (if (string-match woman-file-compression-regexp file) - (file-name-sans-extension file) - file)) - path-index - file) - new)))) - new)) + "Return an alist of the man topics in directory DIR with index PATH-INDEX. +A topic is a filename sans type-related extensions. +Support 3 levels of caching: each element of the alist will be a list +of the first `woman-cache-level' elements from the following list: +\(topic path-index filename)." + ;; This function used to check that each file in the directory was + ;; not itself a directory, but this is very slow and should be + ;; 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! + ;; + ;; 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." @@ -1446,7 +1481,7 @@ Also make each path-info component into a list. (mapcar 'list files) )) - + ;;; dired support (defun woman-dired-define-key (key) @@ -1455,7 +1490,8 @@ Also make each path-info component into a list. (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 () @@ -1624,18 +1660,32 @@ Do not call directly!" (while (re-search-forward "^[ \t]*\n\\([ \t]*\n\\)+" nil t) (replace-match "\n" t t)) + ;; CJK characters are underlined by double-sized "__". + ;; (Code lifted from man.el, with trivial changes.) + (if (< (buffer-size) (position-bytes (point-max))) + ;; Multibyte characters exist. + (progn + (goto-char (point-min)) + (while (search-forward "__\b\b" nil t) + (backward-delete-char 4) + (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)))) + ;; Interpret overprinting to indicate bold face: (goto-char (point-min)) - (while (re-search-forward "\\(.\\)\\(\\(\\1\\)+\\)" nil t) + (while (re-search-forward "\\(.\\)\\(\\(+\\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 "_" 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 @@ -1648,7 +1698,7 @@ Do not call directly!" (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) @@ -1683,34 +1733,28 @@ Leave point at end of new text. Return length of inserted text." (defvar woman-mode-map nil "Keymap for woman mode.") -(if woman-mode-map - () - ;; Set up the keymap, mostly inherited from Man-mode-map: +(unless woman-mode-map (setq woman-mode-map (make-sparse-keymap)) (set-keymap-parent woman-mode-map Man-mode-map) - ;; Above two lines were - ;; (setq woman-mode-map (cons 'keymap 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 [mouse-2] 'woman-mouse-2) - (define-key woman-mode-map [M-mouse-2] 'woman-mouse-2)) + (define-key woman-mode-map [M-mouse-2] 'woman-follow-word)) -(defun woman-mouse-2 (event) +(defun woman-follow-word (event) "Run WoMan with word under mouse as topic. -Require it to be mouse-highlighted unless Meta key used. Argument EVENT is the invoking mouse event." (interactive "e") ; mouse event - (let ((pos (cadr (cadr event)))) ; extract buffer position - (when (or (eq (car event) 'M-mouse-2) - (get-text-property pos 'mouse-face)) - (goto-char pos) - (woman (current-word t))))) + (goto-char (posn-point (event-start event))) + (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" @@ -1731,8 +1775,8 @@ Argument EVENT is the invoking mouse event." ["Use Full Frame Width" woman-toggle-fill-frame :active t :style toggle :selected woman-fill-frame] ["Reformat Last Man Page" woman-reformat-last-file t] - ["Use Coloured Main Faces" woman-colour-faces t] - ["Use Black Main Faces" woman-black-faces t] + ["Use Monochrome Main Faces" woman-monochrome-faces t] + ["Use Default Main Faces" woman-default-faces t] ["Make Contents Menu" (woman-imenu t) (not woman-imenu-done)] "--" ["Describe (Wo)Man Mode" describe-mode t] @@ -1780,6 +1824,8 @@ Argument EVENT is the invoking mouse event." (setq woman-emulation value) (woman-reformat-last-file)) +(put 'woman-mode 'mode-class 'special) + (defun woman-mode () "Turn on (most of) Man mode to browse a buffer formatted by WoMan. WoMan is an ELisp emulation of much of the functionality of the Emacs @@ -1797,34 +1843,33 @@ See `Man-mode' for additional details." (fset 'Man-unindent 'ignore) (fset 'Man-goto-page 'ignore) (unwind-protect - (progn - (set (make-local-variable 'Man-mode-map) woman-mode-map) - ;; Install Man mode: - (Man-mode) - ;; Reset inappropriate definitions: - (setq mode-line-format woman-mode-line-format) - (put 'Man-mode 'mode-class 'special)) + (delay-mode-hooks (Man-mode)) ;; Restore the status quo: (fset 'Man-build-page-list Man-build-page-list) (fset 'Man-strip-page-headers Man-strip-page-headers) (fset 'Man-unindent Man-unindent) - (fset 'Man-goto-page Man-goto-page) - ) - ;; Imenu support: - (set (make-local-variable 'imenu-generic-expression) - ;; `make-local-variable' in case imenu not yet loaded! - woman-imenu-generic-expression) - (set (make-local-variable 'imenu-space-replacement) " ") - ;; For reformat ... - ;; 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)) - (setq buffer-read-only nil) - (WoMan-highlight-references) - (setq buffer-read-only t) - (set-buffer-modified-p nil))) + (fset 'Man-goto-page Man-goto-page))) + (setq major-mode 'woman-mode + mode-name "WoMan") + ;; Don't show page numbers like Man-mode does. (Online documents do + ;; not have pages) + (kill-local-variable 'mode-line-buffer-identification) + (use-local-map woman-mode-map) + ;; Imenu support: + (set (make-local-variable 'imenu-generic-expression) + ;; `make-local-variable' in case imenu not yet loaded! + woman-imenu-generic-expression) + (set (make-local-variable 'imenu-space-replacement) " ") + ;; For reformat ... + ;; 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)) + (set-buffer-modified-p nil) + (run-mode-hooks 'woman-mode-hook)) (defun woman-imenu (&optional redraw) "Add a \"Contents\" menu to the menubar. @@ -1901,7 +1946,7 @@ Optional argument REDRAW, if non-nil, forces mode line to be updated." (around Man-getpage-in-background-advice (topic) activate) "Use WoMan unless invoked outside a WoMan buffer or invoked explicitly. Otherwise use Man and record start of formatting time." - (if (and (eq mode-line-format woman-mode-line-format) + (if (and (eq major-mode 'woman-mode) (not (eq (caar command-history) 'man))) (WoMan-getpage-in-background topic) ;; Initiates man processing @@ -1917,23 +1962,6 @@ Otherwise use Man and record start of formatting time." (- (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!) - ;; [See (elisp)Clickable Text] - (put-text-property (match-beginning 1) (match-end 1) - 'mouse-face 'highlight) - )))) - ;;; Buffer handling: @@ -2095,13 +2123,11 @@ To be called on original buffer and any .so insertions." ;; ***** Need test for .ec arg and warning here! ***** (woman-delete-whole-line))) - ;; Delete comments .\", \", pre-processor - ;; directives '\" (should give warning?) and null - ;; requests. (However, should null . requests cause a break?) + ;; Delete comments .\", \" 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." @@ -2116,6 +2142,32 @@ To be called on original buffer and any .so insertions." (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 + +;; 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 +;; +;; '\" +;; +;; 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. @@ -2143,11 +2195,11 @@ To be called on original buffer and any .so insertions." ;; 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: @@ -2157,7 +2209,19 @@ To be called on original buffer and any .so insertions." ;; 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, @@ -2220,8 +2284,7 @@ To be called on original buffer and any .so insertions." "^" "_"))) (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 @@ -2413,7 +2476,7 @@ Start at FROM and re-scan new text as appropriate." (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)) @@ -2441,7 +2504,7 @@ REQUEST is the invoking directive without the leading dot." (setq c (memq (following-char) woman-if-conditions-true))) ;; Unrecognised letter so reject: ((looking-at "[A-Za-z]") (setq c nil) - (WoMan-warn "%s %s -- unrecognised condition name rejected!" + (WoMan-warn "%s %s -- unrecognized condition name rejected!" request (match-string 0))) ;; Accept strings if identical: ((save-restriction @@ -2721,6 +2784,19 @@ Optional argument APPEND, if non-nil, means append macro." ;;; 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 @@ -2753,10 +2829,7 @@ interpolated by `\*x' and `\*(xx' escapes." (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 @@ -2836,32 +2909,33 @@ map accessory to help construct this alist.") 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)))) )) @@ -2878,7 +2952,7 @@ Useful for constructing the alist variable `woman-special-characters'." (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")) @@ -3146,12 +3220,12 @@ If optional arg CONCAT is non-nil then join arguments." (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.") @@ -3161,7 +3235,7 @@ If optional arg CONCAT is non-nil then join arguments." ;; 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)) @@ -3185,27 +3259,23 @@ If optional arg CONCAT is non-nil then join arguments." ((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)) @@ -3255,8 +3325,8 @@ Ignore the default face and underline only word characters." (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)) @@ -3466,10 +3536,12 @@ expression in parentheses. Leaves point after the value." ;; 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 @@ -3491,9 +3563,9 @@ expression in parentheses. Leaves point after the 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) @@ -3617,7 +3689,7 @@ expression in parentheses. Leaves point after the value." (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) @@ -3664,7 +3736,7 @@ v alters page foot left; m alters page head center. )) ;; 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) @@ -3684,7 +3756,7 @@ Format paragraphs upto TO. Set prevailing indent to 5." ;; 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 @@ -3926,7 +3998,7 @@ Format paragraphs upto TO. (Breaks, but should not.)" (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 @@ -4338,6 +4410,49 @@ Needs doing properly!" )) (woman2-format-paragraphs to)) + +;;; 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. + ;;; WoMan message logging: @@ -4396,6 +4511,7 @@ 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 @@ -4413,69 +4529,5 @@ logging the message." (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. - +;;; arch-tag: eea35e90-552f-4712-a94b-d9ffd3db7651 ;;; woman.el ends here