emacs move to separate files

1 files changed, 363 insertions, 0 deletions

diff --git a/config/emacs/site-lisp/my-defines.el b/config/emacs/site-lisp/my-defines.el
new file mode 100644
index 0000000..425a23e
--- /dev/null
+++ b/config/emacs/site-lisp/my-defines.el
@@ -0,0 +1,363 @@
+;;; Custom definitions, with prefix "my/"  -*- lexical-binding: t; -*-
+
+(defvar surround-keys '("(" "{" "[" "$" "\"" "'"))
+(defun my/wrap-pair ()
+  "Ensure the region is active and then \"insert-pair\"."
+  (interactive)
+  (activate-mark)
+  (insert-pair))
+(eval
+ `(define-keymap
+    :full nil
+    :name "Surround"
+    :prefix 'surround-prefix
+    ,@(mapcan
+       (lambda (key) (list key ''my/wrap-pair))
+       surround-keys
+       )))
+
+(defun my/toggle-frame-transparency ()
+  "Toggle transparency."
+  (interactive)
+  (let ((alpha-transparency 90))
+    (if (eq alpha-transparency (frame-parameter nil 'alpha-background))
+        (set-frame-parameter nil 'alpha-background 100)
+      (set-frame-parameter nil 'alpha-background alpha-transparency))))
+
+(defvar my/prog-cleanup-excluded-modes
+  '(makefile-gmake-mode makefile-mode makefile-imake-mode
+                        makefile-makepp-mode makefile-bsdmake-mode
+                        makefile-automake-mode
+                        python-mode
+                        fundamental-mode)
+  "Major modes for which \"my/clean-prog-file\" should not be run before save.")
+
+(defvar my/prog-cleanup-want-tabs-modes
+  '(makefile-gmake-mode makefile-mode makefile-imake-mode
+                        makefile-makepp-mode makefile-bsdmake-mode makefile-automake-mode)
+  "Major modes that need tabs instead of spaces.
+\"my/clean-prog-file\" should convert spaces to tabs instead of tabs to spaces.")
+
+(defvar my/prog-cleanup-indent-max-lines 500
+  "Skip reindenting the buffer if it is longer than this many lines.
+Nil for no limit.")
+
+(define-minor-mode my/global-prog-clean-mode
+  "Do auto formating on save in prog mode buffers."
+  :global t
+  (if my/global-prog-clean-mode
+      (progn ;enable
+        (add-hook 'before-save-hook 'my/clean-prog-file))
+    (progn ;disable
+      (remove-hook 'before-save-hook 'my/clean-prog-file))))
+(my/global-prog-clean-mode 1)
+
+(defun my/clean-prog-file (&optional buffer)
+  "Perform whitespace cleanup and some normalization on `buffer'.
+Defaults to the current BUFFER.  Converts tabs to spaces unless the
+major mode is in `my/prog-cleanup-want-tabs-modes', otherwise do the
+reverse.  Delete trailing whitespace."
+  (unless buffer (setq buffer (current-buffer)))
+  (with-current-buffer buffer
+    (when (and my/global-prog-clean-mode
+               (not (member major-mode my/prog-cleanup-excluded-modes))
+               (derived-mode-p '(prog-mode))
+               (cond
+                ((and (functionp 'clang-format-buffer)
+                                        ; safety valve for undef'd
+                      (derived-mode-p '(c-mode c++-mode)))
+                 (clang-format-buffer))
+                (t
+                 (when (and my/prog-cleanup-indent-max-lines
+                            (< (car (buffer-line-statistics buffer))
+                               my/prog-cleanup-indent-max-lines))
+                   (indent-region (point-min) (point-max)))))
+               (if (member major-mode my/prog-cleanup-want-tabs-modes)
+                   (tabify (point-min) (point-max))
+                 (untabify (point-min) (point-max)))
+               (delete-trailing-whitespace)))))
+
+(defun my/prog-buffer-setup ()
+  "Do setup in for code buffers."
+  ;; (superword-mode 1)
+  ;; (modify-syntax-entry ?_ "w")
+  ;; (hs-minor-mode 1)
+  (display-fill-column-indicator-mode 1)
+  (smerge-mode 1)
+  (ignore-errors
+    (when (and (derived-mode-p '(c-mode c++-mode))
+               (> (car (buffer-line-statistics)) 0))
+      (c-guess))))
+(add-hook 'prog-mode-hook 'my/prog-buffer-setup)
+
+(defun my/wrap-region-paren ()
+  "Wraps the region in parens.  Similar to pressing ( with the region active."
+  (interactive)
+  (let ((beg (region-beginning))
+        (end (region-end)))
+    (save-excursion
+      (goto-char beg)
+      (insert "(")
+      (goto-char (+ end 1))
+      (insert ")"))))
+
+(defun my/zap-whitespace ()
+  "Zaps (deletes) the whitespace around the point in both directions."
+  (interactive)
+  (push-mark)
+  (skip-chars-backward " \t\n")
+  (push-mark)
+  (skip-chars-forward " \t\n")
+  (delete-region (mark) (point))
+  (pop-mark)
+  (goto-char (mark))
+  (pop-mark))
+
+(defun my/wrap-sexp (&optional arg)
+  "Wraps the following sexp in a pair of parens.
+Places point inside the new pair, pushing the mark before the new pair.
+With prefix ARG do ARG number sexps if given, including backwards."
+  (interactive "p")
+  (message "%s" arg)
+  (if arg
+      (progn
+        (push-mark)
+        (insert-pair arg ?\( ?\)))
+    (insert-pair 1 ?\( ?\))))
+
+(defun my/toggle-window-other-reachability ()
+  "Toggle whether this window can be selected by `other-window'."
+  (interactive)
+  (let* ((win (get-buffer-window (current-buffer)))
+         (current (window-parameter win 'no-other-window)))
+    (set-window-parameter win 'no-other-window (not current))
+    (force-mode-line-update)))
+;; small hack to make other window reachability visible like window dedication
+(advice-add 'mode-line-window-control :around
+            (lambda (f) (concat (funcall f)
+                                (if (window-parameter nil 'no-other-window) "o" "")))
+            '(:name "other-window-indicator"))
+
+;; TODO find a bind for this
+(defun my/open-window-by-buffer (buffer)
+  "Move focus to an extant window by the buffer it contains.
+If no such window exists, switch to BUFFER in the current window."
+  (interactive "bBuffer: ")
+  (let ((win (get-buffer-window buffer t)))
+    (if win
+        (select-window win)
+      (switch-to-buffer buffer))))
+
+(defun my/shorten-path (path)
+  "Shorten string PATH.  Initialize all but the last path component."
+  (let* ((components (split-string path "/"))
+         (last-component (-last (lambda (s) (not (string-empty-p s))) components))
+         (shortened-components
+          (mapcar (lambda (comp)
+                    (if (or (string-equal comp last-component) (string-empty-p comp))
+                        comp
+                      (substring comp 0 1)))
+                  components)))
+    (mapconcat 'identity shortened-components "/")))
+
+(defun my/swap-other-window-buffer ()
+  "Exchange buffer contents with the next window.
+Tries to switch the buffer contents of the current window and the next
+in the cyclic ordering.  Doesn't consider windows that are dedicated."
+  (interactive)
+  (let* ((cw (get-mru-window nil nil nil t))
+         (cb (window-buffer cw))
+         (ow (next-window))
+         (ob (window-buffer ow)))
+    (unless (window-dedicated-p cw)
+      (while (window-dedicated-p ow)
+        (setq ow (next-window ow)
+              ob (window-buffer ow)))
+      (unless (eq cw ow)
+        (progn
+          (with-selected-window ow
+            (switch-to-buffer cb))
+          (with-selected-window cw
+            (switch-to-buffer ob)))))))
+
+(defun my/activate-mark ()
+  "Activate the region a la `C-SPC C-SPC', but don't move the point.
+Useful in combination with `query-replace' for acting on the region."
+  (interactive)
+  (if (region-active-p)
+      (deactivate-mark)
+    (activate-mark)))
+
+(defun my/c-x-n-to-m-n (&optional keymap)
+  "Copy bindings from C-x [n] to M-[n] in KEYMAP, defaulting to the global
+keymap."
+  (unless keymap (setq keymap global-map))
+  (mapc (lambda (n)
+          (let* ((from (concat "C-x " (format "%d" n)))
+                 (to (concat "M-" (format "%d" n)))
+                 (bind (keymap-lookup keymap from)))
+            (keymap-set keymap to bind)))
+        '(0 1 2 3 4 5 6 7 8 9)))
+(my/c-x-n-to-m-n)
+
+(defun my/keymap-keys (map)
+  "Return a list of all key sequences in a keymap MAP recursively."
+  (mapcan (lambda (c)
+            (let ((ks (car c))
+                  (km (cdr c))
+                  (acc nil))
+              (map-keymap (lambda (key bind)
+                            (let ((kss (vconcat ks (vector key))))
+                              (when (commandp bind)
+                                (push kss acc))))
+                          km)
+              acc))
+          (accessible-keymaps map)))
+
+(defun my/eshell (&optional arg)
+  "Create a new eshell or switch to an existing one.
+With ARG, make a new shell.  If the current buffer is an eshell, switch
+back to the previous selected buffer."
+  (interactive "P")
+  (if (eq major-mode 'eshell-mode)
+      (switch-to-prev-buffer)
+    (eshell arg)))
+
+(defun my/eshell-clear-or-center (&optional clear)
+  "Either clear the screen or recenter display depending on point location."
+  (interactive "P")
+  (cond
+   (clear (eshell/clear clear))
+   ((>= (point) eshell-last-output-end) ;; at the input line
+    (eshell/clear clear))
+   (t ;; in scroll back somewhere
+    (recenter-top-bottom))))
+
+(defun my/vc-on-root (&optional arg)
+  "Open a vc dir buffer at the project root.
+With ARG, open a Dired buffer instead."
+  (interactive "P")
+  (let ((dir (project-root (project-current t))))
+    (if arg
+        (dired dir)
+      (vc-dir dir))))
+
+(defun my/shell-at-root ()
+  "Execute an async shell commmand at the root of the current project."
+  (interactive)
+  (let ((prior-cwd default-directory)
+        (want-quit inhibit-quit))
+    (setq inhibit-quit t)
+    (with-local-quit
+      (setq default-directory (project-root (project-current)))
+      (call-interactively 'async-shell-command))
+    (setq default-directory prior-cwd
+          inhibit-quit want-quit)))
+
+(defun my/kill-buffer (&optional arg)
+  "Kill the current buffer.  With ARG kill the window as well."
+  (interactive "P")
+  (if arg
+      (kill-buffer-and-window)
+    (kill-buffer)))
+
+(defvar my/layout-pair (cons nil nil)
+  "Cons pair of window configurations.")
+(add-hook 'after-init-hook
+          (lambda ()
+            (setq my/layout-pair (cons (current-window-configuration)
+                                       (current-window-configuration)))))
+(defun my/layout-swap (&optional arg)
+  "Swap between the two saved window configurations.
+With ARG, don't save the current layout."
+  (interactive "p")
+  (let ((left (car my/layout-pair))
+        (right (cdr my/layout-pair))
+        (cwc (current-window-configuration)))
+    (cond
+     ((>= arg 16) (setq my/layout-pair (cons cwc cwc)))
+     ((eq (selected-frame) (window-configuration-frame right))
+      (unless (>= arg 4) (setq left cwc))
+      (set-window-configuration right t t)
+      (setq my/layout-pair (cons right left)))
+     (t (message "Quick layout swap only works with same frame!")))))
+
+(defun my/display-lines-advice (func &rest r)
+  "Around advice that temporarily shows line numbers."
+  (let ((want-quit inhibit-quit))
+    (setq inhibit-quit t)
+    (display-line-numbers-mode 1)
+    (force-window-update)
+    (with-local-quit
+      (call-interactively func))
+    (display-line-numbers-mode -1)
+    (force-window-update)
+    (setq inhibit-quit want-quit)))
+
+(progn ; my global keybinds
+  (define-minor-mode my/keys-mode
+    "Minor mode collecting global keybinds"
+    :global t
+    :keymap (make-sparse-keymap)
+
+    (if my/keys-mode
+        (repeat-mode 1)
+      (repeat-mode -1)))
+  (require 'eshell)
+  (require 'em-prompt)
+  (put 'other-window 'repeat-map nil)
+  (put 'other-window-backward 'repeat-map nil)
+  (put 'eshell-previous-prompt 'repeat-map nil)
+  (put 'eshell-next-prompt 'repeat-map nil)
+
+  ;; The keymaps in `emulation-mode-map-alists' take precedence over
+  ;; `minor-mode-map-alist'
+  (add-to-list 'emulation-mode-map-alists
+               '((my/keys-mode . my/keys-keymap)))
+
+  (keymap-set my/keys-mode-map "C-x -" 'my/swap-other-window-buffer)
+  (keymap-set my/keys-mode-map "C-x w o" 'my/toggle-window-other-reachability)
+  (keymap-set my/keys-mode-map "C-x w r r" 'window-layout-rotate-clockwise)
+  (keymap-set my/keys-mode-map "C-x w r R" 'window-layout-rotate-anticlockwise)
+  (keymap-set window-layout-rotate-repeat-map "r" 'window-layout-rotate-clockwise)
+  (keymap-set window-layout-rotate-repeat-map "R" 'window-layout-rotate-anticlockwise)
+
+  (keymap-set my/keys-mode-map "C-M-z" 'my/wrap-sexp)
+
+  (keymap-set my/keys-mode-map "C-c R" 'raise-sexp)
+  (keymap-set my/keys-mode-map "C-c r" 'delete-pair)
+
+  (keymap-set my/keys-mode-map "M-s g" 'grep)
+  (keymap-set my/keys-mode-map "M-s r" 'query-replace-regexp)
+  (keymap-set my/keys-mode-map "M-s a" 'align-regexp)
+
+  (keymap-set my/keys-mode-map "M-w" 'copy-region-as-kill)
+  (keymap-set my/keys-mode-map "M-(" 'my/wrap-region-paren)
+  (keymap-set my/keys-mode-map "M-z" 'my/zap-whitespace)
+  (keymap-set my/keys-mode-map "M-o" 'other-window)
+  (keymap-set my/keys-mode-map "M-O" 'other-window-backward)
+  (keymap-set my/keys-mode-map "M-RET" 'my/eshell)
+  (keymap-set my/keys-mode-map "M-C" 'calc)
+  (keymap-set my/keys-mode-map "M-K" 'my/kill-buffer)
+  (keymap-set my/keys-mode-map "M-D" 'my/vc-on-root)
+  (keymap-set my/keys-mode-map "M-Q" 'auto-fill-mode)
+  (keymap-set my/keys-mode-map "M-A" 'beginning-of-line-text)
+  (keymap-set my/keys-mode-map "M-R" 'my/layout-swap)
+  (keymap-set my/keys-mode-map "M-W" 'switch-to-buffer)
+  (keymap-set my/keys-mode-map "M-N" 'man)
+  (keymap-set my/keys-mode-map "M-*" 'my/shell-at-root)
+  (keymap-set my/keys-mode-map "M-S" 'surround-prefix)
+  (keymap-set my/keys-mode-map "M-J" 'my/activate-mark)
+
+  (my/keys-mode 1))
+
+(progn ; mode for log files
+  (define-derived-mode
+    generic-log-mode
+    fundamental-mode
+    "Log"
+    "Major mode for following log files."
+    (setq-local auto-revert-verbose nil)
+    (auto-revert-tail-mode 1))
+  (add-to-list 'auto-mode-alist
+               '("\\.log\\'" . generic-log-mode)))