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