.
676 |
--------------------------------------------------------------------------------
/README.md:
--------------------------------------------------------------------------------
1 | [](https://melpa.org/#/neuron-mode)
2 |
3 | # neuron-mode
4 |
5 | neuron-mode is an Emacs major mode derived from
6 | [markdown-mode](https://jblevins.org/projects/markdown-mode/) to edit notes
7 | using the [neuron](https://neuron.zettel.page/) Zettelkasten manager.
8 |
9 |
neuron-mode demo in doom emacs
10 |
11 | ## Installation
12 |
13 | 1. Install [neuron](https://neuron.zettel.page/2011501.html) and make sure that
14 | the `neuron` command is in your path.
15 |
16 | 2. Install neuron-mode, either via MELPA (recommended) or manually by cloning
17 | this repository.
18 |
19 | If you are using an emacs distribution like doom emacs or spacemacs, refer to
20 | [this paragraph](#appendix-integration-to-emacs-distributions) to see how
21 | neuron-mode can be integrated into your configuration.
22 |
23 | ## Features
24 |
25 | All commands are executed in the active zettelkasten which is either detected by
26 | traversing the directory hierarchy upwards until a `neuron.dhall` file is met
27 | (see [neuron configuration](https://neuron.zettel.page/2011701.html)), or
28 | otherwise it uses the zettelkasten that is specified by
29 | `neuron-default-zettelkasten-directory` (a path). Although `neuron.dhall` files
30 | are not mandatory to use neuron itself, this is what enables neuron-mode
31 | automatically when opening a markdown file. neuron-mode will then cache the
32 | zettels and regenerate it when needed (typically when creating a new zettel).
33 | Sometimes, when the zettelkasten is modified externally to neuron-mode, you
34 | might need to invalidate the cache and rebuild it manually, which is done with
35 | the `neuron-refresh` command. This will also reload the titles displayed next to
36 | zettel links (see next paragraph).
37 |
38 | #### Reading
39 |
40 | neuron-mode allows you to browse your zettelkasten directly from Emacs. Most
41 | importantly, neuron links are shown together with their titles so that you don't
42 | need to read the zettel from the associated HTML file anymore.
43 |
44 | #### Navigating
45 |
46 | neuron links can also be followed using `neuron-follow-thing-at-point`. For
47 | queries, it will prompt you to select a zettel that match the query under the
48 | point.
49 |
50 | Navigating "upwards" is also possible, using the `neuron-edit-uplink` function.
51 |
52 | #### Searching
53 |
54 | The `neuron-edit-zettel` will prompt you with the list of zettels, where you can
55 | search by title, by tag or by ID using ivy.
56 |
57 | projectile can also be useful as a complement to neuron-mode since it allows you
58 | to search the zettelkasten by content.
59 |
60 | #### Editing
61 |
62 | You can create new zettels from Emacs, neuron-mode will take care of creating
63 | the file with a generated hash in the current active zettelkasten.
64 |
65 | Links can be inserted using `neuron-insert-zettel-link` which will prompt you to
66 | select an existing zettel in the active zettelkasten. Zettels can also be linked
67 | and created on the fly by using `neuron-insert-new-zettel`. A third way to
68 | insert links, assuming that you use company, is by typing `
196 |
197 | (include those files in `.doom.d/modules/tools/neuron`)
198 |
199 | This creates a private module that can then be enabled by inserting `neuron`
200 | under the `:tools` section of your `doom!` block (inside your `init.el`).
201 |
202 | ### Spacemacs integration
203 |
204 | A spacemacs layer for neuron-mode along with installation instructions can be
205 | found in the
206 | [LightAndLight/spacemacs-neuron](https://github.com/LightAndLight/spacemacs-neuron)
207 | repository.
208 |
--------------------------------------------------------------------------------
/neuron-mode.el:
--------------------------------------------------------------------------------
1 | ;;; neuron-mode.el --- Major mode for editing zettelkasten notes using neuron -*- lexical-binding: t; -*-
2 |
3 | ;;
4 | ;; Copyright (C) 2020 felko
5 | ;;
6 | ;; Author: felko
7 | ;; Homepage: https://github.com/felko/neuron-mode
8 | ;; Keywords: outlines
9 | ;; Package-Version: 0.1
10 | ;; Package-Requires: ((emacs "26.3") (f "0.20.0") (s "1.12.0") (markdown-mode "2.3") (company "0.9.13"))
11 | ;;
12 | ;; This file is not part of GNU Emacs.
13 |
14 | ;;; License: GNU General Public License v3.0
15 | ;;
16 | ;; This program is free software; you can redistribute it and/or modify
17 | ;; it under the terms of the GNU General Public License as published by
18 | ;; the Free Software Foundation, either version 3 of the License, or
19 | ;; (at your option) any later version.
20 | ;;
21 | ;; This program is distributed in the hope that it will be useful,
22 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
23 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
24 | ;; GNU General Public License for more details.
25 | ;;
26 | ;; You should have received a copy of the GNU General Public License
27 | ;; along with this program. If not, see .
28 |
29 | ;;; Commentary:
30 | ;;
31 | ;; Editing zettelkasten notes using the neuron zettelkasten manager
32 | ;; https://neuron.zettel.page/
33 |
34 | ;;; Code:
35 |
36 | (require 'f)
37 | (require 's)
38 | (require 'cl-macs)
39 | (require 'cl-seq)
40 | (require 'json)
41 | (require 'markdown-mode)
42 | (require 'subr-x)
43 | (require 'seq)
44 | (require 'thingatpt)
45 | (require 'url-parse)
46 | (require 'url-util)
47 | (require 'simple)
48 | (require 'company)
49 | (require 'xref)
50 |
51 | (defgroup neuron nil
52 | "A major mode for editing Zettelkasten notes with neuron."
53 | :prefix "neuron-"
54 | :link '(url-link "https://github.com/felko/neuron-mode")
55 | :group 'markdown)
56 |
57 | (defcustom neuron-default-zettelkasten-directory "~/zettelkasten"
58 | "The location of the default Zettelkasten directory."
59 | :group 'neuron
60 | :type 'string
61 | :safe 'f-directory?)
62 |
63 | (defcustom neuron-generate-on-save nil
64 | "Whether to generate the necessary zettels when a buffer is saved."
65 | :group 'neuron
66 | :type 'boolean
67 | :safe 'booleanp)
68 |
69 | (defcustom neuron-executable "neuron"
70 | "Path to the neuron binary or wrapper around the neuron command.
71 | This might be useful e.g. for Windows users that need to run neuron
72 | from WSL."
73 | :group 'neuron
74 | :type 'string)
75 |
76 | (defcustom neuron-id-format 'hash
77 | "The ID format in which new zettels are created.
78 | 'hash will make neuron generate a hexadecimal 8-digit UUID.
79 | 'prompt will ask for the user to specify the ID every time a zettel is created.
80 | This can be also set to a callable that takes the title as an argument
81 | and returns the desired ID."
82 | :group 'neuron
83 | :type '(choice
84 | (symbol :tag "Let neuron handle the ID creation using CLI arguments")
85 | (function :tag "Function taking the title as argument and returning an ID")))
86 |
87 | (defcustom neuron-title-format "# %s"
88 | "Format of title of a new zettel note.
89 | This format string will be run through `format' (with title
90 | as argument) to populate the new zettel"
91 | :group 'neuron
92 | :type 'string)
93 |
94 | (defcustom neuron-daily-note-id-format "%Y-%m-%d"
95 | "Format of daily note IDs.
96 | When creating a daily note with `neuron-open-daily-notes' this format
97 | string will be run through `format-time-string' to create a zettel
98 | ID."
99 | :group 'neuron
100 | :type 'string)
101 |
102 | (defcustom neuron-daily-note-title-format "%x"
103 | "Format of daily note titles.
104 | When creating a daily note with `neuron-open-daily-notes' this format
105 | string will be run through `format-time-string' to create the title
106 | of the zettel."
107 | :group 'neuron
108 | :type 'string)
109 |
110 | (defcustom neuron-default-tags nil
111 | "List of tags to add to a newly created zettels."
112 | :group 'neuron
113 | :type '(repeat string))
114 |
115 | (defcustom neuron-daily-note-tags (list "journal/daily")
116 | "List of tags to add to a newly created daily notes file."
117 | :group 'neuron
118 | :type '(repeat string))
119 |
120 | (defcustom neuron-tag-specific-title-faces nil
121 | "Faces for links that point to a zettel having a specific tag.
122 | Overrides `neuron-title-overlay-face' which you may inherif from."
123 | :group 'neuron
124 | :type '(alist :key-type string :value-type face))
125 |
126 | (defcustom neuron-rib-server-host "localhost"
127 | "The host on which the rib server is started."
128 | :group 'neuron
129 | :type 'stringp)
130 |
131 | (defcustom neuron-rib-server-port 8080
132 | "The port on which the rib server is started."
133 | :group 'neuron
134 | :type 'integerp)
135 |
136 | (defcustom neuron-max-completion-width 30
137 | "Maximum width of the title in the completion candidates."
138 | :group 'neuron
139 | :type 'integerp)
140 |
141 | (defcustom neuron-max-trail-length 20
142 | "Maximum length of the trail.
143 | The trail stores a list of zettel IDs which tracks
144 | the previously visited zettels."
145 | :group 'neuron
146 | :type 'integerp)
147 |
148 | (defcustom neuron-title-in-buffer-name 't
149 | "Whether to include zettel titles in buffer names.
150 |
151 | If non-nil, the zettel title will be included in the buffer name."
152 | :group 'neuron
153 | :type 'booleanp)
154 |
155 | (defgroup neuron-faces nil
156 | "Faces used in neuron-mode."
157 | :group 'neuron
158 | :group 'faces)
159 |
160 | (defface neuron-link-face
161 | '((((class color) (min-colors 88) (background dark)) :foreground "burlywood")
162 | (((class color) (min-colors 88) (background light)) :foreground "sienna")
163 | (t :inherit link))
164 | "Face for zettel IDs in zettels and prompts"
165 | :group 'neuron-faces)
166 |
167 | (defface neuron-invalid-zettel-id-face
168 | '((t :inherit error))
169 | "Face for links that point to non existent zettels."
170 | :group 'neuron-faces)
171 |
172 | (defface neuron-zettel-tag-face
173 | '((t :inherit shadow))
174 | "Face for tags in prompts."
175 | :group 'neuron-faces)
176 |
177 | (defface neuron-title-overlay-face
178 | '((((class color) (min-colors 88) (background dark)) :foreground "MistyRose2" :underline "MistyRose2")
179 | (((class color) (min-colors 88) (background light)) :foreground "MistyRose4" :underline "MistyRose4")
180 | (((class color)) :foreground "grey" :underline "grey")
181 | (t :inherit italic))
182 | "Face for title overlays displayed with folgezettel links."
183 | :group 'neuron-faces)
184 |
185 | (defface neuron-invalid-link-face
186 | '((t :inherit error))
187 | "Face for the 'Unknown' label dislayed next to short links with unknown IDs."
188 | :group 'neuron-faces)
189 |
190 | (defface neuron-link-mouse-face
191 | '((t :inherit highlight))
192 | "Face displayed when hovering a zettel short link.")
193 |
194 | (defvar neuron-make-title
195 | (lambda (selection)
196 | (with-temp-buffer
197 | (insert selection)
198 | (goto-char (point-min))
199 | (call-interactively #'capitalize-dwim)
200 | (buffer-string)))
201 | "Postprocess the selected text to make the title of zettels.
202 | This function is called by `neuron-create-zettel-from-selected-title' to
203 | generate a title for the new zettel, it passes the selected text as
204 | an argument.")
205 |
206 | (defvar neuron-show-ids nil
207 | "Whether to show IDs next to zettel titles.
208 | Applies both in neuron-mode buffers and in the completion minibuffer when
209 | selecting a zettel. Can be toggled using `neuron-toggle-id-visibility'.")
210 |
211 | (defvar neuron--current-zettelkasten nil
212 | "The currently active zettelkasten.
213 | Since it can be invalid sometimes, it should only be used in internal
214 | functions when we know that the zettelkasten was just updated.")
215 |
216 | (defvar-local neuron-trail nil
217 | "List of previously visited zettels, in order.")
218 |
219 | (defun neuron--detect-zettelkasten (pwd)
220 | "Navigate upwards from PWD until a neuron.dhall file is found.
221 | When no neuron.dhall file was found, return nil."
222 | (let ((is-zk (lambda (dir) (f-exists? (f-join "/" dir "neuron.dhall")))))
223 | (f-traverse-upwards is-zk pwd)))
224 |
225 | (defun neuron--get-zettelkasten (&optional pwd)
226 | "Return the location of the current zettelkasten.
227 | Assuming the current working directory is PWD, first try to
228 | detect the zettelkasten automatically by traversing the hierarchy
229 | upwards until a neuron.dhall file is found. When no neuron.dhall
230 | file is found, return `neuron-default-zettelkasten-directory'.
231 | Lastly, if the default zettelkasten location doesn't point to
232 | an actual directory, return nil."
233 | (interactive "P")
234 | (or
235 | (neuron--detect-zettelkasten pwd)
236 | (let ((root neuron-default-zettelkasten-directory))
237 | (and (f-exists? root) (f-directory? root) neuron-default-zettelkasten-directory))))
238 |
239 | (defun neuron--update-current-zettelkasten (root)
240 | "Update `neuron--current-zettelkasten' with the new value ROOT.
241 | Refresh the zettel cache if the value has changed."
242 | (let ((old-root neuron--current-zettelkasten)
243 | (new-root (expand-file-name root)))
244 | (setq neuron--current-zettelkasten new-root)
245 | (when (or
246 | ;; When the current zettelkasten has changed since last time
247 | (and neuron--current-zettelkasten (not (equal old-root new-root)))
248 | ;; First time that a neuron-mode function was called:
249 | (not neuron--current-zettelkasten))
250 | (neuron--rebuild-cache))
251 | neuron--current-zettelkasten))
252 |
253 | (defun neuron--pop-to-buffer-same-window (buffer)
254 | (xref-push-marker-stack)
255 | (pop-to-buffer-same-window buffer))
256 |
257 | ;;;###autoload
258 | (defun neuron-zettelkasten (&optional pwd)
259 | "The location of the current Zettelkasten directory.
260 | First, it tries to detect automatically the current zettelkasten assuming
261 | the working directory is PWD, by traversing upwards in the directory
262 | hierarchy until a neuron.dhall file is met, and returns
263 | `neuron-default-zettelkasten-directory' when no neuron.dhall was found.
264 | If in turn `neuron-default-zettelkasten-directory' doesn't point to an
265 | existing directory, throw an user error."
266 | (neuron--update-current-zettelkasten
267 | (or
268 | (call-interactively 'neuron--get-zettelkasten pwd)
269 | (let ((default neuron-default-zettelkasten-directory))
270 | (and
271 | (when (not (f-exists? default))
272 | (user-error "Invalid zettelkasten: %s does not exist" default))
273 | (when (not (f-directory? default))
274 | (user-error "Invalid zettelkasten: %s is not a directory" default)))))))
275 |
276 | ;; Convenient alias when the result of `neuron-zettelkasten' isn't assigned
277 | (defun neuron-check-if-zettelkasten-exists ()
278 | "Check whether the active zettelkasten exists."
279 | (neuron-zettelkasten))
280 |
281 | (defun neuron--make-command (cmd &rest args)
282 | "Construct a neuron command CMD with argument ARGS."
283 | (let ((neuron-args
284 | (if (stringp args)
285 | (append (list "-d" neuron--current-zettelkasten cmd) args)
286 | (seq-concatenate 'list (list "-d" neuron--current-zettelkasten cmd) args))))
287 | (concat
288 | neuron-executable
289 | " "
290 | (mapconcat
291 | #'shell-quote-argument
292 | neuron-args " "))))
293 |
294 | (defun neuron--make-query-command (args)
295 | "Construct a neuron query command with the given arguments.
296 | ARGS describes the argument to pass to `neuron query'."
297 | (neuron--make-command "query" args))
298 |
299 | (defun neuron--run-command (cmd)
300 | "Run the CMD neuron command with arguments ARGS in the current zettekasten.
301 | The command is executed as a synchronous process and the standard output is
302 | returned as a string."
303 | (let* ((result (with-temp-buffer
304 | (list (call-process-shell-command cmd nil '(t nil)) (buffer-string))))
305 | (exit-code (nth 0 result))
306 | (output (nth 1 result)))
307 | (if (equal exit-code 0)
308 | (string-trim-right output)
309 | (and (user-error "Command \"%s\" exited with code %d: %s" cmd exit-code output)
310 | nil))))
311 |
312 | (defun neuron--read-query-result (output)
313 | "Parse the OUTPUT of a query command in JSON.
314 | Extract only the result itself, so the query type is lost."
315 | (json-read-from-string output))
316 |
317 | (defun neuron--query-command (args)
318 | "Run a neuron query with given arguments."
319 | (neuron--read-query-result (neuron--run-command (neuron--make-query-command args))))
320 |
321 | (defun neuron--run-rib-process (&rest args)
322 | "Run an asynchronous neuron process spawned by the rib command with arguments ARGS."
323 | (start-process-shell-command "rib" "*rib*" (apply #'neuron--make-command "rib" args)))
324 |
325 | (defun neuron--run-rib-compile (&rest args)
326 | "Run an synchronous neuron command spawned by the rib command with arguments ARGS."
327 | (compile (apply #'neuron--make-command "rib" args)))
328 |
329 | (defvar neuron--zettel-cache nil
330 | "Map containing all zettels indexed by their ID.")
331 |
332 | (defun neuron--rebuild-cache ()
333 | "Rebuild the zettel cache with the current zettelkasten."
334 | (let ((zettels (neuron--query-command "--zettels"))
335 | (assoc-id (lambda (zettel) (cons (intern (map-elt zettel 'ID)) zettel))))
336 | (setq neuron--zettel-cache (mapcar assoc-id zettels))))
337 |
338 | (defun neuron-list-buffers ()
339 | "Return the list of all open neuron-mode buffers in the current zettelkasten."
340 | (let* ((root (neuron-zettelkasten))
341 | (pred (lambda (buffer)
342 | (with-current-buffer buffer
343 | (and
344 | (eq major-mode 'neuron-mode)
345 | (f-parent-of? root buffer-file-name))))))
346 | (seq-filter pred (buffer-list))))
347 |
348 | ;;;###autoload
349 | (defun neuron-refresh ()
350 | "Regenerate the zettel cache and the title overlays in all neuron-mode buffers."
351 | (interactive)
352 | (neuron-check-if-zettelkasten-exists)
353 | (make-thread (lambda ()
354 | (progn
355 | (neuron--rebuild-cache)
356 | (dolist (buffer (neuron-list-buffers))
357 | (with-current-buffer
358 | buffer
359 | (neuron--setup-overlays)
360 | (neuron--name-buffer))
361 | (with-current-buffer buffer (neuron--name-buffer)))
362 | (message "Regenerated zettel cache")))
363 | "neuron-refresh"))
364 |
365 | (defun neuron--is-valid-id (id)
366 | "Check whether the ID is a valid neuron zettel ID.
367 | Valid IDs should be strings of alphanumeric characters."
368 | (string-match (rx bol (+ (or (char (?A . ?Z)) (char (?a . ?z)) digit (char "_-") (char " "))) eol) id))
369 |
370 | (defun neuron--make-new-command (&optional id title)
371 | (neuron-check-if-zettelkasten-exists)
372 | (unless id
373 | (setq id (pcase neuron-id-format
374 | ('prompt
375 | (if-let* ((id (read-string "ID: "))
376 | ((neuron--is-valid-id id)))
377 | id
378 | (user-error "Invalid zettel ID: %S" id)))
379 | ((pred functionp)
380 | (let ((id (funcall neuron-id-format title)))
381 | (if (neuron--is-valid-id id)
382 | id
383 | (user-error "Invalid zettel ID: %S" id)))))))
384 | (let ((args (if id (list id) nil)))
385 | (apply #'neuron--make-command "new" args)))
386 |
387 | (defun neuron-create-zettel-buffer (title &optional id no-default-tags)
388 | "Create a new zettel in the current zettelkasten.
389 | The new zettel will be generated with the given TITLE and ID if specified.
390 | When TITLE is nil, prompt the user.
391 | If NO-DEFAULT-TAGS is non-nil, don't add the tags specified the variable
392 | `neuron-default-tags'."
393 | (interactive (list (read-string "Title: ")))
394 | (neuron-check-if-zettelkasten-exists)
395 | (when (or (not id) (and id (not (neuron--get-cached-zettel-from-id id))))
396 | (let* ((cmd (neuron--make-new-command id title))
397 | (path (neuron--run-command cmd))
398 | (buffer (find-file-noselect path)))
399 | (with-current-buffer buffer
400 | (unless no-default-tags
401 | (dolist (tag neuron-default-tags)
402 | (neuron-add-tag tag)))
403 | (when title
404 | (goto-char (point-max))
405 | (newline)
406 | (insert (format neuron-title-format title)))
407 | (save-buffer))
408 | (neuron--rebuild-cache)
409 | (message "Created %s" (f-filename path))
410 | buffer)))
411 |
412 | (defun neuron--name-buffer ()
413 | "Name the zettel BUFFER according to `neuron-title-in-buffer-name'"
414 | (let* ((zettel-id (neuron--get-zettel-id (current-buffer)))
415 | (zettel-title (neuron--get-zettel-title zettel-id))
416 | (short-buffer-filename (f-filename (buffer-file-name (current-buffer))))
417 | (new-buffer-name (if neuron-title-in-buffer-name
418 | (if zettel-title
419 | (concat short-buffer-filename " (" zettel-title ")")
420 | short-buffer-filename)
421 | short-buffer-filename)))
422 | (rename-buffer new-buffer-name)))
423 |
424 | (defun neuron--get-zettel-title (id)
425 | "Get the title of the zettel with an id of ID.
426 | Returns nil if no such zettle is found."
427 | (alist-get 'Title (neuron--get-cached-zettel-from-id id) nil))
428 |
429 | ;;;###autoload
430 | (defun neuron-new-zettel (&optional title id)
431 | "Create a new zettel and open it in a new buffer.
432 | The new zettel will be generated with the given TITLE and ID if specified.
433 | When TITLE is nil, prompt the user."
434 | (interactive)
435 | (if-let (buffer (call-interactively #'neuron-create-zettel-buffer t (vector title id)))
436 | (neuron--pop-to-buffer-same-window buffer)
437 | (user-error "Unable to create zettel %s" id)))
438 |
439 | ;;;###autoload
440 | (defun neuron-open-daily-notes ()
441 | "Create or open today's daily notes."
442 | (interactive)
443 | (let* ((today (current-time))
444 | (zid (format-time-string neuron-daily-note-id-format today))
445 | (title (format-time-string neuron-daily-note-title-format today))
446 | (new (neuron-create-zettel-buffer title zid t))
447 | (path (neuron--get-zettel-path (neuron--query-zettel-from-id zid)))
448 | (buffer (or new (find-file-noselect path))))
449 | (and
450 | (neuron--pop-to-buffer-same-window buffer)
451 | (with-current-buffer buffer
452 | (when new
453 | (dolist (tag neuron-daily-note-tags)
454 | (neuron-add-tag tag)))))))
455 |
456 | (defun neuron--style-zettel-id (zid)
457 | "Style a ZID as shown in the completion prompt."
458 | (propertize (format "[[[%s]]]" zid) 'face 'neuron-link-face))
459 |
460 | (defun neuron--style-tags (tags)
461 | "Style TAGS as shown in the completion prompt when selecting a zettel."
462 | (if (eq tags [])
463 | ""
464 | (propertize (format "(%s)" (s-join ", " tags)) 'face 'neuron-zettel-tag-face)))
465 |
466 | (defun neuron--propertize-zettel (zettel)
467 | "Format ZETTEL as shown in the selection prompt."
468 | (let ((id (alist-get 'ID zettel))
469 | (title (alist-get 'Title zettel))
470 | (tags (neuron--get-zettel-tags zettel)))
471 | (format "%s %s %s" (neuron--style-zettel-id id) title (neuron--style-tags tags))))
472 |
473 | (defun neuron--select-zettel-from-list (zettels &optional prompt require-match)
474 | "Select a zettel from a given list.
475 | ZETTELS is a list of maps containing zettels (keys: id, title, day, tags, path)
476 | PROMPT is the prompt passed to `completing-read'. When REQUIRE-MATCH is
477 | non-nil require the input to match an existing zettel."
478 | (let ((selection
479 | (completing-read (or prompt "Select Zettel: ")
480 | (mapcar #'neuron--propertize-zettel zettels)
481 | nil
482 | require-match)))
483 | (if (string-match (eval `(rx bos (regexp ,neuron-link-regex))) selection)
484 | ;; The selection is among the candidates
485 | (neuron--get-cached-zettel-from-id (match-string 1 selection))
486 | (unless require-match
487 | (let ((buffer (neuron-create-zettel-buffer selection)))
488 | (neuron--get-cached-zettel-from-id (neuron--get-zettel-id buffer)))))))
489 |
490 | (defun neuron--select-zettel-from-cache (&optional prompt)
491 | "Select a zettel from the current cache.
492 | PROMPT is the prompt passed to `completing-read'."
493 | (neuron--select-zettel-from-list (map-values neuron--zettel-cache) prompt t))
494 |
495 | (defun neuron--select-zettel-from-query (args)
496 | "Select a zettel from a query.
497 | ARGS is the arguments to pass to the neuron query command."
498 | (neuron--select-zettel-from-list (neuron--query-command args) nil t))
499 |
500 | (defun neuron-select-zettel (&optional prompt)
501 | "Find a zettel in the current zettelkasten.
502 | PROMPT is the prompt passed to `completing-read'."
503 | (neuron-check-if-zettelkasten-exists)
504 | (neuron--select-zettel-from-cache prompt))
505 |
506 | (defun neuron--get-zettel-path (zettel)
507 | "Get the absolute path of ZETTEL."
508 | (f-join "/" neuron--current-zettelkasten (alist-get 'Path zettel)))
509 |
510 | (defun neuron--get-plugin-data (plugin-data-list plugin i)
511 | "Extract from all plugin data the part that is relevant for a given plugin.
512 | PLUGIN-DATA-LIST is in the JSON representation of the plugin data and PLUGIN
513 | is the plugin name."
514 | (if (eq i (length plugin-data-list))
515 | nil
516 | (let* ((data (aref plugin-data-list i))
517 | (name (aref (aref data 0) 0)))
518 | (if (equal name plugin)
519 | (aref data 1)
520 | (neuron--get-plugin-data plugin-data-list plugin (+ i 1))))))
521 |
522 | (defun neuron--get-zettel-tags (zettel)
523 | "Get the tags of ZETTEL."
524 | (alist-get 'Tagged (neuron--get-plugin-data (alist-get 'PluginData zettel) "Tags" 0)))
525 |
526 | ;;;###autoload
527 | (defun neuron-edit-zettel (zettel)
528 | "Select and edit ZETTEL."
529 | (interactive (list (neuron-select-zettel "Edit zettel: ")))
530 | (neuron--edit-zettel-from-path (neuron--get-zettel-path zettel)))
531 |
532 | (defun neuron--get-uplinks-from-id (id)
533 | "Get the list of zettels that point to the zettel ID."
534 | (when-let* ((cmd (neuron--make-command "query" "--uplinks-of" id))
535 | (output (neuron--run-command cmd))
536 | (results (neuron--read-query-result output)))
537 | (mapcar (lambda (result) (seq-elt result 1)) results)))
538 |
539 | (defun neuron-edit-uplink ()
540 | "Select and edit a zettel among the ones that link to the current zettel."
541 | (interactive)
542 | (neuron-check-if-zettelkasten-exists)
543 | (let* ((id (neuron--get-zettel-id))
544 | (uplinks (neuron--get-uplinks-from-id id)))
545 | (neuron-edit-zettel (neuron--select-zettel-from-list uplinks "Edit uplink: " t))))
546 |
547 | ;;;###autoload
548 | (defun neuron-edit-zettelkasten-configuration ()
549 | "Open the neuron.dhall configuration file at the root of the zettelkasten."
550 | (interactive)
551 | (find-file (f-join "/" (neuron-zettelkasten) "neuron.dhall")))
552 |
553 | (defun neuron--select-static-file (&optional allow-copy)
554 | "Select a file located in the static directory of the current zettelkasten.
555 | If ALLOW-COPY is non-nil and that the selected file is not in the static
556 | directory, prompt the user if they want to copy it to the static directory,
557 | otherwise return nil."
558 | (let* ((root (neuron-zettelkasten))
559 | (static-dir (f-join "/" root "static"))
560 | (path (read-file-name "Select static file: " static-dir nil t)))
561 | (if (f-descendant-of? path static-dir)
562 | path
563 | (if (and allow-copy
564 | (y-or-n-p (format "File %s is not in the static directory, copy it to %sstatic? " path root)))
565 | (let ((copied-path (f-join "/" static-dir (f-filename path))))
566 | (copy-file path copied-path)
567 | copied-path)
568 | (user-error "File %s is not in %sstatic" path root)))))
569 |
570 | (defun neuron-insert-static-link (path)
571 | "Insert a link to PATH in the static directory."
572 | (interactive (list (neuron--select-static-file t)))
573 | (when path
574 | (insert (format "[](%s)" (f-relative path neuron--current-zettelkasten)))))
575 |
576 | (defun neuron--insert-zettel-link-from-id (id)
577 | "Insert a zettel link."
578 | (progn
579 | (insert (format "[[[%s]]]" id))
580 | (neuron--setup-overlays)))
581 |
582 | (defun neuron-insert-zettel-link ()
583 | "Insert a markdown hypertext link to another zettel."
584 | (interactive)
585 | (neuron-check-if-zettelkasten-exists)
586 | (neuron--insert-zettel-link-from-id (map-elt (neuron-select-zettel "Link zettel: ") 'ID)))
587 |
588 | (defun neuron-insert-new-zettel ()
589 | "Create a new zettel."
590 | (interactive)
591 | (neuron-check-if-zettelkasten-exists)
592 | (when-let* ((buffer (call-interactively #'neuron-create-zettel-buffer))
593 | (id (neuron--get-zettel-id buffer)))
594 | (progn
595 | (neuron--insert-zettel-link-from-id id)
596 | (save-buffer)
597 | (neuron--rebuild-cache)
598 | (neuron--pop-to-buffer-same-window buffer)
599 | (message "Created %s" (buffer-name buffer)))))
600 |
601 | (defun neuron-create-zettel-from-selected-title ()
602 | "Transforms the selected text into a new zettel with the selection as a title."
603 | (interactive)
604 | (when-let* ((selection (buffer-substring-no-properties (region-beginning) (region-end)))
605 | (title (if (s-blank? selection)
606 | (user-error "Cannot create zettel: empty title")
607 | (funcall neuron-make-title selection)))
608 | (buffer (funcall-interactively #'neuron-create-zettel-buffer title))
609 | (id (neuron--get-zettel-id buffer)))
610 | (save-excursion
611 | (delete-region (region-beginning) (region-end))
612 | (goto-char (region-beginning))
613 | (neuron--insert-zettel-link-from-id id)
614 | (neuron--setup-overlays))))
615 |
616 | (defun neuron-create-and-insert-zettel-link (no-prompt)
617 | "Insert a markdown hypertext link to another zettel.
618 | If the selected zettel does not exist it will be created. When
619 | NO-PROMPT is non-nil do not prompt when creating a new zettel."
620 | (interactive "P")
621 | (neuron-check-if-zettelkasten-exists)
622 | (let* ((selection
623 | (neuron--select-zettel-from-list
624 | (map-values neuron--zettel-cache)
625 | "Link zettel: "))
626 | (id (and (listp selection) (alist-get 'ID selection))))
627 | (pcase selection
628 | ;; Existing zettel:
629 | ((guard id)
630 | (neuron--insert-zettel-link-from-id id))
631 | ;; Title of new zettel:
632 | ((pred stringp)
633 | (when (or no-prompt
634 | (y-or-n-p (concat "Create a new zettel (" selection ")? ")))
635 | (let* ((buffer (neuron-create-zettel-buffer selection))
636 | (id (neuron--get-zettel-id buffer)))
637 | (neuron--rebuild-cache)
638 | (neuron--insert-zettel-link-from-id id)))))))
639 |
640 | (defun neuron-toggle-connection-type ()
641 | "Toggle the link under point between folgezettel and cf connection."
642 | (interactive)
643 | (if (thing-at-point-looking-at
644 | neuron-link-regex
645 | ;; limit to current line
646 | (max (- (point) (line-beginning-position))
647 | (- (line-end-position) (point))))
648 | (if-let* ((link (match-string 1))
649 | (start (match-beginning 0))
650 | (end (match-end 0))
651 | (conn (if (null (match-string 2)) 'ordinary 'folgezettel))
652 | (query (neuron--parse-query-from-url-or-id link (eq conn 'folgezettel)))
653 | (toggled (if (eq conn 'folgezettel) 'ordinary 'folgezettel))
654 | (new-query (progn (setf (map-elt query 'conn nil) toggled) query)))
655 | (save-excursion
656 | (goto-char start)
657 | (delete-region start end)
658 | (insert (neuron-render-query new-query))
659 | (neuron--setup-overlays))
660 | (user-error "Invalid query"))
661 | (user-error "No query under point")))
662 |
663 | (defun neuron--flatten-tag-node (node &optional root)
664 | "Flatten NODE into a list of tags.
665 | Each element is a map containing 'tag and 'count keys.
666 | The full tag is retrieved from the ROOT argument that is passed recursively.
667 | See `neuron--flatten-tag-tree'."
668 | (let* ((name (map-elt node 'name))
669 | (count (map-elt node 'count))
670 | (children (map-elt node 'children))
671 | (tag (if root (concat root "/" name) name))
672 | (elem (list (cons 'count count) (cons 'tag tag))))
673 | (cons elem (neuron--flatten-tag-tree children tag))))
674 |
675 | (defun neuron--flatten-tag-tree (tree &optional root)
676 | "Flatten TREE into a list of tags.
677 | Each element is a map containing 'tag and 'count keys.
678 | The full tag is retrieved from the ROOT argument that is passed recursively."
679 | (apply #'append (mapcar (lambda (node) (neuron--flatten-tag-node node root)) tree)))
680 |
681 | (defun neuron--propertize-tag (elem)
682 | "Format ELEM as shown in the tag selection prompt.
683 | ELEM is a map containing the name of the tag and the number of associated zettels."
684 | (let* ((tag (alist-get 'tag elem))
685 | (count (alist-get 'count elem))
686 | (display-count (propertize (format "(%d)" count) 'face 'shadow)))
687 | (format "%s %s" tag display-count)))
688 |
689 | (defun neuron--select-tag-from-query (args &optional prompt require-match)
690 | "Prompt for a tag that is matched by the query.
691 | ARGS is the arguments to pass to the neuron query command.
692 | PROMPT is the prompt that appears when asked to select the tag.
693 | If REQUIRE-MATCH is non-nil require user input to match an existing tag."
694 | (let ((tags (append (neuron--query-command args) nil)))
695 | (completing-read (or prompt "Select tag: ")
696 | tags
697 | nil
698 | require-match)))
699 |
700 | (defun neuron--get-metadata-block-bounds (&optional create-if-missing)
701 | "Return the bounds of the metadata block.
702 | If CREATE-IF-MISSING is non-nil, insert automatically the YAML metadata
703 | blocks delimiters (---)."
704 | (save-excursion
705 | (goto-char (point-min))
706 | (when-let* ((delim (rx bol "---" (0+ blank) eol))
707 | (begin (if (looking-at-p delim) (point)
708 | (when create-if-missing
709 | (save-excursion (insert "---\n---\n"))
710 | (point))))
711 | (end (save-excursion
712 | (goto-char begin)
713 | (forward-line)
714 | (while (not (looking-at-p delim))
715 | (forward-line))
716 | (point))))
717 | (list begin end))))
718 |
719 | (defun neuron--navigate-to-metadata-field (field)
720 | "Move point to the character after metadata FIELD.
721 | If FIELD does not exist it is created."
722 | (goto-char (point-min))
723 | (let* ((block-end (nth 1 (neuron--get-metadata-block-bounds 'create-if-missing)))
724 | (fieldre (rx-to-string `(: bol (0+ blank) ,field ":" (0+ blank)))))
725 | (unless (search-forward-regexp fieldre block-end t)
726 | (goto-char block-end)
727 | (forward-line -1)
728 | (end-of-line)
729 | (insert (concat "\n" field ": ")))))
730 |
731 | (defun neuron-select-tag (&optional prompt require-match)
732 | "Prompt for a tag that is already used in the zettelkasten.
733 | PROMPT is the prompt passed to `completing-read'.
734 | If REQUIRE-MATCH is non-nil require user input to match an existing
735 | tag."
736 | (neuron-check-if-zettelkasten-exists)
737 | (neuron--select-tag-from-query "--tags" prompt require-match))
738 |
739 | (defun neuron-select-multiple-tags (&optional prompt)
740 | "Select multiple tags as a comma-separated list.
741 | PROMPT is the prompt passed to `completing-read'."
742 | (let* ((query-result (neuron--query-command "--tags"))
743 | (tags (mapcar (lambda (el) (alist-get 'tag el)) query-result)))
744 | (completing-read-multiple (or prompt "Select tags: ") tags)))
745 |
746 | (defun neuron-add-tags (tags)
747 | "Add multiple TAGS to the tags metadata field.
748 | When called interactively it promps for multiple comma-separated tags."
749 | (interactive (list (neuron-select-multiple-tags)))
750 | (save-excursion
751 | (neuron--navigate-to-metadata-field "tags")
752 | (dolist (tag tags)
753 | (insert (format "\n - %s" tag)))))
754 |
755 | (defun neuron-add-tag (tag)
756 | "Add TAG to the list of tags.
757 | When called interactively this command prompts for a tag."
758 | (interactive (list (neuron-select-tag)))
759 | (neuron-add-tags (list tag)))
760 |
761 | ;;;###autoload
762 | (defun neuron-query-tags (&rest tags)
763 | "Select and edit a zettel from those that are tagged by TAGS."
764 | (interactive (list (neuron-select-tag "Search by tag: " t)))
765 | (neuron-edit-zettel
766 | (neuron--select-zettel-from-list
767 | (seq-mapcat
768 | (lambda (tag) (neuron--query-command (format "--tag=%s" tag)))
769 | tags
770 | 'list))))
771 |
772 | (defun neuron--edit-zettel-from-path (path)
773 | "Open a neuron zettel from PATH."
774 | (let ((buffer (find-file-noselect path)))
775 | (neuron--pop-to-buffer-same-window buffer)))
776 |
777 | (defun neuron--query-zettel-from-id (id)
778 | "Query a single zettel from the active zettelkasten from its ID.
779 | Returns a map containing its title, tag and full path."
780 | (neuron--read-query-result (neuron--run-command (neuron--make-command "query" "--id" id))))
781 |
782 | (defun neuron--get-cached-zettel-from-id (id &optional retry)
783 | "Fetch a cached zettel from its ID.
784 | When RETRY is non-nil and that the ID wasn't found, the cache is regenerated
785 | and queried a second time. This is called internally to automatically refresh
786 | the cache when the ID is not found."
787 | (or (map-elt neuron--zettel-cache (intern id))
788 | (when retry
789 | (neuron--rebuild-cache)
790 | (or (map-elt neuron--zettel-cache (intern id))
791 | (user-error "Cannot find zettel with ID %s" id)))))
792 |
793 | (defun neuron--edit-zettel-from-id (id)
794 | "Open a neuron zettel from ID."
795 | (if-let ((zettel (neuron--get-cached-zettel-from-id id)))
796 | (neuron-edit-zettel zettel)
797 | (user-error "Zettel %s does not exist" id)))
798 |
799 | (defun neuron--edit-zettel-from-query (args)
800 | "Select and edit a zettel from a query.
801 | ARGS is the arguments to pass to the neuron query command."
802 | (neuron-edit-zettel (neuron--select-zettel-from-query args)))
803 |
804 | (defun neuron--get-zettel-id (&optional buffer)
805 | "Extract the zettel ID of BUFFER."
806 | (interactive "b")
807 | (f-base (buffer-file-name buffer)))
808 |
809 | (defun neuron--open-page (rel-path)
810 | "Open the REL-PATH in the browser.
811 | The path is relative to the neuron output directory."
812 | (let* ((path (f-join "/" neuron--current-zettelkasten ".neuron" "output" rel-path))
813 | (url (format "file://%s" path)))
814 | (browse-url url)))
815 |
816 | (defun neuron--open-zettel-from-id (id)
817 | "Open the generated HTML file from the zettel ID."
818 | (neuron--open-page (format "%s.html" id)))
819 |
820 | ;;;###autoload
821 | (defun neuron-open-zettel ()
822 | "Select a zettel and open the associated HTML file."
823 | (interactive)
824 | (neuron-check-if-zettelkasten-exists)
825 | (neuron--open-zettel-from-id (map-elt (neuron-select-zettel "Open zettel: ") 'ID)))
826 |
827 | (defun neuron-open-index ()
828 | "Open the index.html file."
829 | (interactive)
830 | (neuron-check-if-zettelkasten-exists)
831 | (neuron--open-page "index.html"))
832 |
833 | (defun neuron-open-current-zettel ()
834 | "Open the current zettel's HTML file in the browser."
835 | (interactive)
836 | (neuron-check-if-zettelkasten-exists)
837 | (neuron--open-zettel-from-id (funcall-interactively #'neuron--get-zettel-id)))
838 |
839 | (defconst neuron-link-regex
840 | (concat "\\[\\{2,3\\}\\(z:" thing-at-point-url-path-regexp "\\|[[:alnum:]-_ ]+\\(?:\?[^][\t\n\\ {}]*\\)?\\)]]\\(]\\)*")
841 | "Regex matching zettel links like [[[URL/ID]]] or [[URL/ID]] .
842 | Group 1 is the matched ID or URL.")
843 |
844 |
845 | (defun neuron--extract-id-from-partial-url (url)
846 | "Extract the ID from a single zettel URL."
847 | (let* ((struct (url-generic-parse-url url))
848 | (path (car (url-path-and-query struct)))
849 | (type (url-type struct))
850 | (parts (s-split "/" path)))
851 | (pcase (length parts)
852 | (1 (when (not type) path)) ; path is ID
853 | (2 (when (and (equal type "z") (equal (nth 0 parts) "zettel")) (nth 1 parts))))))
854 |
855 | (defun neuron--follow-query (query)
856 | "Follow a neuron link from a zettel ID or an URL.
857 | QUERY is a query object as described in `neuron--parse-query-from-url-or-id'."
858 | (let ((url (map-elt query 'url)))
859 | (pcase (map-elt query 'type)
860 | ('zettel (neuron--edit-zettel-from-id (alist-get 'id query)))
861 | ('zettels (neuron--edit-zettel-from-query url))
862 | ('tags (neuron-query-tags (neuron--select-tag-from-query url "Search by tag: "))))))
863 |
864 | (defun neuron--parse-query-from-url-or-id (url-or-id folgezettel?)
865 | "Parse a neuron URL or a raw zettel ID as an object representing the query.
866 | URL-OR-ID is a string that is meant to be parsed inside neuron links inside
867 | angle brackets. The query is returned as a map having at least a `'type' field.
868 | When URL-OR-ID is a raw ID, or that it is an URL having startin with z:zettel,
869 | the map also has an `ID' field. Whenever URL-OR-ID is an URL and not an
870 | ID, the map features an `'url' field."
871 | (let* ((struct (url-generic-parse-url url-or-id))
872 | (path-and-query (url-path-and-query struct))
873 | (path (car path-and-query))
874 | (query (cdr path-and-query))
875 | (parts (s-split "/" path))
876 | (type (url-type struct))
877 | (args (when query (url-parse-query-string query)))
878 | (conn (if folgezettel? 'folgezettel 'ordinary))
879 | (common `((conn . ,conn)
880 | (url . ,url-or-id)
881 | (args . ,(assoc-delete-all "cf" args)))))
882 | (append
883 | common
884 | (if (equal type "z")
885 | (pcase (car parts)
886 | ("zettel" (when-let ((id (nth 1 parts))) `((type . zettel) (id . ,id))))
887 | ("zettels" `((type . zettels)))
888 | ("tags" `((type . tags))))
889 | ;; Probably just an ID
890 | `((type . zettel) (id . ,path))))))
891 |
892 | ;; FIXME avoid hexifying link
893 | (defun neuron-render-query (query)
894 | "Render a neuron query in markdown.
895 | QUERY is an alist containing at least the query type and the URL."
896 | (let* ((args (alist-get 'args query))
897 | (conn (alist-get 'conn query))
898 | (link-opening (if (eq conn 'ordinary) "[[" "[[["))
899 | (link-closing (if (eq conn 'ordinary) "]]" "]]]"))
900 | (url-args args)
901 | (url-query (url-build-query-string url-args))
902 | (url-suffix (if url-args (format "?%s" url-query) "")))
903 | (pcase (alist-get 'type query)
904 | ('zettel (format "%s%s%s%s" link-opening (alist-get 'id query) url-suffix link-closing))
905 | ('zettels (format "%sz:zettels%s%s" link-opening url-suffix link-closing))
906 | ('tags (format "%sz:tags%s%s" link-opening url-suffix link-closing)))))
907 |
908 | ;;;###autoload
909 | (defun neuron-follow-thing-at-point ()
910 | "Open the zettel link at point."
911 | (interactive)
912 | (neuron-check-if-zettelkasten-exists)
913 | ;; New links (from the `thing-at-point' demo)
914 | (if (thing-at-point-looking-at
915 | neuron-link-regex
916 | ;; limit to current line
917 | (max (- (point) (line-beginning-position))
918 | (- (line-end-position) (point))))
919 | (if-let ((query (neuron--parse-query-from-url-or-id (match-string 1) 't)))
920 | (neuron--follow-query query)
921 | (user-error "Invalid query"))
922 | ;; Old style links
923 | ;; TODO deprecate
924 | (let* ((link (markdown-link-at-pos (point)))
925 | (id (nth 2 link))
926 | (url (nth 3 link))
927 | (struct (url-generic-parse-url url))
928 | (type (url-type struct)))
929 | (pcase type
930 | ((or "z" "zcf") (neuron--edit-zettel-from-id id))
931 | ((or "zquery" "zcfquery")
932 | (pcase (url-host struct)
933 | ("search" (neuron-edit-zettel (neuron--select-zettel-from-query url)))
934 | ("tags" (neuron-query-tags (neuron--select-tag-from-query url)))))
935 | (_ (markdown-follow-thing-at-point link))))))
936 |
937 | ;;;###autoload
938 | (defun neuron-rib-watch ()
939 | "Start a web app for browsing the zettelkasten."
940 | (interactive)
941 | (let ((root (neuron-zettelkasten)))
942 | (if (neuron--run-rib-process "-w")
943 | (message "Watching %s for changes..." root)
944 | (user-error "Failed to watch %s" root))))
945 |
946 | ;;;###autoload
947 | (defun neuron-rib-serve ()
948 | "Start a web app for browsing the zettelkasten."
949 | (interactive)
950 | (neuron-check-if-zettelkasten-exists)
951 | (let ((address (format "%s:%d" neuron-rib-server-host neuron-rib-server-port)))
952 | (if (neuron--run-rib-process "-ws" address)
953 | (message "Started web application on %s" address)
954 | (user-error "Failed to run rib server on %s" address))))
955 |
956 | ;;;###autoload
957 | (defun neuron-rib-generate ()
958 | "Do an one-off generation of the web interface of the zettelkasten."
959 | (interactive)
960 | (let ((root (neuron-zettelkasten)))
961 | (if (neuron--run-rib-compile)
962 | (message "Generated HTML files")
963 | (user-error "Failed to generate %s" root))))
964 |
965 | ;;;###autoload
966 | (defun neuron-rib-open-page (page)
967 | "Open the web-application at page PAGE."
968 | (neuron-check-if-zettelkasten-exists)
969 | (browse-url (format "http://%s:%d/%s" neuron-rib-server-host neuron-rib-server-port page)))
970 |
971 | ;;;###autoload
972 | (defun neuron-rib-open-z-index ()
973 | "Open the web application in the web browser at z-index."
974 | (interactive)
975 | (neuron-check-if-zettelkasten-exists)
976 | (neuron-rib-open-page "z-index.html"))
977 |
978 | (defun neuron-rib-open-current-zettel ()
979 | "Open the web application in the web browser at the current zettel note."
980 | (interactive)
981 | (neuron-check-if-zettelkasten-exists)
982 | (let ((id (f-base (buffer-file-name))))
983 | (neuron-rib-open-page (concat id ".html"))))
984 |
985 | ;;;###autoload
986 | (defun neuron-rib-open-zettel ()
987 | "Open a zettel in the web application."
988 | (interactive)
989 | (neuron-check-if-zettelkasten-exists)
990 | (let ((zettel (neuron-select-zettel)))
991 | (neuron-rib-open-page (concat (map-elt zettel 'ID) ".html"))))
992 |
993 | (defun neuron-rib-kill ()
994 | "Stop the web application."
995 | (interactive)
996 | (kill-buffer "*rib*"))
997 |
998 | (defconst neuron-tag-component-regex
999 | "[A-Za-z0-9-_]+"
1000 | "Regex matching a tag component.")
1001 |
1002 | (defconst neuron-tag-regex
1003 | (eval `(rx (* (regexp ,neuron-tag-component-regex) "/") (regexp ,neuron-tag-component-regex)))
1004 | "Regex matching a possibly hierarchical tag.")
1005 |
1006 | (defun neuron--make-tag-pattern-component-regex (component &optional leading-slash)
1007 | "Translate the component COMPONENT of a tag pattern into a regex.
1008 | If LEADING-SLASH is non-nil, introduce a leading `/' character in front
1009 | of the necessary regexes."
1010 | (let ((prefix (if leading-slash "/" "")))
1011 | (pcase component
1012 | ((pred (string-match neuron-tag-component-regex))
1013 | (eval `(rx ,prefix ,(regexp-quote component))))
1014 | ("*"
1015 | (eval `(rx ,prefix (group (regexp ,neuron-tag-component-regex)))))
1016 | ("**"
1017 | (eval `(rx (? ,prefix (group (* (regexp ,neuron-tag-component-regex) "/") (regexp ,neuron-tag-component-regex)))))))))
1018 |
1019 | (defun neuron--make-tag-pattern-regex (pattern)
1020 | "Transform a tag pattern PATTERN into a regex."
1021 | (let* ((components (s-split "/" pattern t))
1022 | (concat-patterns (lambda (pat1 pat2)
1023 | (eval `(rx (regexp ,pat1) (regexp ,pat2)))))
1024 | (append-comp-pattern (lambda (pat comp)
1025 | (funcall concat-patterns pat (neuron--make-tag-pattern-component-regex comp 'leading-slash))))
1026 | (remaining (cl-reduce append-comp-pattern (cdr components) :initial-value ""))
1027 | (tag-pattern
1028 | (funcall concat-patterns (neuron--make-tag-pattern-component-regex (car components)) remaining)))
1029 | (eval `(rx bow (regexp ,tag-pattern) eow))))
1030 |
1031 | (defun neuron--replace-tag-in-current-zettel (pattern repl)
1032 | "Replace tags matched by PATTERN to a replacement REPL.
1033 | REPL is a string that may contain substrings like `\\N' where
1034 | N denotes the tag components that were matched by the Nth
1035 | glob."
1036 | (save-excursion
1037 | (when-let* ((tag-regex (neuron--make-tag-pattern-regex pattern))
1038 | (bounds (neuron--get-metadata-block-bounds)))
1039 | (goto-char (nth 1 bounds))
1040 | (while (re-search-backward tag-regex nil t)
1041 | (replace-match repl 'fixed-case)))))
1042 |
1043 | ;;;###autoload
1044 | (defun neuron-replace-tag (pattern repl)
1045 | "Map all tags matching PATTERN to a REPL.
1046 | PATTERN is a tag glob as used in neuron queries.
1047 | REPL is a string that may contain substrings like `\\N' where
1048 | N denotes the tag components that were matched by the Nth glob
1049 | pattern.
1050 | Example:
1051 | `(neuron-add-tag \"**/theorem\" \"math/theorem/\\1\")'
1052 | will replace number-theory/theorem to math/theorem/number-theory
1053 | and algebra/linear/theorem to math/theorem/algebra/linear."
1054 | (interactive (list
1055 | (read-string "Tag pattern: ")
1056 | (read-string "Replacement: ")))
1057 | (neuron--rebuild-cache)
1058 | (let ((current-buffers (neuron-list-buffers)))
1059 | (map-do
1060 | (lambda (_ zettel) (when-let* ((path (neuron--get-zettel-path zettel))
1061 | (buffer (find-file-noselect path)))
1062 | (with-current-buffer buffer
1063 | (neuron--replace-tag-in-current-zettel pattern repl)
1064 | (save-buffer))
1065 | (unless (member buffer current-buffers)
1066 | (kill-buffer buffer))))
1067 | neuron--zettel-cache)
1068 | (message "Replaced all tags")))
1069 |
1070 | (defun neuron--get-title-face-for-tags (tags)
1071 | "Return the face of the title overlay based on the zettel's list of tags TAGS.
1072 | It picks the faces from the `neuron-tag-specific-title-faces' variable.
1073 | When no tag has a particular face, return the default `neuron-title-overlay-face'."
1074 | (or (catch 'found-face
1075 | (pcase-dolist (`(,tag . ,face) neuron-tag-specific-title-faces)
1076 | (when (seq-contains-p tags tag)
1077 | (throw 'found-face (car face)))))
1078 | 'neuron-title-overlay-face))
1079 |
1080 | (defun neuron--setup-overlay-from-id (ov id conn)
1081 | "Setup a single title overlay from a zettel ID.
1082 | OV is the overay to setup or update and CONN describes whether the link is a
1083 | folgezettel or an ordinary connection."
1084 | (if-let* ((zettel (ignore-errors (neuron--get-cached-zettel-from-id id)))
1085 | (title (alist-get 'Title zettel))
1086 | (title-face (neuron--get-title-face-for-tags (neuron--get-zettel-tags zettel)))
1087 | (title-suffix (if (eq conn 'folgezettel) " ᛦ" "")))
1088 | (if neuron-show-ids
1089 | (progn
1090 | (overlay-put ov 'display nil)
1091 | (overlay-put ov 'after-string (format " %s" (propertize title 'face title-face))))
1092 | (overlay-put ov 'after-string nil)
1093 | (overlay-put ov 'display (format "%s%s" (propertize title 'face title-face) title-suffix)))
1094 | ))
1095 |
1096 | (defun neuron--overlay-update (ov after &rest _)
1097 | "Delete the title overlay OV on modification.
1098 | When AFTER is non-nil, this hook is being called after the update occurs."
1099 | (let ((link (buffer-substring (overlay-start ov) (overlay-end ov))))
1100 | (when after
1101 | (if (string-match neuron-link-regex link)
1102 | (let* ((link (match-string 1 link))
1103 | (folgezettel? (not (null (match-string 2))))
1104 | (query (neuron--parse-query-from-url-or-id link folgezettel?)))
1105 | (if query (neuron--setup-overlay-from-query ov query)
1106 | (overlay-put ov 'face 'neuron-invalid-link-face)))
1107 | (delete-overlay ov)))))
1108 |
1109 | (defun neuron--setup-overlay-from-query (ov query)
1110 | "Setup a overlay OV from any zettel link QUERY."
1111 | (overlay-put ov 'evaporate t)
1112 | (overlay-put ov 'modification-hooks (list #'neuron--overlay-update))
1113 | (overlay-put ov 'face 'neuron-link-face)
1114 | (overlay-put ov 'mouse-face 'neuron-link-mouse-face)
1115 | (overlay-put ov 'keymap neuron-mode-link-map)
1116 | (when (equal (alist-get 'type query) 'zettel)
1117 | (neuron--setup-overlay-from-id ov (alist-get 'id query) (alist-get 'conn query))))
1118 |
1119 | (defun neuron--setup-overlays ()
1120 | "Setup title overlays on zettel links."
1121 | (remove-overlays)
1122 | (save-excursion
1123 | (goto-char (point-min))
1124 | (while (re-search-forward neuron-link-regex nil t)
1125 | (let* ((ov (make-overlay (match-beginning 0) (match-end 0) nil t nil))
1126 | (id-string (match-string 1))
1127 | (closing-bracket (match-string 2))
1128 | (folgezettel? (not (null closing-bracket)))
1129 | (query (neuron--parse-query-from-url-or-id id-string folgezettel?)))
1130 | (neuron--setup-overlay-from-query ov query)))))
1131 |
1132 | ;;;###autoload
1133 | (defun neuron-toggle-id-visibility ()
1134 | "Toggle the visibility of IDs in simple links.
1135 | This can be useful to debug when searching for ID, explicitly seeing whether the
1136 | link is a folgezettel of ordinary connection."
1137 | (interactive)
1138 | (setq neuron-show-ids (not neuron-show-ids))
1139 | (dolist (buffer (neuron-list-buffers))
1140 | (with-current-buffer buffer (neuron--setup-overlays))))
1141 |
1142 | ;; Completion
1143 |
1144 | (defun company-neuron--prefix ()
1145 | "Extract the completion prefix, triggered by entering an opening angle bracket."
1146 | (and (derived-mode-p 'neuron-mode)
1147 | (when (looking-back (rx "<" (group (+ (not (any ">"))))) nil)
1148 | (match-string 1))))
1149 |
1150 | (defun company-neuron--fuzzy-match-title (prefix candidate)
1151 | "Return whether PREFIX fuzzily matches the title of the CANDIDATE zettel."
1152 | (let ((full-title (alist-get 'Title (get-text-property 0 'zettel candidate))))
1153 | (cl-subsetp (string-to-list prefix)
1154 | (string-to-list full-title))))
1155 |
1156 | (defun company-neuron--propertize-completion-candidate (zettel)
1157 | "Propertize a zettel title to contain all information about ZETTEL.
1158 | The resulting title is truncated and padded to fit the width given by
1159 | `neuron-max-completion-width'."
1160 | (let* ((title (alist-get 'Title zettel))
1161 | (padded (s-pad-right neuron-max-completion-width " " title))
1162 | (truncated (s-truncate neuron-max-completion-width padded)))
1163 | (propertize truncated 'zettel zettel)))
1164 |
1165 | (defun company-neuron--all-candidates ()
1166 | "Propertize all cached zettels to provide completion candidates."
1167 | (mapcar #'company-neuron--propertize-completion-candidate neuron--zettel-cache))
1168 |
1169 | (defun company-neuron--candidates (prefix)
1170 | "Filter the candidates by fuzzily matching PREFIX against the candidates."
1171 | (cl-remove-if-not
1172 | (lambda (candidate) (company-neuron--fuzzy-match-title prefix candidate))
1173 | (company-neuron--all-candidates)))
1174 |
1175 | (defun company-neuron--completion-annotation (candidate)
1176 | "Annotate the completion CANDIDATE so that it includes the ID of the underlying zettel."
1177 | (let* ((zettel (get-text-property 0 'zettel candidate))
1178 | (annot (format "<%s>" (alist-get 'ID zettel))))
1179 | (concat " " (propertize annot 'face 'neuron-link-face))))
1180 |
1181 | (defun company-neuron--completion-meta (candidate)
1182 | "Display information about the underlying zettel of CANDIDATE.
1183 | The resulting string contains the ID, the full title of the zettel, as well as
1184 | the list of its tags."
1185 | (let ((zettel (get-text-property 0 'zettel candidate)))
1186 | (neuron--propertize-zettel zettel)))
1187 |
1188 | (defun company-neuron--post-completion-action (candidate)
1189 | "Delete the completed zettel title CANDIDATE and replace it with an actual neuron link."
1190 | (let ((begin (point))
1191 | (zettel (get-text-property 0 'zettel candidate)))
1192 | (when (re-search-backward (rx "<"))
1193 | (goto-char begin)
1194 | (delete-region begin (match-end 0))
1195 | (insert (concat (alist-get 'ID zettel) ">"))
1196 | (neuron--setup-overlays))))
1197 |
1198 | ;;;###autoload
1199 | (defun company-neuron (command &optional arg &rest ignored)
1200 | "Defines a company completion backend that completes zettels by title.
1201 | COMMAND is the relevant command provided by company.
1202 | ARG is the command argument, depending on which command was received.
1203 | IGNORED is the rest of the arguments, not sure why it's there."
1204 | (interactive (list 'interactive))
1205 | (cl-case command
1206 | ((interactive) (company-begin-backend 'company-neuron-backend))
1207 | ((prefix) (company-neuron--prefix))
1208 | ((candidates) (company-neuron--candidates arg))
1209 | ((annotation) (company-neuron--completion-annotation arg))
1210 | ((meta) (company-neuron--completion-meta arg))
1211 | ((post-completion) (company-neuron--post-completion-action arg))
1212 | ((no-cache) 't)
1213 | ((ignore-case) t)))
1214 |
1215 | ;;;###autoload
1216 | (defun company-neuron-setup ()
1217 | "Setup company to use the neuron backend."
1218 | (add-to-list 'company-backends 'company-neuron))
1219 |
1220 | ;; Mode declaration
1221 |
1222 | (defvar neuron-mode-map nil "Keymap for `neuron-mode'.")
1223 |
1224 | (progn
1225 | (setq neuron-mode-map (make-sparse-keymap))
1226 |
1227 | (define-key neuron-mode-map (kbd "C-c C-z") #'neuron-new-zettel)
1228 | (define-key neuron-mode-map (kbd "C-c C-e") #'neuron-edit-zettel)
1229 | (define-key neuron-mode-map (kbd "C-c C-t") #'neuron-add-tag)
1230 | (define-key neuron-mode-map (kbd "C-c C-S-t") #'neuron-add-tags)
1231 | (define-key neuron-mode-map (kbd "C-c C-l") #'neuron-insert-zettel-link)
1232 | (define-key neuron-mode-map (kbd "C-c C-S-L") #'neuron-insert-new-zettel)
1233 | (define-key neuron-mode-map (kbd "C-c C-s") #'neuron-insert-static-link)
1234 | (define-key neuron-mode-map (kbd "C-c C-r") #'neuron-open-current-zettel)
1235 | (define-key neuron-mode-map (kbd "C-c C-o") #'neuron-open-daily-notes)
1236 | (define-key neuron-mode-map (kbd "C-c C-,") #'neuron-edit-uplink)
1237 |
1238 | (setq neuron-mode-link-map (make-sparse-keymap))
1239 | (define-key neuron-mode-link-map [mouse-1] #'neuron-follow-thing-at-point)
1240 | (define-key neuron-mode-link-map (kbd "RET") #'neuron-follow-thing-at-point))
1241 |
1242 | (defvar neuron-mode-hook nil
1243 | "Hook run when entering `neuron-mode'.")
1244 |
1245 | (push "z:" thing-at-point-uri-schemes)
1246 |
1247 | ;;;###autoload
1248 | (define-derived-mode neuron-mode markdown-mode "Neuron"
1249 | "A major mode to edit Zettelkasten notes with neuron."
1250 | (neuron-check-if-zettelkasten-exists)
1251 | (when neuron-generate-on-save
1252 | (add-hook 'after-save-hook #'neuron-rib-generate t t))
1253 | (add-hook 'after-save-hook #'neuron--setup-overlays t t)
1254 | (neuron--setup-overlays)
1255 | (use-local-map neuron-mode-map)
1256 | (neuron--name-buffer))
1257 |
1258 | (defun neuron--auto-enable-when-in-zettelkasten ()
1259 | "Automatically switch to neuron-mode when located in a zettelkasten."
1260 | (when (and (eq major-mode 'markdown-mode)
1261 | (neuron--detect-zettelkasten (f-parent buffer-file-name)))
1262 | (neuron-mode)))
1263 |
1264 | (add-hook 'markdown-mode-hook #'neuron--auto-enable-when-in-zettelkasten t nil)
1265 |
1266 | (provide 'neuron-mode)
1267 |
1268 | ;;; neuron-mode.el ends here
1269 |
--------------------------------------------------------------------------------