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

;;

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

;;

;; 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.

(with-no-warnings (require 'cl))

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

(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 enter to debuger and show backtrace when

problems occur, with double prefix enable debugging on event and

signal, else disable breaking to debugger."

  (interactive "P")

  (let ( (lvl1 (not (not mode))) (lvl2 (equal mode '(16))) )

    (setq debug-on-error lvl1)

    ;; Get trace when press C-g.

    (setq debug-on-quit lvl1)

    (setq debug-on-event lvl2)

    (setq debug-on-signal lvl2)))

(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")

(defvar user-nick (user-login-name)

  "My nick 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")

(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 (functionp (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 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 \\[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)