From: Juri Linkov Date: Sat, 7 Dec 2019 22:36:58 +0000 (+0200) Subject: * lisp/man.el (Man-width-max): New defcustom (bug#32536, bug#9385) X-Git-Tag: emacs-27.0.90~408 X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=7e387c9e5265b98dbb3b986f8ab8ac2217052831;p=emacs.git * 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 28bcb720cde..996ef1e6bb9 100644 --- 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 b9ba376cafc..61fa5b083d4 100644 --- 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 beec2e616f5..2509e5f90c9 100644 --- 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."