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 "28.1") (nerd-icons "0.0.1") (fb2-reader "0.1.1") (qrencode "1.2"))
   5 ;; Version: 1.2.3
   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 ;;   :hook (org-mode . org-link-beautify-mode))
  30
  31 ;;; Code:
  32 \f
  33 (require 'ol)
  34 (require 'org)
  35 (require 'org-element)
  36 (require 'org-element-ast)
  37 (require 'nerd-icons)
  38 (require 'color)
  39 (require 'cl-lib)
  40 (require 'time-stamp)
  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 (defgroup org-link-beautify nil
  51   "Customize group of org-link-beautify-mode."
  52   :prefix "org-link-beautify-"
  53   :group 'org)
  54
  55 (defcustom org-link-beautify-async-preview nil
  56   "Use async thread to run preview display function.
  57 This will improve package performance without blocking Emacs."
  58   :type 'boolean
  59   :safe #'booleanp
  60   :group 'org-link-beautify)
  61
  62 (defcustom org-link-beautify-thumbnails-dir 'source-path
  63   "The directory of generated thumbnails.
  64
  65 By default the thumbnails are generated in source file path’s
  66 .thumbnails directory. This is better for avoiding re-generate
  67 preview thumbnails. Or you can set this option to ‘'user-home’
  68 which represent to ~/.cache/thumbnails/."
  69   :type 'symbol
  70   :safe #'symbolp
  71   :group 'org-link-beautify)
  72
  73 (defcustom org-link-beautify-display-overlay-info nil
  74   "Whether display link info with Emacs overlay over link thumbnail.
  75 NOTE: overlays may mess up buffer when you cut text etc."
  76   :type 'boolean
  77   :safe #'booleanp
  78   :group 'org-link-beautify)
  79
  80 (defcustom org-link-beautify-image-preview nil
  81   "Whether enable image files thumbnail preview?"
  82   :type 'boolean
  83   :safe #'booleanp
  84   :group 'org-link-beautify)
  85
  86 (defcustom org-link-beautify-image-preview-list
  87   '("jpg" "jpeg" "png" "gif" "webp")
  88   "A list of image file types be supported with thumbnails."
  89   :type 'list
  90   :safe #'listp
  91   :group 'org-link-beautify)
  92
  93 (defcustom org-link-beautify-video-preview (or (executable-find "ffmpegthumbnailer")
  94                                                (executable-find "qlmanage")
  95                                                (executable-find "ffmpeg"))
  96   "Whether enable video files thumbnail preview?"
  97   :type 'boolean
  98   :safe #'booleanp
  99   :group 'org-link-beautify)
 100
 101 (defcustom org-link-beautify-video-preview-size 512
 102   "The video thumbnail image size."
 103   :type 'number
 104   :safe #'numberp
 105   :group 'org-link-beautify)
 106
 107 (defcustom org-link-beautify-video-preview-list
 108   '("rmvb" "ogg" "ogv" "mp4" "mkv" "mov" "m4v" "webm" "flv")
 109   "A list of video file types be supported with thumbnails."
 110   :type 'list
 111   :safe #'listp
 112   :group 'org-link-beautify)
 113
 114 (defcustom org-link-beautify-subtitle-preview t
 115   "Whether enable subtitle files previewing?"
 116   :type 'boolean
 117   :safe #'booleanp
 118   :group 'org-link-beautify)
 119
 120 ;;; https://en.wikipedia.org/wiki/Subtitles
 121 (defcustom org-link-beautify-subtitle-preview-list
 122   '("ass" "srt" "sub" "vtt" "ssf")
 123   "A list of subtitle file types support previewing."
 124   :type 'list
 125   :safe #'listp
 126   :group 'org-link-beautify)
 127
 128 (defcustom org-link-beautify-audio-preview (or (executable-find "audiowaveform")
 129                                                (executable-find "qlmanage"))
 130   "Whether enable audio files wave form preview?"
 131   :type 'boolean
 132   :safe #'booleanp
 133   :group 'org-link-beautify)
 134
 135 (defcustom org-link-beautify-audio-preview-list '("mp3" "wav" "flac" "ogg" "m4a" "dat")
 136   "A list of audio file types be supported generating audio wave form image."
 137   :type 'list
 138   :safe #'listp
 139   :group 'org-link-beautify)
 140
 141 (defcustom org-link-beautify-audio-preview-size 150
 142   "The audio wave form image size."
 143   :type 'number
 144   :safe #'numberp
 145   :group 'org-link-beautify)
 146
 147 (defcustom org-link-beautify-pdf-preview (or (executable-find "pdftocairo")
 148                                              (executable-find "pdf2svg"))
 149   "Whether enable PDF files image preview?
 150 If command \"pdftocairo\" or \"pdf2svg\" is available, enable PDF
 151 preview by default. You can set this option to nil to disable
 152 PDF preview."
 153   :type 'boolean
 154   :safe #'booleanp
 155   :group 'org-link-beautify)
 156
 157 (defcustom org-link-beautify-pdf-preview-command 'pdftocairo
 158   "The command used to preview PDF file cover."
 159   :type '(choice
 160           :tag "The command used to preview PDF cover."
 161           (const :tag "pdftocairo" pdftocairo)
 162           (const :tag "pdf2svg" pdf2svg))
 163   :safe #'symbolp
 164   :group 'org-link-beautify)
 165
 166 ;;; TODO: smarter value decided based on screen size.
 167 (defcustom org-link-beautify-pdf-preview-size 512
 168   "The PDF preview image size."
 169   :type 'number
 170   :safe #'numberp
 171   :group 'org-link-beautify)
 172
 173 (defcustom org-link-beautify-pdf-preview-default-page-number 1
 174   "The default PDF preview page number."
 175   :type 'number
 176   :safe #'numberp
 177   :group 'org-link-beautify)
 178
 179 (defcustom org-link-beautify-pdf-preview-image-format 'png
 180   "The format of PDF file preview image."
 181   :type '(choice
 182           :tag "The format of PDF file preview image."
 183           (const :tag "PNG" png)
 184           (const :tag "JPEG" jpeg)
 185           (const :tag "SVG" svg))
 186   :safe #'symbolp
 187   :group 'org-link-beautify)
 188
 189 (defcustom org-link-beautify-epub-preview
 190   (cl-case system-type
 191     (gnu/linux (executable-find "gnome-epub-thumbnailer"))
 192     ;; (darwin (executable-find "epub-thumbnailer"))
 193     (t (expand-file-name "scripts/epub-thumbnailer.py" (file-name-directory (or load-file-name (buffer-file-name))))))
 194   "Whether enable EPUB files cover preview?
 195 If command \"gnome-epub-thumbnailer\" is available, enable EPUB
 196 preview by default. You can set this option to nil to disable
 197 EPUB preview."
 198   :type 'boolean
 199   :safe #'booleanp
 200   :group 'org-link-beautify)
 201
 202 (defcustom org-link-beautify-kindle-preview
 203   (cl-case system-type
 204     (gnu/linux (executable-find "mobitool"))
 205     (darwin (executable-find "mobitool")))
 206   "Whether enable Kindle ebook files cover preview?
 207
 208 Enable Kindle ebook preview by default. You can set this option
 209 to nil to disable EPUB preview.
 210
 211 You can install software `libmobi' to get command `mobitool'."
 212   :type 'boolean
 213   :safe #'booleanp
 214   :group 'org-link-beautify)
 215
 216 (defcustom org-link-beautify-fictionbook2-preview (featurep 'fb2-reader)
 217   "Whether enable FictionBook2 ebook files covert preview?"
 218   :type 'boolean
 219   :safe #'booleanp
 220   :group 'org-link-beautify)
 221
 222 (defcustom org-link-beautify-ebook-preview-size nil
 223   "The EPUB cover preview image size."
 224   :type 'number
 225   :safe #'numberp
 226   :group 'org-link-beautify)
 227
 228 (defcustom org-link-beautify-comic-preview
 229   (cl-case system-type
 230     (darwin (executable-find "qlmanage")))
 231   "Whether enable CDisplay Archived Comic Book Formats cover preview.
 232 File extensions like (.cbr, .cbz, .cb7, .cba etc)."
 233   :type 'boolean
 234   :safe #'booleanp
 235   :group 'org-link-beautify)
 236
 237 (defcustom org-link-beautify-comic-preview-size 500
 238   "The CDisplay Archived Comic Book Formats cover preview image size."
 239   :type 'number
 240   :safe #'numberp
 241   :group 'org-link-beautify)
 242
 243 (defcustom org-link-beautify-text-preview nil
 244   "Whether enable text files content preview?"
 245   :type 'boolean
 246   :safe #'booleanp
 247   :group 'org-link-beautify)
 248
 249 (defcustom org-link-beautify-text-preview-list
 250   '("org" "txt" "markdown" "md"
 251     "lisp" "scm" "clj" "cljs"
 252     "py" "rb" "pl"
 253     "c" "cpp" "h" "hpp" "cs" "java"
 254     "r" "jl")
 255   "A list of link types supports text preview below the link."
 256   :type 'list
 257   :safe #'listp
 258   :group 'org-link-beautify)
 259
 260 (defcustom org-link-beautify-archive-preview nil
 261   "Whether enable archive inside files list preview?"
 262   :type 'boolean
 263   :safe #'booleanp
 264   :group 'org-link-beautify)
 265
 266 (defcustom org-link-beautify-archive-preview-command-alist
 267   '(("zip" . "unzip -l")
 268     ("rar" . "unrar l")
 269     ("7z" . "7z l -ba") ; -ba - suppress headers; undocumented.
 270     ("gz" . "gzip --list")
 271     ;; ("bz2" . "")
 272     ("tar" . "tar --list")
 273     ("tar.gz" . "tar --gzip --list")
 274     ("tar.bz2" . "tar --bzip2 --list")
 275     ("xz" . "xz --list")
 276     ("zst" . "zstd --list"))
 277   "An alist of archive types supported archive preview inside files list.
 278 Each element has form (ARCHIVE-FILE-EXTENSION COMMAND)."
 279   :type '(alist :value-type (group string))
 280   :group 'org-link-beautify)
 281
 282 (defcustom org-link-beautify-archive-preview-command (executable-find "7z")
 283   "The command to list out files inside archive file."
 284   :type 'string
 285   :safe #'stringp
 286   :group 'org-link-beautify)
 287
 288 (defcustom org-link-beautify-url-preview nil
 289   "Whether enable URL link preview?"
 290   :type 'boolean
 291   :safe #'booleanp
 292   :group 'org-link-beautify)
 293
 294 (defcustom org-link-beautify-url-preview-size 512
 295   "The URL web page preview thumbnail size."
 296   :type 'number
 297   :safe #'numberp
 298   :group 'org-link-beautify)
 299
 300 (defcustom org-link-beautify-enable-debug-p nil
 301   "Whether enable org-link-beautify print debug info."
 302   :type 'boolean
 303   :safe #'booleanp)
 304
 305 ;;; Helper functions
 306
 307 ;;; Invoke external Python script file or code.
 308 (defcustom org-link-beautify-python-interpreter (executable-find "python3")
 309   "Specify Python interpreter to run python scripts or code."
 310   :type 'string
 311   :safe #'stringp)
 312
 313 (defun org-link-beautify--python-script-run (python-script-file)
 314   "Run PYTHON-SCRIPT-FILE through shell command."
 315   (shell-command-to-string
 316    (format "%s %s" org-link-beautify-python-interpreter python-script-file)))
 317
 318 (defun org-link-beautify--python-command-to-string (&rest code-lines)
 319   "Run Python CODE-LINES through shell command."
 320   (shell-command-to-string
 321    (concat "python -c "
 322            ;; solve double quote character issue.
 323            "\"" (string-replace "\"" "\\\"" (string-join code-lines "\n")) "\"")))
 324
 325 ;;; e.g.
 326 ;; (org-link-beautify--python-command-to-string
 327 ;;  "import numpy as np"
 328 ;;  "print(np.arange(6))"
 329 ;;  "print(\"blah blah\")"
 330 ;;  "print('{}'.format(3))")
 331
 332 ;;; Invoke external JavaScript script file or code.
 333 (defcustom org-link-beautify-javascript-interpreter (executable-find "node")
 334   "Specify JavaScript interpreter to run JavaScript scripts or code."
 335   :type 'string
 336   :safe #'stringp)
 337
 338 (defun org-link-beautify--javascript-script-run (javascript-script-file)
 339   "Run JAVASCRIPT-SCRIPT-FILE through shell command."
 340   (shell-command-to-string
 341    (format "%s %s" org-link-beautify-python-interpreter javascript-script-file)))
 342
 343 (defun org-link-beautify--javascript-command-to-string (&rest code-lines)
 344   "Run JavaScript CODE-LINES through shell command."
 345   (shell-command-to-string
 346    (concat "node --eval "
 347            ;; solve double quote character issue.
 348            "\"" (string-replace "\"" "\\\"" (string-join code-lines "\n")) "\"")))
 349
 350 (org-link-beautify--javascript-command-to-string
 351  "console.log(\"hello, world!\");"
 352  "console.log(1 + 3);")
 353
 354 ;;; Common functions
 355 ;; replace the whole Org buffer font-lock function `org-restart-font-lock'
 356 ;; with a lightweight `jit-lock-refontify' current headline scope only
 357 ;; font-lock function.
 358 (defmacro org-link-beautify--subtree-scope-wrap (body)
 359   "Wrap the BODY to executed in scope of current subtree to get BEGIN and END position."
 360   `(save-excursion
 361      (save-restriction
 362        (org-narrow-to-subtree)
 363        (let* ((begin (point-min))
 364               (end (save-excursion (org-next-visible-heading 1) (point))))
 365          ,body))))
 366
 367 (defun org-link-beautify--get-element (position)
 368   "Return the org element of link at the `POSITION'."
 369   (save-excursion
 370     (goto-char position)
 371     ;; Parse link at point, if any. replace (org-element-context) to improve performance.
 372     (org-element-link-parser)))
 373
 374 (defun org-link-beautify--get-link-description-fast (position)
 375   "Get the link description at `POSITION' (fuzzy but faster version)."
 376   (save-excursion
 377     (goto-char position)
 378     (and (org-in-regexp org-link-bracket-re) (match-string 2))))
 379
 380 (defun org-link-beautify--warning-face-p (path)
 381   "Use `org-warning' face if link PATH does not exist."
 382   (if (and (not (file-remote-p path))
 383            (file-exists-p (expand-file-name path)))
 384       'org-link 'org-warning))
 385
 386 (defun org-link-beautify--notify-generate-thumbnail-failed (source-file thumbnail-file)
 387   "Notify that generating THUMBNAIL-FILE for SOURCE-FILE failed."
 388   (message
 389    "[org-link-beautify] For file %s.\nCreate thumbnail %s failed."
 390    source-file thumbnail-file))
 391
 392 (defun org-link-beautify--add-text-property-marker (start end)
 393   "Add \\='org-link-beautify on link text-property. between START and END."
 394   (put-text-property start end 'type 'org-link-beautify))
 395
 396 (defun org-link-beautify--add-overlay-info (thumbnail start end)
 397   "Display info over the link. Put the overlay on START instead of END."
 398   (when org-link-beautify-display-overlay-info
 399     (let* ((beginning (- start 1))
 400            (end (- start 1))
 401            (filename (file-name-nondirectory thumbnail))
 402            ;; Insert an overlay new line.
 403            ;; -> Prepend a "\n" *newline character* before the /overlay/ ~'before-string~ string.
 404            (str-text-property (concat "\n" "🔗 " (propertize filename 'face 'font-lock-doc-markup-face))))
 405       ;; Detect whether overlay already exist? To avoid insert duplicated overlays many times.
 406       ;; (unless (overlay-get (symbol-value 'ov-name) 'before-string) ...)
 407       (unless (seq-some
 408                (lambda (element) (not (null element)))
 409                (mapcar
 410                 (lambda (plist)
 411                   (plist-get plist 'before-string))
 412                 (mapcar 'overlay-properties
 413                         (overlays-in beginning end))))
 414         ;; Make random overlay object symbol names to store different overlays.
 415         (setq ov-name (make-symbol (concat "org-link-beautify--overlay-" (format "%010d" (random 10000000000)))))
 416         (set-variable (symbol-value 'ov-name) (make-overlay beginning end))
 417         ;; display filename
 418         (overlay-put (symbol-value (symbol-value 'ov-name)) 'before-string str-text-property)
 419         (overlay-put (symbol-value (symbol-value 'ov-name)) 'evaporate t)))))
 420
 421 ;;; TEST:
 422 ;; (org-link-beautify--add-overlay-info "/path/to/thumbnail.png" (+ (point) 1) (+ (point) 2))
 423 ;; (remove-overlays (point) (+ (point) 1)) ; clear displayed overlays.
 424
 425 (defun org-link-beautify--get-thumbnails-dir-path (file)
 426   "Return the FILE thumbnail directory's path."
 427   (cl-case org-link-beautify-thumbnails-dir
 428     (source-path
 429      (concat (file-name-directory file) ".thumbnails/"))
 430     (user-home
 431      (expand-file-name "~/.cache/thumbnails/"))))
 432
 433 (defun org-link-beautify--ensure-thumbnails-dir (thumbnails-dir)
 434   "Ensure THUMBNAILS-DIR exist, if not ,create it."
 435   (unless (file-directory-p thumbnails-dir)
 436     (make-directory thumbnails-dir)))
 437
 438 (defun org-link-beautify--display-thumbnail (thumbnail thumbnail-size start end &optional border-width border-color)
 439   "Display THUMBNAIL between START and END with THUMBNAIL-SIZE and in BORDER-WIDTH BORDER-COLOR when exist."
 440   (when (and (file-exists-p thumbnail)
 441              ;; If thumbnail image already displayed, don't re-display thumbnail.
 442              (not (eq (car (get-text-property start 'display)) 'image)))
 443     (put-text-property
 444      start end
 445      'display (create-image thumbnail nil nil :ascent 100 :max-height thumbnail-size))
 446     (when border-color
 447       (put-text-property start end 'face `(:box (:line-width ,(or border-width 1) :color ,border-color))))))
 448
 449 (defun org-link-beautify--display-content-block (lines-list)
 450   "Display LINES-LIST string as a block with beautified frame border."
 451   (format
 452    "
 453 ┏━§ ✂ %s
 454 %s
 455 ┗━§ ✂ %s
 456 \n"
 457    (make-string (- fill-column 6) ?━)
 458    (mapconcat
 459     (lambda (line)
 460       (concat "┃" line))
 461     lines-list
 462     "\n")
 463    (make-string (- fill-column 6) ?━)))
 464
 465
 466 ;;; Preview functions
 467 (defun org-link-beautify--preview-pdf (path start end &optional search-option)
 468   "Preview PDF file PATH with optional SEARCH-OPTION on link between START and END."
 469   (if (string-match "\\(.*?\\)\\(?:::\\(.*\\)\\)?\\'" path)
 470       (let* ((file-path (match-string 1 path))
 471              ;; DEBUG:
 472              ;; (_ (lambda () (message "--> DEBUG: org-link-beautify (pdf): path: %s" path)))
 473              ;; (_ (lambda () (message "--> DEBUG: org-link-beautify (pdf): search-option: %s" search-option)))
 474              (pdf-page-number (if search-option
 475                                   (string-to-number
 476                                    (cond
 477                                     ((string-prefix-p "P" search-option) ; "P42"
 478                                      (substring search-option 1 nil))
 479                                     ((string-match "\\([[:digit:]]+\\)\\+\\+\\(.*\\)" search-option) ; "40++0.00"
 480                                      (match-string 1 search-option))
 481                                     (t search-option)))
 482                                 (if-let ((search-option (match-string 2 path)))
 483                                     (string-to-number
 484                                      (cond
 485                                       ((string-prefix-p "P" search-option) ; "P42"
 486                                        (substring search-option 1 nil))
 487                                       ((string-match "\\([[:digit:]]+\\)\\+\\+\\(.*\\)" search-option) ; "40++0.00"
 488                                        (match-string 1 search-option))
 489                                       (t search-option)))
 490                                   org-link-beautify-pdf-preview-default-page-number)))
 491              (pdf-file (expand-file-name (org-link-unescape file-path)))
 492              (thumbnails-dir (org-link-beautify--get-thumbnails-dir-path pdf-file))
 493              (thumbnail-file (expand-file-name
 494                               (if (= pdf-page-number 1) ; if have page number ::N specified.
 495                                   (format "%s%s.%s"
 496                                           thumbnails-dir (file-name-base pdf-file)
 497                                           (symbol-name org-link-beautify-pdf-preview-image-format))
 498                                 (format "%s%s-P%s.%s"
 499                                         thumbnails-dir (file-name-base pdf-file) pdf-page-number
 500                                         (symbol-name org-link-beautify-pdf-preview-image-format)))))
 501              (thumbnail-size (or org-link-beautify-pdf-preview-size 512)))
 502         (org-link-beautify--ensure-thumbnails-dir thumbnails-dir)
 503         (unless (file-exists-p thumbnail-file)
 504           (pcase org-link-beautify-pdf-preview-command
 505             ('pdftocairo
 506              ;; DEBUG:
 507              ;; (message
 508              ;;  "org-link-beautify: page-number %s, pdf-file %s, thumbnail-file %s"
 509              ;;  pdf-page-number pdf-file thumbnail-file)
 510              (start-process
 511               "org-link-beautify--pdf-preview"
 512               " *org-link-beautify pdf-preview*"
 513               "pdftocairo"
 514               (pcase org-link-beautify-pdf-preview-image-format
 515                 ('png "-png")
 516                 ('jpeg "-jpeg")
 517                 ('svg "-svg"))
 518               "-singlefile"
 519               "-f" (number-to-string pdf-page-number)
 520               pdf-file (file-name-sans-extension thumbnail-file))
 521              (when (and org-link-beautify-enable-debug-p (not (file-exists-p thumbnail-file)))
 522                (org-link-beautify--notify-generate-thumbnail-failed pdf-file thumbnail-file)))
 523             ('pdf2svg
 524              (unless (eq org-link-beautify-pdf-preview-image-format 'svg)
 525                (warn "The pdf2svg only supports convert PDF to SVG format.
 526 Please adjust `org-link-beautify-pdf-preview-command' to `pdftocairo' or
 527 Set `org-link-beautify-pdf-preview-image-format' to `svg'."))
 528              (start-process
 529               "org-link-beautify--pdf-preview"
 530               " *org-link-beautify pdf-preview*"
 531               "pdf2svg"
 532               pdf-file thumbnail-file (number-to-string pdf-page-number))
 533              (when (and org-link-beautify-enable-debug-p (not (file-exists-p thumbnail-file)))
 534                (org-link-beautify--notify-generate-thumbnail-failed pdf-file thumbnail-file)))))
 535         (org-link-beautify--add-overlay-info thumbnail-file start end)
 536         (org-link-beautify--add-text-property-marker start end)
 537         (org-link-beautify--add-keymap start end)
 538         ;; display thumbnail-file only when it exist, otherwise it will break org-mode buffer fontification.
 539         (if (file-exists-p thumbnail-file)
 540             (org-link-beautify--display-thumbnail thumbnail-file thumbnail-size start end)
 541           'error))))
 542
 543 (defun org-link-beautify--preview-epub (path start end &optional search-option)
 544   "Preview EPUB file PATH and display on link between START and END."
 545   (if (string-match "\\(.*?\\)\\(?:::\\(.*\\)\\)?\\'" path)
 546       (let* ((file-path (match-string 1 path))
 547              ;; DEBUG: (_ (lambda () (message "--> DEBUG: ")))
 548              (epub-page-number (or (match-string 2 path) 1))
 549              (epub-file (expand-file-name (org-link-unescape file-path)))
 550              (thumbnails-dir (org-link-beautify--get-thumbnails-dir-path epub-file))
 551              (thumbnail-file (expand-file-name
 552                               (if (or (null epub-page-number) (= epub-page-number 1)) ; if have page number ::N specified.
 553                                   (format "%s%s.png" thumbnails-dir (file-name-base epub-file))
 554                                 (format "%s%s-P%s.png" thumbnails-dir (file-name-base epub-file) epub-page-number))))
 555              (thumbnail-size (or org-link-beautify-ebook-preview-size 500)))
 556         (org-link-beautify--ensure-thumbnails-dir thumbnails-dir)
 557         ;; DEBUG:
 558         ;; (message epub-file)
 559         (unless (file-exists-p thumbnail-file)
 560           (cl-case system-type
 561             (gnu/linux                 ; for Linux "gnome-epub-thumbnailer"
 562              (start-process
 563               "org-link-beautify--epub-preview"
 564               " *org-link-beautify epub-preview*"
 565               org-link-beautify-epub-preview
 566               epub-file thumbnail-file
 567               ;; (if org-link-beautify-ebook-preview-size
 568               ;;     "--size")
 569               ;; (if org-link-beautify-ebook-preview-size
 570               ;;     (number-to-string thumbnail-size))
 571               )
 572              (when (and org-link-beautify-enable-debug-p (not (file-exists-p thumbnail-file)))
 573                (org-link-beautify--notify-generate-thumbnail-failed epub-file thumbnail-file)))
 574             (darwin            ; for macOS "epub-thumbnailer" command
 575              ;; DEBUG
 576              ;; (message epub-file)
 577              ;; (message thumbnail-file)
 578              ;; (message (number-to-string org-link-beautify-ebook-preview-size))
 579              (make-process
 580               :name "org-link-beautify--epub-preview"
 581               :command (list org-link-beautify-epub-preview
 582                              epub-file
 583                              thumbnail-file
 584                              (number-to-string thumbnail-size))
 585               :buffer " *org-link-beautify epub-preview*"
 586               :stderr nil ; If STDERR is nil, standard error is mixed with standard output and sent to BUFFER or FILTER.
 587               :sentinel (lambda (proc event)
 588                           (if org-link-beautify-enable-debug-p
 589                               (message (format "> proc: %s\n> event: %s" proc event))
 590                             ;; (when (string= event "finished\n")
 591                             ;;   (kill-buffer (process-buffer proc))
 592                             ;;   (kill-process proc))
 593                             )))
 594              (when (and org-link-beautify-enable-debug-p (not (file-exists-p thumbnail-file)))
 595                (org-link-beautify--notify-generate-thumbnail-failed epub-file thumbnail-file)))
 596             (t (user-error "This system platform currently not supported by org-link-beautify.\n Please contribute code to support"))))
 597         (org-link-beautify--add-overlay-info thumbnail-file start end)
 598         (org-link-beautify--add-text-property-marker start end)
 599         (org-link-beautify--add-keymap start end)
 600         ;; display thumbnail-file only when it exist, otherwise it will break org-mode buffer fontification.
 601         (if (file-exists-p thumbnail-file)
 602             (org-link-beautify--display-thumbnail thumbnail-file thumbnail-size start end)
 603           'error))))
 604
 605 (defvar org-link-beautify--kindle-cover
 606   (cond
 607    ;; for macOS, use `mobitool' from libmobi.
 608    ((and (eq system-type 'darwin) (executable-find "mobitool")) "mobitool")
 609    ;; for Linux, use `mobitool' from libmobi.
 610    ((and (eq system-type 'gnu/linux) (executable-find "mobitool")) "mobitool"))
 611   "Find available kindle ebook cover dump command.
 612 You can install software `libmobi' to get command `mobitool'.")
 613
 614 (defun org-link-beautify--preview-kindle (path start end &optional search-option)
 615   "Preview Kindle ebooks at PATH and display on link between START and END."
 616   (if (string-match "\\(.*?\\)\\(?:::\\(.*\\)\\)?\\'" path)
 617       (let* ((file-path (match-string 1 path))
 618              ;; DEBUG: (_ (lambda () (message "--> DEBUG: ")))
 619              (kindle-page-number (or (match-string 2 path) 1))
 620              (kindle-file (expand-file-name (org-link-unescape file-path)))
 621              (thumbnails-dir (org-link-beautify--get-thumbnails-dir-path kindle-file))
 622              (thumbnail-file (expand-file-name
 623                               (if (or (null kindle-page-number) (= kindle-page-number 1)) ; if have page number ::N specified.
 624                                   (format "%s%s.jpg" thumbnails-dir (file-name-base kindle-file))
 625                                 (format "%s%s-P%s.jpg" thumbnails-dir (file-name-base kindle-file) kindle-page-number))))
 626              (thumbnail-size (or org-link-beautify-ebook-preview-size 500)))
 627         (org-link-beautify--ensure-thumbnails-dir thumbnails-dir)
 628         ;; DEBUG:
 629         ;; (message kindle-file)
 630         (unless (file-exists-p thumbnail-file)
 631           (pcase org-link-beautify--kindle-cover
 632             ("mobitool" ; NOTE: mobitool command-line tool dump covert image filename can't be specified.
 633              (let ((mobitool-cover-file (concat thumbnails-dir (file-name-base kindle-file) "_cover.jpg")))
 634                (unless (file-exists-p mobitool-cover-file)
 635                  (message "[org-link-beautify] preview kindle ebook file %s" kindle-file)
 636                  (start-process
 637                   "org-link-beautify--kindle-preview"
 638                   " *org-link-beautify kindle-preview*"
 639                   "mobitool" "-c" "-o" thumbnails-dir kindle-file))
 640                ;; then rename [file.extension.jpg] to [file.jpg]
 641                (when (file-exists-p mobitool-cover-file)
 642                  (rename-file mobitool-cover-file thumbnail-file))
 643                (when (and org-link-beautify-enable-debug-p (not (file-exists-p thumbnail-file)))
 644                  (org-link-beautify--notify-generate-thumbnail-failed kindle-file thumbnail-file))))
 645             (_ (user-error "[org-link-beautify] Error: Can't find command tool to dump kindle ebook file cover."))))
 646         (org-link-beautify--add-overlay-info thumbnail-file start end)
 647         (org-link-beautify--add-text-property-marker start end)
 648         (org-link-beautify--add-keymap start end)
 649         ;; display thumbnail-file only when it exist, otherwise it will break org-mode buffer fontification.
 650         (if (file-exists-p thumbnail-file)
 651             (org-link-beautify--display-thumbnail thumbnail-file thumbnail-size start end)
 652           'error))))
 653
 654 (defun org-link-beautify--preview-comic (path start end &optional search-option)
 655   "Preview CDisplay Archived Comic Book file PATH and display on link between START and END."
 656   (if (string-match "\\(.*?\\)\\(?:::\\(.*\\)\\)?\\'" path)
 657       (let* ((file-path (match-string 1 path))
 658              ;; DEBUG: (_ (lambda () (message "--> DEBUG: ")))
 659              (comic-file (expand-file-name (org-link-unescape file-path)))
 660              (thumbnails-dir (org-link-beautify--get-thumbnails-dir-path comic-file))
 661              (thumbnail-file (expand-file-name
 662                               (format "%s%s.png" thumbnails-dir (file-name-base comic-file))))
 663              (thumbnail-size (or org-link-beautify-comic-preview-size 1080)))
 664         (org-link-beautify--ensure-thumbnails-dir thumbnails-dir)
 665         ;; DEBUG:
 666         ;; (message comic-file)
 667         (unless (file-exists-p thumbnail-file)
 668           (cl-case system-type
 669             ;; TODO:
 670             ;; (gnu/linux
 671             ;;  (start-process
 672             ;;   "org-link-beautify--comic-preview"
 673             ;;   " *org-link-beautify comic-preview*"
 674             ;;   org-link-beautify-comic-preview
 675             ;;   comic-file thumbnail-file
 676             ;;   ;; (if org-link-beautify-comic-preview-size
 677             ;;   ;;     "--size")
 678             ;;   ;; (if org-link-beautify-comic-preview-size
 679             ;;   ;;     (number-to-string thumbnail-size))
 680             ;;   )
 681             ;;  (when (and org-link-beautify-enable-debug-p (not (file-exists-p thumbnail-file)))
 682             ;;    (org-link-beautify--notify-generate-thumbnail-failed comic-file thumbnail-file)))
 683             (darwin            ; for macOS "qlmanage" command
 684              ;; DEBUG
 685              ;; (message comic-file)
 686              ;; (message thumbnail-file)
 687              ;; (message (number-to-string org-link-beautify-comic-preview-size))
 688              ;; $ qlmanage -t "ラセン恐怖閣-マリコとニジロー1-DL版.cbz" - 2.0 -s 1080 -o ".thumbnails"
 689              (let ((qlmanage-thumbnail-file (concat thumbnails-dir (file-name-nondirectory comic-file) ".png")))
 690                (make-process
 691                 :name "org-link-beautify--comic-preview"
 692                 :command (list org-link-beautify-comic-preview
 693                                "-t"
 694                                comic-file
 695                                "-o" thumbnails-dir
 696                                "-s" (number-to-string thumbnail-size))
 697                 :buffer " *org-link-beautify comic-preview*"
 698                 :stderr nil ; If STDERR is nil, standard error is mixed with standard output and sent to BUFFER or FILTER.
 699                 :sentinel (lambda (proc event)
 700                             (if org-link-beautify-enable-debug-p
 701                                 (message (format "> proc: %s\n> event: %s" proc event))
 702                               ;; (when (string= event "finished\n")
 703                               ;;   (kill-buffer (process-buffer proc))
 704                               ;;   (kill-process proc))
 705                               )))
 706                ;; then rename [file.extension.png] to [file.png]
 707                (when (file-exists-p qlmanage-thumbnail-file)
 708                  (rename-file qlmanage-thumbnail-file thumbnail-file))
 709                (when (and org-link-beautify-enable-debug-p (not (file-exists-p thumbnail-file)))
 710                  (org-link-beautify--notify-generate-thumbnail-failed comic-file thumbnail-file))))
 711             (t (user-error "This system platform currently not supported by org-link-beautify.\n Please contribute code to support"))))
 712         (org-link-beautify--add-overlay-info thumbnail-file start end)
 713         (org-link-beautify--add-text-property-marker start end)
 714         (org-link-beautify--add-keymap start end)
 715         ;; display thumbnail-file only when it exist, otherwise it will break org-mode buffer fontification.
 716         (if (file-exists-p thumbnail-file)
 717             (org-link-beautify--display-thumbnail thumbnail-file thumbnail-size start end)
 718           'error))))
 719
 720 (defun org-link-beautify--fictionbook2-extract-cover (file-path)
 721   "Extract cover image data for FILE."
 722   (if-let* ((fb2-file-path file-path)
 723             ;; `fb2-reader-mode'
 724             (book (or (fb2-reader-parse-file-as-xml fb2-file-path)
 725                       (fb2-reader-parse-file-as-html fb2-file-path)))
 726             ;; `fb2-reader-splash-screen'
 727             (cover-item (fb2-reader--get-cover book))
 728             ;; `fb2-reader-splash-cover': (fb2-reader-splash-cover book cover-item)
 729             (attrs (cl-second (cl-third cover-item)))
 730             (img-data (fb2-reader--extract-image-data book attrs))
 731             (type (cl-first img-data))
 732             (data (cl-second img-data))
 733             ;; `fb2-reader--insert-image': (fb2-reader--insert-image data-str type-str nil t)
 734             (type-symbol (alist-get type '(("image/jpeg" . jpeg) ("image/png" . png))))
 735             (data-decoded (base64-decode-string data))
 736             (img-raw (fb2-reader--create-image data-decoded type-symbol))
 737             (image (create-image data-decoded type-symbol 't)))
 738       image
 739     'no-cover))
 740
 741 (defun org-link-beautify--fictionbook2-save-cover (image file-path)
 742   ;; TODO: how to save image data into image file?
 743   ;; `image-save': This writes the original image data to a file.
 744   (with-temp-buffer
 745     (insert (plist-get (cdr image) :data))
 746     (write-region (point-min) (point-max) file-path)))
 747
 748 (defun org-link-beautify--preview-fictionbook2 (path start end &optional search-option)
 749   "Preview FictionBook2 ebooks at PATH and display on link between START and END."
 750   (require 'fb2-reader)
 751   (let* ((fb2-file-path (expand-file-name (org-link-unescape path)))
 752          ;; (_ (lambda () (message "--> DEBUG: %s" fb2-file-path)))
 753          (thumbnails-dir (org-link-beautify--get-thumbnails-dir-path fb2-file-path))
 754          (thumbnail-file-path (expand-file-name (format "%s%s.png" thumbnails-dir (file-name-base fb2-file-path))))
 755          (thumbnail-size (or org-link-beautify-ebook-preview-size 500)))
 756     (org-link-beautify--ensure-thumbnails-dir thumbnails-dir)
 757     (unless (file-exists-p thumbnail-file-path)
 758       (let ((cover-image (org-link-beautify--fictionbook2-extract-cover fb2-file-path)))
 759         (if (eq cover-image 'no-cover)
 760             (message "[org-link-beautify] FictionBook2 preview failed to extract cover image.")
 761           (org-link-beautify--fictionbook2-save-cover cover-image thumbnail-file-path))))
 762     (org-link-beautify--add-overlay-info thumbnail-file start end)
 763     (org-link-beautify--add-text-property-marker start end)
 764     (org-link-beautify--add-keymap start end)
 765     ;; display thumbnail-file-path only when it exist, otherwise it will break org-mode buffer fontification.
 766     (if (file-exists-p thumbnail-file-path)
 767         (org-link-beautify--display-thumbnail thumbnail-file-path thumbnail-size start end)
 768       'error)))
 769
 770 ;;; TEST: [M-:] eval bellowing code on FictionBook2 link.
 771 ;; (let* ((context (org-element-context))
 772 ;;        (beg (org-element-property :begin context))
 773 ;;        (end (org-element-property :end context))
 774 ;;        (path (org-element-property :path context)))
 775 ;;   (org-link-beautify--preview-fictionbook2
 776 ;;    path
 777 ;;    beg end))
 778
 779 (defvar org-link-beautify--preview-text--noerror)
 780
 781 (defun org-link-beautify--preview-text-file (file lines)
 782   "Return first LINES of FILE."
 783   (with-temp-buffer
 784     (condition-case nil
 785         (progn
 786           ;; I originally use `insert-file-contents-literally', so Emacs doesn't
 787           ;; decode the non-ASCII characters it reads from the file, i.e. it
 788           ;; doesn't interpret the byte sequences as Chinese characters. Use
 789           ;; `insert-file-contents' instead. In addition, this function decodes
 790           ;; the inserted text from known formats by calling format-decode,
 791           ;; which see.
 792           (insert-file-contents file)
 793           (org-link-beautify--display-content-block
 794            ;; This `cl-loop' extract a LIST of string lines from the file content.
 795            (cl-loop repeat lines
 796                     unless (eobp)
 797                     collect (prog1 (buffer-substring-no-properties
 798                                     (line-beginning-position)
 799                                     (line-end-position))
 800                               (forward-line 1)))))
 801       (file-error
 802        (funcall (if org-link-beautify--preview-text--noerror #'message #'user-error)
 803                         "Unable to read file %S"
 804                         file)
 805            nil))))
 806
 807 ;;; test
 808 ;; (org-link-beautify--preview-text-file
 809 ;;  (expand-file-name "~/Code/Emacs/org-link-beautify/README.org")
 810 ;;  3)
 811
 812 (defun org-link-beautify--preview-text (path start end &optional lines)
 813   "Preview LINES of TEXT file PATH and display on link between START and END."
 814   (let* ((text-file (expand-file-name (org-link-unescape path)))
 815          (preview-lines (or lines 10))
 816          (preview-content (org-link-beautify--preview-text-file text-file preview-lines)))
 817     (org-link-beautify--add-text-property-marker (1+ end) (+ end 2))
 818     (org-link-beautify--add-keymap (1+ end) (+ end 2))
 819     (put-text-property (1+ end) (+ end 2) 'display (propertize preview-content))
 820     (put-text-property (1+ end) (+ end 2) 'face '(:inherit org-block)))
 821   ;; Fix elisp compiler warning: Unused lexical argument `start'.
 822   (ignore start))
 823
 824 (defun org-link-beautify--preview-archive-file (file command)
 825   "Return the files list inside of archive FILE with COMMAND."
 826   (let ((cmd (format "%s '%s'" command file)))
 827     (org-link-beautify--display-content-block
 828      ;; split large string content into list of lines.
 829      (split-string (shell-command-to-string cmd) "\n"))))
 830
 831 (defun org-link-beautify--preview-archive (path command start end)
 832   "Preview archive PATH content with COMMAND on link between START and END."
 833   (let* ((archive-file (expand-file-name (org-link-unescape path)))
 834          (preview-content (org-link-beautify--preview-archive-file archive-file command)))
 835     (org-link-beautify--add-text-property-marker (1+ end) (+ end 2))
 836     (org-link-beautify--add-keymap (1+ end) (+ end 2))
 837     (put-text-property (1+ end) (+ end 2) 'display (propertize preview-content))
 838     (put-text-property (1+ end) (+ end 2) 'face '(:inherit org-verbatim)))
 839   ;; Fix elisp compiler warning: Unused lexical argument `start'.
 840   (ignore start))
 841
 842 (defun org-link-beautify--preview-image (type path start end)
 843   "Preview image file PATH and display on link TYPE between START and END."
 844   (let* ((image-file (pcase type
 845                        ("file" (expand-file-name (org-link-unescape path)))
 846                        ("image" (expand-file-name (org-link-unescape path)))
 847                        ("attachment" (expand-file-name (org-link-unescape path) (org-attach-dir)))))
 848          (thumbnail-size (or (cond
 849                               ((listp org-image-actual-width)
 850                                (car org-image-actual-width))
 851                               ((numberp org-image-actual-width)
 852                                org-image-actual-width))
 853                              (org-display-inline-image--width
 854                               (org-element-lineage
 855                                            (save-match-data (org-element-context))
 856                                            'link t)))))
 857     (put-text-property
 858      start end
 859      'display (create-image image-file nil nil :ascent 100 :width thumbnail-size))))
 860
 861 (defvar org-link-beautify--video-thumbnailer
 862   (cond
 863    ;; for macOS, use `qlmanage'
 864    ((and (eq system-type 'darwin) (executable-find "qlmanage")) "qlmanage")
 865    ;; for Linux, use `ffmpegthumbnailer'
 866    ((and (eq system-type 'gnu/linux) (executable-find "ffmpegthumbnailer")) "ffmpegthumbnailer")
 867    ;; for general, use `ffmpeg'
 868    ;; $ ffmpeg -i video.mp4 -ss 00:01:00.000 -vframes 1 -vcodec png -an -f rawvideo -s 119x64 out.png
 869    ((executable-find "ffmpeg") "ffmpeg"))
 870   "Find available video thumbnailer command.")
 871
 872 (defun org-link-beautify--preview-video (type path start end)
 873   "Preview video file PATH and display on link TYPE between START and END."
 874   ;; DEBUG: (message "type: %s, path: %s, start: %s, end: %s" type path start end)
 875   (let* ((video-file (pcase type
 876                        ("file" (expand-file-name (org-link-unescape path)))
 877                        ("video" (expand-file-name (org-link-unescape path)))
 878                        ("attachment" (expand-file-name (org-link-unescape path) (org-attach-dir)))))
 879          (video-filename (file-name-nondirectory video-file))
 880          (thumbnails-dir (org-link-beautify--get-thumbnails-dir-path video-file))
 881          (thumbnail-file (expand-file-name (format "%s%s.png" thumbnails-dir (file-name-base video-file))))
 882          (thumbnail-size (or org-link-beautify-video-preview-size 512))
 883          (proc-name (format "org-link-beautify--video-preview - %s" video-filename))
 884          (proc-buffer (format " *org-link-beautify video-preview - %s*" video-filename))
 885          (proc (get-process proc-name)))
 886     (org-link-beautify--ensure-thumbnails-dir thumbnails-dir)
 887     (unless (file-exists-p thumbnail-file)
 888       ;; detect process already running?
 889       (unless proc
 890         (pcase org-link-beautify--video-thumbnailer
 891           ("qlmanage"
 892            (let ((qlmanage-thumbnail-file (concat thumbnails-dir (file-name-nondirectory video-file) ".png")))
 893              (unless (file-exists-p qlmanage-thumbnail-file)
 894                (let ((proc (start-process
 895                             proc-name proc-buffer
 896                             "qlmanage" "-x" "-t" "-s" (number-to-string thumbnail-size) video-file "-o" thumbnails-dir))
 897                      (proc-filter (lambda (proc output)
 898                                     ;; * No thumbnail created for [FILE PATH]
 899                                     (when (string-match "\\* No thumbnail created for.*" output)
 900                                       (message
 901                                        "[org-link-beautify] video preview FAILED on macOS QuickLook generating thumbnail for %s"
 902                                        video-filename)))))
 903                  (set-process-filter proc proc-filter)))
 904              ;; then rename [file.extension.png] to [file.png]
 905              (when (file-exists-p qlmanage-thumbnail-file)
 906                (rename-file qlmanage-thumbnail-file thumbnail-file))
 907              (when (and org-link-beautify-enable-debug-p (not (file-exists-p thumbnail-file)))
 908                (org-link-beautify--notify-generate-thumbnail-failed video-file thumbnail-file))))
 909           ("ffmpegthumbnailer"
 910            (start-process
 911             proc-name proc-buffer
 912             "ffmpegthumbnailer" "-f" "-i" video-file "-s" (number-to-string thumbnail-size) "-o" thumbnail-file)
 913            (when (and org-link-beautify-enable-debug-p (not (file-exists-p thumbnail-file)))
 914              (org-link-beautify--notify-generate-thumbnail-failed video-file thumbnail-file)))
 915           ("ffmpeg"
 916            ;; $ ffmpeg -i video.mp4 -ss 00:01:00.000 -vframes 1 -vcodec png -an -f rawvideo -s 119x64 out.png
 917            (start-process
 918             proc-name proc-buffer
 919             "ffmpeg" "-i" video-file "-ss" "00:01:00.000" "-vframes" "1"
 920             "-vcodec" "png" "-an" "-f" "rawvideo" "-s" (number-to-string thumbnail-size) thumbnail-file)
 921            (when (and org-link-beautify-enable-debug-p (not (file-exists-p thumbnail-file)))
 922              (org-link-beautify--notify-generate-thumbnail-failed video-file thumbnail-file))))))
 923     (org-link-beautify--add-overlay-info thumbnail-file start end)
 924     (org-link-beautify--add-text-property-marker start end)
 925     (org-link-beautify--add-keymap start end)
 926     ;; display thumbnail-file only when it exist, otherwise it will break org-mode buffer fontification.
 927     (if (file-exists-p thumbnail-file)
 928         (org-link-beautify--display-thumbnail
 929          thumbnail-file thumbnail-size start end
 930          5 (cl-case (frame-parameter nil 'background-mode)
 931              (light (color-darken-name (face-background 'default) 10))
 932              (dark (color-lighten-name (face-background 'default) 5))))
 933       'error)))
 934
 935 (defun org-link-beautify--preview-subtitle (path start end &optional lines)
 936   "Preview subtitle file PATH and display on link between START and END."
 937   ;; display preview only when it exist, otherwise it will break org-mode buffer fontification.
 938   (org-link-beautify--preview-text path start end (or lines 20)))
 939
 940 ;;; TEST:
 941 ;; (org-link-beautify--preview-subtitle
 942 ;;  (expand-file-name "/path/to/subtitle.ass")
 943 ;;  nil nil
 944 ;;  3)
 945
 946 (defvar org-link-beautify--audio-thumbnailer
 947   (cond
 948    ;; for macOS, use `qlmanage'
 949    ((and (eq system-type 'darwin) (executable-find "qlmanage")) "qlmanage")
 950    ;; for Linux, use `audiowaveform'
 951    ((and (eq system-type 'gnu/linux) (executable-find "audiowaveform")) "audiowaveform")
 952    ;; for general, use `ffmpeg'
 953    ((executable-find "ffmpeg") "ffmpeg"))
 954   "Find available audio thumbnailer command.")
 955
 956 (defun org-link-beautify--preview-audio (path start end)
 957   "Preview audio PATH with wave form image on link between START and END."
 958   (let* ((audio-file (pcase type
 959                        ("file" (expand-file-name (org-link-unescape path)))
 960                        ("audio" (expand-file-name (org-link-unescape path)))
 961                        ("attachment" (expand-file-name (org-link-unescape path) (org-attach-dir)))))
 962          (audio-filename (file-name-nondirectory audio-file))
 963          (thumbnails-dir (org-link-beautify--get-thumbnails-dir-path audio-file))
 964          (thumbnail-file (expand-file-name (format "%s%s.png" thumbnails-dir (file-name-base audio-file))))
 965          (thumbnail-size (or org-link-beautify-audio-preview-size 200))
 966          (proc-name (format "org-link-beautify--audio-preview - %s" audio-filename))
 967          (proc-buffer (format " *org-link-beautify audio preview - %s*" audio-filename))
 968          (proc (get-process proc-name)))
 969     (org-link-beautify--ensure-thumbnails-dir thumbnails-dir)
 970     (unless (file-exists-p thumbnail-file)
 971       (unless proc
 972         (pcase org-link-beautify--audio-thumbnailer
 973           ("qlmanage"
 974            (let ((qlmanage-thumbnail-file (concat thumbnails-dir (file-name-nondirectory audio-file) ".png")))
 975              (unless (file-exists-p qlmanage-thumbnail-file)
 976                (start-process proc-name proc-buffer
 977                               "qlmanage" "-x" "-t" "-s" (number-to-string thumbnail-size) audio-file "-o" thumbnails-dir))
 978              ;; then rename [file.extension.png] to [file.png]
 979              (when (file-exists-p qlmanage-thumbnail-file)
 980                (rename-file qlmanage-thumbnail-file thumbnail-file))
 981              (when (and org-link-beautify-enable-debug-p (not (file-exists-p thumbnail-file)))
 982                (org-link-beautify--notify-generate-thumbnail-failed audio-file thumbnail-file))))
 983           ("audiowaveform"
 984            (start-process proc-name proc-buffer
 985                           "audiowaveform" "-i" audio-file "-o" thumbnail-file)
 986            (when (and org-link-beautify-enable-debug-p (not (file-exists-p thumbnail-file)))
 987              (org-link-beautify--notify-generate-thumbnail-failed audio-file thumbnail-file)))
 988           ;; TODO: use ffmpeg to generate audio wave form preview image.
 989           ;; ("ffmpeg"
 990           ;;  )
 991           )))
 992     (org-link-beautify--add-overlay-info thumbnail-file start end)
 993     (org-link-beautify--add-text-property-marker start end)
 994     (org-link-beautify--add-keymap start end)
 995     ;; display thumbnail-file only when it exist, otherwise it will break org-mode buffer fontification.
 996     (if (file-exists-p thumbnail-file)
 997         (org-link-beautify--display-thumbnail thumbnail-file thumbnail-size start end)
 998       'error)))
 999
1000 (defvar org-link-beautify--url-screenshot-cmd
1001   (cond
1002    ((executable-find "webkit2png") "webkit2png")
1003    ((executable-find "monolith") "monolith"))
1004   "Find available URL web page screenshot command.")
1005
1006 (defun org-link-beautify--preview-url-archive (url cmd-list)
1007   "Construct process to run"
1008   (let* ((process-name (format "org-link-beautify--url-screenshot %s" url))
1009          (process-buffer (format " *org-link-beautify--url-screenshot %s*" url))
1010          (proc (get-process process-name)))
1011     (unless proc
1012       (eval `(start-process ,process-name ,process-buffer ,@cmd-list)))))
1013
1014 (defun org-link-beautify--preview-url (type path start end)
1015   "Preview PATH with web page screenshot between START and END."
1016   (let* ((url (concat type ":" path))
1017          (thumbnails-dir (org-link-beautify--get-thumbnails-dir-path (buffer-file-name)))
1018          (thumbnail-filename (format "org-link-beautify URL screenshot %s.png" (time-stamp-string)))
1019          (thumbnail-file (expand-file-name thumbnail-filename thumbnails-dir))
1020          (thumbnail-size (or org-link-beautify-url-preview-size 512)))
1021     ;; DEBUG: (message url) ; https://elpa.gnu.org/packages/kiwix.html (with `type')
1022     (org-link-beautify--ensure-thumbnails-dir thumbnails-dir)
1023     (unless (file-exists-p thumbnail-file)
1024       (pcase org-link-beautify--url-screenshot-cmd
1025         ;; TODO:
1026         ("webkit2png"
1027          (org-link-beautify--preview-url-archive url `("webkit2png" ,url "-o" ,thumbnail-file))
1028          (when (and org-link-beautify-enable-debug-p (not (file-exists-p thumbnail-file)))
1029            (org-link-beautify--notify-generate-thumbnail-failed url thumbnail-file)))
1030         ("monolith"
1031          (let* ((thumbnail-file-html (concat (file-name-sans-extension thumbnail-file) ".html"))
1032                 (thumbnail-file thumbnail-file-html)
1033                 (cmd-list `("monolith" "--no-audio" "--no-video" ,url "--output" ,thumbnail-file-html)))
1034            (message "[org-link-beautify] URL screenshot archive with 'monolith' for %s" url)
1035            (org-link-beautify--preview-url-archive url cmd-list)
1036            ;; TODO: convert archived web page to screenshot.
1037            (when (and org-link-beautify-enable-debug-p (not (file-exists-p thumbnail-file)))
1038              (org-link-beautify--notify-generate-thumbnail-failed url thumbnail-file))))))
1039     (org-link-beautify--add-text-property-marker start end)
1040     (org-link-beautify--add-keymap start end)
1041     ;; display thumbnail-file only when it exist, otherwise it will break org-mode buffer fontification.
1042     (if (file-exists-p thumbnail-file)
1043         ;; FIXME: can't display thumbnail image of HTML archive file.
1044         (org-link-beautify--display-thumbnail thumbnail-file thumbnail-size start end)
1045       'error)))
1046
1047 (defun org-link-beautify--return-icon (type path extension &optional link-element)
1048   "Return icon for the link PATH smartly based on TYPE, EXTENSION, etc."
1049   ;; Fix elisp compiler warning: Unused lexical argument `link-element'.
1050   (ignore link-element)
1051   ;; (message "DEBUG: (type) %s" type)
1052   ;; (message "DEBUG: (path) %s" path)
1053   ;; (message "DEBUG: (link-element) %s" link-element)
1054   (pcase type
1055     ("file"
1056      ;; DEBUG:
1057      ;; (message "[DEBUG] type: %s, path: %s, extension: %s" type path extension)
1058      (cond
1059       ;; FIXME: avoid other remote link like /docker: caused `file-exists-p' suspend Emacs.
1060       ;; make sure the link prefix is `file'.
1061       ;; ((not (file-exists-p (expand-file-name path))) ; not exist file!
1062       ;;  (nerd-icons-codicon "nf-cod-error" :face 'nerd-icons-red-alt))
1063       ((file-directory-p path)          ; directory
1064        (nerd-icons-octicon "nf-oct-file_directory" :face (org-link-beautify--warning-face-p path)))
1065       ((file-remote-p path)             ; remote file
1066        (nerd-icons-codicon "nf-cod-remote_explorer" :face 'nerd-icons-lred))
1067       ;; special file types
1068       ;; ((equal (file-name-extension path) "ipynb")
1069       ;;  (nerd-icons-icon-for-file "file.ipynb"))
1070       ;; other file types
1071       (t (nerd-icons-icon-for-file path))))
1072     ("file+sys" (nerd-icons-mdicon "nf-md-file_cog_outline" :face 'nerd-icons-lred))
1073     ("file+emacs" (nerd-icons-icon-for-mode 'emacs-lisp-mode))
1074     ("http" (nerd-icons-icon-for-url (concat "http:" path)))
1075     ("https" (nerd-icons-icon-for-url (concat "https:" path)))
1076     ("ftp" (nerd-icons-mdicon "nf-md-file_link_outline" :face 'nerd-icons-orange))
1077     ("telnet" (nerd-icons-mdicon "nf-md-link_box_variant_outline" :face 'nerd-icons-blue))
1078     ("custom-id" (nerd-icons-mdicon "nf-md-text_box_search_outline" :face 'nerd-icons-blue))
1079     ("id" (nerd-icons-mdicon "nf-md-text_search" :face 'nerd-icons-blue))
1080     ("coderef" (nerd-icons-codicon "nf-cod-references" :face 'nerd-icons-cyan))
1081     ("attachment" (nerd-icons-mdicon "nf-md-attachment" :face 'nerd-icons-lorange))
1082     ("elisp" (nerd-icons-icon-for-file "file.el"))
1083     ("eshell" (nerd-icons-icon-for-mode 'eshell-mode))
1084     ("shell" (nerd-icons-icon-for-mode 'shell-mode))
1085     ("man" (nerd-icons-mdicon "nf-md-file_document_outline" :face 'nerd-icons-lblue))
1086     ("info" (nerd-icons-mdicon "nf-md-information_outline" :face 'nerd-icons-lblue))
1087     ("help" (nerd-icons-mdicon "nf-md-help_circle_outline" :face 'nerd-icons-lblue))
1088     ;; Org Mode external link types
1089     ("eaf" (nerd-icons-mdicon "nf-md-apps" :face 'nerd-icons-blue)) ; emacs-application-framework
1090     ("eww" (nerd-icons-icon-for-mode 'eww-mode))
1091     ("chrome" (nerd-icons-mdicon "nf-md-google_chrome" :face 'nerd-icons-lorange))
1092     ("mu4e" (nerd-icons-mdicon "nf-md-email_search_outline" :face 'nerd-icons-blue))
1093     ("news" (nerd-icons-mdicon "nf-md-newspaper_variant_outline" :face 'nerd-icons-dgreen))
1094     ("git" (nerd-icons-mdicon "nf-md-git" :face 'nerd-icons-lred))
1095     ("orgit" (nerd-icons-faicon "nf-fa-git" :face 'nerd-icons-red))
1096     ("orgit-rev" (nerd-icons-devicon "nf-dev-git_commit" :face 'nerd-icons-silver))
1097     ("orgit-log" (nerd-icons-octicon "nf-oct-diff" :face 'nerd-icons-silver))
1098     ("pdf" (nerd-icons-icon-for-file "file.pdf"))
1099     ("nov" (nerd-icons-icon-for-file "file.epub")) ; for Emacs package "nov.el" link type `nov:'
1100     ("grep" (nerd-icons-mdicon "nf-md-selection_search" :face 'nerd-icons-green))
1101     ("occur" (nerd-icons-mdicon "nf-md-selection_multiple" :face 'nerd-icons-green))
1102     ("rss" (nerd-icons-mdicon "nf-md-rss" :face 'nerd-icons-lorange))
1103     ("elfeed" (nerd-icons-mdicon "nf-md-rss" :face 'nerd-icons-green))
1104     ("wikipedia" (nerd-icons-mdicon "nf-md-wikipedia" :face 'nerd-icons-dsilver))
1105     ("mailto" (nerd-icons-mdicon "nf-md-email_send_outline" :face 'nerd-icons-lblue))
1106     ("irc" (nerd-icons-mdicon "nf-md-chat" :face 'nerd-icons-blue-alt))
1107     ("doi" (nerd-icons-mdicon "nf-md-file_document_plus_outline" :face 'nerd-icons-green))
1108     ("org-contact" (nerd-icons-mdicon "nf-md-contacts_outline" :face 'nerd-icons-purple-alt))
1109     ("org-bookmark" (nerd-icons-mdicon "nf-md-bookmark_check_outline" :face 'nerd-icons-blue-alt))
1110     ("video" (nerd-icons-faicon "nf-fa-file_video_o" :face 'nerd-icons-blue))
1111     ("audio" (nerd-icons-faicon "nf-fa-file_audio_o" :face 'nerd-icons-blue))
1112     ;; org-media-note link types
1113     ("videocite" (nerd-icons-faicon "nf-fa-file_video_o" :face 'nerd-icons-blue-alt))
1114     ("audiocite" (nerd-icons-faicon "nf-fa-file_audio_o" :face 'nerd-icons-blue-alt))
1115     ("javascript" (nerd-icons-mdicon "nf-md-language_javascript" :face 'nerd-icons-yellow))
1116     ("js" (nerd-icons-mdicon "nf-md-language_javascript" :face 'nerd-icons-yellow))
1117     ("vscode" (nerd-icons-mdicon "nf-md-microsoft_visual_studio_code" :face 'nerd-icons-blue-alt))
1118
1119     ;; `org-element-context' will return "fuzzy" type when link not recognized.
1120     ("fuzzy"
1121      (when (string-match "\\([^:]*\\):\\(.*\\)" path) ; extract the "real" link type for "fuzzy" type in :path.
1122        (let ((real-type (match-string 1 path)))
1123          (pcase real-type
1124            ;; (link (:standard-properties [92824 nil 92863 92940 92942 0 nil nil nil nil nil nil ...] :type "fuzzy" :type-explicit-p nil :path "mu4e:msgid:m2zgotun61.fsf@numbchild" :format bracket :raw-link "mu4e:msgid:m2zgotun61.fsf@numbchild" ...))
1125            ("mu4e" (nerd-icons-mdicon "nf-md-email_search_outline" :face 'nerd-icons-blue))
1126            (_
1127             ;; DEBUG:
1128             (message "[org-link-beautify] type: %s, path: %s, extension: %s, link-element: %s" type path extension link-element))))))
1129
1130     (_
1131      ;; DEBUG
1132      (message "[org-link-beautify] type: %s, path: %s, extension: %s, link-element: %s" type path extension link-element)
1133      ;; handle when returned link type is `nil'.
1134      (nerd-icons-mdicon "nf-md-progress_question" :face 'nerd-icons-lyellow))))
1135
1136 (defface org-link-beautify-link-decorator-face
1137   `((t :foreground ,(color-lighten-name (face-foreground 'shadow) 2)
1138        :underline nil))
1139   "Face for org-link-beautify link decorator."
1140   :group 'org-link-beautify)
1141
1142 (defface org-link-beautify-link-description-face
1143   '((t :inherit 'org-link))
1144   "Face for org-link-beautify link description."
1145   :group 'org-link-beautify)
1146
1147 (defface org-link-beautify-link-icon-face
1148   '((t :foreground "gray" :height 95))
1149   "Face for org-link-beautify link icon."
1150   :group 'org-link-beautify)
1151
1152 (defun org-link-beautify--display-icon (start end description icon)
1153   "Display ICON for link on START and END with DESCRIPTION."
1154   (put-text-property
1155    start end
1156    'display
1157    (concat
1158     (propertize "[" 'face 'org-link-beautify-link-decorator-face)
1159     (propertize description 'face 'org-link-beautify-link-description-face)
1160     (propertize "]" 'face 'org-link-beautify-link-decorator-face)
1161     (propertize "⌈" 'face 'org-link-beautify-link-decorator-face)
1162     (propertize icon 'face `(:inherit ,(or (plist-get (get-text-property 0 'face icon) :inherit)
1163                                            'org-link-beautify-link-icon-face)
1164                                       :underline nil))
1165     (propertize "⌋" 'face 'org-link-beautify-link-decorator-face))))
1166
1167 (defun org-link-beautify--display-not-exist (start end description icon)
1168   "Display error color and ICON on START and END with DESCRIPTION."
1169   (put-text-property
1170    start end
1171    'display
1172    (concat
1173     (propertize "[" 'face '(:inherit nil :underline nil :foreground "black"))
1174     (propertize description 'face '(:underline t :foreground "red" :strike-through t))
1175     (propertize "]" 'face '(:inherit nil :underline nil :foreground "black"))
1176     (propertize "(" 'face '(:inherit nil :underline nil :foreground "black"))
1177     (propertize icon 'face '(:inherit nil :underline nil :foreground "orange red"))
1178     (propertize ")" 'face '(:inherit nil :underline nil :foreground "black")))))
1179
1180 (defun org-link-beautify-display (start end path bracket-p)
1181   "Display icon for the link type based on PATH from START to END."
1182   ;; DEBUG:
1183   ;; (message
1184   ;;  (format "start: %s, end: %s, path: %s, bracket-p: %s" start end path bracket-p))
1185   ;; detect whether link is normal, skip other links in special places.
1186   (let ((link-element (org-link-beautify--get-element start))
1187         ;; DEBUG:
1188         ;; (link-element-debug (message link-element))
1189         )
1190     (when (eq (car link-element) 'link)
1191       (save-match-data
1192         (let* ((raw-link (org-element-property :raw-link link-element))
1193                ;; DEBUG:
1194                ;; (raw-link-debug (print raw-link))
1195                (type (org-element-property :type link-element))
1196                ;; DEBUG:
1197                ;; (type-debug (message path))
1198                (path (org-element-property :path link-element))
1199                ;; DEBUG:
1200                ;; (type-debug (message type))
1201                (extension (or (file-name-extension (org-link-unescape path)) "txt"))
1202                ;; the search part behind link separator "::"
1203                (search-option (org-element-property :search-option link-element))
1204                ;; DEBUG: (ext-debug (message extension))
1205                (description (or (and (org-element-property :contents-begin link-element) ; in raw link case, it's nil
1206                                      (buffer-substring-no-properties
1207                                       (org-element-property :contents-begin link-element)
1208                                       (org-element-property :contents-end link-element)))
1209                                 ;; when description not exist, use raw link for raw link case.
1210                                 raw-link))
1211                ;; DEBUG: (desc-debug (print description))
1212                (icon (org-link-beautify--return-icon type path extension link-element))
1213                ;; DEBUG:
1214                ;; (icon-debug (print icon))
1215                )
1216           ;; Fix elisp compiler warning: Unused lexical argument `bracket-p'.
1217           (ignore bracket-p)
1218           (cond
1219            ;; image thumbnail preview
1220            ;; [[file:/path/to/image.jpg]]
1221            ((and org-link-beautify-image-preview
1222                  (member type '("file" "attachment"))
1223                  (cond
1224                   ((member type '("file" "image"))
1225                    (file-exists-p path))
1226                   ((string-equal type "attachment")
1227                    (file-exists-p (expand-file-name (org-link-unescape path) (org-attach-dir)))))
1228                  (member extension org-link-beautify-image-preview-list))
1229             ;; DEBUG:
1230             ;; (user-error "[org-link-beautify] cond -> image file")
1231             (when (eq (org-link-beautify--preview-image type path start end) 'error)
1232               ;; Display icon if thumbnail not available.
1233               (org-link-beautify--add-text-property-marker start end)
1234               (org-link-beautify--add-keymap start end)
1235               (org-link-beautify--display-icon start end description icon)))
1236
1237            ;; video thumbnail preview
1238            ;; [[file:/path/to/video.mp4]]
1239            ;; [[video:/path/to/video.mp4]]
1240            ((and org-link-beautify-video-preview
1241                  (member type '("file" "video" "attachment"))
1242                  (cond
1243                   ((member type '("file" "video"))
1244                    (file-exists-p path))
1245                   ((string-equal type "attachment")
1246                    (file-exists-p (expand-file-name (org-link-unescape path) (org-attach-dir)))))
1247                  (member extension org-link-beautify-video-preview-list))
1248             ;; DEBUG:
1249             ;; (user-error "[org-link-beautify] cond -> video file")
1250             (when (eq (org-link-beautify--preview-video type path start end) 'error)
1251               ;; Display icon if thumbnail not available.
1252               (org-link-beautify--add-text-property-marker start end)
1253               (org-link-beautify--add-keymap start end)
1254               (org-link-beautify--display-icon start end description icon)))
1255
1256            ;; subtitle, closed caption preview
1257            ;; [[file:/path/to/subtitle.ass]]
1258            ;; [[file:/path/to/subtitle.srt]]
1259            ((and org-link-beautify-subtitle-preview
1260                  (member type '("file"))
1261                  (file-exists-p path)
1262                  (member extension org-link-beautify-subtitle-preview-list))
1263             ;; DEBUG:
1264             ;; (user-error "[org-link-beautify] cond -> subtitle file")
1265             (when (eq (org-link-beautify--preview-subtitle path start end) 'error)
1266               ;; Display icon if thumbnail not available.
1267               (org-link-beautify--add-text-property-marker start end)
1268               (org-link-beautify--add-keymap start end)
1269               (org-link-beautify--display-icon start end description icon)))
1270
1271            ;; audio wave form preview
1272            ;; [[file:/path/to/audio.mp3]]
1273            ;; [[audio:/path/to/audio.mp3]]
1274            ((and org-link-beautify-audio-preview
1275                  (member type '("file" "audio"))
1276                  (cond
1277                   ((member type '("file" "audio"))
1278                    (file-exists-p path))
1279                   ((string-equal type "attachment")
1280                    (file-exists-p (expand-file-name (org-link-unescape path) (org-attach-dir)))))
1281                  (member extension org-link-beautify-audio-preview-list))
1282             ;; DEBUG:
1283             ;; (user-error "[org-link-beautify] cond -> audio file")
1284             (when (eq (org-link-beautify--preview-audio type path start end) 'error)
1285               ;; Display icon if thumbnail not available.
1286               (org-link-beautify--add-text-property-marker start end)
1287               (org-link-beautify--add-keymap start end)
1288               (org-link-beautify--display-icon start end description icon)))
1289
1290            ;; PDF file preview
1291            ;; [[file:/path/to/filename.pdf]]
1292            ;; [[pdf:/path/to/filename.pdf::15]]
1293            ;; [[pdfview:/path/to/filename.pdf::15]]
1294            ((and org-link-beautify-pdf-preview
1295                  (or (and (equal type "file") (string= extension "pdf"))
1296                      (member type '("pdf" "pdfview" "docview" "eaf")))
1297                  (file-exists-p path))
1298             ;; DEBUG:
1299             ;; (user-error "[org-link-beautify] cond -> PDF file")
1300             ;; (message "org-link-beautify: PDF file previewing [%s], link-type: [%s], search-option: [%s] (type: %s)," path type search-option (type-of search-option))
1301             (when (eq (org-link-beautify--preview-pdf
1302                        (if (equal type "eaf") (replace-regexp-in-string "pdf::" "" path) path)
1303                        start end
1304                        search-option)
1305                       'error)
1306               ;; Display icon if thumbnail not available.
1307               (org-link-beautify--add-text-property-marker start end)
1308               (org-link-beautify--add-keymap start end)
1309               (org-link-beautify--display-icon start end description icon)))
1310
1311            ;; EPUB file cover preview
1312            ((and org-link-beautify-epub-preview
1313                  (equal type "file")
1314                  (file-exists-p path)
1315                  (string= extension "epub"))
1316             ;; DEBUG:
1317             ;; (user-error "[org-link-beautify] cond -> epub file")
1318             (when (eq (org-link-beautify--preview-epub path start end) 'error)
1319               ;; Display icon if thumbnail not available.
1320               (org-link-beautify--add-text-property-marker start end)
1321               (org-link-beautify--add-keymap start end)
1322               (org-link-beautify--display-icon start end description icon)))
1323
1324            ;; kindle ebook file cover preview
1325            ((and org-link-beautify-kindle-preview
1326                  (equal type "file")
1327                  (file-exists-p path)
1328                  (member extension '("mobi" "azw3")))
1329             ;; DEBUG:
1330             ;; (user-error "[org-link-beautify] cond -> epub file")
1331             (when (eq (org-link-beautify--preview-kindle path start end) 'error)
1332               ;; Display icon if thumbnail not available.
1333               (org-link-beautify--add-text-property-marker start end)
1334               (org-link-beautify--add-keymap start end)
1335               (org-link-beautify--display-icon start end description icon)))
1336
1337            ;; CDisplay Archived Comic Book Formats cover preview
1338            ((and org-link-beautify-comic-preview
1339                  (equal type "file")
1340                  (file-exists-p path)
1341                  (member extension '("cbr" "cbz" "cb7" "cba")))
1342             ;; DEBUG:
1343             ;; (user-error "[org-link-beautify] cond -> comic file")
1344             (when (eq (org-link-beautify--preview-comic path start end) 'error)
1345               ;; Display icon if thumbnail not available.
1346               (org-link-beautify--add-text-property-marker start end)
1347               (org-link-beautify--add-keymap start end)
1348               (org-link-beautify--display-icon start end description icon)))
1349
1350            ;; FictionBook2 (.fb2, .fb2.zip) file cover preview
1351            ((and org-link-beautify-fictionbook2-preview
1352                  (equal type "file")
1353                  (file-exists-p path)
1354                  (or (string= extension "fb2")
1355                      (string= extension "zip")))
1356             ;; DEBUG:
1357             ;; (user-error "[org-link-beautify] cond -> FictionBook2 (.fb2, .fb2.zip) file")
1358             (when (eq (org-link-beautify--preview-fictionbook2 path start end) 'error)
1359               ;; Display icon if thumbnail not available.
1360               (org-link-beautify--add-text-property-marker start end)
1361               (org-link-beautify--add-keymap start end)
1362               (org-link-beautify--display-icon start end description icon)))
1363
1364            ;; text content preview
1365            ((and org-link-beautify-text-preview
1366                  (equal type "file")
1367                  (file-exists-p path)
1368                  (member extension org-link-beautify-text-preview-list))
1369             ;; DEBUG:
1370             ;; (user-error "[org-link-beautify] cond -> text file")
1371             (org-link-beautify--preview-text path start end))
1372
1373            ;; compressed archive file preview
1374            ((and org-link-beautify-archive-preview
1375                  (equal type "file")
1376                  (file-exists-p path)
1377                  (member extension (mapcar 'car org-link-beautify-archive-preview-command-alist)))
1378             ;; DEBUG:
1379             ;; (user-error "[org-link-beautify] cond -> archive file")
1380             ;; (if (null extension)
1381             ;;     (user-error "[org-link-beautify] archive file preview> extension: %s" extension))
1382             ;; (message "[org-link-beautify] archive file preview> path: %s" path)
1383             (let ((command (cdr (assoc extension org-link-beautify-archive-preview-command-alist))))
1384               (org-link-beautify--preview-archive path command start end)))
1385
1386            ;; file does not exist
1387            ((and (equal type "file") (not (file-exists-p path)))
1388             ;; DEBUG:
1389             ;; (user-error "[org-link-beautify] cond -> file")
1390             ;; (message path)
1391             (org-link-beautify--add-text-property-marker start end)
1392             (org-link-beautify--display-not-exist start end description icon))
1393
1394            ;; URL
1395            ((and org-link-beautify-url-preview (org-url-p (concat type path)))
1396             (org-link-beautify--preview-url type path start end))
1397
1398            ;; general icons
1399            (t
1400             ;; DEBUG:
1401             ;; (user-error "[org-link-beautify] cond -> t")
1402             ;; (message "start: %d, end: %d, description: %s, icon: %s" start end description icon)
1403             (org-link-beautify--add-text-property-marker start end)
1404             (org-link-beautify--add-keymap start end)
1405             (org-link-beautify--display-icon start end description icon))))))))
1406
1407 (defun org-link-beautify-display-async (start end path bracket-p)
1408   "Run function `org-link-beautify-display' in async thread to avoid suspend Emacs."
1409   ;; DEBUG: (message "[org-link-beautify] running preview function in async thread for %s" path)
1410   (make-thread
1411    (lambda () (org-link-beautify-display start end path bracket-p))
1412    (make-temp-name "org-link-beautify-display-thread-")))
1413
1414 ;;; hook on headline expand
1415 (defun org-link-beautify-headline-cycle (&optional state)
1416   "Function to be executed on `org-cycle-hook' STATE."
1417   (pcase state
1418     ('subtree (org-link-beautify--refontify state))
1419     ('children (org-link-beautify--refontify state))
1420     ('folded (org-link-beautify--clear state))
1421     ('overview (org-link-beautify--clear state))
1422     (_ (ignore))))
1423
1424 (defun org-link-beautify--refontify (&optional state)
1425   ;; replace the whole Org buffer font-lock function `org-restart-font-lock'
1426   ;; with a lightweight `jit-lock-refontify' current headline scope only
1427   ;; font-lock function.
1428   (when (or (eq state 'children) (eq state 'subtree))
1429     (org-link-beautify--subtree-scope-wrap
1430      (jit-lock-refontify begin end))))
1431
1432 ;;; toggle org-link-beautify text-properties
1433 (defun org-link-beautify--clear-text-properties (&optional begin end)
1434   "Clear all org-link-beautify text-properties between BEGIN and END.
1435 If BEGIN and END is ommited, the default value is `point-min' and `point-max'."
1436   (let ((point (or begin (point-min)))
1437         (bmp (buffer-modified-p)))
1438     (while (setq point (next-single-property-change point 'display))
1439       (when (and (< point (or end (point-max)))
1440                  (get-text-property point 'display)
1441                  (eq (get-text-property point 'type) 'org-link-beautify))
1442         (remove-text-properties
1443              point (setq point (next-single-property-change point 'display))
1444              '(display t))))
1445     (set-buffer-modified-p bmp)))
1446
1447 (defun org-link-beautify--clear (&optional state)
1448   "Clear the text-properties of `org-link-beautify' under STATE headline subtree."
1449   (cond
1450    ((eq state 'folded)
1451     ;; clear in current folded headline
1452     (org-link-beautify--subtree-scope-wrap
1453      (org-link-beautify--clear-text-properties begin end)))
1454    ((eq state 'overview)
1455     ;; clear whole buffer
1456     (org-link-beautify--clear-text-properties))
1457    (t
1458     ;; clear whole buffer when minor mode disabled.
1459     (org-link-beautify--clear-text-properties))))
1460
1461 (defvar org-link-beautify-keymap (make-sparse-keymap))
1462
1463 (defun org-link-beautify--add-keymap (start end)
1464   "Add keymap on link text-property. between START and END."
1465   (put-text-property start end 'keymap org-link-beautify-keymap))
1466
1467 (defun org-link-beautify-open-at-point ()
1468   "Execute `org-open-at-point' only in `org-mode'."
1469   (interactive)
1470   (when (eq major-mode 'org-mode)
1471     (org-open-at-point)))
1472
1473 (define-key org-link-beautify-keymap (kbd "RET") 'org-link-beautify-open-at-point)
1474 (define-key org-link-beautify-keymap [mouse-1] 'org-link-beautify-open-at-point)
1475 (define-key org-link-beautify-keymap (kbd "<mouse-1>") 'org-link-beautify-open-at-point)
1476
1477 (defun org-link-beautify-copy-file-to-clipboard (file)
1478   "Copy the FILE on path to clipboard.
1479 The argument FILE must be the absolute path."
1480   (cl-case system-type
1481     (darwin
1482      (do-applescript
1483       (format "tell app \"Finder\" to set the clipboard to ( POSIX file \"%s\" )" file)))
1484     ;; TODO:
1485     (gnu/linux )
1486     ;; TODO:
1487     (windows-nt ))
1488   (message "Copied file [%s] to system clipboard."
1489            (string-truncate-left file (/ (window-width) 2))))
1490
1491 (defun org-link-beautify-copy-file (&optional args)
1492   "Copy the Org link file at point."
1493   (interactive "P")
1494   (when (derived-mode-p 'org-mode)
1495     (if (or (region-active-p) mark-active)
1496         (let ((region-text (buffer-substring-no-properties
1497                             (region-beginning) (region-end))))
1498           (kill-new region-text)
1499           (deactivate-mark))
1500       (let ((element (org-element-context)))
1501         (if (and (eq (car element) 'link)
1502                  (string-equal (org-element-property :type element) "file"))
1503             (let ((file-path (expand-file-name (org-element-property :path element))))
1504               (org-link-beautify-copy-file-to-clipboard file-path))
1505           (message "[org-link-beautify] No action executed on link."))))))
1506
1507 (define-key org-link-beautify-keymap (kbd "M-w") 'org-link-beautify-copy-file)
1508
1509 (defun org-link-beautify-display-qrcode-for-url (&optional args)
1510   "Display QR code for Org link at point in new buffer in ARGS."
1511   (interactive)
1512   (when (derived-mode-p 'org-mode)
1513     (if-let ((url (org-element-property-raw :raw-link (org-element-context))))
1514         (if (require 'qrencode nil t)
1515             (qrencode-string url)
1516           (package-install 'qrencode)
1517           (qrencode-string url))
1518       (if (or (region-active-p) mark-active)
1519           (org-fill-paragraph t t)
1520         (org-fill-paragraph)))))
1521
1522 (define-key org-link-beautify-keymap (kbd "M-q") 'org-link-beautify-display-qrcode-for-url)
1523
1524 (defun org-link-beautify-goto-file-in-dired ()
1525   "Open Dired and goto the link file position."
1526   (interactive)
1527   (when (derived-mode-p 'org-mode)
1528     (let* ((file-path (org-element-property :path (org-element-context)))
1529            (file-name (file-name-nondirectory file-path)))
1530       (org-attach-reveal)
1531       (search-forward file-name)
1532       (dired-move-to-filename) ; move point to beginning of filename.
1533       (if (and (featurep 'dwim-shell-command) (featurep 'dwim-shell-commands))
1534           (progn
1535             (message "Jumped to position of link file, now you can execute `dwim-shell-command' commands")
1536             (execute-extended-command nil (read-extended-command-1 nil "dwim-shell-commands")))
1537         (user-error "Jumped to position of link file.
1538 Package `dwim-shell-command' is missing, please install it")))))
1539
1540 ;;;###autoload
1541 (defun org-link-beautify-enable ()
1542   "Enable `org-link-beautify'."
1543   (when (display-graphic-p)
1544     (dolist (link-type (mapcar #'car org-link-parameters))
1545       (if org-link-beautify-async-preview
1546           (org-link-set-parameters link-type :activate-func #'org-link-beautify-display-async)
1547         (org-link-set-parameters link-type :activate-func #'org-link-beautify-display)))
1548     (add-hook 'org-cycle-hook #'org-link-beautify-headline-cycle)
1549     (org-restart-font-lock)
1550     ;; Support mouse left click on image to open link.
1551     (make-local-variable 'image-map)
1552     (define-key image-map (kbd "<mouse-1>") 'org-open-at-point)))
1553
1554 ;;;###autoload
1555 (defun org-link-beautify-disable ()
1556   "Disable `org-link-beautify'."
1557   (dolist (link-type (mapcar #'car org-link-parameters))
1558     (org-link-set-parameters link-type :activate-func t))
1559   (remove-hook 'org-cycle-hook #'org-link-beautify-headline-cycle)
1560   (org-link-beautify--clear))
1561
1562 ;;;###autoload
1563 (define-minor-mode org-link-beautify-mode
1564   "A minor mode to beautify Org Mode links with icons, and inline preview etc."
1565   :group 'org-link-beautify
1566   :global nil
1567   :init-value nil
1568   :lighter nil
1569   :keymap org-link-beautify-keymap
1570   (if org-link-beautify-mode
1571       (org-link-beautify-enable)
1572     (org-link-beautify-disable)))
1573
1574 \f
1575
1576 (provide 'org-link-beautify)
1577
1578 ;;; org-link-beautify.el ends here