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 "25.1") (cl-lib "1.0") (olc "1.4.1"))
   7 ;; Package-Version: 0.1
   8 ;; Keywords: 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
  28
  29 ;;; Code:
  30 \f
  31 (require 'cl-lib)
  32 (require 'ol)
  33 (require 'browse-url)
  34
  35 (defgroup org-extra-link-types nil
  36   "The customize group of package org-extra-link-types."
  37   :prefix "org-extra-link-types-"
  38   :group 'org)
  39
  40 ;;===============================================================================
  41 ;;; [ telnet: ]
  42
  43 ;;  e.g. telnet://ptt.cc
  44 (org-link-set-parameters "telnet" :follow #'telnet)
  45
  46 ;;===============================================================================
  47 ;;; [ chrome: ]
  48
  49 ;;; e.g. chrome:chrome://whats-new/
  50
  51 (cl-case system-type
  52   (gnu/linux
  53    (cond
  54     ((executable-find "google-chrome")
  55      (org-link-set-parameters "chrome" :follow #'browse-url-chrome))
  56     ((executable-find "chromium")
  57      (org-link-set-parameters "chrome" :follow #'browse-url-chromium))))
  58   (darwin
  59    (cond
  60     ((file-exists-p "/Applications/Google Chrome.app")
  61      (org-link-set-parameters "chrome" :follow #'browse-url-chrome))
  62     ((file-exists-p "/Applications/Chromium.app")
  63      (org-link-set-parameters "chrome" :follow #'browse-url-chromium))))
  64   (windows-nt
  65    ;; TODO:
  66    ;; https://stackoverflow.com/questions/40674914/google-chrome-path-in-windows-10
  67    ))
  68
  69 ;;===============================================================================
  70 ;;; [ rss: ]
  71
  72 (defun org-rss-link-open (uri)
  73   "Open rss:// URI link."
  74   (eww uri))
  75
  76 (org-link-set-parameters "rss" :follow #'org-rss-link-open)
  77
  78 ;;===============================================================================
  79 ;;; [ tag: ]
  80
  81 ;; e.g. [[tag:work+phonenumber-boss][Optional Description]]
  82
  83 (defun org-tag-link-open (tag)
  84   "Display a list of TODO headlines with tag TAG.
  85 With prefix argument, also display headlines without a TODO keyword."
  86   (org-tags-view (null current-prefix-arg) tag))
  87
  88 (org-link-set-parameters "tag" :follow #'org-tag-link-open)
  89
  90 ;;===============================================================================
  91 ;;; [ track: ]
  92
  93 ;;; `track:' for OSM Maps
  94 ;; [[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]]
  95
  96 (if (featurep 'org-osm-link)
  97     (require 'org-osm-link))
  98
  99 ;;===============================================================================
 100 ;;; [ geo: ]
 101
 102 ;; [geo:37.786971,-122.399677;u=35]
 103 ;; [[geo:58.397813,15.576063]]
 104 ;; [[geo:9FCQ9HXG+4CG]]
 105
 106 ;;; Open Location Code library `olc'
 107 (autoload 'olc-encode "olc")
 108 (autoload 'olc-decode "olc")
 109
 110 (defcustom org-geo-link-application-command "gnome-maps"
 111   "Specify the program name for openning geo: link."
 112   :type 'string
 113   :group 'org-extra-link-types)
 114
 115 (defun org-geo-link-open (link)
 116   "Open Geography location `URI' like \"geo:25.5889136,100.2208514\" in Map application."
 117   (if (featurep 'olc)
 118       (let ((location (cond
 119                        ;; (string-match-p "\\,.*" "25.5889136,100.2208514")
 120                        ((string-match-p "\\,.*" link)
 121                         link)
 122                        ;; (string-match-p "\\+.*" "9FCQ9HXG+4CG")
 123                        ((string-match-p "\\+.*" link)
 124                         (when (featurep 'olc)
 125                           (format "%s,%s"
 126                                   (olc-area-lat (olc-decode link))
 127                                   (olc-area-lon (olc-decode link)))))
 128                        (t (user-error "Your link is not Geo location or Open Location Code!")))))
 129         (if (executable-find org-geo-link-application-command)
 130             (start-process
 131              "org-geo-link-open"
 132              "*org-geo-link-open*"
 133              org-geo-link-application-command
 134              (shell-quote-wildcard-pattern location))
 135           (browse-url location)))
 136     (user-error "Emacs package 'olc' is not installed, please install it.")))
 137
 138 (org-link-set-parameters "geo" :follow #'org-geo-link-open)
 139
 140 ;;===============================================================================
 141 ;;; [ video: ]
 142
 143 ;;; e.g. [[video:/path/to/file.mp4::00:13:20]]
 144
 145 (defcustom org-video-link-open-command
 146   (cond
 147    ((executable-find "mpv") "mpv")
 148    ((executable-find "mplayer") "mplayer")
 149    ((executable-find "iina") "iina"))
 150   "Specify the program for openning video: link."
 151   :type 'string
 152   :group 'org-extra-link-types)
 153
 154 (defvar org-video-link-extension-list '("avi" "rmvb" "ogg" "mp4" "mkv"))
 155
 156 (defun org-video-link-open (uri)
 157   "Open video file `URI' with video player."
 158   (let* ((list (split-string uri "::"))
 159          (path (car list))
 160          (start-timstamp (cadr list)))
 161     (pcase org-video-link-open-command
 162       ("mpv"
 163        (make-process
 164         :command (list "mpv" (concat "--start=" start-timstamp)
 165                        (expand-file-name (org-link-unescape path)))
 166         :name "org-video-link"
 167         :buffer " *org-video-link*"))
 168       ("mplayer"
 169        (make-process
 170         :command (list "mplayer" "-ss" start-timstamp
 171                        (expand-file-name (org-link-unescape path)))
 172         :name "org-video-link"
 173         :buffer " *org-video-link*"))
 174       ("iina"
 175        (make-process
 176         :command (list "iina" (concat "--mpv-start=" start-timstamp)
 177                        (expand-file-name (org-link-unescape path)))
 178         :name "org-video-link"
 179         :buffer " *org-video-link*")))))
 180
 181 (defun org-video-complete-link (&optional arg)
 182   "Create a video link using completion."
 183   (let ((file (read-file-name "Video: " nil nil nil nil
 184                               #'(lambda (file)
 185                                   (seq-contains-p
 186                                    org-video-link-extension-list
 187                                    (file-name-extension file)))))
 188         (pwd (file-name-as-directory (expand-file-name ".")))
 189         (pwd1 (file-name-as-directory (abbreviate-file-name
 190                                        (expand-file-name ".")))))
 191     (cond ((equal arg '(16))
 192            (concat "video:"
 193                    (abbreviate-file-name (expand-file-name file))))
 194           ((string-match
 195             (concat "^" (regexp-quote pwd1) "\\(.+\\)") file)
 196            (concat "video:" (match-string 1 file)))
 197           ((string-match
 198             (concat "^" (regexp-quote pwd) "\\(.+\\)")
 199             (expand-file-name file))
 200            (concat "video:"
 201                    (match-string 1 (expand-file-name file))))
 202           (t (concat "video:" file)))))
 203
 204 (org-link-set-parameters "video"
 205                          :follow #'org-video-link-open
 206                          :complete #'org-video-complete-link)
 207
 208 ;;===================================================================================================
 209 ;;; [ web-browser: ] -- open Org link with web browser.
 210
 211 (defun org-web-browser--insert-description (link description)
 212   (string-trim-left link "web-browser:"))
 213
 214 (defun org-web-browser--complete-link ()
 215   "Create a file link using completion."
 216   (let ((file (read-file-name "Local HTML File: ")))
 217     (concat "web-browser:" file)))
 218
 219 (defun org-web-browser--store-link ()
 220   "Store a link from a local HTML file."
 221   (when (member major-mode '(html-mode html-ts-mode html-erb-mode web-mode))
 222     (let* ((link (buffer-file-name (current-buffer)))
 223            (description (file-name-nondirectory link)))
 224       (org-link-store-props
 225        :type "web-browser"
 226        :link link
 227        :description description))))
 228
 229 (defun org-web-browser--open-link (path _)
 230   "Open local HTML file with web browser through function `browse-url'."
 231   (browse-url path))
 232
 233 (defun org-web-browser--export-link (link description backend)
 234   "Export a local HTML file LINK with DESCRIPTION.
 235 BACKEND is the current export backend."
 236   (org-export-file-uri link))
 237
 238 (org-link-set-parameters
 239  "web-browser"
 240  :insert-description #'org-web-browser--insert-description
 241  :complete           #'org-web-browser--complete-link
 242  :store              #'org-web-browser--store-link
 243  :follow             #'org-web-browser--open-link
 244  :export             #'org-web-browser--export-link)
 245
 246 ;;===================================================================================================
 247 ;;; [ javascript: / js: ] -- Org link for executing simple JavaScript code.
 248
 249 ;;; e.g. [[javascript:console.log("hello, world");]]
 250
 251 (defun org-javascript--insert-description (link description)
 252   (string-trim-left link "javascript:"))
 253
 254 (defun org-javascript--enable-code-completion ()
 255   "Enable Corfu in the minibuffer if `completion-at-point' is bound."
 256   (setq-local corfu-auto t)
 257   (setq-local corfu-auto-prefix 1)
 258   (setq-local completion-at-point-functions
 259               (list #'cape-file
 260                     #'cape-keyword
 261                     (cape-company-to-capf 'company-yasnippet)
 262                     #'cape-history
 263                     #'cape-abbrev #'cape-dabbrev))
 264   (corfu-mode 1))
 265
 266 (defmacro org-javascript--enable-code-completion-wrapper (&rest body)
 267   "Use a wrapper macro to add & clean `string-edit-mode-hook' without affecting global environment."
 268   `(let ((link))
 269      (add-hook 'string-edit-mode-hook #'org-javascript--enable-code-completion)
 270      (setq link ,@body)
 271      (remove-hook 'string-edit-mode-hook #'org-javascript--enable-code-completion)
 272      ;; The `link' is the JS code as variable of eval result pass to `org-insert-link'.
 273      link))
 274
 275 (defun org-javascript--complete-code (&optional _arg)
 276   "Complete JavaScript code in javascript: link."
 277   (org-javascript--enable-code-completion-wrapper
 278    (substring-no-properties
 279     (read-string-from-buffer            ; wrapper of `string-edit' with `callback'.
 280      "Write Org javascript: link code here: "
 281      "console.log(\"hello, world\");"))))
 282
 283 (defun org-javascript--store-link ()
 284   "Store link from JavaScript code."
 285   (when (member major-mode '(js-mode js2-mode javascript-mode))
 286     (unless (or (region-active-p) (use-region-p))
 287       (mark-paragraph))
 288     (let* ((org-store-props-function
 289             (if (fboundp 'org-link-store-props)
 290                 'org-link-store-props
 291               'org-store-link-props))
 292            (code (replace-regexp-in-string
 293                   "\n" " " ; replace newline with space to avoid multiple line code issue in link.
 294                   (buffer-substring-no-properties (region-beginning) (region-end))))
 295            (link (format "javascript:%s" code))
 296            (description (concat "JavaScript code: " (s-truncate (- (window-width) 40) code))))
 297       (deactivate-mark)
 298       (funcall org-store-props-function
 299                :type "javascript"
 300                :link link
 301                :description description))))
 302
 303 (defun org-javascript--execute-code (code &optional _)
 304   "Execute the JavaScript CODE in javascript: link."
 305   (cond
 306    ((featurep 'indium)
 307     (indium-launch)
 308     (indium-eval code (lambda (result) result)))
 309    ((featurep 'skewer-mode)
 310     (skewer-repl)
 311     (skewer-eval code (lambda (result) result)))
 312    ((featurep 'js-comint)
 313     (js-comint-start-or-switch-to-repl)
 314     (js-comint-send-string code))))
 315
 316 (defun org-javascript--export-code (link description backend)
 317   "Export a javascript: / js: LINK code with DESCRIPTION.
 318 BACKEND is the current export backend."
 319   ;; Evaluate javascript code in link, display eval result output in exporting.
 320   (org-javascript--execute-code link))
 321
 322 (org-link-set-parameters
 323  "javascript"
 324  :insert-description #'org-javascript--insert-description
 325  :complete           #'org-javascript--complete-code
 326  :store              #'org-javascript--store-link
 327  :follow             #'org-javascript--execute-code
 328  :export             #'org-javascript--export-code)
 329
 330 (org-link-set-parameters
 331  "js"
 332  :insert-description #'org-javascript--insert-description
 333  :complete           #'org-javascript--complete-code
 334  :store              #'org-javascript--store-link
 335  :follow             #'org-javascript--execute-code
 336  :export             #'org-javascript--export-code)
 337
 338 ;;===================================================================================================
 339 ;;; Add "vscode:" link type to open link in Visual Studio Code.
 340
 341 (defun org-vscode-open-path (path &optional _)
 342   "Open link path with Visual Studio Code."
 343   (start-process
 344    "org-vscode-open"
 345    "*org-vscode-open*"
 346    "code" (expand-file-name path))
 347   (message "%s Visual Studio Code opened Org linked project -> \"%s\""
 348            (nerd-icons-mdicon "nf-md-microsoft_visual_studio_code" :face 'nerd-icons-blue-alt)
 349            path))
 350
 351 (defun org-vscode-complete-path (&optional _arg)
 352   "Complete path for vscode: link."
 353   (let ((path (expand-file-name
 354                (substring-no-properties
 355                 (read-file-name "Visual Studio Code link 'vscode:' path: ")))))
 356     (concat "vscode:" path)))
 357
 358 (org-link-set-parameters
 359  "vscode"
 360  :complete           #'org-vscode-complete-path
 361  :follow             #'org-vscode-open-path)
 362
 363 \f
 364
 365 (provide 'org-extra-link-types)
 366
 367 ;;; org-extra-link-types.el ends here