X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/b3253cd4b4bcbe1ab4ad1fdc98b30c33af70332c..bc81e2c4e885787603da3e0314d6ea45a43f7862:/lisp/woman.el diff --git a/lisp/woman.el b/lisp/woman.el index 358cb8fee6..c6bd4a4c8d 100644 --- a/lisp/woman.el +++ b/lisp/woman.el @@ -1,7 +1,6 @@ ;;; woman.el --- browse UN*X manual pages `wo (without) man' -;; Copyright (C) 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, -;; 2009, 2010 Free Software Foundation, Inc. +;; Copyright (C) 2000-2011 Free Software Foundation, Inc. ;; Author: Francis J. Wright ;; Maintainer: FSF @@ -1087,6 +1086,9 @@ Set by .PD; used by .SH, .SS, .TP, .LP, .PP, .P, .IP, .HP.") (defvar woman-nospace nil "Current no-space mode: nil for normal spacing. Set by `.ns' request; reset by any output or `.rs' request") +;; Used for message logging +(defvar WoMan-current-file nil) ; bound in woman-really-find-file +(defvar WoMan-Log-header-point-max nil) (defsubst woman-reset-nospace () "Set `woman-nospace' to nil." @@ -1282,8 +1284,7 @@ cache to be re-read." ;; completions, but to return only a case-sensitive match. This ;; does not seem to work properly by default, so I re-do the ;; completion if necessary. - (let (files - (default (current-word))) + (let (files) (or (stringp topic) (and (if (boundp 'woman-use-topic-at-point) woman-use-topic-at-point @@ -1368,16 +1369,17 @@ regexp that is the final component of DIR. Log a warning if list is empty." (or (file-accessible-directory-p dir) (WoMan-warn "Ignoring inaccessible `man-page' directory `%s'!" dir))) -(defun woman-expand-directory-path (woman-manpath woman-path) - "Expand the manual directories in WOMAN-MANPATH and WOMAN-PATH. -WOMAN-MANPATH should be a list of general manual directories, while -WOMAN-PATH should be a list of specific manual directory regexps. +(defun woman-expand-directory-path (path-dirs path-regexps) + "Expand the manual directories in PATH-DIRS and PATH-REGEXPS. +PATH-DIRS should be a list of general manual directories (like +`woman-manpath'), while PATH-REGEXPS should be a list of specific +manual directory regexps (like `woman-path'). Ignore any paths that are unreadable or not directories." ;; Allow each path to be a single string or a list of strings: - (if (not (listp woman-manpath)) (setq woman-manpath (list woman-manpath))) - (if (not (listp woman-path)) (setq woman-path (list woman-path))) + (if (not (listp path-dirs)) (setq path-dirs (list path-dirs))) + (if (not (listp path-regexps)) (setq path-regexps (list path-regexps))) (let (head dirs path) - (dolist (dir woman-manpath) + (dolist (dir path-dirs) (when (consp dir) (unless path (setq path (split-string (getenv "PATH") path-separator t))) @@ -1391,7 +1393,7 @@ Ignore any paths that are unreadable or not directories." (setq dir (woman-canonicalize-dir dir) dirs (nconc dirs (directory-files dir t woman-manpath-man-regexp))))) - (dolist (dir woman-path) + (dolist (dir path-regexps) (if (or (null dir) (null (setq dir (woman-canonicalize-dir dir) head (file-name-directory dir))) @@ -1508,7 +1510,7 @@ Also make each path-info component into a list. ;; (topic) ;; (topic (path-index) (path-index) ... ) ;; (topic (path-index filename) (path-index filename) ... ) - ;; where the are no duplicates in the value lists. + ;; where there are no duplicates in the value lists. ;; Topic must match first `word' of filename, so ... (let ((topic-regexp (concat @@ -1577,6 +1579,8 @@ Also make each path-info component into a list. ;;; tar-mode support +(defvar global-font-lock-mode) ; defined in font-core.el + (defun woman-tar-extract-file () "In tar mode, run the WoMan man-page browser on this file." (interactive) @@ -2153,8 +2157,8 @@ No external programs are used." (run-hooks 'woman-pre-format-hook) (and (boundp 'font-lock-mode) font-lock-mode (font-lock-mode -1)) ;; (fundamental-mode) - (let ((start-time (current-time)) ; (HIGH LOW MICROSEC) - time) ; HIGH * 2**16 + LOW seconds + (let ((start-time (current-time)) + time) (message "WoMan formatting buffer...") ; (goto-char (point-min)) ; (cond @@ -2163,10 +2167,8 @@ No external programs are used." ; (delete-region (point-min) (point))) ; potentially dangerous! ; (t (message "WARNING: .TH request not found -- not man-page format?"))) (woman-decode-region (point-min) (point-max)) - (setq time (current-time) - time (+ (* (- (car time) (car start-time)) 65536) - (- (cadr time) (cadr start-time)))) - (message "WoMan formatting buffer...done in %d seconds" time) + (setq time (float-time (time-since start-time))) + (message "WoMan formatting buffer...done in %g seconds" time) (WoMan-log-end time)) (run-hooks 'woman-post-format-hook)) @@ -2244,7 +2246,7 @@ To be called on original buffer and any .so insertions." 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) +(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. ;; But this requires care to control major mode implied font locking. @@ -2475,23 +2477,35 @@ Preserves location of `point'." Start at FROM and re-scan new text as appropriate." (goto-char from) (let ((woman0-if-to (make-marker)) - request woman0-macro-alist + woman-request woman0-macro-alist (woman0-search-regex-start woman0-search-regex-start) (woman0-search-regex (concat woman0-search-regex-start woman0-search-regex-end)) + processed-first-hunk 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= request "if") (woman0-if "if")) - ((string= request "ie") (woman0-if "ie")) - ((string= request "el") (woman0-el)) - ((string= request "so") (woman0-so)) - ((string= request "rn") (woman0-rn)) - ((string= request "de") (woman0-de)) - ((string= request "am") (woman0-de 'append)) - (t (woman0-macro request)))) + (setq woman-request (match-string 1)) + + ;; Process escape sequences prior to first request (Bug#7843). + (unless processed-first-hunk + (setq processed-first-hunk t) + (let ((process-escapes-to-marker (point-marker))) + (set-marker-insertion-type process-escapes-to-marker t) + (save-match-data + (save-excursion + (goto-char from) + (woman2-process-escapes process-escapes-to-marker))))) + + (cond ((string= woman-request "ig") (woman0-ig)) + ((string= woman-request "if") (woman0-if "if")) + ((string= woman-request "ie") (woman0-if "ie")) + ((string= woman-request "el") (woman0-el)) + ((string= woman-request "so") (woman0-so)) + ((string= woman-request "rn") (woman0-rn)) + ((string= woman-request "de") (woman0-de)) + ((string= woman-request "am") (woman0-de 'append)) + (t (woman0-macro woman-request)))) (set-marker woman0-if-to nil) (woman0-rename) ;; Should now re-run `woman0-roff-buffer' if any renaming was @@ -2522,6 +2536,7 @@ Start at FROM and re-scan new text as appropriate." (goto-char from) ; necessary! (woman2-process-escapes to 'numeric)) +;; request does not appear to be used dynamically by any callees. (defun woman0-if (request) ".if/ie c anything -- Discard unless c evaluates to true. Remember condition for use by a subsequent `.el'. @@ -2573,6 +2588,7 @@ REQUEST is the invoking directive without the leading dot." (woman-if-ignore woman0-if-to request) ; ERROR! (woman-if-body request woman0-if-to (eq c negated))))) +;; request is not used dynamically by any callees. (defun woman-if-body (request to delete) ; should be reversed as `accept'? "Process if-body, including \\{ ... \\}. REQUEST is the invoking directive without the leading dot. @@ -2629,6 +2645,7 @@ If DELETE is non-nil then delete from point." (if (looking-at "[ \t]*\\{") (search-forward "\\}")) (forward-line 1)))) +;; request is not used dynamically by any callees. (defun woman-if-ignore (to request) "Ignore but warn about an if request ending at TO, named REQUEST." (WoMan-warn-ignored request "ignored -- condition not handled!") @@ -2760,15 +2777,17 @@ Optional argument APPEND, if non-nil, means append macro." (beginning-of-line) ; delete .de/am line (woman-delete-line 1)) -(defun woman0-macro (request) - "Process the macro call named REQUEST." +;; request may be used dynamically (woman-interpolate-macro calls +;; woman-forward-arg). +(defun woman0-macro (woman-request) + "Process the macro call named WOMAN-REQUEST." ;; Leaves point at start of new text. - (let ((macro (assoc request woman0-macro-alist))) + (let ((macro (assoc woman-request woman0-macro-alist))) (if macro (woman-interpolate-macro (cdr macro)) ;; SHOULD DELETE THE UNINTERPRETED REQUEST!!!!! ;; Output this message once only per call (cf. strings)? - (WoMan-warn "Undefined macro %s not interpolated!" request)))) + (WoMan-warn "Undefined macro %s not interpolated!" woman-request)))) (defun woman-interpolate-macro (macro) "Interpolate (.de) or append (.am) expansion of MACRO into the buffer." @@ -2985,8 +3004,10 @@ Useful for constructing the alist variable `woman-special-characters'." ;;; Formatting macros that do not cause a break: -(defvar request) ; Bound locally by woman1-roff-buffer -(defvar unquote) ; Bound locally by woman1-roff-buffer +;; Bound locally by woman[012]-roff-buffer, and also, annoyingly and +;; confusingly, as a function argument. Use dynamically in +;; woman-unquote and woman-forward-arg. +(defvar woman-request) (defun woman-unquote (to) "Delete any double-quote characters between point and TO. @@ -3001,7 +3022,7 @@ Leave point at TO (which should be a marker)." (setq in-quote (not in-quote)) )) (if in-quote - (WoMan-warn "Unpaired \" in .%s arguments." request)))) + (WoMan-warn "Unpaired \" in .%s arguments." woman-request)))) (defsubst woman-unquote-args () "Delete any double-quote characters up to the end of the line." @@ -3010,7 +3031,7 @@ Leave point at TO (which should be a marker)." (defun woman1-roff-buffer () "Process non-breaking requests." (let ((case-fold-search t) - request fn unquote) + woman-request fn woman1-unquote) (while ;; Find next control line: (re-search-forward woman-request-regexp nil t) @@ -3018,14 +3039,14 @@ Leave point at TO (which should be a marker)." ;; Construct woman function to call: ((setq fn (intern-soft (concat "woman1-" - (setq request (match-string 1))))) + (setq woman-request (match-string 1))))) (if (get fn 'notfont) ; not a font-change request (funcall fn) ;; Delete request or macro name: (woman-delete-match 0) ;; If no args then apply to next line else unquote args - ;; (unquote is used by called function): - (setq unquote (not (eolp))) + ;; (woman1-unquote is used by called function): + (setq woman1-unquote (not (eolp))) (if (eolp) (delete-char 1)) ; ;; Hide leading control character in unquoted argument: ; (cond ((memq (following-char) '(?. ?')) @@ -3034,7 +3055,7 @@ Leave point at TO (which should be a marker)." ;; Call the appropriate function: (funcall fn) ;; Hide leading control character in quoted argument (only): - (if (and unquote (memq (following-char) '(?. ?'))) + (if (and woman1-unquote (memq (following-char) '(?. ?'))) (insert "\\&")))))))) ;;; Font-changing macros: @@ -3047,6 +3068,8 @@ Leave point at TO (which should be a marker)." ".I -- Set words of current line in italic font." (woman1-B-or-I ".ft I\n")) +(defvar woman1-unquote) ; bound locally by woman1-roff-buffer + (defun woman1-B-or-I (B-or-I) ".B/I -- Set words of current line in bold/italic font. B-OR-I is the appropriate complete control line." @@ -3055,7 +3078,7 @@ B-OR-I is the appropriate complete control line." ;; Return to bol to process .SM/.B, .B/.if etc. ;; or start of first arg to hide leading control char. (save-excursion - (if unquote + (if woman1-unquote (woman-unquote-args) (while (looking-at "^[.']") (forward-line)) (end-of-line) @@ -3102,11 +3125,12 @@ B-OR-I is the appropriate complete control line." ;; Return to start of first arg to hide leading control char: (save-excursion (setq fonts (cdr fonts)) - (woman-forward-arg unquote 'concat) ; unquote is bound above + ;; woman1-unquote is bound in woman1-roff-buffer. + (woman-forward-arg woman1-unquote 'concat) (while (not (eolp)) (insert (car fonts)) (setq fonts (cdr fonts)) - (woman-forward-arg unquote 'concat)) ; unquote is bound above + (woman-forward-arg woman1-unquote 'concat)) (insert "\\fR"))) (defun woman-forward-arg (&optional unquote concat) @@ -3123,7 +3147,7 @@ If optional arg CONCAT is non-nil then join arguments." (re-search-forward "\"\\|$")) (if (eq (preceding-char) ?\") (if unquote (delete-char -1)) - (WoMan-warn "Unpaired \" in .%s arguments." request))) + (WoMan-warn "Unpaired \" in .%s arguments." woman-request))) ;; (re-search-forward "[^\\\n] \\|$") ; inconsistent (skip-syntax-forward "^ ")) (cond ((null concat) (skip-chars-forward " \t")) ; don't skip eol! @@ -3338,7 +3362,12 @@ Ignore the default face and underline only word characters." ;;; Output translation: -(defvar translations nil) ; Also bound locally by woman2-roff-buffer +;; This is only set by woman2-tr. It is bound locally in woman2-roff-buffer. +;; It is also used by woman-translate. woman-translate may be called +;; outside the scope of woman2-roff-buffer (by experiment). Therefore +;; this used to be globally bound to nil, to avoid an error. Instead +;; we can use bound-and-true-p in woman-translate. +(defvar woman-translations) ;; A list of the form (\"[ace]\" (a . b) (c . d) (e . ?\ )) or nil. (defun woman-get-next-char () @@ -3358,8 +3387,8 @@ Format paragraphs upto TO. Supports special chars. ;; This should be an update, but consing onto the front of the alist ;; has the same effect and match duplicates should not matter. ;; Initialize translation data structures: - (let ((matches (car translations)) - (alist (cdr translations)) + (let ((matches (car woman-translations)) + (alist (cdr woman-translations)) a b) ;; `matches' must be a string: (setq matches @@ -3381,15 +3410,15 @@ Format paragraphs upto TO. Supports special chars. (if (= (string-to-char matches) ?\]) (substring matches 3) (concat "[" matches)) - translations (cons matches alist)) + woman-translations (cons matches alist)) ;; Format any following text: (woman2-format-paragraphs to))) (defsubst woman-translate (to) "Translate up to marker TO. Do this last of all transformations." - (if translations - (let ((matches (car translations)) - (alist (cdr translations)) + (if (bound-and-true-p woman-translations) + (let ((matches (car woman-translations)) + (alist (cdr woman-translations)) ;; Translations are case-sensitive, eg ".tr ab" does not ;; affect "A" (bug#6849). (case-fold-search nil)) @@ -3528,8 +3557,8 @@ The expression may be an argument in quotes." ; (WoMan-warn "Unimplemented numerical operator `%c' in %s" ; (following-char) ; (buffer-substring -; (save-excursion (beginning-of-line) (point)) -; (save-excursion (end-of-line) (point)))) +; (line-beginning-position) +; (line-end-position))) ; (skip-syntax-forward "^ ")) value )) @@ -3598,7 +3627,7 @@ expression in parentheses. Leaves point after the value." (WoMan-warn "Numeric/register argument error: %s" (buffer-substring (point) - (save-excursion (end-of-line) (point)))) + (line-end-position))) (skip-syntax-forward "^ ") 0) (goto-char (match-end 0)) @@ -3633,7 +3662,7 @@ expression in parentheses. Leaves point after the value." (insert-and-inherit (symbol-function 'insert-and-inherit)) (set-text-properties (symbol-function 'set-text-properties)) (woman-registers woman-registers) - fn request translations + fn woman-request woman-translations tab-stop-list) (set-marker-insertion-type to t) ;; ?roff does not squeeze multiple spaces, but does fill, so... @@ -3649,13 +3678,13 @@ expression in parentheses. Leaves point after the value." ;; Construct woman function to call: ((setq fn (intern-soft (concat "woman2-" - (setq request (match-string 1))))) + (setq woman-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!") + ;; (WoMan-warn ".%s request ignored!" woman-request) + (WoMan-warn-ignored woman-request "ignored!") ;; (setq fn 'woman2-LP) ;; AVOID LEAVING A BLANK LINE! ;; (setq fn 'woman2-format-paragraphs) @@ -3748,8 +3777,7 @@ v alters page foot left; m alters page head center. (buffer-substring start here)) (delete-region here (point))))) ;; Embolden heading (point is at end of heading): - (woman-set-face - (save-excursion (beginning-of-line) (point)) (point) 'woman-bold) + (woman-set-face (line-beginning-position) (point) 'woman-bold) (forward-line) (delete-blank-lines) (setq woman-left-margin woman-default-indent) @@ -3768,8 +3796,7 @@ Format paragraphs upto TO. Set prevailing indent to 5." (setq woman-leave-blank-lines nil) ;; 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)) + (woman-set-face (point) (line-end-position) 'woman-bold)) (forward-line) (setq woman-left-margin woman-default-indent woman-nofill nil) ; fill output lines @@ -4340,9 +4367,9 @@ Format paragraphs upto TO." (setq tab-stop-list (reverse tab-stop-list)) (woman2-format-paragraphs to)) -(defsubst woman-get-tab-stop (tab-stop-list) - "If TAB-STOP-LIST is a cons, return its car, else return TAB-STOP-LIST." - (if (consp tab-stop-list) (car tab-stop-list) tab-stop-list)) +(defsubst woman-get-tab-stop (tab-stops) + "If TAB-STOPS is a cons, return its car, else return TAB-STOPS." + (if (consp tab-stops) (car tab-stops) tab-stops)) (defun woman-tab-to-tab-stop () "Insert spaces to next defined tab-stop column. @@ -4361,7 +4388,7 @@ tab stop columns or pairs (COLUMN . TYPE) where TYPE is R or C." eol n) (if type (setq tab (woman-get-tab-stop tab) - eol (save-excursion (end-of-line) (point)) + eol (line-end-position) n (save-excursion (search-forward "\t" eol t)) n (- (if n (1- n) eol) (point)) @@ -4460,9 +4487,6 @@ Format paragraphs upto TO." ;; The basis for this logging code was shamelessly pirated from bytecomp.el ;; by Jamie Zawinski & Hallvard Furuseth -(defvar WoMan-current-file nil) ; bound in woman-really-find-file -(defvar WoMan-Log-header-point-max nil) - (defun WoMan-log-begin () "Log the beginning of formatting in *WoMan-Log*." (let ((WoMan-current-buffer (buffer-name))) @@ -4486,12 +4510,13 @@ Format paragraphs upto TO." (setq format (apply 'format format args)) (WoMan-log-1 (concat "** " format))) +;; request is not used dynamically by any callees. (defun WoMan-warn-ignored (request ignored) "Log a warning message about ignored directive REQUEST. IGNORED is a string appended to the log message." (let ((tail (buffer-substring (point) - (save-excursion (end-of-line) (point))))) + (line-end-position)))) (if (and (> (length tail) 0) (/= (string-to-char tail) ?\ )) (setq tail (concat " " tail))) @@ -4502,7 +4527,7 @@ IGNORED is a string appended to the log message." "Log the end of formatting in *WoMan-Log*. TIME specifies the time it took to format the man page, to be printed with the message." - (WoMan-log-1 (format "Formatting time %d seconds." time) 'end)) + (WoMan-log-1 (format "Formatting time %g seconds." time) 'end)) (defun WoMan-log-1 (string &optional end) "Log a message STRING in *WoMan-Log*. @@ -4557,5 +4582,4 @@ logging the message." (provide 'woman) -;; arch-tag: eea35e90-552f-4712-a94b-d9ffd3db7651 ;;; woman.el ends here