X-Git-Url: http://git.hcoop.net/bpt/emacs.git/blobdiff_plain/debe92052c1c5451982e618e6c7057420a5a7f67..ca0ebeccbbcbaa1877f8ca8cf131598f013e4f0a:/lisp/man.el diff --git a/lisp/man.el b/lisp/man.el index 48639cd764..9c2fa952fd 100644 --- a/lisp/man.el +++ b/lisp/man.el @@ -1,7 +1,7 @@ ;;; man.el --- browse UNIX manual pages -*- coding: iso-8859-1 -*- ;; Copyright (C) 1993, 1994, 1996, 1997, 2001, 2002, 2003, -;; 2004, 2005, 2006, 2007 Free Software Foundation, Inc. +;; 2004, 2005, 2006, 2007, 2008, 2009 Free Software Foundation, Inc. ;; Author: Barry A. Warsaw ;; Maintainer: FSF @@ -10,10 +10,10 @@ ;; This file is part of GNU Emacs. -;; GNU Emacs is free software; you can redistribute it and/or modify +;; GNU Emacs is free software: you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation; either version 3, or (at your option) -;; any later version. +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. ;; GNU Emacs is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of @@ -21,9 +21,7 @@ ;; GNU General Public License for more details. ;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, -;; Boston, MA 02110-1301, USA. +;; along with GNU Emacs. If not, see . ;;; Commentary: @@ -76,7 +74,7 @@ ;; ============= TODO =========== ;; - Add a command for printing. -;; - The awk script deletes multiple blank lines. This behaviour does +;; - The awk script deletes multiple blank lines. This behavior does ;; not allow to understand if there was indeed a blank line at the ;; end or beginning of a page (after the header, or before the ;; footer). A different algorithm should be used. It is easy to @@ -110,7 +108,7 @@ (defvar Man-notify) (defcustom Man-filter-list nil - "*Manpage cleaning filter command phrases. + "Manpage cleaning filter command phrases. This variable contains a list of the following form: '((command-string phrase-string*)*) @@ -427,9 +425,9 @@ Otherwise, the value is whatever the function 'func nil 'action #'Man-xref-button-action) -(defun Man-xref-button-action (button) +(defun Man-xref-button-action (button) (let ((target (button-get button 'Man-target-string))) - (funcall + (funcall (button-get button 'func) (cond ((null target) (button-label button)) @@ -437,7 +435,7 @@ Otherwise, the value is whatever the function (funcall target (button-start button))) (t target))))) -(define-button-type 'Man-xref-man-page +(define-button-type 'Man-xref-man-page :supertype 'Man-abstract-xref-man-page 'func 'man-follow) @@ -642,50 +640,91 @@ a new value." ;; ====================================================================== -;; default man entry: get word under point +;; default man entry: get word near point -(defsubst Man-default-man-entry (&optional pos) - "Make a guess at a default manual entry based on the text at POS. -If POS is nil, the current point is used." - (let (word start original-pos distance) +(defun Man-default-man-entry (&optional pos) + "Guess default manual entry based on the text near position POS. +POS defaults to `point'." + (let (word start pos column distance) (save-excursion - (if pos (goto-char pos)) - ;; Default man entry title is any word the cursor is on, or if - ;; cursor not on a word, nearest preceding or next word-like - ;; object on this line. - (if (not (zerop (skip-chars-backward "-a-zA-Z0-9._+:"))) + (when pos (goto-char pos)) + (setq pos (point)) + ;; The default title is the nearest entry-like object before or + ;; after POS. + (if (and (skip-chars-backward " \ta-zA-Z0-9+") + (not (zerop (skip-chars-backward "("))) + ;; Try to handle the special case where POS is on a + ;; section number. + (looking-at + (concat "([ \t]*\\(" Man-section-regexp "\\)[ \t]*)")) + ;; We skipped a valid section number backwards, look at + ;; preceding text. + (or (and (skip-chars-backward ",; \t") + (not (zerop (skip-chars-backward "-a-zA-Z0-9._+:")))) + ;; Not a valid entry, move POS after closing paren. + (not (setq pos (match-end 0))))) + ;; We have a candidate, make `start' record its starting + ;; position. (setq start (point)) - (setq original-pos (point)) - (setq distance (abs (skip-chars-backward ",; \t"))) + ;; Otherwise look at char before POS. + (goto-char pos) (if (not (zerop (skip-chars-backward "-a-zA-Z0-9._+:"))) - (progn - (setq start (point)) - (goto-char original-pos) - (if (and (< (skip-chars-forward ",; \t") distance) - (looking-at "[-a-zA-Z0-9._+:]")) - (setq start (point)) - (goto-char start))) - (skip-chars-forward ",; \t") - (setq start (point)))) + ;; Our candidate is just before or around POS. + (setq start (point)) + ;; Otherwise record the current column and look backwards. + (setq column (current-column)) + (skip-chars-backward ",; \t") + ;; Record the distance travelled. + (setq distance (- column (current-column))) + (when (looking-back + (concat "([ \t]*\\(?:" Man-section-regexp "\\)[ \t]*)")) + ;; Skip section number backwards. + (goto-char (match-beginning 0)) + (skip-chars-backward " \t")) + (if (not (zerop (skip-chars-backward "-a-zA-Z0-9._+:"))) + (progn + ;; We have a candidate before POS ... + (setq start (point)) + (goto-char pos) + (if (and (skip-chars-forward ",; \t") + (< (- (current-column) column) distance) + (looking-at "[-a-zA-Z0-9._+:]")) + ;; ... but the one after POS is better. + (setq start (point)) + ;; ... and anything after POS is worse. + (goto-char start))) + ;; No candidate before POS. + (goto-char pos) + (skip-chars-forward ",; \t") + (setq start (point))))) + ;; We have found a suitable starting point, try to skip at least + ;; one character. (skip-chars-forward "-a-zA-Z0-9._+:") (setq word (buffer-substring-no-properties start (point))) ;; If there is a continuation at the end of line, check the ;; following line too, eg: ;; see this- ;; command-here(1) + ;; Note: This code gets executed iff our entry is after POS. (when (looking-at "[ \t\r\n]+\\([-a-zA-Z0-9._+:]+\\)([0-9])") - (setq word (concat word (match-string-no-properties 1)))) + (setq word (concat word (match-string-no-properties 1))) + ;; Make sure the section number gets included by the code below. + (goto-char (match-end 1))) (when (string-match "[._]+$" word) (setq word (substring word 0 (match-beginning 0)))) - ;; If looking at something like *strcat(... , remove the '*' - (when (string-match "^*" word) - (setq word (substring word 1))) - ;; If looking at something like ioctl(2) or brc(1M), include the - ;; section number in the returned value. Remove text properties. - (concat word - (if (looking-at - (concat "[ \t]*([ \t]*\\(" Man-section-regexp "\\)[ \t]*)")) - (format "(%s)" (match-string-no-properties 1))))))) + ;; The following was commented out since the preceding code + ;; should not produce a leading "*" in the first place. +;;; ;; If looking at something like *strcat(... , remove the '*' +;;; (when (string-match "^*" word) +;;; (setq word (substring word 1))) + (concat + word + (and (not (string-equal word "")) + ;; If looking at something like ioctl(2) or brc(1M), + ;; include the section number in the returned value. + (looking-at + (concat "[ \t]*([ \t]*\\(" Man-section-regexp "\\)[ \t]*)")) + (format "(%s)" (match-string-no-properties 1))))))) ;; ====================================================================== @@ -790,6 +829,10 @@ all sections related to a subject, put something appropriate into the (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). + (setenv "MAN_KEEP_FORMATTING" "1") (if (fboundp 'start-process) (set-process-sentinel (start-process manual-program buffer @@ -968,7 +1011,7 @@ default type, `Man-xref-man-page' is used for the buttons." (Man-highlight-references0 nil Man-apropos-regexp 1 'Man-default-man-entry (or xref-man-type 'Man-xref-man-page))) - (Man-highlight-references0 Man-see-also-regexp Man-reference-regexp 1 + (Man-highlight-references0 Man-see-also-regexp Man-reference-regexp 1 'Man-default-man-entry (or xref-man-type 'Man-xref-man-page)) (Man-highlight-references0 Man-synopsis-regexp Man-header-regexp 0 2 @@ -995,7 +1038,7 @@ default type, `Man-xref-man-page' is used for the buttons." (match-end button-pos) 'type type 'Man-target-string (cond - ((numberp target) + ((numberp target) (match-string target)) ((functionp target) target)