;; Copyright (C) 2000 Free Software Foundation, Inc.
-;; Author: Francis J. Wright <F.J.Wright@Maths.QMW.ac.uk>
-;; Maintainer: Francis J. Wright <F.J.Wright@Maths.QMW.ac.uk>
-;; Keywords: help, man, UN*X, manual
-;; Adapted-By: Eli Zaretskii <eliz@is.elta.co.il>
-;; Version: see `woman-version'
-;; URL: http://centaur.maths.qmw.ac.uk/Emacs/
+;; Author: Francis J. Wright <F.J.Wright@Maths.QMW.ac.uk>
+;; Maintainer: Francis J. Wright <F.J.Wright@Maths.QMW.ac.uk>
+;; Keywords: help, man, UN*X, manual
+;; Adapted-By: Eli Zaretskii <eliz@is.elta.co.il>
+;; Version: see `woman-version'
+;; URL: http://centaur.maths.qmw.ac.uk/Emacs/WoMan/
;; This file is part of GNU Emacs.
;; Paul A. Thompson <pat@po.cwru.edu>
;; Arrigo Triulzi <arrigo@maths.qmw.ac.uk>
;; Geoff Voelker <voelker@cs.washington.edu>
+;; Eli Zaretskii <eliz@is.elta.co.il>
(defvar woman-version "0.54 (beta)" "WoMan version information.")
(require 'apropos))
(defun woman-mapcan (fn x)
- "Return concatenated list of FN applied to successive CAR elements of X.
+ "Return concatenated list of FN applied to successive `car' elements of X.
FN must return a list, cons or nil. Useful for splicing into a list."
;; Based on the Standard Lisp function MAPCAN but with args swapped!
(and x (nconc (funcall fn (car x)) (woman-mapcan fn (cdr x)))))
(defun woman-parse-colon-path (cd-path)
"Explode a search path CD-PATH into a list of directory names.
-If the platform is Microsoft Windows and no path contains `\\' then
-assume a Cygwin-style colon-separated search path and convert any
-leading drive specifier `//X/' to `X:', otherwise assume paths
-separated by `path-separator'."
- ;; Based on a suggestion by Jari Aalto.
- (woman-mapcan ; splice into list...
- (lambda (path)
- ;; parse-colon-path returns nil for a null path component and
- ;; an empty substring of MANPATH denotes the default list...
- (if path (cons path nil) (woman-parse-man.conf)))
- (if (and (memq system-type '(windows-nt ms-dos))
- (not (or (string-match ";" cd-path)
- (string-match "\\\\" cd-path))))
- (let ((path-separator ":"))
- (mapcar
- (lambda (path) ; //a/b -> a:/b
- (cond ((and path (string-match "\\`//./" path))
- (setq path (substring path 1)) ; //a/b -> /a/b
- (aset path 0 (aref path 1)) ; /a/b -> aa/b
- (aset path 1 ?:) ; aa/b -> a:/b
- ))
- path)
- (parse-colon-path cd-path)))
- (parse-colon-path cd-path))))
+Replace null components by calling `woman-parse-man.conf'.
+Allow UN*X-style search paths on Microsoft platforms, i.e. allow path
+elements to be separated by colons and convert Cygwin-style drive
+specifiers `//x/' to `x:'."
+ ;; Based on suggestions by Jari Aalto and Eli Zaretskii.
+ (mapcar
+ (lambda (path) ; //a/b -> a:/b
+ (when (and path (string-match "\\`//./" path))
+ (setq path (substring path 1)) ; //a/b -> /a/b
+ (aset path 0 (aref path 1)) ; /a/b -> aa/b
+ (aset path 1 ?:)) ; aa/b -> a:/b
+ path)
+ (woman-mapcan ; splice into list...
+ (lambda (path)
+ ;; parse-colon-path returns nil for a null path component and
+ ;; an empty substring of MANPATH denotes the default list...
+ (if path (list path) (woman-parse-man.conf)))
+ (if (and (memq system-type '(windows-nt ms-dos))
+ (not (string-match ";" cd-path)))
+ (let ((path-separator ":"))
+ (parse-colon-path cd-path))
+ (parse-colon-path cd-path)))))
\f
;;; User options:
:group 'woman)
(defcustom woman-man.conf-path
- '("/etc" "/usr/local/lib")
+ '("/etc" "/etc/manpath.config" "/usr/local/lib")
"*List of dirs to search and/or files to try for man config file.
Default is '(\"/etc\" \"/usr/local/lib\") [for GNU/Linux, Cygwin resp.]
A trailing separator (`/' for UNIX etc.) on directories is optional
:group 'woman-interface)
(defun woman-parse-man.conf ()
- "Parse man config file if found. (Used only if MANPATH is not set.)
+ "Parse if possible Linux-style configuration file for man command.
+Used only if MANPATH is not set or contains null components.
Look in `woman-man.conf-path' and return a value for `woman-manpath'.
Concatenate data from all lines in the config file of the form
-MANPATH /usr/man"
+
+ MANPATH /usr/man
+
+or
+
+ MANDATORY_MANPATH /usr/man"
;; Functionality suggested by Charles Curley.
(let ((path woman-man.conf-path)
file manpath)
(with-temp-buffer
(insert-file-contents file)
(while (re-search-forward
- "^[ \t]*MANPATH[ \t]+\\(\\S-+\\)" nil t)
- (setq manpath (cons (match-string 1) manpath)))
+ "^[ \t]*\\(MANDATORY_\\)?MANPATH[ \t]+\\(\\S-+\\)" nil t)
+ (setq manpath (cons (match-string 2) manpath)))
manpath))
))
(setq path (cdr path)))
(or
(and manpath (woman-parse-colon-path manpath))
(woman-parse-man.conf)
- '("/usr/man" "/usr/local/man")
+ '("/usr/man" "/usr/share/man" "/usr/local/man")
))
"*List of DIRECTORY TREES to search for UN*X manual files.
Each element should be the name of a directory that contains
:set 'set-woman-file-regexp
:group 'woman-interface)
-(defcustom woman-use-own-frame
- (or (and (fboundp 'display-graphic-p) (display-graphic-p))
- (memq window-system '(x w32)))
+(defcustom woman-use-own-frame ; window-system
+ (or (and (fboundp 'display-graphic-p) (display-graphic-p)) ; Emacs 21
+ (memq window-system '(x w32))) ; Emacs 20
"*If non-nil then use a dedicated frame for displaying WoMan windows.
Only useful when run on a graphic display such as X or MS-Windows."
:type 'boolean
:type 'boolean
:group 'woman-faces)
+;; This is overkill! Troff uses just italic; Nroff uses just underline.
+;; You should probably select either italic or underline as you prefer, but
+;; not both, although italic and underline work together perfectly well!
(defface woman-italic-face
- `((t (:italic t :underline t :foreground "red")))
- "Face for italic font in man pages.
-Default: italic, underlined, foreground red.
-This is overkill! Troff uses just italic\; Nroff uses just underline.
-You should probably select either italic or underline as you prefer,
-but not both, although italic and underline work together perfectly well!"
+ `((((background light)) (:italic t :underline t :foreground "red"))
+ (((background dark)) (:italic t :underline t)))
+ "Face for italic font in man pages."
:group 'woman-faces)
(defface woman-bold-face
- '((t (:bold t :foreground "blue")))
- "Face for bold font in man pages.
-Default: bold, foreground blue."
+ '((((background light)) (:bold t :foreground "blue"))
+ (((background dark)) (:bold t :foreground "green2")))
+ "Face for bold font in man pages."
:group 'woman-faces)
+;; Brown is a good compromise: it is distinguishable from the default
+;; but not enough so to make font errors look terrible. (Files that use
+;; non-standard fonts seem to do so badly or in idiosyncratic ways!)
(defface woman-unknown-face
- '((t (:foreground "brown")))
- "Face for all unknown fonts in man pages.
-Default: foreground brown.
-Brown is a good compromise: it is distinguishable from the default but
-not enough so to make font errors look terrible. (Files that use
-non-standard fonts seem to do so badly or in idiosyncratic ways!)"
+ '((((background light)) (:foreground "brown"))
+ (((background dark)) (:foreground "cyan")))
+ "Face for all unknown fonts in man pages."
:group 'woman-faces)
(defface woman-addition-face
Default: foreground orange."
:group 'woman-faces)
-(defun woman-colour-faces ()
- "Set foreground colours of italic and bold faces to red and blue."
+(defun woman-default-faces ()
+ "Set foreground colours of italic and bold faces to their default values."
(interactive)
- (set-face-foreground 'woman-italic-face "Red")
- (set-face-foreground 'woman-bold-face "Blue"))
+ (face-spec-set 'woman-italic-face
+ (face-user-default-spec 'woman-italic-face))
+ (face-spec-set 'woman-bold-face (face-user-default-spec 'woman-bold-face)))
-(defun woman-black-faces ()
- "Set foreground colours of italic and bold faces both to black."
+(defun woman-monochrome-faces ()
+ "Set foreground colours of italic and bold faces to that of the default face.
+This is usually either black or white."
(interactive)
- (set-face-foreground 'woman-italic-face "Black")
- (set-face-foreground 'woman-bold-face "Black"))
+ (set-face-foreground 'woman-italic-face 'unspecified)
+ (set-face-foreground 'woman-bold-face 'unspecified))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Experimental font support, initially only for MS-Windows.
(defconst woman-font-support
- (eq window-system 'w32) ; Support X later!
+ (eq window-system 'w32) ; Support X later!
"If non-nil then non-ASCII characters and symbol font supported.")
(defun woman-select-symbol-fonts (fonts)
Should include ?e, ?o (page even/odd) and either ?n (nroff) or ?t (troff).
Default is '(?n ?e ?o). Set via `woman-emulation'.")
+\f
+;;; Button types:
+
+(define-button-type 'woman-xref
+ 'action (lambda (button) (woman (button-label button)))
+ 'help-echo "RET, mouse-2: display this man page")
+
\f
;;; Specialized utility functions:
;; Uniquefy topics:
(woman-topic-all-completions-merge files)))
-(defsubst woman-list-n (n &rest args)
- "Return a list of at most the first N of the arguments ARGS.
-Treats N < 1 as if N = 1."
- (if (< n (length args))
- (setcdr (nthcdr (1- n) args) nil))
- args)
-
(defun woman-topic-all-completions-1 (dir path-index)
- "Return an alist of the man files in directory DIR with index PATH-INDEX.
-The `cdr' of each alist element is the path-index / filename."
- ;; *** NEED case-fold-search t HERE ???
- (let ((old (directory-files dir nil woman-file-regexp))
- new file)
- ;; Convert list to alist of non-directory files:
- (while old
- (setq file (car old)
- old (cdr old))
- (if (file-directory-p file)
- ()
- (setq new (cons
- (woman-list-n
- woman-cache-level
- (file-name-sans-extension
- (if (string-match woman-file-compression-regexp file)
- (file-name-sans-extension file)
- file))
- path-index
- file)
- new))))
- new))
+ "Return an alist of the man topics in directory DIR with index PATH-INDEX.
+A topic is a filename sans type-related extensions.
+Support 3 levels of caching: each element of the alist will be a list
+of the first `woman-cache-level' elements from the following list:
+\(topic path-index filename)."
+ ;; This function used to check that each file in the directory was
+ ;; not itself a directory, but this is very slow and should be
+ ;; unnecessary. So let us assume that `woman-file-regexp' will
+ ;; filter out any directories, which probably should not be there
+ ;; anyway, i.e. it is a user error!
+ (mapcar
+ (lambda (file)
+ (cons
+ (file-name-sans-extension
+ (if (string-match woman-file-compression-regexp file)
+ (file-name-sans-extension file)
+ file))
+ (if (> woman-cache-level 1)
+ (cons
+ path-index
+ (if (> woman-cache-level 2)
+ (cons file nil))))))
+ (directory-files dir nil woman-file-regexp)))
(defun woman-topic-all-completions-merge (alist)
"Merge the alist ALIST so that the keys are unique.
(mapcar 'list files)
))
-
+\f
;;; dired support
(defun woman-dired-define-key (key)
(while (re-search-forward "^[ \t]*\n\\([ \t]*\n\\)+" nil t)
(replace-match "\n" t t))
+ ;; CJK characters are underlined by double-sized "__".
+ ;; (Code lifted from man.el, with trivial changes.)
+ (if (< (buffer-size) (position-bytes (point-max)))
+ ;; Multibyte characters exist.
+ (progn
+ (goto-char (point-min))
+ (while (search-forward "__\b\b" nil t)
+ (backward-delete-char 4)
+ (woman-set-face (point) (1+ (point)) 'woman-italic-face))
+ (goto-char (point-min))
+ (while (search-forward "\b\b__" nil t)
+ (backward-delete-char 4)
+ (woman-set-face (1- (point)) (point) 'woman-italic-face))))
+
;; Interpret overprinting to indicate bold face:
(goto-char (point-min))
- (while (re-search-forward "\\(.\\)\\(\\(\b\\1\\)+\\)" nil t)
+ (while (re-search-forward "\\(.\\)\\(\\(\b+\\1\\)+\\)" nil t)
(woman-delete-match 2)
(woman-set-face (1- (point)) (point) 'woman-bold-face))
(if woman-mode-map
()
- ;; Set up the keymap, mostly inherited from Man-mode-map:
- (setq woman-mode-map (make-sparse-keymap))
+ ;; Set up the keymap, mostly inherited from Man-mode-map. Normally
+ ;; button-buffer-map is used as a parent keymap, but we can't have two
+ ;; parents, so we just copy it.
+ (setq woman-mode-map (copy-keymap button-buffer-map))
(set-keymap-parent woman-mode-map Man-mode-map)
;; Above two lines were
;; (setq woman-mode-map (cons 'keymap Man-mode-map))
(define-key woman-mode-map "w" 'woman)
(define-key woman-mode-map "\en" 'WoMan-next-manpage)
(define-key woman-mode-map "\ep" 'WoMan-previous-manpage)
- (define-key woman-mode-map [mouse-2] 'woman-mouse-2)
- (define-key woman-mode-map [M-mouse-2] 'woman-mouse-2))
+ (define-key woman-mode-map [M-mouse-2] 'woman-follow-word))
-(defun woman-mouse-2 (event)
+(defun woman-follow-word (event)
"Run WoMan with word under mouse as topic.
-Require it to be mouse-highlighted unless Meta key used.
Argument EVENT is the invoking mouse event."
(interactive "e") ; mouse event
- (let ((pos (cadr (cadr event)))) ; extract buffer position
- (when (or (eq (car event) 'M-mouse-2)
- (get-text-property pos 'mouse-face))
- (goto-char pos)
- (woman (current-word t)))))
+ (goto-char (posn-point (event-start event)))
+ (woman (current-word t)))
;; WoMan menu bar and pop-up menu:
(easy-menu-define ; (SYMBOL MAPS DOC MENU)
["Use Full Frame Width" woman-toggle-fill-frame
:active t :style toggle :selected woman-fill-frame]
["Reformat Last Man Page" woman-reformat-last-file t]
- ["Use Coloured Main Faces" woman-colour-faces t]
- ["Use Black Main Faces" woman-black-faces t]
+ ["Use Monochrome Main Faces" woman-monochrome-faces t]
+ ["Use Default Main Faces" woman-default-faces t]
["Make Contents Menu" (woman-imenu t) (not woman-imenu-done)]
"--"
["Describe (Wo)Man Mode" describe-mode t]
(while (re-search-forward Man-reference-regexp end t)
;; Highlight reference when mouse is over it.
;; (NB: WoMan does not hyphenate!)
- ;; [See (elisp)Clickable Text]
- (put-text-property (match-beginning 1) (match-end 1)
- 'mouse-face 'highlight)
- ))))
+ (make-text-button (match-beginning 1) (match-end 1)
+ 'type 'woman-xref)))))
\f
;;; Buffer handling:
logging the message."
(save-excursion
(set-buffer (get-buffer-create "*WoMan-Log*"))
+ (setq buffer-read-only nil)
(goto-char (point-max))
(or end (insert " ")) (insert string "\n")
(if end
;; Comment order and doc strings changed substantially.
;; MS-DOS support added (by Eli Zaretskii).
;; checkdoc run: no real errors.
+;; woman topic interface speeded up.
;;; woman.el ends here