(defgroup reftex): Update home page url-link.
[bpt/emacs.git] / lisp / woman.el
index e5753d7..13fa314 100644 (file)
@@ -1,6 +1,7 @@
 ;;; woman.el --- browse UN*X manual pages `wo (without) man'
 
-;; Copyright (C) 2000, 2002, 2003, 2004, 2005 Free Software Foundation, Inc.
+;; Copyright (C) 2000, 2002, 2003, 2004, 2005,
+;;   2006 Free Software Foundation, Inc.
 
 ;; Author: Francis J. Wright <F.J.Wright@qmul.ac.uk>
 ;; Maintainer: FSF
 ;;   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)))))
 
 
 ;; code fragments, general interest, etc.:
 ;;   Jari Aalto <jari.aalto@cs.tpu.fi>
 ;;   Dean Andrews <dean@dra.com>
-;;   Juanma Barranquero <barranquero@laley-actualidad.es>
+;;   Juanma Barranquero <lekktu@gmail.com>
 ;;   Karl Berry <kb@cs.umb.edu>
 ;;   Jim Chapman <jchapman@netcomuk.co.uk>
 ;;   Kin Cho <kin@neoscale.com>
 (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)
@@ -711,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
@@ -1193,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 +1227,27 @@ Optional argument RE-CACHE, if non-nil, forces the cache to be re-read."
   (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
-              (if default
-                  (format "Manual entry (default `%s'): " default)
-                "Manual entry: ")
-              woman-topic-all-completions nil 1
-              nil
-              'woman-topic-history
-              ;; Default topic.
-              (and woman-topic-at-point
-                   default))))
+             (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!
@@ -1744,7 +1751,18 @@ Leave point at end of new text.  Return length of inserted text."
   (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] '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.
@@ -1870,7 +1888,7 @@ See `Man-mode' for additional details."
   (setq woman-imenu-done nil)
   (if woman-imenu (woman-imenu))
   (let (buffer-read-only)
-    (Man-highlight-references))
+    (Man-highlight-references 'WoMan-xref-man-page))
   (set-buffer-modified-p nil)
   (run-mode-hooks 'woman-mode-hook))
 
@@ -1932,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)
@@ -2450,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))
@@ -2523,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))
@@ -2638,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)
@@ -3425,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.
@@ -3628,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!
@@ -3670,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)
@@ -3882,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
@@ -3951,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))
     ))