pax_global_header00006660000000000000000000000064150753576600014530gustar00rootroot0000000000000052 comment=9cce503eb0e998389485a74b956884d218a960e2 kiwanami-emacs-calfw-6112605/000077500000000000000000000000001507535766000156765ustar00rootroot00000000000000kiwanami-emacs-calfw-6112605/CHANGELOG.md000066400000000000000000000014211507535766000175050ustar00rootroot00000000000000 ## 2.0 - Renamed all symbols to start with the package name. - Added `calfw-compat` for compatibility with old code. - Fixed documentation to adhere to checkdoc guidelines. - Removed `[internal]` crumbs, using `--` in the function name instead. ## 1.7 This fork has the following change - Applied three external pull requests (See Pull requests for more info) - Implement a `noerror` mode for `cfw:cp-get-component` - Showing calendars on separate lines and allowing showing/hiding of them. - Removed everything to do with selecting a date, preferring instead to use the point to indicate selection. - Changed colouring of background/foreground. - Removed M-v and C-v binding. - Cleaned up some of the code and using more standard functions, though much more can be done (WIP). kiwanami-emacs-calfw-6112605/Makefile000066400000000000000000000025171507535766000173430ustar00rootroot00000000000000# Taken from radian SHELL := bash ELFILES := $(wildcard *.el) ELCS := $(ELFILES:.el=.elc) VERSION ?= CMD ?= PACKAGE_LINT=@(emacs --batch --eval '(princ (file-name-directory (locate-library "package-lint")))') PACKAGE_LINT="$(HOME)/.config/emacs/.elocal/straight/repos/package-lint/" .PHONY: all all: $(ELCS) %.elc: %.el @echo ">>> Processing $< ..." # checkdoc -@emacs --batch -L . \ --eval "(require 'checkdoc)" \ --eval "(checkdoc-file \"$<\")" # Package lint -@emacs --batch -L "${PACKAGE_LINT}" \ --eval "(with-temp-buffer (insert-file-contents \"$<\") \ (emacs-lisp-mode) (require 'package-lint) (package-lint-buffer))"; # checkindent -@tmpdir="$$(mktemp -d)"; \ emacs --batch \ --eval "(find-file \"$<\") (emacs-lisp-mode)" \ --eval "(let ((inhibit-message t)) (indent-region (point-min) (point-max)))" \ --eval "(write-file \"$$tmpdir/indented.el\")"; \ (diff <(cat "$<" | nl -v1 -ba | sed 's/\t/: /') \ <(cat "$$tmpdir/indented.el" | nl -v1 -ba | sed 's/\t/: /')) \ | grep -F ">" | grep -o "[a-z].*" | grep . && exit 1 || true @# longlines @#-@awk '(length($$0) >= 80 && $$0 !~ /https?:\/\//) { printf "%s:%d: %s\n", FILENAME, NR, $$0 }' "$<" | (! grep .) # compile -@emacs --batch -L . -f batch-byte-compile $< # clean -@rm -f $@ .PHONY: clean clean: ## Remove build artifacts @rm -f *.elc kiwanami-emacs-calfw-6112605/calfw-cal.el000066400000000000000000000166751507535766000200700ustar00rootroot00000000000000;;; calfw-cal.el --- Calendar view for diary -*- lexical-binding: t -*- ;; Copyright (C) 2011 SAKURAI Masashi ;; Author: SAKURAI Masashi ;; Maintainer: Al Haji-Ali ;; Version: 2.0 ;; Keywords: calendar, org ;; Package-Requires: ((emacs "28.1") (calfw "2.0")) ;; URL: https://github.com/haji-ali/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: ;; Display diary items in the calfw buffer. ;; (require 'calfw-cal) ;; ;; M-x calfw-cal-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 calfw-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 calfw-cal--entry-to-event (date string) "Create a `calfw-event` from a diary entry STRING on DATE. Return the `calfw-event`." (let* ((lines (split-string (replace-regexp-in-string "[\t ]+" " " (string-trim string)) "\n")) (first (car lines)) (desc (mapconcat 'identity (cdr lines) "\n")) (title (progn (string-match calfw-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-calfw-event :title (apply 'propertize title properties) :start-date date :start-time (when start (calfw-parse-str-time start)) :end-time (when end (calfw-parse-str-time end)) :description (apply 'propertize desc properties)))) (defun calfw-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 calfw-cal-text-keymap (let ((map (make-sparse-keymap))) (define-key map [mouse-1] 'calfw-cal-onclick) (define-key map (kbd "") 'calfw-cal-onclick) map) "Key map on the calendar item text.") (defun calfw-cal--schedule-period-to-calendar (begin end) "Return calfw calendar items between BEGIN and END from diary schedule data." (let ((all (diary-list-entries begin (1+ (calfw-days-diff begin end)) t)) non-periods periods) (cl-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 (cl-loop for (date string . rest) in non-periods collect (calfw-cal--entry-to-event date string)) (list (cons 'periods (cl-map 'list (function (lambda (period) (let ((spec (read (substring (car period) 2)))) (cond ((eq calendar-date-style 'american) (list (list (nth 1 spec) (nth 2 spec) (nth 3 spec)) (list (nth 4 spec) (nth 5 spec) (nth 6 spec)) (cdr period))) ((eq calendar-date-style 'european) (list (list (nth 2 spec) (nth 1 spec) (nth 3 spec)) (list (nth 5 spec) (nth 4 spec) (nth 6 spec)) (cdr period))) ((eq calendar-date-style 'iso) (list (list (nth 2 spec) (nth 3 spec) (nth 1 spec)) (list (nth 5 spec) (nth 6 spec) (nth 4 spec)) (cdr period))))))) periods)))))) (defvar calfw-cal-schedule-map (calfw--define-keymap '(("q" . kill-buffer) ("i" . calfw-cal-from-calendar))) "Key map for the calendar buffer.") (defun calfw-cal-create-source (&optional color) "Create diary calendar source. COLOR is the color to use for diary entries. Returns the calendar source." (make-calfw-source :name "calendar diary" :color (or color "SaddleBrown") :data 'calfw-cal--schedule-period-to-calendar)) (defun calfw-cal-open-diary-calendar () "Open the diary schedule calendar in the new buffer." (interactive) (save-excursion (let* ((source1 (calfw-cal-create-source)) (cp (calfw-create-calendar-component-buffer :view 'month :custom-map calfw-cal-schedule-map :contents-sources (list source1)))) (switch-to-buffer (calfw-cp-get-buffer cp))))) (defun calfw-cal-from-calendar () "Insert a new item. This command should be executed on the calfw calendar." (interactive) (let* ((mdy (calfw-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 (calfw-date m d y) t t)))) ;; (progn (eval-current-buffer) (calfw-cal-open-diary-calendar)) (provide 'calfw-cal) ;;; calfw-cal.el ends here kiwanami-emacs-calfw-6112605/calfw-compat.el000066400000000000000000000750111507535766000206010ustar00rootroot00000000000000;;; calfw-compat.el --- Backward compatibility for calfw -*- lexical-binding: t -*- ;; Copyright (C) 2025 Al Haji-Ali ;; Author: Al Haji-Ali ;; Version: 2.0 ;; Keywords: calendar, org ;; Package-Requires: ((emacs "28.1") (calfw "2.0")) ;; URL: https://github.com/haji-ali/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: ;; Defines obsolete aliases so that code that use's calfw old naming scheme ;; does not break, but merely issues warnings. ;;; Code: (require 'cl-macs) ;; for cl--find-class (when nil ;; The following is convenience function to generate calls to appropriate ;; aliasing functions when the old version of calfw is loaded. The list is ;; 95% complete/accurate and required some small modifications. (defun calfw-compat--generate-maps () "Generate function call for all symbols starting with `cfw:'. Output goes into a new buffer, wrapped to `fill-column`." (require 'calfw) (require 'calfw-org) (require 'calfw-ical) (require 'calfw-howm) (require 'calfw-cal) (cl-labels ((new-name (sym) (intern (replace-regexp-in-string "cfw:" "calfw-" (symbol-name sym) nil 'literal)))) (let* ((syms (apropos-internal "cfw:")) (seps '((vars . boundp) (funcs . fboundp) (faces . facep))) (all (cl-loop for (tag . func) in seps collect (cons tag (cl-loop for sym in (sort (seq-filter func syms) 'string-lessp) collect (cons (new-name sym) sym)))))) (with-current-buffer (get-buffer-create "*cfw-obsolete*") (erase-buffer) (emacs-lisp-mode) (pp all (current-buffer)) (pop-to-buffer (current-buffer))) all))) (calfw-compat--generate-maps)) (defcustom calfw-compat-mark-obsolete "2.0" "When non-nil, mark old symbols as obsolete using the value as version." :group 'calfw :type 'string) (defvar calfw-compat-aliases '((vars (calfw-cal-diary-regex . cfw:cal-diary-regex) (calfw-cal-schedule-map . cfw:cal-schedule-map) (calfw-cal-text-keymap . cfw:cal-text-keymap) (calfw-calendar-buffer-name . cfw:calendar-buffer-name) (calfw-calendar-mode-hook . cfw:calendar-mode-hook) (calfw-calendar-mode-map . cfw:calendar-mode-map) (calfw-cp-dipatch-funcs . cfw:cp-dipatch-funcs) (calfw-default-text-sorter . cfw:default-text-sorter) (calfw-dest-background-buffer . cfw:dest-background-buffer) (calfw-details-buffer-name . cfw:details-buffer-name) (calfw-details-mode-hook . cfw:details-mode-hook) (calfw-details-mode-map . cfw:details-mode-map) (calfw-details-window-size . cfw:details-window-size) (calfw-display-calendar-holidays . cfw:display-calendar-holidays) (calfw-event-format-days-overview . cfw:event-format-days-overview) (calfw-event-format-description . cfw:event-format-description) (calfw-event-format-detail . cfw:event-format-detail) (calfw-event-format-end-date . cfw:event-format-end-date) (calfw-event-format-end-time . cfw:event-format-end-time) (calfw-event-format-location . cfw:event-format-location) (calfw-event-format-overview . cfw:event-format-overview) (calfw-event-format-period-overview . cfw:event-format-period-overview) (calfw-event-format-start-date . cfw:event-format-start-date) (calfw-event-format-start-time . cfw:event-format-start-time) (calfw-event-format-title . cfw:event-format-title) (calfw-item-separator-color-face . cfw:face-item-separator-color) (calfw-fchar-horizontal-line . cfw:fchar-horizontal-line) (calfw-fchar-junction . cfw:fchar-junction) (calfw-fchar-left-junction . cfw:fchar-left-junction) (calfw-fchar-right-junction . cfw:fchar-right-junction) (calfw-fchar-top-junction . cfw:fchar-top-junction) (calfw-fchar-top-left-corner . cfw:fchar-top-left-corner) (calfw-fchar-top-right-corner . cfw:fchar-top-right-corner) (calfw-fchar-vertical-line . cfw:fchar-vertical-line) (calfw-fstring-period-end . cfw:fstring-period-end) (calfw-fstring-period-start . cfw:fstring-period-start) (calfw-highlight-today . cfw:highlight-today) (calfw-howm-annotation-contents . cfw:howm-annotation-contents) (calfw-howm-schedule-cache . cfw:howm-schedule-cache) (calfw-howm-schedule-contents . cfw:howm-schedule-contents) (calfw-howm-schedule-hook . cfw:howm-schedule-hook) (calfw-howm-schedule-inline-keymap . cfw:howm-schedule-inline-keymap) (calfw-howm-schedule-map . cfw:howm-schedule-map) (calfw-howm-schedule-summary-transformer . cfw:howm-schedule-summary-transformer) (calfw-ical-calendar-external-shell-command . cfw:ical-calendar-external-shell-command) (calfw-ical-calendar-tmpbuf . cfw:ical-calendar-tmpbuf) (calfw-ical-data-cache . cfw:ical-data-cache) (calfw-ical-url-to-buffer-get . cfw:ical-url-to-buffer-get) (calfw-org-agenda-schedule-args . cfw:org-agenda-schedule-args) (calfw-org-capture-template . cfw:org-capture-template) (calfw-org-custom-map . cfw:org-custom-map) (calfw-org-face-agenda-item-foreground-color . cfw:org-face-agenda-item-foreground-color) (calfw-org-icalendars . cfw:org-icalendars) (calfw-org-overwrite-default-keybinding . cfw:org-overwrite-default-keybinding) (calfw-org-schedule-map . cfw:org-schedule-map) (calfw-org-schedule-summary-transformer . cfw:org-schedule-summary-transformer) (calfw-org-text-keymap . cfw:org-text-keymap) (calfw-read-date-command . cfw:read-date-command) (calfw-render-line-breaker . cfw:render-line-breaker) (calfw-week-days . cfw:week-days) (calfw-week-friday . cfw:week-friday) (calfw-week-monday . cfw:week-monday) (calfw-week-saturday . cfw:week-saturday) (calfw-week-sunday . cfw:week-sunday) (calfw-week-thursday . cfw:week-thursday) (calfw-week-tuesday . cfw:week-tuesday) (calfw-week-wednesday . cfw:week-wednesday) (cl-struct-calfw-component-tags . cl-struct-cfw:component-tags) (cl-struct-calfw-dest-tags . cl-struct-cfw:dest-tags) (cl-struct-calfw-event-tags . cl-struct-cfw:event-tags) (cl-struct-calfw-source-tags . cl-struct-cfw:source-tags)) (funcs (calfw--annotations-merge . cfw:annotations-merge) (calfw-cal-create-source . cfw:cal-create-source) (calfw-cal--entry-to-event . cfw:cal-entry-to-event) (calfw-cal-from-calendar . cfw:cal-from-calendar) (calfw-cal-onclick . cfw:cal-onclick) (calfw-cal--schedule-period-to-calendar . cfw:cal-schedule-period-to-calendar) (calfw-calendar-mode . cfw:calendar-mode) (calfw-calendar-mode-map . cfw:calendar-mode-map) (calfw-calendar-to-emacs . cfw:calendar-to-emacs) (calfw-change-view-day . cfw:change-view-day) (calfw-change-view-month . cfw:change-view-month) (calfw-change-view-two-weeks . cfw:change-view-two-weeks) (calfw-change-view-week . cfw:change-view-week) (calfw-component-click-hooks . cfw:component-click-hooks) (calfw-component-click-hooks--cmacro . cfw:component-click-hooks--cmacro) (calfw-component-dest . cfw:component-dest) (calfw-component-dest--cmacro . cfw:component-dest--cmacro) (calfw-component-model . cfw:component-model) (calfw-component-model--cmacro . cfw:component-model--cmacro) (calfw-component-p . cfw:component-p) (calfw-component-p--cmacro . cfw:component-p--cmacro) (calfw-component-update-hooks . cfw:component-update-hooks) (calfw-component-update-hooks--cmacro . cfw:component-update-hooks--cmacro) (calfw-component-view . cfw:component-view) (calfw-component-view--cmacro . cfw:component-view--cmacro) (calfw-composite-color . cfw:composite-color) (calfw--contents-add . cfw:contents-add) (calfw--contents-get . cfw:contents-get) (calfw--contents-get-internal . cfw:contents-get-internal) (calfw--contents-merge . cfw:contents-merge) (calfw--contents-put-source . cfw:contents-put-source) (calfw-cp-add-click-hook . cfw:cp-add-click-hook) (calfw-cp-add-update-hook . cfw:cp-add-update-hook) (calfw--cp-dispatch-view-impl . cfw:cp-dispatch-view-impl) (calfw-cp-displayed-date-p . cfw:cp-displayed-date-p) (calfw--cp-fire-click-hooks . cfw:cp-fire-click-hooks) (calfw--cp-fire-update-hooks . cfw:cp-fire-update-hooks) (calfw-cp-get-annotation-sources . cfw:cp-get-annotation-sources) (calfw-cp-get-buffer . cfw:cp-get-buffer) (calfw-cp-get-component . cfw:cp-get-component) (calfw-cp-get-contents-sources . cfw:cp-get-contents-sources) (calfw-cp-get-view . cfw:cp-get-view) (calfw-cp-goto-date . cfw:cp-goto-date) (calfw--cp-move-cursor . cfw:cp-move-cursor) (calfw--cp-new . cfw:cp-new) (calfw-cp-resize . cfw:cp-resize) (calfw-cp-set-annotation-sources . cfw:cp-set-annotation-sources) (calfw-cp-set-contents-sources . cfw:cp-set-contents-sources) (calfw-cp-set-view . cfw:cp-set-view) (calfw--cp-update . cfw:cp-update) (calfw-create-calendar-component-buffer . cfw:create-calendar-component-buffer) (calfw-create-calendar-component-region . cfw:create-calendar-component-region) (calfw--cursor-to-date . cfw:cursor-to-date) (calfw-cursor-to-nearest-date . cfw:cursor-to-nearest-date) (calfw-date . cfw:date) (calfw-date-after . cfw:date-after) (calfw-date-before . cfw:date-before) (calfw-date-between . cfw:date-between) (calfw-date-less-equal-p . cfw:date-less-equal-p) (calfw-days-diff . cfw:days-diff) (calfw-ical-decode-to-calendar . cfw:decode-to-calendar) (calfw--define-keymap . cfw:define-keymap) (calfw-dest-after-update . cfw:dest-after-update) (calfw-dest-after-update-func . cfw:dest-after-update-func) (calfw-dest-after-update-func--cmacro . cfw:dest-after-update-func--cmacro) (calfw-dest-before-update . cfw:dest-before-update) (calfw-dest-before-update-func . cfw:dest-before-update-func) (calfw-dest-before-update-func--cmacro . cfw:dest-before-update-func--cmacro) (calfw-dest-buffer . cfw:dest-buffer) (calfw-dest-buffer--cmacro . cfw:dest-buffer--cmacro) (calfw-dest-clear . cfw:dest-clear) (calfw-dest-clear-func . cfw:dest-clear-func) (calfw-dest-clear-func--cmacro . cfw:dest-clear-func--cmacro) (calfw-dest-height . cfw:dest-height) (calfw-dest-height--cmacro . cfw:dest-height--cmacro) (calfw-dest-init-buffer . cfw:dest-init-buffer) (calfw-dest-init-inline . cfw:dest-init-inline) (calfw-dest-init-region . cfw:dest-init-region) (calfw-dest-max-func . cfw:dest-max-func) (calfw-dest-max-func--cmacro . cfw:dest-max-func--cmacro) (calfw-dest-min-func . cfw:dest-min-func) (calfw-dest-min-func--cmacro . cfw:dest-min-func--cmacro) (calfw--dest-ol-today-clear . cfw:dest-ol-today-clear) (calfw--dest-ol-today-set . cfw:dest-ol-today-set) (calfw-dest-p . cfw:dest-p) (calfw-dest-p--cmacro . cfw:dest-p--cmacro) (calfw-dest-point-max . cfw:dest-point-max) (calfw-dest-point-min . cfw:dest-point-min) (calfw--dest-region-clear . cfw:dest-region-clear) (calfw-dest-today-ol . cfw:dest-today-ol) (calfw-dest-today-ol--cmacro . cfw:dest-today-ol--cmacro) (calfw-dest-type . cfw:dest-type) (calfw-dest-type--cmacro . cfw:dest-type--cmacro) (calfw-dest-width . cfw:dest-width) (calfw-dest-width--cmacro . cfw:dest-width--cmacro) (calfw-dest-with-region . cfw:dest-with-region) (calfw--details-find-item . cfw:details-find-item) (calfw-details-kill-buffer-command . cfw:details-kill-buffer-command) (calfw-details-layout . cfw:details-layout) (calfw-details-mode . cfw:details-mode) (calfw-details-navi-next-command . cfw:details-navi-next-command) (calfw-details-navi-next-item-command . cfw:details-navi-next-item-command) (calfw-details-navi-prev-command . cfw:details-navi-prev-command) (calfw-details-navi-prev-item-command . cfw:details-navi-prev-item-command) (calfw-details-popup . cfw:details-popup) (calfw-emacs-to-calendar . cfw:emacs-to-calendar) (calfw-enumerate-days . cfw:enumerate-days) (calfw-event-data . cfw:event-data) (calfw-event-data--cmacro . cfw:event-data--cmacro) (calfw-event-days-overview . cfw:event-days-overview) (calfw-event-description . cfw:event-description) (calfw-event-description--cmacro . cfw:event-description--cmacro) (calfw-event-detail . cfw:event-detail) (calfw-event-end-date . cfw:event-end-date) (calfw-event-end-date--cmacro . cfw:event-end-date--cmacro) (calfw-event-end-time . cfw:event-end-time) (calfw-event-end-time--cmacro . cfw:event-end-time--cmacro) (calfw-event-format . cfw:event-format) (calfw--event-format-field . cfw:event-format-field) (calfw--event-format-field-date . cfw:event-format-field-date) (calfw--event-format-field-number . cfw:event-format-field-number) (calfw--event-format-field-string . cfw:event-format-field-string) (calfw--event-format-field-time . cfw:event-format-field-time) (calfw-event-location . cfw:event-location) (calfw-event-location--cmacro . cfw:event-location--cmacro) (calfw-event-mouse-click-toggle-calendar . cfw:event-mouse-click-toggle-calendar) (calfw-event-overview . cfw:event-overview) (calfw-event-p . cfw:event-p) (calfw-event-p--cmacro . cfw:event-p--cmacro) (calfw-event-period-overview . cfw:event-period-overview) (calfw-event-source . cfw:event-source) (calfw-event-source--cmacro . cfw:event-source--cmacro) (calfw-event-start-date . cfw:event-start-date) (calfw-event-start-date--cmacro . cfw:event-start-date--cmacro) (calfw-event-start-time . cfw:event-start-time) (calfw-event-start-time--cmacro . cfw:event-start-time--cmacro) (calfw-event-status . cfw:event-status) (calfw-event-status--cmacro . cfw:event-status--cmacro) (calfw-event-title . cfw:event-title) (calfw-event-title--cmacro . cfw:event-title--cmacro) (calfw-event-toggle-all-calendars . cfw:event-toggle-all-calendars) (calfw-event-toggle-calendar . cfw:event-toggle-calendar) (calfw--extract-text-props . cfw:extract-text-props) (calfw--fill-keymap-property . cfw:fill-keymap-property) (calfw--find-all-by-date . cfw:find-all-by-date) (calfw--find-by-date . cfw:find-by-date) (calfw--find-first-date . cfw:find-first-date) (calfw--find-item . cfw:find-item) (calfw--find-last-date . cfw:find-last-date) (calfw-flatten . cfw:flatten) (calfw-get-calendar-text . cfw:get-calendar-text) (calfw-howm-create-source . cfw:howm-create-source) (calfw-howm-from-calendar . cfw:howm-from-calendar) (calfw-howm-from-calendar-fast . cfw:howm-from-calendar-fast) (calfw-howm-schedule-cache-clear . cfw:howm-schedule-cache-clear) (calfw-howm--schedule-get . cfw:howm-schedule-get) (calfw-howm-schedule-inline . cfw:howm-schedule-inline) (calfw-howm--schedule-parse-line . cfw:howm-schedule-parse-line) (calfw-howm--schedule-period . cfw:howm-schedule-period) (calfw-howm--schedule-period-to-calendar . cfw:howm-schedule-period-to-calendar) (calfw-ical-convert-event . cfw:ical-convert-event) (calfw-ical-convert-ical-to-calfw . cfw:ical-convert-ical-to-calfw) (calfw-ical-create-source . cfw:ical-create-source) (calfw-ical-data-cache-clear . cfw:ical-data-cache-clear) (calfw-ical-data-cache-clear-all . cfw:ical-data-cache-clear-all) (calfw-ical-debug . cfw:ical-debug) (calfw-ical-event-get-dates . cfw:ical-event-get-dates) (calfw-ical-get-data . cfw:ical-get-data) (calfw-ical-normalize-buffer . cfw:ical-normalize-buffer) (calfw-ical-sanitize-string . cfw:ical-sanitize-string) (calfw-ical-to-calendar . cfw:ical-to-calendar) (calfw-ical-url-to-buffer . cfw:ical-url-to-buffer) (calfw-ical-url-to-buffer-external . cfw:ical-url-to-buffer-external) (calfw-ical-url-to-buffer-internal . cfw:ical-url-to-buffer-internal) (calfw-ical-with-buffer . cfw:ical-with-buffer) (calfw-howm-install-schedules . cfw:install-howm-schedules) (calfw--k . cfw:k) (calfw-make-bg-color . cfw:make-bg-color) (calfw-make-fg-color . cfw:make-fg-color) (calfw-model-abstract-derived . cfw:model-abstract-derived) (calfw-model-abstract-new . cfw:model-abstract-new) (calfw--model-create-updated-view-data . cfw:model-create-updated-view-data) (calfw-model-get-annotation-by-date . cfw:model-get-annotation-by-date) (calfw--model-get-annotation-sources . cfw:model-get-annotation-sources) (calfw-model-get-contents-by-date . cfw:model-get-contents-by-date) (calfw--model-get-contents-sources . cfw:model-get-contents-sources) (calfw-model-get-holiday-by-date . cfw:model-get-holiday-by-date) (calfw-model-get-periods-by-date . cfw:model-get-periods-by-date) (calfw-model-get-sorter . cfw:model-get-sorter) (calfw--model-set-annotation-sources . cfw:model-set-annotation-sources) (calfw--model-set-contents-sources . cfw:model-set-contents-sources) (calfw--model-set-init-date . cfw:model-set-init-date) (calfw-month-year-contain-p . cfw:month-year-contain-p) (calfw-month-year-equal-p . cfw:month-year-equal-p) (calfw-navi-goto-date . cfw:navi-goto-date) (calfw-navi-goto-date-command . cfw:navi-goto-date-command) (calfw-navi-goto-first-date-command . cfw:navi-goto-first-date-command) (calfw-navi-goto-last-date-command . cfw:navi-goto-last-date-command) (calfw-navi-goto-today-command . cfw:navi-goto-today-command) (calfw-navi-goto-week-begin-command . cfw:navi-goto-week-begin-command) (calfw-navi-goto-week-end-command . cfw:navi-goto-week-end-command) (calfw-navi-next-day-command . cfw:navi-next-day-command) (calfw-navi-next-item-command . cfw:navi-next-item-command) (calfw-navi-next-month-command . cfw:navi-next-month-command) (calfw-navi-next-week-command . cfw:navi-next-week-command) (calfw-navi-on-click . cfw:navi-on-click) (calfw-navi-prev-item-command . cfw:navi-prev-item-command) (calfw-navi-previous-day-command . cfw:navi-previous-day-command) (calfw-navi-previous-month-command . cfw:navi-previous-month-command) (calfw-navi-previous-week-command . cfw:navi-previous-week-command) (calfw-open-calendar-buffer . cfw:open-calendar-buffer) (calfw-open-debug-calendar . cfw:open-debug-calendar) (calfw-cal-open-diary-calendar . cfw:open-diary-calendar) (calfw-howm-open-calendar . cfw:open-howm-calendar) (calfw-ical-open-calendar . cfw:open-ical-calendar) (calfw-org-open-calendar . cfw:open-org-calendar) (calfw-org-capture . cfw:org-capture) (calfw-org-capture-day . cfw:org-capture-day) (calfw-org-clean-exit . cfw:org-clean-exit) (calfw-org--collect-schedules-period . cfw:org-collect-schedules-period) (calfw-org-convert-event . cfw:org-convert-event) (calfw-org-convert-org-to-calfw . cfw:org-convert-org-to-calfw) (calfw-org-create-file-source . cfw:org-create-file-source) (calfw-org-create-source . cfw:org-create-source) (calfw-org--extract-summary . cfw:org-extract-summary) (calfw-org-filter-datetime . cfw:org-filter-datetime) (calfw-org-format-date . cfw:org-format-date) (calfw-org-format-title . cfw:org-format-title) (calfw-org-get-timerange . cfw:org-get-timerange) (calfw-org-goto-date . cfw:org-goto-date) (calfw-org-jump-map . cfw:org-jump-map) (calfw-org-normalize-date . cfw:org-normalize-date) (calfw-org-onclick . cfw:org-onclick) (calfw-org-open-agenda-day . cfw:org-open-agenda-day) (calfw-org-read-date-command . cfw:org-read-date-command) (calfw-org--schedule-period-to-calendar . cfw:org-schedule-period-to-calendar) (calfw-org-schedule-sorter . cfw:org-schedule-sorter) (calfw-org-schedule-sorter2 . cfw:org-schedule-sorter2) (calfw-org-summary-format . cfw:org-summary-format) (calfw-org-to-calendar . cfw:org-to-calendar) (calfw-org--tp . cfw:org-tp) (calfw-parse-str-time . cfw:parse-str-time) (calfw-parsetime . cfw:parsetime) (calfw-parsetime-emacs . cfw:parsetime-emacs) (calfw-periods-put-source . cfw:periods-put-source) (calfw-read-date-command-simple . cfw:read-date-command-simple) (calfw-refresh-calendar-buffer . cfw:refresh-calendar-buffer) (calfw--render-add-item-separator-sign . cfw:render-add-item-separator-sign) (calfw--render-add-right . cfw:render-add-right) (calfw--render-append-parts . cfw:render-append-parts) (calfw--render-break-lines . cfw:render-break-lines) (calfw--render-button . cfw:render-button) (calfw--render-calendar-cells-days . cfw:render-calendar-cells-days) (calfw--render-calendar-cells-weeks . cfw:render-calendar-cells-weeks) (calfw--render-center . cfw:render-center) (calfw--render-columns . cfw:render-columns) (calfw--render-day-of-week-names . cfw:render-day-of-week-names) (calfw--render-default-content-face . cfw:render-default-content-face) (calfw--render-event-days-overview-content . cfw:render-event-days-overview-content) (calfw--render-event-details-content . cfw:render-event-details-content) (calfw--render-event-overview-content . cfw:render-event-overview-content) (calfw--render-footer . cfw:render-footer) (calfw--render-get-face-content . cfw:render-get-face-content) (calfw--render-get-face-period . cfw:render-get-face-period) (calfw--render-get-week-face . cfw:render-get-week-face) (calfw--render-left . cfw:render-left) (calfw-render-line-breaker-none . cfw:render-line-breaker-none) (calfw-render-line-breaker-simple . cfw:render-line-breaker-simple) (calfw-render-line-breaker-wordwrap . cfw:render-line-breaker-wordwrap) (calfw--render-map-event-content . cfw:render-map-event-content) (calfw--render-periods . cfw:render-periods) (calfw--render-periods-days . cfw:render-periods-days) (calfw--render-periods-get-min . cfw:render-periods-get-min) (calfw--render-periods-place . cfw:render-periods-place) (calfw--render-periods-stacks . cfw:render-periods-stacks) (calfw--render-periods-title . cfw:render-periods-title) (calfw--render-right . cfw:render-right) (calfw--render-rows-prop . cfw:render-rows-prop) (calfw--render-separator . cfw:render-separator) (calfw--render-sort-contents . cfw:render-sort-contents) (calfw-render-title-day . cfw:render-title-day) (calfw-render-title-month . cfw:render-title-month) (calfw-render-title-period . cfw:render-title-period) (calfw--render-toolbar . cfw:render-toolbar) (calfw--render-truncate . cfw:render-truncate) (calfw--round-cell-width . cfw:round-cell-width) (calfw--rt . cfw:rt) (calfw-show-details-command . cfw:show-details-command) (calfw-source-color . cfw:source-color) (calfw-source-color--cmacro . cfw:source-color--cmacro) (calfw-source-data . cfw:source-data) (calfw-source-data--cmacro . cfw:source-data--cmacro) (calfw-source-hidden . cfw:source-hidden) (calfw-source-hidden--cmacro . cfw:source-hidden--cmacro) (calfw-source-name . cfw:source-name) (calfw-source-name--cmacro . cfw:source-name--cmacro) (calfw-source-opt-face . cfw:source-opt-face) (calfw-source-opt-face--cmacro . cfw:source-opt-face--cmacro) (calfw-source-opt-period-face . cfw:source-opt-period-face) (calfw-source-opt-period-face--cmacro . cfw:source-opt-period-face--cmacro) (calfw-source-p . cfw:source-p) (calfw-source-p--cmacro . cfw:source-p--cmacro) (calfw-source-period-bgcolor . cfw:source-period-bgcolor) (calfw-source-period-bgcolor--cmacro . cfw:source-period-bgcolor--cmacro) (calfw--source-period-bgcolor-get . cfw:source-period-bgcolor-get) (calfw-source-period-fgcolor . cfw:source-period-fgcolor) (calfw-source-period-fgcolor--cmacro . cfw:source-period-fgcolor--cmacro) (calfw--source-period-fgcolor-get . cfw:source-period-fgcolor-get) (calfw-source-update . cfw:source-update) (calfw-source-update--cmacro . cfw:source-update--cmacro) (calfw-strtime . cfw:strtime) (calfw-strtime-emacs . cfw:strtime-emacs) (calfw--sym . cfw:sym) (calfw-time . cfw:time) (calfw-howm--convert-date . cfw:to-howm-date) (calfw--tp . cfw:tp) (calfw--view-day . cfw:view-day) (calfw--view-day-calc-param . cfw:view-day-calc-param) (calfw--view-model-make-common-data . cfw:view-model-make-common-data) (calfw--view-model-make-common-data-for-days . cfw:view-model-make-common-data-for-days) (calfw--view-model-make-common-data-for-weeks . cfw:view-model-make-common-data-for-weeks) (calfw--view-model-make-day-names-for-days . cfw:view-model-make-day-names-for-days) (calfw--view-model-make-day-names-for-week . cfw:view-model-make-day-names-for-week) (calfw--view-model-make-days . cfw:view-model-make-days) (calfw--view-model-make-holidays . cfw:view-model-make-holidays) (calfw--view-model-make-weeks . cfw:view-model-make-weeks) (calfw--view-month . cfw:view-month) (calfw--view-month-calc-param . cfw:view-month-calc-param) (calfw--view-month-model . cfw:view-month-model) (calfw--view-two-weeks . cfw:view-two-weeks) (calfw--view-two-weeks-calc-param . cfw:view-two-weeks-calc-param) (calfw--view-two-weeks-model . cfw:view-two-weeks-model) (calfw-view-two-weeks-model-adjust . cfw:view-two-weeks-model-adjust) (calfw--view-week . cfw:view-week) (calfw--view-week-calc-param . cfw:view-week-calc-param) (calfw--view-week-model . cfw:view-week-model) (calfw-week-begin-date . cfw:week-begin-date) (calfw-week-end-date . cfw:week-end-date) (calfw-howm-elscreen-open-calendar . cfw:elscreen-open-howm-calendar) (calfw-howm-elscreen-kill-calendar . cfw:elscreen-kill-calendar) (copy-calfw-component . copy-cfw:component) (copy-calfw-dest . copy-cfw:dest) (copy-calfw-event . copy-cfw:event) (copy-calfw-source . copy-cfw:source) (make-calfw-component . make-cfw:component) (make-calfw-component--cmacro . make-cfw:component--cmacro) (make-calfw-dest . make-cfw:dest) (make-calfw-dest--cmacro . make-cfw:dest--cmacro) (make-calfw-event . make-cfw:event) (make-calfw-event--cmacro . make-cfw:event--cmacro) (make-calfw-source . make-cfw:source) (make-calfw-source--cmacro . make-cfw:source--cmacro)) (faces (calfw-annotation-face . cfw:face-annotation) (calfw-calendar-hidden-face . cfw:face-calendar-hidden) (calfw-day-title-face . cfw:face-day-title) (calfw-default-content-face . cfw:face-default-content) (calfw-default-day-face . cfw:face-default-day) (calfw-disable-face . cfw:face-disable) (calfw-grid-face . cfw:face-grid) (calfw-header-face . cfw:face-header) (calfw-holiday-face . cfw:face-holiday) (calfw-periods-face . cfw:face-periods) (calfw-saturday-face . cfw:face-saturday) (calfw-sunday-face . cfw:face-sunday) (calfw-title-face . cfw:face-title) (calfw-today-face . cfw:face-today) (calfw-today-title-face . cfw:face-today-title) (calfw-toolbar-face . cfw:face-toolbar) (calfw-toolbar-button-off-face . cfw:face-toolbar-button-off) (calfw-toolbar-button-on-face . cfw:face-toolbar-button-on)))) (let ((alias (if calfw-compat-mark-obsolete (lambda (old new) (define-obsolete-variable-alias old new calfw-compat-mark-obsolete)) #'defvaralias))) (dolist (pair (alist-get 'vars calfw-compat-aliases)) (funcall alias (cdr pair) (car pair)))) (let ((alias (if calfw-compat-mark-obsolete (lambda (old new) (define-obsolete-function-alias old new calfw-compat-mark-obsolete)) #'defalias))) (dolist (pair (alist-get 'funcs calfw-compat-aliases)) (funcall alias (cdr pair) (car pair)))) (let ((alias (if calfw-compat-mark-obsolete (lambda (old new) (define-obsolete-face-alias old new calfw-compat-mark-obsolete)) (lambda (old new) (put old 'face-alias new))))) (dolist (pair (alist-get 'faces calfw-compat-aliases)) (funcall alias (cdr pair) (car pair)))) ;; a HACK to alias old names of structures (put 'cfw:event 'cl--class (cl--find-class 'calfw-event)) (put 'cfw:source 'cl--class (cl--find-class 'calfw-source)) (put 'cfw:componenet 'cl--class (cl--find-class 'calfw-component)) (put 'cfw:event 'cl--class (cl--find-class 'calfw-event)) (put 'cfw:dest 'cl--class (cl--find-class 'calfw-dest)) (defun calfw-compat-update-symbols (files) "Replace old symbols with new ones in FILES, based on `calfw-compat-aliases'." (dolist (f files) (when (file-exists-p f) (with-current-buffer (find-file-noselect f) (save-excursion (dolist (lst calfw-compat-aliases) (dolist (pair (cdr lst)) (goto-char (point-min)) (let ((regexp (format "\\_<%s\\_>" (regexp-quote (symbol-name (cdr pair))))) (new (symbol-name (car pair)))) (while (re-search-forward regexp nil t) (replace-match new t t)))))) (when (buffer-modified-p) (save-buffer)))))) ;; (calfw-compat-update-symbols (directory-files default-directory t ".*\\.el")) (provide 'calfw-compat) ;;; calfw-compat.el ends here kiwanami-emacs-calfw-6112605/calfw-howm.el000066400000000000000000000221711507535766000202670ustar00rootroot00000000000000;;; calfw-howm.el --- Calendar view for howm -*- lexical-binding: t -*- ;; Copyright (C) 2011 SAKURAI Masashi ;; Author: SAKURAI Masashi ;; Maintainer: Al Haji-Ali ;; Version: 2.0 ;; Keywords: calendar ;; Package-Requires: ((emacs "28.1") (calfw "2.0") (howm "1.5.0")) ;; URL: https://github.com/haji-ali/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: ;; (eval-after-load "howm-menu" '(progn ;; (require 'calfw-howm) ;; (calfw-howm-install-schedules) ;; (define-key howm-mode-map (kbd "M-C") 'calfw-howm-open-calendar) ;; )) ;; If you are using Elscreen, here is useful. ;; (define-key howm-mode-map (kbd "M-C") 'calfw-howm-elscreen-open-calendar) ;; One can open a standalone calendar buffer by ;; M-x calfw-howm-open-calendar ;; You can display a calendar in your howm menu. ;; %here%(calfw-howm-schedule-inline) ;;; Code: (require 'howm) (require 'calfw) (defvar calfw-howm-schedule-cache nil "[internal] Cache data for schedule items of howm.") (defun calfw-howm-schedule-cache-clear () "Clear the cache for howm schedule items." (setq calfw-howm-schedule-cache nil)) (defvar calfw-howm-schedule-hook nil "Hook which is called after retrieval of howm schedule items.") (defun calfw-howm--schedule-get () "Return all schedule items in the whole howm data. If cache data exists, this function uses the cache. Returns `calfw-howm-schedule-cache'." (unless calfw-howm-schedule-cache (let* ((howm-schedule-types howm-schedule-menu-types) (raw (howm-reminder-search howm-schedule-types))) (setq calfw-howm-schedule-cache (howm-schedule-sort-items raw))) (run-hooks 'calfw-howm-schedule-hook)) calfw-howm-schedule-cache) (defun calfw-howm--convert-date (date) "Convert a DATE from the Emacs calendar list to 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 calfw-howm--schedule-period (begin end) "Return howm schedule items between BEGIN and END." (let* ((from (calfw-howm--convert-date begin)) (to (calfw-howm--convert-date end)) (filtered (cl-remove-if (lambda (item) (let ((s (howm-schedule-date item))) (or (< s from) (< to s)))) (calfw-howm--schedule-get)))) (howm-schedule-sort-items filtered))) (defvar calfw-howm-schedule-summary-transformer (lambda (line) line) "Transformation function to transform howm summary string to calendar title. If this function splits into a list of string, calfw displays those string in multi-lines. The function takes LINE as an argument.") (defun calfw-howm--schedule-parse-line (line) "Parse LINE and return a list of (date number 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 calfw-howm--schedule-period-to-calendar (begin end) "Return calfw calendar items between BEGIN and END from howm schedule data." (cl-loop with contents = nil with periods = nil for i in (calfw-howm--schedule-period begin end) for date = (calfw-emacs-to-calendar (seconds-to-time (+ 10 (* (howm-schedule-date i) 24 3600)))) for (datestr num type summary) = (calfw-howm--schedule-parse-line (howm-item-summary i)) for summary = (funcall calfw-howm-schedule-summary-transformer summary) do (cond ((and (string= type "@") (< 0 num)) (push (list date (calfw-date-after date (1- num)) summary) periods)) ((and (string= type "!") (< 0 num)) (push (list (calfw-date-before date (1- num)) date summary) periods)) (t (setq contents (calfw--contents-add date summary contents)))) finally return (nconc contents (list (cons 'periods periods))))) (defun calfw-howm-create-source (&optional color) "Create a howm source. COLOR is the color of the source." (make-calfw-source :name "howm schedule" :color (or color "SteelBlue") :update 'calfw-howm-schedule-cache-clear :data 'calfw-howm--schedule-period-to-calendar)) (defvar calfw-howm-schedule-map (calfw--define-keymap '(("RET" . calfw-howm-from-calendar) ("q" . kill-buffer))) "Key map for the howm calendar mode.") (defvar calfw-howm-schedule-contents nil "A list of calfw-source objects for schedule contents.") (defvar calfw-howm-annotation-contents nil "A list of calfw-source objects for annotations.") (defun calfw-howm-open-calendar () "Open a howm schedule calendar in the new buffer." (interactive) (save-excursion (let ((cp (calfw-create-calendar-component-buffer :custom-map calfw-howm-schedule-map :view 'month :contents-sources (append (list (calfw-howm-create-source)) calfw-howm-schedule-contents) :annotation-sources calfw-howm-annotation-contents))) (switch-to-buffer (calfw-cp-get-buffer cp))))) (defun calfw-howm-from-calendar () "Display a howm schedule summary of the date on the cursor. This command should be executed on the calfw calendar. Searches the whole howm data for the date under the cursor." (interactive) (let* ((mdy (calfw-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 calfw-howm-from-calendar-fast () "Display a howm schedule summary of the date on the cursor from the cache. This command should be executed on the calfw calendar. It is faster than `calfw-howm-from-calendar'. The date is determined by `calfw-cursor-to-nearest-date'." (interactive) (let* ((mdy (calfw-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 (calfw-howm--schedule-period mdy mdy))) (cond ((= 1 (length items)) (howm-view-open-item (car items))) (t (howm-view-summary (format "Schedules : %s" (calfw-strtime mdy)) items (list key)) (howm-view-summary-check t))))) ;; (define-key calfw-howm-schedule-map (kbd "RET") 'calfw-howm-from-calendar-fast) ;; (define-key calfw-howm-schedule-inline-keymap (kbd "RET") 'calfw-howm-from-calendar-fast) ;;; Region (defvar calfw-howm-schedule-inline-keymap (calfw--define-keymap '(("RET" . calfw-howm-from-calendar))) "Key map for the howm inline calendar.") (defun calfw-howm-schedule-inline (&optional width height view) "Create a calendar component region for the howm menu with WIDTH and HEIGHT. VIEW specifies the initial view." (let ((custom-map (copy-keymap calfw-howm-schedule-inline-keymap)) cp) (set-keymap-parent custom-map calfw-calendar-mode-map) (setq cp (calfw-create-calendar-component-region :width width :height (or height 10) :keymap custom-map :contents-sources (append (list (calfw-howm-create-source)) calfw-howm-schedule-contents) :annotation-sources calfw-howm-annotation-contents :view (or view 'month)))) "") ; for null output ;;; Installation (defun calfw-howm-install-schedules () "Add a schedule collection function to calfw for howm schedule data." (interactive) (add-hook 'howm-after-save-hook 'calfw-howm-schedule-cache-clear) (add-to-list 'howm-menu-allow 'calfw-howm-schedule-inline)) ;;; for Elscreen (when (featurep 'elscreen-howm) (defun calfw-howm-elscreen-open-calendar () "Open the calendar in the new screen." (interactive) (save-current-buffer (elscreen-create)) (calfw-howm-open-calendar)) (defun calfw-howm-elscreen-kill-calendar () "Kill the calendar buffer and the screen." (interactive) (kill-buffer nil) (unless (elscreen-one-screen-p) (elscreen-kill))) (define-key calfw-howm-schedule-map (kbd "q") 'calfw-howm-elscreen-kill-calendar)) (provide 'calfw-howm) ;;; calfw-howm.el ends here kiwanami-emacs-calfw-6112605/calfw-ical.el000066400000000000000000000310201507535766000202160ustar00rootroot00000000000000;;; calfw-ical.el --- Calendar view for ical format -*- lexical-binding: t -*- ;; Copyright (C) 2011 SAKURAI Masashi ;; Author: SAKURAI Masashi ;; Maintainer: Al Haji-Ali ;; Version: 2.0 ;; Keywords: calendar, ical ;; Package-Requires: ((emacs "28.1") (calfw "2.0")) ;; URL: https://github.com/haji-ali/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 . ;; Package-Requires: ((emacs "28.1")) ;;; 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. ;; (calfw-ical-open-calendar "http://www.google.com/calendar/ical/.../basic.ics") ;; Executing the following command, this program clears caches to refresh the ICS data. ;; (calfw-ical-data-cache-clear-all) ;;; Code: (require 'calfw) (require 'icalendar) (require 'url) (require 'url-http) (defun calfw-ical-decode-to-calendar (dec) "Convert a decoded iCalendar date DEC to a `calfw-date' object." (calfw-date (nth 4 dec) (nth 3 dec) (nth 5 dec))) (defun calfw-ical-event-get-dates (event zone-map) "Return date-time information from iCalendar EVENT object in ZONE-MAP. Returns a list of the form `(period START-DATE END-DATE)' or `(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 (calfw-ical-decode-to-calendar dtstart-dec)) (start-t (calfw-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 (calfw-ical-decode-to-calendar dtend-dec) start-d)) (setq end-1-d (if dtend-1-dec (calfw-ical-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"))) (calfw-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 calfw-ical-sanitize-string (string) "Sanitize STRING by replacing escaped commas and newlines." (when (and string (> (length string) 0)) (replace-regexp-in-string "\\\\n" "\n" (replace-regexp-in-string "\\\\," "," string)))) (defun calfw-ical-convert-event (event zone-map) "Create a calfw event from the ical EVENT using ZONE-MAP. Returns the calfw event." (cl-destructuring-bind (dtag date start end) (calfw-ical-event-get-dates event zone-map) (make-calfw-event :start-date date :start-time start :end-date (when (equal dtag 'period) end) :end-time (when (equal dtag 'time) end) :title (calfw-ical-sanitize-string (icalendar--get-event-property event 'SUMMARY)) :location (calfw-ical-sanitize-string (icalendar--get-event-property event 'LOCATION)) :description (calfw-ical-sanitize-string (icalendar--get-event-property event 'DESCRIPTION))))) (defun calfw-ical-convert-ical-to-calfw (ical-list) "Convert an ical list ICAL-LIST to a calfw list. Returns an alist of `(periods . PERIODS) CONTENTS`, where PERIODS are events with end dates and CONTENTS are events without end dates." (cl-loop with zone-map = (icalendar--convert-all-timezones ical-list) for e in (icalendar--all-events ical-list) for event = (calfw-ical-convert-event e zone-map) if event if (calfw-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 calfw-ical-debug (f) "Display the parsed iCalendar data from URL F in a buffer. The buffer \"*ical-debug*\" contains the parsed data. The buffer containing the iCalendar data from URL F is killed afterwards." (interactive) (let ((buf (calfw-ical-url-to-buffer f))) (unwind-protect (pp-display-expression (with-current-buffer buf (calfw-ical-normalize-buffer) (calfw-ical-convert-ical-to-calfw (icalendar--read-element nil nil))) "*ical-debug*") (kill-buffer buf)))) (defvar calfw-ical-calendar-external-shell-command "wget -q -O - ") (defvar calfw-ical-calendar-tmpbuf " *calfw-tmp*") (defvar calfw-ical-url-to-buffer-get 'calfw-ical-url-to-buffer-internal) (defun calfw-ical-url-to-buffer-external (url) "Retrieve ICS file from URL with an external command. The URL argument specifies the URL to retrieve. Returns the buffer containing the ICS data." (let ((buf (get-buffer-create calfw-ical-calendar-tmpbuf))) (buffer-disable-undo buf) (with-current-buffer buf (erase-buffer)) (call-process-shell-command (concat calfw-ical-calendar-external-shell-command url) nil buf nil) buf)) (defun calfw-ical-url-to-buffer-internal (url) "Retrieve ICS file from URL into a buffer. The buffer `calfw-ical-calendar-tmpbuf' contains the ICS data. Returns the buffer." (let ((buf (url-retrieve-synchronously url)) (dbuf (get-buffer-create calfw-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 calfw-ical-url-to-buffer (url) "Visit the iCalendar file specified by URL in a buffer. If URL is a local file, visit it; otherwise, use `calfw-ical-url-to-buffer-get' to fetch it. Returns the buffer visited." (let* ((url-code (url-generic-parse-url url)) (type (url-type url-code))) (cond (type (funcall calfw-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 calfw-ical-with-buffer (url &rest body) "Execute BODY in a buffer containing the iCalendar data at URL. The buffer containing the iCalendar data at URL is killed after BODY is executed." (let (($buf (gensym))) `(let ((,$buf (calfw-ical-url-to-buffer ,url))) (unwind-protect (with-current-buffer ,$buf (goto-char (point-min)) ,@body) (kill-buffer ,$buf))))) (put 'calfw-ical-with-buffer 'lisp-indent-function 1) (defun calfw-ical-normalize-buffer () "Normalize the current buffer by removing line continuations and VALUE=DATE. Removes line continuations (newline followed by space) and `VALUE=DATE' from `DTSTART' and `DTEND' properties in the current buffer. The buffer is marked as unmodified." (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 calfw-ical-data-cache nil "A list of (url . ics-data).") (defun calfw-ical-data-cache-clear (url) "Remove the cached data for URL from `calfw-ical-data-cache'." (setq calfw-ical-data-cache (cl-loop for i in calfw-ical-data-cache for (u . d) = i unless (equal u url) collect i))) (defun calfw-ical-data-cache-clear-all () "Clear the entire `calfw-ical-data-cache'." (interactive) (setq calfw-ical-data-cache nil)) (defun calfw-ical-get-data (url) "Return the calendar data associated with URL. Return cached data if available, otherwise fetch and convert the ical data at URL. The return value is a list of calendar events." (let ((data (assoc url calfw-ical-data-cache))) (unless data (setq data (let ((cal-list (calfw-ical-with-buffer url (calfw-ical-normalize-buffer) (calfw-ical-convert-ical-to-calfw (icalendar--read-element nil nil))))) (cons url cal-list))) (push data calfw-ical-data-cache)) (cdr data))) (defun calfw-ical-to-calendar (url begin end) "Convert iCalendar data from URL to calendar events between BEGIN and END. Returns a list of calendar events." (cl-loop for event in (calfw-ical-get-data url) if (and (listp event) (equal 'periods (car event))) collect (cons 'periods (cl-loop for evt in (cadr event) if (and (calfw-date-less-equal-p begin (calfw-event-end-date evt)) (calfw-date-less-equal-p (calfw-event-start-date evt) end)) collect evt)) else if (calfw-date-between begin end (calfw-event-start-date event)) collect event)) (defun calfw-ical-create-source (name url color) "Create a calfw source for an ical calendar at URL. NAME is the name of the calendar, COLOR is the color to use. Returns a calfw source." (make-calfw-source :name (concat "iCal:" name) :color color :update (lambda () (calfw-ical-data-cache-clear url)) :data (lambda (begin end) (calfw-ical-to-calendar url begin end)))) (defun calfw-ical-open-calendar (url) "Display a calendar buffer for the iCalendar at URL." (save-excursion (let ((cp (calfw-create-calendar-component-buffer :view 'month :contents-sources (list (calfw-ical-create-source "ical" url "#2952a3"))))) (switch-to-buffer (calfw-cp-get-buffer cp))))) ;; (progn (eval-current-buffer) (calfw-ical-open-calendar "./ics/test.ics")) (provide 'calfw-ical) ;;; calfw-ical.el ends here kiwanami-emacs-calfw-6112605/calfw-org.el000066400000000000000000000516431507535766000201120ustar00rootroot00000000000000;;; calfw-org.el --- Calendar view for org-agenda -*- lexical-binding: t; -*- ;; Copyright (C) 2011 SAKURAI Masashi ;; Author: SAKURAI Masashi ;; Maintainer: Al Haji-Ali ;; Version: 2.0 ;; Keywords: calendar, org ;; Package-Requires: ((emacs "28.1") (calfw "2.0")) ;; URL: https://github.com/haji-ali/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: ;; 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 calfw-org-overwrite-default-keybinding t) ;; ;; M-x calfw-open-org-calendar ;;; Code: (require 'calfw) (require 'org) (require 'org-agenda) (require 'org-element) (require 'org-capture) (require 'google-maps nil t) (defgroup calfw-org nil "Options about calfw-org." :tag "Calfw Org" :group 'org :group 'calfw) (defcustom calfw-org-capture-template nil "`org-capture' template to use with `calfw'. If you use `org-capture' with `calfw', you should set this variable. For example: \\='(\\\"c\\\" \\\"calfw2org\\\" entry (file nil) \\\"* %?\\n %(calfw-org-capture-day)\\\")" :group 'calfw-org :version "24.1" :type '(list string string symbol (list symbol (choice file (const nil))) string)) (defsubst calfw-org--tp (text prop) "Return text property PROP at position 0 in TEXT." (get-text-property 0 prop text)) (defvar calfw-org-agenda-schedule-args nil "Default arguments for collecting agenda entries. If value is nil, `org-agenda-entry-types' is used.") (defvar calfw-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 calfw-org-overwrite-default-keybinding nil "Overwrite default keybinding. needs Emacs restart if it does not work. For example: ------------------------------------------------ key | function ------------------------------------------------ g | `calfw-refresh-calendar-buffer' j | `calfw-org-goto-date' k | `org-capture' x | `calfw-org-clean-exit' d | `calfw-change-view-day' v d | `calfw-change-view-day' v w | `calfw-change-view-week' v m | `calfw-change-view-month' ------------------------------------------------") (defvar calfw-org-face-agenda-item-foreground-color "Seagreen4" "Variable for org agenda item foreground color.") (defun calfw-org--collect-schedules-period (begin end) "Return org schedule items between BEGIN and END." (let ((org-agenda-prefix-format " ")) (setq org-agenda-buffer (when (buffer-live-p org-agenda-buffer) org-agenda-buffer)) (org-compile-prefix-format nil) (cl-loop for date in (calfw-enumerate-days begin end) append (cl-loop for file in (or calfw-org-icalendars (org-agenda-files nil 'ifmode)) append (progn (org-check-agenda-file file) (apply 'org-agenda-get-day-entries file date calfw-org-agenda-schedule-args)))))) (defun calfw-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-link-open-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 calfw-org-jump-map () "Jump to the clicked org item." (interactive) (when (fboundp 'google-maps) ;; TODO: Not sure where this function is from! (let ((loc (get-text-property (point) 'cfw:org-loc))) (when loc (google-maps loc))))) (defun calfw-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 calfw-org-text-keymap (let ((map (make-sparse-keymap))) (define-key map [mouse-1] 'calfw-org-onclick) (define-key map (kbd "RET") 'calfw-org-onclick) (define-key map (kbd "C-c C-o") 'calfw-org-onclick) (define-key map (kbd "m") 'calfw-org-jump-map) map) "Key map on the calendar item text.") (defun calfw-org--extract-summary (org-item) "Remove strings from ORG-ITEM." (let* ((item org-item) (tags (calfw-org--tp item 'tags))) ;; (when (string-match calfw-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 (calfw-org--tp org-item 'org-category))) item)) (defun calfw-org-summary-format (item) "Format an ITEM for display. ITEM is an org entry. Return a string with text properties." (let* (;; (time (calfw-org--tp item 'time)) (time-of-day (calfw-org--tp item 'time-of-day)) (time-str (and time-of-day (format "%02i:%02i " (/ time-of-day 100) (% time-of-day 100)))) ;; (category (calfw-org--tp item 'org-category)) ;; (tags (calfw-org--tp item 'tags)) ;; (marker (calfw-org--tp item 'org-marker)) ;; (buffer (and marker (marker-buffer marker))) (text (calfw-org--extract-summary item)) (props (calfw--extract-text-props item 'face 'keymap)) (extra (calfw-org--tp item 'extra))) (setq text (substring-no-properties text)) (when (and extra (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-link-bracket-re text) (let* ((desc (if (match-end 2) (match-string-no-properties 2 text))) (link (org-link-unescape (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 calfw-org-text-keymap ;; Delete the display property, since displaying images will break our ;; table layout. 'display nil))) (defvar calfw-org-schedule-summary-transformer 'calfw-org-summary-format "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 calfw-org-normalize-date (date) "Return a normalized date (month day year) from DATE." (cond ((numberp date) (calendar-gregorian-from-absolute date)) (t date))) (defun calfw-org-get-timerange (text) "Return a range object (begin end text). If TEXT does not have a range, return nil." (let* ((dotime (calfw-org--tp text 'dotime))) (and (stringp dotime) (and dotime (string-match org-ts-regexp dotime)) (let ((date-string (match-string 1 dotime)) (extra (calfw-org--tp text 'extra))) (if (and extra (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 calfw-org--schedule-period-to-calendar (begin end) "Return calfw calendar items between BEGIN and END from org schedule data." (cl-loop ;;with calfw-org-todo-keywords-regexp = (regexp-opt org-todo-keywords-for-agenda) ; dynamic bind with contents = nil with periods = nil for i in (calfw-org--collect-schedules-period begin end) for date = (calfw-org--tp i 'date) for line = (funcall calfw-org-schedule-summary-transformer i) for range = (calfw-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 (calfw-org--tp i 'dotime) (setq contents (calfw--contents-add (calfw-org-normalize-date date) line contents))) finally return (nconc contents (list (cons 'periods periods))))) (defun calfw-org--schedule-sorter (text1 text2) "Compare org schedule items TEXT1 and TEXT2." (condition-case _ (let ((time1 (calfw-org--tp text1 'time-of-day)) (time2 (calfw-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 calfw-org--schedule-sorter2 (text1 text2) "Compare org schedule items TEXT1 and TEXT2." (condition-case _ (let ((time1 (calfw-org--tp text1 'time-of-day)) (time2 (calfw-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 calfw-org-format-title (file h-obj t-obj h-beg loc) "Create a text string for the title of the headline H-OBJ. Create a text string for the title of the headline H-OBJ in FILE at H-BEG and LOC, using time information from T-OBJ. Return a string with `keymap', `display', `cfw:org-file', `cfw:org-h-beg', and `cfw:org-loc' properties." (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 calfw-org-text-keymap 'display nil 'cfw:org-file file 'cfw:org-h-beg h-beg 'cfw:org-loc loc)) (defun calfw-org-format-date (t-obj lst) "Format a date object T-OBJ using a list of properties LST. Return a list of formatted properties." (mapcar (lambda (v) (org-element-property v t-obj)) lst)) (defun calfw-org-filter-datetime (t-obj lst) "Return the datetime object (T-OBJ) formatted according to LST if it is not nil." (if (car (calfw-org-format-date t-obj lst)) (calfw-org-format-date t-obj lst) nil)) (defun calfw-org-convert-event (file h-obj t-obj h-beg) "Create a calfw event from the org headline object H-OBJ in FILE. Create the event using time object T-OBJ and the beginning of headline object H-BEG. Returns the calfw event created." (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-calfw-event :start-date (calfw-org-format-date t-obj sdate) :start-time (calfw-org-filter-datetime t-obj stime) :end-date (calfw-org-filter-datetime t-obj edate) :end-time (calfw-org-filter-datetime t-obj etime) :title (calfw-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 calfw-org-convert-org-to-calfw (file) "Convert org entries in FILE to calfw format. Returns an alist of `:periods' and `:contents'." (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)))))) (cl-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 = (calfw-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)) (cl-return `((periods ,periods) ,@contents))))))) (defun calfw-org-to-calendar (file begin end) "Convert org entries in FILE between BEGIN and END to calfw events." (cl-loop for event in (calfw-org-convert-org-to-calfw file) if (and (listp event) (equal 'periods (car event))) collect (cons 'periods (cl-loop for evt in (cadr event) if (and (calfw-date-less-equal-p begin (calfw-event-end-date evt)) (calfw-date-less-equal-p (calfw-event-start-date evt) end)) collect evt)) else if (calfw-date-between begin end (calfw-event-start-date event)) collect event)) (defun calfw-org-create-file-source (name file color) "Create an org-element based source with NAME, FILE, and COLOR." (make-calfw-source :name (concat "Org:" name) :color color :data (lambda (begin end) (calfw-org-to-calendar file begin end)))) (defun calfw-org-capture-day () "Return a string representing the date at the cursor position." (with-current-buffer (get-buffer-create calfw-calendar-buffer-name) (let ((pos (calfw-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 calfw-org-capture-template (setq org-capture-templates (append org-capture-templates (list calfw-org-capture-template)))) (defun calfw-org-capture () "Open the `org-agenda' buffer on the selected date. If `calfw-org-capture-template' is set, use `org-capture' with the template specified by the CAR of `calfw-org-capture-template'. Otherwise, display a message indicating that `calfw-org-capture-template' is not set." (interactive) (if calfw-org-capture-template (org-capture nil (car calfw-org-capture-template)) (message "calfw-org-capture-template is not set yet."))) (defun calfw-org-open-agenda-day () "Open `org-agenda' buffer on the selected date. Open the `org-agenda' buffer for the date at point, DATE." (interactive) (let ((date (calfw-cursor-to-nearest-date))) (when date (org-agenda-list nil (calendar-absolute-from-gregorian date) 'day)))) (define-key calfw-calendar-mode-map "c" 'calfw-org-capture) (defvar calfw-org-schedule-map (calfw--define-keymap '(("q" . bury-buffer) ("SPC" . calfw-org-open-agenda-day))) "Key map for the calendar buffer.") (defvar calfw-org-custom-map (calfw--define-keymap '(("g" . calfw-refresh-calendar-buffer) ("j" . calfw-org-goto-date) ("k" . org-capture) ("q" . bury-buffer) ("d" . calfw-change-view-day) ("v d" . calfw-change-view-day) ("v w" . calfw-change-view-week) ("v m" . calfw-change-view-month) ("x" . calfw-org-clean-exit) ("SPC" . calfw-org-open-agenda-day))) "Key map for the calendar buffer.") (defun calfw-org-create-source (&optional color) "Create an `org-agenda' source. COLOR, if given, is the color to use. Returns a new calfw source." (make-calfw-source :name "org-agenda" :color (or color calfw-org-face-agenda-item-foreground-color) :data 'calfw-org--schedule-period-to-calendar)) (defun calfw-org-open-calendar () "Open an org schedule calendar in the new buffer." (interactive) (save-excursion (let* ((source1 (calfw-org-create-source)) (curr-keymap (if calfw-org-overwrite-default-keybinding calfw-org-custom-map calfw-org-schedule-map)) (cp (calfw-create-calendar-component-buffer :view 'month :contents-sources (list source1) :custom-map curr-keymap :sorter 'calfw-org--schedule-sorter))) (switch-to-buffer (calfw-cp-get-buffer cp)) (when (not org-todo-keywords-for-agenda) (message "Warn : open org-agenda buffer first."))))) ;; (defun calfw-org-from-calendar () ;; "Do something. This command should be executed on the calfw calendar." ;; (interactive) ;; (let* ((mdy (calfw-cursor-to-nearest-date)) ;; (m (calendar-extract-month mdy)) ;; (d (calendar-extract-day mdy)) ;; (y (calendar-extract-year mdy))) ;; ;; exec org-remember here? ;; )) (defun calfw-org-read-date-command () "Read a date and return it as a calendar date value." (interactive) (calfw-emacs-to-calendar (org-read-date nil 'to-time))) (defun calfw-org-goto-date () "Move the cursor to the specified date." (interactive) (calfw-navi-goto-date (calfw-org-read-date-command))) ;; (progn (eval-current-buffer) (calfw-open-org-calendar)) ;; (setq org-agenda-files '("./org-samples/complex.org")) (provide 'calfw-org) ;;; calfw-org.el ends here kiwanami-emacs-calfw-6112605/calfw.el000066400000000000000000003644741507535766000173360ustar00rootroot00000000000000;;; calfw.el --- Calendar view framework -*- lexical-binding: t -*- ;; Copyright (C) 2011-2021 SAKURAI Masashi ;; Author: SAKURAI Masashi ;; Maintainer: Al Haji-Ali ;; Version: 2.0 ;; Keywords: calendar ;; Package-Requires: ((emacs "28.1")) ;; URL: https://github.com/haji-ali/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 `calfw-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 `calfw-source' objects. See the function `calfw-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-lib) (require 'calendar) (require 'holidays) (require 'format-spec) ;;; Constants (defconst calfw-week-sunday 0) (defconst calfw-week-monday 1) (defconst calfw-week-tuesday 2) (defconst calfw-week-wednesday 3) (defconst calfw-week-thursday 4) (defconst calfw-week-friday 5) (defconst calfw-week-saturday 6) (defconst calfw-week-days 7) ;;; Customs (defcustom calfw-fchar-vertical-line ?| "The character used for drawing vertical lines." :group 'calfw :type 'character) (defcustom calfw-fchar-horizontal-line ?- "The character used for drawing horizontal lines." :group 'calfw :type 'character) (defcustom calfw-fchar-junction ?+ "The character used for drawing junction lines." :group 'calfw :type 'character) (defcustom calfw-fchar-top-right-corner ?+ "The character used for drawing the top-right corner." :group 'calfw :type 'character) (defcustom calfw-fchar-top-left-corner ?+ "The character used for drawing the top-left corner." :group 'calfw :type 'character) (defcustom calfw-fchar-left-junction ?+ "The character used for drawing junction lines at the left side." :group 'calfw :type 'character) (defcustom calfw-fchar-right-junction ?+ "The character used for drawing junction lines at the right side." :group 'calfw :type 'character) (defcustom calfw-fchar-top-junction ?+ "The character used for drawing junction lines at the top side." :group 'calfw :type 'character) (defcustom calfw-fstring-period-start "(" "The string used to indicate the beginning of a period." :group 'calfw :type 'string) (defcustom calfw-fstring-period-end ")" "The string used to indicate the end of a period." :group 'calfw :type 'string) (defcustom calfw-read-date-command 'calfw-read-date-command-simple "The command used to read the date in `calfw-navi-goto-date-command'. For example `calfw-read-date-command-simple' or `calfw-org-read-date-command'." :group 'calfw :type 'function) (defcustom calfw-event-format-overview "%t" "Format string of `calfw-event's for overviews (month-, 2-week-, week-view). See `calfw-event-format' for possible values." :group 'calfw :type 'string) (defcustom calfw-event-format-days-overview "%s%e%t" "Format string of `calfw-event's for days overviews. See `calfw-event-format' for possible values." :group 'calfw :type 'string) (defcustom calfw-event-format-period-overview "%t%l" "Format string of `calfw-event's for period overviews. See `calfw-event-format' for possible values." :group 'calfw :type 'string) (defcustom calfw-event-format-detail "%s%e%t%l%d" "Format string of `calfw-event's for overviews (month-, week-, day-view). See `calfw-event-format' for possible values." :group 'calfw :type 'string) (defcustom calfw-event-format-title "%s" "Format string for the title of a `calfw-event'. %s = title string" :group 'calfw :type 'string) (defcustom calfw-event-format-start-date "%Y-%m-%d" "Format string for the start date of a `calfw-event'. %Y = year %m = month %d = day" :group 'calfw :type 'string) (defcustom calfw-event-format-start-time "%H:%M " "Format string for the start time of a `calfw-event'. %H = hours %M = minutes" :group 'calfw :type 'string) (defcustom calfw-event-format-end-date "%Y-%m-%d" "Format string for the end date of a `calfw-event'. %Y = year %m = month %d = day" :group 'calfw :type 'string) (defcustom calfw-event-format-end-time "- %H:%M " "Format string for the end time of a `calfw-event'. %H = hours %M = minutes" :group 'calfw :type 'string) (defcustom calfw-event-format-location "\n Location: %s" "Format string for the location of a `calfw-event'. %s = location string" :group 'calfw :type 'string) (defcustom calfw-event-format-description "\n\n%s\n--------------------\n" "Format string for the description of a `calfw-event'. %s = location string" :group 'calfw :type 'string) (defcustom calfw-display-calendar-holidays t "If not-nil, calfw displays holidays." :group 'calfw :type 'boolean) ;;; Faces (defface calfw-title-face '((((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 calfw-header-face '((((class color) (background light)) :foreground "Slategray4" :background "Gray90" :weight bold) (((class color) (background dark)) :foreground "maroon2" :weight bold)) "Face for headers." :group 'calfw) (defface calfw-sunday-face '((((class color) (background light)) :foreground "red2" :background "#ffd5e5" :weight bold) (((class color) (background dark)) :foreground "red" :weight bold)) "Face for Sunday." :group 'calfw) (defface calfw-saturday-face '((((class color) (background light)) :foreground "Blue" :background "#d4e5ff" :weight bold) (((class color) (background light)) :foreground "Blue" :weight bold)) "Face for Saturday." :group 'calfw) (defface calfw-holiday-face '((((class color) (background light)) :background "#ffd5e5") (((class color) (background dark)) :background "grey10" :foreground "purple" :weight bold)) "Face for holidays." :group 'calfw) (defface calfw-grid-face '((((class color) (background light)) :foreground "SlateBlue") (((class color) (background dark)) :foreground "DarkGrey")) "Face for grids." :group 'calfw) (defface calfw-default-content-face '((((class color) (background light)) :foreground "#2952a3") (((class color) (background dark)) :foreground "green2")) "Face for default contents." :group 'calfw) (defface calfw-periods-face '((((class color) (background light)) :background "#668cd9" :foreground "White" :slant italic) (((class color) (background dark)) :foreground "cyan")) "Face for period." :group 'calfw) (defface calfw-day-title-face '((((class color) (background light)) :background "#f8f9ff") (((class color) (background dark)) :background "grey10")) "Face for day title." :group 'calfw) (defface calfw-default-day-face '((((class color) (background light)) :weight bold :inherit calfw-day-title-face) (((class color) (background dark)) :weight bold :inherit calfw-day-title-face)) "Face for default day." :group 'calfw) (defface calfw-annotation-face '((((class color)) :foreground "RosyBrown" :inherit calfw-day-title-face)) "Face for annotations." :group 'calfw) (defface calfw-disable-face '((((class color)) :foreground "DarkGray" :inherit calfw-day-title-face)) "Face for days out of focused period." :group 'calfw) (defface calfw-today-title-face '((((class color) (background light)) :background "#fad163") (((class color) (background dark)) :background "red4" :weight bold)) "Face for today." :group 'calfw) (defface calfw-today-face '((((class color) (background light)) :background "#fff7d7") (((class color) (background dark)) :foreground "Cyan" :weight bold)) "Face for today." :group 'calfw) (defvar calfw-item-separator-color-face "SlateBlue" "Color for the separator line of items in a day.") (defface calfw-calendar-hidden-face '((((class color) (background light)) :foreground "grey" :strike-through t) (((class color) (background dark)) :foreground "grey" :strike-through t) (t :foreground "grey" :strike-through t)) "Face for calendars when hidden." :group 'calfw) ;;; Utilities (defun calfw--k (key alist) "Get a content by KEY from the given ALIST." ;; (cdr (assq key alist))) (defun calfw--sym (&rest strings) "Concatenate STRINGS and return as symbol." ;; (intern-soft (apply 'concat strings))) (defun calfw--rt (text face) "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 calfw--tp (text prop value) "Put a text property PROP with VALUE to the entire TEXT." ;; (unless (stringp text) (setq text (format "%s" text))) (when (< 0 (length text)) (put-text-property 0 (length text) prop value text)) text) (defun calfw--extract-text-props (text &rest excludes) "Return TEXT properties except those in EXCLUDES." ;; (cl-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 calfw--define-keymap (keymap-list) "Key map definition utility. KEYMAP-LIST is a source list like ((key . command) ... )." ;; (let ((new-key-map (make-sparse-keymap))) (mapc (lambda (i) (define-key new-key-map (if (stringp (car i)) (read-kbd-macro (car i)) (car i)) (cdr i))) keymap-list) new-key-map)) (defun calfw-flatten (lst &optional revp) "Flatten a nested list LST into a single list. If REVP is non-nil, reverse the order of elements during flattening." (cl-loop with ret = nil for i in lst do (setq ret (if (consp i) (nconc (calfw-flatten i t) ret) (cons i ret))) finally return (if revp ret (nreverse ret)))) ;;; Date Time Transformation (defun calfw-date (month day year) "Construct a date object in the calendar format, given MONTH, DAY, and YEAR." (and month day year (list month day year))) (defun calfw-time (hours minutes) "Construct a time object in the calendar format (in local time). Returns a list of HOURS and MINUTES." (and hours minutes (list hours minutes))) (defun calfw-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 calfw-calendar-to-emacs (date) "Transform a calendar DATE format to an Emacs format." (encode-time 0 0 0 (calendar-extract-day date) (calendar-extract-month date) (calendar-extract-year date))) (defun calfw-month-year-equal-p (date1 date2) "Return t if of DATE1 and DATE2 have the same month and year." (and (= (calendar-extract-month date1) (calendar-extract-month date2)) (= (calendar-extract-year date1) (calendar-extract-year date2)))) (defun calfw-date-less-equal-p (d1 d2) "Return t if date D1 is less than or equals than date D2." (let ((ed1 (calfw-calendar-to-emacs d1)) (ed2 (calfw-calendar-to-emacs d2))) (or (equal ed1 ed2) (time-less-p ed1 ed2)))) (defun calfw-date-between (begin end date) "Return t if DATE is between BEGIN and END." (and (calfw-date-less-equal-p begin date) (calfw-date-less-equal-p date end))) (defun calfw-month-year-contain-p (month year date2) "Return t if DATE2 is in MONTH and YEAR." (and (= month (calendar-extract-month date2)) (= year (calendar-extract-year date2)))) (defun calfw-date-after (date num) "Return the date after NUM days from DATE." (calendar-gregorian-from-absolute (+ (calendar-absolute-from-gregorian date) num))) (defun calfw-date-before (date num) "Return the date before NUM days from DATE." (calendar-gregorian-from-absolute (- (calendar-absolute-from-gregorian date) num))) (defun calfw-strtime-emacs (time) "Format Emacs time value TIME to the string form YYYY/MM/DD." (format-time-string "%Y/%m/%d" time)) (defun calfw-strtime (date) "Format calendar date value DATE to the string form YYYY/MM/DD." (calfw-strtime-emacs (calfw-calendar-to-emacs date))) (defun calfw-parsetime-emacs (str) "Transform the string format YYYY/MM/DD in STR 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 calfw-parse-str-time (str) "Parse a time string of the format HH:MM in STR to an internal format." (when (string-match "\\([[:digit:]]\\{2\\}\\):\\([[:digit:]]\\{2\\}\\)" str) (calfw-time (string-to-number (match-string 1 str)) (string-to-number (match-string 2 str))))) (defun calfw-parsetime (str) "Transform the string format YYYY/MM/DD in STR to a calendar date value." (calfw-emacs-to-calendar (calfw-parsetime-emacs str))) (defun calfw-read-date-command-simple (string-date) "Parse STRING-DATE and return it as a calendar date value." (interactive "sInput Date (YYYY/MM/DD): ") (calfw-parsetime string-date)) (defun calfw-days-diff (begin end) "Return the number of days between BEGIN and END." (- (time-to-days (calfw-calendar-to-emacs end)) (time-to-days (calfw-calendar-to-emacs begin)))) (defun calfw-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 (calfw-date-after d 1))) (nreverse ret))) (defun calfw-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)))) (calfw-date-after date (if (< 0 num) (- num calfw-week-days) num)))) (defun calfw-week-end-date (date) "Return date of end of the week in which DATE is." (let ((num (+ (- calendar-week-start-day 1) (- calfw-week-days (calendar-day-of-week date))))) (calfw-date-after date (cond ((> 0 num) (+ num calfw-week-days)) ((<= calfw-week-days num) (- num calfw-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. ;; [calfw-component] ;; dest : an object of `calfw-dest' ;; model : an object of the calendar model ;; view : a symbol of view type (month, week, two-weeks, ...) ;; update-hooks : a list of hook functions for update event ;; click-hooks : a list of hook functions for click event (cl-defstruct calfw-component dest model view update-hooks click-hooks) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Data Source ;; This structure defines data sources of the calendar. ;; [calfw-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) ;; hidden : non-nil when it should be hidden in the current view ;; ;; 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. (cl-defstruct calfw-source name data update color period-bgcolor period-fgcolor opt-face opt-period-face hidden) (defun calfw--source-period-bgcolor-get (source) "Return a background color for period items in SOURCE. If `calfw-source-period-bgcolor' is nil, the value of `calfw-source-color' is used." (or (calfw-source-period-bgcolor source) (let ((c (calfw-make-bg-color (calfw-source-color source) (calfw-source-period-fgcolor source)))) (setf (calfw-source-period-bgcolor source) c) c))) (defun calfw--source-period-fgcolor-get (source) "Return a foreground color for period items in SOURCE. If `calfw-source-period-fgcolor' is nil, the black or white (negative color of `calfw-source-period-bgcolor') is used." (or (calfw-source-period-fgcolor source) (let ((c (calfw-make-fg-color (calfw-source-color source) (calfw-source-period-bgcolor source)))) (setf (calfw-source-period-fgcolor source) c) c))) (defun calfw-make-fg-color (src-color _bg-color) "Return a suitable foreground color for SRC-COLOR. Use `calfw-composite-color' with SRC-COLOR, a weight of 0.7, and the default face's foreground color." ;; The calfw way ;; (cl-destructuring-bind ;; (r g b) (color-values (or color "black")) ;; (if (< 147500 (+ r g b)) "black" "white")) ; (* 65536 3 0.75) (calfw-composite-color src-color 0.7 (face-foreground 'default))) (defun calfw-make-bg-color (src-color _fg-color) "Compose SRC-COLOR with the default background color. Returns a color string." (calfw-composite-color src-color 0.3 (face-background 'default))) (defun calfw-composite-color (clr1 alpha clr2) "Return the combination of CLR1 with ALPHA and CLR2. CLR2 is composited with 1-ALPHA transpancy." (let* ((result-rgb (cl-mapcar (lambda (c1 c2) (+ (* alpha c1) (* (- 1 alpha) c2))) (color-name-to-rgb clr1) (color-name-to-rgb clr2)))) (apply 'color-rgb-to-hex (append result-rgb '(2))))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Calendar event ;; This structure defines calendar events. (cl-defstruct calfw-event title ; event title [string] start-date ; start date of the event [calfw-date] start-time ; start time of the event (optional) end-date ; end date of the event [calfw-date] (optional) end-time ; end of the event (optional) description ; event description [string] (optional) location ; location [string] (optional) source ; [internal] source of the event status ; 'cancelled, 'tentative, 'confirmed or nil data ; reference to event data ) (defun calfw-event-overview (event) "Extract the event overview string from EVENT." (calfw-event-format event calfw-event-format-overview)) (defun calfw-event-days-overview (event) "Extract the days overview string from EVENT." (calfw-event-format event calfw-event-format-days-overview)) (defun calfw-event-period-overview (event) "Extract the period overview string from EVENT." (calfw-event-format event calfw-event-format-period-overview)) (defun calfw-event-detail (event) "Extract the details string from EVENT." (calfw-event-format event calfw-event-format-detail)) (defun calfw--event-format-field-string (string) "Return STRING as a format field." `((?s . ,string))) (defun calfw--event-format-field-time (time) "Format TIME values for use by `calfw-event-format-field'. Returns an alist of format characters and formatted time strings." `((?H . ,(calfw--event-format-field-number (car time) 2)) (?M . ,(calfw--event-format-field-number (cadr time) 2)))) (defun calfw--event-format-field-date (date) "Format DATE values for use in `calfw-event-format-field'." `((?Y . ,(calfw--event-format-field-number (caddr date) 4)) (?m . ,(calfw--event-format-field-number (car date) 2)) (?d . ,(calfw--event-format-field-number (cadr date) 2)))) (defun calfw--event-format-field-number (num width) "Format NUM as a string of at least WIDTH digits, padded with zeros." (format (concat "%0" (number-to-string width) "d") num)) (defun calfw--event-format-field (event field args-fun) "Format FIELD of the calfw-event EVENT. Formatting is done according to the string specified in `calfw-event-format-FIELD'. ARGS-FUN is a function to generate arguments for `format-spec'." (let* ((s-name (symbol-name field)) (format-string (symbol-value (calfw--sym "calfw-event-format-" s-name))) (field-val (funcall (calfw--sym "calfw-event-" s-name) event))) (if field-val (format-spec format-string (funcall args-fun field-val)) ""))) (defun calfw-event-format (event format-string) "Format the calfw-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." (calfw--tp (format-spec format-string (mapcar #'(lambda (field) `(,(car field) . ,(calfw--event-format-field event (cadr field) (caddr field)))) '((?t title calfw--event-format-field-string) (?S start-date calfw--event-format-field-date) (?s start-time calfw--event-format-field-time) (?E end-date calfw--event-format-field-date) (?e end-time calfw--event-format-field-time) (?l location calfw--event-format-field-string) (?d description calfw--event-format-field-string)))) 'cfw:source (calfw-event-source event))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Rendering Destination ;; This structure object is the abstraction of the rendering ;; destinations, such as buffers, regions and so on. ;; [calfw-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. ;; today-ol : a list of overlays for today (cl-defstruct calfw-dest type buffer min-func max-func width height clear-func before-update-func after-update-func today-ol) ;; shortcut functions (defmacro calfw-dest-with-region (dest &rest body) "Execute BODY in a buffer narrowed to the region specified by DEST. DEST is a calfw destination. The buffer is narrowed to the region specified by `(calfw-dest-point-min DEST)` and `(calfw-dest-point-max DEST)`." (let (($dest (gensym))) `(let ((,$dest ,dest)) (with-current-buffer (calfw-dest-buffer ,$dest) (save-restriction (narrow-to-region (calfw-dest-point-min ,$dest) (calfw-dest-point-max ,$dest)) ,@body))))) (put 'calfw-dest-with-region 'lisp-indent-function 1) (defun calfw-dest-point-min (c) "Call the minimum function of calendar calfw-dest C." (funcall (calfw-dest-min-func c))) (defun calfw-dest-point-max (c) "Call the maximum function of calendar calfw-dest C." (funcall (calfw-dest-max-func c))) (defun calfw-dest-clear (c) "Call the clear function of calfw-dest C." (funcall (calfw-dest-clear-func c))) (defun calfw-dest-before-update (c) "Call the before update function of calfw-dest C." (when (calfw-dest-before-update-func c) (funcall (calfw-dest-before-update-func c)))) (defun calfw-dest-after-update (c) "Call the after update function of calfw-dest C." (when (calfw-dest-after-update-func c) (funcall (calfw-dest-after-update-func c)))) ;; private functions (defun calfw--dest-ol-today-clear (dest) "Clear decoration overlays in DEST." ;; " Clear decoration overlays." (cl-loop for i in (calfw-dest-today-ol dest) do (delete-overlay i)) (setf (calfw-dest-today-ol dest) nil)) (defun calfw--dest-ol-today-set (dest) "Highlight today in DEST. Sets `calfw-dest-today-ol' of DEST to the created overlays." ;; " Put a highlight face on today." (let (ols) (calfw-dest-with-region dest (calfw--find-all-by-date dest (calendar-current-date) (lambda (begin end) (let ((overlay (make-overlay begin end))) (overlay-put overlay 'face (if (eq 'calfw-day-title-face (get-text-property begin 'face)) 'calfw-today-title-face 'calfw-today-face)) (push overlay ols))))) (setf (calfw-dest-today-ol dest) ols))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Low level API ;; Buffer (defconst calfw-calendar-buffer-name "*cfw-calendar*" "[internal] Default buffer name for the calendar view.") (defun calfw-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 `calfw-calendar-mode' and the key map `calfw-calendar-mode-map'. BUF is a buffer name to render the calendar view. If BUF is nil, the default buffer name `calfw-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 `calfw-component'. CUSTOM-MAP is the additional keymap that is added to default keymap `calfw-calendar-mode-map'." (let ((buffer (or buf (get-buffer-create calfw-calendar-buffer-name))) (window (or (and buf (get-buffer-window buf)) (selected-window))) dest) (setq dest (make-calfw-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 'calfw-calendar-mode) (calfw-calendar-mode custom-map))) dest)) ;; Region (defun calfw-dest-init-region (buf mark-begin mark-end &optional width height) "Create a region destination between MARK-BEGIN and MARK-END in BUF. MARK-BEGIN and MARK-END are markers separated by more than one character. Optional WIDTH and HEIGHT specify the width and height of the region. This destination is employed to be embedded in some application buffer. The destination does not set up any modes or keymaps for the buffer, and is the responsibility of the application that uses calfw." (let ((mark-begin mark-begin) (mark-end mark-end) (window (or (get-buffer-window buf) (selected-window)))) (make-calfw-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 () (calfw--dest-region-clear (marker-position mark-begin) (marker-position mark-end)))))) (defun calfw--dest-region-clear (begin end) "Delete the content of the region from BEGIN to END." (when (< 2 (- end begin)) (delete-region begin (1- end))) (goto-char begin)) ;; Inline text (defconst calfw-dest-background-buffer " *calfw-dest-background*") (defun calfw-dest-init-inline (width height) "Create a text destination with given WIDTH and HEIGHT." (let ((buffer (get-buffer-create calfw-dest-background-buffer)) (window (selected-window)) dest) (setq dest (make-calfw-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 calfw--cp-new (dest model view &optional initial-date) "Create a new component object for DEST, MODEL, and VIEW. INITIAL-DATE is the date to display. VIEW is a symbol specifying the view type: month, two-weeks, week, or day. DEST is a `calfw-dest' object, and MODEL is a model object." (let ((cp (make-calfw-component :dest dest :model model :view (or view 'month)))) (calfw--cp-update cp initial-date) cp)) ;; Getting the component instance (defun calfw-cp-get-component (&optional noerror) "Return the component object on the current cursor position. If NOERROR is non-nil, return nil if no component is found." (or (get-text-property (point) 'cfw:component) (if (local-variable-p 'calfw-component (current-buffer)) (buffer-local-value 'calfw-component (current-buffer)) (unless noerror (error "Not found cfw:component attribute"))))) ;; Getter (defun calfw-cp-get-contents-sources (component &optional exclude-hidden) "Return a list of the content sources for COMPONENT. EXCLUDE-HIDDEN, if non-nil, excludes hidden sources." (calfw--model-get-contents-sources (calfw-component-model component) exclude-hidden)) (defun calfw-cp-get-annotation-sources (component) "Return a list of the annotation sources for COMPONENT." (calfw--model-get-annotation-sources (calfw-component-model component))) (defun calfw-cp-get-view (component) "Return a symbol of the current view type for COMPONENT." (calfw-component-view component)) (defun calfw-cp-get-buffer (component) "Return the destination buffer on which the COMPONENT draws the content." (calfw-dest-buffer (calfw-component-dest component))) (defun calfw-cp-displayed-date-p (component date) "Return non-nil if DATE is displayed in the current view of COMPONENT." (let* ((model (calfw-component-model component)) (begin (calfw--k 'begin-date model)) (end (calfw--k 'end-date model))) (unless (and begin end) (error "Wrong model : %S" model)) (calfw-date-between begin end date))) ;; Setter (defun calfw--cp-move-cursor (dest date &optional force) "Move the cursor in DEST to DATE if the cursor is not already on DATE. FORCE non-nil unconditionally moves the cursor." (when (or force ;; Check if there's a current component, otherwise ;; `calfw-cursor-to-nearest-date' signals an error. (null (calfw-cp-get-component t)) (not (equal (calfw--cursor-to-date) date))) (let ((pos (calfw--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 calfw-cp-set-contents-sources (component sources) "Set content sources for COMPONENT to SOURCES." (calfw--model-set-contents-sources sources (calfw-component-model component))) (defun calfw-cp-set-annotation-sources (component sources) "Set annotation sources for COMPONENT to SOURCES." (calfw--model-set-annotation-sources sources (calfw-component-model component))) (defun calfw-cp-set-view (component view) "Change the view type of COMPONENT and re-draw the content. VIEW is a symbol of the view type." (setf (calfw-component-view component) view) (calfw--cp-update component)) (defun calfw-cp-resize (component width height) "Resize the COMPONENT size to WIDTH and HEIGHT and re-draw the content." (let* ((dest (calfw-component-dest component)) (buf (calfw-dest-buffer dest)) (window (or (and buf (get-buffer-window buf)) (selected-window)))) (setf (calfw-dest-width dest) (or width (window-width window)) (calfw-dest-height dest) (or height (window-height window))))) ;; Hook (defun calfw-cp-add-update-hook (component hook) "Add HOOK to the update hooks of COMPONENT. HOOK is a function that has no argument." (push hook (calfw-component-update-hooks component))) (defun calfw-cp-add-click-hook (component hook) "Add HOOK to the click hooks of COMPONENT. HOOK is a function that has no argument." (push hook (calfw-component-click-hooks component))) ;;; private methods (defvar calfw-cp-dipatch-funcs '((month . calfw--view-month) (week . calfw--view-week) (two-weeks . calfw--view-two-weeks) (day . calfw--view-day)) "Dispatch functions for calfw views.") (defun calfw--cp-dispatch-view-impl (view) "Return a view function corresponding to the view symbol VIEW." (or (alist-get view calfw-cp-dipatch-funcs) (error "Not found such view : %s" view))) (defvar calfw-highlight-today t "Variable to control whether today is rendered differently than other days.") (defun calfw--cp-update (component &optional initial-date) "Clear and re-draw the COMPONENT content. Optional argument INITIAL-DATE specifies the date to display after re-drawing." (let* ((buf (calfw-cp-get-buffer component)) (dest (calfw-component-dest component))) (with-current-buffer buf (calfw-dest-before-update dest) (calfw--dest-ol-today-clear dest) (let ((buffer-read-only nil)) (calfw-dest-with-region dest (calfw-dest-clear dest) (funcall (calfw--cp-dispatch-view-impl (calfw-component-view component)) component))) (when calfw-highlight-today (calfw--dest-ol-today-set dest)) (when initial-date (calfw-cp-goto-date component initial-date)) (calfw-dest-after-update dest) (calfw--cp-fire-update-hooks component)))) (defun calfw--cp-fire-click-hooks (component) "Call click hook functions of COMPONENT with no arguments." (cl-loop for f in (calfw-component-click-hooks component) do (condition-case err (funcall f) (error (message "Calfw: Click / Hook error %S [%s]" f err))))) (defun calfw--cp-fire-update-hooks (component) "Call update hook functions of the COMPONENT with no arguments." (cl-loop for f in (calfw-component-update-hooks component) do (condition-case err (funcall f) (error (message "Calfw: Update / Hook error %S [%s]" f err))))) ;;; Models (defvar calfw-default-text-sorter 'string-lessp "[internal] Default sorting criteria in a calendar cell.") (defun calfw-model-abstract-new (date contents-sources annotation-sources &optional sorter) "Return an abstract model object. DATE is the initial date, CONTENTS-SOURCES is a list of contents functions, ANNOTATION-SOURCES is a list of annotation functions, and SORTER is a function to sort the contents." (unless date (setq date (calendar-current-date))) `((init-date . ,date) (contents-sources . ,contents-sources) (annotation-sources . ,annotation-sources) (sorter . ,(or sorter calfw-default-text-sorter)))) (defun calfw-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." (calfw-model-abstract-new date (calfw--model-get-contents-sources org-model) (calfw--model-get-annotation-sources org-model) (calfw-model-get-sorter org-model))) (defun calfw--model-create-updated-view-data (model view-data) "Clear previous view model data from MODEL and return a new model. The new model is created with VIEW-DATA." (append (calfw-model-abstract-derived (calfw--k 'init-date model) model) view-data)) ;; public functions (defun calfw-model-get-holiday-by-date (date model) "Return a holiday title on the DATE in MODEL." (calfw--contents-get date (calfw--k 'holidays model))) (defun calfw-model-get-contents-by-date (date model) "Return a list of contents on the DATE in MODEL." (calfw--contents-get date (calfw--k 'contents model))) (defun calfw-model-get-annotation-by-date (date model) "Return an annotation on the DATE in MODEL." (calfw--contents-get date (calfw--k 'annotations model))) (defun calfw-model-get-periods-by-date (date model) "Return a list of periods on the DATE in the MODEL." (cl-loop for (begin end event) in (calfw--k 'periods model) for content = (if (calfw-event-p event) (calfw-event-detail event) event) if (calfw-date-between begin end date) collect `(,begin ,end ,content))) (defun calfw-model-get-sorter (model) "Return a sorter function from the calendar MODEL." (calfw--k 'sorter model)) ;; private functions (defun calfw--model-get-contents-sources (model &optional exclude-hidden) "Return a list of content sources of the MODEL. If EXCLUDE-HIDDEN is non-nil, exclude hidden sources." (let ((sources (calfw--k 'contents-sources model))) (if exclude-hidden (seq-filter (lambda (s) (not (calfw-source-hidden s))) sources) sources))) (defun calfw--model-get-annotation-sources (model) "Return a list of annotation sources of the MODEL." (calfw--k 'annotation-sources model)) (defun calfw--model-set-init-date (date model) "Set the DATE that is used to calculate the display period of MODEL. Returns DATE." (let ((cell (assq 'init-date model))) (cond (cell (setcdr cell date)) (t (push (cons 'init-date date) model)))) date) (defun calfw--model-set-contents-sources (sources model) "Set the content SOURCES of the MODEL. Return SOURCES." (let ((cell (assq 'contents-sources model))) (cond (cell (setcdr cell sources)) (t (push (cons 'contents-sources sources) model)))) sources) (defun calfw--model-set-annotation-sources (sources model) "Set the annotation SOURCES of MODEL. Returns SOURCES." (let ((cell (assq 'annotation-sources model))) (cond (cell (setcdr cell sources)) (t (push (cons 'annotation-sources sources) model)))) sources) (defun calfw--contents-get (date contents) "Return a list of contents on the DATE from CONTENTS." (cdr (calfw--contents-get-internal date contents))) (defun calfw--contents-get-internal (date contents) "Return a cons cell that has the key DATE in CONTENTS. One can modify the returned cons cell destructively. Returns nil if DATE is not found in CONTENTS." (cond ((or (null date) (null contents)) nil) (t (cl-loop for i in contents if (equal date (car i)) return i finally return nil)))) (defun calfw--contents-add (date content contents) "Add a record, DATE as a key and CONTENT as a body, to CONTENTS destructively. Returns the modified contents list. If CONTENTS has a record for DATE, this function appends CONTENT to the record." (let* ((prv (calfw--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 calfw--contents-merge (begin end sources) "Return a contents alist between BEGIN date and END, using SOURCES." (cond ((null sources) nil) (t (cl-loop for s in sources for f = (calfw-source-data s) for cnts = (calfw--contents-put-source (funcall f begin end) s) with contents = nil do (cl-loop for c in cnts for (d . line) = c do (setq contents (calfw--contents-add d line contents))) finally return contents)))) (defun calfw-periods-put-source (periods source) "Associate SOURCE with each period in PERIODS. Returns a list of the form \\='((START-DATE END-DATE EVENT) ...)." (cl-loop for period in periods collect (cond ((calfw-event-p period) (setf (calfw-event-source period) source) `(,(calfw-event-start-date period) ,(calfw-event-end-date period) ,period)) (t (cl-destructuring-bind (begin end . summaries) period (list begin end (calfw--tp (if (listp summaries) (mapconcat 'identity (calfw-flatten summaries) " ") summaries) 'cfw:source source))))))) (defun calfw--contents-put-source (contents source) "Put the SOURCE object in the `calfw-source' text property in CONTENTS. During rendering, the SOURCE object is used to put some face property." (cond ((null source) contents) (t (cl-loop for content in contents collect (cond ((calfw-event-p content) (setf (calfw-event-source content) source) `(,(calfw-event-start-date content) ,content)) ((eq (car content) 'periods) (cons 'periods (calfw-periods-put-source (cdr content) source))) (t (cons (car content) (cl-loop for i in (cdr content) collect (calfw--tp i 'cfw:source source))))))))) (defun calfw--annotations-merge (begin end sources) "Return an annotation alist between BEGIN date and END date. Call functions `calfw-annotations-functions' from SOURCES." (cond ((null sources) nil) ((= 1 (length sources)) (funcall (calfw-source-data (car sources)) begin end)) (t (cl-loop for s in sources for f = (calfw-source-data s) for cnts = (funcall f begin end) with annotations = nil do (cl-loop for c in cnts for (d . line) = c for prv = (calfw--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 calfw-render-title-month (date) "Render the calendar title for the monthly view, given DATE." (format "%4s / %s" (calendar-extract-year date) (aref calendar-month-name-array (1- (calendar-extract-month date))))) (defun calfw-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 calfw-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 calfw--render-center (width string &optional padding) "Format STRING in the center, padding to WIDTH with PADDING." (let* ((padding (or padding ?\ )) (cnt (or (and string (calfw--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 calfw--render-left (width string &optional padding) "Format STRING, padding on the right with the character PADDING to WIDTH." (let* ((padding (or padding ?\ )) (cnt (or (and string (calfw--render-truncate string width t)) "")) (len (string-width cnt)) (margin (- width len))) (concat cnt (make-string margin padding)))) (defun calfw--render-separator (string) "Add a separator into the ROWS list, using STRING. Returns STRING." ;; " 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 ,calfw-item-separator-color-face))) (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 (cl-loop with nattrs = nil for (n . v) in (append attrs `((:underline . ,calfw-item-separator-color-face))) 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? CALFW- FACE %S / %S" string last-face))))) string) (defun calfw--render-right (width string &optional padding) "Format STRING of WIDTH, padding on the left with the character PADDING." ;; " Format STRING, padding on the left with the character PADDING." (let* ((padding (or padding ?\ )) (cnt (or (and string (calfw--render-truncate string width t)) "")) (len (string-width cnt)) (margin (- width len))) (concat (make-string margin padding) cnt))) (defun calfw--render-add-right (width left right &optional padding) "Layout strings LEFT and RIGHT within WIDTH. LEFT and RIGHT are truncated to fit within WIDTH, adding PADDING as appropriate." (let* ((padding (or padding ?\ )) (lcnt (or (and left (calfw--render-truncate left width t)) "")) (llen (string-width lcnt)) (rmargin (- width llen)) (right (string-trim right)) (rcnt (or (and right (> rmargin 0) (calfw--render-truncate right rmargin)) "")) (cmargin (- width llen (string-width rcnt)))) (concat lcnt (if (< 0 cmargin) (make-string cmargin padding)) rcnt))) (defun calfw--render-sort-contents (lst sorter) "Sort the string list LST using SORTER. Returns the sorted list." (sort (copy-sequence lst) sorter)) (defun calfw--render-get-face-period (text default-face) "Return a face for the source object of the period TEXT. The face is derived from the `cfw:source' text property of TEXT, and DEFAULT-FACE is returned if the source or background color are nil." (let* ((src (get-text-property 0 'cfw:source text)) (bg-color (and src (calfw--source-period-bgcolor-get src))) (fg-color (and src (calfw--source-period-fgcolor-get src)))) (cond ((or (null src) (null bg-color)) default-face) (t (append (list ':background bg-color ':foreground fg-color) (calfw-source-opt-period-face src)))))) (defun calfw--render-get-face-content (text default-face) "Return a face for the source object of the content TEXT. The face is derived from the `cfw:source' text property of TEXT, or DEFAULT-FACE if the source or its foreground color is nil." (let* ((src (get-text-property 0 'cfw:source text)) (fg-color (and src (calfw-source-color src)))) (cond ((or (null src) (null fg-color)) default-face) (t (append (list ':foreground (calfw-make-fg-color fg-color fg-color) ':background (calfw-make-bg-color fg-color fg-color)) (calfw-source-opt-face src)))))) (defun calfw--render-default-content-face (str &optional default-face) "Put the default content face on STR, retaining existing faces. Use DEFAULT-FACE if non-nil. Return the modified string." ;; (cl-loop for i from 0 below (length str) with ret = (substring str 0) with face = (or default-face (calfw--render-get-face-content str 'calfw-default-content-face)) 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 calfw--render-get-week-face (daynum &optional default-face) "Return face for DAYNUM, or DEFAULT-FACE if DAYNUM is not a weekend." ;; (cond ((= daynum calfw-week-saturday) 'calfw-saturday-face) ((= daynum calfw-week-sunday) 'calfw-sunday-face) (t default-face))) (defun calfw--render-truncate (org limit-width &optional ellipsis) "Truncate a string ORG to LIMIT-WIDTH, like `truncate-string-to-width'. ELLIPSIS is the string to use as ellipsis." ;; " (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))) (unless (get-text-property 0 'help-echo str) (calfw--tp str 'help-echo org)) str) org)) (defface calfw-toolbar-face '((((class color) (background light)) :foreground "Gray90" :background "Gray90") (((class color) (background dark)) :foreground "Steelblue4" :background "Steelblue4")) "Face for toolbar." :group 'calfw) (defface calfw-toolbar-button-off-face '((((class color) (background light)) :foreground "Lightskyblue4" :background "White") (((class color) (background dark)) :foreground "Gray10" :weight bold :background "Steelblue4")) "Face for button on toolbar." :group 'calfw) (defface calfw-toolbar-button-on-face '((((class color) (background light)) :foreground "Lightpink3" :background "Gray94" ) (((class color) (background dark)) :foreground "Gray50" :weight bold :background "Steelblue4")) "Face for button on toolbar." :group 'calfw) (defun calfw--render-button (title command &optional state) "Return a decorated text for the toolbar buttons. TITLE is a button title, COMMAND is an interactive command called by clicking. If STATE is non-nil, the face `calfw-toolbar-button-on-face' is applied, otherwise `calfw-toolbar-button-off-face' is applied." (let ((text (concat "[" title "]")) (keymap (make-sparse-keymap))) (calfw--rt text (if state 'calfw-toolbar-button-on-face 'calfw-toolbar-button-off-face)) (define-key keymap [mouse-1] command) (calfw--tp text 'keymap keymap) (calfw--tp text 'mouse-face 'highlight) text)) (defun calfw--render-toolbar (width current-view prev-cmd next-cmd) "Return a text string of the toolbar. WIDTH is the width of the toolbar. CURRENT-VIEW is a symbol representing the current view type. PREV-CMD and NEXT-CMD are the commands for moving the view." (let* ((prev (calfw--render-button " < " prev-cmd)) (today (calfw--render-button "Today" 'calfw-navi-goto-today-command)) (next (calfw--render-button " > " next-cmd)) (month (calfw--render-button "Month" 'calfw-change-view-month (eq current-view 'month))) (tweek (calfw--render-button "Two Weeks" 'calfw-change-view-two-weeks (eq current-view 'two-weeks))) (week (calfw--render-button "Week" 'calfw-change-view-week (eq current-view 'week))) (day (calfw--render-button "Day" 'calfw-change-view-day (eq current-view 'day))) (sp " ") (toolbar-text (calfw--render-add-right width (concat sp prev sp next sp today sp) (concat day sp week sp tweek sp month sp)))) (calfw--render-default-content-face toolbar-text 'calfw-toolbar-face))) (defun calfw-event-mouse-click-toggle-calendar (event) "Toggle the `calfw-source-hidden' property of calendar source at EVENT." (interactive "e") (when-let ((s (get-text-property (posn-point (event-start event)) 'cfw:source))) (setf (calfw-source-hidden s) (not (calfw-source-hidden s))) (calfw--cp-update (calfw-cp-get-component)))) (defun calfw-event-toggle-calendar (source) "Toggle visibility of calendar SOURCE." (interactive (list (get-text-property (point) 'cfw:source))) (when source (if current-prefix-arg (let* ((comp (calfw-cp-get-component)) (sources (calfw--model-get-contents-sources (calfw-component-model comp)))) (dolist (src sources) (unless (eq src source) (setf (calfw-source-hidden src) (not (calfw-source-hidden src)))))) (setf (calfw-source-hidden source) (not (calfw-source-hidden source)))) (calfw--cp-update (calfw-cp-get-component)))) (defun calfw-event-toggle-all-calendars () "Show all calendars in the current view. If all calendars are already shown, hide them all." (interactive) (when (calfw-cp-get-component) (let* ((comp (calfw-cp-get-component)) (sources (calfw--model-get-contents-sources (calfw-component-model comp))) (all-shown (not (cl-some 'identity (cl-loop for s in sources collect (calfw-source-hidden s)))))) (cl-loop for s in sources do (setf (calfw-source-hidden s) all-shown)) (calfw--cp-update comp)))) (defun calfw--render-footer (_width sources) "Return a text of the footer. The footer is rendered based on the SOURCES." (let* ((spaces (make-string 5 ? )) (whole-text (mapconcat 'identity (cl-loop with keymap = (progn (let ((kmap (make-sparse-keymap))) (define-key kmap [mouse-1] 'calfw-event-mouse-click-toggle-calendar) (define-key kmap [13] 'calfw-event-toggle-calendar) kmap)) for s in sources for hidden-p = (calfw-source-hidden s) for title = (calfw--tp (substring (calfw-source-name s) 0) 'cfw:source s) for dot = (calfw--tp (substring "(==)" 0) 'cfw:source s) collect (progn (calfw--tp dot 'mouse-face 'highlight) (propertize (calfw--render-default-content-face (concat "[" (calfw--rt dot (if hidden-p 'calfw-calendar-hidden-face (calfw--render-get-face-period dot 'calfw-periods-face))) " " title "]") (if hidden-p 'calfw-calendar-hidden-face (calfw--render-get-face-content title 'calfw-default-content-face))) 'keymap keymap))) (concat "\n" spaces)))) (concat spaces whole-text))) (defun calfw--render-periods (date week-day periods-stack cell-width) "Translate PERIODS-STACK to display content on DATE. WEEK-DAY and CELL-WIDTH are used to render the periods title." (cl-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 inwidth = (- cell-width (if beginp 1 0) (if endp 1 0)) for title = (calfw--render-periods-title date week-day begin end content cell-width inwidth) collect (apply 'propertize (concat (when beginp calfw-fstring-period-start) (calfw--render-left inwidth title ?-) (when endp calfw-fstring-period-end)) 'face (calfw--render-get-face-period content 'calfw-periods-face) 'font-lock-face (calfw--render-get-face-period content 'calfw-periods-face) 'cfw:period t props))) (defun calfw--render-periods-title (date week-day begin end content cell-width inwidth) "Return a title string for DATE. Return nil if CONTENT is nil. WEEK-DAY, BEGIN, END, CELL-WIDTH, and INWIDTH are also arguments." (let* ((week-begin (calfw-date-after date (- week-day))) ;; (month-begin (calfw-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 (cl-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 (calfw--render-truncate title inwidth (equal end date)))))) ;; event periods shifts pos - not one line (defun calfw--render-periods-get-min (periods-each-days begin end) "Find the minimum empty row number of the days between BEGIN and END. PERIODS-EACH-DAYS contains the periods." (cl-loop for row-num from 0 below 30 ; assuming the number of stacked periods is less than 30 unless (cl-loop for d in (calfw-enumerate-days begin end) for periods-stack = (calfw--contents-get d periods-each-days) if (and periods-stack (assq row-num periods-stack)) return t) return row-num)) (defun calfw--render-periods-place (periods-each-days row period) "Assign PERIOD content to the ROW'th row on the days of the period. Return PERIODS-EACH-DAYS." (cl-loop for d in (calfw-enumerate-days (car period) (cadr period)) for periods-stack = (calfw--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 calfw--render-periods-stacks (model) "Arrange the `periods' records of the MODEL and create period-stacks. period-stack -> ((row-num . period) ... )" (let* (periods-each-days) (cl-loop for (begin end event) in (calfw--k 'periods model) for content = (if (calfw-event-p event) (calfw-event-period-overview event) event) for period = (list begin end content (calfw--extract-text-props content 'face)) for row = (calfw--render-periods-get-min periods-each-days begin end) do (setq periods-each-days (calfw--render-periods-place periods-each-days row period))) periods-each-days)) (defun calfw--render-columns (day-columns param) "Concatenate each row on the days in DAY-COLUMNS into a string of a line. DAY-COLUMNS is a list of columns. A column is a list of the form \\(DATE \\(DAY-TITLE . ANNOTATION-TITLE) STRING STRING...). PARAM is a plist of parameters." (let ((cell-width (calfw--k 'cell-width param)) (cell-height (calfw--k 'cell-height param)) (EOL (calfw--k 'eol param)) (VL (calfw--k 'vl param)) ;; (hline (calfw-k 'hline param)) (cline (calfw--k 'cline param))) ;; day title (cl-loop for day-rows in day-columns for date = (car day-rows) for (tday . ant) = (cadr day-rows) do (insert VL (if date (calfw--tp (calfw--render-default-content-face (calfw--render-add-right cell-width tday ant) 'calfw-day-title-face) 'cfw:date date) (calfw--render-left cell-width "")))) (insert VL EOL) ;; day contents (cl-loop with breaked-day-columns = (cl-loop for day-rows in day-columns for (date _ants . lines) = day-rows collect (cons date (calfw--render-break-lines lines cell-width (1- cell-height)))) for i from 1 below cell-height do (cl-loop for day-rows in breaked-day-columns for date = (car day-rows) for row = (nth i day-rows) do (insert VL (calfw--tp (calfw--render-separator (calfw--render-left cell-width (and row (format "%s" row)))) 'cfw:date date))) (insert VL EOL)) (insert cline))) (defvar calfw-render-line-breaker 'calfw-render-line-breaker-simple "A function which breaks a long line into some lines. The function takes STRING, LINE-WIDTH and MAX-LINE-NUMBER as arguments. Calfw has 3 strategies: none, simple and wordwrap. `calfw-render-line-breaker-none' never breaks lines. `calfw-render-line-breaker-simple' breaks lines with rigid width \(default). `calfw-render-line-breaker-wordwrap' breaks lines with the Emacs function `fill-region'.") (defun calfw--render-break-lines (lines cell-width cell-height) "Return LINES split into multiple lines based on CELL-WIDTH and CELL-HEIGHT. Uses `calfw-render-line-breaker'." (and lines (let ((num (/ cell-height (length lines)))) (cond ((> 2 num) lines) (t (cl-loop with total-rows = nil for line in lines for rows = (funcall calfw-render-line-breaker line cell-width num) do (when total-rows (calfw--render-add-item-separator-sign total-rows)) (setq total-rows (append total-rows rows)) finally return total-rows)))))) (defun calfw--render-add-item-separator-sign (rows) "Add a separator into the ROWS list. Adds a `cfw:item-separator' text property to the last line of the ROWS list, unless it already has a `cfw:period' property. Returns ROWS." (let ((last-line (car (last rows)))) (unless (get-text-property 0 'cfw:period last-line) (put-text-property 0 (length last-line) 'cfw:item-separator t last-line)) rows)) (defun calfw-render-line-breaker-none (line _w _n) "Return LINE in a list." (list line)) (defun calfw-render-line-breaker-simple (string line-width max-line-num) "Split STRING into lines of width LINE-WIDTH, with at most MAX-LINE-NUM lines. Return a list of strings." (cl-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 (string-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) (cl-incf linenum)) ((= line-width wsum) (push (substring string lastpos (1+ i)) ret) (setq lastpos (1+ i) curcol 0) (cl-incf linenum)) ((< line-width wsum) (push (substring string lastpos i) ret) (setq lastpos i curcol w) (cl-incf linenum)) (t (cl-incf curcol w))) finally return (or (and ret (nreverse ret)) '("")))) (defun calfw-render-line-breaker-wordwrap (string line-width max-line-num) "Break STRING into a list of strings, each no wider than LINE-WIDTH. Uses `fill-region' for word wrapping. Limits the number of lines to MAX-LINE-NUM. Returns a list of strings." (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 (string-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 calfw--render-append-parts (param) "Append rendering parts to PARAM and return a new list." (let* ((EOL "\n") (cell-width (calfw--k 'cell-width param)) (columns (calfw--k 'columns param)) (num-cell-char (/ cell-width (char-width calfw-fchar-horizontal-line)))) (append param `((eol . ,EOL) (vl . ,(calfw--rt (make-string 1 calfw-fchar-vertical-line) 'calfw-grid-face)) (hline . ,(calfw--rt (concat (cl-loop for i from 0 below columns concat (concat (make-string 1 (if (= i 0) calfw-fchar-top-left-corner calfw-fchar-top-junction)) (make-string num-cell-char calfw-fchar-horizontal-line))) (make-string 1 calfw-fchar-top-right-corner) EOL) 'calfw-grid-face)) (cline . ,(calfw--rt (concat (cl-loop for i from 0 below columns concat (concat (make-string 1 (if (= i 0) calfw-fchar-left-junction calfw-fchar-junction)) (make-string num-cell-char calfw-fchar-horizontal-line))) (make-string 1 calfw-fchar-right-junction) EOL) 'calfw-grid-face)))))) (defun calfw--render-day-of-week-names (model param) "Insert week names based on MODEL. Iterates through the headers in MODEL, inserting the day names using `calendar-day-name-array'. PARAM specifies cell width and vertical line." (cl-loop for i in (calfw--k 'headers model) with VL = (calfw--k 'vl param) with cell-width = (calfw--k 'cell-width param) for name = (aref calendar-day-name-array i) do (insert VL (calfw--rt (calfw--render-center cell-width name) (calfw--render-get-week-face i 'calfw-header-face))))) (defun calfw--render-calendar-cells-weeks (model param title-func) "Insert calendar cells for week based views, using MODEL. Iterates over the weeks in `(calfw--k \\='weeks MODEL)' and calls `calfw--render-calendar-cells-days' for each week. PARAM and TITLE-FUNC are passed to `calfw--render-calendar-cells-days'." (cl-loop for week in (calfw--k 'weeks model) do (calfw--render-calendar-cells-days model param title-func week 'calfw--render-event-overview-content t))) (defun calfw--render-rows-prop (rows) "Put a marker as a text property for TAB navigation in ROWS. Returns the ROWS with text properties added." (cl-loop with i = 0 for line in rows collect (prog1 (calfw--tp line 'cfw:row-count i) (if (< 0 (length line)) (cl-incf i))))) (defun calfw--render-map-event-content (lst event-fun) "Map EVENT-FUN over LST, applying it to `calfw-event's." (mapcar #'(lambda (evt) (if (calfw-event-p evt) (funcall event-fun evt) evt)) lst)) (defun calfw--render-event-overview-content (lst) "Apply `calfw-event-overview' on `calfw-event's in LST." (calfw--render-map-event-content lst 'calfw-event-overview)) (defun calfw--render-event-days-overview-content (lst) "Apply `calfw-event-days-overview' on `calfw-event's in LST." (calfw--render-map-event-content lst 'calfw-event-days-overview)) (defun calfw--render-event-details-content (lst) "Apply `calfw-event-detail' on `calfw-event's in LST." (calfw--render-map-event-content lst 'calfw-event-detail)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Views ;;; view model utilities (defun calfw--view-model-make-weeks (begin-date end-date) "Return a list of weeks (list of dates) between BEGIN-DATE and END-DATE." (let* (;; (first-day-day (calendar-day-of-week begin-date)) weeks) (cl-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 (calfw-date-less-equal-p end-date i) (cl-return))) ;; add a day (push i week) ;; increment (setq day (% (1+ day) calfw-week-days)) (setq i (calfw-date-after i 1))) (nreverse weeks))) (defun calfw--view-model-make-days (begin-date end-date) "Return a list of days from BEGIN-DATE to END-DATE, inclusive." (cl-loop with days = nil with i = begin-date do (push i days) (when (calfw-date-less-equal-p end-date i) (cl-return (reverse days))) (setq i (calfw-date-after i 1)))) (defun calfw--view-model-make-day-names-for-week () "Return a list of indices representing the days of the week." (cl-loop for i from 0 below calfw-week-days collect (% (+ calendar-week-start-day i) calfw-week-days))) (defun calfw--view-model-make-day-names-for-days (begin-date end-date) "Return a list of the days of the week between BEGIN-DATE and END-DATE." (cl-loop with day = (calendar-day-of-week begin-date) with day-names = nil with i = begin-date do (push day day-names) (when (calfw-date-less-equal-p end-date i) (cl-return (reverse day-names))) (setq day (% (1+ day) calfw-week-days)) (setq i (calfw-date-after i 1)))) (defvar displayed-month) ; because these variables are binded dynamically. (defvar displayed-year) (defun calfw--view-model-make-holidays (date) "Return an alist of holidays around DATE." (if calfw-display-calendar-holidays (let ((displayed-month (calendar-extract-month date)) (displayed-year (calendar-extract-year date))) (calendar-holiday-list)))) (defun calfw--view-model-make-common-data (model begin-date end-date &optional lst) "Return an alist of common data for MODEL between BEGIN-DATE and END-DATE. Return value is appended to LST if provided." (let* ((contents-all (calfw--contents-merge begin-date end-date (calfw--model-get-contents-sources model t)))) (append `(; common data (begin-date . ,begin-date) (end-date . ,end-date) (holidays . ,(calfw--view-model-make-holidays begin-date)) ; an alist of holidays, (DATE HOLIDAY-NAME) (annotations . ,(calfw--annotations-merge ; an alist of annotations, (DATE ANNOTATION) begin-date end-date (calfw--model-get-annotation-sources model))) (contents . ,(cl-loop for i in contents-all unless (eq 'periods (car i)) collect i)) ; an alist of contents, (DATE LIST-OF-CONTENTS) (periods . ,(calfw--k 'periods contents-all))) ; a list of periods, (BEGIN-DATE END-DATE SUMMARY) lst))) (defun calfw--view-model-make-common-data-for-weeks (model begin-date end-date) "Return a model object for week based views from MODEL, BEGIN-DATE and END-DATE." (calfw--model-create-updated-view-data model (calfw--view-model-make-common-data model begin-date end-date `((headers . ,(calfw--view-model-make-day-names-for-week)) ; a list of the index of day-of-week (weeks . ,(calfw--view-model-make-weeks ; a matrix of day-of-month, which corresponds to the index of `headers' (calfw-week-begin-date begin-date) (calfw-week-end-date end-date))))))) (defun calfw--view-model-make-common-data-for-days (model begin-date end-date) "Return a MODEL object for linear views of days between BEGIN-DATE and END-DATE." (calfw--model-create-updated-view-data model (calfw--view-model-make-common-data model begin-date end-date `((headers . ,(calfw--view-model-make-day-names-for-days begin-date end-date)) ; a list of the index of day-of-week (days . ,(calfw--view-model-make-days ; a list of days, which corresponds to the index of `headers' begin-date end-date)))))) ;;; view-month (defun calfw--view-month-model (model) "Create a logical view model of monthly calendar from MODEL." (let* ((init-date (calfw--k 'init-date model)) (year (calendar-extract-year init-date)) (month (calendar-extract-month init-date)) (begin-date (calfw-date month 1 year)) (end-date (calfw-date month (calendar-last-day-of-month month year) year))) ;; model (append (calfw--view-model-make-common-data-for-weeks model begin-date end-date) `((month . ,month) (year . ,year))))) (defun calfw--round-cell-width (width) "Adjust WIDTH to be a multiple of `calfw-fchar-horizontal-line' width." (cond ((eql (char-width calfw-fchar-horizontal-line) 1) width) (t (- width (% width (char-width calfw-fchar-horizontal-line)))))) (defun calfw--view-month-calc-param (dest total-weeks) "Calculate cell size from DEST and TOTAL-WEEKS and return an alist of parameters." (let* ((win-width (calfw-dest-width dest)) ;; title 2, toolbar 1, header 2, hline 7, footer 1, margin 2 => 15 (win-height (max 15 (- (calfw-dest-height dest) 15))) (junctions-width (* (char-width calfw-fchar-junction) 8)) ; weekdays+1 (cell-width (calfw--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 calfw-week-days) junctions-width))) `((cell-width . ,cell-width) (cell-height . ,cell-height) (total-width . ,total-width) (columns . ,calfw-week-days)))) (defun calfw--view-month (component) "Render monthly calendar view. Render the monthly calendar view for COMPONENT." (let* ((dest (calfw-component-dest component)) (model (calfw--view-month-model (calfw-component-model component))) (total-weeks (length (calfw--k 'weeks model))) (param (calfw--render-append-parts (calfw--view-month-calc-param dest total-weeks))) (total-width (calfw--k 'total-width param)) (EOL (calfw--k 'eol param)) (VL (calfw--k 'vl param)) (hline (calfw--k 'hline param)) (cline (calfw--k 'cline param))) ;; update model (setf (calfw-component-model component) model) ;; header (insert (calfw--rt (calfw-render-title-month (calfw--k 'init-date model)) 'calfw-title-face) EOL (calfw--render-toolbar total-width 'month 'calfw-navi-previous-month-command 'calfw-navi-next-month-command) EOL hline) ;; day names (calfw--render-day-of-week-names model param) (insert VL EOL cline) ;; contents (let ((year (calfw--k 'year model)) (month (calfw--k 'month model))) (calfw--render-calendar-cells-weeks model param (lambda (date week-day hday) (calfw--rt (format "%s" (calendar-extract-day date)) (cond (hday 'calfw-sunday-face) ((not (calfw-month-year-contain-p month year date)) 'calfw-disable-face) (t (calfw--render-get-week-face week-day 'calfw-default-day-face))))))) ;; footer (insert (calfw--render-footer total-width (calfw--model-get-contents-sources model))))) ;;; view-week (defun calfw--view-week-model (model) "Create a logical view model of weekly calendar from MODEL." (let* ((init-date (calfw--k 'init-date model)) (begin-date (calfw-week-begin-date init-date)) (end-date (calfw-week-end-date init-date))) (calfw--view-model-make-common-data-for-weeks model begin-date end-date))) ;; (calfw-view-week-model (calfw-model-abstract-new (calfw-date 1 1 2011) nil nil)) (defun calfw--view-week-calc-param (dest) "Calculate cell size from the reference size and return rendering parameters. Return an alist of rendering parameters based on the size of DEST." (let* ((win-width (calfw-dest-width dest)) ;; title 2, toolbar 1, header 2, hline 2, footer 1, margin 2 => 10 (win-height (max 15 (- (calfw-dest-height dest) 10))) (junctions-width (* (char-width calfw-fchar-junction) 8)) (cell-width (calfw--round-cell-width (max 5 (/ (- win-width junctions-width) 7)))) (cell-height (max 2 win-height)) (total-width (+ (* cell-width calfw-week-days) junctions-width))) `((cell-width . ,cell-width) (cell-height . ,cell-height) (total-width . ,total-width) (columns . ,calfw-week-days)))) (defun calfw--view-week (component) "Render weekly calendar view for COMPONENT. Render the weekly calendar view based on the COMPONENT's model and parameters. The model contains the begin and end dates, and the parameters specify the layout and formatting." (let* ((dest (calfw-component-dest component)) (param (calfw--render-append-parts (calfw--view-week-calc-param dest))) (total-width (calfw--k 'total-width param)) (EOL (calfw--k 'eol param)) (VL (calfw--k 'vl param)) (hline (calfw--k 'hline param)) (cline (calfw--k 'cline param)) (model (calfw--view-week-model (calfw-component-model component))) (begin-date (calfw--k 'begin-date model)) (end-date (calfw--k 'end-date model))) ;; update model (setf (calfw-component-model component) model) ;; header (insert (calfw--rt (calfw-render-title-period begin-date end-date) 'calfw-title-face) EOL (calfw--render-toolbar total-width 'week 'calfw-navi-previous-week-command 'calfw-navi-next-week-command) EOL hline) ;; day names (calfw--render-day-of-week-names model param) (insert VL EOL cline) ;; contents (calfw--render-calendar-cells-weeks model param (lambda (date week-day hday) (calfw--rt (format "%s" (calendar-extract-day date)) (if hday 'calfw-sunday-face (calfw--render-get-week-face week-day 'calfw-default-day-face))))) ;; footer (insert (calfw--render-footer total-width (calfw--model-get-contents-sources model))))) ;;; view-two-weeks (defun calfw-view-two-weeks-model-adjust (model) "Adjust the begin date of the two-weeks MODEL." (let ((in-date (calfw--k 'init-date model))) (cond ((eq 'two-weeks (calfw--k 'type model)) (let ((old-begin-date (calfw--k 'begin-date model)) (old-end-date (calfw--k 'end-date model))) (cond ((calfw-date-between old-begin-date old-end-date in-date) in-date) ((calfw-date-between old-end-date (calfw-date-after old-end-date calfw-week-days) in-date) old-end-date) ((calfw-date-between (calfw-date-after old-begin-date (- calfw-week-days)) old-begin-date in-date) (calfw-date-after old-begin-date (- calfw-week-days))) (t in-date)))) (t in-date)))) (defun calfw--view-two-weeks-model (model) "Create a logical view model of two-weeks calendar from MODEL." (let* ((init-date (calfw-view-two-weeks-model-adjust model)) (begin-date (calfw-week-begin-date init-date)) (end-date (calfw-date-after begin-date (1- (* 2 calfw-week-days))))) ;; model (append (calfw--view-model-make-common-data-for-weeks model begin-date end-date) `((type . two-weeks))))) ;; (calfw-view-two-weeks-model (calfw-model-abstract-new (calfw-date 1 1 2011) nil nil)) (defun calfw--view-two-weeks-calc-param (dest) "Calculate cell size from the reference size and return rendering parameters. Calculate cell size from the reference size in DEST and return an alist of rendering parameters." (let* ((win-width (calfw-dest-width dest)) ;; title 2, toolbar 1, header 2, hline 3, footer 1, margin 2 => 11 (win-height (max 15 (- (calfw-dest-height dest) 11))) (junctions-width (* (char-width calfw-fchar-junction) 8)) (cell-width (calfw--round-cell-width (max 5 (/ (- win-width junctions-width) 7)))) (cell-height (max 2 (/ win-height 2))) (total-width (+ (* cell-width calfw-week-days) junctions-width))) `((cell-width . ,cell-width) (cell-height . ,cell-height) (total-width . ,total-width) (columns . ,calfw-week-days)))) (defun calfw--view-two-weeks (component) "Render two-weeks calendar view for COMPONENT. Render two-weeks calendar view for COMPONENT. The calendar is rendered to the destination specified by the component. The model of the component is updated." (let* ((dest (calfw-component-dest component)) (param (calfw--render-append-parts (calfw--view-two-weeks-calc-param dest))) (total-width (calfw--k 'total-width param)) (EOL (calfw--k 'eol param)) (VL (calfw--k 'vl param)) (hline (calfw--k 'hline param)) (cline (calfw--k 'cline param)) (model (calfw--view-two-weeks-model (calfw-component-model component))) (begin-date (calfw--k 'begin-date model)) (end-date (calfw--k 'end-date model))) ;; update model (setf (calfw-component-model component) model) ;; header (insert (calfw--rt (calfw-render-title-period begin-date end-date) 'calfw-title-face) EOL (calfw--render-toolbar total-width 'two-weeks 'calfw-navi-previous-week-command 'calfw-navi-next-week-command) EOL hline) ;; day names (calfw--render-day-of-week-names model param) (insert VL EOL cline) ;; contents (calfw--render-calendar-cells-weeks model param (lambda (date week-day hday) (calfw--rt (format "%s" (calendar-extract-day date)) (if hday 'calfw-sunday-face (calfw--render-get-week-face week-day 'calfw-default-day-face))))) ;; footer (insert (calfw--render-footer total-width (calfw--model-get-contents-sources model))))) ;;; view-day (defun calfw--view-day-calc-param (dest &optional num) "Calculate cell size from the reference size and return rendering parameters. Calculate cell size from the reference size and return an alist of rendering parameters for DEST. NUM is the number of columns." (let* ((num (or num 1)) (win-width (calfw-dest-width dest)) ;; title 2, toolbar 1, header 2, hline 2, footer 1, margin 2 => 10 (win-height (max 15 (- (calfw-dest-height dest) 10))) (junctions-width (* (char-width calfw-fchar-junction) (1+ num))) (cell-width (calfw--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 calfw--view-day (component) "Render daily calendar view for COMPONENT." (let* ((dest (calfw-component-dest component)) (param (calfw--render-append-parts (calfw--view-day-calc-param dest))) (total-width (calfw--k 'total-width param)) (EOL (calfw--k 'eol param)) (VL (calfw--k 'vl param)) (hline (calfw--k 'hline param)) (cline (calfw--k 'cline param)) (current-date (calfw--k 'init-date (calfw-component-model component))) (model (calfw--view-model-make-common-data-for-days (calfw-component-model component) current-date current-date))) ;; update model (setf (calfw-component-model component) model) ;; header (insert (calfw--rt (calfw-render-title-day current-date) 'calfw-title-face) EOL (calfw--render-toolbar total-width 'day 'calfw-navi-previous-day-command 'calfw-navi-next-day-command) EOL hline) ;; day names (calfw--render-day-of-week-names model param) (insert VL EOL cline) ;; contents (calfw--render-calendar-cells-days model param (lambda (date week-day hday) (calfw--rt (format "%s" (calendar-extract-day date)) (if hday 'calfw-sunday-face (calfw--render-get-week-face week-day 'calfw-default-day-face))))) ;; footer (insert (calfw--render-footer total-width (calfw--model-get-contents-sources model))))) (defun calfw--render-calendar-cells-days (model param title-func &optional days content-fun do-weeks) "Insert calendar cells for the linear views using MODEL and PARAM. Insert calendar cells for the linear views using MODEL, PARAM, and TITLE-FUNC. Optional DAYS, CONTENT-FUN, and DO-WEEKS are also used." (calfw--render-columns (cl-loop with cell-width = (calfw--k 'cell-width param) with days = (or days (calfw--k 'days model)) with content-fun = (or content-fun 'calfw--render-event-days-overview-content) with holidays = (calfw--k 'holidays model) with annotations = (calfw--k 'annotations model) with headers = (calfw--k 'headers model) with raw-periods-all = (calfw--render-periods-stacks model) with sorter = (calfw-model-get-sorter model) for date in days ; days columns loop for count from 0 below (length days) for hday = (car (calfw--contents-get date holidays)) for week-day = (nth count headers) for ant = (calfw--rt (calfw--contents-get date annotations) 'calfw-annotation-face) for raw-periods = (calfw--contents-get date raw-periods-all) for raw-contents = (calfw--render-sort-contents (funcall content-fun (calfw-model-get-contents-by-date date model)) sorter) for prs-contents = (calfw--render-rows-prop (append (if do-weeks (calfw--render-periods date week-day raw-periods cell-width) (calfw--render-periods-days date raw-periods cell-width)) (mapcar 'calfw--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 " " (calfw--rt (substring hday 0) 'calfw-holiday-face)))) collect (cons date (cons (cons tday ant) prs-contents))) param)) (defun calfw--render-periods-days (date periods-stack cell-width) "Insert period texts. When PERIODS-STACK is non-nil, insert period texts for DATE according to CELL-WIDTH. Return a list of strings representing the periods." (when periods-stack (let ((stack (sort (copy-sequence periods-stack) (lambda (a b) (< (car a) (car b)))))) (cl-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 = (calfw--render-truncate (concat (calfw-strtime begin) " - " (calfw-strtime end) " : " content) width t) collect (if content (calfw--rt (concat (if beginp "(" " ") (calfw--render-left width title ?-) (if endp ")" " ")) (calfw--render-get-face-period content 'calfw-periods-face)) ""))))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Navigation ;; Following functions assume that the current buffer is a calendar view. (defun calfw--cursor-to-date (&optional pos) "Return the date at POS, or nil if none." (get-text-property (or pos (point)) 'cfw:date)) (defun calfw-cursor-to-nearest-date () "Return the date at or nearest the cursor position in the calendar." (or (calfw--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 (calfw-component-dest (calfw-cp-get-component))) get) (setq get (lambda (cmds) (save-excursion (if (null cmds) (calfw--cursor-to-date) (ignore-errors (funcall (car cmds)) (funcall get (cdr cmds))))))) (or (cl-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)) (calfw--find-first-date dest)) (t (calfw--find-last-date dest))))))) (defun calfw--find-first-date (dest) "Return the first date in the current buffer using DEST." (let ((pos (next-single-property-change (calfw-dest-point-min dest) 'cfw:date))) (and pos (calfw--cursor-to-date pos)))) (defun calfw--find-last-date (dest) "Return the last date in the current buffer using DEST." (let ((pos (previous-single-property-change (calfw-dest-point-max dest) 'cfw:date))) (and pos (calfw--cursor-to-date (1- pos))))) (defun calfw--find-by-date (dest date) "Return a point where the text property `cfw:date' equals DATE in DEST. If DATE is not found in DEST, return nil." (cl-loop with pos = (calfw-dest-point-min dest) with end = (calfw-dest-point-max dest) for next = (next-single-property-change pos 'cfw:date nil end) for text-date = (and next (calfw--cursor-to-date next)) while (and next (< next end)) do (if (and text-date (equal date text-date)) (cl-return next)) (setq pos next))) (defun calfw--find-all-by-date (dest date func) "Call FUNC with begin and end positions of text with ‘cfw:date' equal to DATE. Call FUNC in each region of DEST where the text-property ‘cfw:date' is equal to DATE. FUNC receives two arguments, begin position and end position." (cl-loop with pos = (calfw-dest-point-min dest) with end = (calfw-dest-point-max dest) for next = (next-single-property-change pos 'cfw:date nil end) for text-date = (and next (calfw--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 calfw--find-item (dest date row-count) "Find the schedule item in DEST which have properties DATE and ROW-COUNT. The parameters are compared to text properties `cfw:date' and `cfw:row-count'. Returns the position of the item, or nil if no item is found." (cl-loop with pos = (calfw-dest-point-min dest) with end = (calfw-dest-point-max dest) with last-found = nil for next = (next-single-property-change pos 'cfw:date nil end) for text-date = (and next (calfw--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)) ;; this is needed item (cl-return next)) (when (and text-date (equal date text-date) text-row-count) ;; keep it to search bottom item (setq last-found next)) (setq pos next) finally (if (and last-found (< row-count 0)) (cl-return last-found)))) (defun calfw-cp-goto-date (component date &optional force-move-cursor) "Go to DATE on COMPONENT. If the current view doesn't contain DATE, update the view to display DATE. If FORCE-MOVE-CURSOR is non-nil, move the cursor." (let ((dest (calfw-component-dest component)) (model (calfw-component-model component))) (unless (calfw-cp-displayed-date-p component date) (calfw--model-set-init-date date model) (calfw--cp-update component)) (calfw--cp-move-cursor dest date force-move-cursor))) (defun calfw-navi-goto-date (date) "Move the cursor to DATE. If DATE is not included on the current calendar, this function changes the calendar view." (let ((cp (calfw-cp-get-component))) (when cp (calfw-cp-goto-date cp date)))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Major Mode / Key bindings (defvar calfw-calendar-mode-map (calfw--define-keymap '( ("" . calfw-navi-next-day-command) ("f" . calfw-navi-next-day-command) ("" . calfw-navi-previous-day-command) ("b" . calfw-navi-previous-day-command) ("" . calfw-navi-next-week-command) ("n" . calfw-navi-next-week-command) ("" . calfw-navi-previous-week-command) ("p" . calfw-navi-previous-week-command) ;; Vi style ("l" . calfw-navi-next-day-command) ("h" . calfw-navi-previous-day-command) ("j" . calfw-navi-previous-week-command) ("k" . calfw-navi-next-week-command) ("^" . calfw-navi-goto-week-begin-command) ("$" . calfw-navi-goto-week-end-command) ("<" . calfw-navi-previous-month-command) ;;("M-v" . calfw-navi-previous-month-command) (">" . calfw-navi-next-month-command) ;;("C-v" . calfw-navi-next-month-command) ("" . calfw-navi-previous-month-command) ("" . calfw-navi-next-month-command) ("" . calfw-navi-goto-first-date-command) ("" . calfw-navi-goto-last-date-command) ("M-g" . calfw-navi-goto-date-command) ("t" . calfw-navi-goto-today-command) ("." . calfw-navi-goto-today-command) ("TAB" . calfw-navi-next-item-command) ("C-i" . calfw-navi-next-item-command) ("" . calfw-navi-prev-item-command) ("S-TAB" . calfw-navi-prev-item-command) ("g" . calfw-refresh-calendar-buffer) ("SPC" . calfw-show-details-command) ("D" . calfw-change-view-day) ("W" . calfw-change-view-week) ("T" . calfw-change-view-two-weeks) ("M" . calfw-change-view-month) ([mouse-1] . calfw-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 calfw-calendar-mode-map (&optional custom-map) "Return a keymap object for the calendar buffer. If CUSTOM-MAP is provided, set its parent to `calfw-calendar-mode-map' and return CUSTOM-MAP. Otherwise, return `calfw-calendar-mode-map'." (cond (custom-map (set-keymap-parent custom-map calfw-calendar-mode-map) custom-map) (t calfw-calendar-mode-map))) (defvar calfw-calendar-mode-hook nil "This hook is called at end of setting up major mode `calfw-calendar-mode'.") (defun calfw-calendar-mode (&optional custom-map) "Set up `calfw-calendar-mode' as the major mode, using CUSTOM-MAP." ;; \\{calfw-calendar-mode-map}" (kill-all-local-variables) (setq truncate-lines t) (use-local-map (calfw-calendar-mode-map custom-map)) (setq major-mode 'calfw-calendar-mode mode-name "Calendar Mode") (setq buffer-undo-list t buffer-read-only t) (run-hooks 'calfw-calendar-mode-hook)) ;;; Actions (defun calfw-change-view-month () "Change the view of the current component to \\='month." (interactive) (when (calfw-cp-get-component) (calfw-cp-set-view (calfw-cp-get-component) 'month))) (defun calfw-change-view-week () "Change current component’s view to \\='week. Changes the view of the current component, as returned by `calfw-cp-get-component', to ‘week." (interactive) (when (calfw-cp-get-component) (calfw-cp-set-view (calfw-cp-get-component) 'week))) (defun calfw-change-view-two-weeks () "Change the view of the calendar component to \\='two-weeks." (interactive) (when (calfw-cp-get-component) (calfw-cp-set-view (calfw-cp-get-component) 'two-weeks))) (defun calfw-change-view-day () "Change the view of the current component to \\='day. Changes the view of the current component, obtained via `calfw-cp-get-component', to `day' by calling `calfw-cp-set-view'." (interactive) (when (calfw-cp-get-component) (calfw-cp-set-view (calfw-cp-get-component) 'day))) (defun calfw-navi-next-item-command () "Move the cursor to the next item." (interactive) (let ((cp (calfw-cp-get-component)) (date (calfw--cursor-to-date)) (rcount (or (get-text-property (point) 'cfw:row-count) -1))) (when (and cp date) (let ((next (calfw--find-item (calfw-component-dest cp) date (1+ rcount)))) (if next (goto-char next) (calfw-navi-goto-date date)))))) (defun calfw-navi-prev-item-command () "Move the cursor to the previous item." (interactive) (let ((cp (calfw-cp-get-component)) (date (calfw--cursor-to-date)) (rcount (or (get-text-property (point) 'cfw:row-count) -1))) (when (and cp date) (let ((next (calfw--find-item (calfw-component-dest cp) date (1- rcount)))) (if next (goto-char next) (calfw-navi-goto-date date)))))) (defun calfw-navi-on-click () "Click on the date at point in the calendar." (interactive) (let ((cp (calfw-cp-get-component)) (date (calfw--cursor-to-date))) (when (and cp date) (calfw-cp-goto-date cp date) (calfw--cp-fire-click-hooks cp)))) (defun calfw-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 (calfw-cp-get-component))) (when cp (unless no-resize (calfw-cp-resize cp (window-width) (window-height))) (cl-loop for s in (calfw-cp-get-contents-sources cp t) for f = (calfw-source-update s) if f do (funcall f)) (cl-loop for s in (calfw-cp-get-annotation-sources cp) for f = (calfw-source-update s) if f do (funcall f)) (calfw--cp-update cp)))) (defun calfw-navi-goto-week-begin-command () "Move the cursor to the first day of the current week." (interactive) (when (calfw-cp-get-component) (calfw-navi-goto-date (calfw-week-begin-date (calfw-cursor-to-nearest-date))))) (defun calfw-navi-goto-week-end-command () "Move the cursor to the last day of the current week." (interactive) (when (calfw-cp-get-component) (calfw-navi-goto-date (calfw-week-end-date (calfw-cursor-to-nearest-date))))) (defun calfw-navi-goto-date-command () "Move the cursor to the specified date." (interactive) (calfw-navi-goto-date (call-interactively calfw-read-date-command))) (defun calfw-navi-goto-today-command () "Move the cursor to today." (interactive) (calfw-navi-goto-date (calfw-emacs-to-calendar (current-time)))) (defun calfw-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 (calfw-cp-get-component) (unless num (setq num 1)) (let* ((cursor-date (calfw-cursor-to-nearest-date)) (new-cursor-date (calfw-date-after cursor-date num))) (calfw-navi-goto-date new-cursor-date)))) (defun calfw-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") (calfw-navi-next-day-command (- (or num 1)))) (defun calfw-navi-goto-first-date-command () "Move the cursor to the first day on the current calendar view." (interactive) (calfw-navi-goto-date (calfw--find-first-date (calfw-component-dest (calfw-cp-get-component))))) (defun calfw-navi-goto-last-date-command () "Move the cursor to the last day on the current calendar view." (interactive) (calfw-navi-goto-date (calfw--find-last-date (calfw-component-dest (calfw-cp-get-component))))) (defun calfw-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") (calfw-navi-next-day-command (* calfw-week-days (or num 1)))) (defun calfw-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") (calfw-navi-next-day-command (* (- calfw-week-days) (or num 1)))) (defun calfw-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 (calfw-cp-get-component) (unless num (setq num 1)) (let* ((cursor-date (calfw-cursor-to-nearest-date)) (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 (calfw-date month day year))) (calfw-navi-goto-date new-cursor-date)))) (defun calfw-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") (calfw-navi-next-month-command (- (or num 1)))) ;;; Detail popup (defun calfw-show-details-command () "Show details on the nearest date." (interactive) (let* ((cursor-date (calfw-cursor-to-nearest-date)) (cp (calfw-cp-get-component)) (model (and cp (calfw-component-model cp)))) (when model (calfw-details-popup (calfw-details-layout cursor-date model))))) (defvar calfw-details-buffer-name "*calfw-details*" "Name of details buffer.") (defvar calfw-details-window-size 20 "Default detail buffer window size.") (defvar calfw-before-win-num) (defvar calfw-main-buf) (defun calfw-details-popup (text) "Popup the buffer to show details. TEXT is a content to show." (let ((buf (get-buffer calfw-details-buffer-name)) (before-win-num (length (window-list))) (main-buf (current-buffer))) (unless (and buf (eq (buffer-local-value 'major-mode buf) 'calfw-details-mode)) (setq buf (get-buffer-create calfw-details-buffer-name)) (with-current-buffer buf (calfw-details-mode) (set (make-local-variable 'calfw-before-win-num) before-win-num))) (with-current-buffer buf (let (buffer-read-only) (set (make-local-variable 'calfw-main-buf) main-buf) (erase-buffer) (insert text) (goto-char (point-min)))) (pop-to-buffer buf))) (defun calfw-details-layout (date model) "Layout details and return the text. DATE is a date to show. MODEL is model object." (let* ((EOL "\n") (HLINE (calfw--rt (concat (make-string (window-width) ?-) EOL) 'calfw-grid-face)) (holiday (calfw-model-get-holiday-by-date date model)) (annotation (calfw-model-get-annotation-by-date date model)) (periods (calfw-model-get-periods-by-date date model)) (contents (calfw--render-sort-contents (calfw--render-event-details-content (calfw-model-get-contents-by-date date model)) (calfw-model-get-sorter model))) (row-count -1)) (concat (calfw--rt (concat "Schedule on " (calfw-strtime date) " (") 'calfw-header-face) (calfw--rt (calendar-day-name date) (calfw--render-get-week-face (calendar-day-of-week date) 'calfw-header-face)) (calfw--rt (concat ")" EOL) 'calfw-header-face) (when (or holiday annotation) (concat (and holiday (calfw--rt holiday 'calfw-holiday-face)) (and holiday annotation " / ") (and annotation (calfw--rt annotation 'calfw-annotation-face)) EOL)) HLINE (cl-loop for (begin end summary) in periods for prefix = (propertize (concat (calfw-strtime begin) " - " (calfw-strtime end) " : ") 'face (calfw--render-get-face-period summary 'calfw-periods-face) 'font-lock-face (calfw--render-get-face-period summary 'calfw-periods-face) 'cfw:row-count (cl-incf row-count)) concat (concat prefix " " summary EOL)) (cl-loop for i in contents for f = (calfw--render-get-face-content i 'calfw-default-content-face) concat (concat "- " (propertize i 'face f 'font-lock-face f 'cfw:row-count (cl-incf row-count)) EOL))))) (defvar calfw-details-mode-map (calfw--define-keymap '(("q" . calfw-details-kill-buffer-command) ("SPC" . calfw-details-kill-buffer-command) ("n" . calfw-details-navi-next-command) ("f" . calfw-details-navi-next-command) ("" . calfw-details-navi-next-command) ("p" . calfw-details-navi-prev-command) ("b" . calfw-details-navi-prev-command) ("" . calfw-details-navi-prev-command) ("TAB" . calfw-details-navi-next-item-command) ("C-i" . calfw-details-navi-next-item-command) ("" . calfw-details-navi-prev-item-command) ("S-TAB" . calfw-details-navi-prev-item-command))) "Default key map for the details buffer.") (defvar calfw-details-mode-hook nil) (defun calfw-details-mode () "Set up major mode `calfw-details-mode'. \\{calfw-details-mode-map}" (kill-all-local-variables) (setq truncate-lines t) (use-local-map calfw-details-mode-map) (setq major-mode 'calfw-details-mode mode-name "Calendar Details Mode") (setq buffer-undo-list t buffer-read-only t) (run-hooks 'calfw-details-mode-hook)) (defun calfw-details-kill-buffer-command () "Kill buffer and delete window." (interactive) (let ((win-num (length (window-list))) (next-win (get-buffer-window calfw-main-buf))) (when (and (not (one-window-p)) (> win-num calfw-before-win-num)) (delete-window)) (kill-buffer calfw-details-buffer-name) (when next-win (select-window next-win)))) (defun calfw-details-navi-next-command (&optional num) "Go to the next day in the calendar and show its details. Go to the next day in the calendar buffer, according to NUM, and show its details in the details buffer." (interactive "p") (when calfw-main-buf (with-current-buffer calfw-main-buf (calfw-navi-next-day-command num) (calfw-show-details-command)))) (defun calfw-details-navi-prev-command (&optional num) "Go to the previous day in the calendar and show its details. Goes back NUM days if NUM is provided." (interactive "p") (when calfw-main-buf (with-current-buffer calfw-main-buf (calfw-navi-previous-day-command num) (calfw-show-details-command)))) (defun calfw-details-navi-next-item-command () "Go to the next item in the calfw details view." (interactive) (let* ((rcount (or (get-text-property (point) 'cfw:row-count) -1)) (next-pos (calfw--details-find-item (1+ rcount)))) (goto-char (or next-pos (point-min))))) (defun calfw-details-navi-prev-item-command () "Go to the previous item in the calfw details buffer." (interactive) (let* ((rcount (or (get-text-property (point) 'cfw:row-count) -1)) (next-pos (calfw--details-find-item (1- rcount)))) (goto-char (or next-pos (point-min))))) (defun calfw--details-find-item (row-count) "Find the schedule item which has a specific ROW-COUNT. ROW-COUNT is compared against the `cfw:row-count' property. Returns the position of the item, or nil if no item is found." (cl-loop with pos = (point-min) for next-pos = (next-single-property-change pos 'cfw:row-count) for text-row-count = (and next-pos (get-text-property next-pos 'cfw:row-count)) while next-pos do (when (eql row-count text-row-count) (cl-return next-pos)) (setq pos next-pos))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; High level API ;; buffer (cl-defun calfw-open-calendar-buffer (&key date buffer custom-map contents-sources annotation-sources view sorter) "Open a calendar buffer. DATE is the initial focus date, BUFFER is the buffer to use, CUSTOM-MAP is the keymap, CONTENTS-SOURCES are the sources for contents, ANNOTATION-SOURCES are the sources for annotations, VIEW is the view to use, and SORTER is the sorter to use." (interactive) (let (cp) (save-excursion (setq cp (calfw-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 (calfw-cp-get-buffer cp)))) (cl-defun calfw-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 `calfw-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 `calfw-calendar-buffer-name'. CUSTOM-MAP is the additional keymap that is added to default keymap `calfw-calendar-mode-map'." (let* ((dest (calfw-dest-init-buffer buffer nil nil custom-map)) (model (calfw-model-abstract-new date contents-sources annotation-sources sorter)) (cp (calfw--cp-new dest model view date))) (with-current-buffer (calfw-dest-buffer dest) (set (make-local-variable 'calfw-component) cp)) cp)) ;; region (cl-defun calfw-create-calendar-component-region (&key date width height keymap contents-sources annotation-sources view sorter) "Display the calendar view at DATE. This function also inserts markers of the rendering destination at current point and 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 as specified by VIEW. If those are nil, the size is calculated from the selected window. CONTENTS-SOURCES, ANNOTATION-SOURCES, and SORTER are used to construct the calendar using `calfw-model-abstract-new' KEYMAP is the keymap that is put to the text property `keymap'. If KEYMAP is nil, `calfw-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 (calfw-dest-init-region (current-buffer) mark-begin mark-end width height)) (model (calfw-model-abstract-new date contents-sources annotation-sources sorter)) (cp (calfw--cp-new dest model view date)) (after-update-func (let ((keymap keymap) (cp cp)) (lambda () (calfw-dest-with-region (calfw-component-dest cp) (let (buffer-read-only) (put-text-property (point-min) (1- (point-max)) 'cfw:component cp) (calfw--fill-keymap-property (point-min) (1- (point-max)) (or keymap calfw-calendar-mode-map)))))))) (setf (calfw-dest-after-update-func dest) after-update-func) (funcall after-update-func) cp)))) (defun calfw--fill-keymap-property (begin end keymap) "Set the KEYMAP 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) (cl-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 (cl-defun calfw-get-calendar-text (width height &key date _keymap contents-sources annotation-sources view sorter) "Return a text that draws the calendar view. WIDTH and HEIGHT are reference size of the calendar view. CONTENTS-SOURCES, ANNOTATION-SOURCES, VIEW, and SORTER are used to construct the calendar using `calfw-model-abstract-new'. DATE is the initial focus date, or today if nil." (let* ((dest (calfw-dest-init-inline width height)) (model (calfw-model-abstract-new date contents-sources annotation-sources sorter)) (cp (calfw--cp-new dest model view date)) text) (setq text (with-current-buffer (calfw-cp-get-buffer cp) (buffer-substring (point-min) (point-max)))) (kill-buffer (calfw-cp-get-buffer cp)) text)) ;;; debug (defun calfw-open-debug-calendar () "Create a calendar buffer with some sample data for debugging purposes." (let* ((source1 (make-calfw-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-calfw-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-calfw-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-calfw-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-calfw-source :name "Events" :color "DarkOrange" :data (lambda (_b _e) `(,(make-calfw-event :title "Shopping" :start-date '(1 17 2011)) ,(make-calfw-event :title "Other Thing" :start-date '(1 17 2011)) ,(make-calfw-event :title "Spring cleaning" :start-date '(1 15 2011) :location "Home" :description "Oh what a joy!!") ,(make-calfw-event :title "Meeting" :start-date '(1 16 2011) :start-time '(15 00) :location "Office" :description "Important talk") ,(make-calfw-event :title "Lunch" :start-date '(1 15 2011) :start-time '(13 15) :end-time '(14 30) :location "Fancy place" :description "Omnomnom") ,(make-calfw-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-calfw-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 (calfw-create-calendar-component-buffer :date (calfw-date 1 10 2011) :view 'two-weeks :contents-sources (list source1 source2 event-source) :annotation-sources (list asource1 asource2)))) (calfw-cp-add-update-hook cp (lambda () (message "CALFW- UPDATE HOOK"))) (calfw-cp-add-click-hook cp (lambda () (message "CALFW- CLICK HOOK %S" (calfw-cursor-to-nearest-date)))) (switch-to-buffer (calfw-cp-get-buffer cp)))) (provide 'calfw) ;;; calfw.el ends here ;; (progn (eval-buffer) (calfw-open-debug-calendar)) ;; (progn (eval-buffer) (calfw-open-calendar-buffer)) kiwanami-emacs-calfw-6112605/calfw.juth000066400000000000000000000675511507535766000177040ustar00rootroot00000000000000PKy"? 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ݝ EntityStorePK9okiwanami-emacs-calfw-6112605/readme.md000066400000000000000000000721541507535766000174660ustar00rootroot00000000000000# 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) ;; For compatiblity with the old name scheme (starting with `cfw:` ;; instead of `calfw-`), uncomment the following code: ;; ;; (setq calfw-compat-mark-obsolete nil) ;; This supresses obsolete messages ;; (require 'calfw-compat) ``` Executing the command `calfw-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 `calfw-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) (calfw-howm-install-schedules) (define-key howm-mode-map (kbd "M-C") 'calfw-howm-open-calendar) )) ``` If you are using Elscreen, here is useful. ```el (define-key howm-mode-map (kbd "M-C") 'calfw-howm-elscreen-open-calendar) ``` You can display a calendar in your howm menu file. ``` %here%(calfw-howm-schedule-inline) ``` ![howm menu embedding](https://cacoo.com/diagrams/vrScI4K2QlmDApfd-1F941.png?width=450) ### For org users: (require 'calfw-org) Then, M-x `calfw-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 `calfw-org-agenda-schedule-args`, like following code: ```el (setq calfw-org-agenda-schedule-args '(:timestamp)) ``` This setting restricts items containing a date stamp or date range matching the selected date. If `calfw-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 `calfw-org-overwrite-default-keybinding` to non-nil, like following code: ```el (setq calfw-org-overwrite-default-keybinding t) ``` Then, following key bindings are overwritten: | key | function |-------|---------------------------------------- | g | Refresh data and re-draw contents (calfw-refresh-calendar-buffer) | j | Goto the specified date (calfw-org-goto-date) | k | org-capture | x | Close calfw and other buffers opened by calfw-org (calfw-org-clean-exit) | d | Day view (calfw-change-view-day) | v d | Day view (calfw-change-view-day) | v w | 1 Week view (calfw-change-view-week) | v m | Month View (calfw-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) (calfw-ical-open-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 `calfw-cal-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 `calfw-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) (calfw-open-calendar-buffer :contents-sources (list (calfw-org-create-source "Green") ; orgmode source (calfw-howm-create-source "Blue") ; howm source (calfw-cal-create-source "Orange") ; diary source (calfw-ical-create-source "Moon" "~/moon.ics" "Gray") ; ICS source1 (calfw-ical-create-source "gcal" "https://..../basic.ics" "IndianRed") ; google calendar ICS ))) ``` The function `calfw-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 `calfw-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 '(calfw-face-title ((t (:foreground "#f0dfaf" :weight bold :height 2.0 :inherit variable-pitch)))) '(calfw-face-header ((t (:foreground "#d0bf8f" :weight bold)))) '(calfw-face-sunday ((t :foreground "#cc9393" :background "grey10" :weight bold))) '(calfw-face-saturday ((t :foreground "#8cd0d3" :background "grey10" :weight bold))) '(calfw-face-holiday ((t :background "grey10" :foreground "#8c5353" :weight bold))) '(calfw-face-grid ((t :foreground "DarkGrey"))) '(calfw-face-default-content ((t :foreground "#bfebbf"))) '(calfw-face-periods ((t :foreground "cyan"))) '(calfw-face-day-title ((t :background "grey10"))) '(calfw-face-default-day ((t :weight bold :inherit calfw-face-day-title))) '(calfw-face-annotation ((t :foreground "RosyBrown" :inherit calfw-face-day-title))) '(calfw-face-disable ((t :foreground "DarkGray" :inherit calfw-face-day-title))) '(calfw-face-today-title ((t :background "#7f9f7f" :weight bold))) '(calfw-face-today ((t :background: "grey10" :weight bold))) '(calfw-face-select ((t :background "#2f2f2f"))) '(calfw-face-toolbar ((t :foreground "Steelblue4" :background "Steelblue4"))) '(calfw-face-toolbar-button-off ((t :foreground "Gray10" :weight bold))) '(calfw-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 calfw-fchar-junction ?+ calfw-fchar-vertical-line ?| calfw-fchar-horizontal-line ?- calfw-fchar-left-junction ?+ calfw-fchar-right-junction ?+ calfw-fchar-top-junction ?+ calfw-fchar-top-left-corner ?+ calfw-fchar-top-right-corner ?+ ) ;; Unicode characters (setq calfw-fchar-junction ?╋ calfw-fchar-vertical-line ?┃ calfw-fchar-horizontal-line ?━ calfw-fchar-left-junction ?┣ calfw-fchar-right-junction ?┫ calfw-fchar-top-junction ?┯ calfw-fchar-top-left-corner ?┏ calfw-fchar-top-right-corner ?┓) ;; Another unicode chars (setq calfw-fchar-junction ?╬ calfw-fchar-vertical-line ?║ calfw-fchar-horizontal-line ?═ calfw-fchar-left-junction ?╠ calfw-fchar-right-junction ?╣ calfw-fchar-top-junction ?╦ calfw-fchar-top-left-corner ?╔ calfw-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 `calfw-render-line-breaker` selects the strategy to break lines. - `calfw-render-line-breaker-none` - Never breaks lines. Longer contents are truncated. - `calfw-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. - `calfw-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 `calfw-source` object, one can extend calfw calendar source. #### struct calfw-source details The struct `calfw-source` is a simple data type defined by cl-defstruct. Here is the details of the slot members of `calfw-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 `calfw-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. #### calfw-source-data details This section explains what objects the function-slot `calfw-source-data` should return. The function-slot `calfw-source-data` receives two arguments, start and end date of the query period, and returns a list of instances of `calfw-event` struct. Here is a simple example. `calfw-source-data example1:` ```el ;; calfw-source-data example (defun sample-data1 (b e) (list (make-calfw-event :title "item1" :start-date (calfw-date 1 1 2011)) (make-calfw-event :title "item2-1" :start-date (calfw-date 1 10 2011)) (make-calfw-event :title "item2-2" :start-date (calfw-date 1 10 2011)))) (calfw-open-calendar-buffer :date (calfw-date 1 1 2011) :contents-sources (list (make-calfw-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 `calfw-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. `calfw-source-data example2:` ```el ;; calfw-source-data period items (defun sample-data2 (b e) (list (make-calfw-event :title "Item1" :start-date (calfw-date 1 15 2011)) (list 'periods (make-calfw-event :title "Period item" :start-date (calfw-date 1 8 2011) :end-date (calfw-date 1 9 2011) :description "Period item description") (make-calfw-event :title "Next item" :start-date (calfw-date 1 11 2011) :end-date (calfw-date 1 12 2011) :description "Next item description")))) (calfw-open-calendar-buffer :date (calfw-date 1 1 2011) :contents-sources (list (make-calfw-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. - `calfw-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. ##### calfw-event struct detail The `calfw-event` struct: | slot name | description | |---------------|---------------------------------------------| | `title` | event title [string] | | `start-date` | start date of the event [calfw-date] | | `start-time` | start time of the event (optional) | | `end-date` | end date of the event [calfw-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 `calfw-event` instances. The functions are used by the calfw plugins (cal,ical, etc) to display in a common way. | Format function | Description | |-----------------------------|-------------------------------------------------------------| | `calfw-event-overview` | To get an overview of the event (month, 2-week & week view) | | `calfw-event-days-overview` | Overview in day-view. | | `calfw-event-period-overview` | Overview of periods (same for all views) | | `calfw-event-detail` | Detailed information of the event for the detail-view | The formatting can be customized by the user with several formatting strings: - `calfw-event-format-overview` - `calfw-event-format-days-overview` - `calfw-event-format-period-overview` - `calfw-event-format-detail` - `calfw-event-format-title` - `calfw-event-format-start-date` - `calfw-event-format-start-time` - `calfw-event-format-end-date` - `calfw-event-format-end-time` - `calfw-event-format-location` - `calfw-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 `calfw-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. `calfw-source-data example1:` ```el ;; calfw-source-data example (defun sample-data1 (b e) '( ((1 1 2011) . ("item1")) ((1 10 2011) . ("item2-1" "item2-2")) )) (calfw-open-calendar-buffer :date (calfw-date 1 1 2011) :contents-sources (list (make-calfw-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. `calfw-source-data example2:` ```el ;; calfw-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) (calfw-open-calendar-buffer :date (calfw-date 1 1 2011) :contents-sources (list (make-calfw-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 `calfw-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 `calfw-calendar-mode` and the keymap `calfw-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) (calfw-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 `calfw-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: - `calfw-component` that gathers following objects up. - `calfw-model` that manages calendar contents. - `calfw-source` that defines schedule items. - `calfw-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) `calfw-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. `calfw-model` and `calfw-source` act as Model of MVC. They manage the schedule contents and calendar logic. `calfw-dest` acts as View of MVC. It abstracts the common interface from UI destinations. ##### calfw-component The object `calfw-component` controls calfw objects and events. The object has following information: - References to `calfw-dest` object and `calfw-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 `calfw-dest`, `calfw-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 `calfw-cp-dispatch-view-impl`. The instance of the calfw component is stored at following places: - `buffer` destination: the buffer-local variable `calfw-component` - `region` destination: the text property `cfw:component` - `text` destination: N/A Calling the utility function `calfw-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. ##### calfw-model The object `calfw-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.) ##### calfw-dest The object `calfw-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, `calfw-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 `calfw-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 `calfw-source` object. It may be straightforward. The input events by the user can be caught by hooks in the `calfw-component`. Then, the selected date is obtained by the function `calfw-cursor-to-nearest-date` or `calfw-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 `calfw-source` objects, one can control event handling at each characters. Once the model is modified, update function of the `calfw-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 - 2025/09/13 ver 2.0 : Fixed bugs, used standard naming and docs. Changed maintainer. - 2015/09/24 ver 1.5 : Fixed bugs and added some customize variables. - 2015/02/27 ver 1.4 : Introduced calfw-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>