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. 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 ;;; 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 ;; It would be better to default to the demo file in the repository.
  41 ;; That avoids creating a directory on the user's system that may not exist yet.
  42 ;; It also allows the user to try the command out without customizing anything first.
  43 (defcustom org-bookmarks-file
  44   (expand-file-name "bookmarks.org" (file-name-directory (or load-file-name (buffer-file-name))))
  45   "The Org bookmarks filename."
  46   :type 'string
  47   :safe #'stringp
  48   :group 'org-bookmarks)
  49
  50 (defcustom org-bookmarks-tag "bookmark"
  51   "The tag to mark Org headline as bookmark entry."
  52   :type 'string
  53   :safe #'stringp
  54   :group 'org-bookmarks)
  55
  56 (defcustom org-bookmarks-browse-function #'browse-url
  57   "Function called by `org-bookmarks' with selected URL as its sole argument."
  58   :type 'function
  59   :group 'org-bookmarks)
  60
  61 (defcustom org-bookmarks-add-org-capture-template nil
  62   "Add org-capture template for org-bookmarks."
  63   :type 'boolean
  64   :safe #'booleanp
  65   :group 'org-bookmarks)
  66
  67
  68 (defun org-bookmarks--candidate (headline)
  69   "Return candidate string from Org HEADLINE."
  70   (when-let ((tags (org-element-property :tags headline))
  71              ( (member org-bookmarks-tag tags))
  72              (url (alist-get "URL" (org-entry-properties headline 'standard) nil nil #'equal))
  73              (info (concat "\n" (propertize url 'face 'link) "\n"))
  74              (headline-title (org-element-property :raw-value headline)))
  75     ;; The URL and ANNOTATION properties will be used for candidate display and browsing.
  76     (let* ((tags-searchable (delete org-bookmarks-tag tags))
  77            ;; TODO: The length counting method not correct on Chinese.
  78            (middle-line-length (when-let* ((length (- (- org-tags-column)
  79                                                       (length (string-join tags-searchable ":"))
  80                                                       (length headline-title) 2))
  81                                            ((wholenump length)))
  82                                  length)))
  83       (propertize
  84        (concat headline-title
  85                (format " %s [%s]"
  86                        (make-string (or middle-line-length 0) ?―)
  87                        (if (= (length tags-searchable) 1)
  88                            (car tags-searchable)
  89                          (string-join tags-searchable ":"))))
  90        'url url 'annotation info))))
  91
  92 (defun org-bookmarks--candidates (file)
  93   "Return a list of candidates from FILE."
  94   ;; It's better to use a temp buffer than touch the user's buffer.
  95   ;; It also cleans up after itself.
  96   (with-temp-buffer
  97     (insert-file-contents file)
  98     (delay-mode-hooks ; This will prevent user hooks from running during parsing.
  99       (org-mode)
 100       (goto-char (point-min))
 101       (let ((candidates nil))
 102         (org-element-map (org-element-parse-buffer 'headline) 'headline
 103           (lambda (headline)
 104             (when-let ((candidate (org-bookmarks--candidate headline)))
 105               (push candidate candidates))))
 106         (nreverse candidates)))))
 107
 108 (defun org-bookmarks--annotator (candidate)
 109   "Annotate bookmark completion CANDIDATE."
 110   (concat (propertize " " 'display '(space :align-to center))
 111           (get-text-property 0 'annotation candidate)))
 112
 113 (defun org-bookmarks--return-candidates (&optional file)
 114   "Return org-bookmarks candidates."
 115   (let ((file (or file org-bookmarks-file)))
 116     (org-bookmarks--candidates file)))
 117
 118 (defvar org-bookmarks--candidates-cache (org-bookmarks--return-candidates)
 119   "A cache variable of org-bookmarks--candidates.")
 120
 121 (defun org-bookmarks (&optional file)
 122   "Open bookmark read from FILE or `org-bookmarks-file'."
 123   (interactive)
 124   (if-let ((file (or file org-bookmarks-file))
 125            ((file-exists-p file)))
 126       (if-let ((candidates org-bookmarks--candidates-cache)
 127                (minibuffer-allow-text-properties t)
 128                (completion-extra-properties
 129                 ;; Using the "bookmark" category caused the annotations to not show.
 130                 ;; I think that may have be do to vertico-mode, but
 131                 ;; it's probably worth using a unique category so users can exercise finer-grained  customization.
 132                 (list :category 'org-bookmark
 133                       :annotation-function #'org-bookmarks--annotator))
 134                (choice (completing-read "org-bookmarks: " candidates nil 'require-match))
 135                (url (get-text-property 0 'url choice)))
 136           (funcall org-bookmarks-browse-function url)
 137         (user-error "No bookmarks found in %S" file))
 138     (user-error "File does not exist: %S" file)))
 139
 140 ;;; TEST:
 141 ;; (org-bookmarks "bookmarks.org")
 142 ;; (org-bookmarks (expand-file-name org-bookmarks-file))
 143
 144 ;;; Add `org-capture' template for adding new bookmark to `org-bookmarks-file'
 145 (when org-bookmarks-add-org-capture-template
 146   (require 'org-capture)
 147   (unless (assoc "b" org-capture-templates)
 148     (add-to-list
 149      'org-capture-templates
 150      `("b" ,(format "%s\tAdd a new bookmark to %s"
 151                     (when (require 'nerd-icons nil t)
 152                       (nerd-icons-mdicon "nf-md-bookmark_plus_outline" :face 'nerd-icons-blue))
 153                     org-bookmarks-file)
 154        entry (file ,(expand-file-name org-bookmarks-file))
 155        "* %^{bookmark title}
 156 :PROPERTIES:
 157 :URL:  %^C
 158 :DATE: %t
 159 :END:"
 160        :empty-lines 1
 161        :jump-to-captured t)
 162      :append)))
 163
 164 \f
 165
 166 (provide 'org-bookmarks)
 167
 168 ;;; org-bookmarks.el ends here