;; -*-Emacs-Lisp-*-
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; This program is free software; you can redistribute it and/or ;;
;; modify it under the terms of the GNU General Public License as ;;
;; published by the Free Software Foundation; either version 3, or (at ;;
;; your option) any later version. ;;
;; ;;
;; This program is distributed in the hope that it will be useful, but ;;
;; WITHOUT ANY WARRANTY; without even the implied warranty of ;;
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU ;;
;; General Public License for more details. ;;
;; ;;
;; You should have received a copy of the GNU General Public License ;;
;; along with this program. If not, see . ;;
;; ;;
;; Written by and Copyright (C) Francois Fleuret ;;
;; Contact for comments & bug reports ;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; This file contains functions to handle rendez-vous and
;; appointments. It has a list of 'notes', each defined by a date, a
;; title, a warning date and optionnaly a tag color and a string of
;; information. The system automatically opens a window when an alarm
;; has to be displayed.
;; Just call enotes/init to load the notes saved during the last
;; session and run the whole stuff. The notes are kept in the variable
;; enotes/notes and saved when a note is added or when emacs is
;; killed.
;; You can bring the main buffer containing all notes by calling
;; enotes/show-all-notes. The defined keys are given at the top of
;; that buffer.
;; I use the following in my .emacs
;;
;; ;; Load the script itself
;; (load "enotes")
;; ;; Load the notes and display the required alarms
;; (enotes/init)
;; ;; That short-cuts to edit all the notes
;; (define-key global-map [(control x) (control n)] 'enotes/show-all-notes)
;;
;; Check the defcustom in the source below to see the tunable
;; variables.
(eval-when-compile (require 'cl))
(require 'time-date)
(require 'parse-time)
(defgroup enotes ()
"Set of functions to handle notes and rendez-vous."
:version "1.3.1")
(provide 'enotes)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defcustom enotes/file "~/.enotes"
"File containing the list of notes."
:type 'string
:group 'enotes)
(defcustom enotes/alarm-hook nil
"Hook called when alarms are to be displayed."
:type 'hook
:group 'enotes)
(defcustom enotes/input-time-format "%Y %b %d %H:%M"
"The time format for input."
:type 'string
:group 'enotes)
(defcustom enotes/time-format "%h %a %d %Y %H:%M"
"The time format."
:type 'string
:group 'enotes)
(defcustom enotes/show-help t
"Should the key help be displayed."
:type 'boolean
:group 'enotes)
(defcustom enotes/full-display t
"Should the infos be displayed."
:type 'boolean
:group 'enotes)
(defcustom enotes/display-mode 'enotes/insert-all-notes-by-week
"How to show the notes. Either `enotes/insert-all-notes-by-delay' or
`enotes/insert-all-notes-by-week'."
:type 'function
:group 'enotes)
(defcustom enotes/color-list '("red" "green3" "yellow" "blue")
"What colors can be given to the tags in front of the note titles"
:type 'list
:group 'enotes)
(defcustom enotes/default-time-fields "6:00"
"The default values for non-specified time fields when setting a date."
:type 'string
:group 'enotes)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defconst enotes/help-string " n,TAB: go to next note p,S-TAB: go to prev note
a: add note C-d,DEL: delete note
e: edit field at point c: change tag color
d: edit event time w: edit warning time
i: edit information I: switch full display
+: move event +1h =: move warning +1h
T: move event +24h t: move warning +24h
f: force warning time at event time
h: show/hide help m: switch display mode
u: undo r: redo
s: save notes RET,g: go to reference
q: quit Q: remove obsolete notes and quit
Contact for remarks & bug reports.")
(defmacro enotes/get-event-time (note) `(elt ,note 0))
(defmacro enotes/get-warning-time (note) `(elt ,note 1))
(defmacro enotes/get-note-time (note) `(elt ,note 2))
(defmacro enotes/get-title (note) `(elt ,note 3))
(defmacro enotes/get-ref (note) `(elt ,note 4))
(defmacro enotes/get-info (note) `(elt ,note 5))
(defmacro enotes/get-color (note) `(elt ,note 6))
(defun enotes/set-event-time (note date) (aset note 0 date))
(defun enotes/set-warning-time (note date) (aset note 1 date))
(defun enotes/set-note-time (note date) (aset note 2 date))
(defun enotes/set-title (note title) (aset note 3 (if (string= title "") "(No title)" title)))
(defun enotes/set-ref (note ref) (aset note 4 ref))
(defun enotes/set-info (note info) (aset note 5 (if (string= info "") nil info)))
(defun enotes/set-color (note color) (aset note 6 (if (string= color "") nil color)))
(defvar enotes/notes nil "Contains the list of notes")
(defvar enotes/mode-map nil "Mode map for enotes/mode")
(defvar enotes/past-history nil "Contains the history for undo")
(defvar enotes/futur-history nil "Contains the history for redo")
(defconst enotes/version "1.2" "The version Identifier")
(defconst enotes/year-duration 31536000 "How many seconds in a year")
(defconst enotes/month-duration 2592000 "How many seconds in a month")
(defconst enotes/week-duration 604800 "How many seconds in a week")
(defconst enotes/day-duration 86400 "How many seconds in a day")
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Face definitions
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defface enotes/list-title-face
'((((background light)) (:foreground "royal blue"))
(((background dark)) (:foreground "azure2")))
"The face for the list titles.")
(defface enotes/alarm-face
'((((background light)) (:foreground "red3" :bold t))
(((background dark)) (:foreground "red" :bold t)))
"The face for the alarm titles.")
(defface enotes/wrong-time-face
'((((background light)) (:foreground "red3" :bold t))
(((background dark)) (:foreground "red" :bold t)))
"The face for time in the past.")
(defface enotes/wrong-warning-face
'((((background light)) (:foreground "orange3" :bold t))
(((background dark)) (:foreground "orange" :bold t)))
"The face for warning after the event.")
(defface enotes/title-face
'((((background light)) (:underline t)))
"The face for event title.")
(defface enotes/information-face
'((((background light)) (:foreground "gray50")))
"The face for the additional information.")
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; (defun enotes/position-note (note)
;; "Returns the position of note NOTE in buffer or nil if it can not be
;; found"
;; (let ((pos (point-min)))
;; (while (and pos (not (eq note (get-text-property pos 'note))))
;; (message "pos = %s note = %s" (prin1-to-string pos) (prin1-to-string (get-text-property pos 'note)))
;; (setq pos (next-single-property-change pos 'note))
;; )
;; (if (and pos (eq note (get-text-property pos 'note))) pos nil)))
(defun enotes/go-to-next-note ()
"Move the cursor to the next note in buffer"
(interactive)
(let ((next (next-single-property-change (point) 'note)))
(when (and next
(not (get-text-property next 'note)))
(setq next (next-single-property-change next 'note)))
(unless next
(setq next (next-single-property-change (point-min) 'note)))
(if next (goto-char next)
(goto-char (point-min)))))
(defun enotes/go-to-prev-note ()
"Move the cursor to the previous note in buffer"
(interactive)
(let ((prev (previous-single-property-change (1- (point)) 'note)))
(when (and prev
(not (get-text-property prev 'note)))
(setq prev (previous-single-property-change prev 'note)))
(unless prev
(setq prev (previous-single-property-change (point-max) 'note)))
(if prev (goto-char prev)
(goto-char (point-max)))))
(defun enotes/go-to-ref-at-point ()
"Go to the reference (file only at this moment) of the note at cursor's location"
(interactive)
(let ((note (get-text-property (point) 'note)))
(if (not note) (error "No note at point")
(let ((ref (enotes/get-ref note)))
(if (not ref) (error "No reference")
(cond ((equal (car ref) 'file)
(switch-to-buffer (find-file-noselect (car (cdr ref))))
(goto-char (car (cddr ref))))
(t (error "Unknown attachement"))))))))
(defun enotes/add-file-note ()
"Add a note with a reference to the visited file"
(interactive)
(let ((date (format-time-string enotes/input-time-format (time-add (current-time) `(0 ,enotes/day-duration 0))))
(file (buffer-file-name)))
(if (not file)
(error "You are not visiting a file")
(enotes/add-note date "Going on working" (list 'file file (point))))))
(defun enotes/round-time (time delay)
"Heuristic to round the given time according to how far away it is
in the futur"
(cond ((> delay enotes/month-duration) (+ 25200 (- time (mod time enotes/day-duration))))
((> delay enotes/day-duration) (- time (mod time 3600)))
((> delay 11400) (- time (mod time 900)))
((> delay 1800) (- time (mod time 300)))
((> delay 300) (- time (mod time 60)))
(t (fround time))))
(defun enotes/next-in-list (x l)
(if x
(if (equal x (car l)) (car (cdr l))
(and l (enotes/next-in-list x (cdr l))))
(car l)))
(defun enotes/next-color ()
"Change the color mark of the event at point"
(interactive)
(let* ((note (get-text-property (point) 'note))
(color (and note (enotes/get-color note))))
(when note
(enotes/store-for-undo)
(enotes/set-color note (enotes/next-in-list color enotes/color-list))
(enotes/do-it))))
(defun enotes/move-warning (change)
"Move the next warning 24 hours in the futur"
(interactive)
(let* ((note (get-text-property (point) 'note))
(time (float-time))
(event-time (enotes/get-event-time note))
(warning-time (enotes/get-warning-time note))
(new-warning-time (+ change warning-time)))
(enotes/store-for-undo)
(if (and (< warning-time event-time) (> new-warning-time event-time))
(enotes/set-warning-time note event-time)
(enotes/set-warning-time note new-warning-time)))
(enotes/do-it))
(defun enotes/move-warning-1h ()
"Move the next warning one hour in the futur"
(interactive)
(enotes/move-warning 3600))
(defun enotes/move-warning-24h ()
"Move the next warning 24 hours in the futur"
(interactive)
(enotes/move-warning enotes/day-duration))
(defun enotes/move-event (change)
"Move the event date itself"
(interactive)
(let* ((note (get-text-property (point) 'note))
(event-time (and note (enotes/get-event-time note)))
(new-event-time (and event-time (+ change event-time))))
(when note
(enotes/store-for-undo)
(enotes/set-event-time note new-event-time)
(enotes/set-refresh-warning-time note)
(enotes/do-it))))
(defun enotes/move-event-24h ()
"Move the event date itself 24 hours in the futur"
(interactive)
(enotes/move-event enotes/day-duration))
(defun enotes/move-event-1h ()
"Move the event date itself one hour in the futur"
(interactive)
(enotes/move-event 3600))
(defun enotes/set-refresh-warning-time (note)
"Compute a new warning date, according to the event date, the note
creating date and the current next warning. This is an ad-hoc
heuristic. Improvements are welcome"
(if (enotes/get-warning-time note)
;; If it's not the first warning, we compute it as a delay from
;; now
(let* ((time (float-time))
(event-time (enotes/get-event-time note))
(warning-time (enotes/get-warning-time note))
(note-time (enotes/get-note-time note))
(anticipation (- event-time note-time))
(delay (- event-time time))
(delay-warning
(cond
((> anticipation enotes/year-duration)
;; The note was set more than ONE YEAR before the
;; event (serious stuff!)
(cond ((> delay (* 2 enotes/month-duration)) enotes/month-duration)
((> delay (* 2 enotes/week-duration)) enotes/week-duration)
(t enotes/day-duration)))
((> anticipation enotes/month-duration)
;; The note was set at least one month before the
;; event
(cond ((> delay enotes/week-duration) (* 2 enotes/day-duration))
(t enotes/day-duration)))
((> anticipation enotes/week-duration)
;; The note was set at least one week before the event
(cond ((> delay enotes/day-duration) enotes/day-duration)
(t 3600)))
(t
(cond ((> delay enotes/day-duration) enotes/day-duration)
((> delay 1800) 1800)
(t 900)))
))
(new-warning-time (enotes/round-time (+ time delay-warning) delay)))
;; If the preceding warning was before the event and the new
;; is after, force the new at the event date
(if (and (< warning-time event-time) (> new-warning-time event-time))
(enotes/set-warning-time note event-time)
;; else let the new be where we computed
(enotes/set-warning-time note new-warning-time)))
;; If it's the first warning, we define how long before the event
;; it has to be set
(let* ((time (fround (float-time)))
(anticipation (- (enotes/get-event-time note) (enotes/get-note-time note)))
(delay-warning
(cond
((> anticipation enotes/year-duration) (* 2 enotes/month-duration))
((> anticipation enotes/month-duration) enotes/week-duration)
((> anticipation enotes/week-duration) (* 2 enotes/day-duration))
((> anticipation (* 2 enotes/day-duration)) enotes/day-duration)
(t 3600)
))
(delay-warning (- (- (enotes/get-event-time note) delay-warning) time)))
;; Force at least 60s in the future
(enotes/set-warning-time
note
(max (+ time 60)
(enotes/round-time (+ time delay-warning) delay-warning))))
)
)
(defun enotes/add-note (&optional date title ref info)
"Add a note and ask for the field values if they are not provided"
(interactive)
(let* ((title (read-from-minibuffer
"Title: "
(or title "")))
(date (read-from-minibuffer
"Date: "
(or date
(format-time-string enotes/input-time-format
(current-time)))))
(info "")
(new-note (vector (enotes/string-to-float-time date)
nil
(fround (float-time))
nil
ref
(if (string= info "") nil info)
nil)))
(enotes/set-title new-note title)
(enotes/set-refresh-warning-time new-note)
(enotes/store-for-undo)
(setq enotes/notes (cons new-note enotes/notes))
(enotes/save-notes)
(enotes/do-it)
;; (message "%s (%s)" (prin1-to-string new-note) (prin1-to-string (enotes/position-note new-note)))
))
(defun enotes/default-list (l default-l)
(when l (cons (or (car l) (car default-l))
(enotes/default-list (cdr l) (cdr default-l)))))
(defun enotes/default-time-fields ()
(let ((time (decode-time (current-time))))
(enotes/default-list
(parse-time-string enotes/default-time-fields)
`(0 0 6 1 ,(elt time 4) ,(elt time 5)))
))
(defun enotes/string-to-float-time (date)
(let ((time (decode-time (current-time))))
(float-time (apply 'encode-time
(enotes/default-list
(parse-time-string date)
(enotes/default-time-fields))))))
(defun enotes/second-to-delay (second)
"Returns a string describing a delay in english"
(cond ((< second (- enotes/day-duration))
(format "%d day%s ago"
(/ second -86400)
(if (> (ftruncate (/ second -86400)) 1)
"s" "")))
((< second -3600)
(format "%dh ago" (/ second -3600)))
((< second -300)
(format "%dmin ago" (/ second -60)))
((< second 0)
(format "now!!!" (/ second -60)))
((< second 3600)
(format "in %dmin" (/ second 60)))
((< second enotes/day-duration)
(format "in %dh" (/ second 3600)))
((< second (* 3 enotes/month-duration))
(format "in %d day%s" (/ second 86400)
(if (> (ftruncate (/ second 86400)) 1)
"s" "")))
(t
(format "in ~ %d month%s" (/ second 2592000)
(if (> (ftruncate (/ second 2592000)) 1)
"s" "")))))
(defun enotes/cond-propertize (cnd str prop)
"Propertize STR if both CND and PROP are non-nil"
(if (and prop cnd) (apply 'propertize (cons str prop))
str))
(defun enotes/title-string (note)
(concat
(propertize
(concat
" "
;; The small color tag
(if (enotes/get-color note)
(propertize " "
'face (cons 'background-color (enotes/get-color note)))
" ")
(if (equal (enotes/get-event-time note) (enotes/get-warning-time note)) "+" " ")
" ")
'field 'title)
(propertize
(enotes/get-title note)
'face 'enotes/title-face
'field 'title)
(if (and (not enotes/full-display) (enotes/get-info note)) (propertize " /.../" 'field 'information) "")
))
(defun enotes/insert-blank-line () (interactive)
(let ((p (point)))
(unless (and
(> p 1)
(eq (char-before p) ?\n)
(or (eq p 2)
(eq (char-before (1- p)) ?\n)))
(insert "\n"))))
(defun enotes/insert-note (note time)
"Insert the note in the buffer, with fields properties so that we can
edit them easily later on"
(let ((obsolete (>= time (enotes/get-event-time note)))
(info (enotes/get-info note))
(title (enotes/title-string note)))
(when enotes/full-display (enotes/insert-blank-line))
(insert
(propertize
(concat
;; Title
title
(if enotes/full-display "\n"
(make-string (max 0 (- 40 (length title))) ? )
)
;; Date event
(propertize
(concat
(if enotes/full-display " Date: " " ")
(enotes/cond-propertize
obsolete
(format-time-string enotes/time-format (seconds-to-time (enotes/get-event-time note)))
'(face enotes/wrong-time-face))
" ("
(enotes/second-to-delay (- (enotes/get-event-time note) time))
")\n")
'field 'event-time)
;; Date next warning
(when (and enotes/full-display
(not (equal (enotes/get-warning-time note) (enotes/get-event-time note))))
(propertize
(concat
" Warning: "
(enotes/cond-propertize
(and (not obsolete) (> (enotes/get-warning-time note) (enotes/get-event-time note)))
(format-time-string enotes/time-format (seconds-to-time (enotes/get-warning-time note)))
'(face enotes/wrong-warning-face))
"\n"
)
'field 'warning-time)
)
;; Reference (if there is one)
(let ((ref (enotes/get-ref note)))
(when ref
(cond ((equal 'file (car ref))
(format " Ref: file [%s]\n" (file-name-nondirectory (car (cdr ref)))))
(t " Ref: *unknown type*\n"))))
;; Complementary information (if there are some)
(when (and enotes/full-display info)
(propertize
(format " Info: %s\n"
(propertize
;; Ugly hack to match exactly the end of
;; the string: add a ^_ at the end ...
(replace-regexp-in-string "[\n ]* " ""
(replace-regexp-in-string "\n\\([^\n]+\\)"
"\n \\1"
(concat info " ")))
'face 'enotes/information-face)
)
'field 'information)
)
)
'note note 'obsolete obsolete))))
(defun enotes/delete-note-at-point ()
"Delete the note at cursor's location"
(interactive)
(let ((note (get-text-property (point) 'note)))
(if (not note) (error "No note at point")
(enotes/store-for-undo)
(setq enotes/notes (delq note enotes/notes))))
(enotes/do-it))
(defun enotes/set-warning-at-event ()
"Force the next warning time at the event time"
(interactive)
(let ((time (float-time))
(note (get-text-property (point) 'note)))
(if (not note) (error "No note at point")
(let ((obsolete (>= time (enotes/get-event-time note))))
(enotes/store-for-undo)
(if obsolete
(enotes/set-warning-time note (+ time 3600))
(enotes/set-warning-time note (enotes/get-event-time note))))
(enotes/do-it))))
(defun enotes/switch-help () (interactive)
(setq enotes/show-help (not enotes/show-help))
(enotes/do-it))
(defun enotes/switch-infos-display ()
"Switch between displaying and not displaying the warning time
and additional information"
(interactive)
(setq enotes/full-display (not enotes/full-display))
(enotes/do-it))
(defun enotes/switch-display () (interactive)
(setq enotes/display-mode
(cdr (assoc
enotes/display-mode
'((enotes/insert-all-notes-by-delay . enotes/insert-all-notes-by-week)
(enotes/insert-all-notes-by-week . enotes/insert-all-notes-by-delay)))))
(enotes/do-it))
(defun enotes/save-note-information () (interactive)
(enotes/store-for-undo)
(enotes/set-info enotes/edited-note
(buffer-substring-no-properties (point-min)
(point-max)))
(kill-this-buffer)
(enotes/do-it))
(defun enotes/cancel-edit-info () (interactive)
(if (and (buffer-modified-p)
(not (y-or-n-p "Lose changes ? ")))
(error "Cancel cancel"))
(kill-this-buffer)
(enotes/do-it)
(message "Cancel")
)
(defun enotes/edit-information-note-at-point ()
"Use the 'field property of the character at point to figure out
what note has to have its information edited, and edit it in a new
buffer"
(interactive)
(let ((note (get-text-property (point) 'note))
(map (make-sparse-keymap)))
(unless note (error "No note at point"))
(switch-to-buffer (get-buffer-create
(generate-new-buffer-name "*enotes information*")))
(text-mode)
(auto-fill-mode)
(define-key map [(control c) (control c)] 'enotes/save-note-information)
(define-key map [(control c) (control q)] 'enotes/cancel-edit-info)
(set (make-local-variable 'enotes/edited-note) note)
(set (make-local-variable 'fill-column) 60)
(use-local-map map)
(when (enotes/get-info note)
(insert (enotes/get-info note))
(setq buffer-undo-list nil)
(set-buffer-modified-p nil)
(set-auto-mode))
(message "C-c C-c to save the information, C-c C-q to cancel")
))
(defun enotes/edit-event-time-note-at-point ()
(interactive)
(let ((note (get-text-property (point) 'note)))
(unless note (error "No note at point"))
(let ((new-event-time (enotes/string-to-float-time
(read-from-minibuffer
"Date: "
(format-time-string
enotes/input-time-format
(seconds-to-time (enotes/get-event-time note)))))))
(unless (= new-event-time (enotes/get-event-time note))
(enotes/store-for-undo)
(enotes/set-event-time note new-event-time)
(enotes/do-it)))))
(defun enotes/edit-warning-time-note-at-point ()
(interactive)
(let ((note (get-text-property (point) 'note)))
(unless note (error "No note at point"))
(let ((new-warning-time (enotes/string-to-float-time
(read-from-minibuffer
"Warning: "
(format-time-string
enotes/input-time-format
(seconds-to-time (enotes/get-warning-time note)))))))
(unless (= new-warning-time (enotes/get-warning-time note))
(enotes/store-for-undo)
(enotes/set-warning-time note new-warning-time)
(enotes/do-it)))))
(defun enotes/edit-field-at-point ()
"Ask for a new value for the field at cursor's location"
(interactive)
(let ((note (get-text-property (point) 'note))
(field (get-text-property (point) 'field)))
(cond
((eq field 'title)
(let ((new-title (read-from-minibuffer "Title: " (enotes/get-title note))))
(unless (string= new-title (enotes/get-title note))
(enotes/store-for-undo)
(enotes/set-title note new-title)
(enotes/do-it))))
((eq field 'event-time)
(let ((new-event-time (enotes/string-to-float-time
(read-from-minibuffer
"Date: "
(format-time-string
enotes/input-time-format
(seconds-to-time (enotes/get-event-time note)))))))
(unless (= new-event-time (enotes/get-event-time note))
(enotes/store-for-undo)
(enotes/set-event-time note new-event-time)
(enotes/set-refresh-warning-time note)
(enotes/do-it))))
((eq field 'note-time)
(error "Can not edit that field"))
((eq field 'warning-time)
(let ((new-warning-time (enotes/string-to-float-time
(read-from-minibuffer
"Warning: "
(format-time-string
enotes/input-time-format
(seconds-to-time (enotes/get-warning-time note)))))))
(unless (= new-warning-time (enotes/get-warning-time note))
(enotes/store-for-undo)
(enotes/set-warning-time note new-warning-time)
(enotes/do-it))))
((eq field 'information)
(enotes/edit-information-note-at-point))
(t (error "No known field at point"))
)
)
)
(defun enotes/remove-buffer ()
"Kill the current buffer and delete the current window if it's not
the only one in the frame"
(interactive)
(kill-this-buffer)
(unless (one-window-p t) (delete-window)))
(defun enotes/remove-obsolete-remove-buffer ()
"Delete the obsolete notes appearing in the current buffer, delete
the buffer and the current window if it's not the only one in the
frame"
(interactive)
(let ((s (point-min)))
(while (setq s (text-property-any (1+ s) (point-max) 'obsolete t))
(setq enotes/notes (delq (get-text-property s 'note) enotes/notes))))
;; If the "list of notes" buffer is visible and is not the current
;; one, refresh it
(enotes/remove-buffer)
(enotes/do-it))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; The undo/redo stuff
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun enotes/store-for-undo ()
"Keep a copy of the current `enotes/notes' in `enotes/past-history'
value for undo. Reset `enotes/futur-history' to nil"
(interactive)
;; Need to copy the cells themselves, thus the mapcar thingy
(setq enotes/past-history (cons (mapcar 'copy-sequence enotes/notes) enotes/past-history)
enotes/futur-history nil)
)
(defun enotes/undo ()
"Put the current `enotes/notes' into `enotes/futur-history' and take
the value of `enotes/notes' from `enotes/past-history'"
(interactive)
(if (not enotes/past-history)
(error "Nothing to undo!")
(setq enotes/futur-history (cons enotes/notes enotes/futur-history)
enotes/notes (car enotes/past-history)
enotes/past-history (cdr enotes/past-history))
(enotes/refresh-note-buffer (float-time) t)
(message "Undo!"))
)
(defun enotes/redo ()
"Put the current `enotes/notes' into `enotes/past-history' and take
the value of `enotes/notes' from `enotes/futur-history'"
(interactive)
(if (not enotes/futur-history)
(error "Nothing to redo!")
(setq enotes/past-history (cons enotes/notes enotes/past-history)
enotes/notes (car enotes/futur-history)
enotes/futur-history (cdr enotes/futur-history))
(enotes/refresh-note-buffer (float-time) t)
(message "Redo!"))
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun enotes/mode ()
"Major mode to manage a list of notes. The list of 'notes' is kept
in `enotes/notes'. Each note is defined by a date, an event time, a
warning time and optionally by a string of informations and a colored
tag. Just call `enotes/init' to load the notes saved during the last
session and run the whole stuff. The notes are saved when a note is
added or when emacs is killed.
You can bring the main buffer containing all notes by calling
`enotes/show-all-notes'."
(interactive)
(unless enotes/mode-map
(setq enotes/mode-map (make-sparse-keymap))
(suppress-keymap enotes/mode-map)
(mapc (lambda (x) (define-key enotes/mode-map (car x) (cdr x)))
`(([(delete)] . enotes/delete-note-at-point)
([(control d)] . enotes/delete-note-at-point)
("d" . enotes/edit-event-time-note-at-point)
("a" . enotes/add-note)
("e" . enotes/edit-field-at-point)
("h" . enotes/switch-help)
("m" . enotes/switch-display)
("I" . enotes/switch-infos-display)
("i" . enotes/edit-information-note-at-point)
("w" . enotes/edit-warning-time-note-at-point)
("c" . enotes/next-color)
("g" . enotes/go-to-ref-at-point)
("t" . enotes/move-warning-24h)
("T" . enotes/move-event-24h)
("=" . enotes/move-warning-1h)
("+" . enotes/move-event-1h)
(,(kbd "RET") . enotes/go-to-ref-at-point)
(,(kbd "TAB") . enotes/go-to-next-note)
("n" . enotes/go-to-next-note)
([(shift iso-lefttab)] . enotes/go-to-prev-note)
("p" . enotes/go-to-prev-note)
("q" . enotes/remove-buffer)
("Q" . enotes/remove-obsolete-remove-buffer)
("u" . enotes/undo)
("r" . enotes/redo)
("s" . enotes/save-notes)
([(control x) (control s)] . enotes/save-notes)
("f" . enotes/set-warning-at-event)
))
(substitute-key-definition 'undo 'enotes/undo enotes/mode-map global-map)
)
(kill-all-local-variables)
(use-local-map enotes/mode-map)
(setq mode-name "Enotes"
buffer-read-only t
;; truncate-lines t
major-mode 'enotes/mode)
)
(defun enotes/list-of-notes-in-buffer ()
"Return all the notes in the current buffer (used to refresh them)"
(let ((current (point-min))
(result ()))
(while (setq current (next-single-property-change current 'note))
(when current
(let ((n (get-text-property current 'note)))
(if (and n (member n enotes/notes)) (setq result (cons n result))))))
result))
(defun enotes/line-title (title)
"Create a string of length 75 padded with -s"
(concat "-- " title " "
(make-string (- 72 (length title)) ?-)
;; "\n"
;; (if enotes/full-display "" "\n")
)
)
(defun enotes/sorted-by-time (notes)
(sort (copy-sequence notes)
(lambda (n1 n2) (and (<= (enotes/get-event-time n1)
(enotes/get-event-time n2))
(or (not (= (enotes/get-event-time n1)
(enotes/get-event-time n2)))
(string< (enotes/get-title n1)
(enotes/get-title n2)))))))
;; Show all notes one after another, sorted by event date. A title is
;; inserted for each week of the year containing events, and for each
;; month.
(defun enotes/insert-all-notes-by-week (time notes-to-display)
"Inserts notes grouped by weeks."
(let ((current-week (format-time-string "%W" (seconds-to-time time)))
(current-year (format-time-string "%Y" (seconds-to-time time)))
(next-week (format-time-string "%W" (seconds-to-time (+ time enotes/week-duration))))
(loop-week "")
(loop-month "")
(loop-year "")
(already-added-blank))
(mapc (lambda (note)
(let* ((time-event (seconds-to-time (enotes/get-event-time note)))
(week (format-time-string "%W" time-event))
(month (format-time-string "%B" time-event))
(year (format-time-string "%Y" time-event)))
(when (not (and (string= month loop-month) (string= year loop-year)))
(setq loop-month month
loop-year year)
(insert "\n"
(propertize (enotes/line-title
(concat month
(if (not (string= year current-year))
(concat " (" year ")"))
))
'face 'enotes/list-title-face)
"\n"
)
(insert "\n")
(setq already-added-blank t)
)
(when (not (string= week loop-week))
(setq loop-week week)
(unless already-added-blank (insert "\n"))
(insert (propertize (concat " Week " week
(when (string= year current-year)
(if (string= week current-week) " (current)"))
(when (string= year current-year)
(if (string= week next-week) " (next week)"))
"\n")
'face 'enotes/list-title-face)
)
(unless enotes/full-display
(insert "\n")
)
)
)
(setq already-added-blank nil)
(enotes/insert-note note time))
(enotes/sorted-by-time notes-to-display)
)
))
;; Show all notes one after another, sorted by event date. A title is
;; inserted for "in a day or more", "in a week or more", etc.
(defun enotes/insert-all-notes-by-delay (time notes-to-display)
"Inserts all notes of the current day, then those less than one week
in the futur, then those less than one month (30 days) in the futur."
(let ((delay 0))
(mapc (lambda (note)
(let ((s (cond
((and (< delay enotes/year-duration)
(>= (- (enotes/get-event-time note) time) enotes/year-duration))
(enotes/line-title "In a year or more"))
((and (< delay enotes/month-duration)
(>= (- (enotes/get-event-time note) time) enotes/month-duration))
(enotes/line-title "In a month or more"))
((and (< delay enotes/week-duration)
(>= (- (enotes/get-event-time note) time) enotes/week-duration))
(enotes/line-title "In a week or more"))
((and (< delay enotes/day-duration)
(>= (- (enotes/get-event-time note) time) enotes/day-duration))
(enotes/line-title "In a day or more")))))
(when s (insert "\n" (propertize s 'face 'enotes/list-title-face) "\n\n")))
(setq delay (- (enotes/get-event-time note) time))
(enotes/insert-note note time))
(enotes/sorted-by-time notes-to-display)
)
)
)
(defun enotes/refresh-note-buffer (time force-all)
"Refresh the current buffer as the buffer containing the list of
notes. If FORCE-ALL is true display all notes, do not only update
those in the buffer"
;; This is sort of ugly, we keep track of where we are, to be able
;; to put back the cursor at the same location (at least the same
;; note and field, or the position itself), even after massive
;; modifications
(let ((note (get-text-property (point) 'note))
(field (get-text-property (point) 'field))
(p (point))
(inhibit-read-only t)
(notes-to-display (if force-all enotes/notes (enotes/list-of-notes-in-buffer))))
(erase-buffer)
(when enotes/show-help
(insert "\n"
enotes/help-string "\n")
)
;; Display all note according to the enotes/display-mode variable.
(if enotes/notes
(eval `(,enotes/display-mode time notes-to-display))
(insert "\n "
(propertize "No note." 'face 'bold)
" (call enotes/init to load the saved ones).\n"))
(enotes/mode)
;; Try to go back where we were, if we can't, go to the point
;; where we were (a priori lame but convenient in practice)
(let* ((s1 (text-property-any (point-min) (point-max) 'note note))
(s2 (and s1 (text-property-any s1 (point-max) 'field field))))
(if s2 (goto-char s2) (goto-char p))
;; (recenter)
)
))
;; Switches to the note list buffer and refresh it
(defun enotes/show-all-notes (&optional current-window)
"Show all notes in a buffer for edition"
(interactive "P")
(let ((buf (get-buffer "*enotes*")))
(if current-window
(switch-to-buffer (get-buffer-create "*enotes*"))
(switch-to-buffer-other-window (get-buffer-create "*enotes*")))
(enotes/refresh-note-buffer (float-time) t)))
(defun enotes/show-alarms (time)
"Add the new alarms to the alarm buffer"
;; I have to say, I am not sure to understand what
;; with-output-to-temp-buffer does ...
(with-output-to-temp-buffer "*enotes alarms*"
(set-buffer "*enotes alarms*")
(insert
"\n"
(propertize
(format " Alarms (%s)" (format-time-string "%a %b %d %H:%M" (current-time)))
'face 'enotes/alarm-face)
"\n"
)
(when enotes/show-help
(insert "\n"
(propertize (enotes/line-title "Help") 'face 'enotes/list-title-face)
"\n\n" enotes/help-string "\n")
)
(mapc (lambda (note)
(when (>= time (enotes/get-warning-time note))
(enotes/set-refresh-warning-time note)
(enotes/insert-note note time)))
enotes/notes)
(enotes/mode)
(resize-temp-buffer-window))
(run-hooks 'enotes/alarm-hook)
)
(defun enotes/do-it ()
"Refresh all buffers in enotes/mode and forces all notes to be
visible in the main one (called *enotes*). Generates an alarm with the
notes whose warnings are in the past, refresh their warning
times. Sets a call for the soonest one in the future."
(let ((time (float-time)))
;; Refresh all notes in all enotes buffers
(mapc (lambda (buf)
(set-buffer buf)
(when (eq major-mode 'enotes/mode)
(enotes/refresh-note-buffer time (string= (buffer-name) "*enotes*"))))
(buffer-list))
(setq enotes/notes (sort enotes/notes
(lambda (n1 n2) (< (enotes/get-warning-time n1)
(enotes/get-warning-time n2)))))
;; If there is at least one to be shown, show them all
(when (and enotes/notes (>= time (enotes/get-warning-time (car enotes/notes))))
(save-excursion (enotes/show-alarms time)))
;; If still something in the pipe, set a call for the next time
(when enotes/notes
(run-at-time (1+ (max 0 (- (enotes/get-warning-time (car enotes/notes)) (float-time))))
nil
'enotes/do-it))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Saving and loading
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun enotes/remove-properties-in-place (l)
(if (stringp l) (set-text-properties 0 (length l) nil l)
(when (and l (listp l))
(enotes/remove-properties-in-place (car l))
(enotes/remove-properties-in-place (cdr l)))))
(defun enotes/save-notes ()
"Write down in the file specified by `enotes/file' the content of
`enotes/notes'"
(interactive)
;; There should not be properties in the strings. However, we strip
;; them out before saving for more safety.
(enotes/remove-properties-in-place enotes/notes)
(with-temp-buffer
;; We trust the automatic detection of the appropriate encoding
;; scheme
;; (set-buffer-file-coding-system 'latin-1)
(set-visited-file-name enotes/file)
(insert ";; -*-Emacs-Lisp-*-\n\n"
";; Saved by enotes.el on "
(format-time-string "%h %a %d %Y %H:%M:%S" (seconds-to-time (float-time)))
".\n"
";; Automatically generated, edit with care.\n"
"\n"
"(setq enotes/notes\n")
(if (not enotes/notes) (insert "()\n")
(insert "'(\n")
;; We manage to have one note per line, so that it is handled
;; correctly by CVS & co. (this is slightly messed-up if you
;; have CRs in the information field)
(mapcar (lambda (entry) (insert (concat (prin1-to-string entry) "\n"))) enotes/notes)
(insert ")\n"))
(insert ")\n")
(emacs-lisp-mode)
(indent-region (point-min) (point-max) nil)
;; save-buffer ensures the creation of the backup files if
;; necessary
(save-buffer))
(let ((buf (get-buffer "*enotes*")))
(when buf
(set-buffer buf)
(set-buffer-modified-p nil)))
(message "Notes saved in %s" enotes/file)
)
(defun enotes/load-notes ()
"Load the notes from the file specified by `enotes/file' into `enotes/notes'"
(if (file-exists-p enotes/file)
;; This hack to handle the old variable name enotes-notes
(let ((enotes-notes nil))
(load enotes/file)
(when (and (not enotes/notes)
enotes-notes)
(setq enotes/notes enotes-notes)))
(setq enotes/notes ())
(message "Creating a new list of notes. Welcome on board!"))
;; Fix the length of notes to the current length (i.e. add as many
;; fields as required to be compliant with the current version)
(setq enotes/notes
(mapcar (lambda (x) ()
(apply 'vector (append x (make-list (- 7 (length x)) nil))))
enotes/notes))
;; If there are events in the past, let's use their date as the
;; warning-time date
;; (mapc (lambda (note)
;; (if (> (float-time) (enotes/get-event-time note))
;; (enotes/set-event-time note (enotes/get-event-time note))))
;; enotes/notes)
(enotes/do-it))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; The main routine to start all that stuff
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun enotes/init (&optional with-what)
"Loads the notes from the file specified in `enotes/file' and calls
`enotes/do-it'."
(interactive)
(add-hook 'kill-emacs-hook 'enotes/save-notes)
(enotes/load-notes))
;; (when (and (memq 'gnus with-what)
;; (require 'gnus-sum nil t))
;; (defun enotes/add-gnus-note ()
;; "Add a note with a reference to a mail"
;; (interactive)
;; (let ((from
;; (save-window-excursion
;; (gnus-setup-message 'reply
;; (gnus-summary-select-article)
;; (set-buffer (gnus-copy-article-buffer))
;; (gnus-msg-treat-broken-reply-to))
;; (and (re-search-forward "^From: \\(.*\\)$")
;; (match-string-no-properties 1))))
;; (date (format-time-string enotes/input-time-format (time-add (current-time) '(0 86400 0)))))
;; (when from (enotes/add-note date (concat "Reply to " from)))))
;; (define-key enotes/mode-map "m" 'gnus-summary-mail-other-window)
;; (define-key 'gnus-summary-mark-map "a" 'enotes/add-gnus-note)
;; )
;; (when (and (memq 'calendar with-what)
;; (require 'parse-time nil t)
;; (require 'calendar nil t))
;; (defun enotes/show-calendar ()
;; (interactive)
;; (let ((note (get-text-property (point) 'note)))
;; (if (not note) (message "No note at point")
;; (calendar-goto-date (format-time-string
;; "%h %a %d %Y %H:%M:%S"
;; (seconds-to-time (enotes/get-event-time note)))))))
;; )