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 "27.1") (all-the-icons "5.0.0"))
   5 ;; Version: 1.2.2
   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 ;; (org-link-beautify-mode 1)
  28
  29 ;;; Code:
  30 \f
  31 (require 'ol)
  32 (require 'org)
  33 (require 'org-element)
  34 (require 'org-crypt)
  35 (require 'all-the-icons)
  36 (require 'color)
  37 (require 'cl-lib)
  38
  39 (defgroup org-link-beautify nil
  40   "Customize group of org-link-beautify-mode."
  41   :prefix "org-link-beautify-"
  42   :group 'org)
  43
  44 (defcustom org-link-beautify-condition-functions '(org-link-beautify--filter-org-mode
  45                                                    org-link-beautify--filter-larg-file)
  46   "A list of functions to be executed as condition before really activate `org-link-beautify'.
  47 Only if all functions evaluated as TRUE, then processed."
  48   :type 'list
  49   :safe #'listp)
  50
  51 (defcustom org-link-beautify-video-preview (or (executable-find "ffmpegthumbnailer")
  52                                                (executable-find "qlmanage")
  53                                                (executable-find "ffmpeg"))
  54   "Whether enable video files thumbnail preview?"
  55   :type 'boolean
  56   :safe #'booleanp
  57   :group 'org-link-beautify)
  58
  59 (defcustom org-link-beautify-thumbnails-dir 'source-path
  60   "The directory of generated thumbnails.
  61
  62 By default the thumbnails are generated in source file path’s
  63 .thumbnails directory. This is better for avoiding re-generate
  64 preview thumbnails. Or you can set this option to ‘'user-home’
  65 which represent to ~/.cache/thumbnails/."
  66   :type 'symbol
  67   :safe #'symbolp
  68   :group 'org-link-beautify)
  69
  70 (defcustom org-link-beautify-video-preview-size 512
  71   "The video thumbnail image size."
  72   :type 'number
  73   :safe #'numberp
  74   :group 'org-link-beautify)
  75
  76 (defcustom org-link-beautify-video-preview-list
  77   '("avi" "rmvb" "ogg" "ogv" "mp4" "mkv" "mov" "m4v" "webm" "flv")
  78   "A list of video file types be supported with thumbnails."
  79   :type 'list
  80   :safe #'listp
  81   :group 'org-link-beautify)
  82
  83 (defcustom org-link-beautify-audio-preview (or (executable-find "audiowaveform")
  84                                                (executable-find "qlmanage"))
  85   "Whether enable audio files wave form preview?"
  86   :type 'boolean
  87   :safe #'booleanp
  88   :group 'org-link-beautify)
  89
  90 (defcustom org-link-beautify-audio-preview-list '("mp3" "wav" "flac" "ogg" "dat")
  91   "A list of audio file types be supported generating audio wave form image."
  92   :type 'list
  93   :safe #'listp
  94   :group 'org-link-beautify)
  95
  96 (defcustom org-link-beautify-audio-preview-size 150
  97   "The audio wave form image size."
  98   :type 'number
  99   :safe #'numberp
 100   :group 'org-link-beautify)
 101
 102 (defcustom org-link-beautify-pdf-preview (or (executable-find "pdftocairo")
 103                                              (executable-find "pdf2svg"))
 104   "Whether enable PDF files image preview?
 105 If command \"pdftocairo\" or \"pdf2svg\" is available, enable PDF
 106 preview by default. You can set this option to nil to disable
 107 PDF preview."
 108   :type 'boolean
 109   :safe #'booleanp
 110   :group 'org-link-beautify)
 111
 112 (defcustom org-link-beautify-pdf-preview-command 'pdftocairo
 113   "The command used to preview PDF file cover."
 114   :type '(choice
 115           :tag "The command used to preview PDF cover."
 116           (const :tag "pdftocairo" pdftocairo)
 117           (const :tag "pdf2svg" pdf2svg))
 118   :safe #'symbolp
 119   :group 'org-link-beautify)
 120
 121 ;;; TODO: smarter value decided based on screen size.
 122 (defcustom org-link-beautify-pdf-preview-size 512
 123   "The PDF preview image size."
 124   :type 'number
 125   :safe #'numberp
 126   :group 'org-link-beautify)
 127
 128 (defcustom org-link-beautify-pdf-preview-default-page-number 1
 129   "The default PDF preview page number."
 130   :type 'number
 131   :safe #'numberp
 132   :group 'org-link-beautify)
 133
 134 (defcustom org-link-beautify-pdf-preview-image-format 'png
 135   "The format of PDF file preview image."
 136   :type '(choice
 137           :tag "The format of PDF file preview image."
 138           (const :tag "PNG" png)
 139           (const :tag "JPEG" jpeg)
 140           (const :tag "SVG" svg))
 141   :safe #'symbolp
 142   :group 'org-link-beautify)
 143
 144 (defcustom org-link-beautify-epub-preview
 145   (cl-case system-type
 146     ('gnu/linux (executable-find "gnome-epub-thumbnailer"))
 147     ('darwin (executable-find "epub-thumbnailer")))
 148   "Whether enable EPUB files cover preview?
 149 If command \"gnome-epub-thumbnailer\" is available, enable EPUB
 150 preview by default. You can set this option to nil to disable
 151 EPUB preview."
 152   :type 'boolean
 153   :safe #'booleanp
 154   :group 'org-link-beautify)
 155
 156 (defcustom org-link-beautify-epub-preview-size nil
 157   "The EPUB cover preview image size."
 158   :type 'number
 159   :safe #'numberp
 160   :group 'org-link-beautify)
 161
 162 (defcustom org-link-beautify-text-preview nil
 163   "Whether enable text files content preview?"
 164   :type 'boolean
 165   :safe #'booleanp
 166   :group 'org-link-beautify)
 167
 168 (defcustom org-link-beautify-text-preview-list
 169   '("org" "txt" "markdown" "md"
 170     "lisp" "scm" "clj" "cljs"
 171     "py" "rb" "pl"
 172     "c" "cpp" "h" "hpp" "cs" "java"
 173     "r" "jl")
 174   "A list of link types supports text preview below the link."
 175   :type 'list
 176   :safe #'listp
 177   :group 'org-link-beautify)
 178
 179 (defcustom org-link-beautify-archive-preview nil
 180   "Whether enable archive inside files list preview?"
 181   :type 'boolean
 182   :safe #'booleanp
 183   :group 'org-link-beautify)
 184
 185 (defcustom org-link-beautify-archive-preview-alist
 186   '(("zip" . "unzip -l")
 187     ("rar" . "unrar l")
 188     ("7z" . "7z l -ba") ; -ba - suppress headers; undocumented.
 189     ("gz" . "gzip --list")
 190     ;; ("bz2" . "")
 191     ("tar" . "tar --list")
 192     ("tar.gz" . "tar --gzip --list")
 193     ("tar.bz2" . "tar --bzip2 --list")
 194     ("xz" . "xz --list")
 195     ("zst" . "zstd --list"))
 196   "An alist of archive types supported archive preview inside files list.
 197 Each element has form (ARCHIVE-FILE-EXTENSION COMMAND)."
 198   :type '(alist :value-type (group string))
 199   :group 'org-link-beautify)
 200
 201 (defcustom org-link-beautify-archive-preview-command (executable-find "7z")
 202   "The command to list out files inside archive file."
 203   :type 'string
 204   :safe #'stringp
 205   :group 'org-link-beautify)
 206
 207 (defcustom org-link-beautify-enable-debug-p nil
 208   "Whether enable org-link-beautify print debug info."
 209   :type 'boolean
 210   :safe #'booleanp)
 211
 212 ;;; Helper functions
 213
 214 ;;; Invoke external Python script file or code.
 215 (defcustom org-link-beautify-python-interpreter (executable-find "python3")
 216   "Specify the Python interpreter to run org-link-beautify python scripts or code."
 217   :type 'string
 218   :safe #'stringp)
 219
 220 (defun org-link-beautify--python-script-run (python-script-file)
 221   "Run Python script file through shell command."
 222   (shell-command-to-string
 223    (format "%s %s" org-link-beautify-python-interpreter python-script-file)))
 224
 225 (defun org-link-beautify--python-command-to-string (&rest code-lines)
 226   "Run Python code lines through shell command."
 227   (shell-command-to-string
 228    (concat "python -c "
 229            ;; solve double quote character issue.
 230            "\"" (string-replace "\"" "\\\"" (string-join code-lines "\n")) "\"")))
 231
 232 ;;; e.g.
 233 ;; (org-link-beautify--python-command-to-string
 234 ;;  "import numpy as np"
 235 ;;  "print(np.arange(6))"
 236 ;;  "print(\"blah blah\")"
 237 ;;  "print('{}'.format(3))")
 238
 239 ;;; Common functions
 240 (defun org-link-beautify--get-element (position)
 241   "Return the org element of link at the `POSITION'."
 242   (save-excursion
 243     (goto-char position)
 244     ;; Parse link at point, if any. replace (org-element-context) to improve performance.
 245     (org-element-link-parser)))
 246
 247 (defun org-link-beautify--get-link-description-fast (position)
 248   "Get the link description at `POSITION' (fuzzy but faster version)."
 249   (save-excursion
 250     (goto-char position)
 251     (and (org-in-regexp org-link-bracket-re) (match-string 2))))
 252
 253 (defun org-link-beautify--warning-face-p (path)
 254   "Use `org-warning' face if link PATH does not exist."
 255   (if (and (not (file-remote-p path))
 256            (file-exists-p (expand-file-name path)))
 257       'org-link 'org-warning))
 258
 259 (defun org-link-beautify--notify-generate-thumbnail-failed (source-file thumbnail-file)
 260   "Notify user that org-link-beautify generating thumbnail file failed."
 261   (message
 262    "[org-link-beautify] For file %s.\nCreate thumbnail %s failed."
 263    source-file thumbnail-file))
 264
 265 (defun org-link-beautify--add-overlay-marker (start end)
 266   "Add 'org-link-beautify on link text-property. between START and END."
 267   (put-text-property start end 'type 'org-link-beautify))
 268
 269 (defun org-link-beautify--get-thumbnails-dir-path (file)
 270   "Return the FILE thumbnail directory's path."
 271   (cl-case org-link-beautify-thumbnails-dir
 272     ('source-path
 273      (concat (file-name-directory file) ".thumbnails/"))
 274     ('user-home
 275      (expand-file-name "~/.cache/thumbnails/"))))
 276
 277 (defun org-link-beautify--ensure-thumbnails-dir (thumbnails-dir)
 278   "Ensure THUMBNAILS-DIR exist, if not ,create it."
 279   (unless (file-directory-p thumbnails-dir)
 280     (make-directory thumbnails-dir)))
 281
 282 (defun org-link-beautify--display-thumbnail (thumbnail thumbnail-size start end)
 283   "Display THUMBNAIL between START and END with size THUMBNAIL-SIZE when exist."
 284   (when (file-exists-p thumbnail)
 285     (put-text-property
 286      start end
 287      'display (create-image thumbnail nil nil :ascent 'center :max-height thumbnail-size))
 288     ;; Support mouse left click on image to open link.
 289     (make-local-variable 'image-map)
 290     (define-key image-map (kbd "<mouse-1>") 'org-open-at-point)))
 291
 292 (defun org-link-beautify--display-content-block (content)
 293   "Display CONTENT string as a block with beautified frame border."
 294   (format
 295    "
 296 ┏━§ ✂ %s
 297 %s
 298 ┗━§ ✂ %s
 299 \n"
 300    (make-string (- fill-column 6) ?━)
 301    (mapconcat
 302     (lambda (line)
 303       (concat "┃" line))
 304     ;; split lines of content into list of lines.
 305     (split-string content "\n")
 306     "\n")
 307    (make-string (- fill-column 6) ?━)))
 308
 309
 310 ;;; Preview functions
 311 (defun org-link-beautify--preview-pdf (path start end &optional search-option)
 312   "Preview PDF file PATH and display on link between START and END."
 313   (if (string-match "\\(.*?\\)\\(?:::\\(.*\\)\\)?\\'" path)
 314       (let* ((file-path (match-string 1 path))
 315              ;; DEBUG:
 316              ;; (_ (lambda (message "--> HERE org-link-beautify (pdf): path: %s" path)))
 317              ;; (_ (lambda (message "--> HERE org-link-beautify (pdf): search-option: %s" search-option)))
 318              (pdf-page-number (if search-option
 319                                   (string-to-number
 320                                    (cond
 321                                     ((string-prefix-p "P" search-option) ; "P42"
 322                                      (substring search-option 1 nil))
 323                                     ((string-match "\\([[:digit:]]+\\)\\+\\+\\(.*\\)" search-option) ; "40++0.00"
 324                                      (match-string 1 search-option))
 325                                     (t search-option)))
 326                                 (if-let ((search-option (match-string 2 path)))
 327                                     (string-to-number
 328                                      (cond
 329                                       ((string-prefix-p "P" search-option) ; "P42"
 330                                        (substring search-option 1 nil))
 331                                       ((string-match "\\([[:digit:]]+\\)\\+\\+\\(.*\\)" search-option) ; "40++0.00"
 332                                        (match-string 1 search-option))
 333                                       (t search-option)))
 334                                   org-link-beautify-pdf-preview-default-page-number)))
 335              (pdf-file (expand-file-name (org-link-unescape file-path)))
 336              (thumbnails-dir (org-link-beautify--get-thumbnails-dir-path pdf-file))
 337              (thumbnail-file (expand-file-name
 338                               (concat
 339                                (if (= pdf-page-number 1) ; if have page number ::N specified.
 340                                    (format "%s%s.%s"
 341                                            thumbnails-dir (file-name-base pdf-file)
 342                                            (symbol-name org-link-beautify-pdf-preview-image-format))
 343                                  (format "%s%s-P%s.%s"
 344                                          thumbnails-dir (file-name-base pdf-file) pdf-page-number
 345                                          (symbol-name org-link-beautify-pdf-preview-image-format))))))
 346              (thumbnail-size (or org-link-beautify-pdf-preview-size 512)))
 347         (org-link-beautify--ensure-thumbnails-dir thumbnails-dir)
 348         (unless (file-exists-p thumbnail-file)
 349           (pcase org-link-beautify-pdf-preview-command
 350             ('pdftocairo
 351              ;; DEBUG:
 352              ;; (message
 353              ;;  "org-link-beautify: page-number %s, pdf-file %s, thumbnail-file %s"
 354              ;;  pdf-page-number pdf-file thumbnail-file)
 355              (start-process
 356               "org-link-beautify--pdf-preview"
 357               " *org-link-beautify pdf-preview*"
 358               "pdftocairo"
 359               (pcase org-link-beautify-pdf-preview-image-format
 360                 ('png "-png")
 361                 ('jpeg "-jpeg")
 362                 ('svg "-svg"))
 363               "-singlefile"
 364               "-f" (number-to-string pdf-page-number)
 365               pdf-file (file-name-sans-extension thumbnail-file))
 366              (when (and org-link-beautify-enable-debug-p (not (file-exists-p thumbnail-file)))
 367                (org-link-beautify--notify-generate-thumbnail-failed pdf-file thumbnail-file)))
 368             ('pdf2svg
 369              (unless (eq org-link-beautify-pdf-preview-image-format 'svg)
 370                (warn "The pdf2svg only supports convert PDF to SVG format.
 371 Please adjust `org-link-beautify-pdf-preview-command' to `pdftocairo' or
 372 Set `org-link-beautify-pdf-preview-image-format' to `svg'."))
 373
 374              (start-process
 375               "org-link-beautify--pdf-preview"
 376               " *org-link-beautify pdf-preview*"
 377               "pdf2svg"
 378               pdf-file thumbnail-file (number-to-string pdf-page-number))
 379              (when (and org-link-beautify-enable-debug-p (not (file-exists-p thumbnail-file)))
 380                (org-link-beautify--notify-generate-thumbnail-failed pdf-file thumbnail-file)))))
 381         (org-link-beautify--add-overlay-marker start end)
 382         (org-link-beautify--add-keymap start end)
 383         ;; display thumbnail-file only when it exist.
 384         (when (file-exists-p thumbnail-file)
 385           (org-link-beautify--display-thumbnail thumbnail-file thumbnail-size start end)))))
 386
 387 (defun org-link-beautify--preview-epub (path start end)
 388   "Preview EPUB file PATH and display on link between START and END."
 389   (if (string-match "\\(.*?\\)\\(?:::\\(.*\\)\\)?\\'" path)
 390       (let* ((file-path (match-string 1 path))
 391              ;; DEBUG: (_ (lambda (message "--> HERE")))
 392              (_epub-page-number (or (match-string 2 path) 1))
 393              (epub-file (expand-file-name (org-link-unescape file-path)))
 394              (thumbnails-dir (org-link-beautify--get-thumbnails-dir-path epub-file))
 395              (thumbnail-file (expand-file-name (format "%s%s.png" thumbnails-dir (file-name-base epub-file))))
 396              (thumbnail-size (or org-link-beautify-epub-preview-size 500)))
 397         (org-link-beautify--ensure-thumbnails-dir thumbnails-dir)
 398         ;; DEBUG:
 399         ;; (message epub-file)
 400         (unless (file-exists-p thumbnail-file)
 401           (cl-case system-type
 402             ('gnu/linux                 ; for Linux "gnome-epub-thumbnailer"
 403              (start-process
 404               "org-link-beautify--epub-preview"
 405               " *org-link-beautify epub-preview*"
 406               org-link-beautify-epub-preview
 407               epub-file thumbnail-file
 408               ;; (if org-link-beautify-epub-preview-size
 409               ;;     "--size")
 410               ;; (if org-link-beautify-epub-preview-size
 411               ;;     (number-to-string thumbnail-size))
 412               )
 413              (when (and org-link-beautify-enable-debug-p (not (file-exists-p thumbnail-file)))
 414                (org-link-beautify--notify-generate-thumbnail-failed epub-file thumbnail-file)))
 415             ('darwin                    ; for macOS "epub-thumbnailer" command
 416              ;; DEBUG
 417              ;; (message epub-file)
 418              ;; (message thumbnail-file)
 419              ;; (message (number-to-string org-link-beautify-epub-preview-size))
 420              (make-process
 421               :name "org-link-beautify--epub-preview"
 422               :command (list org-link-beautify-epub-preview
 423                              epub-file
 424                              thumbnail-file
 425                              (number-to-string thumbnail-size))
 426               :buffer " *org-link-beautify epub-preview*"
 427               :sentinel (lambda (proc event)
 428                           (message (format "> proc: %s\n> event: %s" proc event))
 429                           (when (and org-link-beautify-enable-debug-p (string= event "finished\n"))
 430                             (message "org-link-beautify epub preview Process DONE!")
 431                             (kill-buffer (process-buffer proc))
 432                             ;; (kill-process proc)
 433                             ))
 434               :stdout " *org-link-beautify epub-preview*"
 435               :stderr " *org-link-beautify epub-preview*")
 436              (when (and org-link-beautify-enable-debug-p (not (file-exists-p thumbnail-file)))
 437                (org-link-beautify--notify-generate-thumbnail-failed epub-file thumbnail-file)))
 438             (t (user-error "This system platform currently not supported by org-link-beautify.\n Please contribute code to support"))))
 439         (org-link-beautify--add-overlay-marker start end)
 440         (org-link-beautify--add-keymap start end)
 441         (org-link-beautify--display-thumbnail thumbnail-file thumbnail-size start end))))
 442
 443 (defvar org-link-beautify--preview-text--noerror)
 444
 445 (defun org-link-beautify--preview-text-file (file lines)
 446   "Return first LINES of FILE."
 447   (with-temp-buffer
 448     (condition-case nil
 449         (progn
 450           ;; I originally use `insert-file-contents-literally', so Emacs doesn't
 451           ;; decode the non-ASCII characters it reads from the file, i.e. it
 452           ;; doesn't interpret the byte sequences as Chinese characters. Use
 453           ;; `insert-file-contents' instead. In addition, this function decodes
 454           ;; the inserted text from known formats by calling format-decode,
 455           ;; which see.
 456           (insert-file-contents file)
 457           (org-link-beautify--display-content-block
 458            ;; This `cl-loop' extract a LIST of string lines from the file content.
 459            (cl-loop repeat lines
 460                     unless (eobp)
 461                     collect (prog1 (buffer-substring-no-properties
 462                                     (line-beginning-position)
 463                                     (line-end-position))
 464                               (forward-line 1)))))
 465       (file-error
 466        (funcall (if org-link-beautify--preview-text--noerror #'message #'user-error)
 467                         "Unable to read file %S"
 468                         file)
 469            nil))))
 470
 471 ;;; test
 472 ;; (org-link-beautify--preview-text-file
 473 ;;  (expand-file-name "~/Code/Emacs/org-link-beautify/README.org")
 474 ;;  3)
 475
 476 (defun org-link-beautify--preview-text (path start end &optional lines)
 477   "Preview LINES of TEXT file PATH and display on link between START and END."
 478   (let* ((text-file (expand-file-name (org-link-unescape path)))
 479          (preview-lines (or lines 10))
 480          (preview-content (org-link-beautify--preview-text-file text-file preview-lines)))
 481     (org-link-beautify--add-overlay-marker (1+ end) (+ end 2))
 482     (org-link-beautify--add-keymap (1+ end) (+ end 2))
 483     (put-text-property (1+ end) (+ end 2) 'display (propertize preview-content))
 484     (put-text-property (1+ end) (+ end 2) 'face '(:inherit org-block)))
 485   ;; Fix elisp compiler warning: Unused lexical argument `start'.
 486   (ignore start))
 487
 488 (defun org-link-beautify--preview-archive-file (file command)
 489   "Return the files list inside of archive FILE with COMMAND."
 490   (let ((cmd (format "%s '%s'" command file)))
 491     (org-link-beautify--display-content-block (shell-command-to-string cmd))))
 492
 493 (defun org-link-beautify--preview-archive (path command start end)
 494   "Preview files list of archive file PATH with COMMAND and display on link between START and END."
 495   (let* ((archive-file (expand-file-name (org-link-unescape path)))
 496          (preview-content (org-link-beautify--preview-archive-file archive-file command)))
 497     (org-link-beautify--add-overlay-marker (1+ end) (+ end 2))
 498     (org-link-beautify--add-keymap (1+ end) (+ end 2))
 499     (put-text-property (1+ end) (+ end 2) 'display (propertize preview-content))
 500     (put-text-property (1+ end) (+ end 2) 'face '(:inherit org-verbatim)))
 501   ;; Fix elisp compiler warning: Unused lexical argument `start'.
 502   (ignore start))
 503
 504 (defvar org-link-beautify--video-thumbnailer
 505   (cond
 506    ;; for macOS, use `qlmanage'
 507    ((and (eq system-type 'darwin) (executable-find "qlmanage")) "qlmanage")
 508    ;; for Linux, use `ffmpegthumbnailer'
 509    ((and (eq system-type 'gnu/linux) (executable-find "ffmpegthumbnailer")) "ffmpegthumbnailer")
 510    ;; for general, use `ffmpeg'
 511    ;; $ ffmpeg -ss 00:09:00 video.avi -vcodec png -vframes 1 -an -f rawvideo -s 119x64 out.png
 512    ((executable-find "ffmpeg") "ffmpeg"))
 513   "Find available video thumbnailer command.")
 514
 515 (defun org-link-beautify--preview-video (path start end)
 516   "Preview video file PATH and display on link between START and END."
 517   (let* ((video-file (expand-file-name (org-link-unescape path)))
 518          (thumbnails-dir (org-link-beautify--get-thumbnails-dir-path video-file))
 519          (thumbnail-file (expand-file-name (format "%s%s.png" thumbnails-dir (file-name-base video-file))))
 520          (thumbnail-size (or org-link-beautify-video-preview-size 512)))
 521     (org-link-beautify--ensure-thumbnails-dir thumbnails-dir)
 522     (unless (file-exists-p thumbnail-file)
 523       (pcase org-link-beautify--video-thumbnailer
 524         ("qlmanage"
 525          (start-process
 526           "org-link-beautify--video-preview"
 527           " *org-link-beautify video-preview*"
 528           "qlmanage"
 529           "-x"
 530           "-t"
 531           "-s" (number-to-string thumbnail-size)
 532           video-file
 533           "-o" thumbnails-dir)
 534          ;; then rename [video.mp4.png] to [video.png]
 535          (let ((original-thumbnail-file (concat thumbnails-dir (file-name-nondirectory video-file) ".png")))
 536            (if (and (not org-link-beautify-enable-debug-p) (file-exists-p original-thumbnail-file))
 537                (rename-file original-thumbnail-file thumbnail-file)
 538              (when (and org-link-beautify-enable-debug-p (not (file-exists-p thumbnail-file)))
 539                (org-link-beautify--notify-generate-thumbnail-failed video-file thumbnail-file)))))
 540         ("ffmpegthumbnailer"
 541          (start-process
 542           "org-link-beautify--video-preview"
 543           " *org-link-beautify video-preview*"
 544           "ffmpegthumbnailer"
 545           "-f" "-i" video-file
 546           "-s" (number-to-string thumbnail-size)
 547           "-o" thumbnail-file)
 548          (when (and org-link-beautify-enable-debug-p (not (file-exists-p thumbnail-file)))
 549            (org-link-beautify--notify-generate-thumbnail-failed video-file thumbnail-file)))
 550         ("ffmpeg"
 551          ;; $ ffmpeg -ss 00:09:00 video.avi -vcodec png -vframes 1 -an -f rawvideo -s 119x64 out.png
 552          ((executable-find "ffmpeg")
 553           (start-process
 554            "org-link-beautify--video-preview"
 555            " *org-link-beautify video-preview*"
 556            "ffmpeg"
 557            "-s" "00:09:00" video-file
 558            "-vcodec" "png"
 559            "-vframes" "1"
 560            "-an" "-f" "rawvideo"
 561            "-s" (number-to-string thumbnail-size)
 562            thumbnail-file)
 563           (when (and org-link-beautify-enable-debug-p (not (file-exists-p thumbnail-file)))
 564             (org-link-beautify--notify-generate-thumbnail-failed video-file thumbnail-file))))))
 565     (org-link-beautify--add-overlay-marker start end)
 566     (org-link-beautify--add-keymap start end)
 567     (org-link-beautify--display-thumbnail thumbnail-file thumbnail-size start end)))
 568
 569 (defun org-link-beautify--preview-audio (path start end)
 570   "Preview audio PATH with wave form image on link between START and END."
 571   (let* ((audio-file (expand-file-name (org-link-unescape path)))
 572          (thumbnails-dir (org-link-beautify--get-thumbnails-dir-path audio-file))
 573          (thumbnail-file (expand-file-name (format "%s%s.png" thumbnails-dir (file-name-base audio-file))))
 574          (thumbnail-size (or org-link-beautify-audio-preview-size 200)))
 575     (org-link-beautify--ensure-thumbnails-dir thumbnails-dir)
 576     (unless (file-exists-p thumbnail-file)
 577       ;; DEBUG:
 578       ;; (message "%s\n%s\n" audio-file thumbnail-file)
 579       (cond
 580        ((and (eq system-type 'darwin) (executable-find "qlmanage"))
 581         (start-process
 582          "org-link-beautify--audio-preview"
 583          " *org-link-beautify audio preview*"
 584          "qlmanage"
 585          "-x"
 586          "-t"
 587          "-s" (number-to-string 100)
 588          audio-file
 589          "-o" thumbnails-dir)
 590         ;; then rename [video.mp4.png] to [video.png]
 591         (let ((original-thumbnail-file (concat thumbnails-dir (file-name-nondirectory audio-file) ".png")))
 592           (if (and (not org-link-beautify-enable-debug-p) (file-exists-p original-thumbnail-file))
 593               (rename-file original-thumbnail-file thumbnail-file)
 594             (when (and org-link-beautify-enable-debug-p (not (file-exists-p thumbnail-file)))
 595               (org-link-beautify--notify-generate-thumbnail-failed audio-file thumbnail-file)))))
 596        ((and (eq system-type 'gnu/linux) (executable-find "audiowaveform"))
 597         (start-process
 598          "org-link-beautify--audio-preview"
 599          " *org-link-beautify audio preview*" ; DEBUG: check out output buffer
 600          "audiowaveform"
 601          "-i" audio-file
 602          "-o" thumbnail-file)
 603         (when (and org-link-beautify-enable-debug-p (not (file-exists-p thumbnail-file)))
 604           (org-link-beautify--notify-generate-thumbnail-failed audio-file thumbnail-file)))))
 605     (org-link-beautify--add-overlay-marker start end)
 606     (org-link-beautify--add-keymap start end)
 607     (org-link-beautify--display-thumbnail thumbnail-file thumbnail-size start end)))
 608
 609 (defun org-link-beautify--return-icon (type path extension &optional link-element)
 610   "Return icon for the link PATH smartly based on TYPE, EXTENSION, etc."
 611   ;; Fix elisp compiler warning: Unused lexical argument `link-element'.
 612   (ignore link-element)
 613   ;; (message "DEBUG: (type) %s" type)
 614   ;; (message "DEBUG: (path) %s" path)
 615   ;; (message "DEBUG: (link-element) %s" link-element)
 616   (pcase type
 617     ("file"
 618      (cond
 619       ((not (file-exists-p (expand-file-name path))) ; not exist file!
 620        (all-the-icons-faicon "ban" :face 'org-warning :v-adjust -0.05))
 621       ((file-directory-p path)          ; directory
 622        (all-the-icons-icon-for-dir "path" :face (org-link-beautify--warning-face-p path) :v-adjust 0))
 623       ((file-remote-p path)             ; remote file
 624        (all-the-icons-faicon "server" :face 'org-priority))
 625       (t (all-the-icons-icon-for-file   ; other file types
 626           (format ".%s" extension)
 627           :face (org-link-beautify--warning-face-p path)))))
 628     ("file+sys" (all-the-icons-faicon "link"))
 629     ("file+emacs" (all-the-icons-icon-for-mode 'emacs-lisp-mode))
 630     ("http" (all-the-icons-icon-for-url (concat "http:" path) :v-adjust -0.05))
 631     ("https" (all-the-icons-icon-for-url (concat "https:" path) :v-adjust -0.05))
 632     ("ftp" (all-the-icons-faicon "link"))
 633     ;; ("telnet" (all-the-icons-material "settings_ethernet"))
 634     ("custom-id" (all-the-icons-faicon "search-plus"))
 635     ("coderef" (all-the-icons-faicon "code"))
 636     ("id" (all-the-icons-faicon "link"))
 637     ("attachment" (all-the-icons-faicon "file-archive-o"))
 638     ("elisp" (all-the-icons-icon-for-mode 'emacs-lisp-mode :v-adjust -0.05))
 639     ("eshell" (all-the-icons-icon-for-mode 'eshell-mode))
 640     ("shell" (all-the-icons-icon-for-mode 'shell-mode))
 641     ("man" (all-the-icons-faicon "info-circle" :v-adjust -0.05))
 642     ("info" (all-the-icons-faicon "info" :v-adjust -0.05))
 643     ("help" (all-the-icons-faicon "info" :v-adjust -0.05))
 644     ;; Org Mode external link types
 645     ("eaf" (all-the-icons-faicon "cubes" :v-adjust -0.05)) ; emacs-application-framework
 646     ("eww" (all-the-icons-icon-for-mode 'eww-mode))
 647     ("chrome" (all-the-icons-faicon "chrome" :v-adjust -0.05))
 648     ("mu4e" (all-the-icons-faicon "envelope" :v-adjust -0.05))
 649     ("git" (all-the-icons-faicon "git-square" :v-adjust -0.05))
 650     ("orgit" (all-the-icons-faicon "git-square" :v-adjust -0.05))
 651     ("orgit-rev" (all-the-icons-octicon "git-commit"))
 652     ("orgit-log" (all-the-icons-octicon "git-branch"))
 653     ("pdf" (all-the-icons-icon-for-file ".pdf"))
 654     ("grep" (all-the-icons-icon-for-mode 'grep-mode))
 655     ("occur" (all-the-icons-icon-for-mode 'occur-mode))
 656     ("rss" (all-the-icons-faicon "rss"))
 657     ("elfeed" (all-the-icons-faicon "rss"))
 658     ("wikipedia" (all-the-icons-faicon "wikipedia-w"))
 659     ("mailto" (all-the-icons-faicon "envelope-o" :v-adjust -0.05))
 660     ("irc" (all-the-icons-faicon "comments-o" :v-adjust -0.05))
 661     ("doi" (all-the-icons-faicon "link"))
 662     ("org-contact" (all-the-icons-faicon "user" :v-adjust -0.05))
 663
 664     ;; `org-element-context' will return "fuzzy" type when link not recognized.
 665     ;; ("fuzzy"
 666     ;;  ;; DEBUG
 667     ;;  (message "[org-link-beautify] link-element: %s" link-element)
 668     ;;  (when (string-match ".*:.*" link-element) ; extract the "real" link type for "fuzzy" type.
 669     ;;    (let ((real-type (match-string 1 link-element)))
 670     ;;      (pcase real-type
 671     ;;        ))))
 672     ;; (_
 673     ;;  ;; DEBUG
 674     ;;  (message "[org-link-beautify] link-element: %s" link-element))
 675     ))
 676
 677 (defface org-link-beautify-link-decorator-face
 678   `((t :foreground ,(color-lighten-name (face-foreground 'shadow) 2)))
 679   "Face for org-link-beautify link decorator."
 680   :group 'org-link-beautify)
 681
 682 (defface org-link-beautify-link-description-face
 683   '((t :inherit 'org-link))
 684   "Face for org-link-beautify link description."
 685   :group 'org-link-beautify)
 686
 687 (defface org-link-beautify-link-icon-face
 688   '((t :foreground "gray" :height 95))
 689   "Face for org-link-beautify link icon."
 690   :group 'org-link-beautify)
 691
 692 (defun org-link-beautify--display-icon (start end description icon)
 693   "Display ICON for link on START and END with DESCRIPTION."
 694   (put-text-property
 695    start end
 696    'display
 697    (propertize
 698     (concat
 699      (propertize "[" 'face 'org-link-beautify-link-decorator-face)
 700      (propertize description 'face 'org-link-beautify-link-description-face)
 701      (propertize "]" 'face 'org-link-beautify-link-decorator-face)
 702      (propertize "⌈" 'face 'org-link-beautify-link-decorator-face)
 703      (propertize icon 'face 'org-link-beautify-link-icon-face)
 704      (propertize "⌋" 'face 'org-link-beautify-link-decorator-face)))))
 705
 706 (defun org-link-beautify--display-not-exist (start end description icon)
 707   "Display error color and ICON on START and END with DESCRIPTION."
 708   (put-text-property
 709    start end
 710    'display
 711    (propertize
 712     (concat
 713      (propertize "[" 'face '(:inherit nil :underline nil :foreground "black"))
 714      (propertize description 'face '(:underline t :foreground "red" :strike-through t))
 715      (propertize "]" 'face '(:inherit nil :underline nil :foreground "black"))
 716      (propertize "(" 'face '(:inherit nil :underline nil :foreground "black"))
 717      (propertize icon 'face '(:inherit nil :underline nil :foreground "orange red"))
 718      (propertize ")" 'face '(:inherit nil :underline nil :foreground "black"))))))
 719
 720 (defun org-link-beautify-display (start end path bracket-p)
 721   "Display icon for the link type based on PATH from START to END."
 722   ;; DEBUG:
 723   ;; (message
 724   ;;  (format "start: %s, end: %s, path: %s, bracket-p: %s" start end path bracket-p))
 725   ;; detect whether link is normal, skip other links in special places.
 726   (let ((link-element (org-link-beautify--get-element start))
 727         ;; DEBUG:
 728         ;; (link-element-debug (print link-element))
 729         )
 730     (when (eq (car link-element) 'link)
 731       (save-match-data
 732         (let* ((raw-link (org-element-property :raw-link link-element))
 733                ;; DEBUG:
 734                ;; (raw-link-debug (print raw-link))
 735                (type (org-element-property :type link-element))
 736                ;; DEBUG:
 737                ;; (type-debug (print type))
 738                (extension (or (file-name-extension (org-link-unescape path)) "txt"))
 739                ;; the search part behind link separator "::"
 740                (search-option (org-element-property :search-option link-element))
 741                ;; DEBUG: (ext-debug (message extension))
 742                (description (or (and (org-element-property :contents-begin link-element) ; in raw link case, it's nil
 743                                      (buffer-substring-no-properties
 744                                       (org-element-property :contents-begin link-element)
 745                                       (org-element-property :contents-end link-element)))
 746                                 ;; when description not exist, use raw link for raw link case.
 747                                 raw-link))
 748                ;; DEBUG: (desc-debug (print description))
 749                (icon (or (org-link-beautify--return-icon type path extension link-element)
 750                          ;; handle when returned icon is `nil'.
 751                          (all-the-icons-faicon "question" :v-adjust -0.05)))
 752                ;; DEBUG:
 753                ;; (icon-debug (print icon))
 754                )
 755           ;; Fix elisp compiler warning: Unused lexical argument `bracket-p'.
 756           (ignore bracket-p)
 757           (cond
 758            ;; video thumbnail preview
 759            ;; [[file:/path/to/video.mp4]]
 760            ((and org-link-beautify-video-preview
 761                  (equal type "file") (member extension org-link-beautify-video-preview-list))
 762             ;; DEBUG:
 763             ;; (user-error "[org-link-beautify] cond -> video file")
 764             (org-link-beautify--preview-video path start end))
 765
 766            ;; audio wave form image preview
 767            ;; [[file:/path/to/audio.mp3]]
 768            ((and org-link-beautify-audio-preview
 769                  (equal type "file") (member extension org-link-beautify-audio-preview-list))
 770             ;; DEBUG:
 771             ;; (user-error "[org-link-beautify] cond -> audio file")
 772             (org-link-beautify--preview-audio path start end))
 773
 774            ;; PDF file preview
 775            ;; [[file:/path/to/filename.pdf]]
 776            ;; [[pdf:/path/to/filename.pdf::15]]
 777            ;; [[pdfview:/path/to/filename.pdf::15]]
 778            ((and org-link-beautify-pdf-preview
 779                  (or (and (equal type "file") (string= extension "pdf"))
 780                      (equal type "pdf")
 781                      (equal type "pdfview")
 782                      (equal type "docview")
 783                      (equal type "eaf")))
 784             ;; DEBUG:
 785             ;; (user-error "[org-link-beautify] cond -> PDF file")
 786             ;; (message "org-link-beautify: PDF file previewing [%s], link-type: [%s], search-option: [%s] (type: %s)," path type search-option (type-of search-option))
 787             (org-link-beautify--preview-pdf
 788              (if (equal type "eaf")
 789                  (replace-regexp-in-string "pdf::" "" path)
 790                path)
 791              start end
 792              search-option))
 793
 794            ;; EPUB file cover preview
 795            ((and org-link-beautify-epub-preview
 796                  (equal type "file") (string= extension "epub"))
 797             ;; DEBUG:
 798             ;; (user-error "[org-link-beautify] cond -> epub file")
 799             (org-link-beautify--preview-epub path start end))
 800
 801            ;; text content preview
 802            ((and org-link-beautify-text-preview
 803                  (equal type "file") (member extension org-link-beautify-text-preview-list))
 804             ;; DEBUG:
 805             ;; (user-error "[org-link-beautify] cond -> text file")
 806             (org-link-beautify--preview-text path start end))
 807
 808            ;; compressed archive file preview
 809            ((and org-link-beautify-archive-preview
 810                  (equal type "file") (member extension (mapcar 'car org-link-beautify-archive-preview-alist)))
 811             ;; DEBUG:
 812             ;; (user-error "[org-link-beautify] cond -> archive file")
 813             ;; (if (null extension)
 814             ;;     (user-error "[org-link-beautify] archive file preview> extension: %s" extension))
 815             ;; (message "[org-link-beautify] archive file preview> path: %s" path)
 816             (let ((command (cdr (assoc extension org-link-beautify-archive-preview-alist))))
 817               (org-link-beautify--preview-archive path command start end)))
 818
 819            ;; file does not exist
 820            ((and (equal type "file") (not (file-exists-p path)))
 821             ;; DEBUG:
 822             ;; (user-error "[org-link-beautify] cond -> file")
 823             ;; (message path)
 824             (org-link-beautify--add-overlay-marker start end)
 825             (org-link-beautify--display-not-exist start end description icon))
 826
 827            ;; general icons
 828            (t
 829             ;; DEBUG:
 830             ;; (user-error "[org-link-beautify] cond -> t")
 831             ;; (message "start: %d, end: %d, description: %s, icon: %s" start end description icon)
 832             (org-link-beautify--add-overlay-marker start end)
 833             (org-link-beautify--add-keymap start end)
 834             (org-link-beautify--display-icon start end description icon))))))))
 835
 836 ;;; hook on headline expand
 837 (defun org-link-beautify-headline-cycle (&optional state)
 838   "Function to be executed on `org-cycle-hook' STATE."
 839   (pcase state
 840     ('subtree (ignore))
 841     ('children (ignore))
 842     ('folded
 843      (org-link-beautify-clear state))
 844     (_ (ignore))))
 845
 846 ;;; toggle org-link-beautify text-properties
 847 (defun org-link-beautify--clear-text-properties (&optional begin end)
 848   "Clear all org-link-beautify text-properties between BEGIN and END."
 849   (let ((point (or begin (point-min)))
 850         (bmp (buffer-modified-p)))
 851     (while (setq point (next-single-property-change point 'display))
 852       (when (and (< point (or end (point-max)))
 853                  (get-text-property point 'display)
 854                  (eq (get-text-property point 'type) 'org-link-beautify))
 855         (remove-text-properties
 856              point (setq point (next-single-property-change point 'display))
 857              '(display t))))
 858     (set-buffer-modified-p bmp)))
 859
 860 (defun org-link-beautify-clear (&optional state)
 861   "Clear the text-properties of `org-link-beautify' globally.
 862 Or clear org-link-beautify if headline STATE is folded."
 863   (if (eq state 'folded)
 864       ;; clear in current folded headline
 865       (save-excursion
 866         (save-restriction
 867           (org-narrow-to-subtree)
 868           (let* ((begin (point-min))
 869                  (end (save-excursion (org-next-visible-heading 1) (point))))
 870             (org-link-beautify--clear-text-properties begin end))))
 871     ;; clear in whole buffer
 872     (org-link-beautify--clear-text-properties))
 873   (org-restart-font-lock))
 874
 875 (defvar org-link-beautify--icon-spec-list
 876   '(;; mind map files
 877     ("\\.mm" all-the-icons-fileicon "brain" :face all-the-icons-lpink)
 878     ("\\.xmind" all-the-icons-fileicon "brain" :face all-the-icons-lpink)
 879     ;; archive files
 880     ("\\.zip" all-the-icons-faicon "file-archive-o" :face all-the-icons-yellow)
 881     ("\\.rar" all-the-icons-faicon "file-archive-o" :face all-the-icons-yellow)
 882     ("\\.7z" all-the-icons-faicon "file-archive-o" :face all-the-icons-yellow)
 883     ("\\.gz" all-the-icons-faicon "file-archive-o" :face all-the-icons-yellow)
 884     ("\\.bz2" all-the-icons-faicon "file-archive-o" :face all-the-icons-yellow)
 885     ("\\.tar" all-the-icons-faicon "file-archive-o" :face all-the-icons-yellow)
 886     ("\\.tar.gz" all-the-icons-faicon "file-archive-o" :face all-the-icons-yellow)
 887     ("\\.tar.bz2" all-the-icons-faicon "file-archive-o" :face all-the-icons-yellow)
 888     ("\\.xz" all-the-icons-faicon "file-archive-o" :face all-the-icons-yellow)
 889     ("\\.zst" all-the-icons-faicon "file-archive-o" :face all-the-icons-yellow))
 890   "A list of icon spec to be used by `org-link-beautify--add-more-icons-support'.")
 891
 892 ;;; add more missing icons to `all-the-icons'.
 893 (defun org-link-beautify--add-more-icons-support ()
 894   "Add more icons for file types."
 895   (dolist (icon-spec org-link-beautify--icon-spec-list)
 896     (add-to-list 'all-the-icons-regexp-icon-alist icon-spec)))
 897
 898 (defun org-link-beautify--remove-more-icons-support ()
 899   "Remove added extra icons support for file types from `org-link-beautify'."
 900   (dolist (icon-spec org-link-beautify--icon-spec-list)
 901     (setq all-the-icons-regexp-icon-alist
 902           (delete icon-spec all-the-icons-regexp-icon-alist))))
 903
 904 (defvar org-link-beautify-keymap (make-sparse-keymap))
 905
 906 (defun org-link-beautify--add-keymap (start end)
 907   "Add keymap on link text-property. between START and END."
 908   (put-text-property start end 'keymap org-link-beautify-keymap))
 909
 910 (define-key org-link-beautify-keymap (kbd "RET") 'org-open-at-point)
 911 (define-key org-link-beautify-keymap [mouse-1] 'org-open-at-point)
 912 (define-key org-link-beautify-keymap (kbd "<mouse-1>") 'org-open-at-point)
 913
 914
 915 ;;;###autoload
 916 (defun org-link-beautify-enable ()
 917   "Enable `org-link-beautify'."
 918   (when (display-graphic-p)
 919     (org-link-beautify--add-more-icons-support)
 920     (dolist (link-type (mapcar #'car org-link-parameters))
 921       (org-link-set-parameters link-type :activate-func #'org-link-beautify-display))
 922     (add-hook 'org-cycle-hook #'org-link-beautify-headline-cycle)
 923     (org-restart-font-lock)))
 924
 925 ;;;###autoload
 926 (defun org-link-beautify-disable ()
 927   "Disable `org-link-beautify'."
 928   (org-link-beautify--remove-more-icons-support)
 929   (dolist (link-type (mapcar #'car org-link-parameters))
 930     (org-link-set-parameters link-type :activate-func t))
 931   (remove-hook 'org-cycle-hook #'org-link-beautify-headline-cycle)
 932   (org-link-beautify-clear))
 933
 934 ;;;###autoload
 935 (define-minor-mode org-link-beautify-mode
 936   "A minor mode to beautify Org Mode links with icons, and inline preview etc."
 937   :group 'org-link-beautify
 938   :global nil
 939   :init-value nil
 940   :lighter nil
 941   (if org-link-beautify-mode
 942       (org-link-beautify-enable)
 943     (org-link-beautify-disable)))
 944
 945 (defun org-link-beautify-mode-enable ()
 946   "Required by `define-globalized-minor-mode'."
 947   (org-link-beautify-mode 1))
 948
 949 ;; More than 400K characters.
 950 (defun org-link-beautify--filter-org-mode ()
 951   "Only enable on org-mode major-mode buffers."
 952   (eq major-mode 'org-mode))
 953
 954 ;;; Only enable `org-link-beautify-mode' on `org-mode' buffer.
 955 (defun org-link-beautify--filter-larg-file ()
 956   (< (buffer-size) 400000))
 957
 958 (define-globalized-minor-mode global-org-link-beautify-mode
 959   org-link-beautify-mode org-link-beautify-mode-enable
 960   (message "global-org-link-beautify-mode toggled for all Org-mode buffers.")
 961   :require 'org-link-beautify-mode
 962   :predicate (not (cl-some 'null (mapcar 'funcall org-link-beautify-condition-functions)))
 963   :lighter nil
 964   :group 'org-link-beautify)
 965
 966 \f
 967
 968 (provide 'org-link-beautify)
 969
 970 ;;; org-link-beautify.el ends here