X-Git-Url: https://git.hcoop.net/bpt/emacs.git/blobdiff_plain/edfda78355c5528eee489fa8a7f9c73bf8e734f2..a464a6c73acf27b0d633d428919a36bc16a9d442:/lisp/woman.el diff --git a/lisp/woman.el b/lisp/woman.el index 99de62e3a3..505ed4c00a 100644 --- a/lisp/woman.el +++ b/lisp/woman.el @@ -1,13 +1,12 @@ ;;; woman.el --- browse UN*X manual pages `wo (without) man' -;; Copyright (C) 2000, 2001, 2002, 2003, 2004, 2005, -;; 2006, 2007, 2008 Free Software Foundation, Inc. +;; Copyright (C) 2000-2012 Free Software Foundation, Inc. ;; Author: Francis J. Wright ;; Maintainer: FSF ;; Keywords: help, unix ;; Adapted-By: Eli Zaretskii -;; Version: see `woman-version' +;; Version: 0.551 ;; URL: http://centaur.maths.qmul.ac.uk/Emacs/WoMan/ ;; This file is part of GNU Emacs. @@ -436,7 +435,7 @@ (eval-when-compile ; to avoid compiler warnings (require 'dired) - (require 'cl) + (require 'cl-lib) (require 'apropos)) (defun woman-mapcan (fn x) @@ -468,7 +467,7 @@ As a special case, if PATHS is nil then replace it by calling (parse-colon-path paths))) ((string-match "\\`[a-zA-Z]:" paths) ;; Assume single DOS-style path... - paths) + (list paths)) (t ;; Assume UNIX/Cygwin-style path-list... (woman-mapcan ; splice list into list @@ -810,7 +809,7 @@ without interactive confirmation, if it exists as a topic." (defvar woman-file-regexp nil "Regexp used to select (possibly compressed) man source files, e.g. -\"\\.\\([0-9lmnt]\\w*\\)\\(\\.\\(g?z\\|bz2\\)\\)?\\'\". +\"\\.\\([0-9lmnt]\\w*\\)\\(\\.\\(g?z\\|bz2\\|xz\\)\\)?\\'\". Built automatically from the customizable user options `woman-uncompressed-file-regexp' and `woman-file-compression-regexp'.") @@ -846,23 +845,22 @@ MUST NOT end with any kind of string terminator such as $ or \\'." :group 'woman-interface) (defcustom woman-file-compression-regexp - "\\.\\(g?z\\|bz2\\)\\'" + "\\.\\(g?z\\|bz2\\|xz\\)\\'" "Do not change this unless you are sure you know what you are doing! Regexp used to match compressed man file extensions for which decompressors are available and handled by auto-compression mode, -e.g. \"\\\\.\\\\(g?z\\\\|bz2\\\\)\\\\'\" for `gzip' or `bzip2'. +e.g. \"\\\\.\\\\(g?z\\\\|bz2\\\\|xz\\\\)\\\\'\" for `gzip', `bzip2', or `xz'. Should begin with \\. and end with \\' and MUST NOT be optional." ;; Should be compatible with car of ;; `jka-compr-file-name-handler-entry', but that is unduly ;; complicated, includes an inappropriate extension (.tgz) and is ;; not loaded by default! + :version "24.1" ; added xz :type 'regexp :set 'set-woman-file-regexp :group 'woman-interface) -(defcustom woman-use-own-frame ; window-system - (or (and (fboundp 'display-graphic-p) (display-graphic-p)) ; Emacs 21 - (memq window-system '(x w32 ns))) ; Emacs 20 +(defcustom woman-use-own-frame nil "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 @@ -944,46 +942,29 @@ or different fonts." :type 'boolean :group 'woman-faces) -;; 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))) + '((t :inherit italic)) "Face for italic font in man pages." :group 'woman-faces) -;; backward-compatibility alias -(put 'woman-italic-face 'face-alias 'woman-italic) +(define-obsolete-face-alias 'woman-italic-face 'woman-italic "22.1") (defface woman-bold - '((((min-colors 88) (background light)) (:weight bold :foreground "blue1")) - (((background light)) (:weight bold :foreground "blue")) - (((background dark)) (:weight bold :foreground "green2"))) + '((t :inherit bold)) "Face for bold font in man pages." :group 'woman-faces) -;; backward-compatibility alias -(put 'woman-bold-face 'face-alias 'woman-bold) +(define-obsolete-face-alias 'woman-bold-face 'woman-bold "22.1") -;; 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"))) + '((t :inherit font-lock-warning-face)) "Face for all unknown fonts in man pages." :group 'woman-faces) -;; backward-compatibility alias -(put 'woman-unknown-face 'face-alias 'woman-unknown) +(define-obsolete-face-alias 'woman-unknown-face 'woman-unknown "22.1") (defface woman-addition - '((t (:foreground "orange"))) + '((t :inherit font-lock-builtin-face)) "Face for all WoMan additions to man pages." :group 'woman-faces) -;; backward-compatibility alias -(put 'woman-addition-face 'face-alias 'woman-addition) +(define-obsolete-face-alias 'woman-addition-face 'woman-addition "22.1") (defun woman-default-faces () "Set foreground colors of italic and bold faces to their default values." @@ -1105,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." @@ -1212,11 +1196,9 @@ should be a topic string and non-nil RE-CACHE forces re-caching." (woman-find-file file-name) (message "WoMan Error: No matching manual files found in search path") - (ding)) - ) + (ding))) (message "WoMan Error: No topic specified in non-interactive call") - (ding)) - ) + (ding))) ;; Allow WoMan to be called via the standard Help menu: (define-key-after menu-bar-manuals-menu [woman] @@ -1287,11 +1269,10 @@ automatically used as the topic, if the value of the user option be found. Optional argument RE-CACHE, if non-nil, forces the cache to be re-read." ;; Handle the caching of the directory and topic lists: - (if (and (not re-cache) - (or - (and woman-expanded-directory-path woman-topic-all-completions) - (woman-read-directory-cache))) - () + (unless (and (not re-cache) + (or + (and woman-expanded-directory-path woman-topic-all-completions) + (woman-read-directory-cache))) (message "Building list of manual directory expansions...") (setq woman-expanded-directory-path (woman-expand-directory-path woman-manpath woman-path)) @@ -1303,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 @@ -1328,8 +1308,7 @@ cache to be re-read." 'woman-topic-history default)))) ;; Note that completing-read always returns a string. - (if (= (length topic) 0) - nil ; no topic, so no file! + (unless (= (length topic) 0) (cond ((setq files (woman-file-name-all-completions topic))) ;; Complete topic more carefully, i.e. use the completion @@ -1366,8 +1345,7 @@ cache to be re-read." (not (member (car cdr_list) (cdr cdr_list))) (funcall predicate (car cdr_list))) (setq list cdr_list) - (setcdr list (cdr cdr_list))) - ) + (setcdr list (cdr cdr_list)))) newlist))) (defun woman-file-readable-p (dir) @@ -1391,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))) @@ -1414,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))) @@ -1460,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)))) @@ -1531,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 @@ -1560,10 +1539,8 @@ Also make each path-info component into a list. path (cdr path)) (if (woman-not-member dir path) ; use each directory only once! (setq files (nconc files - (directory-files dir t topic-regexp)))) - )) - (mapcar 'list files) - )) + (directory-files dir t topic-regexp)))))) + (mapcar 'list files))) ;;; dired support @@ -1602,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) @@ -1616,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.") @@ -1668,15 +1639,16 @@ decompress the file if appropriate. See the documentation for the (or exists (setq woman-buffer-alist (cons (cons file-name bufname) woman-buffer-alist) - woman-buffer-number 0)) - ))) + woman-buffer-number 0))))) (Man-build-section-alist) (Man-build-references-alist) (goto-char (point-min))) (defun woman-make-bufname (bufname) "Create an unambiguous buffer name from BUFNAME." - (let ((dot (string-match "\\." bufname))) + ;; See Bug#5038. Any compression extension has already been removed. + ;; Go from eg "host.conf.5" to "5 host.conf". + (let ((dot (string-match "\\.[^.]*\\'" bufname))) (if dot (setq bufname (concat (substring bufname (1+ dot)) " " (substring bufname 0 dot)))) @@ -1785,8 +1757,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)))) - ) + (woman-set-face (match-beginning 2) (match-end 2) 'woman-bold))))) (defun woman-insert-file-contents (filename compressed) "Insert file FILENAME into the current buffer. @@ -1811,9 +1782,7 @@ Leave point at end of new text. Return length of inserted text." (file-error ;; Run find-file-not-found-hooks until one returns non-nil. ;; (run-hook-with-args-until-success 'find-file-not-found-hooks) - (insert "\n***** File " filename " not found! *****\n\n") - ))) - ))) + (insert "\n***** File " filename " not found! *****\n\n"))))))) ;;; Major mode (Man) interface: @@ -1925,6 +1894,7 @@ Argument EVENT is the invoking mouse event." (setq woman-emulation value) (woman-reformat-last-file)) +(defvar bookmark-make-record-function) (put 'woman-mode 'mode-class 'special) (defun woman-mode () @@ -1949,7 +1919,8 @@ See `Man-mode' for additional details." (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))) + (fset 'Man-goto-page Man-goto-page) + (setq tab-width woman-tab-width))) (setq major-mode 'woman-mode mode-name "WoMan") ;; Don't show page numbers like Man-mode does. (Online documents do @@ -1961,6 +1932,9 @@ See `Man-mode' for additional details." ;; `make-local-variable' in case imenu not yet loaded! woman-imenu-generic-expression) (set (make-local-variable 'imenu-space-replacement) " ") + ;; Bookmark support. + (set (make-local-variable 'bookmark-make-record-function) + 'woman-bookmark-make-record) ;; For reformat ... ;; necessary when reformatting a file in its old buffer: (setq imenu--last-menubar-index-alist nil) @@ -1990,8 +1964,7 @@ Optional argument REDRAW, if non-nil, forces mode line to be updated." (interactive) (setq woman-fill-frame (not woman-fill-frame)) (message "Woman fill column set to %s." - (if woman-fill-frame "frame width" woman-fill-column) - )) + (if woman-fill-frame "frame width" woman-fill-column))) (defun woman-mini-help () "Display WoMan commands and user options in an `apropos' buffer." @@ -2000,13 +1973,13 @@ Optional argument REDRAW, if non-nil, forces mode line to be updated." (require 'apropos) (let ((message (let ((standard-output (get-buffer-create "*Apropos*"))) - (print-help-return-message 'identity)))) + (help-print-return-message 'identity)))) (setq apropos-accumulator (apropos-internal "woman" (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) @@ -2018,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)))))) @@ -2042,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 @@ -2118,8 +2091,7 @@ alist in `woman-buffer-alist' and return nil." (setcdr prev-ptr (cdr (cdr prev-ptr))) (if (>= woman-buffer-number (length woman-buffer-alist)) (setq woman-buffer-number 0)) - nil) - ))) + nil)))) ;;; Syntax and display tables: @@ -2161,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 [?\\])) @@ -2177,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 @@ -2187,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)) @@ -2268,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. @@ -2405,52 +2375,7 @@ Currently set only from '\" t in the first line of the source file.") (woman-delete-match 0) (WoMan-warn "Terminal vertical motion escape \\%s ignored!" esc))) - (setq first (not first)) - ))) - -; ;; \h'+/-N' local horizontal motion. -; ;; N may include width escape \w'...' -; ;; Implement arbitrary forward motion and non-overlapping backward -; ;; motion. -; (goto-char from) -; (while (re-search-forward -; ;; Delimiter can be a special char escape sequence \(.. or -; ;; a single normal char (usually '): -; "\\\\h\\(\\\\(..\\|.\\)\\(|\\)?" -; nil t) -; (let ((from (match-beginning 0)) -; (delim (regexp-quote (match-string 1))) -; (absolute (match-string 2)) ; absolute position? -; (N (woman-parse-numeric-arg)) ; distance -; to -; msg) ; for warning -; (if (not (looking-at delim)) -; ;; Warn but leave escape in buffer unprocessed: -; (WoMan-warn -; "Local horizontal motion (%s) delimiter error!" -; (buffer-substring from (1+ (point)))) ; point at end of arg -; (setq to (match-end 0) -; ;; For possible warning -- save before deleting: -; msg (buffer-substring from to)) -; (delete-region from to) -; (if absolute ; make relative -; (setq N (- N (current-column)))) -; (if (>= N 0) -; ;; Move forward by inserting hard spaces: -; (insert-char woman-unpadded-space-char N) -; ;; Move backwards by deleting space, -; ;; first backwards then forwards: -; (while (and -; (<= (setq N (1+ N)) 0) -; (cond ((memq (preceding-char) '(?\ ?\t)) -; (delete-backward-char 1) t) -; ((memq (following-char) '(?\ ?\t)) -; (delete-char 1) t) -; (t nil)))) -; (if (<= N 0) -; (WoMan-warn -; "Negative horizontal motion (%s) would overwrite!" msg)))) -; )) + (setq first (not first))))) ;; Process formatting macros (goto-char from) @@ -2460,19 +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))) @@ -2513,15 +2439,14 @@ Preserves location of `point'." ;; first backwards then forwards: (while (and (<= (setq N (1+ N)) 0) - (cond ((memq (preceding-char) '(?\ ?\t)) - (delete-backward-char 1) t) - ((memq (following-char) '(?\ ?\t)) + (cond ((memq (preceding-char) '(?\s ?\t)) + (delete-char -1) t) + ((memq (following-char) '(?\s ?\t)) (delete-char 1) t) (t nil)))) (if (<= N 0) (WoMan-warn - "Negative horizontal motion (%s) would overwrite!" msg)))) - )) + "Negative horizontal motion (%s) would overwrite!" msg)))))) (goto-char from))) @@ -2546,23 +2471,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 @@ -2581,8 +2518,7 @@ Start at FROM and re-scan new text as appropriate." (delete-region from (point)) (WoMan-warn "ig request ignored -- terminator `.%s' not found!" yy) - (woman-delete-line 1)) - )) + (woman-delete-line 1)))) (defsubst woman0-process-escapes (from to) "Process escapes within an if/ie condition between FROM and TO." @@ -2594,6 +2530,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'. @@ -2615,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))) @@ -2640,13 +2577,12 @@ REQUEST is the invoking directive without the leading dot." (woman0-process-escapes from woman0-if-to) (woman-parse-numeric-arg)))) (setq c (> n 0)) - (goto-char from)) - ) + (goto-char from))) (if (eq c 0) (woman-if-ignore woman0-if-to request) ; ERROR! - (woman-if-body request woman0-if-to (eq c negated))) - )) + (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. @@ -2675,23 +2611,32 @@ If DELETE is non-nil then delete from point." (delete-region (if delete from (match-beginning 0)) (point)) (if (looking-at "^$") (delete-char 1)) )) - (delete (woman-delete-line 1)) ; single-line - ) + (delete (woman-delete-line 1))) ; single-line ;; Process matching .el anything: - (cond ((string= request "ie") + (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)))) - ) - (goto-char from) - )) +;;; ((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 () "Isolated .el request -- should not happen!" @@ -2706,6 +2651,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!") @@ -2733,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)) @@ -2745,8 +2690,7 @@ If DELETE is non-nil then delete from point." (to (copy-marker (+ from length) t))) (woman-pre-process-region from to) (set-marker to nil) - (goto-char from) - ))) + (goto-char from)))) ;;; Process macro definitions: @@ -2766,8 +2710,7 @@ If DELETE is non-nil then delete from point." (setq beg (point) end (progn (woman-forward-arg 'unquote) (point)) new (buffer-substring beg end) - woman0-rename-alist (cons (cons new old) woman0-rename-alist))) - )) + woman0-rename-alist (cons (cons new old) woman0-rename-alist))))) (woman-delete-whole-line)) (defun woman0-rename () @@ -2835,20 +2778,21 @@ Optional argument APPEND, if non-nil, means append macro." (setq woman0-macro-alist (cons macro woman0-macro-alist)) (forward-line) (delete-region from (point)) - (backward-char) ; return to end of .de/am line - )) + (backward-char))) ; return to end of .de/am line (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." @@ -2871,8 +2815,7 @@ Optional argument APPEND, if non-nil, means append macro." ;; Replace formal arg with actual arg: (setq start nil) (while (setq start (string-match formal-arg macro start)) - (setq macro (replace-match actual-arg t t macro))) - ) + (setq macro (replace-match actual-arg t t macro)))) ;; Delete any remaining formal arguments: (setq start nil) (while @@ -2922,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)) @@ -2956,11 +2902,7 @@ interpolated by `\*x' and `\*(xx' escapes." (delete-region beg (point)) (setq woman-string-alist (cons (cons stringname "") - woman-string-alist)))) - )) - )) - )) - )) + woman-string-alist)))))))))))) ;;; Process special character escapes \(xx: @@ -2991,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 @@ -3046,8 +2992,7 @@ Set NEWTEXT in face FACE if specified." (WoMan-warn (concat "Special character " (if (match-beginning 1) "\\(%s" "\\[%s]") " not interpolated!") name) - (if woman-ignore (woman-delete-match 0)))) - )) + (if woman-ignore (woman-delete-match 0)))))) (defun woman-display-extended-fonts () "Display table of glyphs of graphic characters and their octal codes. @@ -3065,15 +3010,16 @@ Useful for constructing the alist variable `woman-special-characters'." (insert " ") (setq i (1+ i)) (when (= i 128) (setq i 160) (insert "\n")) - (if (zerop (% i 8)) (insert "\n"))) - )) - (print-help-return-message))) + (if (zerop (% i 8)) (insert "\n"))))) + (help-print-return-message))) ;;; 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. @@ -3088,8 +3034,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." @@ -3098,7 +3043,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) @@ -3106,14 +3051,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) '(?. ?')) @@ -3122,10 +3067,8 @@ 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) '(?. ?'))) - (insert "\\&")) - ) - ))))) + (if (and woman1-unquote (memq (following-char) '(?. ?'))) + (insert "\\&")))))))) ;;; Font-changing macros: @@ -3137,6 +3080,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." @@ -3145,7 +3090,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) @@ -3192,13 +3137,13 @@ 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 - (insert "\\fR") - )) + (woman-forward-arg woman1-unquote 'concat)) + (insert "\\fR"))) (defun woman-forward-arg (&optional unquote concat) "Move forward over one ?roff argument, optionally unquoting and/or joining. @@ -3213,15 +3158,13 @@ If optional arg CONCAT is non-nil then join arguments." (if unquote (delete-char 1) (forward-char)) (re-search-forward "\"\\|$")) (if (eq (preceding-char) ?\") - (if unquote (delete-backward-char 1)) - (WoMan-warn "Unpaired \" in .%s arguments." request) - )) + (if unquote (delete-char -1)) + (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! ((eq concat 'noskip)) ; do not skip following whitespace - (t (woman-delete-following-space))) - ) + (t (woman-delete-following-space)))) ;; The following requests are not explicit font-change requests and @@ -3246,8 +3189,7 @@ If optional arg CONCAT is non-nil then join arguments." (woman-delete-whole-line) (insert ".ft I\n") (forward-line N) - (insert ".ft R\n") - )) + (insert ".ft R\n"))) ;;; Other non-breaking requests: @@ -3278,8 +3220,7 @@ If optional arg CONCAT is non-nil then join arguments." (save-excursion (while (and (re-search-forward c nil t) (match-beginning 1)) - (delete-char -1))) - )) + (delete-char -1))))) (put 'woman1-hw 'notfont t) (defun woman1-hw () @@ -3371,8 +3312,7 @@ If optional arg CONCAT is non-nil then join arguments." fescape t) (woman-match-name)) (t (setq notfont t))) - (if notfont - () + (unless notfont ;; Get font name: (or font (let ((fontstring (match-string 0))) @@ -3410,8 +3350,7 @@ If optional arg CONCAT is non-nil then join arguments." (setq current-font font) ))) ;; Set font after last request up to eob: - (woman-set-face previous-pos (point) current-font) - )) + (woman-set-face previous-pos (point) current-font))) (defun woman-set-face (from to face) "Set the face of the text from FROM to TO to face FACE. @@ -3430,14 +3369,18 @@ Ignore the default face and underline only word characters." (put-text-property from (point) 'face face-no-ul) (setq from (point)) ))) - (put-text-property from to 'face face)) - )) + (put-text-property from to 'face face)))) ;;; Output translation: -(defvar translations nil) ; Also bound locally by woman2-roff-buffer -;; A list of the form (\"[ace]\" (a . b) (c . d) (e . ?\ )) or nil. +;; 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 . ?\s)) or nil. (defun woman-get-next-char () "Return and delete next char in buffer, including special chars." @@ -3456,8 +3399,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 @@ -3479,16 +3422,18 @@ 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) - )) + (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)) (while (re-search-forward matches to t) ;; Done like this to retain text properties and ;; support translation of special characters: @@ -3497,8 +3442,7 @@ Format paragraphs upto TO. Supports special chars. (buffer-substring-no-properties (match-beginning 0) (match-end 0)) alist))) - (woman-delete-match 0)) - ))) + (woman-delete-match 0))))) ;;; Registers: @@ -3625,8 +3569,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 )) @@ -3688,15 +3632,14 @@ expression in parentheses. Leaves point after the value." (if (re-search-forward delim nil t) ;; Return width of string: (- (match-beginning 0) from) - (WoMan-warn "Width escape delimiter error!")))) - ))) + (WoMan-warn "Width escape delimiter error!"))))))) (if (null n) ;; ERROR -- should handle this better! (progn (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)) @@ -3713,8 +3656,7 @@ expression in parentheses. Leaves point after the value." ;; in which case do nothing and return nil. ) (goto-char (match-end 0))) - (if (numberp n) (round n) n)) - ))) + (if (numberp n) (round n) n))))) ;;; VERTICAL FORMATTING -- Formatting macros that cause a break: @@ -3732,7 +3674,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... @@ -3748,13 +3690,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: + ;; Unrecognized 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) @@ -3773,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 ... @@ -3784,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 @@ -3798,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. @@ -3823,11 +3770,7 @@ Round to whole lines, default 1 line. Format paragraphs upto TO. (defsubst woman-interparagraph-space () "Set variable `woman-leave-blank-lines' from `woman-interparagraph-distance'." -; (if (> woman-interparagraph-distance 0) -; (forward-line 1) ; leave 1 blank line -; (woman-delete-line 1)) ; do not leave blank line - (setq woman-leave-blank-lines woman-interparagraph-distance) - ) + (setq woman-leave-blank-lines woman-interparagraph-distance)) (defun woman2-TH (to) ".TH n c x v m -- Begin a man page. Format paragraphs upto TO. @@ -3841,9 +3784,7 @@ v alters page foot left; m alters page head center. (let ((start (point)) here) (while (not (eolp)) (cond ((looking-at "\"\"[ \t]") - (delete-char 2) - ;; (delete-horizontal-space) - )) + (delete-char 2))) (delete-horizontal-space) (setq here (point)) (insert " -- ") @@ -3853,8 +3794,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) @@ -3873,8 +3813,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 @@ -3955,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) @@ -3974,9 +3913,7 @@ Leave 1 blank line. Format paragraphs upto TO." "Character(s) overwritten by negative vertical spacing in line %d" (count-lines 1 (point)))) (delete-char 1) (insert (substring overlap i (1+ i))))) - (setq i (1+ i)) - )) - ))) + (setq i (1+ i))))))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -3987,13 +3924,20 @@ 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 - ;; and zero width characters \|, \^: + ;; and zero width characters. (while (re-search-forward "\\\\[&|^]" to t) - (woman-delete-match 0)) + (woman-delete-match 0) + ;; If on a line by itself, consume newline as well (Bug#3651). + ;; 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))) + (goto-char from) ;; Interrupt text processing -- CONTINUE current text with the ;; next text line (after any control lines, unless processing to @@ -4013,25 +3957,22 @@ 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, \' -> ` (delete-char 1) (insert ?`)))) ((eq c ?\( )) ; uninterpreted special character - ; \(.. -- do nothing + ; \(.. -- do nothing ((eq c ?t) ; non-interpreted tab \t (delete-char 1) (delete-char -1) (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 @@ -4064,8 +4005,7 @@ Optional argument NUMERIC, if non-nil, means the argument is numeric." (c (if (< (point) to) (following-char) ?_))) (delete-region from to) (delete-char 1) - (insert (make-string N c)) - )) + (insert (make-string N c)))) ;;; 4. Text Filling, Adjusting, and Centering @@ -4088,7 +4028,7 @@ Format paragraphs upto TO." (defun woman2-nf (to) ".nf -- Nofill. Subsequent lines are neither filled nor adjusted. Input text lines are copied directly to output lines without regard -for the current line length. Format paragraphs upto TO." +for the current line length. Format paragraphs up to TO." (setq woman-nofill t) (woman-delete-line 1) ; ignore any arguments (woman2-format-paragraphs to)) @@ -4139,15 +4079,12 @@ non-nil and non-zero." (progn (skip-syntax-forward " ") (beginning-of-line) (point))) - (if woman-nospace - () + (unless woman-nospace (if (or (null leave) (eq leave 0)) ;; output any `pending' vertical space ... (setq leave woman-leave-blank-lines)) - (if (and leave (> leave 0)) (insert-before-markers ?\n)) - ) - (setq woman-leave-blank-lines nil) - ) + (if (and leave (> leave 0)) (insert-before-markers ?\n))) + (setq woman-leave-blank-lines nil)) ;; `fill-region-as-paragraph' in `fill.el' appears to be the principal ;; text filling function, so that is what I use here. @@ -4166,28 +4103,20 @@ If `woman-nofill' is non-nil then indent without filling or adjusting." (skip-syntax-forward " ") ;; Successive control lines are sufficiently common to be worth a ;; special case (maybe): - (if (>= (point) to) ; >= as a precaution! - () - ;; (woman-leave-blank-lines) + (unless (>= (point) to) (woman-reset-nospace) - ;; (woman2-process-escapes to) ; 7 October 1999 (woman2-process-escapes to 'numeric) (if woman-nofill ;; Indent without filling or adjusting ... (progn (woman-leave-blank-lines) - (cond (woman-temp-indent - (indent-to woman-temp-indent) - (forward-line))) + (when woman-temp-indent + (indent-to woman-temp-indent) + (forward-line)) (indent-rigidly (point) to left-margin) - (woman-horizontal-escapes to)) ; 7 October 1999 + (woman-horizontal-escapes to)) ;; Fill and justify ... ;; Blank lines and initial spaces cause a break. -; (cond ((and (= (point) to) (not (looking-at ".nf"))) ; Yuk!!! -; ;; No text after a request that caused a break, so delete -; ;; any spurious blank line left: -; (forward-line -1) -; (if (looking-at "^\\s *$") (kill-line) (forward-line)))) (while (< (point) to) (woman-leave-blank-lines) (let ((from (point))) @@ -4196,13 +4125,6 @@ If `woman-nofill' is non-nil then indent without filling or adjusting." (woman-horizontal-escapes to) ; 7 October 1999 ;; Find the beginning of the next paragraph: (forward-line) -; (if (re-search-forward "\\(^\\s *$\\)\\|\\(^\\s +\\)" to 1) -; ;; A blank line should leave a space like .sp 1 (p. 14). -; (if (eolp) -; (progn -; (skip-syntax-forward " ") -; (setq woman-leave-blank-lines 1)) -; (setq woman-leave-blank-lines nil))) (and (re-search-forward "\\(^\\s *$\\)\\|\\(^\\s +\\)" to 1) ;; A blank line should leave a space like .sp 1 (p. 14). (eolp) @@ -4216,35 +4138,21 @@ If `woman-nofill' is non-nil then indent without filling or adjusting." ;; If a single short line then just leave it. ;; This is necessary to preserve some table layouts. ;; PROBABLY NOT NECESSARY WITH SQUEEZE MODIFICATION !!!!! - (if (or (> (count-lines from (point)) 1) + (when (or (> (count-lines from (point)) 1) + (save-excursion + (backward-char) + (> (current-column) fill-column))) + ;; NOSQUEEZE has no effect if JUSTIFY is full, so redefine + ;; canonically-space-region, see above. + (if (and woman-temp-indent (< woman-temp-indent left-margin)) + (let ((left-margin woman-temp-indent)) + (fill-region-as-paragraph from (point) woman-justify) (save-excursion - (backward-char) - (> (current-column) fill-column))) - ;; ?roff does not squeeze multiple spaces - ;; (fill-region-as-paragraph from (point) woman-justify t) - ;; NOSQUEEZE has no effect if JUSTIFY is full, so - ;; redefine canonically-space-region, see above. - (progn - ;; Needs a re-write of the paragraph formatter to - ;; avoid this nonsense to handle temporary indents! - (if (and woman-temp-indent (< woman-temp-indent left-margin)) - (let ((left-margin woman-temp-indent)) - (fill-region-as-paragraph from (point) woman-justify) - (save-excursion - (goto-char from) - (forward-line) - (setq from (point))))) - (fill-region-as-paragraph from (point) woman-justify)) - ) - ;; A blank line should leave a space like .sp 1 (p. 14). - ;; Delete all but 1 trailing blank lines: - ;;(woman-leave-blank-lines 1) - )) - ) - (setq woman-temp-indent nil) - ;; Non-white-space text has been processed, so ... - ;;(setq woman-leave-blank-lines nil) - )) + (goto-char from) + (forward-line) + (setq from (point))))) + (fill-region-as-paragraph from (point) woman-justify))))) + (setq woman-temp-indent nil))) ;;; Tagged, indented and hanging paragraphs: @@ -4316,8 +4224,7 @@ Format paragraphs upto TO. Set prevailing indent to I." (if (string= (match-string 1) "ta") ; for GetInt.3 (woman2-ta to) (woman-set-interparagraph-distance))) - (set-marker to (woman-find-next-control-line-carefully)) - )) + (set-marker to (woman-find-next-control-line-carefully)))) (let ((tag (point))) (woman-reset-nospace) @@ -4351,9 +4258,7 @@ Format paragraphs upto TO. Set prevailing indent to I." ;; Cannot simply delete (current-column) whitespace ;; characters because some may be tabs! (insert-char ?\s i))) - (goto-char to) ; necessary ??? - )) - )) + (goto-char to))))) (defun woman2-HP (to) ".HP i -- Set prevailing indent to i. Format paragraphs upto TO. @@ -4361,8 +4266,7 @@ Begin paragraph with hanging indent." (let ((i (woman2-get-prevailing-indent))) (woman-interparagraph-space) (setq woman-temp-indent woman-left-margin) - (woman2-format-paragraphs to (+ woman-left-margin i)) - )) + (woman2-format-paragraphs to (+ woman-left-margin i)))) (defun woman2-get-prevailing-indent (&optional leave-eol) "Set prevailing indent to integer argument at point, and return it. @@ -4479,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. @@ -4489,7 +4393,7 @@ The variable `tab-stop-list' is a list whose elements are either left tab stop columns or pairs (COLUMN . TYPE) where TYPE is R or C." ;; Based on tab-to-tab-stop in indent.el. ;; R & C tabs probably not quite right! - (delete-backward-char 1) + (delete-char -1) (let ((tabs tab-stop-list)) (while (and tabs (>= (current-column) (woman-get-tab-stop (car tabs)))) @@ -4500,14 +4404,14 @@ 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)) 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. @@ -4525,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))) @@ -4543,13 +4447,11 @@ Needs doing properly!" (delete-char 1) (insert woman-unpadded-space-char) (goto-char (match-end 0)) - (delete-backward-char 1) + (delete-char -1) (insert-before-markers woman-unpadded-space-char) (subst-char-in-region (match-beginning 0) (match-end 0) - pad woman-unpadded-space-char t) - )) - )) + pad woman-unpadded-space-char t))))) (woman2-format-paragraphs to)) @@ -4558,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 @@ -4571,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) @@ -4584,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) @@ -4595,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))) @@ -4616,8 +4557,7 @@ Format paragraphs upto TO." (concat "file " WoMan-current-file) (concat "buffer " WoMan-current-buffer)) " at " (current-time-string) "\n") - (setq WoMan-Log-header-point-max (point-max)) - ))) + (setq WoMan-Log-header-point-max (point-max))))) (defun WoMan-log (format &rest args) "Log a message out of FORMAT control string and optional ARGS." @@ -4628,14 +4568,15 @@ 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) ?\ )) + (/= (string-to-char tail) ?\s)) (setq tail (concat " " tail))) (WoMan-log-1 (concat "** " request tail " request " ignored)))) @@ -4644,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*. @@ -4663,11 +4604,45 @@ logging the message." (cond (WoMan-Log-header-point-max (goto-char WoMan-Log-header-point-max) (forward-line -1) - (recenter 0))) - ))))) + (recenter 0)))))))) nil) ; for woman-file-readable-p etc. +;;; Bookmark Woman support. +(declare-function bookmark-make-record-default + "bookmark" (&optional no-file no-context posn)) +(declare-function bookmark-prop-get "bookmark" (bookmark prop)) +(declare-function bookmark-default-handler "bookmark" (bmk)) +(declare-function bookmark-get-bookmark-record "bookmark" (bmk)) + +;; FIXME: woman.el and man.el should be better integrated so, for +;; example, bookmarks of one can be used with the other. + +(defun woman-bookmark-make-record () + "Make a bookmark entry for a Woman buffer." + `(,(Man-default-bookmark-title) + ,@(bookmark-make-record-default 'no-file) + (location . ,(concat "woman " woman-last-file-name)) + ;; Use the same form as man's bookmarks, as much as possible. + (man-args . ,woman-last-file-name) + (handler . woman-bookmark-jump))) + +;;;###autoload +(defun woman-bookmark-jump (bookmark) + "Default bookmark handler for Woman buffers." + (let* ((file (bookmark-prop-get bookmark 'man-args)) + ;; FIXME: we need woman-find-file-noselect, since + ;; save-window-excursion can't protect us from the case where + ;; woman-find-file creates a new frame. + (buf (save-window-excursion + (woman-find-file file) (current-buffer)))) + (bookmark-default-handler + `("" (buffer . ,buf) . ,(bookmark-get-bookmark-record bookmark))))) + (provide 'woman) -;; arch-tag: eea35e90-552f-4712-a94b-d9ffd3db7651 + +;; Local Variables: +;; coding: utf-8 +;; End: + ;;; woman.el ends here