summaryrefslogtreecommitdiffstats
path: root/org-zettelkasten.el
blob: 90a6d94c37bc1f655bbe06c6e21b08def7c46b07 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
;;; org-zettelkasten.el --- A Zettelkasten mode leveraging Org  -*- lexical-binding: t; -*-

;; Copyright (C) 2021-2023  Yann Herklotz
;;
;; Author: Yann Herklotz <yann@ymhg.org>
;; Maintainer: Yann Herklotz <yann@ymhg.org>
;; Keywords: files, hypermedia, Org, notes
;; Homepage: https://git.sr.ht/~ymherklotz/org-zettelkasten
;; Package-Requires: ((emacs "24.3") (org "9.0"))

;; Version: 0.6.1

;; This program is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;;
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.
;;
;; You should have received a copy of the GNU General Public License
;; along with this program.  If not, see <https://www.gnu.org/licenses/>.

;;; Commentary:

;; These functions allow for the use of the zettelkasten method in org-mode.
;;
;; It uses the CUSTOM_ID property to store a permanent ID to the note,
;; which are organised in the same fashion as the notes by Luhmann.

;;; Code:

(require 'org)

(defgroup org-zettelkasten nil
  "Helper to work with zettelkasten notes."
  :group 'applications)

(defcustom org-zettelkasten-directory (expand-file-name "~/org-zettelkasten")
  "Main zettelkasten directory."
  :type 'string
  :group 'org-zettelkasten)

(defcustom org-zettelkasten-prefix [(control ?c) ?y]
  "Prefix key to use for Zettelkasten commands in Zettelkasten minor mode.
The value of this variable is checked as part of loading Zettelkasten mode.
After that, changing the prefix key requires manipulating keymaps."
  :type 'key-sequence
  :group 'org-zettelkasten)

(defun org-zettelkasten-incr-id (ident)
  "Simple function to increment any IDENT.

This might result in duplicate IDs though."
  (let* ((ident-list (append nil ident nil))
         (last-ident (last ident-list)))
    (setcar last-ident (+ (car last-ident) 1))
    (concat ident-list)))

(defun org-zettelkasten-incr-id-total (ident)
  "A better way to incement numerical IDENT.

This might still result in duplicate IDENTs for an IDENT that
ends with a letter."
  (if (string-match-p "\\(.*[a-z]\\)\\([0-9]+\\)$" ident)
      (progn
        (string-match "\\(.*[a-z]\\)\\([0-9]+\\)$" ident)
        (let ((pre (match-string 1 ident))
              (post (match-string 2 ident)))
          (concat pre (number-to-string (+ 1 (string-to-number post))))))
    (org-zettelkasten-incr-id ident)))

(defun org-zettelkasten-branch-id (ident)
  "Create a branch ID from IDENT."
  (if (string-match-p ".*[0-9]$" ident)
      (concat ident "a")
    (concat ident "1")))

(defun org-zettelkasten-org-zettelkasten-create (incr newheading)
  "Create a new heading according to INCR and NEWHEADING.

INCR: function to increment the ID by.
NEWHEADING: function used to create the heading and set the current
            POINT to it."
  (let* ((current-id (org-entry-get nil "CUSTOM_ID"))
         (next-id (funcall incr current-id)))
    (funcall newheading)
    (org-set-property "CUSTOM_ID" next-id)
    (org-set-property "EXPORT_DATE" (format-time-string (org-time-stamp-format t t)))))

(defun org-zettelkasten-create-next ()
  "Create a heading at the same level as the current one."
  (org-zettelkasten-org-zettelkasten-create
   #'org-zettelkasten-incr-id #'org-insert-heading-after-current))

(defun org-zettelkasten-create-branch ()
  "Create a branching heading at a level lower than the current."
  (org-zettelkasten-org-zettelkasten-create
   #'org-zettelkasten-branch-id
   (lambda ()
     (org-back-to-heading)
     (org-forward-heading-same-level 1 t)
     (org-insert-subheading ""))))

(defun org-zettelkasten-create-dwim ()
  "Create the right type of heading based on current position."
  (interactive)
  (let ((current-point (save-excursion
                         (org-back-to-heading)
                         (point)))
        (next-point (save-excursion
                      (org-forward-heading-same-level 1 t)
                      (point))))
    (if (= current-point next-point)
        (org-zettelkasten-create-next)
      (org-zettelkasten-create-branch))))

(defun org-zettelkasten-update-modified ()
  "Update the modified timestamp, which can be done on save."
  (interactive)
  (org-set-property "modified" (format-time-string
                                (org-time-stamp-format t t))))

(defun org-zettelkasten-search-current-id ()
  "Search for references to the current ID the `org-zettelkasten'
directory."
  (interactive)
  (let ((current-id (org-entry-get nil "CUSTOM_ID")))
    (lgrep (concat "[:[]." current-id "]") "*.org" org-zettelkasten-directory)))

(defvar org-zettelkasten-mode-map
  (let ((map (make-sparse-keymap)))
    (define-key map "n" #'org-zettelkasten-create-dwim)
    (define-key map "C-s" #'org-zettelkasten-search-current-id)
    map))

(defvar org-zettelkasten-minor-mode-map
  (let ((map (make-sparse-keymap)))
    (define-key map org-zettelkasten-prefix org-zettelkasten-mode-map)
    map)
  "Keymap used for binding footnote minor mode.")

;;;###autoload
(define-minor-mode org-zettelkasten-mode
  "Enable the keymaps to be used with zettelkasten."
  :lighter " ZK"
  :keymap org-zettelkasten-minor-mode-map)

(with-eval-after-load 'consult (require 'org-zettelkasten-consult))
(with-eval-after-load 'counsel (require 'org-zettelkasten-counsel))

(provide 'org-zettelkasten)

;;; org-zettelkasten.el ends here