diff -r df7496e40bee -r a234a7579958 lisp/my-old-planner.el --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/lisp/my-old-planner.el Thu Oct 13 08:46:42 2011 -0400 @@ -0,0 +1,448 @@ +; timeclock functionnality +(require 'timeclock) +(require 'calendar) + +;(timeclock-modeline-display) +(add-hook 'kill-emacs-hook 'timeclock-query-out) + +;; planner mode + +;;; helper functions + +(defun planner-date-to-calendar (date) + "Convert a planner date string like \"YYYY.MM.DD\" in + a calendar date list (month day year)." + (let ((split-date + (mapcar 'string-to-number + (split-string (file-name-nondirectory date) "\\.")))) + (list (nth 1 split-date) + (nth 2 split-date) + (nth 0 split-date)))) + +(defsubst calendar-date-to-planner (date) +; "Convert a planner date string like \"YYYY.MM.DD\" in +; a calendar date list (month day year)." + (format "%04d.%02d.%02d" + (nth 2 date) + (nth 0 date) + (nth 1 date))) + +;; Moving functions + +(defun planner-goto-schedule () + "Create if necessary and go to a Schedule section in current planner. +Ensure to preserved the buffer-modified-p value so that a kill will not +preserve the automated change for nothing." + (interactive) + (goto-char (point-min)) + (let ((modified (buffer-modified-p))) + (unless (re-search-forward "^\\* Schedule\n\n" nil t) + (re-search-forward "^\\* Notes") + (beginning-of-line) + (insert "* Schedule\n\n\n\n") + (forward-line -2) + (set-buffer-modified-p modified)))) + +(defun planner-goto-events () + "Create if necessary and go to a Events section just before the +Schedule one (which is also create if necessary) in current planner. +Ensure to preserved the buffer-modified-p value so that a kill will +not preserve the automated change for nothing." + (interactive) + (goto-char (point-min)) + (let ((modified (buffer-modified-p))) + (unless (re-search-forward "^\\* Events\n\n" nil t) + (planner-goto-schedule) + (re-search-backward "^\\* Schedule") + (insert "* Events\n\n\n\n") + (forward-line -2) + (set-buffer-modified-p modified)))) + +;; The reminders converter. +;; +;; It now used a custom diary file, so you +;; can included it without breaking your normal diary-file. +;; The function can also set some arguments. I used it to call +;; a modified remconv which accept a "euro" argument to output +;; euro style date. +;; +;; I no more used those ones now since I'm directly marking the +;; calendar and the add-appt from the planner files. + +(defcustom planner-diary-file diary-file + "Diary file where to add planner entries. You can set this value to +another file than `diary-file' and add in `diary-file' the #include +\"~/your-planner-diary-file-name\". Just make sure that you call +`planner-convert-reminders' before `include-other-diary-files' in the +`list-diary-entries-hook'." + :type 'file + :group 'planner) + +(defcustom planner-remconv-command "remconv" + "A command that output diary compatible entries. Can take arguments +also." + :type 'string + :group 'planner) + +(defun planner-convert-reminders () + "Generate a diary file from a .reminders file. +You can add this this function to the `list-diary-entries-hook'" + (with-current-buffer (find-file-noselect planner-diary-file) + (erase-buffer) + (insert (shell-command-to-string planner-remconv-command)) + (save-buffer))) + +;; redefinition of planner-maybe-remove-file +;; +;; The kill-buffer of this function make me crazy. I modify it so you +;; can change it's behavior using this custom variable. Personnaly, I +;; used ignore and let emacs ask me to save it when I kill it. Take +;; also note that I change the regexp to remove any file that only +;; have empty section (section with just a first level heading). This +;; is to cope with the new Events and Schedule sections. + +(defcustom planner-not-empty-file 'kill-this-buffer + "Command to run when a planner file is not empty. Can be +kill-this-buffer, save-buffer or ignore for example." + :type 'function + :group 'planner) + +(defvar local-planner-empty-line-regexp "\\(\\* .*\\|[[:space:]]*\\)") +(defvar planner-empty-file-regexp + (concat "\\(^" local-planner-empty-line-regexp + "\n\\)*[[:space:]]*\\'")) + +; redefinition + +(defun planner-maybe-remove-file () + "This function remove the file if it contains only first level +headings and empty lines." + (interactive) + (goto-char (point-min)) + (if (looking-at planner-empty-file-regexp) + (let ((filename buffer-file-name)) + (set-buffer-modified-p nil) + (kill-buffer (current-buffer)) + (delete-file filename)) + (funcall planner-not-empty-file))) + +;; planner-browse-url bbdb url handling +;; +;; My emacs-wiki doesn't like bbdb url like [[bbdb://Fabien Niņoles]] +;; I make this advice so he can replace _ with space and __ with _ in the +;; url before letting planner-browse-url handling it. + +(defadvice planner-browse-url (before local-bbdb-url-pretreatment (url)) + "Pretreatment of some URL." + (if (string-match "^bbdb://\\(.+\\)" url) + (setq url + (mapconcat + '(lambda (str) (subst-char-in-string ?_ ? str t)) + (split-string url "__") + "_")))) + +(ad-activate 'planner-browse-url) + +;; diary support functions +;; +;; This functions add diary entries into the Schedule and Events +;; sections of a planner buffer. I hook it to the +;; `planner-seek-to-first' function and only if the Events section +;; doesn't already exist. The best should be that it check if the +;; entry doesn't exist already instead but currently it works pretty +;; good. You can always call it interactively if you want to update +;; your Events/Schedule. Just make sure that you don't add the +;; `planner-convert-reminder' set in the `list-diary-entries-hook' +;; setup. + +(defun planner-insert-diary () + "Insert the diary schedule in the planner buffer." + (interactive) + (let* + ((entries (list-diary-entries (planner-date-to-calendar (emacs-wiki-page-name)) 1)) + (events)) + (planner-goto-schedule) + (while entries + (let* ((entry (nth 1 (car entries))) + (lines (split-string entry "\n")) + (line)) + (while (setq line (car lines)) + (if (string-match + "^[[:space:]]*\\([0-9]+:[0-9]\\{2\\}\\(?:am\\|pm\\)?\\)\\(-[0-9]+:[0-9]\\{2\\}\\(?:am\\|pm\\)?\\)?[[:space:]]+\\(.*\\)$" + line) + (let ((starttime (match-string 1 line)) + (endtime (match-string 2 line)) + (description (match-string 3 line))) + (insert (concat " " starttime + " | " description + (if endtime + (let + ((minutes + (- (appt-convert-time (substring endtime 1 nil)) + (appt-convert-time starttime)))) + (format " (%d:%02d)" + (/ minutes 60) + (% minutes 60))) + "") + "\n"))) + (setq events (cons line events))) + (setq lines (cdr lines)))) + (setq entries (cdr entries))) + (planner-goto-events) + (while events + (insert (concat " - " (car events) "\n")) + (setq events (cdr events))))) + +(defadvice planner-seek-to-first (after planner-insert-diary-ad ()) + "Insert the diary into a newly create buffer." + (if (string-match planner-date-regexp (emacs-wiki-page-name)) + (save-excursion + (goto-char (point-min)) + (if (not (re-search-forward "^\\* Events[[:space:]]*$" nil t)) + (planner-insert-diary))))) + +(ad-activate 'planner-seek-to-first) + +;; appt support +;; +;; I'm loading now my appointments directly from the planner list. It +;; has the same functionnality as the regular appt-make-list, +;; including its own planner-prev-appt-check variable. It's set as an +;; after-advice to appt-check. I also add a function that parse the +;; current line and add the appt to it's list. The +;; planner-appt-entry-regexp are setup to catch any 'HH:MM | Message +;; (HH:MM)' line (just like allrems). You can set it up also to ignore +;; some special line (like those beginning with '&' for example). + +(require 'appt) + +(defvar planner-appt-entry-regexp + "^[[:space:]]*\\([0-9]+:[0-9]\\{2\\}\\)[[:space:]]*|[[:space:]]*\\([^&].*\\)[[:space:]]*\\(([0-9]+:[0-9]\\{2\\})\\)?[[:space:]]*$" + "Regexp that match a appt entry in planner.") + +(defun planner-appt-add () + "Add this line as an appointment. The line should match +`planner-appt-entry-regexp'." + (interactive) + (save-excursion + (beginning-of-line) + (if (looking-at planner-appt-entry-regexp) + (appt-add (match-string-no-properties 1) (match-string-no-properties 2)) + (error "No appointment on this line")))) + +(defun planner-make-appt-list () + "Load today planner file and make appt-list from schedule." + (interactive) + (save-excursion + (save-window-excursion + (planner-goto-today) + (while (re-search-forward planner-appt-entry-regexp nil t) + (appt-add (match-string-no-properties 1) (match-string-no-properties 2)))))) + +(defvar planner-prev-appt-check nil + "Determine the last time appt-check are called") + +(defadvice appt-check (after planner-appt-check-ad ()) + "Call planner-make-appt-list the first time and every day." + (let* ((now (decode-time)) + (cur-hour (nth 2 now)) + (cur-min (nth 1 now)) + (cur-comp-time (+ (* cur-hour 60) cur-min))) + (if (or (null planner-prev-appt-check) + (< cur-comp-time planner-prev-appt-check)) + (planner-make-appt-list)) + (setq planner-prev-appt-check cur-comp-time))) + +(ad-activate 'appt-check) + +;; calendar support +;; +;; This function are used to mark calendar entries directly from the +;; planner files. I try to optimize it with a helper function that +;; take the list of planner-date string corresponding to the three +;; months display of the calendar (same behavior as the +;; mark-diary-entries-hook). One of the helper are made in elisp, and +;; the other used an external perl script to parse the entries. The +;; only thing check is a non-empty (I mean non-space) Events section. +;; Used it as a hook to the `mark-diary-entries-hook'. Since this +;; function also search for diary entries, you can used it in +;; conjunction with diary. And with the `planner-diary-insert' +;; function, you just have to type 'n' at the calendar day to see both +;; the diary and your normal planner entry. The helper script is call events +;; and it's very short (see documentation of planner-mark-calendar-external-helper +;; for the script. The script also return the entry line so that you can remove +;; specially mark entry if you care, either by directly modifying the +;; script or by modifying the planner-mark-calendar-external-helper +;; function. + +(defcustom planner-mark-calendar-helper 'planner-mark-calendar-internal-helper + "Helper function to determinate which day have a non-empty events. +Currently, it exist two functions to do it: +`planner-mark-calendar-internal-helper' which is a lisp +implementation, and `planner-mark-calendar-external-helper' which used +a external script to do most of the parsing." + :type 'function + :group 'planner) + +(defun planner-mark-calendar () + "Look for planner file with non-empty events." + (save-window-excursion + (set-buffer calendar-buffer) + (let ((prev-month displayed-month) + (prev-year displayed-year) + (succ-month displayed-month) + (succ-year displayed-year) + (last-day) + (day) + (files nil)) + (increment-calendar-month succ-month succ-year 1) + (increment-calendar-month prev-month prev-year -1) + (setq day (calendar-absolute-from-gregorian (list prev-month 1 prev-year))) + (setq last-day + (calendar-absolute-from-gregorian + (list succ-month + (calendar-last-day-of-month succ-month succ-year) + succ-year))) + (while (<= day last-day) + (let* ((date (calendar-gregorian-from-absolute day)) + (file + (expand-file-name + (calendar-date-to-planner date) + planner-directory))) + (if (file-readable-p file) + (setq files (cons file files)))) + (setq day (1+ day))) + (setq files (funcall planner-mark-calendar-helper files)) + (while files + (mark-visible-calendar-date (planner-date-to-calendar (car files))) + (setq files (cdr files)))))) + +(defun planner-mark-calendar-internal-helper (files) + "Local (elisp) helper function for `planner-mark-calendar'." + (let ((correct)) + (while files + (find-file-other-window (car files)) + (goto-char (point-min)) + (if (re-search-forward "^\\* Events" nil t) + (progn + (forward-line 1) + (if (re-search-forward + "[^[:space:]]+" + (save-excursion + (re-search-forward "^\\* " nil t) + (let ((p (match-beginning 0))) + (and p (1- p)))) + t) + (setq correct (cons (car files) correct))))) + (if (not (buffer-modified-p)) (kill-this-buffer)) + (setq files (cdr files))) + correct)) + +(defcustom planner-mark-calendar-external-script "events %s" + "Command line that select files that must be marked. +This string is send to the shell with %s replace with a list +of space separate (maybe non-existing) file names. An example +of such script follow: + +#!/usr/bin/perl -s + +for $file (sort @ARGV) { + open (FILE, $file) || die \"Cannot open file $file\\n\"; + $inevents = 0; + while () { + if ($inevents == 0) { + if (/^\\* Events/) { + $inevents = 1; + } + } elsif (/^\\* /) { + $inevents = 0; + break; + } + elsif (/^\\s*\\S/) { + printf \"$file: $_\"; + } + } + close (FILE); +}; +" + :type 'string + :group 'planner) + +(defun planner-mark-calendar-external-helper (files) + "Use an external application to parse the planner files. +The command line is set with the `planner-mark-calendar-external-script' +variable and must take a list of files as arguments." + (let* ((command (concat "events " + (mapconcat 'identity files " "))) + (output (split-string (shell-command-to-string command) "\n")) + (results)) + (while output + (if (string-match "^\\([^:]+\\):" (car output)) + (setq results + (cons (match-string 1 (car output)) + results))) + (setq output (cdr output))) + results)) + + +;; planner-mode key mapping +;; +;; No comment for this one. Do ye want. + +(eval-after-load "planner" + '(progn + (define-key planner-mode-map [(control ?c) (control ?w)] + 'planner-goto-schedule) + (define-key planner-mode-map [(control ?c) (control ?n)] + 'planner-create-note) + (define-key planner-mode-map [(control ?c) (control ?e)] + 'planner-appt-add))) + +;; global key mapping + +(define-key ctl-x-map "ta" 'planner-create-task) +(define-key ctl-x-map "ts" 'planner-goto-today) +(define-key ctl-x-map "ti" 'timeclock-in) +(define-key ctl-x-map "to" 'timeclock-out) +(define-key ctl-x-map "tc" 'timeclock-change) +(define-key ctl-x-map "tr" 'timeclock-reread-log) +(define-key ctl-x-map "tv" 'timeclock-status-string) +;(define-key ctl-x-map "tu" 'timeclock-update-modeline) +;(define-key ctl-x-map "tw" 'timeclock-when-to-leave-string) + + +(defun local-planner-kill-buffer () + "Kill the buffer and erase it if empty." + (interactive) + (let ( + (planner-not-empty-file 'kill-this-buffer) +; (planner-not-empty-file (lambda () (save-buffer) (kill-this-buffer))) + ) + (planner-maybe-remove-file))) + +;; planner-mode key mapping +(eval-after-load "planner" + '(progn + (define-key planner-mode-map [(control ?c) (control ?w)] + 'planner-goto-schedule) + (define-key planner-mode-map [(control ?c) (control ?n)] + 'planner-create-note) + (define-key planner-mode-map [(control ?c) (control ?k)] + 'local-planner-kill-buffer) + (define-key planner-mode-map [(control ?c) (control ?e)] + 'planner-appt-add))) + +;; global key mapping + +(define-key ctl-x-map "ta" 'planner-create-task) +(define-key ctl-x-map "ts" 'planner-goto-today) +(define-key ctl-x-map "tj" 'planner-goto) +(define-key ctl-x-map "ti" 'timeclock-in) +(define-key ctl-x-map "to" 'timeclock-out) +(define-key ctl-x-map "tc" 'timeclock-change) +(define-key ctl-x-map "tr" 'timeclock-reread-log) +(define-key ctl-x-map "tv" 'timeclock-status-string) +;(define-key ctl-x-map "tu" 'timeclock-update-modeline) +;(define-key ctl-x-map "tw" 'timeclock-when-to-leave-string) + +(provide 'local-planner)