;; -*-mode:emacs-lisp; coding:latin-1-unix; fill-column:79;-*-

;;; .emacs[.el] -- Universal Startup File for GNU Emacs.

;; Copyright (C) 1998-2011

;; $Author: Andreas Spindler <info@visualco.de>$
;; $License: GPL$
;; $Keywords: gnu emacs lisp startup profile extensions feature convenience$
;; $Maintained at: <http://www.visualco.de>$
;; $Writestamp: 2011-06-28 11:31:04$

;; This is  a UNIVERSAL EMACS STARTUP  FILE for regular GNU  Emacs and Emacs/NT
;; (versions 21.2+). It contains no personal information and is compatible with
;; Emacs versions 21.2+.

;;; - Turn Emacs into a Common User Acces (CUA) editor.

;;; - Turn Emacs into a DWIM editor (http://www.catb.org/~esr/jargon/html/D/DWIM.html).

;;; - Configure the default frame and special popup frames.

;;; - Configures all major programming modes.

;;; - Compile and debug code.

;;; - Handle desktop files.

;;; - Make practical use of TAGS files and the etags program.

;;; - Configure interactive spell checking for words.

;;; - Under Windows enable Cygwin Bash, render PostScript files, run Explorer.

;;; - I-search symbol at point, pop local and global marks.

;;; - Enable Anti-RSI `type-break-mode'

;; CUA is a "consistent and usable" user-interface standard published by IBM in
;; 1987. The standard had strong  impact on Microsoft Windows, OSF/Motif, MacOS
;; and Gnome/KDE, but not "character  mode" on UNIX terminal. Most relevant for
;; Emacs  are SHIFT-DEL  (cut),  CTRL-INSERT (copy)  and SHIFT-INSERT  (paste).
;; These   key   bindings   are   established   by   `--CUA-mode-key-bindings'.
;; Frames/windows, point, mouse, modeline,  font-locking faces and current line
;; highlighting  are  configured  particulary  with  regard to  CUA.  See  also
;; <http://en.wikipedia.org/wiki/IBM_Common_User_Access>.

;; PostScript-rendering   under   Windows   uses   Aladdin   Ghostscript.   See
;; `--ps-print-buffer' bound to C-x_p.

;; Spelling interactively checks a word (sexp), region or the whole buffer for
;; spelling errors.  M-$ check a region or the buffer for spelling errors, M-t
;; check the region or word but not the buffer if neither of both is available.

;; See also <http://www.dur.ac.uk/p.j.heslin/Software/Emacs/Easymacs/>.

;;; Copyright/License:

;; This .emacs-file is free software; you can redistribute it and/or modify it
;; under the terms of the GNU General Public License as published by the Free
;; SoftwareFoundation; either version 2, or (at your option) any later version.

;; This .emacs-file is distributed in the hope that it will be useful, but
;; WITHOUTANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
;; FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for
;; more details.

;;; Conventions:

;; Defuns defined locally in this file carry the prefix `--xxx'. Defuns that
;; are specific to Microsoft Windows NT use `--winntxxx'.

;;; Resources:

;; <http://www.gnu.org/s/emacs/manual/html_node/elisp/Startup-Summary.html>

;; <http://renormalist.net/cgi-bin/twiki/view/Renormalist/EmacsLanguageModeCreationTutorial>

;;; Notes:

;;; Compatibility:

(if (>= emacs-major-version 22)
    (defvar --start-time (float-time (current-time))))
(require 'cl)                           ; Common Lisp Extensions
(defconst --winntp
  (or (eq window-system 'w32)
      (eq window-system 'win32)
      (eq system-type 'windows-nt)) "Running under Windows NT?")
(defconst --linuxp
  (or (eq system-type 'gnu/linux)       ; true e.g. for RedHat
      (eq system-type 'linux)) "Running under GNU/Linux?")
(defconst --macosp
  (memq window-system '(mac macos darwin)) "Running under MacOS?")
(defconst --xwmp
  (memq window-system '(x mac macos darwin)) "Running under some X Window Manager?")
(defconst --unixp
  (or --macosp --linuxp
      (eq system-type 'cygwin)
      (eq system-type 'usg-unix-v)
      (eq system-type 'berkeley-unix))
  "Running under a UNIX-OS (including Cygwin, Linux and MacOS)?")
(defconst --cygwinp (and --winntp
             (or (not (string-equal (getenv "CYGWIN") ""))
                 (not (string-equal (getenv "CYGNUSDIR") ""))
                 (file-exists-p "c:\\cygwin\\Cygwin.bat"))
             )
  "Running under Windows NT/Cygwin?")
(defconst --superuserp (eq 0 (user-uid)) "Is this Emacs instance run by the super-user (root)?")
(defconst --xemacsp (featurep 'xemacs) "Is this XEmacs?")
(defconst --emacs23p (and (not --xemacsp)
              (and (>= emacs-major-version 23)
                   (>= emacs-minor-version 2))))
(defconst --emacs22p (and (not --xemacsp)
              (and (>= emacs-major-version 22)
                   (>= emacs-minor-version 1))))
(defconst --emacs21p (and (not --xemacsp)
              (>= emacs-major-version 21)))
(defconst --no-desktop (member "--no-desktop" command-line-args)
  "True when no desktop file is loaded (--no-desktop command-line switch set).")
(defconst --batch-mode (member "--batch-mode" command-line-args)
  "True when running in batch-mode (--batch-mode command-line switch set).")
(defvar --have-desktop nil
  "t if a desktop file was loaded.")

(defvar --scratch-directory
  (save-excursion (set-buffer "*scratch*") default-directory)
  "The `default-directory' local variable of the <*scratch*> buffer.")

(defun --startup-directory ()
  "Return directory from which Emacs was started: `desktop-dirname' or the `--scratch-directory'.
Note also `default-minibuffer-frame'."
  (if --have-desktop
      desktop-dirname
    --scratch-directory))

;;; Convenience functions

(defun em ()
  (interactive)
  (find-file (--file-expand-patterns "~/.emacs.el")))
(defun emloc ()
  (interactive)
  (let ((a (concat (--startup-directory) "/.emacs.local"))
    (b "~/.emacs.local"))
    (find-file (if (--file-exists-p a) a
         (if (--file-exists-p b) b)))))
(defun bashrc ()
  (interactive) (find-file (--file-expand-patterns "~/.bashrc")))
(defun abbrevs ()
  (interactive) (find-file (--file-expand-patterns abbrev-file-name)) (lisp-mode))

(defun scratch()
  (interactive)
  (switch-to-buffer "*scratch*")
  (lisp-interaction-mode)
  (if current-prefix-arg
      (delete-region (point-min) (point-max))
    (goto-char (point-max))))

(defun trunc()
  ;; From http://www.emacswiki.org/emacs/McMahanEmacsMacros
  "Toggle between truncated and wrapped lines, redraw the display."
  (interactive)
  (toggle-truncate-lines nil)
  (message (if truncate-lines
           "Truncating lines (... $)"
         "Wrapping lines (...\\)")
       (redraw-display)))

(cond
 (--winntp
  (defun wordpad()
    "Launch the Wordpad editor"
    (interactive)
    (w32-shell-execute "open" "wordpad.exe"))
  (defun notepad()
    "Launch the Notepad editor"
    (interactive)
    (w32-shell-execute "open" "notepad.exe"))
  )
 )

(setq revert-without-query (list ".+"))

(pushnew (expand-file-name "~/bin/elisp") load-path)

;;; -------- LISP UTILITY FUNCTIONS
;;; ---------------------------------------------------------------------------

(when (not (fboundp 'delete-dups))
  (defun delete-dups (list)             ; copied from Emacs 22 <subr.el>
    "Destructively remove `equal' duplicates from LIST.
Store the result in LIST and return it. LIST must be a proper list. Of several
`equal' occurrences of an element in LIST, the first one is kept."
    (let ((tail list))
      (while tail
    (setcdr tail (delete (car tail) (cdr tail)))
    (setq tail (cdr tail)))) list))

(defun flatten(list)
  "Flatten LIST, returning a list with the atoms in LIST at any level. LIST is
a flat or a list of list. Also works for a consp whose cdr is non-nil."
  ;; This is a non-recurise implementation. It is standard/traditional Lisp
  ;; code, not original with me.
  (cond ((null list) nil)
    ((atom list) list)
    (t
     (let ((old list) (new ()) item)
       (while old
         (if (atom old)             ; from consp with non-nil cdr
         (setq item old
               old nil)
           (setq item (car old)
             old (cdr old)))
         ;; Make item atomic.
         (while (consp item)
           (if (cdr item)
           (setq old (cons (cdr item) old)))
           (setq item (car item)))
         (setq new (cons item new)))
       (reverse new)))))

(defun join (sep &rest sequences) "Like Perl's `join'."
  (mapconcat '(lambda(x)x) (flatten sequences) sep))
(defun qq (&rest sequences) "Wrap string(s) into double-quotes."
  (concat "\"" (join "" sequences) "\""))
(defun join-re (&rest res) "Parenthesize (group) Emacs regular expressions."
  (concat "\\(" (join "\\|" res) "\\)"))
(defun shy-re (&rest res) "Like `join-re', but build a shy group."
  (concat "\\(?:" (join "\\|" res) "\\)"))
(defun strempty (str) "Return t if STR is `nil' or \"\"."
  (or (not str) (string-equal str "")))
(defun strjoin (strings &optional separator)
  "Join STRINGS with SEPARATOR. Example:
    (strjoin (mapcar (lambda (cons) (format \"-name *.%s\" cons)) alist) \" -o \")"
  (mapconcat 'identity (flatten strings) (or separator " ")))

(defun strreplace (str regexp repl &optional first)
  "Replace matches of REGEXP in STR with REPL (literally - \\& and \\1 to \\9 won't work).
If REPL is a function call this function, passing it the match string as an
argument; the replace text is then the function result. If FIRST is true
replace just the first match Returns the replaced string.

Example: Substitute environment variables.

    (strreplace \"$HOME/bin:$PRJDIR/phenotypes\" \"\\$[A-Za-z_]+\"
'(lambda(s)(getenv (substring s 1))))"
  (let ((safe (match-data)))
    (unwind-protect
    ;; bodyform
    ;; Hints:
    ;;  (string-match "f" "foo") => begin 0, end 1
    ;;  (string-match "foo" "foo") => begin 0, end 3
    ;;  (substring "foo" 0 1) => "f"
    (let ((result "") (start 0) stop mbeg mend)
      (while (and (not stop) (string-match regexp str start))
        (setq mbeg (match-beginning 0) ; zerobased index of 1st matched char
          mend (match-end 0))      ; zerobased index of 1st char *beyond* the match
        (setq result (concat result (substring str start mbeg)
                 (if (functionp repl)
                     (funcall repl (substring str mbeg mend)) repl)))
        (setq start mend stop first))
      (if (>= start 0)         ; if matched at least once result result plus rest, otherwise str
          (setq str (concat result (substring str start))))
      str)
      ;; unwindform
      (store-match-data safe))))

(defvar --read-string-history nil)
(defun --read-string (prompt defval &optional initval)
  "Read a string from the minibuffer, prompting with string `prompt'.
INITVAL is a string to insert before reading (after the prompt). PROMPT is appended with DEFVAL, so
the person being prompted which string is charged when entering the empty string."
  (read-string (format "%s (`%s')? " prompt defval)
           (or initval "") '--read-string-history defval))
(defun --read-pathname (prompt defval &optional initval)
  "Like `--read-string', but use `file-name-history'."
  (read-string (format "%s (`%s')? " prompt defval)
           (or initval "") 'file-name-history defval))
(defun --wap-region (&optional strict real-word)
  "Return the symbol or word that point is on (or a nearby one) as a cons with
buffer offsets delimiting the beginning/ending point of some word.

The result is nil when there is no word nearby. If STRICT is non-nil return nil
unless point is within or adjacent to a symbol or word. The function finds a
symbol zbkess REAL-WORD is non-nil, in which case ist finds a word."
  ;; Copied from Emacs 22 simple.el `current-word', then modified to return a cons.
  (save-excursion
    (let* ((oldpoint (point)) (start (point)) (end (point))
       (syntaxes (if real-word "w" "w_"))
       (not-syntaxes (concat "^" syntaxes)))
      (skip-syntax-backward syntaxes) (setq start (point))
      (goto-char oldpoint)
      (skip-syntax-forward syntaxes) (setq end (point))
      (when (and (eq start oldpoint) (eq end oldpoint)
         (not strict))
    ;; Point is neither within nor adjacent to a word.
    ;; Look for preceding word in same line.
    (skip-syntax-backward not-syntaxes (save-excursion (beginning-of-line) (point)))
    (if (bolp)               ; no preceding word in same line -> look for following word in line
        (progn (skip-syntax-forward not-syntaxes (save-excursion (end-of-line) (point)))
           (setq start (point))
           (skip-syntax-forward syntaxes)
           (setq end (point)))
      (setq end (point))
      (skip-syntax-backward syntaxes)
      (setq start (point))))
      ;; If we found something nonempty, return it as a string.
      (unless (= start end)
    ;;(buffer-substring-no-properties start end)
    (cons start end)))))
(defun --wap (&optional strict real-word)
  "Return symbol or word that point is on (or a nearby one) as a string.
The result has no text properties. See `--wap-region' for parameters STRICT and
REAL-WORD."
  (let ((reg (--wap-region)))
    (condition-case nil
    (buffer-substring-no-properties (car reg) (cdr reg))
      (error))))

;;; -------- I/O FUNCTIONS
;;; ---------------------------------------------------------------------------

(defun --buffer-file-name (f) (if (bufferp f) (buffer-file-name f) f))
(defun --buffer-directory-name (f) (if (bufferp f) (buffer-file-name f) f))
(defun --file-readable-p (f) (and f (file-readable-p (--buffer-file-name f))))
(defun --file-exists-p (f)
  "When F is a buffer test if its associated file exists, otherwise interpret F
as filename. Note also `file-accessible-directory-p'."
  (and f (file-exists-p (--buffer-file-name f))))
(defun --directory-exists-p (f)
  (and f (file-accessible-directory-p (--buffer-directory-name f))))
(defun --file-size (filename) (nth 7 (file-attributes filename)))
(defun --file-empty (filename) (= 0 (--file-size filename)))

(defun --close-buffer (b &optional keep-windows)
  (when (get-buffer b)
    (if (not keep-windows) (delete-windows-on b))
    (kill-buffer b)))

(defun --file-expand-variables (strings)
  "Replace environment variables of the form \"$VARIABLE\" in all STRINGS (list or scalar)."
  ;; In `ff-list-replace-env-vars'; the call to `string-match' can fail on nil.
  (setq wantarray (listp strings))
  (unless wantarray
    (setq strings (list strings)))
  (condition-case nil
      (progn
    (setq list (ff-list-replace-env-vars strings))
    (if wantarray
        list
      (car list)))
    (error)))

(defun --file-expand-patterns (path &optional dirname no-wildcards)
  "PATH is a single string or list of pathname strings.
DIRNAME is the directory to start from if PATH is relative (does not start with
slash or tilde; default: `default-directory'). NO-WILDCARDS, when non-nil does
not expand shell patterns (globs) in PATH.

The type of the result is the type of PATH (string or list of strings).

Steps performed:

1.) Substitute environment variables of the form \"$FOO\" or \"($FOO)\".
2.) Convert filename to absolute, and canonicalize it (`expand-file-name').
3.) Convert all backslashes (\"\\\") into slashes (\"/\").

For example, to get a list of existing directories use:

    (setq existing-dirs
        \(mapcan '(lambda (f) (when (and f (file-directory-p f)) (list f)))
        \(flatten (mapcar '--file-expand-patterns path-list))))
"
  (if (null path)
      (setq path ""))
  (if (stringp path)
      (strreplace
       (strreplace (expand-file-name
            (--file-expand-variables path)
            (--file-expand-variables (or dirname default-directory)))
           "\\\\" "/") "//" "/")
    ;; Argument is a list of strings: recurse for each string.
    (if no-wildcards
    (mapcar (lambda(x)(--file-expand-patterns x)) path)
      (flatten (mapcan 'file-expand-wildcards (mapcar '--file-expand-patterns path))))))

(defun --file-expand-directory-patterns (path &optional dirname no-wildcards)
  "Like `--file-expand-patterns' but expand only regular directories. Filter
out files, non-existing directories and all directory names starting with a
dot."
  (flatten (mapcan '(lambda (f)
              (when (and f (not (string-match "/\\." f)) (file-directory-p f))
            (list f)))
           (delete-dups (--file-expand-patterns path dirname no-wildcards)))))

(defun --find-pathnames (&optional pattern dirnames first)
  "Find existing file(s) that match PATTERN in DIRNAMES (default: `ff-search-directories').
Non-nil for FIRST stops after the first found PATTERN.

Returns a flat, unique list of pathnames. When PATTERN is omitted this function
finds all concrete directory names.

In PATTERN and DIRNAMES environment variables of the form \"$FOO\" or
\"($FOO)\" get substituted. All DIRNAMES can use shell patterns too. When a
part of the directory name is \"/*\" its occurence is expanded by all existing
directory-names at that level. For example, \"$HOME/prj/*/mk/gnu\" expands to
all sub-directories in \"~/prj\" that have a \"../mk/gnu\" branch."
  ;; This function is based on `ff-get-file-name'. Added environment variables,
  ;; shell patterns and the `first' flag. Notice that `ff-get-file-name'
  ;; returns only the first found file, but this version returns all files.
  (require 'find-file)
  (or dirnames (setq dirnames ff-search-directories))
  (if (stringp dirnames)
      (--find-pathnames pattern (list dirnames) first)
    ;; Search in `dirnames' - which may be something stupid like (nil).
    (let ((dirs (flatten (if (symbolp dirnames)
                 (--file-expand-variables (symbol-value dirnames))
               (--file-expand-variables dirnames))))
      (dir) (rest) (found (list)))
      (setq dir (car dirs))
      (unless ff-quiet-mode
    (message "Find all occurences of <%s> in <%s>" pattern dir))
      (while (and dirs (or (not first) (not found)))
    ;; Unless dir contains a "/*" look for pattern in the directory;
    ;; otherwise search recursively in sub-directories.
    (if (and dir (not (string-match "\\([^*]*\\)/\\\*\\(/.*\\)*" dir)))
        ;; Not contains a "/*".
        (dolist (file (list (--file-expand-patterns pattern dir)))
          (if (not (file-exists-p file))
          (unless ff-quiet-mode
            (message "File <%s> not exists" file))
        (unless ff-quiet-mode (message "Found <%s>" file))
        (setq found (append found (list file)))
        )
          )
      ;; Else recurse sub-dirs.
      (when dir
        (if (match-beginning 2)
        (setq rest (substring dir (match-beginning 2) (match-end 2)))
          (setq rest ""))
        (setq dir (substring dir (match-beginning 1) (match-end 1)))
        (let ((dirlist (ff-all-dirs-under dir '(".svn" "." ".."))) subdir compl-dirs)
          (setq subdir (car dirlist))
          (while dirlist
        ;;              (unless ff-quiet-mode
        ;;                (message "Subdir <%s>: will be searched for file-pattern '%s'" subdir pattern))
        (setq compl-dirs (append compl-dirs (list (concat subdir rest))))
        (setq dirlist (cdr dirlist))
        (setq subdir (car dirlist)))
          (when compl-dirs
        (setq found (append found (--find-pathnames pattern compl-dirs first))))
          )
        )
      )
    (setq dirs (cdr dirs))
    (setq dir (car dirs)))
      ;; Return.
      (mapcar (lambda (a) (expand-file-name a)) (delete-dups found))
      )
    )
  )

(defun --find-first-path (pattern &optional dirnames)
  "Like `--find-pathnames', with FIRST enabled."
  (car (--find-pathnames pattern dirnames t)))

(defun --find-program (filename &optional dirnames)
  "Like `--find-first-path', but prepend the paths in the PATH envvar to DIRNAMES."
  (setq dirnames (append dirnames (split-string (getenv "PATH") (if --winntp ";" ":"))))
  (if --winntp
      (setq dirnames (append dirnames '("$USERPROFILE/bin" "$PROGRAMFILES/*" "c:/prog/*")))
    (setq dirnames (append dirnames '("$HOME/bin"))))
  (let ((ff-quiet-mode nil))
    (--find-first-path filename dirnames)))

(defun --find-file (filename &optional dirname fontnum)
  (let ((fn (--find-first-path filename dirname)))
    (if (not (--file-exists-p fn))
    (error "File <%s> not found" fn)
      (fru-find-file-reuse-frames fn)
      (delete-other-windows)
      (fru-maximize-frame)
      (when fontnum
    (fru-set-frame-font fontnum)))
    ))
(defun --find-garbage-files-dired (&optional dirname)
  "Run this function interactively, wait until the process terminated, then
mark files Note also \"%m\" in dired buffer with marks all files matching an
Emacs regexp (use \".*\" to mark all files)."
  (interactive "D")
  (let ((genl-files '("*.tmp" "*.bak" "*.log" "*.orig" "*.rej"
              "nul" "tags" "*.exe.stackdump"))
    ( tex-files '("*.loc" "*.toc" "*.dvi" "*.aux"))
    ( win-files '("*.jbf" "thumbs.db" "pspbrwse.jbf"))
    (msvc-files (if current-prefix-arg
            '("*.obj" "*.lib" "*.res" "*.map" "*.exp" "*.sbr" "*.pdb" "*.suo"
              "*.cv4" "*.pch" "*.ncb" "*.map" "*.csm" "*.idb" "*.bcw" "*.mbt"
              "*.obr" "*.mrt" "*.ilk" "*.plg" "*.crf" "*.rsp" "*.bsc")))
    ( gcc-files (if current-prefix-arg
            '("*.o" "*.a" "*.gch"))))
    (let ((xlist (flatten (append win-files genl-files tex-files msvc-files gcc-files))))
      (find-dired (--file-expand-patterns dirname)
          (strjoin (mapcar (lambda (a) (format "-iname '%s'" a)) xlist) " -o ")))
    )
  )

(defun --find-intermediate-files-dired ()
  "Run this function interactively, then wait until the process terminated,
then mark all files using an Emacs regex. Note also \"% m\" in dired buffer,
with prefix-arg unmark."
  (interactive)
  (let ((genl-garbage '(tmp bak orig rej))
    ( tex-garbage '(loc toc dvi aux))
    ( win-garbage '(jbf))
    (msvc-garbage '(obj lib res map exp sbr pdb suo cv4 pch ncb map csm idb bcw mbt obr mrt ilk plg crf))
    ( gcc-garbage '(o a)))
    (let ((alist (flatten (append win-garbage genl-garbage tex-garbage msvc-garbage gcc-garbage))))
      (find-dired (--file-expand-patterns "$PRJDIR")
          (strjoin (mapcar (lambda (a) (format "-name *.%s" a)) alist) " -o ")))
    )
  )

(defun --shell-command (cmd &optional prompt)
  "Execute CMD (PROMPT non-nil requires the user to acknowledge).
When CMD ends in an ampersand execute asynchronously."
  (when (or (not prompt)
        (yes-or-no-p (format "%s\nExecute this command? " cmd)))
    (let ((result (shell-command cmd))
      (b1 (get-buffer-window "*Async Shell Command*"))
      (b2 (get-buffer-window "*Shell Command Output*")))
      (when b1
    (delete-windows-on b1)
    (delete-frame (window-frame b1)))
      (when b2
    (delete-windows-on b2)
    (delete-frame (window-frame b2)))
      result)))

;;; -------- EMACS CONFIGURATION
;;; ---------------------------------------------------------------------------

(message "Startup font: %s" (frame-parameter nil 'font))

(if --emacs23p              ; Emacs 23.2+
    (setq major-mode 'text-mode
      fill-column 79
      tab-width 4)
  (setq default-major-mode 'text-mode
    default-fill-column 79
    default-tab-width 4)
  )
(prefer-coding-system 'latin-1-unix)
(setq sentence-end-double-space nil     ; two spaces are wrong in german (DIN 5008)
      version-control t                 ; version numbers for backup files
      delete-old-versions t             ; delete excess backup files silently
      dired-listing-switches "-al"
      dired-recursive-deletes t         ; delete non-empty directories
      kill-whole-line t
      truncate-lines t                  ; dont display continuation lines
      truncate-partial-width-windows t
      track-eol t
      resize-minibuffer-mode t
      line-number-mode t
      column-number-mode t
      tab-stop-list '(4 8 12 16 20 24 28 32 36 40 44 48 52 56 60 64 68 72 76 80)
      indent-tabs-mode nil
      search-highlight t
      case-fold-search nil              ; case-sensitive search/replace
      query-replace-highlight t
      query-replace-interactive nil
      transient-mark-mode t
      require-final-newline t           ; text files shall end in a newline
      next-line-add-newlines nil        ; stop at the end of the file, not just add lines
      read-file-name-completion-ignore-case t
      completion-ignore-case t
      comment-column 72
      automatic-hscrolling nil
      message-log-max 1000
      auto-revert-verbose nil
      inhibit-startup-screen t
      inhibit-startup-message t         ; make Emacs start without so much fanfare
      large-file-warning-threshold 100000000 ; 100 MB
      message-log-max 1000)

(transient-mark-mode 1)
(setq mark-even-if-inactive t)

(fset 'yes-or-no-p 'y-or-n-p)           ; replace "yes" by "y"
(show-paren-mode t)
(setq show-paren-delay 1
      show-paren-ring-bell-on-mismatch t
      show-paren-style 'mixed)

(icomplete-mode t)                      ; completion in the mini-buffer
(setq completion-ignore-case t
      completion-ignored-extensions ; completion ignores filenames ending in any string in this list
      (append '(".o" ".elc" ".ps" ".pdf" )
          completion-ignored-extensions))
(setq enable-local-variables t
      enable-local-eval 'maybe
      safe-local-variable-values
      (quote ((minor-mode . auto-revert)
          (buffer-file-coding-system . iso-latin-1-unix)
          (buffer-file-coding-system . iso-latin-1))))

(setq tramp-mode nil)

;;;; Start Emacs server

;; When some instance of GNU Emacs plays the role of the server we can use the
;; emacsclient program to quickly edit files. In practice, however, the server
;; feature is capricious. Under Windows we must suppress the "directory
;; ~/.emacs.d/server is unsafe" error on FAT32 partitions (see also
;; <http://brain-break.blogspot.com/2009/08/when-moving-from-gnu-emacs-22.html>).
;; Second handle that `server-start' throws when the server directory does not
;; exist. In succession Emacs won't start up again! Third handle the case that
;; the server is already running.

(unless (or --no-desktop --batch-mode)
  (require 'server)
  (when (and (= emacs-major-version 23)
         (= emacs-minor-version 1)
         (equal window-system 'w32))
    (defun server-ensure-safe-dir (dir) "Noop" t)) ; Suppress error "directory
                    ; ~/.emacs.d/server is
                    ; unsafe" on windows.
  (condition-case nil
      (server-start)
    (error
     (let* ((server-dir (if server-use-tcp server-auth-dir server-socket-dir)))
       (when (and server-use-tcp
          (not (file-accessible-directory-p server-dir)))
     (display-warning                   ; write to buffer <*Warnings*>
      'server "Unable to start the Emacs server, because the server-directory is not accessible." :warning)
     (display-warning
      'server (format "Creating %S" server-dir) :warning)
     (make-directory server-dir t)
     (server-start))))
    )
  )

;;;; Default coding system for files

;; The value of `default-buffer-file-coding-system' is `iso-latin-1-dos' by
;; default for NT/Emacs.

(if --winntp (set-default-coding-systems 'iso-latin-1))

;; In its default configuration, Emacs thinks BS (ASCII 8) and `C-h' are the
;; same (`backward-delete-char-untabify').

(global-set-key "\M-h" 'help-command)
(global-set-key "\C-h" 'help-command)

;; Setup european display (ISO 8859, Latin-1, Windows-Latin-1). Windows-Latin-1
;; are M$ additions to ISO-8859 character sets (not multilanguage compatible).

(if (eq emacs-major-version 19)
    (standard-display-european t)       ; else >= 20
  (set-language-environment "Latin-1")
  ;;(set-terminal-coding-system 'iso-8859-1)
  (standard-display-8bit 128 159))

;;;; Backup files

;; When you use Emacs to edit a file, it automatically creates a backup of the
;; original file (`make-backup-files'). Backup file have a tilde (<foo~>) at
;; the end. Emacs makes a backup for a file only the first time the file is
;; saved from a buffer. No matter how many times you subsequently save the
;; file, its backup remains unchanged. However, if you kill the buffer and then
;; visit the file again, a new backup file will be made. With <C-u C-x C-s> you
;; can explicitly tell Emacs to backup the version just saved when the file is
;; saved again.

(defvar --user-temporary-directory "~/.emacs.d/backups") ; refers to `auto-save-list-file-prefix'
(if (not (file-exists-p --user-temporary-directory))
    (make-directory --user-temporary-directory t))
(setq backup-directory-alist `(("." . ,--user-temporary-directory)))
(setq make-backup-files t
      version-control t                 ; numbered backups
      delete-old-versions t
      kept-old-versions 4
      kept-new-versions 8
      backup-by-copying t)

;;;; Autosave files

;; Before the user presses <C-x C-s> to save a file Emacs auto-saves files
;; (<#foo#>) based on counting keystrokes (`auto-save-interval') or when you
;; stop typing (`auto-save-timeout'). Emacs also auto-saves whenever it gets a
;; fatal error, including killing the Emacs job with a shell command. When the
;; user saves the file, the auto-saved version is deleted. But when the user
;; exits the file without saving it, Emacs or the X session crashes, the
;; auto-saved files still exist (`recover-file'). Emacs records interrupted
;; sessions for later recovery in files named <~/.emacs.d/auto-save-list>
;; (`recover-session').
;;
;; Since auto-saving happens "in-place" it can slow down editing when connected
;; to a slow machine. The second reason why auto-saving is disabled by default
;; is that many files contain sensitive data.

(setq auto-save-default nil)

;;;; Auto-Insert, Tooltips, Writestamps

(tooltip-mode t)
(setq tooltip-delay 0.5    ; seconds before displaying a tooltip the first time
      tooltip-hide-delay 8)             ; seconds before hiding the tooltip
(auto-insert-mode 1)
(add-hook 'find-file-hooks 'auto-insert)

(setq time-stamp-active t                ; enable writestamps
      time-stamp-line-limit 100          ; find in the first n lines
      time-stamp-format "%:y-%02m-%02d %02H:%02M:%02S"
      ;; time-stamp-format "%:y-%02m-%02d %02H:%02M:%02S %u" ; the original format
      time-stamp-start "\\$[wW]ritestamp: " ; regexp after which stamp is written
      time-stamp-end "\\$")

;;;; Display time in modeline

;; Runs a process which will update the mode-line every minute to tell the
;; time, load level and whether you have mail. This also runs the hook
;; `display-time-hook' after each update.

(setq display-time-day-and-date t
      display-time-24hr-format t)
(display-time)

;;;; Highlight current line (`hl-line')

(unless (or --no-desktop --batch-mode)
  (when --emacs21p
    (require 'hl-line)
    (setq hl-line-sticky-flag nil)))

;;;; Anti-RSI (Repeated Strain Injury) mode (`type-break-mode')
;;
;; Use `type-break' to take a break now. The command `type-break-statistics'
;; prints interesting things.
;;
;; - Keep your elbows slightly open, at around 121° (reduced the risk by 84%)
;;
;; - Leave more than 12 cm between the edge of the table and the "J" key (... by 62%)
;;
;; - Don't use your neck to hold the phone (... by 60%)
;;
;; - Avoid keyboard wrist rests (... by 48%)
;;
;; - Don't bend your wrists when holding the mouse. Keep it within 5° (... by 45%)
;;
;; - Strike the keys with a light touch, with less than 48 g of pressure (... by 40%)
;;
;; - Raise the screen so that your neck tilt by less than 3° (... by 36%)
;;
;; - Rest your elbows or forearms on the chair armrests, or on the desk itself (... by 35%)
;;
;; - Use a keyboard that is less than 3.5 cm thick (... by 35%)
;;
;; - Keep the keyboard slightly lower than your elbows (... by 23%)
;;
;; - Avoid resting your hands on the leading edge of your desk, or pad the edge (... by 22%)
;;
;; More tipps:
;;
;; - The keyboard should be pretty close to your lap. Like, within two inches
;;   or so. Don't use the feet on the back of the keyboard.
;;
;; - On a side view of your body, joints should be at right angles, roughly.
;;   Feet on the floor, back straight.
;;
;; - Take breaks at least every hour, preferably more.
;;     - Hold your hands at arms length away from your body.
;;     - Spread out your fingers on a horizontal plane. You'll feel
;;       stretching. Keep them there for several seconds.
;;     - Stretching.
;;
;; - Stress plays a factor in RSI.
;;
;; - Don't type with your wrists on the keyboard wrist pad. When typing, your
;;   fingers should be curved and below your wrists, like they would be if you
;;   played the piano. Never force wrists while typing.
;;
;; - Make CAPSLOCK work as an additional CTRL-key
;;   (http://www.emacswiki.org/emacs/MovingTheCtrlKey). So CTRL gets a more
;;   central position on the keyboard. Which, in Emacs, is quite useful
;;   considering ones frequent use of CTRL commands. However, this cannot be
;;   done in Emacs.

(unless --no-desktop
  (setq type-break-mode-line-message-mode t
    type-break-demo-functions '(type-break-demo-boring)
    type-break-time-warning-intervals '()
    ;; No type break file
    type-break-file-name nil)
  (type-break-mode))

;;; -------- POINT, MOUSE AND DISPLAY
;;; ---------------------------------------------------------------------------

;;;; Mouse color and behaviors

(mouse-avoidance-mode 'exile) ; push it out of the way when the cursor approaches
(if (load "mwheel" t)           ; turn on mouse-wheel scrolling
    (mwheel-install))
(setq mouse-scroll-delay 0.0)
(set-mouse-color "goldenrod")

(global-set-key [down-mouse-3] 'imenu)  ; right mouse button -> imenu

;;;; Cursor color and shape

;; (blink-cursor-mode nil)
(set-cursor-color "red")
(setq cursor-in-non-selected-windows nil
      cursor-type 'box)
(add-hook
 'post-command-hook
 (lambda ()
   "Change cursor color and type according to some minor modes."
   ;; Change cursor color according to mode; inspired by
   ;; <http://www.emacswiki.org/emacs/ChangingCursorDynamically>. Valid values
   ;; are
   ;;      t, nil, box, hollow, bar, (bar . WIDTH), hbar, (hbar. HEIGHT)
   (setq read-only-color        "darkgreen"
     read-only-type     'box
     overwrite-color        "brown"
     overwrite-cursor-type 'box
     regular-color          "orangered"
     regular-cursor-type    'box)
   (cond
    (buffer-read-only
     (set-cursor-color read-only-color)
     (setq cursor-type read-only-type)
     (blink-cursor-mode 0))
    (overwrite-mode
     (set-cursor-color overwrite-color)
     (setq cursor-type overwrite-cursor-type)
     (blink-cursor-mode 1))
    (t
     (set-cursor-color regular-color)
     (setq cursor-type regular-cursor-type)
     (blink-cursor-mode 0)))
   )
 )

;;;; Main colors (Font locking and faces)
;;
;; Define two static color schemes here for "light" and "dark" background (see
;; `frame-background-mode'). These schemes will look good on most displays. Try
;; `list-colors-display', `list-faces-display'.

(defun --set-my-faces ()
  (interactive)
  (custom-set-faces
   '(mode-line
     ((((class color) (background dark))
       (:foreground "whitesmoke" :background "darkblue"))
      (((class color) (background light))
       (:foreground "whitesmoke" :background "mediumblue"))))

   '(isearch-lazy-highlight-face        ; auto-highlighted text
     ((((class color) (background dark))
       (:bold t :foreground "darkred" :background "whitesmoke"))
      (((class color) (background light))
       (:bold t :foreground "black" :background "lemonchiffon"))))
   '(isearch
     ((((class color) (background dark))
       (:foreground "black" :background "yellow" :bold t :italic nil))
      (((class color) (background light))
       (:foreground "black" :background "yellow" :bold t :italic nil))))
   '(region                             ; selected text
     ((((class color) (background dark))
       (:foreground "yellow1" :background "gold4" :bold t))
      (((class color) (background light))
       (:foreground "springgreen" :background "black"))))

   '(fixed-pitch
     ((((class color) (background dark))
       (:bold t :foreground "darkgrey")
       ((class color) (background light))
       (:bold t :foreground "dimgrey"))))

   '(minibuffer-noticeable-prompt
     ((((class color) (background dark))
       (:bold t :foreground "mediumvioletred" :background "gray82"))
      (((class color) (background light))
       (:bold t :foreground "mediumvioletred" :background "whitesmoke"))))
   '(minibuffer-prompt
     ((((class color) (background dark))
       (:bold t :foreground "crimson" :background "gray82"))
      (((class color) (background light))
       (:bold t :foreground "midnightblue" :background "whitesmoke"))))

   '(font-lock-warning-face
     ((((class color))
       (:bold t :italic t :underline t :foreground "darkred"))))
   '(font-lock-builtin-face
     ((((class color) (background dark))
       (:foreground "blue4"))
      (((class color) (background light))
       (:bold t :foreground "blue4"))))
   '(font-lock-keyword-face
     ((((class color) (background dark))
       (:bold t :foreground "mediumblue"))
      (((class color) (background light))
       (:bold t :foreground "blue3"))))
   '(font-lock-constant-face
     ((((class color) (background dark))
       (:foreground "firebrick"))
      (((class color) (background light))
       (:foreground "darkred"))))
   '(font-lock-function-name-face
     ((((class color) (background dark))
       (:foreground "blue3"))
      (((class color) (background light))
       (:foreground "mediumblue"))))
   '(font-lock-variable-name-face
     ((((class color))
       (:foreground "darkslateblue"))))
   '(font-lock-type-face
     ((((class color))
       (:foreground "mediumblue"))))
   '(font-lock-yacc-face
     ((((class color)) (:foreground "forestgreen"))))

   ;; Colors for comments and embedded documentation.
   '(font-lock-comment-face
     ((((class color) (background dark))
       (:foreground "darkgreen"))
      (((class color) (background light))
       (:foreground "forestgreen"))))
   '(font-lock-doc-face
     ((((class color) (background dark))
       (:foreground "seagreen4" :width condensed))
      (((class color) (background light))
       (:underline t :foreground "mediumseagreen" :width condensed))))

   ;; Colors for quoted strings.
   '(font-lock-string-face
     ((((class color) (background dark))
       (:foreground "darkmagenta"))
      (((class color) (background light))
       (:foreground "MediumVioletRed"))))
   '(sh-heredoc-face
     ((((class color) (background dark))
       (:bold t :foreground "darkmagenta"))
      (((class color) (background light))
       (        :foreground "Firebrick"))))
   '(sh-quoted-exec
     ((((class color) (background dark))
       (:bold t :foreground "darkmagenta"))
      (((class color) (background light))
       (        :foreground "DarkOrange"))))

   ;; Colors for `cperl-mode'.
   '(cperl-array
     ((((class color))
       (:bold t :foreground "black"))))
   '(cperl-array-face
     ((((class color))
       (:bold t :foreground "black"))))
   '(cperl-hash
     ((((class color))
       (:bold t :italic t :foreground "black"))))
   '(cperl-hash-face
     ((((class color))
       (:bold t :italic t :foreground "black"))))
   '(cperl-invalid-face
     ((((class color))
       (:foreground "whitesmoke" :background "darkred"))))
   '(cperl-nonoverridable
     ((((class color))
       (:italic t :foreground "mediumblue"))))
   '(cperl-nonoverridable-face
     ((((class color))
       (:italic t :foreground "mediumblue"))))

   ;; Colors for `outline-mode' and `outline-minor-mode'.
   ;; Reused by `asciidoc-mode' (http://www.visualco.de)
   '(outline-1                          ; chapter
     ((((class color) (background light))
       (:height 1.3 :underline t :bold t :foreground "midnightblue"))
      (((class color) (background dark))
       (:height 1.3 :underline t :bold t :foreground "midnightblue"))))
   '(outline-2                          ; section
     ((((class color) (background light))
       (:height 1.2 :bold t :foreground "navyblue"))
      (((class color) (background dark))
       (:height 1.2 :bold t :foreground "navyblue"))))
   '(outline-3                          ; subsection
     ((((class color) (background light))
       (:height 1.1 :bold t :foreground "mediumblue"))
      (((class color) (background dark))
       (:height 1.1 :bold t :foreground "mediumblue"))))
   '(outline-4                          ; subsubsection
     ((((class color) (background light))
       (:height 1.1 :bold t :foreground "royalblue"))
      (((class color) (background dark))
       (:height 1.1 :bold t :foreground "royalblue"))))
   '(outline-5                          ; paragraph
     ((((class color) (background light))
       (:height 1.0 :bold t :foreground "cornflowerblue"))
      (((class color) (background dark))
       (:height 1.0 :bold t :foreground "cornflowerblue"))
      ))
   '(outline-6                          ; subparagraph
     ((((class color) (background light))
       (:height 1.0 :italic t :foreground "deepskyblue"))
      (((class color) (background dark))
       (:height 1.0 :italic t :foreground "deepskyblue"))))

   ;; Colors for mismatched parentheses.

   '(show-paren-match
     ((((class color) (background dark))
       (:background "whitesmoke" :bold t))) ;
     ((((class color) (background light))
       (:background "lemonchiffon" :bold t))))
   '(show-paren-mismatch
     ((((class color) (background dark))
       (:foreground "red2" :background "black" :bold t)))
     ((((class color) (background light))
       (:foreground "red2" :background "black" :bold t))))
   )

  ;; Colors for the `ido' feature.

  (if (featurep 'ido)
      (custom-set-faces
       '(ido-first-match                ;-face
     ((((class color)(min-colors 88))
       (:foreground "black" :background "yellow" :bold t))))
       '(ido-only-match                 ;-face
     ((((class color)(min-colors 88))
       (:foreground "black" :background "yellow" :bold t))))
       '(ido-subdir                     ;-face
     ((((class color)(min-colors 88))
       (:foreground "forestgreen" :background "yellow" :bold t))))
       '(ido-indicator                  ;-face
     ((((class color)(min-colors 88))
       (:foreground "forestgreen" :background "yellow" :bold t)))
     (t (:inverse-video t)))
       )
    )

  ;; Colors for `hl-line-mode', line continuation and trailing whitespace and
  ;; end of line. Use `nobreak-space' face for ellipsis and end of line
  ;; (outline + selective display,
  ;; <http://www.emacswiki.org/emacs/OutlineMode#toc3>).

  (when (featurep 'hl-line)
    (custom-set-faces
     (if --emacs22p
     '(hl-line
       ((((class color) (background dark))
         (:bold t :background "whitesmoke"))
        (((class color) (background light))
         (:bold t :background "papaya whip"))))
       '(highlight                      ; Emacs 21 only
     ((((class color) (background dark))
       (:bold t :background "whitesmoke"))
      (((class color) (background light))
       (:bold t :background "darkolivegreen1"))))
       )
     )
    )

  (custom-set-faces
   '(trailing-whitespace
     ((((class color) (background dark))
       (:bold t :background "whitesmoke"))
      (((class color) (background light))
       (:bold t :background "gray92"))))
   '(sh-escaped-newline
     ((((class color) (background dark))
       (:bold t))
      (((class color) (background light))
       (:bold t :foreground "OrangeRed"))))
   )

  (if (>= emacs-major-version 23)
      (set-display-table-slot
       standard-display-table 'selective-display
       (let ((face-offset (* (face-id 'nobreak-space) (lsh 1 22))))
     (vconcat (mapcar (lambda (c) (+ face-offset c)) "...")))
       )
    ;; Else use a different string only.
    (set-display-table-slot standard-display-table
                'selective-display (string-to-vector " [...]"))
    )
  )

(global-font-lock-mode t)
(setq font-lock-support-mode 'jit-lock-mode
      font-lock-verbose nil
      font-lock-maximum-decoration t)
(add-hook 'after-init-hook '--set-my-faces)

;;;; Outline mode
;;
;; Calls `text-mode-hook' and then `outline-mode-hook'.

;;(eval-after-load "outline" '(require 'foldout))
(add-hook 'outline-mode-hook (lambda() (hide-body) (outline-next-visible-heading 1)))
(add-hook 'outline-minor-mode-hook (lambda() (--outline-minor-mode-key-bindings)))

(defun --outline-minor-mode-key-bindings (&optional regexp level)
  "When REGEXP is non-nil enable `outline-minor-mode' and set `outline-regexp' and `outline-level'.
Outline mode searches for matches of `outline-regexp' and then calls the
function `outline-level' on each to determine the depth at which a statement is
nested in the outline, e.g.

    (defun outline-level () ; very simple approach
        (- (match-end 0) (match-beginning 0)))

When REGEXP is nil assume outline-minor-mode is already enabled.

Finally bind the regular `outline-mode' C-c keymap. Although this may interfere
with some major mode, whose hook-function actually called
`--outline-minor-mode-key-bindings', the C-c @ map established by
`outline-minor-mode' is too unhandy."
  (when regexp
    (outline-minor-mode t)
    (set (make-local-variable 'outline-regexp) regexp)
    ;; Since this function is called from a major-mode hook. `outline-level' is maybe
    ;; `lisp-outline-level', `latex-outline-level' etc. and must be reset because it is incompatible
    ;; with the new REGEXP.
    (setq outline-level (if level level 'outline-level)))
  ;; Bind keys `C-HOME' and `C-END'.
  (local-set-key [(control home)]
         '(lambda() "Show previous entry."
            (interactive) (hide-entry)
            (unless (or (and (not (bolp)) (outline-back-to-heading)) (outline-get-last-sibling))
              (outline-previous-visible-heading 1))
            (show-entry)(recenter)))
  (local-set-key [(control end)]
         '(lambda() "Show next entry."
            (interactive) (hide-entry)
            (outline-next-visible-heading 1)
            (show-entry) (recenter)))
  ;; Map the safe C-c@ prefix of `outline-minor-mode' to C-c as with
  ;; `outline-mode'. Note that `--outline-minor-mode-key-bindings' typically is
  ;; called from mode hooks, so this destroys bindings made so far.
  (local-set-key [(control c)(control n)] 'outline-next-visible-heading)
  (local-set-key [(control c)(control p)] 'outline-previous-visible-heading)
  (local-set-key [(control c)(control f)] 'outline-forward-same-level)
  (local-set-key [(control c)(control b)] 'outline-backward-same-level)
  (local-set-key [(control c)(control u)] 'outline-up-heading)
  (local-set-key [(control c)(control a)] 'show-all)
  (local-set-key [(control c)(control e)] 'show-entry)
  (local-set-key [(control c)(control k)] 'show-branches)
  (local-set-key [(control c)(tab)] 'show-children)
  (local-set-key [(control c)(control s)] 'show-subtree)
  (local-set-key [(control c)(control t)] 'hide-body)
  (local-set-key [(control c)(control c)] 'hide-entry)
  (local-set-key [(control c)(control d)] 'hide-subtree)
  (local-set-key [(control c)(control q)] 'hide-sublevels)
  (local-set-key [(control c)(control o)] 'hide-other)
  ;; Bind C-c C-l to provide a better `hide-leaves' using `hide-sublevels'.
  ;; Therefore we go upwards to the next blank line and call `hide-sublevels'
  ;; on it, which hides bodies more effectively than `hide-leaves'.
  ;;;;(local-set-key [(control c)(control l)] 'hide-leaves)
  (local-set-key [(control c)(control l)]
         '(lambda() (interactive)
            (let (stop)
              (save-excursion
            (end-of-buffer-nomark)
            (while (and (not stop) (not (bobp)))
              (if (setq stop (looking-at "^[^* \t\n\^M\^L]*$")) ; blank line?
                  (hide-sublevels 1)
                (previous-line-nomark))))))
         )
  )

;; Trailing whitespace and visible TABs
;;
;; http://www.emacswiki.org/emacs/ShowWhiteSpace

(add-hook 'after-init-hook            ; assume this is run before the mode hook
      '(lambda()
         (mapc
          (lambda (hook)
        (add-hook hook (lambda() (setq show-trailing-whitespace t))))
          '(text-mode-hook
        change-log-mode-hook
        scheme-mode-hook
        emacs-lisp-mode-hook
        cperl-mode-hook
        sh-mode-hook
        c-mode-common-hook))
         )
      )

;;;; Toggle selective display (F10) and whitespace-mode (C-x F10)

(global-set-key [f10]
        (lambda() "Emacs has the ability to hide lines indented more
than a certain number of columns. Toggle selective display at prefix-arg or
column 1."
          (interactive)
          (set-selective-display
           (if selective-display nil (or current-prefix-arg 1)))))

(global-set-key [?\C-x f10] 'whitespace-mode)

;;; -------- ABBREVATIONS
;;; ---------------------------------------------------------------------------

;;;; Dynamic abbrevations

;; Load `abbrev-file-name' (default: <~/.abbrev_defs>). The `--abbrev-*'
;; functions are helper functions for hooks set by `declare-abbrev-table'.

(defun --abbrev-backward-char ()
  (backward-char) t) ; return non-nil to inhibit insertion of the character
                    ; that triggered the expansion
(put '--abbrev-backward-char 'no-self-insert t)

(global-set-key [(backtab)] 'dabbrev-expand) ; S-TAB - alternately use `abbrev-expand'
(global-set-key [f3] 'dabbrev-expand)
(setq dabbrev-case-replace nil)         ; reserve case when expanding

(abbrev-mode 1)
(if --emacs23p                          ; enable abbrev-mode for all buffers
    (setq abbrev-mode t)
  (setq default-abbrev-mode t))
(condition-case nil
    (quietly-read-abbrev-file)
  (error "%s not found" abbrev-file-name))

;;; -------- SEARCH/REPLACE
;;; ---------------------------------------------------------------------------

;;;; I-search symbol at point

;; I-search with initial contents (symbol at point). Both variants are
;; modified, and based on code from
;; <http://www.emacswiki.org/emacs/SearchAtPoint>.`isearch-forward-at-point' is
;; like `isearch-forward', but bound to <M-s> and directly begins the search
;; for the symbol at point. `isearch-yank-symbol' extends `isearch-forwards',
;; by overloading <C-y> which normally yanks the rest of the line at the
;; Isearch command prompt. This is particular unuseful; yanking the symbol (as
;; defined by the current programming mode) is a more obvious binding. Note
;; that the Emacswiki-version had bugs; below is a corrected version.

(defvar isearch-initial-string nil)

(defun isearch-set-initial-string ()
  (remove-hook 'isearch-mode-hook 'isearch-set-initial-string)
  (setq isearch-string isearch-initial-string)
  (isearch-search-and-update))

(defun isearch-forward-at-point (&optional regexp-p no-recursive-edit)
  "Interactive search forward for the symbol at point."
  (interactive "P\np")
  (if regexp-p
      (isearch-forward regexp-p no-recursive-edit)
    (let* ((end (progn (skip-syntax-forward "w_") (point)))
       (begin (progn (skip-syntax-backward "w_") (point))))
      (if (eq begin end)
      (isearch-forward regexp-p no-recursive-edit) ; no symbol
    (setq isearch-initial-string (buffer-substring begin end))
    (add-hook 'isearch-mode-hook 'isearch-set-initial-string)
    (isearch-forward regexp-p no-recursive-edit)))))
(define-key global-map "\M-s" 'isearch-forward-at-point)
(define-key isearch-mode-map "\M-s" 'isearch-repeat-forward)

(defun isearch-yank-regexp (regexp)
  "Pull REGEXP into search regexp."
  (let ((isearch-regexp nil))
    (isearch-yank-string regexp))
  (if (not isearch-regexp)
      (isearch-toggle-regexp))
  (isearch-search-and-update))
(defun isearch-yank-symbol ()
  "Turn symbol at point into regexp search string."
  (interactive)
  (let ((sym (find-tag-default)))
    (if (null sym)
    (message "No symbol at point")
      (message (regexp-quote sym))
      (isearch-yank-regexp (concat "\\<" (regexp-quote sym) "\\>")))))
(define-key isearch-mode-map "\C-y" 'isearch-yank-symbol)

;;;; Query/Replace

;; Use `tags-query-replace' to `query-replace-regexp' on all files listed in
;; tags table. See <http://www.emacswiki.org/emacs/CategorySearchAndReplace>

(defadvice query-replace-read-args (before barf-if-buffer-read-only activate)
  "Signal a `buffer-read-only' error if the current buffer is read-only."
  (barf-if-buffer-read-only))

(defun --smart-query-replace (from to &optional delimited)
  "Like `query-replace', but operate on the whole buffer and propose symbol at
point. Third arg DELIMITED (interactive prefix-arg), if non-nil, means replace
only matches at word boundaries."
  ;; Motivation: `query-replace' (incremental) and `replace-string' (global)
  ;; replaces those occurrences between `point' and the end of the buffer. Also
  ;; there's no way to access the symbol at point.
  (interactive
   (let ((common (query-replace-read-args "Query replace (whole buffer)" nil)))
     (list (nth 0 common) (nth 1 common) (nth 2 common))))
  (let ((case-fold-search t))
    (if (and transient-mark-mode mark-active)
    (deactivate-mark))
    (perform-replace
     (when (length from) from (--wap t delimited))
     to t nil delimited nil nil (point-min) (point-max))))

(global-set-key "\M-r" '--smart-query-replace) ; default `move-to-window-line'

;;;; Global `cc-search-directories' and `cc-other-file-alist'

;; These are global lists of directories to search for a specific file by
;; `find-file' etc.

(require 'find-file)
(setq ff-case-fold-search nil        ; allows extensions in different cases
      ff-always-try-to-create nil    ; don't create other file if was not found
      ff-quiet-mode nil
      ff-ignore-include nil
      cc-search-directories
      (append cc-search-directories
          '("." ".." "../.."
        "../src" "../../src"
        "../inc" "../../inc"
        "../include" "../../include"))
      cc-other-file-alist
      (append '(("\\.html$" (".pl" ".pm"))
        ("\\.c$" (".h"))
        ("\\.cpp$" (".hpp" ".h" ".inl"))
        ("\\.hpp$" (".C" ".cpp" ".tt"))
        ("\\.h$"(".inl" ".c" ".cpp" ".l" ".y" ".tt"))
        ("\\.tt$"(".h"))
        ("\\.tex$" (".txt" ".sty" ".log")))
          cc-other-file-alist))

(when --unixp
  (setq cc-search-directories
    (append cc-search-directories
        '("/usr/*/include"
          "/usr/*/include/*"
          "/usr/*/include/*/*"  ; e.g. /usr/local/include/c++/4.0.1/
          "/usr/include/sys"
          "/usr/include/sys/*"))))
(when --cygwinp
  (setq cc-search-directories
    (append cc-search-directories
        '("$CYGNUSDIR/*/include"))))

(when (getenv "INCLUDE")
  (setq cc-search-directories (append cc-search-directories
                      (split-string (getenv "INCLUDE") (if --winntp ";" ":")))))

;;;; Enable `ido-mode' (interactive do)
;;
;; Switches between buffers, files and directories with a minimum of
;; keystrokes, by using a different completion function. It superseeds
;; `iswitchb', which provided that functionality only for buffer switching.

(condition-case nil
    (progn
      (require 'ido)
      (ido-mode 1)
      (setq ido-everywhere t
        ido-enable-flex-matching t  ; match any characters in the substring
        ido-confirm-unique-completion t ; wait for RET on unique TAB completeions
        ido-max-prospects 20)
      (add-hook ; sort some buffers to the end - copied from
                    ; `ido-summary-buffers-to-end' code
       'ido-make-buffer-list-hook
       '(lambda()
      (let ((summaries
         (delq nil (mapcar
                (lambda (x)
                  (if (or (--is-transient-buffer x)
                      (string-match "Summary" x)
                      (string-match "output\\*\\'" x)) x))
                ido-temp-list))))
        (ido-to-end summaries))))
      (global-set-key [(C-next)] 'ido-switch-buffer)
      (global-set-key [(C-prior)] 'ido-switch-buffer-other-frame))
  (error
   ;; In case there's no `ido-mode' (Emacs 21 or below) use its ancestor
   ;; `iswitchb' in conjunction with `icomplete' and `ffap'.
   (icomplete-mode 1)
   (when (fboundp 'ffap-bindings) (ffap-bindings))
   (require 'iswitchb)
   (setq iswitchb-default-method 'always-frame)
   (iswitchb-default-keybindings)
   (global-set-key [(C-next)] 'iswitchb-buffer)
   (global-set-key [(C-prior)] 'iswitchb-buffer-other-frame))
  )

;;; -------- ETAGS / EBROWSE
;;; ---------------------------------------------------------------------------

;; Principally we use multiple tags files here, i.e. we append
;; `tags-table-list' and set `tags-file-name' to nil.
;;
;; Stray tags files are created by the find-tag advice.

(require 'etags)

(setq tags-case-fold-search t
      tags-revert-without-query t
      tags-add-tables 'ask-user)

(defvar --etags-cmd
  (if --winntp
      ;; EmacsW32 seems to push its "bin" directory to the front of PATH, so
      ;; <etags.exe> shall be found. Prevent use of Cygwin ctags under NT,
      ;; since file arguments then have to be filtered by cygpath
      "etags"
    ;; Default tags command for *NIX.
    "ctags -e"))

(defvar --scratch-tags-file
  (expand-file-name "TAGS" --scratch-directory)
  "File <TAGS> in `--scratch-directory'.")

(defun mktags (&optional reset)
  "Replaces the TAGS target of a makefile.
Run etags on all `cc-search-directories' appending `--scratch-tags-file'.
With RESET being non-nil (interactively, with prefix-arg) remove the file
first."
  (interactive "p")
  (let ((ff-quiet-mode t)
    (x --scratch-tags-file))
    (when (and reset (--file-exists-p x))
      (message "Removing default tags-file '%s'" x)
      (delete-file x))
    (let ((l (--find-pathnames nil cc-search-directories)))
      (while l
    (setq d (car l) l (cdr l))
    ;; ctags --list-kinds: classes(c), structs(s), unions(u), typedefs(t),
    ;;                     macros(d), prototypes(p), enum-names(g),
    ;;                     extern-vars(x)
    (let ((cmd (format "%s --append=yes --c++-kinds=csutdpgx -f '%s' %s/*"
               --etags-cmd x d)))
      (message cmd)
      (shell-command cmd)))))
  (delete-other-windows)
  (--populate-tags-table-list))

(defadvice find-tag (around adhoc-refresh-etags activate)
  "When a tag was not found append local TAGS file by running etags on the
current file, visit the tags file and redo `find-tag'."
  ;; This advice is based on an idea by Järneström Jonas
  ;; (<http://paste.lisp.org/display/70466/raw>).
  (let* ((filename (buffer-file-name))
     (dirname (file-name-directory filename))
     (extension (and filename (file-name-extension filename))))
    (condition-case err
    ad-do-it
      (error
       ;; Tag not found error catched. `buffer-file-name' is some tags file
       ;; now, since the etags feature searches the current tags file using
       ;; relatively simple regexes (see `find-tag-in-order').

       (and (buffer-modified-p)
        (not (ding))
        (yes-or-no-p "Buffer modified, save it? ")
        (save-buffer))
       (let* ((tags-revert-without-query t)
          (ad-hoc-tags (format "%s/TAGS" dirname))
          (cmd (format "%s -a -f '%s' '%s' *.%s" --etags-cmd ad-hoc-tags filename
               (or extension "el"))))
     (message "Running: %s" cmd)
     (shell-command (concat cmd " 2>/dev/null"))
     (--append-tags-file ad-hoc-tags))
       ad-do-it)))
  )

(defun --find-tag (tagname &optional next-p regexp-p)
  "Like `find-tag' but prompts with the tag arround point and create ad-hoc tags.
Ad-hoc tags files are \"stray tags files\" in the buffer directory. If second
arg NEXT-P is t (interactively, with prefix arg) continue a `tags-search'."
  (interactive (list (--read-string "Find tag" (find-tag-default))))
  (when nil
    (let ((stray (--file-expand-patterns "TAGS")))
      (let ((auto-tags (flatten (list --scratch-tags-file stray))))
    (while auto-tags
      (setq fname (car auto-tags))
      (setq dname (file-name-directory fname))
      (setq auto-tags (cdr auto-tags))
      (setq notexists (not (--file-exists-p fname)))
      (message "Examine tags-file <%s>" fname)
      (when (or notexists (--file-empty fname))
        (when (yes-or-no-p (format "Tags file <%s> %s.\n      Create from sources in <%s>? "
                       fname (if notexists "does not exist" "is empty") dname))
          (let ((cmd (format "%s -f '%s' %s/*.h %s/*.el %s/*.pm"
                 --etags-cmd fname dname dname dname)))
        (message "Running: %s" cmd)
        (shell-command (concat cmd " 2>/dev/null")))
          (--append-tags-file fname)))
      )
    )
      )
    )
  ;; Find TAGNAME.
  (if (or current-prefix-arg next-p)
      (find-tag tagname t regexp-p)
    (condition-case nil
    (find-tag tagname nil regexp-p)
      ;; When `find-tag' throws our advice was of no avail.
      ;; Maybe the tag is in other sources in buffer directory.
      ;; TODO: append --scratch-tags-file with sources in buffer directory?
      (error (message "No tags containing '%s'" tagname))))
  )

(defun --find-tag/quiet ()
  "Like `find-tag' but use text at point as the tagname, do not prompt."
  (interactive) (find-tag (find-tag-default) current-prefix-arg))

(defun --find-tag/here (&optional adhoc)
  "Like `--find-tag' but after retagging sources in the current directory.
When the tags file existed it is deleted. If ADHOC (interactively, with
prefix-arg) use `--scratch-tags-file')."
  (interactive)
  (and (buffer-modified-p)
       (yes-or-no-p "Buffer modified, save it? ") (save-buffer))
  (let ((deftag (find-tag-default))
    (tagsfile (if (or current-prefix-arg adhoc)
              --scratch-tags-file
            (--file-expand-patterns "TAGS")))
    (tags-revert-without-query t))
    (if (--file-exists-p tagsfile)
    (delete-file tagsfile))

    (let ((cmd (format "%s -f '%s' *akefile *.h *.hpp *.pm *.el" --etags-cmd tagsfile)))
      (message "Running: %s" cmd)
      (if (and --winntp (not --cygwinp))
      (eshell-command cmd)     ; a shell entirely implemented in Emacs Lisp
    (shell-command cmd)))
    (unless (--file-exists-p tagsfile)
      (error "No tags file found in '%s'." default-directory))
    (--append-tags-file tagsfile)
    (--find-tag (--read-string "Find tag" deftag)))
  )

(defun --append-tags-file (&optional some-tags-file)
  "Use this function in place of `visit-tags-table' to append SOME-TAGS-FILE to
the list of available tags files, if non-nil. Then clean up the list from
duplicate, non-existing or empty files."

  ;; `visit-tags-table' sets `tags-file-name', so it cannot be used to append
  ;; `tags-table-list'. Note, however, that neither `visit-tags-table' nor
  ;; `--append-tags-file' actually read in the tags table contents until you
  ;; try to use them.

  (when tags-file-name
    (message "WARNING: tags-file-name cleared (was set to '%s')" tags-file-name)
    (setq tags-table-list (append tags-table-list tags-file-name))
    (setq tags-file-name nil))
  (when (and some-tags-file (not (tags-table-list-member some-tags-file tags-table-list)))
    (setq tags-table-list (append tags-table-list (list some-tags-file))))
  )

(defun --clean-tags-table-list ()
  "Free the list from duplicate, non-existing or empty tags files."
  (setq tags-table-list
    (flatten
     (delete-dups
      (append '() (mapcan
               '(lambda (f)
              ;; `append' removes nil -> make sure `lambda' returns
              ;; nil nless exists.
              (when (and (stringp f)
                     (or (--directory-exists-p f)
                     (and (--file-exists-p f)
                          (not (--file-empty f)))))
                (list f)))
               tags-table-list)))))
  )

(defun --enumerate-tags-table-list (&optional clean)
  (interactive "p")
  (--append-tags-file)
  (message "These tags files are listed:")
  (let ((l tags-table-list))
    (while l
      (message "    %s" (car l))
      (setq l (cdr l))))
  (when clean
    (--clean-tags-table-list)
    (message "These tags files actually contain tags:")
    (let ((l tags-table-list))
      (while l
    (message "  %s" (car l))
    (setq l (cdr l))))
    )
  )

(defun --populate-tags-table-list (&optional extra-files)
  "Append all existing tags files under `cc-search-directories'.
Consider:
    (add-hook 'after-init-hook '--populate-tags-table-list)"
  (interactive)
  (let ((ff-quiet-mode t))
    (setq tags-table-list
      (flatten (append tags-table-list extra-files
               (--find-pathnames "TAGS" cc-search-directories))))
    )
  )


(add-hook 'after-init-hook '(lambda()
                  (--append-tags-file --scratch-tags-file)
                  (--populate-tags-table-list)))

(global-set-key [f11] '--find-tag/quiet)
(global-set-key [?\M-.] '--find-tag)
(global-set-key [?\C-x ?\M-.] '--find-tag/here)
(global-set-key [(control kp-divide)] 'tags-search)
(global-set-key [(meta kp-divide)] 'tags-query-replace)
(global-set-key [(control kp-subtract)]
        '(lambda () "Back to first found item."
           (interactive) (tags-loop-continue t)))
(global-set-key [(control kp-add)]
        '(lambda () "Continue `tags-search', `tags-query-replace' or `find-tag'."
           (interactive)
           (condition-case nil (tags-loop-continue)
             (error ; no tags-search/replace in progress -> find next `last-tag'
              (find-tag last-tag t)))))
(global-set-key [(control kp-multiply)] 'pop-tag-mark) ; pop back to where `find-tag' was invoked
(global-set-key [(control kp-enter)] 'list-tags)

;;;; BROWSE file (ebrowse)

;; Class browser for C++. It consists of a fast C parser for C++, the <ebrowse>
;; program, which creates file <BROWSE> and some Lisp.

(when nil
  (defun --toggle-ebrowse ()
    "Toggle ebrowse-buffer. With prefix-arg kill it."
    (interactive)
    (setq bfn (concat (--startup-directory) "BROWSE"))
    (unless (--file-exists-p bfn)
      (error (format "<%s> not exists - stop" bfn)))
    (setq bbf (get-file-buffer bfn))
    (if current-prefix-arg
    (when bbf
      (set-register ?b nil)
      (set-register ?e nil)
      (delete-windows-on bbf)
      (kill-buffer bbf)
      (kill-buffer "*Tree Statistics*")
      (kill-buffer "*Members*"))
      (if bbf
      ;; Browser buffer exists, to toggle between it and ?e.
      (if (or (eq bbf (current-buffer))
          (string= (buffer-name) "*Members*"))
          ;; Current buffer is some ebrowse-buffer -> back to ?e
          (progn (if (> (count-windows) 1)
             (window-configuration-to-register ?b)
               (set-register ?b nil))
             (jump-to-register ?e t))
        ;; Current buffer is NOT some ebrowse-buffer -> back to ?b
        (if (and (get-buffer-window bbf)
             (not (or (window-live-p (get-buffer-window bbf))
                  (window-live-p (get-buffer-window "*Members*")))))
        ;; No ebrowse-buffer visible -> save ?e and show browser.
        (progn
          (window-configuration-to-register ?e)
          (if (get-register ?b)
              (jump-to-register ?b t)
            ;; ?b not available -> switch to ebrowse-buffer.
            (delete-other-windows)
            (switch-to-buffer bbf t)
            (when (setq bbf (get-buffer "*Members*"))
              (split-window-vertically)
              (other-window 1)
              (switch-to-buffer bbf t)
              (other-window -11))))
          ;; Else some ebrowse-buffer is visible in some other window;
          ;; delete these windows, then overwrite ?e and clear ?b.
          (delete-windows-on bbf)
          (delete-windows-on "*Members*")
          (set-register ?b nil)
          (window-configuration-to-register ?e))
        )
    ;; No browse buffer yet loaded. Store editor-windows to ?e and
    ;; initially open the browse file in this frame, in a single window.
    (window-configuration-to-register ?e)
    (set-register ?b nil)
    (delete-other-windows)
    (find-file bfn)
    (ebrowse-tree-mode))
      )
    )
  (add-hook 'c-mode-common-hook '(lambda() (local-set-key [f11] '--toggle-ebrowse)))
  (add-to-list 'auto-mode-alist '("\\(BROWSE\\|BROWSE\\.*\\)" . ebrowse-tree-mode))
  )

;;; -------- SYSTEM INTERFACE
;;; ---------------------------------------------------------------------------

;;;; Shell environment (Cygwin/Cmd)
;;
;;  F12         toggle between shell buffer and current window configuration
;;  SHIFT-F12   like before, but let shell buffer appear in a dedicated frame
;;  ALT-F12     inject a pushd to change to directory of current buffer
;;  CTRL-F12    `shell-command'

(global-set-key [(f12)] '--toggle-shell)
(global-set-key [(shift f12)] '(lambda()(interactive)(--toggle-shell 'frame)))
(global-set-key [(meta f12)] '(lambda()(interactive)(--toggle-shell nil t)))
(global-set-key [(meta f10)] '(lambda()(interactive)(--toggle-shell nil t)))
(global-set-key [(control f12)] 'shell-command) ; alias M-!

(cond
 (--winntp
  (defun cmd()
    "Launch the NT Command console in the buffer's directory."
    (interactive)
    (w32-shell-execute "open" "cmd"))
  (defun explorer (file)
    "Launch Windows Explorer."
    (interactive "fFile/Folder: ")
    (let ((w32file (substitute ?\\ ?/ (expand-file-name file))))
      (if (file-directory-p w32file)
      (w32-shell-execute "explore" w32file "/e,/select,")
    (w32-shell-execute "open" "explorer" (concat "/e,/select," w32file)))))
  (defun remote-desktop (&optional rdpfile)
    "Connect to a machine using the XP remote desktop connection in console mode."
    (interactive)
    (w32-shell-execute "open" "mstsc.exe"))

  )
 )

(setq shell-prompt-pattern "^[^#$%<>\n]* *[#$%>~] *"
      comint-prompt-regexp shell-prompt-pattern)
(cond
 (--cygwinp
  (defun xterm()
    "Launch a shell (rxvt) in the buffer's directory."
    (interactive)
    (w32-shell-execute "open" "rxvt"
               (concat (getenv "XTERM_SWITCHES") " -T 'xterm' -e bash"))
    )
  ;; Attempt to use Cygwin Bash. Default is COMSPEC.
  (if (load "cygwin-mount" t)
      (condition-case nil
      (progn
        (cygwin-mount-activate)
        (unless (getenv "CYGNUSDIR")
          (setenv "CYGNUSDIR" "c:\\cygwin"))
        (unless (getenv "BASH_ENV")
          (setenv "BASH_ENV" (--find-first-path ".bash_env" (list "$HOME" "$USERPROFILE" "c:/" "h:/"))))
        (setq exec-path (cons (concat (getenv "CYGNUSDIR") "\\bin") exec-path))
        (setq shell-file-name "bash"
          shell-command-switch "-c"
          explicit-bash-args '("--login" "--noediting" "-i")
          dired-chmod-program "chmod"
          w32-quote-process-args ?\"
          w32-allow-system-shell t
          w32-system-shells (append '("bash" "bash.exe") w32-system-shells))
        (setq explicit-shell-file-name shell-file-name)
        (setenv "SHELL" shell-file-name)
        (setenv "PS1" "[\\j] \\w > ")
        (setenv "PID" nil)
        (setenv "MAKE_MODE" "UNIX")
        (add-hook 'comint-output-filter-functions
              '(lambda (text)   ; perfect-track-directory
             (if (string-match "\\w*Working directory is ||\\([^|]+\\)||" text)
                 (cd (substring text (match-beginning 1) (match-end 1))))) nil t)
        (add-hook 'comint-output-filter-functions 'shell-strip-ctrl-m nil t) ; no ^M echoing
        (add-hook 'comint-output-filter-functions 'comint-watch-for-password-prompt nil t)
        (fset 'original-comint-exec-1 (symbol-function 'comint-exec-1))
        (defun comint-exec-1 (name buffer command switches)
          (let ((binary-process-input t)
            (binary-process-output nil))
        (original-comint-exec-1 name buffer command switches)))
        )
    (error))
    )
  )
 (--unixp
  (add-hook 'comint-output-filter-functions 'comint-strip-ctrl-m)
  (add-hook 'comint-output-filter-functions 'comint-watch-for-password-prompt nil t)
  )
 )

(autoload 'comint-add-scroll-to-bottom "comint-scroll-to-bottom"
  "Activate `comint-scroll-to-bottom'.")

(setq comint-file-name-quote-list '(?\   ?\")
      process-coding-system-alist
      (cons '("bash" . undecided-unix) process-coding-system-alist))

(add-hook 'after-init-hook
      '(lambda()
         (when (and --winntp --emacs22p)
           (set-message-beep 'silent))
         (when (get-buffer "*Shell Configuration*")
           (kill-buffer "*Shell Configuration*")
           (delete-other-windows)))
      t)

(add-hook 'shell-mode-hook
      '(lambda()
         ;; NOT shell script programming mode. General settings. See also
         ;; <http://www.emacswiki.org/cgi-bin/wiki/ansi-color.el>
         (setq comint-prompt-regexp shell-prompt-pattern
           comint-completion-addsuffix t
           comint-scroll-show-maximum-output 'this
           comint-eol-on-send t)
         (setq shell-dirstack-query "cygpath -w `dirs`")
         (make-variable-buffer-local 'comint-completion-addsuffix)
         (load-library "ansi-color")
         (ansi-color-for-comint-mode-on))
      )

(defvar --toggle-shell-last-window-conf nil "The last window configuration.")
(defvar --toggle-shell-last-buf nil "The last buffer object in case there's no last window configuration.")
(defvar --toggle-shell-last-frame nil "The frame that was selected when opening a shell buffer.")

(defun --toggle-shell-have-conf ()
  (window-configuration-p --toggle-shell-last-window-conf))
(defun --toggle-shell-store-last-conf ()
  (setq --toggle-shell-last-buf (current-buffer)
    --toggle-shell-last-frame (selected-frame)
    --toggle-shell-last-window-conf (current-window-configuration)))
(defun --toggle-shell-restore-last-conf ()
  (if (--toggle-shell-have-conf)
      (progn (raise-frame --toggle-shell-last-frame)
         (set-window-configuration --toggle-shell-last-window-conf))
    (let ((bufnam (if (bufferp --toggle-shell-last-buf)
              (buffer-name --toggle-shell-last-buf) --toggle-shell-last-buf)))
      (if bufnam
      (if (get-buffer bufnam) (switch-to-buffer bufnam t)
        (message "%s: buffer not available" bufnam))))))

(defun --toggle-shell (&optional display inject-cd)
  "Toggles between current buffers and a system shell buffer. With prefix-arg
close the shell.

When DISPLAY is 'vertical splits the shell as vertical window; when 'frame uses
a dedicated frame (default: single window). When INJECT-CD executes a `pushd'
to the working directory of the buffer from which you toggled the shell."
  (interactive)
  (let* ((shell-buf (get-buffer "*shell*"))
     (shell-window (if shell-buf (get-buffer-window shell-buf t))) ; non-nil when currently displayed
     (shell-frame (if shell-window (window-frame shell-window)))
     (in-shell (eq (current-buffer) shell-buf))
     (vertical (string= display 'vertical))
     (popup-frame (or (string= display 'frame)
              (and inject-cd (not (bufferp shell-buf)))
              (and (framep shell-frame)
                   (not (eq shell-frame (selected-frame)))))))
    ;; With prefix-arg close shell, restore windows. Otherwise (no prefix-arg)
    ;; toggle shell window; restore windows when called twice in a row, or the
    ;; current buffer is the shell buffer (`in-shell').
    (if current-prefix-arg
    ;; Kill shell.
    (if (bufferp shell-buf)
        (progn (message "Exiting shell '%s'" (buffer-name shell-buf))
           (kill-buffer shell-buf)
           (if in-shell (--toggle-shell-restore-last-conf)))
      (error "No shell buffer to kill."))
      ;; If already in shell-buffer toggle back to stored frame-configuration.
      (if (and in-shell (not inject-cd))
      (progn
        (--toggle-shell-restore-last-conf)
        ;; Recurse to reopen the shell-buffer in a dedicated frame, or
        ;; close the dedicated frame and reopen the buffer in a window.
        (if (and popup-frame (eq shell-frame (selected-frame)))
        (--toggle-shell 'frame inject-cd)
          (when (and popup-frame shell-frame)
        (delete-frame shell-frame)
        (--toggle-shell nil inject-cd))))
    ;; Not in shell buffer. Warp to it or create new one.
    (unless in-shell
      (--toggle-shell-store-last-conf))
    (if popup-frame
        (progn (switch-to-buffer-other-frame (or shell-buf "*shell*"))
           (raise-frame
            (or shell-frame (window-frame (get-buffer-window "*shell*" t)))))
      (if (> (count-windows) 1)
          (delete-other-windows)))
    ;; Finally `cd' into the working directory the current buffer.
    (let ((new-shell (not (bufferp shell-buf)))
          (new-dir       ; `default-directory' of `--toggle-shell-last-buf'
           (if --toggle-shell-last-buf
           (buffer-local-value 'default-directory --toggle-shell-last-buf))))
      ;; (if (buffer-file-name --toggle-shell-last-buf)
      ;;       (file-name-directory (buffer-file-name --toggle-shell-last-buf))
      ;;     (buffer-local-value 'default-directory --toggle-shell-last-buf)))))
      ;; Open shell, move point to end-of-buffer. The new shell-buffer's
      ;; `default-directory' will be that of the buffer the shell was
      ;; launched from.
      (when vertical
        (if (> (count-windows) 1)
        (delete-other-windows))
        (split-window-vertically) (other-window 1))
      (funcall 'shell)
      (when new-shell
        (message "New shell %s (%s)" (buffer-name (current-buffer)) new-dir)
        (if inject-cd (sit-for 2))) ; wait for prompt
      (goto-char (point-max))
      ;; If on a command-prompt insert and launch a "cd" command (assume no
      ;; job is running).
      (when (and inject-cd new-dir)
        (save-excursion
          (backward-line-nomark) (end-of-line)
          (unless (setq inject-cd (re-search-forward comint-prompt-regexp (point-max) t))
        (error "Cannot `pushd', shell is busy")))
        (when (and inject-cd
               ;;(not (string= default-directory new-dir))
               ;;(not shell-last-dir ...)
               )
          (let* ((cmd (format "pushd '%s' %s" (comint-quote-filename new-dir)
                  (if (buffer-file-name --toggle-shell-last-buf)
                      (format "# '%s'"
                          (file-name-directory (buffer-file-name --toggle-shell-last-buf)))
                    ""))))
        ;; `shell-process-cd' set new `default-directory' and set
        ;; `shell-last-dir' to old. (If the pushd command is
        ;; successful, a dirs is performed as well; >nul discards this
        ;; output.)
        (shell-process-cd new-dir)
        (insert cmd)
        (comint-send-input)
        (message "%s: cd '%s'" (buffer-name --toggle-shell-last-buf) new-dir))
          )
        )
      )
    )
      )
    )
  )

;;;; Transparent file compression and encrpytion

;; Preload the pgg feature, an interface between Emacs and various PGP
;; implementations (GnuPG by default). Requires the <gpg> (GNU Privacy Guard) program.
;;
;; C-S-e: encrypt region or buffer
;; C-S-d: decrypt

(auto-compression-mode t)               ; from jka-compr.el, part of GNU/Emacs

(when --emacs22p
  (require 'pgg)
  (setq pgg-scheme 'gpg
    pgg-passphrase-coding-system 'iso-latin-1-unix
    pgg-text-mode nil)
  (defun --decrypt (&optional start end passphrase)
    "Like `pgg-decrypt' but if no region, search for \"BEGIN PGP MESSAGE\"
instead of blindly assuming `point-min' to `point-max'."
    (interactive "r")
    (if (and start end mark-active)
    (let* ((status (pgg-decrypt-region start end passphrase)))
      (when (called-interactively-p 'interactive)
        (pgg-display-output-buffer start end status))
      status)
      ;; No region. Search backward from were we are for the begin of a PGP
      ;; message.
      (if (re-search-backward "-----BEGIN PGP MESSAGE-----" nil t)
      (progn
        (setq start (match-beginning 0))
        (if (re-search-forward "-----END PGP MESSAGE-----" nil t)
        (progn
          (setq end (match-end 0))
          ;; Mark the matched area and let the user type the key again
          ;; to decrypt it (for some reason calling `--decrypt' does
          ;; not work).
          (deactivate-mark)
          (goto-char start)
          (set-mark-command nil)
          (goto-char end)
          )
          )
        )
    )
      )
    )
  (global-set-key [?\C-\S-e] 'pgg-encrypt-symmetric-region)
  (global-set-key [?\C-\S-d] '--decrypt)
  )

;;;; GNU spell checker (ispell/aspell)

;; M-$ check a region or buffer for spelling errors
;; M-t check a region or sexp at point (originally bound to `transpose-words')

(autoload 'ispell-minor-mode "ispell" "Check spelling of words interactively." t)
(autoload 'ispell-word "ispell" "Check spelling of word at or before point" t)
(autoload 'ispell-complete-word "ispell" "Complete word at or before point" t)
(autoload 'ispell-region "ispell" "Check spelling of every word in the region" t)
(autoload 'ispell-buffer "ispell" "Check spelling of every word in the buffer" t)
(autoload 'ispell "ispell" "Run ispell over buffer" t)

(defun --spell-at-point( &optional beg end )
  "Check region or current word for spelling errors."
  (interactive "*r")                    ; unless mark choose sexp at point
  (if (or mark-active)
      (ispell-region beg end)
    (progn (setq deactivate-mark t) (ispell-word))))

(global-set-key "\M-$" 'ispell)           ; region or buffer
(global-set-key "\M-t" '--spell-at-point) ; region or word

;;;; Render and view PostScript

(defun --ps-print-buffer ( &optional ps-filename )
  "Generate PostScript image of the current buffer in file
PS-FILENAME (defaults to `ps-lpr-buffer', which is <emacsspool.ps> in
`temporary-file-directory'). Unless prefix-arg is specified run viewer program.

Under NT install Aladdin Ghostscript and Ghostview from
<http://pages.cs.wisc.edu/~ghost/>. This function requires <gswin32c.exe>,
<gsview32.exe>."
  (interactive)
  ;; Under UNIX `ps-lpr-command' and `ps-lpr-switches' will have default
  ;; values.
  (require 'lpr)
  (defun --find-gswin (exename)
    (--find-program exename '("c:/Program Files/gs/*/bin"
                  "c:/Program Files/Aladdin/*/bin"
                  "$PROGRAMFILES/gs/*/bin"
                  "$PROGRAMFILES/Aladdin/*/bin")))
  (defun --find-gsview (exename)
    (--find-program exename '("c:/Program Files/Ghostgum/*"
                  "$PROGRAMFILES/Ghostgum/*")))
  (if --winntp
      (setq ps-lpr-command (or (--find-gswin "gswin64c.exe")
                   (--find-gswin "gswin32c.exe"))
        ps-lpr-switches (list "-q" "-sDEVICE=mswinpr2" "-dNOPAUSE")))
  ;; Create PostScript file and print.
  (setq ps-paper-type 'a4
    ps-font-size 8
    ps-line-height (* ps-font-size 1.129)
    ps-avg-char-width (* ps-font-size 0.6)
    ps-lpr-buffer (concat (buffer-file-name) ".ps"))
  ;; ps-lpr-buffer (concat temporary-file-directory "emacsspool.ps"))
  (message "Generating PostScript <%s>" ps-lpr-buffer)
  (ps-print-buffer-with-faces ps-lpr-buffer) ; uses ps-lpr-command and ps-lpr-switches
  ;; Preview
  (unless current-prefix-arg
    (when (setq viewer-cmd
        (if --winntp (or (--find-gsview "gsview64.exe")
                 (--find-gsview "gsview32.exe")) nil))
      (progn (shell-command (concat "\"" viewer-cmd "\" \"" ps-lpr-buffer "\"&"))
         (delete-window (get-buffer-window "*Async Shell Command*"))))
    )
  )

(global-set-key [?\C-x ?p] '--ps-print-buffer)

;;;; Browse URLs / Shortcuts for Google, Bing, Leo and Wikipedia

;; Shift-click on URL (middle button).
(global-set-key [S-mouse-2] 'browse-url-at-mouse)

;; Bind the browse-url commands to keys with the `C-c C-z' prefix (as used by
;; html-helper-mode):

(global-set-key "\C-c\C-zu" 'browse-url)
(global-set-key "\C-c\C-z." 'browse-url-at-point)
(global-set-key "\C-c\C-zb" 'browse-url-of-buffer)
;; (global-set-key "\C-c\C-zr" 'browse-url-of-region)
(global-set-key "\C-c\C-zv" 'browse-url-of-file)
(add-hook 'dired-mode-hook (lambda () (local-set-key "\C-c\C-zf" 'browse-url-of-dired-file)))
(setq browse-url-save-file t) ; always save modified buffers before displaying
                    ; the file in a browser

(defun leo (&optional word)
  "Open http://dict.leo.org (English -> German) and propose word at point."
  (interactive (list (read-string "Word: " (--wap))))
  ;; (interactive "sWord: ")
  (browse-url (format "http://dict.leo.org/ende?lp=ende&search=%s" word)))

(defun google (&optional what)
  "Use Google.com to search for WHAT."
  (interactive (list (read-string "What: " (--wap))))
  (browse-url (concat "http://www.google.com/search?q=" what)))

(defun bing (&optional what)
  "Use Bing.com to search for WHAT."
  (interactive (list (read-string "What: " (--wap))))
  (browse-url (concat "http://www.bing.com/search?q=" what)))

(defun wp (&optional what)
  "Use Wikipedia.com to search for WHAT."
  (interactive (list (read-string "What: " (--wap))))
  (browse-url (concat "http://www.wikipedia.de/wiki/" what)))

;; To invoke different browsers for different URLs:
;;      (setq browse-url-browser-function '(("^mailto:" . browse-url-mail)
;;                          ("." . browse-url-netscape)))

;;; -------- FRAMES AND WINDOWS
;;; ---------------------------------------------------------------------------

;;;; Default frame configuration and `frame-background-mode'

(menu-bar-mode 0)
(toggle-scroll-bar 0)
(tool-bar-mode nil)                     ; no toolbar, left scrollbar
(set-scroll-bar-mode 'left)
(setq visible-bell t)
(when (and --winntp --emacs22p)
  (set-message-beep 'silent))

(setq frame-title-format "%F--%b(%f)--%s--%Z"
      icon-title-format "%b %t %f"
      popup-frames t
      display-buffer-reuse-frames t
      ;; "light" (default) or "dark" display
      ;;  frame-background-mode 'dark
      )

(cond
 ((eq frame-background-mode 'dark)
  ;; See http://xpt.sourceforge.net/techdocs/misc/ce01-DarkBackgroundIsGoodForYou/
  (setq initial-frame-alist '((foreground-color . "black")
                  (background-color . "gray82"))) ; 18% grey
  )
 (t                                     ; light
  (setq initial-frame-alist '((foreground-color . "black")
                  (background-color . "ghost white"))))
 )


(setq default-frame-alist initial-frame-alist)

;;;; `special-display-frame-alist'

(cond
 (--winntp
  (setq special-display-frame-alist
    '((border-width . 20)
      (menu-bar-lines . 0)
      (tool-bar-lines . 0)
      (modeline . nil)
      (minibuffer . nil)
      (unsplittable . t)
      (vertical-scroll-bars . nil)
      (horizontal-scroll-bars . nil)))
  )
 (--unixp
  (setq special-display-frame-alist
    '((user-position . t)
      (border-width . 20)
      (menu-bar-lines . 0)
      (tool-bar-lines . 0)
      (modeline . nil)
      (minibuffer . nil)
      (unsplittable . t)))
  )
 )

(global-set-key [?\C-1] (lambda()(interactive)(other-frame -1)))
(global-set-key [?\C-2] (lambda()(interactive)(other-frame 1)))

;;;; Window configuration

(setq scroll-step 3 hscroll-step 5 scroll-conservatively 5 scroll-margin 3
      scroll-preserve-screen-position nil
      split-window-keep-point t
      pop-up-windows t
      even-window-heights nil)

;;;; Window navigation keys

(global-set-key [(f6)] 'next-multiframe-window)
(global-set-key [(control f6)] 'previous-multiframe-window)

;;;; Redisplay/restore/maximize the frame.

;; The below bindings are motivated by the default bindings <C-x +> to
;; `balance-windows' and <C-x -> to `shrink-window-if-larger-than-buffer'.

(global-set-key [(control x)(control -)] 'fru-echo-frame-parameters)
(global-set-key [(control x)(-)] 'fru-auto-display-frame)

(global-set-key [?\C-x ?5 ?3] (lambda() "Show three buffers. When the selected
                buffer already shows more than one window restore the frame.
                With prefix-arg restore the frame configuration."
                (interactive)
                (if current-prefix-arg
                    (fru-restore-frame) (fru-auto-display-three-buffers))))

(defun fru-auto-display-three-buffers (&optional bufleft buftopr bufbotr)
  "Display three interesting buffers in the selected frame. Without arguments
uses the semantics of `--other-persistent-buffer' to find some interesting
buffers to be displayed."
  (interactive)
  ;; Configure the frame to display as much text as possible.
  (delete-other-windows)
  ;;(menu-bar-mode 0) (tool-bar-mode 0)
  ;; Find buffers to display.
  (or bufleft (setq bufleft (current-buffer)))
  (or buftopr (setq buftopr (--recent-buffer bufleft)))
  (or bufbotr (setq bufbotr (--recent-buffer buftopr)))
  ;; Split windows, display the buffers.
  (switch-to-buffer bufleft)
  (split-window-horizontally)
  (other-window 1) (switch-to-buffer buftopr)
  (split-window-vertically)
  (other-window 1) (switch-to-buffer bufbotr)
  (other-window -1) (fru-auto-display-window)
  (other-window 1) (fru-auto-display-window)
  (other-window 1))

;;;; <C-M-Cursor> shrinks/enlarges the selected frame or window

(global-set-key [(control meta up)] (lambda() (interactive)
                      (let ((F (selected-frame)))
                    (if (and (one-window-p t) (frame-restored-p F) (> (frame-height F) 5))
                        (set-frame-height F (- (frame-height F) 1))
                      (shrink-window -1)))))
(global-set-key [(control meta down)] (lambda() (interactive)
                    (let ((F (selected-frame)))
                      (if (and (one-window-p t) (frame-restored-p F))
                          (set-frame-height F (+ (frame-height F) 1))
                        (enlarge-window 1)))))
(global-set-key [(control meta left)] (lambda() (interactive)
                    (let ((F (selected-frame)))
                      (if (and (one-window-p t) (frame-restored-p F) (> (frame-width F) 10))
                          (set-frame-width F (- (frame-width F) 1))
                        (enlarge-window-horizontally -1)))))
(global-set-key [(control meta right)] (lambda() (interactive)
                     (let ((F (selected-frame)))
                       (if (and (one-window-p t) (frame-restored-p F))
                           (set-frame-width F (+ (frame-width F) 1))
                         (enlarge-window-horizontally 1)))))

;;;; Special display popup frames

;; Define which buffers get individual frames of their own. Special display
;; popup frames and the windows in them, are never automatically split/reused
;; for any other buffers. Killing the special buffer deletes its frame
;; automatically.

;; To get a non-popup-frame use
;;      (if (window-dedicated-p (selected-window))
;;          default-minibuffer-frame (selected-frame))
;; Make some buffers which by default appear in other windows, appear in the same window.
;;      (nconc same-window-buffer-names '("*Help*"))

(defvar --desktop-icon)
(defvar --shell-icon)
(defvar --compile-icon)

(if (load "frame-utils" t)
    (progn
      (global-set-key [?\C-x ?5 ?n] 'fru-set-frame-font)
      (setq special-display-regexps
        '(("[*]+\\([Dd]iff\\|[Cc]ompilation\\|[Gg]rep\\|gud\\|GUD\\|VC-log\\)" --display-special-frame)
          ("Help[*]\\|[Ii]nfo[*]\\|[*]Man\\|Messages[*]\\|[*]Apro" --display-special-frame)
          ("shell[*]\\|[*]Async\\|[*][sS]+hell\\|Buffer List[*]\\|[*]Backtrace" --display-special-frame)
          ;; Dired
          ("^[:/~]" --display-special-frame)))
      (setq special-display-regexps
        '(("[*]+\\([Dd]iff\\|[Cc]ompilation\\|[Gg]rep\\|gud\\|GUD\\|VC-log\\)" --display-special-frame)))

      (setq special-display-regexps nil)

      (defun --display-special-frame (buf &optional args)
    "Replaces the `special-display-popup-frame' function."
    (let ((W (special-display-popup-frame buf)) ; resue existing window or create new frame
          (N (buffer-name buf)))
      (when (setq F (window-frame W))
        (if (eq F default-minibuffer-frame) (error "Special frame is the default frame"))
        (if (eq F default-minibuffer-frame) (error "Special frame is the selected frame"))
        ;; The special buffer popped up in new frame `F' with
        ;; `special-display-frame-alist' settings. The buffer name has been
        ;; filtered by `special-display-regexps'
        (defun --mod-frm (fntn          ; number of predef'd font
                  icon          ; icon name
                  rows
                  cols          ; 0 to keep frame width, -1 to use max columns
                  F)
          (when F
        (if fntn )
        (if icon )
        (or (> cols 0) (setq cols (fru-frame-columns F)))
        (or (< cols 120) (setq cols 120))
        (fru-maximize-frame F)
        (when rows
          (modify-frame-parameters F (list (cons 'top 18))))
        (when cols                  ; calculate leftmost pos.
          (modify-frame-parameters F (list (cons 'left 100)))))
          )

        (let ((baserows (or compilation-window-height 50))
          (is-shell (string-match "\\([Ss]hell\\|Buffer List\\|Backtrace\\|[Dd]iff\\)" N))
          (is-dired (string-match "[/~:]" N))
          (is-compilation (string-match "[Cc]ompilation" N))
          (is-gud (string-match "gud" N))
          (is-grep (string-match "[Gg]rep" N))
          (is-info (string-match "\\([Ii]nfo\\|Help\\|Man\\|Messages\\|Apro\\)" N)))
          (when (or is-shell is-dired)
        (when (featurep 'frame-utils)
          (fru-set-frame-font 3 F)
          (fru-set-frame-icon --shell-icon F))
        (set-frame-height F baserows)
        (set-frame-width F (min (fru-frame-columns) 100))
        (modify-frame-parameters F (list (const 'top 18)
                         (cons 'background-color "light yellow")
                         (cons 'foreground-color "gray20")
                         (cons 'vertical-scroll-bars nil)))
        )
          (when is-grep
        (when (featurep 'frame-utils)
          (fru-set-frame-font 1 F)
          (fru-set-frame-icon --shell-icon F))
        (set-frame-height F baserows)
        (set-frame-width F (min (fru-frame-columns) 100))
        (redirect-frame-focus F default-minibuffer-frame)
        (modify-frame-parameters F (list (cons 'background-color "honeydew")
                         (cons 'foreground-color "forest green")))
        )
          (when is-compilation
        (when (featurep 'frame-utils)
          (fru-set-frame-font 2 F)
          (fru-set-frame-icon --compile-icon F))
        (set-frame-height F baserows)
        (set-frame-width F (min (fru-frame-columns) 100))
        (redirect-frame-focus F default-minibuffer-frame)
        (modify-frame-parameters
         F (list (cons 'internal-border-width 1)
             (cons 'left (- (display-pixel-width) (frame-pixel-width F) (fru-frame-right-decoration F)))
             (cons 'top 100)
             (cons 'background-color "alice blue")
             (cons 'foreground-color "blue")))
        )
          (when is-gud
        (when (featurep 'frame-utils)
          (fru-set-frame-font 5 F)
          (fru-set-frame-icon --compile-icon F))
        (set-frame-height F 40)
        (set-frame-width F 80)
        (redirect-frame-focus F default-minibuffer-frame)
        (modify-frame-parameters
         F (list (cons 'left (- (display-pixel-width) (frame-pixel-width F) (fru-frame-right-decoration F)))
             (cons 'background-color "white")
             (cons 'foreground-color "black")))
        )
          (when is-info
        (when (featurep 'frame-utils)
          (fru-set-frame-font 6 F))
        (set-frame-height F 40)
        (set-frame-width F 80)
        (modify-frame-parameters
         F (list (cons 'background-color "white")
             (cons 'foreground-color "black")))
        )
          )
        ) W)
    )
      )
  (message "WARNING: frame-utils not found"))

;;; -------- FILES AND BUFFERS
;;; ---------------------------------------------------------------------------

(global-set-key [pause] 'toggle-read-only)
(global-set-key [(control a)] 'mark-whole-buffer)

(defun --normal-mode-no-gimmicks ()
  "Enable buffer `normal-mode', refontify.  Disable frame menu, toolbar,
scrollbars."
  (interactive)
  (menu-bar-mode 0)
  (toggle-scroll-bar 0)
  (tool-bar-mode nil)
  (set-scroll-bar-mode 'left)
  (normal-mode)
  (--set-my-faces)
  (menu-bar-mode 0) (toggle-scroll-bar 0) (tool-bar-mode 0))

(global-set-key [?\M-g ?g] '--normal-mode-no-gimmicks)

;;;; Transient buffers, kill buffers
;;
;; `dos2unix' and `unix2dos' set the file coding-system of the current buffer
;; to `iso-latin-1-unix' or `iso-latin-1-dos'. However, the buffer is converted
;; not before it is saved to disk.

(defun dos2unix () (interactive) (set-buffer-file-coding-system 'iso-latin-1-unix))
(defun unix2dos () (interactive) (set-buffer-file-coding-system 'iso-latin-1-dos))

(defvar --transient-buffers-filename-regexp
  "configure\\|TAGS\\|BROWSE\\|MAKEDEF")

(defun --is-transient-buffer (&optional buf strict)
  "Test if buffer object BUF (buffer object or name) is transient. BUF defaults
to the current buffer. Transient buffers don't visit a file, or the file is
temporary/read-only (e.g., man-pages, tag-files) If STRICT also matches
filenames with <.>, GUD/compilation/shell buffers."
  (or buf (setq buf (current-buffer)))
  (unless (bufferp buf)
    (setq buf (get-buffer buf)))
  (let* ((bufn (buffer-name buf))
     (buff (buffer-file-name buf)))
    (if (or (not buff)                  ; *pseudo-buffers* have no file
        (string-match "\\.\\(log\\|te?mp\\)$" buff) ; temporary files
        (string-match "\\.\\([1-9]+\\)$" buff) ; read-only files (man-pages etc.)
        (string-match --transient-buffers-filename-regexp buff)
        (and strict (or (string-match "^[\\._]" bufn) ; files beginning with "."
                ))
        )
    buf)
    ))

(defun --toggle-buffer-list (&optional prefix)
  (interactive "P")
  (if (not (eq (selected-frame) default-minibuffer-frame)) ; raise default frame
      (raise-frame))
  (let* ((name "*Buffer List*")
     (buff (get-buffer name))
     (hide (eq (current-buffer) buff)))
    (when (bufferp buff)
      (delete-windows-on buff t)
      (kill-buffer buff))
    (delete-other-windows)
    (unless hide
      (list-buffers t)
      (pop-to-buffer name nil t))
    ))

(defun --nuke (&optional strict)
  "Kill less interesting buffers, other frames and windows.
With prefix-arg or STRICT kill harder; see `--is-transient-buffer'."
  (interactive "P")
  (save-excursion
    (clean-buffer-list)
    (delete-other-frames)
    (delete-other-windows)
    (dolist (b (buffer-list))
      (when (--is-transient-buffer b strict)
    (message "Killing %s" (buffer-name b))
    (delete-windows-on b)
    (kill-buffer b)))
    ))

(defun --drynuke (&optional strict)
  "List \"transient\" buffers that `--nuke' would kill."
  (interactive)
  (message "\nTransient buffers: %s" (if strict "strict" ""))
  (dolist (b (buffer-list))
    (when (--is-transient-buffer b strict)
      (message "%s\t<%s>" (buffer-name b) (buffer-file-name b))))
  (switch-to-buffer-other-window "*Messages*")
  (end-of-buffer-nomark))

(global-set-key [(control f4)] '--nuke)
(global-set-key [(meta control f4)] '--drynuke)

;;;; Smart buffer switching (recent and companion files)
;;
;; M-n and M-p are not bound by default.

(autoload 'live-mode "live-mode" "Automatically reverts a buffer." t)

(global-set-key [?\C-x ?l] 'goto-line)
(global-set-key [(M-return)] '--toggle-buffer-list)
(global-set-key [(control o)] '--switch-to-other-buffer) ; get recently selected buffer or companion file
(global-set-key [(meta o)] '--switch-to-other-buffer-other-frame) ; dto.
(global-set-key [(control x)(control o)] 'revert-buffer)


(defadvice switch-to-buffer (before to-existing-buffer-only activate compile)
  "When interactive, switch to existing buffer only, unless given a prefix argument.
See Glickstein, page 30."
  (interactive
   (list (read-buffer "Switch to buffer? " (--recent-buffer) (null current-prefix-arg)))))

(defun --companion-file-name (&optional implicit)
  "Return the name of the file that accompanies the file this buffer is
visiting.

First find an explicit name by searching the \"$Companion: FILENAME$\" tag at
the beginning of this buffer. If no such tag and IMPLICIT is non-nil try
`ff-other-file-name' (apply `cc-other-file-alist'). Returns a filename or nil."
  (let (f)
    (when (not (--is-transient-buffer))
      (save-excursion
    (goto-char (point-min))
    (when (re-search-forward "\\$ *[Cc]ompanion[ :]+\\(.+?\\)\\$" (point-max) t)
      (setq f (buffer-substring (match-beginning 1)(match-end 1)))))
      (if (and f (not (--file-exists-p f)))
      (unless (yes-or-no-p (concat "The companion file <" f "> was not found. Proceed? "))
        (setq f nil))
    (if implicit ; `ff-other-file-name' not available in Emacs 21 and below
        (setq f (if --emacs22p (ff-other-file-name) nil))))
      )
    f))

(defun --recent-buffer (&optional buf visible-ok frame)
  "Switch to most recently selected buffer.
Like `other-buffer' but prefer buffer connect to files."
  (setq bf1 (or buf (current-buffer))
    buf (other-buffer bf1 visible-ok frame))
  (let ((bufl (buffer-list)))
    (while (and bufl (or (--is-transient-buffer buf) (eq buf bf1)))
      (setq buf (car bufl) bufl (cdr bufl)))
    buf))

(defun --switch-to-other-buffer-other-frame (&optional find-companion)
  "Like `--switch-to-other-buffer' but find the buffer in another frame."
  (interactive)
  (--switch-to-other-buffer (or find-companion current-prefix-arg) 'maybe-frame))

(defun --switch-to-other-buffer (&optional get-companion display-method)
  "\"Je est un autre.\" --- Arthur Rimbaud.

Finds some other, interesting buffer.
    1.) If GET-COMPANION non-nil (interactively, with prefix-arg) test for
        companion file. The file must be explicitly defined by a \"$Companion:
        FILENAME$\" tag near the head of the buffer.
    2.) Test for some existing filename at point.
    3.) Call `ff-find-other-file' to get the header or source file
        corresponding to this file. On some `#include' line pulls in that file.
    4.) Get explicit companion file or some interesting buffer
        `--recent-buffer'. Ask whether to switch.

Return some buffer object or nil."
  (interactive "P")
  (setq display-method (or display-method t))
  (let (ftype newbuf method (borg (current-buffer)))
    ;; 1. try explicit companion file
    (and get-companion (setq newbuf (--companion-file-name)
                 method "Explicit companion file"))
    ;; 2. prompt with filename at point (if any)
    (unless newbuf
      (unless (and (setq newbuf (ffap-file-at-point))
           (> (length newbuf) 1)
           (yes-or-no-p (concat "Load file <" newbuf "> at point? "))
           (setq method "Filename at point"))
    (setq newbuf nil))
      ;; 3. just find some other file or test for #include directive
      (unless newbuf
    (let ((ff-quite-mode t))
      (save-window-excursion
        (ff-find-other-file)
        (unless (eq (current-buffer) borg)
          (setq newbuf (current-buffer)
            method "Implicit companion, or #include")))))
      ;; 4. prompt with explicit companion or some interesting buffer
      (unless newbuf
    (setq recent (--recent-buffer))
    (unless get-companion
      (setq newbuf (--companion-file-name)
        method "Explicit companion file")
      (unless (and newbuf (yes-or-no-p (concat method " <" newbuf ">? ")))
        (setq newbuf nil)))
    (unless newbuf
      (setq newbuf recent
        method "Switch to most recently select buffer")
      (unless (and newbuf (yes-or-no-p (concat method " <" (buffer-name newbuf)">? ")))
        (setq newbuf nil)))
    )
      )
    ;; switch to `newbuf'
    (if newbuf
    (if (not (--file-exists-p newbuf))
        (error "%s: %s: file not found" method (--buffer-file-name newbuf))
      (if (not (--file-readable-p newbuf))
          (error "%s: %s: file exists, but is not readable" method (--buffer-file-name newbuf))
        (unless (bufferp newbuf)
          (setq newbuf (find-file-noselect newbuf)))
        (let ((display-buffer-reuse-frames t))
          (cond
           ((and (memq display-method '(raise-frame maybe-frame))
             ;; Show it in the same window, unless already visible in
             ;; another frame.
             (let ((pop-up-frames t) (pop-up-windows nil))
               (if (featurep 'ido)
               (ido-visit-buffer newbuf 'maybe-frame t)
             (pop-to-buffer newbuf)) ; default when `ido' is not available
               )))
           (t
        ;; Default display method -> same frame, current window.
        (let ((pop-up-frames nil)
              (pop-up-windows nil))
          (pop-to-buffer newbuf)))))
        (raise-frame (window-frame (get-buffer-window newbuf)))
        ))
      ;; else got no other buffer
      )
    newbuf)
  )

(defun --buffer-visible (buffer)
  "Returns the frame displaying BUFFER (object or name), when the frame is
visible and not iconified, nil otherwise."
  (let* ((W (get-buffer-window (if (stringp buf) (get-buffer buf) buf)))
     (F (window-frame W)))
    (if (and W (frame-totally-visible-p F))
    F nil))
  )

;;;; Scrolling, Mark
;;
;; The `mark-ring' is a list of former marks of the current buffer, most recent
;; first. Like `set-mark-command'with prefix-arg.  However, Emacs does not care
;; if the `mark-ring' contains  duplicate or close positions. `--pop-mark' will
;; filter such positions  out, making sure that the jump is  at least 100 chars
;; away.
;;
;; The `global-mark-ring' records  buffers in which the mark  was recently set.
;; Like `pop-global-mark',  but make sure that  the mark being jumped  to is in
;; another buffer, and that this buffer is connected to a file.

(require 'pc-select)                    ; required by `*-nomark'

(setq scroll-margin 5              ; begin this far from screen top/bottom
      scroll-conservatively 100000 ; do not jump to screen-center when scrolling
      scroll-preserve-screen-position 1 ; maintain screen-position on PgUp/PgDown etc.
      mouse-wheel-scroll-amount  '(3 ((shift) . 1) ((control) . nil))
      )

(defun current-line ()
  "Accompanies defines `current-column'."
  (1+ (count-lines (point-min) (point))))

(defun window-top-line ()
  (save-excursion
    (goto-char (window-start))
    (current-line)))

(defun window-bottom-line ()
  (save-excursion
    (move-to-window-line -1)
    (current-line)))

(defun --beginning-of-line ()
  "Toggle point column 0 and first non-blank character."
  (interactive)
  (deactivate-mark)
  (set-window-hscroll (selected-window) 0)
  (setq n (point))
  (back-to-indentation)
  (if (eq n (point))
      (beginning-of-line-nomark)))

(defun --beginning-of-buffer ()
  "Approximate the begin of the current buffer."
  (interactive)
  (beginning-of-buffer-nomark)
  (and (not (--is-transient-buffer))
       (re-search-forward "^#include" (+ (point-min) 500) t))
  (--beginning-of-line))

(defun --end-of-buffer ()
  "Approximate the end of the current buffer."
  (interactive)
  (--beginning-of-line) (end-of-buffer-nomark))

(defun --scroll-down-sticky (&optional num)
  (interactive "p")
  (let ((bottom (window-bottom-line))
    (cur (- (current-line) 1))
    (pos (point)))
    ;; (message "bottom=%d current=%d" bottom cur)
    (scroll-down (or num 2))
    (next-line (or num 2))
    (goto-char pos)
    )
  )

(defun --scroll-up-sticky (&optional num)
  (interactive "p")
  (let ((top (window-top-line))
    (cur (- (current-line) 1))
    (pos (point)))
    ;; (message "top=%d current=%d" top cur)
    (if (< (- cur top) scroll-margin)
    (progn
      (next-line (* 2 scroll-margin))
      (scroll-up (or num 2))
      (previous-line (or num 2)))
      (scroll-up (or num 2))
      (previous-line (or num 2))
      (goto-char pos)                   ; restore column
      )
    )
  )

(defun --scroll-left (&optional num)
  (interactive "p")
  (if (<= (current-column)
      (scroll-left (or num tab-width)))
      (end-of-line-nomark))
  )

(defun --scroll-right (&optional num)
  (interactive "p")
  (if (< (scroll-right (or num tab-width)) 0)
      (--beginning-of-line))
  )

(defun --pop-mark (&optional reccnt beg)
  "Make mark the point, then pop off `mark-ring' and jump to the top location."
  (interactive)
  (if mark-ring
      (if mark-active (setq deactivate-mark t))
    (error "Local mark ring is empty"))
  ;; Jump to mark, pop new, then get number of chars jumped and recurse if the
  ;; mark is to close.
  (or beg (setq beg (point)))
  (set-mark-command 1)
  (delete-other-windows)
  (let ((dist-max 500) (dist (abs (- beg (point))))
    (reccnt (if (numberp reccnt) (+ reccnt 1) 1)))
    (when (< dist dist-max)
      (when (and (numberp reccnt) (> reccnt 100))
    (goto-char beg)
    (error (format "No distant mark found within %d chars - point not moved (try C-u C-SPC)" dist-max)))
      (--pop-mark reccnt beg)))
  )

(defun --pop-global-mark (&optional reccnt beg begbuf)
  "Pop off `global-mark-ring' and jump to the top location."
  (interactive)
  (unless beg
    (setq beg (point) begbuf (current-buffer)))
  (delete-other-windows)
  (pop-global-mark)
  (when (and (numberp reccnt) (> reccnt 100))
    (switch-to-buffer begbuf) (goto-char beg)
    (message "`global-mark-ring' is empty"))
  (if (or (eq begbuf (current-buffer)))
      (--pop-global-mark (if (numberp reccnt) (+ reccnt 1) 1) beg begbuf))
  )

(global-set-key [(M-prior)] '--pop-global-mark) ; recently visited buffers
(global-set-key [(M-next)] '--pop-mark)

;;;; Unscroll
;;
;; Code taken from "Writing GNU Emacs Extensions" by Bob Glickstein, (O'Reilly
;; & Assoc., 1997). This file uses "advice" to modify the scrolling commands
;; such that the screen appearance is preserved at the start of each series of
;; scrolls. After scrolling (intentionally or otherwise), you can restore the
;; display with M-x unscroll RET, which Bob Glickstein likes to bind to C-M-v.
;; Since the KDE WM traps C-M-v, however, we bind it to C-v too.

(defvar unscroll-point (make-marker)
  "Cursor position for next call to \\[unscroll].")
(defvar unscroll-window-start (make-marker)
  "Window start for next call to \\[unscroll].")
(defvar unscroll-hscroll nil
  "Horizontal scroll for next call to \\[unscroll].")

(defun unscroll ()
  "Revert to last position before the start of scrolling."
  (interactive)
  (goto-char unscroll-point) (recenter)
  (set-window-start nil unscroll-window-start)
  (set-window-hscroll nil unscroll-hscroll))

(defun unscroll-maybe-remember ()
  (when (and (symbolp last-command)
         (not (get last-command 'unscrollable)))
    (set-marker unscroll-point (point))
    (set-marker unscroll-window-start (window-start))
    (setq unscroll-hscroll (window-hscroll))))

(put 'scroll-up 'unscrollable t)
(put 'scroll-down 'unscrollable t)
(put 'scroll-left 'unscrollable t)
(put 'scroll-right 'unscrollable t)

(defadvice scroll-up (before remember-for-unscroll activate compile)
  "Remember where we started from, for `unscroll'."
  (unscroll-maybe-remember))
(defadvice scroll-down (before remember-for-unscroll activate compile)
  "Remember where we started from, for `unscroll'."
  (unscroll-maybe-remember))
(defadvice scroll-left (before remember-for-unscroll activate compile)
  "Remember where we started from, for `unscroll'."
  (unscroll-maybe-remember))
(defadvice scroll-right (before remember-for-unscroll activate compile)
  "Remember where we started from, for `unscroll'."
  (unscroll-maybe-remember))

(define-key global-map "\C-\M-v" 'unscroll)
(global-set-key [(control v)] 'unscroll)

;;;; Text paragraph and region
;;
;; Default markup for any text.
;;  1st = code (monospace)
;;  2nd = terms (italics)

;;;; Comments in program code

(require 'newcomment)

(global-set-key [(meta insert)] '--fill-next-column-stop)
(global-set-key [(control k)]
        '(lambda()
           "Cut current line to yank ring."
           (interactive) (beginning-of-line-nomark) (kill-line)))

(defun --fill-next-column-stop ()
  "When the current line defines a comment reindent it and fill up
comment-chars up to the next stop column. Stops are at 8, 25, 48 and 72."
  ;; `comment-start' is defined arbitarily in `newcomment'. It is ";" in ELisp,
  ;; "# " in Perl and "// " in C++ modes. See also function `comment-indent'.
  (interactive)
  (let* ((fill-char
      (if (eq major-mode 'c++-mode)
          "*"
        (substring comment-start 0 1))))
    (indent-according-to-mode)
    (end-of-line-nomark)(backward-char 1)
    (setq break-it nil)
    (unless (looking-at fill-char)      ; already a comment bar?
      (unless (looking-at "[ \t]*$")    ; no, already blank line?
    (previous-line 1)
    (end-of-line-nomark)            ; no, insert new comment line and stop
    (newline) (newline-and-indent)
    (insert fill-char " ")
    (setq break-it t)))
    (unless break-it
      (indent-according-to-mode)
      (end-of-line-nomark)
      (delete-horizontal-space)
      (indent-according-to-mode) ; reindent at `bolp' (necessary on blank lines)
      (let ((n (cond ((<= (current-column)  7)  7)
             ((<= (current-column) 24) 24)
             ((<= (current-column) 47) 47)
             ((<= (current-column) 71) 71)
             (t ; reached maximum column -> kill the line and start over again
              (progn (while (not (bolp)) (delete-char -1))
                 (indent-according-to-mode)
                 (insert fill-char " ") -1)))))
    (message "new comment column-stop -> %d" (+ n 1))
    (while (<= (current-column) n)
      (insert fill-char)))
      )
    )
  )

(defun --indent-for-comment (&optional beg end)
  "Comment out region or insert comment to current line.
If the region is active and `transient-mark-mode' is on, call
`comment-region' (unless it only consists of comments, in which case it calls
`uncomment-region').

Else convert an empty single-line comment or start a new one, according to the
three comment classes:

   A) comment to the right of the code (at the `comment-column')
   B) comment on its own line, indented like code
   C) comment on its own line, beginning at the left-most column.

The idea of this function is, while writing your code, type the comment-char
repeatedly until you are satisfied with the comment."
  (interactive "r")
  ;; Basically the following implementation is a smarter `indent-for-comment'.
  ;; The function was inspired by `asm-comment': in `asm-mode' your repeatedly
  ;; press ';' until the new/present comment is seated right.
  (let ((comment-char (substring comment-start 0 1)) eol commentp)
    (cond
     (buffer-read-only
      (error "Cannot indent comment: buffer is read-only."))
     (overwrite-mode
      ;; Just insert `comment-char'.
      (insert comment-char)
      ;;(indent-for-comment)
      )
     (t
      (if (or mark-active)
      (comment-or-uncomment-region beg end)
    ;; When the mark is inactive.
    (comment-normalize-vars)
    (save-excursion
      (beginning-of-line)
      (setq commentp (comment-search-forward (line-end-position) t))
      (setq at-eol (looking-at "[ \t]*$")))
    (cond
     ;; Blank line? Start comment with two `comment-char's at code indent
     ;; level, like `comment-dwim'.
     ((save-excursion
        (beginning-of-line)
        (looking-at "^[ \t]*$"))
      (indent-according-to-mode)
      ;;(newline-and-indent)
      (insert comment-char comment-char ?\ )
      (recenter)
      (message "Starting new comment at blank line"))

     ;; Nonblank line w/o comment? Start new inline comment.
     ((null commentp)
      (indent-for-comment)
      (insert ?\ )
      (message "New comment at column %d" comment-column))

     ;; Nonblank line where point sits before comment? Indent and jump inside.
     ((<= (point) commentp)
      (indent-for-comment)
      (message "Indent comment"))

     ;; Nonblank line where point sits already IN THE comment, but not at
     ;; EOL? Means that the comment is not empty. If it sits where
     ;; `indent-for-comment' has put point then `comment-char' was pressed
     ;; twice -> kill the comment.
     ((and (not at-eol)
           (= (point) (save-excursion (indent-for-comment) (point))))
      (kill-comment 1) (indent-according-to-mode)
      (message "Killed comment"))

     ;; Nonblank line where point sits IN THE comment OR the comment is
     ;; standalone? Just insert the `comment-char'.
     ((or (not at-eol) (save-excursion (goto-char commentp) (bolp)))
      (insert comment-char)
      (message "Insert comment-char"))

     ;; Empty standalone comment? Upgrade to next comment level.
     ((save-excursion (goto-char commentp) (skip-chars-backward " \t") (bolp))
      (goto-char commentp)
      (insert comment-char)
      (indent-for-comment)
      (message "Upgrade empty standalone comment"))

     ;; Empty inline comment? Convert to standalone comment.
     (t
      (goto-char commentp)
      (skip-chars-backward " \t")
      (delete-region (point) (line-end-position))
      (beginning-of-line) (insert "\n") (backward-char)
      (--indent-for-comment)
      (message "Convert inline to standalone comment")
      )
     )
    )
      )
     )
    )
  )

;;;; Reduce whitespace (Cleanup)

(global-set-key [(control delete)] '--cleanup-whitespace)

(defun --cleanup-whitespace ()
  "Reduce blank lines arround point, join lines.
With prefix-arg fix the whole buffer:
    - delete all the trailing whitespace
    - cleanup the five different kinds of whitespace problems (`whitespace-cleanup')
    - convert multiple spaces to tabs when possible (see`tab-width')"
  (interactive)
  (setq mark-active nil)
  (defun line-comment-position ()
    (let (commentpos)
      (save-excursion
    (beginning-of-line)
    (setq commentpos (comment-search-forward (line-end-position) t)))
      commentpos))
  (save-match-data
    (if current-prefix-arg
    ;; Cleanup whitespace in this buffer, tabify buffer.
    (progn (message "Fixing whitespace problems...")
           (delete-trailing-whitespace)
           (whitespace-cleanup)
           (message "Tabifying buffer (TAB => SPACES)...")
           (tabify (point-min) (point-max)))
      ;; Reduce whitespace arround point, join lines.
      (let* ((thiscomment (line-comment-position))
         (eolpos (line-end-position))
         thisblank singleblank manyblank)
    (save-excursion
      (beginning-of-line)
      (setq thisblank (looking-at "[ \t]*$"))
      (setq singleblank (and thisblank
                 (not (looking-at "[ \t]*\n[ \t]*$"))
                 (or (bobp) (progn (forward-line -1) (not (looking-at "[ \t]*$"))))))
      (setq manyblank (and thisblank (not singleblank))))
    (if singleblank                 ; delete some isolated blank line
        (progn (delete-blank-lines)
           (indent-according-to-mode))
      (if manyblank                 ; delete all surrounding blank lines
          (progn (delete-blank-lines)
             (indent-according-to-mode))
        (if (looking-at "^")        ; at BOL -> join this to end of previous line
        (progn (delete-indentation)
               (indent-according-to-mode)
               (if (not (looking-at comment-start-skip))
               (message "Joined text line")
             (save-excursion (indent-for-comment))
             (fixup-whitespace)
             (message "Joined comment line")))
          (if (looking-at "$")      ; at EOL -> join following line to end of this
          (progn
            (if thiscomment     ; this line has a comment
            (progn (delete-indentation t) ; (skip-syntax-forward " ")
                   (if (looking-at comment-start-skip)
                   (progn (kill-region (point) (match-end 0))
                      (fixup-whitespace)
                      (message "Joined two comment lines"))
                 (message "Joined text to comment line")))
              (delete-indentation t) ; this line has no comment
              (indent-according-to-mode)
              (if (looking-at comment-start-skip)
              (progn (kill-region (point) (match-end 0)) ; kill comment prefix
                 (insert comment-start) (fixup-whitespace) (indent-for-comment)
                 (message "Joined comment line to text line"))
            (message "Joined two text lines")
            (fixup-whitespace))))
        ;; At mid of line -> Fix up horz. whitespace arround point.
        (if (looking-at "[ \t]+")
            (delete-horizontal-space)
          (fixup-whitespace))
        (message "Fixed up whitespace")))))))
    )
  )

;;;; Markup text

(global-set-key [(control <)] '--wap-markup)

(defvar --wap-markup-qs) (make-variable-buffer-local '--wap-markup-qs)
(defvar --wap-markup-qe) (make-variable-buffer-local '--wap-markup-qe)
(defvar --wap-markup-es) (make-variable-buffer-local '--wap-markup-es)
(defvar --wap-markup-ee) (make-variable-buffer-local '--wap-markup-ee)

(defun --enable-quick-markup (&optional s1 e1 s2 e2)
  (if (not s1)
      (--enable-quick-markup "`" "'" "<" ">")
    (setq --wap-markup-qs s1) (setq --wap-markup-qe e1)
    (setq --wap-markup-es s2) (setq --wap-markup-ee e2)))

(defun --wap-markup (&optional beg end)
  "Quote or emphasize (prefix-arg) the current region. Without region get word
at point, according to the current syntax (`--wap-region').
    Quotation: quote/mark substrings, quote, citation (Notierung, Zitat)
    Emphasis: emphasize filenames and URLs, the accentuation (Betonung)
The default markup is `quoting' and <emphasizing>. Programming modes can refine
these character using the `--enable-quick-markup' function. The
programming-mode only defines how the text is edited; how it will appear,
however, depends on the text is typeset/visualized/spoken)."
  (interactive "*r")
  ;; TODO: With prefix arg remove all markups
  ;; TODO: Without prefix arg cycle through all markups --wap-markup-list
  (if (or (not mark-active) (not beg) (not end))
      (let ((reg (--wap-region)))
    (setq beg (car reg) end (cdr reg))))
  (setq s (if current-prefix-arg --wap-markup-es --wap-markup-qs)
    e (if current-prefix-arg --wap-markup-ee --wap-markup-qe))
  (goto-char beg)(insert s)
  (goto-char (+ end (length s)))(insert e)
  (if (eq beg end) (goto-char (+ beg 1)))
  )

;;;; Fill paragraphs
;;
;; M-q fills paragraphs, C-x M-q allows varying indentation of paragraphs in a
;; region. Both justify with prefix-arg.

(global-set-key [(control return)] 'newline-and-indent)
(global-set-key [(control meta return)] '--unwrap-line)
(global-set-key [(meta q)] '--fill)
(global-set-key [(control x)(meta q)] 'fill-nonuniform-paragraphs) ; fill with varying indentation

(defun --fill (&optional justify region)
  "Smart filling function for paragraph at point or paragraphs in region.
If JUSTIFY is non-nil (interactively, with prefix argument), justify as well.

The REGION argument is non-nil if called interactively; then, if the mark is
active use `fill-individual-paragraphs'. The function fills each of the
paragraphs in the active region, treating every change in indentation level OR
prefix as a paragraph boundary, then fills each paragraph using its indentation
level as the fill prefix."
  (interactive
   (progn
     (barf-if-buffer-read-only)
     (list (if current-prefix-arg 'full) t)))
  (cond
   ((and transient-mark-mode mark-active
     (not (eq (region-beginning) (region-end))))
    (message "Filling individual paragraphs")
    (fill-individual-paragraphs (region-beginning) (region-end) justify)
    ;; (setq deactivate-mark t)
    )
   (t
    (message "Filling paragraph at point")
    (fill-paragraph justify))
   )
  )

(defun --unwrap-line()
  "Remove all newlines until we get to two consecutive ones.
Or until we reach the end of the buffer.
Great for unwrapping quotes before sending them on IRC."
  ;; http://www.emacswiki.org/emacs/UnwrapLine
  (interactive)
  (let ((start (point))
    (end (copy-marker (or (search-forward "\n\n" nil t)
                  (point-max))))
    (fill-column (point-max)))
    (fill-region start end)
    (goto-char end)
    (newline)
    (goto-char start)))

;;;; Indent paragraphs
;;
;; TAB: default is `indent-for-tab-command'
;; C-TAB, C-S-TAB and M-TAB: normally used by OS Window managers.
;; TAB: when set as global key make sure it still works in minibuffer completion
;; S-TAB: alias backtab
;;
;; `indent-rigidly' is by default bound to C-x TAB

(global-set-key [(control tab)] '--indent-rigidly)
(global-set-key [(control shift tab)] '--indent-rigidly-backwards)
(global-set-key [(control x)(tab)] '--indent-rigidly)
(global-set-key [(control x)(backtab)] '--indent-rigidly-backwards)

(defun --indent-rigidly (&optional beg end)
  "Insert a physical TAB character at point or indent the region `tab-width'
columns. When a region is active and the prefix argument as one-base column
number and indent each line in the region to that column."
  (interactive "*r")
  (let ((deactivate-mark nil))
    (if mark-active
    (if current-prefix-arg
        (indent-region beg end current-prefix-arg)
      (indent-rigidly beg end tab-width))
      (tab-to-tab-stop))))

(defun --indent-rigidly-backwards (&optional beg end)
  "Untabify line or regino `tab-width' columns."
  (interactive "*r")
  (let ((deactivate-mark nil))
    (if mark-active
    (indent-rigidly beg end (- tab-width))
      (backward-delete-char-untabify tab-width))))

;;;; Speedbar.

(eval-after-load 'speedbar
  '(add-to-list 'speedbar-frame-parameters '(font . "5x8")))


;;; -------- COMPILE AND DEBUG CODE
;;; ---------------------------------------------------------------------------

(global-set-key [(f8)] '--toggle-compilation-buffer)
(global-set-key [(shift f8)] '--compile)
(global-set-key "\C-cm" '--compile)
(global-set-key [(meta f8)] '--compile-all)
(global-set-key "\C-c\M-m" '--compile-all)
(global-set-key [(f4)] 'next-error)
(global-set-key [(shift f4)] 'previous-error)

(global-set-key [(f5)] '--run-debugger) ; TODO: `--display-debugger' if already running
(global-set-key "\C-cd" '--run-debugger)
(global-set-key "\C-cv" '--display-debugger)
(global-set-key [(f9)] 'gud-break)           ; set breakpoint on current line
;;(global-set-key [(shift f9)] ) ; inspect
;;(global-set-key [(f8)] 'gud-step)
;;(global-set-key [(f10)] 'gud-next)

;;;; Flymake.

;; TODO:

;;;; Grep.

(require 'grep)

(setenv "GREP_OPTIONS" "--color=auto --binary-files=without-match -rnH")
(setenv "GREP_COLOR" "0;32")

(when --cygwinp                     ; the default "find" finds Windows FIND.EXE
  (setq find-program "/usr/bin/find"))
(setq grep-command
      (format "grep %s\\\n\t-r -e '<R>' ."
          (strjoin (mapcar (lambda (cons) (format "--include='*.%s'" cons))
                   (list "[chyl]" "cpp" "tt" "p[lm]" "txt" "ChangeLog" "*[Mm]akefile")))))
(setq grep-command (format "grep -r -e '<R>' ."))

(global-set-key [(f7)] 'find-grep-dired)
(global-set-key [(shift f7)] 'grep)
;; (global-set-key [(meta f7)] 'unused)

;;;; Compile.
;;
;; --process-error-filename
;;
;; Oftenly `next-error' fails when the path of the error filename is not
;; relative to the compilation directory'. This function is called by Emacs to
;; post-process filenames while parsing error messages. It takes one arg
;; FILENAME which is the name of a file as found in the compilation output, and
;; returns transformed file name. Probably the best generic solution is to
;; search in `cc-search-directories', which is done here in
;; `--find-first-path'.

(require 'compile)

(defvar compile-all-command nil)

(defun --process-error-filename (filename)
  (let ((f filename) (case-fold-search t) (ff-quiet-mode t))
    ;; transform filename -> f
    (when --winntp
      (setq f (replace-regexp-in-string "\\\\" "/"  f)) ; all backslash -> slash
      (setq f (replace-regexp-in-string "^[1-9]>" "" f)) ; remove "N>" at begin of line (devenv.exe)
      )
    ;; actively find f
    (unless (file-exists-p f)
      (setq f (--find-first-path f)))
    ;; return transformed filename f if it exists, else return original
    ;; filename
    (cond ((and f (file-exists-p f)) f) ; ok
      (t filename)                  ; fail
      )
    )
  )

(setq compilation-read-command t
      compilation-scroll-output t
      compilation-ask-about-save nil
      compilation-window-height 25
      compilation-error-regexp-alist
      ;; WARNING: do not use a leading ^
      (append
       ;; cstor/Rlist
       '(("\\(ERROR\\|FEHLER\\|FATAL\\|WARN[IU]NG\\): *\\([a-zA-Z]?:?.+\\) *(\\([0-9]+\\))" 2 3))
       ;; Borland
       '(("\\(Error\\|Fehler\\|Fatal\\|Warn[iu]ng\\) [EW0-9]+ \\([a-zA-Z]?:?.+\\) \\([0-9]+\\):" 2 3))
       ;; MSC
       '(("\\([1-9]+>\\)\\([^\t\n\r]+\\)(\\([0-9]+\\)) *: +\\(fatal\\|error\\|warning\\)" 2 3))
       '((             "\\([^\t\n\r]+\\)(\\([0-9]+\\)) *: +\\(fatal\\|error\\|warning\\)" 1 2))
       ;; Perl
       '(("\\(.+\\) at \\([^ ]+\\) line \\([0-9]+\\)" 2 3))
       ;; Asciidoc
       '(("\\(ERROR\\|WARNING\\|DEPRECATED\\): \\([^ ]+\\): line \\([0-9]+\\):" 2 3))
       compilation-error-regexp-alist)
      compilation-parse-errors-filename-function
      '--process-error-filename)

(defadvice compilation-goto-locus (after echo-error-message activate)
  "Echo the last error message from the most recent compilation buffer.
Useful when the compilation displays in some other frame."
  (if compilation-last-buffer
      (save-excursion
    (set-buffer compilation-last-buffer)
    (goto-char (window-point (get-buffer-window (current-buffer) t)))
    (message (buffer-substring (line-beginning-position) (line-end-position))))
    (error "No compilation started")))

(defun mk () (interactive)
  (let ((buf (--makefile-buffer)))
    (if buf
    (progn (switch-to-buffer buf t)
           (message (buffer-file-name)))
      (switch-to-buffer (get-buffer "*scratch*") t)
      (error "No Makefile found"))))

(defun --makefile-buffer ()
  (defconst mkf '("GNUmakefile"
          "Makefile" "makefile" "makefile.nt"
          "build" "Build.cmd" "startStudio.cmd"
          "Makefile.in" "Makefile.PL"
          ".emacs.local" "README" "MANIFEST"))
  (setq dirname-to-search (--startup-directory))
  (let ((buf) (l mkf))
    (while (and (not buf) l)
      (if (not (get-buffer (setq f (car l))))
      (setq l (cdr l))
    (setq buf (get-buffer f))))
    (when (not buf)                     ; load one
      (let ((dirname dirname-to-search)
        (l mkf))
    (while (and (not buf) l)
      (if (not (--file-exists-p (setq f (concat dirname (car l)))))
          (setq l (cdr l))
        (setq buf (find-file-noselect f))))))
    buf)
  )

(defun --read-compile-command (prompt &optional cmd)
  "Prompts the user for a command, using PROMPT as the prompt, CMD as the value
and proposes `compile-history' with alternate values (default:
`compile-command')."
  (if (not cmd)
      (progn (setq cmd (or compile-command ""))
         (setq prompt (concat prompt " (compile-command): ")))
    (setq prompt (concat prompt ": ")))
  (read-from-minibuffer prompt (eval cmd) nil nil '(compile-history . 1)))

(defun --compile (&optional clean force-prompt)
  "Switch to directory of the makefile, then run `compile'. At the head of the
current buffer look for
    $Compile: COMMAND$
or (when CLEAN is non-nil)
    $Clean: COMMAND$
Tags are first looked up in current buffer, then the makefile buffer."
  (interactive)
  (setq force-prompt current-prefix-arg)
  (let ((start-buf)
    (mkf-buf (--makefile-buffer))
    (hysteresis 10000)
    (prompt (if clean "Clean" "Compile")))
    (save-excursion
      ;; Search for implicit command in the current buffer. If CLEAN set
      ;; `compile-all-command', else `compile-command'. TODO: put multiple tags
      ;; into a history list.
      (goto-char (point-min))
      (if (and clean (re-search-forward "\\$ *[Cc]lean: *\\(.+\\) *\\$" hysteresis t))
      (setq compile-all-command (buffer-substring (match-beginning 1) (match-end 1))
        start-buf (current-buffer))
    (if (re-search-forward "\\$ *[Cc]ompile: *\\(.+\\) *\\$" hysteresis t)
        (setq compile-command (buffer-substring (match-beginning 1) (match-end 1))
          start-buf (current-buffer))))
      ;; Start compilation when `start-buf' is non-nil.
      (cond
       ((bufferp start-buf)
    ;; Can start compilation.  Prompt for command.
    (setq prompt (format "%s (%s)" prompt (buffer-name start-buf)))
    (if (or force-prompt (eq start-buf mkf-buf))
        (if clean
        (setq compile-all-command (--read-compile-command prompt compile-all-command))
          (setq compile-command (--read-compile-command prompt compile-command))))
    ;; Start compilation. `compile' uses `shell-file-name' plus "-c" and
    ;; the command string.
    (if clean
        (if (strempty compile-all-command)
        (error "Empty clean command")
          (compile compile-all-command)
          (message "%s: %s" prompt compile-all-command))
      (if (strempty compile-command)
          (error "Empty compile command")
        (compile compile-command)
        (message "%s: %s" prompt compile-command))
      )
    ;; Raise the compilation buffer.
    (save-excursion
      (display-buffer (compilation-find-buffer) t t)
      (set-buffer (compilation-find-buffer))
      ;; (set-buffer-file-coding-system 'iso-latin-1-unix)
      (set-buffer-file-coding-system 'utf-8)
      )
    )
       (t
    ;; Try to switch to makefile-buffer and `--compile' again.
    (cond
     ((and (bufferp mkf-buf)
           (not (eq (current-buffer) mkf-buf)))
      (set-buffer mkf-buf)
      (--compile clean))
     (t
      (error "No makefile found and the buffer defines no compile command"))
     )
    )
       )
      )
    nil)
  )

(defun --compile-all (&optional force-prompt)
  "See `--compile'."
  (interactive) (--compile t force-prompt))

(defun --toggle-compilation-buffer (&optional kill)
  "Show or hide compilation/grep/find/message buffer in the selected frame.
With KILL non-nil (interactively, with prefix-arg) kill.
Call multiple times to select all buffer types."
  (interactive "P")
  (let (B W)
    (condition-case nil
    (progn
      (setq B (compilation-find-buffer)) ; throws if none
      (if (and kill B) (kill-compilation)))
      ;; No compilation buffer
      (error
       (unless (setq B (get-buffer "*grep*"))
     (unless (setq B (get-buffer "*Find*"))
       (setq B (get-buffer "*Messages*"))))))
    ;; Kill, show or hide `B'
    (if (and kill B)
    (progn (delete-windows-on B)
           (kill-buffer B))
      ;; Show or hide
      (setq W (get-buffer-window B))
      (if W
      (delete-windows-on B)     ; hide
    (delete-other-windows)      ; show
    (if (< (frame-pixel-width) 1920)
        (split-window-vertically)
      (split-window-horizontally))
    (other-window 1)
    (switch-to-buffer B t)
    (end-of-buffer-nomark)
    (other-window -1)
    )
      (if compilation-in-progress
      (format "Compilation '%s' in progress..." compile-command)))
    )
  )

;;;; Debug (GUD).

;; The original `gud-gdb-massage-args' function destroys the <gdb> commandline,
;; i.e. when I type "gdb --args crmd in.rls --" at the "Run gdb (like this):"
;; prompt, GUD actually runs something like gdb --args crmd in.rls -cd
;; DEFAULT-DIRECTORY -fullname This passes the "-cd" and "-fullname" options to
;; the my program, not to <gdb>. I had this problem with Emcas 21.

(eval-after-load "gud"
  '(progn
     (when (fboundp 'gud-gdb-massage-args)
       (fset 'gud-gdb-massage-args
         '(lambda (file args)
        (setq prog-args args)
        (append
         (list "--silent" "-cd" (expand-file-name default-directory) "-fullname") args)))))
  )

(defun --run-debugger ()
  "Run `perldb' or `gdb'.
To run a debuggee with extra arguments, use the command-line
    gdb --args crmd in.rls --"
  (interactive)
  (require 'gud)

  ;; Try to read the GUD command-lines form the hint-file (how to debug this
  ;; project).
  (let ((hint-file (--file-expand-patterns ".emacs.hints" (--startup-directory)))
    prog-args gdb-cmdline perldb-cmdline)
    (when (--file-readable-p hint-file)
      (save-excursion
    ;; Open a pseudo-buffer and paste the hint-file. Skip
    ;; whitespace/comment lines.
    (find-file "*Local Hints*")
    (insert-file hint-file) (not-modified) (setq buffer-read-only t)
    (while (looking-at "\\( *#\\)\\|\\(^ *$\\)")
      (forward-line))
    (let ((start-pos (point)))
      (end-of-line)
      (setq gdb-cmdline (buffer-substring start-pos (point))))
    (kill-buffer (current-buffer))))

    ;; Figure out which debugger to run. The default is to run <gdb>.
    (cond
     ((equal mode-name "Perl")
      ;; This is a Perl buffer. To run perldb we require the current buffer to
      ;; be a perl script using the -w option.
      (save-excursion
    (goto-char (point-min))
    (if (not (looking-at "^#!.*perl.*-w"))
        (error "perldb: this buffer does not look like a perl script with a `-w' flag"))
    (if (not perldb-cmdline)
        (call-interactively 'perldb)
      (perldb perldb-cmdline)
      (insert "c")))
      )
     (t
      (when --emacs22p
    ;; Configure package <gdb-ui.el> introduced in Emacs 22.1.
    ;;
    ;; The new package provides an enhanced graphical interface to GDB. You
    ;; can interact with GDB through the GUD buffer in the usual way, but
    ;; there are also further buffers which control the execution and
    ;; describe the state of your program. It can separate the input/output
    ;; of your program from that of GDB and watches expressions in the
    ;; speedbar. It also uses features of Emacs 21/22 such as the toolbar,
    ;; and fringe bitmaps indicate breakpoints.
    ;;
    ;; To use this package just type M-x gdb.
    (tool-bar-mode t)
    (setq gdb-many-windows t))
      (if (not gdb-cmdline)
      (progn (call-interactively 'gdb)
         (when prog-args
           (insert "run")
           (comint-send-input)))
    (gdb gdb-cmdline)
    (insert "run")))))
  )

(defun --display-debugger ()
  "Display the GUD, with prefix-arg kill it."
  (interactive)
  (if current-prefix-arg
      (--exit-gud)
    (let ((buf (get-buffer "*gud-crmd*"))) ; TODO: the syntax is actually "*gud-FILE*"
      (when buf
    (delete-other-windows)
    (if (eq buf (current-buffer))
        (switch-to-buffer (--recent-buffer)) ; hide the GUD
      (split-window-vertically) (other-window 1)
      (switch-to-buffer buf)
      (gud-refresh)
      (fru-auto-display-window))))))

(defun --exit-gud ()
  "Terminate any existing debugger buffers, no questions asked."
  (interactive)
  (dolist (buf (buffer-list))
    (if (equal (compare-strings (buffer-name buf) 0 5 "*gud-" 0 5 t) t)
    (--close-buffer buf))))

(defadvice perldb (before perldb-kill-existing-debuggers activate compile)
  (--exit-gud))

(defadvice gdb (before gdb-switch-to-desktop activate compile)
  (--exit-gud)
  (mk))

(cond
 (--winntp
  (global-set-key [(meta f1)] (lambda() (interactive)
                (explorer (or (--buffer-file-name (current-buffer)) default-directory)))))
 (t))

;;; -------- PROGRAMMING MODES
;;; ---------------------------------------------------------------------------
;;

(local-set-key [?\C-c] (make-keymap))

(autoload 'ffap-file-at-point "ffap")
(autoload 'python-mode "python" "Python programming language mode" t)
(autoload 'visual-basic-mode "visual-basic-mode" "Visual Basic programming language mode" t)
(autoload 'css-mode "css-mode" "CSS Stylesheet editing mode" t)
(autoload 'bison-mode "bison-mode" "yacc/bison programming languages mode" t)
(autoload 'flex-mode "flex-mode" "flex programming languages mode" t)

;; Prepend new auto-modes. This effectively overloads some predefined
;; `auto-mode-alist' settings. It is applied to the full pathname, not just the
;; filename. WARNING: using "^" at tbe beginning of the regex not working.

(setq auto-mode-alist
      (append (list '("\\.rls$" . cperl-mode)
            ;;'("\\.\\([Pp][Llm]\\|pod\\)$" . cperl-mode)
            '("\\.[Pp][Yy]$" . python-mode)
            '("\\.java?$" . java-mode)
            '("\\.m$" . objc-mode)
            '("\\.\\([hH]\\|inl\\|[io]dl\\)$" . c++-mode)
            '("\\.\\(frm\\|bas\\|rws\\|vb[as]\\|dsm\\|cls\\)$" . visual-basic-mode)
            '("\\.\\(css\\|csspp\\)$" . css-mode)
            '("[Mm]akefile\\.nt$" . makefile-bsdmake-mode) ; for Win32 makefiles
            '("\\.nmake$" . makefile-bsdmake-mode)
            '("\\.l$" . flex-mode)
            '("\\.y$" . bison-mode)
            '("/[_A-Z]+$" . text-mode)
            '("\\.conf" . conf-mode) ; e.g. xorg.conf
            '("\\.xsd" . xml-mode)
            ) auto-mode-alist))

(if --emacs22p
    (setq auto-mode-alist
      (append (list '("\\(GNU\\)?[Mm]akefile$" . makefile-gmake-mode)
            '("\\.mak$" . makefile-gmake-mode))
          auto-mode-alist)))

(defun --CUA-mode-key-bindings (&optional hilite)
  "Enable `pc-selection-mode' to change mark behavior to emulate Motif, Mac or
Windows mark-region and cut and paste style. Setup certain key bindings for PC
compatibility (fixes the problem that on some machines BS returns DEL).

When HILITE is non-nil enable highlighting the current line, and do extra
highlighting of \"TODO:\", \"WARNING:\" etc. See also
`--outline-minor-mode-key-bindings'."
  (require 'outline)
  (require 'pc-select)
  (if --emacs22p
      (pc-selection-mode t)
    (pc-selection-mode))
  (pc-bindings-mode)
  (hl-line-mode t)                   ; minor mode to highlight the current line
  (--enable-quick-markup)

  ;; Prevent annoying bug "The mark is not set now so there is no region" with
  ;; interactive "r" defuns.
  (set-mark (point))
  (deactivate-mark)

  ;; Replace `scroll-up-nomark'; workarround for a bad bug I suffered under for
  ;; years. Sometimes Emacs 21 had hung uncconditionally when pressing PgDown,
  ;; and had to be killed. Why PgUp is not affected I do not know. Rebinding
  ;; PgDown to `scroll-up' did not help.

  (when --emacs21p                      ; 21+
    (global-set-key
     [next] (lambda(&optional arg)
          (interactive "P")
          (condition-case nil
          (next-line-nomark
           (max 1 (truncate (- (/ (display-pixel-height) (frame-char-height)) 1))))
        (end-of-buffer (goto-char (point-max)))))))

  (defadvice forward-sexp-nomark (after show-entry activate compile) (show-entry))
  (defadvice backward-sexp-nomark (after show-entry activate compile) (show-entry))
  (defadvice forward-word-nomark (after show-entry activate compile) (show-entry))
  (defadvice backward-word-nomark (after show-entry activate compile) (show-entry))
  (defadvice forward-sentence (after show-entry activate compile) (show-entry))
  (defadvice backward-sentence (after show-entry activate compile) (show-entry))
  (defadvice kill-sexp (before show-entry activate compile) (show-entry))
  (defadvice kill-comment (before show-entry activate compile) (show-entry))

  (local-set-key [(control a)] 'mark-whole-buffer)
  (local-set-key [(control delete)] '--cleanup-whitespace)
  (local-set-key [(home)] '--beginning-of-line)
  (local-set-key [(end)] 'end-of-line-nomark)
  (local-set-key "\M-t" '--spell-at-point)

  (local-set-key [(meta home)] '--beginning-of-buffer)
  (local-set-key [(meta end)] '--end-of-buffer)
  (local-set-key [(meta up)] '--scroll-down-sticky)
  (local-set-key [(meta down)] '--scroll-up-sticky)
  (local-set-key [(meta left)] '--scroll-right)
  (local-set-key [(meta right)] '--scroll-left)

  ;; Move over content (parsed text).
  (local-set-key [(control home)] (lambda(&optional arg) (interactive "p")
                    (beginning-of-defun arg) (show-subtree)))
  (local-set-key [(control end)] (lambda(&optional arg) (interactive "p")
                   (end-of-defun arg) (show-subtree)))

  ;; Comments, backslashing.
  (local-set-key [(control c)(k)]
         (lambda( &optional beg end )
           "Uncomment region or kill comment on current line."
           (interactive "r")
           (if (or mark-active)
               (uncomment-region beg end)
             (kill-comment 1) (indent-according-to-mode))))
  (local-set-key [(control c)(c)]
         (lambda (&optional beg end)
           "Comment out region or `indent-for-comment'."
           (interactive "r")
           (if (or mark-active)
               (comment-region beg end)
             (indent-for-comment))))
  (local-set-key [?\C-c ?\\] 'c-backslash-region)

  ;; Highlighting.
  (when (and hilite (fboundp 'global-font-lock-mode))
    (font-lock-add-keywords
     nil '(("\\<\\(\\(TODO\\|BUG\\|DISCLAIMER\\|WARNING\\|NOTE\\|ERROR\\):\\)"
        1 font-lock-warning-face prepend))))

  ;; Rebind common keys for cursor motion and to jump over sexps (Emacs slang
  ;; for balanced expressions). We generalize keys set by various
  ;; programming-language-mode-hooks here, e.g., `C-e' to kill balanced
  ;; expressions.

  (local-set-key [(control e)] 'kill-sexp)
  (local-set-key [(control up)] 'backward-paragraph-nomark)
  (local-set-key [(control down)] 'forward-paragraph-nomark)
  (local-set-key [(control left)] 'backward-sexp-nomark)
  (local-set-key [(control right)] 'forward-sexp-nomark)
  (local-set-key [(control shift left)] (lambda()(interactive)(show-all)(backward-sexp)(mark-sexp 1)))
  (local-set-key [(control shift right)] 'mark-sexp)
  )

;;;; cc (C/C++, ObjectiveC, Java)
;;
;; Create faces that `cc-mode' (<cc-fonts.el>) classifies "future-extensions",
;; and have to be defined defined in advance here.
;;
;; `font-lock-doc-markup-face' -> `c-doc-markup-face-name': comment markups
;; such as Javadoc-tags.
;;
;; `font-lock-doc-string-face' -> `c-doc-face-name': comment markups.
;;
;; `font-lock-label-face' -> `c-label-face-name': labels, case, public,
;; private, proteced
;;
;; See also:
;; - http://www.chemie.fu-berlin.de/chemnet/use/info/cc-mode/cc-mode_6.html
;; - http://www.informatik.uni-hamburg.de/RZ/software/emacs/cc-mode/cc-mode_4.html#SEC7

(defun --copy-face (new-face face)
  "Define NEW-FACE from existing FACE."
  (copy-face face new-face)
  (eval `(defvar ,new-face nil))
  (set new-face new-face))

(--copy-face 'font-lock-doc-markup-face 'font-lock-doc-face) ; alternately: `font-lock-preprocessor-face'
(--copy-face 'font-lock-doc-string-face 'font-lock-comment-face)
(--copy-face 'font-lock-label-face 'font-lock-keyword-face)

(require 'cc-mode)
(require 'cc-styles)

(autoload 'c-comment "c-fill" "Formatting for multiline C comments" t)
(autoload 'hide-ifdef-mode "hideif" "Hide code within preprocessor conditionals" t)

(setq c-doc-comment-style '((java-mode . javadoc)
                (pike-mode . autodoc)
                (c-mode. javadoc)
                (c++-mode. javadoc)))

(c-add-style "compact-k&r"
         '("k&r"
           (c-tab-always-indent . t)
           (c-backslash-column . 72)
           (c-basic-offset . 4)
           (c-echo-syntactic-information-p . t)
           ;; Auto-cleanup certain constructs,such als "} else {". Most of
           ;; them take place only when auto-newline has been turned on.
           (c-cleanup-list . (brace-else-brace
                  brace-elseif-brace
                  brace-catch-brace
                  empty-defun-braces
                  defun-close-semi
                  list-close-comma
                  scope-operator))
           ;; Map syntactic symbols to indentation offsets. See the
           ;; `c-offsets-alist' documentation syntactic symbols.
           (c-offsets-alist . ((inline-open . +)
                   (inline-close . 0)
                   (knr-argdecl-intro . +)
                   (knr-argdecl . 0)
                   (label . 0)
                   (access-label . -)
                   (case-label . 0)
                   (statement-case-intro . +)
                   (statement-case-open . +)
                   (substatement . +)
                   (substatement-open . 0)
                   (inclass . 4) (friend . 0)))
           ;; Leave the comment starter/terminator on separate lines.
           (c-hanging-comment-starter-p . nil)
           (c-hanging-comment-ender-p . nil)
           ;; Control insertion of newlines after braces and commas.
           ;;(c-hanging-brace-alist . ())
           (c-hanging-semi&comma-criteria
        . ((lambda ()
             ;; Prevent newlines from being inserted after semicolons
             ;; when there is a non-blank following line. Based on code
             ;; from the CC mode manual.
             (save-excursion
               (if (and (eq last-command-char ?\;)
                (zerop (forward-line 1))
                (not (looking-at "^[ \t]*$"))) 'stop nil)))
           ;; Stop if a comma/semicolon was inserted in a parentheses
           ;; list.
           c-semi&comma-inside-parenlist))))

(add-hook 'hide-ifdef-mode-hook
      '(lambda()
         (unless hide-ifdef-define-alist
           (setq hide-ifdef-define-alist
             '((win32  UNICODE _UNICODE NDEBUG _MSC_VER _WIN32)
               (win32d UNICODE _UNICODE _DEBUG _MSC_VER _WIN32))))
         (hide-ifdef-use-define-alist 'win32d) ; use this list by default
         (setq hide-ifdef-initially t)))

(add-hook 'c-mode-common-hook
      '(lambda()
         (c-set-style "compact-k&r")
         (--CUA-mode-key-bindings t)
         ;; Fill paragraphs. This only affects `fill-paragraph' and not
         ;; `fill-region'
         (setq fill-paragraph-function 'c-fill-paragraph)
         (local-set-key [(meta q)] '--fill)
         ;; Javadoc comment style. Also let "- " begin paragraphs (item
         ;; lists). The regular `c-paragraph-start' is just "$".
         (when --emacs22p
           (setq c-paragraph-start "\\(@[a-zA-Z]+\\>\\|$\\|- \\)") ; for Javadoc
           (c-setup-paragraph-variables))
         ;; Enable auto-newline insertion (evident by "/a" on the
         ;; modeline). Electrifies certain keys such as the left and right
         ;; braces, colons, semi-colons, etc.
         (if --emacs22p
         (c-toggle-auto-newline 1)
           (c-toggle-auto-state 1))
         ;; Enable hungry-deletion of whitespace (evident by "/h" on the
         ;; modeline). Electrifies backspace/delete keys by consuming all
         ;; preceding/forward whitespace, including newlines and tabs.
         (c-toggle-hungry-state 1)
         (local-set-key [(delete)] 'c-electric-delete-forward)
         ;; Change the insertion behavior of line continuation backslash
         ;; for `c-indent-line' (see cc-cmds.el). The regular code not
         ;; working well: inserts also if on #include, or on a macro that
         ;; yet has no backslashes. The below code only proceeds to
         ;; `c-indent-line' if not on a macro, or if the macro already has
         ;; backslashes, otherwise calls `newline-and-indent'.
         (local-set-key
          [(return)]
          '(lambda() (interactive)
         (let ((has-backslash))
           (save-excursion
             (end-of-line-nomark)
             (if (eq (char-before) ?\\)
             (setq has-backslash t)))
           (if --emacs21p
               (newline-and-indent)
             (if (and (not has-backslash) (c-query-macro-start))
             (newline-and-indent)
               (c-newline-and-indent))))))
         ;; Enable C outline minor mode (NOT part of GNU Emacs).
         (when (and (not --no-desktop) (load "c-outline" t))
           (c-outline)
           (--outline-minor-mode-key-bindings))
         ;; Define C-HOME and C-END for C modes.
         (local-set-key [(control home)] 'c-beginning-of-defun)
         (local-set-key [(controlend)] 'c-end-of-defun)
         (local-set-key [?\C-x ?\C-a] 'c-mark-function)
         ;; TODO: Define advices for `c-electric-paren' (called on `(' and
         ;; `)') and `c-electric-brace' (called on `{' and `}'). See code
         ;; of these functions. Insert additional space before '(':
            ;;;if( => if (
         )
      t)

(when nil
  (add-hook 'c++-mode-hook
        (lambda()
          (font-lock-add-keywords
           'c++-mode
           '(("\\<\\(void\\|unsigned\\|signed\\|char\\|short\\|bool\\|int\\|long\\|double\\|float\\)\\>" .
          font-lock-keyword-face)))) t)
  )

(add-hook 'java-mode-hook (lambda()) t)

(define-derived-mode nonelectric-c-mode c-mode "Nonelectric-C"
  "Enable C-mode with all electricity turned off. Useful for C-like files."
  (setq left-margin 8 fill-column 79 indent-tabs-mode nil tab-width 4)
  ;;(c-toggle-auto-newline nil)
  ;;(c-toggle-hungry-state nil)
  (c-toggle-electric-state 0))

;;;; Generic modes
;;
;; For various other file types. For a list of generic modes see the constants
;; `generic-default-modes', `generic-mswindows-modes', `generic-unix-modes'.

(require 'generic-x)

;;;; Perl, Python Modes.
;;
;; See also the micro-docs `cperl-tips-faces', `cperl-problems',
;; `list-colors-display'.

(defalias 'perl-mode 'cperl-mode)
(eval-after-load "cperl-mode"
  '(progn
     (font-lock-add-keywords
      'cperl-mode
      '(("\\<\\(map\\|split\\|exists\\|basename\\|defined\\|undef\\|scalar\\|delete\\|print\\|push\\|pop\\|keys\\|values\\|shift\\|unshift\\|qw\\|qq\\|confess\\|croak\\|length\\|reverse\\|sort\\)[^A-Za-z0-9_]+" .
     font-lock-keyword-face)))))

(add-hook 'cperl-mode-hook
      (lambda()
        (--CUA-mode-key-bindings t)
        (--enable-quick-markup "F<" ">" "C<" ">")
        (setq case-fold-search nil)
        (setq cperl-font-lock t
          cperl-hairy nil
          ;;cperl-syntaxify-by-font-lock nil
          cperl-comment-columns 72
          cperl-indent-level 4
          cperl-continued-statement-offset 0
          cperl-label-offset 0
          cperl-min-label-indent 4
          ;; Electric braces, colons, semicolons.
          cperl-auto-newline-after-colon nil
          cperl-auto-newline nil
          cperl-extra-newline-before-brace nil
          cperl-extra-newline-before-brace-multiline nil
          cperl-electric-parens nil
          cperl-electric-linefeed nil
          ;; Syntax formatting.
          cperl-fix-hanging-brace-when-indent t
          cperl-break-one-line-blocks-when-indent nil
          cperl-merge-trailing-else t
          cperl-indent-left-aligned-comments nil)

        (local-set-key [?\C-x ?\C-a] 'c-mark-function)

        ;; Outline minor mode and `outline-level' function.

        (--outline-minor-mode-key-bindings
         (shy-re (join-re "#!.+" "package\\b" "__DATA__" "__END__")
             (join-re "=head[1-2]\\b") ; \1
             (join-re "=head[3-4]\\b") ; \2
             (shy-re "=item\\b")       ; \3
             ;;(shy-re "=item\\b" "sub\\b" "BEGIN\\b" "INIT\\b") ; \3
             ;;(shy-re "use vars\\b" "if ([01])" "for\\b" "foreach\\b" "while\\b") ; \4
             ;;(shy-re "if\\b" "unless\\b" "open\\b") ; \5
             ))

        (setq outline-level '(lambda ()
                   (save-excursion
                     (let ((case-fold-search nil))
                       (if (looking-at outline-regexp)
                       ;; Else parse the `outline-regexp'.
                       (cond ((match-beginning 1) 1)
                         ((match-beginning 2) 2)
                         ((match-beginning 3) 3)
                         ((match-beginning 4) 4)
                         ((match-beginning 5) 5) (t 6))
                     ;; Return 0 for "before first heading".
                     (if (bobp) 0 1000))))))

                    ;(hide-body)
        ) 1)

(add-hook 'python-mode-hook
      '(lambda()
         (--CUA-mode-key-bindings t)
         (setq indent-tabs-mode nil)
         ;; Place or move comment when '#' is pressed.
         (local-set-key (vector ?\#) '--indent-for-comment)
         ))

;;;; sh

(add-hook 'sh-mode-hook
      (lambda()
        (--CUA-mode-key-bindings t)
        ;; Place or move comment when '#' is pressed.
        ;;  (local-set-key (vector ?\#) '--indent-for-comment)
        (setq tab-width 4 sh-indent-comment t)))

;;;; Lisp, Visual Basic, Yacc, Lex Modes
;;

(add-hook 'emacs-lisp-mode-hook
      '(lambda()
         (--CUA-mode-key-bindings t)
         (--enable-quick-markup)
         (global-set-key [?\C-x ?\C-e] 'eval-region)
         (global-set-key [?\C-x ?\M-e] 'eval-defun)
         (when --emacs22p (setq emacs-lisp-docstring-fill-column nil))
         ;; Define outline regex with a prefix of ';;;' (the lowest sublevel is 3).
         (--outline-minor-mode-key-bindings "\\(;;;+\\|(defun\\)")
         (local-set-key (vector ?\;) '--indent-for-comment)
         ))

(add-hook 'visual-basic-mode-hook
      '(lambda()
         (--CUA-mode-key-bindings t)
         (setq visual-basic-capitalize-keywords-p t
           visual-basic-wildcards "*.frm *.bas *.cls *.rws *.vbs *.dsm")))

(defun byacc-mode()
  "Enable YACC file editing with Perl action code (assumes C mode as the
base)."
  (interactive)
  (setq c-font-lock-extra-types
    (append c-font-lock-extra-types
        '("__[a-z0-9_]+"        ; identifiers beginning with '__'
          "\\$."                ; yacc vars: $$, $1, $2 ...
          "^ *\\| "             ; rules separator
          )))
  (c-mode)
  (if --emacs22p                        ; disable auto-newline on : , ; { }
      (c-toggle-auto-newline 1)
    (c-toggle-auto-state 1))
  ;; Set font-lock patterns for this mode.
                    ;   (font-lock-add-keywords 'c-mode
                    ;'(("^[A-Za-z_ ]*{\\|}[^{]*$\\|^ *|" . font-lock-constant-face)
                    ;)
                    ;)
  )

;;;; Log4j / Log4cplus

;; The commands `M-}' and `M-{' are redefined to move to the end and beginning
;; of the current log record. Log file buffers are auto reverted by default (or
;; set `log4j-auto-revert-flag' to nil).

(autoload 'log4j-mode "log4j-mode" "Major mode for viewing log files." t)
(add-to-list 'auto-mode-alist '("\\.log\\'" . log4j-mode))

;;;; Makefile Mode
;;

(add-hook 'makefile-mode-hook
      '(lambda()
         (--CUA-mode-key-bindings t)
         (setq indent-tabs-mode t)
         (local-set-key [?\C-c ?\\] 'makefile-backslash-region)))

;;;; Change-Log Mode

(add-hook 'change-log-mode-hook
      '(lambda () ; note that the "^" is *implicit* at the beginning of the regexp
         (set (make-local-variable 'outline-regexp) "[[:digit:]]+")))

;;;; Template Mode (Perl Template Toolkit)

;; Download <template-mode.el> at <http://www.visualco.de>.

(autoload 'template-mode "template-mode" "Major mode for editing Template-Toolkit files" t)
(autoload 'template-minor-mode "template-mode" "Minor mode for editing Template-Toolkit files" t)
(autoload 'outline-template-mode "template-mode" "Combines `outline-mode' (major) with `template-minor-mode'" t)
(autoload 'htmlize-buffer "htmlize" "Convert BUFFER to HTML, preserving colors and decorations" t)

;; Enable `outline-template-mode' on .tt/.tt2-files.

(setq auto-mode-alist
      (append '(("\\.\\(tt\\|tt2\\)$" . outline-template-mode)) auto-mode-alist))

;;;; AutoHotkey-mode (`ahk-mode')

(when --winntp
  (setq ahk-syntax-directory (--file-expand-variables "$PROGRAMFILES/AutoHotkey/Extras/Editors/Syntax/"))
  (add-to-list 'auto-mode-alist '("\\.ahk$" . ahk-mode))
  (autoload 'ahk-mode "ahk-mode")
  (add-hook 'ahk-mode-hook
        '(lambda()
           (--CUA-mode-key-bindings t)
           (local-set-key (vector ?\;) '--indent-for-comment)
           (font-lock-add-keywords
        nil '(("\\<\\(if\\|else\\)\\>" . font-lock-keyword-face)))
           )
        )
  )

;;;; Asciidoc-mode, Text-mode

(autoload 'asciidoc-mode "asciidoc-mode" "" t)
(add-hook 'asciidoc-mode-hook
      '(lambda() (--enable-quick-markup "'" "'" "$$`" "`$$")))

(add-hook 'text-mode-hook
      '(lambda()
         (ispell-minor-mode)
         (--CUA-mode-key-bindings)
         (turn-on-auto-fill)
         (setq indent-tabs-mode nil)
         ;; Put _ into word constituent class (see "Syntax Tables" in "GNU
         ;; Emacs Lisp Reference Manual").
         (modify-syntax-entry ?_ "w")
         ;; Rebind keys for text modes.
         (local-set-key [(control e)] 'kill-word)
         (local-set-key [(control up)] 'backward-paragraph-nomark)
         (local-set-key [(control down)] 'forward-paragraph-nomark)
         (local-set-key [(control left)] 'backward-word-nomark)
         (local-set-key [(control right)] 'forward-word-nomark)
         (local-set-key [(control shift up)] '(lambda()(interactive)(backward-paragraph-nomark)(forward-paragraph-mark)))
         (local-set-key [(control shift down)] '(lambda()(interactive)(forward-paragraph-nomark)(backward-paragraph-mark)))
         (local-set-key [(control shift left)] 'backward-word-mark)
         (local-set-key [(control shift right)] 'forward-word-mark))
      )

;;;; (La)TeX mode

;; `latex-mode' is the major mode for editing files of input for LaTeX, and
;; implemented in <tex-mode.el>. `LaTeX-mode' is the major AUCTeX mode for
;; editing LaTeX. `font-latex' (not part of Emcas) implements better syntax
;; coloring.

(add-hook 'latex-mode-hook
      '(lambda()
         (--CUA-mode-key-bindings)
         (imenu-add-menubar-index)
         (make-variable-buffer-local 'time-stamp-line-limit)
         (setq time-stamp-line-limit 200)
         (if --winntp (setq tex-dvi-print-command "bash -c \"dvips -f *\""))
         (--enable-quick-markup"``" "''" "\\emph{" "}")
         (local-set-key [(control return)] 'latex-insert-item) ; default is M-RETURN
         (if nil
         (--outline-minor-mode-key-bindings
          (join-re "\\\\subparagrap" ; 12: \subparagraph
               "\\\\paragraph."  ; 11: \paragraph
               "\\\\subsubsec"   ; 10: \subsubsection
               "\\\\begin{ab"
               "\\\\subsecti"            ; 9: \subsection \begin{abstract}
               "\\\\section"             ; 8: \section
               "\\\\title{" "\\\\docume" ; 7: \documentclass
               )))

         (when (load "font-latex" t)
           (setq font-lock-maximum-decoration t
             font-latex-do-multi-line nil)
           (custom-set-variables
        '(font-latex-match-reference-keywords
          (quote                ; defaults with \footnote... removed
           ("nocite" "cite" "label"
            "pageref" "vref" "eqref" "ref"
            "include" "input" "bibliography"
            "index" "glossary"
            "sectref" "longref"
            "tabref" "tablongref"
            "figref" "figlongref"))))
           (custom-set-faces
        '(font-latex-bold-face ((t (:foreground "darkslategrey" :bold t :weight bold))))
        '(font-latex-italic-face ((t (:foreground "darkslategrey" :italic t :slant italic))))
        '(font-latex-math-face ((t (:foreground "darkorange3" :background "white smoke"))))
        '(font-latex-sedate-face ((t (:foreground "mediumblue")))) ; own macros, minor keywords
        '(font-latex-string-face ((t (:foreground "violetred" :family "arial"))))
        '(font-latex-subscript-face ((t (:height 0.8))))
        '(font-latex-superscript-face ((t (:height 0.8))))
        '(font-latex-title-1-face ; section
          ((((type tty pc) (class color)))
           (t (:height 1.3 :inherit font-latex-title-2-face))))
        '(font-latex-title-2-face ; subsection
          ((((type tty pc) (class color)))
           (t (:height 1.2 :inherit font-latex-title-3-face))))
        '(font-latex-title-3-face ; subsubsection
          ((((type tty pc) (class color)) (:weight bold))
           (t (:height 1.1 :inherit font-latex-title-4-face))))
        '(font-latex-title-4-face ; paragraph
          ((((type tty pc) (class color)) (:weight bold))
           (((class color) (background light)) (:weight bold :inherit variable-pitch :foreground "blue"))
           (((class color) (background  dark)) (:weight bold :inherit variable-pitch :foreground "yellow"))
           (t (:weight bold :inherit variable-pitch))))
        '(font-latex-warning-face
          ((t (:foreground "black" :background "greenyellow" :weight normal)))))
           )
         )
      )

(when (and (load "auctex.el" t)
       (load "preview-latex.el" t))
  ;; AUCTeX is an advanced mode to edit (La)TeX files which must be installed
  ;; separately.
  (message "AUCTeX found")
  (require 'tex-mik)                    ; more appropriate values for MiKTeX
  (setq TeX-default-mode 'LaTeX-mode)
  (setq-default TeX-master nil)         ; the name of the master file
  (setq TeX-quote-after-quote t         ; type " twice to get TeX-quotes
    TeX-parse-self t
    TeX-auto-save t)
  (setq auto-mode-alist (append (list '("\\.\\(tex\\|cl[so]\\)$" . LaTeX-mode)) auto-mode-alist))
  (custom-set-variables
   ;;'(LaTeX-enable-toolbar nil); turn off AUCTeX toolbar
   '(TeX-electric-sub-and-superscript t))
  (add-hook 'LaTeX-mode-hook            ; also runs `latex-mode-hook'
        '(lambda()
           (auto-fill-mode t)
           (outline-minor-mode t)
           (LaTeX-math-mode)
           (TeX-fold-mode 1)
           (setq ispell-extra-args '("--mode=tex"))
           (local-set-key [(shift tab)] 'TeX-complete-symbol)
           (local-set-key [(f4)] 'TeX-next-error)
           (local-set-key [(f5)] 'TeX-command-master) ; normally runs gdb (debug program)
           (local-set-key [?\M-g ?g] 'TeX-normal-mode)

           ;; From version 11.82 on, handling of verbatim constructs was
           ;; consolidated across AUCTeX. This resulted in the
           ;; font-latex-specific variables
           ;; `font-latex-verb-like-commands',
           ;; `font-latex-verbatim-macros', and
           ;; `font-latex-verbatim-environments' being removed and the more
           ;; general variables `LaTeX-verbatim-macros-with-delims',
           ;; `LaTeX-verbatim-macros-with-braces', and
           ;; `LaTeX-verbatim-environments' being added.

           (setq LaTeX-verbatim-macros-with-braces (list "code")
             LaTeX-verbatim-environments (list "verbatim" "clang" "Clang" "Shlang" "Rlistlang"))

           ;; Deutsche Anführungszeichen.
           (if 0
           (progn (ispell-change-dictionary "deutsch")
              (setq TeX-open-quote "\"`")
              (setq TeX-close-quote "\"'")))
           )
        )
  )

;;;; Windows BAT/CMD files
;;
;; Refine `bat-generic-mode' from <generic-x.el> for more keywords as
;; `cmd-generic-mode'. Code has been copied straight from <generic-x.el>, then
;; modified. Note C-c C-c still runs `bat-generic-mode-compile'.

(add-hook 'cmd-generic-mode-hook
      '(lambda()
         (setq tab-width 8
           tab-stop-list '(1 8 16 24 32 40 48 56 64 72 80 88 106))
         (local-set-key [(tab)] 'tab-to-tab-stop)
         (message "Hello `cmd-generic-mode-hook'.")))

(define-generic-mode cmd-generic-mode
  nil
  nil
  (eval-when-compile
    (list
     ;; Make this one first in the list, otherwise comments will be
     ;; over-written by other variables
     '("^[@ \t]*\\([rR][eE][mM][^\n\r]*\\)" 1 font-lock-comment-face t)
     '("[ \t]+\\(&[rR][eE][mM][^\n\r]*\\)"  1 font-lock-comment-face t)
     '("^[ \t]*\\(::.*\\)"          1 font-lock-comment-face t)
     '("[ \t]+\\(::.*\\)"           1 font-lock-comment-face t)
     '("^[@ \t]*\\([bB][rR][eE][aA][kK]\\|[vV][eE][rR][iI][fF][yY]\\)[ \t]+\\([oO]\\([nN]\\|[fF][fF]\\)\\)"
       (1 font-lock-builtin-face)
       (2 font-lock-constant-face t t))
     ;; Any text (except ON/OFF) following ECHO or ECHO. is a string.
     '("^[@ \t]*\\([eE][cC][hH][oO]\\.?\\)[ \t]+\\(\\([oO]\\([nN]\\|[fF][fF]\\)\\)\\|\\([^>|\r\n]+\\)\\)"
       (1 font-lock-builtin-face)
       (3 font-lock-constant-face t t)
       (5 font-lock-string-face t t))
     ;; These keywords appear as the first word on a line. (Actually, they can
     ;; also appear after "if ..." or "for ..." clause, but since they are
     ;; frequently used in simple text, we punt.)
     ;;
     ;; In `generic-bat-mode-setup-function' we make the keywords
     ;; case-insensitive
     (generic-make-keywords-list
      '("exit"
    "for"
    "if"
    "setlocal" "endlocal"
    "mode"
    "set"
    "chcp"
    "color"
    )
      font-lock-keyword-face "^[@ \t]*")
     ;; These keywords can be anywhere on a line.
     (generic-make-keywords-list
      '("do"
    "exist"
    "else"
    "errorlevel"
    "goto"
    "in"
    "not"
    "use"               ; NET USE ...
    "con"               ; MODE CON ...
    "enableextensions"      ; SETLOCAL
    "enabledelayedexpansion"    ; SETLOCAL
    )
      font-lock-keyword-face)
     ;; These are built-in DOS/Windows commands or external commands frequently
     ;; used in batch files.
     (generic-make-keywords-list
      '("call"
    "cd"
    "cls"
    "copy"
    "choice"
    "del"
    "dir"
    "echo"
    "find"
    "md"
    "net"
    "notepad"
    "path"
    "pause"
    "ping"
    "prompt"
    "rd"
    "ren"
    "set"
    "start"
    "shift"
    "subst"
    "title")
      font-lock-builtin-face "[ \t|\n]")
     ;; Labels, pipes.
     '("^[ \t]*\\(:\\sw+\\)"         1 font-lock-function-name-face t)
     '("\\(>[A-Za-z ]+\\)"       1 font-lock-function-name-face t)
     ;; Variables.
     '("\\(!\\sw+!\\)"           1 font-lock-variable-name-face t)
     '("\\(%\\sw+%\\)"           1 font-lock-variable-name-face t)
     '("\\(%%\\sw+\\)"           1 font-lock-variable-name-face t)
     '("\\(%[0-9]\\)"            1 font-lock-variable-name-face t)
     '("[\t ]+\\([+-/][^\t\n\" ]+\\)" 1 font-lock-type-face)
     '("[ \t\n|]\\<\\([gG][oO][tT][oO]\\)\\>[ \t]*\\(\\sw+\\)?"
       (1 font-lock-keyword-face)
       (2 font-lock-function-name-face nil t))
     '("[ \t\n|]\\<\\([sS][eE][tT]\\)\\>[ \t]*\\(\\sw+\\)?[ \t]*=?"
       (1 font-lock-builtin-face)
       (2 font-lock-variable-name-face t t))))
  '("\\.[bB][aA][tT]\\'"
    "\\.[cC][mM][dD]\\'"
    "\\`[cC][oO][nN][fF][iI][gG]\\."
    "\\`[aA][uU][tT][oO][eE][xX][eE][cC]\\.")
  '(generic-bat-mode-setup-function)
  "Revisited generic mode for MS-Windows batch files.  Replaces `bat-generic-mode'."
  )

;;; -------- DESKTOPS / EXIT EMACS
;;; ---------------------------------------------------------------------------

;; Hooks when Emacs is killed or buffers are killed or saved.

(global-set-key [(meta f4)]
        '(lambda ()
           "Run `--nuke', save all buffers, close Emacs. Like
`save-buffers-kill-emacs', but buffers are cleaned and the rest is saved
without user interaction. In particular, the value of
`buffer-save-without-query' is ignored."
           (interactive)
           (--nuke) (save-some-buffers t)
           (process-kill-without-query (get-process "shell"))
           (when (and (one-window-p t t)
                  ;;(yes-or-no-p "Terminate Emacs? ")
                  )
             (save-buffers-kill-emacs))))

(add-hook 'write-file-hooks
      '(lambda()            ; WARNING: must return nil or Emacs won't exit!
         (unless (or (eq major-mode 'makefile-mode)
             (eq major-mode 'makefile-gmake-mode)
             (eq major-mode 'makefile-automake-mode))
           (copyright-update))
         (time-stamp)))

;;;; Try loading desktop from a previous session.

;; Use `desktop-save' once to save the desktop. When it exists, Emacs updates
;; it on every exit. In Emacs 22+ `desktop-read' is implicitly added to the
;; `after-init-hook' when Emacs is started without the "--no-desktop"
;; command-line switch, and from buffer <*scratch*>.`desktop-read' looks for a
;; file named `desktop-base-file-name' (set below) in directories listed by
;; `desktop-path', with the default value ("." "~/.emacs.d/" "~").

(message (format "Initial buffer-name <%s>, default directory <%s>"
         (buffer-name (current-buffer)) default-directory))

(unless --no-desktop
  (let ((dfn (concat (if --xemacsp ".xemacs" ".emacs") ".desktop."
             (if --winntp "windows-nt"
               (if --macosp "mac-os"
             (if --linuxp "gnu-linux"
               (if --unixp (symbol-name system-type) "generic"))))
             (concat "." (user-login-name)))))
    (message "Looking for desktop file...")
    (if --emacs22p
    (progn
      (setq desktop-save 'if-exists)
      (desktop-save-mode t)
      ;; Look for desktop file only in working directory (alias
      ;; `default-directory' of the scratch buffer). Motivation: do not
      ;; switch to the $HOME desktop when the current directory has no
      ;; desktop yet.
      (setq desktop-base-file-name dfn)
      (setq desktop-path (list "."))
      ;; Heal bug in `desktop-save' "Symbol's value as variable is void: p"
      ;; that prevents Emacs from exiting. Functions in `kill-emacs-hook'
      ;; cannot ask for confirmation to quit anyway.
      (defadvice desktop-save (around heal-desktop-save activate)
        (condition-case err ad-do-it (error (ding))))
      ;; When no desktop was found open the default file and create a
      ;; desktop in `desktop-dirname'.
      (add-hook 'desktop-after-read-hook
            '(lambda() (setq --have-desktop t)))
      (add-hook 'desktop-no-desktop-file-hook
            '(lambda()
               (condition-case nil
               (progn (mk) (desktop-save-in-desktop-dir))
             ;; TODO: is --have-desktop true?
             (error (message "No desktop file found"))))
            )
      )
      ;; Below Emacs 22.1 there is no `desktop-after-read-hook'. Assume that
      ;; `desktop-read' succeeds or throws.
      (require 'desktop)
      (setq desktop-enable t)
      (setq desktop-file-name-format 'local ; absolute, tilde, local
        desktop-basefilename dfn)
      (desktop-load-default)
      (desktop-read)
      (setq --have-desktop
        (file-exists-p (concat desktop-dirname "/" desktop-basefilename)))
      )

    ;; Code run before the desktop is saved.

    (when --have-desktop
      (setq desktop-locals-to-save
        (append desktop-locals-to-save
            '(default-directory
               truncate-lines))
        desktop-globals-to-save
        (append desktop-globals-to-save
            '(minibuffer-history
              tags-table-list
              file-name-history
              extended-command-history shell-command-history
              regexp-history
              compile-command compile-history
              compile-all-command
              find-args-history
              grep-history
              grep-find-history
              find-args-history
              query-replace-history
              gud-gdb-history gud-gdx-history gud-perldb-history)
            )
        )
      (add-hook
       'desktop-save-hook
       '(lambda()
      (--nuke t)                        ; kill unneeded buffers and dot-files
      (when (featurep 'compile)
        (desktop-truncate compile-history 10)
        (desktop-truncate grep-history 20))
      (desktop-truncate minibuffer-history 8)
      (desktop-truncate file-name-history 20)
      (desktop-truncate search-ring 8)
      (desktop-truncate regexp-search-ring 8))
       )
      )
    )
  )

;; Hook run after ~/.emacs and a possible desktop was loaded. Evaluate
;; .emacs.local and set frame properties.

(defun --eval-file-of-lisp (elfile)
  (setq elfile (--file-expand-variables elfile))
  (if (--file-exists-p elfile)
      (progn
    (let ((ff-quiet-mode nil))
      (condition-case nil
          (progn (load-file elfile))
        (error "Evaluating <%s>: load error!" elfile))))
    (message "<%s> not found" elfile)))

(defun --reset-buffer-modes ()
  "Visit all buffers to reset their modes and force a refontification."
  (interactive)
  (save-excursion
    (let ((bufl (buffer-list)))
      (while bufl (setq buf1 (car bufl) bufl (cdr bufl))
         (set-buffer buf1)
         (normal-mode)
         (font-lock-fontify-buffer)))))

(add-hook 'after-init-hook
      '(lambda()
         (let ((ff-quiet-mode t)
           (startdir (--startup-directory)))
           (let ((globaldirs (list "$HOME" "$HOME/bin/elisp"))
             (localdirs (list startdir
                      (concat startdir "/..")
                      (concat startdir "/res")
                      (concat startdir "/mk"))))
         (--eval-file-of-lisp "$HOME/.emacs.local")
         (--eval-file-of-lisp (concat startdir "/.emacs.local"))
         ;; Find us a frame icon.
         (when --winntp
           (setq --desktop-icon (or (--find-first-path "makefile.ico" localdirs)
                        (--find-first-path "favicon.ico" localdirs)
                        (--find-first-path "emacs.ico" localdirs)))
           (let ((found (mapcar
                 (lambda (cons)
                   (--find-first-path cons (append localdirs globaldirs)))
                 (list "build.ico" "shell.ico"))))
             (setq --compile-icon (nth 0 found)
               --shell-icon (nth 1 found)))
           (message "Icons: <%s> (desktop), <%s> (compile), <%s> (shell)"
                --desktop-icon --compile-icon --shell-icon))
         ;; Set frame title and icon.
         (when (featurep 'frame-utils)
           (fru-set-frame-icon --desktop-icon nil
                       (concat (if (<= (length startdir) 50) startdir
                         (concat "..." (substring startdir (-(length startdir) 12))))
                           " -- " frame-title-format)))
         (when --emacs22p
           (message "startup: %s @ %f sec, %s"
                startdir
                (- (float-time (current-time)) --start-time)
                (if --have-desktop "have saved session" "no saved session")))
         )
           t)
         )
      )

;;; AUTO-INSERT, SKELETONS AND ABBREVS
;;; ---------------------------------------------------------------------------

(define-auto-insert
  (cons "\\.\\([Hh]\\)\\'" "C/C++ header")
  '(nil
    "/* -*-coding:iso-latin-1-unix-*-\n"
    " *\n"
    " * " (file-name-nondirectory buffer-file-name) "\n"
    " *\n" " *\n" " *\n"
    " ********\n"
    " * $Author: " (user-full-name) " <" user-mail-address ">$\n"
    " * $Companion: $\n"
    " * $Writestamp: $\n"
    " */\n"
    (let* ((noext (substring buffer-file-name 0 (match-beginning 0)))
       (nopath (file-name-nondirectory noext))
       (ident (concat "__" (upcase nopath) "_H")))
      (concat "#ifndef " ident "\n"
          "#define " ident  "\n\n\n\n"
          "\n\n#endif /* " ident " */\n"))))

(define-auto-insert
  (cons "\\.\\(cpp\\|C\\|cxx\\)\\'" "C/C++ module")
  '(nil
    "/* -*-coding:iso-latin-1-unix-*-\n"
    " *\n"
    " * " (file-name-nondirectory buffer-file-name) "\n"
    " *\n"
    " ********\n"
    " * $Author: " (user-full-name) " <" user-mail-address ">$\n"
    " * $Compile: g++ -std=c++0x -lm " (file-name-nondirectory buffer-file-name) " && ./a && rm a.*$\n"
    " * $Writestamp: $\n"
    " */\n"
    "\n"
    "#include <cassert>\n"
    "#include <iostream>\n"
    "#include <sstream>\n"
    "#include <stdexcept>\n"
    "#include <algorithm>\n"
    "#include <functional>\n"
    "\n"
    "using namespace std;\n"
    "\n"
    "int main(int argc, char *argv[])\n"
    "{\n"
    "\ttry {\n"
    "\t} catch (const std::exception &ex) {\n"
    "\t\tcout << \"catched \" << ex.what() << endl;\n"
    "\t}\n"
    "\n\tcout << __FILE__ << \": ok\";\n\n"
    "\treturn 0;\n"
    "}\n"
    ))

(define-auto-insert
  (cons "\\.\\([Pp][Ll]\\)\\'" "Perl script")
  '(nil
    "#!/usr/bin/perl\n"
    "#\n"
    "# " (file-name-nondirectory buffer-file-name) "\n"
    "#\n" "#\n" "#\n"
    "########\n"
    "# $Author: " (user-full-name) " <" user-mail-address ">$\n"
    "# $Companion: $\n"
    "# $Compile: perl -w -e '' " (file-name-nondirectory buffer-file-name) "$\n"
    "# $Writestamp: $\n"
    "#\n\n"
    "use Carp;\n"
    "use strict;\n"
    "\n"
    "use vars qw/ $VERSION /;\n"
    "\n"
    "BEGIN {\n"
    "\t$VERSION = '0.1';\n"
    "}\n\n\n1;\n\n"
    "### Local Variables:\n"
    "### mode: cperl\n"
    "### fill-column: 100\n"
    "### buffer-file-coding-system: iso-latin-1-unix\n"
    "### End:\n"))

(define-auto-insert
  (cons "\\.\\(sh\\)\\'" "Shell script")
  '(nil
    "#!bash\n"
    "#\n"
    "# " (file-name-nondirectory buffer-file-name) "\n"
    "#\n" "#\n" "#\n"
    "########\n"
    "# $Author: " (user-full-name) " <" user-mail-address ">$\n"
    "# $Companion: $\n"
    "# $Writestamp: $\n"
    "#\n\n"
    "\n"
    "\n"
    "### Local Variables:\n"
    "### fill-column: 79\n"
    "### buffer-file-coding-system: iso-latin-1-unix\n"
    "### End:\n"))

(define-auto-insert
  (cons "\\.\\(pm\\)\\'" "Perl Module")
  '(nil
    "#!/usr/bin/perl\n"
    "#\n"
    "# " (file-name-nondirectory buffer-file-name) "\n"
    "#\n" "#\n" "#\n"
    "########\n"
    "# $Author: " (user-full-name) " <" user-mail-address ">$\n"
    "# $Companion: $\n"
    "# $Compile: perl -M" (file-name-sans-extension buffer-file-name) " -w -e ''$\n"
    "# $Writestamp: $\n"
    "#\n\n"
    "use Carp;\n"
    "use strict;\n"
    "use Exporter;\n"
    "\n"
    "use vars qw/ $VERSION @ISA @EXPORT /;\n"
    "\n"
    "BEGIN {\n"
    "\t$VERSION = '0.1';\n"
    "\t@ISA = qw/ Exporter /;\n"
    "\t@EXPORT = qw/ /;\n"
    "}\n\n\n1;\n\n"
    "### Local Variables:\n"
    "### mode: cperl\n"
    "### fill-column: 100\n"
    "### buffer-file-coding-system: iso-latin-1-unix\n"
    "### End:\n"
    '(normal-mode)
    )
  )

(define-auto-insert
  (cons "\\.\\(txt\\|text\\|asciidoc\\)\\'" "AsciiDoc")
  '("Title: "
    "//\n"
    "// " (buffer-file-name) " --- " str "\n"
    "//\n"
    "// Copyright (C) " (substring (current-time-string) -4) "\n"
    "//\n"
    "// $Compile: asciidoctool " (file-name-nondirectory buffer-file-name) "$\n"
    "// $Compile: asciidoctool -mAX " (file-name-nondirectory buffer-file-name) "$\n"
    "// $Compile: asciidoc -a toc -a footer -a lang=de -a encoding=ISO-8859-1 " (file-name-nondirectory buffer-file-name) "$\n"
    "// $Writestamp: $\n"
    "\n\n"
    str "\n"
    (make-string (length str) ?=) "\n"
    "The Author\n"
    "Version 0.1, Month " (substring (current-time-string) -4) "\n"
    "\n"
    "//:numbered:\n"
    "\n"
    "End of Preamble\n\n"
    "== First section\n\n"
    "\n\n\n"
    ":numbered!:\n"
    "== Bibliography\n\n"
    "[bibliography]\n"
    "- [[[Shortname]]] Author. 'Title'. Publisher. ISBN isbn.\n"
    "\n\n"
    "// Local Variables:\n"
    "// mode: asciidoc\n"
    "// fill-column: 100\n"
    "// buffer-file-coding-system: iso-latin-1-unix\n"
    "// End:\n"
    '(normal-mode)
    )
  )

(define-auto-insert
  (cons "\\.emacs\\.local\\'" "Local Emacs customization file")
  '(nil
    ";; -*-mode:emacs-lisp; fill-column:100; coding:iso-latin-1-unix-*-\n"
    ";;\n"
    ";; " (file-name-nondirectory buffer-file-name) "\n"
    ";;\n"
    ";; Customize Emacs for desktop\n"
    ";;<" (file-name-directory (buffer-file-name (--makefile-buffer))) ">\n"
    ";;\n"
    ";; $Companion: " (file-name-nondirectory (buffer-file-name (--makefile-buffer))) "$\n\n"
    '(normal-mode)
    )
  )

;;;;;;;;
;; Code sekeletons (Abbrevations)
;;
;; Inserted when a keyword is typed (the prefix token). Tokens have to be
;; prepended by a special character. Abbrevs are also expanded in comments, and
;; are case-insensitive. A ";" prefix would be desirable (";class", ";if"etc.)
;; because normally a whitespace character is required after ";" in any text.
;; Alas, due to the "electricity" of some modes, this prefix cannot be choosen.
;; "y" seems to be a good compromise, because you rarely type "yif", "ytry" and
;; "yclass" etc.
;;
;; When the minor `abbrev-mode'is enabled skeletons are automatically pasted when the token is
;; typed. Or mark some text and call skeleton as a function.

(define-skeleton skel-try-catch "" nil
  > "try {" \n
  > _
  \n "} catch (...) {" >
  \n "throw;"
  \n "}" >)

(define-skeleton skel-ife "" nil
  > "if (" _ ") {" \n
  > \n
  "} else {" > \n
  "}" >\n)

(define-skeleton skel-class "" nil      ; full-featured class
  "class " (setq v1 (skeleton-read "Identifier? ")) > \n
  "{" > \n
  "/*** EXPORTED TYPES ***/" > \n
  "// friends and typedefs" > \n \n
  "/*** CONSTRUCTION ***/" > \n
  "public:" > \n
  v1 "() {}" > \n
  "virtual ~" v1 "() {}" > \n \n
  "/*** INTERFACE ***/" > \n
  "public:" > \n \n
  "/*** IMPLEMENTATION ***/" > \n
  "protected:" > \n \n
  "/*** ATTRIBUTES ***/" > \n
  "private:" > \n
  "};" > \n)

(define-skeleton skel-safe-bool "" nil  ; to be placed in the INTERFACE section of a class
  >
  "/**" > \n
  " * @short Test objects of this class." > \n
  " *" > \n
  " * Test validation of an object." > \n
  " *" > \n
  " * The technique used here is called the \"Safe Bool Idiom\". It does the" > \n
  " * trick of testing an object without `bool operator!' or `operator void*'." > \n
  " * For details see <http://www.artima.com/cppsource/safebool.html>." > \n
  " * " > \n
  " * Note that because this object is \"testable\", it can not have the cast" > \n
  " * operator" > \n
  " *" > \n
  " *operator const pointer() const throw()" > \n
  " *" > \n
  " */" > \n
  "private:" > \n
  "void this_type_does_not_support_this_comparison() const { }" > \n
  "typedef void (self::*bool_type)() const;" > \n
  "public:" > \n
  "bool null() const { return p==0; }" > \n
  "bool operator!() const { return null(); }" > \n
  "operator bool_type() const {" > \n
  "return !null() ? &self::this_type_does_not_support_this_comparison : 0;" > \n
  "}" > \n
  "/***/" > \n \n)

(eval-after-load "cc-mode"
  '(progn
     (unless c++-mode-abbrev-table
       (define-abbrev-table 'c++-mode-abbrev-table ()))
     (define-abbrev c++-mode-abbrev-table "ytry" "" 'skel-try-catch)
     (define-abbrev c++-mode-abbrev-table "yif" "" 'skel-ife)
     (define-abbrev c++-mode-abbrev-table "yclass" "" 'skel-class)
     (define-abbrev c++-mode-abbrev-table "ybool" "" 'skel-safe-bool)))

(eval-after-load "cperl-mode"
  '(progn
     (unless cperl-mode-abbrev-table
       (define-abbrev-table 'cperl-mode-abbrev-table ()))
     (define-abbrev cperl-mode-abbrev-table "yif" "" 'skel-ife)))

;;; CUSTOMIZED SETTINGS
;;; ---------------------------------------------------------------------------

(put 'scroll-up-line 'isearch-scroll t)
(put 'scroll-left 'disabled nil)
(put 'downcase-region 'disabled nil)
(put 'upcase-region 'disabled nil)
(put 'dired-find-alternate-file 'disabled nil)
(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 ((buffer-file-coding-system . utf-8) (minor-mode . template-minor-mode) (minor-mode . template) (visual-basic-mode-indent . 4) (buffer-file-coding-system . raw-text-unix) (minor-mode . outline-minor) (fill-columns . 100) (fill-colum . 100) (minor-mode . template-minor) (ange-crypt-mode . 1) (minor-mode . auto-revert) (buffer-file-coding-system . iso-latin-1-unix) (buffer-file-coding-system . iso-latin-1)))))

;; .emacs.el ends here
(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.
 )