.emacsを公開 （CarbonEmacs用)

少しだけemacsにも慣れてきて、ようやく快適に操作ができるようになってきたので、現状のemacs.elをメモしておきます。

CarbonEmacsに標準で入っていなかったlispは
~/site-lisp
に置いておくことで、自分で何を入れたか忘れないようにしておく。

今入れてあるのは、
highlight-completion.el（ファイル名の自動補完）
simple-hatena-mode.el（はてなの投稿）
の２つだけ

現在一番のお気に入りが「バッファの切り替え」
C-, C-. で前後のバッファに移動が出来るようになる。
また、hownやsimple-hatena-modoがやたらとたくさんバッファを作るので、その多くを「移動の際に無視するバッファリスト」に追加。ついでに、バッファに表示される時間も長めに変更。
ちなみにこのLispはPetit emacs lisp tipsを参考に、ほぼコピペさせていただいた。感謝。

これのおかげで、様々なタブ型エディタと同程度の操作性が実現できたと思っている。

残りの大半はMeadow/Emacs memoを参考にした。
この情報量は素晴らしい。

今ちょっと気になっているのが、emacs.elを開いたときの、emacs-lispモード？が、コメントの色を変更してくれないこと。
これ、Meadowだとデフォルトで表示色が変わるんだよなぁ。モード名も確か違った表記だったし。
次はこの辺りを内調べてみようと思う。

lispいじりに明け暮れた土日だった。

;;elisp
(setq load-path
      (append
       (list
       (expand-file-name "~/site-lisp/")
       )
       load-path))

;;simple hatena mode
(require 'simple-hatena-mode)
(setq simple-hatena-default-id "goryugo")

;; 初期フレームの設定
(setq default-frame-alist
      (append (list '(width . 110)
		    '(height . 63)
		    '(top . 0)
		    '(left . 0))
	      default-frame-alist))

;;C-hをバックスペースに
(global-set-key "\C-h" 'delete-backward-char)

;; 括弧の対応をハイライト.
(show-paren-mode 1)

;; BS で選択範囲を消す
(delete-selection-mode 1)

;;ビープ音を消す
(setq ring-bell-function 'ignore)

;;ファイル名自動補完
(setq hc-ctrl-x-c-is-completion t)
(require 'highlight-completion)
(highlight-completion-mode 1)
(global-set-key "\C-\\" 'toggle-input-method)

;;カラーテーマ
(require 'color-theme)
(color-theme-initialize)
(color-theme-deep-blue)

;;リージョン色づけ
(setq transient-mark-mode t)

;;カーソルでのリージョン選択
(pc-selection-mode)

;;一行カット
(setq kill-whole-line t)

;;;;;;;;;;;;;;;;;;;;
;;howm
;;;;;;;;;;;;;;;;;;;;
(setq howm-menu-lang 'ja)
(global-set-key "\C-c,," 'howm-menu)
(mapc
 (lambda (f)
   (autoload f
     "howm" "Hitori Otegaru Wiki Modoki" t))
 '(howm-menu howm-list-all howm-list-recent
             howm-list-grep howm-create
             howm-keyword-to-kill-ring))
;; リンクを TAB で辿る
(eval-after-load "howm-mode"
  '(progn
     (define-key howm-mode-map [tab] 'action-lock-goto-next-link)
     (define-key howm-mode-map [(meta tab)] 'action-lock-goto-previous-link)))
;; 「最近のメモ」一覧時にタイトル表示
(setq howm-list-recent-title t)
;; 全メモ一覧時にタイトル表示
(setq howm-list-all-title t)
;; メニューを 2 時間キャッシュ
(setq howm-menu-expiry-hours 2)

;; howm の時は auto-fill で
(add-hook 'howm-mode-on-hook 'auto-fill-mode)

;; RET でファイルを開く際, 一覧バッファを消す
;; C-u RET なら残る
(setq howm-view-summary-persistent nil)

;; メニューの予定表の表示範囲
;; 10 日前から
(setq howm-menu-schedule-days-before 10)
;; 3 日後まで
(setq howm-menu-schedule-days 3)

;; howm のファイル名
;; 1 メモ 1 ファイル (デフォルト)
(setq howm-file-name-format "%Y/%m/%Y-%m-%d-%H%M%S.howm")
;; 検索しないファイルの正規表現
(setq
 howm-excluded-file-regexp
 "/\\.#\\|[~#]$\\|\\.bak$\\|/CVS/\\|\\.doc$\\|\\.pdf$\\|\\.ppt$\\|\\.xls$")

;; いちいち消すのも面倒なので
;; 内容が 0 ならファイルごと削除する
(if (not (memq 'delete-file-if-no-contents after-save-hook))
    (setq after-save-hook
          (cons 'delete-file-if-no-contents after-save-hook)))
(defun delete-file-if-no-contents ()
  (when (and
         (buffer-file-name (current-buffer))
         (string-match "\\.howm" (buffer-file-name (current-buffer)))
         (= (point-min) (point-max)))
    (delete-file
     (buffer-file-name (current-buffer)))))

;; http://howm.sourceforge.jp/cgi-bin/hiki/hiki.cgi?SaveAndKillBuffer
;; C-cC-c で保存してバッファをキルする
(defun my-save-and-kill-buffer ()
  (interactive)
  (when (and
         (buffer-file-name)
         (string-match "\\.howm"
                       (buffer-file-name)))
    (save-buffer)
    (kill-buffer nil)))
(eval-after-load "howm"
  '(progn
     (define-key howm-mode-map
       "\C-c\C-c" 'my-save-and-kill-buffer)))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;バッファの切り替え
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defvar my-ignore-blst             ; 移動の際に無視するバッファのリスト
  '("*Help*" "*Compile-Log*" "*Mew completions*" "*Completions*"
    "*Shell Command Output*" "*Apropos*" "*Buffer List*" "*GNU Emacs*"
    ".howm-keys" "*Messages*" "*SimpleHatena*" ".howm-history"))
(defvar my-visible-blst nil)       ; 移動開始時の buffer list を保存
(defvar my-bslen 15)               ; buffer list 中の buffer name の最大長
(defvar my-blist-display-time 10)   ; buffer list の表示時間
(defface my-cbface                 ; buffer list 中で current buffer を示す face
  '((t (:foreground "wheat" :underline t))) nil)

(defun my-visible-buffers (blst)
  (if (eq blst nil) '()
    (let ((bufn (buffer-name (car blst))))
      (if (or (= (aref bufn 0) ? ) (member bufn my-ignore-blst))
          ;; ミニバッファと無視するバッファには移動しない
          (my-visible-buffers (cdr blst))
        (cons (car blst) (my-visible-buffers (cdr blst)))))))

(defun my-show-buffer-list (prompt spliter)
  (let* ((len (string-width prompt))
         (str (mapconcat
               (lambda (buf)
                 (let ((bs (copy-sequence (buffer-name buf))))
                   (when (> (string-width bs) my-bslen) ;; 切り詰め 
                     (setq bs (concat (substring bs 0 (- my-bslen 2)) "..")))
                   (setq len (+ len (string-width (concat bs spliter))))
                   (when (eq buf (current-buffer)) ;; 現在のバッファは強調表示
                     (put-text-property 0 (length bs) 'face 'my-cbface bs))
                   (cond ((>= len (frame-width)) ;; frame 幅で適宜改行
                          (setq len (+ (string-width (concat prompt bs spliter))))
                          (concat "\n" (make-string (string-width prompt) ? ) bs))
                         (t bs))))
               my-visible-blst spliter)))
    (let (message-log-max)
      (message "%s" (concat prompt str))
      (when (sit-for my-blist-display-time) (message nil)))))

(defun my-operate-buffer (pos)
  (unless (window-minibuffer-p (selected-window));; ミニバッファ以外で
    (unless (eq last-command 'my-operate-buffer)
      ;; 直前にバッファを切り替えてなければバッファリストを更新
      (setq my-visible-blst (my-visible-buffers (buffer-list))))
    (let* ((blst (if pos my-visible-blst (reverse my-visible-blst))))
      (switch-to-buffer (or (cadr (memq (current-buffer) blst)) (car blst))))
    (my-show-buffer-list (if pos "[-->] " "[<--] ") (if pos " > "  " < " )))
  (setq this-command 'my-operate-buffer))

(global-set-key [?\C-,] (lambda () (interactive) (my-operate-buffer nil)))
(global-set-key [?\C-.] (lambda () (interactive) (my-operate-buffer t)))