;;; 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, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008,
+;; 2009, 2010 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.
-;; GNU Emacs is free software; you can redistribute it and/or modify
+;; GNU Emacs is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 3, or (at your option)
-;; any later version.
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs; see the file COPYING. If not, write to the
-;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
+;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
;; (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'
;; The *WoMan-Log* buffer
;; ======================
-;; This is modelled on the byte-compiler. It logs all files formatted
+;; This is modeled on the byte-compiler. It logs all files formatted
;; by WoMan, and if WoMan finds anything that it cannot handle then it
;; writes a warning to this buffer. If the variable `woman-show-log'
;; is non-nil (by default it is `nil') then WoMan automatically
(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
;; Assume no `cygpath' program available.
;; Hack /cygdrive/x/ or /x/ or (obsolete) //x/ to x:/
(when (string-match "\\`\\(/cygdrive\\|/\\)?/./" file)
- (if (match-string 1) ; /cygdrive/x/ or //x/ -> /x/
+ (if (match-beginning 1) ; /cygdrive/x/ or //x/ -> /x/
(setq file (substring file (match-end 1))))
(aset file 0 (aref file 1)) ; /x/ -> xx/
(aset file 1 ?:)) ; xx/ -> x:/
:group 'help)
(defcustom woman-show-log nil
- "*If non-nil then show the *WoMan-Log* buffer if appropriate.
+ "If non-nil then show the *WoMan-Log* buffer if appropriate.
I.e. if any warning messages are written to it. Default is nil."
:type 'boolean
:group 'woman)
(defcustom woman-pre-format-hook nil
- "*Hook run by WoMan immediately before formatting a buffer.
+ "Hook run by WoMan immediately before formatting a buffer.
Change only via `Customization' or the function `add-hook'."
:type 'hook
:group 'woman)
(defcustom woman-post-format-hook nil
- "*Hook run by WoMan immediately after formatting a buffer.
+ "Hook run by WoMan immediately after formatting a buffer.
Change only via `Customization' or the function `add-hook'."
:type 'hook
:group 'woman)
(defcustom woman-man.conf-path
(let ((path '("/usr/lib" "/etc")))
- (if (eq system-type 'windows-nt)
- (mapcar 'woman-Cyg-to-Win path)
- path))
- "*List of dirs to search and/or files to try for man config file.
+ (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
the first to start with \"man\" and has an extension starting
MANPATH_MAP[ \t]+\\(\\S-+\\)[ \t]+\\(\\S-+\\)\\)" nil t)
(add-to-list 'manpath
(if (match-beginning 1)
- (match-string 1)
+ (match-string 1)
(cons (match-string 2)
(match-string 3)))))
manpath))
(setq path (cdr path)))
(nreverse manpath)))
+;; Autoload so set-locale-environment can operate on it.
+;;;###autoload
+(defcustom woman-locale nil
+ "String specifying a manual page locale, or nil.
+If a manual page is available in the specified locale
+\(e.g. \"sv_SE.ISO8859-1\"), it will be offered in preference to the
+default version. Normally, `set-locale-environment' sets this at startup."
+ :type '(choice string (const nil))
+ :group 'woman-interface
+ :version "23.1")
+
+;; FIXME Is this a sensible list of alternatives?
+(defun woman-expand-locale (locale)
+ "Expand a locale into a list suitable for man page lookup.
+Expands a locale of the form LANGUAGE_TERRITORY.CHARSET into the list:
+LANGUAGE_TERRITORY.CHARSET LANGUAGE_TERRITORY LANGUAGE.CHARSET LANGUAGE.
+The TERRITORY and CHARSET portions may be absent."
+ (string-match "\\([^._]*\\)\\(_[^.]*\\)?\\(\\..*\\)?" locale)
+ (let ((lang (match-string 1 locale))
+ (terr (match-string 2 locale))
+ (charset (match-string 3 locale)))
+ (delq nil (list locale
+ (and charset terr (concat lang terr))
+ (and charset terr (concat lang charset))
+ (if (or charset terr) lang)))))
+
+(defun woman-manpath-add-locales (manpath)
+ "Add locale-specific subdirectories to the elements of MANPATH.
+MANPATH is a list of the form of `woman-manpath'. Returns a list
+with those locale-specific subdirectories specified by the action
+of `woman-expand-locale' on `woman-locale' added, where they exist."
+ (if (zerop (length woman-locale))
+ manpath
+ (let ((subdirs (woman-expand-locale woman-locale))
+ lst dir)
+ (dolist (elem manpath (nreverse lst))
+ (dolist (sub subdirs)
+ (when (file-directory-p
+ (setq dir
+ ;; Use f-n-a-d because parse-colon-path does.
+ (file-name-as-directory
+ (expand-file-name sub (substitute-in-file-name
+ (if (consp elem)
+ (cdr elem)
+ elem))))))
+ (add-to-list 'lst (if (consp elem)
+ (cons (car elem) dir)
+ dir))))
+ ;; Non-locale-specific has lowest precedence.
+ (add-to-list 'lst elem)))))
+
(defcustom woman-manpath
- (or (woman-parse-colon-path (getenv "MANPATH"))
+ ;; Locales could also be added in woman-expand-directory-path.
+ (or (woman-manpath-add-locales
+ (woman-parse-colon-path (getenv "MANPATH")))
'("/usr/man" "/usr/share/man" "/usr/local/man"))
- "*List of DIRECTORY TREES to search for UN*X manual files.
+ "List of DIRECTORY TREES to search for UN*X manual files.
Each element should be the name of a directory that contains
subdirectories of the form `man?', or more precisely subdirectories
selected by the value of `woman-manpath-man-regexp'. Non-directory
The MANPATH environment variable may be set using DOS semi-colon-
separated or UN*X/Cygwin colon-separated syntax (but not mixed)."
:type '(repeat (choice string (cons string string)))
+ :version "23.1" ; added woman-manpath-add-locales
:group 'woman-interface)
(defcustom woman-manpath-man-regexp "[Mm][Aa][Nn]"
(defcustom woman-path
(if (eq system-type 'ms-dos) '("$DJDIR/info" "$DJDIR/man/cat[1-9onlp]"))
- "*List of SPECIFIC DIRECTORIES to search for UN*X manual files.
+ "List of SPECIFIC DIRECTORIES to search for UN*X manual files.
For example
(\"/emacs/etc\").
:group 'woman-interface)
(defcustom woman-cache-level 2
- "*The level of topic caching.
+ "The level of topic caching.
1 - cache only the topic and directory lists
(the only level before version 0.34 - only for compatibility);
2 - cache also the directories for each topic
:group 'woman-interface)
(defcustom woman-cache-filename nil
- "*The full pathname of the WoMan directory and topic cache file.
+ "The full pathname of the WoMan directory and topic cache file.
It is used to save and restore the cache between sessions. This is
especially useful with remote-mounted man page files! The default
value of nil suppresses this action. The `standard' non-nil
:group 'woman-interface)
(defcustom woman-dired-keys t
- "*List of `dired' mode keys to define to run WoMan on current file.
+ "List of `dired' mode keys to define to run WoMan on current file.
E.g. '(\"w\" \"W\"), or any non-null atom to automatically define
\"w\" and \"W\" if they are unbound, or nil to do nothing.
Default is t."
(defcustom woman-imenu-generic-expression
'((nil "\n\\([A-Z].*\\)" 1) ; SECTION, but not TITLE
("*Subsections*" "^ \\([A-Z].*\\)" 1))
- "*Imenu support for Sections and Subsections.
+ "Imenu support for Sections and Subsections.
An alist with elements of the form (MENU-TITLE REGEXP INDEX) --
see the documentation for `imenu-generic-expression'."
:type 'sexp
:group 'woman-interface)
(defcustom woman-imenu nil
- "*If non-nil then WoMan adds a Contents menu to the menubar.
+ "If non-nil then WoMan adds a Contents menu to the menubar.
It does this by calling `imenu-add-to-menubar'. Default is nil."
:type 'boolean
:group 'woman-interface)
(defcustom woman-imenu-title "CONTENTS"
- "*The title to use if WoMan adds a Contents menu to the menubar.
+ "The title to use if WoMan adds a Contents menu to the menubar.
Default is \"CONTENTS\"."
:type 'string
:group 'woman-interface)
;; `woman-use-topic-at-point' may be let-bound when woman is loaded,
;; in which case its global value does not get defined.
;; `woman-file-name' sets it to this value if it is unbound.
- "*Default value for `woman-use-topic-at-point'."
+ "Default value for `woman-use-topic-at-point'."
:type '(choice (const :tag "Yes" t)
(const :tag "No" nil))
:group 'woman-interface)
(defcustom woman-use-topic-at-point woman-use-topic-at-point-default
- "*Control use of the word at point as the default topic.
+ "Control use of the word at point as the default topic.
If non-nil the `woman' command uses the word at point automatically,
without interactive confirmation, if it exists as a topic."
:type '(choice (const :tag "Yes" t)
(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'.")
(defcustom woman-uncompressed-file-regexp
"\\.\\([0-9lmnt]\\w*\\)" ; disallow no extension
- "*Do not change this unless you are sure you know what you are doing!
+ "Do not change this unless you are sure you know what you are doing!
Regexp used to select man source files (ignoring any compression extension).
The SysV standard man pages use two character suffixes, and this is
:group 'woman-interface)
(defcustom woman-file-compression-regexp
- "\\.\\(g?z\\|bz2\\)\\'"
- "*Do not change this unless you are sure you know what you are doing!
+ "\\.\\(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
- "*If non-nil then use a dedicated frame for displaying WoMan windows.
+(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
:group 'woman-interface)
:group 'woman)
(defcustom woman-fill-column 65
- "*Right margin for formatted text -- default is 65."
+ "Right margin for formatted text -- default is 65."
:type 'integer
:group 'woman-formatting)
(defcustom woman-fill-frame nil
;; Based loosely on a suggestion by Theodore Jump:
- "*If non-nil then most of the window width is used."
+ "If non-nil then most of the window width is used."
:type 'boolean
:group 'woman-formatting)
(defcustom woman-default-indent 5
- "*Default prevailing indent set by -man macros -- default is 5.
+ "Default prevailing indent set by -man macros -- default is 5.
Set this variable to 7 to emulate GNU man formatting."
:type 'integer
:group 'woman-formatting)
(defcustom woman-bold-headings t
- "*If non-nil then embolden section and subsection headings. Default is t.
+ "If non-nil then embolden section and subsection headings. Default is t.
Heading emboldening is NOT standard `man' behavior."
:type 'boolean
:group 'woman-formatting)
(defcustom woman-ignore t
- "*If non-nil then unrecognized requests etc. are ignored. Default is t.
+ "If non-nil then unrecognized requests etc. are ignored. Default is t.
This gives the standard ?roff behavior. If nil then they are left in
the buffer, which may aid debugging."
:type 'boolean
:group 'woman-formatting)
(defcustom woman-preserve-ascii t
- "*If non-nil, preserve ASCII characters in the WoMan buffer.
+ "If non-nil, preserve ASCII characters in the WoMan buffer.
Otherwise, to save time, some backslashes and spaces may be
represented differently (as the values of the variables
`woman-escaped-escape-char' and `woman-unpadded-space-char'
:group 'woman-formatting)
(defcustom woman-emulation 'nroff
- "*WoMan emulation, currently either nroff or troff. Default is nroff.
+ "WoMan emulation, currently either nroff or troff. Default is nroff.
Troff emulation is experimental and largely untested.
\(Add groff later?)"
:type '(choice (const nroff) (const troff))
(or (and (fboundp 'display-color-p) (display-color-p))
(and (fboundp 'display-graphic-p) (display-graphic-p))
(x-display-color-p))
- "*If non-nil then WoMan assumes that face support is available.
+ "If non-nil then WoMan assumes that face support is available.
It defaults to a non-nil value if the display supports either colors
or different fonts."
: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."
(let (symbol-fonts)
;; With NTEmacs 20.5, the PATTERN option to `x-list-fonts' does
;; not seem to work and fonts may be repeated, so ...
- (while fonts
- (and (string-match "-Symbol-" (car fonts))
- (not (member (car fonts) symbol-fonts))
- (setq symbol-fonts (cons (car fonts) symbol-fonts)))
- (setq fonts (cdr fonts)))
+ (dolist (font fonts)
+ (and (string-match "-Symbol-" font)
+ (not (member font symbol-fonts))
+ (setq symbol-fonts (cons font symbol-fonts))))
symbol-fonts))
+(declare-function x-list-fonts "xfaces.c"
+ (pattern &optional face frame maximum width))
+
(when woman-font-support
(make-face 'woman-symbol)
;; avoid unnecessarily upsetting the line spacing in NTEmacs 20.5!
(defcustom woman-use-extended-font t
- "*If non-nil then may use non-ASCII characters from the default font."
+ "If non-nil then may use non-ASCII characters from the default font."
:type 'boolean
:group 'woman-faces)
(defcustom woman-use-symbol-font nil
- "*If non-nil then may use the symbol font.
+ "If non-nil then may use the symbol font.
It is off by default, mainly because it may change the line spacing
\(in NTEmacs 20.5)."
:type 'boolean
"Symbol font(s), preferably same size as default when WoMan was loaded.")
(defcustom woman-symbol-font (car woman-symbol-font-list)
- "*A string describing the symbol font to use for special characters.
+ "A string describing the symbol font to use for special characters.
It should be compatible with, and the same size as, the default text font.
Under MS-Windows, the default is
\"-*-Symbol-normal-r-*-*-*-*-96-96-p-*-ms-symbol\"."
(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]
"Save the directory and topic cache.
It is saved to the file named by the variable `woman-cache-filename'."
(if woman-cache-filename
- (save-excursion ; to restore current buffer
+ (with-current-buffer (generate-new-buffer "WoMan tmp buffer")
;; Make a temporary buffer; name starting with space "hides" it.
- (let ((standard-output
- (set-buffer (generate-new-buffer "WoMan tmp buffer")))
+ (let ((standard-output (current-buffer))
(backup-inhibited t))
;; (switch-to-buffer standard-output t) ; only for debugging
(buffer-disable-undo standard-output)
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))
'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)
;; 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)))
- (let (dir head dirs path)
- (while woman-manpath
- (setq dir (car woman-manpath)
- woman-manpath (cdr woman-manpath))
+ (let (head dirs path)
+ (dolist (dir woman-manpath)
(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)))))
- (while woman-path
- (setq dir (car woman-path)
- woman-path (cdr woman-path))
+ (dolist (dir woman-path)
(if (or (null dir)
(null (setq dir (woman-canonicalize-dir dir)
head (file-name-directory dir)))
\(Note that this function changes the value of ALIST.)"
;; Replaces unreadably "optimized" O(n^2) implementation.
;; Instead we use sorting to merge stuff efficiently. -- dak
- (let (elt newalist)
+ (let (newalist)
;; Sort list into reverse order
(setq alist (sort alist (lambda(x y) (string< (car y) (car x)))))
;; merge duplicate keys.
(if (> woman-cache-level 1)
- (while alist
- (setq elt (pop alist))
+ (dolist (elt alist)
(if (equal (car elt) (caar newalist))
(unless (member (cdr elt) (cdar newalist))
(setcdr (car newalist) (cons (cdr elt)
(cdar newalist))))
(setcdr elt (list (cdr elt)))
(push elt newalist)))
- ;; woman-cache-level = 1 => elements are single-element lists ...
- (while alist
- (setq elt (pop alist))
+ ;; woman-cache-level = 1 => elements are single-element lists ...
+ (dolist (elt alist)
(unless (equal (car elt) (caar newalist))
(push elt newalist))))
newalist))
;; (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
;; Use cached path-info to locate files for each topic:
(let ((path-info (cdr (assoc topic topics)))
filename)
- (while path-info
- (setq dir (nth (car (car path-info)) path)
- filename (car (cdr (car path-info)))
- path-info (cdr path-info)
+ (dolist (elt path-info)
+ (setq dir (nth (car elt) path)
+ filename (car (cdr elt))
files (nconc files
;; Find the actual file name:
(if filename
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
"Define dired keys to run WoMan according to `woman-dired-keys'."
(if woman-dired-keys
(if (listp woman-dired-keys)
- (mapcar 'woman-dired-define-key woman-dired-keys)
+ (mapc 'woman-dired-define-key woman-dired-keys)
(woman-dired-define-key-maybe "w")
(woman-dired-define-key-maybe "W")))
(define-key-after (lookup-key dired-mode-map [menu-bar immediate])
(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))))
(select-frame
(or (and (frame-live-p woman-frame) woman-frame)
(setq woman-frame (make-frame)))))
- (switch-to-buffer (get-buffer-create bufname))
+ (set-buffer (get-buffer-create bufname))
+ (condition-case nil
+ (switch-to-buffer (current-buffer))
+ (error (pop-to-buffer (current-buffer))))
(buffer-disable-undo)
(setq buffer-read-only nil)
(erase-buffer) ; NEEDED for reformat
(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:
-(defvar woman-mode-map nil "Keymap for woman mode.")
-
-(unless woman-mode-map
- (setq woman-mode-map (make-sparse-keymap))
- (set-keymap-parent woman-mode-map Man-mode-map)
+(defvar woman-mode-map
+ (let ((map (make-sparse-keymap)))
+ (set-keymap-parent map Man-mode-map)
- (define-key woman-mode-map "R" 'woman-reformat-last-file)
- (define-key woman-mode-map "w" 'woman)
- (define-key woman-mode-map "\en" 'WoMan-next-manpage)
- (define-key woman-mode-map "\ep" 'WoMan-previous-manpage)
- (define-key woman-mode-map [M-mouse-2] 'woman-follow-word)
+ (define-key map "R" 'woman-reformat-last-file)
+ (define-key map "w" 'woman)
+ (define-key map "\en" 'WoMan-next-manpage)
+ (define-key map "\ep" 'WoMan-previous-manpage)
+ (define-key map [M-mouse-2] 'woman-follow-word)
- ;; We don't need to call `man' when we are in `woman-mode'.
- (define-key woman-mode-map [remap man] 'woman)
- (define-key woman-mode-map [remap man-follow] 'woman-follow))
+ ;; We don't need to call `man' when we are in `woman-mode'.
+ (define-key map [remap man] 'woman)
+ (define-key map [remap man-follow] 'woman-follow)
+ map)
+ "Keymap for woman mode.")
(defun woman-follow (topic)
"Get a Un*x manual page of the item under point and put it in a buffer."
(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)
;; necessary to avoid re-installing the same imenu:
(setq woman-imenu-done nil)
(if woman-imenu (woman-imenu))
- (let (buffer-read-only)
+ (let ((inhibit-read-only t))
(Man-highlight-references 'WoMan-xref-man-page))
(set-buffer-modified-p nil)
(run-mode-hooks 'woman-mode-hook))
(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)
- (or (commandp symbol)
- (user-variable-p symbol)))))
- ;; Filter out any inhibited symbols:
- (let ((tem apropos-accumulator))
- (while tem
- (if (get (car tem) 'apropos-inhibit)
- (setq apropos-accumulator (delq (car tem) apropos-accumulator)))
- (setq tem (cdr tem))))
+ (and
+ (or (commandp symbol)
+ (user-variable-p symbol))
+ (not (get symbol 'apropos-inhibit))))))
;; Find documentation strings:
(let ((p apropos-accumulator)
doc symbol)
(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:
(char-to-string woman-unpadded-space-char)
"Internal string representation of unpadded space characters.")
-(defvar woman-syntax-table nil
+(defvar woman-syntax-table
+ (let ((st (make-syntax-table)))
+ ;; The following internal chars must NOT have whitespace syntax:
+ (modify-syntax-entry woman-unpadded-space-char "." st)
+ (modify-syntax-entry woman-escaped-escape-char "." st)
+ st)
"Syntax table to support special characters used internally by WoMan.")
-(if woman-syntax-table
- ()
- (setq woman-syntax-table (make-syntax-table))
- ;; The following internal chars must NOT have whitespace syntax:
- (modify-syntax-entry woman-unpadded-space-char "." woman-syntax-table)
- (modify-syntax-entry woman-escaped-escape-char "." woman-syntax-table)
- )
-
(defun woman-set-buffer-display-table ()
"Set up a display table for a WoMan buffer.
This display table is used for displaying internal special characters, but
(goto-char from)
;; .eo turns off escape character processing
(while (re-search-forward "\\(\\\\[\\e]\\)\\|^\\.eo" to t) ; \\
- (if (match-string 1)
+ (if (match-beginning 1)
(replace-match woman-escaped-escape-string t t)
(woman-delete-whole-line)
;; .ec turns on escape character processing (and sets the
;; escape character to its argument, if any, which I'm ignoring
;; for now!)
(while (and (re-search-forward "\\(\\\\\\)\\|^\\.ec" to t) ; \
- (match-string 1))
+ (match-beginning 1))
(replace-match woman-escaped-escape-string t t))
;; ***** Need test for .ec arg and warning here! *****
(woman-delete-whole-line)))
(defun woman-non-underline-faces ()
"Prepare non-underlined versions of underlined faces."
(let ((face-list (face-list)))
- (while face-list
- (let* ((face (car face-list))
- (face-name (symbol-name face)))
+ (dolist (face face-list)
+ (let ((face-name (symbol-name face)))
(if (and (string-match "\\`woman-" face-name)
(face-underline-p face))
(let ((face-no-ul (intern (concat face-name "-no-ul"))))
(copy-face face face-no-ul)
- (set-face-underline-p face-no-ul nil))))
- (setq face-list (cdr face-list)))))
+ (set-face-underline-p face-no-ul nil)))))))
;; Preprocessors
;; =============
(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)
(delete-char -1) (insert ?\\))
(goto-char from)
(while (search-forward woman-unpadded-space-string nil t)
- (delete-char -1) (insert ?\ ))
- ))
+ (delete-char -1) (insert ?\ ))))
;; Must return the new end of file if used in format-alist.
(point-max)))
to t)
(let ((from (match-beginning 0))
(delim (regexp-quote (match-string 1)))
- (absolute (match-string 2)) ; absolute position?
+ (absolute (match-beginning 2)) ; absolute position?
(N (woman-parse-numeric-arg)) ; distance
to
msg) ; for warning
(while (and
(<= (setq N (1+ N)) 0)
(cond ((memq (preceding-char) '(?\ ?\t))
- (delete-backward-char 1) t)
+ (delete-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))))
- ))
+ "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))
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))
+ (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'.
(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.
;; Interpret bogus `el \}' as `el \{',
;; especially for Tcl/Tk man pages:
"\\(\\\\{\\|el[ \t]*\\\\}\\)\\|\\(\n[.']\\)?[ \t]*\\\\}[ \t]*")
- (match-string 1))
+ (match-beginning 1))
(re-search-forward "\\\\}"))
(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'.
(cond ((re-search-forward "^[.'][ \t]*el[ \t]*" nil t)
(woman-delete-match 0)
((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)
- ))
+ (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!")
(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 ()
"Effect renaming required by .rn requests."
;; For now, do this backwards AFTER all macro expansion.
- (while woman0-rename-alist
- (let* ((new (car woman0-rename-alist))
- (old (cdr new))
- (new (car new)))
- (setq woman0-rename-alist (cdr woman0-rename-alist))
+ (dolist (new woman0-rename-alist)
+ (let ((old (cdr new))
+ (new (car new)))
(goto-char (point-min))
(setq new (concat "^[.'][ \t]*" (regexp-quote new)))
(setq old (concat "." old))
(let (start)
(while (setq start (string-match woman-unescape-regex macro start))
(setq macro
- (if (match-string 1 macro)
+ (if (match-beginning 1)
(replace-match "" t t macro 1)
(replace-match "\\" t t macro))
start (1+ start)))
"Process .de/am xx yy -- (re)define/append macro xx; end at `..'.
\(Should be up to call of yy, which defaults to `.')
Optional argument APPEND, if non-nil, means append macro."
- ;; Modelled on woman-strings. BEWARE: Processing of .am is a hack!
+ ;; Modeled on woman-strings. BEWARE: Processing of .am is a hack!
;; Add support for .rm?
;; (skip-chars-forward " \t")
(if (eolp) ; ignore if no argument
(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
(while
;; Find .ds requests and \* escapes:
(re-search-forward "\\(^[.'][ \t]*ds\\)\\|\\\\\\*" to t)
- (cond ((match-string 1) ; .ds
+ (cond ((match-beginning 1) ; .ds
(skip-chars-forward " \t")
(if (eolp) ; ignore if no argument
()
(delete-region beg (point))
(setq woman-string-alist
(cons (cons stringname "")
- woman-string-alist))))
- ))
- ))
- ))
- ))
+ woman-string-alist))))))))))))
\f
;;; Process special character escapes \(xx:
((cadr replacement) ; Use ASCII simulation
(woman-replace-match (cadr replacement)))))
(WoMan-warn (concat "Special character "
- (if (match-string 1) "\\(%s" "\\[%s]")
+ (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.
Useful for constructing the alist variable `woman-special-characters'."
(interactive)
(with-output-to-temp-buffer "*WoMan Extended Font Map*"
- (save-excursion
- (set-buffer standard-output)
+ (with-current-buffer standard-output
(let ((i 32))
(while (< i 256)
(insert (format "\\%03o " i) (string i) " " (string i))
(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:
(setq c (concat "\\(" c "\\)\\|^[.'][ \t]*hc"))
(save-excursion
(while (and (re-search-forward c nil t)
- (match-string 1))
- (delete-char -1)))
- ))
+ (match-beginning 1))
+ (delete-char -1)))))
(put 'woman1-hw 'notfont t)
(defun woman1-hw ()
"^[.'][ \t]*\\(\\(\\ft\\)\\|\\(.P\\)\\)\\|\\(\\\\f\\)" nil 1)
(let (font beg notfont fescape)
;; Match font indicator and leave point at end of sequence:
- (cond ((match-string 2)
+ (cond ((match-beginning 2)
;; .ft request found
(setq beg (match-beginning 0))
(skip-chars-forward " \t")
(setq font previous-font)
(looking-at "[^ \t\n]+"))
(forward-line)) ; end of control line and \n
- ((match-string 3)
+ ((match-beginning 3)
;; Macro that resets font found
(setq font 'default))
- ((match-string 4)
+ ((match-beginning 4)
;; \f escape found
(setq beg (match-beginning 0)
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
+;; 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)
- ))
+ (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:
((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)
(while
(and
(setq to (re-search-forward "\\(\\\\c\\)?\n[.']" nil t))
- (match-string 1)
+ (match-beginning 1)
(looking-at "br"))
(goto-char (match-beginning 0))
(woman-delete-line 2)))
(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 " -- ")
(woman-forward-arg 'unquote 'concat)
;; Delete repeated arguments:
- (if (string-match (regexp-quote
- (buffer-substring here (point)))
+ (if (string-equal (buffer-substring here (point))
(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
((eq c ?\t) ; skip
(if (eq (following-char) ?\t)
(forward-char) ; both tabs, just skip
- (let ((i woman-tab-width))
- (while (> i 0)
- (if (eolp)
- (insert ?\ ) ; extend line
- (forward-char)) ; skip
- (setq i (1- i)))
+ (dotimes (i woman-tab-width)
+ (if (eolp)
+ (insert ?\ ) ; extend line
+ (forward-char)) ; skip
)))
(t
(if (or (eq (following-char) ?\ ) ; overwrite OK
"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
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; 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).
+ (and (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
(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)
(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)
;; Necessary to avoid spaces inheriting underlines.
;; Cannot simply delete (current-column) whitespace
;; characters because some may be tabs!
- (while (> i 0) (insert ? ) (setq i (1- i)))))
- (goto-char to) ; necessary ???
- ))
- ))
+ (insert-char ?\s i)))
+ (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.
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)))
- (while (> n 0)
- (insert ?\ )
- (setq n (1- n))))
+ (insert-char ?\s n))
(insert ?\ ))))
(defun woman2-DT (to)
(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 WoMan-log-begin ()
"Log the beginning of formatting in *WoMan-Log*."
(let ((WoMan-current-buffer (buffer-name)))
- (save-excursion
- (set-buffer (get-buffer-create "*WoMan-Log*"))
+ (with-current-buffer (get-buffer-create "*WoMan-Log*")
(or (eq major-mode 'view-mode) (view-mode 1))
(setq buffer-read-only nil)
(goto-char (point-max))
(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) ?\ ))
(setq tail (concat " " tail)))
"Log a message STRING in *WoMan-Log*.
If optional argument END is non-nil then make buffer read-only after
logging the message."
- (save-excursion
- (set-buffer (get-buffer-create "*WoMan-Log*"))
+ (with-current-buffer (get-buffer-create "*WoMan-Log*")
(setq buffer-read-only nil)
(goto-char (point-max))
(or end (insert " ")) (insert string "\n")
(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
;;; woman.el ends here
HCoop / bpt / emacs.git / blobdiff