mhc の conflict に priority

mhc で予定がかちあうと conflict マーク [C] が表示されるのだが,これに priority をつけて,優先度高いほうは無印,低いほうは [欠席] とか表示できないかなーとか思った.



見よう見まねで lisp 書いてみたら動いた.あまり深く考えずに作った ad hoc な実装だし冗長な部分があるので,きちんと設計しなおしコーディングも直してみたら,うまく動かなくなった orz

というわけで ad hoc なコードのまま載せます.修正する時間と気力はありません.誰か書き直してくだちい(ぉ

    (add-hook
     'mhc-setup-hook
     '(lambda ()
(defun mhc-summary/insert-dayinfo (mhc-tmp-dayinfo mailer category-predicate secret)
  (let ((time-max -1)
        (schedules (mhc-day-schedules mhc-tmp-dayinfo))
        (mhc-tmp-first t)
        mhc-tmp-begin mhc-tmp-end
        mhc-tmp-location mhc-tmp-schedule
        mhc-tmp-conflict mhc-tmp-priority
        next-begin displayed <b>prev-priority </b>)
    (if schedules
        (progn
          (while schedules
            (if (and (if mhc-summary-display-todo
                         t
                       (not (mhc-schedule-in-category-p
                             (car schedules) "todo")))
                     (funcall category-predicate (car schedules)))
                (progn
                  (setq mhc-tmp-begin (mhc-schedule-time-begin (car schedules))
                        mhc-tmp-end (mhc-schedule-time-end (car schedules))
                        mhc-tmp-priority (mhc-schedule-priority
                                          (car schedules))
                        next-begin (if (car (cdr schedules))
                                       (mhc-schedule-time-begin
                                        (car (cdr schedules))))
			<b>next-priority (if (car (cdr schedules))
                                       (mhc-schedule-priority
                                        (car (cdr schedules))))
			mhc-next-prior (or 
					(not mhc-tmp-priority)
					(and next-priority
					     (<= mhc-tmp-priority next-priority)))
			mhc-prev-prior (or 
					(not mhc-tmp-priority)
					(and prev-priority
					     (<= mhc-tmp-priority prev-priority)))
			mhc-tmp-conflict-next (and mhc-tmp-end next-begin
						   (< next-begin mhc-tmp-end))
			mhc-tmp-conflict-prev (and mhc-tmp-begin time-max 
						   (< mhc-tmp-begin time-max))
                        mhc-tmp-conflict (or mhc-tmp-conflict-next mhc-tmp-conflict-prev)
			mhc-tmp-prior (and mhc-tmp-conflict (not mhc-next-prior) (not mhc-prev-prior))
			mhc-tmp-equal (and mhc-tmp-conflict (or 
						(and mhc-tmp-conflict-prev (not prev-priority))
						(and mhc-tmp-conflict-next (not next-priority))
						(and mhc-tmp-priority next-priority (= mhc-tmp-priority next-priority))
						(and mhc-tmp-priority prev-priority (= mhc-tmp-priority prev-priority))
)
						)</b>
)
                  (if mhc-tmp-end (setq time-max (max mhc-tmp-end time-max)))
		  <b>(if mhc-tmp-priority (setq prev-priority mhc-tmp-priority)
		    (setq prev-priority nil))
		  (if mhc-tmp-prior (setq mhc-summary-string-conflict mhc-summary-string-prior)
		    (if mhc-tmp-equal (setq mhc-summary-string-conflict mhc-summary-string-conflict-orig) 
		      (setq mhc-summary-string-conflict mhc-summary-string-abort)))</b>
                  (setq displayed t)
                  (mhc-summary-insert-contents
                   (car schedules)
                   (and secret
                        (mhc-schedule-in-category-p
                         (car schedules) "private"))
                   'mhc-summary-line-insert
                   mailer)
                  (setq mhc-tmp-first nil)))
            (setq schedules (cdr schedules)))
          (if (not displayed)
              (mhc-summary-insert-contents nil secret
                                           'mhc-summary-line-insert
                                           mailer)))
      (mhc-summary-insert-contents nil secret
                                   'mhc-summary-line-insert
                                   mailer))))
))
(defcustom mhc-summary-string-conflict "[C]"
  "*String which indicates conflicts in summary buffer."
  :group 'mhc
  :type 'string)
<b>(defcustom mhc-summary-string-conflict-orig mhc-summary-string-conflict
  "*String which indicates conflicts in summary buffer."
  :group 'mhc
  :type 'string)
(defcustom mhc-summary-string-abort "[absent] "
  "*String which indicates aborts in summary buffer."
  :group 'mhc
  :type 'string)
(defcustom mhc-summary-string-prior ""
  "*String which indicates priority in summary buffer."
  :group 'mhc
  :type 'string)
</b>

Emacs 20.7.2 + mhc 0.25.

最初,priority 用のフィールドを作ろうと思ったら,その名も X-SC-Priority というヘッダがもともと用意されているのを見つけてそのまま使ってみた.ただしこれは本来は TODO 用のようだ.ともかくこのヘッダに指定した数字が大きいほうが高優先度と見なされる.nice 的に降順にしたければ不等号の向きを変えればいけると思う.



当然ながら 3 つ以上のスケジュールの conflict 時にはうまく動きません(ぉ.まあ,

にあるように,conflict の仕様自体が 3 つ以上のスケジュール判定に対応仕切れてないし.それにしてもこの conflict の判定はほんとよくできてる.



追記: http://nao.s164.xrea.com/td/2005-07-19.html#p01