Because of this question of my own I looked at the function org-agenda-add-time-grid-maybe
which creates the time grid. The code posted there (which is not written by me) does remove a grid line if the time is busy as requested in the OP's comment.
Like you, I wanted to create a visual block in some way. By mixing up the original code of org-agenda-add-time-grid-maybe
and the defadvice by Michael Ekstrand posted in the other thread I came up with the following code for org-agenda-add-time-grid-maybe
. It will output the grid lines in a different color (for the moment I use the face org-archived
) and the times will be followed by a different string. Both can be changed to your liking.
(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)))
Obviously, it would be more elegant to use defadvice, but I could not figure out where exactly to intervene. The function itself goes through every grid time (set in org-agenda-time-grid
) and creates a new list with the final grid including faces (new).
org-agenda-time-grid
not sufficient for your needs? gnu.org/software/emacs/manual/html_node/org/…calfw
(emacswiki.org/emacs/Calfw).init.el
, include(require 'calfw-org)
, and to call the calendar doM-x cfw:open-org-calendar
.