diff --git a/lisp/man.el b/lisp/man.el index defe992074..211d56f9dd 100644 --- a/lisp/man.el +++ b/lisp/man.el @@ -182,6 +182,34 @@ Man-width (integer :tag "Fixed width" :value 65)) :group 'man) +(defcustom Man-width-min 40 + "Minimum number of columns allowed for the width of manual pages. +It defines the minimum 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 smaller than the minimum width, +it will be automatically enlarged to the width defined by this variable. +If the calculated width is smaller than the minimum width, the value +of this variable has no effect. +When nil, there is no limit on minimum width." + :type '(choice (const :tag "No limit" nil) + (integer :tag "Min width" :value 40)) + :version "27.1" + :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. +If the calculated width is smaller than the maximum width, the value +of this variable has no effect. +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" @@ -1005,6 +1033,25 @@ man-follow (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))) + (when (and (integerp Man-width-min) + (> Man-width-min 0)) + (setq width (max width Man-width-min))) + 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)) @@ -1041,20 +1088,8 @@ Man-start-calling (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). @@ -1525,7 +1560,19 @@ Man-mode (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-size-change-functions (debounce #'Man-window-change 1) nil t) + (add-hook 'window-state-change-functions (debounce #'Man-window-change 1) nil t) + (add-hook 'window-selection-change-functions (debounce #'Man-window-change 1) nil t)) + +(defun Man-window-change (window) + (when (window-live-p window) + (with-selected-window 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-build-section-list () "Build the list of manpage sections."