mirrored from git://git.sv.gnu.org/emacs.git
/
simple.el
10885 lines (9854 loc) · 446 KB
/
simple.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
;;; simple.el --- basic editing commands for Emacs -*- lexical-binding: t -*-
;; Copyright (C) 1985-1987, 1993-2023 Free Software Foundation, Inc.
;; Maintainer: emacs-devel@gnu.org
;; Keywords: internal
;; Package: emacs
;; This file is part of GNU Emacs.
;; GNU Emacs is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;; A grab-bag of basic Emacs commands not specifically related to some
;; major mode or to file-handling.
;;; Code:
(eval-when-compile (require 'cl-lib))
(declare-function widget-convert "wid-edit" (type &rest args))
(declare-function shell-mode "shell" ())
;;; From compile.el
(defvar compilation-current-error)
(defvar compilation-context-lines)
(defcustom idle-update-delay 0.5
"Idle time delay before updating various things on the screen.
Various Emacs features that update auxiliary information when point moves
wait this many seconds after Emacs becomes idle before doing an update."
:type 'number
:group 'display
:version "22.1")
(defvar amalgamating-undo-limit 20
"The maximum number of changes to possibly amalgamate when undoing changes.
The `undo' command will normally consider \"similar\" changes
(like inserting characters) to be part of the same change. This
is called \"amalgamating\" the changes. This variable says what
the maximum number of changes considered is when amalgamating. A
value of 1 means that nothing is amalgamated.")
(defgroup killing nil
"Killing and yanking commands."
:group 'editing)
(defgroup paren-matching nil
"Highlight (un)matching of parens and expressions."
:group 'matching)
(defvar-local escaped-string-quote "\\"
"String to insert before a string quote character in a string to escape it.
This is typically a backslash (in most languages):
\\='foo\\\\='bar\\='
\"foo\\\"bar\"
But in SQL, for instance, it's \"\\='\":
\\='foo\\='\\='bar\\='
This can also be a function, which is called with the string
terminator as the argument, and should return a string to be
used as the escape.
This variable is used by the `yank-in-context' command.")
;;; next-error support framework
(defgroup next-error nil
"`next-error' support framework."
:group 'compilation
:version "22.1")
(defface next-error
'((t (:inherit region)))
"Face used to highlight next error locus."
:group 'next-error
:version "22.1")
(defcustom next-error-highlight 0.5
"Highlighting of locations in the selected buffer.
If a number, highlight the locus in `next-error' face for the given time
in seconds, or until the next command is executed.
If t, highlight the locus until the next command is executed, or until
some other locus replaces it.
If nil, don't highlight the locus in the source buffer.
If `fringe-arrow', indicate the locus by the fringe arrow
indefinitely until some other locus replaces it.
See `next-error-highlight-no-select' to customize highlighting
of the locus in non-selected buffers."
:type '(choice (number :tag "Highlight for specified time")
(const :tag "Semipermanent highlighting" t)
(const :tag "No highlighting" nil)
(const :tag "Fringe arrow" fringe-arrow))
:group 'next-error
:version "22.1")
(defcustom next-error-highlight-no-select 0.5
"Highlighting of locations in non-selected source buffers.
Usually non-selected buffers are displayed by `next-error-no-select'.
If number, highlight the locus in `next-error' face for given time in seconds.
If t, highlight the locus indefinitely until some other locus replaces it.
If nil, don't highlight the locus in the source buffer.
If `fringe-arrow', indicate the locus by the fringe arrow
indefinitely until some other locus replaces it.
See `next-error-highlight' to customize highlighting of the locus
in the selected buffer."
:type '(choice (number :tag "Highlight for specified time")
(const :tag "Semipermanent highlighting" t)
(const :tag "No highlighting" nil)
(const :tag "Fringe arrow" fringe-arrow))
:group 'next-error
:version "22.1")
(defcustom next-error-recenter nil
"Display the line in the visited source file recentered as specified.
If non-nil, the value is passed directly to `recenter'."
:type '(choice (integer :tag "Line to recenter to")
(const :tag "Center of window" (4))
(const :tag "No recentering" nil))
:group 'next-error
:version "23.1")
(defcustom next-error-message-highlight nil
"If non-nil, highlight the current error message in the `next-error' buffer.
If the value is `keep', highlighting is permanent, so all visited error
messages are highlighted; this helps to see what messages were visited."
:type '(choice (const :tag "Highlight the current error" t)
(const :tag "Highlight all visited errors" keep)
(const :tag "No highlighting" nil))
:group 'next-error
:version "28.1")
(defface next-error-message
'((t (:inherit highlight :extend t)))
"Face used to highlight the current error message in the `next-error' buffer."
:group 'next-error
:version "28.1")
(defvar-local next-error--message-highlight-overlay
nil
"Overlay highlighting the current error message in the `next-error' buffer.")
(defvar global-minor-modes nil
"A list of the currently enabled global minor modes.
This is a list of symbols.")
(defcustom next-error-hook nil
"List of hook functions run by `next-error' after visiting source file."
:type 'hook
:group 'next-error)
(defcustom next-error-verbose t
"If non-nil, `next-error' always outputs the current error buffer.
If nil, the message is output only when the error buffer
changes."
:group 'next-error
:type 'boolean
:safe #'booleanp
:version "27.1")
(defvar next-error-highlight-timer nil)
(defvar next-error-overlay-arrow-position nil)
(put 'next-error-overlay-arrow-position 'overlay-arrow-string (purecopy "=>"))
(add-to-list 'overlay-arrow-variable-list 'next-error-overlay-arrow-position)
(defvar next-error-last-buffer nil
"The most recent `next-error' buffer.
A buffer becomes most recent when its compilation, grep, or
similar mode is started, or when it is used with \\[next-error]
or \\[compile-goto-error].")
(defvar-local next-error-buffer nil
"The buffer-local value of the most recent `next-error' buffer.")
;; next-error-buffer is made buffer-local to keep the reference
;; to the parent buffer used to navigate to the current buffer, so the
;; next call of next-buffer will use the same parent buffer to
;; continue navigation from it.
(defvar-local next-error-function nil
"Function to use to find the next error in the current buffer.
The function is called with 2 parameters:
ARG is an integer specifying by how many errors to move.
RESET is a boolean which, if non-nil, says to go back to the beginning
of the errors before moving.
Major modes providing compile-like functionality should set this variable
to indicate to `next-error' that this is a candidate buffer and how
to navigate in it.")
(defvar-local next-error-move-function nil
"Function to use to move to an error locus.
It takes two arguments, a buffer position in the error buffer
and a buffer position in the error locus buffer.
The buffer for the error locus should already be current.
nil means use `goto-char' using the second argument position.")
(defsubst next-error-buffer-p (buffer
&optional avoid-current
extra-test-inclusive
extra-test-exclusive)
"Return non-nil if BUFFER is a `next-error' capable buffer.
If AVOID-CURRENT is non-nil, and BUFFER is the current buffer,
return nil.
The function EXTRA-TEST-INCLUSIVE, if non-nil, is called if
BUFFER would not normally qualify. If it returns non-nil, BUFFER
is considered `next-error' capable, anyway, and the function
returns non-nil.
The function EXTRA-TEST-EXCLUSIVE, if non-nil, is called if the
buffer would normally qualify. If it returns nil, BUFFER is
rejected, and the function returns nil."
(and (buffer-name buffer) ;First make sure it's live.
(not (and avoid-current (eq buffer (current-buffer))))
(with-current-buffer buffer
(if next-error-function ; This is the normal test.
;; Optionally reject some buffers.
(if extra-test-exclusive
(funcall extra-test-exclusive)
t)
;; Optionally accept some other buffers.
(and extra-test-inclusive
(funcall extra-test-inclusive))))))
(defcustom next-error-find-buffer-function #'ignore
"Function called to find a `next-error' capable buffer.
This function takes the same three arguments as the function
`next-error-find-buffer', and should return the buffer to be
used by the subsequent invocation of the command `next-error'
and `previous-error'.
If the function returns nil, `next-error-find-buffer' will
try to use the buffer it used previously, and failing that
all other buffers."
:type '(choice (const :tag "No default" ignore)
(const :tag "Single next-error capable buffer on selected frame"
next-error-buffer-on-selected-frame)
(const :tag "Current buffer if next-error capable and outside navigation"
next-error-buffer-unnavigated-current)
(function :tag "Other function"))
:group 'next-error
:version "28.1")
(defun next-error-buffer-on-selected-frame (&optional _avoid-current
extra-test-inclusive
extra-test-exclusive)
"Return a single visible `next-error' buffer on the selected frame."
(let ((window-buffers
(delete-dups
(delq nil (mapcar (lambda (w)
(if (next-error-buffer-p
(window-buffer w)
t
extra-test-inclusive extra-test-exclusive)
(window-buffer w)))
(window-list))))))
(if (eq (length window-buffers) 1)
(car window-buffers))))
(defun next-error-buffer-unnavigated-current (&optional avoid-current
extra-test-inclusive
extra-test-exclusive)
"Try the current buffer when outside navigation.
But return nil if we navigated to the current buffer by the means
of `next-error' command. Otherwise, return it if it's `next-error'
capable."
;; Check that next-error-buffer has no buffer-local value
;; (i.e. we never navigated to the current buffer from another),
;; and the current buffer is a `next-error' capable buffer.
(if (and (not (local-variable-p 'next-error-buffer))
(next-error-buffer-p (current-buffer) avoid-current
extra-test-inclusive extra-test-exclusive))
(current-buffer)))
(defun next-error-find-buffer (&optional avoid-current
extra-test-inclusive
extra-test-exclusive)
"Return a `next-error' capable buffer.
If AVOID-CURRENT is non-nil, treat the current buffer
as an absolute last resort only.
The function EXTRA-TEST-INCLUSIVE, if non-nil, is called in each buffer
that normally would not qualify. If it returns t, the buffer
in question is treated as usable.
The function EXTRA-TEST-EXCLUSIVE, if non-nil, is called in each buffer
that would normally be considered usable. If it returns nil,
that buffer is rejected."
(or
;; 1. If a customizable function returns a buffer, use it.
(funcall next-error-find-buffer-function avoid-current
extra-test-inclusive
extra-test-exclusive)
;; 2. If next-error-last-buffer is an acceptable buffer, use that.
(if (and next-error-last-buffer
(next-error-buffer-p next-error-last-buffer avoid-current
extra-test-inclusive extra-test-exclusive))
next-error-last-buffer)
;; 3. If the current buffer is acceptable, choose it.
(if (next-error-buffer-p (current-buffer) avoid-current
extra-test-inclusive extra-test-exclusive)
(current-buffer))
;; 4. Look for any acceptable buffer.
(let ((buffers (buffer-list)))
(while (and buffers
(not (next-error-buffer-p
(car buffers) avoid-current
extra-test-inclusive extra-test-exclusive)))
(setq buffers (cdr buffers)))
(car buffers))
;; 5. Use the current buffer as a last resort if it qualifies,
;; even despite AVOID-CURRENT.
(and avoid-current
(next-error-buffer-p (current-buffer) nil
extra-test-inclusive extra-test-exclusive)
(progn
(message "This is the only buffer with error message locations")
(current-buffer)))
;; 6. Give up.
(error "No buffers contain error message locations")))
(defun next-error (&optional arg reset)
"Visit next `next-error' message and corresponding source code.
If all the error messages parsed so far have been processed already,
the message buffer is checked for new ones.
A prefix ARG specifies how many error messages to move;
negative means move back to previous error messages.
Just \\[universal-argument] as a prefix means reparse the error message buffer
and start at the first error.
The RESET argument specifies that we should restart from the beginning.
\\[next-error] normally uses the most recently started
compilation, grep, or occur buffer. It can also operate on any
buffer with output from the \\[compile], \\[grep] commands, or,
more generally, on any buffer in Compilation mode or with
Compilation Minor mode enabled, or any buffer in which
`next-error-function' is bound to an appropriate function.
To specify use of a particular buffer for error messages, type
\\[next-error] in that buffer. You can also use the command
`next-error-select-buffer' to select the buffer to use for the subsequent
invocation of `next-error'.
Once \\[next-error] has chosen the buffer for error messages, it
runs `next-error-hook' with `run-hooks', and stays with that buffer
until you use it in some other buffer that uses Compilation mode
or Compilation Minor mode.
To control which errors are matched, customize the variable
`compilation-error-regexp-alist'."
(interactive "P")
(if (consp arg) (setq reset t arg nil))
(let ((buffer (next-error-find-buffer)))
(when buffer
;; We know here that next-error-function is a valid symbol we can funcall
(with-current-buffer buffer
(funcall next-error-function (prefix-numeric-value arg) reset)
(let ((prev next-error-last-buffer))
(next-error-found buffer (current-buffer))
(when (or next-error-verbose
(not (eq prev next-error-last-buffer)))
(message "%s locus from %s"
(cond (reset "First")
((eq (prefix-numeric-value arg) 0) "Current")
((< (prefix-numeric-value arg) 0) "Previous")
(t "Next"))
next-error-last-buffer)))))))
(defun next-error-internal ()
"Visit the source code corresponding to the `next-error' message at point."
(let ((buffer (current-buffer)))
;; We know here that next-error-function is a valid symbol we can funcall
(funcall next-error-function 0 nil)
(let ((prev next-error-last-buffer))
(next-error-found buffer (current-buffer))
(when (or next-error-verbose
(not (eq prev next-error-last-buffer)))
(message "Current locus from %s" next-error-last-buffer)))))
(defun next-error-quit-window (from-buffer to-buffer)
"Quit window of FROM-BUFFER when the prefix arg is 0.
Intended to be used in `next-error-found-function'."
(when (and (eq current-prefix-arg 0) from-buffer
(not (eq from-buffer to-buffer)))
(let ((window (get-buffer-window from-buffer)))
(when (window-live-p window)
(quit-restore-window window)))))
(defcustom next-error-found-function #'ignore
"Function called when a next locus is found and displayed.
Function is called with two arguments: a FROM-BUFFER buffer
from which `next-error' navigated, and a target buffer TO-BUFFER."
:type '(choice (const :tag "No default" ignore)
(const :tag "Quit previous window with M-0"
next-error-quit-window)
(function :tag "Other function"))
:group 'next-error
:version "27.1")
(defun next-error-found (&optional from-buffer to-buffer)
"Function to call when the next locus is found and displayed.
FROM-BUFFER is a buffer from which `next-error' navigated,
and TO-BUFFER is a target buffer."
(setq next-error-last-buffer (or from-buffer (current-buffer)))
(when to-buffer
(with-current-buffer to-buffer
(setq next-error-buffer from-buffer)))
(when next-error-recenter
(recenter next-error-recenter))
(funcall next-error-found-function from-buffer to-buffer)
(next-error-message-highlight from-buffer)
(run-hooks 'next-error-hook))
(defun next-error-select-buffer (buffer)
"Select a `next-error' capable BUFFER and set it as the last used.
This means that the selected buffer becomes the source of locations
for the subsequent invocation of `next-error' or `previous-error'.
Interactively, this command allows selection only among buffers
where `next-error-function' is bound to an appropriate function."
(interactive
(list (get-buffer
(read-buffer "Select next-error buffer: " nil nil
(lambda (b) (next-error-buffer-p (cdr b)))))))
(setq next-error-last-buffer buffer))
(defalias 'goto-next-locus 'next-error)
(defalias 'next-match 'next-error)
(defun previous-error (&optional n)
"Visit previous `next-error' message and corresponding source code.
Prefix arg N says how many error messages to move backwards (or
forwards, if negative).
This operates on the output from the \\[compile] and \\[grep] commands.
See `next-error' for the details."
(interactive "p")
(next-error (- (or n 1))))
(defun first-error (&optional n)
"Restart at the first error.
Visit corresponding source code.
With prefix arg N, visit the source code of the Nth error.
This operates on the output from the \\[compile] command, for instance."
(interactive "p")
(next-error n t))
(defun next-error-no-select (&optional n)
"Move point to the next error in the `next-error' buffer and highlight match.
Prefix arg N says how many error messages to move forwards (or
backwards, if negative).
Finds and highlights the source line like \\[next-error], but does not
select the source buffer."
(interactive "p")
(save-selected-window
(let ((next-error-highlight next-error-highlight-no-select)
(display-buffer-overriding-action
'(nil (inhibit-same-window . t))))
(next-error n))))
(defun previous-error-no-select (&optional n)
"Move point to the previous error in the `next-error' buffer and highlight match.
Prefix arg N says how many error messages to move backwards (or
forwards, if negative).
Finds and highlights the source line like \\[previous-error], but does not
select the source buffer."
(interactive "p")
(next-error-no-select (- (or n 1))))
;; Internal variable for `next-error-follow-mode-post-command-hook'.
(defvar next-error-follow-last-line nil)
(define-minor-mode next-error-follow-minor-mode
"Minor mode for compilation, occur and diff modes.
When turned on, cursor motion in the compilation, grep, occur or diff
buffer causes automatic display of the corresponding source code location."
:group 'next-error :init-value nil :lighter " Fol"
(if (not next-error-follow-minor-mode)
(remove-hook 'post-command-hook 'next-error-follow-mode-post-command-hook t)
(add-hook 'post-command-hook 'next-error-follow-mode-post-command-hook nil t)
(make-local-variable 'next-error-follow-last-line)))
;; Used as a `post-command-hook' by `next-error-follow-mode'
;; for the *Compilation* *grep* and *Occur* buffers.
(defun next-error-follow-mode-post-command-hook ()
(unless (equal next-error-follow-last-line (line-number-at-pos))
(setq next-error-follow-last-line (line-number-at-pos))
(condition-case nil
(let ((compilation-context-lines nil))
(setq compilation-current-error (point))
(next-error-no-select 0))
(error t))))
(defun next-error-message-highlight (error-buffer)
"Highlight the current error message in the `next-error' buffer."
(when next-error-message-highlight
(with-current-buffer error-buffer
(when (and next-error--message-highlight-overlay
(not (eq next-error-message-highlight 'keep)))
(delete-overlay next-error--message-highlight-overlay))
(let ((ol (make-overlay (line-beginning-position) (1+ (line-end-position)))))
;; do not override region highlighting
(overlay-put ol 'priority -50)
(overlay-put ol 'face 'next-error-message)
(overlay-put ol 'window (get-buffer-window))
(setf next-error--message-highlight-overlay ol)))))
(defun recenter-current-error (&optional arg)
"Recenter the current displayed error in the `next-error' buffer."
(interactive "P")
(save-selected-window
(let ((next-error-highlight next-error-highlight-no-select)
(display-buffer-overriding-action
'(nil (inhibit-same-window . t))))
(next-error 0)
(set-buffer (window-buffer))
(recenter-top-bottom arg))))
;;;
(defun fundamental-mode ()
"Major mode not specialized for anything in particular.
Other major modes are defined by comparison with this one."
(interactive)
(kill-all-local-variables)
(run-mode-hooks))
(define-derived-mode clean-mode fundamental-mode "Clean"
"A mode that removes all overlays and text properties."
(kill-all-local-variables t)
(let ((inhibit-read-only t))
(dolist (overlay (overlays-in (point-min) (point-max)))
(delete-overlay overlay))
(set-text-properties (point-min) (point-max) nil)
(setq-local yank-excluded-properties t)))
;; Special major modes to view specially formatted data rather than files.
(defvar-keymap special-mode-map
:suppress t
"q" #'quit-window
"SPC" #'scroll-up-command
"S-SPC" #'scroll-down-command
"DEL" #'scroll-down-command
"?" #'describe-mode
"h" #'describe-mode
">" #'end-of-buffer
"<" #'beginning-of-buffer
"g" #'revert-buffer)
(put 'special-mode 'mode-class 'special)
(define-derived-mode special-mode nil "Special"
"Parent major mode from which special major modes should inherit.
A special major mode is intended to view specially formatted data
rather than files. These modes usually use read-only buffers."
(setq buffer-read-only t))
;; Making and deleting lines.
(defvar self-insert-uses-region-functions nil
"Special hook to tell if `self-insert-command' will use the region.
It must be called via `run-hook-with-args-until-success' with no arguments.
If any function on this hook returns a non-nil value, `delete-selection-mode'
will act on that value (see `delete-selection-helper') and will
usually delete the region. If all the functions on this hook return
nil, it is an indication that `self-insert-command' needs the region
untouched by `delete-selection-mode' and will itself do whatever is
appropriate with the region.
Any function on `post-self-insert-hook' that acts on the region should
add a function to this hook so that `delete-selection-mode' could
refrain from deleting the region before the `post-self-insert-hook'
functions are called.
This hook is run by `delete-selection-uses-region-p', which see.")
(defvar hard-newline (propertize "\n" 'hard t 'rear-nonsticky '(hard))
"Propertized string representing a hard newline character.")
(defun newline (&optional arg interactive)
"Insert a newline, and move to left margin of the new line.
With prefix argument ARG, insert that many newlines.
If `electric-indent-mode' is enabled, this indents the final new line
that it adds, and reindents the preceding line. To just insert
a newline, use \\[electric-indent-just-newline].
If `auto-fill-mode' is enabled, this may cause automatic line
breaking of the preceding line. A non-nil ARG inhibits this.
If `use-hard-newlines' is enabled, the newline is marked with the
text-property `hard'.
A non-nil INTERACTIVE argument means to run the `post-self-insert-hook'."
(interactive "*P\np")
(barf-if-buffer-read-only)
(when (and arg
(< (prefix-numeric-value arg) 0))
(error "Repetition argument has to be non-negative"))
;; Call self-insert so that auto-fill, abbrev expansion etc. happen.
;; Set last-command-event to tell self-insert what to insert.
(let* ((was-page-start (and (bolp) (looking-at page-delimiter)))
(beforepos (point))
(last-command-event ?\n)
;; Don't auto-fill if we have a prefix argument.
(auto-fill-function (if arg nil auto-fill-function))
(arg (prefix-numeric-value arg))
(procsym (make-symbol "newline-postproc")) ;(bug#46326)
(postproc
;; Do the rest in post-self-insert-hook, because we want to do it
;; *before* other functions on that hook.
(lambda ()
(remove-hook 'post-self-insert-hook procsym t)
;; Mark the newline(s) `hard'.
(if use-hard-newlines
(set-hard-newline-properties
(- (point) arg) (point)))
;; If the newline leaves the previous line blank, and we
;; have a left margin, delete that from the blank line.
(save-excursion
(goto-char beforepos)
(beginning-of-line)
(and (looking-at "[ \t]+$")
(> (current-left-margin) 0)
(delete-region (point)
(line-end-position))))
;; Indent the line after the newline, except in one case:
;; when we added the newline at the beginning of a line that
;; starts a page.
(or was-page-start
(move-to-left-margin nil t)))))
(fset procsym postproc)
(if (not interactive)
;; FIXME: For non-interactive uses, many calls actually
;; just want (insert "\n"), so maybe we should do just
;; that, so as to avoid the risk of filling or running
;; abbrevs unexpectedly.
(let ((post-self-insert-hook (list postproc)))
(self-insert-command arg))
(unwind-protect
(progn
(add-hook 'post-self-insert-hook procsym nil t)
(self-insert-command arg))
;; We first used let-binding to protect the hook, but that
;; was naive since add-hook affects the symbol-default
;; value of the variable, whereas the let-binding might
;; protect only the buffer-local value.
(remove-hook 'post-self-insert-hook procsym t))))
nil)
(defun set-hard-newline-properties (from to)
(let ((sticky (get-text-property from 'rear-nonsticky)))
(put-text-property from to 'hard 't)
;; If rear-nonsticky is not "t", add 'hard to rear-nonsticky list
(if (and (listp sticky) (not (memq 'hard sticky)))
(put-text-property from (point) 'rear-nonsticky
(cons 'hard sticky)))))
(defun open-line (n)
"Insert a newline and leave point before it.
If there is a fill prefix and/or a `left-margin', insert them on
the new line if the line would have been blank.
With arg N, insert N newlines."
(interactive "*p")
(let* ((do-fill-prefix (and fill-prefix (bolp)))
(do-left-margin (and (bolp) (> (current-left-margin) 0)))
(loc (point-marker))
;; Don't expand an abbrev before point.
(abbrev-mode nil))
(newline n)
(goto-char loc)
(while (> n 0)
(cond ((bolp)
(if do-left-margin (indent-to (current-left-margin)))
(if do-fill-prefix (insert-and-inherit fill-prefix))))
(forward-line 1)
(setq n (1- n)))
(goto-char loc)
;; Necessary in case a margin or prefix was inserted.
(end-of-line)))
(defun split-line (&optional arg)
"Split current line, moving portion beyond point vertically down.
If the current line starts with `fill-prefix', insert it on the new
line as well. With prefix ARG, don't insert `fill-prefix' on new line.
When called from Lisp code, ARG may be a prefix string to copy."
(interactive "*P")
(skip-chars-forward " \t")
(let* ((col (current-column))
(pos (point))
;; What prefix should we check for (nil means don't).
(prefix (cond ((stringp arg) arg)
(arg nil)
(t fill-prefix)))
;; Does this line start with it?
(have-prfx (and prefix
(save-excursion
(beginning-of-line)
(looking-at (regexp-quote prefix))))))
(newline 1)
(if have-prfx (insert-and-inherit prefix))
(indent-to col 0)
(goto-char pos)))
(defface separator-line
'((((type graphic) (background dark))
:height 0.1 :background "#505050")
(((type graphic) (background light))
:height 0.1 :background "#a0a0a0")
(t
:foreground "ForestGreen" :underline t))
"Face for separator lines."
:version "29.1"
:group 'text)
(defun make-separator-line (&optional length)
"Make a string appropriate for usage as a visual separator line.
This uses the `separator-line' face.
If LENGTH is nil, use the window width."
(if (or (display-graphic-p)
(display-supports-face-attributes-p '(:underline t)))
(if length
(concat (propertize (make-string length ?\s) 'face 'separator-line)
"\n")
(propertize "\n" 'face '(:inherit separator-line :extend t)))
;; In terminals (that don't support underline), use a line of dashes.
(concat (propertize (make-string (or length (1- (window-width))) ?-)
'face 'separator-line)
"\n")))
(defun delete-indentation (&optional arg beg end)
"Join this line to previous and fix up whitespace at join.
If there is a fill prefix, delete it from the beginning of this
line.
With prefix ARG, join the current line to the following line.
When BEG and END are non-nil, join all lines in the region they
define. Interactively, BEG and END are, respectively, the start
and end of the region if it is active, else nil. (The region is
ignored if prefix ARG is given.)"
(interactive
(progn (barf-if-buffer-read-only)
(cons current-prefix-arg
(and (use-region-p)
(list (region-beginning) (region-end))))))
;; Consistently deactivate mark even when no text is changed.
(setq deactivate-mark t)
(if (and beg (not arg))
;; Region is active. Go to END, but only if region spans
;; multiple lines.
(and (goto-char beg)
(> end (line-end-position))
(goto-char end))
;; Region is inactive. Set a loop sentinel
;; (subtracting 1 in order to compare less than BOB).
(setq beg (1- (line-beginning-position (and arg 2))))
(when arg (forward-line)))
(let ((prefix (and (> (length fill-prefix) 0)
(regexp-quote fill-prefix))))
(while (and (> (line-beginning-position) beg)
(forward-line 0)
(= (preceding-char) ?\n))
(delete-char -1)
;; If the appended line started with the fill prefix,
;; delete the prefix.
(if (and prefix (looking-at prefix))
(replace-match "" t t))
(fixup-whitespace))))
(defalias 'join-line #'delete-indentation) ; easier to find
(defun delete-blank-lines ()
"On blank line, delete all surrounding blank lines, leaving just one.
On isolated blank line, delete that one.
On nonblank line, delete any immediately following blank lines."
(interactive "*")
(let (thisblank singleblank)
(save-excursion
(beginning-of-line)
(setq thisblank (looking-at "[ \t]*$"))
;; Set singleblank if there is just one blank line here.
(setq singleblank
(and thisblank
(not (looking-at "[ \t]*\n[ \t]*$"))
(or (bobp)
(progn (forward-line -1)
(not (looking-at "[ \t]*$")))))))
;; Delete preceding blank lines, and this one too if it's the only one.
(if thisblank
(progn
(beginning-of-line)
(if singleblank (forward-line 1))
(delete-region (point)
(if (re-search-backward "[^ \t\n]" nil t)
(progn (forward-line 1) (point))
(point-min)))))
;; Delete following blank lines, unless the current line is blank
;; and there are no following blank lines.
(if (not (and thisblank singleblank))
(save-excursion
(end-of-line)
(forward-line 1)
(delete-region (point)
(if (re-search-forward "[^ \t\n]" nil t)
(progn (beginning-of-line) (point))
(point-max)))))
;; Handle the special case where point is followed by newline and eob.
;; Delete the line, leaving point at eob.
(if (looking-at "^[ \t]*\n\\'")
(delete-region (point) (point-max)))))
(defcustom delete-trailing-lines t
"If non-nil, \\[delete-trailing-whitespace] deletes trailing lines.
Trailing lines are deleted only if `delete-trailing-whitespace'
is called on the entire buffer (rather than an active region)."
:type 'boolean
:group 'editing
:version "24.3")
(defun region-modifiable-p (start end)
"Return non-nil if the region contains no read-only text."
(and (not (get-text-property start 'read-only))
(eq end (next-single-property-change start 'read-only nil end))))
(defun delete-trailing-whitespace (&optional start end)
"Delete trailing whitespace between START and END.
If called interactively, START and END are the start/end of the
region if the mark is active, or of the buffer's accessible
portion if the mark is inactive.
This command deletes whitespace characters after the last
non-whitespace character in each line between START and END. It
does not consider formfeed characters to be whitespace.
If this command acts on the entire buffer (i.e. if called
interactively with the mark inactive, or called from Lisp with
END nil), it also deletes all trailing lines at the end of the
buffer if the variable `delete-trailing-lines' is non-nil."
(interactive (progn
(barf-if-buffer-read-only)
(if (use-region-p)
(list (region-beginning) (region-end))
(list nil nil))))
(save-match-data
(save-excursion
(let ((end-marker (and end (copy-marker end))))
(goto-char (or start (point-min)))
(with-syntax-table (make-syntax-table (syntax-table))
;; Don't delete formfeeds, even if they are considered whitespace.
(modify-syntax-entry ?\f "_")
(while (re-search-forward "\\s-$" end-marker t)
(skip-syntax-backward "-" (line-beginning-position))
(let ((b (point)) (e (match-end 0)))
(if (region-modifiable-p b e)
(delete-region b e)
(goto-char e)))))
(if end
(set-marker end-marker nil)
;; Delete trailing empty lines.
(and delete-trailing-lines
;; Really the end of buffer.
(= (goto-char (point-max)) (1+ (buffer-size)))
(<= (skip-chars-backward "\n") -2)
(region-modifiable-p (1+ (point)) (point-max))
(delete-region (1+ (point)) (point-max)))))))
;; Return nil for the benefit of `write-file-functions'.
nil)
(defun newline-and-indent (&optional arg)
"Insert a newline, then indent according to major mode.
Indentation is done using the value of `indent-line-function'.
In programming language modes, this is the same as TAB.
In some text modes, where TAB inserts a tab, this command indents to the
column specified by the function `current-left-margin'.
With ARG, perform this action that many times.
Also see `open-line' (bound to \\[open-line]) for a command that
just inserts a newline without doing any indentation."
(interactive "*p")
(delete-horizontal-space t)
(unless arg
(setq arg 1))
(let ((electric-indent-mode nil))
(dotimes (_ arg)
(newline nil t)
(indent-according-to-mode))))
(defun reindent-then-newline-and-indent ()
"Reindent current line, insert newline, then indent the new line.
Indentation of both lines is done according to the current major mode,
which means calling the current value of `indent-line-function'.
In programming language modes, this is the same as TAB.
In some text modes, where TAB inserts a tab, this indents to the
column specified by the function `current-left-margin'."
(interactive "*")
(let ((pos (point))
(electric-indent-mode nil))
;; Be careful to insert the newline before indenting the line.
;; Otherwise, the indentation might be wrong.
(newline)
(save-excursion
(goto-char pos)
;; We are at EOL before the call to indent-according-to-mode, and
;; after it we usually are as well, but not always. We tried to
;; address it with `save-excursion' but that uses a normal marker
;; whereas we need `move after insertion', so we do the save/restore
;; by hand.
(setq pos (copy-marker pos t))
(indent-according-to-mode)
(goto-char pos)
;; Remove the trailing white-space after indentation because
;; indentation may introduce the whitespace.
(delete-horizontal-space t))
(indent-according-to-mode)))
(defcustom read-quoted-char-radix 8
"Radix for \\[quoted-insert] and other uses of `read-quoted-char'.
Supported radix values are 8, 10 and 16."
:type '(choice (const 8) (const 10) (const 16))
:group 'editing-basics)
(defun read-quoted-char (&optional prompt)
"Like `read-char', but do not allow quitting.
Also, if the first character read is an octal digit,
we read any number of octal digits and return the
specified character code. Any nondigit terminates the sequence.
If the terminator is RET, it is discarded;
any other terminator is used itself as input.
The optional argument PROMPT specifies a string to use to prompt the user.
The variable `read-quoted-char-radix' controls which radix to use
for numeric input."
(let ((message-log-max nil)
(help-events (delq nil (mapcar (lambda (c) (unless (characterp c) c))
help-event-list)))
done (first t) (code 0) char translated)
(while (not done)
(let ((inhibit-quit first)
;; Don't let C-h or other help chars get the help
;; message--only help function keys. See bug#16617.
(help-char nil)
(help-event-list help-events)
(help-form
"Type the special character you want to use,
or the octal character code.
RET terminates the character code and is discarded;
any other non-digit terminates the character code and is then used as input."))
(setq char (read-event (and prompt (format "%s-" prompt)) t))
(if inhibit-quit (setq quit-flag nil)))
;; Translate TAB key into control-I ASCII character, and so on.
;; Note: `read-char' does it using the `ascii-character' property.
;; We tried using read-key instead, but that disables the keystroke
;; echo produced by 'C-q', see bug#24635.
(let ((translation (lookup-key local-function-key-map (vector char))))
(setq translated (if (arrayp translation)
(aref translation 0)
char)))
(if (integerp translated)
(setq translated (char-resolve-modifiers translated)))
(cond ((null translated))
((not (integerp translated))
(setq unread-command-events (list char)
done t))
((/= (logand translated ?\M-\^@) 0)
;; Turn a meta-character into a character with the 0200 bit set.
(setq code (logior (logand translated (lognot ?\M-\^@)) 128)
done t))
((and (<= ?0 translated)
(< translated (+ ?0 (min 10 read-quoted-char-radix))))
(setq code (+ (* code read-quoted-char-radix) (- translated ?0)))
(and prompt (setq prompt (message "%s %c" prompt translated))))
((and (<= ?a (downcase translated))
(< (downcase translated)
(+ ?a -10 (min 36 read-quoted-char-radix))))
(setq code (+ (* code read-quoted-char-radix)
(+ 10 (- (downcase translated) ?a))))
(and prompt (setq prompt (message "%s %c" prompt translated))))
((and (not first) (eq translated ?\C-m))