org-agenda のようなもの
(require 'cl)
(setf *my-howm:howm-menu-reminder-cached* "")
(defadvice howm-menu-reminder (after my-howm:howm-menu-reminder activate)
(let ((ret ad-return-value))
(setq *my-howm:howm-menu-reminder-cached* ret)
ret))
(setq my-howm:howm-agenda-time-grid
`(:separator
"------------------"
:periods
,(loop for time from 800 to 2000 by 200 collect time)
;; => (800 1000 1200 1400 1600 1800 2000)
:header
,(format "%-15s%s%s"
(format-time-string "%A" (current-time))
(format-time-string "20%y-%m-%d" (current-time))
" [今日]")
))
(defun my-howm:insert-colon (string)
;; "1234"
;; => "12:34"
(replace-regexp-in-string "\\(..\\)$" ":\\1" string))
(defun my-howm:remove-colon (string)
;; "12:34"
;; => "1234"
(apply #'concat (split-string string ":")))
(defun my-howm:extract-note (string)
;; (my-howm:extract-note "> 土 0 | [2014-01-18 23:16]@ test2 foo bar")
;; => "[2014-01-18 23:16]@ test2"
(replace-regexp-in-string "^\\(.+\\][^\s]+? \\)\\(.*\\'\\)" "\\2" string))
(defun my-howm:insert-space-after-the-day-of-the-week (string)
;; => 月-12
;; => 月 -12
(replace-regexp-in-string "\\([日月火水木金土]\\)\\(-.*\\'\\)" "\\1 \\2" string))
(defun my-howm:insert-dummy-after-yyyy-mm-dd (string)
;; [2014-01-28]
;; => [2014-01-28 -999]
(replace-regexp-in-string "\\(\\[[-[:digit:]]+\\)\\(\\].*\\'\\)" "\\1 -999\\2" string))
(defun my-howm:insert-dummy-for-splitting (string)
(my-howm:insert-dummy-after-yyyy-mm-dd (my-howm:insert-space-after-the-day-of-the-week string)))
(defun my-howm:howm-symbol->string (string)
(lexical-let ((symbol (substring string 0 1)))
(cdr (assoc symbol
'(("@" . "schedule:")
("+" . "todo:")
("!" . "deadline:")
("-" . "normal:")
("~" . "defer:"))))))
(defun my-howm:lines->list-of-today-items (lines)
(loop for item in (mapcar #'my-howm:string->day-time-symbol-number-note (split-string lines "\n"))
when item
collect (apply #'my-howm:status-time-note item)))
(defun my-howm:string->day-time-symbol-number-note (line)
(lexical-let ((item (split-string (my-howm:insert-dummy-for-splitting line) "[][ ]")))
(when (cddr item)
(destructuring-bind (_a _b diff _d yyyy-mm-dd time symbol-and-number . _)
(remove-if #'(lambda (string) (string= "" string)) item)
(list :day yyyy-mm-dd
:diff (string-to-number diff)
:time (string-to-number (my-howm:remove-colon time))
:status (my-howm:howm-symbol->string (substring symbol-and-number 0 1))
:number (string-to-number (substring symbol-and-number 1 (length symbol-and-number)))
:note (my-howm:extract-note line))))))
(defun* my-howm:status-time-note (&key day diff time status number note)
(cond
((< diff 0) nil)
((= diff 0)
(list :status status :time time :note note))
((and (or (string= status "schedule:")
(string= status "deadline:"))
(<= diff number))
(list :status status :time time :note note))
(t nil)))
(defun* my-howm:item->string (&key status time note)
(save-excursion
(save-window-excursion
(save-restriction
(with-temp-buffer
(insert (format "%12s " status))
(insert (format "%5s......" (if (< time 0) ;時刻が指定されていない場合
" "
(my-howm:insert-colon (format "%04d" time)))))
(insert " ")
(lexical-let ((p (point)))
(insert note)
;; note 部分の properties を取り出す
(lexical-let ((prop (text-properties-at (- (point) 1)))
;; それぞれの属性に応じて face を適用する
;; 何も属性が無いならば done の face を適用する
(face (concat "howm-reminder-" (if (string= " " status) "done" (substring status 0 -1)) "-face")))
;; ファイルへのリンクを行全体に設定する
(set-text-properties (point-at-bol) (point-at-eol) prop)
;; 行頭から note 挿入位置までの間に font-lock-face を設定する
(add-text-properties (point-at-bol) p `(font-lock-face ,face))
)
(newline)
(buffer-string)))))))
(defun flatten (l)
(cond ((null l) nil)
((atom l) (list l))
(t (mapcan #'flatten l))))
(defun my-howm:sort-by-time (list)
(cl-stable-sort list #'<
:key #'(lambda (x)
(destructuring-bind (&key status time note)
x
time))))
(defun my-howm:flatten-filter-sort (list fn)
(my-howm:sort-by-time
(remove-if fn
(loop for x in list
collect (if (atom x) x (flatten x)))
)))
(defun my-howm:sorted-list-of-today-items (lines)
(my-howm:flatten-filter-sort
(my-howm:lines->list-of-today-items lines)
#'null))
(defun my-howm:make-lines-for-howm-menu-today (howm-agenda-time-grid items)
;; 日曜日 2014-01-19 [今日]
;; 08:00...... ------------------
;; 10:00...... ------------------
;; schedule: 11:30...... lunch
;; 12:00...... ------------------
(save-excursion
(save-window-excursion
(save-restriction
(with-temp-buffer
(destructuring-bind (&key separator periods header)
howm-agenda-time-grid
(insert header)
(newline)
;; fixed and optional periods
(loop for fixed-period in periods
do
;; optional period
(loop for item in items
do (destructuring-bind (&key status time note)
item
(when (< time fixed-period)
(insert (apply #'my-howm:item->string item))
(pop items))))
;; fixed period
(lexical-let ((status " ")
(time fixed-period)
(note separator))
(insert (my-howm:item->string :status status :time time :note note)))
;; remainder
finally do (loop for item in items
do (insert (apply #'my-howm:item->string item)))
)
(buffer-string)))))))
(defun my-howm:howm-menu-today-string ()
(my-howm:make-lines-for-howm-menu-today
my-howm:howm-agenda-time-grid
(my-howm:sorted-list-of-today-items *my-howm:howm-menu-reminder-cached*)))
(setq howm-menu-allow (append '(my-howm:howm-menu-today-string) howm-menu-allow))
(defun yyyy-mm-dd->day-value (yyyy-mm-dd)
(destructuring-bind (y m d)
(mapcar #'string-to-number (split-string yyyy-mm-dd "-"))
(car (encode-time 0 0 0 d m y))))
(defun diff-days (from to)
(- (yyyy-mm-dd->day-value to)
(yyyy-mm-dd->day-value from)))
Last modified : 2014/07/09 23:56:57 JST