org-extra-link-types.el

   1 ;;; org-extra-link-types.el --- Add extra link types to Org Mode -*- lexical-binding: t; -*-
   2
   3 ;; Time-stamp: <2020-08-13 19:50:23 stardiviner>
   4
   5 ;; Authors: stardiviner <numbchild@gmail.com>
   6 ;; Package-Requires: ((emacs "27.1") (olc "1.4.1"))
   7 ;; Package-Version: 0.1
   8 ;; Keywords: text org
   9 ;; homepage: https://repo.or.cz/org-extra-link-types.el.git
  10
  11 ;; org-extra-link-types is free software; you can redistribute it and/or modify it
  12 ;; under the terms of the GNU General Public License as published by
  13 ;; the Free Software Foundation; either version 3, or (at your option)
  14 ;; any later version.
  15 ;;
  16 ;; org-extra-link-types is distributed in the hope that it will be useful, but WITHOUT
  17 ;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
  18 ;; or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public
  19 ;; License for more details.
  20 ;;
  21 ;;
  22 ;; You should have received a copy of the GNU General Public License
  23 ;; along with GNU Emacs.  If not, see <https://www.gnu.org/licenses/>.
  24
  25 ;;; Commentary:
  26
  27 ;; (use-package org-extra-link-types
  28 ;;   :vc (:url "git://repo.or.cz/org-extra-link-types.el.git")
  29 ;;   :demand t)
  30
  31 ;;; Code:
  32 \f
  33 (require 'cl-lib)
  34 (require 'ol)
  35 (require 'browse-url)
  36
  37 (defgroup org-extra-link-types nil
  38   "The customize group of package org-extra-link-types."
  39   :prefix "org-extra-link-types-"
  40   :group 'org)
  41
  42 ;;===============================================================================
  43 ;;; [ telnet: ]
  44
  45 ;;  e.g. telnet://ptt.cc
  46 (org-link-set-parameters "telnet" :follow #'telnet)
  47
  48 ;;===============================================================================
  49 ;;; [ chrome: ]
  50
  51 ;;; e.g. chrome:chrome://whats-new/
  52
  53 (cl-case system-type
  54   (gnu/linux
  55    (cond
  56     ((executable-find "google-chrome")
  57      (org-link-set-parameters "chrome" :follow #'browse-url-chrome))
  58     ((executable-find "chromium")
  59      (org-link-set-parameters "chrome" :follow #'browse-url-chromium))))
  60   (darwin
  61    (cond
  62     ((file-exists-p "/Applications/Google Chrome.app")
  63      (org-link-set-parameters "chrome" :follow #'browse-url-chrome))
  64     ((file-exists-p "/Applications/Chromium.app")
  65      (org-link-set-parameters "chrome" :follow #'browse-url-chromium))))
  66   (windows-nt
  67    ;; TODO:
  68    ;; https://stackoverflow.com/questions/40674914/google-chrome-path-in-windows-10
  69    ))
  70
  71 ;;===============================================================================
  72 ;;; [ rss: ]
  73
  74 (defun org-rss-link-open (uri)
  75   "Open rss:// URI link."
  76   (eww uri))
  77
  78 (org-link-set-parameters "rss" :follow #'org-rss-link-open)
  79
  80 ;;===============================================================================
  81 ;;; [ tag: ]
  82
  83 ;; e.g. [[tag:work+phonenumber-boss][Optional Description]]
  84
  85 (defun org-tag-link-open (tag)
  86   "Display a list of TODO headlines with tag TAG.
  87 With prefix argument, also display headlines without a TODO keyword."
  88   (org-tags-view (null current-prefix-arg) tag))
  89
  90 (org-link-set-parameters "tag" :follow #'org-tag-link-open)
  91
  92 ;;===============================================================================
  93 ;;; [ track: ]
  94
  95 ;;; `track:' for OSM Maps
  96 ;; [[track:((9.707032442092896%2052.37033874553582)(9.711474180221558%2052.375238282987))data/images/org-osm-link.svg][Open this link will generate svg, png image for track link on map]]
  97
  98 (if (featurep 'org-osm-link)
  99     (require 'org-osm-link))
 100
 101 ;;===============================================================================
 102 ;;; [ geo: ]
 103
 104 ;; [geo:37.786971,-122.399677;u=35]
 105 ;; [[geo:58.397813,15.576063]]
 106 ;; [[geo:9FCQ9HXG+4CG]]
 107
 108 ;;; Open Location Code library `olc'
 109 (autoload 'olc-encode "olc")
 110 (autoload 'olc-decode "olc")
 111
 112 (defcustom org-geo-link-application-command "gnome-maps"
 113   "Specify the program name for openning geo: link."
 114   :type 'string
 115   :group 'org-extra-link-types)
 116
 117 (defun org-geo-link-open (link)
 118   "Open geography `LINK' like \"geo:25.5889136,100.2208514\" in Map application."
 119   (if (featurep 'olc)
 120       (let ((location (cond
 121                        ;; (string-match-p "\\,.*" "25.5889136,100.2208514")
 122                        ((string-match-p "\\,.*" link)
 123                         link)
 124                        ;; (string-match-p "\\+.*" "9FCQ9HXG+4CG")
 125                        ((string-match-p "\\+.*" link)
 126                         (when (featurep 'olc)
 127                           (format "%s,%s"
 128                                   (olc-area-lat (olc-decode link))
 129                                   (olc-area-lon (olc-decode link)))))
 130                        (t (user-error "Your link is not Geo location or Open Location Code!")))))
 131         (if (executable-find org-geo-link-application-command)
 132             (start-process
 133              "org-geo-link-open"
 134              "*org-geo-link-open*"
 135              org-geo-link-application-command
 136              (shell-quote-wildcard-pattern location))
 137           (browse-url location)))
 138     (user-error "Emacs package 'olc' is not installed, please install it")))
 139
 140 (org-link-set-parameters "geo" :follow #'org-geo-link-open)
 141
 142 ;;===============================================================================
 143 ;;; [ magnet: ]
 144
 145 ;;; e.g. [[magnet:?xt=urn:btih:07327331BA1AD104828A6C07EAA48F6977D842AC]]
 146
 147 (defcustom org-magnet-link-open-command
 148   (cl-case system-type
 149     (darwin
 150      (cond
 151       ((file-exists-p "/Applications/Thunder.app")
 152        "open /Applications/Thunder.app")
 153       ((file-exists-p "/Applications/Motrix.app")
 154        "open /Applications/Motrix.app")
 155       ((file-exists-p "/Applications/qBittorrent.app")
 156        "open /Applications/qBittorrent.app")
 157       (t "open --url")))
 158     (gnu/linux "xdg-open")
 159     (windows-nt))
 160   "Specify the magnet: link open command."
 161   :type 'string
 162   :group 'org-extra-link-types)
 163
 164 (defun org-magnet-link-open (link)
 165   "Open magnet: LINK with downloader application."
 166   (let ((url (concat "magnet:" link)))
 167     (shell-command (concat org-magnet-link-open-command " " url))))
 168
 169 (org-link-set-parameters "magnet" :follow #'org-magnet-link-open)
 170
 171 ;;===============================================================================
 172 ;;; [ ipfs:// ]
 173
 174 ;; ipfs://<cid>/<path>
 175 ;; ipns://<ipns-name>/<path>
 176 ;;
 177 ;; ipfs://{cid}/path/to/subresource/cat.jpg
 178 ;;
 179 ;; Examples:
 180 ;;
 181 ;; ipfs://{cidv1}
 182 ;; ipfs://{cidv1}/path/to/resource
 183 ;; ipfs://{cidv1}/path/to/resource?query=foo#fragment
 184 ;;
 185 ;; ipns://{cidv1-libp2p-key}
 186 ;; ipns://{cidv1-libp2p-key}/path/to/resource
 187 ;; ipns://{dnslink-name}/path/to/resource?query=foo#fragment
 188
 189 (defun org-ipfs-link-open (url)
 190   "Open ipfs:// link URL with IPFS Desktop."
 191   (let ((url (shell-quote-argument url)))
 192     (async-shell-command
 193      (cl-case system-type
 194        (gnu/linux (format "open -a \"/Applications/IPFS Desktop.app\" --args %s" url))
 195        (darwin (format "ipfs --args %s" url))
 196        (windows-nt (format "ipfs --args %s" url))))))
 197
 198 (org-link-set-parameters "ipfs" :follow 'org-ipfs-link-open)
 199
 200 ;;===============================================================================
 201 ;;; [ video: ]
 202
 203 ;;; e.g. [[video:/path/to/file.mp4::00:13:20]]
 204
 205 (defcustom org-video-link-open-command
 206   (cond
 207    ((executable-find "mpv") "mpv")
 208    ((executable-find "mplayer") "mplayer")
 209    ((executable-find "iina") "iina"))
 210   "Specify the program for openning video: link."
 211   :type 'string
 212   :group 'org-extra-link-types)
 213
 214 (defvar org-video-link-extension-list '("avi" "rmvb" "ogg" "mp4" "mkv"))
 215
 216 (defun org-video-link-open (uri)
 217   "Open video file `URI' with video player."
 218   (let* ((list (split-string uri "::"))
 219          (path (car list))
 220          (start-timstamp (cadr list)))
 221     (pcase org-video-link-open-command
 222       ("mpv"
 223        (make-process
 224         :command (list "mpv" (concat "--start=" start-timstamp)
 225                        (expand-file-name (org-link-unescape path)))
 226         :name "org-video-link"
 227         :buffer " *org-video-link*"))
 228       ("mplayer"
 229        (make-process
 230         :command (list "mplayer" "-ss" start-timstamp
 231                        (expand-file-name (org-link-unescape path)))
 232         :name "org-video-link"
 233         :buffer " *org-video-link*"))
 234       ("iina"
 235        (make-process
 236         :command (list "iina" (concat "--mpv-start=" start-timstamp)
 237                        (expand-file-name (org-link-unescape path)))
 238         :name "org-video-link"
 239         :buffer " *org-video-link*")))))
 240
 241 (defun org-video-link-complete (&optional args)
 242   "Create a video link using completion with ARGS."
 243   (let ((file (read-file-name "Video: " nil nil nil nil
 244                               #'(lambda (file)
 245                                   (seq-contains-p
 246                                    org-video-link-extension-list
 247                                    (file-name-extension file)))))
 248         (pwd (file-name-as-directory (expand-file-name ".")))
 249         (pwd1 (file-name-as-directory (abbreviate-file-name
 250                                        (expand-file-name ".")))))
 251     (cond ((equal args '(16))
 252            (concat "video:"
 253                    (abbreviate-file-name (expand-file-name file))))
 254           ((string-match
 255             (concat "^" (regexp-quote pwd1) "\\(.+\\)") file)
 256            (concat "video:" (match-string 1 file)))
 257           ((string-match
 258             (concat "^" (regexp-quote pwd) "\\(.+\\)")
 259             (expand-file-name file))
 260            (concat "video:"
 261                    (match-string 1 (expand-file-name file))))
 262           (t (concat "video:" file)))))
 263
 264 (org-link-set-parameters
 265  "video"
 266  :follow #'org-video-link-open
 267  :complete #'org-video-link-complete)
 268
 269 ;;===================================================================================================
 270 ;;; [ web-browser: ] -- open Org link with web browser.
 271
 272 (defun org-web-browser--insert-description (link description)
 273   (string-trim-left link "web-browser:"))
 274
 275 (defun org-web-browser--complete-link ()
 276   "Create a file link using completion."
 277   (let ((file (read-file-name "Local HTML File: ")))
 278     (concat "web-browser:" file)))
 279
 280 (defun org-web-browser--store-link ()
 281   "Store a link from a local HTML file."
 282   (when (member major-mode '(html-mode html-ts-mode html-erb-mode web-mode))
 283     (let* ((link (buffer-file-name (current-buffer)))
 284            (description (file-name-nondirectory link)))
 285       (org-link-store-props
 286        :type "web-browser"
 287        :link link
 288        :description description))))
 289
 290 (defun org-web-browser--open-link (path &optional _)
 291   "Open local HTML file in PATH with web browser through function `browse-url'."
 292   (browse-url path))
 293
 294 (defun org-web-browser--export-link (link &optional description backend)
 295   "Export a local HTML file LINK with DESCRIPTION.
 296 BACKEND is the current export backend."
 297   (org-export-file-uri link))
 298
 299 (org-link-set-parameters
 300  "web-browser"
 301  :insert-description #'org-web-browser--insert-description
 302  :complete           #'org-web-browser--complete-link
 303  :store              #'org-web-browser--store-link
 304  :follow             #'org-web-browser--open-link
 305  :export             #'org-web-browser--export-link)
 306
 307 ;;===================================================================================================
 308 ;;; [ javascript: / js: ] -- Org link for executing simple JavaScript code.
 309
 310 ;;; e.g. [[javascript:console.log("hello, world");]]
 311
 312 (defun org-javascript--insert-description (link &optional description)
 313   (string-trim-left link "javascript:"))
 314
 315 (defun org-javascript--enable-code-completion ()
 316   "Enable Corfu in the minibuffer if `completion-at-point' is bound."
 317   (setq-local corfu-auto t)
 318   (setq-local corfu-auto-prefix 1)
 319   (setq-local completion-at-point-functions
 320               (list #'cape-file
 321                     #'cape-keyword
 322                     (cape-company-to-capf 'company-yasnippet)
 323                     #'cape-history
 324                     #'cape-abbrev #'cape-dabbrev))
 325   (corfu-mode 1))
 326
 327 (defmacro org-javascript--enable-code-completion-wrapper (&rest body)
 328   "Use a wrapper macro to add & clean `string-edit-mode-hook' without affecting global environment."
 329   `(let ((link))
 330      (add-hook 'string-edit-mode-hook #'org-javascript--enable-code-completion)
 331      (setq link ,@body)
 332      (remove-hook 'string-edit-mode-hook #'org-javascript--enable-code-completion)
 333      ;; The `link' is the JS code as variable of eval result pass to `org-insert-link'.
 334      link))
 335
 336 (defun org-javascript--complete-code (&optional _arg)
 337   "Complete JavaScript code in javascript: link."
 338   (org-javascript--enable-code-completion-wrapper
 339    (substring-no-properties
 340     (read-string-from-buffer            ; wrapper of `string-edit' with `callback'.
 341      "Write Org javascript: link code here: "
 342      "console.log(\"hello, world\");"))))
 343
 344 (defun org-javascript--store-link ()
 345   "Store link from JavaScript code."
 346   (when (member major-mode '(js-mode js2-mode javascript-mode))
 347     (unless (or (region-active-p) (use-region-p))
 348       (mark-paragraph))
 349     (let* ((org-store-props-function
 350             (if (fboundp 'org-link-store-props)
 351                 'org-link-store-props
 352               'org-store-link-props))
 353            (code (replace-regexp-in-string
 354                   "\n" " " ; replace newline with space to avoid multiple line code issue in link.
 355                   (buffer-substring-no-properties (region-beginning) (region-end))))
 356            (link (format "javascript:%s" code))
 357            (description (concat "JavaScript code: " (s-truncate (- (window-width) 40) code))))
 358       (deactivate-mark)
 359       (funcall org-store-props-function
 360                :type "javascript"
 361                :link link
 362                :description description))))
 363
 364 (defun org-javascript--execute-code (code &optional _)
 365   "Execute the JavaScript CODE in javascript: link."
 366   (cond
 367    ((featurep 'indium)
 368     (indium-launch)
 369     (indium-eval code (lambda (result) result)))
 370    ((featurep 'skewer-mode)
 371     (skewer-repl)
 372     (skewer-eval code (lambda (result) result)))
 373    ((featurep 'js-comint)
 374     (js-comint-start-or-switch-to-repl)
 375     (js-comint-send-string code))))
 376
 377 (defun org-javascript--export-code (link description backend)
 378   "Export a javascript: / js: LINK code with DESCRIPTION.
 379 BACKEND is the current export backend."
 380   ;; Evaluate javascript code in link, display eval result output in exporting.
 381   (org-javascript--execute-code link))
 382
 383 (org-link-set-parameters
 384  "javascript"
 385  :insert-description #'org-javascript--insert-description
 386  :complete           #'org-javascript--complete-code
 387  :store              #'org-javascript--store-link
 388  :follow             #'org-javascript--execute-code
 389  :export             #'org-javascript--export-code)
 390
 391 (org-link-set-parameters
 392  "js"
 393  :insert-description #'org-javascript--insert-description
 394  :complete           #'org-javascript--complete-code
 395  :store              #'org-javascript--store-link
 396  :follow             #'org-javascript--execute-code
 397  :export             #'org-javascript--export-code)
 398
 399 ;;===================================================================================================
 400 ;;; Add "vscode:" link type to open link in Visual Studio Code.
 401
 402 (defun org-vscode-open (path &optional _)
 403   "Open link PATH with Visual Studio Code."
 404   (if (string-match-p "//settings/.*" path)
 405       ;; [[vscode://settings/terminal.integrated.shellIntegration.enabled]]
 406       (cl-case system-type
 407         (darwin
 408          (start-process "org-vscode-open" " *org-vscode-open*" "open" (concat "vscode:" path)))
 409         (gnu/linux
 410          (start-process "org-vscode-open" " *org-vscode-open*" "xdg-open" (concat "vscode:" path))))
 411     ;; $ code /path/to/file_or_directory
 412     (start-process
 413      "org-vscode-open"
 414      "*org-vscode-open*"
 415      "code" (expand-file-name path)))
 416   (message "%s Visual Studio Code opened Org linked project -> \"%s\""
 417            (nerd-icons-mdicon "nf-md-microsoft_visual_studio_code" :face 'nerd-icons-blue-alt)
 418            path))
 419
 420 (defun org-vscode-complete (&optional _arg)
 421   "Complete path for vscode: link."
 422   (let ((path (expand-file-name
 423                (substring-no-properties
 424                 (read-file-name "Visual Studio Code link 'vscode:' path: ")))))
 425     (concat "vscode:" path)))
 426
 427 (org-link-set-parameters
 428  "vscode"
 429  :complete           #'org-vscode-complete
 430  :follow             #'org-vscode-open)
 431
 432 ;;===================================================================================================
 433 ;;; Add "weixin:" link type to open link in WeChat.
 434
 435 ;; https://stackoverflow.com/questions/35425553/how-do-i-link-to-wechat-from-a-webpage
 436 ;; WeChat does have a URI scheme that can be used from a browser. The scheme prefix is `weixin://'.
 437 ;;
 438 ;; There are a few URIs that can be used with this:
 439 ;;
 440 ;; `weixin://dl/stickers'
 441 ;; `weixin://dl/settings'
 442 ;; `weixin://dl/posts'
 443 ;; `weixin://dl/moments'
 444 ;; However, in answer to your question specifically, there is one where you can chat to a contact specifically:
 445 ;;
 446 ;; `weixin://dl/chat?{toID}'
 447 ;;
 448 ;; You will need to replace `{toID}' with whatever the destination user's WeChat ID is.
 449
 450 (defun org-weixin-link-open (path &optional _args)
 451   "Open WeiXin link PATH with optional ARGS."
 452   (cl-case system-type
 453     (darwin
 454      ;; open or switch to WeChat Application at first to make it available.
 455      (ns-do-applescript
 456 "tell application \"System Events\" to tell process \"WeChat\"
 457     if visible is true then
 458         set visible to true
 459     else
 460         tell application \"WeChat\" to activate
 461     end if
 462 end tell")
 463      (start-process "org-weixin-link-open"
 464                     " *org-weixin-link-open*"
 465                     "open" (concat "weixin:" path)))
 466     (gnu/linux
 467      (start-process "org-weixin-link-open"
 468                     " *org-weixin-link-open*"
 469                     "xg-open" (concat "weixin:" path)))))
 470
 471 (dolist (link-type '("weixin" "wechat"))
 472   (org-link-set-parameters
 473    link-type
 474    :follow   #'org-weixin-link-open))
 475
 476 ;;===================================================================================================
 477 ;;; Add "macappstore:" link type to open link in macOS App Store.
 478
 479 ;; This works with the new Mac App Store on Mojave.
 480 ;; macappstore://apps.apple.com/app/idxxxxxxxxx?action=write-review
 481 ;; If you also want to support iOS as well, use this general link:
 482 ;; https://apps.apple.com/app/idxxxxxxxxx?action=write-review
 483 ;; Replace xxxxxxxxx with your App ID. (can be found on App Store Connect)
 484
 485 (defun org-macappstore-open (url &optional _args)
 486   "Open macappstore:// link URL with ARGS from `browse-url'."
 487   (when (eq system-type 'darwin)
 488     ;; $ open vscode://settings/terminal.integrated.shellIntegration.enabled
 489     (start-process "org-macappstore-link-open"
 490                    " *org-macappstore-link-open*"
 491                    "open" (concat "macappstore:" url))))
 492
 493 (org-link-set-parameters
 494  "macappstore"
 495  :follow #'org-macappstore-open)
 496
 497 ;;; Add "applescript:" link type to open AppleScript Editor on macOS.
 498
 499 ;; "applescript://com.apple.scripteditor?action=new&script=..."
 500
 501 ;; e.g. applescript://com.apple.scripteditor?action=new&script=%0Atell%20application%20%22System%20Events%0A
 502 ;; (url-hexify-string "tell application \"System Events\"")
 503 ;; (url-hexify-string "\n")
 504
 505 (defun org-applescript-link-store ()
 506   "Store applescript:// link in `applescript-mode'."
 507   (when (or (eq major-mode 'applescript-mode)
 508             (eq major-mode 'apples-mode))
 509     (let ((link (concat "applescript://com.apple.scripteditor?action=new&script="
 510                        (url-hexify-string
 511                         (concat "\n" (buffer-substring-no-properties (point-min) (point-max)) "\n"))))
 512           (description "applescript: code link open AppleScript Editor"))
 513       (org-link-store-props
 514        :type "applescript"
 515        :link link
 516        :description description))))
 517
 518 (defun org-applescript-link-open (url &optional _args)
 519   "Open applescript:// link URL with ARGS using AppleScript Editor on macOS."
 520   (when (eq system-type 'darwin)
 521     (start-process "org-applescript-link-open"
 522                    " *org-applescript-link-open*"
 523                    "open" (concat "applescript:" url))))
 524
 525 (org-link-set-parameters
 526  "applescript"
 527  :store #'org-applescript-link-store
 528  :follow #'org-applescript-link-open)
 529
 530 \f
 531
 532 (provide 'org-extra-link-types)
 533
 534 ;;; org-extra-link-types.el ends here