;;; woman.el --- browse UN*X manual pages `wo (without) man'
-;; Copyright (C) 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008,
-;; 2009, 2010 Free Software Foundation, Inc.
+;; Copyright (C) 2000-2011 Free Software Foundation, Inc.
;; Author: Francis J. Wright <F.J.Wright@qmul.ac.uk>
;; Maintainer: FSF
(defvar woman-file-regexp nil
"Regexp used to select (possibly compressed) man source files, e.g.
-\"\\.\\([0-9lmnt]\\w*\\)\\(\\.\\(g?z\\|bz2\\)\\)?\\'\".
+\"\\.\\([0-9lmnt]\\w*\\)\\(\\.\\(g?z\\|bz2\\|xz\\)\\)?\\'\".
Built automatically from the customizable user options
`woman-uncompressed-file-regexp' and `woman-file-compression-regexp'.")
:group 'woman-interface)
(defcustom woman-file-compression-regexp
- "\\.\\(g?z\\|bz2\\)\\'"
+ "\\.\\(g?z\\|bz2\\|xz\\)\\'"
"Do not change this unless you are sure you know what you are doing!
Regexp used to match compressed man file extensions for which
decompressors are available and handled by auto-compression mode,
-e.g. \"\\\\.\\\\(g?z\\\\|bz2\\\\)\\\\'\" for `gzip' or `bzip2'.
+e.g. \"\\\\.\\\\(g?z\\\\|bz2\\\\|xz\\\\)\\\\'\" for `gzip', `bzip2', or `xz'.
Should begin with \\. and end with \\' and MUST NOT be optional."
;; Should be compatible with car of
;; `jka-compr-file-name-handler-entry', but that is unduly
;; complicated, includes an inappropriate extension (.tgz) and is
;; not loaded by default!
+ :version "24.1" ; added xz
:type 'regexp
:set 'set-woman-file-regexp
:group 'woman-interface)
(defvar woman-nospace nil
"Current no-space mode: nil for normal spacing.
Set by `.ns' request; reset by any output or `.rs' request")
+;; Used for message logging
+(defvar WoMan-current-file nil) ; bound in woman-really-find-file
+(defvar WoMan-Log-header-point-max nil)
(defsubst woman-reset-nospace ()
"Set `woman-nospace' to nil."
;; completions, but to return only a case-sensitive match. This
;; does not seem to work properly by default, so I re-do the
;; completion if necessary.
- (let (files
- (default (current-word)))
+ (let (files)
(or (stringp topic)
(and (if (boundp 'woman-use-topic-at-point)
woman-use-topic-at-point
(or (file-accessible-directory-p dir)
(WoMan-warn "Ignoring inaccessible `man-page' directory `%s'!" dir)))
-(defun woman-expand-directory-path (woman-manpath woman-path)
- "Expand the manual directories in WOMAN-MANPATH and WOMAN-PATH.
-WOMAN-MANPATH should be a list of general manual directories, while
-WOMAN-PATH should be a list of specific manual directory regexps.
+(defun woman-expand-directory-path (path-dirs path-regexps)
+ "Expand the manual directories in PATH-DIRS and PATH-REGEXPS.
+PATH-DIRS should be a list of general manual directories (like
+`woman-manpath'), while PATH-REGEXPS should be a list of specific
+manual directory regexps (like `woman-path').
Ignore any paths that are unreadable or not directories."
;; Allow each path to be a single string or a list of strings:
- (if (not (listp woman-manpath)) (setq woman-manpath (list woman-manpath)))
- (if (not (listp woman-path)) (setq woman-path (list woman-path)))
+ (if (not (listp path-dirs)) (setq path-dirs (list path-dirs)))
+ (if (not (listp path-regexps)) (setq path-regexps (list path-regexps)))
(let (head dirs path)
- (dolist (dir woman-manpath)
+ (dolist (dir path-dirs)
(when (consp dir)
(unless path
(setq path (split-string (getenv "PATH") path-separator t)))
(setq dir (woman-canonicalize-dir dir)
dirs (nconc dirs (directory-files
dir t woman-manpath-man-regexp)))))
- (dolist (dir woman-path)
+ (dolist (dir path-regexps)
(if (or (null dir)
(null (setq dir (woman-canonicalize-dir dir)
head (file-name-directory dir)))
(push (woman-topic-all-completions-1 dir path-index)
files))
(setq path-index (1+ path-index)))
- ;; Uniquefy topics:
- ;; Concate all lists with a single nconc call to
+ ;; Uniquify topics:
+ ;; Concatenate all lists with a single nconc call to
;; avoid retraversing the first lists repeatedly -- dak
(woman-topic-all-completions-merge
(apply #'nconc files))))
;; (topic)
;; (topic (path-index) (path-index) ... )
;; (topic (path-index filename) (path-index filename) ... )
- ;; where the are no duplicates in the value lists.
+ ;; where there are no duplicates in the value lists.
;; Topic must match first `word' of filename, so ...
(let ((topic-regexp
(concat
;;; tar-mode support
+(defvar global-font-lock-mode) ; defined in font-core.el
+
(defun woman-tar-extract-file ()
"In tar mode, run the WoMan man-page browser on this file."
(interactive)
;; Both advices are disabled because "a file in Emacs should not put
;; advice on a function in Emacs" (see Info node "(elisp)Advising
;; Functions"). Counting the formatting time is useful for
-;; developping, but less applicable for daily use. The advice for
+;; developing, but less applicable for daily use. The advice for
;; `Man-getpage-in-background' can be discarded, because the
;; key-binding in `woman-mode-map' has been remapped to call `woman'
;; but `man'. Michael Albinus <michael.albinus@gmx.de>
(run-hooks 'woman-pre-format-hook)
(and (boundp 'font-lock-mode) font-lock-mode (font-lock-mode -1))
;; (fundamental-mode)
- (let ((start-time (current-time)) ; (HIGH LOW MICROSEC)
- time) ; HIGH * 2**16 + LOW seconds
+ (let ((start-time (current-time))
+ time)
(message "WoMan formatting buffer...")
; (goto-char (point-min))
; (cond
; (delete-region (point-min) (point))) ; potentially dangerous!
; (t (message "WARNING: .TH request not found -- not man-page format?")))
(woman-decode-region (point-min) (point-max))
- (setq time (current-time)
- time (+ (* (- (car time) (car start-time)) 65536)
- (- (cadr time) (cadr start-time))))
- (message "WoMan formatting buffer...done in %d seconds" time)
+ (setq time (float-time (time-since start-time)))
+ (message "WoMan formatting buffer...done in %g seconds" time)
(WoMan-log-end time))
(run-hooks 'woman-post-format-hook))
This applies to text between .TE and .TS directives.
Currently set only from '\" t in the first line of the source file.")
-(defun woman-decode-region (from to)
+(defun woman-decode-region (from _to)
"Decode the region between FROM and TO in UN*X man-page source format."
;; Suitable for use in format-alist.
;; But this requires care to control major mode implied font locking.
Start at FROM and re-scan new text as appropriate."
(goto-char from)
(let ((woman0-if-to (make-marker))
- request woman0-macro-alist
+ woman-request woman0-macro-alist
(woman0-search-regex-start woman0-search-regex-start)
(woman0-search-regex
(concat woman0-search-regex-start woman0-search-regex-end))
+ processed-first-hunk
woman0-rename-alist)
(set-marker-insertion-type woman0-if-to t)
(while (re-search-forward woman0-search-regex nil t)
- (setq request (match-string 1))
- (cond ((string= request "ig") (woman0-ig))
- ((string= request "if") (woman0-if "if"))
- ((string= request "ie") (woman0-if "ie"))
- ((string= request "el") (woman0-el))
- ((string= request "so") (woman0-so))
- ((string= request "rn") (woman0-rn))
- ((string= request "de") (woman0-de))
- ((string= request "am") (woman0-de 'append))
- (t (woman0-macro request))))
+ (setq woman-request (match-string 1))
+
+ ;; Process escape sequences prior to first request (Bug#7843).
+ (unless processed-first-hunk
+ (setq processed-first-hunk t)
+ (let ((process-escapes-to-marker (point-marker)))
+ (set-marker-insertion-type process-escapes-to-marker t)
+ (save-match-data
+ (save-excursion
+ (goto-char from)
+ (woman2-process-escapes process-escapes-to-marker)))))
+
+ (cond ((string= woman-request "ig") (woman0-ig))
+ ((string= woman-request "if") (woman0-if "if"))
+ ((string= woman-request "ie") (woman0-if "ie"))
+ ((string= woman-request "el") (woman0-el))
+ ((string= woman-request "so") (woman0-so))
+ ((string= woman-request "rn") (woman0-rn))
+ ((string= woman-request "de") (woman0-de))
+ ((string= woman-request "am") (woman0-de 'append))
+ (t (woman0-macro woman-request))))
(set-marker woman0-if-to nil)
(woman0-rename)
;; Should now re-run `woman0-roff-buffer' if any renaming was
(goto-char from) ; necessary!
(woman2-process-escapes to 'numeric))
+;; request does not appear to be used dynamically by any callees.
(defun woman0-if (request)
".if/ie c anything -- Discard unless c evaluates to true.
Remember condition for use by a subsequent `.el'.
;; ((looking-at "[te]") (setq c nil)) ; reject t(roff) and e(ven page)
((looking-at "[ntoe]")
(setq c (memq (following-char) woman-if-conditions-true)))
- ;; Unrecognised letter so reject:
+ ;; Unrecognized letter so reject:
((looking-at "[A-Za-z]") (setq c nil)
(WoMan-warn "%s %s -- unrecognized condition name rejected!"
request (match-string 0)))
(woman-if-ignore woman0-if-to request) ; ERROR!
(woman-if-body request woman0-if-to (eq c negated)))))
+;; request is not used dynamically by any callees.
(defun woman-if-body (request to delete) ; should be reversed as `accept'?
"Process if-body, including \\{ ... \\}.
REQUEST is the invoking directive without the leading dot.
;; Process matching .el anything:
(cond ((string= request "ie")
;; Discard unless previous .ie c `evaluated to false'.
+ ;; IIUC, an .ie must be followed by an .el.
+ ;; (An if with no else uses .if rather than .ie.)
+ ;; TODO warn if no .el found?
+ ;; The .el should come immediately after the .ie (modulo
+ ;; comments etc), but this searches to eob.
(cond ((re-search-forward "^[.'][ \t]*el[ \t]*" nil t)
(woman-delete-match 0)
(woman-if-body "el" nil (not delete)))))
+;;; FIXME neither the comment nor the code here make sense to me.
+;;; This branch was executed for an else (any else, AFAICS).
+;;; At this point, the else in question has already been processed above.
+;;; The re-search will find the _next_ else, if there is one, and
+;;; delete it. If there is one, it belongs to another if block. (Bug#9447)
+;;; woman0-el does not need this bit either.
;; Got here after processing a single-line `.ie' as a body
;; clause to be discarded:
- ((string= request "el")
- (cond ((re-search-forward "^[.'][ \t]*el[ \t]*" nil t)
- (woman-delete-match 0)
- (woman-if-body "el" nil t)))))
+;;; ((string= request "el")
+;;; (cond ((re-search-forward "^[.'][ \t]*el[ \t]*" nil t)
+;;; (woman-delete-match 0)
+;;; (woman-if-body "el" nil t)))))
+ )
(goto-char from)))
(defun woman0-el ()
(if (looking-at "[ \t]*\\{") (search-forward "\\}"))
(forward-line 1))))
+;; request is not used dynamically by any callees.
(defun woman-if-ignore (to request)
"Ignore but warn about an if request ending at TO, named REQUEST."
(WoMan-warn-ignored request "ignored -- condition not handled!")
(beginning-of-line) ; delete .de/am line
(woman-delete-line 1))
-(defun woman0-macro (request)
- "Process the macro call named REQUEST."
+;; request may be used dynamically (woman-interpolate-macro calls
+;; woman-forward-arg).
+(defun woman0-macro (woman-request)
+ "Process the macro call named WOMAN-REQUEST."
;; Leaves point at start of new text.
- (let ((macro (assoc request woman0-macro-alist)))
+ (let ((macro (assoc woman-request woman0-macro-alist)))
(if macro
(woman-interpolate-macro (cdr macro))
;; SHOULD DELETE THE UNINTERPRETED REQUEST!!!!!
;; Output this message once only per call (cf. strings)?
- (WoMan-warn "Undefined macro %s not interpolated!" request))))
+ (WoMan-warn "Undefined macro %s not interpolated!" woman-request))))
(defun woman-interpolate-macro (macro)
"Interpolate (.de) or append (.am) expansion of MACRO into the buffer."
("bv" "|") ; bold vertical
;; groff etc. extensions:
+ ;; List these via eg man -Tdvi groff_char > groff_char.dvi.
("lq" "\"")
("rq" "\"")
("aq" "'")
("ha" "^")
("ti" "~")
+ ("oq" "‘") ; u2018
+ ("cq" "’") ; u2019
+ ("hy" "‐") ; u2010
)
"Alist of special character codes with ASCII and extended-font equivalents.
Each alist elements has the form
\f
;;; Formatting macros that do not cause a break:
-(defvar request) ; Bound locally by woman1-roff-buffer
-(defvar unquote) ; Bound locally by woman1-roff-buffer
+;; Bound locally by woman[012]-roff-buffer, and also, annoyingly and
+;; confusingly, as a function argument. Use dynamically in
+;; woman-unquote and woman-forward-arg.
+(defvar woman-request)
(defun woman-unquote (to)
"Delete any double-quote characters between point and TO.
(setq in-quote (not in-quote))
))
(if in-quote
- (WoMan-warn "Unpaired \" in .%s arguments." request))))
+ (WoMan-warn "Unpaired \" in .%s arguments." woman-request))))
(defsubst woman-unquote-args ()
"Delete any double-quote characters up to the end of the line."
(defun woman1-roff-buffer ()
"Process non-breaking requests."
(let ((case-fold-search t)
- request fn unquote)
+ woman-request fn woman1-unquote)
(while
;; Find next control line:
(re-search-forward woman-request-regexp nil t)
;; Construct woman function to call:
((setq fn (intern-soft
(concat "woman1-"
- (setq request (match-string 1)))))
+ (setq woman-request (match-string 1)))))
(if (get fn 'notfont) ; not a font-change request
(funcall fn)
;; Delete request or macro name:
(woman-delete-match 0)
;; If no args then apply to next line else unquote args
- ;; (unquote is used by called function):
- (setq unquote (not (eolp)))
+ ;; (woman1-unquote is used by called function):
+ (setq woman1-unquote (not (eolp)))
(if (eolp) (delete-char 1))
; ;; Hide leading control character in unquoted argument:
; (cond ((memq (following-char) '(?. ?'))
;; Call the appropriate function:
(funcall fn)
;; Hide leading control character in quoted argument (only):
- (if (and unquote (memq (following-char) '(?. ?')))
+ (if (and woman1-unquote (memq (following-char) '(?. ?')))
(insert "\\&"))))))))
;;; Font-changing macros:
".I -- Set words of current line in italic font."
(woman1-B-or-I ".ft I\n"))
+(defvar woman1-unquote) ; bound locally by woman1-roff-buffer
+
(defun woman1-B-or-I (B-or-I)
".B/I -- Set words of current line in bold/italic font.
B-OR-I is the appropriate complete control line."
;; Return to bol to process .SM/.B, .B/.if etc.
;; or start of first arg to hide leading control char.
(save-excursion
- (if unquote
+ (if woman1-unquote
(woman-unquote-args)
(while (looking-at "^[.']") (forward-line))
(end-of-line)
;; Return to start of first arg to hide leading control char:
(save-excursion
(setq fonts (cdr fonts))
- (woman-forward-arg unquote 'concat) ; unquote is bound above
+ ;; woman1-unquote is bound in woman1-roff-buffer.
+ (woman-forward-arg woman1-unquote 'concat)
(while (not (eolp))
(insert (car fonts))
(setq fonts (cdr fonts))
- (woman-forward-arg unquote 'concat)) ; unquote is bound above
+ (woman-forward-arg woman1-unquote 'concat))
(insert "\\fR")))
(defun woman-forward-arg (&optional unquote concat)
(re-search-forward "\"\\|$"))
(if (eq (preceding-char) ?\")
(if unquote (delete-char -1))
- (WoMan-warn "Unpaired \" in .%s arguments." request)))
+ (WoMan-warn "Unpaired \" in .%s arguments." woman-request)))
;; (re-search-forward "[^\\\n] \\|$") ; inconsistent
(skip-syntax-forward "^ "))
(cond ((null concat) (skip-chars-forward " \t")) ; don't skip eol!
\f
;;; Output translation:
-(defvar translations nil) ; Also bound locally by woman2-roff-buffer
+;; This is only set by woman2-tr. It is bound locally in woman2-roff-buffer.
+;; It is also used by woman-translate. woman-translate may be called
+;; outside the scope of woman2-roff-buffer (by experiment). Therefore
+;; this used to be globally bound to nil, to avoid an error. Instead
+;; we can use bound-and-true-p in woman-translate.
+(defvar woman-translations)
;; A list of the form (\"[ace]\" (a . b) (c . d) (e . ?\ )) or nil.
(defun woman-get-next-char ()
;; This should be an update, but consing onto the front of the alist
;; has the same effect and match duplicates should not matter.
;; Initialize translation data structures:
- (let ((matches (car translations))
- (alist (cdr translations))
+ (let ((matches (car woman-translations))
+ (alist (cdr woman-translations))
a b)
;; `matches' must be a string:
(setq matches
(if (= (string-to-char matches) ?\])
(substring matches 3)
(concat "[" matches))
- translations (cons matches alist))
+ woman-translations (cons matches alist))
;; Format any following text:
(woman2-format-paragraphs to)))
(defsubst woman-translate (to)
"Translate up to marker TO. Do this last of all transformations."
- (if translations
- (let ((matches (car translations))
- (alist (cdr translations))
+ (if (bound-and-true-p woman-translations)
+ (let ((matches (car woman-translations))
+ (alist (cdr woman-translations))
;; Translations are case-sensitive, eg ".tr ab" does not
;; affect "A" (bug#6849).
(case-fold-search nil))
; (WoMan-warn "Unimplemented numerical operator `%c' in %s"
; (following-char)
; (buffer-substring
-; (save-excursion (beginning-of-line) (point))
-; (save-excursion (end-of-line) (point))))
+; (line-beginning-position)
+; (line-end-position)))
; (skip-syntax-forward "^ "))
value
))
(WoMan-warn "Numeric/register argument error: %s"
(buffer-substring
(point)
- (save-excursion (end-of-line) (point))))
+ (line-end-position)))
(skip-syntax-forward "^ ")
0)
(goto-char (match-end 0))
(insert-and-inherit (symbol-function 'insert-and-inherit))
(set-text-properties (symbol-function 'set-text-properties))
(woman-registers woman-registers)
- fn request translations
+ fn woman-request woman-translations
tab-stop-list)
(set-marker-insertion-type to t)
;; ?roff does not squeeze multiple spaces, but does fill, so...
;; Construct woman function to call:
((setq fn (intern-soft
(concat "woman2-"
- (setq request (match-string 1)))))
+ (setq woman-request (match-string 1)))))
;; Delete request or macro name:
(woman-delete-match 0))
- ;; Unrecognised request:
+ ;; Unrecognized request:
((prog1 nil
- ;; (WoMan-warn ".%s request ignored!" request)
- (WoMan-warn-ignored request "ignored!")
+ ;; (WoMan-warn ".%s request ignored!" woman-request)
+ (WoMan-warn-ignored woman-request "ignored!")
;; (setq fn 'woman2-LP)
;; AVOID LEAVING A BLANK LINE!
;; (setq fn 'woman2-format-paragraphs)
(buffer-substring start here))
(delete-region here (point)))))
;; Embolden heading (point is at end of heading):
- (woman-set-face
- (save-excursion (beginning-of-line) (point)) (point) 'woman-bold)
+ (woman-set-face (line-beginning-position) (point) 'woman-bold)
(forward-line)
(delete-blank-lines)
(setq woman-left-margin woman-default-indent)
(setq woman-leave-blank-lines nil)
;; Optionally embolden heading (point is at beginning of heading):
(if woman-bold-headings
- (woman-set-face
- (point) (save-excursion (end-of-line) (point)) 'woman-bold))
+ (woman-set-face (point) (line-end-position) 'woman-bold))
(forward-line)
(setq woman-left-margin woman-default-indent
woman-nofill nil) ; fill output lines
;; Done like this to preserve any text properties of the `\'
(while (search-forward "\\" to t)
(let ((c (following-char)))
+ ;; Some other escapes, such as \f, are handled in
+ ;; `woman0-process-escapes'.
(cond ((eq c ?') ; \' -> '
(delete-char -1)
(cond (numeric ; except in numeric args, \' -> `
(insert "\t"))
((and numeric
(memq c '(?w ?n ?h)))) ; leave \w, \n, \h (?????)
- ((eq c ?l) (woman-horizontal-line))
- (t
- ;; \? -> ? where ? is any remaining character
- (WoMan-warn "Escape ignored: \\%c -> %c" c c)
- (delete-char -1))
- )))
+ ((eq c ?l) (woman-horizontal-line)))))
(goto-char from)
;; Process non-default tab settings:
(cond (tab-stop-list
(setq tab-stop-list (reverse tab-stop-list))
(woman2-format-paragraphs to))
-(defsubst woman-get-tab-stop (tab-stop-list)
- "If TAB-STOP-LIST is a cons, return its car, else return TAB-STOP-LIST."
- (if (consp tab-stop-list) (car tab-stop-list) tab-stop-list))
+(defsubst woman-get-tab-stop (tab-stops)
+ "If TAB-STOPS is a cons, return its car, else return TAB-STOPS."
+ (if (consp tab-stops) (car tab-stops) tab-stops))
(defun woman-tab-to-tab-stop ()
"Insert spaces to next defined tab-stop column.
eol n)
(if type
(setq tab (woman-get-tab-stop tab)
- eol (save-excursion (end-of-line) (point))
+ eol (line-end-position)
n (save-excursion
(search-forward "\t" eol t))
n (- (if n (1- n) eol) (point))
;; The basis for this logging code was shamelessly pirated from bytecomp.el
;; by Jamie Zawinski <jwz@lucid.com> & Hallvard Furuseth <hbf@ulrik.uio.no>
-(defvar WoMan-current-file nil) ; bound in woman-really-find-file
-(defvar WoMan-Log-header-point-max nil)
-
(defun WoMan-log-begin ()
"Log the beginning of formatting in *WoMan-Log*."
(let ((WoMan-current-buffer (buffer-name)))
(setq format (apply 'format format args))
(WoMan-log-1 (concat "** " format)))
+;; request is not used dynamically by any callees.
(defun WoMan-warn-ignored (request ignored)
"Log a warning message about ignored directive REQUEST.
IGNORED is a string appended to the log message."
(let ((tail
(buffer-substring (point)
- (save-excursion (end-of-line) (point)))))
+ (line-end-position))))
(if (and (> (length tail) 0)
(/= (string-to-char tail) ?\ ))
(setq tail (concat " " tail)))
"Log the end of formatting in *WoMan-Log*.
TIME specifies the time it took to format the man page, to be printed
with the message."
- (WoMan-log-1 (format "Formatting time %d seconds." time) 'end))
+ (WoMan-log-1 (format "Formatting time %g seconds." time) 'end))
(defun WoMan-log-1 (string &optional end)
"Log a message STRING in *WoMan-Log*.
(provide 'woman)
-;; arch-tag: eea35e90-552f-4712-a94b-d9ffd3db7651
+\f
+;; Local Variables:
+;; coding: utf-8
+;; End:
+
;;; woman.el ends here
HCoop / bpt / emacs.git / blobdiff