cfw:cp-move-cursor operates on the wrong buffer; and, suggestions . . . #61
Description
First off, let me please take this opportunity to say how grateful I am that you invested the time to write such a useful library. It is truly AWESOME! I wish I would have known about it sooner, and I really wish Emacs had these features built in. Thank you, thank you, and thank you!
When running M-x cfw:open-org-calendar from a non-calendar buffer, there are of course several functions that get called one after the other. While going through the chain of functions, we finally get to cfw:cp-set-selected-date. Within the first condition of cfw:cp-set-selected-date, the function cfw:cp-move-cursor is called. As you know, cfw:cp-move-cursor uses the (current-buffer) to set-window-point. This causes point to move upward on whatever the current-buffer happens to be. I would suggest referring to the to the *cfw-calendar* instead of the current-buffer to fix this issue -- e.g.:
(defun cfw:cp-move-cursor (dest date)
"[internal] Just move the cursor onto the date. This function
is called by `cfw:cp-set-selected-date'."
(let ((pos (cfw:find-by-date dest date)))
(when pos
(goto-char pos)
(when
(and
(get-buffer-window cfw:calendar-buffer-name)
(not (eql (selected-window) (get-buffer-window cfw:calendar-buffer-name))))
(set-window-point (get-buffer-window cfw:calendar-buffer-name) pos)))))
FYI No. 1: I'm not a programmer, just a weekend hobbyist. I developed (with the occasional help of a few generous programmers who participate on Stack Overflow) a rotating 12-month calendar that shows birthdays, holidays, appointments, and stuff, which you may enjoy taking a look at. There is no copyright or anything -- if you like any of it, feel free to use some or all of it.
https://github.com/lawlist/lorg-calendar
FYI No. 2: Here is a link to a modification of org-agenda-list to show birthdays and holidays in the *Org Agenda* buffer:
http://emacs.stackexchange.com/a/10872/2287
Suggestion No. 1: I set up birthdays using the same mechanism as you did for holidays, but to achieve a different face, I had to add another argument to (lambda (date week-day hday bday) in a few places and make some other changes. There will be many people who are not so familiar with elisp that will undoubtedly be using your library -- they will likely lack the necessary skills to modify your code to include birthdays, so you may want to consider including it for cfw:open-org-calendar. The birthdays can be set up with holiday-fixed and you could include an example, and set up another variable -- e.g., cfw:show-birthdays. My custom version of your library is already tweaked, so I'm just suggesting it for other people if you are so inclined.
Suggestion No. 2: The face for Saturday needs to be changed to include a condition for a dark background -- it presently has two (2) settings for a light background, instead of one each -- it should be:
(defface cfw:face-saturday
'((((class color) (background light))
:foreground "Blue" :background "#d4e5ff" :weight bold)
(((class color) (background dark))
:foreground "Blue" :weight bold))
"Face for Saturday" :group 'calfw)
Suggestion No. 3: Here is a fix for the holiday and weekend numbered dates not having a background color that matches the bar strip across the top of each numbered day -- modify a couple of conditions in the following functions -- cfw:view-month; cfw:view-week; cfw:view-two-weeks; and, cfw:view-day:
[***]
(hday 'cfw:face-holiday-date)
[***]
(t
(cfw:render-get-week-date-face week-day 'cfw:face-default-day))
Create a new function:
(defun cfw:render-get-week-date-face (daynum &optional default-face)
"[internal] Put the default numbered date week face."
(cond
((= daynum cfw:week-saturday)
'cfw:face-saturday-date)
((= daynum cfw:week-sunday)
'cfw:face-sunday-date)
(t default-face)))
Create three (3) new faces, or four (4) if you are inclined to add birthdays:
(defface cfw:face-holiday-date
'((((class color) (background light))
:background "#ffd5e5")
(((class color) (background dark))
:background "grey10" :foreground "OrangeRed" :weight bold))
"Face for holidays date." :group 'calfw)
(defface cfw:face-sunday-date
'((((class color) (background light))
:foreground "red2" :background "#ffd5e5" :weight bold)
(((class color) (background dark))
:background "grey10" :foreground "red" :weight bold))
"Face for Sunday date." :group 'calfw)
(defface cfw:face-saturday-date
'((((class color) (background light))
:foreground "Blue" :background "#d4e5ff" :weight bold)
(((class color) (background dark))
:background "grey10" :foreground "blue" :weight bold))
"Face for Saturday date." :group 'calfw)
Suggestion No. 4: The background colors of the two overlays relating to the today title bar and the selected date title bar conflict in that Emacs does not know which takes priority over the other -- sometimes today will show the today background when it is the selected, or sometimes visa-versa. I dealt with this issue by doing something not fully supported yet according to the overlay documentation -- i.e., I added a negative priority to the today face title bar -- within the function cfw:dest-ol-today-set, I added (overlay-put overlay 'priority -1). This resolves the conflict in favor of the selected date. I took it one step further by modifying cfw:dest-ol-selection-set to make a determination whether (equal date (calendar-current-date)) and if so, then use a new face for today+selected and of course I created that new face.
Suggestion No. 5: The calendar view presently only display a schedule of org-mode events for the current month. This is problematic because the calendar views (month, week, two-weeks) may show a few days before the beginning of the month, and/or a few days following the end of the month. Let's say we are looking at the month view of May 2015 -- in this example, April 26 to 30 are visible, and so is June 1 to 6. There may be some very important events in the org-mode files that need to display during those periods that are outside the current month. Here is an example of how to fix this problem (the screenshot above includes the fix):
(defun cfw:view-model-make-common-data-for-weeks (model begin-date end-date)
"[internal] Return a model object for week based views."
(let* (
;; a list of the index of day-of-week
(index-days-of-week (cfw:view-model-make-day-names-for-week))
;; a matrix of day-of-month, which corresponds to the index of `headers'
(matrix-days-of-month
(cfw:view-model-make-weeks
(cfw:week-begin-date begin-date)
(cfw:week-end-date end-date)))
(first (car (car matrix-days-of-month)))
(last (car (last (car (last matrix-days-of-month))))) )
(cfw:model-create-updated-view-data model
(cfw:view-model-make-common-data model first last
`((headers . ,index-days-of-week)
(weeks . ,matrix-days-of-month))))))
Suggestion No. 6: I added some new faces for Saturday and Sunday in the week titles, so that they are a different color than the numbered date -- see the screenshot above.
Suggestion No. 7: I didn't see a setting to programmatically open a calendar buffer on a specific month/year WHEN no calendar buffer exists, so here is my modification (e.g., from a *scratch* buffer, a user might want to jump directly to July of the current year to see what's on calendar that month) -- and, I added functions bound from f1 to f12 and also put them in the menubar (for when a user is already inside a calendar buffer).
Suggestion No. 8: The other thing you might want to consider is adding a toolbar menu, which also works for people using a mouse context menu or when the user clicks on the major-mode name in the mode-line. I use a right-click mouse pop-up menu that is a customized version of the menu-bar, and I hide the menu-bar to save extra screen real estate.
EXAMPLES FOR SUGGESTIONS 7 AND 8
(defun cfw:open-org-calendar (&optional init-date goto-today)
"Open an org schedule calendar in the new buffer."
(interactive)
(let* (
(source1 (cfw:org-create-source))
(cp
(cfw:create-calendar-component-buffer
:date init-date
:view 'month
:contents-sources (list source1)
:custom-map cfw:org-schedule-map
:sorter 'cfw:org-schedule-sorter)) )
(switch-to-buffer (cfw:cp-get-buffer cp))
(when goto-today
(let* (
(today (calendar-current-date))
(dest (cfw:component-dest (cfw:cp-get-component)))
(first-date (cfw:find-first-date dest))
(last-date (cfw:find-last-date dest))
(today-is-visible-p (cfw:date-between first-date last-date today)))
(when today-is-visible-p
(cfw:navi-goto-date today))))
(set-window-start (get-buffer-window cfw:calendar-buffer-name) (point-min))))
(defun cfw:f1 ()
"January of the current year."
(interactive)
(let ((current-year (nth 2 (calendar-current-date))))
(cfw:open-org-calendar (list 01 01 current-year) 'today-maybe)))
(defun cfw:f2 ()
"February of the current year."
(interactive)
(let ((current-year (nth 2 (calendar-current-date))))
(cfw:open-org-calendar (list 02 01 current-year) 'today-maybe)))
(defun cfw:f3 ()
"March of the current year."
(interactive)
(let ((current-year (nth 2 (calendar-current-date))))
(cfw:open-org-calendar (list 03 01 current-year) 'today-maybe)))
(defun cfw:f4 ()
"April of the current year."
(interactive)
(let ((current-year (nth 2 (calendar-current-date))))
(cfw:open-org-calendar (list 04 01 current-year) 'today-maybe)))
(defun cfw:f5 ()
"May of the current year."
(interactive)
(let ((current-year (nth 2 (calendar-current-date))))
(cfw:open-org-calendar (list 05 01 current-year) 'today-maybe)))
(defun cfw:f6 ()
"June of the current year."
(interactive)
(let ((current-year (nth 2 (calendar-current-date))))
(cfw:open-org-calendar (list 06 01 current-year) 'today-maybe)))
(defun cfw:f7 ()
"July of the current year."
(interactive)
(let ((current-year (nth 2 (calendar-current-date))))
(cfw:open-org-calendar (list 07 01 current-year) 'today-maybe)))
(defun cfw:f8 ()
"August of the current year."
(interactive)
(let ((current-year (nth 2 (calendar-current-date))))
(cfw:open-org-calendar (list 08 01 current-year) 'today-maybe)))
(defun cfw:f9 ()
"September of the current year."
(interactive)
(let ((current-year (nth 2 (calendar-current-date))))
(cfw:open-org-calendar (list 09 01 current-year) 'today-maybe)))
(defun cfw:f10 ()
"October of the current year."
(interactive)
(let ((current-year (nth 2 (calendar-current-date))))
(cfw:open-org-calendar (list 10 01 current-year) 'today-maybe)))
(defun cfw:f11 ()
"November of the current year."
(interactive)
(let ((current-year (nth 2 (calendar-current-date))))
(cfw:open-org-calendar (list 011 01 current-year 'today-maybe))))
(defun cfw:f12 ()
"December of the current year."
(interactive)
(let ((current-year (nth 2 (calendar-current-date))))
(cfw:open-org-calendar (list 012 01 current-year 'today-maybe))))
(defvar cfw:calendar-mode-map
(let* (
(map (make-sparse-keymap))
(current-year (nth 2 (calendar-current-date))))
(define-key map [menu-bar cfw]
(cons "CFW" (make-sparse-keymap "CFW")))
(define-key map [right] 'cfw:navi-next-day-command)
(define-key map "f" 'cfw:navi-next-day-command)
(define-key map "l" 'cfw:navi-next-day-command)
(bindings--define-key map [menu-bar cfw cfw:navi-next-day-command]
'(menu-item "Next Day" cfw:navi-next-day-command
:help "My help sentence."))
(define-key map [left] 'cfw:navi-previous-day-command)
(define-key map "b" 'cfw:navi-previous-day-command)
(define-key map "h" 'cfw:navi-previous-day-command)
(bindings--define-key map [menu-bar cfw cfw:navi-previous-day-command]
'(menu-item "Previous Day" cfw:navi-previous-day-command
:help "My help sentence."))
(define-key map [down] 'cfw:navi-next-week-command)
(define-key map "n" 'cfw:navi-next-week-command)
(define-key map "j" 'cfw:navi-next-week-command)
(bindings--define-key map [menu-bar cfw cfw:navi-next-week-command]
'(menu-item "Next Week" cfw:navi-next-week-command
:help "My help sentence."))
(define-key map [up] 'cfw:navi-previous-week-command)
(define-key map "p" 'cfw:navi-previous-week-command)
(define-key map "k" 'cfw:navi-previous-week-command)
(bindings--define-key map [menu-bar cfw cfw:navi-previous-week-command]
'(menu-item "Previous Week" cfw:navi-previous-week-command
:help "My help sentence."))
(define-key map "^" 'cfw:navi-goto-week-begin-command)
(bindings--define-key map [menu-bar cfw cfw:navi-goto-week-begin-command]
'(menu-item "Week Begin" cfw:navi-goto-week-begin-command
:help "My help sentence."))
(define-key map "$" 'cfw:navi-goto-week-end-command)
(bindings--define-key map [menu-bar cfw cfw:navi-goto-week-end-command]
'(menu-item "Week End" cfw:navi-goto-week-end-command
:help "My help sentence."))
(define-key map "[" 'cfw:navi-previous-month-command)
(define-key map "M-v" 'cfw:navi-previous-month-command)
(define-key map [prior] 'cfw:navi-previous-month-command)
(bindings--define-key map [menu-bar cfw cfw:navi-previous-month-command]
'(menu-item "Previous Month" cfw:navi-previous-month-command
:help "My help sentence."))
(define-key map "]" 'cfw:navi-next-month-command)
(define-key map "C-v" 'cfw:navi-next-month-command)
(define-key map [next] 'cfw:navi-next-month-command)
(bindings--define-key map [menu-bar cfw cfw:navi-next-month-command]
'(menu-item "Next Month" cfw:navi-next-month-command
:help "My help sentence."))
(define-key map [home] 'cfw:navi-goto-first-date-command)
(bindings--define-key map [menu-bar cfw cfw:navi-goto-first-date-command]
'(menu-item "First Date" cfw:navi-goto-first-date-command
:help "My help sentence."))
(define-key map [end] 'cfw:navi-goto-last-date-command)
(bindings--define-key map [menu-bar cfw cfw:navi-goto-last-date-command]
'(menu-item "Last Date" cfw:navi-goto-last-date-command
:help "My help sentence."))
(bindings--define-key map [menu-bar cfw sep] menu-bar-separator)
(define-key map "g" 'cfw:navi-goto-date-command)
(bindings--define-key map [menu-bar cfw cfw:navi-goto-date-command]
'(menu-item "Goto Date" cfw:navi-goto-date-command
:help "My help sentence."))
(define-key map [menu-bar cfw goto]
(cons
(format "Goto Month -- %s" current-year)
(make-sparse-keymap "Goto Month")))
(define-key map [f12] 'cfw:f12)
(bindings--define-key map [menu-bar cfw goto cfw:f12]
`(menu-item (format "December %s" ,current-year)
cfw:f12
:help "Click to jump to December."))
(define-key map [f11] 'cfw:f11)
(bindings--define-key map [menu-bar cfw goto cfw:f11]
`(menu-item (format "November %s" ,current-year)
cfw:f11
:help "Click to jump to November."))
(define-key map [f10] 'cfw:f10)
(bindings--define-key map [menu-bar cfw goto cfw:f10]
`(menu-item (format "October %s" ,current-year)
cfw:f10
:help "Click to jump to October."))
(define-key map [f9] 'cfw:f9)
(bindings--define-key map [menu-bar cfw goto cfw:f9]
`(menu-item (format "September %s" ,current-year)
cfw:f9
:help "Click to jump to September."))
(define-key map [f8] 'cfw:f8)
(bindings--define-key map [menu-bar cfw goto cfw:f8]
`(menu-item (format "August %s" ,current-year)
cfw:f8
:help "Click to jump to August."))
(define-key map [f7] 'cfw:f7)
(bindings--define-key map [menu-bar cfw goto cfw:f7]
`(menu-item (format "July %s" ,current-year)
cfw:f7
:help "Click to jump to July."))
(define-key map [f6] 'cfw:f6)
(bindings--define-key map [menu-bar cfw goto cfw:f6]
`(menu-item (format "June %s" ,current-year)
cfw:f6
:help "Click to jump to June."))
(define-key map [f5] 'cfw:f5)
(bindings--define-key map [menu-bar cfw goto cfw:f5]
`(menu-item (format "May %s" ,current-year)
cfw:f5
:help "Click to jump to May."))
(define-key map [f4] 'cfw:f4)
(bindings--define-key map [menu-bar cfw goto cfw:f4]
`(menu-item (format "April %s" ,current-year)
cfw:f4
:help "Click to jump to April."))
(define-key map [f3] 'cfw:f3)
(bindings--define-key map [menu-bar cfw goto cfw:f3]
`(menu-item (format "March %s" ,current-year)
cfw:f3
:help "Click to jump to March."))
(define-key map [f2] 'cfw:f2)
(bindings--define-key map [menu-bar cfw goto cfw:f2]
`(menu-item (format "February %s" ,current-year)
cfw:f2
:help "Click to jump to February."))
(define-key map [f1] 'cfw:f1)
(bindings--define-key map [menu-bar cfw goto cfw:f1]
`(menu-item (format "January %s" ,current-year)
cfw:f1
:help "Click to jump to January."))
(define-key map "t" 'cfw:navi-goto-today-command)
(define-key map "." 'cfw:navi-goto-today-command)
(bindings--define-key map [menu-bar cfw cfw:navi-goto-today-command]
'(menu-item "Today" cfw:navi-goto-today-command
:help "My help sentence."))
(define-key map [tab] 'cfw:navi-next-item-command)
(bindings--define-key map [menu-bar cfw cfw:navi-next-item-command]
'(menu-item "Next Item" cfw:navi-next-item-command
:help "My help sentence."))
(define-key map "r" 'cfw:refresh-calendar-buffer)
(bindings--define-key map [menu-bar cfw cfw:refresh-calendar-buffer]
'(menu-item "Refresh" cfw:refresh-calendar-buffer
:help "My help sentence."))
(define-key map [?\s] 'cfw:show-details-command)
(bindings--define-key map [menu-bar cfw cfw:show-details-command]
'(menu-item "Details" cfw:show-details-command
:help "My help sentence."))
(define-key map "D" 'cfw:change-view-day)
(bindings--define-key map [menu-bar cfw cfw:change-view-day]
'(menu-item "Day View" cfw:change-view-day
:help "My help sentence."))
(define-key map "W" 'cfw:change-view-week)
(bindings--define-key map [menu-bar cfw cfw:change-view-week]
'(menu-item "Week View" cfw:change-view-week
:help "My help sentence."))
(define-key map "T" 'cfw:change-view-two-weeks)
(bindings--define-key map [menu-bar cfw cfw:change-view-two-weeks]
'(menu-item "2-Week View" cfw:change-view-two-weeks
:help "My help sentence."))
(define-key map "M" 'cfw:change-view-month)
(bindings--define-key map [menu-bar cfw cfw:change-view-month]
'(menu-item "Month View" cfw:change-view-month
:help "My help sentence."))
(define-key map "q" 'bury-buffer)
(bindings--define-key map [menu-bar cfw burry-buffer]
'(menu-item "Burry Buffer" burry-buffer
:help "My help sentence."))
(define-key map [mouse-1] 'cfw:navi-on-click)
(define-key map "0" 'digit-argument)
(define-key map "1" 'digit-argument)
(define-key map "2" 'digit-argument)
(define-key map "3" 'digit-argument)
(define-key map "4" 'digit-argument)
(define-key map "5" 'digit-argument)
(define-key map "6" 'digit-argument)
(define-key map "7" 'digit-argument)
(define-key map "8" 'digit-argument)
(define-key map "9" 'digit-argument)
map)
"Keymap for `cfw:calendar-mode'.")
(defvar cfw:org-schedule-map
(let ((map (make-sparse-keymap)))
(define-key map [menu-bar cfw]
(cons "CFW-SCHEDULE" (make-sparse-keymap "CFW-SCHEDULE")))
(bindings--define-key map [menu-bar cfw sep-agenda] menu-bar-separator)
(define-key map "A" 'cfw:org-open-agenda-day)
(bindings--define-key map [menu-bar cfw cfw:org-open-agenda-day]
'(menu-item "Agenda" cfw:org-open-agenda-day
:help "My help sentence."))
map)
"Keymap for `cfw:org-schedule-map'.")