[mhc:00422] Re: mhc-snap20000229

[Hideyuki SHIRAI (白井秀行) <shirai@xxxxxxxxxxxxxxxxxxx>]

From: Yoshinari NOMURA <nom@xxxxxxxxxxxxxxxxxxx> さん曰く
Subject: [mhc:00421] mhc-snap20000229
Message-ID: <20000229185803F.nom@xxxxxxxxxxxxxxxxxxx>
Date: Tue, 29 Feb 2000 18:58:08 +0900

nom> 乃村です。忙しさも一山越えました。とりあえず、これまで頂いたパッ
nom> チを整理して snap を作りました。

お疲れ様です。

nom> ほとんど頂いたパッチを当てただけの物で、自分では十分にチェックで
nom> きていません。19.28 対応の確認もできていません。

これって、

nom>     + 19.28 の macro 書式に戻す。

のことですか？ 今のところ問題はないです。

nom>     + 3ヶ月表示で、予定のある日に下線を引いてみた (うるさい?)

## 派手なの好きです。:-)

以下、本題。

nom>     + face の設定 mhc-category-face-alist, mhc-symbol-face-alist 書式を変更

face 回りなのですが、

● XEmacs だと (facep 'italic) って
・(facep 'italic) => nil
・(find-face 'italic) => #<face italic "Italic text.">
 となります。実は最初から XEmacs だけユーザ定義が効きました。

● う〜〜ん、ユーザ定義が効かない。
 1. mhc.el が load されたときに実行される (mhc-face-setup) は
  interactive ではないから overwrite されない。
  (call-interactively 'mhc-face-setup) でもいいけどなんか気持悪い。
  
 2. 'M-x mhc-face-setup' としたときは (interactive-p) => t だけど
  let 式の () が足らないから overwrite されない。

 3. (setq mhc-category-face-alist '(("holiday"  . (italic "Red"))))
  として 2. を直して M-x mhc-face-setup するとエラーになる。

のパッチです

-- 
白井秀行 (mailto:shirai@xxxxxxxxxxxxxxxxxxx)

--- mhc-face.el.orig	Tue Feb 22 19:21:19 2000
+++ mhc-face.el	Tue Feb 29 20:45:37 2000
@@ -67,7 +67,8 @@
       'default))
 
 (defun mhc-face-make-face-from-string (string prop &optional prefix overwrite)
-  (let ((symbol-name (concat prefix (if prefix "-") string)))
+  (let ((symbol-name 
+	 (if (stringp prefix) (concat prefix "-" string) string)))
     (mhc-face-make-face-from-symbol (intern symbol-name) prop overwrite)))
 
 (defun mhc-face-make-face-from-symbol (symbol prop &optional overwrite)
@@ -78,7 +79,7 @@
 	(font    (nth 4 prop))
 	(stipple (nth 5 prop))
 	(face    nil))
-    (if (and (facep symbol) (not overwrite))
+    (if (and (mhc-facep symbol) (not overwrite))
 	symbol
       (setq face (if parent (copy-face parent symbol) (make-face symbol)))
       (if fg      (set-face-foreground  face fg))
@@ -93,7 +94,7 @@
 
 (defun mhc-face-get-gray-face (face)
   (let ((gray-symbol (intern (concat (symbol-name face) "-gray"))))
-    (if (facep gray-symbol)
+    (if (mhc-facep gray-symbol)
 	()
       (copy-face face gray-symbol)
       (set-face-background gray-symbol "gray"))
@@ -101,7 +102,7 @@
 
 (defun mhc-face-get-busy-face (face)
   (let ((busy-symbol (intern (concat (symbol-name face) "-busy"))))
-    (if (facep busy-symbol)
+    (if (mhc-facep busy-symbol)
 	()
       (copy-face face busy-symbol)
       (or (make-face-bold busy-symbol nil t)
@@ -111,7 +112,7 @@
 
 (defun mhc-face-get-underline-face (face)
   (let ((busy-symbol (intern (concat (symbol-name face) "-uline"))))
-    (if (facep busy-symbol)
+    (if (mhc-facep busy-symbol)
 	()
       (copy-face face busy-symbol)
       (set-face-underline-p busy-symbol t))
@@ -120,9 +121,9 @@
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; setup faces.
 
-(defun mhc-face-setup ()
+(defun mhc-face-setup (&optional overwrite)
   (interactive)
-  (let (ow (interactive-p))
+  (let ((ow (or (interactive-p) overwrite)))
     ;;
     (mhc-face-setup-internal mhc-symbol-face-alist-internal ow)
     (mhc-face-setup-internal mhc-symbol-face-alist          ow)
@@ -141,6 +142,7 @@
 	(mhc-face-make-face-from-string 
 	 (format "mhc-category-face-%s" (downcase (car lst)))
 	 (cdr lst)
+	 nil
 	 overwrite))
        ((symbolp (car lst))
 	(mhc-face-make-face-from-symbol
@@ -152,15 +154,20 @@
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; facep for emacs 19.28
 
-(or (fboundp 'facep)
-    ;; Introduced in Emacs 19.29.
-    (defun facep (x)
-      "Return t if X is a face name or an internal face vector."
-      (and (or (and (fboundp 'internal-facep) (internal-facep x))
-	       (and 
-		(symbolp x) 
-		(assq x (and (boundp 'global-face-data) global-face-data))))
-	   t)))
+(cond
+ ((fboundp 'find-face)
+  (defalias 'mhc-facep 'find-face))
+ ((fboundp 'facep)
+  (defalias 'mhc-facep 'facep))
+ (t
+  ;; Introduced in Emacs 19.29.
+  (defun mhc-facep (x)
+    "Return t if X is a face name or an internal face vector."
+    (and (or (and (fboundp 'internal-facep) (internal-facep x))
+	     (and 
+	      (symbolp x) 
+	      (assq x (and (boundp 'global-face-data) global-face-data))))
+	 t))))
 
 (provide 'mhc-face)
 
--- mhc.el.orig	Tue Feb 29 19:52:24 2000
+++ mhc.el	Tue Feb 29 20:47:34 2000
@@ -1026,7 +1026,7 @@
     (view-file-other-window path)))
 
 (mhc-db-setup mhc-schedule-file (mhc-summary-folder-to-path mhc-base-folder))
-(mhc-face-setup)
+(mhc-face-setup 'overwrite)
 (put-text-property 2 4 'face 'mhc-calendar-face-sunday  mhc-cal-week-header)
 (put-text-property 20 22 'face 'mhc-calendar-face-saturday mhc-cal-week-header)