КартаСайта ПоследниеИзменения ТерриторияЕмаксЛиспа КакИчто Известия

AlexSchroederConfigAlpinobombus

Download

;;; .emacs for Carbon Emacs on Alex Schroeder's iBook -*- coding: utf-8 -*-
;; This is free software.
;; Posted using C-x h M-| and the following command:
;; wikiput -m -z uihnscuskc -s update -u AlexSchroeder http://www.emacswiki.org/cgi-bin/wiki/AlexSchroederConfigAlpinobombus
;; Get wikiput from here:
;; http://www.oddmuse.org/cgi-bin/oddmuse/Automatic_Posting_and_Uploading

;; Darwinports and other paths, since my .bashrc is not being read
(add-to-list 'load-path (expand-file-name "elisp" (getenv "HOME")))
(setq exec-path (split-string "/Users/alex/bin:/opt/local/bin:/bin:/sbin:/usr/bin:/usr/local/bin:/usr/sbin" path-separator))
(setenv "PATH" (mapconcat 'identity exec-path ":"))
(setenv "MANPATH" "/opt/local/share/man:/usr/share/man:/usr/X11R6/man:/man")
(setenv "INFOPATH" "/opt/local/share/info:/usr/local/info:/usr/local/share/info:/usr/share/info")
(setenv "PERL5LIB" "/Library/Perl/5.8.1")
(setenv "ODD" "/Users/Shared/Oddmuse")
(setenv "WikiDataDir" "/Users/alex/oddmuse/test-data")

;; minor modes
(global-font-lock-mode 1)
(iswitchb-mode 1)
(show-paren-mode 1)
(tool-bar-mode -1)
(winner-mode 1)
(windmove-default-keybindings)
(column-number-mode 1)
(blink-cursor-mode -1)

(defalias 'yes-or-no-p 'y-or-n-p)

(when (require 'mac-print-mode nil t)
  (mac-print-mode 1)
  (global-set-key (kbd "M-p") 'mac-print-buffer))

(setq vc-follow-symlinks t
      inhibit-startup-screen t
      initial-scratch-message nil
      ispell-silently-savep t)

(global-set-key (kbd "C-c i") 'indent-region)
(global-set-key (kbd "C-c c") 'comment-region)
(global-set-key (kbd "C-c s") 'ispell-word)
(global-set-key (kbd "C-c n") (lambda () (interactive) (find-file "~/NOTES")))
(global-set-key (kbd "C-h a") 'apropos)
(global-set-key (kbd "C-c r") 'replace-word-at-point)
(global-set-key (kbd "C-x 8 1 / 3") "")
(global-set-key (kbd "C-x 8 1 / 3") "")
(global-set-key (kbd "C-x 8 1 / 5") "")
(global-set-key (kbd "C-x 8 1 / 6") "")
(global-set-key (kbd "C-x 8 2 / 3") "")
(global-set-key (kbd "C-x 8 2 / 5") "")
(global-set-key (kbd "C-x 8 3 / 5") "")
(global-set-key (kbd "C-x 8 4 / 5") "")
(global-set-key (kbd "C-x 8 5 / 6") "")

(global-set-key (kbd "C-x 8 : o") "ō")
(global-set-key (kbd "C-x 8 : O") "Ō")
(global-set-key (kbd "C-x 8 : u") "ū")
(global-set-key (kbd "C-x 8 : U") "Ū")

(global-set-key (kbd "M-<up>") 'scroll-down)
(global-set-key (kbd "M-<down>") 'scroll-up)

;; zoom
(defconst default-font-size (face-attribute 'default :height) "Default font size.")
(defconst current-font-size (face-attribute 'default :height) "Current font size.")

(global-set-key (kbd "M-+") 'text-scale-adjust)
(global-set-key (kbd "M--") 'text-scale-adjust)
(global-set-key (kbd "M-0") 'text-scale-adjust)

(require 'browse-kill-ring nil t)
(when (fboundp 'browse-kill-ring-default-keybindings)
  (browse-kill-ring-default-keybindings))

(autoload 'word-at-point "thingatpt" nil t)

(defun replace-word-at-point (from to)
  "Replace word at point."
  (interactive (let ((from (word-at-point)))
		 (list from (query-replace-read-to from "Replace" nil))))
  (query-replace from to))

(defun insert-date (arg)
  "Insert date at point.
With prefix argument, insert date and time."
  (interactive "P")
  (insert (format-time-string "%Y-%m-%d"))
  (when arg
    (insert (format-time-string " %H:%M"))))

(defun reverse-paragraphs (beg end)
  "Reverse the order of paragraphs in a region.
From a program takes two point or marker arguments, BEG and END."
  (interactive "r")
  (when (> beg end)
    (let (mid) (setq mid end end beg beg mid)))
  (save-excursion
    ;; the last paragraph might be missing a trailing newline
    (goto-char end)
    (setq end (point-marker))
    ;; the real work.
    (goto-char beg)
    (let (paragraphs fix-newline)
      (while (< beg end)
	;; skip to the beginning of the next paragraph instead of
	;; remaining on the position separating the two paragraphs
	(when (= 0 (forward-paragraph 1))
	  (goto-char (1+ (match-end 0))))
	(when (> (point) end)
	  (goto-char end))
	(setq paragraphs (cons (buffer-substring beg (point))
			       paragraphs))
	(delete-region beg (point)))
      ;; if all but the last paragraph end with two newlines, add a
      ;; newline to the last paragraph
      (when (and (null (delete 2 (mapcar (lambda (s)
					   (when (string-match "\n+$" s -2)
					     (length (match-string 0 s))))
					 (cdr paragraphs))))
		 (when (string-match "\n+$" (car paragraphs) -2)
		   (= 1 (length (match-string 0 (car paragraphs))))))
	(setq fix-newline t)
	(setcar paragraphs (concat (car paragraphs) "\n")))
      ;; insert paragraphs
      (dolist (par paragraphs)
	(insert par))
      (when fix-newline
	(delete-char -1)))))

;;; bs instead of buffer-menu
(global-set-key (kbd "C-x C-b") 'bs-show)

(setq bs-configurations
      '(("all" nil nil nil nil nil)
        ("files" nil nil nil bs-visits-non-file bs-sort-buffer-interns-are-last)
        ("dired" nil nil nil
         (lambda (buf)
           (with-current-buffer buf
             (not (eq major-mode 'dired-mode)))) nil)
        ("rcirc" nil nil nil
         (lambda (buf)
           (with-current-buffer buf
             (not (eq major-mode 'rcirc-mode))))
	 rcirc-sort-buffers)))

(defun rcirc-sort-name (buf)
  "Return server process and buffer name as a string."
  (when (boundp 'rcirc-server-buffer)
    (with-current-buffer buf
      (downcase (concat (if rcirc-server-buffer
			    (buffer-name rcirc-server-buffer)
			  " ")
			" "
			(or rcirc-target ""))))))

(defun rcirc-sort-buffers (a b)
  "Sort buffers A and B using `rcirc-sort-name'."
  (string< (rcirc-sort-name a)
	   (rcirc-sort-name b)))

;; color theme and related stuff
;; (set-face-font 'default "fontset-osaka14")
;; (setq inhibit-startup-message t
;;       initial-scratch-message nil
;;       initial-frame-alist '((top . 0))
;;       default-frame-alist '((height . 35)))
;; (require 'pink-bliss)
;; (color-theme-pink-bliss)

(define-generic-mode 'htaccess-mode
  '(?#)
  '( ;; core
    "AcceptPathInfo" "AccessFileName" "AddDefaultCharset" "AddOutputFilterByType"
    "AllowEncodedSlashes" "AllowOverride" "AuthName" "AuthType"
    "CGIMapExtension" "ContentDigest" "DefaultType" "DocumentRoot"
    "EnableMMAP" "EnableSendfile" "ErrorDocument" "ErrorLog"
    "FileETag" "ForceType" "HostnameLookups" "IdentityCheck"
    "Include" "KeepAlive" "KeepAliveTimeout" "LimitInternalRecursion"
    "LimitRequestBody" "LimitRequestFields" "LimitRequestFieldSize" "LimitRequestLine"
    "LimitXMLRequestBody" "LogLevel" "MaxKeepAliveRequests" "NameVirtualHost"
    "Options" "Require" "RLimitCPU" "RLimitMEM"
    "RLimitNPROC" "Satisfy" "ScriptInterpreterSource" "ServerAdmin"
    "ServerAlias" "ServerName" "ServerPath" "ServerRoot"
    "ServerSignature" "ServerTokens" "SetHandler" "SetInputFilter"
    "SetOutputFilter" "TimeOut" "UseCanonicalName"
    ;; .htaccess tutorial
    "AddHandler" "AuthUserFile" "AuthGroupFile"
    ;; mod_rewrite
    "RewriteBase" "RewriteCond" "RewriteEngine" "RewriteLock" "RewriteLog"
    "RewriteLogLevel" "RewriteMap" "RewriteOptions" "RewriteRule"
    ;; mod_alias
    "Alias" "AliasMatch" "Redirect" "RedirectMatch" "RedirectPermanent"
    "RedirectTemp" "ScriptAlias" "ScriptAliasMatch")
  '(("%{\\([A-Z_]+\\)}" 1 font-lock-variable-name-face)
    ("\\b[0-9][0-9][0-9]\\b" . font-lock-constant-face)
    ("\\[.*\\]" . font-lock-type-face))
  '(".htaccess\\'")
  nil
  "Generic mode for Apache .htaccess files.")

;; session management, optional
(when (require 'session nil t)
  (add-hook 'after-init-hook 'session-initialize))

;; slime mode, optional
;; (setq inferior-lisp-program "/sw/bin/openmcl")
;; (add-to-list 'load-path "~/elisp/slime-1.2.1")
;; (when (require 'slime nil t)
;;   (slime-setup))

;;; Unicode

(setq unicode-helper-data-txt "~/Documents/Unicode/UnicodeData.txt")
(global-set-key (kbd "C-c C-p RET") 'unicode-helper-name-at-point)
(global-set-key (kbd "C-c C-p =") 'unicode-helper-name-at-point)
(global-set-key (kbd "C-c C-p C-c") 'unicode-helper-insert-codepoint)
(global-set-key (kbd "C-c C-p C-n") 'unicode-helper-insert-char-name)
(autoload 'unicode-helper-name-at-point "unicode-helper-mode" nil t)
(autoload 'unicode-helper-insert-codepoint "unicode-helper-mode" nil t)
(autoload 'unicode-helper-insert-char-name "unicode-helper-mode" nil t)

;;; css mode
(autoload 'css-mode "css-mode" nil t)
(add-to-list 'auto-mode-alist '("\\.css\\'" . css-mode))

;;; ispell

(setq ispell-program-name "aspell"
      ispell-dictionary "english"
      ispell-dictionary-alist
      (let ((default '("[A-Za-z]" "[^A-Za-z]" "[']" nil
		       ("-B" "-d" "english" "--dict-dir"
			"/Library/Application Support/cocoAspell/aspell6-en-6.0-0")
		       nil iso-8859-1)))
	`((nil ,@default)
	  ("english" ,@default)
	  ("swiss" "[a-zA-Z\304\326\334\344\366\337\374]"
	   "[^a-zA-Z\304\326\334\344\366\337\374]" "[']" t
	   ("-C" "-d" "swiss" "--dict-dir"
	    "/Library/Application Support/cocoAspell/aspell6-de-20030222-1")
	   "~latin1" iso-8859-1))))

;;; dired mode

(require 'dired-x)
(setq dired-recursive-deletes 'top
      dired-recursive-copies 'top
      dired-dwim-target t
      dired-guess-shell-alist-user '(("\\.pdf$" "open")))

(defface dired-pdf-face '((t (:foreground "firebrick"))) "PDF files")

; (setq dired-mode-hook nil)
(add-hook 'dired-mode-hook
	  (lambda ()
	    (local-set-key (kbd "C-c C-r")
			   'wdired-change-to-wdired-mode)
	    (local-set-key (kbd "M-<down>")
			   (lambda ()
			     (interactive)
			     (dired-do-shell-command
			      "open" nil
			      (dired-get-marked-files t current-prefix-arg))))
	    (font-lock-add-keywords
	     nil '(("^  .*\\.pdf$"
		    (".+"
		     (dired-move-to-filename)
		     nil
		     (0 'dired-pdf-face)))))))
	  
;;; aquamacs
;; (global-set-key (kbd "H-q") (kbd "M-q"))

;;; carbon emacs

;; (set-keyboard-coding-system 'mac-roman);; no longer necessary in Emacs 23
;; (global-set-key (kbd "M-SPC") 'just-one-space)
;; (global-set-key (kbd "§") 'just-one-space)
;; (global-set-key  (kbd "~")); because alt-n does not work
;; (global-set-key (kbd "°") (kbd "^")); because ^ SPC does not work

; (setq selection-coding-system 'latin-1)
; (set-terminal-coding-system 'utf-8)
; (set-keyboard-coding-system 'iso-latin-1)

(prefer-coding-system 'utf-8)
(add-to-list 'file-coding-system-alist
	     '("Unicode\\.txt\\'" . utf-8))

(setq sentence-end-double-space nil)

(add-hook 'sgml-mode-hook (lambda ()
			    (local-set-key (kbd "C-c t") 'sgml-tag)))

(dolist (hook '(emacs-lisp-mode-hook
		lisp-mode-hook
		change-log-mode
		texinfo-mode-hook))
  (add-hook hook (lambda ()
		   (eldoc-mode 1)
		   (set (make-local-variable 'sentence-end-double-space) t))))

(defun highlight-fixme ()
  (font-lock-add-keywords nil'(("\\<\\(FIXME!?\\)"
				1 font-lock-warning-face prepend))))

(defface whitespace '((t (:background "hotpink"))) "Whitespace.")

(defun highlight-whitespace ()
  (font-lock-add-keywords nil'(("\t" . 'whitespace))))

(add-hook 'find-file-hook 'highlight-fixme t)

(setq change-log-default-name "ChangeLog"
      user-full-name "Alex Schroeder"
      ;; for ChangeLog, I want my GNU address
      add-log-mailing-address "alex@gnu.org"
      ;; for Gnus, I want my Gmail address
      user-mail-address "kensanata@gmail.com")

;; (global-set-key (kbd "M-SPC") 'just-one-space)
;; (global-set-key (kbd "C-v") 'goto-line)

(global-set-key (kbd "C-x v x") 'vc-revision-other-window)

(defun url-encode (str)
  "URL-encode STR."
  (interactive "sURL-encode: ")
  (message "%s" (url-hexify-string str)))
(defalias 'url-escape 'url-encode)

(defun url-decode (str)
  "URL-decode STR."
  (interactive "sURL-decode: ")
  (message "%s" (decode-coding-string
		 (url-unhex-string str)
		 'utf-8)))

;;; hippie expand

;; (global-set-key (kbd "C-<tab>") 'dabbrev-expand)
(global-set-key (kbd "C-<tab>") 'hippie-expand)
(setq hippie-expand-try-functions-list
      '(try-expand-all-abbrevs try-expand-dabbrev
	try-expand-dabbrev-all-buffers try-expand-dabbrev-from-kill
	try-complete-lisp-symbol-partially try-complete-lisp-symbol))

;;; eshell
(global-set-key (kbd "C-z") 'eshell)
(setq eshell-save-history-on-exit t)
(add-hook 'eshell-mode-hook
	  (lambda ()
	    (local-set-key (kbd "C-z") 'bury-buffer)
	    (local-set-key (kbd "C-a") 'eshell-bol)
	    (local-set-key (kbd "<up>") 'previous-line)
	    (local-set-key (kbd "<down>") 'next-line)))
(defalias 'eshell/emacs 'find-file)
(defalias 'eshell/less 'find-file)
(defun eshell/dired () (dired (eshell/pwd)))

;;; scheme
(require 'cmuscheme)
(setq scheme-program-name "/opt/local/bin/scsh")

;;; perl
(add-to-list 'auto-mode-alist '("\\.pl\\'" . cperl-mode))
(add-to-list 'auto-mode-alist '("\\.t\\'" . cperl-mode))
(add-to-list 'interpreter-mode-alist '("perl" . cperl-mode))
(add-hook 'cperl-mode-hook
	  (lambda ()
	    (local-set-key (kbd "C-h f") 'cperl-perldoc)))
(defalias 'perldoc 'cperl-perldoc)

;;; eldav for emacswiki, optional
;; (add-to-list 'load-path "~/elisp/eldav-0.8.1")
;; (require 'eldav nil t)
;; (defun eldav-file-writable-p (file)
;;   t)

;; (find-file ":http://www.emacswiki.org/cgi-bin/emacs/dav/ElDav")

(defun rcirc-unfill ()
  (interactive)
  (save-excursion
    (goto-char rcirc-prompt-end-marker)
    (while (re-search-forward "\\s-+" nil t)
      (replace-match " "))))

;;; rcirc, write such as not to require rcirc at startup
(autoload 'rcirc "rcirc" t)

(global-set-key (kbd "C-c e")
		(lambda ()
		  (interactive)
		  (rcirc nil)))

(setq rcirc-prompt "%n> "; list nick
      rcirc-fill-prefix "      "
      rcirc-fill-column 65; side-by-side on my laptop
      rcirc-log-flag t
      rcirc-log-directory "~/Documents/IRC Logs"
      rcirc-default-nick "kensanata"
      rcirc-keywords '("ken" "kens" "kensa")
      rcirc-server-alist
      '(("irc.freenode.net" :channels
	 ("#emacs" "#rcirc" "#wiki" "#oddmuse" "#epfarms"
	  "#hcoop"))
	("irc.datacomm.ch" :channels ("#drsrm"))
	("irc.chaostreff.ch" :channels ("#hackerfunk"))
	("irc.perl.org" :channels ("#perlde")))
      rcirc-decode-coding-system 'undecided
      rcirc-coding-system-alist
      '(("#nihongo" undecided . iso-2022-jp))
      rcirc-ignore-list '()
      rcirc-authinfo (with-temp-buffer
		       (insert-file-contents-literally "~/.rcirc-authinfo")
		       (read (current-buffer))))

(eval-after-load 'rcirc '(require 'rcirc-pounce))
(eval-after-load 'rcirc '(require 'rcirc-color))

(setq rcirc-colors
      (let (candidates)
        (dolist (item color-name-rgb-alist)
	  (destructuring-bind (color r g b) item
	    (let ((d (sqrt (+ (* (/ r 512) (/ r 512))
			      (* (/ g 512) (/ g 512))
			      (* (/ b 512) (/ b 512))))))
	      (if (and (not (= r g))
		       (not (= r b)); grey
		       (> d 10)
		       (< d 150))
		  (setq candidates (cons color candidates))))))
	candidates))


(eval-after-load 'rcirc
  '(defun-rcirc-command encoding (arg)
     "Change the encoding coding system
`rcirc-encode-coding-system' for the current buffer only."
     (interactive)
     (if (string= arg "")
	 (rcirc-print process (rcirc-nick process) "NOTICE" target
		      (symbol-name rcirc-encode-coding-system))
       (set (make-local-variable 'rcirc-encode-coding-system)
	    (intern-soft arg)))))

(add-hook 'rcirc-mode-hook
	  (lambda ()
	    (rcirc-track-minor-mode 1)
	    (local-set-key (kbd "M-q") 'rcirc-unfill)))

;; define rcirc faces

(defface rcirc-nick-in-message '((t (:background "lemon chiffon")))
  "My nick when mentioned by others.")
(defface rcirc-my-nick '((t (:foreground "purple")))
  "My own nick for rcirc.")
(defface rcirc-track-nick '((t (:inherit rcirc-my-nick)))
  "The face used indicate activity directed at you.")
(defface rcirc-nick-in-message-full-line '((t ()))
  "The face used emphasize the entire message when your nick is mentioned.")
(defface rcirc-track-keyword '((t (:inherit bold)))
  "The face used indicate activity directed at you.")
(defface rcirc-prompt '((t (:foreground "orchid")))
  "My prompt for rcirc.")

;;; elim / garak
;; (add-to-list 'load-path "~/elisp/elim")
;; (autoload 'garak "garak.el" "Instant messaging client." t)

;;; Jabber (GTalk)
(add-to-list 'load-path "~/elisp/jabber")
(require 'jabber-autoloads)
(setq jabber-history-enabled t
      jabber-use-global-history nil
      jabber-history-dir "~/Documents/Jabber Logs"
      jabber-vcard-avatars-retrieve nil
      jabber-chat-buffer-show-avatar nil
      jabber-account-list `(("kensanata@gmail.com"
			     (:network-server . "talk.google.com")
			     (:connection-type . ssl))))
;; Extract password from ~/.netrc file and add it to the
;; jabber-account-list. We extract all the network-server entries from
;; jabber-account-list, find the corresponding lines in ~/.netrc, use
;; the account name mentioned in there to find the entry in the
;; jabber-account-list, and add the password there. This means that
;; the JID has to be equal to the login value and the network-server
;; has to be equal to the machine value.  This probably doesn't work
;; for multiple JIDs connecting to the same network server, yet.
(when (require 'netrc nil t)
  (dolist (server (mapcar (lambda (elem)
			    (cdr (assq :network-server (cdr elem))))
			  jabber-account-list))
    ;; Here, data should be a list of matching entries, but I'm not
    ;; sure the netrc format allows that.
    (let* ((data (netrc-machine (netrc-parse "~/.netrc") server t))
	   (username (netrc-get data "login"))
	   (password (netrc-get data "password"))
	   (account (assoc username jabber-account-list)))
      (unless (assq :password (cdr account))
	(setcdr account (cons (cons :password password)
			      (cdr account)))))))

;;; debugging hashmaps

(defun describe-hash (variable &optional buffer)
  "Display the full documentation of VARIABLE (a symbol).
    Returns the documentation as a string, also.
    If VARIABLE has a buffer-local value in BUFFER (default to the current buffer),
    it is displayed along with the global value."
  (interactive
   (let ((v (variable-at-point))
	 (enable-recursive-minibuffers t)
	 val)
     (setq val (completing-read
		(if (and (symbolp v)
			 (hash-table-p (symbol-value v)))
		    (format
		     "Describe hash-map (default %s): " v)
		  "Describe hash-map: ")
		obarray
		(lambda (atom) (and (boundp atom)
				    (hash-table-p (symbol-value atom))))
		t nil nil
		(if (hash-table-p v) (symbol-name v))))
     (list (if (equal val "")
	       v (intern val)))))
  (with-output-to-temp-buffer (help-buffer)
    (maphash (lambda (key value)
	       (pp key)
	       (princ " => ")
	       (pp value)
	       (terpri))
	     (symbol-value variable))))

;;; text

(add-hook 'text-mode-hook 'turn-on-auto-fill)
(add-hook 'sgml-mode-hook 'turn-off-auto-fill)

;;; Oddmuse

(setq oddmuse-username "AlexSchroeder"
      oddmuse-directory "~/.emacs.d/oddmuse")
(add-to-list 'auto-mode-alist '("/Users/alex/emacs/oddmuse" . oddmuse-mode))
(autoload 'oddmuse-edit "oddmuse" "Edit a page on an Oddmuse wiki." t)
(autoload 'oddmuse-post "oddmuse" "Post the current buffer to an Oddmuse wiki." t)
(autoload 'oddmuse-mode "oddmuse" "Yadda yadda." t)
(setq oddmuse-wikis
      '(("TestWiki" "http://www.emacswiki.org/cgi-bin/test" utf-8)
	("EmacsWiki" "http://www.emacswiki.org/cgi-bin/emacs" utf-8)
	("CommunityWiki" "http://www.communitywiki.org/cw" utf-8)
	("OddmuseWiki" "http://www.oddmuse.org/cgi-bin/oddmuse" utf-8)
	("Alex" "http://www.emacswiki.org/cgi-bin/alex" utf-8)
	("GoldenLanterns" "http://www.campaignwiki.org/wiki/GoldenLanterns" utf-8)
	("Kaylash" "http://campaignwiki.org/wiki/Kaylash" utf-8)))

(add-hook 'text-mode-hook
	  (lambda ()
	    (local-set-key (kbd "C-c =") 'oddmuse-section)
	    (local-set-key (kbd "C-c -") 'oddmuse-subsection)))

;; (add-hook 'oddmuse-hook
;; 	  (lambda ()
;; 	    (unless (string-match "question" oddmuse-post)
;; 	      (setq oddmuse-post (concat "question=1;" oddmuse-post)))))

(add-hook 'oddmuse-mode-hook
	  (lambda ()
	    (font-lock-add-keywords nil campaign-wiki-font-lock-list)))

(defun oddmuse-section () (interactive) (oddmuse-header ?=))
(defun oddmuse-subsection () (interactive) (oddmuse-header ?-))
(defun oddmuse-header (char)
  (let ((n (- (line-end-position 0) (line-beginning-position 0))))
    (beginning-of-line)
    (insert (make-string n char))))
(defun oddmuse-links ()
  "Translate HTML links into Oddmuse links."
  (interactive)
  (while (re-search-forward "<a href=\"\\([^\"]*\\)\">\\([^<]*\\)</a>" nil t)
    (replace-match "[\\1 \\2]")
    (replace-string "\n" " " nil (match-beginning 0) (match-end 0))))

(define-generic-mode 'wikidot-mode
  nil; comments
  nil; keywords
  '(("^\\++.*$" . 'dired-header)
    ("^>.*$" . 'fixed-pitch)
    ("\\[.*?\\]" . 'link)
    ("\\*\\*.*?\\*\\*" . 'bold)
    ("//.*?//" . 'italic)
    ("||~[^|\n]*" . 'bold);; ||~ heading ||
    ("||[^~|\n]+$" . font-lock-warning-face); || cell ||
    ("||\\([^~|\n]*\\)" 1 'mode-line-highlight)); font-lock list
  '(".wikidot\\'"); auto-mode-alist
  nil; function-list
  "Major mode for editing wikidot files.")

(defun wikidot-table (start end rows)
  "Convert region into a table.
The region must contain one cell content per line,
cells by columns first."
  (interactive "r\nnHow many rows? ")
  (let ((cells (split-string (buffer-substring start end)
			     " *\n *" t)))
    (unless (= 0 (mod (length cells) rows))
      (error "Cannot fit %d cells into %d rows"
	     (length cells) rows))
    (unless cells
      (error "No cells in the region"))
    (dotimes (row rows)
      (let (result)
	(dotimes (col (/ (length cells) rows))
	  (setq result (cons (nth (+ (* col rows) row) cells)
			     result)))
	(let ((sep (if (= row 0) "||~ " "|| ")))
	  (insert sep (mapconcat 'identity
				 (nreverse result)
				 (concat " " sep))
		  " ||\n")))))
  (delete-region start end))

(require 'goto-addr)
(define-generic-mode 'alex-oddmuse-mode
  nil; comments
  nil; keywords
  `(("^=[^=\n]+=+$" . 'info-title-1)
    ("^==[^=\n]+=+$" . 'info-title-2)
    ("^===[^=\n]+=+$" . 'info-title-3)
    ("^====[^=\n]+=+$" . 'info-title-4)
    ("^[ \t].*$" . 'fixed-pitch)
    ("\\[\\[.*?\\]\\]" . 'link)
    ("\\[.*\\]" . 'link)
    (,goto-address-url-regexp . 'link)
    ("\\*\\*.*?\\*\\*" . 'bold)
    ("\\*.*?\\*" . 'bold)
    ("//.*?//" . 'italic)
    ("/.*?/" . 'italic)
    ("__.*?__" . 'italic)
    ("_.*?_" . 'underline)); font-lock list
  '(".oddmuse\\'"); auto-mode-alist
  '((lambda () (require 'info) (require 'goto-addr))); function-list
  "Major mode for editing Oddmuse wiki files.
The particular markup mix is specific to my preferences.")

(defvar campaign-wiki-font-lock-list
  '(("^=[^=\n]+" . 'info-title-1)
    ("^==[^=\n]+" . 'info-title-2)
    ("^===[^=\n]+" . 'info-title-3)
    ("^====+[^=\n]+" . 'info-title-4)
    ("\\[\\[.*?\\]\\]" . 'link)
    ("\\[b\\].*?\\[/b\\]" . 'bold)
    ("\\[i\\].*?\\[/i\\]" . 'italic)
    ("\\[.*\\]" . 'link)
    ("\\*\\*.*?\\*\\*" . 'bold)
    ("\\*.*?\\*" . 'bold)
    ("\\_<//.*?//" . 'italic)
    ("\\_</.*?/" . 'italic)
    ("__.*?__" . 'italic)
    ("_.*?_" . 'underline)
    ("|+=?" . font-lock-string-face)
    ("\\\\\\\\[ \t]+" . font-lock-warning-face)))

(define-generic-mode 'campaign-wiki-mode
  nil; comments
  nil; keywords
  campaign-wiki-font-lock-list; font-lock list
  '(".campaign\\'"); auto-mode-alist
  '((lambda ()
      (require 'info)
      (require 'goto-addr)
      (local-set-key (kbd "C-c =") 'oddmuse-section)
      (local-set-key (kbd "C-c -") 'oddmuse-subsection))); function-list
  "Campaign Wiki stuff including Creole Markup and BBCode.")

(defun creole-table (start end columns transposed)
  "Convert region into a table.
The region must contain one cell content per line,
cells by columns first."
  (interactive "r\nnHow many columns? \nP")
  (let* ((cells (split-string (buffer-substring start end) " *\n *" t))
	 (rows (/ (length cells) columns)))
    (unless (= 0 (mod (length cells) columns))
      (error "Cannot fit %d cells into %d columns"
	     (length cells) columns))
    (unless cells
      (error "No cells in the region"))
    (dotimes (row rows)
      (let (result)
	(if transposed
	    (progn
	      (dotimes (col columns)
		(setq result (cons (nth (+ (* col rows) row) cells) result)))
	      (nreverse result))
	  (setq result cells)
	  (setq cells (nthcdr columns cells))
	  (setcdr (nthcdr (1- columns) result) nil))
	(let ((sep (if (= row 0) "|= " "| ")))
	  (insert sep (mapconcat 'identity result (concat " " sep)) " |\n")))))
    (delete-region start end))

;;; isearch & occur

(defun isearch-occur ()
  "Invoke `occur' from within isearch."
  (interactive)
  (let ((case-fold-search isearch-case-fold-search))
    (occur (if isearch-regexp isearch-string (regexp-quote isearch-string)))))

(define-key isearch-mode-map (kbd "C-o") 'isearch-occur)

;;; org

(setq org-CUA-compatible t)
(define-key global-map "\C-cl" 'org-store-link)
(when (boundp 'session-globals-exclude)
  (add-to-list 'session-globals-exclude 'org-mark-ring))

;;; ediff

(setq ediff-window-setup-function 'ediff-setup-windows-plain)

;; Calendar

(setq calendar-week-start-day 1
      calendar-day-name-array ["Sonntag" "Montag" "Dienstag" "Mittwoch"
			       "Donnerstag" "Freitag" "Samstag"]
      calendar-month-name-array
      (apply 'vector
	     (mapcar (lambda (s)
		       (encode-coding-string s 'latin-1))
		     '("Januar" "Februar" "März" "April" "Mai"
		       "Juni" "Juli" "August" "September"
		       "Oktober" "November" "Dezember"))))

;;; Mush Mode

 (autoload 'mu-open "mu" "Play on MUSHes and MUDs" t)
 (add-hook 'mu-connection-mode-hook 'ansi-color-for-comint-mode-on)

;;; WriteRoom

(defun write-room ()
  "Make a frame without any bling."
  (interactive)
  ;; to restore:
  ;; (setq mode-line-format (default-value 'mode-line-format))
  (let ((frame (make-frame '((vertical-scroll-bars . nil)
			     (left-fringe . 0); no fringe
			     (right-fringe . 0)
			     (background-mode . dark)
			     (background-color . "black")
			     (foreground-color . "green")
			     (cursor-color . "green")
			     (border-width . 0)
			     (border-color . "black"); should be unnecessary
			     (internal-border-width . 64); whitespace!
			     (cursor-type . box)
			     (menu-bar-lines . 0)
			     (tool-bar-lines . 0)
			     (top . 0)
			     (left . 0)
			     (width . 128)
			     (height . 39)
			     (fullscreen . t); does not work on all systems
			     (unsplittable . t)))))
    (select-frame frame)
    (find-file "~/NOTES")
    (mode-line-mode -1)
    ;; maximize window if fullscreen above had no effect
    (when (fboundp 'w32-send-sys-command)
      (w32-send-sys-command 61488 frame))))

(define-minor-mode mode-line-mode
  "Toggle the modeline."
  nil "" nil
  (if mode-line-mode
      (kill-local-variable 'mode-line-format)
    (setq mode-line-format nil)))

;;; org

(setq org-CUA-compatible t)
(define-key global-map "\C-cl" 'org-store-link)
(add-to-list 'session-globals-exclude 'org-mark-ring)
(add-hook 'org-mode-hook 'my-org-init)
(defun my-org-init ()
  (local-set-key (kbd "C-<tab>") 'hippie-expand)
  (require 'typopunct)
  (typopunct-change-language 'english)
  (typopunct-mode 1))
(setq org-export-html-style
      "<link rel=\"stylesheet\" type=\"text/css\" href\=\"adventure.css\">")

;;; ediff

(setq ediff-window-setup-function 'ediff-setup-windows-plain)


;; Predictive

(add-to-list 'load-path "~/elisp/predictive")
(autoload 'predictive-mode "predictive" "predictive" t)
(set-default 'predictive-auto-add-to-dict t)
(setq predictive-main-dict 'rpg-dictionary
      predictive-use-auto-learn-cache nil
      predictive-add-to-dict-ask nil
      predictive-auto-learn t
      auto-completion-min-chars 4)

;;; Japanese, flashcard, and working with the edic and kanjidic files

(autoload 'flashcard-mode "flashcard" t)
(add-to-list 'auto-mode-alist '("\\.deck\\'" . flashcard-mode))
(add-hook 'flashcard-mode-hook
	  (lambda ()
	    (set-face-attribute 'flashcard-question-face nil :height 3.0)))


;; (add-hook 'flashcard-mode-hook
;;           'flashcard-add-scroll-to-bottom)
;; (add-hook 'flashcard-positive-feedback-functions
;;           'flashcard-feedback-highlight-answer)
;; (add-hook 'flashcard-positive-feedback-functions
;;           'flashcard-feedback-congratulate)
;; (add-hook 'flashcard-positive-feedback-functions
;;           'flashcard-method-leitner-positive-feedback)

(defun find-file-with-message (file)
  "Call `find-file' if necessary and print a message."
  (message "Opening %s..." file)
  (find-file file)
  (message "Opening %s...done" file))

(defun find-region-translation (start end)
  "Find the region in the EDICT file."
  (interactive "r")
  (let ((str (buffer-substring-no-properties start end))
	(conf (current-window-configuration)))
    (if (= (length str) 1)
	(find-file-with-message "/Users/alex/Documents/Japan/kanjidic")
      (find-file-with-message "/Users/alex/Documents/Japan/edict"))
    (goto-char (point-min))
    (when (occur str)
      (set-window-configuration conf)
      (switch-to-buffer "*Occur*")
      (local-set-key (kbd "q") 'bury-buffer))))

(global-set-key (kbd "C-c j") 'find-region-translation)

;;; Identica, Laconica, identi.ca

(when (require 'netrc nil t)
  (autoload 'identica-mode "identica-mode" nil t)
  (let ((identica (netrc-machine (netrc-parse "~/.netrc") "identi.ca" t)))
    (setq identica-username (netrc-get identica "login")
	  identica-password (netrc-get identica "password"))))

;;; Twitter

(when (require 'netrc nil t)
  (let ((twitter (netrc-machine (netrc-parse "~/.netrc") "identi.ca" t)))
    (setq twitter-username (netrc-get twitter "login")
	  twitter-password (netrc-get twitter "password"))))
;; (setq twit-user twitter-username)
;; (setq twit-pass twitter-password)
(setq twitter-include-replies t)

(autoload 'twitter-get-friends-timeline "twitter" nil t)
(autoload 'twitter-status-edit "twitter" nil t)
(global-set-key "\C-xt" 'twitter-get-friends-timeline)
(add-hook 'twitter-status-edit-mode-hook 'longlines-mode)

;; (autoload 'twit-show-recent-tweets "twit" nil t)
;; (autoload 'twit-search "twit" nil t)
;; (autoload 'twit-search-at-to-me "twit" nil t)
;; (autoload 'twit-show-direct-tweets "twit" nil t)
;; (autoload 'twit-direct "twit" nil t)
;; (setq twit-show-user-images t)

;;; w3m / WWW / browsing
(setq w3m-home-page "file:///Users/alex/Desktop/delicious-20090728.htm")
(add-to-list 'load-path "/usr/local/share/emacs/site-lisp/w3m/")
(require 'w3m-load)
(load-library "w3m-ems.el")
(setq browse-url-browser-function 'w3m
      w3m-use-cookies t)

(let ((delicious (netrc-machine (netrc-parse "~/.netrc") "delicious.com" t)))
  (setq delicious-username (netrc-get delicious "login")
	delicious-password (netrc-get delicious "password")))

(defun w3m-add-delicious-bookmark (url description tags)
  (interactive (list (read-from-minibuffer "URL: " w3m-current-url)
		     (read-from-minibuffer "Description: " w3m-current-title)
		     (read-from-minibuffer "Tags (space separated): ")))
  (setq description (replace-regexp-in-string " " "+" description)
	tags (replace-regexp-in-string " " "+" tags))
  (let* ((auth (concat delicious-username ":" delicious-password))
         (url-api (format "https://api.del.icio.us/v1/posts/add?&url=%s&description=%s&tags=%s"
                          url description tags)))
    (with-temp-buffer
      (apply #'call-process "curl" nil t nil
             `("-u" ,auth ,url-api))
      (message "%s" (buffer-string))
      (goto-char (point-min))
      (if (re-search-forward "<result code=\"done\" />" nil t)
          (message "%s added to delicious" description)
	(error "Failed to add bookmark to delicious")))))

;;; NPC data files

(defvar npc-names nil)

(defun npc-names-init (file)
  (interactive "fSource file for names (default to current file): ")
  (message "Reading %s..." file)
  (save-window-excursion
    (find-file file)
    (goto-char (point-min))
    (while (re-search-forward "^\\[\\([MF]\\)\\]=\\(\\w+\\)" nil t)
      (setq npc-names (cons (cons (match-string 2)
				  (match-string 1))
			    npc-names))))
  (message "Reading %s...done" file))

(defun npc-names (gender number)
  (interactive "kMale or Female names? \nnHow many: ")
  (setq gender (upcase gender))
  (when (null npc-names)
    (npc-names-init "~/.npc/human_names.txt"))
  (when (null npc-names)
    (error "No NPC names found"))
  (let ((len (length npc-names)))
    (message
     (mapconcat
      (lambda (s)
	(while (not (string= (cdr (setq s (nth (random len) npc-names)))
			     gender))
	  t)
	(car s))
      (make-list number nil)
      ", "))))

(defun stirling-fact (n)
  "Aproximate n!.
\"It has both pi and e in it, so I guess it's all right.\"
-- yrk on http://yrk.livejournal.com/181968.html"
  (* (sqrt (* 2 3.14159265 n))
     (expt (/ n 2.71828183) n)
     (+ 1 (/ 1 (* 12 n)))))

(defun round-next-number ()
  (interactive)
  (when (re-search-forward "[0-9]+\\.[0-9][0-9]+")
    (let ((num (string-to-number (match-string 0))))
      (replace-match (format "%.1f" num)))))

(defun irc-version-summary ()
  "Run this after you've sent a /CTCP #test VERSION."
  (interactive)
  (save-excursion
    (let ((agents))
      (while (re-search-forward "CTCP VERSION \\(\\sw+\\)" nil t)
	(let* ((key (match-string-no-properties 1))
	       (cell (or (assoc key agents)
			 (car (setq agents (cons (cons key 0) agents))))))
	  (setcdr cell (1+ (cdr cell)))))
      (setq agents (sort agents (lambda (a b) (> (cdr a) (cdr b)))))
      (pop-to-buffer (get-buffer-create "*IRC Clients*"))
      (erase-buffer)
      (dolist (item agents)
	(insert (format "%4d %s\n" (cdr item) (car item))))
      (insert "----\n"
	      (format "%4d total\n"
		      (apply '+ (mapcar 'cdr agents)))))))

;;; Gnus
(setq gnus-select-method '(nntp "news.hispeed.ch")
      gnus-secondary-select-methods
      '((nnimap "gmail"
	       (nnimap-address "imap.gmail.com")
	       (nnimap-authinfo-file "~/.netrc")
	       (nnimap-server-port 993)
	       (nnimap-stream ssl)
	       (nnmail-expiry-target "nnimap+gmail:[Gmail]/Trash")
	       (nnmail-expiry-wait immediate)))
      gnus-treat-display-smileys nil)
(add-hook 'gnus-summary-mode-hook 'my-gnus-summary-keys)

(defun my-gnus-summary-keys ()
  (local-set-key "y" 'gmail-archive)
  (local-set-key "$" 'gmail-report-spam))

(defun gmail-archive ()
  "Archive the current or marked mails.
This moves them into the All Mail folder."
  (interactive)
  (gnus-summary-move-article nil "nnimap+gmail:[Gmail]/All Mail"))

(defun gmail-report-spam ()
  "Report the current or marked mails as spam.
This moves them into the Spam folder."
  (interactive)
  (gnus-summary-move-article nil "nnimap+gmail:[Gmail]/Spam"))

;;; Writing mail, message-mode
(setq mail-user-agent 'gnus-user-agent
      gnus-outgoing-message-group "nnimap+gmail:[Gmail]/Sent Mail")

;; override the simple defun provided
(defadvice message-expand-name (after or-complete-alias activate)
  "Complete alias at point if it could not be expanded."
  (unless ad-return-value
    (mail-abbrev-complete-alias)))

;;; Mail sending, SMTP
(setq send-mail-function 'smtpmail-send-it
      message-send-mail-function 'smtpmail-send-it
      smtpmail-smtp-server "smtp.gmail.com"
      smtpmail-smtp-service 587
      smtpmail-starttls-credentials
      `((,smtpmail-smtp-server
	 , smtpmail-smtp-service
	   nil nil))
      smtpmail-auth-credentials "~/.netrc")

;;; automatic additions

(put 'narrow-to-region 'disabled nil)
(put 'not-modified 'disabled t)

(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.
 '(canlock-password "f0e77d033338878513c7e4935cfac5eaa0da285c")
 '(safe-local-variable-values (quote ((org-export-html-style . "   <style type=\"text/css\">
      .todo, .author, .date { display: none; }
      h2, h3 { font-size: inherit; margin: 0; }
      h3:before { content: \"• \"; }
      h3 { font-weight: inherit; padding-left: 1em; }
      h4:before { content: \"· \"; }
      h4 { font-weight: inherit; padding-left: 2em; }
      p { margin: 0; padding-left: 2em; }
  </style>")))))
(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.
 )