In case anybody else is interested, I'm attaching a patch that adds
the functionality I asked for previously in this thread. The patch
adds two interactive functions: planner-appt-cancel and
planner-appt-uncancel.
M-x planner-appt-cancel moves the current Schedule entry to the
Canceled section on the current page (creating it, if necessary). The
presence of the entry in the Canceled section will prevent it from
being re-insinuated, if it is a cyclic entry, and suppress its display
in Forthcoming Appointments.
M-x planner-appt-uncancel moves the current schedule entry from
Canceled to the Schedule, and deletes the Canceled section if it is
empty.
Let me know if you find this useful.
Regards,
Chris
On Dec 3, 2007 12:28 PM, Jim Ottaway <[EMAIL PROTECTED]> wrote:
> >>>>> Christopher L Conway <[EMAIL PROTECTED]> writes:
>
> > Jim,
> > Thanks for your suggestion. I don't think this will work for me. This
> > is a meeting that occurs probably 3 weeks out of 4. It is canceled for
> > holidays, if multiple participants are traveling, etc. What I'd
> > like---and what I assume would be broadly useful to others as well as
> > me---is an interactive function that says: "this particular cyclic
> > appt will not be happening on this particular day; do not re-insinuate
> > it." Since I may attend this same meeting for several years to come
> > and cancellations are bound to run into the dozens, it would be best
> > if this didn't clog up my .diary.cyclic-tasks file; it probably should
> > "live" in some annotation on the day page.
>
> > If all of the above sounds rather demanding, I should not that I am
> > willing to try hacking this up myself. I'm just asking if there's a
> > pre-existing solution to the problem.
>
> I see. I don't think anything like that can be done currently, and it
> sounds useful, so hack away!
>
> For the record: I think I was wrong in my previous example, I think the
> all the dates have to be in the same arrangement:
>
> %%(and (not (member date '((18 12 2007)
> (15 1 2008))))
> (diary-cyclic 7 4 12 2007))) Tue @11:00am | 12:00 | Meeting
>
> [for european-calendar-style = t].
>
>
> Regards,
> --
> Dr Jim Ottaway
> Research Officer: Translating Neurobiological Research
> BIOS Centre for Bioscience, Biomedicine, Biotechnology and Society
> London School of Economics and Political Science
>
> _______________________________________________
> Planner-el-discuss mailing list
> [email protected]
> https://mail.gna.org/listinfo/planner-el-discuss
>
>
diff -ruN -x '*~' /home/chris/downloads/planner-latest/planner-appt.el planner/planner-appt.el
--- /home/chris/downloads/planner-latest/planner-appt.el 2007-12-05 00:01:36.000000000 -0500
+++ planner/planner-appt.el 2007-12-08 18:40:43.000000000 -0500
@@ -75,6 +75,11 @@
:group 'planner-appt
:type 'string)
+(defcustom planner-appt-canceled-section "Canceled"
+ "The name of the section where the canceled schedule items are to be found."
+ :group 'planner-appt
+ :type 'string)
+
(defcustom planner-appt-font-lock-appointments-flag t
"Non-nil means use font-locking for appointments."
:group 'planner-appt
@@ -264,6 +269,12 @@
:group 'planner-appt
:type 'regexp)
+(defcustom planner-appt-canceled-prefix
+ "_X "
+ "Prefix of canceled schedule appointments."
+ :group 'planner-appt
+ :type 'string)
+
;;; Planner Miscellany
@@ -723,9 +734,17 @@
(setq date (planner-date-to-filename (car entry))
line (cadr entry))
(if (string-match planner-appt-schedule-appt-regexp line)
- (setq time (save-match-data
- (appt-convert-time (match-string 1 line)))
- text (match-string 0 line))
+ ;; planner-appt-canceled-p can clobber entry (via
+ ;; planner-find-file, for some reason), so we back up and
+ ;; restore
+ (let ((old-entry entry))
+ (unless (and (assoc date (planner-file-alist))
+ (save-match-data
+ (planner-appt-canceled-p (match-string 0 line) date)))
+ (setq time (save-match-data
+ (appt-convert-time (match-string 1 line)))
+ text (match-string 0 line)))
+ (setq entry old-entry))
(when (string-match planner-appt-forthcoming-task-regexp line)
(setq task-info (planner-task-info-from-string date line))
(setq task-data (planner-appt-forthcoming-task-data task-info))
@@ -1344,6 +1363,104 @@
1441))
nil))))
+;; A canceled schedule entry begins with planner-appt-canceled prefix
+;; and an arbitrary amount of whitespace
+(defun planner-appt-canceled-prefix-regexp ()
+ "Regular expression matching a canceled schedule appointment prefix"
+ (concat "^" planner-appt-canceled-prefix "\\s-*"))
+
+;; A canceled schedule entry is the canceled appointment prefix, an
+;; abitrary amount of whitespace, and a schedule appointment. We have
+;; to strip off the line-beginning carat from
+;; planner-appt-schedule-regexp, thus the substring expr.
+
+(defun planner-appt-canceled-regexp ()
+ "Regular expression matching a canceled schedule appointment"
+ (concat (planner-appt-canceled-prefix-regexp) "\\("
+ (substring planner-appt-schedule-regexp 1) "\\)"))
+
+
+;; Test whether a particular schedule appointment has been
+;; canceled. The appointment text has to match exactly.
+
+(defun planner-appt-canceled-p (appt &optional file)
+ "Returns t if appt is a canceled schedule appointment.
+Optional argument file gives the name of a Planner file to search for appt."
+ (let ((filepath (buffer-file-name)))
+ (when file
+ (let ((file-pair (assoc file (planner-file-alist))))
+ (unless file-pair
+ (error (concat "Planner file " file " does not exist")))
+ (setq filepath (cdr file-pair))))
+ (with-temp-buffer
+ (with-planner
+ (insert-file-contents filepath)
+ (and (planner-maybe-seek-to-first planner-appt-canceled-section)
+ (let ((end (save-excursion
+ (planner-appt-seek-to-end-of-current-section)
+ (1+ (point)))))
+ (re-search-forward
+ (concat (planner-appt-canceled-prefix-regexp)
+ (regexp-quote appt)) end t)))))))
+
+;; Cancel an appointment. By moving a cyclic entry it to "Canceled"
+;; rather than just deleting it, its re-insinuation is suppressed.
+;; Adding the planner-appt-canceled-prefix "hides" the appointment
+;; from the planner-appt-forthcoming-* routines, which grab *anything*
+;; that looks like a reminder appointment from the day pages, even if
+;; they're not in the Schedule section.
+
+(defun planner-appt-cancel ()
+ "Move current appointment to planner-appt-canceled-section."
+ (interactive)
+
+ (beginning-of-line)
+ (unless (looking-at planner-appt-schedule-regexp)
+ (error "No schedule entry at point"))
+
+ (let ((beg (point)))
+ (forward-line 1)
+ (let ((appt (delete-and-extract-region beg (point))))
+ ;; Create the Canceled section right after the Schedule section,
+ ;; if it doesn't exist
+ (unless (planner-maybe-seek-to-first planner-appt-canceled-section)
+ (planner-appt-seek-to-end-of-current-section)
+ (insert "\n* " planner-appt-canceled-section "\n\n"))
+ (insert planner-appt-canceled-prefix appt)
+ ;; Move the cursor to the beginning of the appt
+ (forward-line -1))))
+
+;; Uncancel an appointment, by deleting it from the Canceled section
+;; and moving it to the Schedule section. Remove the Cancled section
+;; if it is now empty.
+
+(defun planner-appt-uncancel ()
+ "Move current canceled appointment back to the schedule."
+ (interactive)
+ (beginning-of-line)
+ (unless (looking-at (planner-appt-canceled-regexp))
+ (error "No canceled schedule entry at point"))
+
+ (let ((appt (match-string 1))
+ (beg (point)))
+ (forward-line 1)
+ (delete-region beg (point))
+ ;; Check if the Canceled section is empty and, if so, delete it
+ (when (planner-maybe-seek-to-first planner-appt-canceled-section)
+ (let ((beg (save-excursion
+ (forward-line -2)
+ (point)))
+ (end (save-excursion
+ (planner-appt-seek-to-end-of-current-section)
+ (1+ (point)))))
+ (unless (re-search-forward (planner-appt-canceled-regexp) end t)
+ (delete-region beg end))))
+ (planner-seek-to-first planner-appt-schedule-section)
+ (insert appt ?\n)
+ (when planner-appt-sort-schedule-on-update-flag
+ (planner-appt-schedule-sort))))
+
+
;;; Cyclical Schedule Entries
(require 'diary-lib)
@@ -1373,17 +1490,23 @@
(let ((entries
(planner-appt-schedule-get-cyclic-tasks (planner-page-name))))
(when entries
- (planner-seek-to-first planner-appt-schedule-section)
- (let ((start (point)))
- (dolist (entry entries)
- ;; Only insert if the entry is not already there.
- (unless (save-excursion
- (goto-char start)
- (search-forward entry nil t))
- (insert entry ?\n))))
- ;; Lazy way of putting them in the right place.
- (when planner-appt-sort-schedule-on-update-flag
- (planner-appt-schedule-sort))))))
+ (let ((point-canceled (if (planner-maybe-seek-to-first
+ planner-appt-canceled-section)
+ (point)
+ (point-max)))
+ (point-schedule (progn (planner-seek-to-first
+ planner-appt-schedule-section)
+ (point))))
+ (let ((start (min point-schedule point-canceled)))
+ (dolist (entry entries)
+ ;; Only insert if the entry is not already there.
+ (unless (save-excursion
+ (goto-char start)
+ (search-forward entry nil t))
+ (insert entry ?\n))))
+ ;; Lazy way of putting them in the right place.
+ (when planner-appt-sort-schedule-on-update-flag
+ (planner-appt-schedule-sort)))))))
(defun planner-appt-schedule-add-cyclic-maybe ()
"Add cylical tasks to the schedule.
diff -ruN -x '*~' /home/chris/downloads/planner-latest/planner.el planner/planner.el
--- /home/chris/downloads/planner-latest/planner.el 2007-12-05 00:01:36.000000000 -0500
+++ planner/planner.el 2007-12-07 13:20:35.000000000 -0500
@@ -1607,11 +1607,10 @@
(delete-region beg end)
(goto-char (planner-line-beginning-position)))))
-(defun planner-seek-to-first (&optional section)
- "Positions the point at the specified SECTION, or Tasks if not specified."
- (interactive)
- (unless section
- (setq section planner-default-section))
+(defun planner-maybe-seek-to-first (section)
+ "Positions the point at the specified SECTION, if it exists.
+Returns nil if SECTION doesn't exist."
+ (let ((start (point)))
(unless (stringp section)
(setq section (cdr (assoc section planner-sections))))
(widen)
@@ -1631,7 +1630,17 @@
(> (forward-line 1) 0)) (insert "\n"))
(when (or (looking-at "^\\*\\s-+")
(> (forward-line 1) 0)) (insert "\n"))
- (when (looking-at "^\\*\\s-+") (forward-line -1))))
+ (when (looking-at "^\\*\\s-+") (forward-line -1)))
+ t)
+ (progn (goto-char start) nil))))
+
+
+(defun planner-seek-to-first (&optional section)
+ "Positions the point at the specified SECTION, or Tasks if not specified."
+ (interactive)
+ (unless section
+ (setq section planner-default-section))
+ (unless (planner-maybe-seek-to-first section)
;; Section not found, so create it.
(funcall planner-create-section-function section)))
_______________________________________________
Planner-el-discuss mailing list
[email protected]
https://mail.gna.org/listinfo/planner-el-discuss
