lisp/my-planner.el
author Fabien Ninoles <fabien@tzone.org>
Sat, 03 Jan 2015 11:21:56 -0500
changeset 10 449bcf8e92c2
parent 1 a234a7579958
permissions -rw-r--r--
Add the Hira binding.

;;;_ 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)