[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[mhc:00255] sample mhc-mode-hook ^^;;;
乃村さんが mhc-mode-hook を採用して下さったので、昨日の出張の新
幹線でひとつ作ってみました。
Emacs 標準の calendar 機能(M-x calendar) と mhc を同時に表示する
ものです。calendar 側をそれなりに設定すると、色がついたりするの
で、3ヵ月分の calendar が表示されるのも結構便利なんじゃないかと
勝手に思っています。
mhc-mode で "C-ct" で calendar の表示/非表示が切り替わります。残
りは、Mew から mhc を使っているときに *こうすると便利* と感じた
ものや、mhc 以外では calendar buffer が邪魔なので見えなくしたり
しています。
本当は、xcal の様に split-window-horizontally して立て型で表示し
たいのですが、(個人的に)todo です。
--
白井秀行@興味があったら使ってみて下さい。
以下、続く。
;; mhc で calendar を表示する。~/.emacs に書いてね。
(add-hook 'mhc-mode-hook
'(lambda ()
(define-key mhc-mode-map "\C-ct" 'mhc-toggle-show-calendar)
(if (equal mhc-mailer-package 'mew)
(progn (define-key mhc-mode-map "g" 'mhc-summary-goto-folder)
(define-key mhc-mode-map "i" 'mhc-summary-get)
(define-key mhc-mode-map "\C-c\C-q" 'mhc-kill-buffer)))
(mhc-show-calender)))
(defun mhc-toggle-show-calendar ()
(interactive)
(setq mhc-show-calendar (not mhc-show-calendar))
(mhc-rescan-month))
(defun mhc-summary-goto-folder (&optional arg)
(interactive "P")
(mhc-calendar-delete-window)
(mew-summary-goto-folder arg))
(defun mhc-summary-get (&optional arg)
(interactive "P")
(mhc-calendar-delete-window)
(mew-summary-get arg))
(defun mhc-kill-buffer (&optional buf)
(interactive)
(mhc-calendar-delete-window)
(mew-kill-buffer buf))
(defvar mhc-show-calendar nil)
(defun mhc-show-calender ()
;; お節介開始
(if (not (equal mhc-mailer-package 'mew))
()
(and (mew-buffer-message)
(get-buffer-window (mew-buffer-message))
(window-live-p (get-buffer-window (mew-buffer-message)))
(delete-window (get-buffer-window (mew-buffer-message))))
(and mew-summary-buffer-disp-msg
(mew-summary-toggle-disp-msg)))
;; お節介終了
(if (not mhc-show-calendar)
(mhc-calendar-delete-window)
(let ((fld (buffer-name))
(redisp t)
year month)
(if (not (string-match "^[^/]*/\\([12][0-9][0-9][0-9]\\)/\\([0-9][0-9]\\)$"
fld))
()
(setq year (string-to-number
(substring fld (match-beginning 1) (match-end 1))))
(setq month (string-to-number
(substring fld (match-beginning 2) (match-end 2))))
(save-excursion
(require 'calendar)
(if (not (get-buffer calendar-buffer))
(let* ((cdate (ddate-now))
(cyear (car cdate))
(cmonth (nth 1 cdate)))
(if (fboundp 'calendar-basic-setup)
(calendar-basic-setup)
(calendar))
(and (equal mhc-mailer-package 'mew)
(mew-buffers-setup calendar-buffer))
(and (= cyear year) (= cmonth month)
(setq redisp nil))))
(set-buffer (get-buffer calendar-buffer))
(pop-to-buffer (current-buffer))
(and redisp
(generate-calendar-window month year))
(bury-buffer (current-buffer)))
(pop-to-buffer fld)))))
(defun mhc-calendar-delete-window ()
(and mhc-mode
(boundp 'calendar-buffer)
(get-buffer-window calendar-buffer)
(window-live-p (get-buffer-window calendar-buffer))
(delete-window (get-buffer-window calendar-buffer))))