changelog shortlog graph tags branches changeset files revisions annotate raw help

Mercurial > core / emacs/default.el

changeset 643: f901de70a80e
parent: 6c0e4a44c082
child: 926d95e5fdc7
author: Richard Westhaver <ellis@rwest.io>
date: Tue, 10 Sep 2024 21:26:30 -0400
permissions: -rw-r--r--
description: opt fixes and test updates
1 ;;; default.el --- default config -*- lexical-binding: t -*-
2 
3 ;;; Code:
4 ;;; Settings
5 (require 'util)
6 (put 'upcase-region 'disabled nil)
7 (put 'list-threads 'disabled nil)
8 (put 'list-timers 'disabled nil)
9 (setq show-paren-context-when-offscreen 'overlay)
10 (setopt
11  org-safe-remote-resources '("\\`https://cdn\\.compiler\\.company/org/clean\\.theme\\'")
12  ;; tabs = bad (unless in makefile..)
13  indent-tabs-mode nil
14  make-backup-files nil
15  auto-save-list-file-prefix (expand-file-name "auto-save/." user-emacs-directory)
16  tramp-auto-save-directory (expand-file-name "auto-save/tramp/" user-emacs-directory)
17  dired-free-space nil
18  mml-attach-file-at-the-end t
19  dired-mouse-drag-files t
20  confirm-kill-emacs nil
21  confirm-kill-processes nil
22  use-short-answers t
23  display-time-format "%Y-%m-%d %H:%M"
24  ring-bell-function 'ignore
25  completion-ignore-case t
26  ;; NOTE 2023-11-04: you need to add the following lines to ~/.gnupg/gpg-agent.conf:
27  ;; allow-emacs-pinentry
28  ;; allow-loopback-pinentry
29  epg-pinentry-mode 'loopback
30  shr-use-colors nil
31  shr-use-fonts nil
32  shr-max-image-proportion 0.6
33  shr-image-animate nil
34  shr-discard-aria-hidden t
35  bookmark-default-file (expand-file-name "bookmarks" user-emacs-directory)
36  tempo-interactive t
37  emms-directory (expand-file-name "emms" user-emacs-directory)
38  gnus-cache-directory (expand-file-name "gnus" user-emacs-directory)
39  url-cache-directory (expand-file-name "url" user-emacs-directory)
40  tab-always-indent 'complete
41  shr-cookie-policy nil
42  ;; NOTE 2023-11-04: EXPERIMENTAL
43  ediff-floating-control-frame t
44  register-use-preview nil
45  shr-use-xwidgets-for-media t
46  which-key-mode t
47  view-read-only t)
48 
49 ;;; Treesitter
50 
51 ;;(add-to-list 'treesit-extra-load-path "/usr/local/lib/")
52 
53 ;; (let ((grammar-dir "/usr/local/share/tree-sitter/"))
54 ;; (when (file-exists-p grammar-dir)
55 ;; (setq treesit-extra-load-path
56 ;; (append
57 ;; (flatten
58 ;; (mapcar
59 ;; (lambda (f)
60 ;; (unless (or (string= "." f) (string= ".." f))
61 ;; (concat grammar-dir f)))
62 ;; (directory-files "/usr/local/share/tree-sitter")))
63 ;; treesit-extra-load-path))))
64 
65 ;;; Variables
66 (defvar user-emacs-lib-directory (expand-file-name (join-paths user-emacs-directory "lib")))
67 (defvar user-custom-file (expand-file-name (format "%s.el" user-login-name) user-emacs-directory))
68 (defvar user-home-directory (expand-file-name "~"))
69 (defvar user-lab-directory (expand-file-name "lab" user-home-directory))
70 (defvar user-stash-directory (expand-file-name ".stash" user-home-directory))
71 (defvar user-store-directory (expand-file-name ".store" user-home-directory))
72 (defvar user-mail-directory (expand-file-name "mail" user-home-directory))
73 (defvar user-org-stash-directory (expand-file-name "org" user-stash-directory))
74 (defvar default-theme 'leuven-dark)
75 (defvar company-source-directory (join-paths user-home-directory "comp"))
76 (defvar company-org-directory (join-paths company-source-directory "org"))
77 (defvar company-domain "compiler.company")
78 (defvar company-name "The Compiler Company, LLC")
79 (defvar company-vc-domain "vc.compiler.company")
80 (defvar company-home "the.compiler.company")
81 (defvar company-cdn-url "https://cdn.compiler.company")
82 
83 ;;; Theme
84 (defun load-default-theme (&optional theme)
85  (interactive)
86  (when theme (setq default-theme theme))
87  (load-theme default-theme))
88 
89 ;;; Packages
90 (with-eval-after-load 'package
91  (setq package-archives
92  '(("gnu" . "https://elpa.gnu.org/packages/")
93  ("nongnu" . "https://elpa.nongnu.org/nongnu/")
94  ("melpa" . "https://melpa.org/packages/")))
95  (setopt
96  use-package-always-ensure t
97  use-package-expand-minimally t)
98  (add-packages
99  eglot-x ;; LSP extensions
100  org-web-tools ;; web parsing
101  citeproc ;; citations
102  htmlize ;; html export
103  all-the-icons all-the-icons-dired all-the-icons-ibuffer ;; icons
104  hide-mode-line) ;; ui
105  ;; bbdb
106  (package-install-selected-packages t))
107 
108 ;;; Env
109 (require 'exec-path-from-shell)
110 (exec-path-from-shell-copy-envs (list "SSH_AGENT_PID"
111  "SSH_AUTH_SOCK"
112  "PATH"
113  "CARGO_HOME"
114  "CC"
115  "LD"
116  "LD_LIBRARY_PATH"
117  "RUSTUP_HOME"
118  "QUICKLISP_HOME"
119  "DEV" "DEV_ID" "DEV_HOME"
120  "WORKER" "WORKER_ID" "WORKER_HOME"
121  "SBCL_HOME"
122  "STASH"
123  "STORE"
124  "LISP_HOME"))
125 
126 (add-to-list 'exec-path (expand-file-name "~/.cargo/bin/"))
127 (add-to-list 'exec-path (expand-file-name "~/.local/bin/"))
128 (add-to-list 'exec-path "/bin/")
129 (add-to-list 'exec-path "/usr/local/sbin/")
130 (add-to-list 'exec-path "/usr/local/bin/")
131 (add-to-list 'exec-path "/usr/local/share/lisp/bin/")
132 
133 ;;; Completions
134 (use-package cape :ensure t)
135 (use-package orderless
136  :ensure t
137  :init
138  (setq completion-styles '(orderless partial-completion basic)
139  completion-category-overrides '((file (styles basic partial-completion))
140  (eglot (styles orderless))
141  (eglot-capf (styles orderless)))))
142 
143 (use-package corfu
144  :ensure t
145  :config
146  (global-corfu-mode)
147  (corfu-popupinfo-mode)
148  (corfu-echo-mode)
149  (dolist (c (list (cons "SPC" " ")
150  (cons "." ".")
151  (cons "," ",")
152  (cons ":" ":")
153  (cons ")" ")")
154  (cons "}" "}")
155  (cons "]" "]")))
156  (define-key corfu-map (kbd (car c)) `(lambda ()
157  (interactive)
158  (corfu-insert)
159  (insert ,(cdr c)))))
160  (add-to-list 'completion-at-point-functions #'cape-dabbrev t)
161  (add-to-list 'completion-at-point-functions #'cape-abbrev t)
162  (add-to-list 'completion-at-point-functions #'cape-file)
163  (defun corfu-move-to-minibuffer ()
164  (interactive)
165  (pcase completion-in-region--data
166  (`(,beg ,end ,table ,pred ,extras)
167  (let ((completion-extra-properties extras)
168  completion-cycle-threshold completion-cycling)
169  (consult-completion-in-region beg end table pred)))))
170  (keymap-set corfu-map "M-m" #'corfu-move-to-minibuffer)
171  (add-to-list 'corfu-continue-commands #'corfu-move-to-minibuffer)
172  (unless (display-graphic-p)
173  (require 'corfu-terminal)
174  (corfu-terminal-mode 1)))
175 
176 (use-package kind-icon
177  :ensure t
178  :after corfu
179  ;:custom
180  ; (kind-icon-blend-background t)
181  ; (kind-icon-default-face 'corfu-default) ; only needed with blend-background
182  :config
183  (add-to-list 'corfu-margin-formatters #'kind-icon-margin-formatter))
184 
185 
186 (use-package vertico
187  :ensure t
188  :config (vertico-mode)
189  (keymap-set vertico-map "M-q" #'vertico-quick-insert)
190  (keymap-set vertico-map "C-q" #'vertico-quick-exit))
191 
192 (use-package marginalia :ensure t
193  :config (marginalia-mode))
194 (use-package embark
195  :ensure t)
196 (use-package embark-consult :ensure t)
197 (use-package consult :ensure t)
198 
199 ;;; Desktop
200 (setopt desktop-dirname (expand-file-name "sessions" user-emacs-directory))
201 
202 ;;; Multisession
203 (setq multisession-storage 'sqlite)
204 
205 ;;; Kill Ring
206 (kill-ring-deindent-mode)
207 
208 ;;; VC
209 ;; use rhg, fallback to hg. see hgrc
210 (if (file-exists-p "~/.local/bin/rhg")
211  (setq hg-binary "~/.local/bin/rhg"))
212 
213 ;;; Dired
214 ;;; Projects
215 (setopt project-list-file (expand-file-name "projects" user-emacs-directory)
216  project-mode-line t
217  project-file-history-behavior 'relativize)
218 
219 ;;; Tabs
220 (add-hook 'tab-bar-mode-hook #'tab-bar-history-mode)
221 
222 ;;; Lisp
223 (use-package company :ensure t)
224 (use-package slime-repl-ansi-color :ensure t)
225 
226 (defvar slime-toggle nil)
227 (defun slime-toggle ()
228  "toggle between lisp file and slime-repl"
229  (interactive)
230  (cond
231  ((eq major-mode 'slime-repl-mode)
232  (setq slime-toggle (pop-to-buffer (or slime-toggle (read-buffer "lisp buffer: ")))))
233  ((not (eq major-mode 'slime-repl-mode))
234  (if (slime-connected-p)
235  (progn
236  (setq slime-toggle (current-buffer))
237  (slime-switch-to-output-buffer))
238  (setq slime-toggle (current-buffer))
239  (slime)))))
240 
241 (use-package slime
242  :ensure t
243  :after (slime-cape slime-repl-ansi-color)
244  :init
245  (require 'slime-cape)
246  (setq slime-contribs '(slime-fancy
247  slime-quicklisp
248  slime-hyperdoc
249  ;; slime-listener-hooks
250  ;; slime-enclosing-context
251  ;; slime-media
252  ;; slime-mrepl
253  slime-company
254  slime-sbcl-exts
255  slime-cape ;; ext
256  slime-repl-ansi-color
257  ;; slime-cl-indent
258  ;; slime-snapshot
259  slime-sprof
260  slime-tramp
261  ;; slime-typeout-frame
262  slime-xref-browser
263  slime-repl-ansi-color
264  ;; slime-highlight-edits
265  slime-asdf))
266  (put 'make-instance 'common-lisp-indent-function 1)
267  (put 'reinitialize-instance 'common-lisp-indent-function 1)
268  (slime-company-init)
269  (slime-setup)
270  ;; X11-only (mcclim requires clx)
271  (defun clouseau-inspect (string)
272  "Inspect a lisp value with Clouseau. make sure to load clouseau
273 with a custom core or in your init file before using this
274 function: '(ql:quickload :clouseau)'."
275  (interactive
276  (list (slime-read-from-minibuffer
277  "Inspect value (evaluated): "
278  (slime-sexp-at-point))))
279  (let ((inspector 'cl-user::*clouseau-inspector*))
280  (slime-eval-async
281  `(cl:progn
282  (cl:defvar ,inspector nil)
283  ;; (Re)start the inspector if necessary.
284  (cl:unless (cl:and (clim:application-frame-p ,inspector)
285  (clim-internals::frame-process ,inspector))
286  (cl:setf ,inspector (cl:nth-value 1 (clouseau:inspect nil :new-process t))))
287  ;; Tell the inspector to visualize the correct datum.
288  (cl:setf (clouseau:root-object ,inspector :run-hook-p t)
289  (cl:eval (cl:read-from-string ,string)))
290  ;; Return nothing.
291  (cl:values)))))
292 
293  (define-common-lisp-style "core" "Core Common Lisp Indentation Style"
294  (:inherit "sbcl")
295  (:indentation
296  (defpkg (as defpackage))
297  (define-package (as defpackage))))
298 
299  ;; lisp font-lock defaults: https://www.n16f.net/blog/custom-font-lock-configuration-in-emacs/
300  ;; (defface cl-character-face
301  ;; '((default :inherit font-lock-constant-face))
302  ;; "The face used to highlight Common Lisp character literals.")
303 
304  ;; (defface cl-standard-function-face
305  ;; '((default :inherit font-lock-keyword-face))
306  ;; "The face used to highlight standard Common Lisp function symbols.")
307 
308  ;; (defface cl-standard-value-face
309  ;; '((default :inherit font-lock-variable-name-face))
310  ;; "The face used to highlight standard Common Lisp value symbols.")
311 
312  ;; (defvar cl-font-lock-keywords
313  ;; (let* ((character-re (concat "#\\\\" lisp-mode-symbol-regexp "\\_>"))
314  ;; (function-re (concat "(" (regexp-opt cl-function-names t) "\\_>"))
315  ;; (value-re (regexp-opt cl-value-names 'symbols)))
316  ;; `((,character-re . 'cl-character-face)
317  ;; (,function-re
318  ;; (1 'cl-standard-function-face))
319  ;; (,value-re . 'cl-standard-value-face))))
320 
321  (setq common-lisp-style-default "core")
322  ;; (define-key slime-prefix-map (kbd "i") 'clouseau-inspect)
323  (setq slime-threads-update-interval 1)
324  (add-hook 'slime-mode-hook #'slime-cape-maybe-enable 100)
325  (add-hook 'slime-repl-mode-hook #'slime-cape-maybe-enable 100))
326 
327 (use-package lisp-mode
328  :ensure nil
329  :after slime
330  :custom
331  inferior-lisp-program "sbcl --dynamic-space-size=8G"
332  scheme-program-name "gsi"
333  guile-program "guile"
334  cmulisp-program "lisp"
335  scsh-program "scsh")
336 
337 ;;; Eglot
338 (with-eval-after-load 'eglot
339  (unless (package-installed-p 'eglot-x)
340  (package-vc-install '(eglot-x :url "https://vc.compiler.company/packy/eglot-x.git")))
341  (require 'eglot-x)
342  (with-eval-after-load 'eglot-x
343  (add-to-list 'eglot-server-programs
344  '((rust-ts-mode rust-mode) .
345  ("rust-analyzer" :initializationOptions (:check (:command "clippy")))))
346  (eglot-x-setup)))
347 
348 ;;; Rust
349 (add-hook 'rust-mode-hook 'eglot-ensure)
350 
351 (setq rust-rustfmt-switches nil
352  rust-indent-offset 2)
353 
354 ;;; Python
355 (setq python-indent-offset 2)
356 (add-hook 'python-mode-hook 'eglot-ensure)
357 
358 ;;; Javascript
359 (setq js-indent-level 2)
360 
361 ;;; Bash
362 (setq sh-basic-offset 2)
363 
364 ;;; Graphviz
365 (use-package graphviz-dot-mode
366  :config
367  (setq graphviz-dot-indent-width 2))
368 ;;; Comments
369 (defcustom prog-comment-keywords
370  '("TODO" "REVIEW" "FIX" "HACK" "RESEARCH")
371  "List of strings with comment keywords."
372  :group 'default)
373 
374 (defcustom prog-comment-timestamp-format-concise "%F"
375  "Specifier for date in `prog-comment-timestamp-keyword'.
376 Refer to the doc string of `format-time-string' for the available
377 options."
378  :group 'default)
379 
380 (defcustom prog-comment-timestamp-format-verbose "%F %T %z"
381  "Like `prog-comment-timestamp-format-concise', but longer."
382  :group 'default)
383 
384 ;;;###autoload
385 (defun prog-comment-dwim (arg)
386  "Flexible, do-what-I-mean commenting.
387 
388 If region is active and ARG is either a numeric argument greater
389 than one or a universal prefix (\\[universal-argument]), then
390 apply `comment-kill' on all comments in the region.
391 
392 If the region is active and no ARG is supplied, or is equal to a
393 numeric prefix of 1, then toggle the comment status of the region.
394 
395 Else toggle the comment status of the line at point. With a
396 numeric prefix ARG, do so for ARGth lines (negative prefix
397 operates on the lines before point)."
398  (interactive "p")
399  (cond
400  ((and (> arg 1) (use-region-p))
401  (let* ((beg (region-beginning))
402  (end (region-end))
403  (num (count-lines beg end)))
404  (save-excursion
405  (goto-char beg)
406  (comment-kill num))))
407  ((use-region-p)
408  (comment-or-uncomment-region (region-beginning) (region-end)))
409  (t
410  (save-excursion (comment-line (or arg 1))))))
411 
412 (defvar prog-comment--keyword-hist '()
413  "Input history of selected comment keywords.")
414 
415 (defun prog-comment--keyword-prompt (keywords)
416  "Prompt for candidate among KEYWORDS."
417  (let ((def (car prog-comment--keyword-hist)))
418  (completing-read
419  (format "Select keyword [%s]: " def)
420  keywords nil nil nil 'prog-comment--keyword-hist def)))
421 
422 
423 ;;;###autoload
424 (defun prog-comment-timestamp-keyword (keyword &optional verbose)
425  "Add timestamped comment with KEYWORD.
426 
427 When called interactively, the list of possible keywords is that
428 of `prog-comment-keywords', though it is possible to
429 input arbitrary text.
430 
431 If point is at the beginning of the line or if line is empty (no
432 characters at all or just indentation), the comment is started
433 there in accordance with `comment-style'. Any existing text
434 after the point will be pushed to a new line and will not be
435 turned into a comment.
436 
437 If point is anywhere else on the line, the comment is indented
438 with `comment-indent'.
439 
440 The comment is always formatted as 'DELIMITER KEYWORD DATE:',
441 with the date format being controlled by the variable
442 `prog-comment-timestamp-format-concise'.
443 
444 With optional VERBOSE argument (such as a prefix argument
445 `\\[universal-argument]'), use an alternative date format, as
446 specified by `prog-comment-timestamp-format-verbose'."
447  (interactive
448  (list
449  (prog-comment--keyword-prompt prog-comment-keywords)
450  current-prefix-arg))
451  (let* ((date (if verbose
452  comment-timestamp-format-verbose
453  prog-comment-timestamp-format-concise))
454  (string (format "%s %s: " keyword (format-time-string date)))
455  (beg (point)))
456  (cond
457  ((or (eq beg (pos-bol))
458  (default-line-regexp-p 'empty))
459  (let* ((maybe-newline (unless (default-line-regexp-p 'empty 1) "\n")))
460  ;; NOTE 2021-07-24: we use this `insert' instead of
461  ;; `comment-region' because of a yet-to-be-determined bug that
462  ;; traps `undo' to the two states between the insertion of the
463  ;; string and its transformation into a comment.
464  (insert
465  (concat comment-start
466  ;; NOTE 2021-07-24: See function `comment-add' for
467  ;; why we need this.
468  (make-string
469  (comment-add nil)
470  (string-to-char comment-start))
471  comment-padding
472  string
473  comment-end))
474  (indent-region beg (point))
475  (when maybe-newline
476  (save-excursion (insert maybe-newline)))))
477  (t
478  (comment-indent t)
479  (insert (concat " " string))))))
480 
481 (setq hexl-bits 8)
482 (setq tab-width 4)
483 
484 ;;; Keyboard Macros
485 (defun toggle-macro-recording ()
486  (interactive)
487  (if defining-kbd-macro
488  (end-kbd-macro)
489  (start-kbd-macro nil)))
490 
491 (defun play-macro-if-not-playing ()
492  (interactive)
493  (if defining-kbd-macro
494  (end-kbd-macro)
495  (call-last-kbd-macro)))
496 
497 ;;; Registers
498 ;; - additional register vtypes: buffer
499 (defun decrement-register (number register)
500  "Subtract NUMBER from the contents of register REGISTER.
501 Interactively, NUMBER is the prefix arg."
502  (interactive "p\ncDecrement register: ")
503  (increment-register (- number) register))
504 
505 (defun copy-register (a b)
506  "Copy register A to B."
507  (interactive
508  (list (register-read-with-preview "From register: ")
509  (register-read-with-preview "To register: ")))
510  (set-register b (get-register a)))
511 
512 (defun buffer-to-register (register &optional delete)
513  "Put current buffer in register - this would also work for
514  just buffers, as switch-to-buffer can use both, but it
515  facilitates for easier saving/restoring of registers."
516  (interactive "cPut current buffername in register: \nP.")
517  (set-register register (cons 'buffer (buffer-name (current-buffer)))))
518 
519 (defun file-to-register (register &optional delete)
520  "This is better than put-buffer-in-register for file-buffers, because a closed
521  file can be opened again, but does not work for no-file-buffers."
522  (interactive "cPut the filename of current buffer in register: \nP")
523  (set-register register (cons 'file (buffer-file-name (current-buffer)))))
524 
525 (defun file-query-to-register (register &optional delete)
526  (interactive
527  (list
528  (register-read-with-preview "File query to register: ")))
529  (set-register register (list 'file-query (buffer-file-name (current-buffer)) (point))))
530 
531 ;; additional register-val handlers
532 ;; (cl-defmethod register-val-jump-to :around ((val cons) delete)
533 ;; (cond
534 ;; (t (cl-call-next-method val delete))))
535 
536 ;;; Outlines
537 (defun outline-hook (&optional rx)
538  "Enable `outline-minor-mode' and set `outline-regexp'."
539  (when rx (setq-local outline-regexp rx))
540  (outline-minor-mode 1))
541 
542 (setq outline-minor-mode-use-buttons nil)
543 
544 (defun add-outline-hook (mode &optional rx)
545  (let ((sym (symb mode "-hook")))
546  (add-hook sym (lambda () (outline-hook rx)))))
547 
548 (defmacro outline-hooks (&rest pairs)
549  `(mapc (lambda (x) (add-outline-hook (car x) (cadr x))) ',pairs))
550 
551 (outline-hooks (asm-mode ";;;+")
552  (nasm-mode ";;;+")
553  (rust-mode "\\(//!\\|////+\\)")
554  (sh-mode "###+")
555  (sh-script-mode "###+")
556  (makefile-mode "###+")
557  (conf-mode "###+")
558  (common-lisp-mode)
559  (emacs-lisp-mode)
560  (lisp-data-mode)
561  (org-mode)
562  (css-mode)
563  (html-mode)
564  (skel-mode))
565 
566 ;;; Scratch
567 (defcustom default-scratch-buffer-mode 'lisp-interaction-mode
568  "Default major mode for new scratch buffers"
569  :group 'default)
570 
571 ;; Adapted from the `scratch.el' package by Ian Eure.
572 (defun default-scratch-list-modes ()
573  "List known major modes."
574  (cl-loop for sym the symbols of obarray
575  for name = (symbol-name sym)
576  when (and (functionp sym)
577  (not (member sym minor-mode-list))
578  (string-match "-mode$" name)
579  (not (string-match "--" name)))
580  collect name))
581 
582 (defun default-scratch-buffer-setup (region &optional mode)
583  "Add contents to `scratch' buffer and name it accordingly.
584 
585 REGION is added to the contents to the new buffer.
586 
587 Use the current buffer's major mode by default. With optional
588 MODE use that major mode instead."
589  (let* ((major (or mode major-mode))
590  (string (format "Scratch buffer for: %s\n\n" major))
591  (text (concat string region))
592  (buf (format "*Scratch for %s*" major)))
593  (with-current-buffer (get-buffer-create buf)
594  (funcall major)
595  (save-excursion
596  (insert text)
597  (goto-char (point-min))
598  (comment-region (pos-bol) (pos-eol)))
599  (vertical-motion 2))
600  (pop-to-buffer buf)))
601 
602 ;;;###autoload
603 (defun default-scratch-buffer (&optional arg)
604  "Produce a bespoke scratch buffer matching current major mode.
605 
606 With optional ARG as a prefix argument (\\[universal-argument]),
607 use `default-scratch-buffer-mode'.
608 
609 With ARG as a double prefix argument, prompt for a major mode
610 with completion.
611 
612 If region is active, copy its contents to the new scratch
613 buffer."
614  (interactive "P")
615  (let* ((default-mode default-scratch-buffer-mode)
616  (modes (default-scratch-list-modes))
617  (region (with-current-buffer (current-buffer)
618  (if (region-active-p)
619  (buffer-substring-no-properties
620  (region-beginning)
621  (region-end))
622  "")))
623  (m))
624  (pcase (prefix-numeric-value arg)
625  (16 (progn
626  (setq m (intern (completing-read "Select major mode: " modes nil t)))
627  (default-scratch-buffer-setup region m)))
628  (4 (default-scratch-buffer-setup region default-mode))
629  (_ (default-scratch-buffer-setup region)))))
630 
631 ;;;###autoload
632 (defun scratch-new ()
633  "create a new scratch buffer. (could be *scratch* - *scratchN*)"
634  (interactive)
635  (let ((n 0)
636  bufname)
637  (while (progn
638  (setq bufname
639  (concat "*scratch"
640  (if (= n 0) "" (int-to-string n))
641  "*"))
642  (setq n (1+ n))
643  (get-buffer bufname)))
644  (switch-to-buffer (get-buffer-create bufname))
645  (insert initial-scratch-message)
646  (lisp-interaction-mode)))
647 
648 ;;; Shell
649 (defun set-no-process-query-on-exit ()
650  (let ((proc (get-buffer-process (current-buffer))))
651  (when (processp proc)
652  (set-process-query-on-exit-flag proc nil))))
653 
654 (add-hook 'shell-mode-hook 'set-no-process-query-on-exit)
655 (add-hook 'term-exec-hook 'set-no-process-query-on-exit)
656 
657 ;;; Eshell
658 (defun eshell-new()
659  "Open a new instance of eshell."
660  (interactive)
661  (eshell 'Z))
662 
663 (setq eshell-highlight-prompt t
664  eshell-hist-ignoredups t
665  eshell-save-history-on-exit t
666  eshell-prefer-lisp-functions nil
667  eshell-destroy-buffer-when-process-dies t)
668 
669 (add-hook 'eshell-mode-hook
670  (lambda ()
671  (eshell/alias "d" "dired $1")
672  (eshell/alias "ff" "find-file $1")
673  (eshell/alias "hgfe" "hg-fast-export.sh")))
674 
675 (defun eshell/clear ()
676  "Clear the eshell buffer."
677  (let ((inhibit-read-only t))
678  (erase-buffer)
679  (eshell-send-input)))
680 
681 (defun eshell-quit-or-delete-char (arg)
682  (interactive "p")
683  (if (and (eolp) (looking-back eshell-prompt-regexp))
684  (progn
685  (eshell-life-is-too-much) ; Why not? (eshell/exit)
686  (ignore-errors
687  (delete-window)))
688  (delete-forward-char arg)))
689 
690 (add-hook 'eshell-mode-hook
691  (lambda ()
692  (bind-keys :map eshell-mode-map
693  ("C-d" . eshell-quit-or-delete-char))))
694 
695 (defun eshell-next-prompt (n)
696  "Move to end of Nth next prompt in the buffer. See `eshell-prompt-regexp'."
697  (interactive "p")
698  (re-search-forward eshell-prompt-regexp nil t n)
699  (when eshell-highlight-prompt
700  (while (not (get-text-property (line-beginning-position) 'read-only) )
701  (re-search-forward eshell-prompt-regexp nil t n)))
702  (eshell-skip-prompt))
703 
704 (defun eshell-previous-prompt (n)
705  "Move to end of Nth previous prompt in the buffer. See `eshell-prompt-regexp'."
706  (interactive "p")
707  (backward-char)
708  (eshell-next-prompt (- n)))
709 
710 (defun eshell-insert-history ()
711  "Displays the eshell history to select and insert back into your eshell."
712  (interactive)
713  (insert (ido-completing-read "Eshell history: "
714  (delete-dups
715  (ring-elements eshell-history-ring)))))
716 
717 ;;; Eww
718 (setopt
719  browse-url-browser-function 'eww
720  eww-auto-rename-buffer 'title
721  eww-search-prefix "https://google.com/search?q=")
722 
723 ;; ref: https://github.com/oantolin/emacs-config/blob/master/my-lisp/shr-heading.el
724 (defun shr-heading-next (&optional arg)
725  "Move forward by ARG headings (any h1-h4).
726 If ARG is negative move backwards, ARG defaults to 1."
727  (interactive "p")
728  (unless arg (setq arg 1))
729  (catch 'return
730  (dotimes (_ (abs arg))
731  (when (> arg 0) (end-of-line))
732  (if-let ((match
733  (funcall (if (> arg 0)
734  #'text-property-search-forward
735  #'text-property-search-backward)
736  'face '(shr-h1 shr-h2 shr-h3 shr-h4)
737  (lambda (tags face)
738  (cl-loop for x in (if (consp face) face (list face))
739  thereis (memq x tags))))))
740  (goto-char
741  (if (> arg 0) (prop-match-beginning match) (prop-match-end match)))
742  (throw 'return nil))
743  (when (< arg 0) (beginning-of-line)))
744  (beginning-of-line)
745  (point)))
746 
747 (defun shr-heading-previous (&optional arg)
748  "Move backward by ARG headings (any h1-h4).
749 If ARG is negative move forwards instead, ARG defaults to 1."
750  (interactive "p")
751  (shr-heading-next (- (or arg 1))))
752 
753 (defun shr-heading--line-at-point ()
754  "Return the current line."
755  (buffer-substring (line-beginning-position) (line-end-position)))
756 
757 (defun shr-heading-setup-imenu ()
758  "Setup imenu for h1-h4 headings in eww buffer.
759 Add this function to appropriate major mode hooks such as
760 `eww-mode-hook' or `elfeed-show-mode-hook'."
761  (setq-local
762  imenu-prev-index-position-function #'shr-heading-previous
763  imenu-extract-index-name-function #'shr-heading--line-at-point))
764 
765 (defvar shr-heading-map
766  (let ((map (make-sparse-keymap)))
767  (define-key map "n" #'shr-heading-next)
768  (define-key map "\C-n" #'shr-heading-next)
769  (define-key map "p" #'shr-heading-previous)
770  (define-key map "\C-p" #'shr-heading-previous)
771  map))
772 
773 (add-hook 'eww-mode-hook 'shr-heading-setup-imenu)
774 (add-hook 'eww-mode-hook (lambda () (define-key eww-mode-map "i" shr-heading-map)))
775 
776 ;;; Tramp
777 (setopt tramp-default-method "ssh"
778  tramp-default-user user-login-name
779  tramp-default-host "localhost")
780 
781 ;;; Imenu
782 (use-package imenu-list :ensure t)
783 
784 ;;; Org
785 (require 'org)
786 (require 'org-agenda)
787 (require 'org-id)
788 (require 'org-protocol)
789 
790 (setq org-html-htmlize-output-type 'css
791  org-html-head-include-default-style nil
792  ;; cc default
793  org-ascii-text-width 80)
794 
795 (org-crypt-use-before-save-magic)
796 
797 (setq org-structure-template-alist
798  '(("s" . "src")
799  ("e" . "src emacs-lisp")
800  ("x" . "src shell")
801  ("l" . "src lisp")
802  ("h" . "export html")
803  ("p" . "src python")
804  ("r" . "src rust")
805  ("E" . "example")
806  ("q" . "quote")
807  ("c" . "center")
808  ("C" . "comment")
809  ("v" . "verse")))
810 
811 ;; org-sbx [[https://list.orgmode.org/d429d29b-42fa-7d7b-6f3a-9fe692fd6dc7@grinta.net/T/]]
812 (defun %org-sbx (name header args)
813  (let* ((args (mapconcat
814  (lambda (x)
815  (format "%s=%S" (symbol-name (car x)) (cadr x)))
816  args ", "))
817  (ctx (list 'babel-call (list :call name
818  :name name
819  :inside-header header
820  :arguments args
821  :end-header ":results silent")))
822  (info (org-babel-lob-get-info ctx)))
823  (when info (org-babel-execute-src-block nil info))))
824 
825 (defmacro org-sbx (name &rest args)
826  (let* ((header (if (stringp (car args)) (car args) nil))
827  (args (if (stringp (car args)) (cdr args) args)))
828  (unless (stringp name)
829  (setq name (symbol-name name)))
830  (let ((result (%org-sbx name header args)))
831  (org-trim (if (stringp result) result (format "%S" result))))))
832 
833 (defun org-babel-execute-region (beg end &optional arg)
834  (interactive "r")
835  (narrow-to-region beg end)
836  (org-babel-execute-buffer arg)
837  (widen))
838 
839 (defun org-schedule-effort ()
840  (interactive)
841  (save-excursion
842  (org-back-to-heading t)
843  (let* ((element (org-element-at-point))
844  (effort (org-element-property :EFFORT element))
845  (scheduled (org-element-property :scheduled element))
846  (ts-year-start (org-element-property :year-start scheduled))
847  (ts-month-start (org-element-property :month-start scheduled))
848  (ts-day-start (org-element-property :day-start scheduled))
849  (ts-hour-start (org-element-property :hour-start scheduled))
850  (ts-minute-start (org-element-property :minute-start scheduled)) )
851  (org-schedule nil (concat
852  (format "%s" ts-year-start)
853  "-"
854  (if (< ts-month-start 10)
855  (concat "0" (format "%s" ts-month-start))
856  (format "%s" ts-month-start))
857  "-"
858  (if (< ts-day-start 10)
859  (concat "0" (format "%s" ts-day-start))
860  (format "%s" ts-day-start))
861  " "
862  (if (< ts-hour-start 10)
863  (concat "0" (format "%s" ts-hour-start))
864  (format "%s" ts-hour-start))
865  ":"
866  (if (< ts-minute-start 10)
867  (concat "0" (format "%s" ts-minute-start))
868  (format "%s" ts-minute-start))
869  "+"
870  effort)) )))
871 
872 (setopt org-preview-latex-image-directory "~/.emacs.d/.cache/ltximg"
873  org-latex-image-default-width "8cm"
874  org-refile-use-cache t
875  org-refile-allow-creating-parent-nodes 'confirm
876 
877  org-refile-targets '((nil :maxlevel . 3)
878  (org-agenda-files :maxlevel . 3))
879  ;; org-agenda-files (list "inbox.org")
880  org-agenda-include-diary t
881  org-agenda-include-inactive-timestamps t
882  org-confirm-babel-evaluate nil
883  org-src-fontify-natively t
884  org-src-tabs-act-natively t
885  org-footnote-section nil
886  org-log-into-drawer t
887  org-log-refile 'time
888  org-log-redeadline 'time
889  org-log-states-order-reversed nil
890  org-clock-persist 'history)
891 
892 (add-hook 'after-init-hook #'org-clock-persistence-insinuate)
893 
894 ;; archive
895 (defun extract-org-directory-titles-as-list (&optional dir)
896  (interactive "D")
897  (print
898  (delete nil
899  (let ((case-fold-search t))
900  (mapcar (lambda (f)
901  (when (string-match "org$" f)
902  (with-temp-buffer
903  (insert-file-contents-literally
904  (concat (file-name-as-directory dir) f))
905  (while (and (not (looking-at-p "#\\+TITLE:"))
906  (not (eobp)))
907  (forward-line))
908  (when (not (eobp))
909  (cons f (substring (thing-at-point 'line) 9 -1))))))
910  (directory-files dir))))))
911 
912 (defun insert-directory-org-file-titles (&optional dir)
913  (interactive "D")
914  (let ((files-titles (extract-org-directory-titles-as-list dir)))
915  (dolist (ft files-titles)
916  (insert (concat "[[file:" (car ft)"][" (cdr ft) "]]\n")))))
917 
918 (defun insert-directory-org-files (&optional dir)
919  (interactive "D")
920  (let ((files (directory-files dir)))
921  (dolist (f files)
922  (insert (concat "[[file:" f "][" (file-name-base f) "]]\n")))))
923 
924 (defun include-directory-org-files (&optional dir)
925  (interactive "D")
926  (let ((files (directory-files dir)))
927  (dolist (f files)
928  (insert (concat "#+INCLUDE: " f "\n")))))
929 
930 (defun org-todo-at-date (date)
931  "create a todo entry for a given date."
932  (interactive (list (org-time-string-to-time (org-read-date))))
933  (cl-flet ((org-current-effective-time (&rest r) date)
934  (org-today (&rest r) (time-to-days date)))
935  (cond ((eq major-mode 'org-mode) (org-todo))
936  ((eq major-mode 'org-agenda-mode) (org-agenda-todo)))))
937 
938 (defun org-agenda-show-week-all (&optional arg ) (interactive "P") (org-agenda arg "n"))
939 
940 (defun org-ask-location ()
941  "prompt for a location."
942  (let* ((org-refile-targets '((nil :maxlevel . 9)))
943  (hd (condition-case nil
944  (car (org-refile-get-location))
945  (error (car org-refile-history)))))
946  (goto-char (point-min))
947  (outline-next-heading)
948  (if (re-search-forward
949  (format org-complex-heading-regexp-format (regexp-quote hd))
950  nil t)
951  (goto-char (line-beginning-position))
952  (goto-char (point-max))
953  (or (bolp) (insert "\n"))
954  (insert "* " hd "\n")))
955  (end-of-line))
956 
957 (defun org-capture-fileref-snippet (f type headers func-name)
958  (let* ((code-snippet
959  (buffer-substring-no-properties (mark) (- (point) 1)))
960  (file-name (buffer-file-name))
961  (file-base (file-name-nondirectory file-name))
962  (line-number (line-number-at-pos (region-beginning)))
963  (initial-txt (if (null func-name)
964  (format "From [[file:%s::%s][%s]]:"
965  file-name line-number file-base)
966  (format "From ~%s~ (in [[file:%s::%s][%s]]):"
967  func-name file-name line-number
968  file-base))))
969  (format "
970  %s
971  #+BEGIN_%s %s
972  %s
973  #+END_%s" initial-txt type headers code-snippet type)))
974 
975 (defun org-capture-clip-snippet (f)
976  "Given a file, F, this captures the currently selected text
977  within an Org EXAMPLE block and a backlink to the file."
978  (with-current-buffer (find-buffer-visiting f)
979  (org-capture-fileref-snippet f "EXAMPLE" "" nil)))
980 
981 (defun org-capture-code-snippet (f)
982  "Given a file, F, this captures the currently selected text
983  within an Org SRC block with a language based on the current mode
984  and a backlink to the function and the file."
985  (with-current-buffer (find-buffer-visiting f)
986  (let ((org-src-mode (replace-regexp-in-string "-mode" "" (format "%s" major-mode)))
987  (func-name (which-function)))
988  (org-capture-fileref-snippet f "SRC" org-src-mode func-name))))
989 
990 (defun region-to-clocked-task (start end)
991  "Copies the selected text to the currently clocked in org-mode task."
992  (interactive "r")
993  (org-capture-string (buffer-substring-no-properties start end) "3"))
994 
995 (setq org-global-properties
996  '(quote (("EFFORT_ALL" . "0:15 0:30 0:45 1:00 2:00 3:00 4:00 5:00 6:00 0:00")
997  ("STYLE_ALL" . "habit"))))
998 
999 (defun org-mode-ask-effort ()
1000  "Ask for an effort estimate when clocking in."
1001  (unless (org-entry-get (point) "Effort")
1002  (let ((effort
1003  (completing-read
1004  "Effort: "
1005  (org-entry-get-multivalued-property (point) "Effort"))))
1006  (unless (equal effort "")
1007  (org-set-property "Effort" effort)))))
1008 
1009 (add-hook 'org-clock-in-prepare-hook
1010  'org-mode-ask-effort)
1011 
1012 ;;;###autoload
1013 (defun org-adjust-tags-column-reset-tags ()
1014  "In org-mode buffers it will reset tag position according to
1015 `org-tags-column'."
1016  (when (and
1017  (not (string= (buffer-name) "*Remember*"))
1018  (eql major-mode 'org-mode))
1019  (let ((b-m-p (buffer-modified-p)))
1020  (condition-case nil
1021  (save-excursion
1022  (goto-char (point-min))
1023  (command-execute 'outline-next-visible-heading)
1024  ;; disable (message) that org-set-tags generates
1025  (cl-flet ((message (&rest ignored) nil))
1026  (org-set-tags 1 t))
1027  (set-buffer-modified-p b-m-p))
1028  (error nil)))))
1029 
1030 ;; TODO 2024-08-05: infer logbook column-titles/props
1031 (defun column-display-value-transformer (column-title value)
1032  "Modifies the value to display in column view."
1033  (let ((title (upcase column-title)))
1034  (when (and (member title '("UPDATED" "NOTE")))
1035  (org-back-to-heading)
1036  (re-search-forward
1037  "Note taken on \\[\\(.*\\)\\] \\\\\\\\\\\n +\\(.*\\) *$"
1038  (org-entry-end-position) t))
1039  (if (equal column-title "UPDATED")
1040  (match-string-no-properties 1)
1041  (match-string-no-properties 2))))
1042 
1043 (setq org-columns-modify-value-for-display-function
1044  #'column-display-value-transformer)
1045 
1046 ;;;###autoload
1047 (defun org-align-all-tables ()
1048  "align all tables in current buffer"
1049  (interactive)
1050  (org-table-map-tables 'org-table-align 'quietly))
1051 
1052 (defun org-remove-redundant-tags ()
1053  "Remove redundant tags of headlines in current buffer.
1054 
1055 A tag is considered redundant if it is local to a headline and
1056 inherited by a parent headline."
1057  (interactive)
1058  (when (eq major-mode 'org-mode)
1059  (save-excursion
1060  (org-map-entries
1061  (lambda ()
1062  (let ((alltags (split-string (or (org-entry-get (point) "ALLTAGS") "") ":"))
1063  local inherited tag)
1064  (dolist (tag alltags)
1065  (if (get-text-property 0 'inherited tag)
1066  (push tag inherited) (push tag local)))
1067  (dolist (tag local)
1068  (if (member tag inherited) (org-toggle-tag tag 'off)))))
1069  t nil))))
1070 
1071 ;;;; Agenda
1072 (cl-pushnew '("w" "Work in progress tasks" ((todo "WIP") (agenda))) org-agenda-custom-commands)
1073 
1074 (defvar org-agenda-overriding-header)
1075 (defvar org-agenda-sorting-strategy)
1076 (defvar org-agenda-restrict)
1077 (defvar org-agenda-restrict-begin)
1078 (defvar org-agenda-restrict-end)
1079 
1080 ;;;###autoload
1081 (defun org-agenda-reschedule-to-today ()
1082  (interactive)
1083  (cl-flet ((org-read-date (&rest rest) (current-time)))
1084  (call-interactively 'org-agenda-schedule)))
1085 
1086 ;; Patch org-mode to use vertical splitting
1087 (defadvice org-prepare-agenda (after org-fix-split)
1088  (toggle-window-split))
1089 (ad-activate 'org-prepare-agenda)
1090 
1091 (add-hook 'org-agenda-mode-hook (lambda () (hl-line-mode 1)))
1092 
1093 (defun org-agenda-log-mode-colorize-block ()
1094  "Set different line spacing based on clock time duration."
1095  (save-excursion
1096  (let* ((colors (cl-case (alist-get 'background-mode (frame-parameters))
1097  (light
1098  (list "#F6B1C3" "#FFFF9D" "#BEEB9F" "#ADD5F7"))
1099  (dark
1100  (list "#aa557f" "DarkGreen" "DarkSlateGray" "DarkSlateBlue"))))
1101  pos
1102  duration)
1103  (nconc colors colors)
1104  (goto-char (point-min))
1105  (while (setq pos (next-single-property-change (point) 'duration))
1106  (goto-char pos)
1107  (when (and (not (equal pos (pos-bol)))
1108  (setq duration (org-get-at-bol 'duration)))
1109  ;; larger duration bar height
1110  (let ((line-height (if (< duration 15) 1.0 (+ 0.5 (/ duration 30))))
1111  (ov (make-overlay (pos-bol) (1+ (pos-eol)))))
1112  (overlay-put ov 'face `(:background ,(car colors) :foreground "black"))
1113  (setq colors (cdr colors))
1114  (overlay-put ov 'line-height line-height)
1115  (overlay-put ov 'line-spacing (1- line-height))))))))
1116 
1117 (add-hook 'org-agenda-finalize-hook #'org-agenda-log-mode-colorize-block)
1118 
1119 ;;;###autoload
1120 (defun org-agenda-current-subtree-or-region (only-todos)
1121  "Display an agenda view for the current subtree or region.
1122  With prefix, display only TODO-keyword items."
1123  (interactive "P")
1124  (let ((starting-point (point))
1125  header)
1126  (with-current-buffer (or (buffer-base-buffer (current-buffer))
1127  (current-buffer))
1128  (if (use-region-p)
1129  (progn
1130  (setq header "Region")
1131  (put 'org-agenda-files 'org-restrict (list (buffer-file-name (current-buffer))))
1132  (setq org-agenda-restrict (current-buffer))
1133  (move-marker org-agenda-restrict-begin (region-beginning))
1134  (move-marker org-agenda-restrict-end
1135  (save-excursion
1136  ;; If point is at beginning of line, include
1137  ;; heading on that line by moving forward 1.
1138  (goto-char (1+ (region-end)))
1139  (org-end-of-subtree))))
1140  ;; No region; restrict to subtree.
1141  (save-excursion
1142  (save-restriction
1143  ;; In case the command was called from an indirect buffer, set point
1144  ;; in the base buffer to the same position while setting restriction.
1145  (widen)
1146  (goto-char starting-point)
1147  (setq header "Subtree")
1148  (org-agenda-set-restriction-lock))))
1149  ;; NOTE: Unlike other agenda commands, binding `org-agenda-sorting-strategy'
1150  ;; around `org-search-view' seems to have no effect.
1151  (let ((org-agenda-sorting-strategy '(priority-down timestamp-up))
1152  (org-agenda-overriding-header header))
1153  (org-search-view (if only-todos t nil) "*"))
1154  (org-agenda-remove-restriction-lock t)
1155  (message nil))))
1156 
1157 (defun org-export-translate-to-lang (term-translations &optional lang)
1158  "Adds desired translations to `org-export-dictionary'.
1159  TERM-TRANSLATIONS is alist consisted of term you want to translate
1160  and its corresponding translation, first as :default then as :html and
1161  :utf-8. LANG is language you want to translate to."
1162  (dolist (term-translation term-translations)
1163  (let* ((term (car term-translation))
1164  (translation-default (nth 1 term-translation))
1165  (translation-html (nth 2 term-translation))
1166  (translation-utf-8 (nth 3 term-translation))
1167  (term-list (assoc term org-export-dictionary))
1168  (term-langs (cdr term-list)))
1169  (setcdr term-list (append term-langs
1170  (list
1171  (list lang
1172  :default translation-default
1173  :html translation-html
1174  :utf-8 translation-utf-8)))))))
1175 
1176 ;;; Dictionary
1177 (setq dictionary-server "compiler.company"
1178  switch-to-buffer-obey-display-actions t)
1179 
1180 ;;; Ispell
1181 ;; requires aspell and a hunspell dictionary (hunspell-en_us)
1182 (setq-default ispell-program-name "aspell")
1183 (add-hook 'mail-send-hook #'ispell-message)
1184 
1185 ;;; Skel
1186 (add-to-load-path user-emacs-lib-directory)
1187 (require 'sk)
1188 (require 'skt)
1189 
1190 (provide 'default)
1191 ;; default.el ends here