1 ;;; notes-mode.el --- Indexing system for on-line note-taking
3 ;; Copyright (C) 1994-2007,2012 Free Software Foundation, Inc.
5 ;; Author: <johnh@isi.edu>.
8 ;; This file is part of GNU Emacs.
10 ;; GNU Emacs is free software: you can redistribute it and/or modify
11 ;; it under the terms of the GNU General Public License as published by
12 ;; the Free Software Foundation, either version 3 of the License, or
13 ;; (at your option) any later version.
15 ;; GNU Emacs is distributed in the hope that it will be useful,
16 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
18 ;; GNU General Public License for more details.
20 ;; You should have received a copy of the GNU General Public License
21 ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
29 (require 'notes-variables)
32 (defvar notes-mode-hooks nil
33 "Hooks to run when entering notes-mode.")
34 (defvar notes-load-mode-hooks nil
35 "Hooks to run when entering notes-mode is loaded.")
37 (defconst notes-beginning-of-defun-regexp "^\\* .*\n\\-"
38 "Regexp matching the beginning of notes section.")
40 (defvar notes-default-tab-binding (global-key-binding "\t")
41 "Saved tab binding for notes-complete-subject.")
42 (defvar notes-default-return-binding (global-key-binding "\r")
43 "Saved return binding for notes-electric-return.")
46 (defun notes-beginning-of-defun ()
47 "Go to the beginning of a notes ``section''."
52 ;; handle starting on a title
53 (if (and (looking-at notes-beginning-of-defun-regexp)
54 (/= (point) old-point))
57 (if (looking-at "^-") ;; handle starting on the underline under a title
59 (re-search-backward notes-beginning-of-defun-regexp nil 'to-limit))))
61 (defun notes-end-of-defun ()
62 "Go to the end of a notes ``section''."
64 (let ((regexp notes-beginning-of-defun-regexp))
65 (if (looking-at regexp)
66 (goto-char (match-end 0)))
67 ;; Find next section and leave cursor at section beginning
68 (if (re-search-forward regexp nil 'to-limit)
69 (re-search-backward regexp 0 t)
70 ;;(goto-char restore-point)
73 (defun notes-follow-link (which)
74 "Go to the WHICH link for this topic.
75 WHICH is either \"next\" or \"prev\".
76 If there are no links for the current note,
77 we go to the last note based upon the index file."
81 (start-buffer (current-buffer))
82 ;; We have to handle links in the same buffer,
83 ;; so the following code figure out where we go
84 ;; and returns it out of the save-excursion.
85 ;; If we end up in another buffer, we let the save-excursion
86 ;; leave the original buffer unchanged. If we end up in
87 ;; the same buffer, we need to go wherever we end up.
88 ;; Can anyone suggest a better way?
92 (setq end-of-note (point))
93 (notes-beginning-of-defun)
94 (setq beginning-of-note (point))
95 (if (and (= beginning-of-note 1) (not (looking-at notes-beginning-of-defun-regexp)))
97 ;; When "above" the first note, search to end of first
98 ;; real note (otherwise end-of-note is just the start
99 ;; of the first real note and there are no links).
102 (setq end-of-note (point))
103 (goto-char beginning-of-note)))
104 (if (re-search-forward (concat "^"
105 (if (eq which 'next) "next" "prev")
106 ":[ ]+<") end-of-note t)
107 (progn ; link exists, just take it
109 (notes-w3-follow-link (point))
110 (cons (current-buffer) (point)))
111 ;; No link; go through the index file.
112 (if (notes-goto-index-entry which)
113 (let ((index-buffer (current-buffer)))
114 (notes-index-follow-link (point))
115 (bury-buffer index-buffer))
116 (error "No known notes in that direction.")
117 (bury-buffer (current-buffer)))
118 (cons (current-buffer) (point))))))
119 ;; Check for going to the same buffer (and the save-excursion
120 ;; undoing our work).
121 (if (eq start-buffer (car end-buffer-and-point))
122 (goto-char (cdr end-buffer-and-point)))))
125 (defun notes-follow-next-link ()
126 "Go to the next link for this topic."
128 (notes-follow-link 'next))
130 (defun notes-follow-prev-link ()
131 "Go to the previous link for this topic."
133 (notes-follow-link 'prev))
135 (defvar notes-complete-subject-abbrevs-alist
136 '(("SP2010" "USC/Classes/CS551/SP2010")
137 ("FA2011" "USC/Classes/CS551/FA2011"))
138 "Alist of simple substitution of subjects.
139 If subject completion is requested, then subject that matches
140 the left-side of an alist value is replaced by the right-side value.")
142 (defun notes-complete-subject-abbrevs (key)
143 "Handle abbreviations on notes SUBJECTS.
144 Currently this is just a hack."
145 (let ((value (assoc key notes-complete-subject-abbrevs-alist)))
151 (defun notes-complete-subject ()
152 "Complete the notes subject under point."
155 ((subject (save-excursion
157 (notes-extract-subject t)))
158 old-completion-ignore-case
160 (if (not (and notes-mode-complete-subjects subject))
161 (call-interactively notes-default-tab-binding)
162 ;; Complete the title.
163 (if (null notes-subject-table)
164 (save-excursion ;; FIXME: Why??
165 (find-file-noselect (expand-file-name "index" notes-dir))))
167 ;; Run completer if it's loaded,
168 ;; otherwise do our own thing.
169 (setq completion-ignore-case t)
171 ((fboundp 'completer-complete-goto)
172 (completer-complete-goto "^ \t\n\"" " " notes-subject-table nil))
173 ;; NEEDSWORK: should try other completers, too.
174 (t ;; Do our own completion.
175 (setq full-subject (try-completion subject notes-subject-table)
176 subject (completing-read "Subject: "
177 notes-subject-table nil nil
178 (if (stringp full-subject)
181 (delete-region (line-beginning-position) (line-end-position))
182 (insert "* " (notes-complete-subject-abbrevs subject))))
183 (setq completion-ignore-case old-completion-ignore-case))))
185 (defun notes-fix-prevnext-this-entry ()
186 "Fix up the prev link for the current entry, if necessary.
187 Currently this code only handles brand new entries."
188 ;; Contributed from Takashi Nishimoto <g96p0935@mse.waseda.ac.jp>.
191 (let ((subject (notes-extract-subject nil t))
192 (this-url (notes-current-url))
194 (with-current-buffer (find-file-noselect
195 (expand-file-name "index" notes-dir))
196 (goto-char (point-min))
197 (if (re-search-forward
198 (concat "^" (regexp-quote subject) ":.* \\([0-9]+\\)$")
200 (save-window-excursion
201 (cond ((and (notes-w3-url
202 (notes-file-to-url (match-string 1) subject))
203 (re-search-forward "^next: " nil t)
204 (looking-at "<none>"))
206 (pre-modified (buffer-modified-p))
209 (setq last-url (notes-current-url))
210 (if (and (null pre-modified)
211 (>= notes-electric-prevnext 2))
215 (notes-beginning-of-defun)
217 (if (not (looking-at "prev: "))
218 (insert "prev: " last-url "\n" "next: <none>\n\n")
219 (forward-line 3))))))
221 (defun notes-electric-return (arg)
222 "* Return, underlining if we're on a subject."
224 (if (let ((cur-point (point)))
227 (and (not (eq cur-point (point))) ;; normal return if at b-o-ln
228 (notes-extract-subject t))))
229 (progn (notes-underline-line)
230 (if notes-electric-prevnext
231 (notes-fix-prevnext-this-entry)))
232 (call-interactively notes-default-return-binding)))
234 (defun notes-current-url ()
235 "Return the notes-URL of the current entry around the current point."
236 (let ((subject (notes-extract-subject nil t))
237 (date (file-name-nondirectory buffer-file-name)))
239 (abbreviate-file-name buffer-file-name)
240 (if subject (concat "#* " subject) "")
243 (defun notes-current-url-as-kill ()
244 "* Put the notes-URL of the current entry into the kill ring."
246 (kill-new (notes-current-url)))
248 (defun notes-goto-index-entry (&optional direction)
249 "* Jump to the index entry corresponding to our current note entry.
250 If we're not in an entry, we leave you in the index file.
251 If the current date doesn't exist, error in DIRECTION.
252 Returns nil if on errors (no index; no date in DIRECTION),
253 otherwise the point of the hit."
255 (let ((start-buffer (current-buffer))
256 (subject (notes-extract-subject)) ; get subject if on it
257 (date (if (null (buffer-file-name)) nil
258 (file-name-nondirectory (buffer-file-name)))))
259 ;; Try and get the subject, either forward...
262 (notes-beginning-of-defun)
263 (setq subject (notes-extract-subject))))
268 (setq subject (notes-extract-subject))))
269 ;; Form and jump to the url for the index-entry.
270 (if (and (notes-w3-url (concat notes-url-prefix
272 (if subject (concat "#" subject) ""))
274 ;; Go to the current date, if any.
275 (notes-index-goto-date date direction))
279 (defun notes-extract-subject (&optional relaxed search)
280 "Extract the subject under the point in the current buffer.
281 If RELAXED, then accept non-underlined subjects.
282 If SEARCH we'll search back in the buffer for the nearest
285 Returns nil if we're not on as subject."
288 ;; directly on a note
289 ((or (looking-at notes-beginning-of-defun-regexp)
291 (looking-at "^\\* ")))
294 ((start (+ (point) 2))
295 (end (progn (end-of-line) (point))))
296 (buffer-substring start end))))
299 (notes-beginning-of-defun)
300 (notes-extract-subject relaxed nil)))
306 (defun notes-underline-line ()
307 "* Create a row of dashes as long as this line, or adjust the current underline."
309 ;; check to see if it's already underlined
312 (looking-at "^[ \t]*--*$"))
313 (notes-old-underline-line)
315 (notes-new-underline-line)
318 (defun notes-new-underline-line ()
319 "Underline a line with a row of dashes. Move point after the dashes.
320 \\[notes-new-underline-line] reproduces leading spaces."
323 ((bol (progn (beginning-of-line)
325 (bospaces (progn (skip-chars-forward " \t")
327 (nospaces (- bospaces bol))
328 (eol (progn (end-of-line)
329 (untabify bol (point))
331 (insert "\n" (buffer-substring bol bospaces))
332 (insert-char ?- (- eol bospaces))))
334 (defun notes-old-underline-line ()
335 "Replace the following line with a row of dashes. Leave the point unchanged."
339 (delete-region (line-beginning-position) (1+ (line-end-position))))
340 (notes-new-underline-line)))
342 (defun notes-mode-initialize-note-from-cache ()
343 "Build a new note from the cache. Return valid cache contents or nil."
346 ((new-buffer (current-buffer))
347 (cache-file (expand-file-name "mknew.cache" notes-dir))
348 (buf (find-file cache-file))
356 (>= (count-lines (point-min) (point-max)) 3))
358 ;; If you know a more elegant way to extact the first
359 ;; three lines of a file, please let me know.
360 (goto-char (point-min))
363 (setq magic-line (buffer-substring m (- (point) 1)))
366 (setq prev-file (buffer-substring m (- (point) 1)))
369 (setq this-file (buffer-substring m (- (point) 1)))
370 (setq cache-contents (buffer-substring (point) (point-max)))
375 (string-equal magic-line "mknew.cache 830494922")
376 (file-newer-than-file-p cache-file prev-file)
377 (string-equal (file-name-nondirectory this-file)
378 (file-name-nondirectory (buffer-file-name
383 ;; Kill the buffer to avoid "buf changed, reload?" warnings.
388 (defun notes-mode-initialize-note ()
389 "Fill in an empty new note.
390 Create any directories as necessary.
391 Use the mknew cache if possible."
394 ((dir (directory-file-name (file-name-directory (buffer-file-name)))))
395 (if (file-exists-p dir)
397 (make-directory dir t)
398 (message "New intermediate directory created.")))
399 (if notes-mode-initialization-program
401 ((cache-contents (notes-mode-initialize-note-from-cache)))
403 (insert cache-contents)
404 (shell-command-on-region
407 (concat (expand-file-name notes-mode-initialization-program
410 ;; FIXME: Use shell-quote-argument.
411 (buffer-file-name) "'") 't)))))
416 ;; requires "PEM - PGP Enhanced Messaging for GNU Emacs"
417 ;; from Roy Frederick Busdiecker, III (Rick)
418 ;; or mailcrypt 3.4.x or >=3.5.x
421 (defvar notes-encryption-library
424 ; ((fboundp 'mc-encrypt-region) 'mailcrypt)
425 ; ((fboundp 'npgp:encrypt-region) 'npgp)
427 "PGP library to use.")
429 (defvar notes-encryption-sub-library
431 "Variant of mailcrypt to use (`pgp', `pgp50', or `gpg').")
433 (defvar notes-encryption-npgp-userid nil
434 "PGP key for the current user.")
436 (defvar notes-encryption-npgp-key-id nil
437 "Keyid of PGP key for the current user.
438 Useful if your \\[user-full-name] doesn't match a unique key.
439 Should have a leading 0x.")
441 (defun notes-encryption-npgp-userid ()
442 "Return notes-encryption-userid, initializing it if necessary."
444 (if (and notes-encryption-userid
446 notes-encryption-userid
447 (setq notes-encryption-userid
449 (if notes-encryption-key-id
450 (npgp:get-key-by-key-id notes-encryption-key-id)
451 (pam:read-name-key (user-full-name)))))))
453 (defun notes-encryption-mailcrypt-keyid ()
454 "Do the right thing."
457 ((eq notes-encryption-sub-library 'pgp)
458 (cdr (mc-pgp-lookup-key mc-pgp-user-id)))
459 ((eq notes-encryption-sub-library 'pgp50)
460 (cdr (mc-pgp50-lookup-key mc-pgp50-user-id)))
461 ((eq notes-encryption-sub-library 'gpg)
462 (cdr (mc-gpg-lookup-key mc-gpg-user-id)))
463 (t (error "notes-encryption-decrypt-region: no pgp sub-library."))))
465 (defun notes-encryption-load-mailcrypt ()
467 ;; ick ick ick this code needs to be cleaned up
469 ((null (eq notes-encryption-library 'mailcrypt))
471 ((eq notes-encryption-sub-library 'pgp)
472 (load-library "mc-pgp"))
473 ((eq notes-encryption-sub-library 'pgp50)
474 (load-library "mc-pgp5"))
475 ((eq notes-encryption-sub-library 'gpg)
476 (load-library "mc-gpg"))
477 (t (error "notes-encryption-load-mailcrypt: no pgp sub-library."))))
479 (defun notes-encryption-decrypt-region (start end)
481 ((eq notes-encryption-library 'npgp)
484 (npgp:decrypt-region start end))
485 ((eq notes-encryption-library 'mailcrypt)
486 (notes-encryption-load-mailcrypt)
488 ((eq notes-encryption-sub-library 'pgp)
489 (mc-pgp-decrypt-region start end))
490 ((eq notes-encryption-sub-library 'pgp50)
491 (mc-pgp50-decrypt-region start end))
492 ((eq notes-encryption-sub-library 'gpg)
493 (mc-gpg-decrypt-region start end))
494 (t (error "notes-encryption-decrypt-region: no pgp sub-library."))))
495 (t (error "notes-encryption-decrypt-region: no pgp library."))))
497 (defun notes-encryption-encrypt-region (start end)
499 ((eq notes-encryption-library 'npgp)
500 (npgp:encrypt-region (notes-encryption-npgp-userid) start end))
501 ((eq notes-encryption-library 'mailcrypt)
502 (notes-encryption-load-mailcrypt)
503 (let ((old-sign mc-pgp-always-sign)
504 old-comment recipients)
505 (setq mc-pgp-always-sign 'never
506 recipients (list (notes-encryption-mailcrypt-keyid)))
508 ((eq notes-encryption-sub-library 'pgp)
509 (setq old-comment mc-pgp-comment
511 (mc-pgp-encrypt-region recipients start end
512 (notes-encryption-mailcrypt-keyid) nil)
513 (setq mc-pgp-comment old-comment))
514 ((eq notes-encryption-sub-library 'pgp50)
515 (setq old-comment mc-pgp50-comment
517 (mc-pgp50-encrypt-region recipients start end
518 (notes-encryption-mailcrypt-keyid) nil)
519 (setq mc-pgp50-comment old-comment))
520 ((eq notes-encryption-sub-library 'gpg)
521 (setq old-comment mc-gpg-comment
523 (mc-gpg-encrypt-region recipients start end
524 (notes-encryption-mailcrypt-keyid) nil)
525 (setq mc-gpg-comment old-comment))
526 (t (error "notes-encryption-decrypt-region: no gpg sub-library.")))
527 (setq mc-pgp-always-sign old-sign)))
528 (t (error "notes-encryption-decrypt-region: no pgp library."))))
530 (defun notes-encrypt-note (prefix)
531 "Encrypt the current note for the current user. With PREFIX, start from point."
535 ;; Unless a prefix arg, start at beginning-of-note.
538 (if (not (looking-at notes-beginning-of-defun-regexp))
539 (notes-beginning-of-defun))
540 ;; skip over the header
541 (while (and (or (looking-at notes-beginning-of-defun-regexp)
543 (looking-at "^\\(prev\\|next\\): ")
544 (looking-at "^[ \t]*$"))
545 (< (point) (point-max)))
549 (if (re-search-forward "^-----BEGIN PGP MESSAGE"
554 (error "Note is already encrypted."))
557 (while (or (looking-at notes-beginning-of-defun-regexp)
558 (looking-at "^[ \t]*$"))
562 (notes-encryption-encrypt-region start end))))
564 (defun notes-decrypt-note ()
565 "Decrypt the current note for the current user."
568 (if (not (looking-at notes-beginning-of-defun-regexp))
569 (notes-beginning-of-defun))
570 (if (null (re-search-forward "^-----BEGIN PGP"
575 (error "Note is not encrypted."))
577 (let ((start (point)))
578 (if (null (re-search-forward "^-----END PGP"
583 (error "Could not find end of encrypted note."))
586 (notes-encryption-decrypt-region start (point)))))
590 ;;; notes or notes-index?
592 (defun notes-summarize-subject (regexp-subject &optional subject)
593 "* Collect all of a subject."
595 (require 'notes-index-mode)
598 ((eq major-mode 'notes-mode)
599 (setq subject (notes-extract-subject nil t)))
600 ((eq major-mode 'notes-index-mode)
601 (setq subject (notes-index-extract-subject)))))
603 (error "notes-summarize-subject: no subject specified or inferable."))
605 ((buf (get-buffer-create (concat "*notes on " subject "*"))))
608 (apply 'call-process (expand-file-name "catsubject" notes-bin-dir)
617 ;;; notes-rename-subject
619 (defun notes-rename-subject ()
620 "* Rename the current subject.
621 Assumes working next/prev linkage between the entries."
623 (let ((subject (notes-extract-subject)))
628 (if (not (looking-at "* "))
631 (error "not yet done")
640 (defvar notes-mode-map
641 (let ((map (make-sparse-keymap)))
642 ;; Random key-bindings.
643 (define-key map "\M-\C-a" 'notes-beginning-of-defun)
644 (define-key map "\M-\C-e" 'notes-end-of-defun)
645 (define-key map "\C-c\C-d" 'notes-decrypt-note)
646 (define-key map "\C-c\C-e" 'notes-encrypt-note)
647 (define-key map "\C-c\r" 'notes-w3-follow-link)
648 (define-key map "\C-c\C-p" 'notes-follow-prev-link)
649 (define-key map "\C-c\C-n" 'notes-follow-next-link)
650 (define-key map "\C-c\C-i" 'notes-goto-index-entry)
651 (define-key map "\C-c\C-k" 'notes-current-url-as-kill)
652 (define-key map "\C-c\C-s" 'notes-summarize-subject)
653 (define-key map "\C-c-" 'notes-underline-line)
654 ;; FIXME: Use completion-at-point-functions instead.
655 (define-key map "\t" 'notes-complete-subject)
656 ;; FIXME: Use post-self-insert-hook instead.
657 (define-key map "\r" 'notes-electric-return)
658 (define-key map "\n" 'notes-electric-return) ; a more common synonym
659 (notes-platform-bind-mouse map 'S-mouse-2 'notes-w3-follow-link-mouse)
663 (define-derived-mode notes-mode indented-text-mode "Notes"
664 "Enable notes-mode for a buffer.
666 Inside a notes buffer one can click on URLs and follow them to
669 See the file notes-variables.el for all customization options.
670 To change options, (require 'notes-variables) in your .emacs
671 and then change things.
673 Subjects in notes mode are lines beginning with an asterisk
674 and underlined with dashes. Subjects can be completed
675 with \\[notes-complete-subject] and are automatically underlined.
677 You may wish to add this code to your .emacs file:
678 (add-to-list 'auto-mode-alist
679 (cons \"/9[0-9][0-9][0-9][0-9][0-9].?\\\\'\" 'notes-mode))
680 (define-key global-map [?\\C-c ?n] 'notes-index-todays-link)
681 to automatically enter notes mode.
683 I have two suggestions for how to organize your notes files.
684 First, I collect my notes into a separate file per day. (If you have
685 fewer notes, you may find once-per-week or month more suitable.)
686 Second, at the beginning of each file I have a subject \"* Today\".
687 Since every file has this subject, I can use its prev and next links
688 to easily move around the collection of files.
690 The key-bindings of this mode are:
692 (notes-platform-init)
694 ;; Now set up the mode.
698 (set (make-local-variable 'imenu-prev-index-position-function)
699 'notes-beginning-of-defun)
700 (set (make-local-variable 'imenu-extract-index-name-function)
701 'notes-extract-subject)
703 (set (make-local-variable 'font-lock-defaults)
704 `(notes-font-lock-keywords
705 t nil nil beginning-of-line))
707 ;; Finally, try to fill in an empty note.
708 (if (zerop (buffer-size))
709 (notes-mode-initialize-note))
711 ;; Enable outline-minor-mode (forcebly, in case someone already
712 ;; has it in their text-mode hook). Bug found by
713 ;; Nils Ackermann <nils@nieback.de>.
714 (if notes-use-outline-mode
715 (outline-minor-mode 1)))
722 (run-hooks 'notes-mode-load-hooks)
723 (provide 'notes-mode)
724 ;;; notes-mode.el ends here