commit 7a5c91a2831602c3cd961158cf0b6a876852d7ac (HEAD, refs/remotes/origin/master) Author: Juri Linkov Date: Mon Nov 27 19:35:45 2023 +0200 * lisp/dired.el (dired-context-menu): Add menu item "Open With" (bug#63911). Populate the menu item "Open With" with commands returned by 'shell-command-guess' on the current file name. diff --git a/lisp/dired.el b/lisp/dired.el index 6eecba1f96a..97645c731c8 100644 --- a/lisp/dired.el +++ b/lisp/dired.el @@ -2595,13 +2595,28 @@ dired-context-menu "Populate MENU with Dired mode commands at CLICK." (when (mouse-posn-property (event-start click) 'dired-filename) (define-key menu [dired-separator] menu-bar-separator) - (let ((easy-menu (make-sparse-keymap "Immediate"))) + (let* ((filename (save-excursion + (mouse-set-point click) + (dired-get-filename nil t))) + (commands (shell-command-guess (list filename))) + (easy-menu (make-sparse-keymap "Immediate"))) (easy-menu-define nil easy-menu nil - '("Immediate" + `("Immediate" ["Find This File" dired-mouse-find-file :help "Edit file at mouse click"] ["Find in Other Window" dired-mouse-find-file-other-window - :help "Edit file at mouse click in other window"])) + :help "Edit file at mouse click in other window"] + ,@(when commands + (list (cons "Open With" + (append + (mapcar (lambda (command) + `[,(or (get-text-property 0 'name command) + command) + (lambda () + (interactive) + (dired-do-async-shell-command + ,command nil (list ,filename)))]) + commands))))))) (dolist (item (reverse (lookup-key easy-menu [menu-bar immediate]))) (when (consp item) (define-key menu (vector (car item)) (cdr item)))))) commit b8d4242e8bdbdb6ca364bf0760e50689f6a6e118 Author: Juri Linkov Date: Mon Nov 27 19:32:10 2023 +0200 New user option 'shell-command-guess-functions' (bug#18132) * lisp/dired-aux.el (dired-minibuffer-default-add-shell-commands): Remove function since now mailcap commands are available by shell-command-guess-mailcap for shell-command-guess used by dired-guess-shell-command. (dired-read-shell-command): Don't set minibuffer-default-add-function to dired-minibuffer-default-add-shell-commands. (dired-guess-shell-command): Replace dired-guess-default with shell-command-guess. (shell-command-guess-functions): New defcustom. (shell-command-guess, shell-command-guess-dired) (shell-command-guess-mailcap, shell-command-guess-xdg): New functions. * lisp/simple.el (minibuffer-default-add-shell-commands): Use 'shell-command-guess' instead of requiring 'mailcap' with 'mailcap-file-default-commands'. Remove 'interactive'. diff --git a/etc/NEWS b/etc/NEWS index fd633fad6fb..6661ac70e1b 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -503,6 +503,12 @@ hidden and an ellipsis is displayed instead. A value of 'window' means using the right edge of window as the display restriction. The default is nil. +*** New user option 'shell-command-guess-functions'. +It defines how to populate a list of commands available +for 'M-!', 'M-&', '!', '&' based on marked files in Dired. +Possible backends are 'dired-guess-default', MIME types, +XDG configuration. + ** Ediff --- diff --git a/lisp/dired-aux.el b/lisp/dired-aux.el index 02194e6ff45..47e97c96ce1 100644 --- a/lisp/dired-aux.el +++ b/lisp/dired-aux.el @@ -763,22 +763,6 @@ dired-trample-file-versions ;;; Shell commands -(declare-function mailcap-file-default-commands "mailcap" (files)) - -(defvar dired-aux-files) - -(defun dired-minibuffer-default-add-shell-commands () - "Return a list of all commands associated with current Dired files. -This function is used to add all related commands retrieved by `mailcap' -to the end of the list of defaults just after the default value." - (interactive) - (let ((commands (and (boundp 'dired-aux-files) - (require 'mailcap nil t) - (mailcap-file-default-commands dired-aux-files)))) - (if (listp minibuffer-default) - (append minibuffer-default commands) - (cons minibuffer-default commands)))) - ;; This is an extra function so that you can redefine it, e.g., to use gmhist. (defun dired-read-shell-command (prompt arg files) "Read a Dired shell command. @@ -789,14 +773,9 @@ dired-read-shell-command Use `dired-guess-shell-command' to offer a smarter default choice of shell command." - (minibuffer-with-setup-hook - (lambda () - (setq-local dired-aux-files files) - (setq-local minibuffer-default-add-function - #'dired-minibuffer-default-add-shell-commands)) - (setq prompt (format prompt (dired-mark-prompt arg files))) - (dired-mark-pop-up nil 'shell files - 'dired-guess-shell-command prompt files))) + (setq prompt (format prompt (dired-mark-prompt arg files))) + (dired-mark-pop-up nil 'shell files + 'dired-guess-shell-command prompt files)) ;;;###autoload (defcustom dired-confirm-shell-command t @@ -1316,7 +1295,7 @@ dired-guess-default ;;;###autoload (defun dired-guess-shell-command (prompt files) "Ask user with PROMPT for a shell command, guessing a default from FILES." - (let ((default (dired-guess-default files)) + (let ((default (shell-command-guess files)) default-list val) (if (null default) ;; Nothing to guess @@ -1340,6 +1319,67 @@ dired-guess-shell-command ;; If we got a return, then return default. (if (equal val "") default val)))) +(defcustom shell-command-guess-functions + '(shell-command-guess-dired) + "List of functions that guess shell commands for files. +Each function receives a list of commands and a list of file names +and should return the same list of commands with changes +such as added new commands." + :type '(repeat + (choice (function-item shell-command-guess-dired) + (function-item shell-command-guess-mailcap) + (function-item shell-command-guess-xdg) + (function :tag "Custom function"))) + :group 'dired + :version "30.1") + +;;;###autoload +(defun shell-command-guess (files) + "Return a list of shell commands, appropriate for FILES. +The list is populated by calling functions from +`shell-command-guess-functions'. Each function receives the list +of commands and the list of file names and returns the same list +after adding own commands to the composite list." + (let ((commands nil)) + (run-hook-wrapped 'shell-command-guess-functions + (lambda (fun) + (setq commands (funcall fun commands files)) + nil)) + commands)) + +(defun shell-command-guess-dired (commands files) + "Populate COMMANDS using `dired-guess-default'." + (append (ensure-list (dired-guess-default files)) commands)) + +(declare-function mailcap-file-default-commands "mailcap" (files)) + +(defun shell-command-guess-mailcap (commands files) + "Populate COMMANDS by MIME types of FILES." + (require 'mailcap) + (append (mailcap-file-default-commands files) commands)) + +(declare-function xdg-mime-apps "xdg" (mime)) +(declare-function xdg-desktop-read-file "xdg" (filename &optional group)) + +(defun shell-command-guess-xdg (commands files) + "Populate COMMANDS by XDG configuration for FILES." + (require 'xdg) + (let* ((xdg-mime (when (executable-find "xdg-mime") + (string-trim-right + (shell-command-to-string + (concat "xdg-mime query filetype " (car files)))))) + (xdg-mime-apps (unless (string-empty-p xdg-mime) + (xdg-mime-apps xdg-mime))) + (xdg-commands + (mapcar (lambda (desktop) + (setq desktop (xdg-desktop-read-file desktop)) + (propertize + (replace-regexp-in-string + " .*" "" (gethash "Exec" desktop)) + 'name (gethash "Name" desktop))) + xdg-mime-apps))) + (append xdg-commands commands))) + ;;; Commands that delete or redisplay part of the dired buffer @@ -3856,9 +3896,6 @@ dired-vc-deduce-fileset (setq model (vc-checkout-model backend only-files-list)))) (list backend files only-files-list state model))) -(define-obsolete-function-alias 'minibuffer-default-add-dired-shell-commands - #'dired-minibuffer-default-add-shell-commands "29.1") - (provide 'dired-aux) diff --git a/lisp/simple.el b/lisp/simple.el index 02c68912dba..35bce6ab4b8 100644 --- a/lisp/simple.el +++ b/lisp/simple.el @@ -4273,19 +4273,17 @@ shell-command-default-error-buffer is run interactively. A value of nil means that output to stderr and stdout will be intermixed in the output stream.") -(declare-function mailcap-file-default-commands "mailcap" (files)) (declare-function dired-get-filename "dired" (&optional localp no-error-if-not-filep)) (defun minibuffer-default-add-shell-commands () "Return a list of all commands associated with the current file. -This function is used to add all related commands retrieved by `mailcap' -to the end of the list of defaults just after the default value." - (interactive) +This function is used to add all related commands retrieved by +`shell-command-guess' to the end of the list of defaults just +after the default value." (let* ((filename (if (listp minibuffer-default) (car minibuffer-default) minibuffer-default)) - (commands (and filename (require 'mailcap nil t) - (mailcap-file-default-commands (list filename))))) + (commands (and filename (shell-command-guess (list filename))))) (setq commands (mapcar (lambda (command) (concat command " " filename)) commands)) commit d15084c822e6815dde348dd0dd8175b9694f9f12 Author: Juri Linkov Date: Mon Nov 27 19:16:02 2023 +0200 * lisp/dired.el (dired-insert-set-properties): Fix 'isearch-open-invisible'. Set overlay property 'isearch-open-invisible' to 'delete-overlay' for 'dired-filename-display-length' (bug#67161). diff --git a/lisp/dired.el b/lisp/dired.el index 096d6a838f8..6eecba1f96a 100644 --- a/lisp/dired.el +++ b/lisp/dired.el @@ -1967,7 +1967,7 @@ dired-insert-set-properties ;; made invisible via text properties. (let ((ov (make-overlay ell-beg (point)))) (overlay-put ov 'invisible 'dired-filename-hide) - (overlay-put ov 'isearch-open-invisible t) + (overlay-put ov 'isearch-open-invisible #'delete-overlay) (overlay-put ov 'evaporate t))))) (add-text-properties beg (1+ end) commit 39cd1db63a94176e1161a1bf215a79eabc4aa430 Author: Juri Linkov Date: Mon Nov 27 19:09:49 2023 +0200 * lisp/progmodes/project.el (project-prompt-project-name): Add 'reverse'. Reverse ret that should restore order for 'C-x p p M-n M-n ...' (bug#67310). diff --git a/lisp/progmodes/project.el b/lisp/progmodes/project.el index f7f057396e1..a81bb63fba4 100644 --- a/lisp/progmodes/project.el +++ b/lisp/progmodes/project.el @@ -1808,7 +1808,7 @@ project-prompt-project-name (name (project-name proj))) (push name project--name-history) (push (cons name proj) ret))) - ret)) + (reverse ret))) ;; XXX: Just using this for the category (for the substring ;; completion style). (table (project--file-completion-table commit 1dab381c823b8bca23a1ed6335dd24ee50af7fc9 Author: Alan Mackenzie Date: Mon Nov 27 15:36:36 2023 +0000 Compiler optimizer: push forms onto byte-compile-form-stack This fixes bug#67483. * lisp/emacs-lisp/byte-opt.el (byte-optimize-form): Push and pop FORM onto/off byte-compile-form-stack so that warning messages get a position near to the erroneous source. diff --git a/lisp/emacs-lisp/byte-opt.el b/lisp/emacs-lisp/byte-opt.el index 2caaadc9f9e..06257a9a2da 100644 --- a/lisp/emacs-lisp/byte-opt.el +++ b/lisp/emacs-lisp/byte-opt.el @@ -514,6 +514,7 @@ byte-optimize-one-form (byte-optimize-form form for-effect))) (defun byte-optimize-form (form &optional for-effect) + (push form byte-compile-form-stack) (while (progn ;; First, optimize all sub-forms of this one. @@ -530,6 +531,7 @@ byte-optimize-form (byte-compile-log " %s\t==>\t%s" old new) (setq form new) (not (eq new old)))))))) + (pop byte-compile-form-stack) form) (defun byte-optimize--rename-var-body (var new-var body)