Meadowをバージョンアップしました

Emacs

僕はWindowsではエディタ(というか開発環境というか生活そのもの)としてMeadowを使っているのですが、ついに重い腰を上げてMeadowのバージョンアップを敢行しました。MeadowというかEmacsは設定が柔軟にできる分、ついつい普段使わないような余分な設定が膨れ上がったりして自分でも設定ファイルがわけわからん状態になりがちです。なので、バージョンアップは結構大変。今回はその辺の余分な設定も見直して、ないと死んじゃうくらい常用しているソフトウェアだけに厳選しました。
インストールしたソフトウェアは以下です。

color-theme等は、Meadowをインストールしたディレクトリ/site-lisp以下に手動でコピーしました(面倒なのでsite-lispをそのまま使うことにしました)。
.emacsは以下です。そのうち機会があったら、これは〜という設定を紹介しようかな。

;; ====================
;;  Meadow config file
;; ====================
;;
;;  since Sat Mar 17 00:00:06 +0900 2007
;;

(defmacro eval-safe (&rest body)
  `(condition-case err
       (progn ,@body)
     (error (message "[eval-safe] %s" err))))

;; global key binding
(global-unset-key "\C-q") 
(global-set-key "\C-q\C-q" 'quoted-insert)
(global-set-key "\C-xn"	   'next-error)
(global-set-key "\C-h"	   'backward-delete-char-untabify)
(global-set-key "\C-u"	   'advertised-undo)
(global-set-key "\M-c"	   'compile)
(global-set-key "\M-u"	   'universal-argument)

;; register 
(set-register ?f '(file . "c:/Documents and Settings/s-tanaka/デスクトップ"))
 
;; misc 
(set-language-environment 'Japanese)

(setq fill-column -1)
(setq kill-whole-line t)
(setq scroll-step 1)
(setq blink-matching-delay 0.2)
(setq inhibit-startup-message t)
(transient-mark-mode t)
(menu-bar-mode 0)
(tool-bar-mode 0)
(scroll-bar-mode -1)
(fset 'yes-or-no-p 'y-or-n-p)
(column-number-mode t)
(setq mouse-yank-at-point t)
(setq visible-bell t)
(setq ring-bell-function '(lambda ()))
(put 'upcase-region 'disabled nil)
(put 'narrow-to-region 'disabled nil)

;; face 
(eval-safe 
 (require 'color-theme)
 (color-theme-initialize)
 (color-theme-robin-hood))

(w32-add-font
 "fixedsys"
 '((spec
    ((:char-spec ascii :height any)
     strict
     (w32-logfont "FixedSys" 0 16 400 0 nil nil nil 128 1 1 1))
    ((:char-spec ascii :height any :weight bold)
     strict
     (w32-logfont "FixedSys" 0 16 800 0 nil nil nil 128 1 1 1))
    ((:char-spec ascii :height any :slant italic)
     strict
     (w32-logfont "FixedSys" 0 16 400 0 nil nil nil 128 1 1 1))
    ((:char-spec ascii :height any :weight bold :slant italic)
     strict
     (w32-logfont "FixedSys" 0 16 800 0 nil nil nil 128 1 1 1))
    ((:char-spec japanese-jisx0208 :height any)
     strict
     (w32-logfont "FixedSys" 0 16 400 0 nil nil nil 128 1 1 1))
    ((:char-spec japanese-jisx0208 :height any :weight bold)
     strict
     (w32-logfont "FixedSys" 0 16 800 0 nil nil nil 128 1 1 1))
    ((:char-spec japanese-jisx0208 :height any :slant italic)
     strict
     (w32-logfont "FixedSys" 0 16 400 0 nil nil nil 128 1 1 1))
    ((:char-spec japanese-jisx0208 :height any :weight bold :slant italic)
     strict
     (w32-logfont "FixedSys" 0 16 800 0 t nil nil 128 1 1 1)))))

(set-face-attribute 'variable-pitch nil :family "*")
(setq default-frame-alist
      (append '((font   . "fixedsys")
		(width  . 116)
		(height .  45)
		(top    .   0)
		(left   .   0))
	      default-frame-alist))

;; dabbrev 
(setq dabbrev-case-fold-search nil)
(setq dabbrev-abbrev-char-regexp "\\w\\|\\s_")

;; auto-mode  
(setq auto-mode-alist
      (append '(("\\.rb$"  . ruby-mode))
	      auto-mode-alist))

;; auto-insert 
(load "autoinsert")
(setq auto-insert-alist 
      (append '((ruby-mode . (lambda () (insert "#!/usr/bin/env ruby\n\n")))
		(html-mode . (lambda () (sgml-tag "pre"))))
	      auto-insert-alist ))
(add-hook 'find-file-hooks 'auto-insert)

;; minibuffer  
(add-hook
 'minibuffer-setup-hook
 '(lambda ()
    (local-set-key "\C-w" 'backward-kill-word)))

;; dired
(add-hook
 'dired-mode-hook
 '(lambda ()
    (define-key dired-mode-map "U" 'dired-up-directory)))
(setq dired-listing-switches "-l")

;; cc-mode
(add-hook
 'c-mode-common-hook
 '(lambda ()
    (c-set-style "CC-MODE")
    (setq tab-width 8)
    (setq c-basic-offset 4)    
    (define-key c-mode-map "\C-cp" 'c-insert-printf)
    (define-key c-mode-map "\C-cf" 'c-insert-for)
    (modify-syntax-entry ?_ "w")
    (font-lock-add-keywords 'c-mode '("\\<\\(TRUE\\|FALSE\\)\\>"))
    (setq c-font-lock-extra-types '("FILE" "\\sw+_t"))))

(defun c-insert-printf()
  (interactive)
  (c-indent-command)
  (insert "printf(\"")
  (let ((p (point)))
    (insert "\")\;")
    (goto-char p)))

(defun c-insert-for()
  (interactive)
  (c-indent-command)
  (insert "for (i = 0; i < ")
  (let ((p (point)))
    (insert "; i++) {\n")
    (insert "}")
    (c-indent-command)
    (goto-char p)))

;; ruby-mode
(autoload 'ruby-mode "ruby-mode" "Mode for editing ruby source files")
(setq interpreter-mode-alist
      (append '(("^#!.*ruby" . ruby-mode)) interpreter-mode-alist))
(setq ruby-deep-indent-paren nil)

(add-hook
 'ruby-mode-hook
 '(lambda ()
    (define-key ruby-mode-map "\C-cb" 'ruby-insert-block)
    (define-key ruby-mode-map "\C-cB" 'ruby-insert-block2)
    (define-key ruby-mode-map "\C-ci" 'ruby-insert-escape)
    (define-key ruby-mode-map "\C-co" 'ruby-insert-open)
    (define-key ruby-mode-map "\C-cp" 'ruby-insert-print-line)))

(defun ruby-insert-block ()
  (interactive)
  (ruby-indent-command)
  (insert "do |")
  (let ((p (point)))
    (insert "|\n end")
    (ruby-indent-command)
    (goto-char p)))

(defun ruby-insert-block2 ()
  (interactive)
  (ruby-indent-command)
  (insert "{|")
  (let ((p (point)))
    (insert "| }")
    (goto-char p)))

(defun ruby-insert-escape ()
  (interactive)
  (insert "#{")
  (let ((p (point)))
    (insert "}")
    (goto-char p)))

(defun ruby-insert-open ()
  (interactive)
  (insert "open('")
  (let ((p (point)))
    (insert "', 'r') ")
    (ruby-insert-block)
    (insert "file")
    (goto-char p)))

(defun ruby-insert-print-line ()
  (interactive)
  (ruby-indent-command)
  (insert "print \"") 
  (let ((p (point)))
    (insert "\\n\"")
    (goto-char p)))

;; haskell-mode
(eval-safe
 (load "haskell-mode-2.3/haskell-site-file")
 (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))

;; text-mode
(add-hook
 'text-mode-hook
 '(lambda ()
    (auto-fill-mode 0)
    (define-key text-mode-map "\C-cb" 'text-insert-hatena-code-block)
    (define-key text-mode-map "\C-cl" 'text-insert-line)))

(defun text-insert-line ()
  (interactive)
  (insert "----\n"))

(defun text-insert-hatena-code-block ()
  (interactive)
  (insert ">||\n||<\n")
  (previous-line 1))

;; html-mode (for predoc)
(define-skeleton html-href-anchor2
  "HTML anchor tag with href attribute."
  "URL: "
  "<a href=\"" str "\">" _ "</a>")
(setq html-mode-hook
      '(lambda ()
	 (local-set-key "\C-c\C-ch" 'html-href-anchor2)))

;; skk
(eval-safe 
 (require 'skk-leim)
 (setq default-input-method "japanese-skk")
 (require 'skk-vars)
 (setq skk-set-henkan-point-key
       (append '(?:) skk-set-henkan-point-key))
 (setq skk-downcase-alist
       (append '((?: . ?\;)) skk-downcase-alist))
 (setq skk-rom-kana-rule-list
       (append
	'((";" nil ("ッ" . "っ"))
	  ("x;" nil ";")
	  ("la" nil ("ァ" . "ぁ"))
	  ("li" nil ("ィ" . "ぃ"))
	  ("lu" nil ("ゥ" . "ぅ"))
	  ("le" nil ("ェ" . "ぇ"))
	  ("lo" nil ("ォ" . "ぉ"))
	  ("lya" nil ("ャ" . "ゃ"))
	  ("lyu" nil ("ュ" . "ゅ"))
	  ("lyo" nil ("ョ" . "ょ")))
	skk-rom-kana-rule-list)))

;; dabbrev
(eval-safe (require 'dabbrev-highlight))

;; memo
(setq user-full-name "TANAKA Shin-ya")
(setq user-mail-address "tanaka.shinya@gmail.com")
 
(setq memo-tmp-dirname "~/memo/")
(setq memo-tmp-format "%Y/h%m-%d.txt")
(setq memo-filename "~/memo/ch2004.txt")

(add-hook
 'change-log-mode-hook 
 '(lambda ()
    (set (make-local-variable 'add-log-time-format) 
	 'add-log-iso8601-time-string-with-weekday)))
 
(global-set-key "\C-q\C-w" 'memo-tmp-open-today)
(defun memo-tmp-open-today (arg)
  (interactive "P")
  (let ((today-file
	 (concat memo-tmp-dirname 
		 (format-time-string memo-tmp-format))))
    (find-file today-file)))

(global-set-key "\C-xM" 'memo)
(defun memo ()
  (interactive)
  (add-change-log-entry
   nil
   (expand-file-name memo-filename)))

(global-set-key "\C-xm" 'memo-open)
(defun memo-open ()
  (interactive)
  (find-file memo-filename)
  (change-log-mode))

(defun add-log-iso8601-time-string-with-weekday ()
  (let ((system-time-locale "C"))
    (concat (add-log-iso8601-time-string)
            " " "(" (format-time-string "%a") ")")))

;; browse-url
(setq thing-at-point-url-path-regexp
      "[^]\t\n \"'()<>[^`{}]*[^]\t\n \"'()<>[^`{}.,;]+")

(setq thing-at-point-url-regexp
      (concat
       "\\<\\(h?t?tps?://\\|ftp://\\|gopher://\\|"
       "telnet://\\|wais://\\|file:/\\|s?news:\\|mailto:\\)"
       thing-at-point-url-path-regexp))

(setq browse-url-browser-function '(("." . browse-url-firefox)))
(setq browse-url-firefox-program "c:/Program Files/Mozilla Firefox/firefox.exe")
(defun browse-url-firefox (url &optional new-window)
  (interactive (browse-url-interactive-arg "URL: "))
  (if (string-match "^t?tp://" url)
      (setq url (concat "http://" (substring url (match-end 0)))))
  (if (string-match "^t?tps://" url)
      (setq url (concat "https://" (substring url (match-end 0)))))
  (start-process (concat browse-url-firefox-program url) nil 
		 browse-url-firefox-program "-remote" 
		 (concat "openurl(" url ", new-tab)")))

;; hatena
(defun hatena-convert-url-to-id ()
  "カーソル付近のURLをはてなID記法に変換する。"
  (interactive)
  (let ((bounds (bounds-of-thing-at-point 'url)))
    (if bounds
	(let* ((beg (car bounds))
	       (end (cdr bounds))
	       (urls (split-string (buffer-substring beg end) "/"))
	       (user (nth 3 urls))
	       (date (nth 4 urls))
	       (item (nth 5 urls))
	       (idstr (concat "id:" user)))
	  (if (and date (not (string-equal date "")))
	      (setq idstr (concat idstr ":" date)))
	  (if (and item (not (string-equal item "")))
	      (setq idstr (concat idstr ":" item)))
	  (delete-region beg end)
	  (insert idstr)))))

;; indent-and-next-line
(global-set-key "\M-n" 'indent-and-next-line)
(fset 'indent-and-next-line "\C-i\C-n")

;; insert-arrow
(global-set-key "\M-'" 'insert-arrow)
(fset 'insert-arrow "->")

;; trim-buffer
(defun trim-buffer ()
  "Delete excess white space."
  (interactive)
  (save-excursion
    (goto-char (point-min))
    (while (re-search-forward "[ \t]+$" nil t)
      (replace-match "" nil nil))
    (goto-char (point-max))
    (delete-blank-lines)
    (mark-whole-buffer)
    (tabify (region-beginning) (region-end))))

;; end