X-Git-Url: https://git.hcoop.net/bpt/emacs.git/blobdiff_plain/c3760c17bd1d2b81a05c50c1b1f7236fc34adb33..a464a6c73acf27b0d633d428919a36bc16a9d442:/lisp/woman.el diff --git a/lisp/woman.el b/lisp/woman.el index 75a36d6ac3..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) @@ -1439,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)))) @@ -1595,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.") @@ -1987,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) @@ -1999,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)))))) @@ -2023,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 @@ -2141,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 [?\\])) @@ -2393,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))) @@ -2445,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) @@ -2558,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))) @@ -2685,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)) @@ -2872,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)) @@ -3384,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." @@ -3697,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!") @@ -3719,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 ... @@ -3730,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 @@ -3744,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. @@ -3893,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) @@ -3923,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 @@ -3931,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))) @@ -3954,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, \' -> ` @@ -3967,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 @@ -4411,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. @@ -4429,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))) @@ -4460,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 @@ -4473,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) @@ -4486,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) @@ -4497,6 +4528,17 @@ 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: @@ -4534,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))))