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