org-link-beautify.el

   1 ;;; org-link-beautify.el --- Beautify Org Links -*- lexical-binding: t; -*-
   2
   3 ;; Authors: stardiviner <numbchild@gmail.com>
   4 ;; Package-Requires: ((emacs "29.1") (org "9.7.14") (nerd-icons "0.0.1") (qrencode "1.3"))
   5 ;; Version: 2.0.0
   6 ;; Keywords: hypermedia
   7 ;; homepage: https://repo.or.cz/org-link-beautify.git
   8
   9 ;; org-link-beautify is free software; you can redistribute it and/or modify it
  10 ;; under the terms of the GNU General Public License as published by
  11 ;; the Free Software Foundation; either version 3, or (at your option)
  12 ;; any later version.
  13 ;;
  14 ;; org-link-beautify is distributed in the hope that it will be useful, but WITHOUT
  15 ;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
  16 ;; or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public
  17 ;; License for more details.
  18 ;;
  19 ;;
  20 ;; You should have received a copy of the GNU General Public License
  21 ;; along with GNU Emacs.  If not, see <https://www.gnu.org/licenses/>.
  22
  23 ;;; Commentary:
  24
  25 ;; Usage:
  26 ;;
  27 ;; (use-package org-link-beautify
  28 ;;   :ensure t
  29 ;;   :init (org-link-beautify-mode t))
  30
  31 ;;; Code:
  32 \f
  33 (require 'org) ; including `ol'
  34 (require 'org-element)
  35 (require 'org-element-ast)
  36 (require 'cl-lib)
  37 (require 'color)
  38 (require 'faces)
  39 (require 'image)
  40 (require 'nerd-icons)
  41 (require 'qrencode)
  42
  43 ;; (require 'fb2-reader)
  44 (declare-function fb2-reader--create-image "fb2-reader" (data type &rest props))
  45 (declare-function fb2-reader--extract-image-data "fb2-reader" (book attributes &optional tags))
  46 (declare-function fb2-reader--get-cover "fb2-reader" (book))
  47 (declare-function fb2-reader-parse-file-as-html "fb2-reader" (file))
  48 (declare-function fb2-reader-parse-file-as-xml "fb2-reader" (file))
  49
  50 ;;; Customization
  51 (defgroup org-link-beautify nil
  52   "Customize group of `org-link-beautify-mode'."
  53   :prefix "org-link-beautify-"
  54   :group 'org)
  55
  56 (defcustom org-link-beautify-thumbnails-dir 'current-working-directory
  57   "The directory of generated thumbnails.
  58
  59 By default option value with symbol 'current-working-directory the
  60 thumbnails are generated in source file path’s .thumbnails directory.
  61 This is better for avoiding re-generate preview thumbnails. Or you can
  62 set this option to 'user-home which represent to ~/.cache/thumbnails/."
  63   :type 'symbol
  64   :safe #'symbolp
  65   :group 'org-link-beautify)
  66
  67 (defcustom org-link-beautify-enable-debug-p nil
  68   "Whether enable org-link-beautify print debug info."
  69   :type 'boolean
  70   :safe #'booleanp)
  71
  72
  73 ;;; overlay keymap keybindings
  74
  75 (defvar org-link-beautify-keymap
  76   (let ((map (make-sparse-keymap)))
  77     (set-keymap-parent map image-map) ; inherit `image-map' keybindings on preview thumbnail image.
  78     map))
  79
  80 (defun org-link-beautify-action-goto-file-in-dired ()
  81   "Action of opening Dired and goto the link file position."
  82   (interactive)
  83   (when (derived-mode-p 'org-mode)
  84     (let* ((file-path (org-element-property :path (org-element-context)))
  85            (file-name (file-name-nondirectory file-path)))
  86       (org-attach-reveal)
  87       (search-forward file-name)
  88       (dired-move-to-filename) ; move point to beginning of filename.
  89       (if (and (featurep 'dwim-shell-command) (featurep 'dwim-shell-commands))
  90           (progn
  91             (message "Jumped to position of link file, now you can execute `dwim-shell-command' commands")
  92             (command-execute nil (read-extended-command-1 nil "dwim-shell-commands")))
  93         (user-error "Jumped to position of link file.
  94 Package `dwim-shell-command' is missing, please install it")))))
  95
  96 (define-key org-link-beautify-keymap (kbd "M-o") #'org-link-beautify-action-goto-file-in-dired)
  97
  98 (defun org-link-beautify--copy-file-to-clipboard (file)
  99   "Copy the FILE on path to clipboard.
 100 The argument FILE must be the absolute path."
 101   (cl-case system-type
 102     (darwin
 103      (do-applescript
 104       (format "tell app \"Finder\" to set the clipboard to ( POSIX file \"%s\" )" file)))
 105     (gnu/linux
 106      ;; - xclip-copyfile :: command copies files into the X clipboard, recursing into directories.
 107      ;; - xclip-cutfile :: command Copy the files, but also deletes them afterwards.
 108      ;; - xclip-pastefile :: command Paste the files out of the clipboard.
 109      ;; - xclip :: command Copy text or files to the clipboard.
 110      (if (executable-find "xclip-copyfile")
 111          (shell-command (format "xclip-copyfile %s" file))
 112        (user-error "[org-link-beautify] Error: the command-line tool 'xclip-copyfile' is not installed!")))
 113     ;; TODO:
 114     (windows-nt ))
 115   (message "Copied file [%s] to system clipboard." (string-truncate-left file (/ (window-width) 2))))
 116
 117 (defun org-link-beautify-action-copy-file (&optional args)
 118   "Action of copying the Org link file at point with optional ARGS."
 119   (interactive "P")
 120   (when (derived-mode-p 'org-mode)
 121     (if (or (region-active-p) mark-active)
 122         (let ((region-text (buffer-substring-no-properties
 123                             (region-beginning) (region-end))))
 124           (kill-new region-text)
 125           (deactivate-mark))
 126       (let ((element (org-element-context)))
 127         (if (and (eq (car element) 'link)
 128                  (string-equal (org-element-property :type element) "file"))
 129             (let ((file-path (expand-file-name (org-element-property :path element))))
 130               (org-link-beautify--copy-file-to-clipboard file-path))
 131           (message "[org-link-beautify] No action executed on link."))))))
 132
 133 (define-key org-link-beautify-keymap (kbd "M-w") #'org-link-beautify-action-copy-file)
 134
 135 (defun org-link-beautify-action-qrcode-for-url (&optional args)
 136   "Action of displaying QR code for Org link at point in new buffer in ARGS."
 137   (interactive)
 138   (when (derived-mode-p 'org-mode)
 139     (if-let ((url (org-element-property-raw :raw-link (org-element-context))))
 140         (if (require 'qrencode nil t)
 141             (qrencode-string url)
 142           (package-install 'qrencode)
 143           (qrencode-string url))
 144       (if (or (region-active-p) mark-active)
 145           (org-fill-paragraph t t)
 146         (org-fill-paragraph)))))
 147
 148 (define-key org-link-beautify-keymap (kbd "M-q") 'org-link-beautify-action-qrcode-for-url)
 149
 150 ;;; helper functions
 151
 152 (defun org-link-beautify--get-thumbnails-dir-path (file)
 153   "Return the FILE thumbnail directory's path."
 154   (if file
 155       (cl-case org-link-beautify-thumbnails-dir
 156         (current-working-directory
 157          (concat (file-name-directory file) ".thumbnails/"))
 158         (user-home
 159          (expand-file-name "~/.cache/thumbnails/")))
 160     (user-error "[org-link-beautify] Error: the paramter `file' of function `org-link-beautify--get-thumbnails-dir-path' is nil")))
 161
 162 (defun org-link-beautify--ensure-thumbnails-dir (thumbnails-dir)
 163   "Ensure THUMBNAILS-DIR exist, if not ,create it."
 164   (if (file-exists-p (file-name-parent-directory thumbnails-dir))
 165       (unless (file-directory-p thumbnails-dir)
 166         (make-directory thumbnails-dir))
 167     (if (yes-or-no-p "[org-link-beautify] thumbnails directory parent directory does not exist, create it?")
 168         (make-directory thumbnails-dir t)
 169       (warn "[org-link-beautify] thumbnails directory parent directory does not exist"))))
 170
 171 (defun org-link-beautify--notify-generate-thumbnail-failed (source-file thumbnail-file)
 172   "Notify that generating THUMBNAIL-FILE for SOURCE-FILE failed."
 173   (message "[org-link-beautify] For file %s.\nCreate thumbnail %s failed." source-file thumbnail-file))
 174
 175 (defun org-link-beautify--display-content-block (lines-list)
 176   "Display LINES-LIST string as a block with beautified frame border."
 177   (format
 178    "
 179 ┏━§ ✂ %s
 180 %s
 181 ┗━§ ✂ %s
 182 \n"
 183    (make-string (- fill-column 6) ?━)
 184    (mapconcat
 185     (lambda (line)
 186       (concat "┃" line))
 187     lines-list
 188     "\n")
 189    (make-string (- fill-column 6) ?━)))
 190
 191 (defun org-link-beautify--display-org-content (org-content)
 192   "Display ORG-CONTENT in `org-mode'."
 193   (with-temp-buffer
 194     (let ((org-startup-with-link-previews nil))
 195       (insert org-content)
 196       (org-mode)
 197       ;; (goto-char (line-beginning-position 2))
 198       ;; FIXME: how to fix org-attach directory issue.
 199       ;; error: "Need absolute ‘org-attach-id-dir’ to attach in buffers without filename"
 200       ;; reference `org-attach-dir'
 201       ;; (when (org-entry-get nil "DIR" org-attach-use-inheritance)
 202       ;;   (org-link-preview-region t t (point-min) (point-max)))
 203       (buffer-substring (point-min) (point-max)))))
 204
 205 ;;; Invoke external Python script file or code.
 206
 207 (defcustom org-link-beautify-python-interpreter (executable-find "python3")
 208   "Specify Python interpreter to run python scripts or code."
 209   :type 'string
 210   :safe #'stringp)
 211
 212 (defun org-link-beautify--python-script-run (python-script-file)
 213   "Run PYTHON-SCRIPT-FILE through shell command."
 214   (shell-command-to-string
 215    (format "%s %s" org-link-beautify-python-interpreter python-script-file)))
 216
 217 (defun org-link-beautify--python-command-to-string (&rest code-lines)
 218   "Run Python CODE-LINES through shell command."
 219   (shell-command-to-string
 220    (concat "python -c "
 221            ;; solve double quote character issue.
 222            "\"" (string-replace "\"" "\\\"" (string-join code-lines "\n")) "\"")))
 223
 224 ;; TEST:
 225 ;; (org-link-beautify--python-command-to-string
 226 ;;  "import numpy as np"
 227 ;;  "print(np.arange(6))"
 228 ;;  "print(\"blah blah\")"
 229 ;;  "print('{}'.format(3))")
 230
 231 ;;; Invoke external JavaScript script file or code.
 232
 233 (defcustom org-link-beautify-javascript-interpreter (executable-find "node")
 234   "Specify JavaScript interpreter to run JavaScript scripts or code."
 235   :type 'string
 236   :safe #'stringp)
 237
 238 (defun org-link-beautify--javascript-script-run (javascript-script-file)
 239   "Run JAVASCRIPT-SCRIPT-FILE through shell command."
 240   (shell-command-to-string
 241    (format "%s %s" org-link-beautify-javascript-interpreter javascript-script-file)))
 242
 243 (defun org-link-beautify--javascript-command-to-string (&rest code-lines)
 244   "Run JavaScript CODE-LINES through shell command."
 245   (shell-command-to-string
 246    (concat org-link-beautify-javascript-interpreter
 247            " --eval "
 248            ;; solve double quote character issue.
 249            "\"" (string-replace "\"" "\\\"" (string-join code-lines "\n")) "\"")))
 250
 251 ;; TEST:
 252 ;; (org-link-beautify--javascript-command-to-string
 253 ;;  "console.log(\"hello, world!\");"
 254 ;;  "console.log(1 + 3);")
 255
 256 ;;; Iconify for link
 257
 258 (defun org-link-beautify--get-link-description (position)
 259   "Get the link description at POSITION (fuzzy but faster version)."
 260   (save-excursion
 261     (goto-char position)
 262     (cond
 263      ((org-element-link-parser)
 264       (let ((link (org-element-link-parser)))
 265         (if (org-element-property :contents-begin link)
 266             (buffer-substring-no-properties
 267              (org-element-property :contents-begin link)
 268              (org-element-property :contents-end link))
 269           (org-element-property :raw-link link))))
 270      ((org-element-context)
 271       (let ((link (org-element-link-parser)))
 272         (org-element-property :raw-link link)))
 273      (t (save-excursion
 274           (goto-char position)
 275           (and (org-in-regexp org-link-bracket-re) (match-string 2)))))))
 276
 277 (defun org-link-beautify--return-warning-face (ov path link)
 278   "Return warning face if PATH does not exist on OV overlay at LINK element."
 279   (when (string-equal (org-element-property :type link) "file")
 280     (if (and (not (file-remote-p path))
 281              (file-exists-p (expand-file-name path)))
 282         'org-link
 283       'error)))
 284
 285 (defun org-link-beautify--return-icon (ov path link)
 286   "Return icon for PATH on OV overlay at LINK element."
 287   (let ((type (org-element-property :type link))
 288         (extension (file-name-extension path)))
 289     (pcase type
 290       ("file" (if-let (extension (file-name-extension path))
 291                   (nerd-icons-icon-for-extension extension)
 292                 (nerd-icons-icon-for-dir path)))
 293       ("attachment" (if-let (extension (file-name-extension path))
 294                         (nerd-icons-icon-for-extension extension)
 295                       (nerd-icons-icon-for-dir path)))
 296       ("http" (nerd-icons-icon-for-url (concat type ":" path)))
 297       ("https" (nerd-icons-icon-for-url (concat type ":" path)))
 298       ("ftp" (nerd-icons-icon-for-url (concat type ":" path)))
 299       ;; Org mode internal link types
 300       ("custom-id" (nerd-icons-mdicon "nf-md-text_box_search_outline" :face 'nerd-icons-blue))
 301       ("id" (nerd-icons-mdicon "nf-md-text_search" :face 'nerd-icons-blue))
 302       ("coderef" (nerd-icons-codicon "nf-cod-references" :face 'nerd-icons-cyan))
 303       ("elisp" (nerd-icons-icon-for-file "file.el"))
 304       ("eshell" (nerd-icons-icon-for-mode 'eshell-mode))
 305       ("shell" (nerd-icons-icon-for-mode 'shell-mode))
 306       ("man" (nerd-icons-mdicon "nf-md-file_document_outline" :face 'nerd-icons-lblue))
 307       ("woman" (nerd-icons-mdicon "nf-md-file_document_outline" :face 'nerd-icons-blue-alt))
 308       ("info" (nerd-icons-mdicon "nf-md-information_outline" :face 'nerd-icons-lblue))
 309       ("help" (nerd-icons-mdicon "nf-md-help_circle_outline" :face 'nerd-icons-lblue))
 310       ("shortdoc" (nerd-icons-mdicon "nf-md-file_link" :face 'nerd-icons-blue))
 311       ;; org-ref link types
 312       ("cite" (nerd-icons-codicon "nf-cod-references" :face 'nerd-icons-cyan))
 313       ;; Org mode external link types
 314       ("eaf" (nerd-icons-mdicon "nf-md-apps" :face 'nerd-icons-blue)) ; emacs-application-framework
 315       ("eww" (nerd-icons-icon-for-mode 'eww-mode)) ; EWW
 316       ("chrome" (nerd-icons-mdicon "nf-md-google_chrome" :face 'nerd-icons-lorange))
 317       ("edge" (nerd-icons-mdicon "nf-md-microsoft_edge" :face 'nerd-icons-green))
 318       ("mu4e" (nerd-icons-mdicon "nf-md-email_search_outline" :face 'nerd-icons-blue))
 319       ("news" (nerd-icons-mdicon "nf-md-newspaper_variant_outline" :face 'nerd-icons-dgreen))
 320       ("git" (nerd-icons-mdicon "nf-md-git" :face 'nerd-icons-lred))
 321       ("orgit" (nerd-icons-faicon "nf-fa-git" :face 'nerd-icons-red))
 322       ("orgit-rev" (nerd-icons-devicon "nf-dev-git_commit" :face 'nerd-icons-silver))
 323       ("orgit-log" (nerd-icons-octicon "nf-oct-diff" :face 'nerd-icons-silver))
 324       ("pdf" (nerd-icons-faicon "nf-fa-file_pdf" :face 'nerd-icons-red))
 325       ("epub" (nerd-icons-mdicon "nf-md-book_open_page_variant_outline" :face 'nerd-icons-blue-alt))
 326       ("nov" (nerd-icons-icon-for-file "file.epub")) ; for Emacs package "nov.el" link type `nov:'
 327       ("grep" (nerd-icons-mdicon "nf-md-selection_search" :face 'nerd-icons-green))
 328       ("occur" (nerd-icons-mdicon "nf-md-selection_multiple" :face 'nerd-icons-green))
 329       ("rss" (nerd-icons-mdicon "nf-md-rss" :face 'nerd-icons-lorange))
 330       ("elfeed" (nerd-icons-mdicon "nf-md-rss" :face 'nerd-icons-green))
 331       ("wikipedia" (nerd-icons-mdicon "nf-md-wikipedia" :face 'nerd-icons-dsilver))
 332       ("mailto" (nerd-icons-mdicon "nf-md-email_send_outline" :face 'nerd-icons-lblue))
 333       ("irc" (nerd-icons-mdicon "nf-md-chat" :face 'nerd-icons-blue-alt))
 334       ("wechat" (nerd-icons-mdicon "nf-md-wechat" :face 'nerd-icons-green))
 335       ("magnet" (nerd-icons-mdicon "nf-md-magnet" :face 'nerd-icons-blue-alt))
 336       ("ref" (nerd-icons-codicon "nf-cod-references" :face 'nerd-icons-blue))
 337       ("doi" (nerd-icons-mdicon "nf-md-file_document_plus_outline" :face 'nerd-icons-green))
 338       ("org-contact" (nerd-icons-mdicon "nf-md-contacts_outline" :face 'nerd-icons-purple-alt))
 339       ("org-bookmark" (nerd-icons-mdicon "nf-md-bookmark_check_outline" :face 'nerd-icons-blue-alt))
 340       ("org-ql-search" (nerd-icons-mdicon "nf-md-text_box_search_outline" :face 'nerd-icons-blue-alt))
 341       ;; org-media-note link types
 342       ("video" (nerd-icons-faicon "nf-fa-file_video_o" :face 'nerd-icons-blue))
 343       ("audio" (nerd-icons-faicon "nf-fa-file_audio_o" :face 'nerd-icons-blue))
 344       ("videocite" (nerd-icons-faicon "nf-fa-file_video_o" :face 'nerd-icons-blue-alt))
 345       ("audiocite" (nerd-icons-faicon "nf-fa-file_audio_o" :face 'nerd-icons-blue-alt))
 346       ("javascript" (nerd-icons-mdicon "nf-md-language_javascript" :face 'nerd-icons-yellow))
 347       ("js" (nerd-icons-mdicon "nf-md-language_javascript" :face 'nerd-icons-yellow))
 348       ("vscode" (nerd-icons-mdicon "nf-md-microsoft_visual_studio_code" :face 'nerd-icons-blue-alt)) ; Visual Studio Code
 349       ("macappstore" (nerd-icons-mdicon "nf-md-apple" :face 'nerd-icons-blue)) ; Mac App Store
 350
 351       ("fuzzy"
 352        ;; Org internal [[reference][reference]] -> NOT supported by:
 353        ;; `(org-link-set-parameters link-type :activate-func ...)'
 354        ;;
 355        ;; (link (:standard-properties [584419 nil 584470 584517 584519 0 nil nil nil nil nil nil ...] :type "fuzzy" :type-explicit-p nil :path "defcustom org-contacts-identity-properties-list" :format bracket :raw-link "defcustom org-contacts-identity-properties-list" ...))
 356
 357        (when-let* ((_ (string-match "\\([^:]*\\):\\(.*\\)" path))
 358                    (real-type (match-string 1 path))) ; extract the "real" link type for "fuzzy" type in :path.
 359          (cond
 360           (t
 361            (message "[org-link-beautify] link type not supported, add PR for this link type.
 362 type: %s, path: %s, extension: %s, link-element: %s" type path extension link)
 363            (nerd-icons-mdicon "nf-md-progress_question" :face 'nerd-icons-lyellow)))))
 364       (_
 365        (message "[org-link-beautify] link type not supported, add PR for this link type.
 366 type: %s, path: %s, extension: %s, link-element: %s" type path extension link)
 367        ;; handle when returned link type is `nil'.
 368        (nerd-icons-mdicon "nf-md-progress_question" :face 'nerd-icons-lyellow)))))
 369
 370 (defun org-link-beautify-iconify (ov path link)
 371   "Iconify PATH over OV overlay position for LINK element."
 372   (when-let* ((begin (org-element-begin link))
 373               (end (org-element-end link))
 374               (description (org-link-beautify--get-link-description begin))
 375               (icon (org-link-beautify--return-icon ov path link)))
 376     (overlay-put ov
 377                  'display (concat
 378                            (propertize "[" 'face `( :inherit nil
 379                                                     :underline nil
 380                                                     :foreground ,(if (face-foreground 'shadow)
 381                                                                      (color-lighten-name (face-foreground 'shadow) 2)
 382                                                                    "gray40")))
 383                            (propertize description 'face (org-link-beautify--return-warning-face ov path link))
 384                            (propertize "]" 'face `( :inherit nil
 385                                                     :underline nil
 386                                                     :foreground ,(if (face-foreground 'shadow)
 387                                                                      (color-lighten-name (face-foreground 'shadow) 2)
 388                                                                    "gray40")))))
 389     (overlay-put ov
 390                  'after-string (concat
 391                                 (propertize "[" 'face '(:inherit nil :underline nil :foreground "orange"))
 392                                 icon
 393                                 (propertize "]" 'face '(:inherit nil :underline nil :foreground "orange"))))))
 394
 395 ;;; General thumbnail generator.
 396
 397 (defvar org-link-beautify-thumbnailer-script
 398   (expand-file-name "scripts/thumbnailer.py" (file-name-directory (or load-file-name (buffer-file-name))))
 399   "The path of general thumbnailer script.")
 400
 401 (defun org-link-beautify-thumbnailer (path)
 402   "Generate thumbnail image for file of PATH over OV overlay position for LINK element."
 403   (when (string-match "\\(.*?\\)\\(?:::\\(.*\\)\\)?\\'" path)
 404     (let* ((file-path (match-string 1 path))
 405            (input-file (expand-file-name (org-link-unescape file-path)))
 406            (search-option (match-string 2 path))
 407            (thumbnails-dir (org-link-beautify--get-thumbnails-dir-path input-file))
 408            (thumbnail-file (expand-file-name (format "%s%s.png" thumbnails-dir (file-name-base input-file))))
 409            (thumbnail-size 600)
 410            (proc-name (format "org-link-beautify thumbnailer - %s" (file-name-base input-file)))
 411            (proc-buffer (format " *org-link-beautify thumbnailer - %s*" (file-name-base input-file)))
 412            (proc (get-process proc-name)))
 413       (make-process
 414        :name proc-name
 415        :command (list org-link-beautify-thumbnailer-script
 416                       input-file
 417                       thumbnail-file
 418                       (number-to-string thumbnail-size))
 419        :buffer proc-buffer
 420        :stderr nil ; If STDERR is nil, standard error is mixed with standard output and sent to BUFFER or FILTER.
 421        :sentinel (lambda (proc event)
 422                    (when org-link-beautify-enable-debug-p
 423                      (message (format "> proc: %s\n> event: %s" proc event)))
 424                    ;; (when (string= event "finished\n")
 425                    ;;   (kill-buffer (process-buffer proc))
 426                    ;;   (kill-process proc))
 427                    ))
 428       ;; return the thumbnail file as result.
 429       thumbnail-file)))
 430
 431 (defun org-link-beautify-preview-thumbnail (ov path link)
 432   "Display thumbnail on overlay OV from PATH at element LINK."
 433   (if-let* (( (display-graphic-p))
 434             (thumbnail-file (expand-file-name path))
 435             ;; ((string-match-p (image-file-name-regexp) thumbnail-file))
 436             ((file-exists-p thumbnail-file)))
 437       (let* ((width (or (org-display-inline-image--width link) 300))
 438              (align (org-image--align link))
 439              (image (org--create-inline-image thumbnail-file width)))
 440         (when image                     ; Add image to overlay
 441               ;; See bug#59902. We cannot rely on Emacs to update image if the file has changed.
 442           (image-flush image) ; refresh image in cache if file changed.
 443               (overlay-put ov 'display image)
 444               (overlay-put ov 'face    'default)
 445               (overlay-put ov 'keymap  org-link-beautify-keymap)
 446           (when align
 447             (overlay-put ov
 448                          'before-string (propertize " "
 449                                                     'face 'default
 450                                                     'display (pcase align
 451                                                                ("center" `(space :align-to (- center (0.5 . ,image))))
 452                                                                ("right"  `(space :align-to (- right ,image)))))))
 453           t))))
 454
 455 ;;; Preview file: link type
 456
 457 (defun org-link-beautify-preview-file (ov path link)
 458   "Preview file of PATH over OV overlay position for LINK element.
 459 This function will apply file type function based on file extension."
 460   (let ((extension (file-name-extension path)))
 461     (cond
 462      ((null extension) ; no file extension, it's directory.
 463       (org-link-beautify-iconify ov path link))
 464      ((string-match-p (image-file-name-regexp) path) ; `org-link-beautify-image-preview-list'
 465       (org-link-beautify-preview-file-image ov path link))
 466      ((string-equal extension "pdf")
 467       (org-link-beautify-preview-file-pdf ov path link))
 468      ((string-equal extension "epub")
 469       (org-link-beautify-preview-file-epub ov path link))
 470      ((string-match-p "\\(mobi\\|azw3\\)" extension)
 471       (org-link-beautify-preview-file-kindle ov path link))
 472      ((string-match-p "\\.fb2\\(\\.zip\\)?" path)
 473       (org-link-beautify-preview-file-fictionbook2 ov path link))
 474      ((member extension org-link-beautify-comic-preview-list)
 475       (org-link-beautify-preview-file-comic ov path link))
 476      ((member extension org-link-beautify-video-preview-list)
 477       (org-link-beautify-preview-file-video ov path link))
 478      ((member extension org-link-beautify-audio-preview-list)
 479       (org-link-beautify-preview-file-audio ov path link))
 480      ((member extension org-link-beautify-subtitle-preview-list)
 481       (org-link-beautify-preview-file-subtitle ov path link))
 482      ((member extension org-link-beautify-archive-preview-list)
 483       (org-link-beautify-preview-file-archive ov path link))
 484      ((member extension org-link-beautify-source-code-preview-list)
 485       (org-link-beautify-preview-file-source-code ov path link))
 486      (t (let ((thumbnail-file (org-link-beautify-thumbnailer path)))
 487           (if (file-exists-p thumbnail-file)
 488               (org-link-beautify-preview-thumbnail ov path link)
 489             (org-link-beautify-iconify ov path link)))))))
 490
 491 (defun org-link-beautify-preview-attachment (ov path link)
 492   "Preview attachment file of PATH over OV overlay position for LINK element.
 493 This function will apply file type function based on file extension."
 494   (org-with-point-at (org-element-begin link)
 495     (org-link-beautify-preview-file ov (org-attach-expand path) link)))
 496
 497 ;;; file: [image]
 498
 499 (defcustom org-link-beautify-image-preview-list
 500   '("jpg" "jpeg" "png" "gif" "webp")
 501   "A list of image file types be supported with thumbnails."
 502   :type 'list
 503   :safe #'listp
 504   :group 'org-link-beautify)
 505
 506 (defun org-link-beautify-preview-file-image (ov path link)
 507   "Preview image file of PATH over OV overlay position for LINK element."
 508   (if-let* (( (display-graphic-p))
 509             (file (expand-file-name path))
 510             ;; ((string-match-p (image-file-name-regexp) file))
 511             ((file-exists-p file)))
 512       (let* ((align (org-image--align link))
 513              (width (org-display-inline-image--width link))
 514              (image (org--create-inline-image file width)))
 515         (when image                     ; Add image to overlay
 516               ;; See bug#59902. We cannot rely on Emacs to update image if the file has changed.
 517           (image-flush image) ; refresh image in cache if file changed.
 518               (overlay-put ov 'display image)
 519               (overlay-put ov 'face    'default)
 520               (overlay-put ov 'keymap  org-link-beautify-keymap)
 521           (when align
 522             (overlay-put ov
 523                          'before-string (propertize " "
 524                                                     'face 'default
 525                                                     'display (pcase align
 526                                                                ("center" `(space :align-to (- center (0.5 . ,image))))
 527                                                                ("right"  `(space :align-to (- right ,image)))))))
 528           t))))
 529
 530 ;;; file: .pdf
 531
 532 (defcustom org-link-beautify-pdf-preview-command
 533   (cond
 534    ((executable-find "pdftocairo") "pdftocairo")
 535    ((executable-find "pdf2svg") "pdf2svg"))
 536   "The command used to preview PDF file cover."
 537   :type 'string
 538   :safe #'stringp
 539   :group 'org-link-beautify)
 540
 541 (defcustom org-link-beautify-pdf-preview-size 300
 542   "The PDF preview image size."
 543   :type 'number
 544   :safe #'numberp
 545   :group 'org-link-beautify)
 546
 547 (defcustom org-link-beautify-pdf-preview-default-page-number 1
 548   "The default PDF preview page number."
 549   :type 'number
 550   :safe #'numberp
 551   :group 'org-link-beautify)
 552
 553 (defcustom org-link-beautify-pdf-preview-image-format 'png
 554   "The format of PDF file preview image."
 555   :type '(choice
 556           :tag "The format of PDF file preview image."
 557           (const :tag "PNG" png)
 558           (const :tag "JPEG" jpeg)
 559           (const :tag "SVG" svg))
 560   :safe #'symbolp
 561   :group 'org-link-beautify)
 562
 563 (defun org-link-beautify--generate-preview-for-file-pdf (path)
 564   "Generate THUMBNAIL-FILE with THUMBNAIL-SIZE for .pdf file of PATH."
 565   (when (string-match "\\(.*?\\)\\(?:::\\(.*\\)\\)?\\'" path)
 566     (let* ((file-path (match-string 1 path))
 567            (search-option (match-string 2 path))
 568            (pdf-page-number (if search-option
 569                                 (string-to-number
 570                                  (cond
 571                                   ((string-prefix-p "P" search-option) ; "P42"
 572                                    (substring search-option 1 nil))
 573                                   ((string-match "\\([[:digit:]]+\\)\\+\\+\\(.*\\)" search-option) ; "40++0.00"
 574                                    (match-string 1 search-option))
 575                                   (t search-option)))
 576                               (if-let ((search-option (match-string 2 path)))
 577                                   (string-to-number
 578                                    (cond
 579                                     ((string-prefix-p "P" search-option) ; "P42"
 580                                      (substring search-option 1 nil))
 581                                     ((string-match "\\([[:digit:]]+\\)\\+\\+\\(.*\\)" search-option) ; "40++0.00"
 582                                      (match-string 1 search-option))
 583                                     (t search-option)))
 584                                 org-link-beautify-pdf-preview-default-page-number)))
 585            (pdf-file (expand-file-name (org-link-unescape file-path)))
 586            (thumbnails-dir (org-link-beautify--get-thumbnails-dir-path pdf-file))
 587            (thumbnail-file (expand-file-name
 588                             (if (= pdf-page-number 1) ; if have page number ::N specified.
 589                                 (format "%s%s.%s"
 590                                         thumbnails-dir (file-name-base pdf-file)
 591                                         (symbol-name org-link-beautify-pdf-preview-image-format))
 592                               (format "%s%s-P%s.%s"
 593                                       thumbnails-dir (file-name-base pdf-file) pdf-page-number
 594                                       (symbol-name org-link-beautify-pdf-preview-image-format)))))
 595            (thumbnail-size 600)
 596            (proc-name (format "org-link-beautify pdf preview - %s" pdf-file))
 597            (proc-buffer (format " *org-link-beautify pdf preview - %s*" pdf-file))
 598            (proc (get-process proc-name)))
 599       (org-link-beautify--ensure-thumbnails-dir thumbnails-dir)
 600       (unless (file-exists-p thumbnail-file)
 601         (pcase (file-name-nondirectory org-link-beautify-pdf-preview-command)
 602           ("pdftocairo"
 603            (start-process
 604             proc-name proc-buffer
 605             "pdftocairo"
 606             (pcase org-link-beautify-pdf-preview-image-format
 607               ('png "-png")
 608               ('jpeg "-jpeg")
 609               ('svg "-svg"))
 610             "-singlefile"
 611             "-f" (number-to-string pdf-page-number)
 612             pdf-file (file-name-sans-extension thumbnail-file)))
 613           ("pdf2svg"
 614            (unless (eq org-link-beautify-pdf-preview-image-format 'svg)
 615              (warn "The pdf2svg only supports convert PDF to SVG format.
 616 Please adjust `org-link-beautify-pdf-preview-command' to `pdftocairo' or
 617 Set `org-link-beautify-pdf-preview-image-format' to `svg'."))
 618            (start-process
 619             proc-name proc-buffer
 620             "pdf2svg" pdf-file thumbnail-file (number-to-string pdf-page-number)))))
 621       (when (and org-link-beautify-enable-debug-p (not (file-exists-p thumbnail-file)))
 622         (org-link-beautify--notify-generate-thumbnail-failed path thumbnail-file))
 623       ;; return the thumbnail file as result.
 624       thumbnail-file)))
 625
 626 (defun org-link-beautify-preview-file-pdf (ov path link)
 627   "Preview pdf file of PATH over OV overlay position for LINK element."
 628   (if-let* (( (display-graphic-p))
 629             (org-link-beautify-pdf-preview-command)
 630             (thumbnail-file (org-link-beautify--generate-preview-for-file-pdf path))
 631             ((file-exists-p thumbnail-file))
 632             ;; NOTE: limite thumbnail image inline display width to hardcoded 300.
 633             (width (or 300 (org-display-inline-image--width link) org-link-beautify-pdf-preview-size))
 634             (image (org--create-inline-image thumbnail-file width)))
 635       (prog1 ov
 636         (overlay-put ov 'display image)
 637             (overlay-put ov 'face    'default)
 638             (overlay-put ov 'keymap  org-link-beautify-keymap))
 639     (org-link-beautify-iconify ov path link)))
 640
 641 ;;; file: .epub
 642
 643 (defcustom org-link-beautify-epub-preview-command
 644   (let ((script (expand-file-name "scripts/thumbnailer-ebook.py" (file-name-directory (or load-file-name (buffer-file-name))))))
 645     (cl-case system-type
 646       (gnu/linux (if (executable-find "gnome-epub-thumbnailer")
 647                      "gnome-epub-thumbnailer"
 648                    script))
 649       (darwin (if (executable-find "epub-thumbnailer")
 650                   "epub-thumbnailer"
 651                 script))
 652       (t script)))
 653   "Whether enable EPUB files cover preview?
 654 If command \"gnome-epub-thumbnailer\" is available, enable EPUB
 655 preview by default. You can set this option to nil to disable
 656 EPUB preview."
 657   :type 'string
 658   :safe #'stringp
 659   :group 'org-link-beautify)
 660
 661 (defcustom org-link-beautify-ebook-preview-size 600
 662   "The EPUB cover preview image size."
 663   :type 'number
 664   :safe #'numberp
 665   :group 'org-link-beautify)
 666
 667 (defun org-link-beautify--generate-preview-for-file-epub (path)
 668   "Generate THUMBNAIL-FILE with THUMBNAIL-SIZE for .epub file of PATH."
 669   (when (string-match "\\(.*?\\)\\(?:::\\(.*\\)\\)?\\'" path)
 670     (let* ((file-path (match-string 1 path))
 671            (search-option (match-string 2 path))
 672            ;; TODO: currently epub file page number thumbnail is not supported by `org-link-beautify-epub-preview-command'.
 673            (epub-page-number (if search-option (string-to-number search-option) 1))
 674            (epub-file (expand-file-name (org-link-unescape file-path)))
 675            (thumbnails-dir (org-link-beautify--get-thumbnails-dir-path epub-file))
 676            (thumbnail-file (expand-file-name
 677                             (if (or (null epub-page-number) (= epub-page-number 1)) ; if have page number ::N specified.
 678                                 (format "%s%s.png" thumbnails-dir (file-name-base epub-file))
 679                               (format "%s%s-P%s.png" thumbnails-dir (file-name-base epub-file) epub-page-number))))
 680            (thumbnail-size (or org-link-beautify-ebook-preview-size 600))
 681            (proc-name (format "org-link-beautify epub preview - %s" epub-file))
 682            (proc-buffer (format " *org-link-beautify epub preview - %s*" epub-file))
 683            (proc (get-process proc-name)))
 684       (org-link-beautify--ensure-thumbnails-dir thumbnails-dir)
 685       (unless (file-exists-p thumbnail-file)
 686         (pcase (file-name-nondirectory org-link-beautify-epub-preview-command)
 687           ("epub-thumbnailer"           ; for macOS "epub-thumbnailer" command
 688            (make-process
 689             :name proc-name
 690             :command (list org-link-beautify-epub-preview-command
 691                            epub-file
 692                            thumbnail-file
 693                            (number-to-string thumbnail-size))
 694             :buffer proc-buffer
 695             :stderr nil ; If STDERR is nil, standard error is mixed with standard output and sent to BUFFER or FILTER.
 696             :sentinel (lambda (proc event)
 697                         (if org-link-beautify-enable-debug-p
 698                             (message (format "> proc: %s\n> event: %s" proc event))
 699                           ;; (when (string= event "finished\n")
 700                           ;;   (kill-buffer (process-buffer proc))
 701                           ;;   (kill-process proc))
 702                           ))))
 703           ("gnome-epub-thumbnailer"                 ; for Linux "gnome-epub-thumbnailer"
 704            (start-process
 705             proc-name proc-buffer
 706             org-link-beautify-epub-preview-command
 707             epub-file thumbnail-file
 708             (when org-link-beautify-ebook-preview-size "--size")
 709             (when org-link-beautify-ebook-preview-size (number-to-string thumbnail-size))))
 710           (_ (user-error "This system platform currently not supported by org-link-beautify.\n Please contribute code to support"))))
 711       (when (and org-link-beautify-enable-debug-p (not (file-exists-p thumbnail-file)))
 712         (org-link-beautify--notify-generate-thumbnail-failed epub-file thumbnail-file))
 713       ;; return the thumbnail file as result.
 714       thumbnail-file)))
 715
 716 (defun org-link-beautify-preview-file-epub (ov path link)
 717   "Preview epub file of PATH over OV overlay position for LINK element."
 718   (if-let* (( (display-graphic-p))
 719             (org-link-beautify-epub-preview-command)
 720             (thumbnail-file (org-link-beautify--generate-preview-for-file-epub path))
 721             ((file-exists-p thumbnail-file))
 722             ;; NOTE: limite thumbnail image inline display width to hardcoded 300.
 723             (width (or 300 (org-display-inline-image--width link) org-link-beautify-ebook-preview-size))
 724             (image (org--create-inline-image thumbnail-file width)))
 725       (prog1 ov
 726         (overlay-put ov 'display image)
 727             (overlay-put ov 'face    'default)
 728             (overlay-put ov 'keymap  org-link-beautify-keymap))
 729     (org-link-beautify-iconify ov path link)))
 730
 731 ;;; file: .mobi, .azw3
 732
 733 (defcustom org-link-beautify-kindle-preview-command
 734   (cl-case system-type
 735     (gnu/linux (executable-find "mobitool"))
 736     (darwin (executable-find "mobitool")))
 737   "Whether enable Kindle ebook files cover preview?
 738
 739 Enable Kindle ebook preview by default.
 740
 741 You can set this option to nil to disable EPUB preview.
 742
 743 You can install software `libmobi' to get command `mobitool'."
 744   :type 'string
 745   :safe #'stringp
 746   :group 'org-link-beautify)
 747
 748 (defcustom org-link-beautify-kindle-preview-size 300
 749   "The Kindle cover preview image size."
 750   :type 'number
 751   :safe #'numberp
 752   :group 'org-link-beautify)
 753
 754 (defun org-link-beautify--generate-preview-for-file-kindle (path)
 755   "Generate THUMBNAIL-FILE with THUMBNAIL-SIZE for .mobi & .azw3 file of PATH."
 756   (when (string-match "\\(.*?\\)\\(?:::\\(.*\\)\\)?\\'" path)
 757     (let* ((file-path (match-string 1 path))
 758            (kindle-page-number (or (match-string 2 path) 1))
 759            (kindle-file (expand-file-name (org-link-unescape file-path)))
 760            (thumbnails-dir (org-link-beautify--get-thumbnails-dir-path kindle-file))
 761            (thumbnail-file (expand-file-name
 762                             (if (or (null kindle-page-number) (= kindle-page-number 1)) ; if have page number ::N specified.
 763                                 (format "%s%s.jpg" thumbnails-dir (file-name-base kindle-file))
 764                               (format "%s%s-P%s.jpg" thumbnails-dir (file-name-base kindle-file) kindle-page-number))))
 765            (thumbnail-size (or org-link-beautify-ebook-preview-size 600))
 766            (proc-name (format "org-link-beautify kindle preview - %s" kindle-file))
 767            (proc-buffer (format " *org-link-beautify kindle preview - %s*" kindle-file))
 768            (proc (get-process proc-name)))
 769       (org-link-beautify--ensure-thumbnails-dir thumbnails-dir)
 770       (unless (file-exists-p thumbnail-file)
 771         (pcase (file-name-nondirectory org-link-beautify-kindle-preview-command)
 772           ("mobitool"
 773            ;; mobitool dumped cover image thumbnail filename can't be specified in command-line argument.
 774            (let ((mobitool-cover-file (concat thumbnails-dir (file-name-base kindle-file) "_cover.jpg")))
 775              (unless (file-exists-p mobitool-cover-file)
 776                (message "[org-link-beautify] preview kindle ebook file %s" kindle-file)
 777                (start-process
 778                 proc-name proc-buffer
 779                 "mobitool" "-c" "-o" thumbnails-dir kindle-file))
 780              ;; then rename [file.extension.jpg] to [file.jpg]
 781              (when (file-exists-p mobitool-cover-file)
 782                (rename-file mobitool-cover-file thumbnail-file))))
 783           (_ (user-error "[org-link-beautify] Error: Can't find command tool to dump kindle ebook file cover"))))
 784       (when (and org-link-beautify-enable-debug-p (not (file-exists-p thumbnail-file)))
 785         (org-link-beautify--notify-generate-thumbnail-failed kindle-file thumbnail-file))
 786       ;; return the thumbnail file as result.
 787       thumbnail-file)))
 788
 789 (defun org-link-beautify-preview-file-kindle (ov path link)
 790   "Preview kindle .mobi or .azw3 file of PATH over OV overlay position for LINK element."
 791   (if-let* (( (display-graphic-p))
 792             (org-link-beautify-kindle-preview-command)
 793             (thumbnail-file (org-link-beautify--generate-preview-for-file-kindle path))
 794             ((file-exists-p thumbnail-file))
 795             ;; NOTE: limite epub file thumbnail image inline display width to hardcoded 300.
 796             (width (or 300 (org-display-inline-image--width link)))
 797             (image (org--create-inline-image thumbnail-file width)))
 798       (prog1 ov
 799         (overlay-put ov 'display image)
 800             (overlay-put ov 'face    'default)
 801             (overlay-put ov 'keymap  org-link-beautify-keymap))
 802     (org-link-beautify-iconify ov path link)))
 803
 804 ;;; FictionBook2 (.fb2, .fb2.zip) file cover preview
 805
 806 (defcustom org-link-beautify-fictionbook2-preview (featurep 'fb2-reader)
 807   "Whether enable FictionBook2 ebook files covert preview?"
 808   :type 'boolean
 809   :safe #'booleanp
 810   :group 'org-link-beautify)
 811
 812 (defcustom org-link-beautify-fictionbook2-preview-size 300
 813   "The FictionBook2 cover preview image size."
 814   :type 'number
 815   :safe #'numberp
 816   :group 'org-link-beautify)
 817
 818 (defun org-link-beautify-fictionbook2--extract-cover (file-path)
 819   "Extract cover image data for FictionBook2 at FILE-PATH."
 820   (if-let* (;; reference `fb2-reader-mode'
 821             (book (or (fb2-reader-parse-file-as-xml file-path)
 822                       (fb2-reader-parse-file-as-html file-path)))
 823             ;; reference `fb2-reader-splash-screen'
 824             (cover-item (fb2-reader--get-cover book))
 825             ;; reference `fb2-reader-splash-cover': (fb2-reader-splash-cover book cover-item)
 826             (attrs (cl-second (cl-third cover-item)))
 827             (img-data (fb2-reader--extract-image-data book attrs))
 828             (type (cl-first img-data))
 829             (data (cl-second img-data))
 830             ;; reference `fb2-reader--insert-image': (fb2-reader--insert-image data-str type-str nil t)
 831             (type-symbol (alist-get type '(("image/jpeg" . jpeg) ("image/png" . png)) nil nil 'equal))
 832             (data-decoded (base64-decode-string data))
 833             (img-raw (fb2-reader--create-image data-decoded type-symbol))
 834             (image (create-image data-decoded type-symbol 't)))
 835       image
 836     'no-cover))
 837
 838 (defun org-link-beautify-fictionbook2--save-cover (image thumbnail-file)
 839   "Save FictionBook2 cover IMAGE to THUMBNAIL-FILE."
 840   ;; `image-save': This writes the original image data to a file.
 841   (with-temp-buffer
 842     (insert (plist-get (cdr image) :data))
 843     (write-region (point-min) (point-max) thumbnail-file)))
 844
 845 (defun org-link-beautify--generate-preview-for-file-fictionbook2 (path)
 846   "Generate THUMBNAIL-FILE with THUMBNAIL-SIZE for .fb2 & .fb2.zip file of PATH."
 847   (when (string-match "\\(.*?\\)\\(?:::\\(.*\\)\\)?\\'" path)
 848     (let* ((file-path (match-string 1 path))
 849            (search-option (match-string 2 path))
 850            (fictionbook2-file (expand-file-name (org-link-unescape file-path)))
 851            (thumbnails-dir (org-link-beautify--get-thumbnails-dir-path fictionbook2-file))
 852            (thumbnail-file (cond
 853                             ((string-match-p "\\.fb2.zip$" path)
 854                              (expand-file-name
 855                               (format "%s%s.png" thumbnails-dir (string-replace ".fb2" "" (file-name-base fictionbook2-file)))))
 856                             ((string-match-p "\\.fb2$" path)
 857                              (expand-file-name (format "%s%s.png" thumbnails-dir (file-name-base fictionbook2-file))))))
 858            (thumbnail-size (or org-link-beautify-fictionbook2-preview-size 600))
 859            (proc-name (format "org-link-beautify fictionbook preview - %s" fictionbook2-file))
 860            (proc-buffer (format " *org-link-beautify fictionbook preview - %s*" fictionbook2-file))
 861            (proc (get-process proc-name)))
 862       (org-link-beautify--ensure-thumbnails-dir thumbnails-dir)
 863       (unless (file-exists-p thumbnail-file)
 864         (let ((cover-image (org-link-beautify-fictionbook2--extract-cover fictionbook2-file)))
 865           (if (eq cover-image 'no-cover)
 866               (message "[org-link-beautify] FictionBook2 preview failed to extract cover image.")
 867             (org-link-beautify-fictionbook2--save-cover cover-image thumbnail-file))))
 868       (when (and org-link-beautify-enable-debug-p (not (file-exists-p thumbnail-file)))
 869         (org-link-beautify--notify-generate-thumbnail-failed fictionbook2-file thumbnail-file))
 870       ;; return the thumbnail file as result.
 871       thumbnail-file)))
 872
 873 (defun org-link-beautify-preview-file-fictionbook2 (ov path link)
 874   "Preview FictionBook2 .fb2, .fb2.zip file of PATH over OV overlay position for LINK element."
 875   (if-let* ((org-link-beautify-fictionbook2-preview)
 876             ( (display-graphic-p))
 877             (thumbnail-file (org-link-beautify--generate-preview-for-file-fictionbook2 path))
 878             ((file-exists-p thumbnail-file))
 879             ;; NOTE: limite thumbnail image inline display width to hardcoded 300.
 880             (width (or 300 (org-display-inline-image--width link)))
 881             (image (org--create-inline-image thumbnail-file width)))
 882       (prog1 ov
 883         (overlay-put ov 'display image)
 884             (overlay-put ov 'face    'default)
 885             (overlay-put ov 'keymap  org-link-beautify-keymap))
 886     (org-link-beautify-iconify ov path link)))
 887
 888 ;;; Source Code File
 889
 890 (defcustom org-link-beautify-source-code-preview-command
 891   (cond
 892    ((executable-find "silicon") "silicon")
 893    ((executable-find "germanium") "germanium"))
 894   "The command used to preview source code file."
 895   :type 'string
 896   :safe #'stringp
 897   :group 'org-link-beautify)
 898
 899 (defcustom org-link-beautify-source-code-preview-list
 900   '(; "org" "txt" "markdown" "md"
 901     "lisp" "scm" "clj" "cljs"
 902     "py" "rb" "pl"
 903     "c" "cpp" "h" "hpp" "cs" "java"
 904     "js" "css"
 905     "R" "jl")
 906   "A list of link types supports source code file preview below the link."
 907   :type 'list
 908   :safe #'listp
 909   :group 'org-link-beautify)
 910
 911 (defcustom org-link-beautify-source-code-preview-max-lines 30
 912   "The maximum lines number of file for previewing."
 913   :type 'number
 914   :safe #'numberp
 915   :group 'org-link-beautify)
 916
 917 (defun org-link-beautify--preview-source-code-file (file)
 918   "Return first 10 lines of FILE."
 919   (with-temp-buffer
 920     (condition-case nil
 921         (progn
 922           ;; I originally use `insert-file-contents-literally', so Emacs doesn't
 923           ;; decode the non-ASCII characters it reads from the file, i.e. it
 924           ;; doesn't interpret the byte sequences as Chinese characters. Use
 925           ;; `insert-file-contents' instead. In addition, this function decodes
 926           ;; the inserted text from known formats by calling format-decode,
 927           ;; which see.
 928           (insert-file-contents file)
 929           (org-link-beautify--display-content-block
 930            ;; This `cl-loop' extract a LIST of string lines from the file content.
 931            (cl-loop repeat 10
 932                     unless (eobp)
 933                     collect (prog1 (buffer-substring-no-properties
 934                                     (line-beginning-position)
 935                                     (line-end-position))
 936                               (forward-line 1)))))
 937       (file-error
 938        (message "Unable to read file %S" file)
 939            nil))))
 940
 941 (defun org-link-beautify--generate-preview-for-file-source-code (path)
 942   "Generate THUMBNAIL-FILE with THUMBNAIL-SIZE for source code file of PATH."
 943   (when (string-match "\\(.*?\\)\\(?:::\\(.*\\)\\)?\\'" path)
 944     (let* ((file-path (match-string 1 path))
 945            (search-option (match-string 2 path))
 946            (source-code-file (expand-file-name (org-link-unescape file-path)))
 947            (thumbnails-dir (org-link-beautify--get-thumbnails-dir-path source-code-file))
 948            (thumbnail-file (expand-file-name (format "%s%s.png" thumbnails-dir (file-name-base source-code-file))))
 949            (thumbnail-size 600)
 950            (proc-name (format "org-link-beautify code preview - %s" source-code-file))
 951            (proc-buffer (format " *org-link-beautify code preview - %s*" source-code-file))
 952            (proc (get-process proc-name)))
 953       (org-link-beautify--ensure-thumbnails-dir thumbnails-dir)
 954       (unless (and (file-exists-p thumbnail-file)
 955                    ;; limit to maximum 30 lines of file.
 956                    (> (string-to-number (shell-command-to-string (format "cat %s | wc -l" source-code-file)))
 957                       org-link-beautify-source-code-preview-max-lines))
 958         (unless proc
 959           (pcase (file-name-nondirectory org-link-beautify-source-code-preview-command)
 960             ("silicon"
 961              (start-process
 962               proc-name proc-buffer
 963               "silicon" source-code-file "-o" thumbnail-file
 964               "--theme" "Dracula"
 965               "--no-window-controls" "--shadow-blur-radius" "30" "--shadow-color" "#555"
 966               "--window-title" (file-name-nondirectory file-path)))
 967             ("germanium"
 968              (start-process
 969               proc-name proc-buffer
 970               "germanium" source-code-file "-o" thumbnail-file
 971               "--no-line-number" "--no-window-access-bar")))))
 972       (when (and org-link-beautify-enable-debug-p (not (file-exists-p thumbnail-file)))
 973         (org-link-beautify--notify-generate-thumbnail-failed fictionbook2-file thumbnail-file))
 974       ;; return the thumbnail file as result.
 975       thumbnail-file)))
 976
 977 (defun org-link-beautify-preview-file-source-code (ov path link)
 978   "Preview source code file of PATH over OV overlay position for LINK element."
 979   (if-let* (( (display-graphic-p))
 980             (org-link-beautify-source-code-preview-command)
 981             (thumbnail-file (org-link-beautify--generate-preview-for-file-source-code path))
 982             ((file-exists-p thumbnail-file))
 983             (image (create-image thumbnail-file nil nil :width 800)))
 984       (prog1 ov
 985         (overlay-put ov 'display image)
 986             (overlay-put ov 'face    'default)
 987             (overlay-put ov 'keymap  org-link-beautify-keymap))
 988     (if-let* ((source-code (org-link-beautify--preview-source-code-file path)))
 989         (prog1 ov
 990           (overlay-put ov 'after-string source-code)
 991               (overlay-put ov 'face    'org-block))
 992       (org-link-beautify-iconify ov path link))))
 993
 994 ;;; file: [comic]
 995
 996 (defcustom org-link-beautify-comic-preview-command
 997   (cl-case system-type
 998     (darwin (or (executable-find "qlmanage") org-link-beautify-thumbnailer-script))
 999     (gnu/linux org-link-beautify-thumbnailer-script))
1000   "Whether enable CDisplay Archived Comic Book Formats cover preview.
1001 File extensions like (.cbr, .cbz, .cb7, .cba, .cbt etc)."
1002   :type 'string
1003   :safe #'stringp
1004   :group 'org-link-beautify)
1005
1006 (defcustom org-link-beautify-comic-preview-list
1007   '("cbr" "cbz" "cb7" "cba" "cbt")
1008   "A list of comic file types be supported with thumbnails."
1009   :type 'list
1010   :safe #'listp
1011   :group 'org-link-beautify)
1012
1013 (defcustom org-link-beautify-comic-preview-size 500
1014   "The CDisplay Archived Comic Book Formats cover preview image size."
1015   :type 'number
1016   :safe #'numberp
1017   :group 'org-link-beautify)
1018
1019 (defun org-link-beautify--generate-preview-for-file-comic (path)
1020   "Generate THUMBNAIL-FILE with THUMBNAIL-SIZE for CDisplay Archived Comic Book: .cbz, .cbr etc file of PATH."
1021   (when (string-match "\\(.*?\\)\\(?:::\\(.*\\)\\)?\\'" path)
1022     (let* ((file-path (match-string 1 path))
1023            (comic-file (expand-file-name (org-link-unescape file-path)))
1024            (thumbnails-dir (org-link-beautify--get-thumbnails-dir-path comic-file))
1025            (thumbnail-file (expand-file-name (format "%s%s.png" thumbnails-dir (file-name-base comic-file))))
1026            (thumbnail-size (or org-link-beautify-comic-preview-size 1080))
1027            (proc-name (format "org-link-beautify comic preview - %s" (file-name-base file-path)))
1028            (proc-buffer (format " *org-link-beautify comic preview - %s*" (file-name-base file-path)))
1029            (proc (get-process proc-name)))
1030       (org-link-beautify--ensure-thumbnails-dir thumbnails-dir)
1031       (unless (file-exists-p thumbnail-file)
1032         (unless proc
1033           (cl-case system-type
1034             (gnu/linux
1035              (pcase (file-name-nondirectory org-link-beautify-comic-preview-command)
1036                ("cbconvert"              ; https://github.com/gen2brain/cbconvert
1037                 (start-process
1038                  proc-name
1039                  proc-buffer
1040                  org-link-beautify-comic-preview-command
1041                  "cover" comic-file "--output" thumbnails-dir
1042                  (if org-link-beautify-comic-preview-size
1043                      "--width")
1044                  (if org-link-beautify-comic-preview-size
1045                      (number-to-string thumbnail-size))))
1046                ("thumbnailer.py" (org-link-beautify-thumbnailer file-path))))
1047             (darwin
1048              ;; for macOS "qlmanage" command
1049              ;; $ qlmanage -t "ラセン恐怖閣-マリコとニジロー1-DL版.cbz" - 2.0 -s 1080 -o ".thumbnails"
1050              (pcase (file-name-nondirectory org-link-beautify-comic-preview-command)
1051                ("qlmanage"
1052                 (let ((qlmanage-thumbnail-file (concat thumbnails-dir (file-name-nondirectory comic-file) ".png")))
1053                   (make-process
1054                    :name proc-name
1055                    :command (list org-link-beautify-comic-preview-command
1056                                   "-t"
1057                                   comic-file
1058                                   "-o" thumbnails-dir
1059                                   "-s" (number-to-string thumbnail-size))
1060                    :buffer proc-buffer
1061                    :stderr nil ; If STDERR is nil, standard error is mixed with standard output and sent to BUFFER or FILTER.
1062                    :sentinel (lambda (proc event)
1063                                (if org-link-beautify-enable-debug-p
1064                                    (message (format "> proc: %s\n> event: %s" proc event))
1065                                  ;; (when (string= event "finished\n")
1066                                  ;;   (kill-buffer (process-buffer proc))
1067                                  ;;   (kill-process proc))
1068                                  )))
1069                   ;; then rename [file.extension.png] to [file.png]
1070                   (when (file-exists-p qlmanage-thumbnail-file)
1071                     (rename-file qlmanage-thumbnail-file thumbnail-file))))
1072                ("thumbnailer.py" (org-link-beautify-thumbnailer file-path))))
1073             (t (user-error "This system platform currently not supported by org-link-beautify.\n Please contribute code to support")))))
1074       (when (and org-link-beautify-enable-debug-p (not (file-exists-p thumbnail-file)))
1075         (org-link-beautify--notify-generate-thumbnail-failed comic-file thumbnail-file))
1076       ;; return the thumbnail file as result.
1077       thumbnail-file)))
1078
1079 (defun org-link-beautify-preview-file-comic (ov path link)
1080   "Preview comic .cbz or .cbr file of PATH over OV overlay position for LINK element."
1081   (if-let* (( (display-graphic-p))
1082             (org-link-beautify-comic-preview-command)
1083             (thumbnail-file (org-link-beautify--generate-preview-for-file-comic path))
1084             ((file-exists-p thumbnail-file))
1085             (image (create-image thumbnail-file nil nil :width (or org-link-beautify-comic-preview-size 300))))
1086       (prog1 ov
1087         (overlay-put ov 'display image)
1088             (overlay-put ov 'face    'default)
1089             (overlay-put ov 'keymap  org-link-beautify-keymap))
1090     (org-link-beautify-iconify ov path link)))
1091
1092 ;;; file: [video]
1093
1094 (defvar org-link-beautify-video-thumbnailer-script
1095   (expand-file-name "scripts/thumbnailer-video.py" (file-name-directory (or load-file-name (buffer-file-name))))
1096   "The path of video thumbnailer script.")
1097
1098 (defcustom org-link-beautify-video-preview-command
1099   (cl-case system-type
1100     ;; for macOS, use `qlmanage' on priority
1101     (darwin (or (executable-find "qlmanage") (executable-find "ffmpeg")))
1102     ;; for Linux, use `ffmpegthumbnailer' on priority
1103     (gnu/linux (or (executable-find "ffmpegthumbnailer") (executable-find "ffmpeg")))
1104     ;; for general, use `ffmpeg'
1105     ;; $ ffmpeg -i video.mp4 -ss 00:01:00.000 -vframes 1 -vcodec png -an -f rawvideo -s 119x64 out.png
1106     (t (or (executable-find "ffmpeg")
1107            org-link-beautify-video-thumbnailer-script
1108            org-link-beautify-thumbnailer-script)))
1109   "The available command to preview video."
1110   :type 'string
1111   :safe #'stringp
1112   :group 'org-link-beautify)
1113
1114 (defcustom org-link-beautify-video-preview-list
1115   '("mp4" "webm" "mkv" "mov" "mpeg" "ogg" "ogv" "rmvb" "rm" "avi" "m4v" "flv")
1116   "A list of video file types be supported with thumbnails."
1117   :type 'list
1118   :safe #'listp
1119   :group 'org-link-beautify)
1120
1121 (defcustom org-link-beautify-video-preview-size 600
1122   "The video thumbnail image size."
1123   :type 'number
1124   :safe #'numberp
1125   :group 'org-link-beautify)
1126
1127 (defun org-link-beautify--generate-preview-for-file-video (path)
1128   "Generate THUMBNAIL-FILE with THUMBNAIL-SIZE for video .mp4 etc file of PATH."
1129   (when (string-match "\\(.*?\\)\\(?:::\\(.*\\)\\)?\\'" path)
1130     (let* ((file-path (match-string 1 path))
1131            (search-option (match-string 2 path))
1132            (video-file (expand-file-name (org-link-unescape file-path)))
1133            (video-filename (file-name-nondirectory video-file))
1134            (thumbnails-dir (org-link-beautify--get-thumbnails-dir-path video-file))
1135            (thumbnail-file (expand-file-name (format "%s%s.png" thumbnails-dir (file-name-base video-file))))
1136            (thumbnail-size (or org-link-beautify-video-preview-size 600))
1137            (proc-name (format "org-link-beautify video preview - %s" video-filename))
1138            (proc-buffer (format " *org-link-beautify video preview - %s*" video-filename))
1139            (proc (get-process proc-name)))
1140       (org-link-beautify--ensure-thumbnails-dir thumbnails-dir)
1141       (unless (file-exists-p thumbnail-file)
1142         ;; detect process already running?
1143         (unless proc
1144           (pcase (file-name-nondirectory org-link-beautify-video-preview-command)
1145             ("ffmpeg"
1146              ;; $ ffmpeg -i video.mp4 -ss 00:00:00.001 -vframes 1 -vcodec png -an -f rawvideo -s 119x64 out.png
1147              (let ((thumbnail-width thumbnail-size)
1148                    (thumbnail-height 300))
1149                (start-process
1150                 proc-name proc-buffer
1151                 "ffmpeg"
1152                 "-i" video-file
1153                 "-ss" "00:00:00.001"
1154                 "-vframes" "1"
1155                 "-vcodec" "png"
1156                 "-an"
1157                 "-f" "rawvideo"
1158                 "-s" (format "%sx%s" thumbnail-width thumbnail-height)
1159                 thumbnail-file)))
1160             ("qlmanage"
1161              (let ((qlmanage-thumbnail-file (concat thumbnails-dir (file-name-nondirectory video-file) ".png")))
1162                (unless (file-exists-p qlmanage-thumbnail-file)
1163                  (let ((proc (start-process
1164                               proc-name proc-buffer
1165                               "qlmanage" "-x" "-t" "-s" (number-to-string thumbnail-size) video-file "-o" thumbnails-dir))
1166                        (proc-filter (lambda (proc output)
1167                                       ;; * No thumbnail created for [FILE PATH]
1168                                       (when (string-match "\\* No thumbnail created for.*" output)
1169                                         (message
1170                                          "[org-link-beautify] video preview FAILED on macOS QuickLook generating thumbnail for %s"
1171                                          video-filename)))))
1172                    (set-process-filter proc proc-filter)))
1173                ;; then rename [file.extension.png] to [file.png]
1174                (when (file-exists-p qlmanage-thumbnail-file)
1175                  (rename-file qlmanage-thumbnail-file thumbnail-file))))
1176             ("ffmpegthumbnailer"
1177              (start-process
1178               proc-name proc-buffer
1179               "ffmpegthumbnailer" "-f" "-i" video-file "-s" (number-to-string thumbnail-size) "-o" thumbnail-file))
1180             ("thumbnailer-video.py"
1181              (make-process
1182               :name proc-name
1183               :command (list org-link-beautify-video-thumbnailer-script
1184                              input-file
1185                              thumbnail-file
1186                              (number-to-string thumbnail-size))
1187               :buffer proc-buffer
1188               :stderr nil ; If STDERR is nil, standard error is mixed with standard output and sent to BUFFER or FILTER.
1189               :sentinel (lambda (proc event)
1190                           (when org-link-beautify-enable-debug-p
1191                             (message (format "> proc: %s\n> event: %s" proc event)))
1192                           ;; (when (string= event "finished\n")
1193                           ;;   (kill-buffer (process-buffer proc))
1194                           ;;   (kill-process proc))
1195                           ))))))
1196       (when (and org-link-beautify-enable-debug-p (not (file-exists-p thumbnail-file)))
1197         (org-link-beautify--notify-generate-thumbnail-failed video-file thumbnail-file))
1198       ;; return the thumbnail file as result.
1199       thumbnail-file)))
1200
1201 (defun org-link-beautify-preview-file-video (ov path link)
1202   "Preview video file of PATH over OV overlay position for LINK element."
1203   (if-let* (( (display-graphic-p))
1204             (org-link-beautify-video-preview-command)
1205             (thumbnail-file (org-link-beautify--generate-preview-for-file-video path))
1206             ((file-exists-p thumbnail-file))
1207             (image (create-image thumbnail-file nil nil :width 400)))
1208       (prog1 ov
1209         (overlay-put ov 'display image)
1210             (overlay-put ov 'face    'default)
1211             (overlay-put ov 'keymap  org-link-beautify-keymap))
1212     (org-link-beautify-iconify ov path link)))
1213
1214 ;;; file: [audio]
1215
1216 (defcustom org-link-beautify-audio-preview-command
1217   (cl-case system-type
1218     (darwin (or (executable-find "ffmpeg") (executable-find "qlmanage")))
1219     (gnu/linux (or (executable-find "ffmpeg") (executable-find "audiowaveform"))))
1220   "Find available audio preview command."
1221   :type 'string
1222   :safe #'stringp
1223   :group 'org-link-beautify)
1224
1225 (defcustom org-link-beautify-audio-preview-list '("mp3" "wav" "flac" "ogg" "m4a" "opus" "dat")
1226   "A list of audio file types be supported generating audio wave form image."
1227   :type 'list
1228   :safe #'listp
1229   :group 'org-link-beautify)
1230
1231 (defcustom org-link-beautify-audio-preview-size 600
1232   "The audio wave form image size."
1233   :type 'number
1234   :safe #'numberp
1235   :group 'org-link-beautify)
1236
1237 (defun org-link-beautify--generate-preview-for-file-audio (path)
1238   "Generate THUMBNAIL-FILE with THUMBNAIL-SIZE for audio .mp3 etc file of PATH."
1239   (when (string-match "\\(.*?\\)\\(?:::\\(.*\\)\\)?\\'" path)
1240     (let* ((file-path (match-string 1 path))
1241            (search-option (match-string 2 path))
1242            (audio-file (expand-file-name (org-link-unescape file-path)))
1243            (audio-filename (file-name-nondirectory audio-file))
1244            (thumbnails-dir (org-link-beautify--get-thumbnails-dir-path audio-file))
1245            (thumbnail-file (expand-file-name (format "%s%s.png" thumbnails-dir (file-name-base audio-file))))
1246            (thumbnail-size (or org-link-beautify-audio-preview-size 300))
1247            (proc-name (format "org-link-beautify audio preview - %s" audio-filename))
1248            (proc-buffer (format " *org-link-beautify audio preview - %s*" audio-filename))
1249            (proc (get-process proc-name)))
1250       (org-link-beautify--ensure-thumbnails-dir thumbnails-dir)
1251       (unless (file-exists-p thumbnail-file)
1252         (unless proc
1253           (pcase (file-name-nondirectory org-link-beautify-audio-preview-command)
1254             ("ffmpeg"
1255              (start-process
1256               proc-name proc-buffer
1257               "ffmpeg" "-i" audio-file
1258               "-filter_complex" "[0:a]aformat=channel_layouts=mono,compand=gain=-6,showwavespic=s=600x120:colors=#9cf42f[fg];color=s=600x120:color=#44582c,drawgrid=width=iw/10:height=ih/5:color=#9cf42f@0.1[bg];[bg][fg]overlay=format=auto,drawbox=x=(iw-w)/2:y=(ih-h)/2:w=iw:h=1:color=#9cf42f"
1259               "-frames:v" "1"
1260               thumbnail-file))
1261             ("qlmanage"
1262              (let ((qlmanage-thumbnail-file (concat thumbnails-dir (file-name-nondirectory audio-file) ".png")))
1263                (unless (file-exists-p qlmanage-thumbnail-file)
1264                  (start-process
1265                   proc-name proc-buffer
1266                   "qlmanage" "-x" "-t" "-s" (number-to-string thumbnail-size) audio-file "-o" thumbnails-dir))
1267                ;; then rename [file.extension.png] to [file.png]
1268                (when (file-exists-p qlmanage-thumbnail-file)
1269                  (rename-file qlmanage-thumbnail-file thumbnail-file))))
1270             ("audiowaveform"
1271              (start-process
1272               proc-name proc-buffer
1273               "audiowaveform" "-i" audio-file "-o" thumbnail-file)))))
1274       (when (and org-link-beautify-enable-debug-p (not (file-exists-p thumbnail-file)))
1275         (org-link-beautify--notify-generate-thumbnail-failed audio-file thumbnail-file))
1276       ;; return the thumbnail file as result.
1277       thumbnail-file)))
1278
1279 (defun org-link-beautify-preview-file-audio (ov path link)
1280   "Preview audio file of PATH over OV overlay position for LINK element."
1281   (if-let* (( (display-graphic-p))
1282             (org-link-beautify-audio-preview-command)
1283             (thumbnail-file (org-link-beautify--generate-preview-for-file-audio path))
1284             ((file-exists-p thumbnail-file))
1285             (image (create-image thumbnail-file nil nil :width (or org-link-beautify-audio-preview-size 300))))
1286       (prog1 ov
1287         (overlay-put ov 'display image)
1288             (overlay-put ov 'face    'default)
1289             (overlay-put ov 'keymap  org-link-beautify-keymap))
1290     (org-link-beautify-iconify ov path link)))
1291
1292 ;;; file: [subtitle]
1293
1294 (defcustom org-link-beautify-subtitle-preview-command org-link-beautify-thumbnailer-script
1295   "The command to preview subtitle file."
1296   :type 'string
1297   :safe #'stringp
1298   :group 'org-link-beautify)
1299
1300 ;; https://en.wikipedia.org/wiki/Subtitles
1301 (defcustom org-link-beautify-subtitle-preview-list
1302   '("ass" "srt" "sub" "vtt" "ssf")
1303   "A list of subtitle file types support previewing."
1304   :type 'list
1305   :safe #'listp
1306   :group 'org-link-beautify)
1307
1308 (defcustom org-link-beautify-subtitle-preview-size 300
1309   "The subtitle preview image size."
1310   :type 'number
1311   :safe #'numberp
1312   :group 'org-link-beautify)
1313
1314 (defun org-link-beautify--generate-preview-for-file-subtitle (path)
1315   "Generate THUMBNAIL-FILE with THUMBNAIL-SIZE for subtitle file of PATH."
1316   (when (string-match "\\(.*?\\)\\(?:::\\(.*\\)\\)?\\'" path)
1317     (let* ((file-path (match-string 1 path))
1318            (search-option (match-string 2 path))
1319            (subtitle-file (expand-file-name (org-link-unescape file-path))))
1320       (if-let* ((org-link-beautify-subtitle-preview-command)
1321                 (thumbnails-dir (org-link-beautify--get-thumbnails-dir-path subtitle-file))
1322                 (thumbnail-file (expand-file-name (format "%s%s.png" thumbnails-dir (file-name-base subtitle-file))))
1323                 (thumbnail-size (or org-link-beautify-subtitle-preview-size 200))
1324                 (proc-name (format "org-link-beautify subtitle preview - %s" subtitle-file))
1325                 (proc-buffer (format " *org-link-beautify subtile preview - %s*" subtitle-file))
1326                 (proc (get-process proc-name)))
1327           (prog1 thumbnail-file ; return the thumbnail file as result.
1328             (unless (file-exists-p thumbnail-file)
1329               (org-link-beautify--ensure-thumbnails-dir thumbnails-dir)
1330               (pcase (file-name-nondirectory org-link-beautify-subtitle-preview-command)
1331                 ("thumbnailer.py" (org-link-beautify-thumbnailer file-path)))))
1332         (let* ((subtitle-file-context (split-string (shell-command-to-string (format "head -n 20 '%s'" subtitle-file)) "\n"))
1333                (text (concat "\n" (org-link-beautify--display-content-block subtitle-file-context))))
1334           ;; return the subtitle file context as result.
1335           text)))))
1336
1337 (defun org-link-beautify-preview-file-subtitle (ov path link)
1338   "Preview subtitle file of PATH over OV overlay position for LINK element."
1339   (if-let* (( (display-graphic-p))
1340             (org-link-beautify-subtitle-preview-command)
1341             (thumbnail-file (org-link-beautify--generate-preview-for-file-subtitle path))
1342             ((file-exists-p thumbnail-file))
1343             (image (create-image thumbnail-file nil nil :width (or org-link-beautify-subtitle-preview-size 300))))
1344       (prog1 ov
1345         (overlay-put ov 'display image)
1346             (overlay-put ov 'face    'default)
1347             (overlay-put ov 'keymap  org-link-beautify-keymap))
1348     (if-let* ((text (org-link-beautify--generate-preview-for-file-subtitle path)))
1349         (prog1 ov
1350           (overlay-put ov 'after-string text)
1351               (overlay-put ov 'face         'default))
1352       (org-link-beautify-iconify ov path link))))
1353
1354 ;;; file: [archive file]
1355
1356 (defcustom org-link-beautify-archive-preview-list
1357   '("zip" "rar" "7z" "gz" "tar" "tar.gz" "tar.bz2" "xz" "zst")
1358   "A list of archive file types support previewing."
1359   :type 'list
1360   :safe #'listp
1361   :group 'org-link-beautify)
1362
1363 (defcustom org-link-beautify-archive-preview-command-alist
1364   '(("zip" . "unzip -l")
1365     ("rar" . "unrar l")
1366     ("7z" . "7z l -ba") ; -ba - suppress headers; undocumented.
1367     ("gz" . "gzip --list")
1368     ;; ("bz2" . "")
1369     ("tar" . "tar --list")
1370     ("tar.gz" . "tar --gzip --list")
1371     ("tar.bz2" . "tar --bzip2 --list")
1372     ("xz" . "xz --list")
1373     ("zst" . "zstd --list"))
1374   "An alist of archive types supported archive preview inside files list.
1375 Each element has form (ARCHIVE-FILE-EXTENSION COMMAND)."
1376   :type '(alist :value-type (group string))
1377   :group 'org-link-beautify)
1378
1379 (defun org-link-beautify--generate-preview-for-file-archive (path)
1380   "Get the files list preview of archive file at PATH."
1381   (when (string-match "\\(.*?\\)\\(?:::\\(.*\\)\\)?\\'" path)
1382     (let* ((file-path (match-string 1 path))
1383            (search-option (match-string 2 path))
1384            (archive-file (expand-file-name (org-link-unescape file-path)))
1385            (archive-extension (file-name-extension archive-file))
1386            (command (cdr (assoc archive-extension org-link-beautify-archive-preview-command-alist)))
1387            (execute-command (format "%s '%s'" command archive-file))
1388            (archive-files-list (split-string (shell-command-to-string execute-command) "\n"))
1389            (text (concat "\n" (org-link-beautify--display-content-block archive-files-list))))
1390       ;; return the files list in archive file as result.
1391       text)))
1392
1393 (defun org-link-beautify-preview-file-archive (ov path link)
1394   "Preview archive file link of PATH over OV overlay position for LINK element."
1395   (if-let* ((text (org-link-beautify--generate-preview-for-file-archive path)))
1396       (prog1 ov
1397         (overlay-put ov 'after-string text)
1398             (overlay-put ov 'face         'default)
1399             (overlay-put ov 'keymap       org-link-beautify-keymap))
1400     (org-link-beautify-iconify ov path link)))
1401
1402 ;;; pdf: & docview: link type
1403
1404 (defun org-link-beautify-preview-pdf (ov path link)
1405   "Preview pdf: link of PATH over OV overlay position for LINK element."
1406   (if-let* (( (display-graphic-p))
1407             (thumbnail-file (org-link-beautify--generate-preview-for-file-pdf path))
1408             ((file-exists-p thumbnail-file))
1409             ;; reference `org--create-inline-image'
1410             (width (org-display-inline-image--width link))
1411             (image (org--create-inline-image thumbnail-file width)))
1412       (prog1 ov
1413         (overlay-put ov 'display image)
1414             (overlay-put ov 'face    'default)
1415             (overlay-put ov 'keymap  org-link-beautify-keymap))
1416     (org-link-beautify-iconify ov path link)))
1417
1418 ;;; epub: link type
1419
1420 (defalias 'org-link-beautify-preview-epub 'org-link-beautify-preview-file-epub
1421   "Preview epub: link of PATH over OV overlay position for LINK element.")
1422
1423 ;;; nov: link type
1424
1425 (defalias 'org-link-beautify-preview-nov 'org-link-beautify-preview-epub
1426   "Preview nov: link of PATH over OV overlay position for LINK element.")
1427
1428 ;;; video: link type
1429
1430 (defalias 'org-link-beautify-preview-video 'org-link-beautify-preview-file-video
1431   "Preview video: link of PATH over OV overlay position for LINK element.")
1432
1433 ;;; audio: link type
1434
1435 (defalias 'org-link-beautify-preview-audio 'org-link-beautify-preview-file-audio
1436   "Preview audio: link of PATH over OV overlay position for LINK element.")
1437
1438 ;;; org-contact: link type
1439
1440 (defun org-link-beautify--generate-preview-for-org-contacts (name)
1441   "Get the avatar of org-contact in NAME."
1442   (let* ((epom (org-contacts-search-contact name)))
1443     (org-contacts-get-avatar-icon epom)))
1444
1445 ;;; TEST:
1446 ;; (org-link-beautify--generate-preview-for-org-contacts "stardiviner")
1447
1448 (defun org-link-beautify-preview-org-contact (ov path link)
1449   "Preview org-contct: link of PATH over OV overlay position for LINK element."
1450   (if-let* ((name path)
1451             ( (display-graphic-p))
1452             (image (org-link-beautify--generate-preview-for-org-contacts name)))
1453       (prog1 ov
1454         (overlay-put ov 'display image)
1455         (overlay-put ov 'after-string (concat
1456                                        (propertize "{" 'face '(:foreground "purple2"))
1457                                        (propertize name 'face 'org-verbatim)
1458                                        (propertize "}" 'face '(:foreground "purple2")))))
1459     (if-let* ((text (org-element-property :title (org-contacts-search-contact name))))
1460         (overlay-put ov 'after-string (concat
1461                                        (propertize "{" 'face '(:foreground "purple2"))
1462                                        (propertize text 'face 'org-verbatim)
1463                                        (propertize "}" 'face '(:foreground "purple2"))))
1464       (org-link-beautify-iconify ov path link))))
1465
1466 ;;; org-bookmark: link type
1467
1468 (require 'org-bookmarks nil t)
1469
1470 (defun org-link-beautify--generate-preview-for-org-bookmarks (path)
1471   "Get the bookmark content at title PATH."
1472   (when (string-match "\\(.*?\\)\\(?:::\\(.*\\)\\)?\\'" path)
1473     (let* ((bookmark-title (match-string 1 path))
1474            (search-option (match-string 2 path))
1475            ;; reference `org-bookmarks-link-open'
1476            (bookmark-content (org-bookmarks--get-bookmark-content path))
1477            (cwd (file-name-directory org-bookmarks-file))
1478            (text (concat "\n" (org-link-beautify--display-org-content bookmark-content))))
1479       ;; return the files list in archive file as result.
1480       text)))
1481
1482 (defun org-link-beautify-preview-org-bookmark (ov path link)
1483   "Preview org-bookmark: link of PATH over OV overlay position for LINK element."
1484   (if-let* (((require 'org-bookmarks nil t))
1485             (text (org-link-beautify--generate-preview-for-org-bookmarks path)))
1486       (prog1 ov
1487         (overlay-put ov 'after-string text)
1488         (overlay-put ov 'face         'org-link))
1489     (org-link-beautify-iconify ov path link)))
1490
1491 ;;; excalidraw: link type
1492
1493 (defun org-link-beautify-preview-excalidraw (ov path link)
1494   "Preview excalidraw file of PATH over OV overlay position for LINK element."
1495   ;; TODO: reference `org-excalidraw--shell-cmd-to-svg'
1496   nil)
1497
1498 ;;; geo: link type
1499
1500 (defun org-link-beautify-preview-geography (ov path link)
1501   "Preview geo: link of PATH over OV overlay position for LINK element."
1502   ;; TODO
1503   nil)
1504
1505 ;;; git: link type
1506
1507 (defun org-link-beautify-preview-git (ov path link)
1508   "Preview git: link of PATH over OV overlay position for LINK element."
1509   (org-link-beautify-iconify ov path link))
1510
1511 ;;; http[s]: url link type
1512
1513 (defcustom org-link-beautify-url-preview-command
1514   (cl-case system-type
1515     (darwin
1516      (cond
1517       ;; Google Chrome headless screenshot
1518       ((file-exists-p "/Applications/Google Chrome.app/Contents/MacOS/Google Chrome")
1519        "/Applications/Google Chrome.app/Contents/MacOS/Google Chrome")
1520       ;; webkit2png
1521       ((executable-find "webkit2png") "webkit2png")
1522       ;; monolith
1523       ((executable-find "monolith") "monolith")))
1524     (gnu/linux
1525      (cond
1526       ;; Google Chrome headless screenshot
1527       ((executable-find "chrome") (executable-find "google-chrome"))
1528       ;; webkit2png
1529       ((executable-find "webkit2png") "webkit2png")
1530       ;; monolith
1531       ((executable-find "monolith") "monolith"))))
1532   "Find available URL web page screenshot archive command."
1533   :type 'string
1534   :safe #'stringp
1535   :group 'org-link-beautify)
1536
1537 (defcustom org-link-beautify-url-preview-size 800
1538   "The url web page thumbnail image size."
1539   :type 'number
1540   :safe #'numberp
1541   :group 'org-link-beautify)
1542
1543 (defun org-link-beautify--generate-preview-for-url (ov path link)
1544   "Generate screenshot archive for the URL PATH web page on OV overlay at LINK element."
1545   (let* ((type (org-element-property :type link))
1546          (url (concat type ":" path))
1547          (thumbnails-dir (org-link-beautify--get-thumbnails-dir-path (buffer-file-name)))
1548          (thumbnail-filename (format "org-link-beautify screenshot of sha1 URL %s.png" (sha1 url)))
1549          (thumbnail-file (expand-file-name thumbnail-filename thumbnails-dir))
1550          (html-archive-file (concat (file-name-sans-extension thumbnail-file) ".html"))
1551          (thumbnail-size (or org-link-beautify-url-preview-size 1000))
1552          (proc-name (format "org-link-beautify url screenshot - %s" url))
1553          (proc-buffer (format " *org-link-beautify url screenshot - %s*" url))
1554          (proc (get-process proc-name)))
1555     (org-link-beautify--ensure-thumbnails-dir thumbnails-dir)
1556     (unless (or (file-exists-p thumbnail-file)
1557                 (file-exists-p html-archive-file))
1558       (when org-link-beautify-url-preview-command
1559         (unless proc
1560           (pcase org-link-beautify-url-preview-command
1561             ((or "/Applications/Google Chrome.app/Contents/MacOS/Google Chrome" "google-chrome")
1562              ;; $ google-chrome --headless --screenshot=screenshot.png "https://www.chromestatus.com/"
1563              (start-process
1564               proc-name proc-buffer
1565               org-link-beautify-url-preview-command
1566               "--headless"
1567               (format "--screenshot=%s" thumbnail-file)
1568               url))
1569             ("webkit2png"
1570              (make-process
1571               :name proc-name
1572               :command (list "webkit2png" url "-o" thumbnail-file)
1573               :buffer proc-buffer
1574               :stderr nil ; If STDERR is nil, standard error is mixed with standard output and sent to BUFFER or FILTER.
1575               :sentinel (lambda (proc event)
1576                           (when (string= event "finished\n")
1577                             (kill-buffer (process-buffer proc))
1578                             (kill-process proc)))))
1579             ("monolith"
1580              (let* ((html-archive-file (concat (file-name-sans-extension thumbnail-file) ".html")))
1581                (make-process
1582                 :name proc-name
1583                 :command (list "monolith" "--no-audio" "--no-video" url "--output" html-archive-file)
1584                 :buffer proc-buffer
1585                 :stderr nil ; If STDERR is nil, standard error is mixed with standard output and sent to BUFFER or FILTER.
1586                 :sentinel (lambda (proc event)
1587                             (when (string= event "finished\n")
1588                               (kill-buffer (process-buffer proc))
1589                               (kill-process proc))))))))))
1590     (when (and org-link-beautify-enable-debug-p (not (file-exists-p thumbnail-file)))
1591       (org-link-beautify--notify-generate-thumbnail-failed url thumbnail-file))))
1592
1593 (defun org-link-beautify-preview-url (ov path link)
1594   "Preview http[s]: URL link of PATH over OV overlay position for LINK element."
1595   (if-let* (( (display-graphic-p))
1596             (org-link-beautify-url-preview-command)
1597             (thumbnail-file (org-link-beautify--generate-preview-for-url ov path link))
1598             ((file-exists-p thumbnail-file))
1599             (image (create-image thumbnail-file nil nil :width (or org-link-beautify-url-preview-size 600))))
1600       (prog1 ov
1601         (overlay-put ov 'display image)
1602             (overlay-put ov 'face    'default)
1603             (overlay-put ov 'keymap  org-link-beautify-keymap))
1604     (org-link-beautify-iconify ov path link)))
1605
1606 ;;; Insert Org link without description based on smart detecting file extension.
1607
1608 (defun org-link-beautify-remove-description (orig-func link-raw &optional link-description)
1609   "Advice function to remove LINK-DESCRIPTION from LINK-RAW around ORIG-FUNC.
1610
1611 This is for link image previewing to get around function `org-link-preview'
1612 \(original named `org-toggle-inline-images'\) parameter `include-linked'."
1613   (let ((link-type (when (string-match org-link-types-re link-raw) (match-string 1 link-raw)))
1614         (extension (file-name-extension link-raw)))
1615     (when (or (member extension image-file-name-extensions) ; image files
1616               (member extension '("pdf" "epub" "mobi" "azw3" "lit" "fb2" "fb2.zip")) ; ebook files
1617               (member extension '("avi" "rmvb" "ogg" "ogv" "mp4" "mkv" "mov" "mpeg" "webm" "flv" "ts" "mpg")) ; video files
1618               (member extension '("mp3" "wav" "flac" "ogg" "m4a" "opus" "dat")) ; audio files
1619               (member extension '("cbr" "cbz" "cb7" "cba" "cbt")) ; comic files
1620               (member extension '("zip" "rar" "7z" "gz" "tar" "tar.gz" "tar.bz2" "xz" "zst")) ; archive files
1621               (member extension '("ass" "srt" "sub" "vtt" "ssf")) ; subtitle files
1622               (member link-type '("info" "help" "shortdoc" "man" "woman" "id" "custom-id" "coderef"))
1623               (member link-type '("elisp" "shell" "js" "javascript" "grep" "occur" "git"))
1624               (member link-type '("mailto" "rss" "news" "wikipedia" "irc" "magnet" "wechat" "web-browser" "eww" "chrome" "edge"))
1625               (member link-type '("org-ql-search" "org-contact" "org-bookmark" "orgit" "orgit-rev" "orgit-log"))
1626               ;; Emacs package special link types
1627               ;; NOTE: "epub" "nov" page-number thumbnail generating not supported.
1628               (member link-type '("pdf" "pdfview" "docview")) ; "epub" "nov"
1629               (member link-type '("video" "videocite" "audio" "audiocite" "excalidraw"))
1630               ;; speail meaning link types
1631               (member link-type '("geo"))
1632               ;; special application link types
1633               (member link-type '("vscode" "macappstore")))
1634       (setq link-description nil)))
1635   (funcall orig-func link-raw link-description))
1636
1637
1638 ;;; minor mode `org-link-beautify-mode'
1639
1640 ;;;###autoload
1641 (defun org-link-beautify-enable ()
1642   "Enable `org-link-beautify'."
1643   (dolist (link-type (mapcar #'car org-link-parameters))
1644     (pcase link-type
1645       ("file" (org-link-set-parameters link-type :preview #'org-link-beautify-preview-file)) ; `org-link-preview-file',
1646       ("attachment" (org-link-set-parameters link-type :preview #'org-link-beautify-preview-attachment)) ; `org-attach-preview-file'
1647       ("docview" (org-link-set-parameters link-type :preview #'org-link-beautify-preview-pdf)) ; extension `doc-view'
1648       ("pdfview" (org-link-set-parameters link-type :preview #'org-link-beautify-preview-pdf)) ; extension `pdf-tools'
1649       ("pdf" (org-link-set-parameters link-type :preview #'org-link-beautify-preview-pdf))
1650       ("epub" (org-link-set-parameters link-type :preview #'org-link-beautify-preview-epub))
1651       ("nov" (org-link-set-parameters link-type :preview #'org-link-beautify-preview-nov)) ; extension `nov'
1652       ("geo" (org-link-set-parameters link-type :preview #'org-link-beautify-preview-geography))
1653       ("http" (org-link-set-parameters link-type :preview #'org-link-beautify-preview-url))
1654       ("https" (org-link-set-parameters link-type :preview #'org-link-beautify-preview-url))
1655       ("ftp" (org-link-set-parameters link-type :preview #'org-link-beautify-preview-url))
1656
1657       ;; Org mode internal link types
1658       ("custom-id" (org-link-set-parameters link-type :preview #'org-link-beautify-iconify))
1659       ("id" (org-link-set-parameters link-type :preview #'org-link-beautify-iconify))
1660       ("coderef" (org-link-set-parameters link-type :preview #'org-link-beautify-iconify))
1661       ("elisp" (org-link-set-parameters link-type :preview #'org-link-beautify-iconify))
1662       ("eshell" (org-link-set-parameters link-type :preview #'org-link-beautify-iconify))
1663       ("shell" (org-link-set-parameters link-type :preview #'org-link-beautify-iconify))
1664       ("man" (org-link-set-parameters link-type :preview #'org-link-beautify-iconify))
1665       ("woman" (org-link-set-parameters link-type :preview #'org-link-beautify-iconify))
1666       ("info" (org-link-set-parameters link-type :preview #'org-link-beautify-iconify))
1667       ("help" (org-link-set-parameters link-type :preview #'org-link-beautify-iconify))
1668       ("shortdoc" (org-link-set-parameters link-type :preview #'org-link-beautify-iconify))
1669
1670       ;; Org mode external link types
1671       ("grep" (org-link-set-parameters link-type :preview #'org-link-beautify-iconify))
1672       ("occur" (org-link-set-parameters link-type :preview #'org-link-beautify-iconify))
1673       ("mailto" (org-link-set-parameters link-type :preview #'org-link-beautify-iconify))
1674       ("news" (org-link-set-parameters link-type :preview #'org-link-beautify-iconify))
1675       ("rss" (org-link-set-parameters link-type :preview #'org-link-beautify-iconify))
1676       ("elfeed" (org-link-set-parameters link-type :preview #'org-link-beautify-iconify)) ; extension `elfeed'
1677       ("wikipedia" (org-link-set-parameters link-type :preview #'org-link-beautify-iconify))
1678       ("irc" (org-link-set-parameters link-type :preview #'org-link-beautify-iconify))
1679       ("wechat" (org-link-set-parameters link-type :preview #'org-link-beautify-iconify))
1680       ("magnet" (org-link-set-parameters link-type :preview #'org-link-beautify-iconify))
1681       ("git" (org-link-set-parameters link-type :preview #'org-link-beautify-preview-git))
1682       ("eww" (org-link-set-parameters link-type :preview #'org-link-beautify-iconify)) ; EWW
1683       ("chrome" (org-link-set-parameters link-type :preview #'org-link-beautify-iconify))
1684       ("edge" (org-link-set-parameters link-type :preview #'org-link-beautify-iconify))
1685       ("mu4e" (org-link-set-parameters link-type :preview #'org-link-beautify-iconify))
1686       ("web-browser" (org-link-set-parameters link-type :preview #'org-link-beautify-preview-git))
1687
1688       ;; org-ref link types
1689       ("cite" (org-link-set-parameters link-type :preview #'org-link-beautify-iconify))
1690       ("ref" (org-link-set-parameters link-type :preview #'org-link-beautify-iconify))
1691       ("doi" (org-link-set-parameters link-type :preview #'org-link-beautify-iconify))
1692       ("bibtex" (org-link-set-parameters link-type :preview #'org-link-beautify-iconify))
1693       ("bibliography" (org-link-set-parameters link-type :preview #'org-link-beautify-iconify))
1694
1695       ;; org-mode extensions link types
1696       ("org-ql-search" (org-link-set-parameters link-type :preview #'org-link-beautify-iconify)) ; extension `org-ql'
1697       ("org-contact" (org-link-set-parameters link-type :preview #'org-link-beautify-preview-org-contact)) ; extension `org-contacts'
1698       ("org-bookmark" (org-link-set-parameters link-type :preview #'org-link-beautify-preview-org-bookmark)) ; extension `org-bookmarks'
1699       ("orgit-rev" (org-link-set-parameters link-type :preview #'org-link-beautify-preview-git)) ; extension `orgit'
1700       ("orgit-log" (org-link-set-parameters link-type :preview #'org-link-beautify-preview-git)) ; extension `orgit'
1701       ("orgit" (org-link-set-parameters link-type :preview #'org-link-beautify-preview-git))     ; extension `orgit'
1702       ("excalidraw" (org-link-set-parameters link-type :preview #'org-link-beautify-preview-excalidraw)) ; extension `org-excalidraw'
1703
1704       ;; org-media-note link types
1705       ("video" (org-link-set-parameters link-type :preview #'org-link-beautify-preview-video)) ; `org-media-note'
1706       ("audio" (org-link-set-parameters link-type :preview #'org-link-beautify-preview-audio)) ; `org-media-note'
1707       ("videocite" (org-link-set-parameters link-type :preview #'org-link-beautify-preview-video)) ; `org-media-note'
1708       ("audiocite" (org-link-set-parameters link-type :preview #'org-link-beautify-preview-audio)) ; `org-media-note'
1709
1710       ;; other link types
1711       ("eaf" (org-link-set-parameters link-type :preview #'org-link-beautify-iconify)) ; extension `emacs-application-framework'
1712       ("javascript" (org-link-set-parameters link-type :preview #'org-link-beautify-iconify)) ; Org mode inline source code link
1713       ("js" (org-link-set-parameters link-type :preview #'org-link-beautify-iconify)) ; Org mode inline source code link
1714       ("vscode" (org-link-set-parameters link-type :preview #'org-link-beautify-iconify)) ; Visual Studio Code
1715       ("macappstore" (org-link-set-parameters link-type :preview #'org-link-beautify-iconify)) ; Mac App Store
1716       ("fuzzy" (org-link-set-parameters link-type :preview #'org-link-beautify-iconify)) ; org-mode internal raw link type
1717       (_ (org-link-set-parameters link-type :preview #'org-link-beautify-iconify))))
1718   ;; remove link description
1719   (advice-add 'org-link-make-string :around #'org-link-beautify-remove-description))
1720
1721 ;;;###autoload
1722 (defun org-link-beautify-disable ()
1723   "Disable `org-link-beautify'."
1724   (dolist (link-type (mapcar #'car org-link-parameters))
1725     (pcase link-type
1726       ("file" (org-link-set-parameters "file" :preview #'org-link-preview-file))
1727       ("attachment" (org-link-set-parameters "attachment" :preview #'org-attach-preview-file))
1728       (_ (org-link-set-parameters link-type :preview nil))))
1729   (advice-remove 'org-link-make-string #'org-link-beautify-remove-description))
1730
1731 (defvar org-link-beautify-mode-map
1732   (let ((map (make-sparse-keymap)))
1733     map)
1734   "The `org-link-beautify-mode' minor mode map.")
1735
1736 ;;;###autoload
1737 (define-minor-mode org-link-beautify-mode
1738   "A minor mode to beautify Org Mode links with icons, and inline preview etc."
1739   :group 'org-link-beautify
1740   :global t
1741   :init-value nil
1742   :lighter " ߷"
1743   :keymap org-link-beautify-mode-map ; avoid to enable `org-link-beautify-keymap' globally everywhere.
1744   (if org-link-beautify-mode
1745       (org-link-beautify-enable)
1746     (org-link-beautify-disable)))
1747
1748 \f
1749
1750 (provide 'org-link-beautify)
1751
1752 ;;; org-link-beautify.el ends here