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