From 1bd545fac60f955c1d8b6de2db3a0aca6b9d32c5 Mon Sep 17 00:00:00 2001 From: Gabriel do Nascimento Ribeiro Date: Wed, 23 Nov 2022 01:50:21 -0300 Subject: [PATCH 1/1] Add user option `project-buffer-name-function' * lisp/buff-menu.el (Buffer-menu-buffer-name): New constant to store the default buffer name. (list-buffers-noselect): Use the new constant. * lisp/vc/vc-dir.el (vc-dir-buffer-name): New constant to store the default buffer name. (vc-dir): Use the new constant. * lisp/progmodes/project.el (project-buffer-name-function): New user option to allow customization of project-related buffer names. (project-compilation-buffer-name-function): Make obsolete. (project-buffer-name-default): New function to compute the name of project-related buffers. (project-find-regexp, project-or-external-find-regexp, project-vc-dir) (project-shell, project-eshell, project-async-shell-command) (project-shell-command, project-compile, project-list-buffers) (project-kill-buffers): Use the new user option `project-buffer-name-function' to compute the buffer name. * etc/NEWS: Announce the changes. --- etc/NEWS | 8 +++++ lisp/buff-menu.el | 7 +++-- lisp/progmodes/project.el | 65 ++++++++++++++++++++++++++++++--------- lisp/vc/vc-dir.el | 7 ++++- 4 files changed, 69 insertions(+), 18 deletions(-) diff --git a/etc/NEWS b/etc/NEWS index 5a65896d69..b3e1b5e3c4 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -2263,6 +2263,14 @@ matches. --- *** New function 'xref-show-xrefs'. ++++ +*** New user option 'project-buffer-name-function'. +This control the name of project-related buffers. + +--- +*** 'project-compilation-buffer-name-function' is now obsolete. +Use the new user option 'project-buffer-name-function' instead. + ** File notifications +++ diff --git a/lisp/buff-menu.el b/lisp/buff-menu.el index aa5f70edf2..e6b91682dd 100644 --- a/lisp/buff-menu.el +++ b/lisp/buff-menu.el @@ -95,6 +95,9 @@ Buffer-menu-use-frame-buffer-list :group 'Buffer-menu :version "22.1") +(defconst Buffer-menu-buffer-name "*Buffer List*" + "Name of the output buffer for `buffer-menu' and related commands.") + (defvar-local Buffer-menu-files-only nil "Non-nil if the current Buffer Menu lists only file buffers. This is set by the prefix argument to `buffer-menu' and related @@ -634,11 +637,11 @@ list-buffers-noselect that filters out buffers from the list of buffers. See more at `Buffer-menu-filter-predicate'." (let ((old-buffer (current-buffer)) - (buffer (get-buffer-create "*Buffer List*"))) + (buffer (get-buffer-create Buffer-menu-buffer-name))) (with-current-buffer buffer (Buffer-menu-mode) (setq Buffer-menu-files-only - (and files-only (>= (prefix-numeric-value files-only) 0))) + (and files-only (>= (prefix-numeric-value files-only) 0))) (setq Buffer-menu-filter-predicate filter-predicate) (list-buffers--refresh buffer-list old-buffer) (tabulated-list-print)) diff --git a/lisp/progmodes/project.el b/lisp/progmodes/project.el index 751e240a56..d706bd128f 100644 --- a/lisp/progmodes/project.el +++ b/lisp/progmodes/project.el @@ -818,7 +818,8 @@ project-find-regexp caller-dir nil t))) (project--files-in-directory dir nil - (grep-read-files regexp)))))) + (grep-read-files regexp))))) + (xref-buffer-name (funcall project-buffer-name-function "xref"))) (xref-show-xrefs (apply-partially #'project--find-regexp-in-files regexp files) nil))) @@ -846,7 +847,8 @@ project-or-external-find-regexp (files (project-files pr (cons (project-root pr) - (project-external-roots pr))))) + (project-external-roots pr)))) + (xref-buffer-name (funcall project-buffer-name-function "xref"))) (xref-show-xrefs (apply-partially #'project--find-regexp-in-files regexp files) nil))) @@ -1024,7 +1026,8 @@ project-dired (defun project-vc-dir () "Run VC-Dir in the current project's root." (interactive) - (vc-dir (project-root (project-current t)))) + (let ((vc-dir-buffer-name (funcall project-buffer-name-function "vc-dir"))) + (vc-dir (project-root (project-current t))))) (declare-function comint-check-proc "comint") @@ -1038,13 +1041,13 @@ project-shell (interactive) (require 'comint) (let* ((default-directory (project-root (project-current t))) - (default-project-shell-name (project-prefixed-buffer-name "shell")) - (shell-buffer (get-buffer default-project-shell-name))) + (buffer-name (funcall project-buffer-name-function "shell")) + (shell-buffer (get-buffer buffer-name))) (if (and shell-buffer (not current-prefix-arg)) (if (comint-check-proc shell-buffer) (pop-to-buffer shell-buffer (bound-and-true-p display-comint-buffer-action)) (shell shell-buffer)) - (shell (generate-new-buffer-name default-project-shell-name))))) + (shell (generate-new-buffer-name buffer-name))))) ;;;###autoload (defun project-eshell () @@ -1056,7 +1059,7 @@ project-eshell (interactive) (defvar eshell-buffer-name) (let* ((default-directory (project-root (project-current t))) - (eshell-buffer-name (project-prefixed-buffer-name "eshell")) + (eshell-buffer-name (funcall project-buffer-name-function "eshell")) (eshell-buffer (get-buffer eshell-buffer-name))) (if (and eshell-buffer (not current-prefix-arg)) (pop-to-buffer eshell-buffer (bound-and-true-p display-comint-buffer-action)) @@ -1067,7 +1070,9 @@ project-async-shell-command "Run `async-shell-command' in the current project's root directory." (declare (interactive-only async-shell-command)) (interactive) - (let ((default-directory (project-root (project-current t)))) + (let ((default-directory (project-root (project-current t))) + (shell-command-buffer-name-async (funcall project-buffer-name-function + "Async Shell Command"))) (call-interactively #'async-shell-command))) ;;;###autoload @@ -1075,7 +1080,9 @@ project-shell-command "Run `shell-command' in the current project's root directory." (declare (interactive-only shell-command)) (interactive) - (let ((default-directory (project-root (project-current t)))) + (let ((default-directory (project-root (project-current t))) + (shell-command-buffer-name (funcall project-buffer-name-function + "Shell Command Output"))) (call-interactively #'shell-command))) (declare-function fileloop-continue "fileloop" ()) @@ -1136,6 +1143,32 @@ project-compilation-buffer-name-function (const :tag "Prefixed with root directory name" project-prefixed-buffer-name) (function :tag "Custom function"))) +(make-obsolete-variable 'project-compilation-buffer-name-function + 'project-buffer-name-function + "29.1") + +(defcustom project-buffer-name-function 'project-buffer-name-default + "Function to compute the name of a project buffer. +Function receives one argument, the base buffer name as string. +It should return the buffer name as string." + :version "29.1" + :group 'project + :type 'function) + +(defun project-buffer-name-default (name) + "Function to compute buffer names for project commands." + (pcase name + ("compilation" (compilation--default-buffer-name name)) + ("shell" (project-prefixed-buffer-name name)) + ("eshell" (project-prefixed-buffer-name name)) + ("Shell Command Output" shell-command-buffer-name) + ("Async Shell Command" shell-command-buffer-name-async) + ("Buffer List" Buffer-menu-buffer-name) + ("xref" xref-buffer-name) + ("vc-dir" vc-dir-buffer-name) + (t (format "*%s-%s*" + (project-name (project-current)) + name)))) ;;;###autoload (defun project-compile () @@ -1143,9 +1176,9 @@ project-compile (declare (interactive-only compile)) (interactive) (let ((default-directory (project-root (project-current t))) - (compilation-buffer-name-function - (or project-compilation-buffer-name-function - compilation-buffer-name-function))) + (compilation-buffer-name-function (lambda (_) + (funcall project-buffer-name-function + "compilation")))) (call-interactively #'compile))) (defcustom project-ignore-buffer-conditions nil @@ -1231,13 +1264,13 @@ project-display-buffer-other-frame ;;;###autoload (defun project-list-buffers (&optional arg) "Display a list of project buffers. -The list is displayed in a buffer named \"*Buffer List*\". By default, all project buffers are listed except those whose names start with a space (which are for internal use). With prefix argument ARG, show only buffers that are visiting files." (interactive "P") - (let ((pr (project-current t))) + (let ((pr (project-current t)) + (Buffer-menu-buffer-name (funcall project-buffer-name-function "Buffer List"))) (display-buffer (if (version< emacs-version "29.0.50") (let ((buf (list-buffers-noselect arg (project-buffers pr)))) @@ -1365,6 +1398,8 @@ project-kill-buffers (interactive) (let* ((pr (project-current t)) (bufs (project--buffers-to-kill pr)) + (Buffer-menu-buffer-name (funcall project-buffer-name-function + "Buffer List")) (query-user (lambda () (yes-or-no-p (format "Kill %d buffers in %s? " @@ -1377,7 +1412,7 @@ project-kill-buffers (project-kill-buffers-display-buffer-list (when (with-current-buffer-window - (get-buffer-create "*Buffer List*") + (get-buffer-create Buffer-menu-buffer-name) `(display-buffer--maybe-at-bottom (dedicated . t) (window-height . (fit-window-to-buffer)) diff --git a/lisp/vc/vc-dir.el b/lisp/vc/vc-dir.el index 037de415e6..ff7ac2e025 100644 --- a/lisp/vc/vc-dir.el +++ b/lisp/vc/vc-dir.el @@ -118,6 +118,10 @@ vc-dir-status-ignored ;; To distinguish files and directories. directory) +;;;###autoload +(defconst vc-dir-buffer-name "*vc-dir*" + "Name of the output buffer for `vc-dir' command.") + (defvar vc-ewoc nil) (defvar vc-dir-process-buffer nil @@ -1446,7 +1450,8 @@ vc-dir (unless backend (setq backend (vc-responsible-backend dir))) (let (pop-up-windows) ; based on cvs-examine; bug#6204 - (pop-to-buffer (vc-dir-prepare-status-buffer "*vc-dir*" dir backend))) + (pop-to-buffer (vc-dir-prepare-status-buffer vc-dir-buffer-name + dir backend))) (if (derived-mode-p 'vc-dir-mode) (vc-dir-refresh) ;; FIXME: find a better way to pass the backend to `vc-dir-mode'. -- 2.34.1