]> code.delx.au - gnu-emacs/blobdiff - lisp/woman.el
Add a provide statement.
[gnu-emacs] / lisp / woman.el
index c3becb5186e6b90297500aba7469056611c0b52a..610590a297211516d3d9fad5638f85d6338b9fcc 100644 (file)
@@ -1,11 +1,11 @@
 ;;; woman.el --- browse UN*X manual pages `wo (without) man'
 
-;; Copyright (C) 2000, 2002 Free Software Foundation, Inc.
+;; Copyright (C) 2000, 2002, 2004 Free Software Foundation, Inc.
 
 ;; Author: Francis J. Wright <F.J.Wright@qmul.ac.uk>
 ;; Maintainer: Francis J. Wright <F.J.Wright@qmul.ac.uk>
 ;; Keywords: help, unix
-;; Adapted-By: Eli Zaretskii <eliz@is.elta.co.il>
+;; Adapted-By: Eli Zaretskii <eliz@gnu.org>
 ;; Version: see `woman-version'
 ;; URL: http://centaur.maths.qmul.ac.uk/Emacs/WoMan/
 
 ;;   Alexander Hinds <ahinds@thegrid.net>
 ;;   Stefan Hornburg <sth@hacon.de>
 ;;   Theodore Jump <tjump@cais.com>
+;;   David Kastrup <dak@gnu.org>
 ;;   Paul Kinnucan <paulk@mathworks.com>
 ;;   Jonas Linde <jonas@init.se>
 ;;   Andrew McRae <andrewm@optimation.co.nz>
   "Return concatenated list of FN applied to successive `car' elements of X.
 FN must return a list, cons or nil.  Useful for splicing into a list."
   ;; Based on the Standard Lisp function MAPCAN but with args swapped!
-  (and x (nconc (funcall fn (car x)) (woman-mapcan fn (cdr x)))))
+  ;; More concise implementation than the recursive one.  -- dak
+  (apply #'nconc (mapcar fn x)))
 
 (defun woman-parse-colon-path (paths)
   "Explode search path string PATHS into a list of directory names.
@@ -539,9 +541,9 @@ Change only via `Customization' or the function `add-hook'."
        (mapcar 'woman-Cyg-to-Win path)
       path))
   "*List of dirs to search and/or files to try for man config file.
-A trailing separator (`/' for UNIX etc.) on directories is optional
-and the filename used if a directory is specified is the first to
-match the regexp \"man.*\\.conf\".
+A trailing separator (`/' for UNIX etc.) on directories is optional,
+and the filename is used if a directory specified is the first to
+contain the strings \"man\" and \".conf\" (in that order).
 If MANPATH is not set but a config file is found then it is parsed
 instead to provide a default value for `woman-manpath'."
   :type '(repeat string)
@@ -554,7 +556,9 @@ Look in `woman-man.conf-path' and return a value for `woman-manpath'.
 Concatenate data from all lines in the config file of the form
   MANPATH  /usr/man
 or
-  MANDATORY_MANPATH  /usr/man"
+  MANDATORY_MANPATH  /usr/man
+or
+  OPTIONAL_MANPATH  /usr/man"
   ;; Functionality suggested by Charles Curley.
   (let ((path woman-man.conf-path)
        file manpath)
@@ -574,7 +578,7 @@ or
                    (while (re-search-forward
                            ;; `\(?: ... \)' is a "shy group"
                            "\
-^[ \t]*\\(?:MANDATORY_\\)?MANPATH[ \t]+\\(\\S-+\\)" nil t)
+^[ \t]*\\(?:MANDATORY_\\|OPTIONAL_\\)?MANPATH[ \t]+\\(\\S-+\\)" nil t)
                      (setq manpath (cons (match-string 1) manpath)))
                    manpath))
                 ))
@@ -807,7 +811,7 @@ Only useful when run on a graphic display such as X or MS-Windows."
 
 (defcustom woman-fill-frame nil
   ;; Based loosely on a suggestion by Theodore Jump:
-  "*If non-nil then most of the frame width is used."
+  "*If non-nil then most of the window width is used."
   :type 'boolean
   :group 'woman-formatting)
 
@@ -830,10 +834,15 @@ the buffer, which may aid debugging."
   :type 'boolean
   :group 'woman-formatting)
 
-(defcustom woman-preserve-ascii nil
-  "*If non-nil then preserve ASCII characters in the WoMan buffer.
-Otherwise, non-ASCII characters (that display as ASCII) may remain.
-This is irrelevant unless the buffer is to be saved to a file."
+(defcustom woman-preserve-ascii t
+  "*If non-nil, preserve ASCII characters in the WoMan buffer.
+Otherwise, to save time, some backslashes and spaces may be
+represented differently (as the values of the variables
+`woman-escaped-escape-char' and `woman-unpadded-space-char'
+respectively) so that the buffer content is strictly wrong even though
+it should display correctly.  This should be irrelevant unless the
+buffer text is searched, copied or saved to a file."
+  ;; This option should probably be removed!
   :type 'boolean
   :group 'woman-formatting)
 
@@ -1058,13 +1067,6 @@ The ordinal numbers start from 0.")
 Should include ?e, ?o (page even/odd) and either ?n (nroff) or ?t (troff).
 Default is '(?n ?e ?o).  Set via `woman-emulation'.")
 
-\f
-;;; Button types:
-
-(define-button-type 'woman-xref
-  'action (lambda (button) (woman (button-label button)))
-  'help-echo "RET, mouse-2: display this man page")
-
 \f
 ;;; Specialized utility functions:
 
@@ -1130,7 +1132,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)
@@ -1228,7 +1230,7 @@ Optional argument RE-CACHE, if non-nil, forces the cache to be re-read."
                   ;; Was let-bound when file loaded, so ...
                   (setq woman-topic-at-point woman-topic-at-point-default)))
             (setq topic
-                  (current-word t))    ; only within or adjacent to word
+                  (or (current-word t) ""))    ; only within or adjacent to word
             (assoc topic woman-topic-all-completions))
        (setq topic
              (completing-read
@@ -1237,7 +1239,7 @@ Optional argument RE-CACHE, if non-nil, forces the cache to be re-read."
               ;; Initial input suggestion (was nil), with
               ;; cursor at left ready to kill suggestion!:
               (and woman-topic-at-point
-                   (cons (current-word) 0)) ; nearest word
+                   (cons (or (current-word) "") 0)) ; nearest word
               'woman-topic-history)))
     ;; Note that completing-read always returns a string.
     (if (= (length topic) 0)
@@ -1367,15 +1369,16 @@ The cdr of each alist element is the path-index / filename."
   ;; is re-processed by `woman-topic-all-completions-merge'.
   (let (dir files (path-index 0))      ; indexing starts at zero
     (while path
-      (setq dir (car path)
-           path (cdr path))
+      (setq dir (pop path))
       (if (woman-not-member dir path)  ; use each directory only once!
-         (setq files
-               (nconc files
-                      (woman-topic-all-completions-1 dir path-index))))
+         (push (woman-topic-all-completions-1 dir path-index)
+               files))
       (setq path-index (1+ path-index)))
     ;; Uniquefy topics:
-    (woman-topic-all-completions-merge files)))
+    ;; Concate all lists with a single nconc call to
+    ;; avoid retraversing the first lists repeatedly  -- dak
+    (woman-topic-all-completions-merge
+     (apply #'nconc files))))
 
 (defun woman-topic-all-completions-1 (dir path-index)
   "Return an alist of the man topics in directory DIR with index PATH-INDEX.
@@ -1388,55 +1391,54 @@ of the first `woman-cache-level' elements from the following list:
   ;; unnecessary.  So let us assume that `woman-file-regexp' will
   ;; filter out any directories, which probably should not be there
   ;; anyway, i.e. it is a user error!
-  (mapcar
-   (lambda (file)
-     (cons
-      (file-name-sans-extension
-       (if (string-match woman-file-compression-regexp file)
-          (file-name-sans-extension file)
-        file))
-      (if (> woman-cache-level 1)
-         (cons
-          path-index
-          (if (> woman-cache-level 2)
-              (cons file nil))))))
-   (directory-files dir nil woman-file-regexp)))
+  ;;
+  ;; Don't sort files: we do that when merging, anyway.  -- dak
+  (let (newlst (lst (directory-files dir nil woman-file-regexp t))
+              ;; Make an explicit regexp for stripping extension and
+              ;; compression extension: file-name-sans-extension is a
+              ;; far too costly function.  -- dak
+              (ext (format "\\(\\.[^.\\/]*\\)?\\(%s\\)?\\'"
+                           woman-file-compression-regexp)))
+    ;; Use a loop instead of mapcar in order to avoid the speed
+    ;; penalty of binding function arguments.  -- dak
+      (dolist (file lst newlst)
+       (push
+        (cons
+         (if (string-match ext file)
+             (substring file 0 (match-beginning 0))
+           file)
+         (and (> woman-cache-level 1)
+              (cons
+               path-index
+               (and (> woman-cache-level 2)
+                    (list file)))))
+        newlst))))
 
 (defun woman-topic-all-completions-merge (alist)
   "Merge the alist ALIST so that the keys are unique.
 Also make each path-info component into a list.
 \(Note that this function changes the value of ALIST.)"
-  ;; Intended to be fast by avoiding recursion and list copying.
-  (if (> woman-cache-level 1)
-      (let ((newalist alist))
-       (while newalist
-         (let ((tail newalist) (topic (car (car newalist))))
-           ;; Make the path-info into a list:
-           (setcdr (car newalist) (list (cdr (car newalist))))
-           (while tail
-             (while (and tail (not (string= topic (car (car (cdr tail))))))
-               (setq tail (cdr tail)))
-             (if tail                  ; merge path-info into (car newalist)
-                 (let ((path-info (cdr (car (cdr tail)))))
-                   (if (member path-info (cdr (car newalist)))
-                       ()
-                     ;; Make the path-info into a list:
-                     (nconc (car newalist) (list path-info)))
-                   (setcdr tail (cdr (cdr tail))))
-               ))
-           (setq newalist (cdr newalist))))
-       alist)
+  ;; Replaces unreadably "optimized" O(n^2) implementation.
+  ;; Instead we use sorting to merge stuff efficiently.  -- dak
+  (let (elt newalist)
+    ;; Sort list into reverse order
+    (setq alist (sort alist (lambda(x y) (string< (car y) (car x)))))
+    ;; merge duplicate keys.
+    (if (> woman-cache-level 1)
+       (while alist
+         (setq elt (pop alist))
+         (if (equal (car elt) (caar newalist))
+             (unless (member (cdr elt) (cdar newalist))
+               (setcdr (car newalist) (cons (cdr elt)
+                                            (cdar newalist))))
+           (setcdr elt (list (cdr elt)))
+           (push elt newalist)))
     ;; woman-cache-level = 1 => elements are single-element lists ...
-    (while (and alist (member (car alist) (cdr alist)))
-      (setq alist (cdr alist)))
-    (if alist
-       (let ((newalist alist) cdr_alist)
-         (while (setq cdr_alist (cdr alist))
-           (if (not (member (car cdr_alist) (cdr cdr_alist)))
-               (setq alist cdr_alist)
-             (setcdr alist (cdr cdr_alist)))
-           )
-         newalist))))
+      (while alist
+       (setq elt (pop alist))
+       (unless (equal (car elt) (caar newalist))
+         (push elt newalist))))
+    newalist))
 
 (defun woman-file-name-all-completions (topic)
   "Return an alist of the files in all man directories that match TOPIC."
@@ -1751,7 +1753,7 @@ Leave point at end of new text.  Return length of inserted text."
 Argument EVENT is the invoking mouse event."
   (interactive "e")                    ; mouse event
   (goto-char (posn-point (event-start event)))
-  (woman (current-word t)))
+  (woman (or (current-word t) "")))
 
 ;; WoMan menu bar and pop-up menu:
 (easy-menu-define
@@ -1869,7 +1871,7 @@ See `Man-mode' for additional details."
     (setq woman-imenu-done nil)
     (if woman-imenu (woman-imenu))
     (setq buffer-read-only nil)
-    (WoMan-highlight-references)
+    (Man-highlight-references)
     (setq buffer-read-only t)
     (set-buffer-modified-p nil)))
 
@@ -1964,21 +1966,6 @@ Otherwise use Man and record start of formatting time."
                  (- (cadr time) (cadr WoMan-Man-start-time)))))
     (message "Man formatting done in %d seconds" time)))
 
-(defun WoMan-highlight-references ()
-  "Highlight the references (in the SEE ALSO section) on mouse-over."
-  ;; Based on `Man-build-references-alist' in `man'.
-  (when (Man-find-section Man-see-also-regexp)
-    (forward-line 1)
-    (let ((end (save-excursion
-                (Man-next-section 1)
-                (point))))
-      (back-to-indentation)
-      (while (re-search-forward Man-reference-regexp end t)
-       ;; Highlight reference when mouse is over it.
-       ;; (NB: WoMan does not hyphenate!)
-       (make-text-button (match-beginning 1) (match-end 1)
-                         'type 'woman-xref)))))
-
 \f
 ;;; Buffer handling:
 
@@ -2226,7 +2213,7 @@ Currently set only from '\" t in the first line of the source file.")
     ;; Based loosely on a suggestion by Theodore Jump:
     (if (or woman-fill-frame
            (not (and (integerp woman-fill-column) (> woman-fill-column 0))))
-       (setq woman-fill-column (- (frame-width) woman-default-indent)))
+       (setq woman-fill-column (- (window-width) woman-default-indent)))
 
     ;; Check for preprocessor requests:
     (goto-char from)
@@ -3254,7 +3241,7 @@ If optional arg CONCAT is non-nil then join arguments."
   ;; Paragraph .LP/PP/HP/IP/TP and font .B/.BI etc. macros reset font.
   ;; Should .SH/.SS reset font?
   ;; Font size setting macros (?) should reset font.
-  (let ((woman-font-alist woman-font-alist) ; for local updating
+  (let ((font-alist woman-font-alist) ; for local updating
        (previous-pos (point))
        (previous-font 'default)
        (current-font 'default))
@@ -3285,15 +3272,15 @@ If optional arg CONCAT is non-nil then join arguments."
          ;; Get font name:
          (or font
              (let ((fontstring (match-string 0)))
-               (setq font (assoc fontstring woman-font-alist)
-                     ;; NB: woman-font-alist contains VARIABLE NAMES.
+               (setq font (assoc fontstring font-alist)
+                     ;; NB: font-alist contains VARIABLE NAMES.
                      font (if font
                               (cdr font)
                             (WoMan-warn "Unknown font %s." fontstring)
                             ;; Output this message once only per call ...
-                            (setq woman-font-alist
+                            (setq font-alist
                                   (cons (cons fontstring 'woman-unknown-face)
-                                        woman-font-alist))
+                                        font-alist))
                             'woman-unknown-face)
                      )))
          ;; Delete font control line or escape sequence:
@@ -4548,4 +4535,5 @@ logging the message."
 
 (provide 'woman)
 
+;;; arch-tag: eea35e90-552f-4712-a94b-d9ffd3db7651
 ;;; woman.el ends here