lisp/my-planner.el
changeset 1 a234a7579958
equal deleted inserted replaced
0:df7496e40bee 1:a234a7579958
       
     1 ;;;_ Planner configuration
       
     2 
       
     3 ;; In emacs21/sarge, schedule doesn't exist.
       
     4 ;; But in planner-el/etch, schedule is in contrib.
       
     5 (if (not (locate-library "schedule"))
       
     6     (setcdr (last load-path)
       
     7 		     '("/usr/share/emacs/site-lisp/planner-el/contrib")))
       
     8 (if (locate-library "schedule")
       
     9     (require 'planner-timeclock))
       
    10 ;(require 'planner-wl)
       
    11 ;(planner-wl-insinuate)
       
    12 (require 'planner-diary)
       
    13 (planner-diary-insinuate)
       
    14 (require 'planner-export-diary)
       
    15 (planner-calendar-insinuate)
       
    16 (require 'planner-appt)
       
    17 (planner-appt-use-tasks)
       
    18 (planner-appt-insinuate)
       
    19 (require 'planner-cyclic)
       
    20 (planner-appt-schedule-cyclic-insinuate)
       
    21 (planner-appt-calendar-insinuate)
       
    22 (require 'planner-timeclock-summary)
       
    23 (planner-timeclock-summary-insinuate)
       
    24 (require 'planner-timeclock-summary-proj)
       
    25 (planner-timeclock-summary-proj-insinuate)
       
    26 (require 'planner-schedule)
       
    27 (require 'planner-bbdb)
       
    28 (require 'planner-erc)
       
    29 (require 'planner-bookmark)
       
    30 (require 'remember-planner)
       
    31 (require 'planner-log-edit)
       
    32 (planner-install-extra-task-keybindings)
       
    33 (planner-install-extra-context-keybindings)
       
    34 (require 'planner-trunk)
       
    35 (require 'planner-multi)
       
    36 
       
    37 ; Local functions for planner
       
    38 
       
    39 (defvar my-planner-week-summary-buffer
       
    40   "Week-%Y-%U.muse")
       
    41 
       
    42 (defvar my-planner-week-summary-regexp
       
    43   "Week-\\([0-9]{4}\\)-\\([0-5][0-9]\\)\\.muse")
       
    44   
       
    45 (defun first-day-of-the-week (date)
       
    46   (progn 
       
    47     ;; (SEC MINUTE HOUR DAY MONTH YEAR DOW DST ZONE)
       
    48     (setcar (nthcdr 3 date)
       
    49 	    (- (elt date 3)
       
    50 	       (elt date 6)))
       
    51     (setcar (nthcdr 6 date) 0)
       
    52     (apply 'encode-time date)))
       
    53 
       
    54 (defun last-day-of-the-week (date)
       
    55   (progn 
       
    56     ;; (SEC MINUTE HOUR DAY MONTH YEAR DOW DST ZONE)
       
    57     (setcar (nthcdr 3 date)
       
    58 	    (+ (elt date 3)
       
    59 	       (- 6 (elt date 6))))
       
    60     (setcar (nthcdr 6 date) 6)
       
    61     (apply 'encode-time date)))
       
    62 
       
    63 (defun my-planner-file-to-date (filename)
       
    64   (let ((calendar-date
       
    65 	 (planner-filename-to-calendar-date filename)))
       
    66     (decode-time (encode-time 0 0 0 (elt calendar-date 1)
       
    67 		      (elt calendar-date 0) (elt calendar-date 2)))))
       
    68 
       
    69 (defun my-planner-week-summary (week-day)
       
    70   (interactive (list (planner-read-date "Select a day of the week" t)))
       
    71   (let ((date
       
    72 	 (my-planner-file-to-date week-day)))
       
    73   (planner-timeclock-summary-show-range 
       
    74    (planner-date-to-filename (first-day-of-the-week date))
       
    75    (planner-date-to-filename (last-day-of-the-week date)))))
       
    76 
       
    77 ;;;_ redefinition of planner-maybe-remove-file 
       
    78 ;;
       
    79 ;; The kill-buffer of this function make me crazy.  I modify it so you
       
    80 ;; can change it's behavior using this custom variable.  Personnaly, I
       
    81 ;; used ignore and let emacs ask me to save it when I kill it.  Take
       
    82 ;; also note that I change the regexp to remove any file that only
       
    83 ;; have empty section (section with just a first level heading).  This
       
    84 ;; is to cope with the new Events and Schedule sections.
       
    85 
       
    86 (defcustom planner-not-empty-file 'kill-this-buffer
       
    87   "Command to run when a planner file is not empty.  Can be
       
    88 kill-this-buffer, save-buffer or ignore for example."
       
    89   :type 'function
       
    90   :group 'planner)
       
    91 
       
    92 (defvar local-planner-empty-line-regexp "\\(\\* .*\\|[[:space:]]*\\|No entries[[:space:]]*\\)")
       
    93 (defvar planner-empty-file-regexp 
       
    94   (concat "\\(^" local-planner-empty-line-regexp
       
    95           "\n\\)*[[:space:]]*\\'"))
       
    96 
       
    97 ; redefinition
       
    98 
       
    99 (defun planner-maybe-remove-file ()
       
   100   "This function remove the file if it contains only first level
       
   101 headings and empty lines."
       
   102   (interactive)
       
   103   (goto-char (point-min))
       
   104   (if (looking-at planner-empty-file-regexp)
       
   105       (let ((filename buffer-file-name))
       
   106 	(set-buffer-modified-p nil)
       
   107 	(kill-buffer (current-buffer))
       
   108 	(delete-file filename))
       
   109     (funcall planner-not-empty-file)))
       
   110 
       
   111 ;;;_ Planner automatic retrunl
       
   112 
       
   113 ;; Should all been rework because planner-trunk just
       
   114 ;; look for Projects page.
       
   115 
       
   116 ;; (defun my-planner-trunk-tasks-build-rules ()
       
   117 ;;   (let ((rule-set nil))
       
   118 ;;     (save-excursion
       
   119 ;;       (save-restriction
       
   120 ;; 	(when (planner-narrow-to-section 'tasks)
       
   121 ;; 	  (goto-char (point-min))
       
   122 ;; 	  (while (not (equal (point-max) (point)))
       
   123 ;; 	    (let ((current-task (planner-task-description 
       
   124 ;; 				 (planner-current-task-info))))
       
   125 ;; 	      (if current-task
       
   126 ;; 		  (if (string-match "|\\(.*\\)|" current-task)
       
   127 ;; 		      (let ((category
       
   128 ;; 			     (substring current-task 
       
   129 ;; 					(match-beginning 1)
       
   130 ;; 					(match-end 1))))		       
       
   131 ;; 			(add-to-list 'rule-set
       
   132 ;; 			      (list (format "|%s|" category)
       
   133 ;; 					  category))))))
       
   134 ;; 	    (forward-line)))))
       
   135 ;;     rule-set))
       
   136 
       
   137 ;; (defun my-planner-trunk-tasks (&optional force)
       
   138 ;;   (interactive "P")
       
   139 ;;   (let ((page-name (planner-page-name)))
       
   140 ;;     (if (not (catch 'done 
       
   141 ;; 	       (mapc (lambda (rule)
       
   142 ;; 		       (if (string-match (car rule) page-name)
       
   143 ;; 			   (if force
       
   144 ;; 			       (progn 
       
   145 ;; 				 (delq rule planner-trunk-rule-list)
       
   146 ;; 				 (throw 'done nil))
       
   147 ;; 			     (throw 'done t))))
       
   148 ;; 		     planner-trunk-rule-list)
       
   149 ;; 	       nil))
       
   150 ;; 	(add-to-list 'planner-trunk-rule-list
       
   151 ;; 		     (list (regexp-quote (planner-page-name)) 
       
   152 ;; 			   nil (my-planner-trunk-tasks-build-rules))))
       
   153 ;;       (planner-trunk-tasks force)))
       
   154 
       
   155 ;;;_ Planner replan
       
   156 
       
   157 ;; Remember last day of plan so that it can go back correctly in time.
       
   158 
       
   159 (defcustom my-planner-last-replan-day (calendar-current-date)
       
   160   "Last day plan."
       
   161   :type '(list
       
   162 	       (integer :tag "day")
       
   163 	       (integer :tag "month")
       
   164 	       (integer :tag "year")))
       
   165 
       
   166 (defun my-planner-replan ()
       
   167   "Run plan with the last day checked."
       
   168   (interactive)
       
   169   (let ((current-date (calendar-current-date))
       
   170 	(number-of-days 0))
       
   171     (setq number-of-days
       
   172 	  (- (calendar-absolute-from-gregorian current-date)
       
   173 	     (calendar-absolute-from-gregorian my-planner-last-replan-day)))
       
   174     (if (> number-of-days 0)
       
   175 	(plan number-of-days))
       
   176     (customize-save-variable 'my-planner-last-replan-day current-date)))
       
   177 
       
   178 (defun my-planner-page-template (sections)
       
   179   "Function to create a planner page."
       
   180   (mapconcat (lambda (section)
       
   181 	       (concat "* " section))
       
   182 	     sections "\n\n\n"))
       
   183   
       
   184 (defun my-planner-day-page-template ()
       
   185   "Function template to insert a planner day page."
       
   186   (my-planner-page-template ["Évènements" "Tâches" "Rendez-vous" "Horaire" "Notes" "Activités"]))
       
   187 
       
   188 (defun my-planner-plan-page-template ()
       
   189   "Function template to insert a planner day page."
       
   190   (my-planner-page-template ["Tâches" "Notes" "Rapport d'activités"]))
       
   191 
       
   192 ;;;_ Set the diary export file
       
   193 
       
   194 ;; Should have been used with a (get-planner-default-directory) too.
       
   195 
       
   196 (setq planner-export-diary-number-of-days 7
       
   197       diary-file "~/Plans/diary"
       
   198       planner-export-diary-file "~/Plans/diary.planner")
       
   199 
       
   200 ;; global key mapping
       
   201 
       
   202 (defvar my-planner-keymap
       
   203   (let ((map (make-sparse-keymap)))
       
   204     (mapcar
       
   205      (lambda (args) 
       
   206        (apply (lambda (key symbol)
       
   207 		(define-key map key symbol)) args))
       
   208      '(("a" planner-create-task)
       
   209        ("b" planner-create-task-from-buffer)
       
   210        ("c" timeclock-change)
       
   211        ("f" planner-appt-forthcoming-display)
       
   212        ("p" planner-goto-plan-page)
       
   213        ("i" timeclock-in)
       
   214        ("j" planner-goto)
       
   215        ("o" timeclock-out)
       
   216        ("r" timeclock-reread-log)
       
   217        ("s" planner-goto-today)
       
   218        ("v" timeclock-status-string)
       
   219        ("w" my-planner-week-summary)
       
   220        ("x" planner-index)))
       
   221     map)
       
   222   "Global planner keymap I love to use.")
       
   223 
       
   224 (define-key ctl-x-map "t" my-planner-keymap)
       
   225 
       
   226 (provide 'my-planner)
       
   227