GNU bug report logs - #63911
Dired Open With

Previous Next

Full log

Message #8 received at 63911 <at> debbugs.gnu.org (full text, mbox):

From: Juri Linkov <juri <at> linkov.net>
To: 63911 <at> debbugs.gnu.org
Subject: Re: bug#63911: Dired Open With
Date: Fri, 23 Jun 2023 19:27:10 +0300

[Message part 1 (text/plain, inline)]

> As requested in bug#63875, here is a new context submenu "Open With" in Dired:
>
> +    (require 'mailcap nil t)
> +    (let* ((filename (save-excursion
> +                       (mouse-set-point click)
> +                       (dired-get-filename nil t)))
> +           (commands (mailcap-file-default-commands (list filename)))

After using this for a while I noticed that most of the time
mailcap suggestions are useless - they don't contain the same
items as in the context menus of a File Manager.  For example,
clicking the right mouse button on a ScreamTracker .stm file
opens a menu with Rhythmbox, and clicking on a ScreamTracker3
.s3m file opens a menu where the first item is Celluloid
and the second is Rhythmbox.

So I implemented support for xdg commands that now displays exactly
the same menus in Emacs as in the File Manager, and with the same order.

This is not the final patch, maybe more customization needed
before pushing to master.

[dired-context-menu-desktop-commands.patch (text/x-diff, inline)]

diff --git a/lisp/dired.el b/lisp/dired.el
index 914d0a0e783..7d5691df352 100644
--- a/lisp/dired.el
+++ b/lisp/dired.el
@@ -2504,17 +2504,58 @@ dired-mode-operate-menu
     ["Delete Image Tag..." image-dired-delete-tag
      :help "Delete image tag from current or marked files"]))
 
+(declare-function mailcap-file-default-commands "mailcap" (files))
+(declare-function xdg-mime-apps "xdg" (mime))
+(declare-function xdg-desktop-read-file "xdg" (filename &optional group))
+
 (defun dired-context-menu (menu click)
   "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")))
+    (require 'mailcap)
+    (require 'xdg)
+    (let* ((filename (save-excursion
+                       (mouse-set-point click)
+                       (dired-get-filename nil t)))
+           (mailcap-commands (mailcap-file-default-commands (list filename)))
+           (xdg-mime (when (executable-find "xdg-mime")
+                       (string-trim-right
+                        (shell-command-to-string
+                         (concat "xdg-mime query filetype " filename)))))
+           (xdg-mime-apps (unless (string-empty-p xdg-mime)
+                            (xdg-mime-apps xdg-mime)))
+           (desktop-commands
+            (mapcar (lambda (desktop)
+                      (setq desktop (xdg-desktop-read-file desktop))
+                      (cons (gethash "Name" desktop)
+                            (replace-regexp-in-string
+                             " .*" "" (gethash "Exec" desktop))))
+                    xdg-mime-apps))
+           (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 (or desktop-commands mailcap-commands)
+              (list (cons "Open With"
+                          (append
+                           (mapcar (lambda (desktop-command)
+                                     `[,(car desktop-command)
+                                       (lambda ()
+                                         (interactive)
+                                         (dired-do-async-shell-command
+                                          ,(cdr desktop-command) nil
+                                          (list ,filename)))])
+                                   desktop-commands)
+                           (mapcar (lambda (mailcap-command)
+                                     `[,mailcap-command
+                                       (lambda ()
+                                         (interactive)
+                                         (dired-do-async-shell-command
+                                          ,mailcap-command nil (list ,filename)))])
+                                   mailcap-commands)))))))
       (dolist (item (reverse (lookup-key easy-menu [menu-bar immediate])))
         (when (consp item)
           (define-key menu (vector (car item)) (cdr item))))))

Previous Next

GNU bug tracking system
Copyright (C) 1999 Darren O. Benham, 1997,2003 nCipher Corporation Ltd, 1994-97 Ian Jackson.