bug#22332: 25.0.50; woman moves point in a wrong buffer

[Kaushal Modi <kaushal.modi@gmail.com>]

[-- Attachment #1: Type: text/plain, Size: 16734 bytes --]

Hi all,

>> Martin Rudalics

> This might fix the call from ‘woman-find-file’.  But ‘WoMan-find-buffer’
> is also called from ‘WoMan-previous-manpage’ and ‘WoMan-next-manpage’.
> How can we be sure that ‘display-buffer’ does not display the previous
> or next WoMan buffer in another window?  And if it does so, we have the
> problem that that other window does not get selected.
>

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
From: Kaushal Modi <kaushal.modi@gmail.com>
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.

=====

(global-set-key (kbd "C-c 0") (lambda ()
                                (interactive)
                                (load-file
"/path/to/the/patched/woman.el")))
(global-set-key (kbd "C-c 1") (lambda () (interactive) (woman "timelocal")))
(global-set-key (kbd "C-c 2") (lambda () (interactive) (woman "timezone")))
(global-set-key (kbd "C-c 3") (lambda () (interactive) (woman "acos")))
(global-set-key (kbd "C-c p") #'WoMan-previous-manpage)
(global-set-key (kbd "C-c n") #'WoMan-next-manpage)

=====

[-- Attachment #2: Type: text/html, Size: 28218 bytes --]