;;; man.el --- browse UNIX manual pages -*- coding: iso-8859-1 -*-
-;; Copyright (C) 1993-1994, 1996-1997, 2001-2012
-;; Free Software Foundation, Inc.
+;; Copyright (C) 1993-1994, 1996-1997, 2001-2013 Free Software
+;; Foundation, Inc.
;; Author: Barry A. Warsaw <bwarsaw@cen.com>
;; Maintainer: FSF
\f
;;; Code:
-(eval-when-compile (require 'cl))
+(require 'ansi-color)
(require 'button)
-;; vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv
-;; empty defvars (keep the compiler quiet)
-
(defgroup man nil
"Browse UNIX manual pages."
:prefix "Man-"
:group 'help)
(defvar Man-notify)
+
(defcustom Man-filter-list nil
"Manpage cleaning filter command phrases.
This variable contains a list of the following form:
(defvar Man-sed-script nil
"Script for sed to nuke backspaces and ANSI codes from manpages.")
-;; vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv
-;; user variables
-
(defcustom Man-fontify-manpage-flag t
"Non-nil means make up the manpage with fonts."
:type 'boolean
:group 'man)
-(defcustom Man-overstrike-face 'bold
+(defface Man-overstrike
+ '((t (:inherit bold)))
"Face to use when fontifying overstrike."
- :type 'face
- :group 'man)
+ :group 'man
+ :version "24.3")
-(defcustom Man-underline-face 'underline
+(defface Man-underline
+ '((t (:inherit underline)))
"Face to use when fontifying underlining."
- :type 'face
- :group 'man)
+ :group 'man
+ :version "24.3")
-(defcustom Man-reverse-face 'highlight
+(defface Man-reverse
+ '((t (:inherit highlight)))
"Face to use when fontifying reverse video."
- :type 'face
- :group 'man)
+ :group 'man
+ :version "24.3")
+
+(defvar Man-ansi-color-map (let ((ansi-color-faces-vector
+ [ default Man-overstrike default Man-underline
+ Man-underline default default Man-reverse ]))
+ (ansi-color-make-color-map))
+ "The value used here for `ansi-color-map'.")
;; Use the value of the obsolete user option Man-notify, if set.
(defcustom Man-notify-method (if (boundp 'Man-notify) Man-notify 'friendly)
:version "24.1"
:type 'string :group 'bookmark)
-(defvar manual-program "man"
- "The name of the program that produces man pages.")
+(defcustom manual-program "man"
+ "Program used by `man' to produce man pages."
+ :type 'string
+ :group 'man)
-(defvar Man-untabify-command "pr"
- "Command used for untabifying.")
+(defcustom Man-untabify-command "pr"
+ "Program used by `man' for untabifying."
+ :type 'string
+ :group 'man)
-(defvar Man-untabify-command-args (list "-t" "-e")
- "List of arguments to be passed to `Man-untabify-command' (which see).")
+(defcustom Man-untabify-command-args (list "-t" "-e")
+ "List of arguments to be passed to `Man-untabify-command' (which see)."
+ :type '(repeat string)
+ :group 'man)
-(defvar Man-sed-command "sed"
- "Command used for processing sed scripts.")
+(defcustom Man-sed-command "sed"
+ "Program used by `man' to process sed scripts."
+ :type 'string
+ :group 'man)
-(defvar Man-awk-command "awk"
- "Command used for processing awk scripts.")
+(defcustom Man-awk-command "awk"
+ "Program used by `man' to process awk scripts."
+ :type 'string
+ :group 'man)
-(defvar Man-mode-hook nil
- "Hook run when Man mode is enabled.")
+(defcustom Man-mode-hook nil
+ "Hook run when Man mode is enabled."
+ :type 'hook
+ :group 'man)
-(defvar Man-cooked-hook nil
- "Hook run after removing backspaces but before `Man-mode' processing.")
+(defcustom Man-cooked-hook nil
+ "Hook run after removing backspaces but before `Man-mode' processing."
+ :type 'hook
+ :group 'man)
(defvar Man-name-regexp "[-a-zA-Z0-9_+][-a-zA-Z0-9_.:+]*"
"Regular expression describing the name of a manpage (without section).")
(concat "\\(" Man-name-regexp "\\)\\((\\(" Man-section-regexp "\\))\\)?")
"Regular expression describing a reference in the SEE ALSO section.")
-(defvar Man-switches ""
+(defcustom Man-switches ""
"Switches passed to the man command, as a single string.
-
-If you want to be able to see all the manpages for a subject you type,
-make -a one of the switches, if your `man' program supports it.")
+For example, the -a switch lets you see all the manpages for a
+specified subject, if your `man' program supports it."
+ :type 'string
+ :group 'man)
(defvar Man-specified-section-option
(if (string-match "-solaris[0-9.]*$" system-configuration)
Otherwise, the value is whatever the function
`Man-support-local-filenames' should return.")
-;; ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
-;; end user variables
\f
;; other variables and keymap initializations
(defvar Man-original-frame)
(list (let* ((default-entry (Man-default-man-entry))
;; ignore case because that's friendly for bizarre
;; caps things like the X11 function names and because
- ;; "man" itself is case-sensitive on the command line
+ ;; "man" itself is case-insensitive on the command line
;; so you're accustomed not to bother about the case
;; ("man -k" is case-insensitive similarly, so the
;; table has everything available to complete)
Man-width)
(Man-width (frame-width))
((window-width))))))
- (setenv "GROFF_NO_SGR" "1")
;; Since man-db 2.4.3-1, man writes plain text with no escape
;; sequences when stdout is not a tty. In 2.5.0, the following
;; env-var was added to allow control of this (see Debian Bug#340673).
See the variable `Man-notify-method' for the different notification behaviors."
(let ((saved-frame (with-current-buffer man-buffer
Man-original-frame)))
- (case Man-notify-method
- (newframe
- ;; Since we run asynchronously, perhaps while Emacs is waiting
- ;; for input, we must not leave a different buffer current. We
- ;; can't rely on the editor command loop to reselect the
- ;; selected window's buffer.
- (save-excursion
- (let ((frame (make-frame Man-frame-parameters)))
- (set-window-buffer (frame-selected-window frame) man-buffer)
- (set-window-dedicated-p (frame-selected-window frame) t)
- (or (display-multi-frame-p frame)
- (select-frame frame)))))
- (pushy
- (switch-to-buffer man-buffer))
- (bully
- (and (frame-live-p saved-frame)
- (select-frame saved-frame))
- (pop-to-buffer man-buffer)
- (delete-other-windows))
- (aggressive
- (and (frame-live-p saved-frame)
- (select-frame saved-frame))
- (pop-to-buffer man-buffer))
- (friendly
- (and (frame-live-p saved-frame)
- (select-frame saved-frame))
- (display-buffer man-buffer 'not-this-window))
- (polite
- (beep)
- (message "Manual buffer %s is ready" (buffer-name man-buffer)))
- (quiet
- (message "Manual buffer %s is ready" (buffer-name man-buffer)))
- (t ;; meek
- (message ""))
- )))
+ (pcase Man-notify-method
+ (`newframe
+ ;; Since we run asynchronously, perhaps while Emacs is waiting
+ ;; for input, we must not leave a different buffer current. We
+ ;; can't rely on the editor command loop to reselect the
+ ;; selected window's buffer.
+ (save-excursion
+ (let ((frame (make-frame Man-frame-parameters)))
+ (set-window-buffer (frame-selected-window frame) man-buffer)
+ (set-window-dedicated-p (frame-selected-window frame) t)
+ (or (display-multi-frame-p frame)
+ (select-frame frame)))))
+ (`pushy
+ (switch-to-buffer man-buffer))
+ (`bully
+ (and (frame-live-p saved-frame)
+ (select-frame saved-frame))
+ (pop-to-buffer man-buffer)
+ (delete-other-windows))
+ (`aggressive
+ (and (frame-live-p saved-frame)
+ (select-frame saved-frame))
+ (pop-to-buffer man-buffer))
+ (`friendly
+ (and (frame-live-p saved-frame)
+ (select-frame saved-frame))
+ (display-buffer man-buffer 'not-this-window))
+ (`polite
+ (beep)
+ (message "Manual buffer %s is ready" (buffer-name man-buffer)))
+ (`quiet
+ (message "Manual buffer %s is ready" (buffer-name man-buffer)))
+ (_ ;; meek
+ (message ""))
+ )))
(defun Man-softhyphen-to-minus ()
;; \255 is SOFT HYPHEN in Latin-N. Versions of Debian man, at
(message "Please wait: formatting the %s man page..." Man-arguments)
(goto-char (point-min))
;; Fontify ANSI escapes.
- (let ((faces nil)
- (buffer-undo-list t)
- (start (point)))
- ;; http://www.isthe.com/chongo/tech/comp/ansi_escapes.html
- ;; suggests many codes, but we only handle:
- ;; ESC [ 00 m reset to normal display
- ;; ESC [ 01 m bold
- ;; ESC [ 04 m underline
- ;; ESC [ 07 m reverse-video
- ;; ESC [ 22 m no-bold
- ;; ESC [ 24 m no-underline
- ;; ESC [ 27 m no-reverse-video
- (while (re-search-forward "\e\\[0?\\([1470]\\|2\\([247]\\)\\)m" nil t)
- (if faces (put-text-property start (match-beginning 0) 'face
- (if (cdr faces) faces (car faces))))
- (setq faces
- (cond
- ((match-beginning 2)
- (delq (case (char-after (match-beginning 2))
- (?2 Man-overstrike-face)
- (?4 Man-underline-face)
- (?7 Man-reverse-face))
- faces))
- ((eq (char-after (match-beginning 1)) ?0) nil)
- (t
- (cons (case (char-after (match-beginning 1))
- (?1 Man-overstrike-face)
- (?4 Man-underline-face)
- (?7 Man-reverse-face))
- faces))))
- (delete-region (match-beginning 0) (match-end 0))
- (setq start (point))))
+ (let ((ansi-color-apply-face-function
+ (lambda (beg end face)
+ (when face
+ (put-text-property beg end 'face face))))
+ (ansi-color-map Man-ansi-color-map))
+ (ansi-color-apply-on-region (point-min) (point-max)))
;; Other highlighting.
(let ((buffer-undo-list t))
(if (< (buffer-size) (position-bytes (point-max)))
(goto-char (point-min))
(while (search-forward "__\b\b" nil t)
(backward-delete-char 4)
- (put-text-property (point) (1+ (point)) 'face Man-underline-face))
+ (put-text-property (point) (1+ (point)) 'face 'Man-underline))
(goto-char (point-min))
(while (search-forward "\b\b__" nil t)
(backward-delete-char 4)
- (put-text-property (1- (point)) (point) 'face Man-underline-face))))
+ (put-text-property (1- (point)) (point) 'face 'Man-underline))))
(goto-char (point-min))
(while (search-forward "_\b" nil t)
(backward-delete-char 2)
- (put-text-property (point) (1+ (point)) 'face Man-underline-face))
+ (put-text-property (point) (1+ (point)) 'face 'Man-underline))
(goto-char (point-min))
(while (search-forward "\b_" nil t)
(backward-delete-char 2)
- (put-text-property (1- (point)) (point) 'face Man-underline-face))
+ (put-text-property (1- (point)) (point) 'face 'Man-underline))
(goto-char (point-min))
(while (re-search-forward "\\(.\\)\\(\b+\\1\\)+" nil t)
(replace-match "\\1")
- (put-text-property (1- (point)) (point) 'face Man-overstrike-face))
+ (put-text-property (1- (point)) (point) 'face 'Man-overstrike))
(goto-char (point-min))
(while (re-search-forward "o\b\\+\\|\\+\bo" nil t)
(replace-match "o")
(put-text-property (1- (point)) (point) 'face 'bold))
;; When the header is longer than the manpage name, groff tries to
;; condense it to a shorter line interspersed with ^H. Remove ^H with
- ;; their preceding chars (but don't put Man-overstrike-face). (Bug#5566)
+ ;; their preceding chars (but don't put Man-overstrike). (Bug#5566)
(goto-char (point-min))
(while (re-search-forward ".\b" nil t) (backward-delete-char 2))
(goto-char (point-min))
(while (re-search-forward Man-heading-regexp nil t)
(put-text-property (match-beginning 0)
(match-end 0)
- 'face Man-overstrike-face)))
+ 'face 'Man-overstrike)))
(message "%s man page formatted" (Man-page-from-arguments Man-arguments)))
(defun Man-highlight-references (&optional xref-man-type)
(while (re-search-forward "[-|]\\(\b[-|]\\)+" nil t) (replace-match "+"))
;; When the header is longer than the manpage name, groff tries to
;; condense it to a shorter line interspersed with ^H. Remove ^H with
- ;; their preceding chars (but don't put Man-overstrike-face). (Bug#5566)
+ ;; their preceding chars (but don't put Man-overstrike). (Bug#5566)
(goto-char (point-min))
(while (re-search-forward ".\b" nil t) (backward-delete-char 2))
(Man-softhyphen-to-minus)