Use line-end-position rather than end-of-line, etc.
[bpt/emacs.git] / lisp / woman.el
index 291ebce..2511341 100644 (file)
@@ -7,7 +7,7 @@
 ;; Maintainer: FSF
 ;; Keywords: help, unix
 ;; Adapted-By: Eli Zaretskii <eliz@gnu.org>
-;; Version: see `woman-version'
+;; Version: 0.551
 ;; URL: http://centaur.maths.qmul.ac.uk/Emacs/WoMan/
 
 ;; This file is part of GNU Emacs.
@@ -810,7 +810,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,16 +846,17 @@ 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)
@@ -1507,7 +1508,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
@@ -2474,23 +2475,23 @@ 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))
        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))
+      (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
@@ -2521,6 +2522,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'.
@@ -2572,6 +2574,7 @@ REQUEST is the invoking directive without the leading dot."
        (woman-if-ignore woman0-if-to request) ; ERROR!
       (woman-if-body request woman0-if-to (eq c negated)))))
 
+;; request is not used dynamically by any callees.
 (defun woman-if-body (request to delete) ; should be reversed as `accept'?
   "Process if-body, including \\{ ... \\}.
 REQUEST is the invoking directive without the leading dot.
@@ -2628,6 +2631,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!")
@@ -2759,15 +2763,17 @@ Optional argument APPEND, if non-nil, means append macro."
   (beginning-of-line)                  ; delete .de/am line
   (woman-delete-line 1))
 
-(defun woman0-macro (request)
-  "Process the macro call named REQUEST."
+;; request may be used dynamically (woman-interpolate-macro calls
+;; woman-forward-arg).
+(defun woman0-macro (woman-request)
+  "Process the macro call named WOMAN-REQUEST."
   ;; Leaves point at start of new text.
-  (let ((macro (assoc request woman0-macro-alist)))
+  (let ((macro (assoc woman-request woman0-macro-alist)))
     (if macro
        (woman-interpolate-macro (cdr macro))
       ;; SHOULD DELETE THE UNINTERPRETED REQUEST!!!!!
       ;; Output this message once only per call (cf. strings)?
-      (WoMan-warn "Undefined macro %s not interpolated!" request))))
+      (WoMan-warn "Undefined macro %s not interpolated!" woman-request))))
 
 (defun woman-interpolate-macro (macro)
   "Interpolate (.de) or append (.am) expansion of MACRO into the buffer."
@@ -2984,8 +2990,10 @@ Useful for constructing the alist variable `woman-special-characters'."
 \f
 ;;; 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.
@@ -3000,7 +3008,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."
@@ -3009,7 +3017,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)
@@ -3017,14 +3025,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) '(?. ?'))
@@ -3033,7 +3041,7 @@ Leave point at TO (which should be a marker)."
          ;; Call the appropriate function:
          (funcall fn)
          ;; Hide leading control character in quoted argument (only):
-         (if (and unquote (memq (following-char) '(?. ?')))
+         (if (and woman1-unquote (memq (following-char) '(?. ?')))
              (insert "\\&"))))))))
 
 ;;; Font-changing macros:
@@ -3046,6 +3054,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."
@@ -3054,7 +3064,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)
@@ -3101,11 +3111,12 @@ B-OR-I is the appropriate complete control line."
   ;; Return to start of first arg to hide leading control char:
   (save-excursion
     (setq fonts (cdr fonts))
-    (woman-forward-arg unquote 'concat)        ; unquote is bound above
+    ;; woman1-unquote is bound in woman1-roff-buffer.
+    (woman-forward-arg woman1-unquote 'concat)
     (while (not (eolp))
       (insert (car fonts))
       (setq fonts (cdr fonts))
-      (woman-forward-arg unquote 'concat)) ; unquote is bound above
+      (woman-forward-arg woman1-unquote 'concat))
     (insert "\\fR")))
 
 (defun woman-forward-arg (&optional unquote concat)
@@ -3122,7 +3133,7 @@ If optional arg CONCAT is non-nil then join arguments."
          (re-search-forward "\"\\|$"))
        (if (eq (preceding-char) ?\")
            (if unquote (delete-char -1))
-         (WoMan-warn "Unpaired \" in .%s arguments." request)))
+         (WoMan-warn "Unpaired \" in .%s arguments." woman-request)))
     ;; (re-search-forward "[^\\\n] \\|$")      ; inconsistent
     (skip-syntax-forward "^ "))
   (cond ((null concat) (skip-chars-forward " \t")) ; don't skip eol!
@@ -3337,7 +3348,12 @@ Ignore the default face and underline only word characters."
 \f
 ;;; Output translation:
 
-(defvar translations nil)  ; Also bound locally by woman2-roff-buffer
+;; This is only set by woman2-tr.  It is bound locally in woman2-roff-buffer.
+;; It is also used by woman-translate.  woman-translate may be called
+;; outside the scope of woman2-roff-buffer (by experiment).  Therefore
+;; this used to be globally bound to nil, to avoid an error.  Instead
+;; we can use bound-and-true-p in woman-translate.
+(defvar woman-translations)
 ;; A list of the form (\"[ace]\" (a . b) (c . d) (e . ?\ )) or nil.
 
 (defun woman-get-next-char ()
@@ -3357,8 +3373,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
@@ -3380,15 +3396,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)))
 
 (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:
@@ -3524,8 +3543,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
     ))
@@ -3594,7 +3613,7 @@ expression in parentheses.  Leaves point after the value."
            (WoMan-warn "Numeric/register argument error: %s"
                        (buffer-substring
                         (point)
-                        (save-excursion (end-of-line) (point))))
+                        (line-end-position)))
            (skip-syntax-forward "^ ")
            0)
        (goto-char (match-end 0))
@@ -3629,7 +3648,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...
@@ -3645,13 +3664,13 @@ expression in parentheses.  Leaves point after the value."
            ;; Construct woman function to call:
            ((setq fn (intern-soft
                       (concat "woman2-"
-                              (setq request (match-string 1)))))
+                              (setq woman-request (match-string 1)))))
             ;; Delete request or macro name:
             (woman-delete-match 0))
            ;; Unrecognised request:
            ((prog1 nil
-              ;; (WoMan-warn ".%s request ignored!" request)
-              (WoMan-warn-ignored request "ignored!")
+              ;; (WoMan-warn ".%s request ignored!" woman-request)
+              (WoMan-warn-ignored woman-request "ignored!")
               ;; (setq fn 'woman2-LP)
               ;; AVOID LEAVING A BLANK LINE!
               ;; (setq fn 'woman2-format-paragraphs)
@@ -3744,8 +3763,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)
@@ -3764,8 +3782,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
@@ -4357,7 +4374,7 @@ tab stop columns or pairs (COLUMN . TYPE) where TYPE is R or C."
               eol n)
          (if type
              (setq tab (woman-get-tab-stop tab)
-                   eol (save-excursion (end-of-line) (point))
+                   eol (line-end-position)
                    n (save-excursion
                        (search-forward "\t" eol t))
                    n (- (if n (1- n) eol) (point))
@@ -4482,12 +4499,13 @@ Format paragraphs upto TO."
   (setq format (apply 'format format args))
   (WoMan-log-1 (concat "**  " format)))
 
+;; request is not used dynamically by any callees.
 (defun WoMan-warn-ignored (request ignored)
   "Log a warning message about ignored directive REQUEST.
 IGNORED is a string appended to the log message."
   (let ((tail
         (buffer-substring (point)
-                          (save-excursion (end-of-line) (point)))))
+                          (line-end-position))))
     (if (and (> (length tail) 0)
             (/= (string-to-char tail) ?\ ))
        (setq tail (concat " " tail)))
@@ -4553,5 +4571,4 @@ logging the message."
 
 (provide 'woman)
 
-;; arch-tag: eea35e90-552f-4712-a94b-d9ffd3db7651
 ;;; woman.el ends here