Adding support for mime types, a bit slow

1 files changed, 83 insertions, 11 deletions

diff --git a/hmm.el b/hmm.el
index 2e11423..fa16699 100644
--- a/hmm.el
+++ b/hmm.el
@@ -2,7 +2,9 @@
 
 (defvar hmm-web-search-engines nil "hmm web search engines.")
 (defvar hmm-web-browsers nil "hmm web browers.")
+(defvar hmm-file-handlers nil "hmm file handlers.")
 (defvar hmm-query-handlers nil "hmm query handlers.")
+(defvar hmm-url-handlers nil "hmm url handlers.")
 (defvar hmm-commands '(:query nil :url nil :file nil))
 
 (defmacro hmm-define-web-search-engine (engine browser)
@@ -18,16 +20,41 @@
           (format ,(plist-get engine :format) query)))
        (hmm-add-command '(:command ,function-name) :query))))
 
+(defmacro hmm-define-external-command (xdg-command)
+  (let* ((description (or (plist-get xdg-command :description)
+                          (format "Open with %s" (plist-get xdg-command :name))))
+         (function-name (intern
+                         (format "hmm-%s"
+                                 (plist-get xdg-command :xdg-desktop-name))))
+         (command `(replace-regexp-in-string
+                    "%[fFuU]" arg
+                    ,(plist-get xdg-command :external-command)))
+         (name (plist-get xdg-command :name))
+         (handler (plist-put xdg-command :command function-name)))
+    `(progn
+       (defun ,function-name (arg)
+         ,description
+         (interactive ,(format "sRun %s with: " name))
+         (start-process-shell-command
+          (concat ,name " " arg) nil ,command))
+       (hmm-add-command ',handler :file))))
+
+;; (defmacro hmm-define-file-url-handler-from-file-handler (handler)
+;;   (let ((function-name (intern
+;;                         (format "hmm-file-url-%s")))))
+;;   `(progn
+;;      (defun hmm-file-url)))
+
 (defun hmm-add-command (command handling)
   (let ((commands (plist-get hmm-commands handling)))
     (add-to-list 'commands command)
     (plist-put hmm-commands handling commands)))
 
-(defun hmm-query-region (from to)
+(defun hmm-thing-in-region (from-to)
   (interactive "r")
   (unless (region-active-p) (error "Region not active."))
   (let* ((query (buffer-substring from to)))
-    (hmm-search-internal query)))
+    (hmm-query query)))
 
 (defun hmm-thing-at-point ()
   (interactive)
@@ -47,13 +74,14 @@ If it is a url, display a list of url handlers."
 
 (defun hmm-url (url)
   (interactive (list (read-string "URL: " (thing-at-point-url-at-point))))
-  (hmm-open-internal url :url "Handle url %s using: "))
+  (hmm-handle-internal url :url "Handle url %s using: "))
 
 (defun hmm-file (file)
-  (interactive (list (read-string "File: " (thing-at-point-file-at-point))))
-  (hmm-open-internal file :file "Handle file %s using: "))
+  (interactive (list (read-file-name "File: " default-directory
+                                     (thing-at-point-file-at-point))))
+  (hmm-handle-internal file :file "Handle file %s using: "))
 
-(defun hmm-open-internal (thing type prompt)
+(defun hmm-handle-internal (thing type prompt)
   (let ((selected
          (completing-read
           (format prompt thing)
@@ -75,7 +103,10 @@ If it is a url, display a list of url handlers."
      (plist-get handler :command))
    (seq-filter
     (lambda (handler)
-      (string-match (or (plist-get handler :regex) ".*") thing))
+      (string-match (or (plist-get handler :regex) ".*") thing)
+      (or (member (hmm-file-mime-type thing)
+                  (plist-get handler :mimetypes))
+          (not (plist-get handler :xdg-desktop-name))))
     (plist-get hmm-commands type))))
 
 (defun hmm-update-commands ()
@@ -84,16 +115,57 @@ If it is a url, display a list of url handlers."
   (dolist (engine hmm-web-search-engines)
     (dolist (browser hmm-web-browsers)
       (eval `(hmm-define-web-search-engine ,engine ,browser))))
-  (mapc (lambda (command) (hmm-add-command command :query))
-        hmm-query-handlers)
+  (dolist (xdg-command (hmm-get-xdg-commands))
+    (eval `(hmm-define-external-command ,xdg-command)))
+  (dolist (command hmm-query-handlers) (hmm-add-command command :query))
   (mapc (lambda (browser)
           (add-to-list 'hmm-url-handlers
                        (list :command (plist-get browser :command)
                              :regex "^http\\(s\\)?://.*$")))
         hmm-web-browsers)
   (mapc (lambda (command) (hmm-add-command command :url))
-        hmm-url-handlers))
+        hmm-url-handlers)
+  (mapc (lambda (command) (hmm-add-command command :file))
+        hmm-file-handlers))
+
+(defun hmm-get-xdg-commands ()
+  (seq-filter
+   'identity
+   (mapcar
+    (lambda (desktop-file)
+      (condition-case nil
+          (let ((parsed (xdg-desktop-read-file desktop-file)))
+            (list
+             :name (gethash "Name" parsed)
+             :description (gethash "Comment" parsed)
+             :xdg-desktop-name (intern (concat "xdg-desktop-"
+                                               (file-name-base desktop-file)))
+             :external-command (gethash "Exec" parsed)
+             :mimetypes (seq-filter (lambda (s) (not (string-empty-p s)))
+                                    (split-string (gethash "MimeType" parsed) ";"))))
+        (error nil)))
+    (hmm-get-all-desktop-files))))
+
+(defun hmm-get-all-desktop-files ()
+  (mapcan (lambda (dir)
+            (let ((app-dir (expand-file-name "applications" dir)))
+              (when (file-exists-p app-dir)
+                (directory-files app-dir t "\\.desktop$"))))
+          (cons (xdg-data-home) (xdg-data-dirs))))
+
+(defun hmm-file-mime-type (file)
+  (when (file-exists-p file)
+    (replace-regexp-in-string
+     "^.*: \\(.*\\); .*$" "\\1"
+     (hmm-shell-command-output (format "file -Li %s" file)))))
 
-(hmm-update-commands)
+(defun hmm-shell-command-output (command)
+  (let ((inhibit-message t))
+    (if (= 0
+           (shell-command command))
+        (with-current-buffer shell-command-buffer-name
+          (string-trim (buffer-string)))
+      (error (with-current-buffer shell-command-buffer-name
+               (string-trim (buffer-string)))))))
 
 (provide 'hmm)