[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[mhc:00341] calendar-other-window
From: Yoshinari NOMURA <nom@xxxxxxxxxxxxxxxxxxx> さん曰く
Subject: [mhc:00309] mhc-snap20000104
Message-ID: <20000104234020S.nom@xxxxxxxxxxxxxxxxxxx>
Date: Tue, 4 Jan 2000 23:40:24 +0900
nom> 当面の TODO は以下のような感じです。何か忘れていることないですか?
nom>
nom> 別バッファでカレンダー表示
これをやってみました。
http://www.swlab.csce.kyushu-u.ac.jp/~nom/prj/mhc/mhc-snap20000112.tar.gz
への patch です。
--
白井秀行 (mailto:shirai@xxxxxxxxxxxxxxxxxxx)
--- mhc.el.orig Fri Jan 14 15:36:41 2000
+++ mhc.el Fri Jan 14 15:49:40 2000
@@ -403,35 +403,101 @@
(message "Scanning %s ... done." (ddate-yymm-s1 ddate "/"))))
(defvar mhc-insert-calendar t)
+(defvar mhc-insert-calendar-other-window nil)
+(defvar mhc-calendar-buffer "*mhc-cal*")
+(defvar mhc-calendar-window-width (if (featurep 'xemacs) 24 22))
+(defvar mhc-calendar-date nil)
-(defun mhc-cal-toggle-insert-rectangle ()
- (interactive)
- (setq mhc-insert-calendar (not mhc-insert-calendar))
+(defun mhc-cal-toggle-insert-rectangle (&optional arg)
+ (interactive "P")
+ (if arg
+ (setq mhc-insert-calendar-other-window (not mhc-insert-calendar-other-window))
+ (setq mhc-insert-calendar (not mhc-insert-calendar)))
+ (if (and mhc-insert-calendar mhc-insert-calendar-other-window)
+ ()
+ (and (memq 'mhc-calendar-post-command post-command-hook)
+ (remove-hook 'post-command-hook 'mhc-calendar-post-command))
+ (mhc-calendar-delete-window))
(mhc-rescan-month))
+(defun mhc-calendar-delete-window ()
+ (let (win)
+ (if (not (and (boundp 'mhc-calendar-buffer)
+ (setq win (get-buffer-window mhc-calendar-buffer))
+ (window-live-p win)))
+ ()
+ (delete-window win)
+ (bury-buffer mhc-calendar-buffer))))
+
(defun mhc-cal-insert-rectangle-at (ddate col)
+ (if mhc-insert-calendar-other-window
+ (mhc-calendar-other-window ddate col)
+ (mhc-cal-insert-rectangle-at-own ddate col "| ")))
+
+(defun mhc-calendar-other-window (ddate col)
+ (make-variable-buffer-local 'mhc-calendar-date)
+ (setq mhc-calendar-date ddate)
+ (mhc-calendar-delete-window)
+ (let ((win (selected-window)))
+ (if (get-buffer mhc-calendar-buffer)
+ (and (window-live-p (get-buffer-window mhc-calendar-buffer))
+ (not (one-window-p))
+ (delete-window (get-buffer-window mhc-calendar-buffer))))
+ (select-window (split-window-horizontally
+ (- (window-width) mhc-calendar-window-width)))
+ (switch-to-buffer (set-buffer (get-buffer-create mhc-calendar-buffer)))
+ (setq buffer-read-only t)
+ (let ((buffer-read-only nil))
+ (buffer-disable-undo)
+ (erase-buffer)
+ (mhc-cal-insert-rectangle-at-own ddate 0 "")
+ (set-buffer-modified-p nil))
+ (select-window win)
+ (and (not (memq 'mhc-calendar-post-command post-command-hook))
+ (add-hook 'post-command-hook 'mhc-calendar-post-command))))
+
+(defun mhc-calendar-post-command ()
+ (interactive)
+ (if (and mhc-calendar-date
+ (get-buffer mhc-calendar-buffer))
+ (let ((win (selected-window))
+ (pwin (get-buffer-window mhc-calendar-buffer)))
+ (if (and (window-live-p pwin)
+ (= mhc-calendar-window-width (window-width pwin))
+ (= (window-height) (window-height pwin)))
+ ()
+ (if (< (window-height) (/ (frame-height) 3)) ;; xxx for Mew
+ (mhc-calendar-delete-window)
+ (and (window-live-p pwin) (not (one-window-p)) (delete-window pwin))
+ (select-window (split-window-horizontally
+ (- (window-width) mhc-calendar-window-width)))
+ (switch-to-buffer (set-buffer (get-buffer mhc-calendar-buffer)))
+ (select-window win))))
+ (mhc-calendar-delete-window)))
+
+(defun mhc-cal-insert-rectangle-at-own (ddate col prefix)
(save-excursion
(put-text-property (point-min) (point-max) 'rear-nonsticky t)
(goto-char (point-min))
(mhc-cal-move-to-column-force col)
- (mhc-cal-insert-rectangle (ddate-mm-dec ddate))
- (forward-line 1)
+ (mhc-cal-insert-rectangle (ddate-mm-dec ddate) prefix)
+ (and (= (forward-line 1) 1) (insert "\n"))
(mhc-cal-move-to-column-force col)
- (insert "| ")
- (forward-line 1)
+ (insert prefix)
+ (and (= (forward-line 1) 1) (insert "\n"))
(mhc-cal-move-to-column-force col)
- (mhc-cal-insert-rectangle ddate)
- (forward-line 1)
+ (mhc-cal-insert-rectangle ddate prefix)
+ (and (= (forward-line 1) 1) (insert "\n"))
(mhc-cal-move-to-column-force col)
- (insert "| ")
- (forward-line 1)
+ (insert prefix)
+ (and (= (forward-line 1) 1) (insert "\n"))
(mhc-cal-move-to-column-force col)
- (mhc-cal-insert-rectangle (ddate-mm-inc ddate))))
+ (mhc-cal-insert-rectangle (ddate-mm-inc ddate) prefix)))
(defun mhc-sch-foldermsg (sch)
@@ -885,13 +951,14 @@
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; make rectangle like calendar.el
-(defconst mhc-cal-week-header "| Su Mo Tu We Th Fr Sa")
-(put-text-property 2 4 'face 'red mhc-cal-week-header)
-(put-text-property 20 22 'face 'blue mhc-cal-week-header)
+(defconst mhc-cal-week-header "Su Mo Tu We Th Fr Sa")
+(put-text-property 0 2 'face 'red mhc-cal-week-header)
+(put-text-property 18 20 'face 'blue mhc-cal-week-header)
-(defun mhc-cal-insert-rectangle (&optional ddate)
+(defun mhc-cal-insert-rectangle (&optional ddate prefix)
(interactive)
- (insert-rectangle (mhc-cal-make-rectangle (or ddate (ddate-now)))))
+ (insert-rectangle
+ (mhc-cal-make-rectangle (or ddate (ddate-now)) (or prefix ""))))
;; This function is stolen from rect.el of emacs 20.4
;;
@@ -909,30 +976,41 @@
(goto-char pos)))
column))
-(defun mhc-cal-make-rectangle (&optional ddate)
+(defun mhc-cal-make-rectangle (&optional ddate prefix)
(interactive)
- (let (last dd ww month sch dstr (i 0) (week "| "))
+ (let ((week prefix)
+ last dd ww month sch dstr color
+ (td 0)
+ (i 0))
(setq last (ddate-mm-last-day (or ddate (ddate-now)))
dd (ddate-mm-first-day (or ddate (ddate-now)))
ww (ddate-ww dd)
month (list
- mhc-cal-week-header
- (format "| %s" (ddate-yymm-sj dd))))
+ (concat prefix mhc-cal-week-header)
+ (format "%s %s" week (ddate-yymm-sj dd))))
+ (if (or (null ddate)
+ (and (= (ddate-yy ddate) (ddate-yy (ddate-now)))
+ (= (ddate-mm ddate) (ddate-mm (ddate-now)))))
+ (setq td (ddate-dd (ddate-now))))
+
(while (< i ww) (setq week (concat week " ")
i (1+ i)))
(while (ddate<= dd last)
(setq color
(cond
+ ((= (ddate-dd dd) td)
+ 'conf)
((equal (ddate-ww dd) 0)
- 'red )
+ 'red)
((mhc-db-holiday-p dd)
(mhc-category-string-to-face "Holiday"))
- ((equal (ddate-ww dd) 6) 'blue)
+ ((equal (ddate-ww dd) 6)
+ 'blue)
(t
nil )))
- (if (and (not (string= week "| ")) (= (ddate-ww dd) 0))
+ (if (and (not (string= week prefix)) (= (ddate-ww dd) 0))
(setq month (cons week month)
- week "| "))
+ week prefix))
(setq dstr (format "%2d " (ddate-dd dd)))
(if color
(put-text-property 0 (1- (length dstr))