org-bookmarks.el

   1 ;;; org-bookmarks.el --- Manage bookmarks in Org mode -*- lexical-binding: t; -*-
   2 ;; -*- coding: utf-8 -*-
   3
   4 ;; Copyright (C) 2020-2021 Free Software Foundation, Inc.
   5
   6 ;; Authors: stardiviner <numbchild@gmail.com>
   7 ;; Package-Requires: ((emacs "26.1"))
   8 ;; Version: 0.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.
  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 ;;; Code:
  31 \f
  32 (require 'org) ; for `org-tags-column'
  33 (require 'org-element)
  34
  35 (defgroup org-bookmarks nil
  36   "The defcustom group of `org-bookmarks'."
  37   :prefix "org-boomarks-"
  38   :group 'org)
  39
  40 ;; The :group keyword is not necessary if a group has been defined in the same file.
  41 ;; It will default to the last declared.
  42
  43 ;; It would be better to default to the demo file in the repository.
  44 ;; That avoids creating a directory on the user's system that may not exist yet.
  45 ;; It also allows the user to try the command out without customizing anything first.
  46 (defcustom org-bookmarks-file
  47   (expand-file-name "bookmarks.org" (file-name-directory (or load-file-name (buffer-file-name))))
  48   "The Org bookmarks filename."
  49   :type 'string
  50   :safe #'stringp
  51   :group 'org-bookmarks)
  52
  53 (defcustom org-bookmarks-tag "bookmark"
  54   "The tag to mark Org headline as bookmark entry."
  55   :type 'string
  56   :safe #'stringp
  57   :group 'org-bookmarks)
  58
  59 ;; It's possible the user may want to change which function is used to browse the URL.
  60 (defcustom org-bookmarks-browse-function #'browse-url
  61   "Function called by `org-bookmarks' with selected URL as its sole argument."
  62   :type 'function
  63   :group 'org-bookmarks)
  64
  65 (defcustom org-bookmarks-add-org-capture-template nil
  66   "Add org-capture template for org-bookmarks."
  67   :type 'boolean
  68   :safe #'booleanp
  69   :group 'org-bookmarks)
  70
  71 ;; Decomposing the logic of the main funciton into smaller functions makes the program
  72 ;; easier to reason about and more flexible.
  73
  74 ;; We're mapping over headlines via the org-element API, so we can assume that's
  75 ;; what type of element we'll be operating on here.
  76 (defun org-bookmarks--candidate (headline)
  77   "Return candidate string from Org HEADLINE."
  78   ;; We can use when-let to succinctly assign variables and return early for
  79   ;; non-matching headlines
  80   (when-let ((tags (org-element-property :tags headline))
  81              ((member org-bookmarks-tag tags))
  82              (tags-searchable (remove org-bookmarks-tag tags))
  83              (url (alist-get "URL" (org-entry-properties headline 'standard) nil nil #'equal))
  84              (info (concat "\n" (propertize url 'face 'link) "\n"))
  85              (headline-title (org-element-property :raw-value headline))
  86              ;; TODO: The length counting method not correct on Chinese.
  87              (middle-line-length (when-let* ((length (- (- org-tags-column)
  88                                                         (length tags-searchable)
  89                                                         (length headline-title) 2))
  90                                              ((wholenump length)))
  91                                    length)))
  92     ;; The URL and ANNOTATION properties will be used for candidate display and browsing.
  93     (propertize
  94      (concat headline-title
  95              (format " %s [%s]"
  96                      (make-string middle-line-length ?―)
  97                      (if (= (length tags-searchable) 1)
  98                          (car tags-searchable)
  99                        (string-join tags-searchable ":"))))
 100      'url url 'annotation info)))
 101
 102 (defun org-bookmarks--candidates (file)
 103   "Return a list of candidates from FILE."
 104   ;; It's better to use a temp buffer than touch the user's buffer.
 105   ;; It also cleans up after itself.
 106   (with-temp-buffer
 107     (insert-file-contents file)
 108     (delay-mode-hooks ;; This will prevent user hooks from running during parsing.
 109       (org-mode)
 110       (goto-char (point-min))
 111       (let ((candidates nil))
 112         (org-element-map (org-element-parse-buffer 'headline) 'headline
 113           (lambda (headline)
 114             (when-let ((candidate (org-bookmarks--candidate headline)))
 115               (push candidate candidates))))
 116         (nreverse candidates)))))
 117
 118 ;; The annotation function can look up the properties on each candidate.
 119 (defun org-bookmarks--annotator (candidate)
 120   "Annotate bookmark completion CANDIDATE."
 121   (concat (propertize " " 'display '(space :align-to center))
 122           (get-text-property 0 'annotation candidate)))
 123
 124 (defun org-bookmarks (&optional file)
 125   "Open bookmark read from FILE or `org-bookmarks-file'."
 126   (interactive)
 127   (if-let ((file (or file org-bookmarks-file))
 128            ;; Ensure file exists first.
 129            ((file-exists-p file)))
 130       (if-let ((candidates (org-bookmarks--candidates file))
 131                ;; Necessary for propertized text in minibuffer.
 132                (minibuffer-allow-text-properties t)
 133                (completion-extra-properties
 134                 ;; Using the "bookmark" category caused the annotations to not show.
 135                 ;; I think that may have be do to vertico-mode, but
 136                 ;; it's probably worth using a unique category so users can exercise finer-grained  customization.
 137                 (list :category 'org-bookmark
 138                       :annotation-function #'org-bookmarks--annotator))
 139                (choice (completing-read "org-bookmarks: " candidates nil 'require-match))
 140                (url (get-text-property 0 'url choice)))
 141           (funcall org-bookmarks-browse-function url)
 142         (user-error "No bookmarks found in %S" file))
 143     (user-error "File does not exist: %S" file)))
 144
 145 ;;; TEST:
 146 ;; (org-bookmarks "bookmarks.org")
 147 ;; (org-bookmarks (expand-file-name org-bookmarks-file))
 148
 149 ;;; Add `org-capture' template for adding new bookmark to `org-bookmarks-file'
 150 (when org-bookmarks-add-org-capture-template
 151   (require 'org-capture)
 152   (unless (assoc "b" org-capture-templates)
 153     (add-to-list
 154      'org-capture-templates
 155      `("b" ,(format "%s\tAdd a new bookmark to %s"
 156                     (when (require 'nerd-icons nil t)
 157                       (nerd-icons-mdicon "nf-md-bookmark_plus_outline" :face 'nerd-icons-blue))
 158                     org-bookmarks-file)
 159        entry (file ,(expand-file-name org-bookmarks-file))
 160        "* %^{bookmark title}
 161 :PROPERTIES:
 162 :URL:  %^C
 163 :DATE: %t
 164 :END:"
 165        :empty-lines 1
 166        :jump-to-captured t)
 167      :append)))
 168
 169 \f
 170
 171 (provide 'org-bookmarks)
 172
 173 ;;; org-bookmarks.el ends here