* lisp/man.el (Man-width-max): New defcustom (bug#32536, bug#9385)

(Man-columns): New buffer-local variable.
(Man-columns): New function.
(Man-start-calling): Call Man-columns and set buffer-local Man-columns.
(Man--window-state-change-timer): New internal variable.
(Man--window-state-change): New internal function.
(Man-fit-to-window): New function.
(Man-mode): Add Man--window-state-change to local hook
window-state-change-functions.

* lisp/image-mode.el (image-fit-to-window): Add window arg to
window-buffer call.

diff --git a/etc/NEWS b/etc/NEWS
index 28bcb720cdead20d85ad0e9167ecdaeb48501eab..996ef1e6bb91c4e6d4fade139af684493b7b0595 100644 (file)
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -1268,6 +1268,8 @@ them to the 'browse-url' function, like the other protocols: 'ftp',
 'http', and 'https'.  This allows to have references to local HTML
 files, for example.
 
+*** 'Man-width-max' (80 by default) limits the number of columns on man pages.
+
 ** Xref
 
 +++

diff --git a/lisp/image-mode.el b/lisp/image-mode.el
index b9ba376cafc7ced900ea8c8991d996e1d7aa6bc5..61fa5b083d4983106acada860d3cdb6e4d51014c 100644 (file)
--- a/lisp/image-mode.el
+++ b/lisp/image-mode.el
@@ -870,7 +870,7 @@ Otherwise, display the image by calling `image-mode'."
 (defun image-fit-to-window (window)
   "Adjust size of image to display it exactly in WINDOW boundaries."
   (when (window-live-p window)
-    (with-current-buffer (window-buffer)
+    (with-current-buffer (window-buffer window)
       (when (derived-mode-p 'image-mode)
         (let ((spec (image-get-display-property)))
           (when (eq (car-safe spec) 'image)

diff --git a/lisp/man.el b/lisp/man.el
index beec2e616f5c9088e0a7033d8bc56de328c8f098..2509e5f90c938f27e64cad2fb9e09557769b5b61 100644 (file)
--- a/lisp/man.el
+++ b/lisp/man.el
@@ -182,6 +182,18 @@ The value also can be a positive integer for a fixed width."
                  (integer :tag "Fixed width" :value 65))
   :group 'man)
 
+(defcustom Man-width-max 80
+  "Maximum number of columns allowed for the width of manual pages.
+It defines the maximum width for the case when `Man-width' is customized
+to a dynamically calculated value depending on the frame/window width.
+If the width calculated for `Man-width' is larger than the maximum width,
+it will be automatically reduced to the width defined by this variable.
+When nil, there is no limit on maximum width."
+  :type '(choice (const :tag "No limit" nil)
+                 (integer :tag "Max width" :value 80))
+  :version "27.1"
+  :group 'man)
+
 (defcustom Man-frame-parameters nil
   "Frame parameter list for creating a new frame for a manual page."
   :type '(repeat (cons :format "%v"
@@ -1022,6 +1034,22 @@ names or descriptions.  The pattern argument is usually an
       (error "No item under point")
     (man man-args)))
 
+(defvar Man-columns nil)
+
+(defun Man-columns ()
+  (let ((width (cond
+                ((and (integerp Man-width) (> Man-width 0))
+                 Man-width)
+                (Man-width
+                 (let ((window (get-buffer-window nil t)))
+                   (frame-width (and window (window-frame window)))))
+                (t
+                 (window-width (get-buffer-window nil t))))))
+    (when (and (integerp Man-width-max)
+               (> Man-width-max 0))
+      (setq width (min width Man-width-max)))
+    width))
+
 (defmacro Man-start-calling (&rest body)
   "Start the man command in `body' after setting up the environment."
   `(let ((process-environment (copy-sequence process-environment))
@@ -1058,20 +1086,8 @@ names or descriptions.  The pattern argument is usually an
              (not (or (getenv "MANWIDTH") (getenv "COLUMNS"))))
       ;; Since the page buffer is displayed beforehand,
       ;; we can select its window and get the window/frame width.
-      (setenv "COLUMNS" (number-to-string
-                        (cond
-                         ((and (integerp Man-width) (> Man-width 0))
-                          Man-width)
-                         (Man-width
-                          (if (window-live-p (get-buffer-window (current-buffer) t))
-                              (with-selected-window (get-buffer-window (current-buffer) t)
-                                (frame-width))
-                            (frame-width)))
-                         (t
-                          (if (window-live-p (get-buffer-window (current-buffer) t))
-                              (with-selected-window (get-buffer-window (current-buffer) t)
-                                (window-width))
-                            (window-width)))))))
+      (setq-local Man-columns (Man-columns))
+      (setenv "COLUMNS" (number-to-string Man-columns)))
     ;; Since man-db 2.4.3-1, man writes plain text with no escape
     ;; sequences when stdout is not a tty.     In 2.5.0, the following
     ;; env-var was added to allow control of this (see Debian Bug#340673).
@@ -1157,6 +1173,25 @@ Return the buffer in which the manpage will appear."
             (search-backward text nil t))
         (search-forward text nil t)))))
 
+(defvar Man--window-state-change-timer nil)
+
+(defun Man--window-state-change (window)
+  (unless (integerp Man-width)
+    (when (timerp Man--window-state-change-timer)
+      (cancel-timer Man--window-state-change-timer))
+    (setq Man--window-state-change-timer
+          (run-with-idle-timer 1 nil #'Man-fit-to-window window))))
+
+(defun Man-fit-to-window (window)
+  "Adjust width of the buffer to fit columns into WINDOW boundaries."
+  (when (window-live-p window)
+    (with-current-buffer (window-buffer window)
+      (when (and (derived-mode-p 'Man-mode)
+                 (not (eq Man-columns (Man-columns))))
+        (let ((proc (get-buffer-process (current-buffer))))
+          (unless (and proc (not (eq (process-status proc) 'exit)))
+            (Man-update-manpage)))))))
+
 (defun Man-notify-when-ready (man-buffer)
   "Notify the user when MAN-BUFFER is ready.
 See the variable `Man-notify-method' for the different notification behaviors."
@@ -1543,7 +1578,8 @@ The following key bindings are currently in effect in the buffer:
   (set (make-local-variable 'outline-regexp) Man-heading-regexp)
   (set (make-local-variable 'outline-level) (lambda () 1))
   (set (make-local-variable 'bookmark-make-record-function)
-       'Man-bookmark-make-record))
+       'Man-bookmark-make-record)
+  (add-hook 'window-state-change-functions #'Man--window-state-change nil t))
 
 (defun Man-build-section-list ()
   "Build the list of manpage sections."