-;;; woman.el --- browse UN*X manual pages `wo (without) man'
+;;; woman.el --- browse UN*X manual pages `wo (without) man' -*- lexical-binding: t; -*-
;; Copyright (C) 2000-2021 Free Software Foundation, Inc.
\f
;;; Code:
+(eval-when-compile (require 'cl-lib))
+
(defvar woman-version "0.551 (beta)" "WoMan version information.")
(make-obsolete-variable 'woman-version nil "28.1")
;; an empty substring of MANPATH denotes the default list.
(if (memq system-type '(windows-nt ms-dos))
(cond ((null paths)
- (mapcar 'woman-Cyg-to-Win (woman-parse-man.conf)))
+ (mapcar #'woman-Cyg-to-Win (woman-parse-man.conf)))
((string-match-p ";" paths)
;; Assume DOS-style path-list...
(mapcan ; splice list into list
(lambda (x)
(if x
(list x)
- (mapcar 'woman-Cyg-to-Win (woman-parse-man.conf))))
+ (mapcar #'woman-Cyg-to-Win (woman-parse-man.conf))))
(parse-colon-path paths)))
((string-match-p "\\`[a-zA-Z]:" paths)
;; Assume single DOS-style path...
;; Assume UNIX/Cygwin-style path-list...
(mapcan ; splice list into list
(lambda (x)
- (mapcar 'woman-Cyg-to-Win
+ (mapcar #'woman-Cyg-to-Win
(if x (list x) (woman-parse-man.conf))))
(let ((path-separator ":"))
(parse-colon-path paths)))))
(defcustom woman-man.conf-path
(let ((path '("/usr/lib" "/etc")))
(cond ((eq system-type 'windows-nt)
- (mapcar 'woman-Cyg-to-Win path))
+ (mapcar #'woman-Cyg-to-Win path))
((eq system-type 'darwin)
(cons "/usr/share/misc" path))
(t path)))
Note: an optional compression regexp will be appended, so this regexp
MUST NOT end with any kind of string terminator such as $ or \\\\='."
:type 'regexp
- :set 'set-woman-file-regexp
+ :set #'set-woman-file-regexp
:group 'woman-interface)
(defcustom woman-file-compression-regexp
;; not loaded by default!
:version "24.1" ; added xz
:type 'regexp
- :set 'set-woman-file-regexp
+ :set #'set-woman-file-regexp
:group 'woman-interface)
(defcustom woman-use-own-frame nil
(setq dir (and (member (car dir) path) (cdr dir))))
(when dir
(cl-pushnew (substitute-in-file-name dir) lst :test #'equal))))
- (mapcar 'substitute-in-file-name woman-path)))
+ (mapcar #'substitute-in-file-name woman-path)))
(defun woman-read-directory-cache ()
"Load the directory and topic cache.
(if (woman-not-member dir path) ; use each directory only once!
(setq files (nconc files
(directory-files dir t topic-regexp))))))
- (mapcar 'list files)))
+ (mapcar #'list files)))
\f
;;; dired support
(defun woman-dired-define-key (key)
"Bind the argument KEY to the command `woman-dired-find-file'."
- (define-key dired-mode-map key 'woman-dired-find-file))
+ (define-key dired-mode-map key #'woman-dired-find-file))
(defsubst woman-dired-define-key-maybe (key)
"If KEY is undefined in Dired, bind it to command `woman-dired-find-file'."
"Define dired keys to run WoMan according to `woman-dired-keys'."
(if woman-dired-keys
(if (listp woman-dired-keys)
- (mapc '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])
(if (featurep 'dired)
(woman-dired-define-keys)
- (add-hook 'dired-mode-hook 'woman-dired-define-keys))
+ (add-hook 'dired-mode-hook #'woman-dired-define-keys))
(declare-function dired-get-filename "dired"
(&optional localp no-error-if-not-filep))
(let ((map (make-sparse-keymap)))
(set-keymap-parent map Man-mode-map)
- (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)
+ (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 map [remap man] 'woman)
- (define-key map [remap man-follow] 'woman-follow)
+ (define-key map [remap man] #'woman)
+ (define-key map [remap man-follow] #'woman-follow)
map)
"Keymap for `woman-mode'.")
\\{woman-mode-map}"
;; FIXME: Should all this just be re-arranged so that this can just
;; inherit `man-common' and be done with it?
- (let ((Man-build-page-list (symbol-function 'Man-build-page-list))
- (Man-strip-page-headers (symbol-function 'Man-strip-page-headers))
- (Man-unindent (symbol-function 'Man-unindent))
- (Man-goto-page (symbol-function 'Man-goto-page)))
+ (cl-letf (((symbol-function 'Man-build-page-list) #'ignore)
+ ((symbol-function 'Man-strip-page-headers) #'ignore)
+ ((symbol-function 'Man-unindent) #'ignore)
+ ((symbol-function 'Man-goto-page) #'ignore))
;; Prevent inappropriate operations:
- (fset 'Man-build-page-list 'ignore)
- (fset 'Man-strip-page-headers 'ignore)
- (fset 'Man-unindent 'ignore)
- (fset 'Man-goto-page 'ignore)
- (unwind-protect
- (delay-mode-hooks (Man-mode))
- ;; Restore the status quo:
- (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)
- (setq tab-width woman-tab-width)))
+ (delay-mode-hooks (Man-mode)))
+ (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
(setq imenu-generic-expression woman-imenu-generic-expression)
(setq-local imenu-space-replacement " ")
;; Bookmark support.
- (setq-local bookmark-make-record-function 'woman-bookmark-make-record)
+ (setq-local 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)
(defvar woman0-rename-alist) ; bound in woman0-roff-buffer
+;; Bound locally by woman[012]-roff-buffer, and woman0-macro.
+;; Use dynamically in woman-unquote and woman-forward-arg.
+(defvar woman-request)
+
(defun woman0-roff-buffer (from)
"Process conditional-type requests and user-defined macros.
Start at FROM and re-scan new text as appropriate."
;; request may be used dynamically (woman-interpolate-macro calls
;; woman-forward-arg).
-(defun woman0-macro (woman-request)
- "Process the macro call named WOMAN-REQUEST."
+(defun woman0-macro (request)
+ "Process the macro call named REQUEST."
;; Leaves point at start of new text.
- (let ((macro (assoc woman-request woman0-macro-alist)))
+ (let ((woman-request request)
+ (macro (assoc 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!" woman-request))))
+ (WoMan-warn "Undefined macro %s not interpolated!" request))))
(defun woman-interpolate-macro (macro)
"Interpolate (.de) or append (.am) expansion of MACRO into the buffer."
\f
;;; Formatting macros that do not cause a break:
-;; 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.
Leave point at TO (which should be a marker)."
".SM -- Set the current line in small font, i.e. IGNORE!"
nil)
-(defalias 'woman1-SB 'woman1-B)
+(defalias 'woman1-SB #'woman1-B)
;; .SB -- Set the current line in small bold font, i.e. just embolden!
;; (This is what /usr/local/share/groff/tmac/tmac.an does. The
;; Linux man.7 is wrong about this!)
;;; Other non-breaking requests correctly ignored by nroff:
(put 'woman1-ps 'notfont t)
-(defalias 'woman1-ps 'woman-delete-whole-line)
+(defalias 'woman1-ps #'woman-delete-whole-line)
;; .ps -- Point size -- IGNORE!
(put 'woman1-ss 'notfont t)
-(defalias 'woman1-ss 'woman-delete-whole-line)
+(defalias 'woman1-ss #'woman-delete-whole-line)
;; .ss -- Space-character size -- IGNORE!
(put 'woman1-cs 'notfont t)
-(defalias 'woman1-cs 'woman-delete-whole-line)
+(defalias 'woman1-cs #'woman-delete-whole-line)
;; .cs -- Constant character space (width) mode -- IGNORE!
(put 'woman1-ne 'notfont t)
-(defalias 'woman1-ne 'woman-delete-whole-line)
+(defalias 'woman1-ne #'woman-delete-whole-line)
;; .ne -- Need vertical space -- IGNORE!
(put 'woman1-vs 'notfont t)
-(defalias 'woman1-vs 'woman-delete-whole-line)
+(defalias 'woman1-vs #'woman-delete-whole-line)
;; .vs -- Vertical base line spacing -- IGNORE!
(put 'woman1-bd 'notfont t)
-(defalias 'woman1-bd 'woman-delete-whole-line)
+(defalias 'woman1-bd #'woman-delete-whole-line)
;; .bd -- Embolden font -- IGNORE!
;;; Non-breaking SunOS-specific macros:
(woman-forward-arg 'unquote 'concat))
(put 'woman1-IX 'notfont t)
-(defalias 'woman1-IX 'woman-delete-whole-line)
+(defalias 'woman1-IX #'woman-delete-whole-line)
;; .IX -- Index macro, for Sun internal use -- IGNORE!
\f
inc (cdr value)
;; eval internal (.X) registers
;; stored as lisp variable names:
- value (eval (car value)))
+ value (eval (car value) t))
(if (and pm inc) ; auto-increment
(setq value
(funcall (intern-soft pm) value inc)
"Process breaks. Format paragraphs and headings."
(let ((case-fold-search t)
(to (make-marker))
- (canonically-space-region
- (symbol-function 'canonically-space-region))
- (insert-and-inherit (symbol-function 'insert-and-inherit))
- (set-text-properties (symbol-function 'set-text-properties))
(woman-registers woman-registers)
fn woman-request woman-translations
tab-stop-list)
(set-marker-insertion-type to t)
;; ?roff does not squeeze multiple spaces, but does fill, so...
- (fset 'canonically-space-region 'ignore)
- ;; Try to avoid spaces inheriting underlines from preceding text!
- (fset 'insert-and-inherit (symbol-function 'insert))
- (fset 'set-text-properties 'ignore)
- (unwind-protect
- (progn
- (while
- ;; Find next control line:
- (re-search-forward woman-request-regexp nil t)
- (cond
- ;; Construct woman function to call:
- ((setq fn (intern-soft
- (concat "woman2-"
- (setq woman-request (match-string 1)))))
- ;; Delete request or macro name:
- (woman-delete-match 0))
- ;; Unrecognized request:
- ((prog1 nil
- ;; (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)
- ))
- ;; .LP assumes it is at eol and leaves a (blank) line,
- ;; so leave point at end of line before paragraph:
- ((or (looking-at "[ \t]*$") ; no argument
- woman-ignore) ; ignore all
- ;; (beginning-of-line) (kill-line)
- ;; AVOID LEAVING A BLANK LINE!
- (beginning-of-line) (woman-delete-line 1))
- (t (end-of-line) (insert ?\n)))
- (if (not (or fn
- (and (not (memq (following-char) '(?. ?')))
- (setq fn 'woman2-format-paragraphs))))
- ()
- ;; 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 ...
- (woman2-format-paragraphs (copy-marker (point-max) t)
- woman-left-margin)))
- (fset 'canonically-space-region canonically-space-region)
- (fset 'set-text-properties set-text-properties)
- (fset 'insert-and-inherit insert-and-inherit)
- (set-marker to nil))))
+ (cl-letf (((symbol-function 'canonically-space-region) #'ignore)
+ ;; Try to avoid spaces inheriting underlines from preceding text!
+ ((symbol-function 'insert-and-inherit) #'insert)
+ ((symbol-function 'set-text-properties) #'ignore))
+ (while
+ ;; Find next control line:
+ (re-search-forward woman-request-regexp nil t)
+ (cond
+ ;; Construct woman function to call:
+ ((setq fn (intern-soft
+ (concat "woman2-"
+ (setq woman-request (match-string 1)))))
+ ;; Delete request or macro name:
+ (woman-delete-match 0))
+ ;; Unrecognized request:
+ ((prog1 nil
+ ;; (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)
+ ))
+ ;; .LP assumes it is at eol and leaves a (blank) line,
+ ;; so leave point at end of line before paragraph:
+ ((or (looking-at "[ \t]*$") ; no argument
+ woman-ignore) ; ignore all
+ ;; (beginning-of-line) (kill-line)
+ ;; AVOID LEAVING A BLANK LINE!
+ (beginning-of-line) (woman-delete-line 1))
+ (t (end-of-line) (insert ?\n)))
+ (if (not (or fn
+ (and (not (memq (following-char) '(?. ?')))
+ (setq fn 'woman2-format-paragraphs))))
+ ()
+ ;; 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 ...
+ (woman2-format-paragraphs (copy-marker (point-max) t)
+ woman-left-margin)))
+ (set-marker to nil)))
(defun woman-find-next-control-line (&optional pat)
"Find and return start of next control line.
(setq woman-prevailing-indent woman-default-indent)
(woman2-format-paragraphs to woman-left-margin))
-(defalias 'woman2-PP 'woman2-LP)
-(defalias 'woman2-P 'woman2-LP)
+(defalias 'woman2-PP #'woman2-LP)
+(defalias 'woman2-P #'woman2-LP)
(defun woman2-ns (to)
".ns -- Turn on no-space mode. Format paragraphs upto TO."
If no argument then use value of optional arg PREVIOUS if non-nil,
otherwise set PREVIOUS. Delete the whole remaining control line."
(if (eolp) ; space already skipped
- (set arg (if previous (eval previous) 0))
- (if previous (set previous (eval arg)))
+ (set arg (if previous (symbol-value previous) 0))
+ (if previous (set previous (symbol-value arg)))
(woman2-process-escapes-to-eol 'numeric)
(let ((pm (if (looking-at "[+-]")
(prog1 (following-char)
(forward-char 1))))
(i (woman-parse-numeric-arg)))
(cond ((null pm) (set arg i))
- ((= pm ?+) (set arg (+ (eval arg) i)))
- ((= pm ?-) (set arg (- (eval arg) i)))
+ ((= pm ?+) (set arg (+ (symbol-value arg) i)))
+ ((= pm ?-) (set arg (- (symbol-value arg) i)))
))
(beginning-of-line))
(woman-delete-line 1)) ; ignore any remaining arguments
(setq woman-nofill t)
(woman2-format-paragraphs to))
-(defalias 'woman2-TE 'woman2-fi)
+(defalias 'woman2-TE #'woman2-fi)
;; ".TE -- End of table code for the tbl processor."
;; Turn filling and adjusting back on.
projects / emacs.git / commitdiff