Added the gpl-3.0.txt file.
[elisp.git] / enotes.el
1 ;; -*-Emacs-Lisp-*-
2
3 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
4 ;; This program is free software; you can redistribute it and/or         ;;
5 ;; modify it under the terms of the GNU General Public License as        ;;
6 ;; published by the Free Software Foundation; either version 3, or (at   ;;
7 ;; your option) any later version.                                       ;;
8 ;;                                                                       ;;
9 ;; This program is distributed in the hope that it will be useful, but   ;;
10 ;; WITHOUT ANY WARRANTY; without even the implied warranty of            ;;
11 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU      ;;
12 ;; General Public License for more details.                              ;;
13 ;;                                                                       ;;
14 ;; You should have received a copy of the GNU General Public License     ;;
15 ;; along with this program. If not, see <http://www.gnu.org/licenses/>.  ;;
16 ;;                                                                       ;;
17 ;; Written by and Copyright (C) Francois Fleuret                         ;;
18 ;; Contact <francois@fleuret.org> for comments & bug reports             ;;
19 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
20
21 ;; This file contains functions to handle rendez-vous and
22 ;; appointments. It has a list of 'notes', each defined by a date, a
23 ;; title, a warning date and optionnaly a tag color and a string of
24 ;; information. The system automatically opens a window when an alarm
25 ;; has to be displayed.
26
27 ;; Just call enotes/init to load the notes saved during the last
28 ;; session and run the whole stuff. The notes are kept in the variable
29 ;; enotes/notes and saved when a note is added or when emacs is
30 ;; killed.
31
32 ;; You can bring the main buffer containing all notes by calling
33 ;; enotes/show-all-notes. The defined keys are given at the top of
34 ;; that buffer.
35
36 ;; I use the following in my .emacs
37 ;;
38 ;; ;; Load the script itself
39 ;; (load "enotes")
40 ;; ;; Load the notes and display the required alarms
41 ;; (enotes/init)
42 ;; ;; That short-cuts to edit all the notes
43 ;; (define-key global-map [(control x) (control n)] 'enotes/show-all-notes)
44 ;;
45 ;; Check the defcustom in the source below to see the tunable
46 ;; variables.
47
48 (eval-when-compile (require 'cl))
49
50 (require 'time-date)
51 (require 'parse-time)
52
53 (defgroup enotes ()
54   "Set of functions to handle notes and rendez-vous."
55   :version "1.3.1")
56
57 (provide 'enotes)
58
59 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
60
61 (defcustom enotes/file "~/.enotes"
62   "File containing the list of notes."
63   :type 'string
64   :group 'enotes)
65
66 (defcustom enotes/alarm-hook nil
67   "Hook called when alarms are to be displayed."
68   :type 'hook
69   :group 'enotes)
70
71 (defcustom enotes/input-time-format "%Y %b %d %H:%M"
72   "The time format for input."
73   :type 'string
74   :group 'enotes)
75
76 (defcustom enotes/time-format "%h %a %d %Y %H:%M"
77   "The time format."
78   :type 'string
79   :group 'enotes)
80
81 (defcustom enotes/show-help t
82   "Should the key help be displayed."
83   :type 'boolean
84   :group 'enotes)
85
86 (defcustom enotes/full-display t
87   "Should the infos be displayed."
88   :type 'boolean
89   :group 'enotes)
90
91 (defcustom enotes/display-mode 'enotes/insert-all-notes-by-week
92   "How to show the notes. Either `enotes/insert-all-notes-by-delay' or
93 `enotes/insert-all-notes-by-week'."
94   :type 'function
95   :group 'enotes)
96
97 (defcustom enotes/color-list '("red" "green3" "yellow" "blue")
98   "What colors can be given to the tags in front of the note titles"
99   :type 'list
100   :group 'enotes)
101
102 (defcustom enotes/default-time-fields "6:00"
103   "The default values for non-specified time fields when setting a date."
104   :type 'string
105   :group 'enotes)
106
107 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
108
109 (defconst enotes/help-string "   n,TAB: go to next note       p,S-TAB: go to prev note
110    a: add note                  C-d,DEL: delete note
111    e: edit field at point       c: change tag color
112    d: edit event time           w: edit warning time
113    i: edit information          I: switch full display
114    +: move event +1h            =: move warning +1h
115    T: move event +24h           t: move warning +24h
116    f: force warning time at event time
117    h: show/hide help            m: switch display mode
118    u: undo                      r: redo
119    s: save notes                RET,g: go to reference
120    q: quit                      Q: remove obsolete notes and quit
121
122    Contact <francois@fleuret.org> for remarks & bug reports.")
123
124 (defmacro enotes/get-event-time (note) `(elt ,note 0))
125 (defmacro enotes/get-warning-time (note) `(elt ,note 1))
126 (defmacro enotes/get-note-time (note) `(elt ,note 2))
127 (defmacro enotes/get-title (note) `(elt ,note 3))
128 (defmacro enotes/get-ref (note) `(elt ,note 4))
129 (defmacro enotes/get-info (note) `(elt ,note 5))
130 (defmacro enotes/get-color (note) `(elt ,note 6))
131
132 (defun enotes/set-event-time (note date) (aset note 0 date))
133 (defun enotes/set-warning-time (note date) (aset note 1 date))
134 (defun enotes/set-note-time (note date) (aset note 2 date))
135 (defun enotes/set-title (note title) (aset note 3 (if (string= title "") "(No title)" title)))
136 (defun enotes/set-ref (note ref) (aset note 4 ref))
137 (defun enotes/set-info (note info) (aset note 5  (if (string= info "") nil info)))
138 (defun enotes/set-color (note color) (aset note 6  (if (string= color "") nil color)))
139
140 (defvar enotes/notes nil "Contains the list of notes")
141 (defvar enotes/mode-map nil "Mode map for enotes/mode")
142
143 (defvar enotes/past-history nil "Contains the history for undo")
144 (defvar enotes/futur-history nil "Contains the history for redo")
145
146 (defconst enotes/version "1.2" "The version Identifier")
147 (defconst enotes/year-duration 31536000 "How many seconds in a year")
148 (defconst enotes/month-duration 2592000 "How many seconds in a month")
149 (defconst enotes/week-duration 604800 "How many seconds in a week")
150 (defconst enotes/day-duration 86400 "How many seconds in a day")
151
152 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
153 ;; Face definitions
154 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
155
156 (defface enotes/list-title-face
157   '((((background light)) (:foreground "royal blue"))
158     (((background dark)) (:foreground "azure2")))
159   "The face for the list titles.")
160
161 (defface enotes/alarm-face
162   '((((background light)) (:foreground "red3" :bold t))
163     (((background dark)) (:foreground "red" :bold t)))
164   "The face for the alarm titles.")
165
166 (defface enotes/wrong-time-face
167   '((((background light)) (:foreground "red3" :bold t))
168     (((background dark)) (:foreground "red" :bold t)))
169   "The face for time in the past.")
170
171 (defface enotes/wrong-warning-face
172   '((((background light)) (:foreground "orange3" :bold t))
173     (((background dark)) (:foreground "orange" :bold t)))
174   "The face for warning after the event.")
175
176 (defface enotes/title-face
177   '((((background light)) (:underline t)))
178   "The face for event title.")
179
180 (defface enotes/information-face
181   '((((background light)) (:foreground "gray50")))
182   "The face for the additional information.")
183
184 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
185
186 ;; (defun enotes/position-note (note)
187 ;;   "Returns the position of note NOTE in buffer or nil if it can not be
188 ;; found"
189 ;;   (let ((pos (point-min)))
190 ;;     (while (and pos (not (eq note (get-text-property pos 'note))))
191 ;;       (message "pos = %s note = %s" (prin1-to-string pos) (prin1-to-string (get-text-property pos 'note)))
192 ;;       (setq pos (next-single-property-change pos 'note))
193 ;;       )
194 ;;     (if (and pos (eq note (get-text-property pos 'note))) pos nil)))
195
196 (defun enotes/go-to-next-note ()
197   "Move the cursor to the next note in buffer"
198   (interactive)
199   (let ((next (next-single-property-change (point) 'note)))
200     (when (and next
201                (not (get-text-property next 'note)))
202       (setq next (next-single-property-change next 'note)))
203     (unless next
204       (setq next (next-single-property-change (point-min) 'note)))
205     (if next (goto-char next)
206       (goto-char (point-min)))))
207
208 (defun enotes/go-to-prev-note ()
209   "Move the cursor to the previous note in buffer"
210   (interactive)
211   (let ((prev (previous-single-property-change (1- (point)) 'note)))
212     (when (and prev
213                (not (get-text-property prev 'note)))
214       (setq prev (previous-single-property-change prev 'note)))
215     (unless prev
216       (setq prev (previous-single-property-change (point-max) 'note)))
217     (if prev (goto-char prev)
218       (goto-char (point-max)))))
219
220 (defun enotes/go-to-ref-at-point ()
221   "Go to the reference (file only at this moment) of the note at cursor's location"
222   (interactive)
223   (let ((note (get-text-property (point) 'note)))
224     (if (not note) (error "No note at point")
225       (let ((ref (enotes/get-ref note)))
226         (if (not ref) (error "No reference")
227           (cond ((equal (car ref) 'file)
228                  (switch-to-buffer (find-file-noselect (car (cdr ref))))
229                  (goto-char (car (cddr ref))))
230                 (t (error "Unknown attachement"))))))))
231
232 (defun enotes/add-file-note ()
233   "Add a note with a reference to the visited file"
234   (interactive)
235   (let ((date (format-time-string enotes/input-time-format (time-add (current-time) `(0 ,enotes/day-duration 0))))
236         (file (buffer-file-name)))
237     (if (not file)
238         (error "You are not visiting a file")
239       (enotes/add-note date "Going on working" (list 'file file (point))))))
240
241 (defun enotes/round-time (time delay)
242   "Heuristic to round the given time according to how far away it is
243 in the futur"
244   (cond ((> delay enotes/month-duration) (+ 25200 (- time (mod time enotes/day-duration))))
245         ((> delay enotes/day-duration) (- time (mod time 3600)))
246         ((> delay 11400) (- time (mod time 900)))
247         ((> delay 1800) (- time (mod time 300)))
248         ((> delay 300) (- time (mod time 60)))
249         (t (fround time))))
250
251 (defun enotes/next-in-list (x l)
252   (if x
253       (if (equal x (car l)) (car (cdr l))
254         (and l (enotes/next-in-list x (cdr l))))
255     (car l)))
256
257 (defun enotes/next-color ()
258   "Change the color mark of the event at point"
259   (interactive)
260   (let* ((note (get-text-property (point) 'note))
261          (color (and note (enotes/get-color note))))
262     (when note
263       (enotes/store-for-undo)
264       (enotes/set-color note (enotes/next-in-list color enotes/color-list))
265       (enotes/do-it))))
266
267 (defun enotes/move-warning (change)
268   "Move the next warning 24 hours in the futur"
269   (interactive)
270   (let* ((note (get-text-property (point) 'note))
271          (time (float-time))
272          (event-time (enotes/get-event-time note))
273          (warning-time (enotes/get-warning-time note))
274          (new-warning-time (+ change warning-time)))
275     (enotes/store-for-undo)
276     (if (and (< warning-time event-time) (> new-warning-time event-time))
277         (enotes/set-warning-time note event-time)
278       (enotes/set-warning-time note new-warning-time)))
279   (enotes/do-it))
280
281 (defun enotes/move-warning-1h ()
282   "Move the next warning one hour in the futur"
283   (interactive)
284   (enotes/move-warning 3600))
285
286 (defun enotes/move-warning-24h ()
287   "Move the next warning 24 hours in the futur"
288   (interactive)
289   (enotes/move-warning enotes/day-duration))
290
291 (defun enotes/move-event (change)
292   "Move the event date itself"
293   (interactive)
294   (let* ((note (get-text-property (point) 'note))
295          (event-time (and note (enotes/get-event-time note)))
296          (new-event-time (and event-time (+ change event-time))))
297     (when note
298       (enotes/store-for-undo)
299       (enotes/set-event-time note new-event-time)
300       (enotes/set-refresh-warning-time note)
301       (enotes/do-it))))
302
303 (defun enotes/move-event-24h ()
304   "Move the event date itself 24 hours in the futur"
305   (interactive)
306   (enotes/move-event enotes/day-duration))
307
308 (defun enotes/move-event-1h ()
309   "Move the event date itself one hour in the futur"
310   (interactive)
311   (enotes/move-event 3600))
312
313 (defun enotes/set-refresh-warning-time (note)
314   "Compute a new warning date, according to the event date, the note
315 creating date and the current next warning. This is an ad-hoc
316 heuristic. Improvements are welcome"
317
318   (if (enotes/get-warning-time note)
319
320       ;; If it's not the first warning, we compute it as a delay from
321       ;; now
322
323       (let* ((time (float-time))
324              (event-time (enotes/get-event-time note))
325              (warning-time (enotes/get-warning-time note))
326              (note-time (enotes/get-note-time note))
327              (anticipation (- event-time note-time))
328              (delay (- event-time time))
329              (delay-warning
330
331               (cond
332                ((> anticipation enotes/year-duration)
333                 ;; The note was set more than ONE YEAR before the
334                 ;; event (serious stuff!)
335                 (cond ((> delay (* 2 enotes/month-duration)) enotes/month-duration)
336                       ((> delay (* 2 enotes/week-duration)) enotes/week-duration)
337                       (t enotes/day-duration)))
338
339                ((> anticipation enotes/month-duration)
340                 ;; The note was set at least one month before the
341                 ;; event
342                 (cond ((> delay enotes/week-duration) (* 2 enotes/day-duration))
343                       (t enotes/day-duration)))
344
345                ((> anticipation enotes/week-duration)
346                 ;; The note was set at least one week before the event
347                 (cond ((> delay enotes/day-duration) enotes/day-duration)
348                       (t 3600)))
349
350                (t
351                 (cond ((> delay enotes/day-duration) enotes/day-duration)
352                       ((> delay 1800) 1800)
353                       (t 900)))
354
355                ))
356
357              (new-warning-time (enotes/round-time (+ time delay-warning) delay)))
358
359         ;; If the preceding warning was before the event and the new
360         ;; is after, force the new at the event date
361
362         (if (and (< warning-time event-time) (> new-warning-time event-time))
363             (enotes/set-warning-time note event-time)
364           ;; else let the new be where we computed
365           (enotes/set-warning-time note new-warning-time)))
366
367     ;; If it's the first warning, we define how long before the event
368     ;; it has to be set
369
370     (let* ((time (fround (float-time)))
371            (anticipation (- (enotes/get-event-time note) (enotes/get-note-time note)))
372            (delay-warning
373             (cond
374              ((> anticipation enotes/year-duration) (* 2 enotes/month-duration))
375              ((> anticipation enotes/month-duration) enotes/week-duration)
376              ((> anticipation enotes/week-duration) (* 2 enotes/day-duration))
377              ((> anticipation (* 2 enotes/day-duration)) enotes/day-duration)
378              (t 3600)
379              ))
380            (delay-warning (- (- (enotes/get-event-time note) delay-warning) time)))
381
382       ;; Force at least 60s in the future
383
384       (enotes/set-warning-time
385        note
386        (max (+ time 60)
387             (enotes/round-time (+ time delay-warning) delay-warning))))
388     )
389   )
390
391 (defun enotes/add-note (&optional date title ref info)
392   "Add a note and ask for the field values if they are not provided"
393   (interactive)
394
395   (let* ((title (read-from-minibuffer
396                  "Title: "
397                  (or title "")))
398          (date (read-from-minibuffer
399                 "Date: "
400                 (or date
401                     (format-time-string enotes/input-time-format
402                                         (current-time)))))
403          (info "")
404          (new-note (vector (enotes/string-to-float-time date)
405                            nil
406                            (fround (float-time))
407                            nil
408                            ref
409                            (if (string= info "") nil info)
410                            nil)))
411
412     (enotes/set-title new-note title)
413     (enotes/set-refresh-warning-time new-note)
414
415     (enotes/store-for-undo)
416
417     (setq enotes/notes (cons new-note enotes/notes))
418     (enotes/save-notes)
419     (enotes/do-it)
420     ;;     (message "%s (%s)" (prin1-to-string new-note) (prin1-to-string (enotes/position-note new-note)))
421     ))
422
423 (defun enotes/default-list (l default-l)
424   (when l (cons (or (car l) (car default-l))
425                 (enotes/default-list (cdr l) (cdr default-l)))))
426
427 (defun enotes/default-time-fields ()
428   (let ((time (decode-time (current-time))))
429     (enotes/default-list
430      (parse-time-string enotes/default-time-fields)
431      `(0 0 6 1 ,(elt time 4) ,(elt time 5)))
432     ))
433
434 (defun enotes/string-to-float-time (date)
435   (let ((time (decode-time (current-time))))
436     (float-time (apply 'encode-time
437                        (enotes/default-list
438                         (parse-time-string date)
439                         (enotes/default-time-fields))))))
440
441 (defun enotes/second-to-delay (second)
442   "Returns a string describing a delay in english"
443   (cond ((< second (- enotes/day-duration))
444          (format "%d day%s ago"
445                  (/ second -86400)
446                  (if (> (ftruncate (/ second -86400)) 1)
447                      "s" "")))
448         ((< second -3600)
449          (format "%dh ago" (/ second -3600)))
450         ((< second -300)
451          (format "%dmin ago" (/ second -60)))
452         ((< second 0)
453          (format "now!!!" (/ second -60)))
454         ((< second 3600)
455          (format "in %dmin" (/ second 60)))
456         ((< second enotes/day-duration)
457          (format "in %dh" (/ second 3600)))
458         ((< second enotes/month-duration)
459          (format "in %d day%s" (/ second 86400)
460                  (if (> (ftruncate (/ second 86400)) 1)
461                      "s" "")))
462         (t
463          (format "in ~ %d month%s" (/ second 2592000)
464                  (if (> (ftruncate (/ second 2592000)) 1)
465                      "s" "")))))
466
467 (defun enotes/cond-propertize (cnd str prop)
468   "Propertize STR if both CND and PROP are non-nil"
469   (if (and prop cnd) (apply 'propertize (cons str prop))
470     str))
471
472 (defun enotes/title-string (note)
473   (concat
474
475    (propertize
476
477     (concat
478      " "
479
480      ;; The small color tag
481
482      (if (enotes/get-color note)
483          (propertize " " 'face (cons 'background-color
484                                      (enotes/get-color note)))
485        " ")
486
487      " ")
488
489     'field 'title)
490
491    (propertize
492     (enotes/get-title note)
493     'face 'enotes/title-face
494     'field 'title)
495
496    (if (and (not enotes/full-display) (enotes/get-info note)) (propertize " /.../" 'field 'information) "")
497
498    ))
499
500 (defun enotes/insert-blank-line () (interactive)
501   (let ((p (point)))
502     (unless (and
503              (> p 1)
504              (eq (char-before p) ?\n)
505              (or (eq p 2)
506                  (eq (char-before (1- p)) ?\n)))
507       (insert "\n"))))
508
509 (defun enotes/insert-note (note time)
510   "Insert the note in the buffer, with fields properties so that we can
511 edit them easily later on"
512   (let ((obsolete (>= time (enotes/get-event-time note)))
513         (info (enotes/get-info note))
514         (title (enotes/title-string note)))
515
516     (when enotes/full-display (enotes/insert-blank-line))
517
518     (insert
519      (propertize
520       (concat
521
522        ;; Title
523
524        title
525
526        (if enotes/full-display "\n"
527          (make-string (max 0 (- 40 (length title))) ? )
528          )
529
530        ;; Date event
531
532        (propertize
533         (concat
534          (if enotes/full-display "       Date: " "   ")
535          (enotes/cond-propertize
536           obsolete
537           (format-time-string enotes/time-format (seconds-to-time (enotes/get-event-time note)))
538           '(face enotes/wrong-time-face))
539          " ("
540          (enotes/second-to-delay (- (enotes/get-event-time note) time))
541          ")\n")
542         'field 'event-time)
543
544        ;; Date next warning
545
546        (when (and enotes/full-display
547                   (not (equal (enotes/get-warning-time note) (enotes/get-event-time note))))
548          (propertize
549           (concat
550            "    Warning: "
551            (enotes/cond-propertize
552             (and (not obsolete) (> (enotes/get-warning-time note) (enotes/get-event-time note)))
553             (format-time-string enotes/time-format (seconds-to-time (enotes/get-warning-time note)))
554             '(face enotes/wrong-warning-face))
555            "\n"
556            )
557           'field 'warning-time)
558          )
559
560        ;; Reference (if there is one)
561
562        (let ((ref (enotes/get-ref note)))
563          (when ref
564            (cond ((equal 'file (car ref))
565                   (format "        Ref: file [%s]\n" (file-name-nondirectory (car (cdr ref)))))
566                  (t "       Ref: *unknown type*\n"))))
567
568        ;; Complementary information (if there are some)
569
570        (when (and enotes/full-display info)
571          (propertize
572           (format "       Info: %s\n"
573                   (propertize
574                    ;; Ugly hack to match exactly the end of
575                    ;; the string: add a ^_ at the end ...
576                    (replace-regexp-in-string "[\n ]*\1f" ""
577                                              (replace-regexp-in-string "\n\\([^\n]+\\)"
578                                                                        "\n             \\1"
579                                                                        (concat info "\1f")))
580                    'face 'enotes/information-face)
581                   )
582           'field 'information)
583          )
584
585        )
586
587       'note note 'obsolete obsolete))))
588
589 (defun enotes/delete-note-at-point ()
590   "Delete the note at cursor's location"
591   (interactive)
592   (let ((note (get-text-property (point) 'note)))
593     (if (not note) (error "No note at point")
594       (enotes/store-for-undo)
595       (setq enotes/notes (delq note enotes/notes))))
596   (enotes/do-it))
597
598 (defun enotes/set-warning-at-event ()
599   "Force the next warning time at the event time"
600   (interactive)
601   (let ((time (float-time))
602         (note (get-text-property (point) 'note)))
603     (if (not note) (error "No note at point")
604       (let ((obsolete (>= time (enotes/get-event-time note))))
605         (enotes/store-for-undo)
606         (if obsolete
607             (enotes/set-warning-time note (+ time 3600))
608           (enotes/set-warning-time note (enotes/get-event-time note))))
609       (enotes/do-it))))
610
611 (defun enotes/switch-help () (interactive)
612   (setq enotes/show-help (not enotes/show-help))
613   (enotes/do-it))
614
615 (defun enotes/switch-infos-display ()
616   "Switch between displaying and not displaying the warning time
617 and additional information"
618   (interactive)
619   (setq enotes/full-display (not enotes/full-display))
620   (enotes/do-it))
621
622 (defun enotes/switch-display () (interactive)
623
624   (setq enotes/display-mode
625         (cdr (assoc
626               enotes/display-mode
627               '((enotes/insert-all-notes-by-delay . enotes/insert-all-notes-by-week)
628                 (enotes/insert-all-notes-by-week . enotes/insert-all-notes-by-delay)))))
629
630   (enotes/do-it))
631
632 (defun enotes/save-note-information () (interactive)
633         (enotes/store-for-undo)
634         (enotes/set-info enotes/edited-note
635                          (buffer-substring-no-properties (point-min)
636                                                          (point-max)))
637         (kill-this-buffer)
638         (enotes/do-it))
639
640 (defun enotes/cancel-edit-info () (interactive)
641   (if (and (buffer-modified-p)
642            (not (y-or-n-p "Lose changes ? ")))
643       (error "Cancel cancel"))
644
645   (kill-this-buffer)
646   (enotes/do-it)
647   (message "Cancel")
648   )
649
650 (defun enotes/edit-information-note-at-point ()
651   "Use the 'field property of the character at point to figure out
652 what note has to have its information edited, and edit it in a new
653 buffer"
654
655   (interactive)
656   (let ((note (get-text-property (point) 'note))
657         (map (make-sparse-keymap)))
658
659     (unless note (error "No note at point"))
660
661     (switch-to-buffer (get-buffer-create
662                        (generate-new-buffer-name "*enotes information*")))
663
664     (text-mode)
665     (auto-fill-mode)
666
667     (define-key map [(control c) (control c)] 'enotes/save-note-information)
668     (define-key map [(control c) (control q)] 'enotes/cancel-edit-info)
669
670     (set (make-local-variable 'enotes/edited-note) note)
671     (set (make-local-variable 'fill-column) 60)
672
673     (use-local-map map)
674     (when (enotes/get-info note)
675       (insert (enotes/get-info note))
676       (setq buffer-undo-list nil)
677       (set-buffer-modified-p nil)
678       (set-auto-mode))
679
680     (message "C-c C-c to save the information, C-c C-q to cancel")
681
682     ))
683
684 (defun enotes/edit-event-time-note-at-point ()
685   (interactive)
686   (let ((note (get-text-property (point) 'note)))
687
688     (unless note (error "No note at point"))
689
690     (let ((new-event-time (enotes/string-to-float-time
691                            (read-from-minibuffer
692                             "Date: "
693                             (format-time-string
694                              enotes/input-time-format
695                              (seconds-to-time (enotes/get-event-time note)))))))
696       (unless (= new-event-time (enotes/get-event-time note))
697         (enotes/store-for-undo)
698         (enotes/set-event-time note new-event-time)
699         (enotes/do-it)))))
700
701 (defun enotes/edit-warning-time-note-at-point ()
702   (interactive)
703   (let ((note (get-text-property (point) 'note)))
704
705     (unless note (error "No note at point"))
706
707     (let ((new-warning-time (enotes/string-to-float-time
708                              (read-from-minibuffer
709                               "Warning: "
710                               (format-time-string
711                                enotes/input-time-format
712                                (seconds-to-time (enotes/get-warning-time note)))))))
713       (unless (= new-warning-time (enotes/get-warning-time note))
714         (enotes/store-for-undo)
715         (enotes/set-warning-time note new-warning-time)
716         (enotes/do-it)))))
717
718 (defun enotes/edit-field-at-point ()
719   "Ask for a new value for the field at cursor's location"
720   (interactive)
721
722   (let ((note (get-text-property (point) 'note))
723         (field (get-text-property (point) 'field)))
724
725     (cond
726
727      ((eq field 'title)
728       (let ((new-title (read-from-minibuffer "Title: " (enotes/get-title note))))
729         (unless (string= new-title (enotes/get-title note))
730           (enotes/store-for-undo)
731           (enotes/set-title note new-title)
732           (enotes/do-it))))
733
734      ((eq field 'event-time)
735       (let ((new-event-time (enotes/string-to-float-time
736                              (read-from-minibuffer
737                               "Date: "
738                               (format-time-string
739                                enotes/input-time-format
740                                (seconds-to-time (enotes/get-event-time note)))))))
741         (unless (= new-event-time (enotes/get-event-time note))
742           (enotes/store-for-undo)
743           (enotes/set-event-time note new-event-time)
744           (enotes/set-refresh-warning-time note)
745           (enotes/do-it))))
746
747      ((eq field 'note-time)
748       (error "Can not edit that field"))
749
750      ((eq field 'warning-time)
751       (let ((new-warning-time (enotes/string-to-float-time
752                                (read-from-minibuffer
753                                 "Warning: "
754                                 (format-time-string
755                                  enotes/input-time-format
756                                  (seconds-to-time (enotes/get-warning-time note)))))))
757         (unless (= new-warning-time (enotes/get-warning-time note))
758           (enotes/store-for-undo)
759           (enotes/set-warning-time note new-warning-time)
760           (enotes/do-it))))
761
762      ((eq field 'information)
763       (enotes/edit-information-note-at-point))
764
765      (t (error "No known field at point"))
766
767      )
768     )
769   )
770
771 (defun enotes/remove-buffer ()
772   "Kill the current buffer and delete the current window if it's not
773 the only one in the frame"
774   (interactive)
775   (kill-this-buffer)
776   (unless (one-window-p t) (delete-window)))
777
778 (defun enotes/remove-obsolete-remove-buffer ()
779   "Delete the obsolete notes appearing in the current buffer, delete
780 the buffer and the current window if it's not the only one in the
781 frame"
782   (interactive)
783
784   (let ((s (point-min)))
785     (while (setq s (text-property-any (1+ s) (point-max) 'obsolete t))
786       (setq enotes/notes (delq (get-text-property s 'note) enotes/notes))))
787
788   ;; If the "list of notes" buffer is visible and is not the current
789   ;; one, refresh it
790
791   (enotes/remove-buffer)
792   (enotes/do-it))
793
794 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
795 ;; The undo/redo stuff
796 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
797
798 (defun enotes/store-for-undo ()
799   "Keep a copy of the current `enotes/notes' in `enotes/past-history'
800 value for undo. Reset `enotes/futur-history' to nil"
801   (interactive)
802   ;; Need to copy the cells themselves, thus the mapcar thingy
803   (setq enotes/past-history (cons (mapcar 'copy-sequence enotes/notes) enotes/past-history)
804         enotes/futur-history nil)
805   )
806
807 (defun enotes/undo ()
808   "Put the current `enotes/notes' into `enotes/futur-history' and take
809 the value of `enotes/notes' from `enotes/past-history'"
810   (interactive)
811   (if (not enotes/past-history)
812       (error "Nothing to undo!")
813     (setq enotes/futur-history (cons enotes/notes enotes/futur-history)
814           enotes/notes (car enotes/past-history)
815           enotes/past-history (cdr enotes/past-history))
816     (enotes/refresh-note-buffer (float-time) t)
817     (message "Undo!"))
818   )
819
820 (defun enotes/redo ()
821   "Put the current `enotes/notes' into `enotes/past-history' and take
822 the value of `enotes/notes' from `enotes/futur-history'"
823   (interactive)
824   (if (not enotes/futur-history)
825       (error "Nothing to redo!")
826     (setq enotes/past-history (cons enotes/notes enotes/past-history)
827           enotes/notes (car enotes/futur-history)
828           enotes/futur-history (cdr enotes/futur-history))
829     (enotes/refresh-note-buffer (float-time) t)
830     (message "Redo!"))
831   )
832
833 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
834
835 (defun enotes/mode ()
836   "Major mode to manage a list of notes. The list of 'notes' is kept
837 in `enotes/notes'. Each note is defined by a date, an event time, a
838 warning time and optionally by a string of informations and a colored
839 tag. Just call `enotes/init' to load the notes saved during the last
840 session and run the whole stuff. The notes are saved when a note is
841 added or when emacs is killed.
842
843 You can bring the main buffer containing all notes by calling
844 `enotes/show-all-notes'."
845
846   (interactive)
847
848   (unless enotes/mode-map
849     (setq enotes/mode-map (make-sparse-keymap))
850     (suppress-keymap enotes/mode-map)
851     (mapc (lambda (x) (define-key enotes/mode-map (car x) (cdr x)))
852           `(([(delete)] . enotes/delete-note-at-point)
853             ([(control d)] . enotes/delete-note-at-point)
854             ("d" . enotes/edit-event-time-note-at-point)
855             ("a" . enotes/add-note)
856             ("e" . enotes/edit-field-at-point)
857             ("h" . enotes/switch-help)
858             ("m" . enotes/switch-display)
859             ("I" . enotes/switch-infos-display)
860             ("i" . enotes/edit-information-note-at-point)
861             ("w" . enotes/edit-warning-time-note-at-point)
862             ("c" . enotes/next-color)
863             ("g" . enotes/go-to-ref-at-point)
864             ("t" . enotes/move-warning-24h)
865             ("T" . enotes/move-event-24h)
866             ("=" . enotes/move-warning-1h)
867             ("+" . enotes/move-event-1h)
868             (,(kbd "RET") . enotes/go-to-ref-at-point)
869             (,(kbd "TAB") . enotes/go-to-next-note)
870             ("n" . enotes/go-to-next-note)
871             ([(shift iso-lefttab)] . enotes/go-to-prev-note)
872             ("p" . enotes/go-to-prev-note)
873             ("q" . enotes/remove-buffer)
874             ("Q" . enotes/remove-obsolete-remove-buffer)
875             ("u" . enotes/undo)
876             ("r" . enotes/redo)
877             ("s" . enotes/save-notes)
878             ([(control x) (control s)] . enotes/save-notes)
879             ("f" . enotes/set-warning-at-event)
880             ))
881
882     (substitute-key-definition 'undo 'enotes/undo enotes/mode-map global-map)
883     )
884
885   (kill-all-local-variables)
886
887   (use-local-map enotes/mode-map)
888
889   (setq mode-name "Enotes"
890         buffer-read-only t
891         ;;         truncate-lines t
892         major-mode 'enotes/mode)
893   )
894
895 (defun enotes/list-of-notes-in-buffer ()
896   "Return all the notes in the current buffer (used to refresh them)"
897   (let ((current (point-min))
898         (result ()))
899     (while (setq current (next-single-property-change current 'note))
900       (when current
901         (let ((n (get-text-property current 'note)))
902           (if (and n (member n enotes/notes)) (setq result (cons n result))))))
903     result))
904
905 (defun enotes/line-title (title)
906   "Create a string of length 75 padded with -s"
907   (concat "-- " title " "
908           (make-string (- 72 (length title)) ?-)
909           ;; "\n"
910           ;; (if enotes/full-display "" "\n")
911           )
912   )
913
914 (defun enotes/sorted-by-time (notes)
915   (sort (copy-sequence notes)
916         (lambda (n1 n2) (and (<= (enotes/get-event-time n1)
917                                  (enotes/get-event-time n2))
918                              (or (not (= (enotes/get-event-time n1)
919                                          (enotes/get-event-time n2)))
920                                  (string< (enotes/get-title n1)
921                                           (enotes/get-title n2)))))))
922
923 ;; Show all notes one after another, sorted by event date. A title is
924 ;; inserted for each week of the year containing events, and for each
925 ;; month.
926
927 (defun enotes/insert-all-notes-by-week (time notes-to-display)
928   "Inserts notes grouped by weeks."
929   (let ((current-week (format-time-string "%W" (seconds-to-time time)))
930         (current-year (format-time-string "%Y" (seconds-to-time time)))
931         (next-week (format-time-string "%W" (seconds-to-time (+ time enotes/week-duration))))
932         (loop-week "")
933         (loop-month "")
934         (loop-year "")
935         (already-added-blank))
936
937     (mapc (lambda (note)
938
939             (let* ((time-event (seconds-to-time (enotes/get-event-time note)))
940                    (week (format-time-string "%W" time-event))
941                    (month (format-time-string "%B" time-event))
942                    (year (format-time-string "%Y" time-event)))
943
944               (when (not (and (string= month loop-month) (string= year loop-year)))
945                 (setq loop-month month
946                       loop-year year)
947                 (insert "\n"
948                         (propertize (enotes/line-title
949                                      (concat month
950                                              (if (not (string= year current-year))
951                                                  (concat " (" year ")"))
952                                              ))
953                                     'face 'enotes/list-title-face)
954                         "\n"
955                         )
956                 (insert "\n")
957                 (setq already-added-blank t)
958                 )
959
960               (when (not (string= week loop-week))
961                 (setq loop-week week)
962                 (unless already-added-blank (insert "\n"))
963                 (insert (propertize (concat "   Week " week
964                                             (when (string= year current-year)
965                                               (if (string= week current-week) " (current)"))
966                                             (when (string= year current-year)
967                                               (if (string= week next-week) " (next week)"))
968                                             "\n")
969                                     'face 'enotes/list-title-face)
970                         )
971
972                 (unless enotes/full-display
973                   (insert "\n")
974                   )
975                 )
976               )
977
978             (setq already-added-blank nil)
979             (enotes/insert-note note time))
980
981           (enotes/sorted-by-time notes-to-display)
982           )
983     ))
984
985 ;; Show all notes one after another, sorted by event date. A title is
986 ;; inserted for "in a day or more", "in a week or more", etc.
987
988 (defun enotes/insert-all-notes-by-delay (time notes-to-display)
989   "Inserts all notes of the current day, then those less than one week
990 in the futur, then those less than one month (30 days) in the futur."
991   (let ((delay 0))
992     (mapc (lambda (note)
993             (let ((s (cond
994                       ((and (< delay enotes/year-duration)
995                             (>= (- (enotes/get-event-time note) time) enotes/year-duration))
996                        (enotes/line-title "In a year or more"))
997
998                       ((and (< delay enotes/month-duration)
999                             (>= (- (enotes/get-event-time note) time) enotes/month-duration))
1000                        (enotes/line-title "In a month or more"))
1001
1002                       ((and (< delay enotes/week-duration)
1003                             (>= (- (enotes/get-event-time note) time) enotes/week-duration))
1004                        (enotes/line-title "In a week or more"))
1005
1006                       ((and (< delay enotes/day-duration)
1007                             (>= (- (enotes/get-event-time note) time) enotes/day-duration))
1008                        (enotes/line-title "In a day or more")))))
1009
1010               (when s (insert "\n" (propertize s 'face 'enotes/list-title-face) "\n\n")))
1011
1012             (setq delay (- (enotes/get-event-time note) time))
1013             (enotes/insert-note note time))
1014
1015           (enotes/sorted-by-time notes-to-display)
1016           )
1017     )
1018   )
1019
1020 (defun enotes/refresh-note-buffer (time force-all)
1021
1022   "Refresh the current buffer as the buffer containing the list of
1023 notes. If FORCE-ALL is true display all notes, do not only update
1024 those in the buffer"
1025
1026   ;; This is sort of ugly, we keep track of where we are, to be able
1027   ;; to put back the cursor at the same location (at least the same
1028   ;; note and field, or the position itself), even after massive
1029   ;; modifications
1030
1031   (let ((note (get-text-property (point) 'note))
1032         (field (get-text-property (point) 'field))
1033         (p (point))
1034         (inhibit-read-only t)
1035         (notes-to-display (if force-all enotes/notes (enotes/list-of-notes-in-buffer))))
1036
1037     (erase-buffer)
1038
1039     (when enotes/show-help
1040       (insert "\n"
1041               enotes/help-string "\n")
1042       )
1043
1044     ;; Display all note according to the enotes/display-mode variable.
1045
1046     (if enotes/notes
1047         (eval `(,enotes/display-mode time notes-to-display))
1048       (insert "\n  "
1049               (propertize "No note." 'face 'bold)
1050               " (call enotes/init to load the saved ones).\n"))
1051
1052     (enotes/mode)
1053
1054     ;; Try to go back where we were, if we can't, go to the point
1055     ;; where we were (a priori lame but convenient in practice)
1056
1057     (let* ((s1 (text-property-any (point-min) (point-max) 'note note))
1058            (s2 (and s1 (text-property-any s1 (point-max) 'field field))))
1059       (if s2 (goto-char s2) (goto-char p))
1060       ;;       (recenter)
1061       )
1062     ))
1063
1064 ;; Switches to the note list buffer and refresh it
1065
1066 (defun enotes/show-all-notes (&optional current-window)
1067   "Show all notes in a buffer for edition"
1068   (interactive "P")
1069   (let ((buf (get-buffer "*enotes*")))
1070     (if current-window
1071         (switch-to-buffer (get-buffer-create "*enotes*"))
1072       (switch-to-buffer-other-window (get-buffer-create "*enotes*")))
1073     (enotes/refresh-note-buffer (float-time) t)))
1074
1075 (defun enotes/show-alarms (time)
1076   "Add the new alarms to the alarm buffer"
1077
1078   ;; I have to say, I am not sure to understand what
1079   ;; with-output-to-temp-buffer does ...
1080
1081   (with-output-to-temp-buffer "*enotes alarms*"
1082     (set-buffer "*enotes alarms*")
1083
1084     (insert
1085      "\n"
1086      (propertize
1087       (format "   Alarms (%s)" (format-time-string "%a %b %d %H:%M" (current-time)))
1088       'face 'enotes/alarm-face)
1089      "\n"
1090      )
1091
1092     (when enotes/show-help
1093       (insert "\n"
1094               (propertize (enotes/line-title "Help") 'face 'enotes/list-title-face)
1095               "\n\n" enotes/help-string "\n")
1096       )
1097
1098     (mapc (lambda (note)
1099             (when (>= time (enotes/get-warning-time note))
1100               (enotes/set-refresh-warning-time note)
1101               (enotes/insert-note note time)))
1102           enotes/notes)
1103
1104     (enotes/mode)
1105
1106     (resize-temp-buffer-window))
1107
1108   (run-hooks 'enotes/alarm-hook)
1109   )
1110
1111 (defun enotes/do-it ()
1112
1113   "Refresh all buffers in enotes/mode and forces all notes to be
1114 visible in the main one (called *enotes*). Generates an alarm with the
1115 notes whose warnings are in the past, refresh their warning
1116 times. Sets a call for the soonest one in the future."
1117
1118   (let ((time (float-time)))
1119
1120     ;; Refresh all notes in all enotes buffers
1121     (mapc (lambda (buf)
1122             (set-buffer buf)
1123             (when (eq major-mode 'enotes/mode)
1124               (enotes/refresh-note-buffer time (string= (buffer-name) "*enotes*"))))
1125           (buffer-list))
1126
1127     (setq enotes/notes (sort enotes/notes
1128                              (lambda (n1 n2) (< (enotes/get-warning-time n1)
1129                                                 (enotes/get-warning-time n2)))))
1130
1131     ;; If there is at least one to be shown, show them all
1132     (when (and enotes/notes (>= time (enotes/get-warning-time (car enotes/notes))))
1133       (save-excursion (enotes/show-alarms time)))
1134
1135     ;; If still something in the pipe, set a call for the next time
1136     (when enotes/notes
1137       (run-at-time (1+ (max 0 (- (enotes/get-warning-time (car enotes/notes)) (float-time))))
1138                    nil
1139                    'enotes/do-it))))
1140
1141 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1142 ;; Saving and loading
1143 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1144
1145 (defun enotes/remove-properties-in-place (l)
1146   (if (stringp l) (set-text-properties 0 (length l) nil l)
1147     (when (and l (listp l))
1148       (enotes/remove-properties-in-place (car l))
1149       (enotes/remove-properties-in-place (cdr l)))))
1150
1151 (defun enotes/save-notes ()
1152   "Write down in the file specified by `enotes/file' the content of
1153 `enotes/notes'"
1154   (interactive)
1155
1156   ;; There should not be properties in the strings. However, we strip
1157   ;; them out before saving for more safety.
1158
1159   (enotes/remove-properties-in-place enotes/notes)
1160
1161   (with-temp-buffer
1162
1163     ;; We trust the automatic detection of the appropriate encoding
1164     ;; scheme
1165
1166     ;; (set-buffer-file-coding-system 'latin-1)
1167
1168     (set-visited-file-name enotes/file)
1169
1170     (insert ";; -*-Emacs-Lisp-*-\n\n"
1171             ";; Saved by enotes.el on "
1172             (format-time-string "%h %a %d %Y %H:%M:%S" (seconds-to-time (float-time)))
1173             ".\n"
1174             ";; Automatically generated, edit with care.\n"
1175             "\n"
1176             "(setq enotes/notes\n")
1177
1178     (if (not enotes/notes) (insert "()\n")
1179       (insert "'(\n")
1180       ;; We manage to have one note per line, so that it is handled
1181       ;; correctly by CVS & co. (this is slightly messed-up if you
1182       ;; have CRs in the information field)
1183       (mapcar (lambda (entry) (insert (concat (prin1-to-string entry) "\n"))) enotes/notes)
1184       (insert ")\n"))
1185
1186     (insert ")\n")
1187     (emacs-lisp-mode)
1188     (indent-region (point-min) (point-max) nil)
1189     ;; save-buffer ensures the creation of the backup files if
1190     ;; necessary
1191     (save-buffer))
1192
1193   (let ((buf (get-buffer "*enotes*")))
1194     (when buf
1195       (set-buffer buf)
1196       (set-buffer-modified-p nil)))
1197
1198   (message "Notes saved in %s" enotes/file)
1199
1200   )
1201
1202 (defun enotes/load-notes ()
1203
1204   "Load the notes from the file specified by `enotes/file' into `enotes/notes'"
1205
1206   (if (file-exists-p enotes/file)
1207       ;; This hack to handle the old variable name enotes-notes
1208       (let ((enotes-notes nil))
1209         (load enotes/file)
1210         (when (and (not enotes/notes)
1211                    enotes-notes)
1212           (setq enotes/notes enotes-notes)))
1213     (setq enotes/notes ())
1214     (message "Creating a new list of notes. Welcome on board!"))
1215
1216   ;; Fix the length of notes to the current length (i.e. add as many
1217   ;; fields as required to be compliant with the current version)
1218
1219   (setq enotes/notes
1220         (mapcar (lambda (x) ()
1221                   (apply 'vector (append x (make-list (- 7 (length x)) nil))))
1222                 enotes/notes))
1223
1224   ;; If there are events in the past, let's use their date as the
1225   ;; warning-time date
1226
1227   ;;   (mapc (lambda (note)
1228   ;;           (if (> (float-time) (enotes/get-event-time note))
1229   ;;               (enotes/set-event-time note (enotes/get-event-time note))))
1230   ;;         enotes/notes)
1231
1232   (enotes/do-it))
1233
1234 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1235 ;; The main routine to start all that stuff
1236 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1237
1238 (defun enotes/init (&optional with-what)
1239   "Loads the notes from the file specified in `enotes/file' and calls
1240 `enotes/do-it'."
1241   (interactive)
1242
1243   (add-hook 'kill-emacs-hook 'enotes/save-notes)
1244
1245   (enotes/load-notes))
1246
1247 ;;   (when (and (memq 'gnus with-what)
1248 ;;              (require 'gnus-sum nil t))
1249
1250 ;;     (defun enotes/add-gnus-note ()
1251 ;;       "Add a note with a reference to a mail"
1252 ;;       (interactive)
1253 ;;       (let ((from
1254 ;;              (save-window-excursion
1255 ;;                (gnus-setup-message 'reply
1256 ;;                  (gnus-summary-select-article)
1257 ;;                  (set-buffer (gnus-copy-article-buffer))
1258 ;;                  (gnus-msg-treat-broken-reply-to))
1259 ;;                (and (re-search-forward "^From: \\(.*\\)$")
1260 ;;                     (match-string-no-properties 1))))
1261 ;;             (date (format-time-string enotes/input-time-format (time-add (current-time) '(0 86400 0)))))
1262 ;;         (when from (enotes/add-note date (concat "Reply to " from)))))
1263 ;;     (define-key enotes/mode-map "m" 'gnus-summary-mail-other-window)
1264 ;;     (define-key 'gnus-summary-mark-map "a" 'enotes/add-gnus-note)
1265 ;;     )
1266
1267 ;;   (when (and (memq 'calendar with-what)
1268 ;;              (require 'parse-time nil t)
1269 ;;              (require 'calendar nil t))
1270
1271 ;;     (defun enotes/show-calendar ()
1272 ;;       (interactive)
1273 ;;       (let ((note (get-text-property (point) 'note)))
1274 ;;         (if (not note) (message "No note at point")
1275 ;;           (calendar-goto-date (format-time-string
1276 ;;                                "%h %a %d %Y %H:%M:%S"
1277 ;;                                (seconds-to-time (enotes/get-event-time note)))))))
1278 ;;     )