1 |
;;; simple.el --- basic editing commands for Emacs |
;;; simple.el --- basic editing commands for Emacs |
2 |
|
|
3 |
;; Copyright (C) 1985, 86, 87, 93, 94, 95, 96, 97, 98, 99, 2000, 2001, 2002 |
;; Copyright (C) 1985, 86, 87, 93, 94, 95, 96, 97, 98, 99, |
4 |
|
;; 2000, 2001, 2002, 2003 |
5 |
;; Free Software Foundation, Inc. |
;; Free Software Foundation, Inc. |
6 |
|
|
7 |
;; Maintainer: FSF |
;; Maintainer: FSF |
181 |
(goto-char loc) |
(goto-char loc) |
182 |
(end-of-line))) |
(end-of-line))) |
183 |
|
|
184 |
(defun split-line () |
(defun split-line (&optional arg) |
185 |
"Split current line, moving portion beyond point vertically down." |
"Split current line, moving portion beyond point vertically down. |
186 |
(interactive "*") |
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. |
188 |
|
|
189 |
|
When called from Lisp code, the arg may be a prefix string to copy." |
190 |
|
(interactive "*P") |
191 |
(skip-chars-forward " \t") |
(skip-chars-forward " \t") |
192 |
(let ((col (current-column)) |
(let* ((col (current-column)) |
193 |
(pos (point))) |
(pos (point)) |
194 |
|
;; What prefix should we check for (nil means don't). |
195 |
|
(prefix (cond ((stringp arg) arg) |
196 |
|
(arg nil) |
197 |
|
(t fill-prefix))) |
198 |
|
;; Does this line start with it? |
199 |
|
(have-prfx (and prefix |
200 |
|
(save-excursion |
201 |
|
(beginning-of-line) |
202 |
|
(looking-at (regexp-quote prefix)))))) |
203 |
(newline 1) |
(newline 1) |
204 |
|
(if have-prfx (insert-and-inherit prefix)) |
205 |
(indent-to col 0) |
(indent-to col 0) |
206 |
(goto-char pos))) |
(goto-char pos))) |
207 |
|
|
333 |
digits are interpreted as a character code. This is intended to be |
digits are interpreted as a character code. This is intended to be |
334 |
useful for editing binary files." |
useful for editing binary files." |
335 |
(interactive "*p") |
(interactive "*p") |
336 |
(let ((char (if (or (not overwrite-mode) |
(let* ((char (let (translation-table-for-input) |
337 |
(eq overwrite-mode 'overwrite-mode-binary)) |
(if (or (not overwrite-mode) |
338 |
(read-quoted-char) |
(eq overwrite-mode 'overwrite-mode-binary)) |
339 |
(read-char)))) |
(read-quoted-char) |
340 |
|
(read-char))))) |
341 |
;; Assume character codes 0240 - 0377 stand for characters in some |
;; Assume character codes 0240 - 0377 stand for characters in some |
342 |
;; single-byte character set, and convert them to Emacs |
;; single-byte character set, and convert them to Emacs |
343 |
;; characters. |
;; characters. |
368 |
"Move point to the first non-whitespace character on this line." |
"Move point to the first non-whitespace character on this line." |
369 |
(interactive) |
(interactive) |
370 |
(beginning-of-line 1) |
(beginning-of-line 1) |
371 |
(skip-chars-forward " \t")) |
(let ((limit (line-end-position))) |
372 |
|
(skip-syntax-forward " " limit))) |
373 |
|
|
374 |
(defun fixup-whitespace () |
(defun fixup-whitespace () |
375 |
"Fixup white space between objects around point. |
"Fixup white space between objects around point. |
506 |
(setq start (point)) |
(setq start (point)) |
507 |
(goto-char opoint) |
(goto-char opoint) |
508 |
(forward-line 0) |
(forward-line 0) |
509 |
(if (/= start 1) |
(if (/= start (point-min)) |
510 |
(message "line %d (narrowed line %d)" |
(message "line %d (narrowed line %d)" |
511 |
(1+ (count-lines 1 (point))) |
(1+ (count-lines (point-min) (point))) |
512 |
(1+ (count-lines start (point)))) |
(1+ (count-lines start (point)))) |
513 |
(message "Line %d" (1+ (count-lines 1 (point))))))))) |
(message "Line %d" (1+ (count-lines (point-min) (point))))))))) |
514 |
|
|
515 |
(defun count-lines (start end) |
(defun count-lines (start end) |
516 |
"Return number of lines between START and END. |
"Return number of lines between START and END. |
547 |
byte, just \"...\" is shown. |
byte, just \"...\" is shown. |
548 |
|
|
549 |
In addition, with prefix argument, show details about that character |
In addition, with prefix argument, show details about that character |
550 |
in *Help* buffer. See also the command `describe-char-after'." |
in *Help* buffer. See also the command `describe-char'." |
551 |
(interactive "P") |
(interactive "P") |
552 |
(let* ((char (following-char)) |
(let* ((char (following-char)) |
553 |
(beg (point-min)) |
(beg (point-min)) |
587 |
(format "(0%o, %d, 0x%x)" char char char)))) |
(format "(0%o, %d, 0x%x)" char char char)))) |
588 |
(if detail |
(if detail |
589 |
;; We show the detailed information about CHAR. |
;; We show the detailed information about CHAR. |
590 |
(describe-char-after (point))) |
(describe-char (point))) |
591 |
(if (or (/= beg 1) (/= end (1+ total))) |
(if (or (/= beg 1) (/= end (1+ total))) |
592 |
(message "Char: %s %s point=%d of %d (%d%%) <%d - %d> column %d %s" |
(message "Char: %s %s point=%d of %d (%d%%) <%d - %d> column %d %s" |
593 |
(if (< char 256) |
(if (< char 256) |
667 |
"Prompting with PROMPT, let user edit COMMAND and eval result. |
"Prompting with PROMPT, let user edit COMMAND and eval result. |
668 |
COMMAND is a Lisp expression. Let user edit that expression in |
COMMAND is a Lisp expression. Let user edit that expression in |
669 |
the minibuffer, then read and evaluate the result." |
the minibuffer, then read and evaluate the result." |
670 |
(let ((command (read-from-minibuffer prompt |
(let ((command |
671 |
(prin1-to-string command) |
(unwind-protect |
672 |
read-expression-map t |
(read-from-minibuffer prompt |
673 |
'(command-history . 1)))) |
(prin1-to-string command) |
674 |
;; If command was added to command-history as a string, |
read-expression-map t |
675 |
;; get rid of that. We want only evaluable expressions there. |
'(command-history . 1)) |
676 |
(if (stringp (car command-history)) |
;; If command was added to command-history as a string, |
677 |
(setq command-history (cdr command-history))) |
;; get rid of that. We want only evaluable expressions there. |
678 |
|
(if (stringp (car command-history)) |
679 |
|
(setq command-history (cdr command-history)))))) |
680 |
|
|
681 |
;; If command to be redone does not match front of history, |
;; If command to be redone does not match front of history, |
682 |
;; add it to the history. |
;; add it to the history. |
702 |
(let ((print-level nil) |
(let ((print-level nil) |
703 |
(minibuffer-history-position arg) |
(minibuffer-history-position arg) |
704 |
(minibuffer-history-sexp-flag (1+ (minibuffer-depth)))) |
(minibuffer-history-sexp-flag (1+ (minibuffer-depth)))) |
705 |
(read-from-minibuffer |
(unwind-protect |
706 |
"Redo: " (prin1-to-string elt) read-expression-map t |
(read-from-minibuffer |
707 |
(cons 'command-history arg)))) |
"Redo: " (prin1-to-string elt) read-expression-map t |
708 |
|
(cons 'command-history arg)) |
709 |
;; If command was added to command-history as a string, |
|
710 |
;; get rid of that. We want only evaluable expressions there. |
;; If command was added to command-history as a |
711 |
(if (stringp (car command-history)) |
;; string, get rid of that. We want only |
712 |
(setq command-history (cdr command-history))) |
;; evaluable expressions there. |
713 |
|
(if (stringp (car command-history)) |
714 |
|
(setq command-history (cdr command-history)))))) |
715 |
|
|
716 |
;; If command to be redone does not match front of history, |
;; If command to be redone does not match front of history, |
717 |
;; add it to the history. |
;; add it to the history. |
718 |
(or (equal newcmd (car command-history)) |
(or (equal newcmd (car command-history)) |
719 |
(setq command-history (cons newcmd command-history))) |
(setq command-history (cons newcmd command-history))) |
720 |
(eval newcmd)) |
(eval newcmd)) |
721 |
(ding)))) |
(if command-history |
722 |
|
(error "Argument %d is beyond length of command history" arg) |
723 |
|
(error "There are no previous complex commands to repeat"))))) |
724 |
|
|
725 |
(defvar minibuffer-history nil |
(defvar minibuffer-history nil |
726 |
"Default minibuffer history list. |
"Default minibuffer history list. |
955 |
(let ((modified (buffer-modified-p)) |
(let ((modified (buffer-modified-p)) |
956 |
(recent-save (recent-auto-save-p))) |
(recent-save (recent-auto-save-p))) |
957 |
(or (eq (selected-window) (minibuffer-window)) |
(or (eq (selected-window) (minibuffer-window)) |
958 |
(message "Undo!")) |
(message (if (and transient-mark-mode mark-active) |
959 |
|
"Undo in region!" |
960 |
|
"Undo!"))) |
961 |
(unless (eq last-command 'undo) |
(unless (eq last-command 'undo) |
962 |
(if (if transient-mark-mode mark-active (and arg (not (numberp arg)))) |
(if (if transient-mark-mode mark-active (and arg (not (numberp arg)))) |
963 |
(undo-start (region-beginning) (region-end)) |
(undo-start (region-beginning) (region-end)) |
1004 |
Call `undo-start' to get ready to undo recent changes, |
Call `undo-start' to get ready to undo recent changes, |
1005 |
then call `undo-more' one or more times to undo them." |
then call `undo-more' one or more times to undo them." |
1006 |
(or pending-undo-list |
(or pending-undo-list |
1007 |
(error "No further undo information")) |
(error (format "No further undo information%s" |
1008 |
|
(if (and transient-mark-mode mark-active) |
1009 |
|
" for region" "")))) |
1010 |
(let ((undo-in-progress t)) |
(let ((undo-in-progress t)) |
1011 |
(setq pending-undo-list (primitive-undo count pending-undo-list)))) |
(setq pending-undo-list (primitive-undo count pending-undo-list)))) |
1012 |
|
|
1112 |
If it crosses the edge, we return nil." |
If it crosses the edge, we return nil." |
1113 |
(cond ((integerp undo-elt) |
(cond ((integerp undo-elt) |
1114 |
(and (>= undo-elt start) |
(and (>= undo-elt start) |
1115 |
(< undo-elt end))) |
(<= undo-elt end))) |
1116 |
((eq undo-elt nil) |
((eq undo-elt nil) |
1117 |
t) |
t) |
1118 |
((atom undo-elt) |
((atom undo-elt) |
1132 |
(cons alist-elt undo-adjusted-markers))) |
(cons alist-elt undo-adjusted-markers))) |
1133 |
(and (cdr alist-elt) |
(and (cdr alist-elt) |
1134 |
(>= (cdr alist-elt) start) |
(>= (cdr alist-elt) start) |
1135 |
(< (cdr alist-elt) end)))) |
(<= (cdr alist-elt) end)))) |
1136 |
((null (car undo-elt)) |
((null (car undo-elt)) |
1137 |
;; (nil PROPERTY VALUE BEG . END) |
;; (nil PROPERTY VALUE BEG . END) |
1138 |
(let ((tail (nthcdr 3 undo-elt))) |
(let ((tail (nthcdr 3 undo-elt))) |
1139 |
(and (>= (car tail) start) |
(and (>= (car tail) start) |
1140 |
(< (cdr tail) end)))) |
(<= (cdr tail) end)))) |
1141 |
((integerp (car undo-elt)) |
((integerp (car undo-elt)) |
1142 |
;; (BEGIN . END) |
;; (BEGIN . END) |
1143 |
(and (>= (car undo-elt) start) |
(and (>= (car undo-elt) start) |
1144 |
(< (cdr undo-elt) end))))) |
(<= (cdr undo-elt) end))))) |
1145 |
|
|
1146 |
(defun undo-elt-crosses-region (undo-elt start end) |
(defun undo-elt-crosses-region (undo-elt start end) |
1147 |
"Test whether UNDO-ELT crosses one edge of that region START ... END. |
"Test whether UNDO-ELT crosses one edge of that region START ... END. |
1181 |
|
|
1182 |
(defvar shell-command-default-error-buffer nil |
(defvar shell-command-default-error-buffer nil |
1183 |
"*Buffer name for `shell-command' and `shell-command-on-region' error output. |
"*Buffer name for `shell-command' and `shell-command-on-region' error output. |
1184 |
This buffer is used when `shell-command' or 'shell-command-on-region' |
This buffer is used when `shell-command' or `shell-command-on-region' |
1185 |
is run interactively. A value of nil means that output to stderr and |
is run interactively. A value of nil means that output to stderr and |
1186 |
stdout will be intermixed in the output stream.") |
stdout will be intermixed in the output stream.") |
1187 |
|
|
1291 |
;; Output goes in a separate buffer. |
;; Output goes in a separate buffer. |
1292 |
;; Preserve the match data in case called from a program. |
;; Preserve the match data in case called from a program. |
1293 |
(save-match-data |
(save-match-data |
1294 |
(if (string-match "[ \t]*&[ \t]*$" command) |
(if (string-match "[ \t]*&[ \t]*\\'" command) |
1295 |
;; Command ending with ampersand means asynchronous. |
;; Command ending with ampersand means asynchronous. |
1296 |
(let ((buffer (get-buffer-create |
(let ((buffer (get-buffer-create |
1297 |
(or output-buffer "*Async Shell Command*"))) |
(or output-buffer "*Async Shell Command*"))) |
1362 |
(if (= (buffer-size) 0) |
(if (= (buffer-size) 0) |
1363 |
0 |
0 |
1364 |
(count-lines (point-min) (point-max))))) |
(count-lines (point-min) (point-max))))) |
1365 |
(cond ((or (<= lines 1) |
(cond ((= lines 0)) |
1366 |
(<= lines |
((and (or (<= lines 1) |
1367 |
(if resize-mini-windows |
(<= lines |
1368 |
(cond ((floatp max-mini-window-height) |
(if resize-mini-windows |
1369 |
(* (frame-height) |
(cond ((floatp max-mini-window-height) |
1370 |
max-mini-window-height)) |
(* (frame-height) |
1371 |
((integerp max-mini-window-height) |
max-mini-window-height)) |
1372 |
max-mini-window-height) |
((integerp max-mini-window-height) |
1373 |
(t |
max-mini-window-height) |
1374 |
1)) |
(t |
1375 |
1))) |
1)) |
1376 |
|
1))) |
1377 |
|
;; Don't use the echo area if the output buffer is |
1378 |
|
;; already dispayed in the selected frame. |
1379 |
|
(not (get-buffer-window (current-buffer)))) |
1380 |
;; Echo area |
;; Echo area |
1381 |
(goto-char (point-max)) |
(goto-char (point-max)) |
1382 |
(when (bolp) |
(when (bolp) |
1494 |
;; No prefix argument: put the output in a temp buffer, |
;; No prefix argument: put the output in a temp buffer, |
1495 |
;; replacing its entire contents. |
;; replacing its entire contents. |
1496 |
(let ((buffer (get-buffer-create |
(let ((buffer (get-buffer-create |
1497 |
(or output-buffer "*Shell Command Output*"))) |
(or output-buffer "*Shell Command Output*")))) |
|
(success nil)) |
|
1498 |
(unwind-protect |
(unwind-protect |
1499 |
(if (eq buffer (current-buffer)) |
(if (eq buffer (current-buffer)) |
1500 |
;; If the input is the same buffer as the output, |
;; If the input is the same buffer as the output, |
1526 |
(list buffer error-file) |
(list buffer error-file) |
1527 |
buffer) |
buffer) |
1528 |
nil shell-command-switch command))) |
nil shell-command-switch command))) |
|
(setq success (and exit-status (equal 0 exit-status))) |
|
1529 |
;; Report the output. |
;; Report the output. |
1530 |
(with-current-buffer buffer |
(with-current-buffer buffer |
1531 |
(setq mode-line-process |
(setq mode-line-process |
1532 |
(if (not success) |
(cond ((null exit-status) |
1533 |
(concat (format " - Exit [%d]" exit-status))))) |
" - Error") |
1534 |
|
((stringp exit-status) |
1535 |
|
(format " - Signal [%s]" exit-status)) |
1536 |
|
((not (equal 0 exit-status)) |
1537 |
|
(format " - Exit [%d]" exit-status))))) |
1538 |
(if (with-current-buffer buffer (> (point-max) (point-min))) |
(if (with-current-buffer buffer (> (point-max) (point-min))) |
1539 |
;; There's some output, display it |
;; There's some output, display it |
1540 |
(display-message-or-buffer buffer) |
(display-message-or-buffer buffer) |
1544 |
(< 0 (nth 7 (file-attributes error-file)))) |
(< 0 (nth 7 (file-attributes error-file)))) |
1545 |
"some error output" |
"some error output" |
1546 |
"no output"))) |
"no output"))) |
1547 |
(if (equal 0 exit-status) |
(cond ((null exit-status) |
1548 |
(message "(Shell command succeeded with %s)" |
(message "(Shell command failed with error)")) |
1549 |
output) |
((equal 0 exit-status) |
1550 |
(message "(Shell command failed with code %d and %s)" |
(message "(Shell command succeeded with %s)" |
1551 |
exit-status output))) |
output)) |
1552 |
|
((stringp exit-status) |
1553 |
|
(message "(Shell command killed by signal %s)" |
1554 |
|
exit-status)) |
1555 |
|
(t |
1556 |
|
(message "(Shell command failed with code %d and %s)" |
1557 |
|
exit-status output)))) |
1558 |
;; Don't kill: there might be useful info in the undo-log. |
;; Don't kill: there might be useful info in the undo-log. |
1559 |
;; (kill-buffer buffer) |
;; (kill-buffer buffer) |
1560 |
)))) |
)))) |
1757 |
(defvar kill-ring-yank-pointer nil |
(defvar kill-ring-yank-pointer nil |
1758 |
"The tail of the kill ring whose car is the last thing yanked.") |
"The tail of the kill ring whose car is the last thing yanked.") |
1759 |
|
|
1760 |
(defun kill-new (string &optional replace) |
(defun kill-new (string &optional replace yank-handler) |
1761 |
"Make STRING the latest kill in the kill ring. |
"Make STRING the latest kill in the kill ring. |
1762 |
Set `kill-ring-yank-pointer' to point to it. |
Set `kill-ring-yank-pointer' to point to it. |
1763 |
If `interprogram-cut-function' is non-nil, apply it to STRING. |
If `interprogram-cut-function' is non-nil, apply it to STRING. |
1764 |
Optional second argument REPLACE non-nil means that STRING will replace |
Optional second argument REPLACE non-nil means that STRING will replace |
1765 |
the front of the kill ring, rather than being added to the list." |
the front of the kill ring, rather than being added to the list. |
1766 |
(and (fboundp 'menu-bar-update-yank-menu) |
|
1767 |
(menu-bar-update-yank-menu string (and replace (car kill-ring)))) |
Optional third arguments YANK-HANDLER controls how the STRING is later |
1768 |
|
inserted into a buffer; see `insert-for-yank' for details. |
1769 |
|
When a yank handler is specified, STRING must be non-empty (the yank |
1770 |
|
handler is stored as a `yank-handler'text property on STRING). |
1771 |
|
|
1772 |
|
When the yank handler has a non-nil PARAM element, the original STRING |
1773 |
|
argument is not used by `insert-for-yank'. However, since Lisp code |
1774 |
|
may access and use elements from the kill-ring directly, the STRING |
1775 |
|
argument should still be a \"useful\" string for such uses." |
1776 |
|
(if (> (length string) 0) |
1777 |
|
(if yank-handler |
1778 |
|
(put-text-property 0 1 'yank-handler yank-handler string) |
1779 |
|
(remove-list-of-text-properties 0 1 '(yank-handler) string)) |
1780 |
|
(if yank-handler |
1781 |
|
(signal 'args-out-of-range |
1782 |
|
(list string "yank-handler specified for empty string")))) |
1783 |
|
(if (fboundp 'menu-bar-update-yank-menu) |
1784 |
|
(menu-bar-update-yank-menu string (and replace (car kill-ring)))) |
1785 |
(if (and replace kill-ring) |
(if (and replace kill-ring) |
1786 |
(setcar kill-ring string) |
(setcar kill-ring string) |
1787 |
(setq kill-ring (cons string kill-ring)) |
(setq kill-ring (cons string kill-ring)) |
1791 |
(if interprogram-cut-function |
(if interprogram-cut-function |
1792 |
(funcall interprogram-cut-function string (not replace)))) |
(funcall interprogram-cut-function string (not replace)))) |
1793 |
|
|
1794 |
(defun kill-append (string before-p) |
(defun kill-append (string before-p &optional yank-handler) |
1795 |
"Append STRING to the end of the latest kill in the kill ring. |
"Append STRING to the end of the latest kill in the kill ring. |
1796 |
If BEFORE-P is non-nil, prepend STRING to the kill. |
If BEFORE-P is non-nil, prepend STRING to the kill. |
1797 |
If `interprogram-cut-function' is set, pass the resulting kill to |
Optional third argument YANK-HANDLER specifies the yank-handler text |
1798 |
it." |
property to be set on the combined kill ring string. If the specified |
1799 |
(kill-new (if before-p |
yank-handler arg differs from the yank-handler property of the latest |
1800 |
(concat string (car kill-ring)) |
kill string, STRING is added as a new kill ring element instead of |
1801 |
(concat (car kill-ring) string)) |
being appending to the last kill. |
1802 |
t)) |
If `interprogram-cut-function' is set, pass the resulting kill to it." |
1803 |
|
(let* ((cur (car kill-ring))) |
1804 |
|
(kill-new (if before-p (concat string cur) (concat cur string)) |
1805 |
|
(or (= (length cur) 0) |
1806 |
|
(equal yank-handler (get-text-property 0 'yank-handler cur))) |
1807 |
|
yank-handler))) |
1808 |
|
|
1809 |
(defun current-kill (n &optional do-not-move) |
(defun current-kill (n &optional do-not-move) |
1810 |
"Rotate the yanking point by N places, and then return that kill. |
"Rotate the yanking point by N places, and then return that kill. |
1846 |
'(text-read-only buffer-read-only error)) |
'(text-read-only buffer-read-only error)) |
1847 |
(put 'text-read-only 'error-message "Text is read-only") |
(put 'text-read-only 'error-message "Text is read-only") |
1848 |
|
|
1849 |
(defun kill-region (beg end) |
(defun kill-region (beg end &optional yank-handler) |
1850 |
"Kill between point and mark. |
"Kill between point and mark. |
1851 |
The text is deleted but saved in the kill ring. |
The text is deleted but saved in the kill ring. |
1852 |
The command \\[yank] can retrieve it from there. |
The command \\[yank] can retrieve it from there. |
1865 |
Any command that calls this function is a \"kill command\". |
Any command that calls this function is a \"kill command\". |
1866 |
If the previous command was also a kill command, |
If the previous command was also a kill command, |
1867 |
the text killed this time appends to the text killed last time |
the text killed this time appends to the text killed last time |
1868 |
to make one entry in the kill ring." |
to make one entry in the kill ring. |
1869 |
|
|
1870 |
|
In Lisp code, optional third arg YANK-HANDLER specifies the yank-handler |
1871 |
|
text property to be set on the killed text. See `insert-for-yank'." |
1872 |
(interactive "r") |
(interactive "r") |
1873 |
(condition-case nil |
(condition-case nil |
1874 |
(let ((string (delete-and-extract-region beg end))) |
(let ((string (delete-and-extract-region beg end))) |
1875 |
(when string ;STRING is nil if BEG = END |
(when string ;STRING is nil if BEG = END |
1876 |
;; Add that string to the kill ring, one way or another. |
;; Add that string to the kill ring, one way or another. |
1877 |
(if (eq last-command 'kill-region) |
(if (eq last-command 'kill-region) |
1878 |
(kill-append string (< end beg)) |
(kill-append string (< end beg) yank-handler) |
1879 |
(kill-new string))) |
(kill-new string nil yank-handler))) |
1880 |
(setq this-command 'kill-region)) |
(setq this-command 'kill-region)) |
1881 |
((buffer-read-only text-read-only) |
((buffer-read-only text-read-only) |
1882 |
;; The code above failed because the buffer, or some of the characters |
;; The code above failed because the buffer, or some of the characters |
1967 |
|
|
1968 |
;; This is actually used in subr.el but defcustom does not work there. |
;; This is actually used in subr.el but defcustom does not work there. |
1969 |
(defcustom yank-excluded-properties |
(defcustom yank-excluded-properties |
1970 |
'(read-only invisible intangible field mouse-face help-echo local-map keymap) |
'(read-only invisible intangible field mouse-face help-echo local-map keymap |
1971 |
|
yank-handler) |
1972 |
"*Text properties to discard when yanking." |
"*Text properties to discard when yanking." |
1973 |
:type '(choice (const :tag "All" t) (repeat symbol)) |
:type '(choice (const :tag "All" t) (repeat symbol)) |
1974 |
:group 'editing |
:group 'editing |
1975 |
:version "21.4") |
:version "21.4") |
1976 |
|
|
1977 |
|
(defvar yank-window-start nil) |
1978 |
|
(defvar yank-undo-function nil |
1979 |
|
"If non-nil, function used by `yank-pop' to delete last stretch of yanked text. |
1980 |
|
Function is called with two parameters, START and END corresponding to |
1981 |
|
the value of the mark and point; it is guaranteed that START <= END. |
1982 |
|
Normally set from the UNDO element of a yank-handler; see `insert-for-yank'.") |
1983 |
|
|
1984 |
(defun yank-pop (arg) |
(defun yank-pop (arg) |
1985 |
"Replace just-yanked stretch of killed text with a different stretch. |
"Replace just-yanked stretch of killed text with a different stretch. |
1986 |
This command is allowed only immediately after a `yank' or a `yank-pop'. |
This command is allowed only immediately after a `yank' or a `yank-pop'. |
2000 |
(setq this-command 'yank) |
(setq this-command 'yank) |
2001 |
(let ((inhibit-read-only t) |
(let ((inhibit-read-only t) |
2002 |
(before (< (point) (mark t)))) |
(before (< (point) (mark t)))) |
2003 |
(delete-region (point) (mark t)) |
(if before |
2004 |
|
(funcall (or yank-undo-function 'delete-region) (point) (mark t)) |
2005 |
|
(funcall (or yank-undo-function 'delete-region) (mark t) (point))) |
2006 |
|
(setq yank-undo-function nil) |
2007 |
(set-marker (mark-marker) (point) (current-buffer)) |
(set-marker (mark-marker) (point) (current-buffer)) |
2008 |
(insert-for-yank (current-kill arg)) |
(insert-for-yank (current-kill arg)) |
2009 |
|
;; Set the window start back where it was in the yank command, |
2010 |
|
;; if possible. |
2011 |
|
(set-window-start (selected-window) yank-window-start t) |
2012 |
(if before |
(if before |
2013 |
;; This is like exchange-point-and-mark, but doesn't activate the mark. |
;; This is like exchange-point-and-mark, but doesn't activate the mark. |
2014 |
;; It is cleaner to avoid activation, even though the command |
;; It is cleaner to avoid activation, even though the command |
2021 |
"Reinsert the last stretch of killed text. |
"Reinsert the last stretch of killed text. |
2022 |
More precisely, reinsert the stretch of killed text most recently |
More precisely, reinsert the stretch of killed text most recently |
2023 |
killed OR yanked. Put point at end, and set mark at beginning. |
killed OR yanked. Put point at end, and set mark at beginning. |
2024 |
With just C-u as argument, same but put point at beginning (and mark at end). |
With just \\[universal-argument] as argument, same but put point at beginning (and mark at end). |
2025 |
With argument N, reinsert the Nth most recently killed stretch of killed |
With argument N, reinsert the Nth most recently killed stretch of killed |
2026 |
text. |
text. |
2027 |
See also the command \\[yank-pop]." |
See also the command \\[yank-pop]." |
2028 |
(interactive "*P") |
(interactive "*P") |
2029 |
|
(setq yank-window-start (window-start)) |
2030 |
;; If we don't get all the way thru, make last-command indicate that |
;; If we don't get all the way thru, make last-command indicate that |
2031 |
;; for the following command. |
;; for the following command. |
2032 |
(setq this-command t) |
(setq this-command t) |
2042 |
(goto-char (prog1 (mark t) |
(goto-char (prog1 (mark t) |
2043 |
(set-marker (mark-marker) (point) (current-buffer))))) |
(set-marker (mark-marker) (point) (current-buffer))))) |
2044 |
;; If we do get all the way thru, make this-command indicate that. |
;; If we do get all the way thru, make this-command indicate that. |
2045 |
(setq this-command 'yank) |
(if (eq this-command t) |
2046 |
|
(setq this-command 'yank)) |
2047 |
nil) |
nil) |
2048 |
|
|
2049 |
(defun rotate-yank-pointer (arg) |
(defun rotate-yank-pointer (arg) |
2091 |
(let ((col (current-column))) |
(let ((col (current-column))) |
2092 |
(forward-char -1) |
(forward-char -1) |
2093 |
(setq col (- col (current-column))) |
(setq col (- col (current-column))) |
2094 |
(insert-char ?\ col) |
(insert-char ?\ col) |
2095 |
(delete-char 1))) |
(delete-char 1))) |
2096 |
(forward-char -1) |
(forward-char -1) |
2097 |
(setq count (1- count)))))) |
(setq count (1- count)))))) |
2158 |
(forward-visible-line (prefix-numeric-value arg)) |
(forward-visible-line (prefix-numeric-value arg)) |
2159 |
(if (eobp) |
(if (eobp) |
2160 |
(signal 'end-of-buffer nil)) |
(signal 'end-of-buffer nil)) |
2161 |
(if (or (looking-at "[ \t]*$") (and kill-whole-line (bolp))) |
(let ((end |
2162 |
(forward-visible-line 1) |
(save-excursion |
2163 |
(end-of-visible-line))) |
(end-of-visible-line) (point)))) |
2164 |
|
(if (or (save-excursion |
2165 |
|
(skip-chars-forward " \t" end) |
2166 |
|
(= (point) end)) |
2167 |
|
(and kill-whole-line (bolp))) |
2168 |
|
(forward-visible-line 1) |
2169 |
|
(goto-char end)))) |
2170 |
(point)))) |
(point)))) |
2171 |
|
|
2172 |
|
|
2173 |
(defun forward-visible-line (arg) |
(defun forward-visible-line (arg) |
2174 |
"Move forward by ARG lines, ignoring currently invisible newlines only. |
"Move forward by ARG lines, ignoring currently invisible newlines only. |
2175 |
If ARG is negative, move backward -ARG lines. |
If ARG is negative, move backward -ARG lines. |
2176 |
If ARG is zero, move to the beginning of the current line." |
If ARG is zero, move to the beginning of the current line." |
2177 |
(condition-case nil |
(condition-case nil |
2178 |
(if (> arg 0) |
(if (> arg 0) |
2179 |
(while (> arg 0) |
(progn |
2180 |
(or (zerop (forward-line 1)) |
(while (> arg 0) |
|
(signal 'end-of-buffer nil)) |
|
|
;; If the following character is currently invisible, |
|
|
;; skip all characters with that same `invisible' property value, |
|
|
;; then find the next newline. |
|
|
(while (and (not (eobp)) |
|
|
(let ((prop |
|
|
(get-char-property (point) 'invisible))) |
|
|
(if (eq buffer-invisibility-spec t) |
|
|
prop |
|
|
(or (memq prop buffer-invisibility-spec) |
|
|
(assq prop buffer-invisibility-spec))))) |
|
|
(goto-char |
|
|
(if (get-text-property (point) 'invisible) |
|
|
(or (next-single-property-change (point) 'invisible) |
|
|
(point-max)) |
|
|
(next-overlay-change (point)))) |
|
2181 |
(or (zerop (forward-line 1)) |
(or (zerop (forward-line 1)) |
2182 |
(signal 'end-of-buffer nil))) |
(signal 'end-of-buffer nil)) |
2183 |
(setq arg (1- arg))) |
;; If the newline we just skipped is invisible, |
2184 |
|
;; don't count it. |
2185 |
|
(let ((prop |
2186 |
|
(get-char-property (1- (point)) 'invisible))) |
2187 |
|
(if (if (eq buffer-invisibility-spec t) |
2188 |
|
prop |
2189 |
|
(or (memq prop buffer-invisibility-spec) |
2190 |
|
(assq prop buffer-invisibility-spec))) |
2191 |
|
(setq arg (1+ arg)))) |
2192 |
|
(setq arg (1- arg))) |
2193 |
|
;; If invisible text follows, and it is a number of complete lines, |
2194 |
|
;; skip it. |
2195 |
|
(let ((opoint (point))) |
2196 |
|
(while (and (not (eobp)) |
2197 |
|
(let ((prop |
2198 |
|
(get-char-property (point) 'invisible))) |
2199 |
|
(if (eq buffer-invisibility-spec t) |
2200 |
|
prop |
2201 |
|
(or (memq prop buffer-invisibility-spec) |
2202 |
|
(assq prop buffer-invisibility-spec))))) |
2203 |
|
(goto-char |
2204 |
|
(if (get-text-property (point) 'invisible) |
2205 |
|
(or (next-single-property-change (point) 'invisible) |
2206 |
|
(point-max)) |
2207 |
|
(next-overlay-change (point))))) |
2208 |
|
(unless (bolp) |
2209 |
|
(goto-char opoint)))) |
2210 |
(let ((first t)) |
(let ((first t)) |
2211 |
(while (or first (< arg 0)) |
(while (or first (< arg 0)) |
2212 |
(if (zerop arg) |
(if (zerop arg) |
2213 |
(beginning-of-line) |
(beginning-of-line) |
2214 |
(or (zerop (forward-line -1)) |
(or (zerop (forward-line -1)) |
2215 |
(signal 'beginning-of-buffer nil))) |
(signal 'beginning-of-buffer nil))) |
2216 |
|
;; If the newline we just moved to is invisible, |
2217 |
|
;; don't count it. |
2218 |
|
(unless (bobp) |
2219 |
|
(let ((prop |
2220 |
|
(get-char-property (1- (point)) 'invisible))) |
2221 |
|
(if (if (eq buffer-invisibility-spec t) |
2222 |
|
prop |
2223 |
|
(or (memq prop buffer-invisibility-spec) |
2224 |
|
(assq prop buffer-invisibility-spec))) |
2225 |
|
(setq arg (1+ arg))))) |
2226 |
|
(setq first nil) |
2227 |
|
(setq arg (1+ arg))) |
2228 |
|
;; If invisible text follows, and it is a number of complete lines, |
2229 |
|
;; skip it. |
2230 |
|
(let ((opoint (point))) |
2231 |
(while (and (not (bobp)) |
(while (and (not (bobp)) |
2232 |
(let ((prop |
(let ((prop |
2233 |
(get-char-property (1- (point)) 'invisible))) |
(get-char-property (1- (point)) 'invisible))) |
2239 |
(if (get-text-property (1- (point)) 'invisible) |
(if (get-text-property (1- (point)) 'invisible) |
2240 |
(or (previous-single-property-change (point) 'invisible) |
(or (previous-single-property-change (point) 'invisible) |
2241 |
(point-min)) |
(point-min)) |
2242 |
(previous-overlay-change (point)))) |
(previous-overlay-change (point))))) |
2243 |
(or (zerop (forward-line -1)) |
(unless (bolp) |
2244 |
(signal 'beginning-of-buffer nil))) |
(goto-char opoint))))) |
|
(setq first nil) |
|
|
(setq arg (1+ arg))))) |
|
2245 |
((beginning-of-buffer end-of-buffer) |
((beginning-of-buffer end-of-buffer) |
2246 |
nil))) |
nil))) |
2247 |
|
|
2252 |
;; skip all characters with that same `invisible' property value, |
;; skip all characters with that same `invisible' property value, |
2253 |
;; then find the next newline. |
;; then find the next newline. |
2254 |
(while (and (not (eobp)) |
(while (and (not (eobp)) |
2255 |
(let ((prop |
(save-excursion |
2256 |
(get-char-property (point) 'invisible))) |
(skip-chars-forward "^\n") |
2257 |
(if (eq buffer-invisibility-spec t) |
(let ((prop |
2258 |
prop |
(get-char-property (point) 'invisible))) |
2259 |
(or (memq prop buffer-invisibility-spec) |
(if (eq buffer-invisibility-spec t) |
2260 |
(assq prop buffer-invisibility-spec))))) |
prop |
2261 |
|
(or (memq prop buffer-invisibility-spec) |
2262 |
|
(assq prop buffer-invisibility-spec)))))) |
2263 |
|
(skip-chars-forward "^\n") |
2264 |
(if (get-text-property (point) 'invisible) |
(if (get-text-property (point) 'invisible) |
2265 |
(goto-char (next-single-property-change (point) 'invisible)) |
(goto-char (next-single-property-change (point) 'invisible)) |
2266 |
(goto-char (next-overlay-change (point)))) |
(goto-char (next-overlay-change (point)))) |
2447 |
|
|
2448 |
(defun set-mark-command (arg) |
(defun set-mark-command (arg) |
2449 |
"Set mark at where point is, or jump to mark. |
"Set mark at where point is, or jump to mark. |
2450 |
With no prefix argument, set mark, push old mark position on local mark |
With no prefix argument, set mark, and push old mark position on local |
2451 |
ring, and push mark on global mark ring. Immediately repeating the |
mark ring; also push mark on global mark ring if last mark was set in |
2452 |
command activates `transient-mark-mode' temporarily. |
another buffer. Immediately repeating the command activates |
2453 |
|
`transient-mark-mode' temporarily. |
2454 |
With argument, jump to mark, and pop a new position for mark off the ring |
|
2455 |
\(does not affect global mark ring\). Repeating the command without |
With argument, e.g. \\[universal-argument] \\[set-mark-command], \ |
2456 |
an argument jumps to the next position off the mark ring. |
jump to mark, and pop a new position |
2457 |
|
for mark off the local mark ring \(this does not affect the global |
2458 |
|
mark ring\). Use \\[pop-global-mark] to jump to a mark off the global |
2459 |
|
mark ring \(see `pop-global-mark'\). |
2460 |
|
|
2461 |
|
Repeating the \\[set-mark-command] command without the prefix jumps to |
2462 |
|
the next position off the local (or global) mark ring. |
2463 |
|
|
2464 |
|
With a double \\[universal-argument] prefix argument, e.g. \\[universal-argument] \ |
2465 |
|
\\[universal-argument] \\[set-mark-command], unconditionally |
2466 |
|
set mark where point is. |
2467 |
|
|
2468 |
Novice Emacs Lisp programmers often try to use the mark for the wrong |
Novice Emacs Lisp programmers often try to use the mark for the wrong |
2469 |
purposes. See the documentation of `set-mark' for more information." |
purposes. See the documentation of `set-mark' for more information." |
2471 |
(if (eq transient-mark-mode 'lambda) |
(if (eq transient-mark-mode 'lambda) |
2472 |
(setq transient-mark-mode nil)) |
(setq transient-mark-mode nil)) |
2473 |
(cond |
(cond |
2474 |
|
((and (consp arg) (> (prefix-numeric-value arg) 4)) |
2475 |
|
(push-mark-command nil)) |
2476 |
((not (eq this-command 'set-mark-command)) |
((not (eq this-command 'set-mark-command)) |
2477 |
(if arg |
(if arg |
2478 |
(pop-to-mark-command) |
(pop-to-mark-command) |
2479 |
(push-mark-command t))) |
(push-mark-command t))) |
2480 |
((eq last-command 'pop-to-mark-command) |
((eq last-command 'pop-to-mark-command) |
2481 |
(if (and (consp arg) (> (prefix-numeric-value arg) 4)) |
(setq this-command 'pop-to-mark-command) |
2482 |
(push-mark-command nil) |
(pop-to-mark-command)) |
2483 |
(setq this-command 'pop-to-mark-command) |
((and (eq last-command 'pop-global-mark) (not arg)) |
2484 |
(pop-to-mark-command))) |
(setq this-command 'pop-global-mark) |
2485 |
|
(pop-global-mark)) |
2486 |
(arg |
(arg |
2487 |
(setq this-command 'pop-to-mark-command) |
(setq this-command 'pop-to-mark-command) |
2488 |
(pop-to-mark-command)) |
(pop-to-mark-command)) |
2550 |
With prefix arg, `transient-mark-mode' is enabled temporarily." |
With prefix arg, `transient-mark-mode' is enabled temporarily." |
2551 |
(interactive "P") |
(interactive "P") |
2552 |
(if arg |
(if arg |
2553 |
(if mark-active |
(if mark-active |
2554 |
(if (null transient-mark-mode) |
(if (null transient-mark-mode) |
2555 |
(setq transient-mark-mode 'lambda)) |
(setq transient-mark-mode 'lambda)) |
2556 |
(setq arg nil))) |
(setq arg nil))) |
2562 |
(goto-char omark) |
(goto-char omark) |
2563 |
nil))) |
nil))) |
2564 |
|
|
2565 |
(defun transient-mark-mode (arg) |
(define-minor-mode transient-mark-mode |
2566 |
"Toggle Transient Mark mode. |
"Toggle Transient Mark mode. |
2567 |
With arg, turn Transient Mark mode on if arg is positive, off otherwise. |
With arg, turn Transient Mark mode on if arg is positive, off otherwise. |
2568 |
|
|
2583 |
\\[apropos-documentation] and type \"transient\" or \"mark.*active\" at |
\\[apropos-documentation] and type \"transient\" or \"mark.*active\" at |
2584 |
the prompt, to see the documentation of commands which are sensitive to |
the prompt, to see the documentation of commands which are sensitive to |
2585 |
the Transient Mark mode." |
the Transient Mark mode." |
2586 |
(interactive "P") |
:global t :group 'editing-basics :require nil) |
|
(setq transient-mark-mode |
|
|
(if (null arg) |
|
|
(not transient-mark-mode) |
|
|
(> (prefix-numeric-value arg) 0))) |
|
|
(if (interactive-p) |
|
|
(if transient-mark-mode |
|
|
(message "Transient Mark mode enabled") |
|
|
(message "Transient Mark mode disabled")))) |
|
2587 |
|
|
2588 |
(defun pop-global-mark () |
(defun pop-global-mark () |
2589 |
"Pop off global mark ring and jump to the top location." |
"Pop off global mark ring and jump to the top location." |
3163 |
(and prefix (not (equal prefix "")) |
(and prefix (not (equal prefix "")) |
3164 |
;; Use auto-indentation rather than a guessed empty prefix. |
;; Use auto-indentation rather than a guessed empty prefix. |
3165 |
(not (and fill-indent-according-to-mode |
(not (and fill-indent-according-to-mode |
3166 |
(string-match "[ \t]*" prefix))) |
(string-match "\\`[ \t]*\\'" prefix))) |
3167 |
(setq fill-prefix prefix)))) |
(setq fill-prefix prefix)))) |
3168 |
|
|
3169 |
(while (and (not give-up) (> (current-column) fc)) |
(while (and (not give-up) (> (current-column) fc)) |
3170 |
;; Determine where to split the line. |
;; Determine where to split the line. |
3171 |
(let* (after-prefix |
(let* (after-prefix |
3230 |
"The function to use for `auto-fill-function' if Auto Fill mode is turned on. |
"The function to use for `auto-fill-function' if Auto Fill mode is turned on. |
3231 |
Some major modes set this.") |
Some major modes set this.") |
3232 |
|
|
3233 |
|
;; FIXME: turn into a proper minor mode. |
3234 |
|
;; Add a global minor mode version of it. |
3235 |
(defun auto-fill-mode (&optional arg) |
(defun auto-fill-mode (&optional arg) |
3236 |
"Toggle Auto Fill mode. |
"Toggle Auto Fill mode. |
3237 |
With arg, turn Auto Fill mode on if and only if arg is positive. |
With arg, turn Auto Fill mode on if and only if arg is positive. |
3298 |
(prin1 selective-display t) |
(prin1 selective-display t) |
3299 |
(princ "." t)) |
(princ "." t)) |
3300 |
|
|
3301 |
|
(defvaralias 'indicate-unused-lines 'indicate-empty-lines) |
3302 |
|
(defvaralias 'default-indicate-unused-lines 'default-indicate-empty-lines) |
3303 |
|
|
3304 |
|
(defun toggle-truncate-lines (arg) |
3305 |
|
"Toggle whether to fold or truncate long lines on the screen. |
3306 |
|
With arg, truncate long lines iff arg is positive. |
3307 |
|
Note that in side-by-side windows, truncation is always enabled." |
3308 |
|
(interactive "P") |
3309 |
|
(setq truncate-lines |
3310 |
|
(if (null arg) |
3311 |
|
(not truncate-lines) |
3312 |
|
(> (prefix-numeric-value arg) 0))) |
3313 |
|
(force-mode-line-update) |
3314 |
|
(unless truncate-lines |
3315 |
|
(let ((buffer (current-buffer))) |
3316 |
|
(walk-windows (lambda (window) |
3317 |
|
(if (eq buffer (window-buffer window)) |
3318 |
|
(set-window-hscroll window 0))) |
3319 |
|
nil t))) |
3320 |
|
(message "Truncate long lines %s" |
3321 |
|
(if truncate-lines "enabled" "disabled"))) |
3322 |
|
|
3323 |
(defvar overwrite-mode-textual " Ovwrt" |
(defvar overwrite-mode-textual " Ovwrt" |
3324 |
"The string displayed in the mode line when in overwrite mode.") |
"The string displayed in the mode line when in overwrite mode.") |
3325 |
(defvar overwrite-mode-binary " Bin Ovwrt" |
(defvar overwrite-mode-binary " Bin Ovwrt" |
3363 |
'overwrite-mode-binary)) |
'overwrite-mode-binary)) |
3364 |
(force-mode-line-update)) |
(force-mode-line-update)) |
3365 |
|
|
3366 |
(defcustom line-number-mode t |
(define-minor-mode line-number-mode |
|
"*Non-nil means display line number in mode line." |
|
|
:type 'boolean |
|
|
:group 'editing-basics) |
|
|
|
|
|
(defun line-number-mode (arg) |
|
3367 |
"Toggle Line Number mode. |
"Toggle Line Number mode. |
3368 |
With arg, turn Line Number mode on iff arg is positive. |
With arg, turn Line Number mode on iff arg is positive. |
3369 |
When Line Number mode is enabled, the line number appears |
When Line Number mode is enabled, the line number appears |
3372 |
Line numbers do not appear for very large buffers and buffers |
Line numbers do not appear for very large buffers and buffers |
3373 |
with very long lines; see variables `line-number-display-limit' |
with very long lines; see variables `line-number-display-limit' |
3374 |
and `line-number-display-limit-width'." |
and `line-number-display-limit-width'." |
3375 |
(interactive "P") |
:init-value t :global t :group 'editing-basics :require nil) |
|
(setq line-number-mode |
|
|
(if (null arg) (not line-number-mode) |
|
|
(> (prefix-numeric-value arg) 0))) |
|
|
(force-mode-line-update)) |
|
3376 |
|
|
3377 |
(defcustom column-number-mode nil |
(define-minor-mode column-number-mode |
|
"*Non-nil means display column number in mode line." |
|
|
:type 'boolean |
|
|
:group 'editing-basics) |
|
|
|
|
|
(defun column-number-mode (arg) |
|
3378 |
"Toggle Column Number mode. |
"Toggle Column Number mode. |
3379 |
With arg, turn Column Number mode on iff arg is positive. |
With arg, turn Column Number mode on iff arg is positive. |
3380 |
When Column Number mode is enabled, the column number appears |
When Column Number mode is enabled, the column number appears |
3381 |
in the mode line." |
in the mode line." |
3382 |
(interactive "P") |
:global t :group 'editing-basics :require nil) |
|
(setq column-number-mode |
|
|
(if (null arg) (not column-number-mode) |
|
|
(> (prefix-numeric-value arg) 0))) |
|
|
(force-mode-line-update)) |
|
3383 |
|
|
3384 |
(defgroup paren-blinking nil |
(defgroup paren-blinking nil |
3385 |
"Blinking matching of parens and expressions." |
"Blinking matching of parens and expressions." |
3505 |
At top-level, as an editor command, this simply beeps." |
At top-level, as an editor command, this simply beeps." |
3506 |
(interactive) |
(interactive) |
3507 |
(deactivate-mark) |
(deactivate-mark) |
3508 |
|
(setq defining-kbd-macro nil) |
3509 |
(signal 'quit nil)) |
(signal 'quit nil)) |
3510 |
|
|
3511 |
(define-key global-map "\C-g" 'keyboard-quit) |
(define-key global-map "\C-g" 'keyboard-quit) |
3604 |
(function :tag "Other")) |
(function :tag "Other")) |
3605 |
:group 'mail) |
:group 'mail) |
3606 |
|
|
|
(defun define-mail-user-agent (symbol composefunc sendfunc |
|
|
&optional abortfunc hookvar) |
|
|
"Define a symbol to identify a mail-sending package for `mail-user-agent'. |
|
|
|
|
|
SYMBOL can be any Lisp symbol. Its function definition and/or |
|
|
value as a variable do not matter for this usage; we use only certain |
|
|
properties on its property list, to encode the rest of the arguments. |
|
|
|
|
|
COMPOSEFUNC is program callable function that composes an outgoing |
|
|
mail message buffer. This function should set up the basics of the |
|
|
buffer without requiring user interaction. It should populate the |
|
|
standard mail headers, leaving the `to:' and `subject:' headers blank |
|
|
by default. |
|
|
|
|
|
COMPOSEFUNC should accept several optional arguments--the same |
|
|
arguments that `compose-mail' takes. See that function's documentation. |
|
|
|
|
|
SENDFUNC is the command a user would run to send the message. |
|
|
|
|
|
Optional ABORTFUNC is the command a user would run to abort the |
|
|
message. For mail packages that don't have a separate abort function, |
|
|
this can be `kill-buffer' (the equivalent of omitting this argument). |
|
|
|
|
|
Optional HOOKVAR is a hook variable that gets run before the message |
|
|
is actually sent. Callers that use the `mail-user-agent' may |
|
|
install a hook function temporarily on this hook variable. |
|
|
If HOOKVAR is nil, `mail-send-hook' is used. |
|
|
|
|
|
The properties used on SYMBOL are `composefunc', `sendfunc', |
|
|
`abortfunc', and `hookvar'." |
|
|
(put symbol 'composefunc composefunc) |
|
|
(put symbol 'sendfunc sendfunc) |
|
|
(put symbol 'abortfunc (or abortfunc 'kill-buffer)) |
|
|
(put symbol 'hookvar (or hookvar 'mail-send-hook))) |
|
|
|
|
3607 |
(define-mail-user-agent 'sendmail-user-agent |
(define-mail-user-agent 'sendmail-user-agent |
3608 |
'sendmail-user-agent-compose |
'sendmail-user-agent-compose |
3609 |
'mail-send-and-exit) |
'mail-send-and-exit) |
3700 |
(defvar set-variable-value-history nil |
(defvar set-variable-value-history nil |
3701 |
"History of values entered with `set-variable'.") |
"History of values entered with `set-variable'.") |
3702 |
|
|
3703 |
(defun set-variable (var val) |
(defun set-variable (var val &optional make-local) |
3704 |
"Set VARIABLE to VALUE. VALUE is a Lisp object. |
"Set VARIABLE to VALUE. VALUE is a Lisp object. |
3705 |
When using this interactively, enter a Lisp object for VALUE. |
When using this interactively, enter a Lisp object for VALUE. |
3706 |
If you want VALUE to be a string, you must surround it with doublequotes. |
If you want VALUE to be a string, you must surround it with doublequotes. |
3710 |
it were the arg to `interactive' (which see) to interactively read VALUE. |
it were the arg to `interactive' (which see) to interactively read VALUE. |
3711 |
|
|
3712 |
If VARIABLE has been defined with `defcustom', then the type information |
If VARIABLE has been defined with `defcustom', then the type information |
3713 |
in the definition is used to check that VALUE is valid." |
in the definition is used to check that VALUE is valid. |
3714 |
|
|
3715 |
|
With a prefix argument, set VARIABLE to VALUE buffer-locally." |
3716 |
(interactive |
(interactive |
3717 |
(let* ((default-var (variable-at-point)) |
(let* ((default-var (variable-at-point)) |
3718 |
(var (if (symbolp default-var) |
(var (if (symbolp default-var) |
3721 |
(read-variable "Set variable: "))) |
(read-variable "Set variable: "))) |
3722 |
(minibuffer-help-form '(describe-variable var)) |
(minibuffer-help-form '(describe-variable var)) |
3723 |
(prop (get var 'variable-interactive)) |
(prop (get var 'variable-interactive)) |
3724 |
(prompt (format "Set %s to value: " var)) |
(prompt (format "Set %s%s to value: " var |
3725 |
|
(cond ((local-variable-p var) |
3726 |
|
" (buffer-local)") |
3727 |
|
((or current-prefix-arg |
3728 |
|
(local-variable-if-set-p var)) |
3729 |
|
" buffer-locally") |
3730 |
|
(t " globally")))) |
3731 |
(val (if prop |
(val (if prop |
3732 |
;; Use VAR's `variable-interactive' property |
;; Use VAR's `variable-interactive' property |
3733 |
;; as an interactive spec for prompting. |
;; as an interactive spec for prompting. |
3737 |
(read |
(read |
3738 |
(read-string prompt nil |
(read-string prompt nil |
3739 |
'set-variable-value-history))))) |
'set-variable-value-history))))) |
3740 |
(list var val))) |
(list var val current-prefix-arg))) |
3741 |
|
|
3742 |
|
(and (custom-variable-p var) |
3743 |
|
(not (get var 'custom-type)) |
3744 |
|
(custom-load-symbol var)) |
3745 |
(let ((type (get var 'custom-type))) |
(let ((type (get var 'custom-type))) |
3746 |
(when type |
(when type |
3747 |
;; Match with custom type. |
;; Match with custom type. |
3750 |
(unless (widget-apply type :match val) |
(unless (widget-apply type :match val) |
3751 |
(error "Value `%S' does not match type %S of %S" |
(error "Value `%S' does not match type %S of %S" |
3752 |
val (car type) var)))) |
val (car type) var)))) |
3753 |
|
|
3754 |
|
(if make-local |
3755 |
|
(make-local-variable var)) |
3756 |
|
|
3757 |
(set var val) |
(set var val) |
3758 |
|
|
3759 |
;; Force a thorough redisplay for the case that the variable |
;; Force a thorough redisplay for the case that the variable |
3867 |
;; that can be found before POINT. |
;; that can be found before POINT. |
3868 |
(defun choose-completion-delete-max-match (string) |
(defun choose-completion-delete-max-match (string) |
3869 |
(let ((opoint (point)) |
(let ((opoint (point)) |
3870 |
(len (min (length string) |
len) |
3871 |
(- (point) (point-min))))) |
;; Try moving back by the length of the string. |
3872 |
(goto-char (- (point) (length string))) |
(goto-char (max (- (point) (length string)) |
3873 |
|
(minibuffer-prompt-end))) |
3874 |
|
;; See how far back we were actually able to move. That is the |
3875 |
|
;; upper bound on how much we can match and delete. |
3876 |
|
(setq len (- opoint (point))) |
3877 |
(if completion-ignore-case |
(if completion-ignore-case |
3878 |
(setq string (downcase string))) |
(setq string (downcase string))) |
3879 |
(while (and (> len 0) |
(while (and (> len 0) |
3880 |
(let ((tail (buffer-substring (point) |
(let ((tail (buffer-substring (point) opoint))) |
|
(+ (point) len)))) |
|
3881 |
(if completion-ignore-case |
(if completion-ignore-case |
3882 |
(setq tail (downcase tail))) |
(setq tail (downcase tail))) |
3883 |
(not (string= tail (substring string 0 len))))) |
(not (string= tail (substring string 0 len))))) |
3890 |
These functions are called in order with four arguments: |
These functions are called in order with four arguments: |
3891 |
CHOICE - the string to insert in the buffer, |
CHOICE - the string to insert in the buffer, |
3892 |
BUFFER - the buffer in which the choice should be inserted, |
BUFFER - the buffer in which the choice should be inserted, |
3893 |
MINI-P - non-nil iff BUFFER is a minibuffer, and |
MINI-P - non-nil iff BUFFER is a minibuffer, and |
3894 |
BASE-SIZE - the number of characters in BUFFER before |
BASE-SIZE - the number of characters in BUFFER before |
3895 |
the string being completed. |
the string being completed. |
3896 |
|
|
3904 |
(defun choose-completion-string (choice &optional buffer base-size) |
(defun choose-completion-string (choice &optional buffer base-size) |
3905 |
"Switch to BUFFER and insert the completion choice CHOICE. |
"Switch to BUFFER and insert the completion choice CHOICE. |
3906 |
BASE-SIZE, if non-nil, says how many characters of BUFFER's text |
BASE-SIZE, if non-nil, says how many characters of BUFFER's text |
3907 |
to keep. If it is nil, use choose-completion-delete-max-match instead." |
to keep. If it is nil, we call `choose-completion-delete-max-match' |
3908 |
|
to decide what to delete." |
3909 |
|
|
3910 |
;; If BUFFER is the minibuffer, exit the minibuffer |
;; If BUFFER is the minibuffer, exit the minibuffer |
3911 |
;; unless it is reading a file name and CHOICE is a directory, |
;; unless it is reading a file name and CHOICE is a directory, |
3912 |
;; or completion-no-auto-exit is non-nil. |
;; or completion-no-auto-exit is non-nil. |
3913 |
|
|
3914 |
(let ((buffer (or buffer completion-reference-buffer)) |
(let ((buffer (or buffer completion-reference-buffer)) |
3915 |
(mini-p (string-match "\\` \\*Minibuf-[0-9]+\\*\\'" (buffer-name buffer)))) |
(mini-p (string-match "\\` \\*Minibuf-[0-9]+\\*\\'" |
3916 |
|
(buffer-name buffer)))) |
3917 |
;; If BUFFER is a minibuffer, barf unless it's the currently |
;; If BUFFER is a minibuffer, barf unless it's the currently |
3918 |
;; active minibuffer. |
;; active minibuffer. |
3919 |
(if (and mini-p |
(if (and mini-p |
3921 |
(not (equal buffer |
(not (equal buffer |
3922 |
(window-buffer (active-minibuffer-window)))))) |
(window-buffer (active-minibuffer-window)))))) |
3923 |
(error "Minibuffer is not active for completion") |
(error "Minibuffer is not active for completion") |
3924 |
(unless (run-hook-with-args-until-success |
(unless (run-hook-with-args-until-success |
3925 |
'choose-completion-string-functions choice buffer mini-p base-size) |
'choose-completion-string-functions |
3926 |
;; Insert the completion into the buffer where completion was requested. |
choice buffer mini-p base-size) |
3927 |
|
;; Insert the completion into the buffer where it was requested. |
3928 |
(set-buffer buffer) |
(set-buffer buffer) |
3929 |
(if base-size |
(if base-size |
3930 |
(delete-region (+ base-size (if mini-p |
(delete-region (+ base-size (if mini-p |
3986 |
|
|
3987 |
(defun completion-setup-function () |
(defun completion-setup-function () |
3988 |
(save-excursion |
(save-excursion |
3989 |
(let ((mainbuf (current-buffer))) |
(let ((mainbuf (current-buffer)) |
3990 |
|
(mbuf-contents (minibuffer-contents))) |
3991 |
|
;; When reading a file name in the minibuffer, |
3992 |
|
;; set default-directory in the minibuffer |
3993 |
|
;; so it will get copied into the completion list buffer. |
3994 |
|
(if minibuffer-completing-file-name |
3995 |
|
(with-current-buffer mainbuf |
3996 |
|
(setq default-directory (file-name-directory mbuf-contents)))) |
3997 |
(set-buffer standard-output) |
(set-buffer standard-output) |
3998 |
(completion-list-mode) |
(completion-list-mode) |
3999 |
(make-local-variable 'completion-reference-buffer) |
(make-local-variable 'completion-reference-buffer) |
4000 |
(setq completion-reference-buffer mainbuf) |
(setq completion-reference-buffer mainbuf) |
4001 |
(if (eq minibuffer-completion-table 'read-file-name-internal) |
(if minibuffer-completing-file-name |
4002 |
;; For file name completion, |
;; For file name completion, |
4003 |
;; use the number of chars before the start of the |
;; use the number of chars before the start of the |
4004 |
;; last file name component. |
;; last file name component. |
4006 |
(save-excursion |
(save-excursion |
4007 |
(set-buffer mainbuf) |
(set-buffer mainbuf) |
4008 |
(goto-char (point-max)) |
(goto-char (point-max)) |
4009 |
(skip-chars-backward (format "^%c" directory-sep-char)) |
(skip-chars-backward "^/") |
4010 |
(- (point) (minibuffer-prompt-end)))) |
(- (point) (minibuffer-prompt-end)))) |
4011 |
;; Otherwise, in minibuffer, the whole input is being completed. |
;; Otherwise, in minibuffer, the whole input is being completed. |
4012 |
(save-match-data |
(save-match-data |
4162 |
(let ((args (process-contact process t))) |
(let ((args (process-contact process t))) |
4163 |
(setq args (plist-put args :name newname)) |
(setq args (plist-put args :name newname)) |
4164 |
(setq args (plist-put args :buffer |
(setq args (plist-put args :buffer |
4165 |
(if (process-buffer process) (current-buffer)))) |
(if (process-buffer process) |
4166 |
|
(current-buffer)))) |
4167 |
(apply 'make-network-process args)) |
(apply 'make-network-process args)) |
4168 |
(apply 'start-process newname |
(apply 'start-process newname |
4169 |
(if (process-buffer process) (current-buffer)) |
(if (process-buffer process) (current-buffer)) |
4174 |
new-process (process-inherit-coding-system-flag process)) |
new-process (process-inherit-coding-system-flag process)) |
4175 |
(set-process-filter new-process (process-filter process)) |
(set-process-filter new-process (process-filter process)) |
4176 |
(set-process-sentinel new-process (process-sentinel process)) |
(set-process-sentinel new-process (process-sentinel process)) |
4177 |
|
(set-process-plist new-process (copy-sequence (process-plist process))) |
4178 |
new-process))) |
new-process))) |
4179 |
|
|
4180 |
;; things to maybe add (currently partly covered by `funcall mode'): |
;; things to maybe add (currently partly covered by `funcall mode'): |
4418 |
; (message "You cannot modify the prompt"))) |
; (message "You cannot modify the prompt"))) |
4419 |
; |
; |
4420 |
; |
; |
4421 |
;(setq minibuffer-prompt-properties |
;(setq minibuffer-prompt-properties |
4422 |
; (list 'modification-hooks '(minibuffer-prompt-modification) |
; (list 'modification-hooks '(minibuffer-prompt-modification) |
4423 |
; 'insert-in-front-hooks '(minibuffer-prompt-insertion))) |
; 'insert-in-front-hooks '(minibuffer-prompt-insertion))) |
4424 |
; |
; |
4425 |
|
|
4426 |
|
(provide 'simple) |
4427 |
;;; simple.el ends here |
;;; simple.el ends here |