私自身のこの質問のために、私org-agenda-add-time-grid-maybe
は時間グリッドを作成する関数を見ました。そこに投稿されたコード(私は作成していません)は、OPのコメントで要求されているように時間が忙しい場合、グリッド線を削除します。
あなたのように、私は何らかの方法で視覚的なブロックを作成したかったのです。の元のコードorg-agenda-add-time-grid-maybe
と他のスレッドに投稿されたMichael Ekstrandによる欠点を組み合わせることで、次のコードを思い付きましたorg-agenda-add-time-grid-maybe
。それは異なる色でグリッド線を出力します(私は今のところfaceを使用していますorg-archived
)、そして時間の後には異なる文字列が続きます。どちらもお好みに変更できます。
(defun org-agenda-add-time-grid-maybe (list ndays todayp)
"Add a time-grid for agenda items which need it.
LIST is the list of agenda items formatted by `org-agenda-list'.
NDAYS is the span of the current agenda view.
TODAYP is t when the current agenda view is on today."
(catch 'exit
(cond ((not org-agenda-use-time-grid) (throw 'exit list))
((and todayp (member 'today (car org-agenda-time-grid))))
((and (= ndays 1) (member 'daily (car org-agenda-time-grid))))
((member 'weekly (car org-agenda-time-grid)))
(t (throw 'exit list)))
(let* ((blocks (mapcar (lambda (x)
(let ((start (get-text-property 1 'time-of-day x))
(dur (get-text-property 1 'duration x)))
(cond
((and start dur) (cons start
(org-time-from-minutes
(truncate
(+ dur (org-time-to-minutes start))))))
(start start)
(t nil))))
list))
(have (delq nil (mapcar
(lambda (x) (get-text-property 1 'time-of-day x))
list)))
(string (nth 3 org-agenda-time-grid))
(gridtimes (nth 1 org-agenda-time-grid))
(req (car org-agenda-time-grid))
(remove (member 'remove-match req))
new time)
(if (and (member 'require-timed req) (not have))
;; don't show empty grid
(throw 'exit list))
(while (setq time (pop gridtimes))
(unless (and remove (member time have))
(let* ((windows (delq nil blocks))
(hit nil))
(dolist (busy windows)
(unless hit
(when (and (>= time (car busy))
(< time (cdr busy)))
(setq hit t))))
(setq time (replace-regexp-in-string " " "0" (format "%04s" time)))
(if hit
(progn
(push (org-agenda-format-item
(concat string " dito") string nil "" nil
(concat (substring time 0 -2) ":" (substring time -2)))
new)
(put-text-property 2 (length (car new)) 'face 'org-archived (car new)))
(progn
(push (org-agenda-format-item
nil string nil "" nil
(concat (substring time 0 -2) ":" (substring time -2)))
new)
(put-text-property 2 (length (car new)) 'face 'org-time-grid (car new))))
(setq hit nil))))
(when (and todayp org-agenda-show-current-time-in-grid)
(push (org-agenda-format-item
nil org-agenda-current-time-string nil "" nil
(format-time-string "%H:%M "))
new)
(put-text-property
2 (length (car new)) 'face 'org-agenda-current-time (car new)))
(if (member 'time-up org-agenda-sorting-strategy-selected)
(append new list)
(append list new)))))
(defun org-time-to-minutes (time)
"Convert an HHMM TIME to minutes."
(+ (* (/ time 100) 60) (% time 100)))
(defun org-time-from-minutes (minutes)
"Convert a number of MINUTES to an HHMM time."
(+ (* (/ minutes 60) 100) (% minutes 60)))
明らかに、defadviceを使用する方がよりエレガントになりますが、正確に介入する場所を見つけることができませんでした。関数自体は、すべてのグリッド時間(で設定org-agenda-time-grid
)を通過し、面を含む最終グリッド(新規)を持つ新しいリストを作成します。
org-agenda-time-grid
ニーズに十分ではありませんか? gnu.org/software/emacs/manual/html_node/org/...