よろずや

Emacs のカスタマイズ

環境紹介

使っているパッケージ

使っているパッケージは site-lisp 内を見てもらば一目瞭然です.

COGRE-0.2/			gnuplot-mode.0.6.0/
DTD/				haskell-mode-1.44/
EDE-1.0.beta2/			htmlfontify-0.20/
Mule-UCS-0.84/			ilisp/
SKK-JISYO.L			mew/
SKK-JISYO.LL			mhc-0.25.1/
SKK-JISYO.zipcode		misc/
SKK.tut				navi2ch/
apel-10.4/			psgml-1.3.1/
bbdb/				sdic-2.1.3/
calc-2.02f/			semantic-1.4.4/
ddskk-20030420/			sml-mode-3.9.5/
ecb-1.93/			speedbar-0.14beta4/
eieio-0.17/			subdirs.el
elib-1.0/			tramp-2.0.33/
emacs-tiny-tools-2002.0805/	trr19/
emacs-w3m-1.3.3/		ttyplay/
emacs-wget-0.4.0/		tuareg-mode-1.40.4/
esheet/				yatex1.70/
flim-1.14.4/

ファイル一個で済んでしまうような小さなものは misc の中にまとめてあります.

asciiart.el           dope.el          newsflash.el      tab.el
bbdb-mew.el           elscreen-tab.el  planner.el        texinfo-markup.el
ce-scroll.el          elscreen.el      pobox.el          typing.el
checkdoc.el           emacs-wiki.el    python-mode.el    vline.el
color-theme.el        escreen-tab.el   rain.el           windows-tab.el
colorful.el           escreen.el       remember.el       windows.el
cperl-mode.el         gnuserv.el       revive.el         x-face-e21.el
css-mode.el           highline.el      romakana.el       xml-parse.el
dabbrev-highlight.el  htmlize.el       seimei.el         yank-pop-summary.el
dabbrev-ja.el         id3.el           select-xface.el   
display-deadline.el   latex-markup.el  shell-command.el  
dmacro.el             mpg123.el        suggbind.el

emacs-wiki.el のメモは別ページにあります.

color-theme.el の紹介

light

blue

black

color-theme.el は Emacs の見た目を切り替えるためのツールです. なかなか便利なのですが,

といた要望を見たすため,自分の好みでテーマを自作 1 しました.追加したテーマは

の 4 種類です.しかし根性が足りずに中途半端に終ってしまいました.ところどこ ろ というか沢山 見にくい face が残ってます(だれか直して…). 改造した color-theme.el は↓です.

使い方は load-path の通ったところに color-theme.el を置いて

(require 'color-theme)
(color-theme-lisper-light)
;;(color-theme-lisper-blue)
;;(color-theme-lisper-black)

.emacs

とするだけです.この例では color-theme-lisper-light を使用していますが,暗い 背景に切り替えたくなったら M-x color-theme-lisper-black とかしてください.

color-theme.el : テーマの作成法(Step by Step)

いきなり自作テーマに飽きつつあります.というわけで,簡単なテーマの作り方を紹 介します.これを切っかけに,皆さんがんがんテーマを作ったり改造したり公開した りしてくるとれると嬉しいです.

最初に作成するテーマの名前を決めます.仮に example としましょう.color-theme の流儀に従うとcolor-theme-example という関数を作成することになります.

(defun color-theme-example ()
  (interactive)
  (color-theme-install
   '(color-theme-example)))

これはまだ何もしてません.これが何も設定しない(無を設定する?)最小のテーマ です.

次にテーマの基本的な配色を考えます.重要なのは,

の 3 つです.今回は文字の色を white, 背景色を darkgreen, カーソルの色を lightblue としましょう.これらは属性リストで表現されます.

(defun color-theme-example ()
  (interactive)
  (color-theme-install
   '(color-theme-example
     ((foreground-color . "white")
      (background-color . "darkgreen")
      (cursor-color . "lightblue")))))

好きな色を探すには M-x list-colors-display を使いましょう.あるいは,名前よ りももっと細かく色を指定したいという向きには "#RRGGBB" や "rgb:R/G/B" といっ た文字列も使用できます.たとえば, "white" は "#FFFFFF" や "rgb:f/f/f" と同 じです.

さて,これでも少々ショボイ事を除けば立派なテーマです.試しに書いた color-theme-example 関数内にカーソルを移動し, M-x eval-defun で関数定義を評 価してください.ミニバッファにcolor-theme-example と表示されたら無事に評価で きています.M-x color-theme-example で実行してみてください.背景がグリーンで 白い文字の画面になったはずです.

さて,これでは少々さみしいので,もうすこし色を追加してみましょう.まずモード 行の色を換えてみましょう.背景を white,文字を darkblue にしてみたいと思いま す.

(defun color-theme-example ()
  (interactive)
  (color-theme-install
   '(color-theme-example
     ((foreground-color . "white")
      (background-color . "darkgreen")
      (cursor-color . "lightblue"))
     ;; モード行の文字を white, 背景を darkblue に
     (modeline ((t (:foreground "white" :background "darkblue")))))))

また,M-x eval-defun で定義を評価した後,M-x color-theme-example で評価して ください.モード行の色がかわってテーマらしくなってきたと思います.

このプログラムを解説すると,modeline というフェイス(face)を ((t (:foreground "white" :background "darkblue"))) という値に設定しているのです. この値は前景色(:foreground)が "whiet", 背景色が(:background)が "darkblue" という事をしめしています.最初の t ってなんだ?と疑問に思うでしょ うが,これは emacs の都合で

  (modeline ((背景が暗い場合   属性を表わすリスト)
             (背景が明るい場合 属性を表わすリスト)))
とか
  (modeline ((ウィンドウシステムの場合   属性を表わすリスト)
             (コンソールの場合 属性を表わすリスト)))

といったように,フェイスの設定を場合わけするための機構です.(詳しく知りたい 方は elisp リファレンス等を参照してください)とりあえず,今は t を指定してお くものだと思ってください.

  (modeline ((t 見た目定義するリスト)))

という理解で十分 1 です.見た目を定義するリストが今回は (:foreground "white" :background "darkblue") だったわけです.さらに他のフェイスも設定して みましょう.リージョンの背景色を lightskyblue に,メニューやメニューバーを darkblue 背景に白い文字といきましょう.

[1] なぜなら,どーせ端末上などの色の制限が厳しい場合は color-theme とか使わ ずに設定するから.(私だけでしょーか?)

(defun color-theme-example ()
  (interactive)
  (color-theme-install
   '(color-theme-example
     ((foreground-color . "white")
      (background-color . "darkgreen")
      (cursor-color . "lightblue"))
     ;; モード行,リージョン,メニュー,メニューバーの設定
     (modeline ((t (:foreground "white" :background "darkblue"))))
     (region   ((t (:foreground "black" :background "lightskyblue"))))
     (menu     ((t (:foreground "white" :background "darkblue"))))
     (menubar  ((t (:foreground "white" :background "darkblue")))))))

メニューバーが青くなりましたか?あんまり face をあれこれ変更しまくっていると Emacs 上で色が変わらなくなる時があります.そんな時は慌てず騒がず Emacs を 再起動しましょう.

メニューが青くなっていたら成功です.リージョンの色が見えないときは, M-x transient-mark-mode で transient-mark-mode を enable にしてください.

さて,見た目もだいぶテーマらしくなってきました.最後に font-lock を設定してみましょう. 色を考えるのが面倒なので "#RRGGBB" 記法でてきとーに決めちゃいます.

(defun color-theme-example ()
  (interactive)
  (color-theme-install
   '(color-theme-example
     ((foreground-color . "white")
      (background-color . "darkgreen")
      (cursor-color . "lightblue"))
     ;; モード行,リージョン,メニュー,メニューバーの設定
     (modeline   ((t (:foreground "white" :background "darkblue"))))
     (region     ((t (:foreground "black" :background "lightskyblue"))))
     (menu       ((t (:foreground "white" :background "darkblue"))))
     (menubar    ((t (:foreground "white" :background "darkblue"))))
     (scroll-bar ((t (:foreground "white" :background "darkblue"))))
     ;; font-lock 属性の指定
     (font-lock-builtin-face       ((t (:foreground "#FFFFDD"))))
     (font-lock-comment-face       ((t (:foreground "#FFDDFF"))))
     (font-lock-constant-face      ((t (:foreground "#DDFFFF"))))
     (font-lock-doc-face           ((t (:foreground "#FFFFCC"))))
     (font-lock-function-name-face ((t (:foreground "#FFCCFF"))))
     (font-lock-keyword-face       ((t (:foreground "#CCFFFF"))))
     (font-lock-string-face        ((t (:foreground "#FFFFBB"))))
     (font-lock-type-face          ((t (:foreground "#FFBBFF"))))
     (font-lock-variable-name-face ((t (:foreground "#BBFFFF"))))
     (font-lock-warning-face       ((t (:foreground "#FFFFAA")))))))

これで何らかのプログラミンング言語のコードでも除いてみるとそれぞれ指定 した色が付いているのが確認できるはずです.

今回は :foreground, :background に色を指定するというもっとも基本的なものしか 扱いませんでしたが,

(font-lock-type-face ((t (:underline t :italic t))))

といったようにアンダーラインや斜体の指定もできます.詳細はやっぱり elisp リ ファレンスをみてください.

ここまでできればテーマを自作する事も可能です.もっと face を知りたい場合には, M-x list-faces-display で face の一覧を見たり M-x describe-face で調べたいフェ イスの名前(list-faces-display で調べた名前)を指定して詳しい情報を得ること もできます.

個人的な .emacs

.emacs は FreeBSD, Windows で共有しています.そんなわけでちょっと見難いですが.

;;; -*- mode: Emacs-Lisp; syntax: elisp; coding: iso-2022-7bit -*-

(setq time-stamp-format "%:y-%02m-%02d %02H:%02M:%02S")
(defconst dot-emacs-version "$IDd: .emacs,v 2.2 Time-stamp: <2003-05-01 23:57:48>$")

(defvar *site-lisp* nil "ローカル用の elisp パッケージ置場")
(defvar *ms-windows-p* (fboundp 'w32-version) "Microsoft Windows 上で動作しているか?")
(defvar *freebsd-p* (string-match "\\(freebsd\\)" (version)) "FreeBSD 上で動作しているか?")

(when *ms-windows-p*
  (setq *site-lisp*
	(if (file-directory-p "~/local/site-lisp/")
	    "~/local/site-lisp/" (concat exec-directory "../site-lisp/")))
  (let* ((d default-directory))
    (cd *site-lisp*)
    (when (fboundp 'normal-top-level-add-subdirs-to-load-path)
      (normal-top-level-add-subdirs-to-load-path))
    (cd d))
  ;; 日本語環境設定
  (require 'un-define)
  (require 'un-tools)
  (set-language-environment "Japanese")
  (set-default-coding-systems 'sjis-dos)
  (set-w32-system-coding-system 'sjis-dos)
  (set-clipboard-coding-system 'sjis-dos)
  ;; ファイル名と文字コードの対応を指定しておく
  (nconc auto-coding-alist
	 '(("\\.pyw?$" . utf-8)
	   ;;'("memo" . iso-2022-jp-unix)
	   ;;'("\\.html$" . utf-8)
	   ;;'("\\.tex$" . iso-2022-jp-unix)
	   ("\\.mbox$" . euc-jp-unix)
	   ("\\.utf8$" . utf-8)))
  ;; 起動時のカレントディレクトリを c:/home にする
  (when (string-equal (downcase default-direct)
		      (downcase (expand-file-name exec-directory)))
    (cd (convert-standard-filename "~/")))
  ;; Shell 関連
  ;; coding-system の設定
  ;; (modify-coding-system-alist 'process "\\.exe" 'undecided-dos)
  ;; browse-url の設定
  (require 'browse-url)
  (global-set-key [S-mouse-2] 'browse-url-at-mouse)
  (global-set-key [f7]
		  (lambda ()
		    (interactive)
		    (insert (w32-get-clipboard-data))))
  (global-set-key [f8]
		  (lambda (beg end)
		    (interactive "r")
		    (w32-set-clipboard-data (buffer-substring beg end))))
  ;; ウィンドウの最大化/解除を F9 キーに割り当ててみる(トグルする)
  ;; #define SC_MINIMIZE     0xF020 61472
  ;; #define SC_MAXIMIZE     0xF030 61488
  ;; #define SC_NEXTWINDOW   0xF040
  ;; #define SC_PREVWINDOW   0xF050
  ;; ...
  ;; #define SC_RESTORE      0xF120 (+ (* 15 16 16 16) (* 1 16 16) (* 2 16)) -> 61728
  (defvar SC_MAXIMIZE 61488)
  (defvar SC_RESTORE 61728)
  (defvar *wm-message* SC_MAXIMIZE)
  (global-set-key [f9]
		  (lambda ()
		    (interactive)
		    (w32-send-sys-command *wm-message*)
		    (setq *wm-message* (if (eq *wm-message* SC_MAXIMIZE) SC_RESTORE SC_MAXIMIZE)))))

(when *freebsd-p*
  ;; UNIX 向けの設定
  (when (null *site-lisp*)
    (setq *site-lisp* "~/local/site-lisp/")
    (let* ((old default-directory))
      (cd *site-lisp*)
      (when (fboundp 'normal-top-level-add-subdirs-to-load-path)
	(normal-top-level-add-subdirs-to-load-path))
      (cd old)))
  ;; for Mule-UCS
  (require 'un-define)
  (require 'un-tools)
  (nconc auto-coding-alist
	 '(("\\.pyw?$" . utf-8)
	   ;;'("memo" . euc-jp-unix)
	   ("\\.utf8$" . utf-8)
	   ("\\.html$" . utf-8)
	   ;;'("\\.tex$" . iso-2022-jp-unix)
	   ("\\.mbox$" . euc-jp-unix)))
  (set-language-environment "Japanese")
  ;; Default shell mode input/output to EUC
  (set-default-coding-systems 'euc-jp-unix)
  (set-terminal-coding-system 'euc-jp-unix)
  ;; browse-url
  (require 'browse-url)
  (setq browse-url-netscape-program "mozilla")
  (global-set-key [S-mouse-2] 'browse-url-at-mouse))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;                     Basic Customization                          ;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(global-set-key "\C-p" 'previous-window-line)
(global-set-key "\C-n" 'next-window-line)
(global-set-key [up] 'previous-window-line)
(global-set-key [down] 'next-window-line)
(defun previous-window-line (n)
  (interactive "p")
  (let ((cur-col
	 (- (current-column)
	    (save-excursion (vertical-motion 0) (current-column)))))
    (vertical-motion (- n))
    (move-to-column (+ (current-column) cur-col)))
  (run-hooks 'auto-line-hook))

(defun next-window-line (n)
  (interactive "p")
  (let ((cur-col
	 (- (current-column)
	    (save-excursion (vertical-motion 0) (current-column)))))
    (vertical-motion n)
    (move-to-column (+ (current-column) cur-col)))
  (run-hooks 'auto-line-hook))

;; By an unknown contributor (from Emacs FAQ)
(global-set-key "%" 'match-paren)
(defun match-paren (arg)
  "Go to the matching parenthesis if on parenthesis otherwise insert %."
  (interactive "p")
  (cond ((looking-at "\\s\(") (forward-list 1) (backward-char 1))
	((looking-at "\\s\)") (forward-char 1) (backward-list 1))
	(t (self-insert-command (or arg 1)))))

;; Don't Display Startup Message
(setq inhibit-startup-message t)

;; enable visible-bell
(setq visible-bell t)

;; show time in status line
;(setq display-time-24hr-format t)
;(setq display-time-day-and-date t)
;;(setq display-time-string-forms
;;      '(24-hours ":" minutes))
;; ;;      '(month "/" day "(" dayname ") " 24-hours ":" minutes))
;;(display-time)

;;; Display line and column No. in mode-line
(line-number-mode t)
(column-number-mode t)

;; Swap C-h <-> Del
;; (load "term/bobcat")
(load-library "term/keyswap")
(when (eq window-system 'x)
  (define-key function-key-map [delete] [8])
  (put 'delete 'ascii-character 8))

;;; news
;(setq nntp-server-action-alist '(("innd" (ding))))
;(setq gnus-nntp-server "dell")
;(setq gnus-select-method '(nntp "dell.my.domain"))

;; backup and  Auto Save
(defvar *auto-save-directory* nil "自動セーブにつかうディレクトリ")
(setq *auto-save-directory* (convert-standard-filename "~/.autosave/"))
(when (not (file-directory-p *auto-save-directory*))
  (make-directory *auto-save-directory*))
(setq auto-save-list-file-prefix (concat *auto-save-directory* ".saves-")
      make-backup-files      t
      backup-directory-alist `(("." . ,*auto-save-directory*))
      version-control        t
      kept-old-versions      9
      kept-new-versions      3
      delete-old-versions    t
      backup-by-copying      t)

;;; Default major mode set to text-mode
(setq default-major-mode 'text-mode)

;;; Scroll with 1 line at the end of window.
(setq scroll-step 1)
(setq scroll-conservatively 1)

;;; Default fill column set to 76 columns. If line over 76 caharacters
;;; the line will be folded.
;(setq text-mode-hook (lambda () (auto-fill-mode 1)))
;(add-hook 'text-mode-hook 'turn-on-auto-fill)
(setq-default fill-column 76)

;;; No new-line insert at the end buffer
(setq next-line-add-newlines nil)

;;; Delete line with C-k
;(setq kill-whole-line t)
;;; Add newline if not ended newline.
(setq require-final-newline t)

(blink-cursor-mode nil)

;; buffer-menu
(global-set-key "\C-x\C-b" 'buffer-menu)


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;                 Set Japanese input methods.                      ;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;; ddskk
;;(setq load-path (cons (concat *site-lisp* "ddskk20021117") load-path))
(setq load-path (cons (concat *site-lisp* "ddskk-20030420") load-path))
(require 'skk-autoloads)
(global-set-key "\C-x\C-j" 'skk-mode)
(global-set-key "\C-xj" 'skk-auto-fill-mode)
(add-hook 'isearch-mode-hook
	  (lambda ()
	    (and (boundp 'skk-mode) skk-mode
 		 (skk-isearch-mode-setup) )))
(add-hook 'isearch-mode-end-hook
	  (lambda ()
 	    (and (boundp 'skk-mode) skk-mode
 		 (skk-isearch-mode-cleanup)
 		 (skk-set-cursor-color-properly))))
(setq skk-tut-file (expand-file-name (concat *site-lisp* "SKK.tut"))
      ;;skk-initial-search-jisyo nil
      ;;skk-kakutei-jisyo nil
      skk-large-jisyo
      (expand-file-name (concat *site-lisp* "SKK-JISYO.LL"))
      skk-aux-large-jisyo
      (expand-file-name (concat *site-lisp* "SKK-JISYO.zipcode")))

;; pobox
(autoload 'pobox-mode "pobox.el")
(setq pobox-toggle-key "\C-c\C-j"
      pobox-server     "localhost")
(global-set-key pobox-toggle-key 'pobox-mode)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;                     Visual Configuration                         ;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defmacro set-attribute-list (&rest forms)
  (let ((body (mapcar (lambda (e)
			(cons 'set-face-attribute
			      (cons `(quote ,(car e)) (cons nil (cdr e)))))
		      forms)))
    `(progn ,@body)))

(when (and *ms-windows-p*
	   window-system
	   ;;(null (query-fontset "-*-Courier New-normal-r-*-*-16-*-*")))
	   (null (query-fontset "-*-FixedSys-normal-r-*-*-14-*-*")))
  ;; (insert (prin1-to-string (w32-select-font))) で取得したフォント情報
  ;; w32-system-coding-system が sjis-dos じゃないと文字化けしたのがかえってくる
  (setq scalable-fonts-allowed nil)
  (create-fontset-from-fontset-spec
   (concat
    "-*-FixedSys-normal-r-*-*-14-*-*-*-c-*-fontset-null,\n"
    "japanese-jisx0208:-*-MS ゴシック-normal-r-*-*-16-120-*-*-c-*-jisx0208-sjis,\n"
    "japanese-jisx0212:-*-MS ゴシック-normal-r-*-*-16-120-*-*-c-*-jisx0208-sjis,\n"
    "katakana-jisx0201:-*-MS ゴシック-normal-r-*-*-16-120-*-*-c-*-jisx0208-sjis,\n"
    "latin-jisx0201:-*-FixedSys-normal-r-*-*-14-*-*-*-c-*-*--iso8859-1,\n"
    "japanese-jisx0208-1978:-*-MS ゴシック-normal-r-*-*-16-120-*-*-c-*-jisx0208-sjis")))

(when (and *freebsd-p*
	   window-system
	   (null (query-fontset "-*-fixed-medium-r-normal-*-16-*-*-*-c-*")))
  (setq scalable-fonts-allowed t)
  (create-fontset-from-fontset-spec
   (concat
    "-*-fixed-medium-r-normal-*-16-*-*-*-c-*-fontset-null,\n"
    "japanese-jisx0208:-*-gothic-*-r-*-*-16-*-*-*-*-*-jisx0208.1983-*,\n"
    "japanese-jisx0212:-*-gothic-*-r-*-*-16-*-*-*-*-*-jisx0208.1990-*,\n"
    "katakana-jisx0201:-*-gothic-*-r-*-*-16-*-*-*-*-*-jisx0201.1976-*,\n"
    "latin-jisx0201:-*-fixed-medium-r-normal-*-16-*-*-*-*-*-iso8859-1,\n"
    "japanese-jisx0208-1978:-*-gothic-*-r-*-*-16-*-*-*-*-*-jisx0208.1983-*"))
  (create-fontset-from-fontset-spec
   (concat
    "-*-fixed-bold-r-normal-*-16-*-*-*-c-*-fontset-null,\n"
    "japanese-jisx0208:-*-gothic-*-r-*-*-16-*-*-*-*-*-jisx0208.1983-*,\n"
    "japanese-jisx0212:-*-gothic-*-r-*-*-16-*-*-*-*-*-jisx0208.1990-*,\n"
    "katakana-jisx0201:-*-gothic-*-r-*-*-16-*-*-*-*-*-jisx0201.1976-*,\n"
    "latin-jisx0201:-*-fixed-bold-r-normal-*-14-*-*-*-c-*-iso8859-1,\n"
    "japanese-jisx0208-1978:-*-gothic-*-r-*-*-16-*-*-*-*-*-jisx0208.1983-*")))

(setq frame-title-format "%b")
(setq default-frame-alist
      (list
       ;;'(ime-font . "Nihongo-12") ; TrueType
       ;; '(font . "bdf-fontset")    ; BDF
       ;; '(font . "private-fontset"); TrueType
       ;; '(font . "fontset-std")) ; 定義した fontset を使用
       ;; '(font . "FixedSys")) ; フォント名直指定
       ;;`(font . ,(if *ms-windows-p* "fontset-null" "fontset-16"))
       '(font . "fontset-null")
       ;; '(top . 100) '(left . 100)
       '(width . 80) '(height . 25)))

(cond (window-system
       (tool-bar-mode 0) ;; hide icon tool bar
       (require 'color-theme)
       (color-theme-lisper-light)
       ;;(color-theme-lisper-blue)
       ;;(color-theme-lisper-green)
       ;;(color-theme-lisper-black)
       (when *freebsd-p*
	 (set-face-attribute
	  'bold nil
	   :font "-*-fixed-bold-r-normal-*-16-*-*-*-c-*-fontset-null"))
       (require 'font-lock)
       (setq transient-mark-mode t)
       (setq font-lock-support-mode 'jit-lock-mode)
       (global-font-lock-mode t)
       (require 'hl-line)
       (setf hl-line-face 'hl-line-face)
       (global-hl-line-mode))
      (t
       (global-font-lock-mode t)
       ;;(set-cursor-color "white")
       (set-attribute-list
	(font-lock-function-name-face :foreground "white" :background "black" :bold t :underline t)
	(font-lock-constant-face :foreground "white" :background "black" :bold t :underline nil)
	(font-lock-builtin-face :foreground "yellow" :background "black" :bold t :underline t)
	(highlight :foreground "black" :background "white" :bold nil :underline nil))
       (menu-bar-mode -1)))

(require 'color-theme)
;;(color-theme-classic)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;		Customization of Standard Packages		    ;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;; scheme
;; (setq scheme-program-name "guile")
;; (setq scheme-program-name "scm")
;;(setq scheme-program-name "scheme")
(setq scheme-program-name "gosh")

;; prolog
(setq prolog-program-name "gprolog")

;; eldoc (for Lisp Programming)
(add-hook 'emacs-lisp-mode-hook  'turn-on-eldoc-mode)
(add-hook 'lisp-interaction-mode-hook 'turn-on-eldoc-mode)
(add-hook 'ielm-mode-hook 'turn-on-eldoc-mode)

;; hexl-mode
(autoload 'hexl-find-file "hexl" "Edit file FILENAME in hexl-mode." t)
(define-key global-map "\C-c\C-h" 'hexl-find-file)

;;; Dired
(require 'dired)
(add-hook 'dired-load-hook
	  (lambda ()
	    (load "dired-x")
	    (when *ms-windows-p*
	      ;;(setq dired-guess-shell-gnutar "gtar")
	      (setq dired-x-hands-off-my-keys nil))))
(add-hook 'dired-mode-hook
	  (lambda ()
	    (when *ms-windows-p*
	      ;; Set dired-x buffer-local variables here.  For example:
	      (setq dired-omit-files-p t))))
(define-key dired-mode-map "s" 'dired-sort-select)
(setq dired-sort-select-alist
      '(("extention" . "X")("name" . "U") ("size" . "S") ("time" . "t")
	("version" . "v") ("status" . "c") ("atime" . "u"))
      dired-sort-select-default "name")
(defun dired-sort-select (arg)
  (interactive "P")
  (dired-sort-other
   (concat dired-listing-switches
	   (cdr (assoc
		 (completing-read "sort by: "
				  dired-sort-select-alist
				  nil nil nil nil
				  dired-sort-select-default)
		 dired-sort-select-alist))
	   (and arg "r"))))

;;(if *ms-windows-p* (require 'ls-lisp) (setenv "LC_TIME" "C"))
(require 'ls-lisp)
(autoload 'tar-mode "tar-mode")
(require 'jka-compr)
;;(toggle-auto-compression 1)
(auto-compression-mode t)

;; start emacs-server or gnuserv
(if (not *ms-windows-p*)
    (server-start)
  (require 'gnuserv)
  (gnuserv-start))

;; ChangeLog memo
(setq user-mail-address (concat (user-login-name) "@" (system-name))
      user-full-name    (user-full-name))
(defun memo ()
  (interactive)
  (add-change-log-entry
   nil
   (convert-standard-filename 
    (if (file-exists-p (expand-file-name "~/.emacs.d/memo"))
	"~/.emacs.d/memo"
      "~/memo"))))
(define-key ctl-x-map "M" 'memo)

;; wheel
(require 'mwheel)
(mwheel-install)

;; experimental

;; ffap
(ffap-bindings)

;; tmm
(require 'tmm)
(global-set-key [f2] 'tmm-menubar)

;; desktop
(require 'desktop)
(desktop-load-default)
(desktop-read)

(nconc desktop-globals-to-save
       '(kill-ring
	 extended-command-history
	 file-name-history
	 query-replace-history
	 read-expression-history
	 regexp-history
	 shell-command-history))

;; (add-hook 'kill-emacs-hook
;; 	  (lambda ()
;; 	    (desktop-truncate search-ring 3)
;; 	    (desktop-truncate regexp-search-ring 3)))

(defmacro set-desktop-truncates (&rest forms)
  (let ((body (mapcar
	       (lambda (e) `(desktop-truncate ,(car e) ,(cadr e)))
	       forms)))
    `(progn ,@body)))

(global-set-key [f3]
		(lambda ()
		  "現在開いているバッファ,モードを保存する."
		  (interactive)
		  (set-desktop-truncates
		   ;; default variables
		   (search-ring 50)
		   (regexp-search-ring 50)
		   ;; additional variables
		   (search-ring 100)
		   (extended-command-history 100)
		   (regexp-search-ring 100)
		   (kill-ring 50)
		   (file-name-history 100)
		   (query-replace-history 100)
		   (read-expression-history 50)
		   (regexp-history 100)
		   (shell-command-history 100))
		  (desktop-save "~/.emacs.d/")
		  (message "Desktop Saved.")))

(global-set-key [f4]
		(lambda ()
		  "バッファ,モードを復帰する."
		  (interactive)
		  (load (convert-standard-filename "~/.emacs.d/.emacs.desktop"))))


;; building Regexps with visual feedback
(global-set-key [f11] 're-builder)

;; undo
(global-set-key [f12] 'undo)

;; webjump
(require 'webjump)
(setq webjump-sites
      (append '(("google" . "www.google.co.jp")
		("slashdot" . "slashdot.jp")
		("freshmeat" . "www.freshmeat.net")
		("altavista" . "www.altavista.com"))
	      webjump-sites))

;; eshell
(defun eshell/emacs (&rest args)
  (mapc #'find-file (mapcar #'expand-file-name args)))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;		Customization of Non-standard Packages		    ;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;; tramp
(require 'tramp)
(setq tramp-default-method (if *ms-windows-p* "pscp" "scp"))
(when *ms-windows-p* (setq tramp-rsh-end-of-line "\r"))
;;(setq tramp-debug-buffer t) ;; for Debug
(tramp-set-completion-function "ssh"
			       '((tramp-parse-shosts "/etc/ssh_known_hosts")
				 (tramp-parse-shosts "~/.ssh/known_hosts")))

;; demacro
(autoload 'dmacro-exec "dmacro" nil t)
(defconst *dmacro-key* "\C-t" "repeat")
(global-set-key *dmacro-key* 'dmacro-exec)


;;; mew
(setq load-path (cons (concat *site-lisp* "mew") load-path))
(load "~/.mew.el")
;; BBDB
;; config
(when *freebsd-p*
  (require 'bbdb)
  (bbdb-initialize)
  (autoload 'bbdb-insinuate-mew "bbdb-mew" "Hook BBDB into Mew")
  (add-hook 'mew-init-hook 'bbdb-insinuate-mew)
  (setq bbdb-file                "~/.bbdb"
	bbdb-pop-up-target-lines 4
	;; @ add field automatically
	bbdb/mail-auto-create-p  t
	bbdb/news-auto-create-p  t)
  (add-hook 'bbdb-notice-hook
	    (lambda (record)
	      (x-face-show -1)
	      (bbdb-auto-notes-hook record)
	      (x-face-show)))
  ;; @ list of items to collect
  (setq bbdb-auto-notes-alist
	`(("X-ML-Name" (".*" ml 0))
	  ("X-Ml-Name" (".*" ml 0))
	  ("X-Mailer" (".*" mua 0))
	  ("User-Agent" (".*" mua 0))
	  ("X-Newsreader" (".*" mua 0))
	  ("X-Emacs" (".*" emacs 0))
	  ("X-Url" (".*" www 0))
	  ("X-Uri" (".*" www 0))
	  ;;("X-Face" (".*" face 0))
	  ("To" (,(concat (user-login-name) "@") ml "direct"))))
  (put 'face 'field-separator "\n")
  (setq bbdb-auto-notes-alist
	(append bbdb-auto-notes-alist
		`(("x-face"
		   (,(concat "[\t\n ]*\\([^\t\n ]*\\)"
			     "\\([\t\n ]+\\([^\t\n ]+\\)\\)?"
			     "\\([\t\n ]+\\([^\t\n ]+\\)\\)?"
			     "\\([\t\n ]+\\([^\t\n ]+\\)\\)?"
			     "\\([\t\n ]+\\([^\t\n ]+\\)\\)?")
		    face
		    "\\1\\3\\5\\7\\9")))))
  ;; x-face
  (cond ((= 21 emacs-major-version)
	 (setq mew-use-highlight-x-face t
	       mew-use-highlight-x-face-function 'x-face-decode-message-header)
	 (require 'x-face-e21)
	 ;; Show X-Face images when `x-face-insert' is done.
	 (setq x-face-auto-image t)
	 (define-key mew-header-mode-map "\M-t" 'x-face-show)
	 (define-key mew-message-mode-map "\M-t" 'x-face-show)
	 (define-key mew-summary-mode-map "\C-x4s" 'x-face-save)
	 (define-key mew-draft-mode-map "\C-x4i" 'x-face-insert)
	 (define-key mew-draft-header-map "\C-x4i" 'x-face-insert)
	 (define-key mew-draft-mode-map "\M-t" 'x-face-show)
	 (define-key mew-draft-header-map "\M-t" 'x-face-show)
	 (add-hook 'mime-edit-translate-hook 'x-face-turn-off)
	 (add-hook 'mew-make-message-hook 'x-face-turn-off)
	 (add-hook 'mew-draft-mode-edit-again-hook 'x-face-turn-off)
	 (add-hook 'mew-draft-mode-hook 'x-face-turn-off)
	 ;; If a file name has no directory component, it should be
	 ;; found in the directory which is specified by the option
	 ;; `x-face-image-file-directory'.
	 (setq x-face-image-file-directory (expand-file-name "~/.xfaces")
	       x-face-default-xbm-file     "default.xbm")
	 (add-hook 'mew-draft-mode-hook 'x-face-insert)
	 (require 'select-xface)
	 ;; For Mew:
	 (add-hook 'mew-draft-mode-hook
		   (lambda ()
		     (define-key (current-local-map) "\C-c\C-x"
		       'select-xface))))))


;;; sdic
(let ((*local-dictionary* "~/local/dictionary/"))
  (when (and (file-exists-p (concat *site-lisp* "sdic-2.1.3"))
	     (file-exists-p *local-dictionary*))
    ;;(require 'sdic)
    (autoload 'sdic-describe-word "sdic" "英単語の意味を調べる" t nil)
    (autoload 'sdic-describe-word-at-point "sdic" "カーソルの位置の英単語の意味を調べる" t nil)
    (let ((files (directory-files *local-dictionary* nil "\\\\*.sdic$"))
	  (eiwa '("gene.sdic" "jarg431.sdic" "eijiro52.sdic" "otojiro.sdic" "ryaku52.sdic" "user_eiwa.sdic"))
	  (waei '("edict.sdic" "waeiji52.sdic" "user_waei.sdic")))
      (defvar sdic-eiwa-dictionary-list nil)
      (defvar sdic-waei-dictionary-list nil)
      (setq sdic-eiwa-dictionary-list nil
	    sdic-waei-dictionary-list nil)
      (dolist (f files)
	(when (member f (append eiwa waei))
	  (add-to-list
	   (if (member f eiwa) 'sdic-eiwa-dictionary-list 'sdic-waei-dictionary-list)
	   (cons 'sdicf-client (if *ms-windows-p*
				   (cons (concat *local-dictionary* f) '((strategy direct)))
				 (list (concat *local-dictionary* f))))))))
    (add-hook 'view-mode-hook
	      (lambda () 
		(define-key view-mode-map [mouse-2] #'sdic-describe-word-at-point)
		(define-key view-mode-map "e" #'sdic-describe-word-at-point)))
    (global-set-key "\C-cw" 'sdic-describe-word-at-point)
    (global-set-key "\C-ce"
		    (lambda (beg end)
		      (interactive "r")
		      (let ((str (buffer-substring beg end)))
			(sdic-describe-word (if (eq (aref str 0) ?\')
						str
					      (concat "'" str "'"))))))))

(add-to-list 'Info-default-directory-list (expand-file-name "~/local/info"))
(load "dabbrev-ja")
(require 'dabbrev-highlight)
(require 'shell-command)
(require 'yank-pop-summary)
(global-set-key "\M-y" 'yank-pop-forward)
(global-set-key "\C-\M-y" 'yank-pop-backward)
;; (require 'display-deadline)
;; ;;(display-deadline "%d days remains to the end of the year"
;; ;;		  (encode-time 0 0 0 1 1 2003))
;; (display-deadline "あと %d 日"
;; 		  (encode-time 0 0 0 1 1 2003))

;; suggest key bindings (to learn key binding)
(setq suggest-key-bindings nil)
(require 'suggbind)

;; lookup
(when (file-exists-p (concat *site-lisp* "lookup"))
  (require 'lookup)
  ;; keymap
  (define-key ctl-x-map "l" 'lookup)              ; C-x l - lookup
  (define-key ctl-x-map "y" 'lookup-region)       ; C-x y - lookup-region
  (define-key ctl-x-map "\C-y" 'lookup-pattern)   ; C-x C-y - lookup-pattern
  ;; agent
  (setq lookup-search-agents '((ndic "~/local/eijiro"))))


;; navi2ch
(when (file-exists-p (concat *site-lisp* "navi2ch"))
  (require 'navi2ch)
  ;; (setq navi2ch-list-bbstable-url "http://www.2ch.net/bbsmenu.html")
  (setq navi2ch-article-auto-expunge t
	navi2ch-article-max-buffers  2
	navi2ch-article-auto-range   nil
	navi2ch-offline              t)
  (require 'izonmoji-mode)
  (add-hook 'navi2ch-bm-mode-hook      'izonmoji-mode-on)
  (add-hook 'navi2ch-article-mode-hook 'izonmoji-mode-on))


;; mpg123
(cond (*ms-windows-p*
       (setq mpg123-system-type 'nt
	     mpg123-startup-volume 70
	     mpg123-process-coding-system 'sjis-dos
	     mpg123-need-slider nil)
       ;;(require 'mpg123)
       (autoload 'mpg123 "mpg123" "A Front-end to mpg123" t))
      (t
       (setq mpg123-startup-volume 70
	     mpg123-need-slider nil)
       (require 'mpg123)))


;; emacs-w3m
(when (not *ms-windows-p*)
  (autoload 'w3m "w3m" "Interface for w3m on Emacs." t)
  (eval-after-load "w3m-form"
    '(define-key w3m-form-input-textarea-keymap [f2]
       (lambda ()
	 (interactive)
	 (set-buffer-file-coding-system 'euc-jp-dos)
	 (save-excursion
	   (goto-char (point-min))
	   (replace-regexp "
$" "")))))
  (eval-after-load "w3m"
    '(setq w3m-command-arguments
	   (nconc w3m-command-arguments '("-no-proxy"))
	   w3m-icon-directory (concat *site-lisp* "emacs-w3m-1.3.3/icons/")
	   w3m-no-proxy-domains '("localhost"))))

;; (require 'mew-w3m)
;; (setq mew-porg-html '(mew-mime-text/html-w3m nil il))


;; ttyplay/ttyrec
(require 'ttyplay)
(when (not *ms-windows-p*) (require 'ttyrec))


;; trr
(setenv "TRRDIR" (concat *site-lisp* "trr19"))
(setenv "TRRBINDIR" (concat *site-lisp* "trr19"))
(require 'trr)


;; mhc
(require 'mhc)
(setq mhc-mailer-package 'mew)
(autoload 'mhc-mode "mhc" nil t)
(add-hook 'mew-summary-mode-hook 'mhc-mode)
(add-hook 'mew-virtual-mode-hook 'mhc-mode)
(add-hook 'mew-message-hook      'mhc-misc-hdr-decode)
(defun mhc-misc-hdr-decode () nil) ;; error 出てうるさいから消しとく…

;; calc
(autoload 'calc-dispatch "calc" "Emacs Calculator" t nil)
(global-set-key "\e#" 'calc-dispatch)


;; psgml
(autoload 'sgml-mode "psgml" "Major mode to edit SGML files." t)
(autoload 'xml-mode "psgml" "Major mode to edit XML files." t)
(setq sgml-catalog-files 
      `("CATALOG" ,(concat *site-lisp* "DTD/xhtml11/xhtml11.cat")
	"CATALOG" ,(concat *site-lisp* "DTD/xhtml-modularization/xhtml.cat"))
      sgml-set-face t
      xml-set-face  t)

;; load emacs-wiki config file
(when (file-exists-p "~//Wiki/config.el")
  (load "~/Wiki/config.el"))

;; speedbar & eieio & semantic
;;(require 'speedbar)
(push (concat *site-lisp* "speedbar-0.14beta4/") load-path)
(require 'speedbar)
;;(push (concat *site-lisp* "eieio-0.17/") load-path)
(require 'eieio)
;;(push (concat *site-lisp* "semantic-1.4.4/") load-path)
(setq semantic-load-turn-everything-on t)
(require 'semantic-load)
(global-semanticdb-minor-mode 1)
(setq semanticdb-default-save-directory "~/.emacs.d/semantic/")
;;(push (concat *site-lisp* "EDE-1.0.beta2/") load-path)
(require 'ede)
;;(push (concat *site-lisp* "ecb-1.93/") load-path)
(require 'ecb)

;; ;; elscreen
;; (require 'elscreen)
;; (add-hook 'after-make-frame-functions 'elscreen-alloc-confs)
;; (setq elscreen-mode-to-screen-alist nil)
;; (require 'elscreen-tab)

;; escreen
(cond
  ((require 'windows nil t)
   (win:startup-with-window)
   (define-key global-map win:switch-prefix nil)
   (setq win:switch-prefix "\C-\\")
   (define-key global-map win:switch-prefix win:switch-map)
   (setq win:switch-prefix "\C-z")
   (define-key global-map win:switch-prefix win:switch-map)
   (setq win:use-frame nil)
   ;;(define-key global-map "\C-zw1" 'win-switch-to-window)
   (require 'windows-tab)
   (cond
    ((string-equal (getenv "TERM") "screen")
    ;; (win-tab-setup 'screen-caption))
     (win-tab-setup 'header-line))
    (window-system
     (win-tab-setup 'header-line))
    (t (win-tab-setup 'echo-area))))
  ((require 'escreen nil t)
   (global-set-key "\C-z" escreen-map)
   ;; elscreen っぽい表示
   ;;(setq escreen-mode-line-format '(escreen-number-mode ("[" escreen-current-screen-string "]")))
   (escreen-install)
   ;; タブ化
   (require 'escreen-tab)))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;                           YaTeX                                  ;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(add-to-list 'auto-mode-alist '("\\.tex$" . yatex-mode))
;; ((not *ms-windows-p*)
;;       (setq YaTeX-hilit-sectioning-face '(darkred/snow snow/darkred))))
;; font 関連は require の前に?
(autoload 'yatex-mode "yatex")
(setq YaTeX-use-font-lock (featurep 'font-lock)
      YaTeX-use-hilit19 nil
      tex-command  "platex"
      dvi2-command (if *ms-windows-p*
		       (if (file-exists-p "c:/usr/local/tex313w/dviout.exe")
			   "c:/usr/local/tex313w/dviout.exe"
			 "c:/dviout/dviout.exe")
		     "xdvi")
      ;; kanji-code 1: SJIS, 2: JIS, 3: EUC
      YaTeX-kanji-code  2
      YaTeX-use-LaTeX2e t
      YaTeX-user-completion-table "~/.emacs.d/.yatexrc"
      YaTeX-help-file             (concat *site-lisp* "yatex1.70/help/YATEXHLP.jp")
      YaTeX-help-file-private     "~/.emacs.d/YATEXHLP.jp")

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;                          Haskell                                 ;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(nconc auto-mode-alist
       '(("\\.[hg]s$"  . haskell-mode)
	 ("\\.hi$"     . haskell-mode)
	 ("\\.l[hg]s$" . literate-haskell-mode)))
(autoload 'haskell-mode "haskell-mode"
   "Major mode for editing Haskell scripts." t)
(autoload 'literate-haskell-mode "haskell-mode"
   "Major mode for editing literate Haskell scripts." t)
(add-hook 'haskell-mode-hook 'turn-on-haskell-font-lock)
(add-hook 'haskell-mode-hook 'turn-on-haskell-decl-scan)
(add-hook 'haskell-mode-hook 'turn-on-haskell-doc-mode)
(add-hook 'haskell-mode-hook 'turn-on-haskell-indent)
(add-hook 'haskell-mode-hook 'turn-on-haskell-simple-indent)
;;(add-hook 'haskell-mode-hook 'turn-on-haskell-hugs)
(add-hook 'haskell-mode-hook 'turn-on-haskell-ghci)


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;                          Python                                  ;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(nconc auto-mode-alist '(("\\.py\\w?" . python-mode)))
(autoload 'python-mode "python-mode" "Major mode for editing python code" t)


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;                      ML (sml & ocaml)                            ;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(nconc auto-mode-alist '(("\\.cm\\w?"  . sml-mode)
			 ("\\.sml\\w?" . sml-mode)
			 ("\\.ml\\w?"  . tuareg-mode)))
(autoload 'sml-mode "sml-mode" "Major mode for editing sml code" t)
(autoload 'tuareg-mode "tuareg" "Major mode for editing Caml code" t)
(autoload 'camldebug "camldebug" "Run the Caml debugger" t)
;;(if (and (boundp 'window-system) window-system)
;;    (require 'font-lock))


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;                             ilisp                                ;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;;(when (file-exists-p (concat *site-lisp* "ilisp-5.12.0"))
(when (file-exists-p (concat *site-lisp* "ilisp"))
  (require 'completer)
  ;; TMC completion
  (load "completion")
  (initialize-completions)
  ;; Autoload based on your Lisp. You only really need the one you
  ;; use. If called with a prefix, you will be prompted for a
  ;; buffer and program.
  ;;(autoload 'run-ilisp   "ilisp" "Select a new inferior Lisp." t)
  ;;(autoload 'common-lisp "ilisp" "Inferior generic Common Lisp." t)
  ;; Franz
  ;;(autoload 'allegro     "ilisp" "Inferior Allegro Common Lisp." t)
  ;; CMUCL
  (autoload 'cmulisp     "ilisp" "Inferior CMU Common Lisp." t)
  ;; CLISP (Bruno Haible and Michael Stoll)
  ;;(autoload 'clisp-hs   "ilisp"
  ;;"Inferior Haible/Stoll CLISP Common Lisp." t)
  ;; Scheme
  ;; (autoload 'scheme     "ilisp" "Inferior generic Scheme." t)
  ;; (autoload 'scm        "ilisp" "Inferior SCM Scheme." t)
  ;; (autoload 'chez       "ilisp" "Inferior Chez Scheme." t)
  ;; (autoload 'guile      "ilisp" "Inferior GUILE Scheme." t)
  ;; Define where Lisp programs are found. (This may already have
  ;; been done at your site).
  (setq allegro-program "/usr/local/acl5/lisp")
  (setq clisp-hs-program
	(if *freebsd-p*
	    "clisp -I"
	  "/usr/local/clisp-2.30/clisp.bat"))
  (when (and (or (string-equal (getenv "TERM") "screen")
		 (eq window-system nil))
	     (require 'w3m))
    (setq browse-url-browser-function #'w3m-browse-url))
  (setq cmulisp-program
	(cond
	  ((file-exists-p "~/local/bin/lisp")
	   (let* ((dir "~/local/lib/cmucl/")
		  (lisp "~/local/bin/lisp")
		  (core (expand-file-name (concat dir "lib/user.core"))))
	     (if (file-exists-p core)
	       (concat lisp " -core " core)
	       lisp)))
	  (t
	   (let* ((dir "/usr/local/lib/cmucl/")
		  (lisp "/usr/local/bin/lisp")
		  (core (concat dir "lib/user.core")))
	     (if (file-exists-p core)
	       (concat lisp " -core " core)
	       lisp)))))
  ;; If you are interested in maintaining CMUCL or compiling it
  ;; from source then set this to where the source files are.
  ;;(setq cmulisp-local-source-directory
  ;;"/usr/robotics/shared/cmu-cl/17c/")
  ;; (setq scm-program "scm -i")
  ;; (setq chez-program "petite")
  ;; (setq guile-program "guile")
  ;; This makes reading a Lisp or Scheme file load in ILISP.
  (set-default 'auto-mode-alist
	       (append '(("\\.lisp$" . lisp-mode)
			 ("\\.lsp$" . lisp-mode)
			 ("\\.cl$" . lisp-mode))
		       auto-mode-alist))
  (add-hook 'lisp-mode-hook (lambda () (require 'ilisp)))
  (set-default 'auto-mode-alist
	       (append '(("\\.scm$" . scheme-mode)
			 ("\\.ss$" . scheme-mode)
			 ("\\.stk$" . scheme-mode)
			 ("\\.stklos$" . scheme-mode))
		       auto-mode-alist))
  (add-hook 'scheme-mode-hook (lambda () (require 'ilisp)))
  ;; Configuration of Erik Naggum's HyperSpec access package.
  ;; If you have a local copy of the HyperSpec, set its path here.
   (setq common-lisp-hyperspec-root
	 (concat "file://" (expand-file-name "~/doc/lisp/doc/HyperSpec/"))
	 common-lisp-hyperspec-symbol-table
	 (expand-file-name "~/doc/lisp/doc/HyperSpec/Data/Map_Sym.txt"))
   ;; Configuration of Utz-Uwe Haus' CLtL2 access package.
   ;; If you have a local copy of CLtL2, set its path here.
   (require 'cltl2)
   (setq cltl2-root-url (concat "file:" (expand-file-name "~/doc/lisp/doc/cltl/")))
   (global-set-key "\C-cL" 'cltl2-lookup)
   ;; Sample load hook
   (add-hook 'ilisp-load-hook
	     (lambda ()
		;; Change default key prefix to C-c
		(setq ilisp-*prefix* "\C-c")
		;; Set a keybinding for the COMMON-LISP-HYPERSPEC command
		(defkey-ilisp "" 'common-lisp-hyperspec)
		;; Make sure that you don't keep popping up the 'inferior
		;; Lisp' buffer window when this is already visible in
		;; another frame. Actually this variable has more impact
		;; than that. Watch out.
		;; (setq pop-up-frames t)
		(message "Running ilisp-load-hook")
		;; Define LispMachine-like key bindings, too.
		;; (ilisp-lispm-bindings) Sample initialization hook.
		;; Set the inferior Lisp directory to the directory of
		;; the buffer that spawned it on the first prompt.
		(add-hook 'ilisp-init-hook
			  (lambda ()
			     (default-directory-lisp ilisp-last-buffer)))
		))
   (require 'ilisp)
   (define-key ilisp-mode-map "\C-i" #'complete-lisp))

;; Common Lisp indentation.
(load-library "cl-indent")
(add-hook 'ilisp-mode-hook
	  (lambda ()
	    (setq ilisp-*prefix* "\C-c")
	    (setq lisp-indent-function 'common-lisp-indent-function)))

;; Additional definitions by Pierpaolo Bernardi.
(defun cl-indent (sym indent)
  (put sym 'common-lisp-indent-function
       (if (symbolp indent)
	   (get indent 'common-lisp-indent-function)
	 indent)))

(cl-indent 'if '1)
(cl-indent 'defclass '((&whole 4 &rest (&whole 2 &rest 1))
	               &rest (&whole 2 &rest 1)))
(cl-indent 'defgeneric 'defun)
(cl-indent 'defmethod '(4 4 (&whole 4 &rest 1) &body))
(cl-indent 'generic-flet 'flet)
(cl-indent 'generic-labels 'labels)
(cl-indent 'symbol-macrolet 'multiple-value-bind)
(cl-indent 'with-accessors 'multiple-value-bind)
(cl-indent 'with-added-methods '((1 4 ((&whole 1))) (2 &body)))
(cl-indent 'with-slots 'multiple-value-bind)
(cl-indent 'handler-bind '((&whole 4 &rest 1) 2 &body))
(cl-indent 'handler-case '((1 4) (&whole 2 ((0 1) (1 3) (2 &body)))))
(cl-indent 'define-condition '((1 6)
			       (2 6 ((&whole 1)))
			       (3 4 ((&whole 1)))
	                       (4 &body)))
(cl-indent 'restart-bind '(((&whole 2 (0 1) (&whole 1))) (2 &body)))
(cl-indent 'restart-case '((1 4) (&whole 2 ((0 1) (&whole 1)))))
(cl-indent 'with-condition-restarts '((1 4 ((&whole 1))) (2 &body)))
(cl-indent 'with-simple-restart '((1 4 ((&whole 1))) (2 &body)))


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;                        Utility Function                          ;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defun my-url-encode-string (str &optional coding)
  (apply (function concat)
	 (mapcar
	  (lambda (ch)
	    (cond
	     ((eq ch ?\n)				; newline
	      "%0D%0A")
	     ((string-match "[-a-zA-Z0-9_:/]" (char-to-string ch)) ; xxx?
	      (char-to-string ch))		; printable
	     ((char-equal ch ?\x20)		; space
	      "+")
	     (t
	      (format "%%%02X" ch))))	; escape
	  ;; Coerce a string to a list of chars.
	  (append (encode-coding-string (or str "") (or coding 'iso-2022-jp))
		  nil))))

(when (file-exists-p (concat *site-lisp* "misc/newsflash.el"))
  (require 'newsflash))

;; (require 'messenger "~/program/msn/messenger.el")
;; (add-hook 'msn-switchboard-message-hook
;; 	  (lambda ()
;; 	    (let ((visible-bell nil))
;; 	      (beep))))
;; (add-hook 'msn-connect-hook
;; 	  (lambda ()
;; 	    (setcdr (assoc 'mail *msn-user-account*) nil)))

(when (file-exists-p "~/program/msn/current.el")
  (require 'messenger "~/program/msn/current.el")
  (add-hook 'msn-background-message-notify-hook
	    (lambda ()
	      (message "メッセージ着信!!"))))