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

;;

;; Config file for GNU Emacs.

;;

;; For load order see README.

;; Try to speed things up, especially in VM.

(setq gc-cons-threshold 6000000)

(require 'cl-lib)

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

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

;; Keep it above modes saving state into files or you'll see files like ".recentf~" in "~/.emacs.d".

(setq

 make-backup-files t

 ;; In other case (by renaming) you loose original file creation date.

 backup-by-copying t

 backup-directory-alist '(("." . "~/.emacs.d/.backup")) ; don't litter my fs tree

 delete-old-versions t                         ; delete excess backup versions silently

 kept-old-versions 1                           ; store first original version

 kept-new-versions 3                           ; store last 3 version

 version-control t)                            ; use versioned backups

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

(message "lockfile")

;; (info "(elisp) File Locks")

;; Disable stupid file locking. It breaks editing WSL files from Cygwin Emacs.

;; https://emacs.stackexchange.com/questions/61962/what-is-interlocking-about

;; https://cygwin.com/pipermail/cygwin/2020-November/246887.html

(setq create-lockfiles nil)

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

(message "auto save")

;; Disable auto saving, files "#name#" might trigger false rebuild if there is

;; some file watcher. Also those files looks like garbage in other tools/IDE.

(setq auto-save-default nil)

;; If nil autosave to a different file than the original.

(setq auto-save-visited-file-name nil)

(setq auto-save-interval 300)

;; Note: if you kill unsaved file auto save file not deleted.

(setq delete-auto-save-files t)

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

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

;; `save-place-file' in ".emacs".

(save-place-mode 1) ; since v25.1

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

(message "recentf")

(eval-and-compile

  (require 'recentf))

;; (recentf-load-list)

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

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

;; Need to be defined before loading "recentf" because default value is

;; "mode", meaning cleanup when turning the mode on.

(setq recentf-auto-cleanup 600)

;; Disable population of `file-name-history', it causes calls to

;;   abbreviate-file-name => file-name-case-insensitive-p => tramp-autoload-file-name-handler

;; taking 41% of startup time.

;; `ido-switch-buffer' doesn't depends on `file-name-history', nothing to lose.

(setq recentf-initialize-file-name-history nil)

(recentf-mode 1)

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

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

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

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

(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 is loaded after '.emacs'.

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

(setq warning-suppress-types '(comp))

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

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

(message "user info")

(cl-eval-when (compile) (require 'info))

;; Following variables are loaded by (load my-lisp-auth t) from init.el:

;; user-full-name  user-mail-address  user-nick  user-home-page

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

;; Ensure the help doesn't trigger autoloading.

(setq help-enable-autoload nil)

(setq help-enable-completion-autoload nil)

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

(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

    ) )

(defun my-assoc-push (key value alist)

  "Add association if `key' is not in `alist' and replace all

accociation with single, if there is `key'."

  (when (not (symbolp alist)) (error "alist is not a symbol."))

  (set alist

       (cons (cons key value)

             (cl-remove key (symbol-value alist) :key #'car :test #'equal))))

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

(defun my-path-append-to-beginning (pathenv path)

  "Append PATH to the beginning of PATHENV, pruning existing entries."

  (let* ( (pathenv (concat ":" pathenv ":"))

	  (beg (cl-search (concat ":" path ":") pathenv))

	  lh rh )

    (when beg

      (setq lh (substring pathenv 0 beg))

      (setq rh (substring pathenv (1+ (cl-search ":" pathenv :start2 (1+ beg))) nil))

      (setq pathenv (concat lh ":" rh)))

    ;; pathenv keeps ":" as a prefix (OK for the next concat) and suffix (need one to strip).

    (setq pathenv (substring pathenv 0 (1- (length pathenv))))

    (concat path pathenv)))

;; (my-path-append-to-beginning "a:b:c" "a")

;; (my-path-append-to-beginning "a:b:c" "b")

;; (my-path-append-to-beginning "a:b:c" "c")

;; (my-path-append-to-beginning "a:b:c" "d")

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

(message "lisp, elisp")

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

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