2011年8月5日金曜日

最近のdot.emacs


このエントリーをはてなブックマークに追加


こんな感じに落ち着いてる。


; -*- Mode: Emacs-Lisp ; Coding: utf-8 -*-

;; ---------------------------------------------------
;; 追加load-path
;; ---------------------------------------------------
(add-to-list 'load-path "~/.emacs.d/site-lisp/")
(add-to-list 'load-path "~/.emacs.d/site-lisp/anything")
(add-to-list 'load-path "~/.emacs.d/site-lisp/themes")
(add-to-list 'load-path "~/.emacs.d/site-lisp/sdic")
(add-to-list 'load-path "~/.emacs.d/site-lisp/w3m")
(add-to-list 'load-path "~/.emacs.d/site-lisp/slime-2011-06-09")
(add-to-list 'load-path "~/.emacs.d/site-lisp/slime-2011-06-09/contrib")
(add-to-list 'load-path "~/.emacs.d/site-lisp/navi2ch")
(add-to-list 'load-path "~/.emacs.d/site-lisp/navi2ch/contrib")
(add-to-list 'load-path "~/.emacs.d/site-lisp/twittering-mode-2.0.0")
(add-to-list 'load-path "~/.emacs.d/site-lisp/apel")
(add-to-list 'load-path "~/.emacs.d/site-lisp/emu")
(add-to-list 'load-path "~/.emacs.d/site-lisp/flim")
(add-to-list 'load-path "~/.emacs.d/site-lisp/semi")
(add-to-list 'load-path "~/.emacs.d/site-lisp/wl")
(add-to-list 'load-path "~/.emacs.d/site-lisp/ejacs-11-27-08")



;; ---------------------------------------------------
;; 環境依存パス
;; ---------------------------------------------------
(defvar *hyper-spec-dir* "file:///cygdrive/c/export/home/.emacs.d/HyperSpec/")
(defvar *ctl2-dir*       "file:///cygdrive/c/export/home/.emacs.d/cltl/")
(defvar *chrome-path*    "C:/Users/win7-u24/AppData/Local/Google/Chrome/Application/chrome.exe")



;; ---------------------------------------------------
;; 起動時間を測定
;; ---------------------------------------------------
(defun my-time-lag ()
  (let* ((now (current-time))
         (min (- (car now) (car my-time-zero)))
         (sec (- (car (cdr now)) (car (cdr my-time-zero))))
         (msec (/ (- (car (cdr (cdr now)))
       (car (cdr (cdr my-time-zero))))
    1000))
         (lag (+ (* 60000 min) (* 1000 sec) msec)))
    (message "'.emacs.el' loading time: %d msec." lag)))
(setq my-time-zero (current-time)) 



;; ---------------------------------------------------
;; フォント設定
;; ---------------------------------------------------

;;(set-default-font "MS ゴシック-10")
;;(set-default-font "Osaka-等幅-10")
;;(set-default-font "VL Gothic Regular-10")

;; デフォルトフォントの設定
(set-face-attribute 'default nil
                    ;; :family "inconsolata"
                    :family "MS ゴシック"
                    :height 100)

;; 日本語フォントの指定(指定しない場合はデフォルトが使われる)
(set-fontset-font "fontset-default"
                  'japanese-jisx0208
                  '("MS ゴシック*" . "jisx0208.*"))

(set-fontset-font "fontset-default"
                  'katakana-jisx0201
                  '("MS ゴシック*" . "jisx0201.*"))

;; 文字飾りを有効にする
(setq w32-enable-synthesized-fonts t)

;; フォントの大きさを調整する
(add-to-list 'face-font-rescale-alist
             `(,(encode-coding-string ".*MS.*bold.*iso8859.*" 'emacs-mule) . 0.9))

(add-to-list 'face-font-rescale-alist
             `(,(encode-coding-string ".*MS.*bold.*jisx02.*" 'emacs-mule) . 0.95))

;; 行間を指定
(setq-default line-spacing 0.2)



;; ---------------------------------------------------
;; 日本語設定
;; ---------------------------------------------------

;; デフォルト言語を日本語に
(set-language-environment "Japanese")

;; 日本語入力のための設定
(set-keyboard-coding-system 'cp932)

;; デフォルト文字コードと、改行コードの設定
(set-default-coding-systems 'utf-8-unix)
;;(set-default-coding-systems 'japanese-cp932-dos)

;; ファイル名をSJISで取り扱う
(setq default-file-name-coding-system 'japanese-cp932-dos)

;; プロセス起動時の文字コード
(setq default-process-coding-system '(cp932 . cp932))


;; 詳細に文字コードを設定する場合
;;(prefer-coding-system 'utf-8-unix)
;;(prefer-coding-system 'utf-8-dos)
;;(set-keyboard-coding-system 'sjis)
;;(set-terminal-coding-system 'sjis)
;;(set-buffer-file-coding-system 'sjis)
;;(set-clipboard-coding-system 'sjis-dos)
;;(set-w32-system-coding-system 'sjis-dos)
;;(setq coding-category-raw-text 'sjis)

;;(setq default-mime-charset-for-write 'ISO-2022-JP)
;;(setq default-mime-charset 'ISO-2022-JP)



;; ---------------------------------------------------
;; 機種依存文字設定
;; ---------------------------------------------------

;; 機種依存文字
(require 'cp5022x)
(define-coding-system-alias 'euc-jp 'cp51932)

;; decode-translation-table の設定
(coding-system-put 'euc-jp :decode-translation-table
     (get 'japanese-ucs-jis-to-cp932-map 'translation-table))
(coding-system-put 'iso-2022-jp :decode-translation-table
     (get 'japanese-ucs-jis-to-cp932-map 'translation-table))
(coding-system-put 'utf-8 :decode-translation-table
     (get 'japanese-ucs-jis-to-cp932-map 'translation-table))

;; encode-translation-table の設定
(coding-system-put 'euc-jp :encode-translation-table
     (get 'japanese-ucs-cp932-to-jis-map 'translation-table))
(coding-system-put 'iso-2022-jp :encode-translation-table
     (get 'japanese-ucs-cp932-to-jis-map 'translation-table))
(coding-system-put 'cp932 :encode-translation-table
     (get 'japanese-ucs-jis-to-cp932-map 'translation-table))
(coding-system-put 'utf-8 :encode-translation-table
     (get 'japanese-ucs-jis-to-cp932-map 'translation-table))

;; charset と coding-system の優先度設定
(set-charset-priority 'ascii 'japanese-jisx0208 'latin-jisx0201
        'katakana-jisx0201 'iso-8859-1 'cp1252 'unicode)
(set-coding-system-priority 'utf-8 'euc-jp 'iso-2022-jp 'cp932)

;; PuTTY 用の terminal-coding-system の設定
(apply 'define-coding-system 'utf-8-for-putty
       "UTF-8 (translate jis to cp932)"
       :encode-translation-table 
       (get 'japanese-ucs-jis-to-cp932-map 'translation-table)
       (coding-system-plist 'utf-8))
(set-terminal-coding-system 'utf-8-for-putty)

;; East Asian Ambiguous
(defun set-east-asian-ambiguous-width (width)
  (while (char-table-parent char-width-table)
    (setq char-width-table (char-table-parent char-width-table)))
  (let ((table (make-char-table nil)))
    (dolist (range 
      '(#x00A1 #x00A4 (#x00A7 . #x00A8) #x00AA (#x00AD . #x00AE)
        (#x00B0 . #x00B4) (#x00B6 . #x00BA) (#x00BC . #x00BF)
        #x00C6 #x00D0 (#x00D7 . #x00D8) (#x00DE . #x00E1) #x00E6
        (#x00E8 . #x00EA) (#x00EC . #x00ED) #x00F0 
        (#x00F2 . #x00F3) (#x00F7 . #x00FA) #x00FC #x00FE
        #x0101 #x0111 #x0113 #x011B (#x0126 . #x0127) #x012B
        (#x0131 . #x0133) #x0138 (#x013F . #x0142) #x0144
        (#x0148 . #x014B) #x014D (#x0152 . #x0153)
        (#x0166 . #x0167) #x016B #x01CE #x01D0 #x01D2 #x01D4
        #x01D6 #x01D8 #x01DA #x01DC #x0251 #x0261 #x02C4 #x02C7
        (#x02C9 . #x02CB) #x02CD #x02D0 (#x02D8 . #x02DB) #x02DD
        #x02DF (#x0300 . #x036F) (#x0391 . #x03A9)
        (#x03B1 . #x03C1) (#x03C3 . #x03C9) #x0401 
        (#x0410 . #x044F) #x0451 #x2010 (#x2013 . #x2016)
        (#x2018 . #x2019) (#x201C . #x201D) (#x2020 . #x2022)
        (#x2024 . #x2027) #x2030 (#x2032 . #x2033) #x2035 #x203B
        #x203E #x2074 #x207F (#x2081 . #x2084) #x20AC #x2103
        #x2105 #x2109 #x2113 #x2116 (#x2121 . #x2122) #x2126
        #x212B (#x2153 . #x2154) (#x215B . #x215E) 
        (#x2160 . #x216B) (#x2170 . #x2179) (#x2190 . #x2199)
        (#x21B8 . #x21B9) #x21D2 #x21D4 #x21E7 #x2200
        (#x2202 . #x2203) (#x2207 . #x2208) #x220B #x220F #x2211
        #x2215 #x221A (#x221D . #x2220) #x2223 #x2225
        (#x2227 . #x222C) #x222E (#x2234 . #x2237)
        (#x223C . #x223D) #x2248 #x224C #x2252 (#x2260 . #x2261)
        (#x2264 . #x2267) (#x226A . #x226B) (#x226E . #x226F)
        (#x2282 . #x2283) (#x2286 . #x2287) #x2295 #x2299 #x22A5
        #x22BF #x2312 (#x2460 . #x24E9) (#x24EB . #x254B)
        (#x2550 . #x2573) (#x2580 . #x258F) (#x2592 . #x2595) 
        (#x25A0 . #x25A1) (#x25A3 . #x25A9) (#x25B2 . #x25B3)
        (#x25B6 . #x25B7) (#x25BC . #x25BD) (#x25C0 . #x25C1)
        (#x25C6 . #x25C8) #x25CB (#x25CE . #x25D1) 
        (#x25E2 . #x25E5) #x25EF (#x2605 . #x2606) #x2609
        (#x260E . #x260F) (#x2614 . #x2615) #x261C #x261E #x2640
        #x2642 (#x2660 . #x2661) (#x2663 . #x2665) 
        (#x2667 . #x266A) (#x266C . #x266D) #x266F #x273D
        (#x2776 . #x277F) (#xE000 . #xF8FF) (#xFE00 . #xFE0F) 
        #xFFFD
        ))
      (set-char-table-range table range width))
    (optimize-char-table table)
    (set-char-table-parent table char-width-table)
    (setq char-width-table table)))
(set-east-asian-ambiguous-width 2)

;; emacs-w3m
(eval-after-load "w3m"
  '(when (coding-system-p 'cp51932)
     (add-to-list 'w3m-compatible-encoding-alist '(euc-jp . cp51932))))

;; Gnus
(eval-after-load "mm-util"
  '(when (coding-system-p 'cp50220)
     (add-to-list 'mm-charset-override-alist '(iso-2022-jp . cp50220))))

;; SEMI (cf. http://d.hatena.ne.jp/kiwanami/20091103/1257243524)
(eval-after-load "mcs-20"
  '(when (coding-system-p 'cp50220)
     (add-to-list 'mime-charset-coding-system-alist 
    '(iso-2022-jp . cp50220))))

;; 全角チルダ/波ダッシュをWindowsスタイルにする
(let ((table (make-translation-table-from-alist '((#x301c . #xff5e))) ))
  (mapc
   (lambda (coding-system)
     (coding-system-put coding-system :decode-translation-table table)
     (coding-system-put coding-system :encode-translation-table table)
     )
   '(utf-8 cp932 utf-16le)))


;; 区切り文字に全角スペースや、・を含める
(setq paragraph-start '"^\\([  ・○<\t\n\f]\\|(?[0-9a-zA-Z]+)\\)")



;; ---------------------------------------------------
;; 日本語入力設定
;; ---------------------------------------------------

;; 標準IMEの設定
(setq default-input-method "W32-IME")

;; IME状態のモードライン表示
(setq-default w32-ime-mode-line-state-indicator "[Aa]")
(setq w32-ime-mode-line-state-indicator-list '("[Aa]" "[あ]" "[Aa]"))

;; IMEの初期化
(w32-ime-initialize)

;; IME OFF時の初期カーソルカラー
(set-cursor-color "red")

;; IME ON/OFF時のカーソルカラー
(add-hook 'input-method-activate-hook
   (lambda() (set-cursor-color "green")))
(add-hook 'input-method-inactivate-hook
   (lambda() (set-cursor-color "red")))

;; バッファ切り替え時にIME状態を引き継ぐ
(setq w32-ime-buffer-switch-p t)


;; isearch した時にミニバッファに日本語表示
(defun w32-isearch-update ()
  (interactive)
  (isearch-update))
(define-key isearch-mode-map [compend] 'w32-isearch-update)
(define-key isearch-mode-map [kanji] 'isearch-toggle-input-method)

(add-hook 'isearch-mode-hook
          (lambda () (setq w32-ime-composition-window (minibuffer-window))))
(add-hook 'isearch-mode-end-hook
          (lambda () (setq w32-ime-composition-window nil)))

;;   ;; ---------------------------------------------------
;;   ;; IIIMECF
;;   ;;   Solaris10のATOKへ接続する場合
;;   ;; ---------------------------------------------------
;;   ; 接続先のIIIMFサーバを指定する
;;   (setq iiimcf-server-control-hostlist (list "tcp:192.168.1.30:9010"))
;;   
;;   ; 接続する時に送信するユーザ名を指定(デフォルトはシステムにログインしているユーザが使われる)
;;   (setq iiimcf-server-control-username "root@sol10-xvm")
;;   (setq iiimcf-server-control-default-language "ja")
;;   (setq iiimcf-server-control-default-input-method "atokx2")
;;   (setq default-input-method 'iiim-server-control)
;;   (require 'iiimcf-sc)
;;   
;;   ; Shift-Space で半角スペースを挿入
;;   (defun atok-insert-half-space ()
;;     (interactive) (insert " "))
;;   (define-key iiimcf-server-control-initial-state-keymap
;;     (kbd "S-SPC") 'atok-insert-half-space)



;; ---------------------------------------------------
;; 基本設定
;; ---------------------------------------------------

;; 初期ディレクトリを設定
(setq default-directory "~/")

;; 起動画面を消す
(setq inhibit-startup-message t)

;; スタートアップ時のエコー領域メッセージの非表示
;;(setq inhibit-startup-echo-area-message -1)

;; scratchバッファの初期メッセージを消す
(setq initial-scratch-message "")

;; メニューバー、ツールバー非表示
(tool-bar-mode nil)
(menu-bar-mode nil)

;; スクロールバーの表示
(scroll-bar-mode nil)

;; ヴィジブルベルを抑制
(setq visible-bell nil)

;; ビープ音を抑制
(setq ring-bell-function '(lambda ()))

;; yes/no を y/n へ簡略化
(fset 'yes-or-no-p 'y-or-n-p)

;; テンポラリディレクトリを指定
;;(setq temporary-file-directory "~/Temp")

;; ガベージコレクションの頻度
(setq gc-cons-threshold 10000)

;; ごみ箱を有効
(setq delete-by-moving-to-trash t)

;; delete-backward-char で複数の whitespace を消す。
(setq backward-delete-char-untabify-method 'hungry)

;; messagesバッファの行数を増やす
(setq message-log-max 512)

;; デフォルトブラウザをChromeへ
(setq browse-url-browser-function
      '(("."        . browse-url-generic)))
(setq browse-url-generic-program *chrome-path*)


;; ---------------------------------------------------
;; 汎用キーバインド
;; ---------------------------------------------------

;; C-hをバックスペースに

;; この設定だとisearchでC-hが利かなかったので変更
;;(global-set-key "\C-h" 'delete-backward-char)
;;(global-set-key "\C-h" 'backward-delete-char-untabify)
(keyboard-translate ?\C-h ?\C-?)
(global-set-key "\C-h" nil)


;; help-for-help を F1 キーに
(global-set-key [f1] 'help-for-help)

;; C-h に割り当てられている関数 help-command を C-x C-h に割り当てる
(define-key global-map "\C-x\C-h" 'help-command)

;; C-@ で日本語入力のON/OFF
(global-set-key "\C-@" 'toggle-input-method)



;; ---------------------------------------------------
;; リージョン操作
;; ---------------------------------------------------

;: リージョンをハイライト(暫定マークモード)
(setq-default transient-mark-mode t)

;: バッファ切り替え時にリージョンを保持
(setq highlight-nonselected-windows t)

;; yank した文字列を強調表示
(when (or window-system (eq emacs-major-version '21))
  (defadvice yank (after ys:highlight-string activate)
    (let ((ol (make-overlay (mark t) (point))))
      (overlay-put ol 'face 'highlight)
      (sit-for 0.5)
      (delete-overlay ol)))
  (defadvice yank-pop (after ys:highlight-string activate)
    (when (eq last-command 'yank)
      (let ((ol (make-overlay (mark t) (point))))
        (overlay-put ol 'face 'highlight)
        (sit-for 0.5)
        (delete-overlay ol)))))

;; 短形選択を強化
;; http://taiyaki.org/elisp/sense-region/src/sense-region.el
;; 外部からのコピペに影響するので無効にする
;;(require 'sense-region)
;;(sense-region-on)


;; 標準の短形操作をON
(cua-mode t)
(setq cua-enable-cua-keys nil)



;; ---------------------------------------------------
;; モードライン
;; ---------------------------------------------------

;; 行番号の表示
(line-number-mode t)

;; 列番号の表示
(column-number-mode t)

;; 日付、時刻の表示
(require 'time)
(setq display-time-24hr-format t)
(setq display-time-string-forms
      '( year  "/" month "/" day "(" dayname ") " 24-hours ":" minutes))
(display-time-mode t)


;; cp932エンコード時の表示を「P」とする
(coding-system-put 'cp932 :mnemonic ?P)
(coding-system-put 'cp932-dos :mnemonic ?P)
(coding-system-put 'cp932-unix :mnemonic ?P)
(coding-system-put 'cp932-mac :mnemonic ?P)



;; ---------------------------------------------------
;; カーソル
;; ---------------------------------------------------

;; カーソル点滅表示
(blink-cursor-mode 0)

;; スクロール時のカーソル位置の維持
(setq scroll-preserve-screen-position t)

;; カーソル行にアンダーラインを引く
(setq hl-line-face 'underline)
(global-hl-line-mode)

;; 対応するカッコを強調表示
(show-paren-mode t)

;; スクロール行数(一行ごとのスクロール)
(setq vertical-centering-font-regexp ".*")
(setq scroll-conservatively 35)
(setq scroll-margin 0)
(setq scroll-step 1)

;; 画面スクロール時の重複行数
(setq next-screen-context-lines 1)

;; キー入力中にマウスポインタを右上隅へ移動
;; banish
;;   キー操作によって右上隅に移動(デフォルト)
;; exile
;;   カーソルが近付いたときだけ右上隅に移動、その後復帰
;; jump
;;   カーソルが近付くとランダムに移動
(mouse-avoidance-mode 'banish)



;; ---------------------------------------------------
;; バッファ表示
;; ---------------------------------------------------

;; タブ幅を変更
(setq-default tab-width 4)

;; インデントをスペースに統一
(setq indent-tabs-mode nil)

;; フレームタイトルの設定
(setq frame-title-format "%b")

;; バッファ一覧を使い易く
(global-set-key "\C-x\C-b" 'buffer-menu)

;; バッファ中の行番号表示
(global-linum-mode t)

;; 行番号のフォーマット
(set-face-attribute 'linum nil :foreground "gray" :height 0.8)
(setq linum-format "%4d")

;; C-x C-f での意味の無いパス表示をグレーアウトする
(file-name-shadow-mode t)

;; 自動分割が行われるポリシーを決定
(setq split-height-threshold t)   ; 上下分割を許可
(setq split-width-threshold nil)  ; 左右分割を拒否

;; 一時バッファのサイズを表示量に応じて調整
;; (temp-buffer-resize-mode t)

;; バッファ画面外文字の切り詰め表示
(setq truncate-lines nil)

;; ウィンドウ縦分割時のバッファ画面外文字の切り詰め表示
(setq truncate-partial-width-windows nil)

;; 同一バッファ名にディレクトリ付与
(require 'uniquify)
(setq uniquify-buffer-name-style 'forward)
(setq uniquify-buffer-name-style 'post-forward-angle-brackets)
(setq uniquify-ignore-buffers-re "*[^*]+*")


;; タブ, 全角スペースを表示する
;;(defface my-face-r-1 '((t (:background "gray15"))) nil)
(defface my-face-b-1 '((t (:background "gray"))) nil)
(defface my-face-b-2 '((t (:background "gray26"))) nil)
(defface my-face-u-1 '((t (:foreground "SteelBlue" :underline t))) nil)
(defvar my-face-r-1 'my-face-r-1)
(defvar my-face-b-1 'my-face-b-1)
(defvar my-face-b-2 'my-face-b-2)
(defvar my-face-u-1 'my-face-u-1)

(defadvice font-lock-mode (before my-font-lock-mode ())
  (font-lock-add-keywords
   major-mode
   '(("\t" 0 my-face-b-2 append)
     (" " 0 my-face-b-1 append)
     ("[ \t]+$" 0 my-face-u-1 append)
;;     ("[\r]*\n" 0 my-face-r-1 append)
     )))
(ad-enable-advice 'font-lock-mode 'before 'my-font-lock-mode)
(ad-activate 'font-lock-mode)



;; ---------------------------------------------------
;; バッファ操作
;; ---------------------------------------------------

;; C-c b 時のバッファ切り替えにインクリメンタルサーチを使う
(iswitchb-mode 1)

;; C-c b 時にお手軽バッファ切替
(add-hook 'iswitchb-define-mode-map-hook
    (lambda ()
   (define-key iswitchb-mode-map "\C-n" 'iswitchb-next-match)
   (define-key iswitchb-mode-map "\C-p" 'iswitchb-prev-match)
   (define-key iswitchb-mode-map "\C-f" 'iswitchb-next-match)
   (define-key iswitchb-mode-map "\C-b" 'iswitchb-prev-match)))

;; 画面分割時にShift + 矢印キー でウインドを移動
(windmove-default-keybindings)
(setq windmove-wrap-around t)

;; 補完候補が表示された時に、入力完了後に候補バッファを自動的に閉じる
(require 'lcomp)
(lcomp-install)



;; ---------------------------------------------------
;; 入力支援
;; ---------------------------------------------------

;; C-oでの入力補完を日本語でも有効にする
;; http://namazu.org/~tsuchiya/elisp/dabbrev-ja.el
;; http://www.namazu.org/~tsuchiya/elisp/dabbrev-highlight.el
(load "dabbrev-ja")
(require 'dabbrev-highlight)

;; C-o で dabbrev-expand
(global-set-key "\C-o" 'dabbrev-expand)

;; M-x にインクリメンタルサーチを付ける
;; http://homepage1.nifty.com/bmonkey/emacs/elisp/mcomplete.el
(require 'mcomplete)
(turn-on-mcomplete-mode)

;; yank を履歴から選択できるように
;; http://www.emacswiki.org/emacs/BrowseKillRing
(require 'browse-kill-ring)
(global-set-key "\M-y" 'browse-kill-ring)

;; kill-ring を一行で表示
(setq browse-kill-ring-display-style 'one-line)

;; browse-kill-ring 終了時にバッファを kill する
(setq browse-kill-ring-quit-action 'kill-and-delete-window)

;; 必要に応じて browse-kill-ring のウィンドウの大きさを変更する
(setq browse-kill-ring-resize-window t)

;; kill-ring の内容を表示する際の区切りを指定する
(setq browse-kill-ring-separator "-------")

;; 現在選択中の kill-ring のハイライトする
(setq browse-kill-ring-highlight-current-entry t)

;; 区切り文字のフェイスを指定する
(setq browse-kill-ring-separator-face 'region)

;; 一覧で表示する文字数を指定する. nil ならすべて表示される.
(setq browse-kill-ring-maximum-display-length 100)

;; redoを有効にする。
(require 'redo+)
(global-set-key (kbd "M-/") 'redo)
(setq undo-limit 600000)
(setq undo-strong-limit 900000)
(setq undo-no-redo t)



;; ---------------------------------------------------
;; 自動バックアップ設定
;; ---------------------------------------------------

;; バックアップファイルを一箇所にまとめる
(setq make-backup-files t)
(setq backup-directory-alist
      (cons (cons "\\.*$" (expand-file-name "~/.emacs.d/backup"))
   backup-directory-alist))

;; バックアップのバージョン管理を行う
(setq version-control t)

;; 新しいものをいくつ残すか
(setq kept-new-versions 5)

;; 古いものをいくつ残すか
(setq kept-old-versions 5)

;; 古いバージョンを消去するのに確認を求めない。
(setq delete-old-versions t)

;; 終了時にautosaveファイルを削除する
(setq delete-auto-save-files t)

;; 編集中ファイルのバックアップ間隔(秒)
(setq auto-save-timeout 30)

;; 編集中ファイルのバックアップ間隔(打鍵)
(setq auto-save-interval 500)



;; ---------------------------------------------------
;; 印刷設定
;;  GhostScriptが必要
;;  BoldFontが必要
;;     M-x ps-print-buffer 白黒印刷
;;     M-x ps-print-buffer-with-face カラー印刷
;; ---------------------------------------------------

(require 'cl)
(defun listsubdir (basedir)
  (remove-if (lambda (x) (not (file-directory-p x)))
             (directory-files basedir t "^[^.]")))

(setq bdf-directory-list
      (listsubdir "D:\emacs\font\intlfonts-1.2.1"))

(setq ps-print-color-p t
      ps-lpr-command "D:/emacs/gs/gs8.71/bin/gswin32c.exe"
      ps-multibyte-buffer 'non-latin-printer
      ps-lpr-switches '("-sDEVICE=mswinpr2" "-dNOPAUSE" "-dBATCH" "-dWINKANJI")
      printer-name nil
      ps-printer-name nil
      ps-printer-name-option nil
      ps-print-header nil            ; ヘッダを表示しない
      )



;; ---------------------------------------------------
;; スタイルの設定
;; ---------------------------------------------------

;; http://code.google.com/p/gnuemacscolorthemetest/downloads/list
;; からファイルを取ってきて、site-lispに coloer-theme.el と themesフォルダを入れる
(require 'color-theme)

;; (color-theme-initialize)
(setq color-theme-load-all-themes nil)
 
(require 'color-theme-tangotango)
 
;; select theme - first list element is for windowing system, second is for console/terminal
;; Source : http://www.emacswiki.org/emacs/ColorTheme#toc9
(setq color-theme-choices 
      '(color-theme-tangotango color-theme-tangotango))
 
;; default-start
(funcall (lambda (cols)
    (let ((color-theme-is-global nil))
      (eval 
       (append '(if (window-system))
        (mapcar (lambda (x) (cons x nil)) 
         cols)))))
  color-theme-choices)
 
;; test for each additional frame or console
(require 'cl)
(fset 'test-win-sys 
      (funcall (lambda (cols)
   (lexical-let ((cols cols))
     (lambda (frame)
       (let ((color-theme-is-global nil))
         ;; must be current for local ctheme
         (select-frame frame)
         ;; test winsystem
         (eval 
   (append '(if (window-system frame)) 
    (mapcar (lambda (x) (cons x nil)) 
     cols)))))))
        color-theme-choices ))
;; hook on after-make-frame-functions
(add-hook 'after-make-frame-functions 'test-win-sys)
 
(color-theme-tangotango)

;; テーマを指定
;;(color-theme-subtle-hacker)
;;(color-theme-railscasts)
;;(color-theme-irblack)


;; 初期のウインドウサイズの設定
(setq initial-frame-alist
      (append
       '((top    . 0)                 ; フレームの縦位置(ドット数)
  (left   . 800)              ; フレームの横位置(ドット数)
  (width  . 145)               ; フレーム幅(文字数)
  (height . 89)                ; フレーム高(文字数)
  (alpha . (nil nil nil nil))) ; フレームの透明度 透過率を指定 nilで0%
       initial-frame-alist))



;; ---------------------------------------------------
;; ウィンドウのサイズを変更する
;; ---------------------------------------------------
(defun my-window-resizer ()
  "Control window size and position."
  (interactive)
  (let ((window-obj (selected-window))
        (current-width (window-width))
        (current-height (window-height))
        (dx (if (= (nth 0 (window-edges)) 0) 1
              -1))
        (dy (if (= (nth 1 (window-edges)) 0) 1
              -1))
        action c)
    (catch 'end-flag
      (while t
        (setq action
              (read-key-sequence-vector (format "Resize window [%dx%d] ←:h ↓:j ↑:k →:l"
                                                (window-width)
                                                (window-height))))
        (setq c (aref action 0))
        (cond ((= c ?l)
               (enlarge-window-horizontally dx))
              ((= c ?h)
               (shrink-window-horizontally dx))
              ((= c ?j)
               (enlarge-window dy))
              ((= c ?k)
               (shrink-window dy))
              ;; otherwise
              (t
               (let ((last-command-char (aref action 0))
                     (command (key-binding action)))
                 (when command
                   (call-interactively command)))
               (message "Quit")
               (throw 'end-flag t)))))))

(global-set-key "\C-cR" 'my-window-resizer)



;; ---------------------------------------------------
;; *scratch* バッファをkillさせない。
;; ---------------------------------------------------
(defun my-make-scratch (&optional arg)
  (interactive)
  (progn
    ;; "*scratch*" を作成して buffer-list に放り込む
    (set-buffer (get-buffer-create "*scratch*"))
    (funcall initial-major-mode)
    (erase-buffer)
    (when (and initial-scratch-message (not inhibit-startup-message))
      (insert initial-scratch-message))
    (or arg (progn (setq arg 0)
                   (switch-to-buffer "*scratch*")))
    (cond ((= arg 0) (message "*scratch* is cleared up."))
          ((= arg 1) (message "another *scratch* is created")))))

(add-hook 'kill-buffer-query-functions
          ;; *scratch* バッファで kill-buffer したら内容を消去するだけにする
          (lambda ()
            (if (string= "*scratch*" (buffer-name))
                (progn (my-make-scratch 0) nil)
              t)))

(add-hook 'after-save-hook
          ;; *scratch* バッファの内容を保存したら *scratch* バッファを新しく作る
          (lambda ()
            (unless (member (get-buffer "*scratch*") (buffer-list))
              (my-make-scratch 1))))



;; ---------------------------------------------------
;; windows.el
;; http://www.gentei.org/~yuuji/software/
;; ---------------------------------------------------
;; C-z C-w n    前後のウィンドウへ移動
;; C-z C-w p    前後のウィンドウへ移動
;; C-z !        現在のウィンドウを破棄
;; C-z C-w C-w  メニューの表示
;; C-z =        ウィンドウ一覧

;; キーバインドを変更.
;; デフォルトは C-c C-w
(setq win:switch-prefix "\C-z")
(define-key global-map win:switch-prefix nil)
(define-key global-map "\C-z1" 'win-switch-to-window)
(require 'windows)

;; 新規にフレームを作らない
(setq win:use-frame nil)
(win:startup-with-window)
(define-key ctl-x-map "C" 'see-you-again)

;; 短縮入力を無効
(setq win:quick-selection nil)



;; ---------------------------------------------------
;; anything
;; http://www.emacswiki.org/cgi-bin/wiki/download/anything.el
;; http://www.emacswiki.org/cgi-bin/wiki/download/anything-config.el
;; ---------------------------------------------------
(require 'anything)
(require 'anything-config)

(define-key global-map (kbd "M-]") 'anything)
(define-key anything-map (kbd "C-p") 'anything-previous-line)
(define-key anything-map (kbd "C-n") 'anything-next-line)
(define-key anything-map (kbd "C-v") 'anything-next-page)
(define-key anything-map (kbd "M-v") 'anything-previous-page)

(setq anything-sources
      (list anything-c-source-buffers              ;; バッファの一覧
     anything-c-source-bookmarks            ;; ブックマーク
     anything-c-source-file-name-history    ;; ファイルの履歴
     anything-c-source-files-in-current-dir ;; カレントディレクトリのファイル
     anything-c-source-recentf              ;; 最近開いたファイル
     anything-c-source-man-pages            ;; woman
     anything-c-source-info-pages           ;; info
     anything-c-source-calculation-result   ;; calc-eval の履歴
     anything-c-source-emacs-commands       ;; Emacsコマンド
     ;;anything-c-source-locate               ;; コマンドパス
     ))



;; ---------------------------------------------------
;; zlc
;; ファイルの補完リストから選択できるようにする
;; http://github.com/mooz/emacs-zlc/raw/master/zlc.el
;; ---------------------------------------------------
(require 'zlc)

;; 候補一覧を表示する際に、最初の項目を選択状態にする
;(setq zlc-select-completion-immediately t)

(let ((map minibuffer-local-map))
  ;; like menu select
  ;;(define-key map (kbd "<down>")  'zlc-select-next-vertical)
  ;;(define-key map (kbd "<up>")    'zlc-select-previous-vertical)
  ;;(define-key map (kbd "<right>") 'zlc-select-next)
  ;;(define-key map (kbd "<left>")  'zlc-select-previous)

  (define-key map (kbd "C-n")  'zlc-select-next-vertical)
  (define-key map (kbd "C-p")  'zlc-select-previous-vertical)
  (define-key map (kbd "C-f")  'zlc-select-next)
  (define-key map (kbd "C-b")  'zlc-select-previous)

  ;;; reset selection
  (define-key map (kbd "C-c") 'zlc-reset)
  )



;; ---------------------------------------------------
;; dired
;; ---------------------------------------------------

;; ファイルの一括操作
;; dired で r を押して編集開始。
;; C-x C-s で確定、C-c C-k で破棄
;; ESC l:ファイル名を小文字にする
;; ESC c:ファイル名の一文字を大文字にする
;; ESC u:ファイル名を大文字にする
(require 'wdired)
(define-key dired-mode-map "r" 'wdired-change-to-wdired-mode)

;; ディレクトリを先に表示する
(setq ls-lisp-dirs-first t)

;; 表示オプション
(setq dired-listing-switches "-AFlh")

(load "dired-x")

;; http://uenox.ld.infoseek.co.jp/elisp/uenox-dired.el
;;  Dired に以下の3つの機能が追加されます。(キーマップはこのファイルの
;;  最後の方を書き換えることで変更できます。)
;;   * C-j 
;;     現在の行のファイルをWindowsに関連付けられたアプリケーションを使っ
;;     て開きます。(わざわざエクスプローラーを開かなくて良くなります。)
;;   * w
;;     現在の行のファイル名をUNIX形式にてコピーします。
;;   * W
;;     現在の行のファイル名をDOS形式にてコピーします。
(load "uenox-dired")

;; スペースでマークする (FD like)
(define-key dired-mode-map " " 'dired-toggle-mark)
(defun dired-toggle-mark (arg)
  (interactive "P")
  (let ((dired-marker-char
         (if (save-excursion (beginning-of-line)
                             (looking-at " "))
             dired-marker-char ?\040)))
    (dired-mark arg)
    (dired-previous-line 1)))

;; 再帰的なコピー/削除を行う
(setq dired-recursive-copies 'always)
(setq dired-recursive-deletes 'always)

;; lisp のみで find-dired を実行する
;;   M-x find-dired-lisp
;;   M-x find-grep-dired-lisp
(autoload 'find-dired-lisp      "find-dired-lisp" "findr" t nil)
(autoload 'find-grep-dired-lisp "find-dired-lisp" "findr" t nil)

(define-key dired-mode-map "\C-c\C-s" 'find-dired-lisp)
(define-key dired-mode-map "\C-c\M-s" 'find-grep-dired-lisp)


;; マークつきのファイルを印刷(白黒)
(defun dired-ps-print-files ()
  (interactive)
  (let ((files-to-print (dired-get-marked-files)))
    (while (setq file (car files-to-print))
      (setq files-to-print (cdr files-to-print))
      (find-file file)
      (ps-print-buffer)
      (kill-buffer nil))))

;; マークつきのファイルを印刷(カラー)
(defun dired-ps-print-files-with-face ()
  (interactive)
  (let ((files-to-print (dired-get-marked-files)))
    (while (setq file (car files-to-print))
      (setq files-to-print (cdr files-to-print))
      (find-file file)
      (ps-print-buffer-with-faces)
      (kill-buffer nil))))

;; フォルダ移動時にバッファを生成しない
(defun dired-my-advertised-find-file ()
  (interactive)
  (let ((kill-target (current-buffer))
        (check-file (dired-get-filename)))
    (funcall 'dired-advertised-find-file)
    (if (file-directory-p check-file)
        (kill-buffer kill-target))))

(defun dired-my-up-directory (&optional other-window)
  "Run dired on parent directory of current directory.
Find the parent directory either in this buffer or another buffer.
Creates a buffer if necessary."
  (interactive "P")
  (let* ((dir (dired-current-directory))
         (up (file-name-directory (directory-file-name dir))))
    (or (dired-goto-file (directory-file-name dir))
        ;; Only try dired-goto-subdir if buffer has more than one dir.
        (and (cdr dired-subdir-alist)
             (dired-goto-subdir up))
        (progn
          (if other-window
              (dired-other-window up)
            (progn
              (kill-buffer (current-buffer))
              (dired up))
          (dired-goto-file dir))))))

(define-key dired-mode-map "\C-m" 'dired-my-advertised-find-file)
(define-key dired-mode-map "^" 'dired-my-up-directory)

;; w キーでw3mを呼び出す
(add-hook 'dired-mode-hook
          (lambda ()
            (define-key dired-mode-map "w" 'dired-w3m-find-file)))
(defun dired-w3m-find-file ()
  (interactive)
  (require 'w3m)
  (let ((file (dired-get-filename)))
    (w3m-find-file file)))



;; ---------------------------------------------------
;; eshell
;; ---------------------------------------------------

;; C-c d でカレントバッファのディレクトリへ移動しeshellを起動
(defun eshell-cd-default-directory ()
  (interactive)
  (let ((dir default-directory))
    (eshell)
    (cd dir)
    (eshell-interactive-print (concat "cd " dir "\n"))
    (eshell-emit-prompt)))

(global-set-key "\C-cd" 'eshell-cd-default-directory)

;; less を実装
;; written by Stefan Reichoer <reichoer@web.de>
(defun eshell/less (&rest args)
 "Invoke `view-file' on the file.
\"less +42 foo\" also goes to line 42 in the buffer."
 (while args
   (if (string-match "\\`\\+\\([0-9]+\\)\\'" (car args))
       (let* ((line (string-to-number (match-string 1 (pop args))))
              (file (pop args)))
         (view-file file)
         (goto-line line))
     (view-file (pop args)))))

;; lsで表示したファイルを直接選択できるようにする
;;; From: http://www.emacswiki.org/cgi-bin/wiki.pl/EshellEnhancedLS
(eval-after-load "em-ls"
  '(progn
     ;; (defun ted-eshell-ls-find-file-at-point (point)
     ;;          "RET on Eshell's `ls' output to open files."
     ;;          (interactive "d")
     ;;          (find-file (buffer-substring-no-properties
     ;;                      (previous-single-property-change point 'help-echo)
     ;;                      (next-single-property-change point 'help-echo))))
     (defun pat-eshell-ls-find-file-at-mouse-click (event)
       "Middle click on Eshell's `ls' output to open files.
 From Patrick Anderson via the wiki."
       (interactive "e")
       (ted-eshell-ls-find-file-at-point (posn-point (event-end event))))
     (defun ted-eshell-ls-find-file ()
       (interactive)
       (let ((fname (buffer-substring-no-properties
                     (previous-single-property-change (point) 'help-echo)
                     (next-single-property-change (point) 'help-echo))))
         ;; Remove any leading whitespace, including newline that might
         ;; be fetched by buffer-substring-no-properties
         (setq fname (replace-regexp-in-string "^[ \t\n]*" "" fname))
         ;; Same for trailing whitespace and newline
         (setq fname (replace-regexp-in-string "[ \t\n]*$" "" fname))
         (cond
          ((equal "" fname)
           (message "No file name found at point"))
          (fname
           (find-file fname)))))
     (let ((map (make-sparse-keymap)))
       ;;          (define-key map (kbd "RET")      'ted-eshell-ls-find-file-at-point)
       ;;          (define-key map (kbd "<return>") 'ted-eshell-ls-find-file-at-point)
       (define-key map (kbd "RET")      'ted-eshell-ls-find-file)
       (define-key map (kbd "<return>") 'ted-eshell-ls-find-file)
       (define-key map (kbd "<mouse-2>") 'pat-eshell-ls-find-file-at-mouse-click)
       (defvar ted-eshell-ls-keymap map))
     (defadvice eshell-ls-decorated-name (after ted-electrify-ls activate)
       "Eshell's `ls' now lets you click or RET on file names to open them."
       (add-text-properties 0 (length ad-return-value)
                            (list 'help-echo "RET, mouse-2: visit this file"
                                  'mouse-face 'highlight
                                  'keymap ted-eshell-ls-keymap)
                            ad-return-value)
       ad-return-value)))



;; ---------------------------------------------------
;; woman
;;  Linux-JP のman page を使う
;; ---------------------------------------------------
(setq woman-cache-filename "~/.emacs.d/.wmncach.el")
(setq woman-manpath '("~/.emacs.d/man.ja_JP.cp932"))



;; ---------------------------------------------------
;; sdic
;; ---------------------------------------------------
(autoload 'sdic-describe-word "sdic" "英単語の意味を調べる" t nil)
(global-set-key "\C-cw" 'sdic-describe-word)
(autoload 'sdic-describe-word-at-point "sdic" "カーソルの位置の英単語の意味を調べる" t nil)
(global-set-key "\C-cW" 'sdic-describe-word-at-point)

;; mkary でインデックス化したファイルを検索
;; mkary はEUC-JPで記載されたファイルしかインデックス化できないので注意
;; 別途 suflary の mkary.exeが必要
(setq sdic-eiwa-dictionary-list '((sdicf-client "~/.emacs.d/dict/eijirou.sdic"   (strategy array))))
(setq sdic-waei-dictionary-list '((sdicf-client "~/.emacs.d/dict/waeijirou.sdic" (strategy array))))


;;(setq sdic-eiwa-dictionary-list
;;      '((sdicf-client "~/.emacs.d/dict/eijirou.sdic")))
;;(setq sdic-waei-dictionary-list
;;      '((sdicf-client "~/.emacs.d/dict/waeijirou.sdic")))

;; 検索時の文字をEUC-JPに
(setq sdic-default-coding-system 'euc-japan-unix)



;; ---------------------------------------------------
;; org-mode
;; ---------------------------------------------------
(require 'org-install)
(setq org-startup-truncated nil)
(setq org-return-follows-link t)
(add-to-list 'auto-mode-alist '("\\.org$" . org-mode))
(org-remember-insinuate)
(setq org-directory "~/org/")
(setq org-default-notes-file (concat org-directory "agenda.org"))

;; (setq org-remember-templates
;;       '(("Todo" ?t "\n** TODO %T [/] %?\n   %i\n   ---> %a\n" "~/org/todo.org"     "Notes")
;;         ("Memo" ?m "** TECH %?\n   %i\n   %a\n   %T"      "~/org/memo.org"     "Notes")
;;  ("Pass" ?p "** PASS %?\n   %i\n   %a\n   %T"      "~/org/password.org" "Notes")
;;         ))

(define-key global-map "\C-cl" 'org-store-link)
(define-key global-map "\C-ca" 'org-agenda)

(global-font-lock-mode t)
(add-hook 'org-mode-hook 'turn-on-font-lock)

(set-face-attribute 'org-level-1 nil :family "MS ゴシック" :height 100)
(set-face-attribute 'org-level-2 nil :family "MS ゴシック" :height 100)

;; (global-set-key "\C-c\C-r" 'org-remember)



;; ---------------------------------------------------
;; emacs-w3m
;;  ftp://ftp.jaist.ac.jp/pub/cygwin/release/w3m/w3m-0.5.1-2.tar.bz2
;;  http://emacs-w3m.namazu.org/index-ja.html
;; ---------------------------------------------------
(require 'w3m-load)

(setq w3m-icon-directory "~/.emacs.d/site-lisp/w3m/w3m-icons")

;; (setq w3m-async-exec t)
;; (setq w3m-command-arguments
;;       (nconc w3m-command-arguments
;;              '("-o" "http_proxy=http://adresss.or.ip.com")))



;;; ---------------------------------------------------
;;; auto-comp
;;; ---------------------------------------------------
(add-to-list 'load-path "~/.emacs.d/site-lisp/auto-complete")
(require 'auto-complete-config)
(add-to-list 'ac-dictionary-directories "~/.emacs.d/site-lisp/auto-complete/ac-dict")
(ac-config-default)



;; ---------------------------------------------------
;; SLIME
;; ---------------------------------------------------

;; デフォルト実行するCLを選択
;;(setq inferior-lisp-program "sbcl.exe --noinform")
;;(setq inferior-lisp-program "sbcl.exe --noinform --core c:/export/home/clisp/.sbcl.main.core")
;;(setq inferior-lisp-program "clisp.exe")
;;(setq inferior-lisp-program "wx86cl.exe")
;;(setq inferior-lisp-program "alisp.exe")
(setq inferior-lisp-program "wx86cl64.exe")

(setq slime-net-coding-system 'utf-8-unix)

;; slime 各種設定
(add-hook 'lisp-mode-hook (lambda ()
       (show-paren-mode t)
       (slime-mode t)))


;; slime キーバインドを設定
(add-hook 'slime-mode-hook
   '(lambda ()
   (setq indent-tabs-mode nil)
      (define-key slime-mode-map [(tab)]     'slime-indent-and-complete-symbol)
      (define-key slime-mode-map (kbd "C-i") 'lisp-indent-line)
      (define-key slime-mode-map "\C-cs"     'slime-selector)))

(add-hook 'slime-repl-mode-hook
   '(lambda ()
   (setq indent-tabs-mode nil)
      (define-key slime-repl-mode-map "\C-c\M-r" 'slime-restart-inferior-lisp)))


(require 'slime)
(slime-setup
 '(
   slime-repl
;;   inferior-slime
;;   slime-asdf
;;   slime-autodoc
   slime-banner
;;   slime-c-p-c
;;   slime-editing-commands
;;   slime-fancy-inspector
   slime-fancy
;;   slime-fuzzy
;;   slime-highlight-edits
;;   slime-parse
;;   slime-presentation-streams
;;   slime-presentations
;;   slime-references
;;   slime-scratch
;;   slime-tramp
;;   slime-typeout-frame
;;   slime-xref-browser
;;   slime-clipboard
;;   slime-compiler-notes-tree
;;   slime-enclosing-context
;;   slime-hyperdoc
;;   slime-fontifying-fu
;;   slime-indentation
;;   slime-mdot-fu
;;   slime-media
;;   slime-motd
;;   slime-package-fu
;;   slime-sbcl-exts
;;   slime-scheme
;;   slime-snapshot
;;   slime-sprof
   ))


;; slimeでauto-completeを使う
(require 'ac-slime)
(add-hook 'slime-mode-hook 'set-up-slime-ac)
(add-hook 'slime-repl-mode-hook 'set-up-slime-ac)
 
(define-globalized-minor-mode real-global-auto-complete-mode
  auto-complete-mode (lambda ()
      (if (not (minibufferp (current-buffer)))
      (auto-complete-mode 1))))
(real-global-auto-complete-mode t)


;; カーソル付近の単語の情報を表示
(slime-autodoc-mode)

;; 補完モードをfuzzyにする。
(setq slime-complete-symbol*-fancy    t)
(setq slime-complete-symbol-function 'slime-fuzzy-complete-symbol)

(setq slime-truncate-lines nil)
(setq slime-enable-evaluate-in-emacs t)

;; REPLの戻り値の色を変更する。
(set-face-attribute 'slime-repl-inputed-output-face nil :foreground "goldenrod")

;; C-c L で slimeを起動
(defun my-slime (&optional command coding-system)
  (interactive)
  (switch-to-buffer-other-window
   (get-buffer-create "*lisp*"))
  (slime command coding-system))
(global-set-key "\C-cL" 'my-slime)

;; slime-connectの簡易呼び出し
;;(defun slime-ccl ()
;;  (interactive)
;;  (slime-connect "localhost" 4011))


;; HyperSpecのパスを指定
;; ここで注意なのは、w3mにはcygwin形式のパスを渡す必要がある。
(require 'hyperspec)
(setq
 common-lisp-hyperspec-root *hyper-spec-dir*
 common-lisp-hyperspec-symbol-table (expand-file-name "~/.emacs.d/HyperSpec/Data/MapSym.txt"))

;; HyperSpecをemacs-w3mで起動
(defadvice common-lisp-hyperspec
  (around hyperspec-lookup-w3m () activate)
  (let* ((window-configuration (current-window-configuration))
         (browse-url-browser-function
          `(lambda (url new-window)
             (w3m-browse-url url nil)
             (let ((hs-map (copy-keymap w3m-mode-map)))
               (define-key hs-map (kbd "q")
                 (lambda ()
                   (interactive)
                   (kill-buffer nil)
                   (set-window-configuration ,window-configuration)))
               (use-local-map hs-map)))))
    ad-do-it))

;; cltl2 をw3mで見る
(require 'cltl2)

;;ここは各自の cltl2 の html を配置している場所を指定する
(setq cltl2-root-url *ctl2-dir*)

(defadvice cltl2-lookup (around cltl2-lookup-by-w3m () activate)
  (let* ((window-configuration (current-window-configuration))
         (browse-url-browser-function
          `(lambda (url new-window)
             (w3m-browse-url url nil)
             (let ((cltl2-map (copy-keymap w3m-mode-map)))
               (define-key cltl2-map (kbd "q")
                 (lambda ()
                   (interactive)
                   (kill-buffer nil)
                   (set-window-configuration ,window-configuration)))
               (use-local-map cltl2-map)))))
    ad-do-it))


;; Hyperspec と cltl2 を anything で引けるようにする
(eval-after-load "anything"
  '(progn
     (setq anything-c-source-hyperspec
           `((name . "Lookup Hyperspec")
             (candidates . (lambda ()
                             (let ((symbols nil))
                               (mapatoms #'(lambda (sym) (push (symbol-name sym) symbols))
                                         common-lisp-hyperspec-symbols)
                               symbols)))
             (action . (("Show Hyperspec" . hyperspec-lookup)))))

     (setq anything-c-source-cltl2
           `((name . "Lookup CLTL2")
             (candidates . (lambda ()
                             (let ((symbols nil))
                               (mapatoms #'(lambda (sym) (push (symbol-name sym) symbols))
                                         cltl2-symbols)
                               symbols)))
             (action . (("Show CLTL2" . cltl2-lookup)))))

     (defun anything-hyperspec-and-cltl2 ()
       (interactive)
       (anything (list anything-c-source-hyperspec anything-c-source-cltl2) (thing-at-point 'symbol)))))

(global-set-key "\C-cH" 'anything-hyperspec-and-cltl2)



;; ---------------------------------------------------
;; navi2ch
;; 実行には gzip.exe が必要
;; ---------------------------------------------------

(autoload 'navi2ch "navi2ch" "Navigator for 2ch for Emacs" t)

;; 終了時に訪ねない
(setq navi2ch-ask-when-exit nil)

;; スレのデフォルト名を使う
(setq navi2ch-message-user-name "")

;; あぼーんがあったたき元のファイルは保存しない
(setq navi2ch-net-save-old-file-when-aborn nil)

;; 送信時に訪ねる
(setq navi2ch-message-ask-before-send t)

;; kill するときに訪ねない
(setq navi2ch-message-ask-before-kill nil)

;; バッファは 10 個まで
(setq navi2ch-article-max-buffers 10)

;; navi2ch-article-max-buffers を超えたら古いバッファは消す
(setq navi2ch-article-auto-expunge t)

;; Board モードのレス数欄にレスの増加数を表示する。
(setq navi2ch-board-insert-subject-with-diff t)

;; Board モードのレス数欄にレスの未読数を表示する。
(setq navi2ch-board-insert-subject-with-unread t)

;; 既読スレはすべて表示
(setq navi2ch-article-exist-message-range '(1 . 1000))

;; 未読スレもすべて表示
(setq navi2ch-article-new-message-range '(1000 . 1))

;; 3 ペインモードでみる
(setq navi2ch-list-stay-list-window nil)

;; C-c 2 で起動
(global-set-key "\C-c2" 'navi2ch)

;; AAを綺麗に表示する
(setq navi2ch-mona-enable t)
(add-hook 'navi2ch-mona-load-hook
          (lambda ()
            (set-face-attribute 'navi2ch-mona-face nil :family "MS Pゴシック")))



;; ---------------------------------------------------
;; Twitter-mode
;; ---------------------------------------------------

;; C-c C-f twittering-friends-timeline         フレンドタイムラインを表示
;; C-c C-r twittering-replies-timeline         リプライタイムラインを表示
;; C-c C-g twittering-public-timeline         パブリックタイムラインを表示
;; C-c C-u twittering-user-timeline         ユーザータイムラインを表示
;; C-c C-s twittering-update-status-interactive つぶやきをポストする
;; C-c C-e twittering-erase-old-statuses    表示されているつぶやきをクリア
;; C-m         twittering-enter                 ? 通常のエンターと同じ動作?
;; C-c C-l twittering-update-lambda        「λかわいいよλ」をポスト
;; [mouse-1] twittering-click                 クリック
;; C-c C-v twittering-view-user-page         リンクを開く
;; g         twittering-current-timeline         タイムラインの更新
;; j         next-line                         (廃棄)
;; k         previous-line                         (廃棄)
;; j         twittering-goto-next-status         次のつぶやきに移動
;; k         twittering-goto-previous-status         前のつぶやきに移動
;; l         forward-char                         一文字進む
;; h         backward-char                         一文字戻る
;; 0         beginning-of-line                 行頭に移動
;; ^         beginning-of-line-text                 テキストの先頭に移動
;; $         end-of-line                         行末に移動
;; n         twittering-goto-next-status-of-user そのユーザーの次のつぶやきに移動
;; p         twittering-goto-previous-status-of-user そのユーザーの前のつぶやきに移動
;; [backspace] backward-char                         一文字戻る
;; G        end-of-buffer                         バッファの最後に移動
;; H        beginning-of-buffer                 バッファの先頭に移動
;; i        twittering-icon-mode                 アイコンモードに移行
;; s        twittering-scroll-mode                 スクロールモードに移動
;; t        twittering-toggle-proxy                 プロキシの使用のON/OFF
;; C-c C-p twittering-toggle-proxy                 プロキシの使用のON/OFF
;; M-x           twittering-jojo-mode                 twittering-jojo-mode twittering-jojo-modeで待機
;
;; (setq twittering-proxy-use t)
;; (setq twittering-proxy-server "127.0.0.1")
;; (setq twittering-proxy-port 8080)
;;  プロキシが127.0.0.1、ポートが8080の場合です。
;; 
;;  プロキシがユーザー名やパスワードを要求する場合は、次の設定も追加します。
;; 
;; (setq twittering-proxy-user "ユーザー名")
;; (setq twittering-proxy-password "パスワード")
;; 
;;  タイムラインに現れるつぶやきのフォーマットも変更できるようです。デフォルトの設定は次のようになっており、
;; 
;; (setq twittering-status-format "%i %s,  %@:¥n  %t // from %f%L")
;; ;; %s - screen_name
;; ;; %S - name
;; ;; %i - profile_image
;; ;; %d - description
;; ;; %l - location
;; ;; %L - " [location]"
;; ;; %u - url
;; ;; %j - user.id
;; ;; %p - protected?
;; ;; %c - created_at (raw UTC string)
;; ;; %C{time-format-str} - created_at (formatted with time-format-str)
;; ;; %@ - X seconds ago
;; ;; %t - text
;; ;; %' - truncated
;; ;; %f - source
;; ;; %# - id
;;  この設定でC-c C-lをすると、次のように表示されます。
;; 
;;  imait,  about 1 hour ago:
;;   λかわいいよλ // from twittering-mode [Kyoto, Japan]

(add-to-list 'load-path "~/.emacs.d/elisp/twittering-mode-2.0.0")

(require 'twittering-mode)

(setq twittering-auth-method 'xauth)
(setq twittering-username "username")
(setq twittering-timer-interval 75)
(setq twittering-convert-fix-size 36)
(setq twittering-update-status-function 'twittering-update-status-from-pop-up-buffer)
(setq twittering-icon-mode t)
(setq twittering-scroll-mode nil)
(setq twittering-fallback-image-format 'png)
(setq twittering-use-icon-storage t)

;;(setq twittering-status-format "%i %p%s / %S: %r %R [%@]\n%FOLD{%T}")
(setq twittering-status-format "%i %p%s / %S: %r %R [%@] by %f \n%T\n")
(setq twittering-retweet-format " QT @%s: %t")

;; F お気に入り
;; R ユーザーリプライ
;; [ 公式リツイート
;; ] 引用リツイート
(define-key twittering-mode-map (kbd "F") 'twittering-favorite)
(define-key twittering-mode-map (kbd "R") 'twittering-native-retweet)
(define-key twittering-mode-map (kbd "Q") 'twittering-organic-retweet)
(define-key twittering-mode-map (kbd "C-c C-f") 'twittering-home-timeline)


;; "<"">"で先頭、最後尾にいけるように
(define-key twittering-mode-map (kbd "<") (lambda () (interactive) (goto-char (point-min))))
(define-key twittering-mode-map (kbd ">") (lambda () (interactive) (goto-char (point-max))))

;;(setq twittering-status-format "%i %s,  %@: %f%L\n%t")
;;(setq twittering-timer-interval 120)
;;(setq twittering-convert-fix-size 48)
(setq twittering-account-authorization 'authorized)
(setq twittering-oauth-access-token-alist
   '(("oauth_token" . "xxxxxxxxxxxxxx")
  ("oauth_token_secret" . "xxxxxxxxxxxxxx")
  ("user_id" . "xxxxxxxxxxxxxx")
  ("screen_name" . "xxxxxxxxxxxxxx")))

;; C-c t でtwmodeを起動
(global-set-key "\C-ct" 'twit)



;; ---------------------------------------------------
;; wanderlust
;; ---------------------------------------------------
(autoload 'wl "wl" "Wanderlust" t)
(autoload 'wl-other-frame "wl" "Wanderlust on new frame." t)
(autoload 'wl-draft "wl-draft" "Write draft with Wanderlust." t)

;;;; 日本語の添付ファイル名を正しく表示。これがないと化ける。
;;(defvar my-mime-filename-coding-system-for-decode
;;  '(iso-2022-jp japanese-shift-jis japanese-iso-8bit))
;;(defun my-mime-decode-filename (filename)
;;  (let ((rest (eword-decode-string filename)))
;;   (or (when (and my-mime-filename-coding-system-for-decode
;;                  (string= rest filename))
;;         (let ((dcs (mapcar (function coding-system-base)
;;                            (detect-coding-string filename))))
;;           (unless (memq 'emacs-mule dcs)
;;             (let ((pcs my-mime-filename-coding-system-for-decode))
;;               (while pcs
;;                 (if (memq (coding-system-base (car pcs)) dcs)
;;                     (setq rest (decode-coding-string filename (car pcs))
;;                           pcs nil)
;;                   (setq pcs (cdr pcs))))))))
;;       rest)))
;;(eval-after-load "mime"
;; '(defadvice mime-entity-filename (after eword-decode-for-broken-MUA activate)
;;    "Decode encoded file name for BROKEN MUA."
;;    (when (stringp ad-return-value)
;;      (setq ad-return-value (my-mime-decode-filename ad-return-value)))))
;;(require 'std11)
;;
;;;; ファイル名が日本語の添付ファイルをエンコードする [semi-gnus-ja: 6046]
;;(eval-after-load "std11"
;; '(defadvice std11-wrap-as-quoted-string 
;;    (before encode-string activate)
;;    "Encode a string."
;;    (require 'eword-encode)
;;    (ad-set-arg 0 (eword-encode-string (ad-get-arg 0)))))

; w3m でhtmlメールを表示
(require 'mime-w3m)

; デフォルト mime をiso-2022-jpに
; (setq wl-mime-charset 'iso-2022-jp)

; メールディレクトリを指定
(setq elmo-localdir-folder-path "~/.mail")
(setq elmo-maildir-folder-path  "~/.mail/maildir")
(setq elmo-archive-folder-path  "~/.mail/archive")
(setq elmo-lost+found-folder "+lost+found")

(setq wl-queue-folder "+queue")

; 起動時にフォルダの未読チェックをしない
(setq wl-auto-check-folder-name "none")

; アイコンディレクトリを設定
(setq wl-icon-directory "~/.emacs.d/site-lisp/wl/icons")

;; tmp ディレクトリ を指定(デフォルト ~/tmp)
(setq wl-temporary-file-directory "~/temp")

;; 以下の設定は dot.wl へ集約
;; From: の設定
;(setq wl-from "Your Name <yourname@address.com>")
;
;; (system-name) が FQDN を返さない場合、
;; `wl-local-domain' にホスト名を除いたドメイン名を設定してください。
;(setq wl-local-domain "fqdn.domain.name.com")
;
;; IMAP サーバの設定
;(setq elmo-imap4-default-server "imap.server.com")
;
;; SMTP サーバの設定
;(setq wl-smtp-posting-server "smtp.server.com")
;
;; IMAP サーバの認証方式の設定
;(setq elmo-imap4-default-authenticate-type 'clear) ; 生パスワード
;;(setq elmo-imap4-default-authenticate-type 'cram-md5) ; CRAM-MD5
;
;; 自動でBCCを付ける
;(setq mail-self-blind t)
;(setq wl-bcc "yourname@domain.com")


; 初期設定は 500。この値よりサマリの更新数が多い場合、一部分だけ更新するか どうか質問する。
(setq elmo-folder-update-threshold 5000)

; `wl-summary-goto-folder' の時に選択するデフォルトのフォルダ
(setq wl-default-folder "%inbox")

; 終了時に確認する
(setq wl-interactive-exit t)

; メール送信時には確認する
(setq wl-interactive-send t)

; サマリモードの幅とヘッダ表示
(setq wl-summary-width nil)
(setq wl-summary-line-format "%n %1T%1P%1@ %Y/%M/%D(%W) %h:%m %-5S %t%[%25(%c %f%) %] %s")

; 日本語フォルダ対策
(setq elmo-imap4-use-modified-utf7 t)

; 非同期でチェックするように
(setq wl-folder-check-async t)

; 返信時にTO/CCにメールアドレスのみを挿入する
(setq wl-draft-reply-use-address-with-full-name nil)

; 自分宛のメールに返信する場合、TO/CCから自分のアドレスを削除
(setq wl-draft-always-delete-myself t)

; 返信時のドラフトバッファをフル画面に
(setq wl-draft-reply-buffer-style 'full)

; # での印刷で、白黒をデフォルトにする
(setq wl-ps-print-buffer-function 'ps-print-buffer)

; 全てのヘッダを非表示に
(setq wl-message-ignored-field-list '(".*:"))

; 表示するヘッダを選択
(setq wl-message-visible-field-list
      '("^To:" "^Subject:" "^From:" "^Date:" "^Cc:"))

; ヘッダの並びをソートする
(setq wl-message-sort-field-list
      '("^From:" "^To:" "^Cc:" "^Subject:" "^Date:"))

; 添付ファイルの保存先を変更する
(setq mime-save-directory "~")

; 起動時にはオフライン状態にする
(setq wl-plugged nil)

; 大きいメッセージを送信時に分割しない
(setq mime-edit-split-message nil)

; メール送信時には確認する
(setq wl-interactive-send t)

; デフォルトのドラフトをローカルに
(setq wl-draft-folder "+draft")

; 警告無しに開けるメールサイズの最大値(デフォルト:30K)
(setq elmo-message-fetch-threshold 5000000)

; プリフェッチ時に確認を求めるメールサイズの最大値(デフォルト:30K)
(setq wl-prefetch-threshold 5000000)

; サマリモードでスレッド結合を使わない
; 'thread でスレッドモードに
; Tでトグル
(setq wl-summary-default-view 'sequence)

; ドラフトバッファを自動保存しない
(setq wl-auto-save-drafts-interval nil)

; サマリモードに遷移した際に、カーソルを最下部に移動する。
(add-hook 'wl-summary-prepared-hook 'wl-summary-display-bottom)

; 転送時の件名プレフィクスを設定する  
(setq wl-forward-subject-prefix "Fwd: ")

;; 送信時に文字コードをチェックする
;;; locale
;(require 'mess-lcl)
;
;(setq wl-draft-clone-local-variable-regexp "^\\(wl\\|mime\\|message\\)")
;(setq mime-edit-translate-buffer-hook
;      '((lambda ()
;  (let ((message-mime-mode mime-edit-mode-flag)
;               (message-edit-buffer (current-buffer))
;               message-save-encoder)
;           (message-locale-maybe-encode)))
; mime-edit-translate-header))
;
;;(setq mail-send-hook 
;;      '(lambda ()
;;  (let ((message-mime-mode mime-edit-mode-flag)
;;        (message-edit-buffer (current-buffer))
;;        message-save-encoder)
;;    (message-locale-maybe-encode)
;;    (mime-edit-translate-header)
;;    (call-interactively 'mime-edit-maybe-split-and-send))))
;      
;;(setq message-locale-default 'none)
;(setq message-locale-default 'fj)
;;(setq message-locale-default nil)
;;(setq message-locale-default 'en)
;
;(setq message-locale-mime-charsets-alist
;      '((en us-ascii)
; (fj us-ascii iso-2022-jp iso-2022-jp-2)
; (none)))
; 上記設定はUTF-8での送信を行えることにしたので不要
; 参考:http://d.hatena.ne.jp/kiwanami/20091103/1257243524
;      http://article.gmane.org/gmane.mail.wanderlust.general.japanese/5978
; 
; 以下 flim へのパッチ
; --- mel-q-ccl.el~ 2006-06-12 15:10:02 +0000
; +++ mel-q-ccl.el 2008-04-03 06:33:51 +0000
; @@ -893,7 +893,13 @@
;    (defun quoted-printable-ccl-encode-region (start end)
;      "Encode the region from START to END with quoted-printable encoding."
;      (interactive "*r")
; -    (decode-coding-region start end 'mel-ccl-quoted-printable-lf-lf-rev))
; +    (save-excursion
; +      (goto-char start)
; +      (insert (prog1
; +    (decode-coding-string
; +     (string-as-unibyte (buffer-substring start end))
; +     'mel-ccl-quoted-printable-lf-lf-rev)
; +  (delete-region start end)))))
; 
;    (defun quoted-printable-ccl-insert-encoded-file (filename)
;      "Encode contents of the file named as FILENAME, and insert it."
;


; msgdbに情報を追加
(setq elmo-msgdb-extra-fields
      '("x-ml-name"
        "reply-to"
        "sender"
        "mailing-list"
        "newsgroups"
        "content-type"))

; Hyper Estraier 対応のサーチを行う
(require 'elmo-search-est)

;; mailcapを参照せずに添付ファイルを開く
(defvar my-mime-preview-play-current-entity-appname "fiber"
 "meadow なら fiber, mac なら open, linux なら xdg-open")

(unless (functionp #'mime-preview-play-current-entity-orig)
  (fset #'mime-preview-play-current-entity-orig
        (symbol-function #'mime-preview-play-current-entity)))

(setq mime-play-delete-file-immediately nil)

(defun mime-preview-play-current-entity (&optional ignore-examples mode)
  (interactive "P")
  (if (and mode (not (equal mode "play")))
      (mime-preview-play-current-entity-orig ignore-examples mode)
    (let* ((entity (get-text-property (point) 'mime-view-entity))
           (name (mime-entity-safe-filename entity))
           (filename (expand-file-name (if (and name (not (string= name "")))
                                           name
                                         (make-temp-name "EMI"))
                                       (make-temp-file "EMI" 'directory))))
      (mime-write-entity-content entity filename)
      (message "External method is starting...")
      (let* ((process-name
              (concat my-mime-preview-play-current-entity-appname " " filename))
             (process
              (start-process process-name
                             mime-echo-buffer-name
                             my-mime-preview-play-current-entity-appname
                             filename)))
        (set-alist 'mime-mailcap-method-filename-alist process filename)
        (set-process-sentinel process 'mime-mailcap-method-sentinel)))))



;; ---------------------------------------------------
;; js2-mode, Ejacs
;; ---------------------------------------------------

(autoload 'js2-mode "js2" nil t)

(when (load "js2" t)
  (setq js2-cleanup-whitespace nil
        js2-mirror-mode nil
        js2-bounce-indent-flag nil)

  (defun indent-and-back-to-indentation ()
    (interactive)
    (indent-for-tab-command)
    (let ((point-of-indentation
           (save-excursion
             (back-to-indentation)
             (point))))
      (skip-chars-forward "\s " point-of-indentation)))
  (define-key js2-mode-map "\C-i" 'indent-and-back-to-indentation)

  (define-key js2-mode-map "\C-m" nil)
  (add-to-list 'auto-mode-alist '("\.js$" . js2-mode)))


(autoload 'js-console "js-console" nil t)



;; ---------------------------------------------------
;; mpg123
;; ---------------------------------------------------
(autoload 'mpg123 "mpg123" "A Front-end to mpg123" t)
(setq mpg123-mpg123-command "mpg123.exe") ; mpg123のコマンド名
(setq mpg123-startup-volume 20)           ; 起動時の音量
(setq mpg123-default-repeat -1)           ; 繰り返し回数。-1は永遠に繰り返す。
(setq mpg123-default-dir                  ; 起動時のディレクトリ
      (expand-file-name "~/"))
(setq mpg123-file-name-coding-system 'japanese-cp932-dos)
(setq mpg123-process-coding-system   'japanese-cp932-dos)



;; ---------------------------------------------------
;; 起動時間の測定
;; ---------------------------------------------------
(my-time-lag)

(custom-set-variables
  ;; custom-set-variables was added by Custom.
  ;; If you edit it by hand, you could mess it up, so be careful.
  ;; Your init file should contain only one such instance.
  ;; If there is more than one, they won't work right.
 '(safe-local-variable-values (quote ((Package . CL-USER) (Syntax . COMMON-LISP) (Syntax . ANSI-Common-Lisp) (Base . 10)))))
(custom-set-faces
  ;; custom-set-faces was added by Custom.
  ;; If you edit it by hand, you could mess it up, so be careful.
  ;; Your init file should contain only one such instance.
  ;; If there is more than one, they won't work right.
 )

0 件のコメント:

コメントを投稿