| blob | f41b9cbd11a292af05485fc9370f63c0449c6616 |
1 ;;; simple.el --- basic editing commands for Emacs
3 ;; Copyright (C) 1985, 86, 87, 93, 94, 95, 96, 97, 98, 99,
4 ;; 2000, 2001, 2002, 2003
5 ;; Free Software Foundation, Inc.
7 ;; Maintainer: FSF
8 ;; Keywords: internal
10 ;; This file is part of GNU Emacs.
12 ;; GNU Emacs is free software; you can redistribute it and/or modify
13 ;; it under the terms of the GNU General Public License as published by
14 ;; the Free Software Foundation; either version 2, or (at your option)
15 ;; any later version.
17 ;; GNU Emacs is distributed in the hope that it will be useful,
18 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
19 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
20 ;; GNU General Public License for more details.
22 ;; You should have received a copy of the GNU General Public License
23 ;; along with GNU Emacs; see the file COPYING. If not, write to the
24 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
25 ;; Boston, MA 02111-1307, USA.
27 ;;; Commentary:
29 ;; A grab-bag of basic Emacs commands not specifically related to some
30 ;; major mode or to file-handling.
32 ;;; Code:
40 "Killing and yanking commands"
44 "Highlight (un)matching of parens and expressions."
50 "Switch to the next buffer in cyclic order."
57 "Switch to the previous buffer in cyclic order."
60 found)
70 "Major mode not specialized for anything in particular.
71 Other major modes are defined by comparison with this one."
75 ;; Making and deleting lines.
78 "Insert a newline, and move to left margin of the new line if it's blank.
79 If `use-hard-newlines' is non-nil, the newline is marked with the
80 text-property `hard'.
81 With ARG, insert that many newlines.
82 Call `auto-fill-function' if the current column number is greater
83 than the value of `fill-column' and ARG is nil."
86 ;; Inserting a newline at the end of a line produces better redisplay in
87 ;; try_window_id than inserting at the beginning of a line, and the textual
88 ;; result is the same. So, if we're at beginning of line, pretend to be at
89 ;; the end of the previous line.
92 ;; Make sure no functions want to be told about
93 ;; the range of the changes.
96 ;; Make sure there are no markers here.
99 ;; Make sure no text properties want to know
100 ;; where the change was.
105 ;; Make sure the newline before point isn't intangible.
107 ;; Make sure the newline before point isn't read-only.
109 ;; Make sure the newline before point isn't invisible.
111 ;; Make sure the newline before point has the same
112 ;; properties as the char before it (if any).
119 ;; Call self-insert so that auto-fill, abbrev expansion etc. happens.
120 ;; Set last-command-char to tell self-insert what to insert.
122 ;; Don't auto-fill if we have a numeric argument.
123 ;; Also not if flag is true (it would fill wrong line);
124 ;; there is no need to since we're at BOL.
128 ;; If we get an error in self-insert-command, put point at right place.
130 ;; Even if we did *not* get an error, keep that forward-char;
131 ;; all further processing should apply to the newline that the user
132 ;; thinks he inserted.
134 ;; Mark the newline(s) `hard'.
138 ;; If the newline leaves the previous line blank,
139 ;; and we have a left margin, delete that from the blank line.
147 ;; Indent the line after the newline, except in one case:
148 ;; when we added the newline at the beginning of a line
149 ;; which starts a page.
152 nil)
157 ;; If rear-nonsticky is not "t", add 'hard to rear-nonsticky list
163 "Insert a newline and leave point before it.
164 If there is a fill prefix and/or a left-margin, insert them on the new line
165 if the line would have been blank.
166 With arg N, insert N newlines."
171 ;; Don't expand an abbrev before point.
185 "Split current line, moving portion beyond point vertically down.
186 If the current line starts with `fill-prefix', insert it on the new
187 line as well. With prefix arg, don't insert fill-prefix on new line.
189 When called from Lisp code, the arg may be a prefix string to copy."
194 ;; What prefix should we check for (nil means don't).
198 ;; Does this line start with it?
209 "Join this line to previous and fix up whitespace at join.
210 If there is a fill prefix, delete it from the beginning of this line.
211 With argument, join this line to following line."
218 ;; If the second line started with the fill prefix,
219 ;; delete the prefix.
231 "On blank line, delete all surrounding blank lines, leaving just one.
232 On isolated blank line, delete that one.
233 On nonblank line, delete any immediately following blank lines."
239 ;; Set singleblank if there is just one blank line here.
246 ;; Delete preceding blank lines, and this one too if it's the only one.
255 ;; Delete following blank lines, unless the current line is blank
256 ;; and there are no following blank lines.
265 ;; Handle the special case where point is followed by newline and eob.
266 ;; Delete the line, leaving point at eob.
271 "Delete all the trailing whitespace across the current buffer.
272 All whitespace after the last non-whitespace character in a line is deleted.
274 A formfeed is not considered whitespace by this function."
281 ;; Don't delete formfeeds, even if they are considered whitespace.
288 "Insert a newline, then indent according to major mode.
289 Indentation is done using the value of `indent-line-function'.
290 In programming language modes, this is the same as TAB.
291 In some text modes, where TAB inserts a tab, this command indents to the
292 column specified by the function `current-left-margin'."
299 "Reindent current line, insert newline, then indent the new line.
300 Indentation of both lines is done according to the current major mode,
301 which means calling the current value of `indent-line-function'.
302 In programming language modes, this is the same as TAB.
303 In some text modes, where TAB inserts a tab, this indents to the
304 column specified by the function `current-left-margin'."
307 ;; Be careful to insert the newline before indenting the line.
308 ;; Otherwise, the indentation might be wrong.
317 "Read next input character and insert it.
318 This is useful for inserting control characters.
320 If the first character you type after this command is an octal digit,
321 you should type a sequence of octal digits which specify a character code.
322 Any nondigit terminates the sequence. If the terminator is a RET,
323 it is discarded; any other terminator is used itself as input.
324 The variable `read-quoted-char-radix' specifies the radix for this feature;
325 set it to 10 or 16 to use decimal or hex instead of octal.
327 In overwrite mode, this function inserts the character anyway, and
328 does not handle octal digits specially. This means that if you use
329 overwrite as your normal editing mode, you can use this function to
330 insert characters when necessary.
332 In binary overwrite mode, this function does overwrite, and octal
333 digits are interpreted as a character code. This is intended to be
334 useful for editing binary files."
341 ;; Assume character codes 0240 - 0377 stand for characters in some
342 ;; single-byte character set, and convert them to Emacs
343 ;; characters.
356 "Move forward ARG lines and position at first nonblank character."
362 "Move backward ARG lines and position at first nonblank character."
368 "Move point to the first non-whitespace character on this line."
372 ;; Move back over chars that have whitespace syntax but have the p flag.
376 "Fixup white space between objects around point.
377 Leave one space or none, according to the context."
384 nil
388 "Delete all spaces and tabs around point.
389 If BACKWARD-ONLY is non-nil, only delete spaces before point."
394 orig-pos
403 "Delete all spaces and tabs around point, leaving one space."
416 \f
418 "Move point to the beginning of the buffer; leave mark at previous position.
419 With arg N, put point N/10 of the way from the beginning.
421 If the buffer is narrowed, this command uses the beginning and size
422 of the accessible part of the buffer.
424 Don't use this command in Lisp programs!
425 \(goto-char (point-min)) is faster and avoids clobbering the mark."
432 ;; Avoid overflow for large buffer sizes!
440 "Move point to the end of the buffer; leave mark at previous position.
441 With arg N, put point N/10 of the way from the end.
443 If the buffer is narrowed, this command uses the beginning and size
444 of the accessible part of the buffer.
446 Don't use this command in Lisp programs!
447 \(goto-char (point-max)) is faster and avoids clobbering the mark."
454 ;; Avoid overflow for large buffer sizes!
459 ;; If we went to a place in the middle of the buffer,
460 ;; adjust it to the beginning of a line.
463 ;; If the end of the buffer is not already on the screen,
464 ;; then scroll specially to put it near, but not at, the bottom.
469 "Put point at beginning and mark at end of buffer.
470 You probably should not use this function in Lisp programs;
471 it is usually a mistake for a Lisp function to use any subroutine
472 that uses or sets the mark."
477 \f
479 ;; Counting lines, one way or another.
482 "Goto line ARG, counting from line 1 at beginning of buffer."
493 "Print number of lines and characters in the region."
499 "Print the current buffer line number and narrowed line number of point."
512 "Return number of lines between START and END.
513 This is usually the number of newlines between them,
514 but can be one more if START is not equal to END
515 and the greater of them is not at the start of a line."
531 done)))
535 "Return (narrowed) buffer line number at position POS.
536 If POS is nil, use current buffer location."
546 "Print info on cursor position (on screen and within buffer).
547 Also describe the character after point, and give its character code
548 in octal, decimal and hex.
550 For a non-ASCII multibyte character, also give its encoding in the
551 buffer's selected coding system if the coding system encodes the
552 character safely. If the character is encoded into one byte, that
553 code is shown in hex. If the character is encoded into more than one
556 In addition, with prefix argument, show details about that character
557 in *Help* buffer. See also the command `describe-char'."
565 ;; Avoid overflow from multiplying by 100!
569 ""
575 pos total percent beg end col hscroll)
577 pos total percent col hscroll))
579 encoded encoding-msg)
590 char char char
592 "..."
596 ;; We show the detailed information about CHAR.
603 encoding-msg pos total percent beg end col hscroll)
608 encoding-msg pos total percent col hscroll))))))
609 \f
614 m)
620 "*Value to use for `print-level' when printing value in `eval-expression'.
621 A value of nil means no limit."
627 "*Value to use for `print-length' when printing value in `eval-expression'.
628 A value of nil means no limit."
634 "*Non-nil means set `debug-on-error' when evaluating in `eval-expression'.
635 If nil, don't change the value of `debug-on-error'."
640 ;; We define this, rather than making `eval' interactive,
641 ;; for the sake of completion of names like eval-region, eval-current-buffer.
644 "Evaluate EVAL-EXPRESSION-ARG and print value in the echo area.
645 Value is also consed on to front of the variable `values'.
646 Optional argument EVAL-EXPRESSION-INSERT-VALUE, if non-nil, means
647 insert the result into the current buffer instead of printing it in
648 the echo area."
651 nil read-expression-map t
653 current-prefix-arg))
658 ;; Bind debug-on-error to something unique so that we can
659 ;; detect when evaled code changes it.
663 ;; If evaled code has changed the value of debug-on-error,
664 ;; propagate that change to the global binding.
677 "Prompting with PROMPT, let user edit COMMAND and eval result.
678 COMMAND is a Lisp expression. Let user edit that expression in
679 the minibuffer, then read and evaluate the result."
686 read-expression-map t
688 ;; If command was added to command-history as a string,
689 ;; get rid of that. We want only evaluable expressions there.
693 ;; If command to be redone does not match front of history,
694 ;; add it to the history.
700 "Edit and re-evaluate last complex command, or ARGth from last.
701 A complex command is one which used the minibuffer.
702 The command is placed in the minibuffer as a Lisp form for editing.
703 The result is executed, repeating the command as changed.
704 If the command has been changed or is not the most recent previous command
705 it is added to the front of the command history.
706 You can use the minibuffer history commands \\<minibuffer-local-map>\\[next-history-element] and \\[previous-history-element]
707 to get different commands to edit and resubmit."
710 newcmd)
722 ;; If command was added to command-history as a
723 ;; string, get rid of that. We want only
724 ;; evaluable expressions there.
728 ;; If command to be redone does not match front of history,
729 ;; add it to the history.
736 \f
738 "Default minibuffer history list.
739 This is used for all minibuffer input
742 "Control whether history list elements are expressions or strings.
743 If the value of this variable equals current minibuffer depth,
744 they are expressions; otherwise they are strings.
745 \(That convention is designed to do the right thing fora
752 "Text that was in this minibuffer before any history commands.
753 This is nil if there have not yet been any history commands
762 "A point-motion hook for the minibuffer, that moves point out of the prompt."
766 "*Minibuffer history variables for which matching should ignore case.
767 If a history variable is a member of this list, then the
769 commands ignore case when searching it, regardless of `case-fold-search'."
774 "Find the previous history element that matches REGEXP.
775 \(Previous history elements refer to earlier actions.)
776 With prefix argument N, search for Nth previous match.
777 If N is negative, find the next or Nth next match.
778 Normally, history elements are matched case-insensitively if
779 `case-fold-search' is non-nil, but an uppercase letter in REGEXP
780 makes the search case-sensitive.
781 See also `minibuffer-history-case-insensitive-variables'."
785 nil
786 minibuffer-local-map
787 nil
789 ;; Use the last regexp specified, by default, if input is empty.
794 regexp)
804 ;; On some systems, ignore case for file names.
806 minibuffer-history-case-insensitive-variables)
807 t
808 ;; Respect the user's setting for case-fold-search:
809 case-fold-search)
810 nil))
811 prevpos
812 match-string
813 match-offset
820 "No later matching history item"
841 next-matching-history-element))
845 "Find the next history element that matches REGEXP.
846 \(The next history element refers to a more recent action.)
847 With prefix argument N, search for Nth next match.
848 If N is negative, find the previous or Nth previous match.
849 Normally, history elements are matched case-insensitively if
850 `case-fold-search' is non-nil, but an uppercase letter in REGEXP
851 makes the search case-sensitive."
855 nil
856 minibuffer-local-map
857 nil
859 ;; Use the last regexp specified, by default, if input is empty.
863 regexp)
870 "Insert the next element of the minibuffer history into the minibuffer."
875 elt minibuffer-returned-to-present)
887 previous-history-element))
909 elt))
913 "Inserts the previous element of the minibuffer history into the minibuffer."
918 "Get next history element which completes the minibuffer before the point.
919 The contents of the minibuffer after the point are deleted, and replaced
920 by the new completion."
926 n)
927 ;; next-matching-history-element always puts us at (point-min).
928 ;; Move to the position we were at before changing the buffer contents.
929 ;; This is still sensical, because the text before point has not changed.
933 "\
934 Get previous history element which completes the minibuffer before the point.
935 The contents of the minibuffer after the point are deleted, and replaced
936 by the new completion."
940 ;; For compatibility with the old subr of the same name.
942 "Return the display width of the minibuffer prompt.
943 Return 0 if current buffer is not a mini-buffer."
944 ;; Return the width of everything before the field at the end of
945 ;; the buffer; this should be 0 for normal buffers.
947 \f
948 ;Put this on C-x u, so we can force that rather than C-_ into startup msg
961 "Undo some previous changes.
962 Repeat this command to undo more changes.
963 A numeric argument serves as a repeat count.
965 In Transient Mark mode when the mark is active, only undo changes within
967 as an argument limits undo to changes within the current region."
969 ;; Make last-command indicate for the next command that this was an undo.
970 ;; That way, another undo will undo more.
971 ;; If we get to the end of the undo history and get an error,
972 ;; another undo command will find the undo history empty
973 ;; and will get another error. To begin undoing the undos,
974 ;; you must type some other command.
977 ;; If we get an error in undo-start,
978 ;; the next command should not be a "consecutive undo".
979 ;; So set `this-command' to something other than `undo'.
988 ;; get rid of initial undo boundary
990 ;; If we got this far, the next command should be a consecutive undo.
992 ;; Check to see whether we're hitting a redo record, and if
993 ;; so, ask the user whether she wants to skip the redo/undo pair.
1000 ;; The equiv entry might point to another redo record if we have done
1001 ;; undo-redo-undo-redo-... so skip to the very last equiv.
1009 ;; Record the fact that the just-generated undo records come from an
1010 ;; undo operation, so we can skip them later on.
1011 ;; I don't know how to do that in the undo-in-region case.
1014 ;; Don't specify a position in the undo record for the undo command.
1015 ;; Instead, undoing this should move point to where the change is.
1039 "Undo some previous changes.
1040 Repeat this command to undo more changes.
1041 A numeric argument serves as a repeat count.
1042 Contrary to `undo', this will not redo a previous undo."
1045 ;; Richard said that we should not use C-x <uppercase letter> and I have
1046 ;; no idea whereas to bind it. Any suggestion welcome. -stef
1047 ;; (define-key ctl-x-map "U" 'undo-only)
1053 "Non-nil while performing an undo.
1057 "Undo back N undo-boundaries beyond what was already undone recently.
1058 Call `undo-start' to get ready to undo recent changes,
1059 then call `undo-more' one or more times to undo them."
1067 ;; Deep copy of a list
1069 "Make a copy of undo list LIST."
1075 elt))
1078 "Set `pending-undo-list' to the front of the undo list.
1079 The next call to `undo-more' will undo the most recently made change.
1080 If BEG and END are specified, then only undo elements
1081 that apply to text between BEG and END are used; other undo elements
1082 are ignored. If BEG and END are nil, all undo elements are used."
1088 buffer-undo-list)))
1093 "Return a list of undo elements for the region START to END.
1094 The elements come from `buffer-undo-list', but we keep only
1095 the elements inside this region, and discard those outside this region.
1096 If we find an element that crosses an edge of this region,
1097 we stop and ignore all further elements."
1100 undo-adjusted-markers
1101 some-rejected
1102 undo-elt undo-elt temp-undo-list delta)
1107 ;; This is a "was unmodified" element.
1108 ;; Keep it if we have kept everything thus far.
1115 ;; Don't put two nils together in the list
1129 ;; Loop down the earlier events adjusting their buffer
1130 ;; positions to reflect the fact that a change to the buffer
1131 ;; isn't being undone. We only need to process those element
1132 ;; types which undo-elt-in-region will return as being in
1133 ;; the region since only those types can ever get into the
1134 ;; output
1143 ;; (TEXT . POSITION)
1150 ;; (BEGIN . END)
1155 ;; (nil PROPERTY VALUE BEG . END)
1165 "Determine whether UNDO-ELT falls inside the region START ... END.
1166 If it crosses the edge, we return nil."
1171 t)
1173 nil)
1175 ;; (TEXT . POSITION)
1179 ;; This is a marker-adjustment element (MARKER . ADJUSTMENT).
1180 ;; See if MARKER is inside the region.
1191 ;; (nil PROPERTY VALUE BEG . END)
1196 ;; (BEGIN . END)
1201 "Test whether UNDO-ELT crosses one edge of that region START ... END.
1202 This assumes we have already decided that UNDO-ELT
1203 is not *inside* the region START...END."
1206 ;; (nil PROPERTY VALUE BEG . END)
1211 ;; (BEGIN . END)
1215 ;; Return the first affected buffer position and the delta for an undo element
1216 ;; delta is defined as the change in subsequent buffer positions if we *did*
1217 ;; the undo.
1221 ;; (TEXT . POSITION)
1224 ;; (BEGIN . END)
1229 \f
1237 "*Buffer name for `shell-command' and `shell-command-on-region' error output.
1238 This buffer is used when `shell-command' or `shell-command-on-region'
1239 is run interactively. A value of nil means that output to stderr and
1243 "Execute string COMMAND in inferior shell; display output, if any.
1244 With prefix argument, insert the COMMAND's output at point.
1246 If COMMAND ends in ampersand, execute it asynchronously.
1247 The output appears in the buffer `*Async Shell Command*'.
1248 That buffer is in shell mode.
1250 Otherwise, COMMAND is executed synchronously. The output appears in
1251 the buffer `*Shell Command Output*'. If the output is short enough to
1252 display in the echo area (which is determined by the variables
1253 `resize-mini-windows' and `max-mini-window-height'), it is shown
1254 there, but it is nonetheless available in buffer `*Shell Command
1255 Output*' even though that buffer is not automatically displayed.
1257 To specify a coding system for converting non-ASCII characters
1259 before this command.
1261 Noninteractive callers can specify coding systems by binding
1262 `coding-system-for-read' and `coding-system-for-write'.
1264 The optional second argument OUTPUT-BUFFER, if non-nil,
1265 says to put the output in some other buffer.
1266 If OUTPUT-BUFFER is a buffer or buffer name, put the output there.
1267 If OUTPUT-BUFFER is not a buffer and not nil,
1268 insert output in current buffer. (This cannot be done asynchronously.)
1269 In either case, the output is inserted after point (leaving mark after it).
1271 If the command terminates without error, but generates output,
1273 the output can be displayed in the echo area or in its buffer.
1274 If the output is short enough to display in the echo area
1275 \(determined by the variable `max-mini-window-height' if
1276 `resize-mini-windows' is non-nil), it is shown there. Otherwise,
1277 the buffer containing the output is displayed.
1281 of the output.
1283 If there is no output, or if output is inserted in the current buffer,
1284 then `*Shell Command Output*' is deleted.
1286 If the optional third argument ERROR-BUFFER is non-nil, it is a buffer
1287 or buffer name to which to direct the command's standard error output.
1288 If it is nil, error output is mingled with regular output.
1289 In an interactive call, the variable `shell-command-default-error-buffer'
1290 specifies the value of ERROR-BUFFER."
1294 current-prefix-arg
1295 shell-command-default-error-buffer))
1296 ;; Look for a handler in case default-directory is a remote file name.
1304 ;; Output goes in current buffer.
1310 temporary-file-directory)))
1311 nil)))
1314 ;; We do not use -f for csh; we will not support broken use of
1315 ;; .cshrcs. Even the BSD csh manual says to use
1316 ;; "if ($?prompt) exit" before things which are not useful
1317 ;; non-interactively. Besides, if someone wants their other
1318 ;; aliases for shell commands then they can still have them.
1322 t)
1323 nil shell-command-switch command)
1330 ;; Do no formatting while reading error file,
1331 ;; because that can run a shell command, and we
1332 ;; don't want that to cause an infinite recursion.
1334 ;; Put point after the inserted errors.
1338 ;; This is like exchange-point-and-mark, but doesn't
1339 ;; activate the mark. It is cleaner to avoid activation,
1340 ;; even though the command loop would deactivate the mark
1341 ;; because we inserted text.
1345 ;; Output goes in a separate buffer.
1346 ;; Preserve the match data in case called from a program.
1349 ;; Command ending with ampersand means asynchronous.
1353 proc)
1354 ;; Remove the ampersand.
1356 ;; If will kill a process, query first.
1368 shell-command-switch command))
1372 ))
1374 output-buffer nil error-buffer)))))))
1378 "Display MESSAGE in the echo area if possible, otherwise in a pop-up buffer.
1379 MESSAGE may be either a string or a buffer.
1381 A buffer is displayed using `display-buffer' if MESSAGE is too long for
1382 the maximum height of the echo area, as defined by `max-mini-window-height'
1383 if `resize-mini-windows' is non-nil.
1385 Returns either the string shown in the echo area, or when a pop-up
1386 buffer is used, the window used to display it.
1388 If MESSAGE is a string, then the optional argument BUFFER-NAME is the
1389 name of the buffer used to display it in the case where a pop-up buffer
1390 is used, defaulting to `*Message*'. In the case where MESSAGE is a
1391 string and it is displayed in the echo area, it is not specified whether
1392 the contents are inserted into the buffer anyway.
1394 Optional arguments NOT-THIS-WINDOW and FRAME are as for `display-buffer',
1395 and only used if a buffer is displayed."
1397 ;; Trivial case where we can use the echo area
1401 ;; Trivial case where we can just remove single trailing newline
1404 ;; General case
1407 message
1416 0
1420 (<= lines
1424 max-mini-window-height))
1426 max-mini-window-height)
1430 ;; Don't use the echo area if the output buffer is
1431 ;; already dispayed in the selected frame.
1433 ;; Echo area
1439 ;; Buffer
1442 not-this-window frame))))))))
1445 ;; We have a sentinel to prevent insertion of a termination message
1446 ;; in the buffer itself.
1454 &optional output-buffer replace
1455 error-buffer)
1456 "Execute string COMMAND in inferior shell with region as input.
1457 Normally display output (if any) in temp buffer `*Shell Command Output*';
1458 Prefix arg means replace the region with it. Return the exit code of
1459 COMMAND.
1461 To specify a coding system for converting non-ASCII characters
1463 before this command. By default, the input (from the current buffer)
1464 is encoded in the same coding system that will be used to save the file,
1465 `buffer-file-coding-system'. If the output is going to replace the region,
1466 then it is decoded from that same coding system.
1468 The noninteractive arguments are START, END, COMMAND, OUTPUT-BUFFER,
1469 REPLACE, ERROR-BUFFER. Noninteractive callers can specify coding
1470 systems by binding `coding-system-for-read' and
1471 `coding-system-for-write'.
1473 If the command generates output, the output may be displayed
1474 in the echo area or in a buffer.
1475 If the output is short enough to display in the echo area
1476 \(determined by the variable `max-mini-window-height' if
1477 `resize-mini-windows' is non-nil), it is shown there. Otherwise
1478 it is displayed in the buffer `*Shell Command Output*'. The output
1479 is available in that buffer in both cases.
1481 If there is output and an error, a message about the error
1482 appears at the end of the output.
1484 If there is no output, or if output is inserted in the current buffer,
1485 then `*Shell Command Output*' is deleted.
1487 If the optional fourth argument OUTPUT-BUFFER is non-nil,
1488 that says to put the output in some other buffer.
1489 If OUTPUT-BUFFER is a buffer or buffer name, put the output there.
1490 If OUTPUT-BUFFER is not a buffer and not nil,
1491 insert output in the current buffer.
1492 In either case, the output is inserted after point (leaving mark after it).
1494 If REPLACE, the optional fifth argument, is non-nil, that means insert
1495 the output in place of text from START to END, putting point and mark
1496 around it.
1498 If optional sixth argument ERROR-BUFFER is non-nil, it is a buffer
1499 or buffer name to which to direct the command's standard error output.
1500 If it is nil, error output is mingled with regular output.
1501 In an interactive call, the variable `shell-command-default-error-buffer'
1502 specifies the value of ERROR-BUFFER."
1506 ;; Do this before calling region-beginning
1507 ;; and region-end, in case subprocess output
1508 ;; relocates them while we are in the minibuffer.
1510 nil nil nil
1512 ;; call-interactively recognizes region-beginning and
1513 ;; region-end specially, leaving them in the history.
1515 string
1516 current-prefix-arg
1517 current-prefix-arg
1518 shell-command-default-error-buffer)))
1524 temporary-file-directory)))
1525 nil))
1526 exit-status)
1530 ;; Replace specified region with output from command.
1532 ;; Don't muck with mark unless REPLACE says we should.
1539 t)
1540 nil shell-command-switch command))
1541 ;; It is rude to delete a buffer which the command is not using.
1542 ;; (let ((shell-buffer (get-buffer "*Shell Command Output*")))
1543 ;; (and shell-buffer (not (eq shell-buffer (current-buffer)))
1544 ;; (kill-buffer shell-buffer)))
1545 ;; Don't muck with mark unless REPLACE says we should.
1547 ;; No prefix argument: put the output in a temp buffer,
1548 ;; replacing its entire contents.
1553 ;; If the input is the same buffer as the output,
1554 ;; delete everything but the specified region,
1555 ;; then replace that region with the output.
1561 shell-file-name t
1564 t)
1565 nil shell-command-switch
1566 command)))
1567 ;; Clear the output buffer, then run the command with
1568 ;; output there.
1580 buffer)
1581 nil shell-command-switch command)))
1582 ;; Report the output.
1592 ;; There's some output, display it
1594 ;; No output; error?
1598 "some error output"
1604 output))
1607 exit-status))
1610 exit-status output))))
1611 ;; Don't kill: there might be useful info in the undo-log.
1612 ;; (kill-buffer buffer)
1613 ))))
1621 ;; Do no formatting while reading error file,
1622 ;; because that can run a shell command, and we
1623 ;; don't want that to cause an infinite recursion.
1625 ;; Put point after the inserted errors.
1629 exit-status))
1632 "Execute shell command COMMAND and return its output as a string."
1635 standard-output
1637 \f
1641 (define-key map (vector meta-prefix-char t) 'universal-argument-other-key)
1642 (define-key map [switch-frame] nil)
1643 (define-key map [?\C-u] 'universal-argument-more)
1644 (define-key map [?-] 'universal-argument-minus)
1645 (define-key map [?0] 'digit-argument)
1646 (define-key map [?1] 'digit-argument)
1647 (define-key map [?2] 'digit-argument)
1648 (define-key map [?3] 'digit-argument)
1649 (define-key map [?4] 'digit-argument)
1650 (define-key map [?5] 'digit-argument)
1651 (define-key map [?6] 'digit-argument)
1652 (define-key map [?7] 'digit-argument)
1653 (define-key map [?8] 'digit-argument)
1654 (define-key map [?9] 'digit-argument)
1655 (define-key map [kp-0] 'digit-argument)
1656 (define-key map [kp-1] 'digit-argument)
1657 (define-key map [kp-2] 'digit-argument)
1658 (define-key map [kp-3] 'digit-argument)
1659 (define-key map [kp-4] 'digit-argument)
1660 (define-key map [kp-5] 'digit-argument)
1661 (define-key map [kp-6] 'digit-argument)
1662 (define-key map [kp-7] 'digit-argument)
1663 (define-key map [kp-8] 'digit-argument)
1664 (define-key map [kp-9] 'digit-argument)
1665 (define-key map [kp-subtract] 'universal-argument-minus)
1666 map)
1669 (defvar universal-argument-num-events nil
1670 "Number of argument-specifying events read by `universal-argument'.
1671 `universal-argument-other-key' uses this to discard those events
1672 from (this-command-keys), and reread only the final command.")
1674 (defvar overriding-map-is-bound nil
1675 "Non-nil when `overriding-terminal-local-map' is `universal-argument-map'.")
1677 (defvar saved-overriding-map nil
1678 "The saved value of `overriding-terminal-local-map'.
1682 (defun ensure-overriding-map-is-bound ()
1683 "Check `overriding-terminal-local-map' is `universal-argument-map'."
1684 (unless overriding-map-is-bound
1685 (setq saved-overriding-map overriding-terminal-local-map)
1686 (setq overriding-terminal-local-map universal-argument-map)
1687 (setq overriding-map-is-bound t)))
1689 (defun restore-overriding-map ()
1690 "Restore `overriding-terminal-local-map' to its saved value."
1691 (setq overriding-terminal-local-map saved-overriding-map)
1692 (setq overriding-map-is-bound nil))
1694 (defun universal-argument ()
1695 "Begin a numeric argument for the following command.
1700 multiplies the argument by 4 each time.
1702 which is different in effect from any particular numeric argument.
1704 (interactive)
1705 (setq prefix-arg (list 4))
1706 (setq universal-argument-num-events (length (this-command-keys)))
1707 (ensure-overriding-map-is-bound))
1709 ;; A subsequent C-u means to multiply the factor by 4 if we've typed
1710 ;; nothing but C-u's; otherwise it means to terminate the prefix arg.
1711 (defun universal-argument-more (arg)
1712 (interactive "P")
1713 (if (consp arg)
1714 (setq prefix-arg (list (* 4 (car arg))))
1715 (if (eq arg '-)
1716 (setq prefix-arg (list -4))
1717 (setq prefix-arg arg)
1718 (restore-overriding-map)))
1719 (setq universal-argument-num-events (length (this-command-keys))))
1721 (defun negative-argument (arg)
1722 "Begin a negative numeric argument for the next command.
1724 (interactive "P")
1725 (cond ((integerp arg)
1726 (setq prefix-arg (- arg)))
1727 ((eq arg '-)
1728 (setq prefix-arg nil))
1729 (t
1730 (setq prefix-arg '-)))
1731 (setq universal-argument-num-events (length (this-command-keys)))
1732 (ensure-overriding-map-is-bound))
1734 (defun digit-argument (arg)
1735 "Part of the numeric argument for the next command.
1737 (interactive "P")
1738 (let* ((char (if (integerp last-command-char)
1739 last-command-char
1740 (get last-command-char 'ascii-character)))
1742 (cond ((integerp arg)
1743 (setq prefix-arg (+ (* arg 10)
1744 (if (< arg 0) (- digit) digit))))
1745 ((eq arg '-)
1746 ;; Treat -0 as just -, so that -01 will work.
1747 (setq prefix-arg (if (zerop digit) '- (- digit))))
1748 (t
1749 (setq prefix-arg digit))))
1750 (setq universal-argument-num-events (length (this-command-keys)))
1751 (ensure-overriding-map-is-bound))
1753 ;; For backward compatibility, minus with no modifiers is an ordinary
1754 ;; command if digits have already been entered.
1755 (defun universal-argument-minus (arg)
1756 (interactive "P")
1757 (if (integerp arg)
1758 (universal-argument-other-key arg)
1759 (negative-argument arg)))
1761 ;; Anything else terminates the argument and is left in the queue to be
1762 ;; executed as a command.
1763 (defun universal-argument-other-key (arg)
1764 (interactive "P")
1765 (setq prefix-arg arg)
1766 (let* ((key (this-command-keys))
1767 (keylist (listify-key-sequence key)))
1768 (setq unread-command-events
1769 (append (nthcdr universal-argument-num-events keylist)
1770 unread-command-events)))
1771 (reset-this-command-lengths)
1772 (restore-overriding-map))
1773 \f
1774 ;;;; Window system cut and paste hooks.
1776 (defvar interprogram-cut-function nil
1777 "Function to call to make a killed region available to other programs.
1779 Most window systems provide some sort of facility for cutting and
1780 pasting text between the windows of different programs.
1781 This variable holds a function that Emacs calls whenever text
1782 is put in the kill ring, to make the new kill available to other
1783 programs.
1785 The function takes one or two arguments.
1786 The first argument, TEXT, is a string containing
1787 the text which should be made available.
1788 The second, optional, argument PUSH, has the same meaning as the
1789 similar argument to `x-set-cut-buffer', which see.")
1791 (defvar interprogram-paste-function nil
1792 "Function to call to get text cut from other programs.
1794 Most window systems provide some sort of facility for cutting and
1795 pasting text between the windows of different programs.
1796 This variable holds a function that Emacs calls to obtain
1797 text that other programs have provided for pasting.
1799 The function should be called with no arguments. If the function
1800 returns nil, then no other program has provided such text, and the top
1801 of the Emacs kill ring should be used. If the function returns a
1802 string, then the caller of the function \(usually `current-kill')
1803 should put this string in the kill ring as the latest kill.
1805 Note that the function should return a string only if a program other
1806 than Emacs has provided a string for pasting; if Emacs provided the
1807 most recent string, the function should return nil. If it is
1808 difficult to tell whether Emacs or some other program provided the
1809 current string, it is probably good enough to return nil if the string
1810 is equal (according to `string=') to the last text Emacs provided.")
1811 \f
1814 ;;;; The kill ring data structure.
1816 (defvar kill-ring nil
1817 "List of killed text sequences.
1818 Since the kill ring is supposed to interact nicely with cut-and-paste
1819 facilities offered by window systems, use of this variable should
1820 interact nicely with `interprogram-cut-function' and
1821 `interprogram-paste-function'. The functions `kill-new',
1822 `kill-append', and `current-kill' are supposed to implement this
1823 interaction; you may want to use them instead of manipulating the kill
1824 ring directly.")
1826 (defcustom kill-ring-max 60
1827 "*Maximum length of kill ring before oldest elements are thrown away."
1828 :type 'integer
1829 :group 'killing)
1831 (defvar kill-ring-yank-pointer nil
1832 "The tail of the kill ring whose car is the last thing yanked.")
1834 (defun kill-new (string &optional replace yank-handler)
1835 "Make STRING the latest kill in the kill ring.
1836 Set `kill-ring-yank-pointer' to point to it.
1837 If `interprogram-cut-function' is non-nil, apply it to STRING.
1838 Optional second argument REPLACE non-nil means that STRING will replace
1839 the front of the kill ring, rather than being added to the list.
1841 Optional third arguments YANK-HANDLER controls how the STRING is later
1842 inserted into a buffer; see `insert-for-yank' for details.
1843 When a yank handler is specified, STRING must be non-empty (the yank
1844 handler, if non-nil, is stored as a `yank-handler' text property on STRING).
1846 When the yank handler has a non-nil PARAM element, the original STRING
1847 argument is not used by `insert-for-yank'. However, since Lisp code
1848 may access and use elements from the kill-ring directly, the STRING
1850 (if (> (length string) 0)
1851 (if yank-handler
1852 (put-text-property 0 (length string)
1853 'yank-handler yank-handler string))
1854 (if yank-handler
1855 (signal 'args-out-of-range
1856 (list string "yank-handler specified for empty string"))))
1857 (if (fboundp 'menu-bar-update-yank-menu)
1858 (menu-bar-update-yank-menu string (and replace (car kill-ring))))
1859 (if (and replace kill-ring)
1860 (setcar kill-ring string)
1861 (setq kill-ring (cons string kill-ring))
1862 (if (> (length kill-ring) kill-ring-max)
1863 (setcdr (nthcdr (1- kill-ring-max) kill-ring) nil)))
1864 (setq kill-ring-yank-pointer kill-ring)
1865 (if interprogram-cut-function
1866 (funcall interprogram-cut-function string (not replace))))
1868 (defun kill-append (string before-p &optional yank-handler)
1869 "Append STRING to the end of the latest kill in the kill ring.
1870 If BEFORE-P is non-nil, prepend STRING to the kill.
1871 Optional third argument YANK-HANDLER, if non-nil, specifies the
1872 yank-handler text property to be set on the combined kill ring
1873 string. If the specified yank-handler arg differs from the
1874 yank-handler property of the latest kill string, this function
1875 adds the combined string to the kill ring as a new element,
1876 instead of replacing the last kill with it.
1877 If `interprogram-cut-function' is set, pass the resulting kill to it."
1878 (let* ((cur (car kill-ring)))
1879 (kill-new (if before-p (concat string cur) (concat cur string))
1880 (or (= (length cur) 0)
1881 (equal yank-handler (get-text-property 0 'yank-handler cur)))
1882 yank-handler)))
1884 (defun current-kill (n &optional do-not-move)
1885 "Rotate the yanking point by N places, and then return that kill.
1886 If N is zero, `interprogram-paste-function' is set, and calling it
1887 returns a string, then that string is added to the front of the
1888 kill ring and returned as the latest kill.
1889 If optional arg DO-NOT-MOVE is non-nil, then don't actually move the
1890 yanking point; just return the Nth kill forward."
1891 (let ((interprogram-paste (and (= n 0)
1892 interprogram-paste-function
1893 (funcall interprogram-paste-function))))
1894 (if interprogram-paste
1895 (progn
1896 ;; Disable the interprogram cut function when we add the new
1897 ;; text to the kill ring, so Emacs doesn't try to own the
1898 ;; selection, with identical text.
1899 (let ((interprogram-cut-function nil))
1900 (kill-new interprogram-paste))
1901 interprogram-paste)
1902 (or kill-ring (error "Kill ring is empty"))
1903 (let ((ARGth-kill-element
1904 (nthcdr (mod (- n (length kill-ring-yank-pointer))
1905 (length kill-ring))
1906 kill-ring)))
1907 (or do-not-move
1908 (setq kill-ring-yank-pointer ARGth-kill-element))
1909 (car ARGth-kill-element)))))
1913 ;;;; Commands for manipulating the kill ring.
1915 (defcustom kill-read-only-ok nil
1916 "*Non-nil means don't signal an error for killing read-only text."
1917 :type 'boolean
1918 :group 'killing)
1920 (put 'text-read-only 'error-conditions
1921 '(text-read-only buffer-read-only error))
1922 (put 'text-read-only 'error-message "Text is read-only")
1924 (defun kill-region (beg end &optional yank-handler)
1925 "Kill between point and mark.
1926 The text is deleted but saved in the kill ring.
1930 If you want to append the killed region to the last killed text,
1933 If the buffer is read-only, Emacs will beep and refrain from deleting
1934 the text, but put the text in the kill ring anyway. This means that
1935 you can use the killing commands to copy text from a read-only buffer.
1937 This is the primitive for programs to kill text (as opposed to deleting it).
1938 Supply two arguments, character numbers indicating the stretch of text
1939 to be killed.
1941 If the previous command was also a kill command,
1942 the text killed this time appends to the text killed last time
1943 to make one entry in the kill ring.
1945 In Lisp code, optional third arg YANK-HANDLER, if non-nil,
1946 specifies the yank-handler text property to be set on the killed
1947 text. See `insert-for-yank'."
1948 (interactive "r")
1949 (condition-case nil
1950 (let ((string (delete-and-extract-region beg end)))
1951 (when string ;STRING is nil if BEG = END
1952 ;; Add that string to the kill ring, one way or another.
1953 (if (eq last-command 'kill-region)
1954 (kill-append string (< end beg) yank-handler)
1955 (kill-new string nil yank-handler)))
1956 (when (or string (eq last-command 'kill-region))
1957 (setq this-command 'kill-region))
1958 nil)
1959 ((buffer-read-only text-read-only)
1960 ;; The code above failed because the buffer, or some of the characters
1961 ;; in the region, are read-only.
1962 ;; We should beep, in case the user just isn't aware of this.
1963 ;; However, there's no harm in putting
1964 ;; the region's text in the kill ring, anyway.
1965 (copy-region-as-kill beg end)
1966 ;; Set this-command now, so it will be set even if we get an error.
1967 (setq this-command 'kill-region)
1968 ;; This should barf, if appropriate, and give us the correct error.
1969 (if kill-read-only-ok
1970 (progn (message "Read only text copied to kill ring") nil)
1971 ;; Signal an error if the buffer is read-only.
1972 (barf-if-buffer-read-only)
1973 ;; If the buffer isn't read-only, the text is.
1974 (signal 'text-read-only (list (current-buffer)))))))
1976 ;; copy-region-as-kill no longer sets this-command, because it's confusing
1977 ;; to get two copies of the text when the user accidentally types M-w and
1978 ;; then corrects it with the intended C-w.
1979 (defun copy-region-as-kill (beg end)
1980 "Save the region as if killed, but don't kill it.
1981 In Transient Mark mode, deactivate the mark.
1982 If `interprogram-cut-function' is non-nil, also save the text for a window
1983 system cut and paste."
1984 (interactive "r")
1985 (if (eq last-command 'kill-region)
1986 (kill-append (buffer-substring beg end) (< end beg))
1987 (kill-new (buffer-substring beg end)))
1988 (if transient-mark-mode
1989 (setq deactivate-mark t))
1990 nil)
1992 (defun kill-ring-save (beg end)
1993 "Save the region as if killed, but don't kill it.
1994 In Transient Mark mode, deactivate the mark.
1995 If `interprogram-cut-function' is non-nil, also save the text for a window
1996 system cut and paste.
1998 If you want to append the killed line to the last killed text,
2001 This command is similar to `copy-region-as-kill', except that it gives
2002 visual feedback indicating the extent of the region being copied."
2003 (interactive "r")
2004 (copy-region-as-kill beg end)
2005 (if (interactive-p)
2006 (let ((other-end (if (= (point) beg) end beg))
2007 (opoint (point))
2008 ;; Inhibit quitting so we can make a quit here
2009 ;; look like a C-g typed as a command.
2010 (inhibit-quit t))
2011 (if (pos-visible-in-window-p other-end (selected-window))
2012 (unless transient-mark-mode
2013 ;; Swap point and mark.
2014 (set-marker (mark-marker) (point) (current-buffer))
2015 (goto-char other-end)
2016 (sit-for 1)
2017 ;; Swap back.
2018 (set-marker (mark-marker) other-end (current-buffer))
2019 (goto-char opoint)
2020 ;; If user quit, deactivate the mark
2021 ;; as C-g would as a command.
2022 (and quit-flag mark-active
2023 (deactivate-mark)))
2024 (let* ((killed-text (current-kill 0))
2025 (message-len (min (length killed-text) 40)))
2026 (if (= (point) beg)
2027 ;; Don't say "killed"; that is misleading.
2029 (substring killed-text (- message-len)))
2031 (substring killed-text 0 message-len))))))))
2033 (defun append-next-kill (&optional interactive)
2034 "Cause following command, if it kills, to append to previous kill.
2035 The argument is used for internal purposes; do not supply one."
2036 (interactive "p")
2037 ;; We don't use (interactive-p), since that breaks kbd macros.
2038 (if interactive
2039 (progn
2040 (setq this-command 'kill-region)
2041 (message "If the next command is a kill, it will append"))
2042 (setq last-command 'kill-region)))
2043 \f
2044 ;; Yanking.
2046 ;; This is actually used in subr.el but defcustom does not work there.
2047 (defcustom yank-excluded-properties
2048 '(read-only invisible intangible field mouse-face help-echo local-map keymap
2049 yank-handler)
2050 "*Text properties to discard when yanking.
2051 The value should be a list of text properties to discard or t,
2052 which means to discard all text properties."
2053 :type '(choice (const :tag "All" t) (repeat symbol))
2054 :group 'editing
2055 :version "21.4")
2057 (defvar yank-window-start nil)
2058 (defvar yank-undo-function nil
2059 "If non-nil, function used by `yank-pop' to delete last stretch of yanked text.
2060 Function is called with two parameters, START and END corresponding to
2061 the value of the mark and point; it is guaranteed that START <= END.
2062 Normally set from the UNDO element of a yank-handler; see `insert-for-yank'.")
2064 (defun yank-pop (&optional arg)
2065 "Replace just-yanked stretch of killed text with a different stretch.
2066 This command is allowed only immediately after a `yank' or a `yank-pop'.
2067 At such a time, the region contains a stretch of reinserted
2068 previously-killed text. `yank-pop' deletes that text and inserts in its
2069 place a different stretch of killed text.
2071 With no argument, the previous kill is inserted.
2072 With argument N, insert the Nth previous kill.
2073 If N is negative, this is a more recent kill.
2075 The sequence of kills wraps around, so that after the oldest one
2076 comes the newest one."
2077 (interactive "*p")
2078 (if (not (eq last-command 'yank))
2079 (error "Previous command was not a yank"))
2080 (setq this-command 'yank)
2081 (unless arg (setq arg 1))
2082 (let ((inhibit-read-only t)
2083 (before (< (point) (mark t))))
2084 (if before
2085 (funcall (or yank-undo-function 'delete-region) (point) (mark t))
2086 (funcall (or yank-undo-function 'delete-region) (mark t) (point)))
2087 (setq yank-undo-function nil)
2088 (set-marker (mark-marker) (point) (current-buffer))
2089 (insert-for-yank (current-kill arg))
2090 ;; Set the window start back where it was in the yank command,
2091 ;; if possible.
2092 (set-window-start (selected-window) yank-window-start t)
2093 (if before
2094 ;; This is like exchange-point-and-mark, but doesn't activate the mark.
2095 ;; It is cleaner to avoid activation, even though the command
2096 ;; loop would deactivate the mark because we inserted text.
2097 (goto-char (prog1 (mark t)
2098 (set-marker (mark-marker) (point) (current-buffer))))))
2099 nil)
2101 (defun yank (&optional arg)
2102 "Reinsert the last stretch of killed text.
2103 More precisely, reinsert the stretch of killed text most recently
2104 killed OR yanked. Put point at end, and set mark at beginning.
2105 With just \\[universal-argument] as argument, same but put point at beginning (and mark at end).
2106 With argument N, reinsert the Nth most recently killed stretch of killed
2107 text.
2109 (interactive "*P")
2110 (setq yank-window-start (window-start))
2111 ;; If we don't get all the way thru, make last-command indicate that
2112 ;; for the following command.
2113 (setq this-command t)
2114 (push-mark (point))
2115 (insert-for-yank (current-kill (cond
2116 ((listp arg) 0)
2117 ((eq arg '-) -2)
2118 (t (1- arg)))))
2119 (if (consp arg)
2120 ;; This is like exchange-point-and-mark, but doesn't activate the mark.
2121 ;; It is cleaner to avoid activation, even though the command
2122 ;; loop would deactivate the mark because we inserted text.
2123 (goto-char (prog1 (mark t)
2124 (set-marker (mark-marker) (point) (current-buffer)))))
2125 ;; If we do get all the way thru, make this-command indicate that.
2126 (if (eq this-command t)
2127 (setq this-command 'yank))
2128 nil)
2130 (defun rotate-yank-pointer (arg)
2131 "Rotate the yanking point in the kill ring.
2132 With argument, rotate that many kills forward (or backward, if negative)."
2133 (interactive "p")
2134 (current-kill arg))
2135 \f
2136 ;; Some kill commands.
2138 ;; Internal subroutine of delete-char
2139 (defun kill-forward-chars (arg)
2140 (if (listp arg) (setq arg (car arg)))
2141 (if (eq arg '-) (setq arg -1))
2142 (kill-region (point) (forward-point arg)))
2144 ;; Internal subroutine of backward-delete-char
2145 (defun kill-backward-chars (arg)
2146 (if (listp arg) (setq arg (car arg)))
2147 (if (eq arg '-) (setq arg -1))
2148 (kill-region (point) (forward-point (- arg))))
2150 (defcustom backward-delete-char-untabify-method 'untabify
2151 "*The method for untabifying when deleting backward.
2152 Can be `untabify' -- turn a tab to many spaces, then delete one space;
2153 `hungry' -- delete all whitespace, both tabs and spaces;
2154 `all' -- delete all whitespace, including tabs, spaces and newlines;
2155 nil -- just delete one character."
2156 :type '(choice (const untabify) (const hungry) (const all) (const nil))
2157 :version "20.3"
2158 :group 'killing)
2160 (defun backward-delete-char-untabify (arg &optional killp)
2161 "Delete characters backward, changing tabs into spaces.
2162 The exact behavior depends on `backward-delete-char-untabify-method'.
2163 Delete ARG chars, and kill (save in kill ring) if KILLP is non-nil.
2164 Interactively, ARG is the prefix arg (default 1)
2165 and KILLP is t if a prefix arg was specified."
2167 (when (eq backward-delete-char-untabify-method 'untabify)
2168 (let ((count arg))
2169 (save-excursion
2170 (while (and (> count 0) (not (bobp)))
2172 (let ((col (current-column)))
2173 (forward-char -1)
2174 (setq col (- col (current-column)))
2175 (insert-char ?\ col)
2176 (delete-char 1)))
2177 (forward-char -1)
2178 (setq count (1- count))))))
2179 (delete-backward-char
2181 ((eq backward-delete-char-untabify-method 'all)
2183 (if skip
2184 (let ((wh (- (point) (save-excursion (skip-chars-backward skip)
2185 (point)))))
2186 (+ arg (if (zerop wh) 0 (1- wh))))
2187 arg))
2188 killp))
2190 (defun zap-to-char (arg char)
2191 "Kill up to and including ARG'th occurrence of CHAR.
2192 Case is ignored if `case-fold-search' is non-nil in the current buffer.
2193 Goes backward if ARG is negative; error if CHAR not found."
2195 (kill-region (point) (progn
2196 (search-forward (char-to-string char) nil nil arg)
2197 ; (goto-char (if (> arg 0) (1- (point)) (1+ (point))))
2198 (point))))
2200 ;; kill-line and its subroutines.
2202 (defcustom kill-whole-line nil
2203 "*If non-nil, `kill-line' with no arg at beg of line kills the whole line."
2204 :type 'boolean
2205 :group 'killing)
2207 (defun kill-line (&optional arg)
2208 "Kill the rest of the current line; if no nonblanks there, kill thru newline.
2209 With prefix argument, kill that many lines from point.
2210 Negative arguments kill lines backward.
2211 With zero argument, kills the text before point on the current line.
2214 a number counts as a prefix arg.
2216 To kill a whole line, when point is not at the beginning, type \
2219 If `kill-whole-line' is non-nil, then this command kills the whole line
2220 including its terminating newline, when used at the beginning of a line
2221 with no argument. As a consequence, you can always kill a whole line
2224 If you want to append the killed line to the last killed text,
2227 If the buffer is read-only, Emacs will beep and refrain from deleting
2228 the line, but put the line in the kill ring anyway. This means that
2229 you can use this command to copy text from a read-only buffer.
2230 \(If the variable `kill-read-only-ok' is non-nil, then this won't
2231 even beep.)"
2232 (interactive "P")
2233 (kill-region (point)
2234 ;; It is better to move point to the other end of the kill
2235 ;; before killing. That way, in a read-only buffer, point
2236 ;; moves across the text that is copied to the kill ring.
2237 ;; The choice has no effect on undo now that undo records
2238 ;; the value of point from before the command was run.
2239 (progn
2240 (if arg
2241 (forward-visible-line (prefix-numeric-value arg))
2242 (if (eobp)
2243 (signal 'end-of-buffer nil))
2244 (let ((end
2245 (save-excursion
2246 (end-of-visible-line) (point))))
2247 (if (or (save-excursion
2248 ;; If trailing whitespace is visible,
2249 ;; don't treat it as nothing.
2250 (unless show-trailing-whitespace
2252 (= (point) end))
2253 (and kill-whole-line (bolp)))
2254 (forward-visible-line 1)
2255 (goto-char end))))
2256 (point))))
2258 (defun kill-whole-line (&optional arg)
2259 "Kill current line.
2260 With prefix arg, kill that many lines starting from the current line.
2261 If arg is negative, kill backward. Also kill the preceding newline.
2262 \(This is meant to make C-x z work well with negative arguments.\)
2263 If arg is zero, kill current line but exclude the trailing newline."
2264 (interactive "P")
2265 (setq arg (prefix-numeric-value arg))
2266 (if (and (> arg 0) (eobp) (save-excursion (forward-visible-line 0) (eobp)))
2267 (signal 'end-of-buffer nil))
2268 (if (and (< arg 0) (bobp) (save-excursion (end-of-visible-line) (bobp)))
2269 (signal 'beginning-of-buffer nil))
2270 (unless (eq last-command 'kill-region)
2271 (kill-new "")
2272 (setq last-command 'kill-region))
2273 (cond ((zerop arg)
2274 ;; We need to kill in two steps, because the previous command
2275 ;; could have been a kill command, in which case the text
2276 ;; before point needs to be prepended to the current kill
2277 ;; ring entry and the text after point appended. Also, we
2278 ;; need to use save-excursion to avoid copying the same text
2279 ;; twice to the kill ring in read-only buffers.
2280 (save-excursion
2281 (kill-region (point) (progn (forward-visible-line 0) (point))))
2282 (kill-region (point) (progn (end-of-visible-line) (point))))
2283 ((< arg 0)
2284 (save-excursion
2285 (kill-region (point) (progn (end-of-visible-line) (point))))
2286 (kill-region (point)
2287 (progn (forward-visible-line (1+ arg))
2288 (unless (bobp) (backward-char))
2289 (point))))
2290 (t
2291 (save-excursion
2292 (kill-region (point) (progn (forward-visible-line 0) (point))))
2293 (kill-region (point)
2294 (progn (forward-visible-line arg) (point))))))
2296 (defun forward-visible-line (arg)
2297 "Move forward by ARG lines, ignoring currently invisible newlines only.
2298 If ARG is negative, move backward -ARG lines.
2299 If ARG is zero, move to the beginning of the current line."
2300 (condition-case nil
2301 (if (> arg 0)
2302 (progn
2303 (while (> arg 0)
2304 (or (zerop (forward-line 1))
2305 (signal 'end-of-buffer nil))
2306 ;; If the newline we just skipped is invisible,
2307 ;; don't count it.
2308 (let ((prop
2309 (get-char-property (1- (point)) 'invisible)))
2310 (if (if (eq buffer-invisibility-spec t)
2311 prop
2312 (or (memq prop buffer-invisibility-spec)
2313 (assq prop buffer-invisibility-spec)))
2314 (setq arg (1+ arg))))
2315 (setq arg (1- arg)))
2316 ;; If invisible text follows, and it is a number of complete lines,
2317 ;; skip it.
2318 (let ((opoint (point)))
2319 (while (and (not (eobp))
2320 (let ((prop
2321 (get-char-property (point) 'invisible)))
2322 (if (eq buffer-invisibility-spec t)
2323 prop
2324 (or (memq prop buffer-invisibility-spec)
2325 (assq prop buffer-invisibility-spec)))))
2326 (goto-char
2327 (if (get-text-property (point) 'invisible)
2328 (or (next-single-property-change (point) 'invisible)
2329 (point-max))
2330 (next-overlay-change (point)))))
2331 (unless (bolp)
2332 (goto-char opoint))))
2333 (let ((first t))
2334 (while (or first (<= arg 0))
2335 (if first
2336 (beginning-of-line)
2337 (or (zerop (forward-line -1))
2338 (signal 'beginning-of-buffer nil)))
2339 ;; If the newline we just moved to is invisible,
2340 ;; don't count it.
2341 (unless (bobp)
2342 (let ((prop
2343 (get-char-property (1- (point)) 'invisible)))
2344 (unless (if (eq buffer-invisibility-spec t)
2345 prop
2346 (or (memq prop buffer-invisibility-spec)
2347 (assq prop buffer-invisibility-spec)))
2348 (setq arg (1+ arg)))))
2349 (setq first nil))
2350 ;; If invisible text follows, and it is a number of complete lines,
2351 ;; skip it.
2352 (let ((opoint (point)))
2353 (while (and (not (bobp))
2354 (let ((prop
2355 (get-char-property (1- (point)) 'invisible)))
2356 (if (eq buffer-invisibility-spec t)
2357 prop
2358 (or (memq prop buffer-invisibility-spec)
2359 (assq prop buffer-invisibility-spec)))))
2360 (goto-char
2361 (if (get-text-property (1- (point)) 'invisible)
2362 (or (previous-single-property-change (point) 'invisible)
2363 (point-min))
2364 (previous-overlay-change (point)))))
2365 (unless (bolp)
2366 (goto-char opoint)))))
2367 ((beginning-of-buffer end-of-buffer)
2368 nil)))
2370 (defun end-of-visible-line ()
2371 "Move to end of current visible line."
2372 (end-of-line)
2373 ;; If the following character is currently invisible,
2374 ;; skip all characters with that same `invisible' property value,
2375 ;; then find the next newline.
2376 (while (and (not (eobp))
2377 (save-excursion
2379 (let ((prop
2380 (get-char-property (point) 'invisible)))
2381 (if (eq buffer-invisibility-spec t)
2382 prop
2383 (or (memq prop buffer-invisibility-spec)
2384 (assq prop buffer-invisibility-spec))))))
2386 (if (get-text-property (point) 'invisible)
2387 (goto-char (next-single-property-change (point) 'invisible))
2388 (goto-char (next-overlay-change (point))))
2389 (end-of-line)))
2390 \f
2391 (defun insert-buffer (buffer)
2392 "Insert after point the contents of BUFFER.
2393 Puts mark after the inserted text.
2394 BUFFER may be a buffer or a buffer name.
2396 This function is meant for the user to run interactively.
2397 Don't call it from programs: use `insert-buffer-substring' instead!"
2398 (interactive
2399 (list
2400 (progn
2401 (barf-if-buffer-read-only)
2402 (read-buffer "Insert buffer: "
2403 (if (eq (selected-window) (next-window (selected-window)))
2404 (other-buffer (current-buffer))
2405 (window-buffer (next-window (selected-window))))
2406 t))))
2407 (push-mark
2408 (save-excursion
2409 (insert-buffer-substring (get-buffer buffer))
2410 (point)))
2411 nil)
2413 (defun append-to-buffer (buffer start end)
2414 "Append to specified buffer the text of the region.
2415 It is inserted into that buffer before its point.
2417 When calling from a program, give three arguments:
2418 BUFFER (or buffer name), START and END.
2419 START and END specify the portion of the current buffer to be copied."
2420 (interactive
2421 (list (read-buffer "Append to buffer: " (other-buffer (current-buffer) t))
2422 (region-beginning) (region-end)))
2423 (let ((oldbuf (current-buffer)))
2424 (save-excursion
2425 (let* ((append-to (get-buffer-create buffer))
2426 (windows (get-buffer-window-list append-to t t))
2427 point)
2428 (set-buffer append-to)
2429 (setq point (point))
2430 (barf-if-buffer-read-only)
2431 (insert-buffer-substring oldbuf start end)
2432 (dolist (window windows)
2433 (when (= (window-point window) point)
2434 (set-window-point window (point))))))))
2436 (defun prepend-to-buffer (buffer start end)
2437 "Prepend to specified buffer the text of the region.
2438 It is inserted into that buffer after its point.
2440 When calling from a program, give three arguments:
2441 BUFFER (or buffer name), START and END.
2442 START and END specify the portion of the current buffer to be copied."
2444 (let ((oldbuf (current-buffer)))
2445 (save-excursion
2446 (set-buffer (get-buffer-create buffer))
2447 (barf-if-buffer-read-only)
2448 (save-excursion
2449 (insert-buffer-substring oldbuf start end)))))
2451 (defun copy-to-buffer (buffer start end)
2452 "Copy to specified buffer the text of the region.
2453 It is inserted into that buffer, replacing existing text there.
2455 When calling from a program, give three arguments:
2456 BUFFER (or buffer name), START and END.
2457 START and END specify the portion of the current buffer to be copied."
2459 (let ((oldbuf (current-buffer)))
2460 (save-excursion
2461 (set-buffer (get-buffer-create buffer))
2462 (barf-if-buffer-read-only)
2463 (erase-buffer)
2464 (save-excursion
2465 (insert-buffer-substring oldbuf start end)))))
2466 \f
2467 (put 'mark-inactive 'error-conditions '(mark-inactive error))
2468 (put 'mark-inactive 'error-message "The mark is not active now")
2470 (defun mark (&optional force)
2471 "Return this buffer's mark value as integer; error if mark inactive.
2472 If optional argument FORCE is non-nil, access the mark value
2473 even if the mark is not currently active, and return nil
2474 if there is no mark at all.
2476 If you are using this in an editing command, you are most likely making
2477 a mistake; see the documentation of `set-mark'."
2478 (if (or force (not transient-mark-mode) mark-active mark-even-if-inactive)
2479 (marker-position (mark-marker))
2480 (signal 'mark-inactive nil)))
2482 ;; Many places set mark-active directly, and several of them failed to also
2483 ;; run deactivate-mark-hook. This shorthand should simplify.
2484 (defsubst deactivate-mark ()
2485 "Deactivate the mark by setting `mark-active' to nil.
2486 \(That makes a difference only in Transient Mark mode.)
2487 Also runs the hook `deactivate-mark-hook'."
2488 (cond
2489 ((eq transient-mark-mode 'lambda)
2490 (setq transient-mark-mode nil))
2491 (transient-mark-mode
2492 (setq mark-active nil)
2493 (run-hooks 'deactivate-mark-hook))))
2495 (defun set-mark (pos)
2496 "Set this buffer's mark to POS. Don't use this function!
2497 That is to say, don't use this function unless you want
2498 the user to see that the mark has moved, and you want the previous
2499 mark position to be lost.
2501 Normally, when a new mark is set, the old one should go on the stack.
2502 This is why most applications should use push-mark, not set-mark.
2504 Novice Emacs Lisp programmers often try to use the mark for the wrong
2505 purposes. The mark saves a location for the user's convenience.
2506 Most editing commands should not alter the mark.
2507 To remember a location for internal use in the Lisp program,
2508 store it in a Lisp variable. Example:
2510 (let ((beg (point))) (forward-line 1) (delete-region beg (point)))."
2512 (if pos
2513 (progn
2514 (setq mark-active t)
2515 (run-hooks 'activate-mark-hook)
2516 (set-marker (mark-marker) pos (current-buffer)))
2517 ;; Normally we never clear mark-active except in Transient Mark mode.
2518 ;; But when we actually clear out the mark value too,
2519 ;; we must clear mark-active in any mode.
2520 (setq mark-active nil)
2521 (run-hooks 'deactivate-mark-hook)
2522 (set-marker (mark-marker) nil)))
2524 (defvar mark-ring nil
2525 "The list of former marks of the current buffer, most recent first.")
2526 (make-variable-buffer-local 'mark-ring)
2527 (put 'mark-ring 'permanent-local t)
2529 (defcustom mark-ring-max 16
2530 "*Maximum size of mark ring. Start discarding off end if gets this big."
2531 :type 'integer
2532 :group 'editing-basics)
2534 (defvar global-mark-ring nil
2535 "The list of saved global marks, most recent first.")
2537 (defcustom global-mark-ring-max 16
2538 "*Maximum size of global mark ring. \
2539 Start discarding off end if gets this big."
2540 :type 'integer
2541 :group 'editing-basics)
2543 (defun pop-to-mark-command ()
2544 "Jump to mark, and pop a new position for mark off the ring
2545 \(does not affect global mark ring\)."
2546 (interactive)
2547 (if (null (mark t))
2548 (error "No mark set in this buffer")
2549 (goto-char (mark t))
2550 (pop-mark)))
2552 (defun push-mark-command (arg &optional nomsg)
2553 "Set mark at where point is.
2554 If no prefix arg and mark is already set there, just activate it.
2555 Display `Mark set' unless the optional second arg NOMSG is non-nil."
2556 (interactive "P")
2557 (let ((mark (marker-position (mark-marker))))
2558 (if (or arg (null mark) (/= mark (point)))
2559 (push-mark nil nomsg t)
2560 (setq mark-active t)
2561 (unless nomsg
2562 (message "Mark activated")))))
2564 (defun set-mark-command (arg)
2565 "Set mark at where point is, or jump to mark.
2566 With no prefix argument, set mark, and push old mark position on local
2567 mark ring; also push mark on global mark ring if last mark was set in
2568 another buffer. Immediately repeating the command activates
2569 `transient-mark-mode' temporarily.
2572 jump to mark, and pop a new position
2573 for mark off the local mark ring \(this does not affect the global
2575 mark ring \(see `pop-global-mark'\).
2578 the next position off the local (or global) mark ring.
2582 set mark where point is.
2584 Novice Emacs Lisp programmers often try to use the mark for the wrong
2585 purposes. See the documentation of `set-mark' for more information."
2586 (interactive "P")
2587 (if (eq transient-mark-mode 'lambda)
2588 (setq transient-mark-mode nil))
2589 (cond
2590 ((and (consp arg) (> (prefix-numeric-value arg) 4))
2591 (push-mark-command nil))
2592 ((not (eq this-command 'set-mark-command))
2593 (if arg
2594 (pop-to-mark-command)
2595 (push-mark-command t)))
2596 ((eq last-command 'pop-to-mark-command)
2597 (setq this-command 'pop-to-mark-command)
2598 (pop-to-mark-command))
2599 ((and (eq last-command 'pop-global-mark) (not arg))
2600 (setq this-command 'pop-global-mark)
2601 (pop-global-mark))
2602 (arg
2603 (setq this-command 'pop-to-mark-command)
2604 (pop-to-mark-command))
2605 ((and (eq last-command 'set-mark-command)
2606 mark-active (null transient-mark-mode))
2607 (setq transient-mark-mode 'lambda)
2608 (message "Transient-mark-mode temporarily enabled"))
2609 (t
2610 (push-mark-command nil))))
2612 (defun push-mark (&optional location nomsg activate)
2613 "Set mark at LOCATION (point, by default) and push old mark on mark ring.
2614 If the last global mark pushed was not in the current buffer,
2615 also push LOCATION on the global mark ring.
2616 Display `Mark set' unless the optional second arg NOMSG is non-nil.
2617 In Transient Mark mode, activate mark if optional third arg ACTIVATE non-nil.
2619 Novice Emacs Lisp programmers often try to use the mark for the wrong
2620 purposes. See the documentation of `set-mark' for more information.
2622 In Transient Mark mode, this does not activate the mark."
2623 (unless (null (mark t))
2624 (setq mark-ring (cons (copy-marker (mark-marker)) mark-ring))
2625 (when (> (length mark-ring) mark-ring-max)
2626 (move-marker (car (nthcdr mark-ring-max mark-ring)) nil)
2627 (setcdr (nthcdr (1- mark-ring-max) mark-ring) nil)))
2628 (set-marker (mark-marker) (or location (point)) (current-buffer))
2629 ;; Now push the mark on the global mark ring.
2630 (if (and global-mark-ring
2631 (eq (marker-buffer (car global-mark-ring)) (current-buffer)))
2632 ;; The last global mark pushed was in this same buffer.
2633 ;; Don't push another one.
2634 nil
2635 (setq global-mark-ring (cons (copy-marker (mark-marker)) global-mark-ring))
2636 (when (> (length global-mark-ring) global-mark-ring-max)
2637 (move-marker (car (nthcdr global-mark-ring-max global-mark-ring)) nil)
2638 (setcdr (nthcdr (1- global-mark-ring-max) global-mark-ring) nil)))
2639 (or nomsg executing-kbd-macro (> (minibuffer-depth) 0)
2640 (message "Mark set"))
2641 (if (or activate (not transient-mark-mode))
2642 (set-mark (mark t)))
2643 nil)
2645 (defun pop-mark ()
2646 "Pop off mark ring into the buffer's actual mark.
2647 Does not set point. Does nothing if mark ring is empty."
2648 (when mark-ring
2649 (setq mark-ring (nconc mark-ring (list (copy-marker (mark-marker)))))
2650 (set-marker (mark-marker) (+ 0 (car mark-ring)) (current-buffer))
2651 (deactivate-mark)
2652 (move-marker (car mark-ring) nil)
2653 (if (null (mark t)) (ding))
2654 (setq mark-ring (cdr mark-ring))))
2656 (defalias 'exchange-dot-and-mark 'exchange-point-and-mark)
2657 (defun exchange-point-and-mark (&optional arg)
2658 "Put the mark where point is now, and point where the mark is now.
2659 This command works even when the mark is not active,
2660 and it reactivates the mark.
2661 With prefix arg, `transient-mark-mode' is enabled temporarily."
2662 (interactive "P")
2663 (if arg
2664 (if mark-active
2665 (if (null transient-mark-mode)
2666 (setq transient-mark-mode 'lambda))
2667 (setq arg nil)))
2668 (unless arg
2669 (let ((omark (mark t)))
2670 (if (null omark)
2671 (error "No mark set in this buffer"))
2672 (set-mark (point))
2673 (goto-char omark)
2674 nil)))
2676 (define-minor-mode transient-mark-mode
2677 "Toggle Transient Mark mode.
2678 With arg, turn Transient Mark mode on if arg is positive, off otherwise.
2680 In Transient Mark mode, when the mark is active, the region is highlighted.
2682 So do certain other operations that set the mark
2683 but whose main purpose is something else--for example,
2689 Many commands change their behavior when Transient Mark mode is in effect
2690 and the mark is active, by acting on the region instead of their usual
2691 default part of the buffer's text. Examples of such commands include
2695 the prompt, to see the documentation of commands which are sensitive to
2696 the Transient Mark mode."
2697 :global t :group 'editing-basics :require nil)
2699 (defun pop-global-mark ()
2700 "Pop off global mark ring and jump to the top location."
2701 (interactive)
2702 ;; Pop entries which refer to non-existent buffers.
2703 (while (and global-mark-ring (not (marker-buffer (car global-mark-ring))))
2704 (setq global-mark-ring (cdr global-mark-ring)))
2705 (or global-mark-ring
2706 (error "No global mark set"))
2707 (let* ((marker (car global-mark-ring))
2708 (buffer (marker-buffer marker))
2709 (position (marker-position marker)))
2710 (setq global-mark-ring (nconc (cdr global-mark-ring)
2711 (list (car global-mark-ring))))
2712 (set-buffer buffer)
2713 (or (and (>= position (point-min))
2714 (<= position (point-max)))
2715 (widen))
2716 (goto-char position)
2717 (switch-to-buffer buffer)))
2718 \f
2719 (defcustom next-line-add-newlines nil
2720 "*If non-nil, `next-line' inserts newline to avoid `end of buffer' error."
2721 :type 'boolean
2722 :version "21.1"
2723 :group 'editing-basics)
2725 (defun next-line (&optional arg)
2726 "Move cursor vertically down ARG lines.
2727 If there is no character in the target line exactly under the current column,
2728 the cursor is positioned after the character in that line which spans this
2729 column, or at the end of the line if it is not long enough.
2730 If there is no line in the buffer after this one, behavior depends on the
2731 value of `next-line-add-newlines'. If non-nil, it inserts a newline character
2732 to create a line, and moves the cursor to that line. Otherwise it moves the
2733 cursor to the end of the buffer.
2736 a semipermanent goal column for this command.
2737 Then instead of trying to move exactly vertically (or as close as possible),
2738 this command moves to the specified goal column (or as close as possible).
2739 The goal column is stored in the variable `goal-column', which is nil
2740 when there is no goal column.
2742 If you are thinking of using this in a Lisp program, consider
2743 using `forward-line' instead. It is usually easier to use
2744 and more reliable (no dependence on goal column, etc.)."
2745 (interactive "p")
2746 (or arg (setq arg 1))
2747 (if (and next-line-add-newlines (= arg 1))
2748 (if (save-excursion (end-of-line) (eobp))
2749 ;; When adding a newline, don't expand an abbrev.
2750 (let ((abbrev-mode nil))
2751 (end-of-line)
2753 (line-move arg))
2754 (if (interactive-p)
2755 (condition-case nil
2756 (line-move arg)
2757 ((beginning-of-buffer end-of-buffer) (ding)))
2758 (line-move arg)))
2759 nil)
2761 (defun previous-line (&optional arg)
2762 "Move cursor vertically up ARG lines.
2763 If there is no character in the target line exactly over the current column,
2764 the cursor is positioned after the character in that line which spans this
2765 column, or at the end of the line if it is not long enough.
2768 a semipermanent goal column for this command.
2769 Then instead of trying to move exactly vertically (or as close as possible),
2770 this command moves to the specified goal column (or as close as possible).
2771 The goal column is stored in the variable `goal-column', which is nil
2772 when there is no goal column.
2774 If you are thinking of using this in a Lisp program, consider using
2775 `forward-line' with a negative argument instead. It is usually easier
2776 to use and more reliable (no dependence on goal column, etc.)."
2777 (interactive "p")
2778 (or arg (setq arg 1))
2779 (if (interactive-p)
2780 (condition-case nil
2781 (line-move (- arg))
2782 ((beginning-of-buffer end-of-buffer) (ding)))
2783 (line-move (- arg)))
2784 nil)
2786 (defcustom track-eol nil
2787 "*Non-nil means vertical motion starting at end of line keeps to ends of lines.
2788 This means moving to the end of each line moved onto.
2789 The beginning of a blank line does not count as the end of a line."
2790 :type 'boolean
2791 :group 'editing-basics)
2793 (defcustom goal-column nil
2795 :type '(choice integer
2796 (const :tag "None" nil))
2797 :group 'editing-basics)
2798 (make-variable-buffer-local 'goal-column)
2800 (defvar temporary-goal-column 0
2801 "Current goal column for vertical motion.
2802 It is the column where point was
2803 at the start of current run of vertical motion commands.
2804 When the `track-eol' feature is doing its job, the value is 9999.")
2806 (defcustom line-move-ignore-invisible nil
2808 Outline mode sets this."
2809 :type 'boolean
2810 :group 'editing-basics)
2812 (defun line-move-invisible (pos)
2813 "Return non-nil if the character after POS is currently invisible."
2814 (let ((prop
2815 (get-char-property pos 'invisible)))
2816 (if (eq buffer-invisibility-spec t)
2817 prop
2818 (or (memq prop buffer-invisibility-spec)
2819 (assq prop buffer-invisibility-spec)))))
2821 ;; This is the guts of next-line and previous-line.
2822 ;; Arg says how many lines to move.
2823 (defun line-move (arg)
2824 ;; Don't run any point-motion hooks, and disregard intangibility,
2825 ;; for intermediate positions.
2826 (let ((inhibit-point-motion-hooks t)
2827 (opoint (point))
2828 new line-end line-beg)
2829 (unwind-protect
2830 (progn
2831 (if (not (memq last-command '(next-line previous-line)))
2832 (setq temporary-goal-column
2833 (if (and track-eol (eolp)
2834 ;; Don't count beg of empty line as end of line
2835 ;; unless we just did explicit end-of-line.
2836 (or (not (bolp)) (eq last-command 'end-of-line)))
2837 9999
2838 (current-column))))
2839 (if (and (not (integerp selective-display))
2840 (not line-move-ignore-invisible))
2841 ;; Use just newline characters.
2842 ;; Set ARG to 0 if we move as many lines as requested.
2843 (or (if (> arg 0)
2844 (progn (if (> arg 1) (forward-line (1- arg)))
2845 ;; This way of moving forward ARG lines
2846 ;; verifies that we have a newline after the last one.
2847 ;; It doesn't get confused by intangible text.
2848 (end-of-line)
2849 (if (zerop (forward-line 1))
2850 (setq arg 0)))
2851 (and (zerop (forward-line arg))
2852 (bolp)
2853 (setq arg 0)))
2854 (signal (if (< arg 0)
2855 'beginning-of-buffer
2856 'end-of-buffer)
2857 nil))
2858 ;; Move by arg lines, but ignore invisible ones.
2859 (while (> arg 0)
2860 ;; If the following character is currently invisible,
2861 ;; skip all characters with that same `invisible' property value.
2862 (while (and (not (eobp)) (line-move-invisible (point)))
2863 (goto-char (next-char-property-change (point))))
2864 ;; Now move a line.
2865 (end-of-line)
2866 (and (zerop (vertical-motion 1))
2867 (signal 'end-of-buffer nil))
2868 (setq arg (1- arg)))
2869 (while (< arg 0)
2870 (beginning-of-line)
2871 (and (zerop (vertical-motion -1))
2872 (signal 'beginning-of-buffer nil))
2873 (setq arg (1+ arg))
2874 (while (and (not (bobp)) (line-move-invisible (1- (point))))
2875 (goto-char (previous-char-property-change (point)))))))
2877 (cond ((> arg 0)
2878 ;; If we did not move down as far as desired,
2879 ;; at least go to end of line.
2880 (end-of-line))
2881 ((< arg 0)
2882 ;; If we did not move down as far as desired,
2883 ;; at least go to end of line.
2884 (beginning-of-line))
2885 (t
2886 (line-move-finish (or goal-column temporary-goal-column) opoint)))))
2887 nil)
2889 (defun line-move-finish (column opoint)
2890 (let ((repeat t))
2891 (while repeat
2892 ;; Set REPEAT to t to repeat the whole thing.
2893 (setq repeat nil)
2895 (let (new
2896 (line-beg (save-excursion (beginning-of-line) (point)))
2897 (line-end
2898 ;; Compute the end of the line
2899 ;; ignoring effectively intangible newlines.
2900 (let ((inhibit-point-motion-hooks nil)
2901 (inhibit-field-text-motion t))
2902 (save-excursion (end-of-line) (point)))))
2904 ;; Move to the desired column.
2905 (line-move-to-column column)
2906 (setq new (point))
2908 ;; Process intangibility within a line.
2909 ;; Move to the chosen destination position from above,
2910 ;; with intangibility processing enabled.
2912 (goto-char (point-min))
2913 (let ((inhibit-point-motion-hooks nil))
2914 (goto-char new)
2916 ;; If intangibility moves us to a different (later) place
2917 ;; in the same line, use that as the destination.
2918 (if (<= (point) line-end)
2919 (setq new (point))
2920 ;; If that position is "too late",
2921 ;; try the previous allowable position.
2922 ;; See if it is ok.
2923 (backward-char)
2924 (if (<= (point) line-end)
2925 (setq new (point))
2926 ;; As a last resort, use the end of the line.
2927 (setq new line-end))))
2929 ;; Now move to the updated destination, processing fields
2930 ;; as well as intangibility.
2931 (goto-char opoint)
2932 (let ((inhibit-point-motion-hooks nil))
2933 (goto-char
2934 (constrain-to-field new opoint nil t
2935 'inhibit-line-move-field-capture)))
2937 ;; If all this moved us to a different line,
2938 ;; retry everything within that new line.
2939 (when (or (< (point) line-beg) (> (point) line-end))
2940 ;; Repeat the intangibility and field processing.
2941 (setq repeat t))))))
2943 (defun line-move-to-column (col)
2944 "Try to find column COL, considering invisibility.
2945 This function works only in certain cases,
2946 because what we really need is for `move-to-column'
2947 and `current-column' to be able to ignore invisible text."
2948 (if (zerop col)
2949 (beginning-of-line)
2950 (move-to-column col))
2952 (when (and line-move-ignore-invisible
2953 (not (bolp)) (line-move-invisible (1- (point))))
2954 (let ((normal-location (point))
2955 (normal-column (current-column)))
2956 ;; If the following character is currently invisible,
2957 ;; skip all characters with that same `invisible' property value.
2958 (while (and (not (eobp))
2959 (line-move-invisible (point)))
2960 (goto-char (next-char-property-change (point))))
2961 ;; Have we advanced to a larger column position?
2962 (if (> (current-column) normal-column)
2963 ;; We have made some progress towards the desired column.
2964 ;; See if we can make any further progress.
2965 (line-move-to-column (+ (current-column) (- col normal-column)))
2966 ;; Otherwise, go to the place we originally found
2967 ;; and move back over invisible text.
2968 ;; that will get us to the same place on the screen
2969 ;; but with a more reasonable buffer position.
2970 (goto-char normal-location)
2971 (let ((line-beg (save-excursion (beginning-of-line) (point))))
2972 (while (and (not (bolp)) (line-move-invisible (1- (point))))
2973 (goto-char (previous-char-property-change (point) line-beg))))))))
2975 ;;; Many people have said they rarely use this feature, and often type
2976 ;;; it by accident. Maybe it shouldn't even be on a key.
2977 (put 'set-goal-column 'disabled t)
2979 (defun set-goal-column (arg)
2981 Those commands will move to this position in the line moved to
2982 rather than trying to keep the same horizontal position.
2983 With a non-nil argument, clears out the goal column
2985 The goal column is stored in the variable `goal-column'."
2986 (interactive "P")
2987 (if arg
2988 (progn
2989 (setq goal-column nil)
2990 (message "No goal column"))
2991 (setq goal-column (current-column))
2992 (message (substitute-command-keys
2994 goal-column))
2995 nil)
2996 \f
2998 (defun scroll-other-window-down (lines)
3000 For more details, see the documentation for `scroll-other-window'."
3001 (interactive "P")
3002 (scroll-other-window
3003 ;; Just invert the argument's meaning.
3004 ;; We can do that without knowing which window it will be.
3005 (if (eq lines '-) nil
3006 (if (null lines) '-
3007 (- (prefix-numeric-value lines))))))
3008 (define-key esc-map [?\C-\S-v] 'scroll-other-window-down)
3010 (defun beginning-of-buffer-other-window (arg)
3011 "Move point to the beginning of the buffer in the other window.
3012 Leave mark at previous position.
3013 With arg N, put point N/10 of the way from the true beginning."
3014 (interactive "P")
3015 (let ((orig-window (selected-window))
3016 (window (other-window-for-scrolling)))
3017 ;; We use unwind-protect rather than save-window-excursion
3018 ;; because the latter would preserve the things we want to change.
3019 (unwind-protect
3020 (progn
3021 (select-window window)
3022 ;; Set point and mark in that window's buffer.
3023 (beginning-of-buffer arg)
3024 ;; Set point accordingly.
3025 (recenter '(t)))
3026 (select-window orig-window))))
3028 (defun end-of-buffer-other-window (arg)
3029 "Move point to the end of the buffer in the other window.
3030 Leave mark at previous position.
3031 With arg N, put point N/10 of the way from the true end."
3032 (interactive "P")
3033 ;; See beginning-of-buffer-other-window for comments.
3034 (let ((orig-window (selected-window))
3035 (window (other-window-for-scrolling)))
3036 (unwind-protect
3037 (progn
3038 (select-window window)
3039 (end-of-buffer arg)
3040 (recenter '(t)))
3041 (select-window orig-window))))
3042 \f
3043 (defun transpose-chars (arg)
3044 "Interchange characters around point, moving forward one character.
3045 With prefix arg ARG, effect is to take character before point
3046 and drag it forward past ARG other characters (backward if ARG negative).
3047 If no argument and at end of line, the previous two chars are exchanged."
3048 (interactive "*P")
3049 (and (null arg) (eolp) (forward-char -1))
3050 (transpose-subr 'forward-char (prefix-numeric-value arg)))
3052 (defun transpose-words (arg)
3053 "Interchange words around point, leaving point at end of them.
3054 With prefix arg ARG, effect is to take word before or around point
3055 and drag it forward past ARG other words (backward if ARG negative).
3056 If ARG is zero, the words around or after point and around or after mark
3057 are interchanged."
3058 ;; FIXME: `foo a!nd bar' should transpose into `bar and foo'.
3059 (interactive "*p")
3060 (transpose-subr 'forward-word arg))
3062 (defun transpose-sexps (arg)
3064 Does not work on a sexp that point is in the middle of
3065 if it is a list or string."
3066 (interactive "*p")
3067 (transpose-subr
3068 (lambda (arg)
3069 ;; Here we should try to simulate the behavior of
3070 ;; (cons (progn (forward-sexp x) (point))
3071 ;; (progn (forward-sexp (- x)) (point)))
3072 ;; Except that we don't want to rely on the second forward-sexp
3073 ;; putting us back to where we want to be, since forward-sexp-function
3074 ;; might do funny things like infix-precedence.
3075 (if (if (> arg 0)
3077 (and (not (bobp))
3079 ;; Jumping over a symbol. We might be inside it, mind you.
3080 (progn (funcall (if (> arg 0)
3081 'skip-syntax-backward 'skip-syntax-forward)
3082 "w_")
3083 (cons (save-excursion (forward-sexp arg) (point)) (point)))
3084 ;; Otherwise, we're between sexps. Take a step back before jumping
3085 ;; to make sure we'll obey the same precedence no matter which direction
3086 ;; we're going.
3087 (funcall (if (> arg 0) 'skip-syntax-backward 'skip-syntax-forward) " .")
3088 (cons (save-excursion (forward-sexp arg) (point))
3089 (progn (while (or (forward-comment (if (> arg 0) 1 -1))
3090 (not (zerop (funcall (if (> arg 0)
3091 'skip-syntax-forward
3092 'skip-syntax-backward)
3093 ".")))))
3094 (point)))))
3095 arg 'special))
3097 (defun transpose-lines (arg)
3098 "Exchange current line and previous line, leaving point after both.
3099 With argument ARG, takes previous line and moves it past ARG lines.
3100 With argument 0, interchanges line point is in with line mark is in."
3101 (interactive "*p")
3102 (transpose-subr (function
3103 (lambda (arg)
3104 (if (> arg 0)
3105 (progn
3106 ;; Move forward over ARG lines,
3107 ;; but create newlines if necessary.
3108 (setq arg (forward-line arg))
3110 (setq arg (1+ arg)))
3111 (if (> arg 0)
3112 (newline arg)))
3113 (forward-line arg))))
3114 arg))
3116 (defun transpose-subr (mover arg &optional special)
3117 (let ((aux (if special mover
3118 (lambda (x)
3119 (cons (progn (funcall mover x) (point))
3120 (progn (funcall mover (- x)) (point))))))
3121 pos1 pos2)
3122 (cond
3123 ((= arg 0)
3124 (save-excursion
3125 (setq pos1 (funcall aux 1))
3126 (goto-char (mark))
3127 (setq pos2 (funcall aux 1))
3128 (transpose-subr-1 pos1 pos2))
3129 (exchange-point-and-mark))
3130 ((> arg 0)
3131 (setq pos1 (funcall aux -1))
3132 (setq pos2 (funcall aux arg))
3133 (transpose-subr-1 pos1 pos2)
3134 (goto-char (car pos2)))
3135 (t
3136 (setq pos1 (funcall aux -1))
3137 (goto-char (car pos1))
3138 (setq pos2 (funcall aux arg))
3139 (transpose-subr-1 pos1 pos2)))))
3141 (defun transpose-subr-1 (pos1 pos2)
3142 (when (> (car pos1) (cdr pos1)) (setq pos1 (cons (cdr pos1) (car pos1))))
3143 (when (> (car pos2) (cdr pos2)) (setq pos2 (cons (cdr pos2) (car pos2))))
3144 (when (> (car pos1) (car pos2))
3145 (let ((swap pos1))
3146 (setq pos1 pos2 pos2 swap)))
3147 (if (> (cdr pos1) (car pos2)) (error "Don't have two things to transpose"))
3148 (atomic-change-group
3149 (let (word2)
3150 ;; FIXME: We first delete the two pieces of text, so markers that
3151 ;; used to point to after the text end up pointing to before it :-(
3152 (setq word2 (delete-and-extract-region (car pos2) (cdr pos2)))
3153 (goto-char (car pos2))
3154 (insert (delete-and-extract-region (car pos1) (cdr pos1)))
3155 (goto-char (car pos1))
3156 (insert word2))))
3157 \f
3158 (defun backward-word (&optional arg)
3159 "Move backward until encountering the beginning of a word.
3160 With argument, do this that many times."
3161 (interactive "p")
3162 (forward-word (- (or arg 1))))
3164 (defun mark-word (arg)
3165 "Set mark arg words away from point.
3166 If this command is repeated, it marks the next ARG words after the ones
3167 already marked."
3168 (interactive "p")
3169 (cond ((and (eq last-command this-command) (mark t))
3170 (set-mark
3171 (save-excursion
3172 (goto-char (mark))
3173 (forward-word arg)
3174 (point))))
3175 (t
3176 (push-mark
3177 (save-excursion
3178 (forward-word arg)
3179 (point))
3180 nil t))))
3182 (defun kill-word (arg)
3183 "Kill characters forward until encountering the end of a word.
3184 With argument, do this that many times."
3185 (interactive "p")
3186 (kill-region (point) (progn (forward-word arg) (point))))
3188 (defun backward-kill-word (arg)
3189 "Kill characters backward until encountering the end of a word.
3190 With argument, do this that many times."
3191 (interactive "p")
3192 (kill-word (- arg)))
3194 (defun current-word (&optional strict really-word)
3195 "Return the symbol or word that point is on (or a nearby one) as a string.
3196 The return value includes no text properties.
3197 If optional arg STRICT is non-nil, return nil unless point is within
3198 or adjacent to a symbol or word.
3199 The function, belying its name, normally finds a symbol.
3200 If optional arg REALLY-WORD is non-nil, it finds just a word."
3201 (save-excursion
3202 (let* ((oldpoint (point)) (start (point)) (end (point))
3203 (syntaxes (if really-word "w" "w_"))
3204 (not-syntaxes (concat "^" syntaxes)))
3205 (skip-syntax-backward syntaxes) (setq start (point))
3206 (goto-char oldpoint)
3207 (skip-syntax-forward syntaxes) (setq end (point))
3208 (when (and (eq start oldpoint) (eq end oldpoint)
3209 ;; Point is neither within nor adjacent to a word.
3210 (not strict))
3211 ;; Look for preceding word in same line.
3212 (skip-syntax-backward not-syntaxes
3213 (save-excursion (beginning-of-line)
3214 (point)))
3215 (if (bolp)
3216 ;; No preceding word in same line.
3217 ;; Look for following word in same line.
3218 (progn
3219 (skip-syntax-forward not-syntaxes
3220 (save-excursion (end-of-line)
3221 (point)))
3222 (setq start (point))
3223 (skip-syntax-forward syntaxes)
3224 (setq end (point)))
3225 (setq end (point))
3226 (skip-syntax-backward syntaxes)
3227 (setq start (point))))
3228 ;; If we found something nonempty, return it as a string.
3229 (unless (= start end)
3230 (buffer-substring-no-properties start end)))))
3231 \f
3232 (defcustom fill-prefix nil
3233 "*String for filling to insert at front of new line, or nil for none."
3234 :type '(choice (const :tag "None" nil)
3235 string)
3236 :group 'fill)
3237 (make-variable-buffer-local 'fill-prefix)
3239 (defcustom auto-fill-inhibit-regexp nil
3240 "*Regexp to match lines which should not be auto-filled."
3241 :type '(choice (const :tag "None" nil)
3242 regexp)
3243 :group 'fill)
3245 (defvar comment-line-break-function 'comment-indent-new-line
3246 "*Mode-specific function which line breaks and continues a comment.
3248 This function is only called during auto-filling of a comment section.
3249 The function should take a single optional argument, which is a flag
3250 indicating whether it should use soft newlines.
3252 Setting this variable automatically makes it local to the current buffer.")
3254 ;; This function is used as the auto-fill-function of a buffer
3255 ;; when Auto-Fill mode is enabled.
3256 ;; It returns t if it really did any work.
3257 ;; (Actually some major modes use a different auto-fill function,
3258 ;; but this one is the default one.)
3259 (defun do-auto-fill ()
3260 (let (fc justify bol give-up
3261 (fill-prefix fill-prefix))
3262 (if (or (not (setq justify (current-justification)))
3263 (null (setq fc (current-fill-column)))
3264 (and (eq justify 'left)
3265 (<= (current-column) fc))
3266 (save-excursion (beginning-of-line)
3267 (setq bol (point))
3268 (and auto-fill-inhibit-regexp
3269 (looking-at auto-fill-inhibit-regexp))))
3270 nil ;; Auto-filling not required
3271 (if (memq justify '(full center right))
3272 (save-excursion (unjustify-current-line)))
3274 ;; Choose a fill-prefix automatically.
3275 (when (and adaptive-fill-mode
3276 (or (null fill-prefix) (string= fill-prefix "")))
3277 (let ((prefix
3278 (fill-context-prefix
3279 (save-excursion (backward-paragraph 1) (point))
3280 (save-excursion (forward-paragraph 1) (point)))))
3281 (and prefix (not (equal prefix ""))
3282 ;; Use auto-indentation rather than a guessed empty prefix.
3283 (not (and fill-indent-according-to-mode
3285 (setq fill-prefix prefix))))
3287 (while (and (not give-up) (> (current-column) fc))
3288 ;; Determine where to split the line.
3289 (let* (after-prefix
3290 (fill-point
3291 (let ((opoint (point)))
3292 (save-excursion
3293 (beginning-of-line)
3294 (setq after-prefix (point))
3295 (and fill-prefix
3296 (looking-at (regexp-quote fill-prefix))
3297 (setq after-prefix (match-end 0)))
3298 (move-to-column (1+ fc))
3299 (fill-move-to-break-point after-prefix)
3300 (point)))))
3302 ;; See whether the place we found is any good.
3303 (if (save-excursion
3304 (goto-char fill-point)
3305 (or (bolp)
3306 ;; There is no use breaking at end of line.
3307 (save-excursion (skip-chars-forward " ") (eolp))
3308 ;; It is futile to split at the end of the prefix
3309 ;; since we would just insert the prefix again.
3310 (and after-prefix (<= (point) after-prefix))
3311 ;; Don't split right after a comment starter
3312 ;; since we would just make another comment starter.
3313 (and comment-start-skip
3314 (let ((limit (point)))
3315 (beginning-of-line)
3316 (and (re-search-forward comment-start-skip
3317 limit t)
3318 (eq (point) limit))))))
3319 ;; No good place to break => stop trying.
3320 (setq give-up t)
3321 ;; Ok, we have a useful place to break the line. Do it.
3322 (let ((prev-column (current-column)))
3323 ;; If point is at the fill-point, do not `save-excursion'.
3324 ;; Otherwise, if a comment prefix or fill-prefix is inserted,
3325 ;; point will end up before it rather than after it.
3326 (if (save-excursion
3328 (= (point) fill-point))
3329 (funcall comment-line-break-function t)
3330 (save-excursion
3331 (goto-char fill-point)
3332 (funcall comment-line-break-function t)))
3333 ;; Now do justification, if required
3334 (if (not (eq justify 'left))
3335 (save-excursion
3336 (end-of-line 0)
3337 (justify-current-line justify nil t)))
3338 ;; If making the new line didn't reduce the hpos of
3339 ;; the end of the line, then give up now;
3340 ;; trying again will not help.
3341 (if (>= (current-column) prev-column)
3342 (setq give-up t))))))
3343 ;; Justify last line.
3344 (justify-current-line justify t t)
3345 t)))
3347 (defvar normal-auto-fill-function 'do-auto-fill
3348 "The function to use for `auto-fill-function' if Auto Fill mode is turned on.
3349 Some major modes set this.")
3351 ;; FIXME: turn into a proper minor mode.
3352 ;; Add a global minor mode version of it.
3353 (defun auto-fill-mode (&optional arg)
3354 "Toggle Auto Fill mode.
3355 With arg, turn Auto Fill mode on if and only if arg is positive.
3356 In Auto Fill mode, inserting a space at a column beyond `current-fill-column'
3357 automatically breaks the line at a previous space.
3359 The value of `normal-auto-fill-function' specifies the function to use
3360 for `auto-fill-function' when turning Auto Fill mode on."
3361 (interactive "P")
3362 (prog1 (setq auto-fill-function
3363 (if (if (null arg)
3364 (not auto-fill-function)
3365 (> (prefix-numeric-value arg) 0))
3366 normal-auto-fill-function
3367 nil))
3368 (force-mode-line-update)))
3370 ;; This holds a document string used to document auto-fill-mode.
3371 (defun auto-fill-function ()
3372 "Automatically break line at a previous space, in insertion of text."
3373 nil)
3375 (defun turn-on-auto-fill ()
3376 "Unconditionally turn on Auto Fill mode."
3377 (auto-fill-mode 1))
3379 (defun turn-off-auto-fill ()
3380 "Unconditionally turn off Auto Fill mode."
3381 (auto-fill-mode -1))
3383 (custom-add-option 'text-mode-hook 'turn-on-auto-fill)
3385 (defun set-fill-column (arg)
3386 "Set `fill-column' to specified argument.
3389 (interactive "P")
3390 (if (consp arg)
3391 (setq arg (current-column)))
3392 (if (not (integerp arg))
3393 ;; Disallow missing argument; it's probably a typo for C-x C-f.
3394 (error "Set-fill-column requires an explicit argument")
3395 (message "Fill column set to %d (was %d)" arg fill-column)
3396 (setq fill-column arg)))
3397 \f
3398 (defun set-selective-display (arg)
3399 "Set `selective-display' to ARG; clear it if no arg.
3400 When the value of `selective-display' is a number > 0,
3401 lines whose indentation is >= that value are not displayed.
3402 The variable `selective-display' has a separate value for each buffer."
3403 (interactive "P")
3404 (if (eq selective-display t)
3405 (error "selective-display already in use for marked lines"))
3406 (let ((current-vpos
3407 (save-restriction
3408 (narrow-to-region (point-min) (point))
3409 (goto-char (window-start))
3410 (vertical-motion (window-height)))))
3411 (setq selective-display
3412 (and arg (prefix-numeric-value arg)))
3413 (recenter current-vpos))
3414 (set-window-start (selected-window) (window-start (selected-window)))
3415 (princ "selective-display set to " t)
3416 (prin1 selective-display t)
3417 (princ "." t))
3419 (defvaralias 'indicate-unused-lines 'indicate-empty-lines)
3420 (defvaralias 'default-indicate-unused-lines 'default-indicate-empty-lines)
3422 (defun toggle-truncate-lines (arg)
3423 "Toggle whether to fold or truncate long lines on the screen.
3424 With arg, truncate long lines iff arg is positive.
3425 Note that in side-by-side windows, truncation is always enabled."
3426 (interactive "P")
3427 (setq truncate-lines
3428 (if (null arg)
3429 (not truncate-lines)
3430 (> (prefix-numeric-value arg) 0)))
3431 (force-mode-line-update)
3432 (unless truncate-lines
3433 (let ((buffer (current-buffer)))
3434 (walk-windows (lambda (window)
3435 (if (eq buffer (window-buffer window))
3436 (set-window-hscroll window 0)))
3437 nil t)))
3438 (message "Truncate long lines %s"
3439 (if truncate-lines "enabled" "disabled")))
3441 (defvar overwrite-mode-textual " Ovwrt"
3442 "The string displayed in the mode line when in overwrite mode.")
3443 (defvar overwrite-mode-binary " Bin Ovwrt"
3444 "The string displayed in the mode line when in binary overwrite mode.")
3446 (defun overwrite-mode (arg)
3447 "Toggle overwrite mode.
3448 With arg, turn overwrite mode on iff arg is positive.
3449 In overwrite mode, printing characters typed in replace existing text
3450 on a one-for-one basis, rather than pushing it to the right. At the
3451 end of a line, such characters extend the line. Before a tab,
3452 such characters insert until the tab is filled in.
3454 is supposed to make it easier to insert characters when necessary."
3455 (interactive "P")
3456 (setq overwrite-mode
3457 (if (if (null arg) (not overwrite-mode)
3458 (> (prefix-numeric-value arg) 0))
3459 'overwrite-mode-textual))
3460 (force-mode-line-update))
3462 (defun binary-overwrite-mode (arg)
3463 "Toggle binary overwrite mode.
3464 With arg, turn binary overwrite mode on iff arg is positive.
3465 In binary overwrite mode, printing characters typed in replace
3466 existing text. Newlines are not treated specially, so typing at the
3467 end of a line joins the line to the next, with the typed character
3468 between them. Typing before a tab character simply replaces the tab
3469 with the character typed.
3471 typing characters do.
3473 Note that binary overwrite mode is not its own minor mode; it is a
3474 specialization of overwrite-mode, entered by setting the
3475 `overwrite-mode' variable to `overwrite-mode-binary'."
3476 (interactive "P")
3477 (setq overwrite-mode
3478 (if (if (null arg)
3479 (not (eq overwrite-mode 'overwrite-mode-binary))
3480 (> (prefix-numeric-value arg) 0))
3481 'overwrite-mode-binary))
3482 (force-mode-line-update))
3484 (define-minor-mode line-number-mode
3485 "Toggle Line Number mode.
3486 With arg, turn Line Number mode on iff arg is positive.
3487 When Line Number mode is enabled, the line number appears
3488 in the mode line.
3490 Line numbers do not appear for very large buffers and buffers
3491 with very long lines; see variables `line-number-display-limit'
3492 and `line-number-display-limit-width'."
3493 :init-value t :global t :group 'editing-basics :require nil)
3495 (define-minor-mode column-number-mode
3496 "Toggle Column Number mode.
3497 With arg, turn Column Number mode on iff arg is positive.
3498 When Column Number mode is enabled, the column number appears
3499 in the mode line."
3500 :global t :group 'editing-basics :require nil)
3502 (define-minor-mode size-indication-mode
3503 "Toggle Size Indication mode.
3504 With arg, turn Size Indication mode on iff arg is positive. When
3505 Size Indication mode is enabled, the size of the accessible part
3506 of the buffer appears in the mode line."
3507 :global t :group 'editing-basics :require nil)
3508 \f
3509 (defgroup paren-blinking nil
3510 "Blinking matching of parens and expressions."
3511 :prefix "blink-matching-"
3512 :group 'paren-matching)
3514 (defcustom blink-matching-paren t
3515 "*Non-nil means show matching open-paren when close-paren is inserted."
3516 :type 'boolean
3517 :group 'paren-blinking)
3519 (defcustom blink-matching-paren-on-screen t
3520 "*Non-nil means show matching open-paren when it is on screen.
3521 If nil, means don't show it (but the open-paren can still be shown
3522 when it is off screen)."
3523 :type 'boolean
3524 :group 'paren-blinking)
3526 (defcustom blink-matching-paren-distance (* 25 1024)
3527 "*If non-nil, is maximum distance to search for matching open-paren."
3528 :type 'integer
3529 :group 'paren-blinking)
3531 (defcustom blink-matching-delay 1
3532 "*Time in seconds to delay after showing a matching paren."
3533 :type 'number
3534 :group 'paren-blinking)
3536 (defcustom blink-matching-paren-dont-ignore-comments nil
3537 "*Non-nil means `blink-matching-paren' will not ignore comments."
3538 :type 'boolean
3539 :group 'paren-blinking)
3541 (defun blink-matching-open ()
3542 "Move cursor momentarily to the beginning of the sexp before point."
3543 (interactive)
3544 (and (> (point) (1+ (point-min)))
3545 blink-matching-paren
3546 ;; Verify an even number of quoting characters precede the close.
3547 (= 1 (logand 1 (- (point)
3548 (save-excursion
3549 (forward-char -1)
3551 (point)))))
3552 (let* ((oldpos (point))
3553 (blinkpos)
3554 (mismatch)
3555 matching-paren)
3556 (save-excursion
3557 (save-restriction
3558 (if blink-matching-paren-distance
3559 (narrow-to-region (max (point-min)
3560 (- (point) blink-matching-paren-distance))
3561 oldpos))
3562 (condition-case ()
3563 (let ((parse-sexp-ignore-comments
3564 (and parse-sexp-ignore-comments
3565 (not blink-matching-paren-dont-ignore-comments))))
3566 (setq blinkpos (scan-sexps oldpos -1)))
3567 (error nil)))
3568 (and blinkpos
3569 (save-excursion
3570 (goto-char blinkpos)
3572 (setq matching-paren
3573 (or (and parse-sexp-lookup-properties
3574 (let ((prop (get-text-property blinkpos 'syntax-table)))
3575 (and (consp prop)
3576 (eq (car prop) 4)
3577 (cdr prop))))
3578 (matching-paren (char-after blinkpos)))
3579 mismatch
3580 (or (null matching-paren)
3581 (/= (char-after (1- oldpos))
3582 matching-paren))))
3583 (if mismatch (setq blinkpos nil))
3584 (if blinkpos
3585 ;; Don't log messages about paren matching.
3586 (let (message-log-max)
3587 (goto-char blinkpos)
3588 (if (pos-visible-in-window-p)
3589 (and blink-matching-paren-on-screen
3590 (sit-for blink-matching-delay))
3591 (goto-char blinkpos)
3592 (message
3593 "Matches %s"
3594 ;; Show what precedes the open in its line, if anything.
3595 (if (save-excursion
3597 (not (bolp)))
3598 (buffer-substring (progn (beginning-of-line) (point))
3599 (1+ blinkpos))
3600 ;; Show what follows the open in its line, if anything.
3601 (if (save-excursion
3602 (forward-char 1)
3604 (not (eolp)))
3605 (buffer-substring blinkpos
3606 (progn (end-of-line) (point)))
3607 ;; Otherwise show the previous nonblank line,
3608 ;; if there is one.
3609 (if (save-excursion
3611 (not (bobp)))
3612 (concat
3613 (buffer-substring (progn
3615 (beginning-of-line)
3616 (point))
3617 (progn (end-of-line)
3619 (point)))
3620 ;; Replace the newline and other whitespace with `...'.
3621 "..."
3622 (buffer-substring blinkpos (1+ blinkpos)))
3623 ;; There is nothing to show except the char itself.
3624 (buffer-substring blinkpos (1+ blinkpos))))))))
3625 (cond (mismatch
3626 (message "Mismatched parentheses"))
3627 ((not blink-matching-paren-distance)
3628 (message "Unmatched parenthesis"))))))))
3630 ;Turned off because it makes dbx bomb out.
3631 (setq blink-paren-function 'blink-matching-open)
3632 \f
3633 ;; This executes C-g typed while Emacs is waiting for a command.
3634 ;; Quitting out of a program does not go through here;
3635 ;; that happens in the QUIT macro at the C code level.
3636 (defun keyboard-quit ()
3637 "Signal a `quit' condition.
3638 During execution of Lisp code, this character causes a quit directly.
3639 At top-level, as an editor command, this simply beeps."
3640 (interactive)
3641 (deactivate-mark)
3642 (setq defining-kbd-macro nil)
3643 (signal 'quit nil))
3645 (define-key global-map "\C-g" 'keyboard-quit)
3647 (defvar buffer-quit-function nil
3650 \(such as cancelling a prefix argument, minibuffer or region) do not apply.")
3652 (defun keyboard-escape-quit ()
3654 This command can exit an interactive command such as `query-replace',
3655 can clear out a prefix argument or a region,
3656 can get out of the minibuffer or other recursive edit,
3657 cancel the use of the current buffer (for special-purpose buffers),
3658 or go back to just one window (by deleting all but the selected window)."
3659 (interactive)
3660 (cond ((eq last-command 'mode-exited) nil)
3661 ((> (minibuffer-depth) 0)
3662 (abort-recursive-edit))
3663 (current-prefix-arg
3664 nil)
3665 ((and transient-mark-mode
3666 mark-active)
3667 (deactivate-mark))
3668 ((> (recursion-depth) 0)
3669 (exit-recursive-edit))
3670 (buffer-quit-function
3671 (funcall buffer-quit-function))
3672 ((not (one-window-p t))
3673 (delete-other-windows))
3675 (bury-buffer))))
3677 (defun play-sound-file (file &optional volume device)
3678 "Play sound stored in FILE.
3679 VOLUME and DEVICE correspond to the keywords of the sound
3680 specification for `play-sound'."
3681 (interactive "fPlay sound file: ")
3682 (let ((sound (list :file file)))
3683 (if volume
3684 (plist-put sound :volume volume))
3685 (if device
3686 (plist-put sound :device device))
3687 (push 'sound sound)
3688 (play-sound sound)))
3690 (define-key global-map "\e\e\e" 'keyboard-escape-quit)
3692 (defcustom read-mail-command 'rmail
3693 "*Your preference for a mail reading package.
3694 This is used by some keybindings which support reading mail.
3695 See also `mail-user-agent' concerning sending mail."
3696 :type '(choice (function-item rmail)
3697 (function-item gnus)
3698 (function-item mh-rmail)
3699 (function :tag "Other"))
3700 :version "21.1"
3701 :group 'mail)
3703 (defcustom mail-user-agent 'sendmail-user-agent
3704 "*Your preference for a mail composition package.
3705 Various Emacs Lisp packages (e.g. Reporter) require you to compose an
3706 outgoing email message. This variable lets you specify which
3707 mail-sending package you prefer.
3709 Valid values include:
3711 `sendmail-user-agent' -- use the default Emacs Mail package.
3712 See Info node `(emacs)Sending Mail'.
3713 `mh-e-user-agent' -- use the Emacs interface to the MH mail system.
3714 See Info node `(mh-e)'.
3715 `message-user-agent' -- use the Gnus Message package.
3716 See Info node `(message)'.
3717 `gnus-user-agent' -- like `message-user-agent', but with Gnus
3718 paraphernalia, particularly the Gcc: header for
3719 archiving.
3721 Additional valid symbols may be available; check with the author of
3722 your package for details. The function should return non-nil if it
3723 succeeds.
3725 See also `read-mail-command' concerning reading mail."
3726 :type '(radio (function-item :tag "Default Emacs mail"
3728 sendmail-user-agent)
3729 (function-item :tag "Emacs interface to MH"
3731 mh-e-user-agent)
3732 (function-item :tag "Gnus Message package"
3734 message-user-agent)
3735 (function-item :tag "Gnus Message with full Gnus features"
3737 gnus-user-agent)
3738 (function :tag "Other"))
3739 :group 'mail)
3741 (define-mail-user-agent 'sendmail-user-agent
3742 'sendmail-user-agent-compose
3743 'mail-send-and-exit)
3745 (defun rfc822-goto-eoh ()
3746 ;; Go to header delimiter line in a mail message, following RFC822 rules
3747 (goto-char (point-min))
3748 (when (re-search-forward
3750 (goto-char (match-beginning 0))))
3752 (defun sendmail-user-agent-compose (&optional to subject other-headers continue
3753 switch-function yank-action
3754 send-actions)
3755 (if switch-function
3756 (let ((special-display-buffer-names nil)
3757 (special-display-regexps nil)
3758 (same-window-buffer-names nil)
3759 (same-window-regexps nil))
3760 (funcall switch-function "*mail*")))
3761 (let ((cc (cdr (assoc-string "cc" other-headers t)))
3762 (in-reply-to (cdr (assoc-string "in-reply-to" other-headers t)))
3763 (body (cdr (assoc-string "body" other-headers t))))
3764 (or (mail continue to subject in-reply-to cc yank-action send-actions)
3765 continue
3766 (error "Message aborted"))
3767 (save-excursion
3768 (rfc822-goto-eoh)
3769 (while other-headers
3770 (unless (member-ignore-case (car (car other-headers))
3771 '("in-reply-to" "cc" "body"))
3772 (insert (car (car other-headers)) ": "
3774 (setq other-headers (cdr other-headers)))
3775 (when body
3776 (forward-line 1)
3777 (insert body))
3778 t)))
3780 (define-mail-user-agent 'mh-e-user-agent
3781 'mh-smail-batch 'mh-send-letter 'mh-fully-kill-draft
3782 'mh-before-send-letter-hook)
3784 (defun compose-mail (&optional to subject other-headers continue
3785 switch-function yank-action send-actions)
3786 "Start composing a mail message to send.
3787 This uses the user's chosen mail composition package
3788 as selected with the variable `mail-user-agent'.
3789 The optional arguments TO and SUBJECT specify recipients
3790 and the initial Subject field, respectively.
3792 OTHER-HEADERS is an alist specifying additional
3793 header fields. Elements look like (HEADER . VALUE) where both
3794 HEADER and VALUE are strings.
3796 CONTINUE, if non-nil, says to continue editing a message already
3797 being composed.
3799 SWITCH-FUNCTION, if non-nil, is a function to use to
3800 switch to and display the buffer used for mail composition.
3802 YANK-ACTION, if non-nil, is an action to perform, if and when necessary,
3803 to insert the raw text of the message being replied to.
3804 It has the form (FUNCTION . ARGS). The user agent will apply
3805 FUNCTION to ARGS, to insert the raw text of the original message.
3806 \(The user agent will also run `mail-citation-hook', *after* the
3807 original text has been inserted in this way.)
3809 SEND-ACTIONS is a list of actions to call when the message is sent.
3810 Each action has the form (FUNCTION . ARGS)."
3811 (interactive
3812 (list nil nil nil current-prefix-arg))
3813 (let ((function (get mail-user-agent 'composefunc)))
3814 (funcall function to subject other-headers continue
3815 switch-function yank-action send-actions)))
3817 (defun compose-mail-other-window (&optional to subject other-headers continue
3818 yank-action send-actions)
3820 (interactive
3821 (list nil nil nil current-prefix-arg))
3822 (compose-mail to subject other-headers continue
3823 'switch-to-buffer-other-window yank-action send-actions))
3826 (defun compose-mail-other-frame (&optional to subject other-headers continue
3827 yank-action send-actions)
3829 (interactive
3830 (list nil nil nil current-prefix-arg))
3831 (compose-mail to subject other-headers continue
3832 'switch-to-buffer-other-frame yank-action send-actions))
3834 (defvar set-variable-value-history nil
3835 "History of values entered with `set-variable'.")
3837 (defun set-variable (var val &optional make-local)
3838 "Set VARIABLE to VALUE. VALUE is a Lisp object.
3839 When using this interactively, enter a Lisp object for VALUE.
3840 If you want VALUE to be a string, you must surround it with doublequotes.
3841 VALUE is used literally, not evaluated.
3843 If VARIABLE has a `variable-interactive' property, that is used as if
3844 it were the arg to `interactive' (which see) to interactively read VALUE.
3846 If VARIABLE has been defined with `defcustom', then the type information
3847 in the definition is used to check that VALUE is valid.
3849 With a prefix argument, set VARIABLE to VALUE buffer-locally."
3850 (interactive
3851 (let* ((default-var (variable-at-point))
3852 (var (if (symbolp default-var)
3853 (read-variable (format "Set variable (default %s): " default-var)
3854 default-var)
3855 (read-variable "Set variable: ")))
3856 (minibuffer-help-form '(describe-variable var))
3857 (prop (get var 'variable-interactive))
3858 (prompt (format "Set %s%s to value: " var
3859 (cond ((local-variable-p var)
3860 " (buffer-local)")
3861 ((or current-prefix-arg
3862 (local-variable-if-set-p var))
3863 " buffer-locally")
3864 (t " globally"))))
3865 (val (if prop
3866 ;; Use VAR's `variable-interactive' property
3867 ;; as an interactive spec for prompting.
3868 (call-interactively `(lambda (arg)
3869 (interactive ,prop)
3870 arg))
3871 (read
3872 (read-string prompt nil
3873 'set-variable-value-history)))))
3874 (list var val current-prefix-arg)))
3876 (and (custom-variable-p var)
3877 (not (get var 'custom-type))
3878 (custom-load-symbol var))
3879 (let ((type (get var 'custom-type)))
3880 (when type
3881 ;; Match with custom type.
3882 (require 'cus-edit)
3883 (setq type (widget-convert type))
3884 (unless (widget-apply type :match val)
3885 (error "Value `%S' does not match type %S of %S"
3886 val (car type) var))))
3888 (if make-local
3889 (make-local-variable var))
3891 (set var val)
3893 ;; Force a thorough redisplay for the case that the variable
3894 ;; has an effect on the display, like `tab-width' has.
3895 (force-mode-line-update))
3897 ;; Define the major mode for lists of completions.
3899 (defvar completion-list-mode-map nil
3900 "Local map for completion list buffers.")
3901 (or completion-list-mode-map
3902 (let ((map (make-sparse-keymap)))
3903 (define-key map [mouse-2] 'mouse-choose-completion)
3904 (define-key map [down-mouse-2] nil)
3905 (define-key map "\C-m" 'choose-completion)
3906 (define-key map "\e\e\e" 'delete-completion-window)
3907 (define-key map [left] 'previous-completion)
3908 (define-key map [right] 'next-completion)
3909 (setq completion-list-mode-map map)))
3911 ;; Completion mode is suitable only for specially formatted data.
3912 (put 'completion-list-mode 'mode-class 'special)
3914 (defvar completion-reference-buffer nil
3915 "Record the buffer that was current when the completion list was requested.
3916 This is a local variable in the completion list buffer.
3917 Initial value is nil to avoid some compiler warnings.")
3919 (defvar completion-no-auto-exit nil
3920 "Non-nil means `choose-completion-string' should never exit the minibuffer.
3921 This also applies to other functions such as `choose-completion'
3922 and `mouse-choose-completion'.")
3924 (defvar completion-base-size nil
3925 "Number of chars at beginning of minibuffer not involved in completion.
3926 This is a local variable in the completion list buffer
3927 but it talks about the buffer in `completion-reference-buffer'.
3928 If this is nil, it means to compare text to determine which part
3929 of the tail end of the buffer's text is involved in completion.")
3931 (defun delete-completion-window ()
3932 "Delete the completion list window.
3933 Go to the window from which completion was requested."
3934 (interactive)
3935 (let ((buf completion-reference-buffer))
3936 (if (one-window-p t)
3937 (if (window-dedicated-p (selected-window))
3938 (delete-frame (selected-frame)))
3939 (delete-window (selected-window))
3940 (if (get-buffer-window buf)
3941 (select-window (get-buffer-window buf))))))
3943 (defun previous-completion (n)
3944 "Move to the previous item in the completion list."
3945 (interactive "p")
3946 (next-completion (- n)))
3948 (defun next-completion (n)
3949 "Move to the next item in the completion list.
3950 With prefix argument N, move N items (negative N means move backward)."
3951 (interactive "p")
3952 (let ((beg (point-min)) (end (point-max)))
3953 (while (and (> n 0) (not (eobp)))
3954 ;; If in a completion, move to the end of it.
3955 (when (get-text-property (point) 'mouse-face)
3956 (goto-char (next-single-property-change (point) 'mouse-face nil end)))
3957 ;; Move to start of next one.
3958 (unless (get-text-property (point) 'mouse-face)
3959 (goto-char (next-single-property-change (point) 'mouse-face nil end)))
3960 (setq n (1- n)))
3961 (while (and (< n 0) (not (bobp)))
3962 (let ((prop (get-text-property (1- (point)) 'mouse-face)))
3963 ;; If in a completion, move to the start of it.
3964 (when (and prop (eq prop (get-text-property (point) 'mouse-face)))
3965 (goto-char (previous-single-property-change
3966 (point) 'mouse-face nil beg)))
3967 ;; Move to end of the previous completion.
3968 (unless (or (bobp) (get-text-property (1- (point)) 'mouse-face))
3969 (goto-char (previous-single-property-change
3970 (point) 'mouse-face nil beg)))
3971 ;; Move to the start of that one.
3972 (goto-char (previous-single-property-change
3973 (point) 'mouse-face nil beg))
3974 (setq n (1+ n))))))
3976 (defun choose-completion ()
3977 "Choose the completion that point is in or next to."
3978 (interactive)
3979 (let (beg end completion (buffer completion-reference-buffer)
3980 (base-size completion-base-size))
3981 (if (and (not (eobp)) (get-text-property (point) 'mouse-face))
3982 (setq end (point) beg (1+ (point))))
3983 (if (and (not (bobp)) (get-text-property (1- (point)) 'mouse-face))
3984 (setq end (1- (point)) beg (point)))
3985 (if (null beg)
3986 (error "No completion here"))
3987 (setq beg (previous-single-property-change beg 'mouse-face))
3988 (setq end (or (next-single-property-change end 'mouse-face) (point-max)))
3989 (setq completion (buffer-substring beg end))
3990 (let ((owindow (selected-window)))
3991 (if (and (one-window-p t 'selected-frame)
3992 (window-dedicated-p (selected-window)))
3993 ;; This is a special buffer's frame
3994 (iconify-frame (selected-frame))
3995 (or (window-dedicated-p (selected-window))
3996 (bury-buffer)))
3997 (select-window owindow))
3998 (choose-completion-string completion buffer base-size)))
4000 ;; Delete the longest partial match for STRING
4001 ;; that can be found before POINT.
4002 (defun choose-completion-delete-max-match (string)
4003 (let ((opoint (point))
4004 len)
4005 ;; Try moving back by the length of the string.
4006 (goto-char (max (- (point) (length string))
4007 (minibuffer-prompt-end)))
4008 ;; See how far back we were actually able to move. That is the
4009 ;; upper bound on how much we can match and delete.
4010 (setq len (- opoint (point)))
4011 (if completion-ignore-case
4012 (setq string (downcase string)))
4013 (while (and (> len 0)
4014 (let ((tail (buffer-substring (point) opoint)))
4015 (if completion-ignore-case
4016 (setq tail (downcase tail)))
4017 (not (string= tail (substring string 0 len)))))
4018 (setq len (1- len))
4019 (forward-char 1))
4020 (delete-char len)))
4022 (defvar choose-completion-string-functions nil
4023 "Functions that may override the normal insertion of a completion choice.
4024 These functions are called in order with four arguments:
4025 CHOICE - the string to insert in the buffer,
4026 BUFFER - the buffer in which the choice should be inserted,
4027 MINI-P - non-nil iff BUFFER is a minibuffer, and
4028 BASE-SIZE - the number of characters in BUFFER before
4029 the string being completed.
4031 If a function in the list returns non-nil, that function is supposed
4032 to have inserted the CHOICE in the BUFFER, and possibly exited
4033 the minibuffer; no further functions will be called.
4035 If all functions in the list return nil, that means to use
4036 the default method of inserting the completion in BUFFER.")
4038 (defun choose-completion-string (choice &optional buffer base-size)
4039 "Switch to BUFFER and insert the completion choice CHOICE.
4040 BASE-SIZE, if non-nil, says how many characters of BUFFER's text
4041 to keep. If it is nil, we call `choose-completion-delete-max-match'
4042 to decide what to delete."
4044 ;; If BUFFER is the minibuffer, exit the minibuffer
4045 ;; unless it is reading a file name and CHOICE is a directory,
4046 ;; or completion-no-auto-exit is non-nil.
4048 (let* ((buffer (or buffer completion-reference-buffer))
4049 (mini-p (minibufferp buffer)))
4050 ;; If BUFFER is a minibuffer, barf unless it's the currently
4051 ;; active minibuffer.
4052 (if (and mini-p
4053 (or (not (active-minibuffer-window))
4054 (not (equal buffer
4055 (window-buffer (active-minibuffer-window))))))
4056 (error "Minibuffer is not active for completion")
4057 (unless (run-hook-with-args-until-success
4058 'choose-completion-string-functions
4059 choice buffer mini-p base-size)
4060 ;; Insert the completion into the buffer where it was requested.
4061 (set-buffer buffer)
4062 (if base-size
4063 (delete-region (+ base-size (if mini-p
4064 (minibuffer-prompt-end)
4065 (point-min)))
4066 (point))
4067 (choose-completion-delete-max-match choice))
4068 (insert choice)
4069 (remove-text-properties (- (point) (length choice)) (point)
4070 '(mouse-face nil))
4071 ;; Update point in the window that BUFFER is showing in.
4072 (let ((window (get-buffer-window buffer t)))
4073 (set-window-point window (point)))
4074 ;; If completing for the minibuffer, exit it with this choice.
4075 (and (not completion-no-auto-exit)
4076 (equal buffer (window-buffer (minibuffer-window)))
4077 minibuffer-completion-table
4078 ;; If this is reading a file name, and the file name chosen
4079 ;; is a directory, don't exit the minibuffer.
4080 (if (and (eq minibuffer-completion-table 'read-file-name-internal)
4081 (file-directory-p (field-string (point-max))))
4082 (let ((mini (active-minibuffer-window)))
4083 (select-window mini)
4084 (when minibuffer-auto-raise
4085 (raise-frame (window-frame mini))))
4086 (exit-minibuffer)))))))
4088 (defun completion-list-mode ()
4089 "Major mode for buffers showing lists of possible completions.
4091 to select the completion near point.
4093 with the mouse."
4094 (interactive)
4095 (kill-all-local-variables)
4096 (use-local-map completion-list-mode-map)
4097 (setq mode-name "Completion List")
4098 (setq major-mode 'completion-list-mode)
4099 (make-local-variable 'completion-base-size)
4100 (setq completion-base-size nil)
4101 (run-hooks 'completion-list-mode-hook))
4103 (defun completion-list-mode-finish ()
4104 "Finish setup of the completions buffer.
4105 Called from `temp-buffer-show-hook'."
4106 (when (eq major-mode 'completion-list-mode)
4107 (toggle-read-only 1)))
4109 (add-hook 'temp-buffer-show-hook 'completion-list-mode-finish)
4111 (defvar completion-setup-hook nil
4112 "Normal hook run at the end of setting up a completion list buffer.
4113 When this hook is run, the current buffer is the one in which the
4114 command to display the completion list buffer was run.
4115 The completion list buffer is available as the value of `standard-output'.")
4117 ;; This function goes in completion-setup-hook, so that it is called
4118 ;; after the text of the completion list buffer is written.
4120 (defun completion-setup-function ()
4121 (save-excursion
4122 (let ((mainbuf (current-buffer))
4123 (mbuf-contents (minibuffer-contents)))
4124 ;; When reading a file name in the minibuffer,
4125 ;; set default-directory in the minibuffer
4126 ;; so it will get copied into the completion list buffer.
4127 (if minibuffer-completing-file-name
4128 (with-current-buffer mainbuf
4129 (setq default-directory (file-name-directory mbuf-contents))))
4130 (set-buffer standard-output)
4131 (completion-list-mode)
4132 (make-local-variable 'completion-reference-buffer)
4133 (setq completion-reference-buffer mainbuf)
4134 (if minibuffer-completing-file-name
4135 ;; For file name completion,
4136 ;; use the number of chars before the start of the
4137 ;; last file name component.
4138 (setq completion-base-size
4139 (save-excursion
4140 (set-buffer mainbuf)
4141 (goto-char (point-max))
4142 (skip-chars-backward "^/")
4143 (- (point) (minibuffer-prompt-end))))
4144 ;; Otherwise, in minibuffer, the whole input is being completed.
4145 (save-match-data
4146 (if (minibufferp mainbuf)
4147 (setq completion-base-size 0))))
4148 (goto-char (point-min))
4149 (if (display-mouse-p)
4150 (insert (substitute-command-keys
4152 (insert (substitute-command-keys
4156 (add-hook 'completion-setup-hook 'completion-setup-function)
4158 (define-key minibuffer-local-completion-map [prior]
4159 'switch-to-completions)
4160 (define-key minibuffer-local-must-match-map [prior]
4161 'switch-to-completions)
4162 (define-key minibuffer-local-completion-map "\M-v"
4163 'switch-to-completions)
4164 (define-key minibuffer-local-must-match-map "\M-v"
4165 'switch-to-completions)
4167 (defun switch-to-completions ()
4168 "Select the completion list window."
4169 (interactive)
4170 ;; Make sure we have a completions window.
4171 (or (get-buffer-window "*Completions*")
4172 (minibuffer-completion-help))
4173 (let ((window (get-buffer-window "*Completions*")))
4174 (when window
4175 (select-window window)
4176 (goto-char (point-min))
4178 (forward-line 1))))
4180 ;; Support keyboard commands to turn on various modifiers.
4182 ;; These functions -- which are not commands -- each add one modifier
4183 ;; to the following event.
4185 (defun event-apply-alt-modifier (ignore-prompt)
4188 (vector (event-apply-modifier (read-event) 'alt 22 "A-")))
4189 (defun event-apply-super-modifier (ignore-prompt)
4192 (vector (event-apply-modifier (read-event) 'super 23 "s-")))
4193 (defun event-apply-hyper-modifier (ignore-prompt)
4196 (vector (event-apply-modifier (read-event) 'hyper 24 "H-")))
4197 (defun event-apply-shift-modifier (ignore-prompt)
4200 (vector (event-apply-modifier (read-event) 'shift 25 "S-")))
4201 (defun event-apply-control-modifier (ignore-prompt)
4204 (vector (event-apply-modifier (read-event) 'control 26 "C-")))
4205 (defun event-apply-meta-modifier (ignore-prompt)
4208 (vector (event-apply-modifier (read-event) 'meta 27 "M-")))
4210 (defun event-apply-modifier (event symbol lshiftby prefix)
4211 "Apply a modifier flag to event EVENT.
4212 SYMBOL is the name of this modifier, as a symbol.
4213 LSHIFTBY is the numeric value of this modifier, in keyboard events.
4214 PREFIX is the string that represents this modifier in an event type symbol."
4215 (if (numberp event)
4216 (cond ((eq symbol 'control)
4217 (if (and (<= (downcase event) ?z)
4218 (>= (downcase event) ?a))
4219 (- (downcase event) ?a -1)
4220 (if (and (<= (downcase event) ?Z)
4221 (>= (downcase event) ?A))
4222 (- (downcase event) ?A -1)
4223 (logior (lsh 1 lshiftby) event))))
4224 ((eq symbol 'shift)
4225 (if (and (<= (downcase event) ?z)
4226 (>= (downcase event) ?a))
4227 (upcase event)
4228 (logior (lsh 1 lshiftby) event)))
4229 (t
4230 (logior (lsh 1 lshiftby) event)))
4231 (if (memq symbol (event-modifiers event))
4232 event
4233 (let ((event-type (if (symbolp event) event (car event))))
4234 (setq event-type (intern (concat prefix (symbol-name event-type))))
4235 (if (symbolp event)
4236 event-type
4237 (cons event-type (cdr event)))))))
4239 (define-key function-key-map [?\C-x ?@ ?h] 'event-apply-hyper-modifier)
4240 (define-key function-key-map [?\C-x ?@ ?s] 'event-apply-super-modifier)
4241 (define-key function-key-map [?\C-x ?@ ?m] 'event-apply-meta-modifier)
4242 (define-key function-key-map [?\C-x ?@ ?a] 'event-apply-alt-modifier)
4243 (define-key function-key-map [?\C-x ?@ ?S] 'event-apply-shift-modifier)
4244 (define-key function-key-map [?\C-x ?@ ?c] 'event-apply-control-modifier)
4246 ;;;; Keypad support.
4248 ;;; Make the keypad keys act like ordinary typing keys. If people add
4249 ;;; bindings for the function key symbols, then those bindings will
4250 ;;; override these, so this shouldn't interfere with any existing
4251 ;;; bindings.
4253 ;; Also tell read-char how to handle these keys.
4254 (mapc
4255 (lambda (keypad-normal)
4256 (let ((keypad (nth 0 keypad-normal))
4257 (normal (nth 1 keypad-normal)))
4258 (put keypad 'ascii-character normal)
4259 (define-key function-key-map (vector keypad) (vector normal))))
4260 '((kp-0 ?0) (kp-1 ?1) (kp-2 ?2) (kp-3 ?3) (kp-4 ?4)
4261 (kp-5 ?5) (kp-6 ?6) (kp-7 ?7) (kp-8 ?8) (kp-9 ?9)
4262 (kp-space ?\ )
4265 (kp-multiply ?*)
4266 (kp-add ?+)
4267 (kp-separator ?,)
4268 (kp-subtract ?-)
4269 (kp-decimal ?.)
4270 (kp-divide ?/)
4271 (kp-equal ?=)))
4272 \f
4273 ;;;;
4274 ;;;; forking a twin copy of a buffer.
4275 ;;;;
4277 (defvar clone-buffer-hook nil
4278 "Normal hook to run in the new buffer at the end of `clone-buffer'.")
4280 (defun clone-process (process &optional newname)
4281 "Create a twin copy of PROCESS.
4282 If NEWNAME is nil, it defaults to PROCESS' name;
4283 NEWNAME is modified by adding or incrementing <N> at the end as necessary.
4284 If PROCESS is associated with a buffer, the new process will be associated
4285 with the current buffer instead.
4286 Returns nil if PROCESS has already terminated."
4287 (setq newname (or newname (process-name process)))
4289 (setq newname (substring newname 0 (match-beginning 0))))
4290 (when (memq (process-status process) '(run stop open))
4291 (let* ((process-connection-type (process-tty-name process))
4292 (new-process
4293 (if (memq (process-status process) '(open))
4294 (let ((args (process-contact process t)))
4295 (setq args (plist-put args :name newname))
4296 (setq args (plist-put args :buffer
4297 (if (process-buffer process)
4298 (current-buffer))))
4299 (apply 'make-network-process args))
4300 (apply 'start-process newname
4301 (if (process-buffer process) (current-buffer))
4302 (process-command process)))))
4303 (set-process-query-on-exit-flag
4304 new-process (process-query-on-exit-flag process))
4305 (set-process-inherit-coding-system-flag
4306 new-process (process-inherit-coding-system-flag process))
4307 (set-process-filter new-process (process-filter process))
4308 (set-process-sentinel new-process (process-sentinel process))
4309 (set-process-plist new-process (copy-sequence (process-plist process)))
4310 new-process)))
4312 ;; things to maybe add (currently partly covered by `funcall mode'):
4313 ;; - syntax-table
4314 ;; - overlays
4315 (defun clone-buffer (&optional newname display-flag)
4316 "Create and return a twin copy of the current buffer.
4317 Unlike an indirect buffer, the new buffer can be edited
4318 independently of the old one (if it is not read-only).
4319 NEWNAME is the name of the new buffer. It may be modified by
4320 adding or incrementing <N> at the end as necessary to create a
4321 unique buffer name. If nil, it defaults to the name of the
4322 current buffer, with the proper suffix. If DISPLAY-FLAG is
4323 non-nil, the new buffer is shown with `pop-to-buffer'. Trying to
4324 clone a file-visiting buffer, or a buffer whose major mode symbol
4325 has a non-nil `no-clone' property, results in an error.
4327 Interactively, DISPLAY-FLAG is t and NEWNAME is the name of the
4328 current buffer with appropriate suffix. However, if a prefix
4329 argument is given, then the command prompts for NEWNAME in the
4330 minibuffer.
4332 This runs the normal hook `clone-buffer-hook' in the new buffer
4333 after it has been set up properly in other respects."
4334 (interactive
4335 (progn
4336 (if buffer-file-name
4337 (error "Cannot clone a file-visiting buffer"))
4338 (if (get major-mode 'no-clone)
4339 (error "Cannot clone a buffer in %s mode" mode-name))
4340 (list (if current-prefix-arg (read-string "Name: "))
4341 t)))
4342 (if buffer-file-name
4343 (error "Cannot clone a file-visiting buffer"))
4344 (if (get major-mode 'no-clone)
4345 (error "Cannot clone a buffer in %s mode" mode-name))
4346 (setq newname (or newname (buffer-name)))
4348 (setq newname (substring newname 0 (match-beginning 0))))
4349 (let ((buf (current-buffer))
4350 (ptmin (point-min))
4351 (ptmax (point-max))
4352 (pt (point))
4353 (mk (if mark-active (mark t)))
4354 (modified (buffer-modified-p))
4355 (mode major-mode)
4356 (lvars (buffer-local-variables))
4357 (process (get-buffer-process (current-buffer)))
4358 (new (generate-new-buffer (or newname (buffer-name)))))
4359 (save-restriction
4360 (widen)
4361 (with-current-buffer new
4362 (insert-buffer-substring buf)))
4363 (with-current-buffer new
4364 (narrow-to-region ptmin ptmax)
4365 (goto-char pt)
4366 (if mk (set-mark mk))
4367 (set-buffer-modified-p modified)
4369 ;; Clone the old buffer's process, if any.
4370 (when process (clone-process process))
4372 ;; Now set up the major mode.
4373 (funcall mode)
4375 ;; Set up other local variables.
4376 (mapcar (lambda (v)
4377 (condition-case () ;in case var is read-only
4378 (if (symbolp v)
4379 (makunbound v)
4380 (set (make-local-variable (car v)) (cdr v)))
4381 (error nil)))
4382 lvars)
4384 ;; Run any hooks (typically set up by the major mode
4385 ;; for cloning to work properly).
4386 (run-hooks 'clone-buffer-hook))
4387 (if display-flag (pop-to-buffer new))
4388 new))
4391 (defun clone-indirect-buffer (newname display-flag &optional norecord)
4392 "Create an indirect buffer that is a twin copy of the current buffer.
4394 Give the indirect buffer name NEWNAME. Interactively, read NEW-NAME
4395 from the minibuffer when invoked with a prefix arg. If NEWNAME is nil
4396 or if not called with a prefix arg, NEWNAME defaults to the current
4397 buffer's name. The name is modified by adding a `<N>' suffix to it
4398 or by incrementing the N in an existing suffix.
4400 DISPLAY-FLAG non-nil means show the new buffer with `pop-to-buffer'.
4401 This is always done when called interactively.
4403 Optional last arg NORECORD non-nil means do not put this buffer at the
4404 front of the list of recently selected ones."
4405 (interactive
4406 (progn
4407 (if (get major-mode 'no-clone-indirect)
4408 (error "Cannot indirectly clone a buffer in %s mode" mode-name))
4409 (list (if current-prefix-arg
4410 (read-string "BName of indirect buffer: "))
4411 t)))
4412 (if (get major-mode 'no-clone-indirect)
4413 (error "Cannot indirectly clone a buffer in %s mode" mode-name))
4414 (setq newname (or newname (buffer-name)))
4416 (setq newname (substring newname 0 (match-beginning 0))))
4417 (let* ((name (generate-new-buffer-name newname))
4418 (buffer (make-indirect-buffer (current-buffer) name t)))
4419 (when display-flag
4420 (pop-to-buffer buffer norecord))
4421 buffer))
4424 (defun clone-indirect-buffer-other-window (buffer &optional norecord)
4425 "Create an indirect buffer that is a twin copy of BUFFER.
4426 Select the new buffer in another window.
4427 Optional second arg NORECORD non-nil means do not put this buffer at
4428 the front of the list of recently selected ones."
4429 (interactive "bClone buffer in other window: ")
4430 (let ((pop-up-windows t))
4431 (set-buffer buffer)
4432 (clone-indirect-buffer nil t norecord)))
4434 (define-key ctl-x-4-map "c" 'clone-indirect-buffer-other-window)
4435 \f
4436 ;;; Handling of Backspace and Delete keys.
4438 (defcustom normal-erase-is-backspace nil
4439 "If non-nil, Delete key deletes forward and Backspace key deletes backward.
4441 On window systems, the default value of this option is chosen
4442 according to the keyboard used. If the keyboard has both a Backspace
4443 key and a Delete key, and both are mapped to their usual meanings, the
4444 option's default value is set to t, so that Backspace can be used to
4445 delete backward, and Delete can be used to delete forward.
4447 If not running under a window system, customizing this option accomplishes
4448 a similar effect by mapping C-h, which is usually generated by the
4449 Backspace key, to DEL, and by mapping DEL to C-d via
4450 `keyboard-translate'. The former functionality of C-h is available on
4451 the F1 key. You should probably not use this setting if you don't
4452 have both Backspace, Delete and F1 keys.
4454 Setting this variable with setq doesn't take effect. Programmatically,
4455 call `normal-erase-is-backspace-mode' (which see) instead."
4456 :type 'boolean
4457 :group 'editing-basics
4458 :version "21.1"
4459 :set (lambda (symbol value)
4460 ;; The fboundp is because of a problem with :set when
4461 ;; dumping Emacs. It doesn't really matter.
4462 (if (fboundp 'normal-erase-is-backspace-mode)
4463 (normal-erase-is-backspace-mode (or value 0))
4464 (set-default symbol value))))
4467 (defun normal-erase-is-backspace-mode (&optional arg)
4468 "Toggle the Erase and Delete mode of the Backspace and Delete keys.
4470 With numeric arg, turn the mode on if and only if ARG is positive.
4472 On window systems, when this mode is on, Delete is mapped to C-d and
4473 Backspace is mapped to DEL; when this mode is off, both Delete and
4474 Backspace are mapped to DEL. (The remapping goes via
4475 `function-key-map', so binding Delete or Backspace in the global or
4476 local keymap will override that.)
4478 In addition, on window systems, the bindings of C-Delete, M-Delete,
4479 C-M-Delete, C-Backspace, M-Backspace, and C-M-Backspace are changed in
4480 the global keymap in accordance with the functionality of Delete and
4481 Backspace. For example, if Delete is remapped to C-d, which deletes
4482 forward, C-Delete is bound to `kill-word', but if Delete is remapped
4483 to DEL, which deletes backward, C-Delete is bound to
4484 `backward-kill-word'.
4486 If not running on a window system, a similar effect is accomplished by
4487 remapping C-h (normally produced by the Backspace key) and DEL via
4488 `keyboard-translate': if this mode is on, C-h is mapped to DEL and DEL
4489 to C-d; if it's off, the keys are not remapped.
4491 When not running on a window system, and this mode is turned on, the
4492 former functionality of C-h is available on the F1 key. You should
4493 probably not turn on this mode on a text-only terminal if you don't
4494 have both Backspace, Delete and F1 keys.
4496 See also `normal-erase-is-backspace'."
4497 (interactive "P")
4498 (setq normal-erase-is-backspace
4499 (if arg
4500 (> (prefix-numeric-value arg) 0)
4501 (not normal-erase-is-backspace)))
4503 (cond ((or (memq window-system '(x w32 mac pc))
4504 (memq system-type '(ms-dos windows-nt)))
4505 (let ((bindings
4506 `(([C-delete] [C-backspace])
4507 ([M-delete] [M-backspace])
4508 ([C-M-delete] [C-M-backspace])
4509 (,esc-map
4510 [C-delete] [C-backspace])))
4511 (old-state (lookup-key function-key-map [delete])))
4513 (if normal-erase-is-backspace
4514 (progn
4515 (define-key function-key-map [delete] [?\C-d])
4516 (define-key function-key-map [kp-delete] [?\C-d])
4517 (define-key function-key-map [backspace] [?\C-?]))
4518 (define-key function-key-map [delete] [?\C-?])
4519 (define-key function-key-map [kp-delete] [?\C-?])
4520 (define-key function-key-map [backspace] [?\C-?]))
4522 ;; Maybe swap bindings of C-delete and C-backspace, etc.
4523 (unless (equal old-state (lookup-key function-key-map [delete]))
4524 (dolist (binding bindings)
4525 (let ((map global-map))
4526 (when (keymapp (car binding))
4527 (setq map (car binding) binding (cdr binding)))
4528 (let* ((key1 (nth 0 binding))
4529 (key2 (nth 1 binding))
4530 (binding1 (lookup-key map key1))
4531 (binding2 (lookup-key map key2)))
4532 (define-key map key1 binding2)
4533 (define-key map key2 binding1)))))))
4534 (t
4535 (if normal-erase-is-backspace
4536 (progn
4537 (keyboard-translate ?\C-h ?\C-?)
4538 (keyboard-translate ?\C-? ?\C-d))
4539 (keyboard-translate ?\C-h ?\C-h)
4540 (keyboard-translate ?\C-? ?\C-?))))
4542 (run-hooks 'normal-erase-is-backspace-hook)
4543 (if (interactive-p)
4544 (message "Delete key deletes %s"
4545 (if normal-erase-is-backspace "forward" "backward"))))
4546 \f
4547 (defcustom idle-update-delay 0.5
4548 "*Idle time delay before updating various things on the screen.
4549 Various Emacs features that update auxiliary information when point moves
4550 wait this many seconds after Emacs becomes idle before doing an update."
4551 :type 'number
4552 :group 'display
4553 :version "21.4")
4554 \f
4555 (defvar vis-mode-saved-buffer-invisibility-spec nil
4556 "Saved value of `buffer-invisibility-spec' when Visible mode is on.")
4558 (define-minor-mode visible-mode
4559 "Toggle Visible mode.
4560 With argument ARG turn Visible mode on iff ARG is positive.
4562 Enabling Visible mode makes all invisible text temporarily visible.
4563 Disabling Visible mode turns off that effect. Visible mode
4564 works by saving the value of `buffer-invisibility-spec' and setting it to nil."
4565 :lighter " Vis"
4566 (when (local-variable-p 'vis-mode-saved-buffer-invisibility-spec)
4567 (setq buffer-invisibility-spec vis-mode-saved-buffer-invisibility-spec)
4568 (kill-local-variable 'vis-mode-saved-buffer-invisibility-spec))
4569 (when visible-mode
4570 (set (make-local-variable 'vis-mode-saved-buffer-invisibility-spec)
4571 buffer-invisibility-spec)
4572 (setq buffer-invisibility-spec nil)))
4573 \f
4574 ;; Minibuffer prompt stuff.
4576 ;(defun minibuffer-prompt-modification (start end)
4577 ; (error "You cannot modify the prompt"))
4578 ;
4579 ;
4580 ;(defun minibuffer-prompt-insertion (start end)
4581 ; (let ((inhibit-modification-hooks t))
4582 ; (delete-region start end)
4583 ; ;; Discard undo information for the text insertion itself
4584 ; ;; and for the text deletion.above.
4585 ; (when (consp buffer-undo-list)
4586 ; (setq buffer-undo-list (cddr buffer-undo-list)))
4587 ; (message "You cannot modify the prompt")))
4588 ;
4589 ;
4590 ;(setq minibuffer-prompt-properties
4591 ; (list 'modification-hooks '(minibuffer-prompt-modification)
4592 ; 'insert-in-front-hooks '(minibuffer-prompt-insertion)))
4593 ;
4595 (provide 'simple)
4597 ;;; arch-tag: 24af67c0-2a49-44f6-b3b1-312d8b570dfd
4598 ;;; simple.el ends here