diff options
Diffstat (limited to 'hmm.el')
| -rw-r--r-- | hmm.el | 158 |
1 files changed, 118 insertions, 40 deletions
@@ -1,8 +1,92 @@ ;; -*- lexical-binding: t; -*- -(defvar hmm-web-search-engines nil "hmm web search engines.") -(defvar hmm-web-browsers nil "hmm web browers.") -(defvar hmm-handlers '(:query nil :url nil :file nil)) +;; Copyright (C) 2022 Yuchen Pei. +;; +;; This file is part of hmm.el. +;; +;; hmm.el is free software: you can redistribute it and/or modify it under +;; the terms of the GNU Affero General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. +;; +;; hmm.el is distributed in the hope that it will be useful, but WITHOUT +;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY +;; or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Affero General +;; Public License for more details. +;; +;; You should have received a copy of the GNU Affero General Public +;; License along with hmm.el. If not, see <https://www.gnu.org/licenses/>. + +(defvar hmm-web-search-engines + '((:name ddg + :format "https://html.duckduckgo.com/html?q=%s") + (:name fsd + :format "https://directory.fsf.org/w/index.php?search=%s") + (:name ml-emacs-devel + :format + "https://lists.gnu.org/archive/cgi-bin/namazu.cgi?query=%s&idxname=emacs-devel") + (:name ml-help-gnu-emacs + :format + "https://lists.gnu.org/archive/cgi-bin/namazu.cgi?query=%s&idxname=help-gnu-emacs") + (:name wikipedia + :format "https://en.wikipedia.org/w/index.php?search=%s")) + "hmm web search engines.") + +(defvar hmm-web-browsers + '((:name eww :command eww) + (:name firefox :command browse-url-firefox)) + "hmm web browers.") + +(defvar hmm-handlers + '(:query + ((:command locate) + (:command project-or-external-find-regexp)) + :url + ((:schemes ("mailto") :command browse-url-mail)) + :file + ((:command find-file) + (:command dired :mimetypes ("inode/directory")) + (:command byte-compile-file :mimetypes ("text/x-lisp")) + (:command hmm-file-mime-type))) + "hmm handlers.") + +(defvar hmm-external-handlers + '((:name mpv + :external-command "mpv %U" + :display-name "mpv player" + :description "Play url with mpv" + :schemes + ("ftp" "http" "https" "mms" "rtmp" "rtsp" "sftp" "smb" "srt") + :handling :url) + (:name wget + :external-command "wget %U" + :display-name "GNU Wget" + :description "The non-interactive network downloader" + :schemes + ("ftp" "http" "https") + :handling :url) + (:name torsocks-mpv + :external-command "torsocks mpv %U" + :display-name "mpv player torsocks" + :description "Play url with mpv over torsocks" + :schemes + ("ftp" "http" "https" "mms" "rtmp" "rtsp" "sftp" "smb" "srt") + :handling :url)) + "hmm external handlers.") + +(defvar hmm-matchers + '(((thing-at-point-url-at-point) . hmm-url) + ((thing-at-point-file-at-point) . hmm-file) + ((and (derived-mode-p 'dired-mode) (dired-get-filename nil t)) + . hmm-file) + ((and (derived-mode-p 'dired-mode) (expand-file-name default-directory)) + . hmm-file) + ((and (derived-mode-p 'org-mode) (my-org-link-at-point)) . hmm-url) + ((get-text-property (point) 'shr-url) . hmm-url) + ((thing-at-point 'symbol) . hmm-query) + ((buffer-file-name) . hmm-file) + ((expand-file-name default-directory) . hmm-file)) + "Matchers for 'hmm-thing-at-point'.") (defmacro hmm-define-web-search-engine (engine browser) (let* ((engine-name (plist-get engine :name)) @@ -51,7 +135,7 @@ (defun hmm-add-handler (handler handling) (let ((handlers (plist-get hmm-handlers handling))) - (add-to-list 'handlers handler) + (cl-pushnew handler handlers) (plist-put hmm-handlers handling handlers))) (defun hmm-thing-in-region (from to) @@ -60,34 +144,19 @@ (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." - (let ((thing)) - (cond ((setq thing (thing-at-point-url-at-point)) - (hmm-url thing)) - ((setq thing (thing-at-point-file-at-point)) - (hmm-file thing)) - ((and (derived-mode-p 'dired-mode) - (setq thing (dired-get-filename nil t))) - (hmm-file thing)) - ((derived-mode-p 'dired-mode) - (hmm-file (expand-file-name default-directory))) - ((and (derived-mode-p 'org-mode) - (setq thing (my-org-link-at-point))) - (hmm-url thing)) - ((setq thing (get-text-property (point) 'shr-url)) - (hmm-url thing)) - ((setq thing (thing-at-point 'symbol)) - (hmm-query thing)) - ((setq thing (buffer-file-name)) - (hmm-file thing)) - ((setq thing (expand-file-name default-directory)) - (hmm-file thing)) - (t (error "Cannot guess what to do with what."))))) +(defmacro hmm-define-hmm-thing-at-point () + `(defun hmm-thing-at-point () + "Prompt for what to do with thing at point." + (interactive) + (let ((thing)) + ,(cons 'cond + (append + (mapcar + (lambda (pair) + `((setq thing ,(car pair)) + (,(cdr pair) thing))) + hmm-matchers) + `((t (error "Cannot guess what to do with what.")))))))) (defun hmm () (interactive) @@ -99,7 +168,7 @@ If it is a url, display a list of url handlers." (defun hmm-query (query) (interactive "sQuery: ") - (hmm-open-internal query :query "Search %s using: ")) + (hmm-handle-internal query :query "Handle query %s using: ")) (defun hmm-url (url) (interactive (list (read-string "URL: " (thing-at-point-url-at-point)))) @@ -144,21 +213,24 @@ If it is a url, display a list of url handlers." (let ((regex (plist-get handler :regex))) (cond ((eq type :url) (let ((schemes (plist-get handler :schemes)) - (url (url-generic-parse-url thing)) - (url-no-scheme)) + (url-obj (url-generic-parse-url thing))) (and (or (null schemes) - (member (url-type url) schemes)) + (member (url-type url-obj) schemes)) (or (not regex) (string-match regex - (progn - (setf (url-type url) nil - (url-fullness url) nil) - (setq url-no-scheme (url-recreate-url url)))))))) + (hmm-url-no-scheme thing)))))) (t (or (not regex) (string-match regex thing)))))) +(defun hmm-url-no-scheme (url) + "Remove the scheme from a url." + (let ((url-obj (url-generic-parse-url url))) + (setf (url-type url-obj) nil + (url-fullness url-obj) nil) + (url-recreate-url url-obj))) + (defun hmm-update-handlers () (interactive) (dolist (engine hmm-web-search-engines) @@ -174,6 +246,12 @@ If it is a url, display a list of url handlers." :schemes (list "http" "https")) :url))) +(defun hmm-update () + (interactive) + (hmm-update-handlers) + (hmm-define-hmm-thing-at-point) + (message "Updated.")) + (defun hmm-get-xdg-handlers () (seq-filter (lambda (handler) |