Can you please try this updated patch? This time, I hope to have it tested all the woman buffer switching activities.
PS: The patch also resulted in many indentation changes. Looks like the default lisp-indent-function is changed since the last major edits to woman.el (because I did C-x h C-M-\ at the end committing my edits). Please advise how to remove just the indentation changes.
From 657205fa5156a853e6d300b98f26fba75210e646 Mon Sep 17 00:00:00 2001
Date: Thu, 4 Feb 2016 00:22:31 -0500
Subject: [PATCH] Fix-22332: woman.el display/switch-to-buffer behav
- This is a continuation of the fix in commit
244a00860b6fe1d6acf92948c5c0d1ef0f8426fa
- This also fixes debbugs 22332; now executing `woman` does not
manipulate the point in a non-*WoMan* buffer.
- WoMan-find-buffer definition is changed; now it returns the WoMan
buffer but does not switch to it by default. We directly switch to the
WoMan buffer only if `WoMan-find-buffer` is given a non-nil argument.
- WoMan-previous-manpage and WoMan-next-manpage now do not result in new
window pops. We now switch to prev/next manpage in the same window.
---
lisp/woman.el | 189 ++++++++++++++++++++++++++++++++--------------------------
1 file changed, 103 insertions(+), 86 deletions(-)
mode change 100644 => 100755 lisp/woman.el
diff --git a/lisp/woman.el b/lisp/woman.el
index 28a4798..f171ac2
--- a/lisp/woman.el
+++ b/lisp/woman.el
@@ -1601,32 +1601,38 @@ woman-find-file
(interactive "fBrowse UN*X manual file: \nP")
(setq woman-last-file-name
(setq file-name (expand-file-name file-name))) ; to canonicalize
- (let ((alist-tail woman-buffer-alist) exists)
+ (let ((alist-tail woman-buffer-alist)
+ woman-buffer
+ exists)
(setq woman-buffer-number 0)
(while (and alist-tail (not (string= file-name (car (car alist-tail)))))
(setq alist-tail (cdr alist-tail)
woman-buffer-number (1+ woman-buffer-number)))
- (or (and (setq exists
- (and alist-tail (WoMan-find-buffer))) ; buffer exists
- (not reformat))
- ;; Format new buffer or reformat current buffer:
- (let* ((bufname (file-name-nondirectory file-name))
- (case-fold-search t)
- (compressed
- (and (string-match-p woman-file-compression-regexp bufname) t)))
- (if compressed
- (setq bufname (file-name-sans-extension bufname)))
- (setq bufname (if exists
- (buffer-name)
- (woman-make-bufname bufname)))
- (woman-really-find-file file-name compressed bufname)
- (or exists
- (setq woman-buffer-alist
- (cons (cons file-name bufname) woman-buffer-alist)
- woman-buffer-number 0)))))
- (Man-build-section-alist)
- (Man-build-references-alist)
- (goto-char (point-min)))
+ (when alist-tail
+ (setq woman-buffer (WoMan-find-buffer)))
+ (setq exists (and alist-tail woman-buffer))
+ (or (and exists ; buffer exists
+ (not reformat))
+ ;; Format new buffer or reformat current buffer:
+ (let* ((bufname (file-name-nondirectory file-name))
+ (case-fold-search t)
+ (compressed
+ (and (string-match-p woman-file-compression-regexp bufname) t)))
+ (if compressed
+ (setq bufname (file-name-sans-extension bufname)))
+ (setq bufname (if exists
+ (buffer-name)
+ (woman-make-bufname bufname)))
+ (woman-really-find-file file-name compressed bufname)
+ (or exists
+ (setq woman-buffer-alist
+ (cons (cons file-name bufname) woman-buffer-alist)
+ woman-buffer-number 0))))
+ (when woman-buffer
+ (with-current-buffer (get-buffer woman-buffer)
+ (Man-build-section-alist)
+ (Man-build-references-alist)
+ (goto-char (point-min))))))
(defun woman-make-bufname (bufname)
"Create an unambiguous buffer name from BUFNAME."
@@ -2032,13 +2038,13 @@ WoMan-previous-manpage
"Find the previous WoMan buffer."
;; Assumes currently in a WoMan buffer!
(interactive)
- (WoMan-find-buffer) ; find current existing buffer
+ (WoMan-find-buffer :switch) ; find current existing buffer
(if (null (cdr woman-buffer-alist))
(error "No previous WoMan buffer"))
(if (>= (setq woman-buffer-number (1+ woman-buffer-number))
- (length woman-buffer-alist))
+ (length woman-buffer-alist))
(setq woman-buffer-number 0))
- (if (WoMan-find-buffer)
+ (if (WoMan-find-buffer :switch)
()
(if (< (setq woman-buffer-number (1- woman-buffer-number)) 0)
(setq woman-buffer-number (1- (length woman-buffer-alist))))
@@ -2048,30 +2054,41 @@ WoMan-next-manpage
"Find the next WoMan buffer."
;; Assumes currently in a WoMan buffer!
(interactive)
- (WoMan-find-buffer) ; find current existing buffer
+ (WoMan-find-buffer :switch) ; find current existing buffer
(if (null (cdr woman-buffer-alist))
(error "No next WoMan buffer"))
(if (< (setq woman-buffer-number (1- woman-buffer-number)) 0)
(setq woman-buffer-number (1- (length woman-buffer-alist))))
- (if (WoMan-find-buffer)
+ (if (WoMan-find-buffer :switch)
()
(WoMan-next-manpage)))
-(defun WoMan-find-buffer ()
- "Switch to buffer corresponding to `woman-buffer-number' and return it.
+(defun WoMan-find-buffer (&optional switch)
+ "Display the buffer corresponding to `woman-buffer-number'.
+If SWITCH is non-nil, directly switch to the WoMan buffer using
+`switch-to-buffer' instead of `display-buffer'.
If such a buffer does not exist then remove its association from the
-alist in `woman-buffer-alist' and return nil."
+alist in `woman-buffer-alist' and return nil.
+Return the buffer otherwise."
(if (zerop woman-buffer-number)
(let ((buffer (get-buffer (cdr (car woman-buffer-alist)))))
(if buffer
- (display-buffer buffer)
+ (if switch
+ (switch-to-buffer buffer)
+ (progn
+ (display-buffer buffer)
+ buffer))
;; Delete alist element:
(setq woman-buffer-alist (cdr woman-buffer-alist))
nil))
(let* ((prev-ptr (nthcdr (1- woman-buffer-number) woman-buffer-alist))
(buffer (get-buffer (cdr (car (cdr prev-ptr))))))
(if buffer
- (display-buffer buffer)
+ (if switch
+ (switch-to-buffer buffer)
+ (progn
+ (display-buffer buffer)
+ buffer))
;; Delete alist element:
(setcdr prev-ptr (cdr (cdr prev-ptr)))
(if (>= woman-buffer-number (length woman-buffer-alist))
@@ -2137,12 +2154,12 @@ woman-decode-buffer
(let ((start-time (current-time))
time)
(message "WoMan formatting buffer...")
-; (goto-char (point-min))
-; (cond
-; ((re-search-forward "^\\.[ \t]*TH" nil t) ; wrong format if not found?
-; (beginning-of-line)
-; (delete-region (point-min) (point))) ; potentially dangerous!
-; (t (message "WARNING: .TH request not found -- not man-page format?")))
+ ;; (goto-char (point-min)) ; ; ;
+ ;; (cond ; ; ;
+ ;; ((re-search-forward "^\\.[ \t]*TH" nil t) ; wrong format if not found? ; ; ;
+ ;; (beginning-of-line) ; ; ;
+ ;; (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 (float-time (time-since start-time)))
(message "WoMan formatting buffer...done in %g seconds" time)
@@ -2259,7 +2276,7 @@ woman-decode-region
(setq-local adaptive-fill-mode nil) ; No special "%" "#" etc filling.
- ;; Set syntax and display tables:
+ ;; Set syntax and display tables:
(set-syntax-table woman-syntax-table)
(woman-set-buffer-display-table)
@@ -2335,8 +2352,8 @@ woman-decode-region
(woman-strings)
;; Special chars moved after translation in
;; `woman2-process-escapes' (for pic.1):
-; (goto-char from)
-; (woman-special-characters)
+ ;; (goto-char from) ; ;
+ ;; (woman-special-characters) ; ;
;; Process standard font-change requests and escapes:
(goto-char from)
@@ -2875,7 +2892,7 @@ woman-strings
(let ((beg (match-beginning 0)))
(woman-match-name)
(let* ((stringname (match-string 0))
- (string (assoc stringname woman-string-alist)))
+ (string (assoc stringname woman-string-alist)))
(cond (string
(delete-region beg (point))
;; Temporary hack in case string starts with a
@@ -2884,7 +2901,7 @@ woman-strings
(insert-before-markers (cdr string)))
(t
(WoMan-warn "Undefined string %s not interpolated!"
- stringname)
+ stringname)
(cond (woman-ignore
;; Output above message once only per call
(delete-region beg (point))
@@ -3050,10 +3067,10 @@ woman1-roff-buffer
;; (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) '(?. ?'))
-; (insert "\\&")
-; (beginning-of-line)))
+ ;; ;; Hide leading control character in unquoted argument:
+ ;; (cond ((memq (following-char) '(?. ?'))
+ ;; (insert "\\&")
+ ;; (beginning-of-line)))
;; Call the appropriate function:
(funcall fn)
;; Hide leading control character in quoted argument (only):
@@ -3107,15 +3124,15 @@ woman1-IB
(woman1-alt-fonts (list "\\fI" "\\fB")))
(defun woman1-IR ()
- ".IR -- Join words of current line alternating italic and Roman fonts."
- (woman1-alt-fonts (list "\\fI" "\\fR")))
+ ".IR -- Join words of current line alternating italic and Roman fonts."
+ (woman1-alt-fonts (list "\\fI" "\\fR")))
(defun woman1-RB ()
- ".RB -- Join words of current line alternating Roman and bold fonts."
+ ".RB -- Join words of current line alternating Roman and bold fonts."
(woman1-alt-fonts (list "\\fR" "\\fB")))
(defun woman1-RI ()
- ".RI -- Join words of current line alternating Roman and italic fonts."
+ ".RI -- Join words of current line alternating Roman and italic fonts."
(woman1-alt-fonts (list "\\fR" "\\fI")))
(defun woman1-alt-fonts (fonts)
@@ -3202,7 +3219,7 @@ woman1-hc
".hc c -- Set hyphenation character to c, i.e. delete it!"
(let ((c (char-to-string (following-char))))
;; (WoMan-log
- ;; "Hyphenation character %s deleted -- hyphenation not supported!" c)
+ ;; "Hyphenation character %s deleted -- hyphenation not supported!" c)
(woman-delete-whole-line)
(setq c (concat "\\(" c "\\)\\|^[.'][ \t]*hc"))
(save-excursion
@@ -3220,27 +3237,27 @@ woman1-hw
(put 'woman1-ps 'notfont t)
(defalias 'woman1-ps 'woman-delete-whole-line)
- ;; .ps -- Point size -- IGNORE!
+;; .ps -- Point size -- IGNORE!
(put 'woman1-ss 'notfont t)
(defalias 'woman1-ss 'woman-delete-whole-line)
- ;; .ss -- Space-character size -- IGNORE!
+;; .ss -- Space-character size -- IGNORE!
(put 'woman1-cs 'notfont t)
(defalias 'woman1-cs 'woman-delete-whole-line)
- ;; .cs -- Constant character space (width) mode -- IGNORE!
+;; .cs -- Constant character space (width) mode -- IGNORE!
(put 'woman1-ne 'notfont t)
(defalias 'woman1-ne 'woman-delete-whole-line)
- ;; .ne -- Need vertical space -- IGNORE!
+;; .ne -- Need vertical space -- IGNORE!
(put 'woman1-vs 'notfont t)
(defalias 'woman1-vs 'woman-delete-whole-line)
- ;; .vs -- Vertical base line spacing -- IGNORE!
+;; .vs -- Vertical base line spacing -- IGNORE!
(put 'woman1-bd 'notfont t)
(defalias 'woman1-bd 'woman-delete-whole-line)
- ;; .bd -- Embolden font -- IGNORE!
+;; .bd -- Embolden font -- IGNORE!
;;; Non-breaking SunOS-specific macros:
@@ -3251,7 +3268,7 @@ woman1-TX
(put 'woman1-IX 'notfont t)
(defalias 'woman1-IX 'woman-delete-whole-line)
- ;; .IX -- Index macro, for Sun internal use -- IGNORE!
+;; .IX -- Index macro, for Sun internal use -- IGNORE!
;;; Direct font selection:
@@ -3552,14 +3569,14 @@ woman-parse-numeric-arg
(if (> (woman-parse-numeric-value) 0) 1 0))
)))
))
-; (if (looking-at "[ \t\nRC)\"]") ; R, C are tab types
-; ()
-; (WoMan-warn "Unimplemented numerical operator `%c' in %s"
-; (following-char)
-; (buffer-substring
-; (line-beginning-position)
-; (line-end-position)))
-; (skip-syntax-forward "^ "))
+ ;; (if (looking-at "[ \t\nRC)\"]") ; R, C are tab types
+ ;; ()
+ ;; (WoMan-warn "Unimplemented numerical operator `%c' in %s"
+ ;; (following-char)
+ ;; (buffer-substring
+ ;; (line-beginning-position)
+ ;; (line-end-position)))
+ ;; (skip-syntax-forward "^ "))
value
))
@@ -3700,16 +3717,16 @@ woman2-roff-buffer
(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 (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))
@@ -4312,13 +4329,13 @@ woman-set-arg
(if previous (set previous (eval 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)))
- ))
+ (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)))
+ ))
(beginning-of-line))
(woman-delete-line 1)) ; ignore any remaining arguments
@@ -4515,8 +4532,8 @@ woman2-TS
(woman2-format-paragraphs to))
(defalias 'woman2-TE 'woman2-fi)
- ;; ".TE -- End of table code for the tbl processor."
- ;; Turn filling and adjusting back on.
+;; ".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)
--
2.6.0.rc0.24.gec371ff
I used this little snippet (saved to test.el) and then running "emacs -Q --load=test.el" to test the above. "C-c 0" would load the patched woman.el and then it is self explanatory how I would have used the test.el.