X-Git-Url: https://git.hcoop.net/bpt/emacs.git/blobdiff_plain/2b0c7330457b8ca42375c92ada7dc7cefb0fa9fb..a464a6c73acf27b0d633d428919a36bc16a9d442:/lisp/woman.el diff --git a/lisp/woman.el b/lisp/woman.el index ac4ace62bf..505ed4c00a 100644 --- a/lisp/woman.el +++ b/lisp/woman.el @@ -1,6 +1,6 @@ ;;; woman.el --- browse UN*X manual pages `wo (without) man' -;; Copyright (C) 2000-2011 Free Software Foundation, Inc. +;; Copyright (C) 2000-2012 Free Software Foundation, Inc. ;; Author: Francis J. Wright ;; Maintainer: FSF @@ -435,7 +435,7 @@ (eval-when-compile ; to avoid compiler warnings (require 'dired) - (require 'cl) + (require 'cl-lib) (require 'apropos)) (defun woman-mapcan (fn x) @@ -1086,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." @@ -1281,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 @@ -1367,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))) @@ -1390,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))) @@ -1436,8 +1439,8 @@ The cdr of each alist element is the path-index / filename." (push (woman-topic-all-completions-1 dir path-index) files)) (setq path-index (1+ path-index))) - ;; Uniquefy topics: - ;; Concate all lists with a single nconc call to + ;; Uniquify topics: + ;; Concatenate all lists with a single nconc call to ;; avoid retraversing the first lists repeatedly -- dak (woman-topic-all-completions-merge (apply #'nconc files)))) @@ -1576,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) @@ -1590,14 +1595,6 @@ Also make each path-info component into a list. (woman-process-buffer) (goto-char (point-min))))) -;; There is currently no `tar-mode-hook' so use ... -(eval-after-load "tar-mode" - '(progn - (define-key tar-mode-map "w" 'woman-tar-extract-file) - (define-key-after (lookup-key tar-mode-map [menu-bar immediate]) - [woman] '("Read Man Page (WoMan)" . woman-tar-extract-file) 'view))) - - (defvar woman-last-file-name nil "The full pathname of the last file formatted by WoMan.") @@ -1982,7 +1979,7 @@ Optional argument REDRAW, if non-nil, forces mode line to be updated." (lambda (symbol) (and (or (commandp symbol) - (user-variable-p symbol)) + (custom-variable-p symbol)) (not (get symbol 'apropos-inhibit)))))) ;; Find documentation strings: (let ((p apropos-accumulator) @@ -1994,7 +1991,7 @@ Optional argument REDRAW, if non-nil, forces mode line to be updated." (if (setq doc (documentation symbol t)) (substring doc 0 (string-match "\n" doc)) "(not documented)")) - (if (user-variable-p symbol) ; 3. variable doc + (if (custom-variable-p symbol) ; 3. variable doc (if (setq doc (documentation-property symbol 'variable-documentation t)) (substring doc 0 (string-match "\n" doc)))))) @@ -2018,7 +2015,7 @@ Optional argument REDRAW, if non-nil, forces mode line to be updated." ;; Both advices are disabled because "a file in Emacs should not put ;; advice on a function in Emacs" (see Info node "(elisp)Advising ;; Functions"). Counting the formatting time is useful for -;; developping, but less applicable for daily use. The advice for +;; developing, but less applicable for daily use. The advice for ;; `Man-getpage-in-background' can be discarded, because the ;; key-binding in `woman-mode-map' has been remapped to call `woman' ;; but `man'. Michael Albinus @@ -2136,7 +2133,7 @@ European characters." (copy-sequence standard-display-table) (make-display-table))) ;; Display the following internal chars correctly: - (aset buffer-display-table woman-unpadded-space-char [?\ ]) + (aset buffer-display-table woman-unpadded-space-char [?\s]) (aset buffer-display-table woman-escaped-escape-char [?\\])) @@ -2152,8 +2149,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 @@ -2162,10 +2159,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)) @@ -2243,7 +2238,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. @@ -2390,18 +2385,20 @@ Currently set only from '\" t in the first line of the source file.") (if woman-negative-vertical-space (woman-negative-vertical-space from)) - (if woman-preserve-ascii - ;; Re-instate escaped escapes to just `\' and unpaddable - ;; spaces to just `space', without inheriting any text - ;; properties. This is not necessary, UNLESS the buffer is to - ;; be saved as ASCII. - (progn - (goto-char from) - (while (search-forward woman-escaped-escape-string nil t) - (delete-char -1) (insert ?\\)) - (goto-char from) - (while (search-forward woman-unpadded-space-string nil t) - (delete-char -1) (insert ?\ )))) + (when woman-preserve-ascii + ;; Re-instate escaped escapes to just `\' and unpaddable spaces + ;; to just `space'. This is not necessary for display since + ;; there are display table entries for the escaped chars, but it + ;; is necessary if the buffer might be saved as ASCII. + ;; + ;; `subst-char-in-region' preserves text properties on the + ;; characters, which is necessary for bold, underline, etc on + ;; \e. There's usually no face on spaces, but if there is then + ;; it's good to keep that too. + (subst-char-in-region from (point-max) + woman-escaped-escape-char ?\\) + (subst-char-in-region from (point-max) + woman-unpadded-space-char ?\s)) ;; Must return the new end of file if used in format-alist. (point-max))) @@ -2442,9 +2439,9 @@ Preserves location of `point'." ;; first backwards then forwards: (while (and (<= (setq N (1+ N)) 0) - (cond ((memq (preceding-char) '(?\ ?\t)) + (cond ((memq (preceding-char) '(?\s ?\t)) (delete-char -1) t) - ((memq (following-char) '(?\ ?\t)) + ((memq (following-char) '(?\s ?\t)) (delete-char 1) t) (t nil)))) (if (<= N 0) @@ -2555,7 +2552,7 @@ REQUEST is the invoking directive without the leading dot." ;; ((looking-at "[te]") (setq c nil)) ; reject t(roff) and e(ven page) ((looking-at "[ntoe]") (setq c (memq (following-char) woman-if-conditions-true))) - ;; Unrecognised letter so reject: + ;; Unrecognized letter so reject: ((looking-at "[A-Za-z]") (setq c nil) (WoMan-warn "%s %s -- unrecognized condition name rejected!" request (match-string 0))) @@ -2618,15 +2615,27 @@ If DELETE is non-nil then delete from point." ;; Process matching .el anything: (cond ((string= request "ie") ;; Discard unless previous .ie c `evaluated to false'. + ;; IIUC, an .ie must be followed by an .el. + ;; (An if with no else uses .if rather than .ie.) + ;; TODO warn if no .el found? + ;; The .el should come immediately after the .ie (modulo + ;; comments etc), but this searches to eob. (cond ((re-search-forward "^[.'][ \t]*el[ \t]*" nil t) (woman-delete-match 0) (woman-if-body "el" nil (not delete))))) +;;; FIXME neither the comment nor the code here make sense to me. +;;; This branch was executed for an else (any else, AFAICS). +;;; At this point, the else in question has already been processed above. +;;; The re-search will find the _next_ else, if there is one, and +;;; delete it. If there is one, it belongs to another if block. (Bug#9447) +;;; woman0-el does not need this bit either. ;; Got here after processing a single-line `.ie' as a body ;; clause to be discarded: - ((string= request "el") - (cond ((re-search-forward "^[.'][ \t]*el[ \t]*" nil t) - (woman-delete-match 0) - (woman-if-body "el" nil t))))) +;;; ((string= request "el") +;;; (cond ((re-search-forward "^[.'][ \t]*el[ \t]*" nil t) +;;; (woman-delete-match 0) +;;; (woman-if-body "el" nil t))))) + ) (goto-char from))) (defun woman0-el () @@ -2670,8 +2679,7 @@ If DELETE is non-nil then delete from point." ;; then use the WoMan search mechanism to find the filename ... (setq filename (woman-file-name - (file-name-sans-extension - (file-name-nondirectory name)))) + (file-name-base name))) ;; Cannot find the file, so ... (kill-buffer (current-buffer)) (error "File `%s' not found" name)) @@ -2857,15 +2865,18 @@ interpolated by `\*x' and `\*(xx' escapes." (re-search-forward "[^ \t\n]+") (let ((string (match-string 0))) (skip-chars-forward " \t") -; (setq string -; (cons string -; ;; hack (?) for CGI.man! -; (cond ((looking-at "\"\"") "\"") -; ((looking-at ".*") (match-string 0))) -; )) - ;; Above hack causes trouble in arguments! - (looking-at ".*") - (setq string (cons string (match-string 0))) + (if (= ?\" (following-char)) + ;; Double-quote starts a string, eg. + ;; .ds foo "blah... + ;; is value blah... through to newline. There's no + ;; closing " (per the groff manual), but rather any + ;; further " is included literally in the string. Eg. + ;; .ds foo "" + ;; sets foo to a single " character. + (forward-char)) + (setq string (cons string + (buffer-substring (point) + (line-end-position)))) ;; This should be an update, but consing a new string ;; onto the front of the alist has the same effect: (setq woman-string-alist (cons string woman-string-alist)) @@ -2922,11 +2933,15 @@ interpolated by `\*x' and `\*(xx' escapes." ("bv" "|") ; bold vertical ;; groff etc. extensions: + ;; List these via eg man -Tdvi groff_char > groff_char.dvi. ("lq" "\"") ("rq" "\"") ("aq" "'") ("ha" "^") ("ti" "~") + ("oq" "‘") ; u2018 + ("cq" "’") ; u2019 + ("hy" "‐") ; u2010 ) "Alist of special character codes with ASCII and extended-font equivalents. Each alist elements has the form @@ -3365,7 +3380,7 @@ Ignore the default face and underline only word characters." ;; 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. +;; A list of the form (\"[ace]\" (a . b) (c . d) (e . ?\s)) or nil. (defun woman-get-next-char () "Return and delete next char in buffer, including special chars." @@ -3678,7 +3693,7 @@ expression in parentheses. Leaves point after the value." (setq woman-request (match-string 1))))) ;; Delete request or macro name: (woman-delete-match 0)) - ;; Unrecognised request: + ;; Unrecognized request: ((prog1 nil ;; (WoMan-warn ".%s request ignored!" woman-request) (WoMan-warn-ignored woman-request "ignored!") @@ -3700,7 +3715,9 @@ expression in parentheses. Leaves point after the value." (setq fn 'woman2-format-paragraphs)))) () ;; Find next control line: - (set-marker to (woman-find-next-control-line)) + (if (equal woman-request "TS") + (set-marker to (woman-find-next-control-line "TE")) + (set-marker to (woman-find-next-control-line))) ;; Call the appropriate function: (funcall fn to))) (if (not (eobp)) ; This should not happen, but ... @@ -3711,12 +3728,13 @@ expression in parentheses. Leaves point after the value." (fset 'insert-and-inherit insert-and-inherit) (set-marker to nil)))) -(defun woman-find-next-control-line () - "Find and return start of next control line." -; (let ((to (save-excursion -; (re-search-forward "^\\." nil t)))) -; (if to (1- to) (point-max))) - (let (to) +(defun woman-find-next-control-line (&optional pat) + "Find and return start of next control line. +PAT, if non-nil, specifies an additional component of the control +line regexp to search for, which is appended to the default +regexp, \"\\(\\\\c\\)?\\n[.']\"." + (let ((pattern (concat "\\(\\\\c\\)?\n[.']" pat)) + to) (save-excursion ;; Must handle ;; ...\c @@ -3725,12 +3743,14 @@ expression in parentheses. Leaves point after the value." ;; BEWARE THAT THIS CODE MAY BE UNRELIABLE!!!!! (while (and - (setq to (re-search-forward "\\(\\\\c\\)?\n[.']" nil t)) + (setq to (re-search-forward pattern nil t)) (match-beginning 1) (looking-at "br")) (goto-char (match-beginning 0)) (woman-delete-line 2))) - (if to (1- to) (point-max)))) + (if to + (- to (+ 1 (length pat))) + (point-max)))) (defun woman2-PD (to) ".PD d -- Set the interparagraph distance to d. @@ -3874,18 +3894,18 @@ Leave 1 blank line. Format paragraphs upto TO." (insert (substring overlap i eol)) (setq i (or eol imax))) ) - ((eq c ?\ ) ; skip + ((eq c ?\s) ; skip (forward-char)) ((eq c ?\t) ; skip (if (eq (following-char) ?\t) (forward-char) ; both tabs, just skip (dotimes (i woman-tab-width) (if (eolp) - (insert ?\ ) ; extend line + (insert ?\s) ; extend line (forward-char)) ; skip ))) (t - (if (or (eq (following-char) ?\ ) ; overwrite OK + (if (or (eq (following-char) ?\s) ; overwrite OK overwritten) ; warning only once per ".sp -" () (setq overwritten t) @@ -3904,7 +3924,7 @@ Leave 1 blank line. Format paragraphs upto TO." (defun woman2-process-escapes (to &optional numeric) "Process remaining escape sequences up to marker TO, preserving point. Optional argument NUMERIC, if non-nil, means the argument is numeric." - (assert (and (markerp to) (marker-insertion-type to))) + (cl-assert (and (markerp to) (marker-insertion-type to))) ;; The first two cases below could be merged (maybe)! (let ((from (point))) ;; Discard zero width filler character used to hide leading dots @@ -3912,7 +3932,9 @@ Optional argument NUMERIC, if non-nil, means the argument is numeric." (while (re-search-forward "\\\\[&|^]" to t) (woman-delete-match 0) ;; If on a line by itself, consume newline as well (Bug#3651). - (and (eq (char-before (match-beginning 0)) ?\n) + ;; But not in a .nf region, preserve all newlines in that case. + (and (not woman-nofill) + (eq (char-before (match-beginning 0)) ?\n) (eq (char-after (match-beginning 0)) ?\n) (delete-char 1))) @@ -3935,6 +3957,8 @@ Optional argument NUMERIC, if non-nil, means the argument is numeric." ;; Done like this to preserve any text properties of the `\' (while (search-forward "\\" to t) (let ((c (following-char))) + ;; Some other escapes, such as \f, are handled in + ;; `woman0-process-escapes'. (cond ((eq c ?') ; \' -> ' (delete-char -1) (cond (numeric ; except in numeric args, \' -> ` @@ -3948,12 +3972,7 @@ Optional argument NUMERIC, if non-nil, means the argument is numeric." (insert "\t")) ((and numeric (memq c '(?w ?n ?h)))) ; leave \w, \n, \h (?????) - ((eq c ?l) (woman-horizontal-line)) - (t - ;; \? -> ? where ? is any remaining character - (WoMan-warn "Escape ignored: \\%c -> %c" c c) - (delete-char -1)) - ))) + ((eq c ?l) (woman-horizontal-line))))) (goto-char from) ;; Process non-default tab settings: (cond (tab-stop-list @@ -4364,9 +4383,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. @@ -4392,7 +4411,7 @@ tab stop columns or pairs (COLUMN . TYPE) where TYPE is R or C." tab (- tab (if (eq type ?C) (/ n 2) n))) ) (setq n (- tab (current-column))) (insert-char ?\s n)) - (insert ?\ )))) + (insert ?\s)))) (defun woman2-DT (to) ".DT -- Restore default tabs. Format paragraphs upto TO. @@ -4410,7 +4429,7 @@ Needs doing properly!" (if (eolp) (woman-delete-whole-line) ; ignore! (let ((delim (following-char)) - (pad ?\ ) end) ; pad defaults to space + (pad ?\s) end) ; pad defaults to space (forward-char) (skip-chars-forward " \t") (or (eolp) (setq pad (following-char))) @@ -4441,8 +4460,6 @@ Needs doing properly!" (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 @@ -4454,6 +4471,22 @@ Format paragraphs upto TO." (woman-delete-line 1) ;; For each column, find its width and align it: (let ((start (point)) (col 1)) + (WoMan-log "%s" (buffer-substring start (+ start 40))) + ;; change T{ T} to tabs + (while (search-forward "T{\n" to t) + (replace-match "") + (catch 'end + (while (search-forward "\n" to t) + (replace-match " ") + (if (looking-at "T}") + (progn + (delete-char 2) + (throw 'end t)))))) + (goto-char start) + ;; strip space and headers + (while (re-search-forward "^\\.TH\\|\\.sp" to t) + (woman-delete-whole-line)) + (goto-char start) (while (prog1 (search-forward "\t" to t) (goto-char start)) ;; Find current column width: (while (< (point) to) @@ -4467,8 +4500,25 @@ Format paragraphs upto TO." (while (< (point) to) (when (search-forward "\t" to t) (delete-char -1) - (insert-char ?\ (- col (current-column)))) + (insert-char ?\s (- col (current-column)))) (forward-line)) + (goto-char start)) + ;; find maximum width + (let ((max-col 0)) + (while (search-forward "\n" to t) + (backward-char) + (if (> (current-column) max-col) + (setq max-col (current-column))) + (forward-char)) + (goto-char start) + ;; break lines if they are too long + (when (and (> max-col woman-fill-column) + (> woman-fill-column col)) + (setq max-col woman-fill-column) + (woman-break-table col to start) + (goto-char start)) + (while (re-search-forward "^_$" to t) + (replace-match (make-string max-col ?_))) (goto-char start)))) ;; Format table with no filling or adjusting (cf. woman2-nf): (setq woman-nofill t) @@ -4478,15 +4528,23 @@ Format paragraphs upto TO." ;; ".TE -- End of table code for the tbl processor." ;; Turn filling and adjusting back on. +(defun woman-break-table (start-column to start) + (while (< (point) to) + (move-to-column woman-fill-column) + (if (eolp) + (forward-line) + (if (and (search-backward " " start t) + (> (current-column) start-column)) + (progn + (insert-char ?\n 1) + (insert-char ?\s (- start-column 5))) + (forward-line))))) ;;; WoMan message logging: ;; 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))) @@ -4518,7 +4576,7 @@ IGNORED is a string appended to the log message." (buffer-substring (point) (line-end-position)))) (if (and (> (length tail) 0) - (/= (string-to-char tail) ?\ )) + (/= (string-to-char tail) ?\s)) (setq tail (concat " " tail))) (WoMan-log-1 (concat "** " request tail " request " ignored)))) @@ -4527,7 +4585,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*. @@ -4582,4 +4640,9 @@ logging the message." (provide 'woman) + +;; Local Variables: +;; coding: utf-8 +;; End: + ;;; woman.el ends here