;;; woman.el --- browse UN*X manual pages `wo (without) man'
-;; Copyright (C) 2000-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2000-2012 Free Software Foundation, Inc.
;; Author: Francis J. Wright <F.J.Wright@qmul.ac.uk>
;; Maintainer: FSF
(eval-when-compile ; to avoid compiler warnings
(require 'dired)
- (require 'cl)
+ (require 'cl-lib)
(require 'apropos))
(defun woman-mapcan (fn x)
(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))))
;;; 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)
(woman-process-buffer)
(goto-char (point-min)))))
-;; There is currently no `tar-mode-hook' so use ...
-(eval-after-load "tar-mode"
- '(progn
- (define-key tar-mode-map "w" 'woman-tar-extract-file)
- (define-key-after (lookup-key tar-mode-map [menu-bar immediate])
- [woman] '("Read Man Page (WoMan)" . woman-tar-extract-file) 'view)))
-
-
(defvar woman-last-file-name nil
"The full pathname of the last file formatted by WoMan.")
(lambda (symbol)
(and
(or (commandp symbol)
- (user-variable-p symbol))
+ (custom-variable-p symbol))
(not (get symbol 'apropos-inhibit))))))
;; Find documentation strings:
(let ((p apropos-accumulator)
(if (setq doc (documentation symbol t))
(substring doc 0 (string-match "\n" doc))
"(not documented)"))
- (if (user-variable-p symbol) ; 3. variable doc
+ (if (custom-variable-p symbol) ; 3. variable doc
(if (setq doc (documentation-property
symbol 'variable-documentation t))
(substring doc 0 (string-match "\n" doc))))))
;; 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>
(copy-sequence standard-display-table)
(make-display-table)))
;; Display the following internal chars correctly:
- (aset buffer-display-table woman-unpadded-space-char [?\ ])
+ (aset buffer-display-table woman-unpadded-space-char [?\s])
(aset buffer-display-table woman-escaped-escape-char [?\\]))
\f
(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.
(if woman-negative-vertical-space
(woman-negative-vertical-space from))
- (if woman-preserve-ascii
- ;; Re-instate escaped escapes to just `\' and unpaddable
- ;; spaces to just `space', without inheriting any text
- ;; properties. This is not necessary, UNLESS the buffer is to
- ;; be saved as ASCII.
- (progn
- (goto-char from)
- (while (search-forward woman-escaped-escape-string nil t)
- (delete-char -1) (insert ?\\))
- (goto-char from)
- (while (search-forward woman-unpadded-space-string nil t)
- (delete-char -1) (insert ?\ ))))
+ (when woman-preserve-ascii
+ ;; Re-instate escaped escapes to just `\' and unpaddable spaces
+ ;; to just `space'. This is not necessary for display since
+ ;; there are display table entries for the escaped chars, but it
+ ;; is necessary if the buffer might be saved as ASCII.
+ ;;
+ ;; `subst-char-in-region' preserves text properties on the
+ ;; characters, which is necessary for bold, underline, etc on
+ ;; \e. There's usually no face on spaces, but if there is then
+ ;; it's good to keep that too.
+ (subst-char-in-region from (point-max)
+ woman-escaped-escape-char ?\\)
+ (subst-char-in-region from (point-max)
+ woman-unpadded-space-char ?\s))
;; Must return the new end of file if used in format-alist.
(point-max)))
;; first backwards then forwards:
(while (and
(<= (setq N (1+ N)) 0)
- (cond ((memq (preceding-char) '(?\ ?\t))
+ (cond ((memq (preceding-char) '(?\s ?\t))
(delete-char -1) t)
- ((memq (following-char) '(?\ ?\t))
+ ((memq (following-char) '(?\s ?\t))
(delete-char 1) t)
(t nil))))
(if (<= N 0)
;; ((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)))
;; 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 ()
;; then use the WoMan search mechanism to find the filename ...
(setq filename
(woman-file-name
- (file-name-sans-extension
- (file-name-nondirectory name))))
+ (file-name-base name)))
;; Cannot find the file, so ...
(kill-buffer (current-buffer))
(error "File `%s' not found" name))
(re-search-forward "[^ \t\n]+")
(let ((string (match-string 0)))
(skip-chars-forward " \t")
-; (setq string
-; (cons string
-; ;; hack (?) for CGI.man!
-; (cond ((looking-at "\"\"") "\"")
-; ((looking-at ".*") (match-string 0)))
-; ))
- ;; Above hack causes trouble in arguments!
- (looking-at ".*")
- (setq string (cons string (match-string 0)))
+ (if (= ?\" (following-char))
+ ;; Double-quote starts a string, eg.
+ ;; .ds foo "blah...
+ ;; is value blah... through to newline. There's no
+ ;; closing " (per the groff manual), but rather any
+ ;; further " is included literally in the string. Eg.
+ ;; .ds foo ""
+ ;; sets foo to a single " character.
+ (forward-char))
+ (setq string (cons string
+ (buffer-substring (point)
+ (line-end-position))))
;; This should be an update, but consing a new string
;; onto the front of the alist has the same effect:
(setq woman-string-alist (cons string woman-string-alist))
("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
;; 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.
+;; A list of the form (\"[ace]\" (a . b) (c . d) (e . ?\s)) or nil.
(defun woman-get-next-char ()
"Return and delete next char in buffer, including special chars."
(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!" woman-request)
(WoMan-warn-ignored woman-request "ignored!")
(setq fn 'woman2-format-paragraphs))))
()
;; Find next control line:
- (set-marker to (woman-find-next-control-line))
+ (if (equal woman-request "TS")
+ (set-marker to (woman-find-next-control-line "TE"))
+ (set-marker to (woman-find-next-control-line)))
;; Call the appropriate function:
(funcall fn to)))
(if (not (eobp)) ; This should not happen, but ...
(fset 'insert-and-inherit insert-and-inherit)
(set-marker to nil))))
-(defun woman-find-next-control-line ()
- "Find and return start of next control line."
-; (let ((to (save-excursion
-; (re-search-forward "^\\." nil t))))
-; (if to (1- to) (point-max)))
- (let (to)
+(defun woman-find-next-control-line (&optional pat)
+ "Find and return start of next control line.
+PAT, if non-nil, specifies an additional component of the control
+line regexp to search for, which is appended to the default
+regexp, \"\\(\\\\c\\)?\\n[.']\"."
+ (let ((pattern (concat "\\(\\\\c\\)?\n[.']" pat))
+ to)
(save-excursion
;; Must handle
;; ...\c
;; BEWARE THAT THIS CODE MAY BE UNRELIABLE!!!!!
(while
(and
- (setq to (re-search-forward "\\(\\\\c\\)?\n[.']" nil t))
+ (setq to (re-search-forward pattern nil t))
(match-beginning 1)
(looking-at "br"))
(goto-char (match-beginning 0))
(woman-delete-line 2)))
- (if to (1- to) (point-max))))
+ (if to
+ (- to (+ 1 (length pat)))
+ (point-max))))
(defun woman2-PD (to)
".PD d -- Set the interparagraph distance to d.
(insert (substring overlap i eol))
(setq i (or eol imax)))
)
- ((eq c ?\ ) ; skip
+ ((eq c ?\s) ; skip
(forward-char))
((eq c ?\t) ; skip
(if (eq (following-char) ?\t)
(forward-char) ; both tabs, just skip
(dotimes (i woman-tab-width)
(if (eolp)
- (insert ?\ ) ; extend line
+ (insert ?\s) ; extend line
(forward-char)) ; skip
)))
(t
- (if (or (eq (following-char) ?\ ) ; overwrite OK
+ (if (or (eq (following-char) ?\s) ; overwrite OK
overwritten) ; warning only once per ".sp -"
()
(setq overwritten t)
(defun woman2-process-escapes (to &optional numeric)
"Process remaining escape sequences up to marker TO, preserving point.
Optional argument NUMERIC, if non-nil, means the argument is numeric."
- (assert (and (markerp to) (marker-insertion-type to)))
+ (cl-assert (and (markerp to) (marker-insertion-type to)))
;; The first two cases below could be merged (maybe)!
(let ((from (point)))
;; Discard zero width filler character used to hide leading dots
(while (re-search-forward "\\\\[&|^]" to t)
(woman-delete-match 0)
;; If on a line by itself, consume newline as well (Bug#3651).
- (and (eq (char-before (match-beginning 0)) ?\n)
+ ;; But not in a .nf region, preserve all newlines in that case.
+ (and (not woman-nofill)
+ (eq (char-before (match-beginning 0)) ?\n)
(eq (char-after (match-beginning 0)) ?\n)
(delete-char 1)))
;; 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.
tab (- tab (if (eq type ?C) (/ n 2) n))) )
(setq n (- tab (current-column)))
(insert-char ?\s n))
- (insert ?\ ))))
+ (insert ?\s))))
(defun woman2-DT (to)
".DT -- Restore default tabs. Format paragraphs upto TO.
(if (eolp)
(woman-delete-whole-line) ; ignore!
(let ((delim (following-char))
- (pad ?\ ) end) ; pad defaults to space
+ (pad ?\s) end) ; pad defaults to space
(forward-char)
(skip-chars-forward " \t")
(or (eolp) (setq pad (following-char)))
(defun woman2-TS (to)
".TS -- Start of table code for the tbl processor.
Format paragraphs upto TO."
- ;; This is a preliminary hack that seems to suffice for lilo.8.
- (woman-delete-line 1) ; ignore any arguments
(when woman-emulate-tbl
;; Assumes column separator is \t and intercolumn spacing is 3.
;; The first line may optionally be a list of options terminated by
(woman-delete-line 1)
;; For each column, find its width and align it:
(let ((start (point)) (col 1))
+ (WoMan-log "%s" (buffer-substring start (+ start 40)))
+ ;; change T{ T} to tabs
+ (while (search-forward "T{\n" to t)
+ (replace-match "")
+ (catch 'end
+ (while (search-forward "\n" to t)
+ (replace-match " ")
+ (if (looking-at "T}")
+ (progn
+ (delete-char 2)
+ (throw 'end t))))))
+ (goto-char start)
+ ;; strip space and headers
+ (while (re-search-forward "^\\.TH\\|\\.sp" to t)
+ (woman-delete-whole-line))
+ (goto-char start)
(while (prog1 (search-forward "\t" to t) (goto-char start))
;; Find current column width:
(while (< (point) to)
(while (< (point) to)
(when (search-forward "\t" to t)
(delete-char -1)
- (insert-char ?\ (- col (current-column))))
+ (insert-char ?\s (- col (current-column))))
(forward-line))
+ (goto-char start))
+ ;; find maximum width
+ (let ((max-col 0))
+ (while (search-forward "\n" to t)
+ (backward-char)
+ (if (> (current-column) max-col)
+ (setq max-col (current-column)))
+ (forward-char))
+ (goto-char start)
+ ;; break lines if they are too long
+ (when (and (> max-col woman-fill-column)
+ (> woman-fill-column col))
+ (setq max-col woman-fill-column)
+ (woman-break-table col to start)
+ (goto-char start))
+ (while (re-search-forward "^_$" to t)
+ (replace-match (make-string max-col ?_)))
(goto-char start))))
;; Format table with no filling or adjusting (cf. woman2-nf):
(setq woman-nofill t)
;; ".TE -- End of table code for the tbl processor."
;; Turn filling and adjusting back on.
+(defun woman-break-table (start-column to start)
+ (while (< (point) to)
+ (move-to-column woman-fill-column)
+ (if (eolp)
+ (forward-line)
+ (if (and (search-backward " " start t)
+ (> (current-column) start-column))
+ (progn
+ (insert-char ?\n 1)
+ (insert-char ?\s (- start-column 5)))
+ (forward-line)))))
\f
;;; WoMan message logging:
;; 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)))
(buffer-substring (point)
(line-end-position))))
(if (and (> (length tail) 0)
- (/= (string-to-char tail) ?\ ))
+ (/= (string-to-char tail) ?\s))
(setq tail (concat " " tail)))
(WoMan-log-1
(concat "** " request tail " request " ignored))))
"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)
+\f
+;; Local Variables:
+;; coding: utf-8
+;; End:
+
;;; woman.el ends here
HCoop / bpt / emacs.git / blobdiff