pax_global_header00006660000000000000000000000064126657241220014521gustar00rootroot0000000000000052 comment=e03ae470788778e7714b73520014eadc03a88abd emacs-calfw-master/000077500000000000000000000000001266572412200145405ustar00rootroot00000000000000emacs-calfw-master/calfw-cal.el000066400000000000000000000133051266572412200167150ustar00rootroot00000000000000;;; calfw-cal.el --- calendar view for emacs diary ;; Copyright (C) 2011 SAKURAI Masashi ;; Author: SAKURAI Masashi ;; Keywords: calendar ;; This program is free software; you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by ;; the Free Software Foundation, either version 3 of the License, or ;; (at your option) any later version. ;; This program is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;; GNU General Public License for more details. ;; You should have received a copy of the GNU General Public License ;; along with this program. If not, see . ;;; Commentary: ;; Display diary items in the calfw buffer. ;; (require 'calfw-cal) ;; ;; M-x cfw:open-diary-calendar ;; Key binding ;; i : insert an entry on the date ;; RET or Click : jump to the entry ;; q : kill-buffer ;; Thanks for furieux's initial code. ;;; Code: (require 'calfw) (require 'calendar) (defvar cfw:cal-diary-regex (let ((time "[[:digit:]]\\{2\\}:[[:digit:]]\\{2\\}") (blanks "[[:blank:]]*")) (concat "\\(" time "\\)?" "\\(?:" blanks "-" blanks "\\(" time "\\)\\)?" blanks "\\(.*\\)")) "Regex extracting start/end time and title from a diary string") (defun cfw:cal-entry-to-event (date string) "[internal] Add text properties to string, allowing calfw to act on it." (let* ((lines (split-string (replace-regexp-in-string "[\t ]+" " " (cfw:trim string)) "\n")) (first (car lines)) (desc (mapconcat 'identity (cdr lines) "\n")) (title (progn (string-match cfw:cal-diary-regex first) (match-string 3 first))) (start (match-string 1 first)) (end (match-string 2 first)) (properties (list 'mouse-face 'highlight 'help-echo string 'cfw-marker (copy-marker (point-at-bol))))) (make-cfw:event :title (apply 'propertize title properties) :start-date date :start-time (when start (cfw:parse-str-time start)) :end-time (when end (cfw:parse-str-time end)) :description (apply 'propertize desc properties)))) (defun cfw:cal-onclick () "Jump to the clicked diary item." (interactive) (let ((marker (get-text-property (point) 'cfw-marker))) (when (and marker (marker-buffer marker)) (switch-to-buffer (marker-buffer marker)) (goto-char (marker-position marker))))) (defvar cfw:cal-text-keymap (let ((map (make-sparse-keymap))) (define-key map [mouse-1] 'cfw:cal-onclick) (define-key map (kbd "") 'cfw:cal-onclick) map) "key map on the calendar item text.") (defun cfw:cal-schedule-period-to-calendar (begin end) "[internal] Return calfw calendar items between BEGIN and END from the diary schedule data." (let ((all (diary-list-entries begin (1+ (cfw:days-diff begin end)) t)) non-periods periods) (loop for i in all for date = (car i) for title = (nth 1 i) for date-spec = (nth 2 i) for dmarker = (nth 3 i) for pspec = (cons date-spec title) do (if (string-match "%%(diary-block" date-spec) (unless (member pspec periods) (push pspec periods)) (push i non-periods))) (append (loop for (date string . rest) in non-periods collect (cfw:cal-entry-to-event date string)) (list (cons 'periods (map 'list (function (lambda (period) (let ((spec (read (substring (car period) 2)))) (list (list (nth 1 spec) (nth 2 spec) (nth 3 spec)) (list (nth 4 spec) (nth 5 spec) (nth 6 spec)) (cdr period))))) periods)))))) (defvar cfw:cal-schedule-map (cfw:define-keymap '( ("q" . kill-buffer) ("i" . cfw:cal-from-calendar) )) "Key map for the calendar buffer.") (defun cfw:cal-create-source (&optional color) "Create diary calendar source." (make-cfw:source :name "calendar diary" :color (or color "SaddleBrown") :data 'cfw:cal-schedule-period-to-calendar)) (defun cfw:open-diary-calendar () "Open the diary schedule calendar in the new buffer." (interactive) (save-excursion (let* ((source1 (cfw:cal-create-source)) (cp (cfw:create-calendar-component-buffer :view 'month :custom-map cfw:cal-schedule-map :contents-sources (list source1)))) (switch-to-buffer (cfw:cp-get-buffer cp))))) (defun cfw:cal-from-calendar () "Insert a new item. This command should be executed on the calfw calendar." (interactive) (let* ((mdy (cfw:cursor-to-nearest-date)) (m (calendar-extract-month mdy)) (d (calendar-extract-day mdy)) (y (calendar-extract-year mdy))) (diary-make-entry (calendar-date-string (cfw:date m d y) t t)) )) ;; (progn (eval-current-buffer) (cfw:open-diary-calendar)) (provide 'calfw-cal) ;;; calfw-cal.el ends here emacs-calfw-master/calfw-howm.el000066400000000000000000000210761266572412200171340ustar00rootroot00000000000000;;; calfw-howm.el --- calendar view for howm ;; Copyright (C) 2011 SAKURAI Masashi ;; Author: SAKURAI Masashi ;; Keywords: calendar ;; This program is free software; you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by ;; the Free Software Foundation, either version 3 of the License, or ;; (at your option) any later version. ;; This program is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;; GNU General Public License for more details. ;; You should have received a copy of the GNU General Public License ;; along with this program. If not, see . ;;; Commentary: ;; (eval-after-load "howm-menu" '(progn ;; (require 'calfw-howm) ;; (cfw:install-howm-schedules) ;; (define-key howm-mode-map (kbd "M-C") 'cfw:open-howm-calendar) ;; )) ;; If you are using Elscreen, here is useful. ;; (define-key howm-mode-map (kbd "M-C") 'cfw:elscreen-open-howm-calendar) ;; One can open a standalone calendar buffer by ;; M-x cfw:open-howm-calendar ;; You can display a calendar in your howm menu. ;; %here%(cfw:howm-schedule-inline) ;;; Code: (require 'howm) (require 'calfw) (defvar cfw:howm-schedule-cache nil "[internal] Cache data for schedule items of howm.") (defun cfw:howm-schedule-cache-clear () "clear cache for howm schedule items." (setq cfw:howm-schedule-cache nil)) (defvar cfw:howm-schedule-hook nil "Hook which is called after retrieval of howm schedule items.") (defun cfw:howm-schedule-get () "[internal] Return all schedule items in the whole howm data. If cache data exists, this function uses the cache." (unless cfw:howm-schedule-cache (let* ((howm-schedule-types howm-schedule-menu-types) (raw (howm-reminder-search howm-schedule-types))) (setq cfw:howm-schedule-cache (howm-schedule-sort-items raw))) (run-hooks 'cfw:howm-schedule-hook)) cfw:howm-schedule-cache) (defun cfw:to-howm-date (date) "[internal] Convert a date format from the Emacs calendar list to the number of howm encoded days." (apply 'howm-encode-day (mapcar 'number-to-string (list (calendar-extract-day date) (calendar-extract-month date) (calendar-extract-year date))))) (defun cfw:howm-schedule-period (begin end) "[internal] Return howm schedule items between BEGIN and END." (let* ((from (cfw:to-howm-date begin)) (to (cfw:to-howm-date end)) (filtered (howm-cl-remove-if (lambda (item) (let ((s (howm-schedule-date item))) (or (< s from) (< to s)))) (cfw:howm-schedule-get)))) (howm-schedule-sort-items filtered))) (defvar cfw:howm-schedule-summary-transformer (lambda (line) line) "Transformation function which transforms the howm summary string to calendar title. If this function splits into a list of string, the calfw displays those string in multi-lines.") (defun cfw:howm-schedule-parse-line (line) "[internal] Parse the given string and return a result list, (date num type summary)." (when (string-match "^\\[\\([^@!]+\\)\\]\\([@!]\\)\\([0-9]*\\) \\(.*\\)$" line) (list (match-string 1 line) (string-to-number (match-string 3 line)) (match-string 2 line) (match-string 4 line)))) (defun cfw:howm-schedule-period-to-calendar (begin end) "[internal] Return calfw calendar items between BEGIN and END from the howm schedule data." (loop with contents = nil with periods = nil for i in (cfw:howm-schedule-period begin end) for date = (cfw:emacs-to-calendar (seconds-to-time (+ 10 (* (howm-schedule-date i) 24 3600)))) for (datestr num type summary) = (cfw:howm-schedule-parse-line (howm-item-summary i)) for summary = (funcall cfw:howm-schedule-summary-transformer summary) do (cond ((< 0 num) (push (list date (cfw:date-after date (1- num)) summary) periods)) (t (setq contents (cfw:contents-add date summary contents)))) finally return (nconc contents (list (cons 'periods periods))))) (defun cfw:howm-create-source (&optional color) "Create a howm source." (make-cfw:source :name "howm schedule" :color (or color "SteelBlue") :update 'cfw:howm-schedule-cache-clear :data 'cfw:howm-schedule-period-to-calendar)) (defvar cfw:howm-schedule-map (cfw:define-keymap '( ("RET" . cfw:howm-from-calendar) ("q" . kill-buffer) )) "Key map for the howm calendar mode.") (defvar cfw:howm-schedule-contents nil "A list of cfw:source objects for schedule contents.") (defvar cfw:howm-annotation-contents nil "A list of cfw:source objects for annotations.") (defun cfw:open-howm-calendar () "Open a howm schedule calendar in the new buffer." (interactive) (save-excursion (let ((cp (cfw:create-calendar-component-buffer :custom-map cfw:howm-schedule-map :view 'month :contents-sources (append (list (cfw:howm-create-source)) cfw:howm-schedule-contents) :annotation-sources cfw:howm-annotation-contents))) (switch-to-buffer (cfw:cp-get-buffer cp))))) (defun cfw:howm-from-calendar () "Display a howm schedule summary of the date on the cursor, searching from the whole howm data. This command should be executed on the calfw calendar." (interactive) (let* ((mdy (cfw:cursor-to-nearest-date)) (m (calendar-extract-month mdy)) (d (calendar-extract-day mdy)) (y (calendar-extract-year mdy)) (key (format-time-string howm-date-format (encode-time 0 0 0 d m y)))) (howm-keyword-search key))) (defun cfw:howm-from-calendar-fast () "Display a howm schedule summary of the date on the cursor, searching from the cache. So, this command is faster than `cfw:howm-from-calendar'. This command should be executed on the calfw calendar." (interactive) (let* ((mdy (cfw:cursor-to-nearest-date)) (m (calendar-extract-month mdy)) (d (calendar-extract-day mdy)) (y (calendar-extract-year mdy)) (key (format-time-string howm-date-format (encode-time 0 0 0 d m y))) (items (cfw:howm-schedule-period mdy mdy))) (cond ((= 1 (length items)) (howm-view-open-item (car items))) (t (howm-view-summary (format "Schedules : %s" (cfw:strtime mdy)) items (list key)) (howm-view-summary-check t))))) ;; (define-key cfw:howm-schedule-map (kbd "RET") 'cfw:howm-from-calendar-fast) ;; (define-key cfw:howm-schedule-inline-keymap (kbd "RET") 'cfw:howm-from-calendar-fast) ;;; Region (defvar cfw:howm-schedule-inline-keymap (cfw:define-keymap '(("RET" . cfw:howm-from-calendar))) "Key map for the howm inline calendar.") (defun cfw:howm-schedule-inline (&optional width height view) "Inline function for the howm menu. See the comment text on the top of this file for the usage." (let ((custom-map (copy-keymap cfw:howm-schedule-inline-keymap)) cp) (set-keymap-parent custom-map cfw:calendar-mode-map) (setq cp (cfw:create-calendar-component-region :width width :height (or height 10) :keymap custom-map :contents-sources (append (list (cfw:howm-create-source)) cfw:howm-schedule-contents) :annotation-sources cfw:howm-annotation-contents :view (or view 'month)))) "") ; for null output ;;; Installation (defun cfw:install-howm-schedules () "Add a schedule collection function to the calfw for the howm schedule data and set up inline calendar function for the howm menu." (interactive) (add-hook 'howm-after-save-hook 'cfw:howm-schedule-cache-clear) (add-to-list 'howm-menu-allow 'cfw:howm-schedule-inline)) ;;; for Elscreen (eval-after-load "elscreen-howm" '(progn (defun cfw:elscreen-open-howm-calendar () "Open the calendar in the new screen." (interactive) (save-current-buffer (elscreen-create)) (cfw:open-howm-calendar)) (defun cfw:elscreen-kill-calendar () "Kill the calendar buffer and the screen." (interactive) (kill-buffer nil) (unless (elscreen-one-screen-p) (elscreen-kill))) (define-key cfw:howm-schedule-map (kbd "q") 'cfw:elscreen-kill-calendar) )) (provide 'calfw-howm) ;;; calfw-howm.el ends here emacs-calfw-master/calfw-ical.el000066400000000000000000000240551266572412200170720ustar00rootroot00000000000000;;; calfw-ical.el --- calendar view for ical format ;; Copyright (C) 2011 SAKURAI Masashi ;; Author: SAKURAI Masashi ;; Keywords: calendar ;; This program is free software; you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by ;; the Free Software Foundation, either version 3 of the License, or ;; (at your option) any later version. ;; This program is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;; GNU General Public License for more details. ;; You should have received a copy of the GNU General Public License ;; along with this program. If not, see . ;;; Commentary: ;; A bridge from ical to calfw. ;; The API and interfaces have not been confirmed yet. ;;; Installation: ;; Here is a minimum sample code: ;; (require 'calfw-ical) ;; To open a calendar buffer, execute the following function. ;; (cfw:open-ical-calendar "http://www.google.com/calendar/ical/.../basic.ics") ;; Executing the following command, this program clears caches to refresh the ICS data. ;; (cfw:ical-data-cache-clear-all) ;;; Code: (require 'calfw) (require 'icalendar) (require 'url) (defun cfw:decode-to-calendar (dec) (cfw:date (nth 4 dec) (nth 3 dec) (nth 5 dec))) (defun cfw:ical-event-get-dates (event) "Return date-time information from iCalendar event object: period event (list 'period start-date end-date), time span event (list 'time date start-time end-time). The period includes end-date. This function is copied from `icalendar--convert-ical-to-diary' and modified. Recursive events have not been supported yet." (let* ((dtstart (icalendar--get-event-property event 'DTSTART)) (dtstart-zone (icalendar--find-time-zone (icalendar--get-event-property-attributes event 'DTSTART) zone-map)) (dtstart-dec (icalendar--decode-isodatetime dtstart nil dtstart-zone)) (start-d (cfw:decode-to-calendar dtstart-dec)) (start-t (cfw:time (nth 2 dtstart-dec) (nth 1 dtstart-dec))) (dtend (icalendar--get-event-property event 'DTEND)) (dtend-zone (icalendar--find-time-zone (icalendar--get-event-property-attributes event 'DTEND) zone-map)) (dtend-dec (icalendar--decode-isodatetime dtend nil dtend-zone)) (dtend-1-dec (icalendar--decode-isodatetime dtend -1 dtend-zone)) (duration (icalendar--get-event-property event 'DURATION)) end-d end-1-d end-t) (when (and dtstart (string= (cadr (icalendar--get-event-property-attributes event 'DTSTART)) "DATE")) (setq start-t nil)) (when duration (let ((dtend-dec-d (icalendar--add-decoded-times dtstart-dec (icalendar--decode-isoduration duration))) (dtend-1-dec-d (icalendar--add-decoded-times dtstart-dec (icalendar--decode-isoduration duration t)))) (if (and dtend-dec (not (eq dtend-dec dtend-dec-d))) (message "Inconsistent endtime and duration for %s" dtend-dec)) (setq dtend-dec dtend-dec-d) (setq dtend-1-dec dtend-1-dec-d))) (setq end-d (if dtend-dec (cfw:decode-to-calendar dtend-dec) start-d)) (setq end-1-d (if dtend-1-dec (cfw:decode-to-calendar dtend-1-dec) start-d)) (setq end-t (if (and dtend-dec (not (string= (cadr (icalendar--get-event-property-attributes event 'DTEND)) "DATE"))) (cfw:time (nth 2 dtend-dec) (nth 1 dtend-dec)) start-t)) (cond ((and start-t (equal start-d end-d)) (list 'time start-d start-t end-t)) ((equal start-d end-1-d) (list 'time start-d nil nil)) (t (list 'period start-d nil end-1-d))))) (defun cfw:ical-sanitize-string (string) (when (and string (> (length string) 0)) (replace-regexp-in-string "\\\\n" "\n" (replace-regexp-in-string "\\\\," "," string)))) (defun cfw:ical-convert-event (event) (destructuring-bind (dtag date start end) (cfw:ical-event-get-dates event) (make-cfw:event :start-date date :start-time start :end-date (when (equal dtag 'period) end) :end-time (when (equal dtag 'time) end) :title (cfw:ical-sanitize-string (icalendar--get-event-property event 'SUMMARY)) :location (cfw:ical-sanitize-string (icalendar--get-event-property event 'LOCATION)) :description (cfw:ical-sanitize-string (icalendar--get-event-property event 'DESCRIPTION))))) (defun cfw:ical-convert-ical-to-calfw (ical-list) (loop with zone-map = (icalendar--convert-all-timezones ical-list) for e in (icalendar--all-events ical-list) for event = (cfw:ical-convert-event e) if event if (cfw:event-end-date event) collect event into periods else collect event into contents else do (progn (message "Ignoring event \"%s\"" e) (message "Cannot handle this event, tag: %s" e)) finally (return `((periods ,periods) ,@contents)))) (defun cfw:ical-debug (f) (interactive) (let ((buf (cfw:ical-url-to-buffer f))) (unwind-protect (pp-display-expression (with-current-buffer buf (cfw:ical-normalize-buffer) (cfw:ical-convert-ical-to-calfw (icalendar--read-element nil nil))) "*ical-debug*") (kill-buffer buf)))) (defvar cfw:ical-calendar-external-shell-command "wget -q -O - ") (defvar cfw:ical-calendar-tmpbuf " *calfw-tmp*") (defvar cfw:ical-url-to-buffer-get 'cfw:ical-url-to-buffer-internal) (defun cfw:ical-url-to-buffer-external (url) "Retrieve ICS file with an external command." (let ((buf (get-buffer-create cfw:ical-calendar-tmpbuf))) (buffer-disable-undo buf) (with-current-buffer buf (erase-buffer)) (call-process-shell-command cfw:ical-calendar-external-shell-command nil buf nil url) buf)) (defun cfw:ical-url-to-buffer-internal (url) "Retrieve ICS file with the url package." (let ((buf (url-retrieve-synchronously url)) (dbuf (get-buffer-create cfw:ical-calendar-tmpbuf)) pos) (unwind-protect (when (setq pos (url-http-symbol-value-in-buffer 'url-http-end-of-headers buf)) (with-current-buffer dbuf (erase-buffer) (decode-coding-string (with-current-buffer buf (buffer-substring (1+ pos) (point-max))) 'utf-8 nil dbuf))) (kill-buffer buf)) dbuf)) (defun cfw:ical-url-to-buffer (url) (let* ((url-code (url-generic-parse-url url)) (type (url-type url-code))) (cond (type (funcall cfw:ical-url-to-buffer-get url)) (t ; assume local file (let ((buf (find-file-noselect (expand-file-name url) t))) (with-current-buffer buf (set-visited-file-name nil)) buf))))) (defmacro cfw:ical-with-buffer (url &rest body) (let (($buf (gensym))) `(let ((,$buf (cfw:ical-url-to-buffer ,url))) (unwind-protect (with-current-buffer ,$buf (goto-char (point-min)) ,@body) (kill-buffer ,$buf))))) (put 'cfw:ical-with-buffer 'lisp-indent-function 1) (defun cfw:ical-normalize-buffer () (save-excursion (goto-char (point-min)) (while (re-search-forward "\n " nil t) (replace-match ""))) (save-excursion (goto-char (point-min)) (while (re-search-forward "DT\\(START\\|END\\);VALUE=DATE:" nil t) (replace-match "DT\\1:"))) (set-buffer-modified-p nil)) (defvar cfw:ical-data-cache nil "a list of (url . ics-data)") (defun cfw:ical-data-cache-clear (url) (setq cfw:ical-data-cache (loop for i in cfw:ical-data-cache for (u . d) = i unless (equal u url) collect i))) (defun cfw:ical-data-cache-clear-all () (interactive) (setq cfw:ical-data-cache nil)) (defun cfw:ical-get-data (url) (let ((data (assoc url cfw:ical-data-cache))) (unless data (setq data (let ((cal-list (cfw:ical-with-buffer url (cfw:ical-normalize-buffer) (cfw:ical-convert-ical-to-calfw (icalendar--read-element nil nil))))) (cons url cal-list))) (push data cfw:ical-data-cache)) (cdr data))) (defun cfw:ical-to-calendar (url begin end) (loop for event in (cfw:ical-get-data url) if (and (listp event) (equal 'periods (car event))) collect (cons 'periods (loop for evt in (cadr event) if (and (cfw:date-less-equal-p begin (cfw:event-end-date evt)) (cfw:date-less-equal-p (cfw:event-start-date evt) end)) collect evt)) else if (cfw:date-between begin end (cfw:event-start-date event)) collect event)) (defun cfw:ical-create-source (name url color) (lexical-let ((url url)) (make-cfw:source :name (concat "iCal:" name) :color color :update (lambda () (cfw:ical-data-cache-clear url)) :data (lambda (begin end) (cfw:ical-to-calendar url begin end))))) (defun cfw:open-ical-calendar (url) "Simple calendar interface. This command displays just one calendar source." (interactive) (save-excursion (let ((cp (cfw:create-calendar-component-buffer :view 'month :contents-sources (list (cfw:ical-create-source "ical" url "#2952a3"))))) (switch-to-buffer (cfw:cp-get-buffer cp))))) ;; (progn (eval-current-buffer) (cfw:open-ical-calendar "./ics/test.ics")) (provide 'calfw-ical) ;;; calfw-ical.el ends here emacs-calfw-master/calfw-org.el000066400000000000000000000454071266572412200167550ustar00rootroot00000000000000;;; calfw-org.el --- calendar view for org-agenda -*- coding: utf-8 -*- ;; Copyright (C) 2011 SAKURAI Masashi ;; Author: SAKURAI Masashi ;; Keywords: calendar, org ;; This program is free software; you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by ;; the Free Software Foundation, either version 3 of the License, or ;; (at your option) any later version. ;; This program is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;; GNU General Public License for more details. ;; You should have received a copy of the GNU General Public License ;; along with this program. If not, see . ;;; Commentary: ;; Display org-agenda items in the calfw buffer. ;; (Because I don't use the org-agenda mainly, ;; I hope someone continue integration with the org.) ;; (require 'calfw-org) ;; ;; ;; use org agenda buffer style keybinding. ;; ;; (setq cfw:org-overwrite-default-keybinding t) ;; ;; M-x cfw:open-org-calendar ;;; Code: (require 'calfw) (require 'org) (require 'org-agenda) (require 'org-element) (require 'org-capture) (require 'google-maps nil t) (defgroup cfw-org nil "Options about calfw-org." :tag "Calfw Org" :group 'org :group 'cfw) (defcustom cfw:org-capture-template nil "org-capture template. If you use `org-capture' with `calfw', you shold set like '(\"c\" \"calfw2org\" entry (file nil) \"* %?\n %(cfw:org-capture-day)\")" :group 'cfw-org :version "24.1" :type '(list string string symbol (list symbol (choice file (const nil))) string)) (defsubst cfw:org-tp (text prop) "[internal] Return text property at position 0." (get-text-property 0 prop text)) (defvar cfw:org-agenda-schedule-args nil "Default arguments for collecting agenda entries. If value is nil, `org-agenda-entry-types' is used.") (defvar cfw:org-icalendars nil "Org buffers for exporting icalendars. Setting a list of the custom agenda files, one can use the different agenda files from the default agenda ones.") (defvar cfw:org-overwrite-default-keybinding nil "Overwrites default keybinding. It needs restarting of Emacs(if not work) For example, ------------------------------------------------ key | function ------------------------------------------------ g | cfw:refresh-calendar-buffer j | cfw:org-goto-date k | org-capture x | cfw:org-clean-exit d | cfw:change-view-day v d | cfw:change-view-day v w | cfw:change-view-week v m | cfw:change-view-month ------------------------------------------------") (defvar cfw:org-face-agenda-item-foreground-color "Seagreen4" "Variable for org agenda item foreground color.") (defun cfw:org-collect-schedules-period (begin end) "[internal] Return org schedule items between BEGIN and END." (let ((org-agenda-prefix-format " ") (span 'day)) (setq org-agenda-buffer (when (buffer-live-p org-agenda-buffer) org-agenda-buffer)) (org-compile-prefix-format nil) (loop for date in (cfw:enumerate-days begin end) append (loop for file in (or cfw:org-icalendars (org-agenda-files nil 'ifmode)) append (progn (org-check-agenda-file file) (apply 'org-agenda-get-day-entries file date cfw:org-agenda-schedule-args)))))) (defun cfw:org-onclick () "Jump to the clicked org item." (interactive) (let ( (marker (get-text-property (point) 'org-marker)) (link (get-text-property (point) 'org-link)) (file (get-text-property (point) 'cfw:org-file)) (beg (get-text-property (point) 'cfw:org-h-beg)) (loc (get-text-property (point) 'cfw:org-loc))) (when link (org-open-link-from-string link)) (when (and marker (marker-buffer marker)) (org-mark-ring-push) (switch-to-buffer (marker-buffer marker)) (widen) (goto-char (marker-position marker)) (when (eq major-mode 'org-mode) (org-reveal))) (when beg (find-file file) (goto-char beg) (org-cycle)))) (defun cfw:org-jump-map () "Jump to the clicked org item." (interactive) (let ((loc (get-text-property (point) 'cfw:org-loc))) (when loc (google-maps loc)))) (defun cfw:org-clean-exit () "Close buffers opened by calfw-org before closing Calendar Framework." (interactive) (org-release-buffers org-agenda-new-buffers) (setq org-agenda-new-buffers nil) (bury-buffer)) (defvar cfw:org-text-keymap (let ((map (make-sparse-keymap))) (define-key map [mouse-1] 'cfw:org-onclick) (define-key map (kbd "RET") 'cfw:org-onclick) (define-key map (kbd "C-c C-o") 'cfw:org-onclick) (define-key map (kbd "m") 'cfw:org-jump-map) map) "key map on the calendar item text.") (defun cfw:org-extract-summary (org-item) "[internal] Remove some strings." (let* ((item org-item) (tags (cfw:org-tp item 'tags))) ;; (when (string-match cfw:org-todo-keywords-regexp item) ; dynamic bind ;; (setq item (replace-match "" nil nil item))) (if tags (when (string-match (concat "[\t ]*:+" (mapconcat 'identity tags ":+") ":+[\t ]*$") item) (setq item (replace-match "" nil nil item)))) (when (string-match "[0-9]\\{2\\}:[0-9]\\{2\\}\\(-[0-9]\\{2\\}:[0-9]\\{2\\}\\)?[\t ]+" item) (setq item (replace-match "" nil nil item))) (when (string-match "^ +" item) (setq item (replace-match "" nil nil item))) (when (= 0 (length item)) (setq item (cfw:org-tp org-item 'org-category))) item)) (defun cfw:org-summary-format (item) "Format an item. (How should be displayed?)" (let* ((time (cfw:org-tp item 'time)) (time-of-day (cfw:org-tp item 'time-of-day)) (time-str (and time-of-day (format "%02i:%02i " (/ time-of-day 100) (% time-of-day 100)))) (category (cfw:org-tp item 'org-category)) (tags (cfw:org-tp item 'tags)) (marker (cfw:org-tp item 'org-marker)) (buffer (and marker (marker-buffer marker))) (text (cfw:org-extract-summary item)) (props (cfw:extract-text-props item 'face 'keymap)) (extra (cfw:org-tp item 'extra))) (setq text (substring-no-properties text)) (when (string-match (concat "^" org-deadline-string ".*") extra) (add-text-properties 0 (length text) (list 'face (org-agenda-deadline-face 1.0)) text)) (if org-todo-keywords-for-agenda (when (string-match (concat "^[\t ]*\\<\\(" (mapconcat 'identity org-todo-keywords-for-agenda "\\|") "\\)\\>") text) (add-text-properties (match-beginning 1) (match-end 1) (list 'face (org-get-todo-face (match-string 1 text))) text))) ;;; ------------------------------------------------------------------------ ;;; act for org link ;;; ------------------------------------------------------------------------ (setq text (replace-regexp-in-string "%[0-9A-F]\\{2\\}" " " text)) (if (string-match org-bracket-link-regexp text) (let* ((desc (if (match-end 3) (org-match-string-no-properties 3 text))) (link (org-link-unescape (org-match-string-no-properties 1 text))) (help (concat "LINK: " link)) (link-props (list 'face 'org-link 'mouse-face 'highlight 'help-echo help 'org-link link))) (if desc (progn (setq desc (apply 'propertize desc link-props)) (setq text (replace-match desc nil nil text))) (setq link (apply 'propertize link link-props)) (setq text (replace-match link nil nil text))))) (when time-str (setq text (concat time-str text))) (propertize (apply 'propertize text props) ;; include org filename ;; (and buffer (concat " " (buffer-name buffer))) 'keymap cfw:org-text-keymap ;; Delete the display property, since displaying images will break our ;; table layout. 'display nil))) (defvar cfw:org-schedule-summary-transformer 'cfw:org-summary-format "Transformation function which transforms the org item string to calendar title. If this function splits into a list of string, the calfw displays those string in multi-lines.") (defun cfw:org-normalize-date (date) "Return a normalized date. (MM DD YYYY)." (cond ((numberp date) (calendar-gregorian-from-absolute date)) (t date))) (defun cfw:org-get-timerange (text) "Return a range object (begin end text). If TEXT does not have a range, return nil." (let* ((dotime (cfw:org-tp text 'dotime))) (and (stringp dotime) (string-match org-ts-regexp dotime) (let ((date-string (match-string 1 dotime)) (extra (cfw:org-tp text 'extra))) (if (string-match "(\\([0-9]+\\)/\\([0-9]+\\)): " extra) (let* ((cur-day (string-to-number (match-string 1 extra))) (total-days (string-to-number (match-string 2 extra))) (start-date (time-subtract (org-read-date nil t date-string) (seconds-to-time (* 3600 24 (- cur-day 1))))) (end-date (time-add (org-read-date nil t date-string) (seconds-to-time (* 3600 24 (- total-days cur-day)))))) (list (calendar-gregorian-from-absolute (time-to-days start-date)) (calendar-gregorian-from-absolute (time-to-days end-date)) text)) ))))) (defun cfw:org-schedule-period-to-calendar (begin end) "[internal] Return calfw calendar items between BEGIN and END from the org schedule data." (loop with cfw:org-todo-keywords-regexp = (regexp-opt org-todo-keywords-for-agenda) ; dynamic bind with contents = nil with periods = nil for i in (cfw:org-collect-schedules-period begin end) for date = (cfw:org-tp i 'date) for line = (funcall cfw:org-schedule-summary-transformer i) for range = (cfw:org-get-timerange line) if range do (unless (member range periods) (push range periods)) else do ; dotime is not present if this event was already added as a timerange (if (cfw:org-tp i 'dotime) (setq contents (cfw:contents-add (cfw:org-normalize-date date) line contents))) finally return (nconc contents (list (cons 'periods periods))))) (defun cfw:org-schedule-sorter (text1 text2) "[internal] Sorting algorithm for org schedule items. TEXT1 < TEXT2." (condition-case err (let ((time1 (cfw:org-tp text1 'time-of-day)) (time2 (cfw:org-tp text2 'time-of-day))) (cond ((and time1 time2) (< time1 time2)) (time1 t) ; time object is moved to upper (time2 nil) ; (t (string-lessp text1 text2)))) (error (string-lessp text1 text2)))) (defun cfw:org-schedule-sorter2 (text1 text2) "[internal] Sorting algorithm for org schedule items. TEXT1 < TEXT2. This function makes no-time items in front of timed-items." (condition-case err (let ((time1 (cfw:org-tp text1 'time-of-day)) (time2 (cfw:org-tp text2 'time-of-day))) (cond ((and time1 time2) (< time1 time2)) (time1 nil) ; time object is moved to upper (time2 t) ; (t (string-lessp text1 text2)))) (error (string-lessp text1 text2)))) (defun cfw:org-format-title (file h-obj t-obj h-beg loc) (propertize (concat (when (org-element-property :hour-start t-obj) (format "%02i:%02i " (org-element-property :hour-start t-obj) (org-element-property :minute-start t-obj))) (org-element-property :title h-obj)) 'keymap cfw:org-text-keymap 'display nil 'cfw:org-file file 'cfw:org-h-beg h-beg 'cfw:org-loc loc)) (defun cfw:org-format-date (t-obj lst) (mapcar (lambda (v) (org-element-property v t-obj)) lst)) (defun cfw:org-filter-datetime (t-obj lst) (if (car (cfw:org-format-date t-obj lst)) (cfw:org-format-date t-obj lst) nil)) (defun cfw:org-convert-event (file h-obj t-obj h-beg) (let ((sdate '(:month-start :day-start :year-start)) (stime '(:hour-start :minute-start)) (edate '(:month-end :day-end :year-end)) (etime '(:hour-end :minute-end)) (loc (org-element-property :LOCATION h-obj))) (make-cfw:event :start-date (cfw:org-format-date t-obj sdate) :start-time (cfw:org-filter-datetime t-obj stime) :end-date (cfw:org-filter-datetime t-obj edate) :end-time (cfw:org-filter-datetime t-obj etime) :title (cfw:org-format-title file h-obj t-obj h-beg loc) :location loc :description (if (org-element-property :contents-begin h-obj) (replace-regexp-in-string " *:PROPERTIES:\n \\(.*\\(?:\n.*\\)*?\\) :END:\n" "" (buffer-substring (org-element-property :contents-begin h-obj) (org-element-property :contents-end h-obj))) nil)))) (defun cfw:org-convert-org-to-calfw (file) (save-excursion (with-current-buffer (find-file-noselect file) (let* ((elem-obj (org-element-parse-buffer)) (pos-lst `( ,@(org-element-map elem-obj 'timestamp (lambda (hl) (org-element-property :begin hl) )) ,@(org-element-map (org-element-map elem-obj 'headline (lambda (hl) (org-element-property :deadline hl) ) ) 'timestamp (lambda (hl) (org-element-property :begin hl) )) ,@(org-element-map (org-element-map elem-obj 'headline (lambda (hl) (org-element-property :scheduled hl) ) ) 'timestamp (lambda (hl) (org-element-property :begin hl) ))))) (loop for pos in pos-lst do (goto-char pos) for t-obj = (org-element-timestamp-parser) for h-obj = (progn (org-back-to-heading t) (org-element-headline-parser (point-max) t)) for h-beg = (point) for event = (cfw:org-convert-event file h-obj t-obj h-beg) for ts-type = (org-element-property :type t-obj) if (eq 'active-range ts-type) collect event into periods else if (eq 'active ts-type) collect event into contents ;; else do ;; (message "calfw-org: Cannot handle event") finally (kill-buffer (get-file-buffer file)) (return `((periods ,periods) ,@contents))))))) (defun cfw:org-to-calendar (file begin end) (loop for event in (cfw:org-convert-org-to-calfw file) if (and (listp event) (equal 'periods (car event))) collect (cons 'periods (loop for evt in (cadr event) if (and (cfw:date-less-equal-p begin (cfw:event-end-date evt)) (cfw:date-less-equal-p (cfw:event-start-date evt) end)) collect evt)) else if (cfw:date-between begin end (cfw:event-start-date event)) collect event)) (defun cfw:org-create-file-source (name file color) "Create org-element based source. " (lexical-let ((file file)) (make-cfw:source :name (concat "Org:" name) :color color :data (lambda (begin end) (cfw:org-to-calendar file begin end))))) (defun cfw:org-capture-day () (with-current-buffer (get-buffer-create cfw:calendar-buffer-name) (let ((pos (cfw:cursor-to-nearest-date))) (concat "<" (format-time-string "%Y-%m-%d %a" (encode-time 0 0 0 (calendar-extract-day pos) (calendar-extract-month pos) (calendar-extract-year pos))) ">")))) (when cfw:org-capture-template (setq org-capture-templates (append org-capture-templates (list cfw:org-capture-template)))) (defun cfw:org-capture () "Open org-agenda buffer on the selected date." (interactive) (if cfw:org-capture-template (org-capture nil (car cfw:org-capture-template)) (message "cfw:org-capture-template is not set yet."))) (defun cfw:org-open-agenda-day () "Open org-agenda buffer on the selected date." (interactive) (let ((date (cfw:cursor-to-nearest-date))) (when date (org-agenda-list nil (calendar-absolute-from-gregorian date) 'day)))) (define-key cfw:calendar-mode-map "c" 'cfw:org-capture) (defvar cfw:org-schedule-map (cfw:define-keymap '( ("q" . bury-buffer) ("SPC" . cfw:org-open-agenda-day) )) "Key map for the calendar buffer.") (defvar cfw:org-custom-map (cfw:define-keymap '( ("g" . cfw:refresh-calendar-buffer) ("j" . cfw:org-goto-date) ("k" . org-capture) ("q" . bury-buffer) ("d" . cfw:change-view-day) ("v d" . cfw:change-view-day) ("v w" . cfw:change-view-week) ("v m" . cfw:change-view-month) ("x" . cfw:org-clean-exit) ("SPC" . cfw:org-open-agenda-day) )) "Key map for the calendar buffer.") (defun cfw:org-create-source (&optional color) "Create org-agenda source." (make-cfw:source :name "org-agenda" :color (or color cfw:org-face-agenda-item-foreground-color) :data 'cfw:org-schedule-period-to-calendar)) (defun cfw:open-org-calendar () "Open an org schedule calendar in the new buffer." (interactive) (save-excursion (let* ((source1 (cfw:org-create-source)) (curr-keymap (if cfw:org-overwrite-default-keybinding cfw:org-custom-map cfw:org-schedule-map)) (cp (cfw:create-calendar-component-buffer :view 'month :contents-sources (list source1) :custom-map curr-keymap :sorter 'cfw:org-schedule-sorter))) (switch-to-buffer (cfw:cp-get-buffer cp)) (when (not org-todo-keywords-for-agenda) (message "Warn : open org-agenda buffer first."))))) (defun cfw:org-from-calendar () "Do something. This command should be executed on the calfw calendar." (interactive) (let* ((mdy (cfw:cursor-to-nearest-date)) (m (calendar-extract-month mdy)) (d (calendar-extract-day mdy)) (y (calendar-extract-year mdy))) ;; exec org-remember here? )) (defun cfw:org-read-date-command () "Move the cursor to the specified date." (interactive) (cfw:emacs-to-calendar (org-read-date nil 'to-time))) (defun cfw:org-goto-date () "Move the cursor to the specified date." (interactive) (cfw:navi-goto-date (cfw:org-read-date-command))) ;; (progn (eval-current-buffer) (cfw:open-org-calendar)) ;; (setq org-agenda-files '("./org-samples/complex.org")) (provide 'calfw-org) ;;; calfw-org.el ends here emacs-calfw-master/calfw.el000066400000000000000000003373421266572412200161720ustar00rootroot00000000000000;;; calfw.el --- Calendar view framework on Emacs ;; Copyright (C) 2011,2012,2013,2014,2015 SAKURAI Masashi ;; Author: SAKURAI Masashi ;; Version: 1.5 ;; Package-Requires: ((google-maps "20130412.230")) ;; Keywords: calendar ;; URL: https://github.com/kiwanami/emacs-calfw ;; This program is free software; you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by ;; the Free Software Foundation, either version 3 of the License, or ;; (at your option) any later version. ;; This program is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;; GNU General Public License for more details. ;; You should have received a copy of the GNU General Public License ;; along with this program. If not, see . ;;; Commentary: ;; This program is a framework for the Calendar component. In the ;; Emacs, uses can show schedules in the calendar views, like iCal, ;; Outlook and Google Calendar. ;;; Installation: ;; Place this program in your load path and add following code. ;; (require 'calfw) ;;; Usage: ;; Executing the command `cfw:open-calendar-buffer', switch to the calendar buffer. ;; You can navigate the date like calendar.el. ;; Schedule data which are shown in the calendar view, are collected ;; by the `cfw:source' objects. See the function `cfw:open-debug-calendar' for example. ;; This program gets the holidays using the function ;; `calendar-holiday-list'. See the document of the holidays.el and ;; the Info text for customizing the holidays. ;;; Add-ons: ;; - calfw-howm.el : Display howm schedules. ;; - calfw-ical.el : Display schedules of the iCalendar format. ;; - calfw-org.el : Display orgmode schedules. ;; - calfw-cal.el : Display emacs diary schedules. ;;; Code: (require 'cl) (require 'calendar) (require 'holidays) ;;; Constants (defconst cfw:week-sunday 0) (defconst cfw:week-monday 1) (defconst cfw:week-tuesday 2) (defconst cfw:week-wednesday 3) (defconst cfw:week-thursday 4) (defconst cfw:week-friday 5) (defconst cfw:week-saturday 6) (defconst cfw:week-days 7) ;;; Customs (defcustom cfw:fchar-vertical-line ?| "The character used for drawing vertical lines." :group 'cfw :type 'character) (defcustom cfw:fchar-horizontal-line ?- "The character used for drawing horizontal lines." :group 'cfw :type 'character) (defcustom cfw:fchar-junction ?+ "The character used for drawing junction lines." :group 'cfw :type 'character) (defcustom cfw:fchar-top-right-corner ?+ "The character used for drawing the top-right corner." :group 'cfw :type 'character) (defcustom cfw:fchar-top-left-corner ?+ "The character used for drawing the top-left corner." :group 'cfw :type 'character) (defcustom cfw:fchar-left-junction ?+ "The character used for drawing junction lines at the left side." :group 'cfw :type 'character) (defcustom cfw:fchar-right-junction ?+ "The character used for drawing junction lines at the right side." :group 'cfw :type 'character) (defcustom cfw:fchar-top-junction ?+ "The character used for drawing junction lines at the top side." :group 'cfw :type 'character) (defcustom cfw:fstring-period-start "(" "The string used to indicate the beginning of a period." :group 'cfw :type 'string) (defcustom cfw:fstring-period-end ")" "The string used to indicate the end of a period." :group 'cfw :type 'string) (defcustom cfw:read-date-command 'cfw:read-date-command-simple "The command used to read the date in `cfw:navi-goto-date-command', for example `cfw:read-date-command-simple' or `cfw:org-read-date-command'." :group 'cfw :type 'function) (defcustom cfw:event-format-overview "%t" "Format string of `cfw:event's for overviews (month-, 2-week-, week-view). See `cfw:event-format' for possible values." :group 'cfw :type 'string) (defcustom cfw:event-format-days-overview "%s%e%t" "Format string of `cfw:event's for days overviews. See `cfw:event-format' for possible values." :group 'cfw :type 'string) (defcustom cfw:event-format-period-overview "%t%l" "Format string of `cfw:event's for period overviews. See `cfw:event-format' for possible values." :group 'cfw :type 'string) (defcustom cfw:event-format-detail "%s%e%t%l%d" "Format string of `cfw:event's for overviews (month-, week-, day-view). See `cfw:event-format' for possible values." :group 'cfw :type 'string) (defcustom cfw:event-format-title "%s" "Format string for the title of a `cfw:event' %s = title string" :group 'cfw :type 'string) (defcustom cfw:event-format-start-date "%Y-%m-%d" "Format string for the start date of a `cfw:event' %Y = year %m = month %d = day" :group 'cfw :type 'string) (defcustom cfw:event-format-start-time "%H:%M " "Format string for the start time of a `cfw:event' %H = hours %M = minutes" :group 'cfw :type 'string) (defcustom cfw:event-format-end-date "%Y-%m-%d" "Format string for the end date of a `cfw:event' %Y = year %m = month %d = day" :group 'cfw :type 'string) (defcustom cfw:event-format-end-time "- %H:%M " "Format string for the end time of a `cfw:event' %H = hours %M = minutes" :group 'cfw :type 'string) (defcustom cfw:event-format-location "\n Location: %s" "Format string for the location of a `cfw:event' %s = location string" :group 'cfw :type 'string) (defcustom cfw:event-format-description "\n\n%s\n--------------------\n" "Format string for the description of a `cfw:event' %s = location string" :group 'cfw :type 'string) (defcustom cfw:display-calendar-holidays t "If not-nil, calfw displays holidays." :group 'cfw :type 'boolean) ;;; Faces (defface cfw:face-title '((((class color) (background light)) :foreground "DarkGrey" :weight bold :height 2.0 :inherit variable-pitch) (((class color) (background dark)) :foreground "darkgoldenrod3" :weight bold :height 2.0 :inherit variable-pitch) (t :height 1.5 :weight bold :inherit variable-pitch)) "Face for title" :group 'calfw) (defface cfw:face-header '((((class color) (background light)) :foreground "Slategray4" :background "Gray90" :weight bold) (((class color) (background dark)) :foreground "maroon2" :weight bold)) "Face for headers" :group 'calfw) (defface cfw:face-sunday '((((class color) (background light)) :foreground "red2" :background "#ffd5e5" :weight bold) (((class color) (background dark)) :foreground "red" :weight bold)) "Face for Sunday" :group 'calfw) (defface cfw:face-saturday '((((class color) (background light)) :foreground "Blue" :background "#d4e5ff" :weight bold) (((class color) (background light)) :foreground "Blue" :weight bold)) "Face for Saturday" :group 'calfw) (defface cfw:face-holiday '((((class color) (background light)) :background "#ffd5e5") (((class color) (background dark)) :background "grey10" :foreground "purple" :weight bold)) "Face for holidays" :group 'calfw) (defface cfw:face-grid '((((class color) (background light)) :foreground "SlateBlue") (((class color) (background dark)) :foreground "DarkGrey")) "Face for grids" :group 'calfw) (defface cfw:face-default-content '((((class color) (background light)) :foreground "#2952a3") (((class color) (background dark)) :foreground "green2")) "Face for default contents" :group 'calfw) (defface cfw:face-periods '((((class color) (background light)) :background "#668cd9" :foreground "White" :slant italic) (((class color) (background dark)) :foreground "cyan")) "Face for period" :group 'calfw) (defface cfw:face-day-title '((((class color) (background light)) :background "#f8f9ff") (((class color) (background dark)) :background "grey10")) "Face for day title" :group 'calfw) (defface cfw:face-default-day '((((class color) (background light)) :weight bold :inherit cfw:face-day-title) (((class color) (background dark)) :weight bold :inherit cfw:face-day-title)) "Face for default day" :group 'calfw) (defface cfw:face-annotation '((((class color)) :foreground "RosyBrown" :inherit cfw:face-day-title)) "Face for annotations" :group 'calfw) (defface cfw:face-disable '((((class color)) :foreground "DarkGray" :inherit cfw:face-day-title)) "Face for days out of focused period" :group 'calfw) (defface cfw:face-today-title '((((class color) (background light)) :background "#fad163") (((class color) (background dark)) :background "red4" :weight bold)) "Face for today" :group 'calfw) (defface cfw:face-today '((((class color) (background light)) :background "#fff7d7") (((class color) (background dark)) :foreground "Cyan" :weight bold)) "Face for today" :group 'calfw) (defface cfw:face-select '((((class color) (background light)) :background "#c3c9f8") (((class color) (background dark)) :background "Blue4")) "Face for selection" :group 'calfw) (defvar cfw:face-item-separator-color "SlateBlue" "Color for the separator line of items in a day.") ;;; Utilities (defun cfw:k (key alist) "[internal] Get a content by key from the given alist." (cdr (assq key alist))) (defun cfw:sym (&rest strings) "[internal] concatenate `strings' and return as symbol." (intern-soft (apply 'concat strings))) (defun cfw:rt (text face) "[internal] Put a face to the given text." (unless (stringp text) (setq text (format "%s" (or text "")))) (put-text-property 0 (length text) 'face face text) (put-text-property 0 (length text) 'font-lock-face face text) text) (defun cfw:tp (text prop value) "[internal] Put a text property to the entire text string." (unless (stringp text) (setq text (format "%s" text))) (when (< 0 (length text)) (put-text-property 0 (length text) prop value text)) text) (defun cfw:extract-text-props (text &rest excludes) "[internal] Return text properties." (loop with ret = nil with props = (text-properties-at 0 text) for name = (car props) for val = (cadr props) while props do (when (and name (not (memq name excludes))) (setq ret (cons name (cons val ret)))) (setq props (cddr props)) finally return ret)) (defun cfw:define-keymap (keymap-list) "[internal] Key map definition utility. KEYMAP-LIST is a source list like ((key . command) ... )." (let ((map (make-sparse-keymap))) (mapc (lambda (i) (define-key map (if (stringp (car i)) (read-kbd-macro (car i)) (car i)) (cdr i))) keymap-list) map)) (defun cfw:trim (str) "[internal] Trim the space char-actors." (if (string-match "^[ \t\n\r]*\\(.*?\\)[ \t\n\r]*$" str) (match-string 1 str) str)) (defun cfw:flatten (lst &optional revp) (loop with ret = nil for i in lst do (setq ret (if (consp i) (nconc (cfw:flatten i t) ret) (cons i ret))) finally return (if revp ret (nreverse ret)))) ;;; Date Time Transformation (defun cfw:date (month day year) "Construct a date object in the calendar format." (and month day year (list month day year))) (defun cfw:time (hours minutes) "Construct a date object in the calendar format." (and hours minutes (list hours minutes))) (defun cfw:emacs-to-calendar (time) "Transform an emacs time format to a calendar one." (let ((dt (decode-time time))) (list (nth 4 dt) (nth 3 dt) (nth 5 dt)))) (defun cfw:calendar-to-emacs (date) "Transform a calendar time format to an emacs one." (encode-time 0 0 0 (calendar-extract-day date) (calendar-extract-month date) (calendar-extract-year date))) (defun cfw:month-year-equal-p (date1 date2) "Return `t' if numbers of month and year of DATE1 is equals to ones of DATE2. Otherwise is `nil'." (and (= (calendar-extract-month date1) (calendar-extract-month date2)) (= (calendar-extract-year date1) (calendar-extract-year date2)))) (defun cfw:date-less-equal-p (d1 d2) "Return `t' if date value D1 is less than or equals to date value D2." (let ((ed1 (cfw:calendar-to-emacs d1)) (ed2 (cfw:calendar-to-emacs d2))) (or (equal ed1 ed2) (time-less-p ed1 ed2)))) (defun cfw:date-between (begin end date) "Return `t' if date value DATE exists between BEGIN and END." (and (cfw:date-less-equal-p begin date) (cfw:date-less-equal-p date end))) (defun cfw:month-year-contain-p (month year date2) "Return `t' if date value DATE2 is included in MONTH and YEAR." (and (= month (calendar-extract-month date2)) (= year (calendar-extract-year date2)))) (defun cfw:date-after (date num) "Return the date after NUM days from DATE." (calendar-gregorian-from-absolute (+ (calendar-absolute-from-gregorian date) num))) (defun cfw:strtime-emacs (time) "Format emacs time value TIME to the string form YYYY/MM/DD." (format-time-string "%Y/%m/%d" time)) (defun cfw:strtime (date) "Format calendar date value DATE to the string form YYYY/MM/DD." (cfw:strtime-emacs (cfw:calendar-to-emacs date))) (defun cfw:parsetime-emacs (str) "Transform the string format YYYY/MM/DD to an emacs time value." (when (string-match "\\([0-9]+\\)\\/\\([0-9]+\\)\\/\\([0-9]+\\)" str) (apply 'encode-time (let (ret) (dotimes (i 6) (push (string-to-number (or (match-string (+ i 1) str) "0")) ret)) ret)))) (defun cfw:parse-str-time (str) "Parsese a time string of the format HH:MM to an internal format." (when (string-match "\\([[:digit:]]\\{2\\}\\):\\([[:digit:]]\\{2\\}\\)" str) (cfw:time (string-to-number (match-string 1 str)) (string-to-number (match-string 2 str))))) (defun cfw:parsetime (str) "Transform the string format YYYY/MM/DD to a calendar date value." (cfw:emacs-to-calendar (cfw:parsetime-emacs str))) (defun cfw:read-date-command-simple (string-date) "Move the cursor to the specified date." (interactive "sInput Date (YYYY/MM/DD): ") (cfw:parsetime string-date)) (defun cfw:days-diff (begin end) "Returns the number of days between `begin' and `end'." (- (time-to-days (cfw:calendar-to-emacs end)) (time-to-days (cfw:calendar-to-emacs begin)))) (defun cfw:enumerate-days (begin end) "Enumerate date objects between BEGIN and END." (when (> (calendar-absolute-from-gregorian begin) (calendar-absolute-from-gregorian end)) (error "Invalid period : %S - %S" begin end)) (let ((d begin) ret (cont t)) (while cont (push (copy-sequence d) ret) (setq cont (not (equal d end))) (setq d (cfw:date-after d 1))) (nreverse ret))) (defun cfw:week-begin-date (date) "Return date of beginning of the week in which DATE is." (let ((num (- calendar-week-start-day (calendar-day-of-week date)))) (cfw:date-after date (if (< 0 num) (- num cfw:week-days) num)))) (defun cfw:week-end-date (date) "Return date of end of the week in which DATE is." (let ((num (+ (- calendar-week-start-day 1) (- cfw:week-days (calendar-day-of-week date))))) (cfw:date-after date (cond ((> 0 num) (+ num cfw:week-days)) ((<= cfw:week-days num) (- num cfw:week-days)) (t num))))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Component ;; This structure defines attributes of the calendar component. ;; These attributes are internal use. Other programs should access ;; through the functions of the component interface. ;; [cfw:component] ;; dest : an object of `cfw:dest' ;; model : an object of the calendar model ;; selected : selected date ;; view : a symbol of view type (month, week, two-weeks, ...) ;; update-hooks : a list of hook functions for update event ;; selectoin-change-hooks : a list of hook functions for selection change event ;; click-hooks : a list of hook functions for click event (defstruct cfw:component dest model selected view update-hooks selection-change-hooks click-hooks) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Data Source ;; This structure defines data sources of the calendar. ;; [cfw:source] ;; name : data source title ;; data : a function that generates an alist of date-contents ;; update : a function that is called when the user needs to update the contents (optional) ;; color : foreground color for normal items (optional) ;; period-fgcolor : foreground color for period items (optional) ;; period-bgcolor : background color for period items (optional) ;; opt-face : a plist of additional face properties for normal items (optional) ;; opt-period-face : a plist of additional face properties for period items (optional) ;; ;; If `period-bgcolor' is nil, the value of `color' is used. ;; If `period-fgcolor' is nil, the black or white (negative color of `period-bgcolor') is used. (defstruct cfw:source name data update color period-bgcolor period-fgcolor opt-face opt-period-face) (defun cfw:source-period-bgcolor-get (source) "[internal] Return a background color for period items. If `cfw:source-period-bgcolor' is nil, the value of `cfw:source-color' is used." (or (cfw:source-period-bgcolor source) (let ((c (cfw:source-color source))) (when c (setf (cfw:source-period-bgcolor source) c)) c))) (defun cfw:source-period-fgcolor-get (source) "[internal] Return a foreground color for period items. If `cfw:source-period-fgcolor' is nil, the black or white (negative color of `cfw:source-period-bgcolor') is used." (or (cfw:source-period-fgcolor source) (let ((c (destructuring-bind (r g b) (color-values (or (cfw:source-period-bgcolor-get source) "black")) (if (< 147500 (+ r g b)) "black" "white")))) ; (* 65536 3 0.75) (setf (cfw:source-period-fgcolor source) c) c))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Calendar event ;; This structure defines calendar events. (defstruct cfw:event title ; event title [string] start-date ; start date of the event [cfw:date] start-time ; start time of the event (optional) end-date ; end date of the event [cfw:date] (optional) end-time ; end of the event (optional) description ; event description [string] (optional) location ; location [strting] (optional) source ; [internal] source of the event ) (defun cfw:event-overview (event) "Function that extracts the overview string from a`cfw:event'." (cfw:event-format event cfw:event-format-overview)) (defun cfw:event-days-overview (event) "Function that extracts the days overview string from a`cfw:event'." (cfw:event-format event cfw:event-format-days-overview)) (defun cfw:event-period-overview (event) "Function that extracts the period overview string from a`cfw:event'." (cfw:event-format event cfw:event-format-period-overview)) (defun cfw:event-detail (event) "Function that extracts the details string from a`cfw:event'." (cfw:event-format event cfw:event-format-detail)) (defun cfw:event-format-field-string (string) "[internal] Used by `cfw:event-format-field' to format string values." `((?s . ,string))) (defun cfw:event-format-field-time (time) "[internal] Used by `cfw:event-format-field' to format time values." `((?H . ,(cfw:event-format-field-number (car time) 2)) (?M . ,(cfw:event-format-field-number (cadr time) 2)))) (defun cfw:event-format-field-date (date) "[internal] Used by `cfw:event-format-field' to format date values." `((?Y . ,(cfw:event-format-field-number (caddr date) 4)) (?m . ,(cfw:event-format-field-number (car date) 2)) (?d . ,(cfw:event-format-field-number (cadr date) 2)))) (defun cfw:event-format-field-number (num width) "[internal] Like `number-to-string', but with width specifier. Padded with zeros." (format (concat "%0" (number-to-string width) "d") num)) (defun cfw:event-format-field (event field args-fun) "[internal] format `field' of the `cfw:event' `event' according to the string specified in cfw:event-format-`field'." (let* ((s-name (symbol-name field)) (format-string (symbol-value (cfw:sym "cfw:event-format-" s-name))) (field-val (funcall (cfw:sym "cfw:event-" s-name) event))) (if field-val (format-spec format-string (funcall args-fun field-val)) ""))) (defun cfw:event-format (event format-string) "Format the `cfw:event' `event' according to `format-string'. The following values are possible: %t = title %S = start date %s = start time %E = end date %e = end time %l = Location %d = Description" (cfw:tp (format-spec format-string (mapcar #'(lambda (field) `(,(car field) . ,(cfw:event-format-field event (cadr field) (caddr field)))) '((?t title cfw:event-format-field-string) (?S start-date cfw:event-format-field-date) (?s start-time cfw:event-format-field-time) (?E end-date cfw:event-format-field-date) (?e end-time cfw:event-format-field-time) (?l location cfw:event-format-field-string) (?d description cfw:event-format-field-string)))) 'cfw:source (cfw:event-source event))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Rendering Destination ;; This structure object is the abstraction of the rendering ;; destinations, such as buffers, regions and so on. ;; [cfw:dest] ;; type : identify symbol for destination type. (buffer, region, text) ;; buffer : a buffer object of rendering destination. ;; min-func : a function that returns upper limit of rendering destination. ;; max-func : a function that returns lower limit of rendering destination. ;; width : width of the reference size. ;; height : height of the reference size. ;; clear-func : a function that clears the rendering destination. ;; before-update-func : a function that is called at the beginning of rendering routine. ;; after-update-func : a function that is called at the end of rendering routine. ;; select-ol : a list of overlays for selection ;; today-ol : a list of overlays for today (defstruct cfw:dest type buffer min-func max-func width height clear-func before-update-func after-update-func select-ol today-ol) ;; shortcut functions (eval-when-compile (defmacro cfw:dest-with-region (dest &rest body) (let (($dest (gensym))) `(let ((,$dest ,dest)) (with-current-buffer (cfw:dest-buffer ,$dest) (save-restriction (narrow-to-region (cfw:dest-point-min ,$dest) (cfw:dest-point-max ,$dest)) ,@body)))))) (put 'cfw:dest-with-region 'lisp-indent-function 1) (defun cfw:dest-point-min (c) (funcall (cfw:dest-min-func c))) (defun cfw:dest-point-max (c) (funcall (cfw:dest-max-func c))) (defun cfw:dest-clear (c) (funcall (cfw:dest-clear-func c))) (defun cfw:dest-before-update (c) (when (cfw:dest-before-update-func c) (funcall (cfw:dest-before-update-func c)))) (defun cfw:dest-after-update (c) (when (cfw:dest-after-update-func c) (funcall (cfw:dest-after-update-func c)))) ;; private functions (defun cfw:dest-ol-selection-clear (dest) "[internal] Clear the selection overlays on the current calendar view." (loop for i in (cfw:dest-select-ol dest) do (delete-overlay i)) (setf (cfw:dest-select-ol dest) nil)) (defun cfw:dest-ol-selection-set (dest date) "[internal] Put a selection overlay on DATE. The selection overlay can be put on some days, calling this function many times. If DATE is not included on the current calendar view, do nothing. This function does not manage the selections, just put the overlay." (lexical-let (ols) (cfw:dest-with-region dest (cfw:find-all-by-date dest date (lambda (begin end) (let ((overlay (make-overlay begin end))) (overlay-put overlay 'face (if (eq 'cfw:face-day-title (get-text-property begin 'face)) 'cfw:face-select)) (push overlay ols))))) (setf (cfw:dest-select-ol dest) ols))) (defun cfw:dest-ol-today-clear (dest) "[internal] Clear decoration overlays." (loop for i in (cfw:dest-today-ol dest) do (delete-overlay i)) (setf (cfw:dest-today-ol dest) nil)) (defun cfw:dest-ol-today-set (dest) "[internal] Put a highlight face on today." (lexical-let (ols) (cfw:dest-with-region dest (cfw:find-all-by-date dest (calendar-current-date) (lambda (begin end) (let ((overlay (make-overlay begin end))) (overlay-put overlay 'face (if (eq 'cfw:face-day-title (get-text-property begin 'face)) 'cfw:face-today-title 'cfw:face-today)) (push overlay ols))))) (setf (cfw:dest-today-ol dest) ols))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Low level API ;; Buffer (defconst cfw:calendar-buffer-name "*cfw-calendar*" "[internal] Default buffer name for the calendar view.") (defun cfw:dest-init-buffer (&optional buf width height custom-map) "Create a buffer destination. This destination uses an entire buffer and set up the major-mode `cfw:calendar-mode' and the key map `cfw:calendar-mode-map'. BUF is a buffer name to render the calendar view. If BUF is nil, the default buffer name `cfw:calendar-buffer-name' is used. WIDTH and HEIGHT are reference size of the calendar view. If those are nil, the size of calendar is calculated from the window that shows BUF or the selected window. The component object is stored at the buffer local variable `cfw:component'. CUSTOM-MAP is the additional keymap that is added to default keymap `cfw:calendar-mode-map'." (lexical-let ((buffer (or buf (get-buffer-create cfw:calendar-buffer-name))) (window (or (and buf (get-buffer-window buf)) (selected-window))) dest) (setq dest (make-cfw:dest :type 'buffer :min-func 'point-min :max-func 'point-max :buffer buffer :width (or width (window-width window)) :height (or height (window-height window)) :clear-func (lambda () (with-current-buffer buffer (erase-buffer))))) (with-current-buffer buffer (unless (eq major-mode 'cfw:calendar-mode) (cfw:calendar-mode custom-map))) dest)) ;; Region (defun cfw:dest-init-region (buf mark-begin mark-end &optional width height) "Create a region destination. The calendar is drew between MARK-BEGIN and MARK-END in the buffer BUF. MARK-BEGIN and MARK-END are separated by more than one character, such as a space. This destination is employed to be embedded in the some application buffer. Because this destination does not set up any modes and key maps for the buffer, the application that uses the calfw is responsible to manage the buffer and key maps." (lexical-let ((mark-begin mark-begin) (mark-end mark-end) (window (or (get-buffer-window buf) (selected-window)))) (make-cfw:dest :type 'region :min-func (lambda () (marker-position mark-begin)) :max-func (lambda () (marker-position mark-end)) :buffer buf :width (or width (window-width window)) :height (or height (window-height window)) :clear-func (lambda () (cfw:dest-region-clear (marker-position mark-begin) (marker-position mark-end))) ))) (defun cfw:dest-region-clear (begin end) "[internal] Clear the content text." (when (< 2 (- end begin)) (delete-region begin (1- end))) (goto-char begin)) ;; Inline text (defconst cfw:dest-background-buffer " *cfw:dest-background*") (defun cfw:dest-init-inline (width height) "Create a text destination." (lexical-let ((buffer (get-buffer-create cfw:dest-background-buffer)) (window (selected-window)) dest) (setq dest (make-cfw:dest :type 'text :min-func 'point-min :max-func 'point-max :buffer buffer :width (or width (window-width window)) :height (or height (window-height window)) :clear-func (lambda () (with-current-buffer buffer (erase-buffer))))) dest)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Component API ;; Create (defun cfw:cp-new (dest model view &optional selected-date) "[internal] Create a new component object. DEST is a cfw:dest object. MODEL is a model object. VIEW is a symbol of the view type: month, two-weeks, week and day. SELECTED-DATE is a selected date initially. This function is called by the initialization functions, `cfw:create-calendar-component-buffer', `cfw:create-calendar-component-region' and `cfw:get-calendar-text'." (let ((cp (make-cfw:component :dest dest :model model :view (or view 'month) :selected (or selected-date (calendar-current-date))))) (cfw:cp-update cp) cp)) ;; Getting the component instance (defun cfw:cp-get-component () "Return the component object on the current cursor position. Firstly, getting a text property `cfw:component' on the current position. If no object is found in the text property, the buffer local variable `cfw:component' is tried to get. If no object is found at the variable, return nil." (let ((component (get-text-property (point) 'cfw:component))) (unless component (unless (local-variable-p 'cfw:component (current-buffer)) (error "Not found cfw:component attribute...")) (setq component (buffer-local-value 'cfw:component (current-buffer)))) component)) ;; Getter (defun cfw:cp-get-selected-date (component) "Return the selected date of the component." (cfw:component-selected component)) (defun cfw:cp-get-contents-sources (component) "Return a list of the content sources." (cfw:model-get-contents-sources (cfw:component-model component))) (defun cfw:cp-get-annotation-sources (component) "Return a list of the annotation sources." (cfw:model-get-annotation-sources (cfw:component-model component))) (defun cfw:cp-get-view (component) "Return a symbol of the current view type." (cfw:component-view component)) (defun cfw:cp-get-buffer (component) "Return a buffer object on which the component draws the content." (cfw:dest-buffer (cfw:component-dest component))) (defun cfw:cp-displayed-date-p (component date) "If the date is displayed in the current view, return `t'. Otherwise return `nil'." (let* ((model (cfw:component-model component)) (begin (cfw:k 'begin-date model)) (end (cfw:k 'end-date model))) (unless (and begin end) (error "Wrong model : %S" model)) (cfw:date-between begin end date))) ;; Setter (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) (unless (eql (selected-window) (get-buffer-window (current-buffer))) (set-window-point (get-buffer-window (current-buffer)) pos))))) (defun cfw:cp-set-selected-date (component date) "Select the date on the component. If the current view doesn't contain the date, this function updates the view to display the date." (let ((last (cfw:component-selected component)) (dest (cfw:component-dest component)) (model (cfw:component-model component))) (cond ((cfw:cp-displayed-date-p component date) (setf (cfw:component-selected component) date) (cfw:dest-before-update dest) (cfw:dest-ol-selection-clear dest) (cfw:dest-ol-selection-set dest date) (cfw:dest-after-update dest) (cfw:cp-move-cursor dest date) (unless (equal last date) (cfw:cp-fire-selection-change-hooks component))) (t (cfw:model-set-init-date date model) (setf (cfw:component-selected component) date) (cfw:cp-update component) (cfw:cp-fire-selection-change-hooks component) ;; Because this function will be called from cfw:cp-update, do nothing here. )))) (defun cfw:cp-set-contents-sources (component sources) "Set content sources for the component. SOURCES is a list of content sources." (cfw:model-set-contents-sources (cfw:component-model component) sources)) (defun cfw:cp-set-annotation-sources (component sources) "Set annotation sources for the component. SOURCES is a list of annotation sources." (cfw:model-set-annotation-sources sources (cfw:component-model component))) (defun cfw:cp-set-view (component view) "Change the view type of the component and re-draw the content. VIEW is a symbol of the view type." (setf (cfw:component-view component) view) (cfw:cp-update component)) (defun cfw:cp-resize (component width height) "Resize the component size and re-draw the content." (let* ((dest (cfw:component-dest component)) (buf (cfw:dest-buffer dest)) (window (or (and buf (get-buffer-window buf)) (selected-window)))) (setf (cfw:dest-width dest) (or width (window-width window)) (cfw:dest-height dest) (or height (window-height window)))) (cfw:cp-update component)) ;; Hook (defun cfw:cp-add-update-hook (component hook) "Add the update hook function to the component. HOOK is a function that has no argument." (push hook (cfw:component-update-hooks component))) (defun cfw:cp-add-selection-change-hook (component hook) "Add the selection change hook function to the component. HOOK is a function that has no argument." (push hook (cfw:component-selection-change-hooks component))) (defun cfw:cp-add-click-hook (component hook) "Add the click hook function to the component. HOOK is a function that has no argument." (push hook (cfw:component-click-hooks component))) ;;; private methods (defun cfw:cp-dispatch-view-impl (view) "[internal] Return a view function which is corresponding to the view symbol. VIEW is a symbol of the view type." (cond ((eq 'month view) 'cfw:view-month) ((eq 'week view) 'cfw:view-week) ((eq 'two-weeks view) 'cfw:view-two-weeks) ((eq 'day view) 'cfw:view-day) (t (error "Not found such view : %s" view)))) (defun cfw:cp-update (component) "[internal] Clear and re-draw the component content." (let* ((buf (cfw:cp-get-buffer component)) (dest (cfw:component-dest component))) (with-current-buffer buf (cfw:dest-before-update dest) (cfw:dest-ol-selection-clear dest) (cfw:dest-ol-today-clear dest) (let ((buffer-read-only nil)) (cfw:dest-with-region dest (cfw:dest-clear dest) (funcall (cfw:cp-dispatch-view-impl (cfw:component-view component)) component))) (cfw:dest-ol-today-set dest) (cfw:cp-set-selected-date component (cfw:component-selected component)) (cfw:dest-after-update dest) (cfw:cp-fire-update-hooks component)))) (defun cfw:cp-fire-click-hooks (component) "[internal] Call click hook functions of the component with no arguments." (loop for f in (cfw:component-click-hooks component) do (condition-case err (funcall f) (nil (message "Calfw: Click / Hook error %S [%s]" f err))))) (defun cfw:cp-fire-selection-change-hooks (component) "[internal] Call selection change hook functions of the component with no arguments." (loop for f in (cfw:component-selection-change-hooks component) do (condition-case err (funcall f) (nil (message "Calfw: Selection change / Hook error %S [%s]" f err))))) (defun cfw:cp-fire-update-hooks (component) "[internal] Call update hook functions of the component with no arguments." (loop for f in (cfw:component-update-hooks component) do (condition-case err (funcall f) (nil (message "Calfw: Update / Hook error %S [%s]" f err))))) ;;; Models (defun cfw:model-abstract-new (date contents-sources annotation-sources &optional sorter) "Return an abstract model object. DATE is initial date for the calculation of the start date and end one. CONTENTS-SOURCES is a list of contents functions. ANNOTATION-SOURCES is a list of annotation functions." (unless date (setq date (calendar-current-date))) `((init-date . ,date) (contents-sources . ,contents-sources) (annotation-sources . ,annotation-sources) (sorter . ,(or sorter cfw:default-text-sorter)))) (defun cfw:model-abstract-derived (date org-model) "Return an abstract model object. The contents functions and annotation ones are copied from ORG-MODEL. DATE is initial date for the calculation of the start date and end one. ORG-MODEL is a model object to inherit." (cfw:model-abstract-new date (cfw:model-get-contents-sources org-model) (cfw:model-get-annotation-sources org-model) (cfw:model-get-sorter org-model))) (defun cfw:model-create-updated-view-data (model view-data) "[internal] Clear previous view model data from MODEL and return a new model with VIEW-DATA." (append (cfw:model-abstract-derived (cfw:k 'init-date model) model) view-data)) (defvar cfw:default-text-sorter 'string-lessp "[internal] Default sorting criteria in a calendar cell.") ;; public functions (defun cfw:model-get-holiday-by-date (date model) "Return a holiday title on the DATE." (cfw:contents-get date (cfw:k 'holidays model))) (defun cfw:model-get-contents-by-date (date model) "Return a list of contents on the DATE." (cfw:contents-get date (cfw:k 'contents model))) (defun cfw:model-get-annotation-by-date (date model) "Return an annotation on the DATE." (cfw:contents-get date (cfw:k 'annotations model))) (defun cfw:model-get-periods-by-date (date model) "Return a list of periods on the DATE." (loop for (begin end event) in (cfw:k 'periods model) for content = (if (cfw:event-p event) (cfw:event-detail event) event) if (cfw:date-between begin end date) collect `(,begin ,end ,content))) (defun cfw:model-get-sorter (model) "Return a sorter function." (cfw:k 'sorter model)) ;; private functions (defun cfw:model-get-contents-sources (model) "[internal] Return a list of content sources of the model." (cfw:k 'contents-sources model)) (defun cfw:model-get-annotation-sources (model) "[internal] Return a list of annotation sources of the model." (cfw:k 'annotation-sources model)) (defun cfw:model-set-init-date (date model) "[internal] Set the init-date that is used to calculate the display period of the calendar." (let ((cell (assq 'init-date model))) (cond (cell (setcdr cell date)) (t (push (cons 'init-date date) model)))) date) (defun cfw:model-set-contents-sources (sources model) "[internal] Set the content sources of the model." (let ((cell (assq 'contents-sources model))) (cond (cell (setcdr cell sources)) (t (push (cons 'contents-sources sources) model)))) sources) (defun cfw:model-set-annotation-sources (sources model) "[internal] Set the annotation sources of the model." (let ((cell (assq 'annotation-sources model))) (cond (cell (setcdr cell sources)) (t (push (cons 'annotation-sources sources) model)))) sources) (defun cfw:contents-get (date contents) "[internal] Return a list of contents on the DATE." (cdr (cfw:contents-get-internal date contents))) (defun cfw:contents-get-internal (date contents) "[internal] Return a cons cell that has the key DATE. One can modify the returned cons cell destructively." (cond ((or (null date) (null contents)) nil) (t (loop for i in contents if (equal date (car i)) return i finally return nil)))) (defun cfw:contents-add (date content contents) "[internal] Add a record, DATE as a key and CONTENT as a body, to CONTENTS destructively. If CONTENTS has a record for DATE, this function appends CONTENT to the record. Return the modified contents list." (let* ((prv (cfw:contents-get-internal date contents)) (lst (if (listp content) (copy-sequence content) (list content)))) (if prv (setcdr prv (append (cdr prv) lst)) (push (cons date lst) contents))) contents) (defun cfw:contents-merge (begin end sources) "[internal] Return an contents alist between begin date and end one, calling functions `:data' function." (cond ((null sources) nil) (t (loop for s in sources for f = (cfw:source-data s) for cnts = (cfw:contents-put-source (funcall f begin end) s) with contents = nil do (loop for c in cnts for (d . line) = c do (setq contents (cfw:contents-add d line contents))) finally return contents)))) (defun cfw:periods-put-source (periods source) (loop for period in periods collect (cond ((cfw:event-p period) (setf (cfw:event-source period) source) `(,(cfw:event-start-date period) ,(cfw:event-end-date period) ,period)) (t (destructuring-bind (begin end . summaries) period (list begin end (cfw:tp (if (listp summaries) (mapconcat 'identity (cfw:flatten summaries) " ") summaries) 'cfw:source source))))))) (defun cfw:contents-put-source (contents source) "[internal] Put the source object to the text property `cfw:source' in the contents list. During rendering, the source object is used to put some face property." (cond ((null source) contents) (t (loop for content in contents collect (cond ((cfw:event-p content) (setf (cfw:event-source content) source) `(,(cfw:event-start-date content) ,content)) ((eq (car content) 'periods) (cons 'periods (cfw:periods-put-source (cdr content) source))) (t (cons (car content) (loop for i in (cdr content) collect (cfw:tp i 'cfw:source source))))))))) (defun cfw:annotations-merge (begin end sources) "[internal] Return an annotation alist between begin date and end one, calling functions `cfw:annotations-functions'." (cond ((null sources) nil) ((= 1 (length sources)) (funcall (cfw:source-data (car sources)) begin end)) (t (loop for s in sources for f = (cfw:source-data s) for cnts = (funcall f begin end) with annotations = nil do (loop for c in cnts for (d . line) = c for prv = (cfw:contents-get-internal d annotations) if prv do (setcdr prv (concat (cdr prv) "/" line)) else do (push (cons d line) annotations)) finally return annotations)))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Rendering Utilities (defun cfw:render-title-month (date) "Render the calendar title for the monthly view." (format "%4s / %s" (calendar-extract-year date) (aref calendar-month-name-array (1- (calendar-extract-month date))))) (defun cfw:render-title-period (begin-date end-date) "Render the calendar title for the period view between BEGIN-DATE and END-DATE." (cond ((eql (calendar-extract-month begin-date) (calendar-extract-month end-date)) (format "%4s / %s %s - %s" (calendar-extract-year begin-date) (aref calendar-month-name-array (1- (calendar-extract-month begin-date))) (calendar-extract-day begin-date) (calendar-extract-day end-date))) (t (format "%4s / %s %s - %s %s" (calendar-extract-year begin-date) (aref calendar-month-name-array (1- (calendar-extract-month begin-date))) (calendar-extract-day begin-date) (aref calendar-month-name-array (1- (calendar-extract-month end-date))) (calendar-extract-day end-date))))) (defun cfw:render-title-day (date) "Render the calendar title for the day view on DATE." (format "%4s / %s %s" (calendar-extract-year date) (aref calendar-month-name-array (1- (calendar-extract-month date))) (calendar-extract-day date))) (defun cfw:render-center (width string &optional padding) "[internal] Format STRING in the center, padding on the both sides with the character PADDING." (let* ((padding (or padding ?\ )) (cnt (or (and string (cfw:render-truncate string width t)) "")) (len (string-width cnt)) (margin (/ (- width len) 2))) (concat (make-string margin padding) cnt (make-string (- width len margin) padding)))) (defun cfw:render-left (width string &optional padding) "[internal] Format STRING, padding on the right with the character PADDING." (let* ((padding (or padding ?\ )) (cnt (or (and string (cfw:render-truncate string width t)) "")) (len (string-width cnt)) (margin (- width len))) (concat cnt (make-string margin padding)))) (defun cfw:render-separator (string) "[internal] Add a separator into the ROWS list." (when (get-text-property 0 'cfw:item-separator string) (let ((last-face (get-text-property 0 'face string))) (cond ((or (null last-face) (listp last-face)) (setq last-face (append last-face `(:underline ,cfw:face-item-separator-color))) (put-text-property 0 (length string) 'face last-face string) (put-text-property 0 (length string) 'font-lock-face last-face string)) ((symbolp last-face) (let ((attrs (face-all-attributes last-face (selected-frame)))) (setq attrs ; transform alist to plist (loop with nattrs = nil for (n . v) in (append attrs `((:underline . ,cfw:face-item-separator-color))) do (setq nattrs (cons n (cons v nattrs))) finally return nattrs)) (put-text-property 0 (length string) 'face attrs string) (put-text-property 0 (length string) 'font-lock-face attrs string))) (t (message "DEBUG? CFW: FACE %S / %S" string last-face))))) string) (defun cfw:render-right (width string &optional padding) "[internal] Format STRING, padding on the left with the character PADDING." (let* ((padding (or padding ?\ )) (cnt (or (and string (cfw:render-truncate string width t)) "")) (len (string-width cnt)) (margin (- width len))) (concat (make-string margin padding) cnt))) (defun cfw:render-add-right (width left right &optional padding) "[internal] Layout strings LEFT and RIGHT within WIDTH." (let* ((padding (or padding ?\ )) (lcnt (or (and left (cfw:render-truncate left width t)) "")) (llen (string-width lcnt)) (rmargin (- width llen)) (right (cfw:trim right)) (rcnt (or (and right (> rmargin 0) (cfw:render-truncate right rmargin)) "")) (cmargin (- width llen (string-width rcnt)))) (concat lcnt (if (< 0 cmargin) (make-string cmargin padding)) rcnt))) (defun cfw:render-sort-contents (lst sorter) "[internal] Sort the string list LST. Maybe need to improve the sorting rule..." (sort (copy-sequence lst) sorter)) (defun cfw:render-get-face-period (text default-face) "[internal] Return a face for the source object of the period text." (let* ((src (get-text-property 0 'cfw:source text)) (bg-color (and src (cfw:source-period-bgcolor-get src))) (fg-color (and src (cfw:source-period-fgcolor-get src)))) (cond ((or (null src) (null bg-color)) default-face) (t (append (list ':background bg-color ':foreground fg-color) (cfw:source-opt-period-face src)))))) (defun cfw:render-get-face-content (text default-face) "[internal] Return a face for the source object of the content text." (let* ((src (get-text-property 0 'cfw:source text)) (fg-color (and src (cfw:source-color src)))) (cond ((or (null src) (null fg-color)) default-face) (t (append (list ':foreground fg-color) (cfw:source-opt-face src)))))) (defun cfw:render-default-content-face (str &optional default-face) "[internal] Put the default content face. If STR has some faces, the faces are remained." (loop for i from 0 below (length str) with ret = (substring str 0) with face = (or default-face (cfw:render-get-face-content str 'cfw:face-default-content)) unless (get-text-property i 'face ret) do (put-text-property i (1+ i) 'face face ret) (put-text-property i (1+ i) 'font-lock-face face ret) finally return ret)) (defun cfw:render-get-week-face (daynum &optional default-face) "[internal] Put the default week face." (cond ((= daynum cfw:week-saturday) 'cfw:face-saturday) ((= daynum cfw:week-sunday) 'cfw:face-sunday) (t default-face))) (defun cfw:render-truncate (org limit-width &optional ellipsis) "[internal] Truncate a string ORG with LIMIT-WIDTH, like `truncate-string-to-width'." (setq org (replace-regexp-in-string "\n" " " org)) (if (< limit-width (string-width org)) (let ((str (truncate-string-to-width (substring org 0) limit-width 0 nil ellipsis))) (cfw:tp str 'mouse-face 'highlight) (unless (get-text-property 0 'help-echo str) (cfw:tp str 'help-echo org)) str) org)) (defface cfw:face-toolbar '((((class color) (background light)) :foreground "Gray90" :background "Gray90") (((class color) (background dark)) :foreground "Steelblue4" :background "Steelblue4")) "Face for toolbar" :group 'calfw) (defface cfw:face-toolbar-button-off '((((class color) (background light)) :foreground "Lightskyblue4" :background "White") (((class color) (background dark)) :foreground "Gray10" :weight bold)) "Face for button on toolbar" :group 'calfw) (defface cfw:face-toolbar-button-on '((((class color) (background light)) :foreground "Lightpink3" :background "Gray94" ) (((class color) (background dark)) :foreground "Gray50" :weight bold)) "Face for button on toolbar" :group 'calfw) (defun cfw:render-button (title command &optional state) "[internal] Return a decorated text for the toolbar buttons. TITLE is a button title. COMMAND is a interactive command function called by clicking. If STATE is non-nil, the face `cfw:face-toolbar-button-on' is applied. Otherwise `cfw:face-toolbar-button-off' is applied." (let ((text (concat "[" title "]")) (keymap (make-sparse-keymap))) (cfw:rt text (if state 'cfw:face-toolbar-button-on 'cfw:face-toolbar-button-off)) (define-key keymap [mouse-1] command) (cfw:tp text 'keymap keymap) (cfw:tp text 'mouse-face 'highlight) text)) (defun cfw:render-toolbar (width current-view prev-cmd next-cmd) "[internal] Return a text of the toolbar. WIDTH is width of the toolbar. CURRENT-VIEW is a symbol of the current view type. This symbol is used to select the button faces on the toolbar. PREV-CMD and NEXT-CMD are the moving view command, such as `cfw:navi-previous(next)-month-command' and `cfw:navi-previous(next)-week-command'." (let* ((prev (cfw:render-button " < " prev-cmd)) (today (cfw:render-button "Today" 'cfw:navi-goto-today-command)) (next (cfw:render-button " > " next-cmd)) (month (cfw:render-button "Month" 'cfw:change-view-month (eq current-view 'month))) (tweek (cfw:render-button "Two Weeks" 'cfw:change-view-two-weeks (eq current-view 'two-weeks))) (week (cfw:render-button "Week" 'cfw:change-view-week (eq current-view 'week))) (day (cfw:render-button "Day" 'cfw:change-view-day (eq current-view 'day))) (sp " ") (toolbar-text (cfw:render-add-right width (concat sp prev sp next sp today sp) (concat day sp week sp tweek sp month sp)))) (cfw:render-default-content-face toolbar-text 'cfw:face-toolbar))) (defun cfw:render-footer (width sources) "[internal] Return a text of the footer." (let* ((whole-text (mapconcat 'identity (loop for s in sources for title = (cfw:tp (substring (cfw:source-name s) 0) 'cfw:source s) for dot = (cfw:tp (substring "(==)" 0) 'cfw:source s) collect (cfw:render-default-content-face (concat "[" (cfw:rt dot (cfw:render-get-face-period dot 'cfw:face-periods)) " " title "]") (cfw:render-get-face-content title 'cfw:face-default-content))) " "))) (cfw:render-default-content-face (cfw:render-left width (concat " " whole-text)) 'cfw:face-toolbar))) (defun cfw:render-periods (date week-day periods-stack cell-width) "[internal] This function translates PERIOD-STACK to display content on the DATE." (loop with prev-row = -1 for (row (begin end content props)) in (sort periods-stack (lambda (a b) (< (car a) (car b)))) nconc (make-list (- row prev-row 1) "") ; add empty padding lines do (setq prev-row row) for beginp = (equal date begin) for endp = (equal date end) for width = (- cell-width (if beginp 1 0) (if endp 1 0)) for title = (cfw:render-periods-title date week-day begin end content cell-width) collect (apply 'propertize (concat (when beginp cfw:fstring-period-start) (cfw:render-left width title ?-) (when endp cfw:fstring-period-end)) 'face (cfw:render-get-face-period content 'cfw:face-periods) 'font-lock-face (cfw:render-get-face-period content 'cfw:face-periods) 'cfw:period t props))) (defun cfw:render-periods-title (date week-day begin end content cell-width) "[internal] Return a title string." (let* ((week-begin (cfw:date-after date (- week-day))) (month-begin (cfw:date (calendar-extract-month date) 1 (calendar-extract-year date))) (title-begin-abs (max (calendar-absolute-from-gregorian begin) (calendar-absolute-from-gregorian week-begin))) (title-begin (calendar-gregorian-from-absolute title-begin-abs)) (num (- (calendar-absolute-from-gregorian date) title-begin-abs))) (when content (loop with title = (substring content 0) for i from 0 below num for pdate = (calendar-gregorian-from-absolute (+ title-begin-abs i)) for chopn = (+ (if (equal begin pdate) 1 0) (if (equal end pdate) 1 0)) for del = (truncate-string-to-width title (- cell-width chopn)) do (setq title (substring title (length del))) finally return (cfw:render-truncate title width (equal end date)))))) ;; event periods shifts pos - not one line (defun cfw:render-periods-get-min (periods-each-days begin end) "[internal] Find the minimum empty row number of the days between BEGIN and END from the PERIODS-EACH-DAYS." (loop for row-num from 0 below 30 ; assuming the number of stacked periods is less than 30 unless (loop for d in (cfw:enumerate-days begin end) for periods-stack = (cfw:contents-get d periods-each-days) if (and periods-stack (assq row-num periods-stack)) return t) return row-num)) (defun cfw:render-periods-place (periods-each-days row period) "[internal] Assign PERIOD content to the ROW-th row on the days of the period, and append the result to periods-each-days." (loop for d in (cfw:enumerate-days (car period) (cadr period)) for periods-stack = (cfw:contents-get-internal d periods-each-days) if periods-stack do (setcdr periods-stack (append (cdr periods-stack) (list (list row period)))) else do (push (cons d (list (list row period))) periods-each-days)) periods-each-days) (defun cfw:render-periods-stacks (model) "[internal] Arrange the `periods' records of the model and create period-stacks on the each days. period-stack -> ((row-num . period) ... )" (let* (periods-each-days) (loop for (begin end event) in (cfw:k 'periods model) for content = (if (cfw:event-p event) (cfw:event-period-overview event) event) for period = (list begin end content (cfw:extract-text-props content 'face)) for row = (cfw:render-periods-get-min periods-each-days begin end) do (setq periods-each-days (cfw:render-periods-place periods-each-days row period))) periods-each-days)) (defun cfw:render-columns (day-columns param) "[internal] This function concatenates each rows on the days into a string of a physical line. DAY-COLUMNS is a list of columns. A column is a list of following form: (DATE (DAY-TITLE . ANNOTATION-TITLE) STRING STRING...)." (let ((cell-width (cfw:k 'cell-width param)) (cell-height (cfw:k 'cell-height param)) (EOL (cfw:k 'eol param)) (VL (cfw:k 'vl param)) (hline (cfw:k 'hline param)) (cline (cfw:k 'cline param))) ;; day title (loop for day-rows in day-columns for date = (car day-rows) for (tday . ant) = (cadr day-rows) do (insert VL (if date (cfw:tp (cfw:render-default-content-face (cfw:render-add-right cell-width tday ant) 'cfw:face-day-title) 'cfw:date date) (cfw:render-left cell-width "")))) (insert VL EOL) ;; day contents (loop with breaked-day-columns = (loop for day-rows in day-columns for (date ants . lines) = day-rows collect (cons date (cfw:render-break-lines lines cell-width (1- cell-height)))) for i from 1 below cell-height do (loop for day-rows in breaked-day-columns for date = (car day-rows) for row = (nth i day-rows) do (insert VL (cfw:tp (cfw:render-separator (cfw:render-left cell-width (and row (format "%s" row)))) 'cfw:date date))) (insert VL EOL)) (insert cline))) (defvar cfw:render-line-breaker 'cfw:render-line-breaker-simple "A function which breaks a long line into some lines. Calfw has 3 strategies: none, simple and wordwrap. `cfw:render-line-breaker-none' never breaks lines. `cfw:render-line-breaker-simple' breaks lines with rigid width (default). `cfw:render-line-breaker-wordwrap' breaks lines with the emacs function `fill-region'. The arguments of a line-breaking function are STRING, LINE-WIDTH and MAX-LINE-NUMBER.") (defun cfw:render-break-lines (lines cell-width cell-height) "[internal] Return lines those are split into some lines by the algorithm defined at `cfw:render-line-breaker'." (and lines (let ((num (/ cell-height (length lines)))) (cond ((> 2 num) lines) (t (loop with total-rows = nil for line in lines for rows = (funcall cfw:render-line-breaker line cell-width num) do (when total-rows (cfw:render-add-item-separator-sign total-rows)) (setq total-rows (append total-rows rows)) finally return total-rows)))))) (defun cfw:render-add-item-separator-sign (rows) "[internal] Add a separator into the ROWS list." (let ((last-line (car (last rows))) last-face) (unless (get-text-property 0 'cfw:period last-line) (put-text-property 0 (length last-line) 'cfw:item-separator t last-line)) rows)) (defun cfw:render-line-breaker-none (line w n) "Line breaking algorithm: Do nothing." (list line)) (defun cfw:render-line-breaker-simple (string line-width max-line-num) "Line breaking algorithm: Just splitting a line with the rigid width." (loop with ret = nil with linenum = 1 with curcol = 0 with lastpos = 0 with endpos = (1- (length string)) for i from 0 upto endpos for c = (aref string i) for w = (char-width c) for wsum = (+ curcol w) do (cond ((and (< i endpos) (<= max-line-num linenum)) (push (cfw:trim (replace-regexp-in-string "[\n\r]" " " (substring string lastpos))) ret) (setq i endpos)) ((= endpos i) (push (substring string lastpos) ret)) ((or (= c 13) (= c 10)) (push (substring string lastpos i) ret) (setq lastpos (1+ i) curcol 0) (incf linenum)) ((= line-width wsum) (push (substring string lastpos (1+ i)) ret) (setq lastpos (1+ i) curcol 0) (incf linenum)) ((< line-width wsum) (push (substring string lastpos i) ret) (setq lastpos i curcol w) (incf linenum)) (t (incf curcol w))) finally return (or (and ret (nreverse ret)) '("")))) (defun cfw:render-line-breaker-wordwrap (string line-width max-line-num) "Line breaking algorithm: Simple word wrapping with fill-region." (if (<= (length string) line-width) (list string) (let ((fill-column line-width) (use-hard-newlines t)) (with-temp-buffer (insert string) (fill-region (point-min) (point-max)) ;; collect lines (goto-char (point-min)) (let ((cont t) (last (point)) ps ret) (while cont (setq ps (re-search-forward "\n" nil t)) (cond ((null ps) (setq cont nil) (when (not (eobp)) (push (buffer-substring last (point-max)) ret))) (t (push (cfw:trim (buffer-substring last (1- ps))) ret) (when (<= max-line-num (length ret)) (setq cont nil)) (setq last ps)))) (or (and ret (nreverse ret)) '(""))))))) (defun cfw:render-append-parts (param) "[internal] Append rendering parts to PARAM and return a new list." (let* ((EOL "\n") (cell-width (cfw:k 'cell-width param)) (columns (cfw:k 'columns param)) (num-cell-char (/ cell-width (char-width cfw:fchar-horizontal-line)))) (append param `((eol . ,EOL) (vl . ,(cfw:rt (make-string 1 cfw:fchar-vertical-line) 'cfw:face-grid)) (hline . ,(cfw:rt (concat (loop for i from 0 below columns concat (concat (make-string 1 (if (= i 0) cfw:fchar-top-left-corner cfw:fchar-top-junction)) (make-string num-cell-char cfw:fchar-horizontal-line))) (make-string 1 cfw:fchar-top-right-corner) EOL) 'cfw:face-grid)) (cline . ,(cfw:rt (concat (loop for i from 0 below columns concat (concat (make-string 1 (if (= i 0) cfw:fchar-left-junction cfw:fchar-junction)) (make-string num-cell-char cfw:fchar-horizontal-line))) (make-string 1 cfw:fchar-right-junction) EOL) 'cfw:face-grid)))))) (defun cfw:render-day-of-week-names (model param) "[internal] Insert week names." (loop for i in (cfw:k 'headers model) with VL = (cfw:k 'vl param) with cell-width = (cfw:k 'cell-width param) for name = (aref calendar-day-name-array i) do (insert VL (cfw:rt (cfw:render-center cell-width name) (cfw:render-get-week-face i 'cfw:face-header))))) (defun cfw:render-calendar-cells-weeks (model param title-func) "[internal] Insert calendar cells for week based views." (loop for week in (cfw:k 'weeks model) do (cfw:render-calendar-cells-days model param title-func week 'cfw:render-event-overview-content t))) (defun cfw:render-rows-prop (rows) "[internal] Put a marker as a text property for TAB navigation." (loop with i = 0 for line in rows collect (prog1 (cfw:tp line 'cfw:row-count i) (if (< 0 (length line)) (incf i))))) (defun cfw:render-map-event-content (lst event-fun) "[internal] `lst' is a list of contents and `cfw:event's. Map over `lst', where `event-fun' is applied if the element is a `cfw:event'." (mapcar #'(lambda (evt) (if (cfw:event-p evt) (funcall event-fun evt) evt)) lst)) (defun cfw:render-event-overview-content (lst) "[internal] Apply `cfw:event-overview' on `cfw:event's in `lst'." (cfw:render-map-event-content lst 'cfw:event-overview)) (defun cfw:render-event-days-overview-content (lst) "[internal] Apply `cfw:event-days-overview' on `cfw:event's in `lst'." (cfw:render-map-event-content lst 'cfw:event-days-overview)) (defun cfw:render-event-details-content (lst) "[internal] Apply `cfw:event-detail' on `cfw:event's in `lst'." (cfw:render-map-event-content lst 'cfw:event-detail)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Views ;;; view model utilities (defun cfw:view-model-make-weeks (begin-date end-date) "[internal] Return a list of weeks those have 7 days." (let* ((first-day-day (calendar-day-of-week begin-date)) weeks) (loop with i = begin-date with day = calendar-week-start-day with week = nil do ;; flush a week (when (and (= day calendar-week-start-day) week) (push (nreverse week) weeks) (setq week nil) (when (cfw:date-less-equal-p end-date i) (return))) ;; add a day (push i week) ;; increment (setq day (% (1+ day) cfw:week-days)) (setq i (cfw:date-after i 1))) (nreverse weeks))) (defun cfw:view-model-make-days (begin-date end-date) "[internal] Return a list of days for linear views." (loop with days = nil with i = begin-date do (push i days) (when (cfw:date-less-equal-p end-date i) (return (reverse days))) (setq i (cfw:date-after i 1)))) (defun cfw:view-model-make-day-names-for-week () "[internal] Return a list of index of day of the week." (loop for i from 0 below cfw:week-days collect (% (+ calendar-week-start-day i) cfw:week-days))) (defun cfw:view-model-make-day-names-for-days (begin-date end-date) "[internal] Return a list of index of day of the week for linear views." (loop with day = (calendar-day-of-week begin-date) with day-names = nil with i = begin-date do (push day day-names) (when (cfw:date-less-equal-p end-date i) (return (reverse day-names))) (setq day (% (1+ day) cfw:week-days)) (setq i (cfw:date-after i 1)))) (defun cfw:view-model-make-holidays (date) "[internal] Return an alist of holidays around DATE." (if cfw:display-calendar-holidays (let ((displayed-month (calendar-extract-month date)) (displayed-year (calendar-extract-year date))) (calendar-holiday-list)))) (defun cfw:view-model-make-common-data (model begin-date end-date &optional lst) "[internal] Return an alist of common data for the model." (let* ((contents-all (cfw:contents-merge begin-date end-date (cfw:model-get-contents-sources model)))) (append `(; common data (begin-date . ,begin-date) (end-date . ,end-date) (holidays . ,(cfw:view-model-make-holidays begin-date)) ; an alist of holidays, (DATE HOLIDAY-NAME) (annotations . ,(cfw:annotations-merge ; an alist of annotations, (DATE ANNOTATION) begin-date end-date (cfw:model-get-annotation-sources model))) (contents . ,(loop for i in contents-all unless (eq 'periods (car i)) collect i)) ; an alist of contents, (DATE LIST-OF-CONTENTS) (periods . ,(cfw:k 'periods contents-all))) ; a list of periods, (BEGIN-DATE END-DATE SUMMARY) lst))) (defun cfw:view-model-make-common-data-for-weeks (model begin-date end-date) "[internal] Return a model object for week based views." (cfw:model-create-updated-view-data model (cfw:view-model-make-common-data model begin-date end-date `((headers . ,(cfw:view-model-make-day-names-for-week)) ; a list of the index of day-of-week (weeks . ,(cfw:view-model-make-weeks ; a matrix of day-of-month, which corresponds to the index of `headers' (cfw:week-begin-date begin-date) (cfw:week-end-date end-date))))))) (defun cfw:view-model-make-common-data-for-days (model begin-date end-date) "[internal] Return a model object for linear views." (cfw:model-create-updated-view-data model (cfw:view-model-make-common-data model begin-date end-date `((headers . ,(cfw:view-model-make-day-names-for-days begin-date end-date)) ; a list of the index of day-of-week (days . ,(cfw:view-model-make-days ; a list of days, which corresponds to the index of `headers' begin-date end-date)))))) ;;; view-month (defun cfw:view-month-model (model) "[internal] Create a logical view model of monthly calendar. This function collects and arranges contents. This function does not know how to display the contents in the destinations." (let* ((init-date (cfw:k 'init-date model)) (year (calendar-extract-year init-date)) (month (calendar-extract-month init-date)) (begin-date (cfw:date month 1 year)) (end-date (cfw:date month (calendar-last-day-of-month month year) year))) ;; model (append (cfw:view-model-make-common-data-for-weeks model begin-date end-date) `((month . ,month) (year . ,year))))) (defun cfw:round-cell-width (width) "[internal] If string-width of `cfw:fchar-horizontal-line' is not 1, this function re-calculate and return the adjusted width." (cond ((eql (char-width cfw:fchar-horizontal-line) 1) width) (t (- width (% width (char-width cfw:fchar-horizontal-line)))))) (defun cfw:view-month-calc-param (dest total-weeks) "[internal] Calculate cell size from the reference size and return an alist of rendering parameters." (let* ((win-width (cfw:dest-width dest)) ;; title 2, toolbar 1, header 2, hline 7, footer 1, margin 2 => 15 (win-height (max 15 (- (cfw:dest-height dest) 15))) (junctions-width (* (char-width cfw:fchar-junction) 8)) ; weekdays+1 (cell-width (cfw:round-cell-width (max 5 (/ (- win-width junctions-width) 7)))) ; weekdays (cell-height (max 2 (/ win-height total-weeks))) ; max weeks = 6 (total-width (+ (* cell-width cfw:week-days) junctions-width))) `((cell-width . ,cell-width) (cell-height . ,cell-height) (total-width . ,total-width) (columns . ,cfw:week-days)))) (defun cfw:view-month (component) "[internal] Render monthly calendar view." (let* ((dest (cfw:component-dest component)) (model (cfw:view-month-model (cfw:component-model component))) (total-weeks (length (cfw:k 'weeks model))) (param (cfw:render-append-parts (cfw:view-month-calc-param dest total-weeks))) (total-width (cfw:k 'total-width param)) (EOL (cfw:k 'eol param)) (VL (cfw:k 'vl param)) (hline (cfw:k 'hline param)) (cline (cfw:k 'cline param))) ;; update model (setf (cfw:component-model component) model) ;; header (insert (cfw:rt (cfw:render-title-month (cfw:k 'init-date model)) 'cfw:face-title) EOL (cfw:render-toolbar total-width 'month 'cfw:navi-previous-month-command 'cfw:navi-next-month-command) EOL hline) ;; day names (cfw:render-day-of-week-names model param) (insert VL EOL cline) ;; contents (let ((year (cfw:k 'year model)) (month (cfw:k 'month model))) (cfw:render-calendar-cells-weeks model param (lambda (date week-day hday) (cfw:rt (format "%s" (calendar-extract-day date)) (cond (hday 'cfw:face-sunday) ((not (cfw:month-year-contain-p month year date)) 'cfw:face-disable) (t (cfw:render-get-week-face week-day 'cfw:face-default-day))))))) ;; footer (insert (cfw:render-footer total-width (cfw:model-get-contents-sources model))))) ;;; view-week (defun cfw:view-week-model (model) "[internal] Create a logical view model of weekly calendar. This function collects and arranges contents. This function does not know how to display the contents in the destinations." (let* ((init-date (cfw:k 'init-date model)) (begin-date (cfw:week-begin-date init-date)) (end-date (cfw:week-end-date init-date))) (cfw:view-model-make-common-data-for-weeks model begin-date end-date))) ;; (cfw:view-week-model (cfw:model-abstract-new (cfw:date 1 1 2011) nil nil)) (defun cfw:view-week-calc-param (dest) "[internal] Calculate cell size from the reference size and return an alist of rendering parameters." (let* ((win-width (cfw:dest-width dest)) ;; title 2, toolbar 1, header 2, hline 2, footer 1, margin 2 => 10 (win-height (max 15 (- (cfw:dest-height dest) 10))) (junctions-width (* (char-width cfw:fchar-junction) 8)) (cell-width (cfw:round-cell-width (max 5 (/ (- win-width junctions-width) 7)))) (cell-height (max 2 win-height)) (total-width (+ (* cell-width cfw:week-days) junctions-width))) `((cell-width . ,cell-width) (cell-height . ,cell-height) (total-width . ,total-width) (columns . ,cfw:week-days)))) (defun cfw:view-week (component) "[internal] Render weekly calendar view." (let* ((dest (cfw:component-dest component)) (param (cfw:render-append-parts (cfw:view-week-calc-param dest))) (total-width (cfw:k 'total-width param)) (EOL (cfw:k 'eol param)) (VL (cfw:k 'vl param)) (hline (cfw:k 'hline param)) (cline (cfw:k 'cline param)) (model (cfw:view-week-model (cfw:component-model component))) (begin-date (cfw:k 'begin-date model)) (end-date (cfw:k 'end-date model))) ;; update model (setf (cfw:component-model component) model) ;; header (insert (cfw:rt (cfw:render-title-period begin-date end-date) 'cfw:face-title) EOL (cfw:render-toolbar total-width 'week 'cfw:navi-previous-week-command 'cfw:navi-next-week-command) EOL hline) ;; day names (cfw:render-day-of-week-names model param) (insert VL EOL cline) ;; contents (cfw:render-calendar-cells-weeks model param (lambda (date week-day hday) (cfw:rt (format "%s" (calendar-extract-day date)) (if hday 'cfw:face-sunday (cfw:render-get-week-face week-day 'cfw:face-default-day))))) ;; footer (insert (cfw:render-footer total-width (cfw:model-get-contents-sources model))))) ;;; view-two-weeks (defun cfw:view-two-weeks-model-adjust (model) "view-two-weeks-model-begin MODEL" (let ((in-date (cfw:k 'init-date model))) (cond ((eq 'two-weeks (cfw:k 'type model)) (let ((old-begin-date (cfw:k 'begin-date model)) (old-end-date (cfw:k 'end-date model))) (cond ((cfw:date-between old-begin-date old-end-date in-date) in-date) ((cfw:date-between old-end-date (cfw:date-after old-end-date cfw:week-days) in-date) old-end-date) ((cfw:date-between (cfw:date-after old-begin-date (- cfw:week-days)) old-begin-date in-date) (cfw:date-after old-begin-date (- cfw:week-days))) (t in-date)))) (t in-date)))) (defun cfw:view-two-weeks-model (model) "[internal] Create a logical view model of two-weeks calendar. This function collects and arranges contents. This function does not know how to display the contents in the destinations." (let* ((init-date (cfw:view-two-weeks-model-adjust model)) (begin-date (cfw:week-begin-date init-date)) (end-date (cfw:date-after begin-date (1- (* 2 cfw:week-days))))) ;; model (append (cfw:view-model-make-common-data-for-weeks model begin-date end-date) `((type . two-weeks))))) ;; (cfw:view-two-weeks-model (cfw:model-abstract-new (cfw:date 1 1 2011) nil nil)) (defun cfw:view-two-weeks-calc-param (dest) "[internal] Calculate cell size from the reference size and return an alist of rendering parameters." (let* ((win-width (cfw:dest-width dest)) ;; title 2, toolbar 1, header 2, hline 3, footer 1, margin 2 => 11 (win-height (max 15 (- (cfw:dest-height dest) 11))) (junctions-width (* (char-width cfw:fchar-junction) 8)) (cell-width (cfw:round-cell-width (max 5 (/ (- win-width junctions-width) 7)))) (cell-height (max 2 (/ win-height 2))) (total-width (+ (* cell-width cfw:week-days) junctions-width))) `((cell-width . ,cell-width) (cell-height . ,cell-height) (total-width . ,total-width) (columns . ,cfw:week-days)))) (defun cfw:view-two-weeks (component) "[internal] Render two-weeks calendar view." (let* ((dest (cfw:component-dest component)) (param (cfw:render-append-parts (cfw:view-two-weeks-calc-param dest))) (total-width (cfw:k 'total-width param)) (EOL (cfw:k 'eol param)) (VL (cfw:k 'vl param)) (hline (cfw:k 'hline param)) (cline (cfw:k 'cline param)) (model (cfw:view-two-weeks-model (cfw:component-model component))) (begin-date (cfw:k 'begin-date model)) (end-date (cfw:k 'end-date model))) ;; update model (setf (cfw:component-model component) model) ;; header (insert (cfw:rt (cfw:render-title-period begin-date end-date) 'cfw:face-title) EOL (cfw:render-toolbar total-width 'two-weeks 'cfw:navi-previous-week-command 'cfw:navi-next-week-command) EOL hline) ;; day names (cfw:render-day-of-week-names model param) (insert VL EOL cline) ;; contents (cfw:render-calendar-cells-weeks model param (lambda (date week-day hday) (cfw:rt (format "%s" (calendar-extract-day date)) (if hday 'cfw:face-sunday (cfw:render-get-week-face week-day 'cfw:face-default-day))))) ;; footer (insert (cfw:render-footer total-width (cfw:model-get-contents-sources model))))) ;;; view-day (defun cfw:view-day-calc-param (dest &optional num) "[internal] Calculate cell size from the reference size and return an alist of rendering parameters." (let* ((num (or num 1)) (win-width (cfw:dest-width dest)) ;; title 2, toolbar 1, header 2, hline 2, footer 1, margin 2 => 10 (win-height (max 15 (- (cfw:dest-height dest) 10))) (junctions-width (* (char-width cfw:fchar-junction) (1+ num))) (cell-width (cfw:round-cell-width (max 3 (/ (- win-width junctions-width) num)))) (cell-height win-height) (total-width (+ (* cell-width num) junctions-width))) `((cell-width . ,cell-width) (cell-height . ,cell-height) (total-width . ,total-width) (columns . ,num)))) (defun cfw:view-day (component) "[internal] Render daily calendar view." (let* ((dest (cfw:component-dest component)) (param (cfw:render-append-parts (cfw:view-day-calc-param dest))) (total-width (cfw:k 'total-width param)) (EOL (cfw:k 'eol param)) (VL (cfw:k 'vl param)) (hline (cfw:k 'hline param)) (cline (cfw:k 'cline param)) (current-date (cfw:k 'init-date (cfw:component-model component))) (model (cfw:view-model-make-common-data-for-days (cfw:component-model component) current-date current-date))) ;; update model (setf (cfw:component-model component) model) ;; header (insert (cfw:rt (cfw:render-title-day current-date) 'cfw:face-title) EOL (cfw:render-toolbar total-width 'day 'cfw:navi-previous-day-command 'cfw:navi-next-day-command) EOL hline) ;; day names (cfw:render-day-of-week-names model param) (insert VL EOL cline) ;; contents (cfw:render-calendar-cells-days model param (lambda (date week-day hday) (cfw:rt (format "%s" (calendar-extract-day date)) (if hday 'cfw:face-sunday (cfw:render-get-week-face week-day 'cfw:face-default-day))))) ;; footer (insert (cfw:render-footer total-width (cfw:model-get-contents-sources model))))) (defun cfw:render-calendar-cells-days (model param title-func &optional days content-fun do-weeks) "[internal] Insert calendar cells for the linear views." (cfw:render-columns (loop with cell-width = (cfw:k 'cell-width param) with days = (or days (cfw:k 'days model)) with content-fun = (or content-fun 'cfw:render-event-days-overview-content) with holidays = (cfw:k 'holidays model) with annotations = (cfw:k 'annotations model) with headers = (cfw:k 'headers model) with raw-periods-all = (cfw:render-periods-stacks model) with sorter = (cfw:model-get-sorter model) for date in days ; days columns loop for count from 0 below (length days) for hday = (car (cfw:contents-get date holidays)) for week-day = (nth count headers) for ant = (cfw:rt (cfw:contents-get date annotations) 'cfw:face-annotation) for raw-periods = (cfw:contents-get date raw-periods-all) for raw-contents = (cfw:render-sort-contents (funcall content-fun (cfw:model-get-contents-by-date date model)) sorter) for prs-contents = (cfw:render-rows-prop (append (if do-weeks (cfw:render-periods date week-day raw-periods cell-width) (cfw:render-periods-days date raw-periods cell-width)) (mapcar 'cfw:render-default-content-face raw-contents))) for num-label = (if prs-contents (format "(%s)" (+ (length raw-contents) (length raw-periods))) "") for tday = (concat " " ; margin (funcall title-func date week-day hday) (if num-label (concat " " num-label)) (if hday (concat " " (cfw:rt (substring hday 0) 'cfw:face-holiday)))) collect (cons date (cons (cons tday ant) prs-contents))) param)) (defun cfw:render-periods-days (date periods-stack cell-width) "[internal] Insert period texts." (when periods-stack (let ((stack (sort (copy-sequence periods-stack) (lambda (a b) (< (car a) (car b)))))) (loop for (row (begin end content)) in stack for beginp = (equal date begin) for endp = (equal date end) for width = (- cell-width 2) for title = (cfw:render-truncate (concat (cfw:strtime begin) " - " (cfw:strtime end) " : " content) width t) collect (if content (cfw:rt (concat (if beginp "(" " ") (cfw:render-left width title ?-) (if endp ")" " ")) (cfw:render-get-face-period content 'cfw:face-periods)) ""))))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Navigation ;; Following functions assume that the current buffer is a calendar view. (defun cfw:cursor-to-date (&optional pos) "[internal] Return the date at the cursor. If the text does not have the text-property `cfw:date', return nil." (get-text-property (or pos (point)) 'cfw:date)) (defun cfw:cursor-to-nearest-date () "Return the date at the cursor. If the point of cursor does not have the date, search the date around the cursor position. If the current buffer is not calendar view (it may be bug), this function may return nil." (or (cfw:cursor-to-date) (let* ((r (lambda () (when (not (eolp)) (forward-char)))) (l (lambda () (when (not (bolp)) (backward-char)))) (u (lambda () (when (not (bobp)) (line-move 1)))) (d (lambda () (when (not (eobp)) (line-move -1)))) (dest (cfw:component-dest (cfw:cp-get-component))) get) (setq get (lambda (cmds) (save-excursion (if (null cmds) (cfw:cursor-to-date) (ignore-errors (funcall (car cmds)) (funcall get (cdr cmds))))))) (or (loop for i in `((,d) (,r) (,u) (,l) (,d ,r) (,d ,l) (,u ,r) (,u ,l) (,d ,d) (,r ,r) (,u ,u) (,l ,l)) for date = (funcall get i) if date return date) (cond ((> (/ (point-max) 2) (point)) (cfw:find-first-date dest)) (t (cfw:find-last-date dest))))))) (defun cfw:find-first-date (dest) "[internal] Return the first date in the current buffer." (let ((pos (next-single-property-change (cfw:dest-point-min dest) 'cfw:date))) (and pos (cfw:cursor-to-date pos)))) (defun cfw:find-last-date (dest) "[internal] Return the last date in the current buffer." (let ((pos (previous-single-property-change (cfw:dest-point-max dest) 'cfw:date))) (and pos (cfw:cursor-to-date (1- pos))))) (defun cfw:find-by-date (dest date) "[internal] Return a point where the text property `cfw:date' is equal to DATE in the current calender view. If DATE is not found in the current view, return nil." (loop with pos = (cfw:dest-point-min dest) with end = (cfw:dest-point-max dest) for next = (next-single-property-change pos 'cfw:date nil end) for text-date = (and next (cfw:cursor-to-date next)) while (and next (< next end)) do (if (and text-date (equal date text-date)) (return next)) (setq pos next))) (defun cfw:find-all-by-date (dest date func) "[internal] Call the function FUNC in each regions where the text-property `cfw:date' is equal to DATE. The argument function FUNC receives two arguments, begin position and end one. This function is mainly used at functions for putting overlays." (loop with pos = (cfw:dest-point-min dest) with end = (cfw:dest-point-max dest) for next = (next-single-property-change pos 'cfw:date nil end) for text-date = (and next (cfw:cursor-to-date next)) while (and next (< next end)) do (if (and text-date (equal date text-date)) (let ((cend (next-single-property-change next 'cfw:date nil end))) (funcall func next cend))) (setq pos next))) (defun cfw:find-item (dest date row-count) "[internal] Find the schedule item which has the text properties as `cfw:date' = DATE and `cfw:row-count' = ROW-COUNT. If no item is found, this function returns nil." (loop with pos = (cfw:dest-point-min dest) with end = (cfw:dest-point-max dest) for next = (next-single-property-change pos 'cfw:date nil end) for text-date = (and next (cfw:cursor-to-date next)) for text-row-count = (and next (get-text-property next 'cfw:row-count)) while (and next (< next end)) do (when (and text-date (equal date text-date) (eql row-count text-row-count)) (return next)) (setq pos next))) (defun cfw:navi-goto-date (date) "Move the cursor to DATE and put selection. If DATE is not included on the current calendar, this function changes the calendar view." (let ((cp (cfw:cp-get-component))) (when cp (cfw:cp-set-selected-date cp date)))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Major Mode / Key bindings (defvar cfw:calendar-mode-map (cfw:define-keymap '( ("" . cfw:navi-next-day-command) ("f" . cfw:navi-next-day-command) ("" . cfw:navi-previous-day-command) ("b" . cfw:navi-previous-day-command) ("" . cfw:navi-next-week-command) ("n" . cfw:navi-next-week-command) ("" . cfw:navi-previous-week-command) ("p" . cfw:navi-previous-week-command) ;; Vi style ("l" . cfw:navi-next-day-command) ("h" . cfw:navi-previous-day-command) ("j" . cfw:navi-next-week-command) ("k" . cfw:navi-previous-week-command) ("^" . cfw:navi-goto-week-begin-command) ("$" . cfw:navi-goto-week-end-command) ("<" . cfw:navi-previous-month-command) ("M-v" . cfw:navi-previous-month-command) (">" . cfw:navi-next-month-command) ("C-v" . cfw:navi-next-month-command) ("" . cfw:navi-previous-month-command) ("" . cfw:navi-next-month-command) ("" . cfw:navi-goto-first-date-command) ("" . cfw:navi-goto-last-date-command) ("g" . cfw:navi-goto-date-command) ("t" . cfw:navi-goto-today-command) ("." . cfw:navi-goto-today-command) ("TAB" . cfw:navi-next-item-command) ("r" . cfw:refresh-calendar-buffer) ("SPC" . cfw:show-details-command) ("D" . cfw:change-view-day) ("W" . cfw:change-view-week) ("T" . cfw:change-view-two-weeks) ("M" . cfw:change-view-month) ([mouse-1] . cfw:navi-on-click) ("q" . bury-buffer) ("0" . digit-argument) ("1" . digit-argument) ("2" . digit-argument) ("3" . digit-argument) ("4" . digit-argument) ("5" . digit-argument) ("6" . digit-argument) ("7" . digit-argument) ("8" . digit-argument) ("9" . digit-argument) )) "Default key map of calendar views.") (defun cfw:calendar-mode-map (&optional custom-map) "[internal] Return a keymap object for the calendar buffer." (cond (custom-map (set-keymap-parent custom-map cfw:calendar-mode-map) custom-map) (t cfw:calendar-mode-map))) (defvar cfw:calendar-mode-hook nil "This hook is called at end of setting up major mode `cfw:calendar-mode'.") (defun cfw:calendar-mode (&optional custom-map) "Set up major mode `cfw:calendar-mode'. \\{cfw:calendar-mode-map}" (kill-all-local-variables) (setq truncate-lines t) (use-local-map (cfw:calendar-mode-map custom-map)) (setq major-mode 'cfw:calendar-mode mode-name "Calendar Mode") (setq buffer-undo-list t buffer-read-only t) (run-hooks 'cfw:calendar-mode-hook)) ;;; Actions (defun cfw:change-view-month () "change-view-month" (interactive) (when (cfw:cp-get-component) (cfw:cp-set-view (cfw:cp-get-component) 'month))) (defun cfw:change-view-week () "change-view-week" (interactive) (when (cfw:cp-get-component) (cfw:cp-set-view (cfw:cp-get-component) 'week))) (defun cfw:change-view-two-weeks () "change-view-two-weeks" (interactive) (when (cfw:cp-get-component) (cfw:cp-set-view (cfw:cp-get-component) 'two-weeks))) (defun cfw:change-view-day () "change-view-day" (interactive) (when (cfw:cp-get-component) (cfw:cp-set-view (cfw:cp-get-component) 'day))) (defun cfw:navi-next-item-command () "Move the cursor to the next item." (interactive) (let ((cp (cfw:cp-get-component)) (date (cfw:cursor-to-date)) (count (or (get-text-property (point) 'cfw:row-count) -1))) (when (and cp date) (let ((next (cfw:find-item (cfw:component-dest cp) date (1+ count)))) (if next (goto-char next) (cfw:navi-goto-date date)))))) (defun cfw:navi-on-click () "click" (interactive) (let ((cp (cfw:cp-get-component)) (date (cfw:cursor-to-date))) (when (and cp date) (cfw:cp-set-selected-date cp date) (cfw:cp-fire-click-hooks cp)))) (defun cfw:refresh-calendar-buffer (no-resize) "Clear the calendar and render again. With prefix arg NO-RESIZE, don't fit calendar to window size." (interactive "P") (let ((cp (cfw:cp-get-component))) (when cp (unless no-resize (cfw:cp-resize cp (window-width) (window-height))) (loop for s in (cfw:cp-get-contents-sources cp) for f = (cfw:source-update s) if f do (funcall f)) (loop for s in (cfw:cp-get-annotation-sources cp) for f = (cfw:source-update s) if f do (funcall f)) (cfw:cp-update cp)))) (defun cfw:navi-goto-week-begin-command () "Move the cursor to the first day of the current week." (interactive) (when (cfw:cp-get-component) (cfw:navi-goto-date (cfw:week-begin-date (cfw:cp-get-selected-date (cfw:cp-get-component)))))) (defun cfw:navi-goto-week-end-command () "Move the cursor to the last day of the current week." (interactive) (when (cfw:cp-get-component) (cfw:navi-goto-date (cfw:week-end-date (cfw:cp-get-selected-date (cfw:cp-get-component)))))) (defun cfw:navi-goto-date-command () "Move the cursor to the specified date." (interactive) (cfw:navi-goto-date (call-interactively cfw:read-date-command))) (defun cfw:navi-goto-today-command () "Move the cursor to today." (interactive) (cfw:navi-goto-date (cfw:emacs-to-calendar (current-time)))) (defun cfw:navi-next-day-command (&optional num) "Move the cursor forward NUM days. If NUM is nil, 1 is used. Moves backward if NUM is negative." (interactive "p") (when (cfw:cp-get-component) (unless num (setq num 1)) (let* ((cursor-date (cfw:cp-get-selected-date (cfw:cp-get-component))) (new-cursor-date (cfw:date-after cursor-date num))) (cfw:navi-goto-date new-cursor-date)))) (defun cfw:navi-previous-day-command (&optional num) "Move the cursor back NUM days. If NUM is nil, 1 is used. Moves forward if NUM is negative." (interactive "p") (cfw:navi-next-day-command (- (or num 1)))) (defun cfw:navi-goto-first-date-command () "Move the cursor to the first day on the current calendar view." (interactive) (cfw:navi-goto-date (cfw:find-first-date (cfw:component-dest (cfw:cp-get-component))))) (defun cfw:navi-goto-last-date-command () "Move the cursor to the last day on the current calendar view." (interactive) (cfw:navi-goto-date (cfw:find-last-date (cfw:component-dest (cfw:cp-get-component))))) (defun cfw:navi-next-week-command (&optional num) "Move the cursor forward NUM weeks. If NUM is nil, 1 is used. Moves backward if NUM is negative." (interactive "p") (cfw:navi-next-day-command (* cfw:week-days (or num 1)))) (defun cfw:navi-previous-week-command (&optional num) "Move the cursor back NUM weeks. If NUM is nil, 1 is used. Moves forward if NUM is negative." (interactive "p") (cfw:navi-next-day-command (* (- cfw:week-days) (or num 1)))) (defun cfw:navi-next-month-command (&optional num) "Move the cursor forward NUM months. If NUM is nil, 1 is used. Movement is backward if NUM is negative." (interactive "p") (when (cfw:cp-get-component) (unless num (setq num 1)) (let* ((cursor-date (cfw:cp-get-selected-date (cfw:cp-get-component))) (month (calendar-extract-month cursor-date)) (day (calendar-extract-day cursor-date)) (year (calendar-extract-year cursor-date)) (last (progn (calendar-increment-month month year num) (calendar-last-day-of-month month year))) (day (min last day)) (new-cursor-date (cfw:date month day year))) (cfw:navi-goto-date new-cursor-date)))) (defun cfw:navi-previous-month-command (&optional num) "Move the cursor back NUM months. If NUM is nil, 1 is used. Movement is forward if NUM is negative." (interactive "p") (cfw:navi-next-month-command (- (or num 1)))) ;;; Detail popup (defun cfw:show-details-command () "Show details on the selected date." (interactive) (let* ((cursor-date (cfw:cursor-to-nearest-date)) (cp (cfw:cp-get-component)) (model (and cp (cfw:component-model cp)))) (when model (cfw:details-popup (cfw:details-layout cursor-date model))))) (defvar cfw:details-buffer-name "*cfw:details*" "[internal]") (defvar cfw:details-window-size 20 "Default detail buffer window size.") (defun cfw:details-popup (text) "Popup the buffer to show details. TEXT is a content to show." (let ((buf (get-buffer cfw:details-buffer-name)) (before-win-num (length (window-list))) (main-buf (current-buffer))) (unless (and buf (eq (buffer-local-value 'major-mode buf) 'cfw:details-mode)) (setq buf (get-buffer-create cfw:details-buffer-name)) (with-current-buffer buf (cfw:details-mode) (set (make-local-variable 'cfw:before-win-num) before-win-num))) (with-current-buffer buf (let (buffer-read-only) (set (make-local-variable 'cfw:main-buf) main-buf) (erase-buffer) (insert text) (goto-char (point-min)))) (pop-to-buffer buf))) (defun cfw:details-layout (date model) "Layout details and return the text. DATE is a date to show. MODEL is model object." (let* ((EOL "\n") (HLINE (cfw:rt (concat (make-string (window-width) ?-) EOL) 'cfw:face-grid)) (holiday (cfw:model-get-holiday-by-date date model)) (annotation (cfw:model-get-annotation-by-date date model)) (periods (cfw:model-get-periods-by-date date model)) (contents (cfw:render-sort-contents (cfw:render-event-details-content (cfw:model-get-contents-by-date date model)) (cfw:model-get-sorter model))) (row-count -1)) (concat (cfw:rt (concat "Schedule on " (cfw:strtime date) " (") 'cfw:face-header) (cfw:rt (calendar-day-name date) (cfw:render-get-week-face (calendar-day-of-week date) 'cfw:face-header)) (cfw:rt (concat ")" EOL) 'cfw:face-header) (when (or holiday annotation) (concat (and holiday (cfw:rt holiday 'cfw:face-holiday)) (and holiday annotation " / ") (and annotation (cfw:rt annotation 'cfw:face-annotation)) EOL)) HLINE (loop for (begin end summary) in periods for prefix = (propertize (concat (cfw:strtime begin) " - " (cfw:strtime end) " : ") 'face (cfw:render-get-face-period summary 'cfw:face-periods) 'font-lock-face (cfw:render-get-face-period summary 'cfw:face-periods) 'cfw:row-count (incf row-count)) concat (concat prefix " " summary EOL)) (loop for i in contents for f = (cfw:render-get-face-content i 'cfw:face-default-content) concat (concat "- " (propertize i 'face f 'font-lock-face f 'cfw:row-count (incf row-count)) EOL))))) (defvar cfw:details-mode-map (cfw:define-keymap '(("q" . cfw:details-kill-buffer-command) ("SPC" . cfw:details-kill-buffer-command) ("n" . cfw:details-navi-next-command) ("f" . cfw:details-navi-next-command) ("" . cfw:details-navi-next-command) ("p" . cfw:details-navi-prev-command) ("b" . cfw:details-navi-prev-command) ("" . cfw:details-navi-prev-command) ("TAB" . cfw:details-navi-next-item-command) )) "Default key map for the details buffer.") (defvar cfw:details-mode-hook nil "") (defun cfw:details-mode () "Set up major mode `cfw:details-mode'. \\{cfw:details-mode-map}" (kill-all-local-variables) (setq truncate-lines t) (use-local-map cfw:details-mode-map) (setq major-mode 'cfw:details-mode mode-name "Calendar Details Mode") (setq buffer-undo-list t buffer-read-only t) (run-hooks 'cfw:details-mode-hook)) (defun cfw:details-kill-buffer-command () "Kill buffer and delete window." (interactive) (let ((win-num (length (window-list))) (next-win (get-buffer-window cfw:main-buf))) (when (and (not (one-window-p)) (> win-num cfw:before-win-num)) (delete-window)) (kill-buffer cfw:details-buffer-name) (when next-win (select-window next-win)))) (defun cfw:details-navi-next-command (&optional num) (interactive "p") (when cfw:main-buf (with-current-buffer cfw:main-buf (cfw:navi-next-day-command num) (cfw:show-details-command)))) (defun cfw:details-navi-prev-command (&optional num) (interactive "p") (when cfw:main-buf (with-current-buffer cfw:main-buf (cfw:navi-previous-day-command num) (cfw:show-details-command)))) (defun cfw:details-navi-next-item-command () (interactive) (let* ((count (or (get-text-property (point) 'cfw:row-count) -1)) (next (cfw:details-find-item (1+ count)))) (goto-char (or next (point-min))))) (defun cfw:details-find-item (row-count) "[internal] Find the schedule item which has the text properties as `cfw:row-count' = ROW-COUNT. If no item is found, this function returns nil." (loop with pos = (point-min) for next = (next-single-property-change pos 'cfw:row-count) for text-row-count = (and next (get-text-property next 'cfw:row-count)) while next do (when (eql row-count text-row-count) (return next)) (setq pos next))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; High level API ;; buffer (defun* cfw:open-calendar-buffer (&key date buffer custom-map contents-sources annotation-sources view sorter) "Open a calendar buffer simply. DATE is initial focus date. If it is nil, today is selected initially. This function uses the function `cfw:create-calendar-component-buffer' internally." (interactive) (save-excursion (let ((cp (cfw:create-calendar-component-buffer :date date :buffer buffer :custom-map custom-map :contents-sources contents-sources :annotation-sources annotation-sources :view view :sorter sorter))) (switch-to-buffer (cfw:cp-get-buffer cp))))) (defun* cfw:create-calendar-component-buffer (&key date buffer custom-map contents-sources annotation-sources view sorter) "Return a calendar buffer with some customize parameters. This function binds the component object at the buffer local variable `cfw:component'. The size of calendar is calculated from the window that shows BUFFER or the selected window. DATE is initial focus date. If it is nil, today is selected initially. BUFFER is the buffer to be rendered. If BUFFER is nil, this function creates a new buffer named `cfw:calendar-buffer-name'. CUSTOM-MAP is the additional keymap that is added to default keymap `cfw:calendar-mode-map'." (let* ((dest (cfw:dest-init-buffer buffer nil nil custom-map)) (model (cfw:model-abstract-new date contents-sources annotation-sources sorter)) (cp (cfw:cp-new dest model view date))) (with-current-buffer (cfw:dest-buffer dest) (set (make-local-variable 'cfw:component) cp)) cp)) ;; region (defun* cfw:create-calendar-component-region (&key date width height keymap contents-sources annotation-sources view sorter) "Insert markers of the rendering destination at current point and display the calendar view. This function returns a component object and stores it at the text property `cfw:component'. DATE is initial focus date. If it is nil, today is selected initially. WIDTH and HEIGHT are reference size of the calendar view. If those are nil, the size is calculated from the selected window. KEYMAP is the keymap that is put to the text property `keymap'. If KEYMAP is nil, `cfw:calendar-mode-map' is used." (let (mark-begin mark-end) (setq mark-begin (point-marker)) (insert " ") (setq mark-end (point-marker)) (save-excursion (let* ((dest (cfw:dest-init-region (current-buffer) mark-begin mark-end width height)) (model (cfw:model-abstract-new date contents-sources annotation-sources sorter)) (cp (cfw:cp-new dest model view date)) (after-update-func (lexical-let ((keymap keymap) (cp cp)) (lambda () (cfw:dest-with-region (cfw:component-dest cp) (let (buffer-read-only) (put-text-property (point-min) (1- (point-max)) 'cfw:component cp) (cfw:fill-keymap-property (point-min) (1- (point-max)) (or keymap cfw:calendar-mode-map)))))))) (setf (cfw:dest-after-update-func dest) after-update-func) (funcall after-update-func) cp)))) (defun cfw:fill-keymap-property (begin end keymap) "[internal] Put the given text property to the region between BEGIN and END. If the text already has some keymap property, the text is skipped." (save-excursion (goto-char begin) (loop with pos = begin with nxt = nil until (or (null pos) (<= end pos)) when (get-text-property pos 'keymap) do (setq pos (next-single-property-change pos 'keymap)) else do (setq nxt (next-single-property-change pos 'keymap)) (when (null nxt) (setq nxt end)) (put-text-property pos (min nxt end) 'keymap keymap)))) ;; inline (defun* cfw:get-calendar-text (width height &key date keymap contents-sources annotation-sources view sorter) "Return a text that is drew the calendar view. In this case, the rendering destination object is disposable. WIDTH and HEIGHT are reference size of the calendar view. If the given size is larger than the minimum size (about 45x20), the calendar is displayed within the given size. If the given size is smaller, the minimum size is used. DATE is initial focus date. If it is nil, today is selected initially." (let* ((dest (cfw:dest-init-inline width height)) (model (cfw:model-abstract-new date contents-sources annotation-sources sorter)) (cp (cfw:cp-new dest model view date)) text) (setq text (with-current-buffer (cfw:cp-get-buffer cp) (buffer-substring (point-min) (point-max)))) (kill-buffer (cfw:cp-get-buffer cp)) text)) ;;; debug (defun cfw:open-debug-calendar () (let* ((source1 (make-cfw:source :name "test1" :color "Lightpink3" :period-bgcolor "Lightpink1" :period-fgcolor "White" :opt-face '(:weight bold) :opt-period-face '(:slant italic) :data (lambda (b e) '(((1 1 2011) "A happy new year!") ((1 10 2011) "TEST2" "TEST3") (periods ((1 8 2011) (1 9 2011) "Range1") ((1 11 2011) (1 12 2011) "[Sample]Range2 1/8-1/9") ((1 12 2011) (1 14 2011) "long long title3")) )) :update (lambda () (message "SOURCE: test1 update!")))) (source2 (make-cfw:source :name "test2" :data (lambda (b e) '(((1 2 2011) "The quick brown fox jumped over the lazy dog. The internationalization and Localization are long words.") ((1 10 2011) "PTEST2 title subject" "PTEST3 multi-line sample") (periods ((1 14 2011) (1 15 2011) "Stack") ((1 29 2011) (1 31 2011) "PERIOD W")) )))) (asource1 (make-cfw:source :name "Moon" :data (lambda (b e) '(((1 4 2011) . "New Moon") ((1 12 2011) . "Young Moon") ((1 20 2011) . "Full Moon") ((1 26 2011) . "Waning Moon") )))) (asource2 (make-cfw:source :name "Moon" :data (lambda (b e) '(((1 5 2011) . "AN1") ((1 13 2011) . "AN2") ((1 20 2011) . "AN3") ((1 28 2011) . "AN4") )))) (event-source (make-cfw:source :name "Events" :color "DarkOrange" :data (lambda (b e) `(,(make-cfw:event :title "Shopping" :start-date '(1 17 2011)) ,(make-cfw:event :title "Other Thing" :start-date '(1 17 2011)) ,(make-cfw:event :title "Spring cleaning" :start-date '(1 15 2011) :location "Home" :description "Oh what a joy!!") ,(make-cfw:event :title "Meeting" :start-date '(1 16 2011) :start-time '(15 00) :location "Office" :description "Important talk") ,(make-cfw:event :title "Lunch" :start-date '(1 15 2011) :start-time '(13 15) :end-time '(14 30) :location "Fancy place" :description "Omnomnom") ,(make-cfw:event :title "Long one" :start-date '(1 17 2011) :description "This is a multiline description. Some text here. But also some here. And here.") (periods ,(make-cfw:event :title "Vacation bla bli blubb very long" :start-date '(1 13 2011) :end-date '(1 20 2011) :location "Beach" :description "Enjoy the sun!")) )))) (cp (cfw:create-calendar-component-buffer :date (cfw:date 1 10 2011) :view 'two-weeks :contents-sources (list source1 source2 event-source) :annotation-sources (list asource1 asource2)))) (cfw:cp-add-update-hook cp (lambda () (message "CFW: UPDATE HOOK"))) (cfw:cp-add-click-hook cp (lambda () (message "CFW: CLICK HOOK %S" (cfw:cursor-to-nearest-date)))) (cfw:cp-add-selection-change-hook cp (lambda () (message "CFW: SELECT %S" (cfw:cursor-to-nearest-date)))) (switch-to-buffer (cfw:cp-get-buffer cp)) )) (provide 'calfw) ;;; calfw.el ends here ;; (progn (eval-current-buffer) (cfw:open-debug-calendar)) ;; (progn (eval-current-buffer) (cfw:open-calendar-buffer)) emacs-calfw-master/calfw.juth000066400000000000000000000675511266572412200165460ustar00rootroot00000000000000PKy"? EntityStore}|ɱۉg/epNْN;ٲC AYM?ePF)`Fh t%Y;٧X|>\{}aX-55) 5KkdlZ>桻^kO, [IRA9b9 KTI@JQi6b-,x('&ud nY:ؾR'9a{yb2cHx2Nm*"bA)Qkk#|L5д&o3?(Dһ[Rr؞t?Iֲ, oa~K^5GkY=to &[pһ}trD4[XSH8(ӸķaDKngbD!x"}N)}$ >sT1|Ky7@ 4 QZ^{LHЋ֬Ghٱ P\jϒ{Η'Oaz‹O@\wߘfNv6{]T@k#& Ó`wJTM3lwORAOo ^aϒtCFlڎRaj0kcìEìM vɓ{CƎA ņQ^$ޥV@x|0έG(0u@1O v<ñhI٦CE1 ah7GԇLTdx4#6,܄,`exum'֠ƛaq[Z}̳[s!+ [vQAH$Gᛢ1cȪ_|,['=UDNd$CD XLi?)9[@`'dšO{D6`fVgj!^fBfV*]9 )ϙ;߿G;'8)02|%I";ڏoTwSf|r]lzp&d0nV˨qpzx9pVe/1(\Nb~ !P$( ThRH#DžHCl2R<6|zU;2=INDgJC KQE1LIRZcPcs`?UtOP64 zਗ਼2≵v?ELPS?NE?xmǩipc NP3#|c14- KNK˧n#yR"0N#0Hti$~SiߕDoK8bcy'N3|U]4;p.bto$y6rrcA|*(h *J8̟92Q}J5odRhƏUwSu;`;d7>2iG28Ք2l7覑9U310̧gCd %xvU}_OIFGj.R@bBB=A~=F4[)p.:L z:-煯щx,jȆb\rTQc[ =pf)2 KJ{!Wy6eڬ=Y-✸'ʣ8&TpGdULqdh"' sFK=?#n{[5jMųk$y6B@?ݹhȟ*G tt&T0+t&`#Lo ֵ6~M1((Q"+!=XR%ʻ^>l"܋><^3R,\ qzn!!Qx;譲S FoO]uSWK"7cDe tOC AhvW_GYxUo}Ku c+6Gn=gWs_gB!p&bT[ʵ|DX!kUݱ~b6658dqlXAϟ,~ή`a{1T(!ǎ]v>Rq4B6h~;){oВ떹|O5]Rr㽷t^5T@KlI9m.#Q űU?qK쁟CE ݯtNq?\gN?0\u/Ol̻㔗%]r‹?r~Goĵ+/q^Ǘ^* Qo '8ua UIkݒ\;.cM|t|ߏ^izwޅ=!Tx>ADf)@UyhaJ@, O!bެ-F7 MS=޹⎁;o4/f)/zV`|:XWfnK F0djFCCKU\\AN3{\^@"log|&ūf*'M]Ň&YH?^/ƻ1 *CB#bߋ07}mU/>'xO-H^(KJ]۔^0z;kXL2!Q2]\/>#X@Zъ%Ϯyb0À%]bc+<;\=OU H~zwy?wΟ4eb,D HWu氚HWG\1ة~r4K@< 8{>o~uC3[M+gC68ʹ["k]K_66mgjHb}LcҦ.m-)bZ} \nʂ&8lZuCZd|,iAAV235='ROczwwݮ*!8K;\&76O}x7\Tqwq]wT(!?t}Iu H ?x{0^P1mnHezaz`Г]w/  $dlz/>K%\)ˏAW.0rAӫ%w`c$& O6 :.;rtIOcCO SgnV!fP*!Pgڒ7 .hP4?_JPتsgnx_Zsժ7f" N7p&8z4!<-lIV3vKQ26?w&+0ئfM=$[S܌_ͭڸR.hE %` 0HrX=d!&SB7Wʳ/3"LvJzmj9fT#W'e3N,h9ۈ."H,ICwHק)WV-/Ramo(31כKZߗ~P@$inF%r @KLQ+˝&(TaI}c#v`c)I6exq\ Zb)p$1eO,Gd !yoϟSI- v"64$M."kh !Ee8Ҹ||fX>? R8@۔c=*uDsu7*ZL,(kAȎF_MD?jnb(KiغFװȞ4uɄcBވX%0n㴬"-Om`ZV+Ad)@.=Vu7W<7_ $u!z/tg DU[{cBߏ.tO ػraʦ.gK$l*.2N| Y΂d=+]=vGfu^t BIKe u1 ͚RLxf՘"O'鱨U!cd4jQYc]MІZASBe~MN˟;V.<~d%߭@@g$05&NJ`c5 dL!AO)y0pH~ԮlޘJ&{]Y[CF}LUw0L-]Ʋv1IlT~/LRNi !tg!"y3T/"t n'Le{ 36jWTݢLo!ݕZ*eҏ!cqpy9[ƧdTSv.8LO@Զl)v+&j[z OjM* tDn:0r< <&\U\p}9q@\p))ړ=sO'_dȈ8p7q^MStI =OL+_>qx8khۤ@埘/IR2; SiSO0C_0K[sЬ%+P,9K;CS"MQ|+Jw)}8̽-UGʋiyi|O 9Wd?Ɩ;-fUxbv-3tqA7wXVyliili K~4:NT^al{qDCr"(#ٛB%5d qtZ|J SRaf)M&ˡiܗC/fu!TɞgЊ_+L GB7d н9L8/v "5)n&nߧZ[7/lݘAr}x{Ay#~=I6O\?x}ׅ'ŏW@j*n>ܾmSpyfhv}J8cN/yzxuEP1͆:ohJφޭÆfKڏf< _/djC>ٻd}<MiC_vZRCemCgS>V%[y(kaQnL3ls7v!n(#͟źc d͊4d3A&cI'& (mn+8QQl񐑧a{kVo ڀdgؙ3k4 o5w4ww"\o}t6Tw{GI`{esN1qfb4O%ZqƐAok 4㾙bN4Hvp`Nb4z)cL(O8ێRajkcoEoM^+}6xt6b, '}0.4VѣP@!?y|HӗmD8n8 64!LBOs!ʃKp O(ch7폽}!I]%PLi{iRq4Cg=Nq?N맩c[!J_K_siMG٤`S#TyA~U7җ6W*\v[%Oy:42n%ܝƪݗKuoh('J=L p4OAU=HG60hi6^^…ˣ)Ug4J&gE|9zJ ">c𖝞7r˯Vs;? A0t^6L֤r+&kX1b olX҈F|vta~貰 ӭh0$aC%ru3c!guť6#.E6)? S:5dBhn 0ʿ3W"MM~k0U8ͽ$k4x3"L#Az|O%ϒ:H|=+Pt}pAMxSޖg7q j1me%?]0*%f+QVnVƐ)xP}iU>/`v:J߲=eNmKN"Rti9xdF=_C\ -9()`rr׮?kGlJRL:A0C g2u4м붌ɥBe=VrxLb~G-NCA@s[s`XU9e& `ّi֓k گ9 CZf. t+Be&<β\n T/ .p9?gR y%Wz&\pJ˳p._³zQ2M1LATVqc*cG_+tD8eXLmdOej&l2{% - 2-7A>}VY#ER ƀ1w8StI8+,xކSQΌL.-p'H<9p_ DXdq[C(:eV`rwC X|5xElckE1JU2)t4`8͈2¡"P 0Lpf#!HEZ0Ng͚ZIj7Zƃd"L9d‘.4A %vZp)6t(?̲RHV{BW+KJESШ420Tk[I.4գY_p@aMf9- R5p.\%hK8 EHUx(t9!&ɇQ _Iwl,b$Wχψ. }h,'|H9Ga𵲱Y!L@*~l4v ,CW'ddq̧i͉˳MI90[dh_jO05{9Pʱ viK?|0;MveBvU CU:1lg_*𓶟@QTaM΅ivgSs]W> ɻddwo@[Ƃ ó]v|9:O]i:z<ʏtCQGX8tRRȰЎA"eG=9Djj +ʆX#vɏ-!irԈP^97'# E`,F&F[g*BҖ)L"kWsF?E¤l6g7fo9Ll͚hJR\vXH70 朩3pӐ vL9 qeCyǥb9]Ś _vVJb2WOX0(-ּ1L!\+!ǘP0My>g   U"+?#<<1Vꘝ3"ݥ 杻MH~2"?7!gBB" 1Ȋtotwa}48DYmwtl $ջ= jE;.pĸXC9`׷0.J'.~BB8Cw3JF@i´he&3)74cWKRK\@T8`%&@Lp*l/Z%POF: 4%P[pVj{s#ui3y8BWesEXՍIj %577Y(BJ$>S4~mLu|MΫ x qA2l5L¦0anP#8l%xU(n(RxG6).(Ň(>,\ F Hߨ_prWR8 ; b/rAIk7417.-?Ix^g=Kޤ;fMMo0w_:-@& "u2'<̐AeuћRfjtUw0Lߕ G3Y螴1e2k,ۿ5Wﱐl?FY3ӓv#Lgaٖduv*!ɊwQ5)榿'Μ^1߻!G_-$Q3O21ˬufm7] 6ƾV,C4 J.2DL uFfe:RD+&b*.%pa ,<`N)+Yr%\ j)AQ˨{)΃@W`bdao~ƥ !T,z]Qqu2*(O8DS=K+w' +i2W2JzVz@ RAF{GD[B<?FCsYEM⿞ %Dxe?]{,87TBd6 O!t\.H9;r0g>2E{m:{gO@#o-:$j}\BC$ +-AfF3 IBp#`;dٗ~̣[KpQ\9t|wv\_qzD`KC<{ߝm-*$f˽Ƕm~cQC$ASJQ CI/f]*%%xRLjRMfU-10&$1(۩<1z&zu!ҋ1.!1 *!w{ SNC68TJ+2?j2DD!yߩGe w}W`œxQC,Qʲؗ9E}cۤ?.VS=.̾bF&AosbO蝧r&]v?}* UFm:" v{ϷC^T0C~+_mtOf ``cx xHN&t⣋jN~\zR1]9FL#9O4ԢkcBBk\IN).]JeDOʉ_XJ渰ݺNITgOFu[.-(69$fnֵfI΂ h:9dHgpk|s%SuzLcSEt2N2K^*.uOu Uｭϵu8;o[֬xSق* 3.Ғ=KmZ\:E^Աo{55x_>T":7ĵo?c- cYZ%?spz 3'rHVkg}z8z W~tS*4P[qW=A:C̸gG!}zrSt,| 9$3U?nf{wRs# $󿅢'4s&O; zVdSQss5l\0bSJSؖҿ4K}1T5_r; RDcO|CQ_bw}[w_rObn^?t!"Yq9.돋]^o䤼lQsԫv+ĝs/ /U@#Q ▋^ZvqUk-P!d/GL5Tx+ENɎ_,Aĵ2D~?Ь!cM\Ⴗ#( C ͙=ܬX /ҁ7rH~)+M *%Bcpn;ln{is63s892Y.iڵ p#\'0+ %-􅳼"7JGΙr9)|Kw|kuE";g+(r}WbxCyn[ZOStk3,x3$;sQA{r{F˯C3jY/*ENܪ݂Cι~ 8;µWss0m MjY79!|QZ|,+ۦ̭m1[[Xɭs rkW}1)0Nb^_pK˭j]0]"!!ۄlgKԤNjNEyiO;?_؅ yt 9h6kH烵yYO(,I'ќ)/d?F((hcݦukDQ,-ya<|cXDgti_M#ڽ&ҫ,G`ґ.A"5SuV(ӞA"oyR9%imLjTVOʗ?4eZNݩ~*7d;O;[ʭ?ל@`U|FO"hK~赿CH! F^COZ !O{ 1 TzKK,~?A?="P1m 3tlq#/ۼY9$5(K{zj{ J$K_Z} Clq ԨӐfϾu zŵS/w59dF͜'4Kc=g0h@!ioO%M";MH޴SNƴ1+j3n)T[}vqmeh/"חx!mnr:ʋ-\g1ys=UɸkE?u}CDKm.B?\yk!r0o讷"%zW{`#mNbO>},m*x Y]g=\L!{kdtۭȕ?<}rǃCh@z9뚋-«q4:SmO=9,ԕ^#SgP˄Š䩏ճ;u=I) f'O gad`8`ض .pm!<CƔsŚ[]ߌwuػj/4}M#iL qu_w+08o"aNo ц1HJNc'Doo=b,ߓꞷfN$5V'e2jmzQXs_xTOScQ+PaHIXCJ&5Uc=lV]Wtc`o@eww>p}<2{FU8oBB !`>絖a#s!C䝀X3%;#^ia7]h_M鳦rnA%0^:7U7/x2%L`/-8ՑKOR~V" }իk1 ZKBgeJdl"`Qt;POAĈz)JTHAXq#$8bۨzQX⹈ԩ򀱮M{§ 6{MTc@5Ǣ&(/I_U@+ҪPUDqPo2OMb-sD.|H^%f#sQ7q|KS}$ޕv|$]Ct2ͱ{iX;cGS颓oWo* v?ȳXۈq]lLaN]HxXH8R5-&5h;-^kc33xq/*aVOfaOELiRDHb xjm4!͹2 #^Py;" ֚P7J7ji7;/Mh&"Le&d+cc=ONX SoH^Gizɇ ;ԿYM$IL$wkk|jI *8m+FjT5bBCeOOFVɫ3Hd5ȫ) qX3GV"+S2ڊ&Po V"+3[yrMEҢNm`XP#ӧZMj$FT#sa|Ä?g=ӷZM$HT$-mEί׈dHE|>n| ӴR9-hBmj0ږbJH(ӊqeO`JRd\)Rh}"*Y(.zlv!>ir 7#_*?Sw$!E$BWG,cfk{u#LٷىD:2F?r -դ, )%Hh"ioO(u4(k\IX^i(LC4HJ֓~GssvZM$JLIOk9v&)['Vfaw2=UՠfvxW J7wW&UR?4 \Hgyaf/VHKIT7X*@eͦEH!9GҜ_{`sm?:76tLGFZ>fj%D+.S&(H<ܰ+C?UCs>OGBbsyOB} >T s[FRhϽxBѡBIs&9[;2%ӊMKGX zzy&g`?웩JM^_٬aJ 7<ԑjW#y5b!s W6j$F6xdOrդ,&)l vkMEY9~pL8FnH)y?tVR!_ؤ~$Mbi/ya] Z;Ij Ҳh$(K׬=I99oQiOY$\(3fX=33vs V6 D0ʮS,Pِi=M+ΧA$໦aT&"٠ߋ:=T7Q,9VOfԕ*O|d"RDH" hBsQ+W^;iAKg([EZ P •2Mo1pGuMO馿xuIK*ӯF.D5]eJTh(դ՘i u-ZiߩsXO7wUTiTMT-Ri/CҨGM+Cs_,=Dբ i)/]`GPCOC'L>OWa:.ʛXtXdͬEf(/O\$6EEEH49o@EEj1V@D$ĭK$D\j%FcQAKZ;&X\ݜ f`􍢃VhWM:SnX3޴e*.XM̚m1R:>[ѦaMɮ?@<|2GJ _$|rrR"8HKƏLiWJ\2A MfHp,&9 YAZgy) I<}XA2Q;H1hI~wDOӉ&Ym1$M+m7Z4cxwsr$jyGҜ-{i-/D:sβcL ,v;驜#I7trlR~1'} #Io_'QM}*a$!EG_MsG; 5]t2vhAG ɖD|=Gp5on=L\Ob\sw.氡qD|%'M3PYLܹ[&9fˁLy:yo?բ: \m S^!l}fzML>8=pxHC ?Vcw%-rDzVyJH [DH"l5(I#h&9w`xI[avTb!'fys*ѷ"ͮc+!uZ!Tš]Ӻ!@hCoY:ؾ颂tvV7s&F\N ӪmDUkY D̬FCxxCe]GoD[-#@xP[-#W48L(I#)T'wO`̱6<=P957?NtQRJ>#UCh&hhޝfG3BjWEV3VHCL7TVDl`U^ݴ3OsKha!E$V~MHsNyH ={GiyGO kzGw'Qᴿ"IYΑSVhsԨ:G#bBՏ,Mz9rV.U&9Y9鲼sFڱ 55Msu;hu u{&jf-7:zZrCG0fJ=kU۴-9X O'I3|ԋCKZ DŽQiE%)C<G4iE425"fXԘ\gJL`Cq9"yDZ) lFLYՋN4V,PM5ݬw8ݑ( 6K3H`I4gآ4,m֚6[4+u~EOP8&CKZ$9yxd(kZRB9G돬U`<Ԅ~I6բ*,&܂YHs2}Ck%hBmpO"n?6Aɔ3$$Y?V8'@ѯy3s"˭׼5~>~UVwkjG[`!*Ԗܚl.vn4!͹&Q)6E HJY0CIC՛kܱ:,΋ |򵕼J 97Z9PkOIVs,P yWBܢ? ٧DsiיsLZD5 s|MV:,c9~ ء:2p]x$9椀eU;1˛s-EqtI5VrΠs|vrBOܮ.tcP)& ZcP|ƕ}y3șNCL+\ʙ .[Xai7b?\LkN*C ?\F,ptrM04Y,phB-XJr:O:M+iL]b. _#_6"ɩpǎ OҊLi7b6, %9nE&,ЗN1cP 9q=Ǝ#AbIO5@:&T~E0+t&Y8fL6_bh&Píq[$L;㴈; ;b(htxTܢP{3G7SowsULE7hBތ^fV6^o ܙnou{5MuemOC>I4I͹@hkD5-?B=n*))Ȣ[S?.[nM4ܚF AeY7>US1+FG+Qݒ U҈ svY6m0漽 dE) z",Km]tx&T CczICn*B~`{1"m3ήOe{Aʰg q^9h{fǺMi{|g^paUXo̅*l{SGmAwg{U" uD✷z9h{M{%;o9#(Pm œ\*lڋ'l`#):&72M#خA.cFORބ.( jGs:zD҄BQDR%ȸ;)\ՎzlNGÛ|C' E㱸bq5JćAQ.A ХHt.lG:Hw뤽K ,/51q ݡ}_ t0,yPy h/%}獽#94dcTVM&)*Ks^[40xAIZZx^'~NȪ#|o>UJq2$#ji qPdّSdp F!u\7i[ DjpfB[#FZIߘ 1p)ykg%\]X{ECޝ2iSS<<'"J4H;*]n,:|>b-ҷH9@7dObRrd KRaAR)45XH&4dԥŜ# j Lc.o\%6Ь>z$ɞWBȃG\/Cv8*c)rtr;Aj=]d{RNɞD|$icFn%\E2fP<dX^uKH`,Q, qcc]Gl@` ظ~=8B,8DC49--ɚ8eҭ٤^d!jQ(:n&cHc?+s߽Q%-x֣j,V݌.S s ]jaVgWR 7x2 z] ]@YסK _ ?OhW4"_g³ L{5M{e9T Y![ =ߙ0>`tZ]Xyѥ|) ̅B/|  '-\.5'HtY*0qKXaE^`% ZG ہg/ :ex<<U= ;J>>fm .1q]U&/S '-# }Ĺp0y2LqD,y fo'Jap.|C@rīM`,&d-P1nI[Z0Z`33cNJȕA1g.|2105f߁<<]4oЕ-T@ ` 0x B,M2Ջ`{ __ j.ja|4tCvrh'2S"ǀ:$~9lN1U5 ?ςWH8uŽBO" mX }21=&}{ x(0;>|]wzV w 3`|RfE:/A, 7ޱ(n^3@S%s Vd0d(<FP q ċfF÷,t`]4* rY^S+cF|̌̄y9NqǩPP*JTm*ݰCHP$VbĂ%6H` -Hnas̽s}g%v)ò>5`yC( 6f ohr"؂|}q?h0pCTe#yx3ffc_y'+Z&%c4  xǣfȣae}+ ɻ EUio ZLۜ8{PGMSҗ ʖ9 hP庾SݒR5G9** %K5FAx,6q : ,",۶JX87jhDJ9<]h6<&D#)&Oa;\8SaK!NԣžMK 0I:5dwF $0LΎ’jܔPEjlaG˷qwd;`+_ "w5Fn\*9Kͱ⩣- J@Y2M H-U[8vS >&#T-)bJ:taM#`)g@I2?ǴbOß<*Ŋ&*u>"NXQ^|DöxŒ`nz]_ϭd"l @WnQR`h 6Ki1pK1; 'F͌[`iILY5[! ϘMb>ol8H%1Қ(ƚ?j8e cu4"1&,رNzFR9=(IV)DeQVfx81%)2σEedJh{$bk̐3K 0?5@?> Lh&&M"o^ ;/0 c}N;I{"HƄb޺Gbd>I/p.YQtd7QXs-ߖ@* '%eZyIgV>갈"ލ#%n*xQ8))k@ì-ݖVsZ yA*_P56)8b5ձJD֖&f=o(".A]jPHf(8lVVDThUIJ /qNǽaEc5Sg&݄ULCXVdTPB75ՠ=Yo1CM n0b΄b-8A  uv[17}HōE!8[B=XVD6u5Aإh QI{Ԭcgvܟ/+:k*ܪI,|+ 5(^F8bjhn[jfʣ̘YǬyt!qoS4o]!`)ޣj?"Xf]f([+~$"H2uc<-`A,Ŷ@# + 7^ ;gW?;w~ҹ(޿yvx(^=r .?c7dL4s:Y]Ln_x~8yZto򿧂ƝPK-%KnݝPKy"?-%Knݝ EntityStorePK9oemacs-calfw-master/readme.md000066400000000000000000000707331266572412200163310ustar00rootroot00000000000000# Calfw - A calendar framework for Emacs ## What is calfw? This program displays a calendar view in the Emacs buffer. ![Calfw image](https://cacoo.com/diagrams/OnjKgBHat0kHs0xp-9E5E0.png?width=600) ### Screenshots Currently, calfw has 4 views, month, 1week, 2week and day view. ![Views](https://cacoo.com/diagrams/OnjKgBHat0kHs0xp-F3756.png?width=600) Pushing SPC key, the detail buffer pops up. Pushing SPC key again, the buffer is closed. ![Pop up details](https://cacoo.com/diagrams/OnjKgBHat0kHs0xp-83C80.png?width=600) Many information items are displayed in the Emacs buffer. ![View details](https://cacoo.com/diagrams/OnjKgBHat0kHs0xp-B961B.png?width=600) ## Installation To use this program, locate this file to load-path directory, and add the following code to your .emacs. ```el (require 'calfw) ``` Executing the command `cfw:open-calendar-buffer`, switch to the calendar buffer. You can navigate the date like calendar.el. Schedule data which are shown in the calendar view, are collected by a list of the struct `cfw:source` objects through the named argument variables `:contents-sources` and `:annotation-sources`. The former source defines schedule contents. The later one does date annotations like the moon phases. This program gets the holidays using the function `calendar-holiday-list`. See the document for the holidays.el and the Info text. ## Key bindings In the calendar buffer and region, you can use following key bindings: | Navigation | | |---------------------|----------------------------------------------| | [left], b, h | Previous day | | [right], f, l | Next day | | [up], p, k | Previous week | | [down], n, j | Next week | | ^ | Week begin | | $ | Week end | | [home] | First date in this month | | [end] | Last date in this month | | M-v, [PgUp], < | Previous month | | C-v, [PgDown], > | Next month | | t | Today | | g | Absolute date (YYYY/MM/DD) | | TAB | Next item in a day | | Changing View | | |---------------------|----------------------------------------------| | M | Month view | | W | 1 Week view | | T | 2 Week view | | D | Day view | | Operation | | |---------------------|----------------------------------------------| | r | Refresh data and re-draw contents | | SPC | Pop-up detail buffer (like Quicklook in Mac) | | RET, [click] | Jump (howm, orgmode) | | q | Bury buffer | The buttons on the toolbar can be clicked. ## Add-ons: Following programs are also useful: - calfw-howm.el : Display howm schedules (http://howm.sourceforge.jp/index.html) - calfw-ical.el : Display schedules of the iCalendar format, such as the google calendar. - calfw-org.el : Display org schedules (http://orgmode.org/) - calfw-cal.el : Display diary schedules. ## Setting example: ### For howm users: ```el (eval-after-load "howm-menu" '(progn (require 'calfw-howm) (cfw:install-howm-schedules) (define-key howm-mode-map (kbd "M-C") 'cfw:open-howm-calendar) )) ``` If you are using Elscreen, here is useful. ```el (define-key howm-mode-map (kbd "M-C") 'cfw:elscreen-open-howm-calendar) ``` You can display a calendar in your howm menu file. ``` %here%(cfw:howm-schedule-inline) ``` ![howm menu embedding](https://cacoo.com/diagrams/vrScI4K2QlmDApfd-1F941.png?width=450) ### For org users: (require 'calfw-org) Then, M-x `cfw:open-org-calendar`. ![org-agenda and calfw-org](https://cacoo.com/diagrams/S6aJntG6giGs44Yn-89CB2.png?width=450) #### Filtering agenda items You can choose agenda items with `cfw:org-agenda-schedule-args`, like following code: ```el (setq cfw:org-agenda-schedule-args '(:timestamp)) ``` This setting restricts items containing a date stamp or date range matching the selected date. If `cfw:org-agenda-schedule-args` is `nil`, the default customize variable `org-agenda-entry-types` is used. For the further information, please refer the orgmode document. - [Worg: Speeding up custom agenda commands](http://orgmode.org/worg/org-tutorials/org-custom-agenda-commands.html#sec-5) #### Orgmode like key bindng You can use another key binding like org agenda buffer, setting `cfw:org-overwrite-default-keybinding` to non-nil, like following code: ```el (setq cfw:org-overwrite-default-keybinding t) ``` Then, following key bindings are overwritten: | key | function |-------|---------------------------------------- | g | Refresh data and re-draw contents (cfw:refresh-calendar-buffer) | j | Goto the specified date (cfw:org-goto-date) | k | org-capture | x | Close calfw and other buffers opened by calfw-org (cfw:org-clean-exit) | d | Day view (cfw:change-view-day) | v d | Day view (cfw:change-view-day) | v w | 1 Week view (cfw:change-view-week) | v m | Month View (cfw:change-view-month) #### Synchronization with google calendar Here is the program which helps synchronization schedule items between org and google calendar, and also collaborates with calfw. - https://github.com/myuhe/org-gcal.el - [Org-modeとGoogle calendar間で予定をやりとりするorg-gcal.elというのを作りました](http://sheephead.homelinux.org/2014/03/14/7023/) - [calfwとorg-gcalの連携](http://sheephead.homelinux.org/2014/03/15/7035/) ### For iCal (Google Calendar) users: Here is a minimum sample code: ```el (require 'calfw-ical) (cfw:open-ical-calendar "http://www.google.com/calendar/ical/.../basic.ics") ``` ![Google Calendar and calfw-ical](https://cacoo.com/diagrams/vrScI4K2QlmDApfd-5E808.png?width=450) Here is the add-on program which communicate with google calendar via API: - [calfwからGoogleカレンダーを編集するcalfw-gcal.elを書いてみた](http://sheephead.homelinux.org/2011/01/18/6559/) - https://github.com/myuhe/calfw-gcal.el/blob/master/calfw-gcal.el ### For diary users: Here is a minimum sample code: ```el (require 'calfw-cal) ``` Then, M-x `cfw:open-diary-calendar`. If you see a blank entry for each day, set the variable `diary-list-include-blanks` to nil. ### General setting The calfw view can display many schedule items, gathering some schedule sources. Using the function `cfw:open-calendar-buffer` is the general way to display the schedules. Here is the sample code: ```el (require 'calfw-cal) (require 'calfw-ical) (require 'calfw-howm) (require 'calfw-org) (defun my-open-calendar () (interactive) (cfw:open-calendar-buffer :contents-sources (list (cfw:org-create-source "Green") ; orgmode source (cfw:howm-create-source "Blue") ; howm source (cfw:cal-create-source "Orange") ; diary source (cfw:ical-create-source "Moon" "~/moon.ics" "Gray") ; ICS source1 (cfw:ical-create-source "gcal" "https://..../basic.ics" "IndianRed") ; google calendar ICS ))) ``` The function `cfw:open-calendar-buffer` receives schedules sources via the named argument `:contents-sources`. One can customize the keymap on the calendar buffer with the named argument `:custom-map` of `cfw:open-calendar-buffer`. ## Customize ### Holidays The calfw collects holidays from the customize variable `calendar-holidays` which belongs to holidays.el in the Emacs. See the document and source of holidays.el for details. ### Format of month and week days The calfw uses some customization variables in the calendar.el. Here is a customization code: ```el ;; Month (setq calendar-month-name-array ["January" "February" "March" "April" "May" "June" "July" "August" "September" "October" "November" "December"]) ;; Week days (setq calendar-day-name-array ["Sunday" "Monday" "Tuesday" "Wednesday" "Thursday" "Friday" "Saturday"]) ;; First day of the week (setq calendar-week-start-day 0) ; 0:Sunday, 1:Monday ``` ### Faces One can customize the faces. Here is a template code for face customization: ```el (custom-set-faces '(cfw:face-title ((t (:foreground "#f0dfaf" :weight bold :height 2.0 :inherit variable-pitch)))) '(cfw:face-header ((t (:foreground "#d0bf8f" :weight bold)))) '(cfw:face-sunday ((t :foreground "#cc9393" :background "grey10" :weight bold))) '(cfw:face-saturday ((t :foreground "#8cd0d3" :background "grey10" :weight bold))) '(cfw:face-holiday ((t :background "grey10" :foreground "#8c5353" :weight bold))) '(cfw:face-grid ((t :foreground "DarkGrey"))) '(cfw:face-default-content ((t :foreground "#bfebbf"))) '(cfw:face-periods ((t :foreground "cyan"))) '(cfw:face-day-title ((t :background "grey10"))) '(cfw:face-default-day ((t :weight bold :inherit cfw:face-day-title))) '(cfw:face-annotation ((t :foreground "RosyBrown" :inherit cfw:face-day-title))) '(cfw:face-disable ((t :foreground "DarkGray" :inherit cfw:face-day-title))) '(cfw:face-today-title ((t :background "#7f9f7f" :weight bold))) '(cfw:face-today ((t :background: "grey10" :weight bold))) '(cfw:face-select ((t :background "#2f2f2f"))) '(cfw:face-toolbar ((t :foreground "Steelblue4" :background "Steelblue4"))) '(cfw:face-toolbar-button-off ((t :foreground "Gray10" :weight bold))) '(cfw:face-toolbar-button-on ((t :foreground "Gray50" :weight bold)))) ``` ### Grid frame Users can have nice unicode grid frame. However, in the some environment, the Emacs can not display the grid characters correctly. Please try following settings. Grid setting example: ```el ;; Default setting (setq cfw:fchar-junction ?+ cfw:fchar-vertical-line ?| cfw:fchar-horizontal-line ?- cfw:fchar-left-junction ?+ cfw:fchar-right-junction ?+ cfw:fchar-top-junction ?+ cfw:fchar-top-left-corner ?+ cfw:fchar-top-right-corner ?+ ) ;; Unicode characters (setq cfw:fchar-junction ?╋ cfw:fchar-vertical-line ?┃ cfw:fchar-horizontal-line ?━ cfw:fchar-left-junction ?┣ cfw:fchar-right-junction ?┫ cfw:fchar-top-junction ?┯ cfw:fchar-top-left-corner ?┏ cfw:fchar-top-right-corner ?┓) ;; Another unicode chars (setq cfw:fchar-junction ?╬ cfw:fchar-vertical-line ?║ cfw:fchar-horizontal-line ?═ cfw:fchar-left-junction ?╠ cfw:fchar-right-junction ?╣ cfw:fchar-top-junction ?╦ cfw:fchar-top-left-corner ?╔ cfw:fchar-top-right-corner ?╗) ``` ### Line breaking If a content string is longer than the cell width, the calfw breaks into the multiple lines. In the current implementation, the Calfw has 3 strategies: none, simple and wordwrap. The variable `cfw:render-line-breaker` selects the strategy to break lines. - `cfw:render-line-breaker-none` - Never breaks lines. Longer contents are truncated. - `cfw:render-line-breaker-simple` (default) - This strategy breaks lines with rigid width. This may be not so beautiful, but In the most cases it looks good. - `cfw:render-line-breaker-wordwrap` - This strategy breaks lines with the emacs function `fill-region`. Although, the line breaking algorithm of the Emacs is not so smart as more complicated ones, such as Knuth/Plass algorithm, this strategy is better than the simple one. ## Calfw framework details In this section, I would explain how to add a new calendar source and how to embed the calfw component in the other applications. ### How to add a new calendar source? Defining the `cfw:source` object, one can extend calfw calendar source. #### struct cfw:source details The struct `cfw:source` is a simple data type defined by cl-defstruct. Here is the details of the slot members of `cfw:source`. | slot name | description | |-----------------|------------------------------------------------------------------------------------------------------------------------------------ | | name | [required] Source name. This name is shown at the status bar. | | data | [required] Data function which returns calendar contents. The function details are described in the next section. | | update | [option] Update function. Calfw calls this function when this source needs to refresh the data. | | color | [option] Color string for this source. Color names those are shown by `M-x list-colors-display` or RGB hex format like "#abcdef". | | period-fgcolor | [option] Foreground color for period items. The default color is white or black. | | period-bgcolor | [option] Background color for period items. The default color is `cfw:source-color`. | | opt-face | [option] Additional options for the normal item face. Ex. `:opt-face '(:weight bold)` | | opt-period-face | [option] Additional options for the period item face. | Only `name` and `data` slots are essential. Many slots are visual options. In many cases, one has to specify only the `color` slot for visual, because the calfw chooses appropriate colors for the rest color options. #### cfw:source-data details This section explains what objects the function-slot `cfw:source-data` should return. The function-slot `cfw:source-data` receives two arguments, start and end date of the query period, and returns a list of instances of `cfw:event` struct. Here is a simple example. `cfw:source-data example1:` ```el ;; cfw:source-data example (defun sample-data1 (b e) (list (make-cfw:event :title "item1" :start-date (cfw:date 1 1 2011)) (make-cfw:event :title "item2-1" :start-date (cfw:date 1 10 2011)) (make-cfw:event :title "item2-2" :start-date (cfw:date 1 10 2011)) )) (cfw:open-calendar-buffer :date (cfw:date 1 1 2011) :contents-sources (list (make-cfw:source :name "test1" :data 'sample-data1))) ``` Evaluating this code in the scratch buffer, following result is displayed. ![Simple source example](https://cacoo.com/diagrams/P6baUrxEQj4NYheV-50310.png?width=450) The date is specified by `cfw:date` type, `([month] [day] [year])`. This format is commonly used in calendar.el and orgmode. (I diagrammed the exchange ways for some time and date formats in Emacs, [here](https://cacoo.com/diagrams/lsA64PTazlLTbSwR).) Period items are little different. One period item is specified by `:start-date` and `:end-date`, and the nested list which has the symbol `periods` at the head collects them, like the following code. `cfw:source-data example2:` ```el ;; cfw:source-data period items (defun sample-data2 (b e) (list (make-cfw:event :title "Item1" :start-date (cfw:date 1 15 2011)) (list 'periods (make-cfw:event :title "Period item" :start-date (cfw:date 1 8 2011) :end-date (cfw:date 1 9 2011) :description "Period item description") (make-cfw:event :title "Next item" :start-date (cfw:date 1 11 2011) :end-date (cfw:date 1 12 2011) :description "Next item description")))) (cfw:open-calendar-buffer :date (cfw:date 1 1 2011) :contents-sources (list (make-cfw:source :name "test2" :data 'sample-data2))) ``` Evaluating this code in the scratch buffer, following result is displayed. ![Range items example](https://cacoo.com/diagrams/P6baUrxEQj4NYheV-40315.png?width=450) Here are other detailed specifications. - The both start and end date are included by the query period. - The items those aren't included in the query period are ignored. - `cfw:source-data` should return a value as fast as possible, because users are waiting for the result. Caching is good idea. - Schedule items don't have to be ordered. Duplicated items may be gathered. - In the day cell, the items are sorted by `string-lessp`, i.e. numerical and alphabetical order. - The ordering function can be customized by the named argument `:sorter` of the component construction. In the above examples, the dates of the schedule items are fixed. The actual sources generate result values by the programs. The codes of calfw add-ons may be helpful for your implementation. ##### cfw:event struct detail The `cfw:event` struct: | slot name | description | |---------------|---------------------------------------------| | `title` | event title [string] | | `start-date` | start date of the event [cfw:date] | | `start-time` | start time of the event (optional) | | `end-date` | end date of the event [cfw:date] (optional) | | `end-time` | end of the event (optional) | | `description` | event description [string] (optional) | | `location` | location [string] (optional) | | `source` | [internal] source of the event | ##### Event formatting The framework has several formatting functions for `cfw:event` instances. The functions are used by the calfw plugins (cal,ical, etc) to display in a common way. | Format function | Description | |-----------------------------|-------------------------------------------------------------| | `cfw:event-overview` | To get an overview of the event (month, 2-week & week view) | | `cfw:event-days-overview` | Overview in day-view. | | `cfw:event-period-overview` | Overview of periods (same for all views) | | `cfw:event-detail` | Detailed information of the event for the detail-view | The formatting can be customized by the user with several formatting strings: - `cfw:event-format-overview` - `cfw:event-format-days-overview` - `cfw:event-format-period-overview` - `cfw:event-format-detail` - `cfw:event-format-title` - `cfw:event-format-start-date` - `cfw:event-format-start-time` - `cfw:event-format-end-date` - `cfw:event-format-end-time` - `cfw:event-format-location` - `cfw:event-format-description` #### Examples - [calfw-git.el](https://gist.github.com/kiwanami/d77d9669440f3336bb9d) - Displaying git commit history items in calfw calendar view - [calfw-syobocal.el](https://gist.github.com/kiwanami/1fd257fc1e8907d4d92e) - Retrieving schedule items via Web API and displaying them in calfw calendar view #### Another way to define schedule items (legacy method) *This subsection explains legacy method to define schedule items, so as for users to read old source codes. We should not use this method in the future.* The function-slot `cfw:source-data` receives two arguments, start and end date of the query period, and returns an alist that consists of ([date] . ([item1] [item2] ... )). Here is a simple example. `cfw:source-data example1:` ```el ;; cfw:source-data example (defun sample-data1 (b e) '( ((1 1 2011) . ("item1")) ((1 10 2011) . ("item2-1" "item2-2")) )) (cfw:open-calendar-buffer :date (cfw:date 1 1 2011) :contents-sources (list (make-cfw:source :name "test1" :data 'sample-data1))) ``` Period items are little different. One period item is specified by `([start date] [end date] [content])` and the `periods` record of the alist collects them as a list, like the following code. `cfw:source-data example2:` ```el ;; cfw:source-data period items (defun sample-data2 (b e) '( ((1 8 2011) . ("item1")) (periods ((1 8 2011) (1 9 2011) "period item") ((1 11 2011) (1 12 2011) "next item")) )) ;; (A . (B C) ) is equivalent to (A B C) (cfw:open-calendar-buffer :date (cfw:date 1 1 2011) :contents-sources (list (make-cfw:source :name "test2" :data 'sample-data2))) ``` ### How to embed the calfw component in the other applications? In this section, the details of calfw components would be explained so as for users to extend calfw in themselves. Calfw is built on the MVC architecture, using simple structure objects and modules employed by naming rules. #### Calfw component Calfw has three destination components to display the calendar. - Independent buffer - Region in the other buffer - Text output ##### Buffer The 'buffer' destination displays the calendar view as ordinary Emacs applications do. The function `cfw:open-calendar-buffer` makes a new calendar buffer (calfw buffer) and displays it by `switch-to-buffer`. The major mode of the calfw buffer is `cfw:calendar-mode` and the keymap `cfw:calendar-mode-map` is bound. This destination is easy to use for applications and users, because the buffer is usual application boundary and users know how to use buffers. ##### Region The 'Region' destination embeds the calendar view in the buffer which is managed by the other applications. This destination can give the other applications a nice calendar view. See the howm embedding for example. Let's try a demonstration. Evaluate this code in your scratch buffer. Region destination example: ```el ;; Evaluate this code in the scratch buffer (require 'calfw) (cfw:create-calendar-component-region :height 10) ``` Then, the calendar view will be embedded in the scratch buffer like the following screenshot. You can navigate the calfw view in the buffer. Undoing for the some times, you can remove the calfw view. ![calfw in the scratch buffer](https://cacoo.com/diagrams/P6baUrxEQj4NYheV-B9649.png?width=600) Because this destination never interacts anything out of the region and has its own key-binds as a text property, users can easily embed a calendar view in the other applications. ##### Text The 'text' destination generates just a text which represent calfw view. The function `cfw:get-calendar-text` returns the text. ##### Destination and View Three destinations are explained as mentioned above. Although they have different appearance, the application can operate the calfw component in the same way. Let us call them 'destination', it is the abstraction of UI components. The similar word 'view' means in which form the calfw displays the contents, for example, monthly form, two-weeks and weekly one and etc. #### Calfw objects ##### Overview The calfw consists of four objects: - `cfw:component` that gathers following objects up. - `cfw:model` that manages calendar contents. - `cfw:source` that defines schedule items. - `cfw:dest` that is abstraction of destinations. The relations between the objects are displayed as UML class diagram ([Diagrammed by astah](http://astah.change-vision.com/ja/:title=Astah)). ![Overview for calfw objects](https://cacoo.com/diagrams/P6baUrxEQj4NYheV-EC8C6.png) `cfw:component` acts as Controller of MVC. It connects model object and destination one, and controls all events. It also gives the interface of calfw objects for the other applications. `cfw:model` and `cfw:source` act as Model of MVC. They manage the schedule contents and calendar logic. `cfw:dest` acts as View of MVC. It abstracts the common interface from UI destinations. ##### cfw:component The object `cfw:component` controls calfw objects and events. The object has following information: - References to `cfw:dest` object and `cfw:model` one. - Selected date on the calfw component. - View style. - Hooks - `update-hooks` - `selection-change-hooks` - `click-hooks`. The object has following operations: - Getting object references to `cfw:dest`, `cfw:model`, belonging buffer and so on. - Getting and setting the selected date (`get-selected-date` / `set-selected-date`). - Getting and setting the view style (`get-view` / `set-view`). - The view style is a symbol, such as `month`, `two-weeks`, `week` and `day`. - Resizing and refreshing the view (`resize` / `update`). - Managing hooks (`add-xxx-hook` / `remove-xxx-hook`) After construction of the calfw component, the destination object can not be changed. The views are defined as a function and dispatched by the function `cfw:cp-dispatch-view-impl`. The instance of the calfw component is stored at following places: - `buffer` destination: the buffer-local variable `cfw:component` - `region` destination: the text property `cfw:component` - `text` destination: N/A Calling the utility function `cfw:cp-get-component`, one can obtain the calfw instance at the appropriate places. The stateless functions, such as simple event handler functions, can use this function to get the instance. The applications those have the state-full operations, however, should hold their own calfw instance for the safety object reference. ##### cfw:model The object `cfw:model` gathers schedule sources and gives a common interface for view functions to access the contents. The object has following information: - contents source objects (`contents-sources`) - annotation source objects (`annotation-sources`) - sorting function (`sorter`) The model object has no information of views and destinations, just manages schedule contents. The holidays are retrieved from the global function `calendar-holiday-list` of calendar.el. The schedule contents are modified through the model object after the component construction. (In the current implementation, the model object is build by alist. Then, view functions adds some data as view model. I think it is not good solution, so the implementation may be modified in future.) ##### cfw:dest The object `cfw:dest` abstracts rendering destinations and gives a common interface of rendering operation to view functions. The object has following information: - destination buffer object (`buffer`) - region functions (`min-func`, `max-func`) - reference size (`width`, `height`) - clearing function (`clear-func`) - advice functions (`before-update-func`, `after-update-func`) - overlay data (`select-ol`, `today-ol`) In the current implementation, `cfw:dest` has three forms, buffer, region and text, mentioned above. Actually, the region destination is what I want. One buffer can have some destination objects, because all data (including local-variables and keymaps) are packed in the `cfw:dest` object. #### Application design In this section, I would describe a simple guide line of application design using calfw. One can use calfw as an application UI (like calfw-howm) or dialog UI for selecting a date (like calendar.el). The user application can choose the destination style: buffer or region. Switching between them is very easy. The data presentation can be achieved by defining `cfw:source` object. It may be straightforward. The input events by the user can be caught by hooks in the `cfw:component`. Then, the selected date is obtained by the function `cfw:cursor-to-nearest-date` or `cfw:cursor-to-date`. The current implementation, calfw can not treat a range on the calendar. Generally, any events can be caught by the custom keymap which is given by the named argument `:custom-map` with component construction. Furthermore, because calfw reserves the text properties (face, keymap and so on) on the text that is returned by `cfw:source` objects, one can control event handling at each characters. Once the model is modified, update function of the `cfw:component` object should be called to refresh the view. The summary diagram is here. ![Summary of application design](https://cacoo.com/diagrams/P6baUrxEQj4NYheV-465D4.png) See the calfw-howm.el code for more details. ## History - 2015/09/24 ver 1.5 : Fixed bugs and added some customize variables. - 2015/02/27 ver 1.4 : Introduced cfw:event struct, improved some functions, fixed some bugs. - 2011/10/10 ver 1.3 : Improved visual and navigation: multi-line, moving items in a day, diary mode and so on. - 2011/07/20 ver 1.2 : Merged many patches and improved many and bug fixed. - 2011/07/05 ver 1.0 : Refactored the whole implementation and design. Improved UI and views. - 2011/01/07 ver 0.2.1 : Supporting org-agenda schedules. - 2011/01/07 ver 0.1 : First release. Supporting howm and iCal schedules. -------------------------------------------------- SAKURAI, Masashi m.sakurai atmark kiwanami.net Time-stamp: <2015-09-24 11:47:57 sakurai>