/[emacs]/emacs/lisp/simple.el
ViewVC logotype

Diff of /emacs/lisp/simple.el

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.551 by miles, Mon Jun 10 08:04:48 2002 UTC revision 1.551.2.1 by miles, Fri Apr 4 06:20:11 2003 UTC
# Line 1  Line 1 
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
# Line 180  With arg N, insert N newlines." Line 181  With arg N, insert N newlines."
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    
# Line 318  In binary overwrite mode, this function Line 333  In binary overwrite mode, this function
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.
# Line 352  useful for editing binary files." Line 368  useful for editing binary files."
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.
# Line 489  that uses or sets the mark." Line 506  that uses or sets the mark."
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.
# Line 530  code is shown in hex.  If the character Line 547  code is shown in hex.  If the character
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))
# Line 570  in *Help* buffer.  See also the command Line 587  in *Help* buffer.  See also the command
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)
# Line 650  the echo area." Line 667  the echo area."
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.
# Line 683  to get different commands to edit and re Line 702  to get different commands to edit and re
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.
# Line 932  as an argument limits undo to changes wi Line 955  as an argument limits undo to changes wi
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))
# Line 979  Some change-hooks test this variable to Line 1004  Some change-hooks test this variable to
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    
# Line 1085  we stop and ignore all further elements. Line 1112  we stop and ignore all further elements.
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)
# Line 1105  If it crosses the edge, we return nil." Line 1132  If it crosses the edge, we return nil."
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.
# Line 1154  is not *inside* the region START...END." Line 1181  is not *inside* the 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    
# Line 1264  specifies the value of ERROR-BUFFER." Line 1291  specifies the value of ERROR-BUFFER."
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*")))
# Line 1335  and only used if a buffer is displayed." Line 1362  and only used if a buffer is displayed."
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)
# Line 1463  specifies the value of ERROR-BUFFER." Line 1494  specifies the value of ERROR-BUFFER."
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,
# Line 1496  specifies the value of ERROR-BUFFER." Line 1526  specifies the value of ERROR-BUFFER."
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)
# Line 1511  specifies the value of ERROR-BUFFER." Line 1544  specifies the value of ERROR-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              ))))              ))))
# Line 1718  ring directly.") Line 1757  ring directly.")
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))
# Line 1735  the front of the kill ring, rather than Line 1791  the front of the kill ring, rather than
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.
# Line 1785  yanking point; just return the Nth kill Line 1846  yanking point; just return the Nth 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.
# Line 1804  Supply two arguments, character numbers Line 1865  Supply two arguments, character numbers
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
# Line 1903  The argument is used for internal purpos Line 1967  The argument is used for internal purpos
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'.
# Line 1928  comes the newest one." Line 2000  comes the newest one."
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
# Line 1943  comes the newest one." Line 2021  comes the newest one."
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)
# Line 1963  See also the command \\[yank-pop]." Line 2042  See also the command \\[yank-pop]."
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)
# Line 2011  and KILLP is t if a prefix arg was speci Line 2091  and KILLP is t if a prefix arg was speci
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))))))
# Line 2078  you can use this command to copy text fr Line 2158  you can use this command to copy text fr
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)))
# Line 2127  If ARG is zero, move to the beginning of Line 2239  If ARG is zero, move to the beginning of
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    
# Line 2142  If ARG is zero, move to the beginning of Line 2252  If ARG is zero, move to the beginning of
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))))
# Line 2334  Display `Mark set' unless the optional s Line 2447  Display `Mark set' unless the optional s
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."
# Line 2348  purposes.  See the documentation of `set Line 2471  purposes.  See the documentation of `set
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))
# Line 2424  and it reactivates the mark. Line 2550  and it reactivates the mark.
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)))
# Line 2436  With prefix arg, `transient-mark-mode' i Line 2562  With prefix arg, `transient-mark-mode' i
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    
# Line 2457  default part of the buffer's text.  Exam Line 2583  default part of the buffer's text.  Exam
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."
# Line 3045  Setting this variable automatically make Line 3163  Setting this variable automatically make
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
# Line 3112  Setting this variable automatically make Line 3230  Setting this variable automatically make
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.
# Line 3178  The variable `selective-display' has a s Line 3298  The variable `selective-display' has a s
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"
# Line 3221  specialization of overwrite-mode, entere Line 3363  specialization of overwrite-mode, entere
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
# Line 3235  in the mode line. Line 3372  in the mode line.
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."
# Line 3381  During execution of Lisp code, this char Line 3505  During execution of Lisp code, this char
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)
# Line 3479  See also `read-mail-command' concerning Line 3604  See also `read-mail-command' concerning
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)
# Line 3610  Each action has the form (FUNCTION . ARG Line 3700  Each action has the form (FUNCTION . ARG
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.
# Line 3620  If VARIABLE has a `variable-interactive' Line 3710  If VARIABLE has a `variable-interactive'
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)
# Line 3629  in the definition is used to check that Line 3721  in the definition is used to check that
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.
# Line 3639  in the definition is used to check that Line 3737  in the definition is used to check that
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.
# Line 3649  in the definition is used to check that Line 3750  in the definition is used to check that
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
# Line 3762  With prefix argument N, move N items (ne Line 3867  With prefix argument N, move N items (ne
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)))))
# Line 3782  With prefix argument N, move N items (ne Line 3890  With prefix argument N, move N items (ne
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    
# Line 3796  the default method of inserting the comp Line 3904  the default method of inserting the comp
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
# Line 3811  to keep.  If it is nil, use choose-compl Line 3921  to keep.  If it is nil, use choose-compl
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
# Line 3875  The completion list buffer is available Line 3986  The completion list buffer is available
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.
# Line 3888  The completion list buffer is available Line 4006  The completion list buffer is available
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
# Line 4044  Returns nil if PROCESS has already termi Line 4162  Returns nil if PROCESS has already termi
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))
# Line 4055  Returns nil if PROCESS has already termi Line 4174  Returns nil if PROCESS has already termi
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'):
# Line 4298  See also `normal-erase-is-backspace'." Line 4418  See also `normal-erase-is-backspace'."
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

Legend:
Removed from v.1.551  
changed lines
  Added in v.1.551.2.1

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26