-
Notifications
You must be signed in to change notification settings - Fork 47
/
radian.el
5485 lines (4677 loc) Β· 211 KB
/
radian.el
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
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
;; -*- lexical-binding: t -*-
;; To see the outline of this file, run M-x outline-minor-mode and
;; then press C-c @ C-t. To also show the top-level functions and
;; variable declarations in each section, run M-x occur with the
;; following query: ^;;;;* \|^(
;;; Detect stale bytecode
;; If Emacs version changed, the bytecode is no longer valid and we
;; must recompile. Also, if the location of Radian changed, our
;; dotfile-finding functions are defined incorrectly and we must
;; recompile.
(eval
`(unless (equal
(list
(emacs-version)
radian-lib-file)
',(eval-when-compile
(list
(emacs-version)
radian-lib-file)))
(throw 'stale-bytecode nil)))
;;; Load built-in utility libraries
(require 'cl-lib)
(require 'map)
(require 'subr-x)
;;; Fix indentation issues
;; The indentation of `define-key' has for some reason changed in
;; Emacs 29 when it was deprecated in favor of `keymap-set'. Maybe
;; that is a bug and they will change it, but for now, force the
;; indentation to the backwards-compatible version.
(put #'define-key 'lisp-indent-function 'defun)
;; The indentation of `thread-first' changed from (indent 1) to
;; (indent 0) in Emacs 28. Use the later version.
(put #'thread-first 'lisp-indent-function 0)
;;; Set early configuration
;; Disable byte-compilation warnings from native-compiled packages
;; from being reported asynchronously into the UI.
(setq native-comp-async-report-warnings-errors nil)
;;; Define Radian customization groups
(defgroup radian-hooks nil
"Startup hooks for Radian Emacs."
:group 'radian
:link '(url-link :tag "GitHub" "https://github.com/radian-software/radian"))
(defgroup radian nil
"Customize your Radian Emacs experience."
:prefix "radian-"
:group 'emacs
:link '(url-link :tag "GitHub" "https://github.com/radian-software/radian"))
;;; Define utility functions and variables
(defvar radian-disabled-packages nil
"List of packages that Radian should not load.
Radian always loads the packages `use-package', `straight',
`blackout', `bind-key' and `el-patch' even if they are members of
this list.")
(defvar radian-compiling nil
"Non-nil when Radian's make is being called.")
(defvar radian-prune-straight-cache
(not (or radian-compiling
(member "--no-local" command-line-args)))
"Non-nil when Radian should prune straight's cache.")
(defvar radian-directory (file-name-directory
(directory-file-name
(file-name-directory
radian-lib-file)))
"Path to the Radian Git repository.")
(defun radian-enabled-p (package)
"Return nil if PACKAGE should not be loaded by Radian."
(not (memq package radian-disabled-packages)))
(defmacro radian-protect-macros (&rest body)
"Eval BODY, protecting macros from incorrect expansion.
This macro should be used in the following situation:
Some form is being evaluated, and this form contains as a
sub-form some code that will not be evaluated immediately, but
will be evaluated later. The code uses a macro that is not
defined at the time the top-level form is evaluated, but will be
defined by time the sub-form's code is evaluated. This macro
handles its arguments in some way other than evaluating them
directly. And finally, one of the arguments of this macro could
be interpreted itself as a macro invocation, and expanding the
invocation would break the evaluation of the outer macro.
You might think this situation is such an edge case that it would
never happen, but you'd be wrong, unfortunately. In such a
situation, you must wrap at least the outer macro in this form,
but can wrap at any higher level up to the top-level form."
(declare (indent 0))
`(eval '(progn ,@body) lexical-binding))
(defmacro radian-protect-macros-maybe (feature &rest body)
"Same as `radian-protect-macros', but only if FEATURE is unavailable.
Otherwise eval BODY normally (subject to eager macroexpansion).
In either case, eagerly load FEATURE during byte-compilation."
(declare (indent 1))
(let ((available (featurep feature)))
(when byte-compile-current-file
(setq available (require feature nil 'noerror)))
(if available
`(progn ,@body)
`(radian-protect-macros
(progn ,@body)))))
(defmacro radian-flet (bindings &rest body)
"Temporarily override function definitions using `cl-letf*'.
BINDINGS are composed of `defun'-ish forms. NAME is the function
to override. It has access to the original function as a
lexically bound variable by the same name, for use with
`funcall'. ARGLIST and BODY are as in `defun'.
\(fn ((defun NAME ARGLIST &rest BODY) ...) BODY...)"
(declare (indent defun))
`(cl-letf* (,@(cl-mapcan
(lambda (binding)
(when (memq (car binding) '(defun lambda))
(setq binding (cdr binding)))
(cl-destructuring-bind (name arglist &rest body) binding
(list
`(,name (symbol-function #',name))
`((symbol-function #',name)
(lambda ,arglist
,@body)))))
bindings))
,@body))
(defmacro radian-defadvice (name arglist where place docstring &rest body)
"Define an advice called NAME and add it to a function.
ARGLIST is as in `defun'. WHERE is a keyword as passed to
`advice-add', and PLACE is the function to which to add the
advice, like in `advice-add'. PLACE should be sharp-quoted.
DOCSTRING and BODY are as in `defun'."
(declare (indent 2)
(doc-string 5))
(unless (stringp docstring)
(error "Radian: advice `%S' not documented'" name))
(unless (and (listp place)
(= 2 (length place))
(eq (nth 0 place) 'function)
(symbolp (nth 1 place)))
(error "Radian: advice `%S' does not sharp-quote place `%S'" name place))
`(progn
;; You'd think I would put an `eval-and-compile' around this. It
;; turns out that doing so breaks the ability of
;; `elisp-completion-at-point' to complete on function arguments
;; to the advice. I know, right? Apparently this is because the
;; code that gets the list of lexically bound symbols at point
;; tries to `macroexpand-all', and apparently macroexpanding
;; `eval-and-compile' goes ahead and evals the thing and returns
;; only the function symbol. No good. But the compiler does still
;; want to know the function is defined (this is a Gilardi
;; scenario), so we pacify it by `eval-when-compile'ing something
;; similar (see below).
(defun ,name ,arglist
,(let ((article (if (string-match-p "^:[aeiou]" (symbol-name where))
"an"
"a")))
(format "%s\n\nThis is %s `%S' advice for\n`%S'."
docstring article where
(if (and (listp place)
(memq (car place) ''function))
(cadr place)
place)))
,@body)
(eval-when-compile
(declare-function ,name nil))
(advice-add ,place ',where #',name)
',name))
(defmacro radian-defhook (name arglist hooks docstring &rest body)
"Define a function called NAME and add it to a hook.
ARGLIST is as in `defun'. HOOKS is a list of hooks to which to
add the function, or just a single hook. DOCSTRING and BODY are
as in `defun'."
(declare (indent 2)
(doc-string 4))
(unless (listp hooks)
(setq hooks (list hooks)))
(dolist (hook hooks)
(unless (string-match-p "-\\(hook\\|functions\\)$" (symbol-name hook))
(error "Symbol `%S' is not a hook" hook)))
(unless (stringp docstring)
(error "Radian: no docstring provided for `radian-defhook'"))
(let ((hooks-str (format "`%S'" (car hooks))))
(dolist (hook (cdr hooks))
(setq hooks-str (format "%s\nand `%S'" hooks-str hook)))
`(progn
(defun ,name ,arglist
,(format "%s\n\nThis function is for use in %s."
docstring hooks-str)
,@body)
(dolist (hook ',hooks)
(add-hook hook ',name)))))
(defmacro radian-operating-system-p (os)
"Return non-nil if OS corresponds to the current operating system.
Allowable values for OS (not quoted) are `macOS', `osx',
`windows', `linux', `unix'."
(pcase os
(`unix `(not (memq system-type '(ms-dos windows-nt cygwin))))
((or `macOS `osx) `(eq system-type 'darwin))
(`linux `(not (memq system-type
'(darwin ms-dos windows-nt cygwin))))
(`windows `(memq system-type '(ms-dos windows-nt cygwin)))))
(defmacro radian-with-operating-system (os &rest body)
"If OS corresponds to the current operating system, eval and return BODY.
If not, return nil.
Allowable values for OS (not quoted) are `macOS', `osx',
`windows', `linux', `unix'."
(declare (indent 1))
`(when (radian-operating-system-p ,os)
,@body))
(defmacro radian-if-compiletime (cond then else)
"Like `if', but COND is evaluated at compile time.
The macro expands directly to either THEN or ELSE, and the other
branch is not compiled. This can be helpful to deal with code
that uses functions only defined in a specific Emacs version."
(declare (indent 2))
(if (eval cond)
then
else))
(defmacro radian-when-compiletime (cond &rest body)
"Like `when', but COND is evaluated at compile time.
BODY is only compiled if COND evaluates to non-nil. This can be
helpful to deal with code that uses functions only defined in a
specific Emacs version."
(declare (indent 1))
(when (eval cond)
`(progn ,@body)))
(defun radian-managed-p (filename)
"Return non-nil if FILENAME is managed by Radian.
This means that FILENAME is a symlink whose target is inside
`radian-directory'."
(let ((truename (file-truename filename)))
(string-prefix-p radian-directory truename
(when (if (fboundp 'file-name-case-insensitive-p)
(file-name-case-insensitive-p truename)
(radian-with-operating-system macOS
t))
'ignore-case))))
(defmacro radian--with-silent-load (&rest body)
"Execute BODY, with the function `load' made silent."
(declare (indent 0))
`(radian-flet ((defun load (file &optional noerror _nomessage &rest args)
(apply load file noerror 'nomessage args)))
,@body))
(defmacro radian--with-silent-write (&rest body)
"Execute BODY, with the function `write-region' made silent."
(declare (indent 0))
`(radian-flet ((defun write-region
(start end filename &optional append visit lockname
mustbenew)
(funcall write-region start end filename append 0
lockname mustbenew)
(when (or (stringp visit) (eq visit t))
(setq buffer-file-name
(if (stringp visit)
visit
filename))
(set-visited-file-modtime)
(set-buffer-modified-p nil))))
(cl-letf (((symbol-function #'message) #'ignore))
,@body)))
(defmacro radian--with-silent-message (regexps &rest body)
"Silencing any messages that match REGEXPS, execute BODY.
REGEXPS is a list of strings; if `message' would display a
message string (not including the trailing newline) matching any
element of REGEXPS, nothing happens. The REGEXPS need not match
the entire message; include ^ and $ if necessary. REGEXPS may
also be a single string."
(declare (indent 1))
(let ((regexps-sym (cl-gensym "regexps")))
`(let ((,regexps-sym ,regexps))
(when (stringp ,regexps-sym)
(setq ,regexps-sym (list ,regexps-sym)))
(radian-flet ((defun message (format &rest args)
(let ((str (apply #'format format args)))
;; Can't use an unnamed block because during
;; byte-compilation, some idiot loads `cl', which
;; sticks an advice onto `dolist' that makes it
;; behave like `cl-dolist' (i.e., wrap it in
;; another unnamed block) and therefore breaks
;; this code.
(cl-block done
(dolist (regexp ,regexps-sym)
(when (or (null regexp)
(string-match-p regexp str))
(cl-return-from done)))
(funcall message "%s" str)))))
,@body))))
(defun radian--advice-silence-messages (func &rest args)
"Invoke FUNC with ARGS, silencing all messages.
This is an `:around' advice for many different functions."
(cl-letf (((symbol-function #'message) #'ignore))
(apply func args)))
(defun radian--random-string ()
"Return a random string designed to be globally unique."
(md5 (format "%s%s%s%s"
(system-name) (emacs-pid) (current-time) (random))))
(defun radian--list-of-strings-p (obj)
"Return non-nil if OBJ is a list of strings."
(and (listp obj)
(cl-every #'stringp obj)))
(defun radian--path-join (path &rest segments)
"Join PATH with SEGMENTS using `expand-file-name'.
First `expand-file-name' is called on the first member of
SEGMENTS, with PATH as DEFAULT-DIRECTORY. Then `expand-file-name'
is called on the second member, with the result of the first call
as DEFAULT-DIRECTORY, and so on. If no SEGMENTS are passed, the
return value is just PATH."
(while segments
(setq path (expand-file-name (pop segments) path)))
path)
;;; Define hooks and load local configuration
;; Reset the value of this variable so that stale functions don't
;; stick around.
(setq radian--finalize-init-hook nil)
(defcustom radian-before-straight-hook nil
"Hook run just before Radian bootstraps straight.el.
For use with `radian-local-on-hook' in init.local.el."
:group 'radian-hooks
:type 'hook)
(defcustom radian-after-init-hook nil
"Hook run after at the very end of init.
For use with `radian-local-on-hook' in init.local.el."
:group 'radian-hooks
:type 'hook)
(defvar radian--hook-contents nil
"Alist mapping local init hooks to lists of forms.
This is used to embed local init hook code directly into the
init-file at the appropriate places during byte-compilation,
without breaking macro-expansion.")
;; Idempotency.
(setq radian--hook-contents nil)
;; Allow binding this variable dynamically before straight.el has been
;; loaded.
(defvar straight-current-profile)
(defmacro radian--with-local-load-history (&rest body)
"Evaluate BODY as part of `radian-local-init-file'.
This ensures that defined functions and variables show up as
being defined there, instead of whatever file they are being
loaded from."
(declare (indent 0))
`(let ((current-load-list nil))
,@body
(push (cons ',radian-local-init-file current-load-list) load-history)))
(defmacro radian--load-local-init-file ()
"Load local init-file, with crazy hacks for byte-compilation.
In particular, if we are byte-compiling, actually macroexpand to
the entire contents of the local init-file, except that the
bodies of invocations to `radian-local-on-hook' are recorded in
`radian--hook-contents'. Otherwise just load the file like
usual."
(if byte-compile-current-file
(let ((forms nil))
(with-temp-buffer
(ignore-errors
;; Can't do this literally because it breaks Unicode
;; characters.
(insert-file-contents radian-local-init-file))
(condition-case _
(while t
(let ((form (read (current-buffer))))
(if (and (listp form)
(eq (nth 0 form) #'radian-local-on-hook)
(nth 1 form)
(symbolp (nth 1 form))
(nthcdr 2 form))
(let* ((name (nth 1 form))
(body (nthcdr 2 form))
(hook (intern (format "radian-%S-hook" name)))
(link (assq hook radian--hook-contents)))
(unless link
(setq link (cons hook nil))
(push link radian--hook-contents))
(dolist (subform body)
(push subform (cdr link))))
(push form forms))))
(end-of-file)))
(setq forms (nreverse forms))
(dolist (link radian--hook-contents)
(setf (cdr link)
(nreverse (cdr link))))
`(radian--with-local-load-history ,@forms))
`(load radian-local-init-file 'noerror 'nomessage)))
(defmacro radian-local-on-hook (name &rest body)
"Register some code to be run on one of Radian's hooks.
The hook to be used is `radian-NAME-hook', with NAME an unquoted
symbol, and the code which is added is BODY wrapped in a `progn'.
See \\[customize-group] RET radian-hooks RET for a list of hooks
which you can use with this macro in your local init-file.
Using this macro instead of defining functions and adding them to
Radian's hooks manually means that a lot of magic happens which
allows Radian to embed your entire local init-file into Radian
during byte-compilation without breaking macroexpansion in
unexpected ways."
(declare (indent 1))
(let ((func-name (intern (format "radian-local--%S" name)))
(hook (intern (format "radian-%S-hook" name))))
`(progn
(radian-defhook ,func-name ()
,hook
"Automatically-generated local hook function."
(radian-protect-macros
,@body)))))
(defvar radian--no-local nil
"Non-nil means to not load local init-file.")
;; Allow to disable local customizations with a
;; command-line argument.
(if (member "--no-local" command-line-args)
;; Make sure to delete --no-local from the list, because
;; otherwise Emacs will issue a warning about the unknown
;; argument.
(setq command-line-args (delete "--no-local" command-line-args)
radian--no-local t)
;; Load local customizations.
(radian--load-local-init-file))
(defmacro radian--run-hook (name)
"Run the given local init HOOK.
The hook to be used is `radian-NAME-hook', with NAME an unquoted
symbol. This binds `straight-current-profile', and also has some
gnarly hacks to allow Radian to embed the entire contents of the
hook directly into the init-file during byte-compilation."
(declare (indent 0))
(let ((hook (intern (format "radian-%S-hook" name))))
`(unless radian--no-local
(let ((straight-current-profile 'radian-local))
(radian--with-local-load-history
,(if byte-compile-current-file
`(progn ,@(alist-get hook radian--hook-contents))
`(run-hooks ',hook)))))))
;;; Startup optimizations
;; Disable frequency of GC. This helps performance both during init
;; and after init. Value is in bytes so this is 100MB, as suggested in
;; <https://github.com/emacs-lsp/lsp-mode#performance>.
(setq gc-cons-threshold (* 100 1024 1024))
;; After we enabled `load-prefer-newer' in init.el, disable it again
;; for the duration of init. Presumably, it slows things down, and we
;; shouldn't need it for anything but loading radian.el itself.
(setq load-prefer-newer nil)
;;; Networking
;; Use `with-eval-after-load' instead of `use-feature' because we have
;; not yet set up package management.
;; Feature `gnutls' provides support for SSL/TLS connections, using
;; the GnuTLS library.
(with-eval-after-load 'gnutls
;; `use-package' does this for us normally.
(eval-when-compile
(require 'gnutls))
;; Do not allow insecure TLS connections.
(setq gnutls-verify-error t)
;; Bump the required security level for TLS to an acceptably modern
;; value.
(setq gnutls-min-prime-bits 3072))
;; Feature `url-http' is a library for making HTTP requests.
(with-eval-after-load 'url-http
(eval-when-compile
(require 'url-http))
(radian-defadvice radian--no-query-on-http-kill
(buffer)
:filter-return #'url-http
"Disable query-on-exit for all network connections.
This prevents Emacs shutdown from being interrupted just because
there is a pending network request."
(prog1 buffer
(set-process-query-on-exit-flag
(get-buffer-process buffer) nil))))
;;; Set up package management
;;;; straight.el
;; Tell straight.el about the profiles we are going to be using.
(setq straight-profiles
'(;; Packages registered in this file.
(radian . "radian.el")
;; Packages registered in the local init-file during hooks.
(radian-local . "radian-local.el")
;; Packages registered interactively.
(nil . "default.el")))
;; Pretend to dynamically bind `straight-current-profile' to `radian'
;; over the init-file. We do this to avoid having straight.el
;; configuration mentioned in the top-level init-file.
(radian-defhook radian--reset-straight-current-profile ()
radian--finalize-init-hook
"Reset `straight-current-profile' to nil.
This function is used on `radian--finalize-init-hook' to emulate
binding the variable dynamically over the entire init-file."
(setq straight-current-profile nil))
(setq straight-current-profile 'radian)
;; Use the develop branch of straight.el on Radian's develop branch.
;; (On Radian's master branch, we use the master branch of
;; straight.el.)
(setq straight-repository-branch "develop")
;; If watchexec and Python are installed, use file watchers to detect
;; package modifications. This saves time at startup. Otherwise, use
;; the ever-reliable find(1).
(if (and (executable-find "watchexec")
(executable-find "python3"))
(setq straight-check-for-modifications '(watch-files find-when-checking))
(setq straight-check-for-modifications
'(find-at-startup find-when-checking)))
;; Clear out recipe overrides (in case of re-init).
(setq straight-recipe-overrides nil)
(radian--run-hook before-straight)
;; Bootstrap the package manager, straight.el.
(defvar bootstrap-version)
(let ((bootstrap-file
(expand-file-name
"straight/repos/straight.el/bootstrap.el"
(or (bound-and-true-p straight-base-dir)
user-emacs-directory)))
(bootstrap-version 5))
(unless (file-exists-p bootstrap-file)
(with-current-buffer
(url-retrieve-synchronously
"https://raw.githubusercontent.com/raxod502/straight.el/develop/install.el"
'silent 'inhibit-cookies)
(goto-char (point-max))
(eval-print-last-sexp)))
(load bootstrap-file nil 'nomessage))
;;;; use-package
;; Package `use-package' provides a handy macro by the same name which
;; is essentially a wrapper around `with-eval-after-load' with a lot
;; of handy syntactic sugar and useful features.
(straight-use-package 'use-package)
;; When configuring a feature with `use-package', also tell
;; straight.el to install a package of the same name, unless otherwise
;; specified using the `:straight' keyword.
(setq straight-use-package-by-default t)
;; Tell `use-package' to always load features lazily unless told
;; otherwise. It's nicer to have this kind of thing be deterministic:
;; if `:demand' is present, the loading is eager; otherwise, the
;; loading is lazy. See
;; https://github.com/jwiegley/use-package#notes-about-lazy-loading.
(setq use-package-always-defer t)
(defmacro radian-use-package (name &rest args)
"Like `use-package', but handles `radian-exclude-packages' properly.
NAME and ARGS are as in `use-package'."
(declare (indent 1))
(let* ((straight (cl-loop for cur on ',args by #'cdr
when (eq (car cur) :straight)
collect (cadr cur)))
(package (cond
(straight (car straight))
(straight-use-package-by-default name))))
(if (radian-enabled-p name)
`(use-package ,name ,@args)
(when package
`(straight-register-package ',package)))))
(defmacro use-feature (name &rest args)
"Like `radian-use-package', but without straight.el integration.
NAME and ARGS are as in `use-package'."
(declare (indent defun))
`(when (radian-enabled-p ',name)
(radian-protect-macros-maybe ,name
(use-package ,name
:straight nil
,@args))))
(defun radian--remove-sharp-quotes (form)
"Remove sharp quotes in all sub-forms of FORM."
(pcase form
(`(function ,x) (radian--remove-sharp-quotes x))
(`(,x . ,y) (cons (radian--remove-sharp-quotes x)
(radian--remove-sharp-quotes y)))
((pred vectorp)
(apply #'vector (mapcar #'radian--remove-sharp-quotes form)))
(x x)))
(radian-defadvice radian--advice-use-package-bind-handle-sharp-quotes
(args)
:filter-args #'use-package-normalize-binder
"Make `use-package' handle sharp-quoted functions correctly in `:bind'.
It is unclear to me why this is needed, as JW said explicitly to
the contrary in
<https://github.com/jwiegley/use-package/issues/461#issuecomment-348045772>.
Nevertheless we hack around the issue by simply doing a recursive
find-and-replace on sharp quotes in the arguments, because that's
the simple solution and the performance overhead is unimportant
since it happens during compilation anyway. (No, I'm not willing
to give up my sharp quotes; having autocompletion is really
nice.)"
(radian--remove-sharp-quotes args))
;; Package `blackout' provides a convenient function for customizing
;; mode lighters. It supports both major and minor modes with the same
;; interface, and includes `use-package' integration. The features are
;; a strict superset of those provided by similar packages `diminish',
;; `delight', and `dim'.
(use-package blackout
:demand t)
;;;; straight.el configuration
;; Feature `straight-x' from package `straight' provides
;; experimental/unstable extensions to straight.el which are not yet
;; ready for official inclusion.
(use-feature straight-x
;; Add an autoload for this extremely useful command.
:commands (straight-x-fetch-all))
;;; Configure ~/.emacs.d paths
;; Package `compat' contains useful functions that are implemented in
;; future emacsen.
(radian-use-package compat)
;; Package `no-littering' changes the default paths for lots of
;; different packages, with the net result that the ~/.emacs.d folder
;; is much more clean and organized.
(radian-use-package no-littering
:defines (radian--auth-source-blacklist-file)
:demand t
:config
(setq radian--auth-source-blacklist-file
(no-littering-expand-var-file-name "auth-source/blacklist.el")))
;;; Prevent Emacs-provided Org from being loaded
;; Our real configuration for Org comes much later. Doing this now
;; means that if any packages that are installed in the meantime
;; depend on Org, they will not accidentally cause the Emacs-provided
;; (outdated and duplicated) version of Org to be loaded before the
;; real one is registered.
(straight-register-package 'org)
(straight-register-package 'org-contrib)
;;; el-patch
;; Package `el-patch' provides a way to override the definition of an
;; internal function from another package by providing an s-expression
;; based diff which can later be validated to ensure that the upstream
;; definition has not changed.
(use-package el-patch)
;; Only needed at compile time, thanks to Jon
;; <https://github.com/radian-software/el-patch/pull/11>.
(eval-when-compile
(require 'el-patch))
;;; Keybindings
;; Package `bind-key' provides a macro by the same name (along with
;; `bind-key*' and `unbind-key') which provides a much prettier API
;; for manipulating keymaps than `define-key' and `global-set-key' do.
;; It's also the same API that `:bind' and similar keywords in
;; `use-package' use.
(use-package bind-key
:demand t)
;; Normalize behavior for the Mac port (i.e. make it behave like
;; normal Emacs on macOS does). By default alt does the default macOS
;; alt thing, while command acts as meta instead of super. Also all
;; the default bindings are gone for some reason :'(
(when (radian-operating-system-p macOS)
(when (and (boundp 'mac-option-modifier)
(boundp 'mac-command-modifier))
(setq mac-option-modifier 'meta)
(setq mac-command-modifier 'super))
(bind-key "s-z" #'undo)
(bind-key "s-x" #'kill-region)
(bind-key "s-c" #'kill-ring-save)
(bind-key "s-v" #'yank)
(bind-key "s-n" #'make-frame)
(bind-key "s-s" #'save-buffer)
(bind-key "s-w" #'delete-frame)
(bind-key "s-q" #'save-buffers-kill-terminal))
(defvar radian-keymap (make-sparse-keymap)
"Keymap for Radian commands that should be put under a prefix.
This keymap is bound under \\[radian-keymap].")
(bind-key* "M-P" radian-keymap)
(defun radian-join-keys (&rest keys)
"Join key sequences KEYS. Empty strings and nils are discarded.
\(radian--join-keys \"\\[radian-keymap] e\" \"e i\")
=> \"\\[radian-keymap] e e i\"
\(radian--join-keys \"\\[radian-keymap]\" \"\" \"e i\")
=> \"\\[radian-keymap] e i\""
(string-join (remove "" (mapcar #'string-trim (remove nil keys))) " "))
(radian-defadvice radian--quoted-insert-allow-quit (quoted-insert &rest args)
:around #'quoted-insert
"Allow quitting out of \\[quoted-insert] with \\[keyboard-quit]."
(radian-flet ((defun insert-and-inherit (&rest args)
(dolist (arg args)
(when (equal arg ?\C-g)
(signal 'quit nil)))
(apply insert-and-inherit args)))
(apply quoted-insert args)))
;; Package `which-key' displays the key bindings and associated
;; commands following the currently-entered key prefix in a popup.
(radian-use-package which-key
:demand t
:config
;; We configure it so that `which-key' is triggered by typing C-h
;; during a key sequence (the usual way to show bindings). See
;; <https://github.com/justbur/emacs-which-key#manual-activation>.
(setq which-key-show-early-on-C-h t)
(setq which-key-idle-delay most-positive-fixnum)
(setq which-key-idle-secondary-delay 1e-100)
(which-key-mode +1)
:blackout t)
;;; Environment
;;;; Environment variables
(defcustom radian-env-setup t
"Non-nil means ~/.profile is sourced after startup.
Environment variables will be copied into the current Emacs
process. This works around issues caused by desktop environments
not providing the proper env vars to graphical applications.
You may want to disable this if your ~/.profile is not safe to
run multiple times."
:type 'boolean)
(defvar radian--env-setup-p nil
"Non-nil if `radian-env-setup' has completed at least once.")
(defun radian-env-setup (&optional again)
"Load ~/.profile and set environment variables exported therein.
Only do this once, unless AGAIN is non-nil."
(interactive (list 'again))
;; No need to worry about race conditions because Elisp isn't
;; concurrent (yet).
(unless (or (not radian-env-setup)
(and radian--env-setup-p (not again)))
(let (;; Current directory may not exist in certain horrifying
;; circumstances (yes, this has happened in practice).
(default-directory "/")
(profile-file "~/.profile")
(buf-name " *radian-env-output*"))
(when (and profile-file
(file-exists-p profile-file)
(executable-find "python3"))
(ignore-errors (kill-buffer buf-name))
(with-current-buffer (get-buffer-create buf-name)
(let* ((python-script
(expand-file-name "scripts/print_env.py" radian-directory))
(delimiter (radian--random-string))
(sh-script (format ". %s && %s %s"
(shell-quote-argument
(expand-file-name profile-file))
(shell-quote-argument python-script)
(shell-quote-argument delimiter)))
(return (call-process "sh" nil t nil "-c" sh-script))
(found-delimiter
(progn
(goto-char (point-min))
(search-forward delimiter nil 'noerror))))
(if (and (= 0 return) found-delimiter)
(let* ((results (split-string
(buffer-string) (regexp-quote delimiter)))
(results (cl-subseq results 1 (1- (length results)))))
(if (cl-evenp (length results))
(progn
(cl-loop for (var value) on results by #'cddr do
(setenv var value)
(when (string= var "PATH")
(setq exec-path (append
(parse-colon-path value)
(list exec-directory)))))
(setq radian--env-setup-p t))
(message
"Loading %s produced malformed result; see buffer %S"
profile-file
buf-name)))
(message "Failed to load %s; see buffer %S"
profile-file
buf-name))))))))
(defvar radian--env-setup-timer
(run-at-time 1 nil #'radian-env-setup)
"Timer used to run `radian-env-setup'.
We (mostly) don't need environment variables to be set correctly
during init, so deferring their processing saves some time at
startup.")
;;;; Clipboard integration
;; On macOS, clipboard integration works out of the box in windowed
;; mode but not terminal mode. The following code to fix it was
;; originally based on [1], and then modified based on [2].
;;
;; [1]: https://gist.github.com/the-kenny/267162
;; [2]: https://emacs.stackexchange.com/q/26471/12534
(radian-with-operating-system macOS
(unless (display-graphic-p)
(defvar radian--clipboard-last-copy nil
"The last text that was copied to the system clipboard.
This is used to prevent duplicate entries in the kill ring.")
(eval-and-compile
(defun radian--clipboard-paste ()
"Return the contents of the macOS clipboard, as a string."
(let* (;; Setting `default-directory' to a directory that is
;; sure to exist means that this code won't error out
;; when the directory for the current buffer does not
;; exist.
(default-directory "/")
;; Command pbpaste returns the clipboard contents as a
;; string.
(text (shell-command-to-string "pbpaste")))
;; If this function returns nil then the system clipboard is
;; ignored and the first element in the kill ring (which, if
;; the system clipboard has not been modified since the last
;; kill, will be the same) is used instead. Including this
;; `unless' clause prevents you from getting the same text
;; yanked the first time you run `yank-pop'.
(unless (string= text radian--clipboard-last-copy)
text)))
(defun radian--clipboard-copy (text)
"Set the contents of the macOS clipboard to given TEXT string."
(let* (;; Setting `default-directory' to a directory that is
;; sure to exist means that this code won't error out
;; when the directory for the current buffer does not
;; exist.
(default-directory "/")
;; Setting `process-connection-type' makes Emacs use a pipe to
;; communicate with pbcopy, rather than a pty (which is
;; overkill).
(process-connection-type nil)
;; The nil argument tells Emacs to discard stdout and
;; stderr. Note, we aren't using `call-process' here
;; because we want this command to be asynchronous.
;;
;; Command pbcopy writes stdin to the clipboard until it
;; receives EOF.
(proc (start-process "pbcopy" nil "pbcopy")))
(process-send-string proc text)
(process-send-eof proc))
(setq radian--clipboard-last-copy text)))
(setq interprogram-paste-function #'radian--clipboard-paste)
(setq interprogram-cut-function #'radian--clipboard-copy)))
;; If you have something on the system clipboard, and then kill
;; something in Emacs, then by default whatever you had on the system
;; clipboard is gone and there is no way to get it back. Setting the
;; following option makes it so that when you kill something in Emacs,
;; whatever was previously on the system clipboard is pushed into the
;; kill ring. This way, you can paste it with `yank-pop'.
(setq save-interprogram-paste-before-kill t)
(radian-defadvice radian--advice-gui-get-selection-quietly (func &rest args)
:around #'gui-selection-value
"Disable an annoying message emitted when Emacs can't yank something.
In particular, if you have an image on your system clipboard and
you either yank or kill (as `save-interprogram-paste-before-kill'
means Emacs will try to put the system clipboard contents into
the kill ring when you kill something new), you'll get the
message \\='gui-get-selection: (error \"Selection owner couldn't
convert\" UTF8_STRING)'. Disable that."
(radian--with-silent-message "Selection owner couldn't convert"
(apply func args)))
;;;; Mouse integration
;; Scrolling is way too fast on macOS with Emacs 27 and on Linux in
;; general. Decreasing the number of lines we scroll per mouse event
;; improves the situation. Normally, holding shift allows this slower
;; scrolling; instead, we make it so that holding shift accelerates
;; the scrolling.
(setq mouse-wheel-scroll-amount
'(1 ((shift) . 5) ((control))))
;; Mouse integration works out of the box in windowed mode but not
;; terminal mode. The following code to fix it was based on
;; <https://stackoverflow.com/a/8859057/3538165>.
(unless (display-graphic-p)
;; Enable basic mouse support (click and drag).
(xterm-mouse-mode t)
;; Note that the reason for the next two functions is that
;; `scroll-down' and `scroll-up' scroll by a "near full screen"
;; by default, whereas we want a single line.
(eval-and-compile
(defun radian-scroll-down ()
"Scroll down one line."
(interactive)
(scroll-down 1))
(defun radian-scroll-up ()
"Scroll up one line."
(interactive)
(scroll-up 1)))
;; Enable scrolling with the mouse wheel.
(bind-key "<mouse-4>" #'radian-scroll-down)
(bind-key "<mouse-5>" #'radian-scroll-up))
;;; Candidate selection
;; Allow doing a command that requires candidate-selection when you
;; are already in the middle of candidate-selection. Sometimes it's
;; handy!
(setq enable-recursive-minibuffers t)
(radian-defadvice radian--advice-eval-expression-save-garbage
(func prompt &optional initial-contents keymap read &rest args)
:around #'read-from-minibuffer
"Save user input in history even if it's not a valid sexp.
We do this by forcing `read-from-minibuffer' to always be called
with a nil value for READ, and then handling the effects of READ
ourselves."
(let ((input (apply func prompt initial-contents keymap nil args)))
(when read
;; This is based on string_to_object in minibuf.c.
(let ((result (read-from-string input)))
(unless (string-match-p
"\\`[ \t\n]*\\'" (substring input (cdr result)))
(signal
'invalid-read-syntax
'("Trailing garbage following expression")))
(setq input (car result))))
input))