emacs: lisp/man.el comparison

comparison lisp/man.el @ 54515:9172c9ef1dcf

(Man-width): New var. (Man-getpage-in-background): Use it. (Man-support-local-filenames): New var and fun. (Man-build-man-command): Don't add a second %s. (Man-fontify-manpage): Clean up message. (Man-mode): Set outline-regexp, outline-level, imenu-generic-expression.

author	Juri Linkov <juri@jurta.org>
date	Tue, 23 Mar 2004 07:33:39 +0000
parents	230edeac0da5
children	4729059e27b8

comparison

equal deleted inserted replaced

-:4f9a38a6854c
+:9172c9ef1dcf
 ;;; 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
 ;; Keywords: help
 ;; Adapted-By: ESR, pot
 :type '(radio (const newframe) (const pushy) (const bully)
 		(const aggressive) (const friendly)
 		(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
 :group 'man)
 (defvar Man-specified-section-option
 (if (string-match "-solaris[0-9.]*$" system-configuration)
 "-s"
 "")
 "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
 ;; other variables and keymap initializations
 	  (length Man-page-list)))
 (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;
+(cond
-			 ; `call-process' below sends it to /dev/null,
+;; Already has %s
-			 ; so we don't need `2>' even with DOS shells
+((string-match "%s" manual-program) "")
-			 ; which do support stderr redirection.
+;; Stock MS-DOS shells cannot redirect stderr;
-			 (if (not (fboundp 'start-process))
+;; `call-process' below sends it to /dev/null,
-			     " %s"
+;; so we don't need `2>' even with DOS shells
-			   (concat " %s 2>" null-device))))
+;; 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)))
 	    (pargs (cdr (car flist))))
 	(setq command
 	    (setq section (if Man-downcase-section-letters-flag
 			      (downcase s2)
 			    s2)
 		  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
 	(if window-system
 	    (unless (or (getenv "MANWIDTH") (getenv "COLUMNS"))
 	      ;; 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
 	     (start-process manual-program buffer "sh" "-c"
 			    (format (Man-build-man-command) man-args))
 (defun Man-fontify-manpage ()
 "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)
 (put-text-property (point)
 		       (progn (if (search-forward "\e[0m" nil 'move)
 	buffer-read-only t)
 (buffer-disable-undo (current-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)
 (Man-goto-page 1)
 (run-hooks 'Man-mode-hook))

Mercurial > emacs

comparison lisp/man.el @ 54515:9172c9ef1dcf