+
+;; -*-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 <http://www.gnu.org/licenses/>. ;;
+;; ;;
+;; Written by and Copyright (C) Francois Fleuret ;;
+;; Contact <francois@fleuret.org> 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)
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(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 <francois@fleuret.org> 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/string-to-float-time (date)
+ (let ((time (decode-time (current-time))))
+ (float-time (apply 'encode-time
+ (enotes/default-list (parse-time-string date) `(0 0 6 1 ,(elt time 4) ,(elt time 5)))))))
+
+(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 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)))
+ " ")
+
+ " ")
+
+ '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 ]*\1f" ""
+ (replace-regexp-in-string "\n\\([^\n]+\\)"
+ "\n \\1"
+ (concat info "\1f")))
+ '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)))))))
+;; )