diff options
Diffstat (limited to 'config/emacs/site-lisp/my-defines.el')
| -rw-r--r-- | config/emacs/site-lisp/my-defines.el | 363 |
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))) |