lisp/my-planner.el
changeset 1 a234a7579958
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/lisp/my-planner.el	Thu Oct 13 08:46:42 2011 -0400
@@ -0,0 +1,227 @@
+;;;_ Planner configuration
+
+;; In emacs21/sarge, schedule doesn't exist.
+;; But in planner-el/etch, schedule is in contrib.
+(if (not (locate-library "schedule"))
+    (setcdr (last load-path)
+		     '("/usr/share/emacs/site-lisp/planner-el/contrib")))
+(if (locate-library "schedule")
+    (require 'planner-timeclock))
+;(require 'planner-wl)
+;(planner-wl-insinuate)
+(require 'planner-diary)
+(planner-diary-insinuate)
+(require 'planner-export-diary)
+(planner-calendar-insinuate)
+(require 'planner-appt)
+(planner-appt-use-tasks)
+(planner-appt-insinuate)
+(require 'planner-cyclic)
+(planner-appt-schedule-cyclic-insinuate)
+(planner-appt-calendar-insinuate)
+(require 'planner-timeclock-summary)
+(planner-timeclock-summary-insinuate)
+(require 'planner-timeclock-summary-proj)
+(planner-timeclock-summary-proj-insinuate)
+(require 'planner-schedule)
+(require 'planner-bbdb)
+(require 'planner-erc)
+(require 'planner-bookmark)
+(require 'remember-planner)
+(require 'planner-log-edit)
+(planner-install-extra-task-keybindings)
+(planner-install-extra-context-keybindings)
+(require 'planner-trunk)
+(require 'planner-multi)
+
+; Local functions for planner
+
+(defvar my-planner-week-summary-buffer
+  "Week-%Y-%U.muse")
+
+(defvar my-planner-week-summary-regexp
+  "Week-\\([0-9]{4}\\)-\\([0-5][0-9]\\)\\.muse")
+  
+(defun first-day-of-the-week (date)
+  (progn 
+    ;; (SEC MINUTE HOUR DAY MONTH YEAR DOW DST ZONE)
+    (setcar (nthcdr 3 date)
+	    (- (elt date 3)
+	       (elt date 6)))
+    (setcar (nthcdr 6 date) 0)
+    (apply 'encode-time date)))
+
+(defun last-day-of-the-week (date)
+  (progn 
+    ;; (SEC MINUTE HOUR DAY MONTH YEAR DOW DST ZONE)
+    (setcar (nthcdr 3 date)
+	    (+ (elt date 3)
+	       (- 6 (elt date 6))))
+    (setcar (nthcdr 6 date) 6)
+    (apply 'encode-time date)))
+
+(defun my-planner-file-to-date (filename)
+  (let ((calendar-date
+	 (planner-filename-to-calendar-date filename)))
+    (decode-time (encode-time 0 0 0 (elt calendar-date 1)
+		      (elt calendar-date 0) (elt calendar-date 2)))))
+
+(defun my-planner-week-summary (week-day)
+  (interactive (list (planner-read-date "Select a day of the week" t)))
+  (let ((date
+	 (my-planner-file-to-date week-day)))
+  (planner-timeclock-summary-show-range 
+   (planner-date-to-filename (first-day-of-the-week date))
+   (planner-date-to-filename (last-day-of-the-week date)))))
+
+;;;_ 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:]]*\\|No entries[[: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 automatic retrunl
+
+;; Should all been rework because planner-trunk just
+;; look for Projects page.
+
+;; (defun my-planner-trunk-tasks-build-rules ()
+;;   (let ((rule-set nil))
+;;     (save-excursion
+;;       (save-restriction
+;; 	(when (planner-narrow-to-section 'tasks)
+;; 	  (goto-char (point-min))
+;; 	  (while (not (equal (point-max) (point)))
+;; 	    (let ((current-task (planner-task-description 
+;; 				 (planner-current-task-info))))
+;; 	      (if current-task
+;; 		  (if (string-match "|\\(.*\\)|" current-task)
+;; 		      (let ((category
+;; 			     (substring current-task 
+;; 					(match-beginning 1)
+;; 					(match-end 1))))		       
+;; 			(add-to-list 'rule-set
+;; 			      (list (format "|%s|" category)
+;; 					  category))))))
+;; 	    (forward-line)))))
+;;     rule-set))
+
+;; (defun my-planner-trunk-tasks (&optional force)
+;;   (interactive "P")
+;;   (let ((page-name (planner-page-name)))
+;;     (if (not (catch 'done 
+;; 	       (mapc (lambda (rule)
+;; 		       (if (string-match (car rule) page-name)
+;; 			   (if force
+;; 			       (progn 
+;; 				 (delq rule planner-trunk-rule-list)
+;; 				 (throw 'done nil))
+;; 			     (throw 'done t))))
+;; 		     planner-trunk-rule-list)
+;; 	       nil))
+;; 	(add-to-list 'planner-trunk-rule-list
+;; 		     (list (regexp-quote (planner-page-name)) 
+;; 			   nil (my-planner-trunk-tasks-build-rules))))
+;;       (planner-trunk-tasks force)))
+
+;;;_ Planner replan
+
+;; Remember last day of plan so that it can go back correctly in time.
+
+(defcustom my-planner-last-replan-day (calendar-current-date)
+  "Last day plan."
+  :type '(list
+	       (integer :tag "day")
+	       (integer :tag "month")
+	       (integer :tag "year")))
+
+(defun my-planner-replan ()
+  "Run plan with the last day checked."
+  (interactive)
+  (let ((current-date (calendar-current-date))
+	(number-of-days 0))
+    (setq number-of-days
+	  (- (calendar-absolute-from-gregorian current-date)
+	     (calendar-absolute-from-gregorian my-planner-last-replan-day)))
+    (if (> number-of-days 0)
+	(plan number-of-days))
+    (customize-save-variable 'my-planner-last-replan-day current-date)))
+
+(defun my-planner-page-template (sections)
+  "Function to create a planner page."
+  (mapconcat (lambda (section)
+	       (concat "* " section))
+	     sections "\n\n\n"))
+  
+(defun my-planner-day-page-template ()
+  "Function template to insert a planner day page."
+  (my-planner-page-template ["Évènements" "Tâches" "Rendez-vous" "Horaire" "Notes" "Activités"]))
+
+(defun my-planner-plan-page-template ()
+  "Function template to insert a planner day page."
+  (my-planner-page-template ["Tâches" "Notes" "Rapport d'activités"]))
+
+;;;_ Set the diary export file
+
+;; Should have been used with a (get-planner-default-directory) too.
+
+(setq planner-export-diary-number-of-days 7
+      diary-file "~/Plans/diary"
+      planner-export-diary-file "~/Plans/diary.planner")
+
+;; global key mapping
+
+(defvar my-planner-keymap
+  (let ((map (make-sparse-keymap)))
+    (mapcar
+     (lambda (args) 
+       (apply (lambda (key symbol)
+		(define-key map key symbol)) args))
+     '(("a" planner-create-task)
+       ("b" planner-create-task-from-buffer)
+       ("c" timeclock-change)
+       ("f" planner-appt-forthcoming-display)
+       ("p" planner-goto-plan-page)
+       ("i" timeclock-in)
+       ("j" planner-goto)
+       ("o" timeclock-out)
+       ("r" timeclock-reread-log)
+       ("s" planner-goto-today)
+       ("v" timeclock-status-string)
+       ("w" my-planner-week-summary)
+       ("x" planner-index)))
+    map)
+  "Global planner keymap I love to use.")
+
+(define-key ctl-x-map "t" my-planner-keymap)
+
+(provide 'my-planner)
+