X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/d0923e437b00977c09b7ef1a54677ccf4d3e00ab..29660eb7cb1ac6ec24d20521cce51c07d9ec5f75:/lisp/woman.el diff --git a/lisp/woman.el b/lisp/woman.el index ba511bca1a..b25a93d86a 100644 --- a/lisp/woman.el +++ b/lisp/woman.el @@ -1,11 +1,12 @@ ;;; woman.el --- browse UN*X manual pages `wo (without) man' -;; Copyright (C) 2000, 2002, 2004 Free Software Foundation, Inc. +;; Copyright (C) 2000, 2002, 2003, 2004, 2005, +;; 2006 Free Software Foundation, Inc. ;; Author: Francis J. Wright -;; Maintainer: Francis J. Wright +;; Maintainer: FSF ;; Keywords: help, unix -;; Adapted-By: Eli Zaretskii +;; Adapted-By: Eli Zaretskii ;; Version: see `woman-version' ;; URL: http://centaur.maths.qmul.ac.uk/Emacs/WoMan/ @@ -23,8 +24,8 @@ ;; You should have received a copy of the GNU General Public License ;; along with GNU Emacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. +;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, +;; Boston, MA 02110-1301, USA. ;;; Commentary: @@ -136,27 +137,23 @@ ;; man man_page_name -;; Using the `word at point' as a topic suggestion -;; =============================================== +;; Using the word at point as the default topic +;; ============================================ -;; By default, the `woman' command uses the word nearest to point in -;; the current buffer as a suggestion for the topic to look up. The -;; topic must be confirmed or edited in the minibuffer. This -;; suggestion can be turned off, or `woman' can use the suggested -;; topic without confirmation* if possible, by setting the user-option -;; `woman-topic-at-point' to nil or t respectively. (Its default -;; value is neither nil nor t, meaning ask for confirmation.) +;; The `woman' command uses the word nearest to point in the current +;; buffer as the default topic to look up if it matches the name of a +;; manual page installed on the system. The default topic can also be +;; used without confirmation by setting the user-option +;; `woman-use-topic-at-point' to t; thanks to Benjamin Riefenstahl for +;; suggesting this functionality. -;; [* Thanks to Benjamin Riefenstahl for suggesting this -;; functionality.] - -;; The variable `woman-topic-at-point' can be rebound locally, which -;; may be useful to provide special private key bindings, e.g. +;; The variable `woman-use-topic-at-point' can be rebound locally, +;; which may be useful to provide special private key bindings, e.g. ;; (global-set-key "\C-cw" ;; (lambda () ;; (interactive) -;; (let ((woman-topic-at-point t)) +;; (let ((woman-use-topic-at-point t)) ;; (woman))))) @@ -384,7 +381,7 @@ ;; code fragments, general interest, etc.: ;; Jari Aalto ;; Dean Andrews -;; Juanma Barranquero +;; Juanma Barranquero ;; Karl Berry ;; Jim Chapman ;; Kin Cho @@ -420,10 +417,7 @@ ;; Paul A. Thompson ;; Arrigo Triulzi ;; Geoff Voelker -;; Eli Zaretskii - -;;; History: -;; For recent change log see end of file. +;; Eli Zaretskii ;;; Code: @@ -431,8 +425,20 @@ (defvar woman-version "0.551 (beta)" "WoMan version information.") (require 'man) +(require 'button) +(define-button-type 'WoMan-xref-man-page + :supertype 'Man-abstract-xref-man-page + 'func (lambda (arg) + (woman + ;; `woman' cannot deal with arguments that contain a + ;; section name, like close(2), so strip the section name. + (if (string-match Man-reference-regexp arg) + (substring arg 0 (match-end 1)) + arg)))) + (eval-when-compile ; to avoid compiler warnings (require 'dired) + (require 'cl) (require 'apropos)) (defun woman-mapcan (fn x) @@ -714,26 +720,21 @@ Default is \"CONTENTS\"." :type 'string :group 'woman-interface) -(defcustom woman-topic-at-point-default 'confirm - ;; `woman-topic-at-point' may be let-bound when woman is loaded, in - ;; which case its global value does not get defined. +(defcustom woman-use-topic-at-point-default nil + ;; `woman-use-topic-at-point' may be let-bound when woman is loaded, + ;; in which case its global value does not get defined. ;; `woman-file-name' sets it to this value if it is unbound. - "*Default value for `woman-topic-at-point'." + "*Default value for `woman-use-topic-at-point'." :type '(choice (const :tag "Yes" t) - (const :tag "No" nil) - (other :tag "Confirm" confirm)) + (const :tag "No" nil)) :group 'woman-interface) -(defcustom woman-topic-at-point woman-topic-at-point-default - "*Controls use by `woman' of `word at point' as a topic suggestion. -If non-nil then the `woman' command uses the word at point as an -initial topic suggestion when it reads a topic from the minibuffer; if -t then the `woman' command uses the word at point WITHOUT -INTERACTIVE CONFIRMATION if it exists as a topic. The default value -is `confirm', meaning suggest a topic and ask for confirmation." +(defcustom woman-use-topic-at-point woman-use-topic-at-point-default + "*Control use of the word at point as the default topic. +If non-nil the `woman' command uses the word at point automatically, +without interactive confirmation, if it exists as a topic." :type '(choice (const :tag "Yes" t) - (const :tag "No" nil) - (other :tag "Confirm" confirm)) + (const :tag "No" nil)) :group 'woman-interface) (defvar woman-file-regexp nil @@ -823,13 +824,13 @@ Set this variable to 7 to emulate GNU man formatting." (defcustom woman-bold-headings t "*If non-nil then embolden section and subsection headings. Default is t. -Heading emboldening is NOT standard `man' behaviour." +Heading emboldening is NOT standard `man' behavior." :type 'boolean :group 'woman-formatting) (defcustom woman-ignore t - "*If non-nil then unrecognised requests etc. are ignored. Default is t. -This gives the standard ?roff behaviour. If nil then they are left in + "*If non-nil then unrecognized requests etc. are ignored. Default is t. +This gives the standard ?roff behavior. If nil then they are left in the buffer, which may aid debugging." :type 'boolean :group 'woman-formatting) @@ -875,45 +876,56 @@ or different fonts." ;; 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-face - `((((background light)) (:slant italic :underline t :foreground "red")) +(defface woman-italic + `((((min-colors 88) (background light)) + (:slant italic :underline t :foreground "red1")) + (((background light)) (:slant italic :underline t :foreground "red")) (((background dark)) (:slant italic :underline t))) "Face for italic font in man pages." :group 'woman-faces) +;; backward-compatibility alias +(put 'woman-italic-face 'face-alias 'woman-italic) -(defface woman-bold-face - '((((background light)) (:weight bold :foreground "blue")) +(defface woman-bold + '((((min-colors 88) (background light)) (:weight bold :foreground "blue1")) + (((background light)) (:weight bold :foreground "blue")) (((background dark)) (:weight bold :foreground "green2"))) "Face for bold font in man pages." :group 'woman-faces) +;; backward-compatibility alias +(put 'woman-bold-face 'face-alias 'woman-bold) ;; Brown is a good compromise: it is distinguishable from the default ;; but not enough so to make font errors look terrible. (Files that use ;; non-standard fonts seem to do so badly or in idiosyncratic ways!) -(defface woman-unknown-face +(defface woman-unknown '((((background light)) (:foreground "brown")) + (((min-colors 88) (background dark)) (:foreground "cyan1")) (((background dark)) (:foreground "cyan"))) "Face for all unknown fonts in man pages." :group 'woman-faces) +;; backward-compatibility alias +(put 'woman-unknown-face 'face-alias 'woman-unknown) -(defface woman-addition-face +(defface woman-addition '((t (:foreground "orange"))) "Face for all WoMan additions to man pages." :group 'woman-faces) +;; backward-compatibility alias +(put 'woman-addition-face 'face-alias 'woman-addition) (defun woman-default-faces () - "Set foreground colours of italic and bold faces to their default values." + "Set foreground colors of italic and bold faces to their default values." (interactive) - (face-spec-set 'woman-italic-face - (face-user-default-spec 'woman-italic-face)) - (face-spec-set 'woman-bold-face (face-user-default-spec 'woman-bold-face))) + (face-spec-set 'woman-italic (face-user-default-spec 'woman-italic)) + (face-spec-set 'woman-bold (face-user-default-spec 'woman-bold))) (defun woman-monochrome-faces () - "Set foreground colours of italic and bold faces to that of the default face. + "Set foreground colors of italic and bold faces to that of the default face. This is usually either black or white." (interactive) - (set-face-foreground 'woman-italic-face 'unspecified) - (set-face-foreground 'woman-bold-face 'unspecified)) + (set-face-foreground 'woman-italic 'unspecified) + (set-face-foreground 'woman-bold 'unspecified)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Experimental font support, initially only for MS-Windows. @@ -934,7 +946,7 @@ This is usually either black or white." symbol-fonts)) (when woman-font-support - (make-face 'woman-symbol-face) + (make-face 'woman-symbol) ;; Set the symbol font only if `woman-use-symbol-font' is true, to ;; avoid unnecessarily upsetting the line spacing in NTEmacs 20.5! @@ -945,8 +957,9 @@ This is usually either black or white." :group 'woman-faces) (defcustom woman-use-symbol-font nil - "*If non-nil then may use the symbol font. It is off by default, -mainly because it may change the line spacing (in NTEmacs 20.5)." + "*If non-nil then may use the symbol font. +It is off by default, mainly because it may change the line spacing +\(in NTEmacs 20.5)." :type 'boolean :group 'woman-faces) @@ -1024,18 +1037,6 @@ Set by `.ns' request; reset by any output or `.rs' request") "Set `woman-nospace' to nil." (setq woman-nospace nil)) -(defconst woman-mode-line-format - ;; This is essentially the Man-mode format with page numbers removed - ;; and line numbers added. (Online documents do not have pages, but - ;; they do have lines!) - '("-" mode-line-mule-info mode-line-modified - mode-line-frame-identification mode-line-buffer-identification - " " global-mode-string - " %[(WoMan" mode-line-process minor-mode-alist ")%]--" - (line-number-mode "L%l--") - (-3 . "%p") "-%-") - "Mode line format for WoMan buffer.") - (defconst woman-request-regexp "^[.'][ \t]*\\(\\S +\\) *" ;; Was "^\\.[ \t]*\\([a-z0-9]+\\) *" but cvs.1 uses a macro named ;; "`" and CGI.man uses a macro named "''"! @@ -1132,7 +1133,7 @@ Used non-interactively, arguments are optional: if given then TOPIC should be a topic string and non-nil RE-CACHE forces re-caching." (interactive (list nil current-prefix-arg)) ;; The following test is for non-interactive calls via gnudoit etc. - (if (or (interactive-p) (not (stringp topic)) (string-match "\\S " topic)) + (if (or (not (stringp topic)) (string-match "\\S " topic)) (let ((file-name (woman-file-name topic re-cache))) (if file-name (woman-find-file file-name) @@ -1196,15 +1197,16 @@ It is saved to the file named by the variable `woman-cache-filename'." (kill-buffer standard-output) )))) -(defvar woman-topic-history nil "Topic read history.") +(defvaralias 'woman-topic-history 'Man-topic-history) (defvar woman-file-history nil "File-name read history.") (defun woman-file-name (topic &optional re-cache) "Get the name of the UN*X man-page file describing a chosen TOPIC. -When `woman' is called interactively, the word at point may be used as -the topic or initial topic suggestion, subject to the value of the -user option `woman-topic-at-point'. Return nil if no file can be found. -Optional argument RE-CACHE, if non-nil, forces the cache to be re-read." +When `woman' is called interactively, the word at point may be +automatically used as the topic, if the value of the user option +`woman-use-topic-at-point' is non-nil. Return nil if no file can +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 @@ -1222,25 +1224,30 @@ Optional argument RE-CACHE, if non-nil, forces the 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) + (let (files + (default (current-word))) (or (stringp topic) - (and (eq t - (if (boundp 'woman-topic-at-point) - woman-topic-at-point - ;; Was let-bound when file loaded, so ... - (setq woman-topic-at-point woman-topic-at-point-default))) - (setq topic - (or (current-word t) "")) ; only within or adjacent to word - (assoc topic woman-topic-all-completions)) + (and (if (boundp 'woman-use-topic-at-point) + woman-use-topic-at-point + ;; Was let-bound when file loaded, so ... + (setq woman-use-topic-at-point woman-use-topic-at-point-default)) + (setq topic (or (current-word t) "")) ; only within or adjacent to word + (test-completion topic woman-topic-all-completions)) (setq topic - (completing-read - "Manual entry: " - woman-topic-all-completions nil 1 - ;; Initial input suggestion (was nil), with - ;; cursor at left ready to kill suggestion!: - (and woman-topic-at-point - (cons (or (current-word) "") 0)) ; nearest word - 'woman-topic-history))) + (let* ((word-at-point (current-word)) + (default + (when (and word-at-point + (test-completion + word-at-point woman-topic-all-completions)) + word-at-point))) + (completing-read + (if default + (format "Manual entry (default %s): " default) + "Manual entry: ") + woman-topic-all-completions nil 1 + nil + 'woman-topic-history + default)))) ;; Note that completing-read always returns a string. (if (= (length topic) 0) nil ; no topic, so no file! @@ -1260,10 +1267,9 @@ Optional argument RE-CACHE, if non-nil, forces the cache to be re-read." ;; Unread the command event (TAB = ?\t = 9) that runs the command ;; `minibuffer-complete' in order to automatically complete the ;; minibuffer contents as far as possible. - (setq unread-command-events '(9)) ; and delete any type-ahead! + (setq unread-command-events '(9)) ; and delete any type-ahead! (completing-read "Manual file: " files nil 1 - (try-completion "" files) 'woman-file-history))) - ))) + (try-completion "" files) 'woman-file-history)))))) (defun woman-select (predicate list) "Select unique elements for which PREDICATE is true in LIST. @@ -1491,7 +1497,8 @@ Also make each path-info component into a list. (defsubst woman-dired-define-key-maybe (key) "If KEY is undefined in Dired, bind it to command `woman-dired-find-file'." - (if (eq (lookup-key dired-mode-map key) 'undefined) + (if (or (eq (lookup-key dired-mode-map key) 'undefined) + (null (lookup-key dired-mode-map key))) (woman-dired-define-key key))) (defun woman-dired-define-keys () @@ -1668,24 +1675,24 @@ Do not call directly!" (goto-char (point-min)) (while (search-forward "__\b\b" nil t) (backward-delete-char 4) - (woman-set-face (point) (1+ (point)) 'woman-italic-face)) + (woman-set-face (point) (1+ (point)) 'woman-italic)) (goto-char (point-min)) (while (search-forward "\b\b__" nil t) (backward-delete-char 4) - (woman-set-face (1- (point)) (point) 'woman-italic-face)))) + (woman-set-face (1- (point)) (point) 'woman-italic)))) ;; Interpret overprinting to indicate bold face: (goto-char (point-min)) (while (re-search-forward "\\(.\\)\\(\\(+\\1\\)+\\)" nil t) (woman-delete-match 2) - (woman-set-face (1- (point)) (point) 'woman-bold-face)) + (woman-set-face (1- (point)) (point) 'woman-bold)) ;; Interpret underlining to indicate italic face: ;; (Must be AFTER emboldening to interpret bold _ correctly!) (goto-char (point-min)) (while (search-forward "_" nil t) (delete-char -2) - (woman-set-face (point) (1+ (point)) 'woman-italic-face)) + (woman-set-face (point) (1+ (point)) 'woman-italic)) ;; Leave any other uninterpreted ^H's in the buffer for now! (They ;; might indicate composite special characters, which could be @@ -1698,7 +1705,7 @@ Do not call directly!" (goto-char (point-min)) (forward-line) (while (re-search-forward "^\\( \\)?\\([A-Z].*\\)" nil t) - (woman-set-face (match-beginning 2) (match-end 2) 'woman-bold-face)))) + (woman-set-face (match-beginning 2) (match-end 2) 'woman-bold)))) ) (defun woman-insert-file-contents (filename compressed) @@ -1733,20 +1740,29 @@ Leave point at end of new text. Return length of inserted text." (defvar woman-mode-map nil "Keymap for woman mode.") -(if woman-mode-map - () - ;; Set up the keymap, mostly inherited from Man-mode-map. Normally - ;; button-buffer-map is used as a parent keymap, but we can't have two - ;; parents, so we just copy it. - (setq woman-mode-map (copy-keymap button-buffer-map)) +(unless woman-mode-map + (setq woman-mode-map (make-sparse-keymap)) (set-keymap-parent woman-mode-map Man-mode-map) - ;; Above two lines were - ;; (setq woman-mode-map (cons 'keymap Man-mode-map)) + (define-key woman-mode-map "R" 'woman-reformat-last-file) (define-key woman-mode-map "w" 'woman) (define-key woman-mode-map "\en" 'WoMan-next-manpage) (define-key woman-mode-map "\ep" 'WoMan-previous-manpage) - (define-key woman-mode-map [M-mouse-2] 'woman-follow-word)) + (define-key woman-mode-map [M-mouse-2] 'woman-follow-word) + + ;; We don't need to call `man' when we are in `woman-mode'. + (define-key woman-mode-map [remap man] 'woman) + (define-key woman-mode-map [remap man-follow] 'woman-follow)) + +(defun woman-follow (topic) + "Get a Un*x manual page of the item under point and put it in a buffer." + (interactive (list (Man-default-man-entry))) + (if (or (not topic) + (string= topic "")) + (error "No item under point") + (woman (if (string-match Man-reference-regexp topic) + (substring topic 0 (match-end 1)) + topic)))) (defun woman-follow-word (event) "Run WoMan with word under mouse as topic. @@ -1829,6 +1845,8 @@ Argument EVENT is the invoking mouse event." (setq woman-emulation value) (woman-reformat-last-file)) +(put 'woman-mode 'mode-class 'special) + (defun woman-mode () "Turn on (most of) Man mode to browse a buffer formatted by WoMan. WoMan is an ELisp emulation of much of the functionality of the Emacs @@ -1846,34 +1864,33 @@ See `Man-mode' for additional details." (fset 'Man-unindent 'ignore) (fset 'Man-goto-page 'ignore) (unwind-protect - (progn - (set (make-local-variable 'Man-mode-map) woman-mode-map) - ;; Install Man mode: - (Man-mode) - ;; Reset inappropriate definitions: - (setq mode-line-format woman-mode-line-format) - (put 'Man-mode 'mode-class 'special)) + (delay-mode-hooks (Man-mode)) ;; Restore the status quo: (fset 'Man-build-page-list Man-build-page-list) (fset 'Man-strip-page-headers Man-strip-page-headers) (fset 'Man-unindent Man-unindent) - (fset 'Man-goto-page Man-goto-page) - ) - ;; Imenu support: - (set (make-local-variable 'imenu-generic-expression) - ;; `make-local-variable' in case imenu not yet loaded! - woman-imenu-generic-expression) - (set (make-local-variable 'imenu-space-replacement) " ") - ;; For reformat ... - ;; necessary when reformatting a file in its old buffer: - (setq imenu--last-menubar-index-alist nil) - ;; necessary to avoid re-installing the same imenu: - (setq woman-imenu-done nil) - (if woman-imenu (woman-imenu)) - (setq buffer-read-only nil) - (Man-highlight-references) - (setq buffer-read-only t) - (set-buffer-modified-p nil))) + (fset 'Man-goto-page Man-goto-page))) + (setq major-mode 'woman-mode + mode-name "WoMan") + ;; Don't show page numbers like Man-mode does. (Online documents do + ;; not have pages) + (kill-local-variable 'mode-line-buffer-identification) + (use-local-map woman-mode-map) + ;; Imenu support: + (set (make-local-variable 'imenu-generic-expression) + ;; `make-local-variable' in case imenu not yet loaded! + woman-imenu-generic-expression) + (set (make-local-variable 'imenu-space-replacement) " ") + ;; For reformat ... + ;; necessary when reformatting a file in its old buffer: + (setq imenu--last-menubar-index-alist nil) + ;; necessary to avoid re-installing the same imenu: + (setq woman-imenu-done nil) + (if woman-imenu (woman-imenu)) + (let (buffer-read-only) + (Man-highlight-references 'WoMan-xref-man-page)) + (set-buffer-modified-p nil) + (run-mode-hooks 'woman-mode-hook)) (defun woman-imenu (&optional redraw) "Add a \"Contents\" menu to the menubar. @@ -1933,7 +1950,7 @@ Optional argument REDRAW, if non-nil, forces mode line to be updated." ;; Output the result: (and (apropos-print t nil) message - (message message)))) + (message "%s" message)))) (defun WoMan-getpage-in-background (topic) @@ -1946,25 +1963,33 @@ Optional argument REDRAW, if non-nil, forces mode line to be updated." (defvar WoMan-Man-start-time nil "Used to record formatting time used by the `man' command.") -(defadvice Man-getpage-in-background - (around Man-getpage-in-background-advice (topic) activate) - "Use WoMan unless invoked outside a WoMan buffer or invoked explicitly. -Otherwise use Man and record start of formatting time." - (if (and (eq mode-line-format woman-mode-line-format) - (not (eq (caar command-history) 'man))) - (WoMan-getpage-in-background topic) - ;; Initiates man processing - (setq WoMan-Man-start-time (current-time)) - ad-do-it)) - -(defadvice Man-bgproc-sentinel - (after Man-bgproc-sentinel-advice activate) - ;; Terminates man processing - "Report formatting time." - (let* ((time (current-time)) - (time (+ (* (- (car time) (car WoMan-Man-start-time)) 65536) - (- (cadr time) (cadr WoMan-Man-start-time))))) - (message "Man formatting done in %d seconds" time))) +;; 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 +;; `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 + +;; (defadvice Man-getpage-in-background +;; (around Man-getpage-in-background-advice (topic) activate) +;; "Use WoMan unless invoked outside a WoMan buffer or invoked explicitly. +;; Otherwise use Man and record start of formatting time." +;; (if (and (eq major-mode 'woman-mode) +;; (not (eq (caar command-history) 'man))) +;; (WoMan-getpage-in-background topic) +;; ;; Initiates man processing +;; (setq WoMan-Man-start-time (current-time)) +;; ad-do-it)) + +;; (defadvice Man-bgproc-sentinel +;; (after Man-bgproc-sentinel-advice activate) +;; ;; Terminates man processing +;; "Report formatting time." +;; (let* ((time (current-time)) +;; (time (+ (* (- (car time) (car WoMan-Man-start-time)) 65536) +;; (- (cadr time) (cadr WoMan-Man-start-time))))) +;; (message "Man formatting done in %d seconds" time))) ;;; Buffer handling: @@ -2199,11 +2224,11 @@ Currently set only from '\" t in the first line of the source file.") ;; Prepare non-underlined versions of underlined faces: (woman-non-underline-faces) - ;; Set font of `woman-symbol-face' to `woman-symbol-font' if + ;; Set font of `woman-symbol' face to `woman-symbol-font' if ;; `woman-symbol-font' is well defined. (and woman-use-symbol-font (stringp woman-symbol-font) - (set-face-font 'woman-symbol-face woman-symbol-font + (set-face-font 'woman-symbol woman-symbol-font (and (frame-live-p woman-frame) woman-frame))) ;; Set syntax and display tables: @@ -2288,8 +2313,7 @@ Currently set only from '\" t in the first line of the source file.") "^" "_"))) (cond (first (replace-match repl nil t) - (put-text-property (1- (point)) (point) - 'face 'woman-addition-face) + (put-text-property (1- (point)) (point) 'face 'woman-addition) (WoMan-warn "Initial vertical motion escape \\%s simulated" esc) (WoMan-log @@ -2444,6 +2468,7 @@ Start at FROM and re-scan new text as appropriate." (woman0-search-regex (concat woman0-search-regex-start woman0-search-regex-end)) 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)) @@ -2509,7 +2534,7 @@ REQUEST is the invoking directive without the leading dot." (setq c (memq (following-char) woman-if-conditions-true))) ;; Unrecognised letter so reject: ((looking-at "[A-Za-z]") (setq c nil) - (WoMan-warn "%s %s -- unrecognised condition name rejected!" + (WoMan-warn "%s %s -- unrecognized condition name rejected!" request (match-string 0))) ;; Accept strings if identical: ((save-restriction @@ -2517,7 +2542,7 @@ REQUEST is the invoking directive without the leading dot." ;; String delimiter can be any non-numeric character, ;; including a special character escape: (looking-at "\\(\\\\(..\\|[^0-9]\\)\\(.*\\)\\1\\(.*\\)\\1\\'")) - (let ((end1 (copy-marker (match-end 2)))) ; end of first string + (let ((end1 (copy-marker (match-end 2) t))) ; End of first string. ;; Delete 2nd and 3rd delimiters to avoid processing them: (delete-region (match-end 3) woman0-if-to) (delete-region (match-end 2) (match-beginning 3)) @@ -2632,10 +2657,9 @@ If DELETE is non-nil then delete from point." (error "File `%s' not found" name)) (beginning-of-line) (woman-delete-line 1) - (let ((from (point)) - (to (make-marker)) - (length (woman-insert-file-contents filename 0))) - (set-marker to (+ from length)) + (let* ((from (point)) + (length (woman-insert-file-contents filename 0)) + (to (copy-marker (+ from length) t))) (woman-pre-process-region from to) (set-marker to nil) (goto-char from) @@ -2914,8 +2938,7 @@ map accessory to help construct this alist.") Set NEWTEXT in face FACE if specified." (woman-delete-match 0) (insert-before-markers newtext) - (if face (put-text-property (1- (point)) (point) - 'face 'woman-symbol-face)) + (if face (put-text-property (1- (point)) (point) 'face 'woman-symbol)) t) (defun woman-special-characters (to) @@ -2933,7 +2956,7 @@ Set NEWTEXT in face FACE if specified." ;; Need symbol font: (if woman-use-symbol-font (woman-replace-match (nth 2 replacement) - 'woman-symbol-face)) + 'woman-symbol)) ;; Need extended font: (if woman-use-extended-font (woman-replace-match (nth 2 replacement)))))) @@ -2958,7 +2981,7 @@ Useful for constructing the alist variable `woman-special-characters'." (while (< i 256) (insert (format "\\%03o " i) (string i) " " (string i)) (put-text-property (1- (point)) (point) - 'face 'woman-symbol-face) + 'face 'woman-symbol) (insert " ") (setq i (1+ i)) (when (= i 128) (setq i 160) (insert "\n")) @@ -3226,12 +3249,12 @@ If optional arg CONCAT is non-nil then join arguments." (defconst woman-font-alist '(("R" . default) - ("I" . woman-italic-face) - ("B" . woman-bold-face) + ("I" . woman-italic) + ("B" . woman-bold) ("P" . previous) ("1" . default) - ("2" . woman-italic-face) - ("3" . woman-bold-face) ; used in bash.1 + ("2" . woman-italic) + ("3" . woman-bold) ; used in bash.1 ) "Alist of ?roff font indicators and woman font variables and names.") @@ -3279,9 +3302,9 @@ If optional arg CONCAT is non-nil then join arguments." (WoMan-warn "Unknown font %s." fontstring) ;; Output this message once only per call ... (setq font-alist - (cons (cons fontstring 'woman-unknown-face) + (cons (cons fontstring 'woman-unknown) font-alist)) - 'woman-unknown-face) + 'woman-unknown) ))) ;; Delete font control line or escape sequence: (cond (beg (delete-region beg (point)) @@ -3420,9 +3443,7 @@ Also bound locally in `woman2-roff-buffer'.") (defsubst woman2-process-escapes-to-eol (&optional numeric) "Process remaining escape sequences up to eol. Handle numeric arguments specially if optional argument NUMERIC is non-nil." - (woman2-process-escapes - (save-excursion (end-of-line) (point-marker)) - numeric)) + (woman2-process-escapes (copy-marker (line-end-position) t) numeric)) (defun woman2-nr (to) ".nr R +/-N M -- Assign +/-N (wrt to previous value, if any) to register R. @@ -3623,6 +3644,7 @@ expression in parentheses. Leaves point after the value." (woman-registers woman-registers) fn request translations tab-stop-list) + (set-marker-insertion-type to t) ;; ?roff does not squeeze multiple spaces, but does fill, so... (fset 'canonically-space-region 'ignore) ;; Try to avoid spaces inheriting underlines from preceding text! @@ -3665,7 +3687,8 @@ expression in parentheses. Leaves point after the value." ;; Call the appropriate function: (funcall fn to))) (if (not (eobp)) ; This should not happen, but ... - (woman2-format-paragraphs (point-max-marker) woman-left-margin)) + (woman2-format-paragraphs (copy-marker (point-max) t) + woman-left-margin)) (fset 'canonically-space-region canonically-space-region) (fset 'set-text-properties set-text-properties) (fset 'insert-and-inherit insert-and-inherit) @@ -3742,7 +3765,7 @@ v alters page foot left; m alters page head center. )) ;; Embolden heading (point is at end of heading): (woman-set-face - (save-excursion (beginning-of-line) (point)) (point) 'woman-bold-face) + (save-excursion (beginning-of-line) (point)) (point) 'woman-bold) (forward-line) (delete-blank-lines) (setq woman-left-margin woman-default-indent) @@ -3762,7 +3785,7 @@ Format paragraphs upto TO. Set prevailing indent to 5." ;; Optionally embolden heading (point is at beginning of heading): (if woman-bold-headings (woman-set-face - (point) (save-excursion (end-of-line) (point)) 'woman-bold-face)) + (point) (save-excursion (end-of-line) (point)) 'woman-bold)) (forward-line) (setq woman-left-margin woman-default-indent woman-nofill nil) ; fill output lines @@ -3877,6 +3900,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))) ;; The first two cases below could be merged (maybe)! (let ((from (point))) ;; Discard zero width filler character used to hide leading dots @@ -3946,15 +3970,13 @@ Optional argument NUMERIC, if non-nil, means the argument is numeric." (delete-char -1) (delete-char 1) (looking-at "\\(.\\)\\(.*\\)\\1") - (let ((to (make-marker)) from N c) - (set-marker to (match-end 2)) - (delete-char 1) - (setq from (point) - N (woman-parse-numeric-arg)) - (setq c (if (< (point) to) (following-char) ?_)) + (forward-char 1) + (let* ((to (match-end 2)) + (from (match-beginning 0)) + (N (woman-parse-numeric-arg)) + (c (if (< (point) to) (following-char) ?_))) (delete-region from to) (delete-char 1) - (set-marker to nil) (insert (make-string N c)) )) @@ -4099,7 +4121,11 @@ If `woman-nofill' is non-nil then indent without filling or adjusting." (eolp) (skip-syntax-forward " ") (setq woman-leave-blank-lines 1)) - (beginning-of-line) + ;; This shouldn't happen, but in case it does (e.g. for + ;; badly-formatted manfiles with no terminating newline), + ;; avoid an infinite loop. + (unless (and (eolp) (eobp)) + (beginning-of-line)) ;; If a single short line then just leave it. ;; This is necessary to preserve some table layouts. ;; PROBABLY NOT NECESSARY WITH SQUEEZE MODIFICATION !!!!!