[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))))