org-bookmarks.el

   1 ;;; org-bookmarks.el --- Manage bookmarks in Org mode -*- lexical-binding: t; -*-
   2 ;; -*- coding: utf-8 -*-
   3
   4 ;; Copyright (C) 2024-2025 stardiviner <numbchild@gmail.com>
   5
   6 ;; Authors: stardiviner <numbchild@gmail.com>
   7 ;; Package-Requires: ((emacs "29.1") (nerd-icons "0.1.0"))
   8 ;; Version: 1.2
   9 ;; Keywords: outline matching hypermedia org
  10 ;; URL: https://repo.or.cz/org-bookmarks.git
  11
  12 ;; org-bookmarks is free software; you can redistribute it and/or modify it
  13 ;; under the terms of the GNU General Public License as published by
  14 ;; the Free Software Foundation; either version 3, or (at your option)
  15 ;; any later version.
  16 ;;
  17 ;; org-bookmarks is distributed in the hope that it will be useful, but WITHOUT
  18 ;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
  19 ;; or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public
  20 ;; License for more details. https://www.gnu.org/licenses/gpl-3.0.txt
  21 ;;
  22 ;;
  23 ;; You should have received a copy of the GNU General Public License
  24 ;; along with GNU Emacs.  If not, see <https://www.gnu.org/licenses/>.
  25
  26 ;;; Commentary:
  27
  28 ;; Usage
  29
  30 ;; 0. config example:
  31 ;;
  32 ;; (use-package org-bookmarks
  33 ;;   :ensure t
  34 ;;   :custom ((org-bookmarks-file "~/Org/Bookmarks/Bookmarks.org")
  35 ;;            (org-bookmarks-add-org-capture-template t))
  36 ;;   :commands (org-bookmarks)
  37 ;;   :init (org-bookmarks-add-org-capture-template))
  38
  39 ;; 1. Record bookmark information into Org mode file.
  40 ;;
  41 ;; 2. bookmark entry is recorded with format like bellowing:
  42 ;;
  43 ;;    #+begin_src org
  44 ;;    * bookmark title                                         :bookmark:tag1:tag2:
  45 ;;    :PROPERTIES:
  46 ;;    :URL:      https://www.example.com
  47 ;;    :DESCRIPTION: example url
  48 ;;    :END:
  49 ;;
  50 ;;    #+end_src
  51 ;;
  52 ;; 3. execute command `org-bookmarks' to search and select bookmark to open in web browser.
  53
  54 ;;; Code:
  55 \f
  56 (require 'org) ; for `org-tags-column'
  57 (require 'org-element)
  58 (require 'nerd-icons)
  59
  60 (eval-when-compile (require 'org-capture))
  61 (eval-when-compile (require 'nerd-icons nil t))
  62 (declare-function 'nerd-icons-mdicon "nerd-icons" (icon-name &rest args))
  63
  64 (defgroup org-bookmarks nil
  65   "The defcustom group of `org-bookmarks'."
  66   :prefix "org-boomarks-"
  67   :group 'org)
  68
  69 ;; It would be better to default to the demo file in the repository.
  70 ;; That avoids creating a directory on the user's system that may not exist yet.
  71 ;; It also allows the user to try the command out without customizing anything first.
  72 (defcustom org-bookmarks-file
  73   (expand-file-name "bookmarks.org" (file-name-directory (or load-file-name (buffer-file-name))))
  74   "The Org bookmarks filename."
  75   :type 'string
  76   :safe #'stringp
  77   :group 'org-bookmarks)
  78
  79 (defcustom org-bookmarks-tag "bookmark"
  80   "The tag to mark Org headline as bookmark entry."
  81   :type 'string
  82   :safe #'stringp
  83   :group 'org-bookmarks)
  84
  85 (defcustom org-bookmarks-tag-exclude-list `(,org-archive-tag "deprecated")
  86   "The list of Org tags to exclude in searching bookmarks list."
  87   :type 'list
  88   :safe #'listp
  89   :group 'org-bookmarks)
  90
  91 (defcustom org-bookmarks-browse-url-function #'browse-url
  92   "Function called by `org-bookmarks' with selected URL as its sole argument."
  93   :type 'function
  94   :group 'org-bookmarks)
  95
  96 (defcustom org-bookmarks-add-org-capture-template nil
  97   "Add `org-capture' template for `org-bookmarks'.
  98 WARNING: If you have `org-capture' template bind to key \"b\" already,
  99 when this option is t, it will override your org-capture template.
 100 Or you can add org-capture template by yourself."
 101   :type 'boolean
 102   :safe #'booleanp
 103   :group 'org-bookmarks)
 104
 105
 106 (defun org-bookmarks--entry-screenshot (headline)
 107   "Return the bookmark HEADLINE object's webpage screenshot inline image."
 108   ;; limit in current headline entry.
 109   (let ((entry-begin (org-element-begin headline))
 110         (entry-end (org-element-end headline)))
 111     ;; skip over to property end
 112     (goto-char entry-begin)
 113     (search-forward-regexp org-property-end-re nil t)
 114     (when (re-search-forward org-link-any-re entry-end t)
 115       ;; back to link beginning
 116       (goto-char (match-beginning 0))
 117       (let* ((link-element (org-element-link-parser))
 118              (link-type (org-element-property :type link-element))
 119              (link-path (org-element-property :path link-element)))
 120         (when (buffer-narrowed-p) (widen))
 121         (when (and link-path
 122                    (string-equal link-type "file")
 123                    (member (intern (file-name-extension link-path)) image-types))
 124           (propertize " "
 125                       'display (create-image link-path nil nil :max-height (* (default-font-height) 20))))))))
 126
 127 ;;; TEST: (org-bookmarks--entry-screenshot (org-element-context))
 128
 129 (defun org-bookmarks--candidate (headline-element)
 130   "Return candidate string from Org HEADLINE-ELEMENT."
 131   (when-let* ((tags (org-element-property :tags headline-element))
 132               ( (and (member org-bookmarks-tag tags)
 133                      (not (seq-intersection tags org-bookmarks-tag-exclude-list))))
 134               (url (alist-get "URL" (org-entry-properties headline-element 'standard) nil nil #'equal))
 135               (description (string-fill
 136                             (or (alist-get "DESCRIPTION" (org-entry-properties headline-element 'standard) nil nil #'equal) "")
 137                             fill-column))
 138               ;; bookmark extra info as bookmark completion candidate annotation.
 139               (info (concat "\n" ; candidate display extra info in multi-line with "\n"
 140                             "   " (propertize url 'face 'link) "\n" ; property :URL:
 141                             "   " (propertize description 'face 'font-lock-comment-face) "\n" ; property :DESCRIPTION:
 142                             ;; The screenshot inline image in bookmark entry body.
 143                             (org-bookmarks--entry-screenshot headline-element) "\n"))
 144               (headline-title (org-element-property :raw-value headline-element))
 145               (position (point)))
 146     ;; The URL and ANNOTATION properties will be used for candidate display and browsing.
 147     (let* ((tags-searchable (delete org-bookmarks-tag tags))
 148            ;; TODO: The length counting method not correct on Chinese.
 149            (middle-line-length (when-let* ((length (- (- org-tags-column)
 150                                                       (length (string-join tags-searchable ":"))
 151                                                       (length headline-title) 2))
 152                                            ((wholenump length)))
 153                                  length))
 154            (middle-line (make-string (or middle-line-length 0) ?―))
 155            (icon (nerd-icons-icon-for-url url))
 156            (tags-displaying (if (= (length tags-searchable) 1)
 157                                 (car tags-searchable)
 158                               (string-join tags-searchable ":"))))
 159       (propertize (format " %s %s %s [%s]" icon headline-title middle-line tags-displaying)
 160                   'title headline-title 'url url 'annotation info
 161                   'position position))))
 162
 163 (defun org-bookmarks--candidates (file)
 164   "Return a list of candidates from FILE."
 165   ;; It's better to use a temp buffer than touch the user's buffer.
 166   ;; It also cleans up after itself.
 167   (with-temp-buffer
 168     (insert-file-contents file) ; don't need to actually open file.
 169     (delay-mode-hooks ; This will prevent user hooks from running during parsing.
 170       (org-mode)
 171       (goto-char (point-min))
 172       (let ((candidates nil))
 173         (org-element-map (org-element-parse-buffer 'headline) 'headline
 174           (lambda (headline-element)
 175             (when-let ((candidate (org-bookmarks--candidate headline-element)))
 176               (push candidate candidates))))
 177         (nreverse candidates)))))
 178
 179 (defun org-bookmarks--completion-annotator (candidate)
 180   "Annotate bookmark completion CANDIDATE."
 181   (concat (propertize " " 'display '(space :align-to center))
 182           (get-text-property 0 'annotation candidate)))
 183
 184 (defun org-bookmarks--completion-action (candidate status)
 185   "The action function to be executed on selected completion CANDIDATE in STATUS."
 186   (message "[org-bookmarks] completion `%s' is selected with status %s" candidate status))
 187
 188 (defun org-bookmarks--return-candidates (&optional file)
 189   "Return `org-bookmarks' candidates which parsed from FILE."
 190   (if-let ((file (or file org-bookmarks-file)))
 191       (org-bookmarks--candidates file)
 192     (user-error "File does not exist: %S" file)))
 193
 194 (defvar org-bookmarks--candidates-cache nil
 195   "A cache variable of `org-bookmarks--candidates'.")
 196
 197 (defun org-bookmarks-db-update-cache ()
 198   "Update the `org-bookmarks' database cache."
 199   (interactive)
 200   (setq org-bookmarks--candidates-cache (org-bookmarks--return-candidates)))
 201
 202 ;;; Auto update org-bookmarks database cache in Emacs idle timer.
 203 (defcustom org-bookmarks-db-update-idle-interval (* 60 10)
 204   "The idle interval seconds for update `org-bookmarks' database cache."
 205   :type 'number
 206   :safe #'numberp
 207   :group 'org-bookmarks)
 208
 209 (run-with-idle-timer org-bookmarks-db-update-idle-interval t 'org-bookmarks-db-update-cache)
 210
 211 ;;;###autoload
 212 (defun org-bookmarks (&optional file)
 213   "Open bookmark read from FILE or `org-bookmarks-file'."
 214   (interactive)
 215   (unless org-bookmarks--candidates-cache
 216     (org-bookmarks-db-update-cache))
 217   (if-let* ((file (or file org-bookmarks-file))
 218             ( (file-exists-p file)))
 219       (if-let* ((candidates org-bookmarks--candidates-cache)
 220                 (minibuffer-allow-text-properties t)
 221                 (completion-extra-properties
 222                  ;; Using the "bookmark" category caused the annotations to not show.
 223                  ;; I think that may have be do to vertico-mode, but it's
 224                  ;; probably worth using a unique category so users can exercise
 225                  ;; finer-grained customization.
 226                  (list :category 'org-bookmark
 227                        :annotation-function #'org-bookmarks--completion-annotator
 228                        :display-sort-function #'minibuffer-sort-by-history ; reference `vertico-sort-function'
 229                        :exit-function #'org-bookmarks--completion-action))
 230                 (choice (completing-read "org-bookmarks: " candidates nil 'require-match))
 231                 (url (get-text-property 0 'url choice)))
 232           (funcall org-bookmarks-browse-url-function url)
 233         (user-error "No bookmarks found in %S" file))
 234     (user-error "File does not exist: %S" file)))
 235
 236 ;;; TEST:
 237 ;; (org-bookmarks "bookmarks.org")
 238 ;; (org-bookmarks (expand-file-name org-bookmarks-file))
 239
 240 ;;; Add link type `org-bookmark:'
 241 (defun org-bookmarks-link-open (bookmark-title _)
 242   "Open the \"org-bookmark:\" link type with BOOKMARK-TITLE."
 243   (if-let* ((file org-bookmarks-file)
 244             (buffer (or (get-buffer (file-name-nondirectory file))
 245                         (find-file-noselect file))))
 246       (with-current-buffer buffer
 247         (let ((marker (org-find-exact-headline-in-buffer bookmark-title buffer)))
 248           (if (fboundp 'org-goto-marker-or-bmk)
 249               (org-goto-marker-or-bmk marker)
 250             (goto-char (marker-position marker))))
 251         (display-buffer buffer '(display-buffer-below-selected))
 252         (when (or (org-invisible-p) (org-invisible-p2))
 253               (org-fold-show-context)))))
 254
 255 (defun org-bookmarks-link-store (&optional _interactive?)
 256   "Store \"org-bookmark:\" type link."
 257   (when (and (eq major-mode 'org-mode)
 258              (string-equal (buffer-name) (file-name-nondirectory org-bookmarks-file)))
 259     (let ((bookmark-title (substring-no-properties
 260                            (org-get-heading :no-tags :no-todo :no-priority :no-comment))))
 261       (org-link-store-props :type "org-bookmark"
 262                             :link (format "org-bookmark:%s" bookmark-title)
 263                             :description nil))))
 264
 265 (defun org-bookmarks-link-complete ()
 266   "Create a \"org-bookmark:\" type link using completion."
 267   (if-let* ((candidates org-bookmarks--candidates-cache)
 268             (minibuffer-allow-text-properties t)
 269             (completion-extra-properties
 270              (list :category 'org-bookmark
 271                    :annotation-function #'org-bookmarks--completion-annotator
 272                    :exit-function (lambda (string status)
 273                                     (message "[org-bookmarks] %s completion selected '%s'" status string))))
 274             (bookmark (completing-read "[org-bookmarks] Complete bookmark: "
 275                                        candidates nil 'require-match))
 276             (bookmark-title (get-text-property 0 'title bookmark)))
 277       (concat "org-bookmark:" bookmark-title)
 278     (user-error "The specified bookmark not found")))
 279
 280 (org-link-set-parameters "org-bookmark"
 281                          :follow #'org-bookmarks-link-open
 282                          :store #'org-bookmarks-link-store
 283                          :complete #'org-bookmarks-link-complete)
 284
 285 ;;;###autoload
 286 ;;; Add `org-capture' template for adding new bookmark to `org-bookmarks-file'.
 287 (defun org-bookmarks-add-org-capture-template ()
 288   "Add `org-capture' template for adding new bookmark to `org-bookmarks-file'."
 289   (require 'org-capture)
 290   ;; Delete existing key "b" binding in `org-capture-templates'.
 291   (if (and (assoc "b" org-capture-templates)
 292            (bound-and-true-p org-bookmarks-add-org-capture-template))
 293       (setq org-capture-templates
 294             (delete (assoc "b" org-capture-templates) org-capture-templates)))
 295   (add-to-list
 296    'org-capture-templates
 297    `("b" ,(format "%s\tAdd a new bookmark to %s"
 298                   (when (fboundp 'nerd-icons-mdicon)
 299                     (nerd-icons-mdicon "nf-md-bookmark_plus_outline" :face 'nerd-icons-blue))
 300                   (file-name-nondirectory org-bookmarks-file))
 301      entry (file ,(expand-file-name org-bookmarks-file))
 302      ,(concat "* %^{bookmark title}\t\t\t\t" (format ":%s:" org-bookmarks-tag) "
 303 :PROPERTIES:
 304 :URL:  %^C
 305 :DATE: %t
 306 :END:")
 307      :empty-lines 1
 308      :jump-to-captured t
 309      :refile-targets ((,org-bookmarks-file :maxlevel 3)))
 310    :append))
 311
 312 \f
 313
 314 (provide 'org-bookmarks)
 315
 316 ;;; org-bookmarks.el ends here