.emacs

;; -*- lisp -*-
 
;;; ==============================
;;; primitive setting
;;; ==============================
;; lang
(set-language-environment "Japanese")
(set-default-coding-systems 'utf-8)
(set-keyboard-coding-system 'utf-8)
(set-terminal-coding-system 'utf-8)
(set-buffer-file-coding-system 'utf-8)
(setq default-buffer-file-coding-system 'utf-8)
 
;; keyset
(global-set-key "\C-h" 'backward-delete-char-untabify)
(define-key minibuffer-local-completion-map "\C-w" 'backward-kill-word)
 
;; cursor line
(defface hlline-face
  '((((class color)
      (background dark))
     ;;(:background "dark state gray"))
     (:background "gray10"
		  :underline "gray24"))
    (((class color)
      (background light))
     (:background "ForestGreen"
		  :underline nil))
    (t ()))
  "*Face used by hl-line.")
(setq hl-line-face 'hlline-face)
(global-hl-line-mode)
 
;;; ==============================
;;; setup path
;;; ==============================
(add-to-list 'exec-path "/opt/local/bin/")
(add-to-list 'load-path "~/c/config/site-lisp/auto-install/")
(add-to-list 'load-path "~/c/config/site-lisp/manual/")
 
;;; ==============================
;;; load elisp library
;;; ==============================
;; disable abbrev mode
(abbrev-mode nil)
 
;; ------------------------------
;; basic command
;; ------------------------------
;; http://www.emacswiki.org/emacs/auto-install.el
(require 'auto-install)
(setq auto-install-directory  "~/c/config/site-lisp/auto-install/")
(auto-install-update-emacswiki-package-name t)
(auto-install-compatibility-setup)
 
(require 'auto-save-buffers)
(run-with-idle-timer 0.5 t 'auto-save-buffers)
 
;; http://coderepos.org/share/browser/lang/elisp/widen-window-mode/trunk/widen-window.el?format=txt
(require 'widen-window)
(global-widen-window-mode t)
 
;; http://cvs.m17n.org/elisp/APEL/
(add-to-list 'load-path
	     "~/c/config/site-lisp/manual/apel/share/emacs/site-lisp/apel/")
(add-to-list 'load-path
	     "~/c/config/site-lisp/manual/apel/share/emacs/site-lisp/emu/")
 
;; http://www.morishima.net/~naoto/software/elscreen/index.php.ja
(load "elscreen" "ElScreen" t)
 
;; ------------------------------
;; yasnippet
;; ------------------------------
;; http://www.emacswiki.org/emacs/Yasnippet
(require 'yasnippet)
(yas/initialize)
(yas/load-directory "~/c/config/snippets")
(yas/minor-mode-auto-on)
 
;; ------------------------------
;; mode for programming laungage
;; ------------------------------
;; js-mode
(add-to-list 'auto-mode-alist '("\\.js\\'" . javascript-mode))
(autoload 'javascript-mode "javascript" nil t)
 
;; coq-mode
(setq auto-mode-alist (cons '("\\.v$" . coq-mode) auto-mode-alist))
(autoload 'coq-mode "coq" "Major mode for editing Coq vernacular." t)
(autoload 'run-coq "inferior-coq" "Run an inferior Coq process." t)
(autoload 'run-coq-other-window "inferior-coq"
  "Run an inferior Coq process in a new window." t)
(autoload 'run-coq-other-frame "inferior-coq"
  "Run an inferior Coq process in a new frame." t)
 
;; sml-mode
(load-file "~/c/config/site-lisp/manual/sml-mode/sml-mode-startup.el")
 
;; http://www.emacswiki.org/emacs/TuaregMode
;; http://aspellfr.free.fr/tuareg-imenu/tuareg-imenu.el
(add-to-list 'load-path "~/c/config/site-lisp/manual/caml-mode")
(add-to-list 'load-path "~/c/config/site-lisp/manual/tuareg-mode")
 
(autoload 'ocamlspot-query "ocamlspot" "OCamlSpot")
(autoload 'tuareg-mode "tuareg" "Major mode for editing Caml code" t)
(autoload 'camldebug "camldebug" "Run the Caml debugger" t)
(autoload 'tuareg-imenu-set-imenu "tuareg-imenu" "Configuration of imenu for tuareg" t)
(setq auto-mode-alist
      (append '(("\\.ml[ily]?$" . tuareg-mode)
		("\\.mli?p$" . tuareg-mode)
		("\\.topml$" . tuareg-mode))
	      auto-mode-alist))
 
(setq ocamlspot-path (executable-find "ocamlspot"))
 
(add-hook 'tuareg-mode-hook
	  (lambda ()
	    (tuareg-imenu-set-imenu)
	    (define-key tuareg-mode-map "\C-c;" 'ocamlspot-query)
	    (define-key tuareg-mode-map "\C-ct" 'caml-types-show-type)))
(add-to-list 'yas/extra-mode-hooks 'tuareg-mode-hook)
 
;; http://www.emacswiki.org/emacs/RubyMode
(add-to-list 'load-path "~/c/config/site-lisp/manual/ruby-mode")
(autoload 'ruby-mode "ruby-mode" "Mode for editing ruby source files" t)
(setq auto-mode-alist
        (append '(("\\.rb$" . ruby-mode)) auto-mode-alist))
(setq interpreter-mode-alist
      (append '(("ruby" . ruby-mode))
	      interpreter-mode-alist))
 
;; http://people.debian.org/~jps/misc/haxe-mode.el
(autoload 'haxe-mode "haxe-mode" "Mode for editing haxe source files" t)
(setq auto-mode-alist
        (append '(("\\.hx$" . haxe-mode)) auto-mode-alist))
 (add-hook 'haxe-mode-hook
	   (function
	    (lambda ()
	      (setq tab-width 4)
	      (setq indent-tabs-mode t)
	      (setq fill-column 80)
	      (local-set-key [(return)] 'newline-and-indent))))
 
;; http://www.emacswiki.org/emacs/HaskellMode
(load "~/c/config/site-lisp/manual/haskell-mode/haskell-site-file")
 
;; erlang
(add-to-list 'load-path "~/c/config/site-lisp/manual/erlang-mode")
(require 'erlang-start)
(add-to-list 'yas/extra-mode-hooks 'erlang-mode-hook)
 
;; scala
(add-to-list 'load-path "~/c/config/site-lisp/manual/scala-mode")
(require 'scala-mode-auto)
 
;; scheme-mode
(setq process-coding-system-alist
      (cons '("gosh" utf-8 . utf-8) process-coding-system-alist))
(autoload 'scheme-mode "cmuscheme" "Major mode for Scheme." t)
(autoload 'run-scheme "cmuscheme" "Run an inferior Scheme process." t)
(defun scheme-other-window ()
  "Run scheme on other window"
  (interactive)
  (switch-to-buffer-other-window
   (get-buffer-create "*scheme*"))
  (run-scheme gosh-program-name))
(define-key global-map
  "\C-cS" 'scheme-other-window)
 
;; ------------------------------
;; icicles
;; ------------------------------
(require 'icicles)
(require 'icicles-cmd)
(require 'icicles-face)
(require 'icicles-fn)
(require 'icicles-mac)
(require 'icicles-mcmd)
(require 'icicles-mode)
(require 'icicles-opt)
(require 'lacarte)
(require 'icomplete+)
(require 'hexrgb)
(require 'synonyms)
(icy-mode)
(add-hook 'icicle-minibuffer-setup-hook
	  (lambda ()
	    (define-key minibuffer-local-completion-map "\C-w" 'backward-kill-word)))
 
;; ------------------------------
;; auto-complete
;; ------------------------------
(require 'auto-complete)
(require 'auto-complete-yasnippet)
(require 'auto-complete-emacs-lisp)
 
(add-to-list 'ac-modes 'tuareg-mode)
(add-to-list 'ac-modes 'haskell-mode)
(add-to-list 'ac-modes 'scheme-mode)
(add-to-list 'ac-modes 'lisp-mode)
(add-to-list 'ac-modes 'haxe-mode)
(add-to-list 'ac-modes 'erlang-mode)
 
(global-auto-complete-mode t)
(define-key ac-complete-mode-map "\C-n" 'ac-next)
(define-key ac-complete-mode-map "\C-p" 'ac-previous)
(set-default 'ac-sources '(ac-source-imenu
			   ac-source-yasnippet
			   ac-source-words-in-buffer))
 
(ac-emacs-lisp-init)
 
;; ------------------------------
;; anything
;; ------------------------------
;; imenu
(require 'which-func)
(setq which-func-modes (append which-func-modes
			       '(java-mode javascript-mode tuareg-mode)))
(which-func-mode t)
 
;; anything
(require 'anything)
(require 'anything-match-plugin)
(require 'anything-config)
(require 'anything-auto-install)
 
(defun anything-yank-selection ()
  (interactive)
  (delete-minibuffer-contents)
  (insert (anything-get-selection)))
(define-key anything-map (kbd "TAB") 'anything-yank-selection)
 
;; candidates-file  plug-in
(defun anything-compile-source--candidates-file (source)
  (if (assoc-default 'candidates-file source)
      `((init acf-init
	      ,@(let ((orig-init (assoc-default 'init source)))
		  (cond ((null orig-init) nil)
                        ((functionp orig-init) (list orig-init))
                        (t orig-init))))
        (candidates-in-buffer)
        ,@source)
    source))
 
(add-to-list 'anything-compile-source-functions
	     'anything-compile-source--candidates-file)
 
(defun acf-init ()
  (destructuring-bind (file &optional updating)
      (anything-mklist (anything-attr 'candidates-file))
    (with-current-buffer (anything-candidate-buffer (find-file-noselect file))
      (when updating
        (buffer-disable-undo)
	(font-lock-mode -1)
	(auto-revert-mode 1)))))
 
(defvar anything-c-source-home-directory
  '((name . "Home directory")
    (candidates-file "~/c/config/filelist/c" updating)
    (requires-pattern . 5)
    (candidate-number-limit . 20)
    (type . file)))
 
(defvar anything-c-source-scheme-directory
  '((name . "Scheme directory")
    (candidates-file "~/c/config/filelist/scheme" updating)
    (requires-pattern . 5)
    (candidate-number-limit . 20)
    (type . file)))
 
;; prefetch
(find-file-noselect "~/c/config/filelist/c")
(find-file-noselect "~/c/config/filelist/scheme")
 
(setq my-anything-file-sources '(anything-c-source-ffap-line
				 anything-c-source-ffap-guesser
				 anything-c-source-home-directory
				 anything-c-source-scheme-directory
				 anything-c-source-file-cache
				 anything-c-source-file-name-history
				 anything-c-source-recentf
				 anything-c-source-buffers+
				 anything-c-source-bookmarks
				 anything-c-source-file-cache
				 anything-c-source-files-in-current-dir+))
 
(setq my-anything-jump-sources '(anything-c-source-imenu
				 anything-c-source-fixme
				 anything-c-source-occur))
 
(setq my-anything-buffer-sources '(anything-c-source-buffers+
				   anything-c-source-buffer-not-found
				   anything-c-source-create
				   anything-c-source-minibuffer-history))
 
(define-key global-map (kbd "C-o") 'anything)
(setq anything-sources (append my-anything-buffer-sources
			       my-anything-file-sources
			       '(anything-c-source-kill-ring
				 anything-c-source-register)
			       my-anything-jump-sources))
 
;; custom version
(defun my-anything-for-files ()
  (interactive)
  (anything my-anything-file-sources))
(defun my-anything-jump ()
  (interactive)
  (anything my-anything-jump-sources))
 
(defun my-anything-for-buffer ()
  (interactive)
  (anything my-anything-buffer-sources))
 
(define-key global-map (kbd "C-x C-o") 'my-anything-for-files)
(define-key global-map (kbd "C-c C-l") 'my-anything-jump)
(define-key global-map (kbd "C-x C-l") 'my-anything-jump)
(define-key global-map (kbd "C-x C-b") 'my-anything-for-buffer)
 
;; anything-project
(require 'anything-project)
(global-set-key (kbd "C-c C-f") 'anything-project)
(ap:add-project
 :name 'ocaml
 :look-for '("OMakeroot")
 :include-regexp '("\\.ml$"
		   "\\.mli$"
		   "\\.mlp$"
		   "\\.mlip$"
		   "OMakefile"
		   "\\.h$"))
;; ------------------------------
;; eshell-mode
;; ------------------------------
;; color handle
(require 'eshell)
(require 'ansi-color)
(defun eshell-handle-ansi-color ()
  (ansi-color-apply-on-region eshell-last-output-start
			      eshell-last-output-end))
 
;; ftp://ftp.newartisans.com/pub/emacs/esh-toggle.el
(require 'esh-toggle)
(global-set-key "\C-cs" 'eshell-toggle)
(global-set-key "\C-cd" 'eshell-toggle-cd)
 
;; C-a
(add-hook 'eshell-mode-hook
          '(lambda ()
	     (add-to-list 'eshell-output-filter-functions 'eshell-handle-ansi-color)
	     (define-key eshell-mode-map (kbd "C-a") 'eshell-bol)))
 
;;; ==============================
;;; settings
;;; ==============================
;; emacs behavior
(setq inhibit-startup-message t)
(setq ring-bell-function 'ignore)
(menu-bar-mode)       ; hide menu
(show-paren-mode)     ; markup paren
(transient-mark-mode) ; markup marker
 
;; 空白の表示/自動削除
(when (boundp 'show-trailing-whitespace)
  (setq-default show-trailing-whitespace t))
(add-hook 'before-save-hook 'delete-trailing-whitespace)
 
;; buffers
;; a/index.html -> index.html<a>
;; b/index.html -> index.html<b>
(require 'uniquify)
(setq uniquify-buffer-name-style 'post-forward-angle-brackets)
 
;; ------------------------------
;; *scratch*を消さない
;; ------------------------------
(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))))
 
;; C-x C-fでファイルを開く
(ffap-bindings)
 
;; ------------------------------
;; copy line
;; ------------------------------
(defun copy-line (&optional arg)
  (interactive "P")
  (toggle-read-only 1)
  (kill-line arg)
  (toggle-read-only 0))
 
(setq-default kill-read-only-ok t)
(global-set-key "\C-c\C-k" 'copy-line)
 
;;; ==============================
;;; color
;;; ==============================
(global-font-lock-mode t)
(set-face-foreground 'font-lock-comment-face "red")
(set-face-foreground 'font-lock-keyword-face "cyan")
(set-face-foreground 'font-lock-string-face  "purple")
(set-face-foreground 'font-lock-function-name-face "cyan")
(set-face-bold-p 'font-lock-function-name-face t)
 
(set-face-foreground 'font-lock-variable-name-face "purple")
(set-face-foreground 'font-lock-type-face "green")
(set-face-foreground 'font-lock-builtin-face "purple")
(set-face-foreground 'font-lock-constant-face "purple")
(set-face-foreground 'font-lock-warning-face "yellow")
(set-face-bold-p 'font-lock-warning-face nil)
 
 
;;; ==============================
;;; template
;;; ==============================
;; auto-insert
(add-hook 'find-file-hooks 'auto-insert)
(setq auto-insert-directory "~/c/docs/insert/")
 
(require 'time-stamp)
(load "autoinsert")
(setq auto-insert-alist
      (append '(
                ("\\.tex" . "tex.txt")
		("\\.c" "c.txt")
		(("\\.rb" . "Ruby script header")
		 nil (insert-text "ruby" "/opt/local/bin/ruby -w" "#"))
		(("\\.py" . "Python script header")
		 nil (insert-text "python" "/usr/bin/python" "#"))
		(("\\.scm" . "Scheme script header")
		 nil (insert-text "scheme" "/opt/local/bin/gosh" ";;"))
		(("\\.pl" . "Perl script header")
		 nil
		 (insert-text "perl" "/usr/bin/perl" "#")
		 "
use strict;
use warnings;
use Data::Dumper;
 
"
		 )
		) auto-insert-alist))
 
(defun insert-text (mode shebang comment)
  (concat "#! " shebang "
" comment " -*- mode:" mode "; coding:utf-8 -*-
" comment "
" comment " " (file-name-nondirectory (buffer-file-name)) " -
" comment "
" comment " Copyright(C) " (substring (current-time-string) -4) " by mzp
" comment " Author: MIZUNO Hiroki / mzpppp at gmail dot com
" comment " http://howdyworld.org
" comment "
" comment " Timestamp: " (time-stamp-yyyy/mm/dd) " " (time-stamp-hh:mm:ss) "
" comment "
" comment " This program is free software; you can redistribute it and/or
" comment " modify it under MIT Lincence.
" comment "
" "
"))
 
 
;;============================================================
;; customize
;;============================================================
(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.
 '(gud-gdb-command-name "gdb --annotate=1")
 '(large-file-warning-threshold nil)
 '(tuareg-skip-after-eval-phrase nil)
 '(weblogger-config-alist (quote (("default" ("user" . "mzp") ("server-url" . "http://mzp.itsuha.net/blog/xmlrpc.php") ("weblog" . "1")))))
 '(ww-advised-functions (quote (other-window split-window switch-to-buffer mouse-drag-region delete-window add-change-log-entry-other-window help-do-xref windmove-down windmove-up windmove-right windmove-left))))
(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.
 '(anything-dir-heading ((t (:foreground "yellow"))))
 '(anything-file-name ((t (:foreground "yellow"))))
 '(anything-isearch-match ((t (:background "Yellow" :foreground "black"))))
 '(region ((((class color) (min-colors 8)) (:background "blue" :foreground "white"))))
 '(which-func ((((background dark)) (:background "white" :foreground "blue"))))
 '(yas/field-highlight-face ((t (:background "yellow" :foreground "black"))))
 '(yas/mirror-highlight-face ((t (:background "red" :foreground "black")))))