-
-
Notifications
You must be signed in to change notification settings - Fork 39
/
simple.el
3094 lines (2827 loc) · 114 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
;; Copyright (C) 1985, 86, 87, 93, 94, 95 Free Software Foundation, Inc.
;; 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 2, 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; see the file COPYING. If not, write to the
;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.
;;; Commentary:
;; A grab-bag of basic Emacs commands not specifically related to some
;; major mode or to file-handling.
;;; Code:
(defun newline (&optional arg)
"Insert a newline, and move to left margin of the new line if it's blank.
The newline is marked with the text-property `hard'.
With arg, insert that many newlines.
In Auto Fill mode, if no numeric arg, break the preceding line if it's long."
(interactive "*P")
(barf-if-buffer-read-only)
;; Inserting a newline at the end of a line produces better redisplay in
;; try_window_id than inserting at the beginning of a line, and the textual
;; result is the same. So, if we're at beginning of line, pretend to be at
;; the end of the previous line.
(let ((flag (and (not (bobp))
(bolp)
(< (or (previous-property-change (point)) -2)
(- (point) 2))))
(was-page-start (and (bolp)
(looking-at page-delimiter)))
(beforepos (point)))
(if flag (backward-char 1))
;; Call self-insert so that auto-fill, abbrev expansion etc. happens.
;; Set last-command-char to tell self-insert what to insert.
(let ((last-command-char ?\n)
;; Don't auto-fill if we have a numeric argument.
;; Also not if flag is true (it would fill wrong line);
;; there is no need to since we're at BOL.
(auto-fill-function (if (or arg flag) nil auto-fill-function)))
(unwind-protect
(self-insert-command (prefix-numeric-value arg))
;; If we get an error in self-insert-command, put point at right place.
(if flag (forward-char 1))))
;; If we did *not* get an error, cancel that forward-char.
(if flag (backward-char 1))
;; Mark the newline(s) `hard'.
(if use-hard-newlines
(let* ((from (- (point) (if arg (prefix-numeric-value arg) 1)))
(sticky (get-text-property from 'rear-nonsticky)))
(put-text-property from (point) '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)))))
;; If the newline leaves the previous line blank,
;; and we have a left margin, delete that from the blank line.
(or flag
(save-excursion
(goto-char beforepos)
(beginning-of-line)
(and (looking-at "[ \t]$")
(> (current-left-margin) 0)
(delete-region (point) (progn (end-of-line) (point))))))
(if flag (forward-char 1))
;; Indent the line after the newline, except in one case:
;; when we added the newline at the beginning of a line
;; which starts a page.
(or was-page-start
(move-to-left-margin nil t)))
nil)
(defun open-line (arg)
"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)))
(newline arg)
(goto-char loc)
(while (> arg 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 arg (1- arg)))
(goto-char loc)
(end-of-line)))
(defun split-line ()
"Split current line, moving portion beyond point vertically down."
(interactive "*")
(skip-chars-forward " \t")
(let ((col (current-column))
(pos (point)))
(newline 1)
(indent-to col 0)
(goto-char pos)))
(defun quoted-insert (arg)
"Read next input character and insert it.
This is useful for inserting control characters.
You may also type up to 3 octal digits, to insert a character with that code.
In overwrite mode, this function inserts the character anyway, and
does not handle octal digits specially. This means that if you use
overwrite as your normal editing mode, you can use this function to
insert characters when necessary.
In binary overwrite mode, this function does overwrite, and octal
digits are interpreted as a character code. This is supposed to make
this function useful in editing binary files."
(interactive "*p")
(let ((char (if (or (not overwrite-mode)
(eq overwrite-mode 'overwrite-mode-binary))
(read-quoted-char)
(read-char))))
(if (> arg 0)
(if (eq overwrite-mode 'overwrite-mode-binary)
(delete-char arg)))
(while (> arg 0)
(insert-and-inherit char)
(setq arg (1- arg)))))
(defun delete-indentation (&optional arg)
"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 argument, join this line to following line."
(interactive "*P")
(beginning-of-line)
(if arg (forward-line 1))
(if (eq (preceding-char) ?\n)
(progn
(delete-region (point) (1- (point)))
;; If the second line started with the fill prefix,
;; delete the prefix.
(if (and fill-prefix
(<= (+ (point) (length fill-prefix)) (point-max))
(string= fill-prefix
(buffer-substring (point)
(+ (point) (length fill-prefix)))))
(delete-region (point) (+ (point) (length fill-prefix))))
(fixup-whitespace))))
(defun fixup-whitespace ()
"Fixup white space between objects around point.
Leave one space or none, according to the context."
(interactive "*")
(save-excursion
(delete-horizontal-space)
(if (or (looking-at "^\\|\\s)")
(save-excursion (forward-char -1)
(looking-at "$\\|\\s(\\|\\s'")))
nil
(insert ?\ ))))
(defun delete-horizontal-space ()
"Delete all spaces and tabs around point."
(interactive "*")
(skip-chars-backward " \t")
(delete-region (point) (progn (skip-chars-forward " \t") (point))))
(defun just-one-space ()
"Delete all spaces and tabs around point, leaving one space."
(interactive "*")
(skip-chars-backward " \t")
(if (= (following-char) ? )
(forward-char 1)
(insert ? ))
(delete-region (point) (progn (skip-chars-forward " \t") (point))))
(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)))))
(defun back-to-indentation ()
"Move point to the first non-whitespace character on this line."
(interactive)
(beginning-of-line 1)
(skip-chars-forward " \t"))
(defun newline-and-indent ()
"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'."
(interactive "*")
(delete-region (point) (progn (skip-chars-backward " \t") (point)))
(newline)
(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 "*")
(save-excursion
(delete-region (point) (progn (skip-chars-backward " \t") (point)))
(indent-according-to-mode))
(newline)
(indent-according-to-mode))
;; Internal subroutine of delete-char
(defun kill-forward-chars (arg)
(if (listp arg) (setq arg (car arg)))
(if (eq arg '-) (setq arg -1))
(kill-region (point) (+ (point) arg)))
;; Internal subroutine of backward-delete-char
(defun kill-backward-chars (arg)
(if (listp arg) (setq arg (car arg)))
(if (eq arg '-) (setq arg -1))
(kill-region (point) (- (point) arg)))
(defun backward-delete-char-untabify (arg &optional killp)
"Delete characters backward, changing tabs into spaces.
Delete ARG chars, and kill (save in kill ring) if KILLP is non-nil.
Interactively, ARG is the prefix arg (default 1)
and KILLP is t if a prefix arg was specified."
(interactive "*p\nP")
(let ((count arg))
(save-excursion
(while (and (> count 0) (not (bobp)))
(if (= (preceding-char) ?\t)
(let ((col (current-column)))
(forward-char -1)
(setq col (- col (current-column)))
(insert-char ?\ col)
(delete-char 1)))
(forward-char -1)
(setq count (1- count)))))
(delete-backward-char arg killp))
(defun zap-to-char (arg char)
"Kill up to and including ARG'th occurrence of CHAR.
Goes backward if ARG is negative; error if CHAR not found."
(interactive "p\ncZap to char: ")
(kill-region (point) (progn
(search-forward (char-to-string char) nil nil arg)
; (goto-char (if (> arg 0) (1- (point)) (1+ (point))))
(point))))
(defun beginning-of-buffer (&optional arg)
"Move point to the beginning of the buffer; leave mark at previous position.
With arg N, put point N/10 of the way from the beginning.
If the buffer is narrowed, this command uses the beginning and size
of the accessible part of the buffer.
Don't use this command in Lisp programs!
\(goto-char (point-min)) is faster and avoids clobbering the mark."
(interactive "P")
(push-mark)
(let ((size (- (point-max) (point-min))))
(goto-char (if arg
(+ (point-min)
(if (> size 10000)
;; Avoid overflow for large buffer sizes!
(* (prefix-numeric-value arg)
(/ size 10))
(/ (+ 10 (* size (prefix-numeric-value arg))) 10)))
(point-min))))
(if arg (forward-line 1)))
(defun end-of-buffer (&optional arg)
"Move point to the end of the buffer; leave mark at previous position.
With arg N, put point N/10 of the way from the end.
If the buffer is narrowed, this command uses the beginning and size
of the accessible part of the buffer.
Don't use this command in Lisp programs!
\(goto-char (point-max)) is faster and avoids clobbering the mark."
(interactive "P")
(push-mark)
(let ((size (- (point-max) (point-min))))
(goto-char (if arg
(- (point-max)
(if (> size 10000)
;; Avoid overflow for large buffer sizes!
(* (prefix-numeric-value arg)
(/ size 10))
(/ (* size (prefix-numeric-value arg)) 10)))
(point-max))))
;; If we went to a place in the middle of the buffer,
;; adjust it to the beginning of a line.
(if arg (forward-line 1)
;; If the end of the buffer is not already on the screen,
;; then scroll specially to put it near, but not at, the bottom.
(if (let ((old-point (point)))
(save-excursion
(goto-char (window-start))
(vertical-motion (window-height))
(< (point) old-point)))
(progn
(overlay-recenter (point))
(recenter -3)))))
(defun mark-whole-buffer ()
"Put point at beginning and mark at end of buffer.
You probably should not use this function in Lisp programs;
it is usually a mistake for a Lisp function to use any subroutine
that uses or sets the mark."
(interactive)
(push-mark (point))
(push-mark (point-max) nil t)
(goto-char (point-min)))
(defun count-lines-region (start end)
"Print number of lines and characters in the region."
(interactive "r")
(message "Region has %d lines, %d characters"
(count-lines start end) (- end start)))
(defun what-line ()
"Print the current buffer line number and narrowed line number of point."
(interactive)
(let ((opoint (point)) start)
(save-excursion
(save-restriction
(goto-char (point-min))
(widen)
(beginning-of-line)
(setq start (point))
(goto-char opoint)
(beginning-of-line)
(if (/= start 1)
(message "line %d (narrowed line %d)"
(1+ (count-lines 1 (point)))
(1+ (count-lines start (point))))
(message "Line %d" (1+ (count-lines 1 (point)))))))))
(defun count-lines (start end)
"Return number of lines between START and END.
This is usually the number of newlines between them,
but can be one more if START is not equal to END
and the greater of them is not at the start of a line."
(save-excursion
(save-restriction
(narrow-to-region start end)
(goto-char (point-min))
(if (eq selective-display t)
(save-match-data
(let ((done 0))
(while (re-search-forward "[\n\C-m]" nil t 40)
(setq done (+ 40 done)))
(while (re-search-forward "[\n\C-m]" nil t 1)
(setq done (+ 1 done)))
(goto-char (point-max))
(if (and (/= start end)
(not (bolp)))
(1+ done)
done)))
(- (buffer-size) (forward-line (buffer-size)))))))
(defun what-cursor-position ()
"Print info on cursor position (on screen and within buffer)."
(interactive)
(let* ((char (following-char))
(beg (point-min))
(end (point-max))
(pos (point))
(total (buffer-size))
(percent (if (> total 50000)
;; Avoid overflow from multiplying by 100!
(/ (+ (/ total 200) (1- pos)) (max (/ total 100) 1))
(/ (+ (/ total 2) (* 100 (1- pos))) (max total 1))))
(hscroll (if (= (window-hscroll) 0)
""
(format " Hscroll=%d" (window-hscroll))))
(col (current-column)))
(if (= pos end)
(if (or (/= beg 1) (/= end (1+ total)))
(message "point=%d of %d(%d%%) <%d - %d> column %d %s"
pos total percent beg end col hscroll)
(message "point=%d of %d(%d%%) column %d %s"
pos total percent col hscroll))
(if (or (/= beg 1) (/= end (1+ total)))
(message "Char: %s (0%o, %d, 0x%x) point=%d of %d(%d%%) <%d - %d> column %d %s"
(single-key-description char) char char char pos total percent beg end col hscroll)
(message "Char: %s (0%o, %d, 0x%x) point=%d of %d(%d%%) column %d %s"
(single-key-description char) char char char pos total percent col hscroll)))))
(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))
(defvar read-expression-map (cons 'keymap minibuffer-local-map)
"Minibuffer keymap used for reading Lisp expressions.")
(define-key read-expression-map "\M-\t" 'lisp-complete-symbol)
(put 'eval-expression 'disabled t)
(defvar read-expression-history nil)
;; We define this, rather than making `eval' interactive,
;; for the sake of completion of names like eval-region, eval-current-buffer.
(defun eval-expression (expression)
"Evaluate EXPRESSION and print value in minibuffer.
Value is also consed on to front of the variable `values'."
(interactive
(list (read-from-minibuffer "Eval: "
nil read-expression-map t
'read-expression-history)))
(setq values (cons (eval expression) values))
(prin1 (car values) t))
(defun edit-and-eval-command (prompt command)
"Prompting with PROMPT, let user edit COMMAND and eval result.
COMMAND is a Lisp expression. Let user edit that expression in
the minibuffer, then read and evaluate the result."
(let ((command (read-from-minibuffer prompt
(prin1-to-string command)
read-expression-map t
'(command-history . 1))))
;; If command was added to command-history as a string,
;; get rid of that. We want only evaluable expressions there.
(if (stringp (car command-history))
(setq command-history (cdr command-history)))
;; If command to be redone does not match front of history,
;; add it to the history.
(or (equal command (car command-history))
(setq command-history (cons command command-history)))
(eval command)))
(defun repeat-complex-command (arg)
"Edit and re-evaluate last complex command, or ARGth from last.
A complex command is one which used the minibuffer.
The command is placed in the minibuffer as a Lisp form for editing.
The result is executed, repeating the command as changed.
If the command has been changed or is not the most recent previous command
it is added to the front of the command history.
You can use the minibuffer history commands \\<minibuffer-local-map>\\[next-history-element] and \\[previous-history-element]
to get different commands to edit and resubmit."
(interactive "p")
(let ((elt (nth (1- arg) command-history))
(minibuffer-history-position arg)
(minibuffer-history-sexp-flag t)
newcmd)
(if elt
(progn
(setq newcmd
(let ((print-level nil))
(read-from-minibuffer
"Redo: " (prin1-to-string elt) read-expression-map t
(cons 'command-history arg))))
;; If command was added to command-history as a string,
;; get rid of that. We want only evaluable expressions there.
(if (stringp (car command-history))
(setq command-history (cdr command-history)))
;; If command to be redone does not match front of history,
;; add it to the history.
(or (equal newcmd (car command-history))
(setq command-history (cons newcmd command-history)))
(eval newcmd))
(ding))))
(defvar minibuffer-history nil
"Default minibuffer history list.
This is used for all minibuffer input
except when an alternate history list is specified.")
(defvar minibuffer-history-sexp-flag nil
"Non-nil when doing history operations on `command-history'.
More generally, indicates that the history list being acted on
contains expressions rather than strings.")
(setq minibuffer-history-variable 'minibuffer-history)
(setq minibuffer-history-position nil)
(defvar minibuffer-history-search-history nil)
(mapcar
(lambda (key-and-command)
(mapcar
(lambda (keymap-and-completionp)
;; Arg is (KEYMAP-SYMBOL . COMPLETION-MAP-P).
;; If the cdr of KEY-AND-COMMAND (the command) is a cons,
;; its car is used if COMPLETION-MAP-P is nil, its cdr if it is t.
(define-key (symbol-value (car keymap-and-completionp))
(car key-and-command)
(let ((command (cdr key-and-command)))
(if (consp command)
;; (and ... nil) => ... turns back on the completion-oriented
;; history commands which rms turned off since they seem to
;; do things he doesn't like.
(if (and (cdr keymap-and-completionp) nil) ;XXX turned off
(progn (error "EMACS BUG!") (cdr command))
(car command))
command))))
'((minibuffer-local-map . nil)
(minibuffer-local-ns-map . nil)
(minibuffer-local-completion-map . t)
(minibuffer-local-must-match-map . t)
(read-expression-map . nil))))
'(("\en" . (next-history-element . next-complete-history-element))
([next] . (next-history-element . next-complete-history-element))
("\ep" . (previous-history-element . previous-complete-history-element))
([prior] . (previous-history-element . previous-complete-history-element))
("\er" . previous-matching-history-element)
("\es" . next-matching-history-element)))
(defun previous-matching-history-element (regexp n)
"Find the previous history element that matches REGEXP.
\(Previous history elements refer to earlier actions.)
With prefix argument N, search for Nth previous match.
If N is negative, find the next or Nth next match."
(interactive
(let* ((enable-recursive-minibuffers t)
(minibuffer-history-sexp-flag nil)
(regexp (read-from-minibuffer "Previous element matching (regexp): "
nil
minibuffer-local-map
nil
'minibuffer-history-search-history)))
;; Use the last regexp specified, by default, if input is empty.
(list (if (string= regexp "")
(if minibuffer-history-search-history
(car minibuffer-history-search-history)
(error "No previous history search regexp"))
regexp)
(prefix-numeric-value current-prefix-arg))))
(let ((history (symbol-value minibuffer-history-variable))
prevpos
(pos minibuffer-history-position))
(while (/= n 0)
(setq prevpos pos)
(setq pos (min (max 1 (+ pos (if (< n 0) -1 1))) (length history)))
(if (= pos prevpos)
(error (if (= pos 1)
"No later matching history item"
"No earlier matching history item")))
(if (string-match regexp
(if minibuffer-history-sexp-flag
(let ((print-level nil))
(prin1-to-string (nth (1- pos) history)))
(nth (1- pos) history)))
(setq n (+ n (if (< n 0) 1 -1)))))
(setq minibuffer-history-position pos)
(erase-buffer)
(let ((elt (nth (1- pos) history)))
(insert (if minibuffer-history-sexp-flag
(let ((print-level nil))
(prin1-to-string elt))
elt)))
(goto-char (point-min)))
(if (or (eq (car (car command-history)) 'previous-matching-history-element)
(eq (car (car command-history)) 'next-matching-history-element))
(setq command-history (cdr command-history))))
(defun next-matching-history-element (regexp n)
"Find the next history element that matches REGEXP.
\(The next history element refers to a more recent action.)
With prefix argument N, search for Nth next match.
If N is negative, find the previous or Nth previous match."
(interactive
(let* ((enable-recursive-minibuffers t)
(minibuffer-history-sexp-flag nil)
(regexp (read-from-minibuffer "Next element matching (regexp): "
nil
minibuffer-local-map
nil
'minibuffer-history-search-history)))
;; Use the last regexp specified, by default, if input is empty.
(list (if (string= regexp "")
(setcar minibuffer-history-search-history
(nth 1 minibuffer-history-search-history))
regexp)
(prefix-numeric-value current-prefix-arg))))
(previous-matching-history-element regexp (- n)))
(defun next-history-element (n)
"Insert the next element of the minibuffer history into the minibuffer."
(interactive "p")
(or (zerop n)
(let ((narg (min (max 1 (- minibuffer-history-position n))
(length (symbol-value minibuffer-history-variable)))))
(if (or (zerop narg)
(= minibuffer-history-position narg))
(error (if (if (zerop narg)
(> n 0)
(= minibuffer-history-position 1))
"End of history; no next item"
"Beginning of history; no preceding item"))
(erase-buffer)
(setq minibuffer-history-position narg)
(let ((elt (nth (1- minibuffer-history-position)
(symbol-value minibuffer-history-variable))))
(insert
(if minibuffer-history-sexp-flag
(let ((print-level nil))
(prin1-to-string elt))
elt)))
(goto-char (point-min))))))
(defun previous-history-element (n)
"Inserts the previous element of the minibuffer history into the minibuffer."
(interactive "p")
(next-history-element (- n)))
(defun next-complete-history-element (n)
"Get next element of history which is a completion of minibuffer contents."
(interactive "p")
(let ((point-at-start (point)))
(next-matching-history-element
(concat "^" (regexp-quote (buffer-substring (point-min) (point)))) n)
;; next-matching-history-element always puts us at (point-min).
;; Move to the position we were at before changing the buffer contents.
;; This is still sensical, because the text before point has not changed.
(goto-char point-at-start)))
(defun previous-complete-history-element (n)
"\
Get previous element of history which is a completion of minibuffer contents."
(interactive "p")
(next-complete-history-element (- n)))
(defun goto-line (arg)
"Goto line ARG, counting from line 1 at beginning of buffer."
(interactive "NGoto line: ")
(setq arg (prefix-numeric-value arg))
(save-restriction
(widen)
(goto-char 1)
(if (eq selective-display t)
(re-search-forward "[\n\C-m]" nil 'end (1- arg))
(forward-line (1- arg)))))
;Put this on C-x u, so we can force that rather than C-_ into startup msg
(define-function 'advertised-undo 'undo)
(defun undo (&optional arg)
"Undo some previous changes.
Repeat this command to undo more changes.
A numeric argument serves as a repeat count."
(interactive "*p")
;; If we don't get all the way thru, make last-command indicate that
;; for the following command.
(setq this-command t)
(let ((modified (buffer-modified-p))
(recent-save (recent-auto-save-p)))
(or (eq (selected-window) (minibuffer-window))
(message "Undo!"))
(or (eq last-command 'undo)
(progn (undo-start)
(undo-more 1)))
(undo-more (or arg 1))
;; Don't specify a position in the undo record for the undo command.
;; Instead, undoing this should move point to where the change is.
(let ((tail buffer-undo-list)
done)
(while (and tail (not done) (not (null (car tail))))
(if (integerp (car tail))
(progn
(setq done t)
(setq buffer-undo-list (delq (car tail) buffer-undo-list))))
(setq tail (cdr tail))))
(and modified (not (buffer-modified-p))
(delete-auto-save-file-if-necessary recent-save)))
;; If we do get all the way thru, make this-command indicate that.
(setq this-command 'undo))
(defvar pending-undo-list nil
"Within a run of consecutive undo commands, list remaining to be undone.")
(defun undo-start ()
"Set `pending-undo-list' to the front of the undo list.
The next call to `undo-more' will undo the most recently made change."
(if (eq buffer-undo-list t)
(error "No undo information in this buffer"))
(setq pending-undo-list buffer-undo-list))
(defun undo-more (count)
"Undo back N undo-boundaries beyond what was already undone recently.
Call `undo-start' to get ready to undo recent changes,
then call `undo-more' one or more times to undo them."
(or pending-undo-list
(error "No further undo information"))
(setq pending-undo-list (primitive-undo count pending-undo-list)))
(defvar shell-command-history nil
"History list for some commands that read shell commands.")
(defvar shell-command-switch "-c"
"Switch used to have the shell execute its command line argument.")
(defun shell-command (command &optional output-buffer)
"Execute string COMMAND in inferior shell; display output, if any.
If COMMAND ends in ampersand, execute it asynchronously.
The output appears in the buffer `*Async Shell Command*'.
That buffer is in shell mode.
Otherwise, COMMAND is executed synchronously. The output appears in the
buffer `*Shell Command Output*'.
If the output is one line, it is displayed in the echo area *as well*,
but it is nonetheless available in buffer `*Shell Command Output*',
even though that buffer is not automatically displayed.
If there is no output, or if output is inserted in the current buffer,
then `*Shell Command Output*' is deleted.
The optional second argument OUTPUT-BUFFER, if non-nil,
says to put the output in some other buffer.
If OUTPUT-BUFFER is a buffer or buffer name, put the output there.
If OUTPUT-BUFFER is not a buffer and not nil,
insert output in current buffer. (This cannot be done asynchronously.)
In either case, the output is inserted after point (leaving mark after it)."
(interactive (list (read-from-minibuffer "Shell command: "
nil nil nil 'shell-command-history)
current-prefix-arg))
;; Look for a handler in case default-directory is a remote file name.
(let ((handler
(find-file-name-handler (directory-file-name default-directory)
'shell-command)))
(if handler
(funcall handler 'shell-command command output-buffer)
(if (and output-buffer
(not (or (bufferp output-buffer) (stringp output-buffer))))
(progn (barf-if-buffer-read-only)
(push-mark)
;; We do not use -f for csh; we will not support broken use of
;; .cshrcs. Even the BSD csh manual says to use
;; "if ($?prompt) exit" before things which are not useful
;; non-interactively. Besides, if someone wants their other
;; aliases for shell commands then they can still have them.
(call-process shell-file-name nil t nil
shell-command-switch command)
;; This is like exchange-point-and-mark, but doesn't
;; activate the mark. It is cleaner to avoid activation,
;; even though the command loop would deactivate the mark
;; because we inserted text.
(goto-char (prog1 (mark t)
(set-marker (mark-marker) (point)
(current-buffer)))))
;; Preserve the match data in case called from a program.
(save-match-data
(if (string-match "[ \t]*&[ \t]*$" command)
;; Command ending with ampersand means asynchronous.
(let ((buffer (get-buffer-create
(or output-buffer "*Async Shell Command*")))
(directory default-directory)
proc)
;; Remove the ampersand.
(setq command (substring command 0 (match-beginning 0)))
;; If will kill a process, query first.
(setq proc (get-buffer-process buffer))
(if proc
(if (yes-or-no-p "A command is running. Kill it? ")
(kill-process proc)
(error "Shell command in progress")))
(save-excursion
(set-buffer buffer)
(setq buffer-read-only nil)
(erase-buffer)
(display-buffer buffer)
(setq default-directory directory)
(setq proc (start-process "Shell" buffer shell-file-name
shell-command-switch command))
(setq mode-line-process '(":%s"))
(require 'shell) (shell-mode)
(set-process-sentinel proc 'shell-command-sentinel)
))
(shell-command-on-region (point) (point) command nil)
))))))
;; We have a sentinel to prevent insertion of a termination message
;; in the buffer itself.
(defun shell-command-sentinel (process signal)
(if (memq (process-status process) '(exit signal))
(message "%s: %s."
(car (cdr (cdr (process-command process))))
(substring signal 0 -1))))
(defun shell-command-on-region (start end command
&optional output-buffer replace)
"Execute string COMMAND in inferior shell with region as input.
Normally display output (if any) in temp buffer `*Shell Command Output*';
Prefix arg means replace the region with it.
The noninteractive arguments are START, END, COMMAND, OUTPUT-BUFFER, REPLACE.
If REPLACE is non-nil, that means insert the output
in place of text from START to END, putting point and mark around it.
If the output is one line, it is displayed in the echo area,
but it is nonetheless available in buffer `*Shell Command Output*'
even though that buffer is not automatically displayed.
If there is no output, or if output is inserted in the current buffer,
then `*Shell Command Output*' is deleted.
If the optional fourth argument OUTPUT-BUFFER is non-nil,
that says to put the output in some other buffer.
If OUTPUT-BUFFER is a buffer or buffer name, put the output there.
If OUTPUT-BUFFER is not a buffer and not nil,
insert output in the current buffer.
In either case, the output is inserted after point (leaving mark after it)."
(interactive (let ((string
;; Do this before calling region-beginning
;; and region-end, in case subprocess output
;; relocates them while we are in the minibuffer.
(read-from-minibuffer "Shell command on region: "
nil nil nil
'shell-command-history)))
;; call-interactively recognizes region-beginning and
;; region-end specially, leaving them in the history.
(list (region-beginning) (region-end)
string
current-prefix-arg
current-prefix-arg)))
(if (or replace
(and output-buffer
(not (or (bufferp output-buffer) (stringp output-buffer))))
(equal (buffer-name (current-buffer)) "*Shell Command Output*"))
;; Replace specified region with output from command.
(let ((swap (and replace (< start end))))
;; Don't muck with mark unless REPLACE says we should.
(goto-char start)
(and replace (push-mark))
(call-process-region start end shell-file-name t t nil
shell-command-switch command)
(let ((shell-buffer (get-buffer "*Shell Command Output*")))
(and shell-buffer (not (eq shell-buffer (current-buffer)))
(kill-buffer shell-buffer)))
;; Don't muck with mark unless REPLACE says we should.
(and replace swap (exchange-point-and-mark)))
;; No prefix argument: put the output in a temp buffer,
;; replacing its entire contents.
(let ((buffer (get-buffer-create
(or output-buffer "*Shell Command Output*")))
(success nil))
(unwind-protect
(if (eq buffer (current-buffer))
;; If the input is the same buffer as the output,
;; delete everything but the specified region,
;; then replace that region with the output.
(progn (setq buffer-read-only nil)
(delete-region (max start end) (point-max))
(delete-region (point-min) (max start end))
(call-process-region (point-min) (point-max)
shell-file-name t t nil
shell-command-switch command)
(setq success t))
;; Clear the output buffer, then run the command with output there.
(save-excursion
(set-buffer buffer)
(setq buffer-read-only nil)
(erase-buffer))
(call-process-region start end shell-file-name
nil buffer nil
shell-command-switch command)
(setq success t))
;; Report the amount of output.
(let ((lines (save-excursion
(set-buffer buffer)
(if (= (buffer-size) 0)
0
(count-lines (point-min) (point-max))))))
(cond ((= lines 0)
(if success
(message "(Shell command completed with no output)"))
(kill-buffer buffer))
((and success (= lines 1))
(message "%s"
(save-excursion
(set-buffer buffer)
(goto-char (point-min))
(buffer-substring (point)
(progn (end-of-line) (point))))))
(t
(set-window-start (display-buffer buffer) 1))))))))
(defconst universal-argument-map
(let ((map (make-sparse-keymap)))
(define-key map [t] 'universal-argument-other-key)
(define-key map (vector meta-prefix-char t) 'universal-argument-other-key)
(define-key map [switch-frame] nil)
(define-key map [?\C-u] 'universal-argument-more)
(define-key map [?-] 'universal-argument-minus)
(define-key map [?0] 'digit-argument)
(define-key map [?1] 'digit-argument)
(define-key map [?2] 'digit-argument)
(define-key map [?3] 'digit-argument)
(define-key map [?4] 'digit-argument)
(define-key map [?5] 'digit-argument)
(define-key map [?6] 'digit-argument)
(define-key map [?7] 'digit-argument)
(define-key map [?8] 'digit-argument)
(define-key map [?9] 'digit-argument)
map)
"Keymap used while processing \\[universal-argument].")
(defvar universal-argument-num-events nil
"Number of argument-specifying events read by `universal-argument'.
`universal-argument-other-key' uses this to discard those events
from (this-command-keys), and reread only the final command.")
(defun universal-argument ()
"Begin a numeric argument for the following command.
Digits or minus sign following \\[universal-argument] make up the numeric argument.
\\[universal-argument] following the digits or minus sign ends the argument.
\\[universal-argument] without digits or minus sign provides 4 as argument.
Repeating \\[universal-argument] without digits or minus sign
multiplies the argument by 4 each time."
(interactive)
(setq prefix-arg (list 4))
(setq universal-argument-num-events (length (this-command-keys)))
(setq overriding-terminal-local-map universal-argument-map))
;; A subsequent C-u means to multiply the factor by 4 if we've typed
;; nothing but C-u's; otherwise it means to terminate the prefix arg.
(defun universal-argument-more (arg)
(interactive "P")
(if (consp arg)
(setq prefix-arg (list (* 4 (car arg))))
(setq prefix-arg arg)
(setq overriding-terminal-local-map nil))
(setq universal-argument-num-events (length (this-command-keys))))
(defun negative-argument (arg)
"Begin a negative numeric argument for the next command.
\\[universal-argument] following digits or minus sign ends the argument."
(interactive "P")
(cond ((integerp arg)
(setq prefix-arg (- arg)))
((eq arg '-)
(setq prefix-arg nil))
(t
(setq prefix-arg '-)))
(setq universal-argument-num-events (length (this-command-keys)))
(setq overriding-terminal-local-map universal-argument-map))
(defun digit-argument (arg)
"Part of the numeric argument for the next command.
\\[universal-argument] following digits or minus sign ends the argument."
(interactive "P")
(let ((digit (- (logand last-command-char ?\177) ?0)))
(cond ((integerp arg)
(setq prefix-arg (+ (* arg 10)
(if (< arg 0) (- digit) digit))))
((eq arg '-)
;; Treat -0 as just -, so that -01 will work.