;; -*- lexical-binding: t; -*- (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) (let* ((engine-name (plist-get engine :name)) (browser-name (plist-get browser :name)) (function-name (intern (format "hmm-search-%s-%s" engine-name browser-name)))) `(progn (defun ,function-name (query) ,(format "Search %s in %s." engine-name browser-name) (interactive ,(format "sSearch %s in %s for: " engine-name browser-name)) (,(plist-get browser :command) (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-thing-in-region (from-to) (interactive "r") (unless (region-active-p) (error "Region not active.")) (let* ((query (buffer-substring from to))) (hmm-query query))) (defun hmm-thing-at-point () (interactive) "Prompt for what to do with thing at point. If it is a file, display a list of file handlers. If it is a url, display a list of url handlers." (cond ((thing-at-point-url-at-point) (hmm-url (thing-at-point-url-at-point))) ((thing-at-point-file-at-point) (hmm-file (thing-at-point-file-at-point))) (t (hmm-query (word-at-point))))) (defun hmm-query (query) (interactive "sQuery: ") (hmm-open-internal query :query "Search %s using: ")) (defun hmm-url (url) (interactive (list (read-string "URL: " (thing-at-point-url-at-point)))) (hmm-handle-internal url :url "Handle url %s using: ")) (defun hmm-file (file) (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-handle-internal (thing type prompt) (let ((selected (completing-read (format prompt thing) (mapcar (lambda (command) (format "%s (%s)" command (if (documentation command) (car (split-string (documentation command) "\n")) "Undocumented"))) (hmm-filter-commands thing type))))) (funcall (intern (car (split-string selected " ("))) thing))) (defun hmm-filter-commands (thing type) (mapcar (lambda (handler) (plist-get handler :command)) (seq-filter (lambda (handler) (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 () (interactive) (setq hmm-commands '(:query nil :url nil :file nil)) (dolist (engine hmm-web-search-engines) (dolist (browser hmm-web-browsers) (eval `(hmm-define-web-search-engine ,engine ,browser)))) (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) (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))))) (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)