;; -*- 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 "silent runing")

(setq inhibit-splash-screen t)

(setq inhibit-startup-message t)

(setq inhibit-startup-buffer-menu t)

(setq initial-scratch-message nil)

(setq initial-major-mode (quote fundamental-mode))

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

(message "helper buffers")

(define-key global-map "\C-v" nil)

(define-key global-map "\C-vt" (lambda nil (interactive) (switch-to-buffer "*scratch*")))

(defvar my-work-file (expand-file-name "~/work.txt"))

(setq initial-buffer-choice my-work-file)

(define-key global-map "\C-vw" (lambda nil (interactive) (find-file my-work-file)))

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

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

        "/.cache/"

        "\\.png\\'"))

(setq recentf-max-saved-items 10000)

(setq recentf-max-menu-items 40)

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

(recentf-mode t)

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

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

;; (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, auto-revert")

(eval-when 'compile (require 'autorevert))

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

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

(setq auto-revert-interval 2)

;; (setq global-auto-revert-mode 1)

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

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

    (cond

     (lvl2 (message "Debugging on quit/event/signal..."))

     (lvl1 (message "Debugging on quit..."))

     (t (message "Debugging disabled...")))))

(defun my-eval-buffer ()

  "Evaluate entire buffer with re-assigning values to `defvar' / `defcustom'.

Useful during package development."

  (interactive)

  (save-excursion

    (goto-char (point-min))

    (while (not (eobp))

      (eval-defun nil)

      (end-of-defun))))

(defun my-load-library (library)

  "Evaluate entire library with re-assigning values to `defvar' / `defcustom'.

Useful during package development."

  (interactive

   (list (completing-read "Load library: "

                          (apply-partially 'locate-file-completion-table

                                           load-path

                                           '("" ".el")))))

  (with-temp-buffer

    (insert-file-contents (locate-file library load-path '("" ".el")))

    (my-eval-buffer)))

(my-debug nil)

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

(message "user info")

(eval-when 'compile (require '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")

;; (setq user-home-page "http://defun.work/")

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

  (let (result)

    (mapatoms (lambda (ob) (when (and (boundp ob)

                                 (keymapp (symbol-value ob))

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

                        (push ob result)))

              obarray)

    (remove-if-not 'identity result) ))

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

(message "lisp, elisp")

(eval-when 'compile (require 'chistory))

(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-prog-mode-list

  '(nsis-mode

    html-mode nxml-mode wesnoth-mode

    LilyPond-mode

    texinfo-mode

    gadict-mode)

  "List of development modes.")

(defvar my-prog-hook-list

   (my-mode2hook my-prog-mode-list)

  "List of development mode hooks.")

(defvar my-text-mode-list

  '(text-mode

    outline-mode

    rst-mode

    diff-mode

    magit-revision-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 "MS Windows, w32, win32")

;; To remap CapsLock to ScrollLock:

;; Windows Registry Editor Version 5.00

;; [HKEY_LOCAL_MACHINE\SYSTEM\CurrentControlSet\Control\Keyboard Layout]

;; ; CapsLock (3a,00) => LWin (5b,e0); LWin (5b,e0) => Apps (5d,e0)

;; "Scancode Map"=hex:00,00,00,00,00,00,00,00,03,00,00,00,5b,e0,3a,00,5d,e0,5b,e0,00,00,00,00

(when (eq window-system 'w32)

  (setq w32-apps-modifier 'super))

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

(message "package, elpa")

(eval-when 'compile (require 'package nil t))

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

(when (fboundp 'package-initialize)

  (package-initialize))

(setq package-archives

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

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

        ("melpa-stbl" . "https://stable.melpa.org/packages/")

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

      package-archive-priorities

      '(("gnu" . 10)

        ("melpa-stbl" . 5)

        ("melpa" . 0)) )

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

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

(eval-when 'compile (load-library "window"))

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

  (add-to-list 'default-frame-alist '(fullscreen . maximized)))

(menu-bar-mode -1)

(when window-system

  (mouse-avoidance-mode 'animate)

  (scroll-bar-mode 1)

  (tool-bar-mode -1)

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

;; 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-default truncate-lines nil))

(setq truncate-partial-width-windows nil)

(setq large-file-warning-threshold (* 12 1000 1000)) ; Greater then 10 MiB in order to open logs without warnings.

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

;; (global-linum-mode 1)

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

(defun my-dpi ()

  (let* ((attrs (car (display-monitor-attributes-list)))

         (size (assoc 'mm-size attrs))

         (sizex (cadr size))

         (res (cdr (assoc 'geometry attrs)))

         (resx (- (caddr res) (car res)))

         dpi)

    (catch 'exit

      ;; in terminal

      (unless sizex

        (throw 'exit 10))

      ;; on big screen

      (when (> sizex 1000)

        (throw 'exit 10))

      ;; DPI

      (* (/ (float resx) sizex) 25.4))))

(defun my-preferred-font-size ()

  (let ( (dpi (my-dpi)) )

  (cond

    ((< dpi 110) 10)

    ((< dpi 130) 11)

    ((< dpi 160) 12)

    (t 12))))

(defvar my-preferred-font-size (my-preferred-font-size))

(defvar my-regular-font

  (cond

   ((eq window-system 'x) (format "DejaVu Sans Mono-%d:weight=normal" my-preferred-font-size))

   ((eq window-system 'w32) (format "Courier New-%d:antialias=none" my-preferred-font-size))))

(defvar my-symbol-font

  (cond

   ((eq window-system 'x) (format "DejaVu Sans Mono-%d:weight=normal" my-preferred-font-size))

   ((eq window-system 'w32) (format "DejaVu Sans Mono-%d:antialias=none" my-preferred-font-size))))

(cond

 ((eq window-system 'x)

  (if (and (fboundp 'find-font) (find-font (font-spec :name my-regular-font)))

      (set-frame-font my-regular-font)

    (set-frame-font "7x14")))

 ((eq window-system 'w32)

  (set-frame-font my-regular-font)

  ;; (set-default-font my-regular-font)

  (add-to-list 'default-frame-alist

               (cons 'font my-regular-font))

  (set-fontset-font nil 'cyrillic my-regular-font)

  (set-fontset-font nil 'greek my-regular-font)

  (set-fontset-font nil 'phonetic my-regular-font)

  (set-fontset-font nil 'symbol my-symbol-font)))