;; -*- mode: emacs-lisp; coding: utf-8; fill-column: 78 -*-

;;

;; Written by Oleksandr Gavenko <gavenkoa@gmail.com>, 2008-2010.

;;

;; This file formed from parts and ideas from many sites/docs and

;; placed in public domain.

;;

;; Config file for GNU Emacs.

;;

;; For load order see README.

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(message "recentf")

(eval-and-compile

  (require 'recentf))

(setq recentf-save-file (concat user-emacs-directory ".recentf"))

(when (eq system-type 'cygwin)

  (setq recentf-save-file (concat user-emacs-directory ".recentf-cygwin")))

(setq recentf-auto-cleanup 600)

;; Prevent TRAMP to login on remote host when loading. Its take time and ask passwords!

(setq recentf-keep '(file-remote-p file-readable-p))

(setq recentf-exclude                   ; Use ``M-x recentf-cleanup`` to update recentf-list.

      '("/devel/[^/]*-\\(orig\\|tmp\\|xxx\\)"

        "/devel/my-\\(merge\\|pull\\)/"

        "\\.png\\'"))

(setq recentf-max-saved-items 10000)

(recentf-mode t)

(global-set-key (kbd "\e\eq") 'recentf-open-files)

(global-set-key [?\s-q] 'recentf-open-files)

(setq recentf-max-menu-items 40)

(setq recentf-show-file-shortcuts-flag nil)

;; (setq recentf-menu-filter 'recentf-arrange-by-dir) ; Too slow with dir widgets.

;; Don't sort ``recentf-list`` so ``recentf-open-files`` show files in historical order!

(setq recentf-menu-filter nil)

(defun my-recentf.clean-project (dir)

  "Remove from recentf all files that belong to DIR directory."

  (interactive (list (read-directory-name "Exclude all paths")))

  (let ( recentf-exclude )

    (setq recentf-exclude (list (concat "^" (regexp-quote (expand-file-name dir)))))

    (recentf-cleanup) ))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(message "revert buffer")

(global-set-key [f5]    'revert-buffer)

(setq revert-without-query (quote (".*")))

(setq auto-revert-interval 2)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(message "debugging")

;; Shut off message buffer by setting nil.

(setq message-log-max 512)

;; Prevent Emacs from loading 'default.el', which loaded after '.emacs'.

;; Also '-q' prevent loading your init file.

(setq inhibit-default-init nil)         ; t/nil

(defun my-debug (mode)

  "With prefix enable debug backtrace when problems occur else disable."

  (interactive "P")

  (when mode

    ;; (setq debug-on-signal t)

    (setq mode t))

  (setq debug-on-error mode)

  ;; Get trace when press C-g.

  (setq debug-on-quit mode)

  ;; (setq debug-on-signal mode)

  )

(my-debug nil)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(message "user info")

;; Set in ~/.emacs.d/.emacs-auth:

;; (setq user-full-name "Oleksandr Gavenko")

;; (setq user-mail-address "gavenkoa@gmail.com")

;; (setq user-nick "gavenkoa")

;; (setq user-home-page "http://gavenkoa.users.sf.net")

(unless (and (boundp 'user-nick) (stringp user-nick))

  (setq user-nick (user-login-name)) )

;; auto-insert and copyright package use this to insert copyright owner. Gnus

;; uses this for Organization header.

(setenv "ORGANIZATION"

        (concat

         user-full-name

         " <" user-mail-address  ">"

         (when (boundp 'user-home-page) (concat ", " user-home-page))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(message "my defun, defmacro, defvar")

(require 'cl)

(defmacro my-filter (pred list)

  "Construct list with elements from LIST which satisfy PRED."

  (let ( (r (make-symbol "r_")) )

    `(let ( (,r (list nil)) )

       (mapc (lambda (item)

               (when (,pred item)

                 (nconc ,r (cons item nil))))

             ,list)

       (cdr ,r))))

(defun my-fold (f x list)

  "Recursively applies (F i j) to LIST starting with X.

For example, (fold F X '(1 2 3)) computes (F (F (F X 1) 2) 3)."

  (let ((li list) (x2 x))

    (while li

      (setq x2 (funcall f x2 (pop li)))

      )

    x2

    ) )

(unless (fboundp 'ignore-errors)

  (defmacro ignore-errors (&rest body)

    "Execute BODY; if an error occurs, return nil.

Otherwise, return result of last form in BODY."

    (declare (debug t) (indent 0))

    `(condition-case nil (progn ,@body) (error nil)))

  )

(defun my-lookup-key (key)

  "Search for KEY in all known keymaps."

  (mapatoms (lambda (ob) (when (and (boundp ob) (keymapp (symbol-value ob)))

                      (when (lookup-key (symbol-value ob) key)

                        (message "%S" ob))))

            obarray))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(message "lisp, elisp")

(setq list-command-history-max 256)

(add-hook 'emacs-lisp-mode-hook 'turn-on-eldoc-mode)

(add-hook 'lisp-interaction-mode-hook 'turn-on-eldoc-mode)

(add-hook 'ielm-mode-hook 'turn-on-eldoc-mode)

(defun my-emacs-lisp-mode-hook ()

  (setq tab-width 8))

(add-hook 'emacs-lisp-mode-hook 'my-emacs-lisp-mode-hook)

(defun my-elisp-find-tag ()

  (interactive)

  (require 'etags)

  (ring-insert find-tag-marker-ring (point-marker))

  (unless (find-variable-at-point)

    (find-function-at-point)

    ))

;; Goto elisp definition.

(define-key emacs-lisp-mode-map (kbd "M-.") 'my-elisp-find-tag)

(if (not (fboundp 'global-prettify-symbols-mode))

    ;; http://www.emacswiki.org/emacs/PrettyLambda

    (font-lock-add-keywords

     'emacs-lisp-mode

     `(("(\\<\\(lambda\\)\\>"

        (1 (progn (compose-region (match-beginning 1) (match-end 1) ,(make-char 'greek-iso8859-7 107)) font-lock-keyword-face)) )))

  (global-prettify-symbols-mode 1))

(defun my-dump-funcs ()

  "Dump all function calls in current buffer. Useful to explore

elisp API from somebody else files."

  (interactive)

  (let* ( (cur-buffer (current-buffer)) (new-buffer (get-buffer-create (concat (buffer-name cur-buffer) "-funcs.el"))) symb )

    (while (search-forward-regexp "([[:alnum:]*]" nil t)

      (setq symb (thing-at-point 'symbol))

      (with-current-buffer new-buffer

        (insert-string symb)

        (insert-char ?\n 1)))

    (switch-to-buffer new-buffer)

    (shell-command-on-region (point-min) (point-max) "sort -u" nil t)

    ))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(message "mode groups")

(defmacro my-defun-rename-symb-tree (name doc func)

  "Travel by TREE and applies FUNC to each symbol."

  `(defun ,name (tree)

     ,doc

     (cond

      ((symbolp tree)

       (,func tree)

       )

      ((listp tree)

       (mapcar ',name tree)

       )

      (t (error "Only tree of symbols allowed."))

      )))

(my-defun-rename-symb-tree

 my-feature2mode

 "Convert TREE of features to TREE of modes for these features. Single symbol allowed."

 (lambda (symb) (intern (concat (symbol-name symb) "-mode"))))

(my-defun-rename-symb-tree

 my-mode2hook

 "Convert TREE of modes to TREE of hooks for these modes. Single symbol allowed."

 (lambda (symb) (intern (concat (symbol-name symb) "-hook")))

 )

(my-defun-rename-symb-tree

 my-mode2modemap

 "Convert TREE of modes to TREE of keymaps for these modes. Single symbol allowed."

 (lambda (symb) (intern (concat (symbol-name symb) "-map")))

 )

(defvar my-devel-mode-list

  '(

    sh-mode script-mode tcl-mode

    c-mode c++-mode java-mode js-mode

    python-mode perl-mode cperl-mode

    lisp-mode

    sql-mode

    emacs-lisp-mode

    makefile-mode makefile-gmake-mode

    nsis-mode

    bat-generic-mode

    html-mode nxml-mode wesnoth-mode

    LilyPond-mode

    texinfo-mode

    )

  "List of development modes.")

(defvar my-devel-mode-hook-list

   (my-mode2hook my-devel-mode-list)

  "List of development mode hooks.")

(defvar my-scroll-margin-mode-list

  '(

    vc-dir-mode

    recentf-dialog-mode

    org-agenda-grid-mode           ; XXX for this item not worked!

    log-view-mode

    dired-mode

    compilation-mode

    )

  "List of modes for enabling scroll margin.")

(defvar my-scroll-margin-mode-hook-list

  (my-mode2hook my-scroll-margin-mode-list)

  "List of mode hooks for enabling scroll margin.")

(defvar my-text-mode-list

  '(

    text-mode

    outline-mode

    rst-mode

    diff-mode

    dict-c5-mode

    )

  "List of text modes.")

(defvar my-text-mode-hook-list

  (my-mode2hook my-text-mode-list)

  "List of text mode hooks.")

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(message "package, elpa")

;; (setq package-enable-at-startup t)

(when (fboundp 'package-initialize)

  (package-initialize))

(setq package-archives

      '(

        ("elpa" . "http://tromey.com/elpa/")

        ("gnu" . "http://elpa.gnu.org/packages/")

        ("marmalade" . "http://marmalade-repo.org/packages/")

        ("melpa" . "http://melpa.milkbox.net/packages/")

        ))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(message "appearance")

;; To maximize frame on full screen, not work with Windows Emacs 21.4.

;; And maked different height with Emacs 22.3 and 23.1.

;; (setq initial-frame-alist '((fullscreen . fullboth)))

(setq display-buffer-reuse-frames t)

(defun my-maximize ()

  ;; Next code work with Emacs 21.4, 22.3, 23.1.

  (let (

        (px (display-pixel-width))

        (py (display-pixel-height))

        (fx (frame-char-width))

        (fy (frame-char-height))

        tx ty

        )

    ;; Next formulas discovered empiric on Windows host with default font.

    (setq tx (- (/ px fx) 7))

    (setq ty (- (/ py fy) 4))

    (setq initial-frame-alist '((top . 2) (left . 2)))

    (add-to-list 'initial-frame-alist (cons 'width tx))

    (add-to-list 'initial-frame-alist (cons 'height ty)) ))

(when window-system

  (if (fboundp 'toggle-frame-maximized)

      (toggle-frame-maximized)

    (my-maximize) ))

(menu-bar-mode -1)

(when window-system

  (mouse-avoidance-mode 'animate)

  (scroll-bar-mode 1)

  (tool-bar-mode -1)

  (setq-default line-spacing nil)

  (defun my-popup-menu ()

    "Menu from keyboard by emulating mouse event."

    (interactive)

    (mouse-popup-menubar

     (list (list (/ (display-pixel-width) 2) 10) (get-buffer-window (buffer-name)))

     nil)

    )

  (global-set-key [f10] 'my-popup-menu)

  (global-set-key [apps] 'my-popup-menu)

  (global-set-key [menu] 'my-popup-menu)

  (when (>= emacs-major-version 22) (tooltip-mode -1))

  )

;; Prefer horizontal windows splitting.

(when (>= emacs-major-version 23)

  (setq split-height-threshold nil)

  (setq split-width-threshold nil)

  )

(setq frame-title-format '("EMACS " system-name ": %b"))

(setq icon-title-format '("EMACS " system-name ": %b"))

;; Deprecated: `default-header-line-format', `default-mode-line-format'.

;; For `mode-line-format' default value was used.

(setq-default header-line-format nil)

(setq default-left-fringe-width nil)

(setq default-right-fringe-width nil)

(setq default-left-margin-width nil)

(setq default-right-margin-width nil)

(if (< emacs-major-version 24)

    (setq default-truncate-lines nil)

  (setq truncate-lines nil)

  )

(setq truncate-partial-width-windows nil)

;; show column & line numbers in status bar

(setq column-number-mode t)

(setq line-number-mode t)

(setq size-indication-mode t)

(setq line-number-display-limit large-file-warning-threshold)

(setq line-number-display-limit-width 200)

;; (linum-mode 1)

;; Also useful such format: (setq display-time-format " %H:%M %d-%m-%y ")

(setq display-time-24hr-format t)

(setq display-time-day-and-date nil)

(setq display-time-default-load-average nil)

(display-time)                          ; display-time-mode

(when window-system

  (set-background-color "white")

  (set-foreground-color "black")

  (set-cursor-color "brown")

  ;; (set-mouse-color "white")

  (setq cursor-type 'box)           ; box, hollow, bar, hbar

  ;;(setq blink-matching-delay 0.01)

  (blink-cursor-mode 1)

  (setq use-file-dialog t)

  (setq use-dialog-box t)

  ;; (set-face-font 'default "7x14")

  )

;; See what I am typing immediately (for keystroke in minibuffer).

(setq echo-keystrokes 0.2)

(when (eq window-system 'x)

  (set-frame-font "-misc-fixed-medium-r-normal--14-*-*-*-c-*-iso10646-1")

  (set-fontset-font "fontset-default" 'latin

                    "-misc-fixed-medium-r-normal--14-*-*-*-c-*-iso10646-1")

  (set-fontset-font "fontset-default" 'phonetic

                    "-misc-fixed-medium-r-normal--14-*-*-*-c-*-iso10646-1")

  (set-fontset-font "fontset-default" 'cyrillic

                    "-misc-fixed-medium-r-normal--14-*-*-*-c-*-iso10646-1")

  (set-fontset-font "fontset-default" 'greek

                    "-misc-fixed-medium-r-normal--14-*-*-*-c-*-iso10646-1"))

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

(when (boundp 'confirm-kill-emacs)

  (setq confirm-kill-emacs 'y-or-n-p))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(message "silent runing")

;; (setq inhibit-splash-screen t) ; nonexist on 21.4.1

(setq inhibit-startup-message t)

(setq initial-scratch-message nil)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(message "shell, bash, Cygwin, MSYS")

(defvar my-use-windows-shell nil

  "If t 'cmdproxy.exe' will be used as shell. Affect on M-x shell like

  commands. If nil, 'sh' will be used." )

(defun follow-cygwin-symlink ()

  "Follow new-style (and also UCS-16) Cygwin symlinks."

  (save-excursion

    (goto-char 0)

    (when (looking-at "!<symlink>\xff\xfe")

      (find-alternate-file

       (substring

        (decode-coding-string

         (buffer-substring (match-end 0) (point-max))

         'utf-16-le)

        0 -1)                           ; -1 for stripping final \0.

       ))))

(defun my-dos2cygwin-path (path)

  "Convert DOS path to Cygwin according to current mount table."

  (interactive (list (read-directory-name "Enter DOS path: ")))

  (setq path (replace-regexp-in-string "\\\\" "/" (expand-file-name path)))

  (let ( (table cygwin-mount-table--internal) item prefix )

    (while table

      (setq item (car table))

      (setq prefix (concat "\\`" (regexp-quote (car item))))

      (setq table (cdr table))

      (when (string-match prefix path)

        (setq path (replace-regexp-in-string prefix (cdr item) path))

        (setq table nil)

        ) )

    path

    ))

(when (eq system-type 'windows-nt)

  (ignore-errors

    (require 'cygwin-mount)

    (cygwin-mount-activate)

    )

  (add-hook 'find-file-hook 'follow-cygwin-symlink)

  ;; Workaround for Cygwin shell, when set 'CYGWIN=noglob'. By default 'shell-quote-argument'

  ;; quoted by double '\' chars this cause failure.

  (defun shell-quote-argument (argument)

    (concat "'" argument "'")

    )

  ;; Workaround for Cygwin when 'shell-file-name' is 'bash'.

  (setq null-device "/dev/null")

  ;; Use shell from Cygwin/MinGW.

  (setq shell-file-name "bash")

  (setenv "SHELL" "/bin/bash")

  (modify-coding-system-alist 'process "bash" '(cp1251-unix . cp1251-unix))

  )

(when (eq window-system 'w32)

  ;; Fix 'starttls.el' on native Windows Emacs with gnutls-cli from Cygwin.

  ;; 'gnutls-cli' run with '-s' opt and process wait for SIGALRM.

  ;; But build-in native Emacs 'kill' command can not send such Cygwin

  ;; specific sygnal. So 'starttls-negotiate-gnutls' function infinitely

  ;; wait for 'gnutls-cli' output.

  (defadvice signal-process (around cygwin (process sigcode))

    "Use 'kill.exe' instead build-in Emacs 'kill'."

    (if (eq sigcode 'SIGALRM)

        (shell-command

         (format "kill.exe -s SIGALRM %d"

                 (if (processp process) (process-id process) process)))

      ad-do-it

      ))

  (ad-activate 'signal-process)

  (modify-coding-system-alist 'process "gnutls-cli" '(binary . binary))

  )

(when (eq window-system 'w32)