1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
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)))
|
