;;; woman.el --- browse UN*X manual pages `wo (without) man'
-;; Copyright (C) 2000, 2001, 2002, 2003, 2004, 2005,
-;; 2006, 2007, 2008 Free Software Foundation, Inc.
+;; Copyright (C) 2000-2012 Free Software Foundation, Inc.
;; Author: Francis J. Wright <F.J.Wright@qmul.ac.uk>
;; Maintainer: FSF
;; Keywords: help, unix
;; Adapted-By: Eli Zaretskii <eliz@gnu.org>
-;; Version: see `woman-version'
+;; Version: 0.551
;; URL: http://centaur.maths.qmul.ac.uk/Emacs/WoMan/
;; This file is part of GNU Emacs.
;; (By default, WoMan will automatically define the dired keys "W" and
;; "w" when it loads, but only if they are not already defined. This
-;; behaviour is controlled by the user option `woman-dired-keys'.
+;; behavior is controlled by the user option `woman-dired-keys'.
;; Note that the `dired-x' (dired extra) package binds
;; `dired-copy-filename-as-kill' to the key "w" (as pointed out by Jim
;; Davidson), although "W" appears to be really unused. The `dired-x'
(eval-when-compile ; to avoid compiler warnings
(require 'dired)
- (require 'cl)
+ (require 'cl-lib)
(require 'apropos))
(defun woman-mapcan (fn x)
(parse-colon-path paths)))
((string-match "\\`[a-zA-Z]:" paths)
;; Assume single DOS-style path...
- paths)
+ (list paths))
(t
;; Assume UNIX/Cygwin-style path-list...
(woman-mapcan ; splice list into list
(defcustom woman-man.conf-path
(let ((path '("/usr/lib" "/etc")))
- (if (eq system-type 'windows-nt)
- (mapcar 'woman-Cyg-to-Win path)
- path))
+ (cond ((eq system-type 'windows-nt)
+ (mapcar 'woman-Cyg-to-Win path))
+ ((eq system-type 'darwin)
+ (cons "/usr/share/misc" path))
+ (t path)))
"List of dirs to search and/or files to try for man config file.
A trailing separator (`/' for UNIX etc.) on directories is
optional, and the filename is used if a directory specified is
(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)
-(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
+(defcustom woman-use-own-frame nil
"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
- `((((min-colors 88) (background light))
- (:slant italic :underline t :foreground "red1"))
- (((background light)) (:slant italic :underline t :foreground "red"))
- (((background dark)) (:slant italic :underline t)))
+ '((t :inherit italic))
"Face for italic font in man pages."
:group 'woman-faces)
-;; backward-compatibility alias
-(put 'woman-italic-face 'face-alias 'woman-italic)
+(define-obsolete-face-alias 'woman-italic-face 'woman-italic "22.1")
(defface woman-bold
- '((((min-colors 88) (background light)) (:weight bold :foreground "blue1"))
- (((background light)) (:weight bold :foreground "blue"))
- (((background dark)) (:weight bold :foreground "green2")))
+ '((t :inherit bold))
"Face for bold font in man pages."
:group 'woman-faces)
-;; backward-compatibility alias
-(put 'woman-bold-face 'face-alias 'woman-bold)
+(define-obsolete-face-alias 'woman-bold-face 'woman-bold "22.1")
-;; 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
- '((((background light)) (:foreground "brown"))
- (((min-colors 88) (background dark)) (:foreground "cyan1"))
- (((background dark)) (:foreground "cyan")))
+ '((t :inherit font-lock-warning-face))
"Face for all unknown fonts in man pages."
:group 'woman-faces)
-;; backward-compatibility alias
-(put 'woman-unknown-face 'face-alias 'woman-unknown)
+(define-obsolete-face-alias 'woman-unknown-face 'woman-unknown "22.1")
(defface woman-addition
- '((t (:foreground "orange")))
+ '((t :inherit font-lock-builtin-face))
"Face for all WoMan additions to man pages."
:group 'woman-faces)
-;; backward-compatibility alias
-(put 'woman-addition-face 'face-alias 'woman-addition)
+(define-obsolete-face-alias 'woman-addition-face 'woman-addition "22.1")
(defun woman-default-faces ()
"Set foreground colors of italic and bold faces to their default values."
(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."
(woman-find-file file-name)
(message
"WoMan Error: No matching manual files found in search path")
- (ding))
- )
+ (ding)))
(message "WoMan Error: No topic specified in non-interactive call")
- (ding))
- )
+ (ding)))
;; Allow WoMan to be called via the standard Help menu:
(define-key-after menu-bar-manuals-menu [woman]
be found. Optional argument RE-CACHE, if non-nil, forces the
cache to be re-read."
;; Handle the caching of the directory and topic lists:
- (if (and (not re-cache)
- (or
- (and woman-expanded-directory-path woman-topic-all-completions)
- (woman-read-directory-cache)))
- ()
+ (unless (and (not re-cache)
+ (or
+ (and woman-expanded-directory-path woman-topic-all-completions)
+ (woman-read-directory-cache)))
(message "Building list of manual directory expansions...")
(setq woman-expanded-directory-path
(woman-expand-directory-path woman-manpath woman-path))
;; 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
'woman-topic-history
default))))
;; Note that completing-read always returns a string.
- (if (= (length topic) 0)
- nil ; no topic, so no file!
+ (unless (= (length topic) 0)
(cond
((setq files (woman-file-name-all-completions topic)))
;; Complete topic more carefully, i.e. use the completion
(not (member (car cdr_list) (cdr cdr_list)))
(funcall predicate (car cdr_list)))
(setq list cdr_list)
- (setcdr list (cdr cdr_list)))
- )
+ (setcdr list (cdr cdr_list))))
newlist)))
(defun woman-file-readable-p (dir)
(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
path (cdr path))
(if (woman-not-member dir path) ; use each directory only once!
(setq files (nconc files
- (directory-files dir t topic-regexp))))
- ))
- (mapcar 'list files)
- ))
+ (directory-files dir t topic-regexp))))))
+ (mapcar 'list files)))
\f
;;; dired support
;;; 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.")
(or exists
(setq woman-buffer-alist
(cons (cons file-name bufname) woman-buffer-alist)
- woman-buffer-number 0))
- )))
+ woman-buffer-number 0)))))
(Man-build-section-alist)
(Man-build-references-alist)
(goto-char (point-min)))
(defun woman-make-bufname (bufname)
"Create an unambiguous buffer name from BUFNAME."
- (let ((dot (string-match "\\." bufname)))
+ ;; See Bug#5038. Any compression extension has already been removed.
+ ;; Go from eg "host.conf.5" to "5 host.conf".
+ (let ((dot (string-match "\\.[^.]*\\'" bufname)))
(if dot (setq bufname (concat
(substring bufname (1+ dot)) " "
(substring bufname 0 dot))))
(goto-char (point-min))
(forward-line)
(while (re-search-forward "^\\( \\)?\\([A-Z].*\\)" nil t)
- (woman-set-face (match-beginning 2) (match-end 2) 'woman-bold))))
- )
+ (woman-set-face (match-beginning 2) (match-end 2) 'woman-bold)))))
(defun woman-insert-file-contents (filename compressed)
"Insert file FILENAME into the current buffer.
(file-error
;; Run find-file-not-found-hooks until one returns non-nil.
;; (run-hook-with-args-until-success 'find-file-not-found-hooks)
- (insert "\n***** File " filename " not found! *****\n\n")
- )))
- )))
+ (insert "\n***** File " filename " not found! *****\n\n")))))))
\f
;;; Major mode (Man) interface:
(setq woman-emulation value)
(woman-reformat-last-file))
+(defvar bookmark-make-record-function)
(put 'woman-mode 'mode-class 'special)
(defun woman-mode ()
(fset 'Man-build-page-list Man-build-page-list)
(fset 'Man-strip-page-headers Man-strip-page-headers)
(fset 'Man-unindent Man-unindent)
- (fset 'Man-goto-page Man-goto-page)))
+ (fset 'Man-goto-page Man-goto-page)
+ (setq tab-width woman-tab-width)))
(setq major-mode 'woman-mode
mode-name "WoMan")
;; Don't show page numbers like Man-mode does. (Online documents do
;; `make-local-variable' in case imenu not yet loaded!
woman-imenu-generic-expression)
(set (make-local-variable 'imenu-space-replacement) " ")
+ ;; Bookmark support.
+ (set (make-local-variable 'bookmark-make-record-function)
+ 'woman-bookmark-make-record)
;; For reformat ...
;; necessary when reformatting a file in its old buffer:
(setq imenu--last-menubar-index-alist nil)
(interactive)
(setq woman-fill-frame (not woman-fill-frame))
(message "Woman fill column set to %s."
- (if woman-fill-frame "frame width" woman-fill-column)
- ))
+ (if woman-fill-frame "frame width" woman-fill-column)))
(defun woman-mini-help ()
"Display WoMan commands and user options in an `apropos' buffer."
(require 'apropos)
(let ((message
(let ((standard-output (get-buffer-create "*Apropos*")))
- (print-help-return-message 'identity))))
+ (help-print-return-message 'identity))))
(setq apropos-accumulator
(apropos-internal "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>
(setcdr prev-ptr (cdr (cdr prev-ptr)))
(if (>= woman-buffer-number (length woman-buffer-alist))
(setq woman-buffer-number 0))
- nil)
- )))
+ nil))))
\f
;;; Syntax and display tables:
(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.
(woman-delete-match 0)
(WoMan-warn
"Terminal vertical motion escape \\%s ignored!" esc)))
- (setq first (not first))
- )))
-
-; ;; \h'+/-N' local horizontal motion.
-; ;; N may include width escape \w'...'
-; ;; Implement arbitrary forward motion and non-overlapping backward
-; ;; motion.
-; (goto-char from)
-; (while (re-search-forward
-; ;; Delimiter can be a special char escape sequence \(.. or
-; ;; a single normal char (usually '):
-; "\\\\h\\(\\\\(..\\|.\\)\\(|\\)?"
-; nil t)
-; (let ((from (match-beginning 0))
-; (delim (regexp-quote (match-string 1)))
-; (absolute (match-string 2)) ; absolute position?
-; (N (woman-parse-numeric-arg)) ; distance
-; to
-; msg) ; for warning
-; (if (not (looking-at delim))
-; ;; Warn but leave escape in buffer unprocessed:
-; (WoMan-warn
-; "Local horizontal motion (%s) delimiter error!"
-; (buffer-substring from (1+ (point)))) ; point at end of arg
-; (setq to (match-end 0)
-; ;; For possible warning -- save before deleting:
-; msg (buffer-substring from to))
-; (delete-region from to)
-; (if absolute ; make relative
-; (setq N (- N (current-column))))
-; (if (>= N 0)
-; ;; Move forward by inserting hard spaces:
-; (insert-char woman-unpadded-space-char N)
-; ;; Move backwards by deleting space,
-; ;; first backwards then forwards:
-; (while (and
-; (<= (setq N (1+ N)) 0)
-; (cond ((memq (preceding-char) '(?\ ?\t))
-; (delete-backward-char 1) t)
-; ((memq (following-char) '(?\ ?\t))
-; (delete-char 1) t)
-; (t nil))))
-; (if (<= N 0)
-; (WoMan-warn
-; "Negative horizontal motion (%s) would overwrite!" msg))))
-; ))
+ (setq first (not first)))))
;; Process formatting macros
(goto-char from)
(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))
- (delete-backward-char 1) t)
- ((memq (following-char) '(?\ ?\t))
+ (cond ((memq (preceding-char) '(?\s ?\t))
+ (delete-char -1) t)
+ ((memq (following-char) '(?\s ?\t))
(delete-char 1) t)
(t nil))))
(if (<= N 0)
(WoMan-warn
- "Negative horizontal motion (%s) would overwrite!" msg))))
- ))
+ "Negative horizontal motion (%s) would overwrite!" msg))))))
(goto-char from)))
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
(delete-region from (point))
(WoMan-warn
"ig request ignored -- terminator `.%s' not found!" yy)
- (woman-delete-line 1))
- ))
+ (woman-delete-line 1))))
(defsubst woman0-process-escapes (from to)
"Process escapes within an if/ie condition between FROM and TO."
(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)))
(woman0-process-escapes from woman0-if-to)
(woman-parse-numeric-arg))))
(setq c (> n 0))
- (goto-char from))
- )
+ (goto-char from)))
(if (eq c 0)
(woman-if-ignore woman0-if-to request) ; ERROR!
- (woman-if-body request woman0-if-to (eq c negated)))
- ))
+ (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.
(delete-region (if delete from (match-beginning 0)) (point))
(if (looking-at "^$") (delete-char 1))
))
- (delete (woman-delete-line 1)) ; single-line
- )
+ (delete (woman-delete-line 1))) ; single-line
;; Process matching .el anything:
- (cond ((string= request "ie")
+ (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))))
- )
- (goto-char from)
- ))
+;;; ((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 ()
"Isolated .el request -- should not happen!"
(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!")
;; 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))
(to (copy-marker (+ from length) t)))
(woman-pre-process-region from to)
(set-marker to nil)
- (goto-char from)
- )))
+ (goto-char from))))
\f
;;; Process macro definitions:
(setq beg (point)
end (progn (woman-forward-arg 'unquote) (point))
new (buffer-substring beg end)
- woman0-rename-alist (cons (cons new old) woman0-rename-alist)))
- ))
+ woman0-rename-alist (cons (cons new old) woman0-rename-alist)))))
(woman-delete-whole-line))
(defun woman0-rename ()
(setq woman0-macro-alist (cons macro woman0-macro-alist))
(forward-line)
(delete-region from (point))
- (backward-char) ; return to end of .de/am line
- ))
+ (backward-char))) ; return to end of .de/am line
(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."
;; Replace formal arg with actual arg:
(setq start nil)
(while (setq start (string-match formal-arg macro start))
- (setq macro (replace-match actual-arg t t macro)))
- )
+ (setq macro (replace-match actual-arg t t macro))))
;; Delete any remaining formal arguments:
(setq start nil)
(while
(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))
(delete-region beg (point))
(setq woman-string-alist
(cons (cons stringname "")
- woman-string-alist))))
- ))
- ))
- ))
- ))
+ woman-string-alist))))))))))))
\f
;;; Process special character escapes \(xx:
("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
(WoMan-warn (concat "Special character "
(if (match-beginning 1) "\\(%s" "\\[%s]")
" not interpolated!") name)
- (if woman-ignore (woman-delete-match 0))))
- ))
+ (if woman-ignore (woman-delete-match 0))))))
(defun woman-display-extended-fonts ()
"Display table of glyphs of graphic characters and their octal codes.
(insert " ")
(setq i (1+ i))
(when (= i 128) (setq i 160) (insert "\n"))
- (if (zerop (% i 8)) (insert "\n")))
- ))
- (print-help-return-message)))
+ (if (zerop (% i 8)) (insert "\n")))))
+ (help-print-return-message)))
\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) '(?. ?')))
- (insert "\\&"))
- )
- )))))
+ (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
- (insert "\\fR")
- ))
+ (woman-forward-arg woman1-unquote 'concat))
+ (insert "\\fR")))
(defun woman-forward-arg (&optional unquote concat)
"Move forward over one ?roff argument, optionally unquoting and/or joining.
(if unquote (delete-char 1) (forward-char))
(re-search-forward "\"\\|$"))
(if (eq (preceding-char) ?\")
- (if unquote (delete-backward-char 1))
- (WoMan-warn "Unpaired \" in .%s arguments." request)
- ))
+ (if unquote (delete-char -1))
+ (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!
((eq concat 'noskip)) ; do not skip following whitespace
- (t (woman-delete-following-space)))
- )
+ (t (woman-delete-following-space))))
;; The following requests are not explicit font-change requests and
(woman-delete-whole-line)
(insert ".ft I\n")
(forward-line N)
- (insert ".ft R\n")
- ))
+ (insert ".ft R\n")))
;;; Other non-breaking requests:
(save-excursion
(while (and (re-search-forward c nil t)
(match-beginning 1))
- (delete-char -1)))
- ))
+ (delete-char -1)))))
(put 'woman1-hw 'notfont t)
(defun woman1-hw ()
fescape t)
(woman-match-name))
(t (setq notfont t)))
- (if notfont
- ()
+ (unless notfont
;; Get font name:
(or font
(let ((fontstring (match-string 0)))
(setq current-font font)
)))
;; Set font after last request up to eob:
- (woman-set-face previous-pos (point) current-font)
- ))
+ (woman-set-face previous-pos (point) current-font)))
(defun woman-set-face (from to face)
"Set the face of the text from FROM to TO to face FACE.
(put-text-property from (point) 'face face-no-ul)
(setq from (point))
)))
- (put-text-property from to 'face face))
- ))
+ (put-text-property from to 'face face))))
\f
;;; Output translation:
-(defvar translations nil) ; Also bound locally by woman2-roff-buffer
-;; A list of the form (\"[ace]\" (a . b) (c . d) (e . ?\ )) or nil.
+;; 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 . ?\s)) or nil.
(defun woman-get-next-char ()
"Return and delete next char in buffer, including special chars."
;; 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)
- ))
+ (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))
(while (re-search-forward matches to t)
;; Done like this to retain text properties and
;; support translation of special characters:
(buffer-substring-no-properties
(match-beginning 0) (match-end 0))
alist)))
- (woman-delete-match 0))
- )))
+ (woman-delete-match 0)))))
\f
;;; Registers:
; (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
))
(if (re-search-forward delim nil t)
;; Return width of string:
(- (match-beginning 0) from)
- (WoMan-warn "Width escape delimiter error!"))))
- )))
+ (WoMan-warn "Width escape delimiter error!")))))))
(if (null n)
;; ERROR -- should handle this better!
(progn
(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))
;; in which case do nothing and return nil.
)
(goto-char (match-end 0)))
- (if (numberp n) (round n) n))
- )))
+ (if (numberp n) (round n) n)))))
\f
;;; VERTICAL FORMATTING -- Formatting macros that cause a break:
(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)
(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.
(defsubst woman-interparagraph-space ()
"Set variable `woman-leave-blank-lines' from `woman-interparagraph-distance'."
-; (if (> woman-interparagraph-distance 0)
-; (forward-line 1) ; leave 1 blank line
-; (woman-delete-line 1)) ; do not leave blank line
- (setq woman-leave-blank-lines woman-interparagraph-distance)
- )
+ (setq woman-leave-blank-lines woman-interparagraph-distance))
(defun woman2-TH (to)
".TH n c x v m -- Begin a man page. Format paragraphs upto TO.
(let ((start (point)) here)
(while (not (eolp))
(cond ((looking-at "\"\"[ \t]")
- (delete-char 2)
- ;; (delete-horizontal-space)
- ))
+ (delete-char 2)))
(delete-horizontal-space)
(setq here (point))
(insert " -- ")
(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
(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)
"Character(s) overwritten by negative vertical spacing in line %d"
(count-lines 1 (point))))
(delete-char 1) (insert (substring overlap i (1+ i)))))
- (setq i (1+ i))
- ))
- )))
+ (setq i (1+ i)))))))
\f
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(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
- ;; and zero width characters \|, \^:
+ ;; and zero width characters.
(while (re-search-forward "\\\\[&|^]" to t)
- (woman-delete-match 0))
+ (woman-delete-match 0)
+ ;; If on a line by itself, consume newline as well (Bug#3651).
+ ;; 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)))
+
(goto-char from)
;; Interrupt text processing -- CONTINUE current text with the
;; next text line (after any control lines, unless processing to
;; 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, \' -> `
(delete-char 1)
(insert ?`))))
((eq c ?\( )) ; uninterpreted special character
- ; \(.. -- do nothing
+ ; \(.. -- do nothing
((eq c ?t) ; non-interpreted tab \t
(delete-char 1)
(delete-char -1)
(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
(c (if (< (point) to) (following-char) ?_)))
(delete-region from to)
(delete-char 1)
- (insert (make-string N c))
- ))
+ (insert (make-string N c))))
;;; 4. Text Filling, Adjusting, and Centering
(defun woman2-nf (to)
".nf -- Nofill. Subsequent lines are neither filled nor adjusted.
Input text lines are copied directly to output lines without regard
-for the current line length. Format paragraphs upto TO."
+for the current line length. Format paragraphs up to TO."
(setq woman-nofill t)
(woman-delete-line 1) ; ignore any arguments
(woman2-format-paragraphs to))
(progn (skip-syntax-forward " ")
(beginning-of-line)
(point)))
- (if woman-nospace
- ()
+ (unless woman-nospace
(if (or (null leave) (eq leave 0))
;; output any `pending' vertical space ...
(setq leave woman-leave-blank-lines))
- (if (and leave (> leave 0)) (insert-before-markers ?\n))
- )
- (setq woman-leave-blank-lines nil)
- )
+ (if (and leave (> leave 0)) (insert-before-markers ?\n)))
+ (setq woman-leave-blank-lines nil))
;; `fill-region-as-paragraph' in `fill.el' appears to be the principal
;; text filling function, so that is what I use here.
(skip-syntax-forward " ")
;; Successive control lines are sufficiently common to be worth a
;; special case (maybe):
- (if (>= (point) to) ; >= as a precaution!
- ()
- ;; (woman-leave-blank-lines)
+ (unless (>= (point) to)
(woman-reset-nospace)
- ;; (woman2-process-escapes to) ; 7 October 1999
(woman2-process-escapes to 'numeric)
(if woman-nofill
;; Indent without filling or adjusting ...
(progn
(woman-leave-blank-lines)
- (cond (woman-temp-indent
- (indent-to woman-temp-indent)
- (forward-line)))
+ (when woman-temp-indent
+ (indent-to woman-temp-indent)
+ (forward-line))
(indent-rigidly (point) to left-margin)
- (woman-horizontal-escapes to)) ; 7 October 1999
+ (woman-horizontal-escapes to))
;; Fill and justify ...
;; Blank lines and initial spaces cause a break.
-; (cond ((and (= (point) to) (not (looking-at ".nf"))) ; Yuk!!!
-; ;; No text after a request that caused a break, so delete
-; ;; any spurious blank line left:
-; (forward-line -1)
-; (if (looking-at "^\\s *$") (kill-line) (forward-line))))
(while (< (point) to)
(woman-leave-blank-lines)
(let ((from (point)))
(woman-horizontal-escapes to) ; 7 October 1999
;; Find the beginning of the next paragraph:
(forward-line)
-; (if (re-search-forward "\\(^\\s *$\\)\\|\\(^\\s +\\)" to 1)
-; ;; A blank line should leave a space like .sp 1 (p. 14).
-; (if (eolp)
-; (progn
-; (skip-syntax-forward " ")
-; (setq woman-leave-blank-lines 1))
-; (setq woman-leave-blank-lines nil)))
(and (re-search-forward "\\(^\\s *$\\)\\|\\(^\\s +\\)" to 1)
;; A blank line should leave a space like .sp 1 (p. 14).
(eolp)
;; If a single short line then just leave it.
;; This is necessary to preserve some table layouts.
;; PROBABLY NOT NECESSARY WITH SQUEEZE MODIFICATION !!!!!
- (if (or (> (count-lines from (point)) 1)
+ (when (or (> (count-lines from (point)) 1)
+ (save-excursion
+ (backward-char)
+ (> (current-column) fill-column)))
+ ;; NOSQUEEZE has no effect if JUSTIFY is full, so redefine
+ ;; canonically-space-region, see above.
+ (if (and woman-temp-indent (< woman-temp-indent left-margin))
+ (let ((left-margin woman-temp-indent))
+ (fill-region-as-paragraph from (point) woman-justify)
(save-excursion
- (backward-char)
- (> (current-column) fill-column)))
- ;; ?roff does not squeeze multiple spaces
- ;; (fill-region-as-paragraph from (point) woman-justify t)
- ;; NOSQUEEZE has no effect if JUSTIFY is full, so
- ;; redefine canonically-space-region, see above.
- (progn
- ;; Needs a re-write of the paragraph formatter to
- ;; avoid this nonsense to handle temporary indents!
- (if (and woman-temp-indent (< woman-temp-indent left-margin))
- (let ((left-margin woman-temp-indent))
- (fill-region-as-paragraph from (point) woman-justify)
- (save-excursion
- (goto-char from)
- (forward-line)
- (setq from (point)))))
- (fill-region-as-paragraph from (point) woman-justify))
- )
- ;; A blank line should leave a space like .sp 1 (p. 14).
- ;; Delete all but 1 trailing blank lines:
- ;;(woman-leave-blank-lines 1)
- ))
- )
- (setq woman-temp-indent nil)
- ;; Non-white-space text has been processed, so ...
- ;;(setq woman-leave-blank-lines nil)
- ))
+ (goto-char from)
+ (forward-line)
+ (setq from (point)))))
+ (fill-region-as-paragraph from (point) woman-justify)))))
+ (setq woman-temp-indent nil)))
\f
;;; Tagged, indented and hanging paragraphs:
(if (string= (match-string 1) "ta") ; for GetInt.3
(woman2-ta to)
(woman-set-interparagraph-distance)))
- (set-marker to (woman-find-next-control-line-carefully))
- ))
+ (set-marker to (woman-find-next-control-line-carefully))))
(let ((tag (point)))
(woman-reset-nospace)
;; Cannot simply delete (current-column) whitespace
;; characters because some may be tabs!
(insert-char ?\s i)))
- (goto-char to) ; necessary ???
- ))
- ))
+ (goto-char to)))))
(defun woman2-HP (to)
".HP i -- Set prevailing indent to i. Format paragraphs upto TO.
(let ((i (woman2-get-prevailing-indent)))
(woman-interparagraph-space)
(setq woman-temp-indent woman-left-margin)
- (woman2-format-paragraphs to (+ woman-left-margin i))
- ))
+ (woman2-format-paragraphs to (+ woman-left-margin i))))
(defun woman2-get-prevailing-indent (&optional leave-eol)
"Set prevailing indent to integer argument at point, and return it.
(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 stop columns or pairs (COLUMN . TYPE) where TYPE is R or C."
;; Based on tab-to-tab-stop in indent.el.
;; R & C tabs probably not quite right!
- (delete-backward-char 1)
+ (delete-char -1)
(let ((tabs tab-stop-list))
(while (and tabs (>= (current-column)
(woman-get-tab-stop (car tabs))))
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))
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)))
(delete-char 1)
(insert woman-unpadded-space-char)
(goto-char (match-end 0))
- (delete-backward-char 1)
+ (delete-char -1)
(insert-before-markers woman-unpadded-space-char)
(subst-char-in-region
(match-beginning 0) (match-end 0)
- pad woman-unpadded-space-char t)
- ))
- ))
+ pad woman-unpadded-space-char t)))))
(woman2-format-paragraphs to))
\f
(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)))
(concat "file " WoMan-current-file)
(concat "buffer " WoMan-current-buffer))
" at " (current-time-string) "\n")
- (setq WoMan-Log-header-point-max (point-max))
- )))
+ (setq WoMan-Log-header-point-max (point-max)))))
(defun WoMan-log (format &rest args)
"Log a message out of FORMAT control string and optional ARGS."
(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) ?\ ))
+ (/= (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*.
(cond (WoMan-Log-header-point-max
(goto-char WoMan-Log-header-point-max)
(forward-line -1)
- (recenter 0)))
- )))))
+ (recenter 0))))))))
nil) ; for woman-file-readable-p etc.
+;;; Bookmark Woman support.
+(declare-function bookmark-make-record-default
+ "bookmark" (&optional no-file no-context posn))
+(declare-function bookmark-prop-get "bookmark" (bookmark prop))
+(declare-function bookmark-default-handler "bookmark" (bmk))
+(declare-function bookmark-get-bookmark-record "bookmark" (bmk))
+
+;; FIXME: woman.el and man.el should be better integrated so, for
+;; example, bookmarks of one can be used with the other.
+
+(defun woman-bookmark-make-record ()
+ "Make a bookmark entry for a Woman buffer."
+ `(,(Man-default-bookmark-title)
+ ,@(bookmark-make-record-default 'no-file)
+ (location . ,(concat "woman " woman-last-file-name))
+ ;; Use the same form as man's bookmarks, as much as possible.
+ (man-args . ,woman-last-file-name)
+ (handler . woman-bookmark-jump)))
+
+;;;###autoload
+(defun woman-bookmark-jump (bookmark)
+ "Default bookmark handler for Woman buffers."
+ (let* ((file (bookmark-prop-get bookmark 'man-args))
+ ;; FIXME: we need woman-find-file-noselect, since
+ ;; save-window-excursion can't protect us from the case where
+ ;; woman-find-file creates a new frame.
+ (buf (save-window-excursion
+ (woman-find-file file) (current-buffer))))
+ (bookmark-default-handler
+ `("" (buffer . ,buf) . ,(bookmark-get-bookmark-record bookmark)))))
+
(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