From oshiro@mibai.tec.u-ryukyu.ac.jp Sun Jan 13 18:03:53 2002
X-RMAIL-ATTRIBUTES: --------
Path: u-ryukyu.ac.jp!news2.u-ryukyu.ac.jp!not-for-mail
From: OSHIRO Naoki <oshiro@mibai.tec.u-ryukyu.ac.jp>
Newsgroups: fj.editor.emacs
Subject: Re: xcal.el (Ver 2.01)
Date: 13 Jan 2002 18:03:53 +0900
Organization: Computer Center, Univ. of The Ryukyus
Lines: 426
Message-ID: <733d1a62rq.fsf@tecD81.tec.u-ryukyu.ac.jp>
References: <50d7fcq0ee.fsf_-_@nakahara.rd.nttdata.co.jp>
	<Tk__7.2299$En1.124898@news1.dion.ne.jp>
NNTP-Posting-Host: 133.13.70.81
Mime-Version: 1.0 (generated by tm-edit 8.8 (Time Passed Me By))
Content-Type: text/plain; charset=ISO-2022-JP
X-Trace: news2.u-ryukyu.ac.jp 1010912654 24729 133.13.70.81 (13 Jan 2002 09:04:14 GMT)
X-Complaints-To: usenet@u-ryukyu.ac.jp
NNTP-Posting-Date: 13 Jan 2002 09:04:14 GMT
X-Newsreader: Gnus v5.3/Emacs 19.34
Xref: u-ryukyu.ac.jp fj.editor.emacs:5175

大城＠琉球大です．

K.Shinzen <kenyu@mx2.nisiq.net> writes:
> emacs上でxcalを使わせてもらっていましたが、
> 新しいxcalに入れ替えたら -nw で起動したときに
> 罫線?が表示されなくなってしまいました。(古い版では出ていました)

(xcal-make-underline) 中の (put-text-property) 部で 
(xcal-lookup-face-create) を underline face で呼び出しているのですが，
これで得た face だとコンソールではアンダーラインが出なくなってしまうよ
うです．xcal-lookup-face-create を外して face をそのまま指定するように
してみました．こちらだと '-nw', X ともにアンダーラインが出ます 
(Emacs-19.34.1/Mule-2.3 で確認)． 

他に (set-foreground-color) を行なっていると underline 部がハイライト
表示されてしまうようです．これを xcal 内で無効化する方法はわかりません
でした．

> ところで、"w" (xcal-edit-for-xcal-week) で曜日毎の
> スケジュールを記述できるのですが、これはどうやって活用する
> 物なのでしょうか? 画面に表示させる方法が分かりません。

xcal.el は Xcal (X 上のアプリのほう) などへのデータ入力インターフェー
スという面もあって，週データは一覧は出ないものの入力できるようになって
いるんだと思います．この週一覧機能は欲しかったものなので，ちょっと作っ
てみました．後ろにパッチをつけます．

 * バージョン 2.01 をベースに作業
 * (xcal-generate-month) を真似て (xcal-generate-week) を作成
   基本的に 7 日間の月としての扱い
 * (xcal-1) で上記のどちらを呼び出すかを切り分け（xcal-disp-week 変数）
 * 同様に (xcal-edit-for-xcal) でも呼び出し切り分け．元の本体部を
   (xcal-day-select-select) に改名（xcal-week-select-select に関数名を
   合わせた）．
 * キーバインド w を (xcal-toggle-disp-month-and-week) に割り当て．
   xcal-disp-week 変数をトグルし (xcal-1) で表示更新
   従来の (xcal-edit-for-xcal-week) は W に割り当て変更
 * 他の曜日処理との対応で xcal-week-schedule リストで日曜を先頭に移動
 * (xcal-copy-schedule) のコピー処理で日付情報を xcal-copy-buffer 変数
   に保存するのでなく，予定のテキスト自体を保存．(xcal-yank-schedule), 
   (xcal-move-schedule) もこれに合わせて変更
 * バージョン表示を 2.01a にしてみた

課題としては

 * 表示月を変更しているときに週表示を行なうと，再度，月表示に戻したと
   きに表示していた月に戻らない（初期化されてしまう）
 * 月一覧を強引に週一覧に転用しているので無理があるかも
 * 週表示中でも本来は動作すべきでない (xcal-before/next) などのバイン
   ド・機能はそのままなので少し怪しい
 * キルした予定データの保持に xcal-copy-buffer という名前の変数を使う
   のは混乱しそう
 * アラームとか使ったことのない機能は未テスト

というあたりです．

[おまけ]
Tk 版の Xcalendar も作ってます．デスクトップのお伴にどうぞ (^^)．
  http://mibai.tec.u-ryukyu.ac.jp/~oshiro/Programs/tcltk/tkcal

--ここから---------------------------------------------------------------
--- xcal.el.org	Sun Jan 13 10:46:53 2002
+++ xcal.el	Sun Jan 13 17:55:54 2002
@@ -1,12 +1,15 @@
 ;;; -*- Mode: Emacs-Lisp -*-
 ;;;
-;;;                     xcal.el    Ver 2.01
+;;;                     xcal.el    Ver 2.01a
 ;;;
 ;;;             Copyleft (C) Shigeki Morimoto 1994-2000
 ;;;
 ;;;                 もりもと しげき ( 森本 茂樹 )
 ;;;                e-mail: Shigeki@Morimo.to
 ;;;
+;;(2001/01/12:oshiro) 週予定の一覧を追加
+;;(2001/01/12:oshiro) 予定のコピー時に日付でなく実体を変数に保存
+;;(2001/01/12:oshiro) underline 時の xcal-lookup-face-create を外した
 ;;(2000/11/30:jun) ハッピーマンデーに対応。xcal-alarm-filterを修正。
 ;;(2000/11/30:isoyama) xcal-lookup-face-create のバグ修正(_ _)
 ;;(2000/11/28:mori) xcal.el Ver 2.0
@@ -79,7 +82,8 @@
 ;;      下               n              xcal-next-day
 ;;      今日             ~              xcal
 ;;      編集             e              xcal-edit-for-xcal
-;;      週間予定         w              xcal-edit-for-xcal-week
+;;      週間予定         W              xcal-edit-for-xcal-week
+;;      週と月の切り換え w              xcal-toggle-disp-month-and-week
 ;;      削除             d              xcal-delete-file
 ;;      終了             q              xcal-quit
 ;;      スクロールアップ C-v            xcal-scroll-up
@@ -281,6 +285,7 @@
 (defvar xcal-selected nil)
 (defvar xcal-alarm-all-ret nil)
 (defvar xcal-alarm-ret nil)
+(defvar xcal-disp-week nil "週一覧表示なら t")
 
 ;;
 ;;
@@ -328,6 +333,14 @@
 
 (defun xcal-edit-for-xcal ()
   (interactive)
+  (cond (xcal-disp-week
+	 (setq xcal-week-select-index (1- xcal-current-day))
+	 (xcal-week-select-select))
+	(t
+	 (xcal-day-select-select))))
+
+(defun xcal-day-select-select ()
+  (interactive)
   (if (get-buffer "*XCal Edit*")
       (progn
 	(set-buffer (get-buffer "*XCal Edit*"))
@@ -383,14 +396,22 @@
 
 (defun xcal-delete-file ()
   (interactive)
-  (let ((file (xcal-file-name xcal-current-year
-			      xcal-current-month
-			      xcal-current-day)))
-    (and (file-exists-p file)
-	 (y-or-n-p (format "%s/%s/%s のスケジュールを消去します。"
-			   xcal-current-year
+  (let ((file 
+	 (if xcal-disp-week (xcal-week-file-name xcal-current-day)
+	   (xcal-file-name xcal-current-year
 			   xcal-current-month
-			   xcal-current-day))
+			   xcal-current-day))))
+    (and (file-exists-p file)
+	 (y-or-n-p (concat
+		    (if xcal-disp-week
+			(format "%s曜日"
+				(nth 0 (nth (1- xcal-current-day)
+					    xcal-week-schedule)))
+		      (format "%s/%s/%s "
+			      xcal-current-year
+			      xcal-current-month
+			      xcal-current-day))
+		    "のスケジュールを消去します。"))
 	 (progn
 	   (delete-file file)
 	   (xcal-refresh))))
@@ -476,24 +497,34 @@
 
 (defun xcal-copy-schedule ()
   (interactive)
-  (setq xcal-copy-buffer (list xcal-current-year
-			       xcal-current-month
-			       xcal-current-day))
-  (message "スケジュールをコピーしました"))
+  (let (temp-buffer
+	(srcFile
+	 (if xcal-disp-week (xcal-week-file-name xcal-current-day)
+	   (xcal-file-name
+	    xcal-current-year xcal-current-month xcal-current-day))))
+      (setq temp-buffer (get-buffer-create "*XCal-temp*"))
+      (set-buffer temp-buffer)
+      (setq buffer-read-only nil)
+      (erase-buffer)
+
+      (if (not (file-exists-p srcFile))
+	  (progn
+	    (message "コピー元のスケジュールがありません")
+	    nil)
+	(insert-file srcFile)
+	(setq xcal-copy-buffer (buffer-substring (point-min) (point-max)))
+	(message "スケジュールをコピーしました")
+	t)))
 
 (defun xcal-yank-schedule ()
   (interactive)
-  (if (null xcal-copy-buffer)
+  (if (not xcal-copy-buffer)
       (error "スケジュールがコピーされていません")
-    (let (year month day srcFile dstFile temp-buffer buffer-read-only)
-      (setq year  (nth 0 xcal-copy-buffer))
-      (setq month (nth 1 xcal-copy-buffer))
-      (setq day   (nth 2 xcal-copy-buffer))
-
-      (setq srcFile (xcal-file-name year month day))
-      (if (not (file-exists-p srcFile))
-	  (error "コピー元のスケジュールがありません"))
-      (setq dstFile (xcal-file-name xcal-current-year xcal-current-month xcal-current-day))
+    (let (year month day dstFile temp-buffer buffer-read-only)
+      (setq dstFile
+	    (if xcal-disp-week (xcal-week-file-name xcal-current-day)
+	      (xcal-file-name
+	       xcal-current-year xcal-current-month xcal-current-day)))
 
       (if (and (file-exists-p dstFile)
 	       (y-or-n-p "上書きしますか？ (n で追加)"))
@@ -504,7 +535,9 @@
       (setq buffer-read-only nil)
       (erase-buffer)
 
-      (insert-file srcFile)
+      (insert xcal-copy-buffer "\n\n")
+      (goto-char (point-max))
+      (delete-blank-lines)
       (if (file-exists-p dstFile)
 	  (insert-file dstFile))
 
@@ -549,14 +582,13 @@
 
 (defun xcal-move-schedule (year month day)
   (interactive (xcal-input-date))
-  (let ((xcal-copy-buffer (list xcal-current-year ; override variables
-				xcal-current-month
-				xcal-current-day))
-	(xcal-current-year year)
-	(xcal-current-month month)
-	(xcal-current-day day))
-    (xcal-yank-schedule))
-  (xcal-delete-file))
+  (if (xcal-copy-schedule)
+      (progn
+	(let ((xcal-current-year year)
+	      (xcal-current-month month)
+	      (xcal-current-day day))
+	  (xcal-yank-schedule))
+	(xcal-delete-file))))
 
 (defun xcal-mode ()
   "\
@@ -611,7 +643,8 @@
 	  (define-key xcal-map "."    'xcal-1)
 	  (define-key xcal-map "e"    'xcal-edit-for-xcal)
 	  (define-key xcal-map " "    'xcal-edit-for-xcal)
-	  (define-key xcal-map "w"    'xcal-edit-for-xcal-week)
+	  (define-key xcal-map "W"    'xcal-edit-for-xcal-week)
+	  (define-key xcal-map "w"    'xcal-toggle-disp-month-and-week)
 	  (define-key xcal-map "d"    'xcal-delete-file)
 	  (define-key xcal-map "\M-k" 'xcal-delete-file)
 	  (define-key xcal-map "q"    'xcal-quit)
@@ -653,6 +686,12 @@
        (eq window-system 'x) (xcal-alarm-start--proc))
   (xcal-1 month-offset))
 
+(defun xcal-toggle-disp-month-and-week ()
+  (interactive)
+  (setq xcal-keys-message nil)
+  (setq xcal-disp-week (not xcal-disp-week))
+  (xcal-1))
+
 (defun xcal-1 (&optional month-offset)
   "xcal の 本体"
   (interactive "P")
@@ -680,13 +719,20 @@
     (setq xcal-current-year year)
     (setq xcal-current-month month)
     (setq xcal-current-day (or day 1))
-    (setq mode-line-process
-	  (format "(%d/%d)" 
-		  xcal-current-year
-		  xcal-current-month))
     (erase-buffer)
-    (xcal-generate-month month year day))
-  (xcal-goto-day xcal-current-day)
+    (cond (xcal-disp-week
+	   (setq mode-line-process "(Week)")
+	   (if (not day) (setq day 1))
+	   (let ((wday (calendar-day-of-week
+			(let ((x (get-year-month-day)))
+			  (append (cdr x) (list (car x)))))))
+	     (xcal-generate-week wday)
+	     (xcal-goto-day (1+ wday))))
+	  (t
+	   (setq mode-line-process
+		 (format "(%d/%d)" xcal-current-year xcal-current-month))
+	   (xcal-generate-month month year day)
+	   (xcal-goto-day xcal-current-day))))
   (xcal-show-keys))
 
 (defun xcal-generate-month (month year &optional today)
@@ -843,6 +889,76 @@
 	(setq day (1+ day)))
       (xcal-make-underline))
     (kill-buffer temp-buffer)))
+
+(defun xcal-generate-week (&optional wday)
+  "週カレンダーのひょーじ"
+  (let* (msg
+	 (last-of-week 7)
+	 (xcal-buffer (current-buffer))
+	 (temp-buffer (get-buffer-create "*XCal-temp*")))
+    (setq xcal-days last-of-week)
+    (setq xcal-day-markers (make-vector (1+ xcal-days) nil))
+    (setq xcal-day-schedule (make-vector (1+ xcal-days) nil))
+
+    (put-text-property (point-min) (point-max) 'face 'none)
+
+    (insert-string "   週の予定\n")
+    (let ((week 1) (face nil))
+      (while (<= week last-of-week)
+	(xcal-make-underline)
+	(aset xcal-day-markers week (make-marker))
+	(let (buffer-read-only file prefix x-prefix col)
+	  ;; テンポラリのバッファに移る
+	  (switch-to-buffer temp-buffer)
+	  (setq buffer-read-only nil)
+	  (erase-buffer)
+	  
+	  ;; スケジュールを
+	  (setq file (xcal-week-file-name week))
+	  (if (file-exists-p file)
+	      (progn
+		(aset xcal-day-schedule week t)
+		(insert-file file)))
+	   
+	  ;; 最後の改行を処理
+	  (goto-char (point-max))
+	  (insert "\n\n")
+	  (delete-blank-lines)
+	  
+	  ;; 空なら "\n" を追加
+	  (goto-char (point-min))
+	  (if (eobp) (insert "\n"))
+	  (setq prefix
+		(concat
+		 (aref ["日" "月" "火" "水" "木" "金" "土"] (1- week))
+		 " "
+		 (if (and wday (= (1- week) wday)) "*" "|")))
+	  (setq x-prefix (concat (make-string (1- (clength prefix)) ? ) "|"))
+	  (let ((color (nth 1 (assoc (1- week) xcal-week-holiday))))
+	    (setq face (if color (xcal-lookup-face-create color) nil)))
+	  (goto-char (point-min))
+	  (while (not (eobp))
+	    (beginning-of-line)
+	    (insert
+	     (concat "   "
+		     (if face (put-text-property
+			       0 (- (length prefix) 2)
+			       'face face prefix))
+		     prefix))
+	    (setq col (current-column))
+	    (setq prefix x-prefix)
+	    (next-line 1))
+	  
+	  (setq msg (buffer-string))
+	  (switch-to-buffer xcal-buffer)
+	  (save-excursion (insert-string msg))
+	  (move-to-column (1- col))
+	  (setq marker (set-marker (aref xcal-day-markers week) (point)))
+	  (goto-char (point-max)))
+
+	(setq week (1+ week)))
+      (xcal-make-underline))
+    (kill-buffer temp-buffer)))
   
 (defun xcal-make-underline ()
   (let (start end len)
@@ -865,7 +981,7 @@
 	(setq face (if (and this (not (eq this 'underline)))
 		       (cons this 'underline) 'underline))
 	(setq x (or (next-single-property-change s 'face) e))
-	(put-text-property s x 'face (xcal-lookup-face-create face))
+	(put-text-property s x 'face face) ;; xcal-lookup-face-create err?
 	(setq s x)))
     (next-line 1)))
  
@@ -892,6 +1008,10 @@
 			  (1- month))
 		    year))))
   
+(defun xcal-week-file-name (week)
+  "曜日からファイル名を作成する。"
+  (format "%s/%s" xcal-directory (nth 1 (nth (1- week) xcal-week-schedule))))
+
 (defun xcal-write-region (begin end file)
   (xcal-make-directory (file-name-directory file))
   (write-region (point-min) (point-max) file))
@@ -1091,14 +1211,18 @@
   (if (null xcal-keys-message)
       (setq xcal-keys-message
 	    (substitute-command-keys
+	     (concat
+	      (if xcal-disp-week
+		  "\
+月予定 \\[xcal-toggle-disp-month-and-week]  "
 	     "\
 先月 \\[xcal-before]  \
 次月 \\[xcal-next]  \
 前日 \\[xcal-previous-day]  \
-明日 \\[xcal-next-day]  \
-編集 \\[xcal-edit-for-xcal]  \
+明日 \\[xcal-next-day]  ")
+"編集 \\[xcal-edit-for-xcal]  \
 削除 \\[xcal-delete-file]  \
-終了 \\[xcal-quit]")))
+終了 \\[xcal-quit]"))))
   (message xcal-keys-message))
   
 (defun xcal-print-out ()
@@ -1115,13 +1239,13 @@
 ;;                                      1         2         3         4         5
 ;;                             1234567890123456789012345678901234567890123456789012
   
-(defvar xcal-week-schedule '(("月" "xwMon")
+(defvar xcal-week-schedule '(("日" "xwSun")
+			     ("月" "xwMon")
 			     ("火" "xwTue")
 			     ("水" "xwWed")
 			     ("木" "xwThu")
 			     ("金" "xwFri")
-			     ("土" "xwSat")
-			     ("日" "xwSun")))
+			     ("土" "xwSat")))
   
 (setq xcal-select-minibuffer-map (make-keymap))
 (suppress-keymap xcal-select-minibuffer-map)
@@ -1213,8 +1337,7 @@
   (setq mode-line-process (concat " "
 				  (nth 0 (nth xcal-week-select-index xcal-week-schedule))
 				  "曜日のスケジュール"))
-  (setq xcal-file
-	(format "%s/%s" xcal-directory (nth 1 (nth xcal-week-select-index xcal-week-schedule))))
+  (setq xcal-file (xcal-week-file-name (1+ xcal-week-select-index)))
   (and (file-exists-p xcal-file) (insert-file xcal-file))
   (message
    (substitute-command-keys "Editing: Type \\[xcal-edit-cease-edit] to return to XCal, \\[xcal-edit-abort-edit] to abort.")))
--ここまで---------------------------------------------------------------

=============================================
OSHIRO Naoki: oshiro@mibai.tec.u-ryukyu.ac.jp
http://mibai.tec.u-ryukyu.ac.jp/~oshiro/