1 files changed, 62 insertions, 10 deletions

diff --git a/lisp/man.el b/lisp/man.el
index 0e665af723e..7222c1bad15 100644
--- a/lisp/man.el
+++ b/lisp/man.el
@@ -1,6 +1,6 @@
 ;;; man.el --- browse UNIX manual pages -*- coding: iso-8859-1 -*-
 
-;; Copyright (C) 1993, 1994, 1996, 1997, 2001, 2003 Free Software Foundation, Inc.
+;; Copyright (C) 1993, 1994, 1996, 1997, 2001, 2003, 2004 Free Software Foundation, Inc.
 
 ;; Author: Barry A. Warsaw <bwarsaw@cen.com>
 ;; Maintainer: FSF
@@ -175,6 +175,17 @@ Any other value of `Man-notify-method' is equivalent to `meek'."
                 (const polite) (const quiet) (const meek))
   :group 'man)
 
+(defcustom Man-width nil
+  "*Number of columns for which manual pages should be formatted.
+If nil, the width of the window selected at the moment of man
+invocation is used.  If non-nil, the width of the frame selected
+at the moment of man invocation is used.  The value also can be a
+positive integer."
+  :type '(choice (const :tag "Window width" nil)
+                 (const :tag "Frame width" t)
+                 (integer :tag "Specific width" :value 65))
+  :group 'man)
+
 (defcustom Man-frame-parameters nil
   "*Frame parameter list for creating a new frame for a manual page."
   :type 'sexp
@@ -317,6 +328,12 @@ make -a one of the switches, if your `man' program supports it.")
     "")
   "Option that indicates a specified a manual section name.")
 
+(defvar Man-support-local-filenames 'auto-detect
+  "Internal cache for the value of the function `Man-support-local-filenames'.
+`auto-detect' means the value is not yet determined.
+Otherwise, the value is whatever the function
+`Man-support-local-filenames' should return.")
+
 ;; ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
 ;; end user variables
 
@@ -486,13 +503,15 @@ This is necessary if one wants to dump man.el with Emacs."
 (defsubst Man-build-man-command ()
   "Builds the entire background manpage and cleaning command."
   (let ((command (concat manual-program " " Man-switches
-                         ; Stock MS-DOS shells cannot redirect stderr;
-                         ; `call-process' below sends it to /dev/null,
-                         ; so we don't need `2>' even with DOS shells
-                         ; which do support stderr redirection.
-                         (if (not (fboundp 'start-process))
-                             " %s"
-                           (concat " %s 2>" null-device))))
+                         (cond
+                          ;; Already has %s
+                          ((string-match "%s" manual-program) "")
+                          ;; Stock MS-DOS shells cannot redirect stderr;
+                          ;; `call-process' below sends it to /dev/null,
+                          ;; so we don't need `2>' even with DOS shells
+                          ;; which do support stderr redirection.
+                          ((not (fboundp 'start-process)) " %s")
+                          ((concat " %s 2>" null-device)))))
         (flist Man-filter-list))
     (while (and flist (car flist))
       (let ((pcom (car (car flist)))
@@ -555,6 +574,31 @@ and the Man-section-translations-alist variables)."
                   slist nil))))
       (concat Man-specified-section-option section " " name))))
 
+(defun Man-support-local-filenames ()
+  "Check the availability of `-l' option of the man command.
+This option allows `man' to interpret command line arguments
+as local filenames.
+Return the value of the variable `Man-support-local-filenames'
+if it was set to nil or t before the call of this function.
+If t, the man command supports `-l' option.  If nil, it don't.
+Otherwise, if the value of `Man-support-local-filenames'
+is neither t nor nil, then determine a new value, set it
+to the variable `Man-support-local-filenames' and return
+a new value."
+  (if (or (not Man-support-local-filenames)
+          (eq Man-support-local-filenames t))
+      Man-support-local-filenames
+    (setq Man-support-local-filenames
+          (with-temp-buffer
+            (and (equal (condition-case nil
+                            (call-process manual-program nil t nil "--help")
+                          (error nil))
+                        0)
+                 (progn
+                   (goto-char (point-min))
+                   (search-forward "--local-file" nil t))
+                 t)))))
+
 
 ;; ======================================================================
 ;; default man entry: get word under point
@@ -679,7 +723,12 @@ all sections related to a subject, put something appropriate into the
               ;; This isn't strictly correct, since we don't know how
               ;; the page will actually be displayed, but it seems
               ;; reasonable.
-              (setenv "COLUMNS" (number-to-string (frame-width)))))
+              (setenv "COLUMNS" (number-to-string
+                                 (cond
+                                  ((and (integerp Man-width) (> Man-width 0))
+                                   Man-width)
+                                  (Man-width (frame-width))
+                                  ((window-width)))))))
         (setenv "GROFF_NO_SGR" "1")
         (if (fboundp 'start-process)
             (set-process-sentinel
@@ -757,7 +806,7 @@ See the variable `Man-notify-method' for the different notification behaviors."
   "Convert overstriking and underlining to the correct fonts.
 Same for the ANSI bold and normal escape sequences."
   (interactive)
-  (message "Please wait: making up the %s man page..." Man-arguments)
+  (message "Please wait: formatting the %s man page..." Man-arguments)
   (goto-char (point-min))
   (while (search-forward "\e[1m" nil t)
     (delete-backward-char 4)
@@ -976,6 +1025,9 @@ The following key bindings are currently in effect in the buffer:
   (auto-fill-mode -1)
   (use-local-map Man-mode-map)
   (set-syntax-table man-mode-syntax-table)
+  (setq imenu-generic-expression (list (list nil Man-heading-regexp 0)))
+  (set (make-local-variable 'outline-regexp) Man-heading-regexp)
+  (set (make-local-variable 'outline-level) (lambda () 1))
   (Man-build-page-list)
   (Man-strip-page-headers)
   (Man-unindent)