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"))
   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
  59 (eval-when-compile (require 'org-capture))
  60 (eval-when-compile (require 'nerd-icons nil t))
  61 (declare-function 'nerd-icons-mdicon "nerd-icons" (icon-name &rest args))
  62
  63 (defgroup org-bookmarks nil
  64   "The defcustom group of `org-bookmarks'."
  65   :prefix "org-boomarks-"
  66   :group 'org)
  67
  68 ;; It would be better to default to the demo file in the repository.
  69 ;; That avoids creating a directory on the user's system that may not exist yet.
  70 ;; It also allows the user to try the command out without customizing anything first.
  71 (defcustom org-bookmarks-file
  72   (expand-file-name "bookmarks.org" (file-name-directory (or load-file-name (buffer-file-name))))
  73   "The Org bookmarks filename."
  74   :type 'string
  75   :safe #'stringp
  76   :group 'org-bookmarks)
  77
  78 (defcustom org-bookmarks-tag "bookmark"
  79   "The tag to mark Org headline as bookmark entry."
  80   :type 'string
  81   :safe #'stringp
  82   :group 'org-bookmarks)
  83
  84 (defcustom org-bookmarks-browse-function #'browse-url
  85   "Function called by `org-bookmarks' with selected URL as its sole argument."
  86   :type 'function
  87   :group 'org-bookmarks)
  88
  89 (defcustom org-bookmarks-add-org-capture-template nil
  90   "Add `org-capture' template for `org-bookmarks'.
  91 WARNING: If you have `org-capture' template bind to key \"b\" already,
  92 when this option is t, it will override your org-capture template.
  93 Or you can add org-capture template by yourself."
  94   :type 'boolean
  95   :safe #'booleanp
  96   :group 'org-bookmarks)
  97
  98
  99 (defun org-bookmarks--entry-screenshot (headline)
 100   "Return the bookmark HEADLINE object's webpage screenshot inline image."
 101   ;; limit in current headline entry.
 102   (let ((entry-begin (org-element-begin headline))
 103         (entry-end (org-element-end headline)))
 104     ;; skip over to property end
 105     (goto-char entry-begin)
 106     (search-forward-regexp org-property-end-re nil t)
 107     (when (re-search-forward org-link-any-re entry-end t)
 108       ;; back to link beginning
 109       (goto-char (match-beginning 0))
 110       (let* ((link-element (org-element-link-parser))
 111              (link-type (org-element-property :type link-element))
 112              (link-path (org-element-property :path link-element)))
 113         (when (buffer-narrowed-p) (widen))
 114         (when (and link-path
 115                    (string-equal link-type "file")
 116                    (member (intern (file-name-extension link-path)) image-types))
 117           (propertize " "
 118                       'display (create-image link-path nil nil :max-height (* (default-font-height) 20))))))))
 119
 120 ;;; TEST: (org-bookmarks--entry-screenshot (org-element-context))
 121
 122 (defun org-bookmarks--candidate (headline)
 123   "Return candidate string from Org HEADLINE."
 124   (when-let* ((tags (org-element-property :tags headline))
 125               ( (member org-bookmarks-tag tags))
 126               (url (alist-get "URL" (org-entry-properties headline 'standard) nil nil #'equal))
 127               (description (string-fill
 128                             (or (alist-get "DESCRIPTION" (org-entry-properties headline 'standard) nil nil #'equal) "")
 129                             fill-column))
 130               ;; bookmark extra info as bookmark completion candidate annotation.
 131               (info (concat "\n" ; candidate display extra info in multi-line with "\n"
 132                             (propertize url 'face 'link) "\n" ; property :URL:
 133                             (propertize description 'face 'font-lock-comment-face) "\n" ; property :DESCRIPTION:
 134                             ;; The screenshot inline image in bookmark entry body.
 135                             (org-bookmarks--entry-screenshot headline) "\n"))
 136               (headline-title (org-element-property :raw-value headline)))
 137     ;; The URL and ANNOTATION properties will be used for candidate display and browsing.
 138     (let* ((tags-searchable (delete org-bookmarks-tag tags))
 139            ;; TODO: The length counting method not correct on Chinese.
 140            (middle-line-length (when-let* ((length (- (- org-tags-column)
 141                                                       (length (string-join tags-searchable ":"))
 142                                                       (length headline-title) 2))
 143                                            ((wholenump length)))
 144                                  length)))
 145       (propertize
 146        (concat headline-title
 147                (format " %s [%s]"
 148                        (make-string (or middle-line-length 0) ?―)
 149                        (if (= (length tags-searchable) 1)
 150                            (car tags-searchable)
 151                          (string-join tags-searchable ":"))))
 152        'title headline-title
 153        'url url 'annotation info))))
 154
 155 (defun org-bookmarks--candidates (file)
 156   "Return a list of candidates from FILE."
 157   ;; It's better to use a temp buffer than touch the user's buffer.
 158   ;; It also cleans up after itself.
 159   (with-temp-buffer
 160     (insert-file-contents file) ; don't need to actually open file.
 161     (delay-mode-hooks ; This will prevent user hooks from running during parsing.
 162       (org-mode)
 163       (goto-char (point-min))
 164       (let ((candidates nil))
 165         (org-element-map (org-element-parse-buffer 'headline) 'headline
 166           (lambda (headline)
 167             (when-let ((candidate (org-bookmarks--candidate headline)))
 168               (push candidate candidates))))
 169         (nreverse candidates)))))
 170
 171 (defun org-bookmarks--completion-annotator (candidate)
 172   "Annotate bookmark completion CANDIDATE."
 173   (concat (propertize " " 'display '(space :align-to center))
 174           (get-text-property 0 'annotation candidate)))
 175
 176 (defun org-bookmarks--completion-action (candidate status)
 177   "The action function to be executed on selected completion CANDIDATE in STATUS."
 178   (message "[org-bookmarks] completion `%s' is selected with status %s" candidate status))
 179
 180 (defun org-bookmarks--return-candidates (&optional file)
 181   "Return `org-bookmarks' candidates which parsed from FILE."
 182   (if-let ((file (or file org-bookmarks-file)))
 183       (org-bookmarks--candidates file)
 184     (user-error "File does not exist: %S" file)))
 185
 186 (defvar org-bookmarks--candidates-cache nil
 187   "A cache variable of `org-bookmarks--candidates'.")
 188
 189 (defun org-bookmarks-db-update-cache ()
 190   "Update the `org-bookmarks' database cache."
 191   (interactive)
 192   (setq org-bookmarks--candidates-cache (org-bookmarks--return-candidates)))
 193
 194 ;;; Auto update org-bookmarks database cache in Emacs idle timer.
 195 (defcustom org-bookmarks-db-update-idle-interval (* 60 10)
 196   "The idle interval seconds for update `org-bookmarks' database cache."
 197   :type 'number
 198   :safe #'numberp
 199   :group 'org-bookmarks)
 200
 201 (run-with-idle-timer org-bookmarks-db-update-idle-interval t 'org-bookmarks-db-update-cache)
 202
 203 ;;;###autoload
 204 (defun org-bookmarks (&optional file)
 205   "Open bookmark read from FILE or `org-bookmarks-file'."
 206   (interactive)
 207   (unless org-bookmarks--candidates-cache
 208     (org-bookmarks-db-update-cache))
 209   (if-let* ((file (or file org-bookmarks-file))
 210             ( (file-exists-p file)))
 211       (if-let* ((candidates org-bookmarks--candidates-cache)
 212                 (minibuffer-allow-text-properties t)
 213                 (completion-extra-properties
 214                  ;; Using the "bookmark" category caused the annotations to not show.
 215                  ;; I think that may have be do to vertico-mode, but it's
 216                  ;; probably worth using a unique category so users can exercise
 217                  ;; finer-grained customization.
 218                  (list :category 'org-bookmark
 219                        :annotation-function #'org-bookmarks--completion-annotator
 220                        :exit-function #'org-bookmarks--completion-action))
 221                 (choice (completing-read "org-bookmarks: " candidates nil 'require-match))
 222                 (url (get-text-property 0 'url choice)))
 223           (funcall org-bookmarks-browse-function url)
 224         (user-error "No bookmarks found in %S" file))
 225     (user-error "File does not exist: %S" file)))
 226
 227 ;;; TEST:
 228 ;; (org-bookmarks "bookmarks.org")
 229 ;; (org-bookmarks (expand-file-name org-bookmarks-file))
 230
 231 ;;; Add link type `org-bookmark:'
 232 (defun org-bookmarks-link-open (bookmark-title _)
 233   "Open the \"org-bookmark:\" link type with BOOKMARK-TITLE."
 234   (if-let* ((file org-bookmarks-file)
 235             (buffer (or (get-buffer (file-name-nondirectory file))
 236                         (find-file-noselect file))))
 237       (with-current-buffer buffer
 238         (let ((marker (org-find-exact-headline-in-buffer bookmark-title buffer)))
 239           (if (fboundp 'org-goto-marker-or-bmk)
 240               (org-goto-marker-or-bmk marker)
 241             (goto-char (marker-position marker))))
 242         (display-buffer buffer '(display-buffer-below-selected))
 243         (when (or (org-invisible-p) (org-invisible-p2))
 244               (org-fold-show-context)))))
 245
 246 (defun org-bookmarks-link-store (&optional _interactive?)
 247   "Store \"org-bookmark:\" type link."
 248   (when (and (eq major-mode 'org-mode)
 249              (string-equal (buffer-name) (file-name-nondirectory org-bookmarks-file)))
 250     (let ((bookmark-title (substring-no-properties
 251                            (org-get-heading :no-tags :no-todo :no-priority :no-comment))))
 252       (org-link-store-props :type "org-bookmark"
 253                             :link (format "org-bookmark:%s" bookmark-title)
 254                             :description nil))))
 255
 256 (defun org-bookmarks-link-complete ()
 257   "Create a \"org-bookmark:\" type link using completion."
 258   (if-let* ((candidates org-bookmarks--candidates-cache)
 259             (minibuffer-allow-text-properties t)
 260             (completion-extra-properties
 261              (list :category 'org-bookmark
 262                    :annotation-function #'org-bookmarks--completion-annotator
 263                    :exit-function (lambda (string status)
 264                                     (message "[org-bookmarks] %s completion selected '%s'" status string))))
 265             (bookmark (completing-read "[org-bookmarks] Complete bookmark: "
 266                                        candidates nil 'require-match))
 267             (bookmark-title (get-text-property 0 'title bookmark)))
 268       (concat "org-bookmark:" bookmark-title)
 269     (user-error "The specified bookmark not found")))
 270
 271 (org-link-set-parameters "org-bookmark"
 272                          :follow #'org-bookmarks-link-open
 273                          :store #'org-bookmarks-link-store
 274                          :complete #'org-bookmarks-link-complete)
 275
 276 ;;;###autoload
 277 ;;; Add `org-capture' template for adding new bookmark to `org-bookmarks-file'.
 278 (defun org-bookmarks-add-org-capture-template ()
 279   "Add `org-capture' template for adding new bookmark to `org-bookmarks-file'."
 280   (require 'org-capture)
 281   ;; Delete existing key "b" binding in `org-capture-templates'.
 282   (if (and (assoc "b" org-capture-templates)
 283            (bound-and-true-p org-bookmarks-add-org-capture-template))
 284       (setq org-capture-templates
 285             (delete (assoc "b" org-capture-templates) org-capture-templates)))
 286   (add-to-list
 287    'org-capture-templates
 288    `("b" ,(format "%s\tAdd a new bookmark to %s"
 289                   (when (fboundp 'nerd-icons-mdicon)
 290                     (nerd-icons-mdicon "nf-md-bookmark_plus_outline" :face 'nerd-icons-blue))
 291                   (file-name-nondirectory org-bookmarks-file))
 292      entry (file ,(expand-file-name org-bookmarks-file))
 293      ,(concat "* %^{bookmark title}\t\t\t\t" (format ":%s:" org-bookmarks-tag) "
 294 :PROPERTIES:
 295 :URL:  %^C
 296 :DATE: %t
 297 :END:")
 298      :empty-lines 1
 299      :jump-to-captured t
 300      :refile-targets ((,org-bookmarks-file :maxlevel 3)))
 301    :append))
 302
 303 \f
 304
 305 (provide 'org-bookmarks)
 306
 307 ;;; org-bookmarks.el ends here