;;; simple.el --- basic editing commands for Emacs
-;; Copyright (C) 1985, 86, 87, 93, 94, 95, 96, 97, 98, 99, 2000, 2001
+;; Copyright (C) 1985, 86, 87, 93, 94, 95, 96, 97, 98, 99,
+;; 2000, 2001, 2002, 2003
;; Free Software Foundation, Inc.
+;; Maintainer: FSF
+;; Keywords: internal
+
;; This file is part of GNU Emacs.
;; GNU Emacs is free software; you can redistribute it and/or modify
"Highlight (un)matching of parens and expressions."
:group 'matching)
+(define-key global-map [?\C-x right] 'next-buffer)
+(define-key global-map [?\C-x left] 'prev-buffer)
+(defun next-buffer ()
+ "Switch to the next buffer in cyclic order."
+ (interactive)
+ (let ((buffer (current-buffer)))
+ (switch-to-buffer (other-buffer buffer))
+ (bury-buffer buffer)))
+
+(defun prev-buffer ()
+ "Switch to the previous buffer in cyclic order."
+ (interactive)
+ (let ((list (nreverse (buffer-list)))
+ found)
+ (while (and (not found) list)
+ (let ((buffer (car list)))
+ (if (and (not (get-buffer-window buffer))
+ (not (string-match "\\` " (buffer-name buffer))))
+ (setq found buffer)))
+ (setq list (cdr list)))
+ (switch-to-buffer found)))
(defun fundamental-mode ()
"Major mode not specialized for anything in particular.
text-property `hard'.
With ARG, insert that many newlines.
Call `auto-fill-function' if the current column number is greater
-than the value of `fill-column' and ARG is `nil'."
+than the value of `fill-column' and ARG is nil."
(interactive "*P")
(barf-if-buffer-read-only)
;; Inserting a newline at the end of a line produces better redisplay in
(goto-char loc)
(end-of-line)))
-(defun split-line ()
- "Split current line, moving portion beyond point vertically down."
- (interactive "*")
+(defun split-line (&optional arg)
+ "Split current line, moving portion beyond point vertically down.
+If the current line starts with `fill-prefix', insert it on the new
+line as well. With prefix arg, don't insert fill-prefix on new line.
+
+When called from Lisp code, the arg may be a prefix string to copy."
+ (interactive "*P")
(skip-chars-forward " \t")
- (let ((col (current-column))
- (pos (point)))
+ (let* ((col (current-column))
+ (pos (point))
+ ;; What prefix should we check for (nil means don't).
+ (prefix (cond ((stringp arg) arg)
+ (arg nil)
+ (t fill-prefix)))
+ ;; Does this line start with it?
+ (have-prfx (and prefix
+ (save-excursion
+ (beginning-of-line)
+ (looking-at (regexp-quote prefix))))))
(newline 1)
+ (if have-prfx (insert-and-inherit prefix))
(indent-to col 0)
(goto-char pos)))
digits are interpreted as a character code. This is intended to be
useful for editing binary files."
(interactive "*p")
- (let ((char (if (or (not overwrite-mode)
- (eq overwrite-mode 'overwrite-mode-binary))
- (read-quoted-char)
- (read-char))))
+ (let* ((char (let (translation-table-for-input)
+ (if (or (not overwrite-mode)
+ (eq overwrite-mode 'overwrite-mode-binary))
+ (read-quoted-char)
+ (read-char)))))
;; Assume character codes 0240 - 0377 stand for characters in some
;; single-byte character set, and convert them to Emacs
;; characters.
"Move point to the first non-whitespace character on this line."
(interactive)
(beginning-of-line 1)
- (skip-chars-forward " \t"))
+ (skip-syntax-forward " " (line-end-position))
+ ;; Move back over chars that have whitespace syntax but have the p flag.
+ (backward-prefix-chars))
(defun fixup-whitespace ()
"Fixup white space between objects around point.
(progn
(skip-chars-forward " \t")
(constrain-to-field nil orig-pos t)))))
-
+\f
(defun beginning-of-buffer (&optional arg)
"Move point to the beginning of the buffer; leave mark at previous position.
With arg N, put point N/10 of the way from the beginning.
(push-mark (point))
(push-mark (point-max) nil t)
(goto-char (point-min)))
-
+\f
;; Counting lines, one way or another.
(setq start (point))
(goto-char opoint)
(forward-line 0)
- (if (/= start 1)
+ (if (/= start (point-min))
(message "line %d (narrowed line %d)"
- (1+ (count-lines 1 (point)))
+ (1+ (count-lines (point-min) (point)))
(1+ (count-lines start (point))))
- (message "Line %d" (1+ (count-lines 1 (point)))))))))
+ (message "Line %d" (1+ (count-lines (point-min) (point)))))))))
(defun count-lines (start end)
"Return number of lines between START and END.
byte, just \"...\" is shown.
In addition, with prefix argument, show details about that character
-in *Help* buffer. See also the command `describe-char-after'."
+in *Help* buffer. See also the command `describe-char'."
(interactive "P")
(let* ((char (following-char))
(beg (point-min))
(if (or (not coding)
(eq (coding-system-type coding) t))
(setq coding default-buffer-file-coding-system))
- ;; Fixme: can we actually have invalid chars now?
- (if (not (char-valid-p char))
+ (if (eq (char-charset char) 'eight-bit)
(setq encoding-msg
- (format "(0%o, %d, 0x%x, invalid)" char char char))
+ (format "(0%o, %d, 0x%x, raw-byte)" char char char))
(setq encoded (and (>= char 128) (encode-coding-char char coding)))
(setq encoding-msg
(if encoded
(format "(0%o, %d, 0x%x)" char char char))))
(if detail
;; We show the detailed information about CHAR.
- (describe-char-after (point)))
+ (describe-char (point)))
(if (or (/= beg 1) (/= end (1+ total)))
(message "Char: %s %s point=%d of %d (%d%%) <%d - %d> column %d %s"
(if (< char 256)
(single-key-description char)
(buffer-substring-no-properties (point) (1+ (point))))
encoding-msg pos total percent col hscroll))))))
-
+\f
(defvar read-expression-map
(let ((m (make-sparse-keymap)))
(define-key m "\M-\t" 'lisp-complete-symbol)
"Prompting with PROMPT, let user edit COMMAND and eval result.
COMMAND is a Lisp expression. Let user edit that expression in
the minibuffer, then read and evaluate the result."
- (let ((command (read-from-minibuffer prompt
- (prin1-to-string command)
- read-expression-map t
- '(command-history . 1))))
- ;; If command was added to command-history as a string,
- ;; get rid of that. We want only evaluable expressions there.
- (if (stringp (car command-history))
- (setq command-history (cdr command-history)))
+ (let ((command
+ (unwind-protect
+ (read-from-minibuffer prompt
+ (prin1-to-string command)
+ read-expression-map t
+ '(command-history . 1))
+ ;; If command was added to command-history as a string,
+ ;; get rid of that. We want only evaluable expressions there.
+ (if (stringp (car command-history))
+ (setq command-history (cdr command-history))))))
;; If command to be redone does not match front of history,
;; add it to the history.
(let ((print-level nil)
(minibuffer-history-position arg)
(minibuffer-history-sexp-flag (1+ (minibuffer-depth))))
- (read-from-minibuffer
- "Redo: " (prin1-to-string elt) read-expression-map t
- (cons 'command-history arg))))
+ (unwind-protect
+ (read-from-minibuffer
+ "Redo: " (prin1-to-string elt) read-expression-map t
+ (cons 'command-history arg))
- ;; If command was added to command-history as a string,
- ;; get rid of that. We want only evaluable expressions there.
- (if (stringp (car command-history))
- (setq command-history (cdr command-history)))
+ ;; If command was added to command-history as a
+ ;; string, get rid of that. We want only
+ ;; evaluable expressions there.
+ (if (stringp (car command-history))
+ (setq command-history (cdr command-history))))))
;; If command to be redone does not match front of history,
;; add it to the history.
(or (equal newcmd (car command-history))
(setq command-history (cons newcmd command-history)))
(eval newcmd))
- (ding))))
-
+ (if command-history
+ (error "Argument %d is beyond length of command history" arg)
+ (error "There are no previous complex commands to repeat")))))
+\f
(defvar minibuffer-history nil
"Default minibuffer history list.
This is used for all minibuffer input
;; Return the width of everything before the field at the end of
;; the buffer; this should be 0 for normal buffers.
(1- (minibuffer-prompt-end)))
-
+\f
;Put this on C-x u, so we can force that rather than C-_ into startup msg
(defalias 'advertised-undo 'undo)
+(defconst undo-equiv-table (make-hash-table :test 'eq :weakness t)
+ "Table mapping redo records to the corresponding undo one.")
+
+(defvar undo-in-region nil
+ "Non-nil if `pending-undo-list' is not just a tail of `buffer-undo-list'.")
+
+(defvar undo-no-redo nil
+ "If t, `undo' doesn't go through redo entries.")
+
(defun undo (&optional arg)
"Undo some previous changes.
Repeat this command to undo more changes.
A numeric argument serves as a repeat count.
In Transient Mark mode when the mark is active, only undo changes within
-the current region. Similarly, when not in Transient Mark mode, just C-u
+the current region. Similarly, when not in Transient Mark mode, just \\[universal-argument]
as an argument limits undo to changes within the current region."
(interactive "*P")
;; Make last-command indicate for the next command that this was an undo.
(setq this-command 'undo)
(let ((modified (buffer-modified-p))
(recent-save (recent-auto-save-p)))
- (or (eq (selected-window) (minibuffer-window))
- (message "Undo!"))
(unless (eq last-command 'undo)
- (if (if transient-mark-mode mark-active (and arg (not (numberp arg))))
+ (setq undo-in-region
+ (if transient-mark-mode mark-active (and arg (not (numberp arg)))))
+ (if undo-in-region
(undo-start (region-beginning) (region-end))
(undo-start))
;; get rid of initial undo boundary
(undo-more 1))
+ ;; Check to see whether we're hitting a redo record, and if
+ ;; so, ask the user whether she wants to skip the redo/undo pair.
+ (let ((equiv (gethash pending-undo-list undo-equiv-table)))
+ (or (eq (selected-window) (minibuffer-window))
+ (message (if undo-in-region
+ (if equiv "Redo in region!" "Undo in region!")
+ (if equiv "Redo!" "Undo!"))))
+ (when (and equiv undo-no-redo)
+ ;; The equiv entry might point to another redo record if we have done
+ ;; undo-redo-undo-redo-... so skip to the very last equiv.
+ (while (let ((next (gethash equiv undo-equiv-table)))
+ (if next (setq equiv next))))
+ (setq pending-undo-list equiv)))
(undo-more
(if (or transient-mark-mode (numberp arg))
(prefix-numeric-value arg)
1))
+ ;; Record the fact that the just-generated undo records come from an
+ ;; undo operation, so we can skip them later on.
+ ;; I don't know how to do that in the undo-in-region case.
+ (unless undo-in-region
+ (puthash buffer-undo-list pending-undo-list undo-equiv-table))
;; Don't specify a position in the undo record for the undo command.
;; Instead, undoing this should move point to where the change is.
(let ((tail buffer-undo-list)
(while (car tail)
(when (integerp (car tail))
(let ((pos (car tail)))
- (if (null prev)
- (setq buffer-undo-list (cdr tail))
- (setcdr prev (cdr tail)))
+ (if prev
+ (setcdr prev (cdr tail))
+ (setq buffer-undo-list (cdr tail)))
(setq tail (cdr tail))
(while (car tail)
(if (eq pos (car tail))
(and modified (not (buffer-modified-p))
(delete-auto-save-file-if-necessary recent-save))))
+(defun undo-only (&optional arg)
+ "Undo some previous changes.
+Repeat this command to undo more changes.
+A numeric argument serves as a repeat count.
+Contrary to `undo', this will not redo a previous undo."
+ (interactive "*p")
+ (let ((undo-no-redo t)) (undo arg)))
+;; Richard said that we should not use C-x <uppercase letter> and I have
+;; no idea whereas to bind it. Any suggestion welcome. -stef
+;; (define-key ctl-x-map "U" 'undo-only)
+
(defvar pending-undo-list nil
"Within a run of consecutive undo commands, list remaining to be undone.")
Call `undo-start' to get ready to undo recent changes,
then call `undo-more' one or more times to undo them."
(or pending-undo-list
- (error "No further undo information"))
+ (error (format "No further undo information%s"
+ (if (and transient-mark-mode mark-active)
+ " for region" ""))))
(let ((undo-in-progress t))
(setq pending-undo-list (primitive-undo count pending-undo-list))))
If it crosses the edge, we return nil."
(cond ((integerp undo-elt)
(and (>= undo-elt start)
- (< undo-elt end)))
+ (<= undo-elt end)))
((eq undo-elt nil)
t)
((atom undo-elt)
(cons alist-elt undo-adjusted-markers)))
(and (cdr alist-elt)
(>= (cdr alist-elt) start)
- (< (cdr alist-elt) end))))
+ (<= (cdr alist-elt) end))))
((null (car undo-elt))
;; (nil PROPERTY VALUE BEG . END)
(let ((tail (nthcdr 3 undo-elt)))
(and (>= (car tail) start)
- (< (cdr tail) end))))
+ (<= (cdr tail) end))))
((integerp (car undo-elt))
;; (BEGIN . END)
(and (>= (car undo-elt) start)
- (< (cdr undo-elt) end)))))
+ (<= (cdr undo-elt) end)))))
(defun undo-elt-crosses-region (undo-elt start end)
"Test whether UNDO-ELT crosses one edge of that region START ... END.
(defvar shell-command-default-error-buffer nil
"*Buffer name for `shell-command' and `shell-command-on-region' error output.
-This buffer is used when `shell-command' or 'shell-command-on-region'
+This buffer is used when `shell-command' or `shell-command-on-region'
is run interactively. A value of nil means that output to stderr and
stdout will be intermixed in the output stream.")
;; Output goes in a separate buffer.
;; Preserve the match data in case called from a program.
(save-match-data
- (if (string-match "[ \t]*&[ \t]*$" command)
+ (if (string-match "[ \t]*&[ \t]*\\'" command)
;; Command ending with ampersand means asynchronous.
(let ((buffer (get-buffer-create
(or output-buffer "*Async Shell Command*")))
(if (yes-or-no-p "A command is running. Kill it? ")
(kill-process proc)
(error "Shell command in progress")))
- (save-excursion
- (set-buffer buffer)
+ (with-current-buffer buffer
(setq buffer-read-only nil)
(erase-buffer)
(display-buffer buffer)
(if (= (buffer-size) 0)
0
(count-lines (point-min) (point-max)))))
- (cond ((or (<= lines 1)
- (<= lines
- (if resize-mini-windows
- (cond ((floatp max-mini-window-height)
- (* (frame-height)
- max-mini-window-height))
- ((integerp max-mini-window-height)
- max-mini-window-height)
- (t
- 1))
- 1)))
+ (cond ((= lines 0))
+ ((and (or (<= lines 1)
+ (<= lines
+ (if resize-mini-windows
+ (cond ((floatp max-mini-window-height)
+ (* (frame-height)
+ max-mini-window-height))
+ ((integerp max-mini-window-height)
+ max-mini-window-height)
+ (t
+ 1))
+ 1)))
+ ;; Don't use the echo area if the output buffer is
+ ;; already dispayed in the selected frame.
+ (not (get-buffer-window (current-buffer))))
;; Echo area
(goto-char (point-max))
(when (bolp)
(let ((swap (and replace (< start end))))
;; Don't muck with mark unless REPLACE says we should.
(goto-char start)
- (and replace (push-mark))
+ (and replace (push-mark (point) 'nomsg))
(setq exit-status
(call-process-region start end shell-file-name t
(if error-file
;; No prefix argument: put the output in a temp buffer,
;; replacing its entire contents.
(let ((buffer (get-buffer-create
- (or output-buffer "*Shell Command Output*")))
- (success nil))
+ (or output-buffer "*Shell Command Output*"))))
(unwind-protect
(if (eq buffer (current-buffer))
;; If the input is the same buffer as the output,
(list buffer error-file)
buffer)
nil shell-command-switch command)))
- (setq success (and exit-status (equal 0 exit-status)))
;; Report the output.
+ (with-current-buffer buffer
+ (setq mode-line-process
+ (cond ((null exit-status)
+ " - Error")
+ ((stringp exit-status)
+ (format " - Signal [%s]" exit-status))
+ ((not (equal 0 exit-status))
+ (format " - Exit [%d]" exit-status)))))
(if (with-current-buffer buffer (> (point-max) (point-min)))
;; There's some output, display it
- (progn
- (if (not success)
- (with-current-buffer buffer
- (save-excursion
- (goto-char (point-max))
- (insert (format "...Shell command failed with code %d"
- exit-status)))))
- (display-message-or-buffer buffer))
+ (display-message-or-buffer buffer)
;; No output; error?
(let ((output
(if (and error-file
(< 0 (nth 7 (file-attributes error-file))))
"some error output"
"no output")))
- (if (equal 0 exit-status)
- (message "(Shell command succeeded with %s)"
- output)
- (message "(Shell command failed with code %d and %s)"
- exit-status output)))
+ (cond ((null exit-status)
+ (message "(Shell command failed with error)"))
+ ((equal 0 exit-status)
+ (message "(Shell command succeeded with %s)"
+ output))
+ ((stringp exit-status)
+ (message "(Shell command killed by signal %s)"
+ exit-status))
+ (t
+ (message "(Shell command failed with code %d and %s)"
+ exit-status output))))
;; Don't kill: there might be useful info in the undo-log.
;; (kill-buffer buffer)
))))
(with-current-buffer
standard-output
(call-process shell-file-name nil t nil shell-command-switch command))))
-
+\f
(defvar universal-argument-map
(let ((map (make-sparse-keymap)))
(define-key map [t] 'universal-argument-other-key)
unread-command-events)))
(reset-this-command-lengths)
(setq overriding-terminal-local-map nil))
-
+\f
;;;; Window system cut and paste hooks.
(defvar interprogram-cut-function nil
difficult to tell whether Emacs or some other program provided the
current string, it is probably good enough to return nil if the string
is equal (according to `string=') to the last text Emacs provided.")
-
+\f
;;;; The kill ring data structure.
(defvar kill-ring-yank-pointer nil
"The tail of the kill ring whose car is the last thing yanked.")
-(defun kill-new (string &optional replace)
+(defun kill-new (string &optional replace yank-handler)
"Make STRING the latest kill in the kill ring.
-Set the kill-ring-yank pointer to point to it.
+Set `kill-ring-yank-pointer' to point to it.
If `interprogram-cut-function' is non-nil, apply it to STRING.
Optional second argument REPLACE non-nil means that STRING will replace
-the front of the kill ring, rather than being added to the list."
- (and (fboundp 'menu-bar-update-yank-menu)
- (menu-bar-update-yank-menu string (and replace (car kill-ring))))
+the front of the kill ring, rather than being added to the list.
+
+Optional third arguments YANK-HANDLER controls how the STRING is later
+inserted into a buffer; see `insert-for-yank' for details.
+When a yank handler is specified, STRING must be non-empty (the yank
+handler is stored as a `yank-handler'text property on STRING).
+
+When the yank handler has a non-nil PARAM element, the original STRING
+argument is not used by `insert-for-yank'. However, since Lisp code
+may access and use elements from the kill-ring directly, the STRING
+argument should still be a \"useful\" string for such uses."
+ (if (> (length string) 0)
+ (if yank-handler
+ (put-text-property 0 1 'yank-handler yank-handler string))
+ (if yank-handler
+ (signal 'args-out-of-range
+ (list string "yank-handler specified for empty string"))))
+ (if (fboundp 'menu-bar-update-yank-menu)
+ (menu-bar-update-yank-menu string (and replace (car kill-ring))))
(if (and replace kill-ring)
(setcar kill-ring string)
(setq kill-ring (cons string kill-ring))
(if interprogram-cut-function
(funcall interprogram-cut-function string (not replace))))
-(defun kill-append (string before-p)
+(defun kill-append (string before-p &optional yank-handler)
"Append STRING to the end of the latest kill in the kill ring.
If BEFORE-P is non-nil, prepend STRING to the kill.
-If `interprogram-cut-function' is set, pass the resulting kill to
-it."
- (kill-new (if before-p
- (concat string (car kill-ring))
- (concat (car kill-ring) string))
- t))
+Optional third argument YANK-HANDLER specifies the yank-handler text
+property to be set on the combined kill ring string. If the specified
+yank-handler arg differs from the yank-handler property of the latest
+kill string, STRING is added as a new kill ring element instead of
+being appending to the last kill.
+If `interprogram-cut-function' is set, pass the resulting kill to it."
+ (let* ((cur (car kill-ring)))
+ (kill-new (if before-p (concat string cur) (concat cur string))
+ (or (= (length cur) 0)
+ (equal yank-handler (get-text-property 0 'yank-handler cur)))
+ yank-handler)))
(defun current-kill (n &optional do-not-move)
"Rotate the yanking point by N places, and then return that kill.
'(text-read-only buffer-read-only error))
(put 'text-read-only 'error-message "Text is read-only")
-(defun kill-region (beg end)
+(defun kill-region (beg end &optional yank-handler)
"Kill between point and mark.
The text is deleted but saved in the kill ring.
The command \\[yank] can retrieve it from there.
Any command that calls this function is a \"kill command\".
If the previous command was also a kill command,
the text killed this time appends to the text killed last time
-to make one entry in the kill ring."
+to make one entry in the kill ring.
+
+In Lisp code, optional third arg YANK-HANDLER specifies the yank-handler
+text property to be set on the killed text. See `insert-for-yank'."
(interactive "r")
(condition-case nil
(let ((string (delete-and-extract-region beg end)))
(when string ;STRING is nil if BEG = END
;; Add that string to the kill ring, one way or another.
(if (eq last-command 'kill-region)
- (kill-append string (< end beg))
- (kill-new string)))
- (setq this-command 'kill-region))
+ (kill-append string (< end beg) yank-handler)
+ (kill-new string nil yank-handler)))
+ (when (or string (eq last-command 'kill-region))
+ (setq this-command 'kill-region)))
((buffer-read-only text-read-only)
;; The code above failed because the buffer, or some of the characters
;; in the region, are read-only.
(setq this-command 'kill-region)
(message "If the next command is a kill, it will append"))
(setq last-command 'kill-region)))
-
+\f
;; Yanking.
+;; This is actually used in subr.el but defcustom does not work there.
+(defcustom yank-excluded-properties
+ '(read-only invisible intangible field mouse-face help-echo local-map keymap
+ yank-handler)
+ "*Text properties to discard when yanking.
+The value should be a list of text properties to discard or t,
+which means to discard all text properties."
+ :type '(choice (const :tag "All" t) (repeat symbol))
+ :group 'editing
+ :version "21.4")
+
+(defvar yank-window-start nil)
+(defvar yank-undo-function nil
+ "If non-nil, function used by `yank-pop' to delete last stretch of yanked text.
+Function is called with two parameters, START and END corresponding to
+the value of the mark and point; it is guaranteed that START <= END.
+Normally set from the UNDO element of a yank-handler; see `insert-for-yank'.")
+
(defun yank-pop (arg)
"Replace just-yanked stretch of killed text with a different stretch.
This command is allowed only immediately after a `yank' or a `yank-pop'.
(setq this-command 'yank)
(let ((inhibit-read-only t)
(before (< (point) (mark t))))
- (delete-region (point) (mark t))
+ (if before
+ (funcall (or yank-undo-function 'delete-region) (point) (mark t))
+ (funcall (or yank-undo-function 'delete-region) (mark t) (point)))
+ (setq yank-undo-function nil)
(set-marker (mark-marker) (point) (current-buffer))
- (let ((opoint (point)))
- (insert (current-kill arg))
- (let ((inhibit-read-only t))
- (remove-text-properties opoint (point) '(read-only nil))))
+ (insert-for-yank (current-kill arg))
+ ;; Set the window start back where it was in the yank command,
+ ;; if possible.
+ (set-window-start (selected-window) yank-window-start t)
(if before
;; This is like exchange-point-and-mark, but doesn't activate the mark.
;; It is cleaner to avoid activation, even though the command
"Reinsert the last stretch of killed text.
More precisely, reinsert the stretch of killed text most recently
killed OR yanked. Put point at end, and set mark at beginning.
-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).
With argument N, reinsert the Nth most recently killed stretch of killed
text.
See also the command \\[yank-pop]."
(interactive "*P")
+ (setq yank-window-start (window-start))
;; If we don't get all the way thru, make last-command indicate that
;; for the following command.
(setq this-command t)
(push-mark (point))
- (let ((opoint (point)))
- (insert (current-kill (cond
- ((listp arg) 0)
- ((eq arg '-) -1)
- (t (1- arg)))))
- (let ((inhibit-read-only t))
- ;; Clear `field' property for the sake of copying from the
- ;; minibuffer prompt or a *shell* prompt.
- (remove-text-properties opoint (point) '(read-only nil field nil))))
+ (insert-for-yank (current-kill (cond
+ ((listp arg) 0)
+ ((eq arg '-) -1)
+ (t (1- arg)))))
(if (consp arg)
;; This is like exchange-point-and-mark, but doesn't activate the mark.
;; It is cleaner to avoid activation, even though the command
(goto-char (prog1 (mark t)
(set-marker (mark-marker) (point) (current-buffer)))))
;; If we do get all the way thru, make this-command indicate that.
- (setq this-command 'yank)
+ (if (eq this-command t)
+ (setq this-command 'yank))
nil)
(defun rotate-yank-pointer (arg)
With argument, rotate that many kills forward (or backward, if negative)."
(interactive "p")
(current-kill arg))
-
+\f
;; Some kill commands.
;; Internal subroutine of delete-char
(let ((col (current-column)))
(forward-char -1)
(setq col (- col (current-column)))
- (insert-char ?\ col)
+ (insert-char ?\ col)
(delete-char 1)))
(forward-char -1)
(setq count (1- count))))))
If the buffer is read-only, Emacs will beep and refrain from deleting
the line, but put the line in the kill ring anyway. This means that
-you can use this command to copy text from a read-only buffer."
+you can use this command to copy text from a read-only buffer.
+\(If the variable `kill-read-only-ok' is non-nil, then this won't
+even beep.)"
(interactive "P")
(kill-region (point)
;; It is better to move point to the other end of the kill
(forward-visible-line (prefix-numeric-value arg))
(if (eobp)
(signal 'end-of-buffer nil))
- (if (or (looking-at "[ \t]*$") (and kill-whole-line (bolp)))
- (forward-visible-line 1)
- (end-of-visible-line)))
+ (let ((end
+ (save-excursion
+ (end-of-visible-line) (point))))
+ (if (or (save-excursion
+ (skip-chars-forward " \t" end)
+ (= (point) end))
+ (and kill-whole-line (bolp)))
+ (forward-visible-line 1)
+ (goto-char end))))
(point))))
+(defun kill-whole-line (&optional arg)
+ "Kill current line.
+With prefix arg, kill that many lines starting from the current line.
+If arg is negative, kill backward. Also kill the preceding newline.
+\(This is meant to make C-x z work well with negative arguments.\)
+If arg is zero, kill current line but exclude the trailing newline."
+ (interactive "P")
+ (setq arg (prefix-numeric-value arg))
+ (if (and (> arg 0) (eobp) (save-excursion (forward-visible-line 0) (eobp)))
+ (signal 'end-of-buffer nil))
+ (if (and (< arg 0) (bobp) (save-excursion (end-of-visible-line) (bobp)))
+ (signal 'beginning-of-buffer nil))
+ (unless (eq last-command 'kill-region)
+ (kill-new "")
+ (setq last-command 'kill-region))
+ (cond ((zerop arg)
+ ;; We need to kill in two steps, because the previous command
+ ;; could have been a kill command, in which case the text
+ ;; before point needs to be prepended to the current kill
+ ;; ring entry and the text after point appended. Also, we
+ ;; need to use save-excursion to avoid copying the same text
+ ;; twice to the kill ring in read-only buffers.
+ (save-excursion
+ (kill-region (point) (progn (forward-visible-line 0) (point))))
+ (kill-region (point) (progn (end-of-visible-line) (point))))
+ ((< arg 0)
+ (save-excursion
+ (kill-region (point) (progn (end-of-visible-line) (point))))
+ (kill-region (point)
+ (progn (forward-visible-line (1+ arg))
+ (unless (bobp) (backward-char))
+ (point))))
+ (t
+ (save-excursion
+ (kill-region (point) (progn (forward-visible-line 0) (point))))
+ (kill-region (point)
+ (progn (forward-visible-line arg) (point))))))
+
(defun forward-visible-line (arg)
"Move forward by ARG lines, ignoring currently invisible newlines only.
If ARG is negative, move backward -ARG lines.
If ARG is zero, move to the beginning of the current line."
(condition-case nil
(if (> arg 0)
- (while (> arg 0)
- (or (zerop (forward-line 1))
- (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))))
+ (progn
+ (while (> arg 0)
(or (zerop (forward-line 1))
- (signal 'end-of-buffer nil)))
- (setq arg (1- arg)))
+ (signal 'end-of-buffer nil))
+ ;; If the newline we just skipped is invisible,
+ ;; don't count it.
+ (let ((prop
+ (get-char-property (1- (point)) 'invisible)))
+ (if (if (eq buffer-invisibility-spec t)
+ prop
+ (or (memq prop buffer-invisibility-spec)
+ (assq prop buffer-invisibility-spec)))
+ (setq arg (1+ arg))))
+ (setq arg (1- arg)))
+ ;; If invisible text follows, and it is a number of complete lines,
+ ;; skip it.
+ (let ((opoint (point)))
+ (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)))))
+ (unless (bolp)
+ (goto-char opoint))))
(let ((first t))
- (while (or first (< arg 0))
- (if (zerop arg)
+ (while (or first (<= arg 0))
+ (if first
(beginning-of-line)
(or (zerop (forward-line -1))
(signal 'beginning-of-buffer nil)))
+ ;; If the newline we just moved to is invisible,
+ ;; don't count it.
+ (unless (bobp)
+ (let ((prop
+ (get-char-property (1- (point)) 'invisible)))
+ (unless (if (eq buffer-invisibility-spec t)
+ prop
+ (or (memq prop buffer-invisibility-spec)
+ (assq prop buffer-invisibility-spec)))
+ (setq arg (1+ arg)))))
+ (setq first nil))
+ ;; If invisible text follows, and it is a number of complete lines,
+ ;; skip it.
+ (let ((opoint (point)))
(while (and (not (bobp))
(let ((prop
(get-char-property (1- (point)) 'invisible)))
(if (get-text-property (1- (point)) 'invisible)
(or (previous-single-property-change (point) 'invisible)
(point-min))
- (previous-overlay-change (point))))
- (or (zerop (forward-line -1))
- (signal 'beginning-of-buffer nil)))
- (setq first nil)
- (setq arg (1+ arg)))))
+ (previous-overlay-change (point)))))
+ (unless (bolp)
+ (goto-char opoint)))))
((beginning-of-buffer end-of-buffer)
nil)))
;; 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)))))
+ (save-excursion
+ (skip-chars-forward "^\n")
+ (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))))))
+ (skip-chars-forward "^\n")
(if (get-text-property (point) 'invisible)
(goto-char (next-single-property-change (point) 'invisible))
(goto-char (next-overlay-change (point))))
(end-of-line)))
-
+\f
(defun insert-buffer (buffer)
"Insert after point the contents of BUFFER.
Puts mark after the inserted text.
BUFFER may be a buffer or a buffer name.
This function is meant for the user to run interactively.
-Don't call it from programs!"
+Don't call it from programs: use `insert-buffer-substring' instead!"
(interactive
(list
(progn
(other-buffer (current-buffer))
(window-buffer (next-window (selected-window))))
t))))
- (or (bufferp buffer)
- (setq buffer (get-buffer buffer)))
- (let (start end newmark)
- (save-excursion
- (save-excursion
- (set-buffer buffer)
- (setq start (point-min) end (point-max)))
- (insert-buffer-substring buffer start end)
- (setq newmark (point)))
- (push-mark newmark))
+ (push-mark
+ (save-excursion
+ (insert-buffer-substring (get-buffer buffer))
+ (point)))
nil)
(defun append-to-buffer (buffer start end)
(erase-buffer)
(save-excursion
(insert-buffer-substring oldbuf start end)))))
-
+\f
(put 'mark-inactive 'error-conditions '(mark-inactive error))
(put 'mark-inactive 'error-message "The mark is not active now")
"Deactivate the mark by setting `mark-active' to nil.
\(That makes a difference only in Transient Mark mode.)
Also runs the hook `deactivate-mark-hook'."
- (if transient-mark-mode
- (progn
- (setq mark-active nil)
- (run-hooks 'deactivate-mark-hook))))
+ (cond
+ ((eq transient-mark-mode 'lambda)
+ (setq transient-mark-mode nil))
+ (transient-mark-mode
+ (setq mark-active nil)
+ (run-hooks 'deactivate-mark-hook))))
(defun set-mark (pos)
"Set this buffer's mark to POS. Don't use this function!
:type 'integer
:group 'editing-basics)
+(defun pop-to-mark-command ()
+ "Jump to mark, and pop a new position for mark off the ring
+\(does not affect global mark ring\)."
+ (interactive)
+ (if (null (mark t))
+ (error "No mark set in this buffer")
+ (goto-char (mark t))
+ (pop-mark)))
+
+(defun push-mark-command (arg &optional nomsg)
+ "Set mark at where point is.
+If no prefix arg and mark is already set there, just activate it.
+Display `Mark set' unless the optional second arg NOMSG is non-nil."
+ (interactive "P")
+ (let ((mark (marker-position (mark-marker))))
+ (if (or arg (null mark) (/= mark (point)))
+ (push-mark nil nomsg t)
+ (setq mark-active t)
+ (unless nomsg
+ (message "Mark activated")))))
+
(defun set-mark-command (arg)
"Set mark at where point is, or jump to mark.
-With no prefix argument, set mark, push old mark position on local mark
-ring, and push mark on global mark ring.
-With argument, jump to mark, and pop a new position for mark off the ring
-\(does not affect global mark ring\).
+With no prefix argument, set mark, and push old mark position on local
+mark ring; also push mark on global mark ring if last mark was set in
+another buffer. Immediately repeating the command activates
+`transient-mark-mode' temporarily.
+
+With argument, e.g. \\[universal-argument] \\[set-mark-command], \
+jump to mark, and pop a new position
+for mark off the local mark ring \(this does not affect the global
+mark ring\). Use \\[pop-global-mark] to jump to a mark off the global
+mark ring \(see `pop-global-mark'\).
+
+Repeating the \\[set-mark-command] command without the prefix jumps to
+the next position off the local (or global) mark ring.
+
+With a double \\[universal-argument] prefix argument, e.g. \\[universal-argument] \
+\\[universal-argument] \\[set-mark-command], unconditionally
+set mark where point is.
Novice Emacs Lisp programmers often try to use the mark for the wrong
purposes. See the documentation of `set-mark' for more information."
(interactive "P")
- (if (null arg)
- (progn
- (push-mark nil nil t))
- (if (null (mark t))
- (error "No mark set in this buffer")
- (goto-char (mark t))
- (pop-mark))))
+ (if (eq transient-mark-mode 'lambda)
+ (setq transient-mark-mode nil))
+ (cond
+ ((and (consp arg) (> (prefix-numeric-value arg) 4))
+ (push-mark-command nil))
+ ((not (eq this-command 'set-mark-command))
+ (if arg
+ (pop-to-mark-command)
+ (push-mark-command t)))
+ ((eq last-command 'pop-to-mark-command)
+ (setq this-command 'pop-to-mark-command)
+ (pop-to-mark-command))
+ ((and (eq last-command 'pop-global-mark) (not arg))
+ (setq this-command 'pop-global-mark)
+ (pop-global-mark))
+ (arg
+ (setq this-command 'pop-to-mark-command)
+ (pop-to-mark-command))
+ ((and (eq last-command 'set-mark-command)
+ mark-active (null transient-mark-mode))
+ (setq transient-mark-mode 'lambda)
+ (message "Transient-mark-mode temporarily enabled"))
+ (t
+ (push-mark-command nil))))
(defun push-mark (&optional location nomsg activate)
"Set mark at LOCATION (point, by default) and push old mark on mark ring.
purposes. See the documentation of `set-mark' for more information.
In Transient Mark mode, this does not activate the mark."
- (if (null (mark t))
- nil
+ (unless (null (mark t))
(setq mark-ring (cons (copy-marker (mark-marker)) mark-ring))
- (if (> (length mark-ring) mark-ring-max)
- (progn
- (move-marker (car (nthcdr mark-ring-max mark-ring)) nil)
- (setcdr (nthcdr (1- mark-ring-max) mark-ring) nil))))
+ (when (> (length mark-ring) mark-ring-max)
+ (move-marker (car (nthcdr mark-ring-max mark-ring)) nil)
+ (setcdr (nthcdr (1- mark-ring-max) mark-ring) nil)))
(set-marker (mark-marker) (or location (point)) (current-buffer))
;; Now push the mark on the global mark ring.
(if (and global-mark-ring
;; Don't push another one.
nil
(setq global-mark-ring (cons (copy-marker (mark-marker)) global-mark-ring))
- (if (> (length global-mark-ring) global-mark-ring-max)
- (progn
- (move-marker (car (nthcdr global-mark-ring-max global-mark-ring))
- nil)
- (setcdr (nthcdr (1- global-mark-ring-max) global-mark-ring) nil))))
+ (when (> (length global-mark-ring) global-mark-ring-max)
+ (move-marker (car (nthcdr global-mark-ring-max global-mark-ring)) nil)
+ (setcdr (nthcdr (1- global-mark-ring-max) global-mark-ring) nil)))
(or nomsg executing-kbd-macro (> (minibuffer-depth) 0)
(message "Mark set"))
(if (or activate (not transient-mark-mode))
(defun pop-mark ()
"Pop off mark ring into the buffer's actual mark.
Does not set point. Does nothing if mark ring is empty."
- (if mark-ring
- (progn
- (setq mark-ring (nconc mark-ring (list (copy-marker (mark-marker)))))
- (set-marker (mark-marker) (+ 0 (car mark-ring)) (current-buffer))
- (deactivate-mark)
- (move-marker (car mark-ring) nil)
- (if (null (mark t)) (ding))
- (setq mark-ring (cdr mark-ring)))))
+ (when mark-ring
+ (setq mark-ring (nconc mark-ring (list (copy-marker (mark-marker)))))
+ (set-marker (mark-marker) (+ 0 (car mark-ring)) (current-buffer))
+ (deactivate-mark)
+ (move-marker (car mark-ring) nil)
+ (if (null (mark t)) (ding))
+ (setq mark-ring (cdr mark-ring))))
(defalias 'exchange-dot-and-mark 'exchange-point-and-mark)
-(defun exchange-point-and-mark ()
+(defun exchange-point-and-mark (&optional arg)
"Put the mark where point is now, and point where the mark is now.
This command works even when the mark is not active,
-and it reactivates the mark."
- (interactive nil)
- (let ((omark (mark t)))
- (if (null omark)
- (error "No mark set in this buffer"))
- (set-mark (point))
- (goto-char omark)
- nil))
-
-(defun transient-mark-mode (arg)
+and it reactivates the mark.
+With prefix arg, `transient-mark-mode' is enabled temporarily."
+ (interactive "P")
+ (if arg
+ (if mark-active
+ (if (null transient-mark-mode)
+ (setq transient-mark-mode 'lambda))
+ (setq arg nil)))
+ (unless arg
+ (let ((omark (mark t)))
+ (if (null omark)
+ (error "No mark set in this buffer"))
+ (set-mark (point))
+ (goto-char omark)
+ nil)))
+
+(define-minor-mode transient-mark-mode
"Toggle Transient Mark mode.
With arg, turn Transient Mark mode on if arg is positive, off otherwise.
\\[apropos-documentation] and type \"transient\" or \"mark.*active\" at
the prompt, to see the documentation of commands which are sensitive to
the Transient Mark mode."
- (interactive "P")
- (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"))))
+ :global t :group 'editing-basics :require nil)
(defun pop-global-mark ()
"Pop off global mark ring and jump to the top location."
(widen))
(goto-char position)
(switch-to-buffer buffer)))
-
+\f
(defcustom next-line-add-newlines nil
"*If non-nil, `next-line' inserts newline to avoid `end of buffer' error."
:type 'boolean
new line-end line-beg)
(unwind-protect
(progn
- (if (not (or (eq last-command 'next-line)
- (eq last-command 'previous-line)))
+ (if (not (memq last-command '(next-line previous-line)))
(setq temporary-goal-column
(if (and track-eol (eolp)
;; Don't count beg of empty line as end of line
;; Set REPEAT to t to repeat the whole thing.
(setq repeat nil)
- ;; Move to the desired column.
- (line-move-to-column column)
-
- (let ((new (point))
+ (let (new
(line-beg (save-excursion (beginning-of-line) (point)))
- (line-end (save-excursion (end-of-line) (point))))
+ (line-end
+ ;; Compute the end of the line
+ ;; ignoring effectively intangible newlines.
+ (let ((inhibit-point-motion-hooks nil)
+ (inhibit-field-text-motion t))
+ (save-excursion (end-of-line) (point)))))
+
+ ;; Move to the desired column.
+ (line-move-to-column column)
+ (setq new (point))
;; Process intangibility within a line.
;; Move to the chosen destination position from above,
;; If intangibility moves us to a different (later) place
;; in the same line, use that as the destination.
(if (<= (point) line-end)
- (setq new (point))))
+ (setq new (point))
+ ;; If that position is "too late",
+ ;; try the previous allowable position.
+ ;; See if it is ok.
+ (backward-char)
+ (if (<= (point) line-end)
+ (setq new (point))
+ ;; As a last resort, use the end of the line.
+ (setq new line-end))))
;; Now move to the updated destination, processing fields
;; as well as intangibility.
(constrain-to-field new opoint nil t
'inhibit-line-move-field-capture)))
- ;; If intangibility processing moved us to a different line,
+ ;; If all this moved us to a different line,
;; retry everything within that new line.
(when (or (< (point) line-beg) (> (point) line-end))
;; Repeat the intangibility and field processing.
This function works only in certain cases,
because what we really need is for `move-to-column'
and `current-column' to be able to ignore invisible text."
- (move-to-column col)
+ (if (zerop col)
+ (beginning-of-line)
+ (move-to-column col))
(when (and line-move-ignore-invisible
(not (bolp)) (line-move-invisible (1- (point))))
"Goal column %d (use \\[set-goal-column] with an arg to unset it)")
goal-column))
nil)
-
+\f
(defun scroll-other-window-down (lines)
"Scroll the \"other window\" down.
(end-of-buffer arg)
(recenter '(t)))
(select-window orig-window))))
-
+\f
(defun transpose-chars (arg)
"Interchange characters around point, moving forward one character.
With prefix arg ARG, effect is to take character before point
and drag it forward past ARG other words (backward if ARG negative).
If ARG is zero, the words around or after point and around or after mark
are interchanged."
+ ;; FIXME: `foo a!nd bar' should transpose into `bar and foo'.
(interactive "*p")
(transpose-subr 'forward-word arg))
Does not work on a sexp that point is in the middle of
if it is a list or string."
(interactive "*p")
- (transpose-subr 'forward-sexp arg))
+ (transpose-subr
+ (lambda (arg)
+ ;; Here we should try to simulate the behavior of
+ ;; (cons (progn (forward-sexp x) (point))
+ ;; (progn (forward-sexp (- x)) (point)))
+ ;; Except that we don't want to rely on the second forward-sexp
+ ;; putting us back to where we want to be, since forward-sexp-function
+ ;; might do funny things like infix-precedence.
+ (if (if (> arg 0)
+ (looking-at "\\sw\\|\\s_")
+ (and (not (bobp))
+ (save-excursion (forward-char -1) (looking-at "\\sw\\|\\s_"))))
+ ;; Jumping over a symbol. We might be inside it, mind you.
+ (progn (funcall (if (> arg 0)
+ 'skip-syntax-backward 'skip-syntax-forward)
+ "w_")
+ (cons (save-excursion (forward-sexp arg) (point)) (point)))
+ ;; Otherwise, we're between sexps. Take a step back before jumping
+ ;; to make sure we'll obey the same precedence no matter which direction
+ ;; we're going.
+ (funcall (if (> arg 0) 'skip-syntax-backward 'skip-syntax-forward) " .")
+ (cons (save-excursion (forward-sexp arg) (point))
+ (progn (while (or (forward-comment (if (> arg 0) 1 -1))
+ (not (zerop (funcall (if (> arg 0)
+ 'skip-syntax-forward
+ 'skip-syntax-backward)
+ ".")))))
+ (point)))))
+ arg 'special))
(defun transpose-lines (arg)
"Exchange current line and previous line, leaving point after both.
(if (> (cdr pos1) (car pos2)) (error "Don't have two things to transpose"))
(atomic-change-group
(let (word2)
+ ;; FIXME: We first delete the two pieces of text, so markers that
+ ;; used to point to after the text end up pointing to before it :-(
(setq word2 (delete-and-extract-region (car pos2) (cdr pos2)))
(goto-char (car pos2))
(insert (delete-and-extract-region (car pos1) (cdr pos1)))
(goto-char (car pos1))
(insert word2))))
-
+\f
(defun backward-word (arg)
"Move backward until encountering the beginning of a word.
With argument, do this that many times."
(interactive "p")
(kill-word (- arg)))
-(defun current-word (&optional strict)
- "Return the word point is on (or a nearby word) as a string.
+(defun current-word (&optional strict really-word)
+ "Return the symbol or word that point is on (or a nearby one) as a string.
+The return value includes no text properties.
If optional arg STRICT is non-nil, return nil unless point is within
-or adjacent to a word."
+or adjacent to a symbol or word.
+The function, belying its name, normally finds a symbol.
+If optional arg REALLY-WORD is non-nil, it finds just a word."
(save-excursion
- (let ((oldpoint (point)) (start (point)) (end (point)))
- (skip-syntax-backward "w_") (setq start (point))
+ (let* ((oldpoint (point)) (start (point)) (end (point))
+ (syntaxes (if really-word "w" "w_"))
+ (not-syntaxes (concat "^" syntaxes)))
+ (skip-syntax-backward syntaxes) (setq start (point))
(goto-char oldpoint)
- (skip-syntax-forward "w_") (setq end (point))
- (if (and (eq start oldpoint) (eq end oldpoint))
- ;; Point is neither within nor adjacent to a word.
- (and (not strict)
- (progn
- ;; Look for preceding word in same line.
- (skip-syntax-backward "^w_"
- (save-excursion (beginning-of-line)
- (point)))
- (if (bolp)
- ;; No preceding word in same line.
- ;; Look for following word in same line.
- (progn
- (skip-syntax-forward "^w_"
- (save-excursion (end-of-line)
- (point)))
- (setq start (point))
- (skip-syntax-forward "w_")
- (setq end (point)))
- (setq end (point))
- (skip-syntax-backward "w_")
- (setq start (point)))
- (buffer-substring-no-properties start end)))
+ (skip-syntax-forward syntaxes) (setq end (point))
+ (when (and (eq start oldpoint) (eq end oldpoint)
+ ;; Point is neither within nor adjacent to a word.
+ (not strict))
+ ;; Look for preceding word in same line.
+ (skip-syntax-backward not-syntaxes
+ (save-excursion (beginning-of-line)
+ (point)))
+ (if (bolp)
+ ;; No preceding word in same line.
+ ;; Look for following word in same line.
+ (progn
+ (skip-syntax-forward not-syntaxes
+ (save-excursion (end-of-line)
+ (point)))
+ (setq start (point))
+ (skip-syntax-forward syntaxes)
+ (setq end (point)))
+ (setq end (point))
+ (skip-syntax-backward syntaxes)
+ (setq start (point))))
+ ;; If we found something nonempty, return it as a string.
+ (unless (= start end)
(buffer-substring-no-properties start end)))))
-
+\f
(defcustom fill-prefix nil
"*String for filling to insert at front of new line, or nil for none."
:type '(choice (const :tag "None" nil)
(and prefix (not (equal prefix ""))
;; Use auto-indentation rather than a guessed empty prefix.
(not (and fill-indent-according-to-mode
- (string-match "[ \t]*" prefix)))
+ (string-match "\\`[ \t]*\\'" prefix)))
(setq fill-prefix prefix))))
-
+
(while (and (not give-up) (> (current-column) fc))
;; Determine where to split the line.
(let* (after-prefix
(fill-point
- (let ((opoint (point))
- bounce
- (first t))
+ (let ((opoint (point)))
(save-excursion
(beginning-of-line)
(setq after-prefix (point))
(looking-at (regexp-quote fill-prefix))
(setq after-prefix (match-end 0)))
(move-to-column (1+ fc))
- ;; Move back to the point where we can break the line.
- ;; We break the line between word or
- ;; after/before the character which has character
- ;; category `|'. We search space, \c| followed by
- ;; a character, or \c| following a character. If
- ;; not found, place the point at beginning of line.
- (while (or first
- (and (not (bobp))
- (not bounce)
- (fill-nobreak-p)))
- (setq first nil)
- (re-search-backward "[ \t]\\|\\c|.\\|.\\c|\\|^")
- ;; If we find nowhere on the line to break it,
- ;; break after one word. Set bounce to t
- ;; so we will not keep going in this while loop.
- (if (<= (point) after-prefix)
- (progn
- (goto-char after-prefix)
- (re-search-forward "[ \t]" opoint t)
- (setq bounce t))
- (if (looking-at "[ \t]")
- ;; Break the line at word boundary.
- (skip-chars-backward " \t")
- ;; Break the line after/before \c|.
- (forward-char 1))))
- (if enable-multibyte-characters
- ;; If we are going to break the line after or
- ;; before a non-ascii character, we may have
- ;; to run a special function for the charset
- ;; of the character to find the correct break
- ;; point.
- (if (not (and (eq (charset-after (1- (point))) 'ascii)
- (eq (charset-after (point)) 'ascii)))
- (fill-find-break-point after-prefix)))
-
- ;; Let fill-point be set to the place where we end up.
- ;; But move back before any whitespace here.
- (skip-chars-backward " \t")
+ (fill-move-to-break-point after-prefix)
(point)))))
;; See whether the place we found is any good.
(if (save-excursion
(goto-char fill-point)
- (and (not (bolp))
- ;; There is no use breaking at end of line.
- (not (save-excursion (skip-chars-forward " ") (eolp)))
- ;; It is futile to split at the end of the prefix
- ;; since we would just insert the prefix again.
- (not (and after-prefix (<= (point) after-prefix)))
- ;; Don't split right after a comment starter
- ;; since we would just make another comment starter.
- (not (and comment-start-skip
- (let ((limit (point)))
- (beginning-of-line)
- (and (re-search-forward comment-start-skip
- limit t)
- (eq (point) limit)))))))
- ;; Ok, we have a useful place to break the line. Do it.
- (let ((prev-column (current-column)))
- ;; If point is at the fill-point, do not `save-excursion'.
- ;; Otherwise, if a comment prefix or fill-prefix is inserted,
- ;; point will end up before it rather than after it.
- (if (save-excursion
- (skip-chars-backward " \t")
- (= (point) fill-point))
- (funcall comment-line-break-function t)
+ (or (bolp)
+ ;; There is no use breaking at end of line.
+ (save-excursion (skip-chars-forward " ") (eolp))
+ ;; It is futile to split at the end of the prefix
+ ;; since we would just insert the prefix again.
+ (and after-prefix (<= (point) after-prefix))
+ ;; Don't split right after a comment starter
+ ;; since we would just make another comment starter.
+ (and comment-start-skip
+ (let ((limit (point)))
+ (beginning-of-line)
+ (and (re-search-forward comment-start-skip
+ limit t)
+ (eq (point) limit))))))
+ ;; No good place to break => stop trying.
+ (setq give-up t)
+ ;; Ok, we have a useful place to break the line. Do it.
+ (let ((prev-column (current-column)))
+ ;; If point is at the fill-point, do not `save-excursion'.
+ ;; Otherwise, if a comment prefix or fill-prefix is inserted,
+ ;; point will end up before it rather than after it.
+ (if (save-excursion
+ (skip-chars-backward " \t")
+ (= (point) fill-point))
+ (funcall comment-line-break-function t)
+ (save-excursion
+ (goto-char fill-point)
+ (funcall comment-line-break-function t)))
+ ;; Now do justification, if required
+ (if (not (eq justify 'left))
(save-excursion
- (goto-char fill-point)
- (funcall comment-line-break-function t)))
- ;; Now do justification, if required
- (if (not (eq justify 'left))
- (save-excursion
(end-of-line 0)
(justify-current-line justify nil t)))
- ;; If making the new line didn't reduce the hpos of
- ;; the end of the line, then give up now;
- ;; trying again will not help.
- (if (>= (current-column) prev-column)
- (setq give-up t)))
- ;; No good place to break => stop trying.
- (setq give-up t))))
+ ;; If making the new line didn't reduce the hpos of
+ ;; the end of the line, then give up now;
+ ;; trying again will not help.
+ (if (>= (current-column) prev-column)
+ (setq give-up t))))))
;; Justify last line.
(justify-current-line justify t t)
t)))
"The function to use for `auto-fill-function' if Auto Fill mode is turned on.
Some major modes set this.")
+;; FIXME: turn into a proper minor mode.
+;; Add a global minor mode version of it.
(defun auto-fill-mode (&optional arg)
"Toggle Auto Fill mode.
With arg, turn Auto Fill mode on if and only if arg is positive.
(error "set-fill-column requires an explicit argument")
(message "Fill column set to %d (was %d)" arg fill-column)
(setq fill-column arg)))
-
+\f
(defun set-selective-display (arg)
"Set `selective-display' to ARG; clear it if no arg.
When the value of `selective-display' is a number > 0,
(prin1 selective-display t)
(princ "." t))
+(defvaralias 'indicate-unused-lines 'indicate-empty-lines)
+(defvaralias 'default-indicate-unused-lines 'default-indicate-empty-lines)
+
+(defun toggle-truncate-lines (arg)
+ "Toggle whether to fold or truncate long lines on the screen.
+With arg, truncate long lines iff arg is positive.
+Note that in side-by-side windows, truncation is always enabled."
+ (interactive "P")
+ (setq truncate-lines
+ (if (null arg)
+ (not truncate-lines)
+ (> (prefix-numeric-value arg) 0)))
+ (force-mode-line-update)
+ (unless truncate-lines
+ (let ((buffer (current-buffer)))
+ (walk-windows (lambda (window)
+ (if (eq buffer (window-buffer window))
+ (set-window-hscroll window 0)))
+ nil t)))
+ (message "Truncate long lines %s"
+ (if truncate-lines "enabled" "disabled")))
+
(defvar overwrite-mode-textual " Ovwrt"
"The string displayed in the mode line when in overwrite mode.")
(defvar overwrite-mode-binary " Bin Ovwrt"
'overwrite-mode-binary))
(force-mode-line-update))
-(defcustom line-number-mode t
- "*Non-nil means display line number in mode line."
- :type 'boolean
- :group 'editing-basics)
-
-(defun line-number-mode (arg)
+(define-minor-mode line-number-mode
"Toggle Line Number mode.
With arg, turn Line Number mode on iff arg is positive.
When Line Number mode is enabled, the line number appears
Line numbers do not appear for very large buffers and buffers
with very long lines; see variables `line-number-display-limit'
and `line-number-display-limit-width'."
- (interactive "P")
- (setq line-number-mode
- (if (null arg) (not line-number-mode)
- (> (prefix-numeric-value arg) 0)))
- (force-mode-line-update))
+ :init-value t :global t :group 'editing-basics :require nil)
-(defcustom column-number-mode nil
- "*Non-nil means display column number in mode line."
- :type 'boolean
- :group 'editing-basics)
-
-(defun column-number-mode (arg)
+(define-minor-mode column-number-mode
"Toggle Column Number mode.
With arg, turn Column Number mode on iff arg is positive.
When Column Number mode is enabled, the column number appears
in the mode line."
- (interactive "P")
- (setq column-number-mode
- (if (null arg) (not column-number-mode)
- (> (prefix-numeric-value arg) 0)))
- (force-mode-line-update))
-
+ :global t :group 'editing-basics :require nil)
+\f
(defgroup paren-blinking nil
"Blinking matching of parens and expressions."
:prefix "blink-matching-"
;Turned off because it makes dbx bomb out.
(setq blink-paren-function 'blink-matching-open)
-
+\f
;; This executes C-g typed while Emacs is waiting for a command.
;; Quitting out of a program does not go through here;
;; that happens in the QUIT macro at the C code level.
At top-level, as an editor command, this simply beeps."
(interactive)
(deactivate-mark)
+ (setq defining-kbd-macro nil)
(signal 'quit nil))
(define-key global-map "\C-g" 'keyboard-quit)
((string-match "^ \\*" (buffer-name (current-buffer)))
(bury-buffer))))
+(defun play-sound-file (file &optional volume device)
+ "Play sound stored in FILE.
+VOLUME and DEVICE correspond to the keywords of the sound
+specification for `play-sound'."
+ (interactive "fPlay sound file: ")
+ (let ((sound (list :file file)))
+ (if volume
+ (plist-put sound :volume volume))
+ (if device
+ (plist-put sound :device device))
+ (push 'sound sound)
+ (play-sound sound)))
+
(define-key global-map "\e\e\e" 'keyboard-escape-quit)
(defcustom read-mail-command 'rmail
(function :tag "Other"))
:group 'mail)
-(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)))
-
(define-mail-user-agent 'sendmail-user-agent
'sendmail-user-agent-compose
'mail-send-and-exit)
(defvar set-variable-value-history nil
"History of values entered with `set-variable'.")
-(defun set-variable (var val)
+(defun set-variable (var val &optional make-local)
"Set VARIABLE to VALUE. VALUE is a Lisp object.
When using this interactively, enter a Lisp object for VALUE.
If you want VALUE to be a string, you must surround it with doublequotes.
it were the arg to `interactive' (which see) to interactively read VALUE.
If VARIABLE has been defined with `defcustom', then the type information
-in the definition is used to check that VALUE is valid."
+in the definition is used to check that VALUE is valid.
+
+With a prefix argument, set VARIABLE to VALUE buffer-locally."
(interactive
(let* ((default-var (variable-at-point))
(var (if (symbolp default-var)
(read-variable "Set variable: ")))
(minibuffer-help-form '(describe-variable var))
(prop (get var 'variable-interactive))
- (prompt (format "Set %s to value: " var))
+ (prompt (format "Set %s%s to value: " var
+ (cond ((local-variable-p var)
+ " (buffer-local)")
+ ((or current-prefix-arg
+ (local-variable-if-set-p var))
+ " buffer-locally")
+ (t " globally"))))
(val (if prop
;; Use VAR's `variable-interactive' property
;; as an interactive spec for prompting.
(read
(read-string prompt nil
'set-variable-value-history)))))
- (list var val)))
+ (list var val current-prefix-arg)))
+ (and (custom-variable-p var)
+ (not (get var 'custom-type))
+ (custom-load-symbol var))
(let ((type (get var 'custom-type)))
(when type
;; Match with custom type.
(unless (widget-apply type :match val)
(error "Value `%S' does not match type %S of %S"
val (car type) var))))
+
+ (if make-local
+ (make-local-variable var))
+
(set var val)
;; Force a thorough redisplay for the case that the variable
;; that can be found before POINT.
(defun choose-completion-delete-max-match (string)
(let ((opoint (point))
- (len (min (length string)
- (- (point) (point-min)))))
- (goto-char (- (point) (length string)))
+ len)
+ ;; Try moving back by the length of the string.
+ (goto-char (max (- (point) (length string))
+ (minibuffer-prompt-end)))
+ ;; See how far back we were actually able to move. That is the
+ ;; upper bound on how much we can match and delete.
+ (setq len (- opoint (point)))
(if completion-ignore-case
(setq string (downcase string)))
(while (and (> len 0)
- (let ((tail (buffer-substring (point)
- (+ (point) len))))
+ (let ((tail (buffer-substring (point) opoint)))
(if completion-ignore-case
(setq tail (downcase tail)))
(not (string= tail (substring string 0 len)))))
(forward-char 1))
(delete-char len)))
-;; Switch to BUFFER and insert the completion choice CHOICE.
-;; BASE-SIZE, if non-nil, says how many characters of BUFFER's text
-;; to keep. If it is nil, use choose-completion-delete-max-match instead.
+(defvar choose-completion-string-functions nil
+ "Functions that may override the normal insertion of a completion choice.
+These functions are called in order with four arguments:
+CHOICE - the string to insert in the buffer,
+BUFFER - the buffer in which the choice should be inserted,
+MINI-P - non-nil iff BUFFER is a minibuffer, and
+BASE-SIZE - the number of characters in BUFFER before
+the string being completed.
+
+If a function in the list returns non-nil, that function is supposed
+to have inserted the CHOICE in the BUFFER, and possibly exited
+the minibuffer; no further functions will be called.
+
+If all functions in the list return nil, that means to use
+the default method of inserting the completion in BUFFER.")
-;; If BUFFER is the minibuffer, exit the minibuffer
-;; unless it is reading a file name and CHOICE is a directory,
-;; or completion-no-auto-exit is non-nil.
(defun choose-completion-string (choice &optional buffer base-size)
- (let ((buffer (or buffer completion-reference-buffer))
- (mini-p (string-match "\\` \\*Minibuf-[0-9]+\\*\\'" (buffer-name buffer))))
+ "Switch to BUFFER and insert the completion choice CHOICE.
+BASE-SIZE, if non-nil, says how many characters of BUFFER's text
+to keep. If it is nil, we call `choose-completion-delete-max-match'
+to decide what to delete."
+
+ ;; If BUFFER is the minibuffer, exit the minibuffer
+ ;; unless it is reading a file name and CHOICE is a directory,
+ ;; or completion-no-auto-exit is non-nil.
+
+ (let* ((buffer (or buffer completion-reference-buffer))
+ (mini-p (minibufferp buffer)))
;; If BUFFER is a minibuffer, barf unless it's the currently
;; active minibuffer.
(if (and mini-p
(not (equal buffer
(window-buffer (active-minibuffer-window))))))
(error "Minibuffer is not active for completion")
- ;; Insert the completion into the buffer where completion was requested.
- (set-buffer buffer)
- (if base-size
- (delete-region (+ base-size (if mini-p
- (minibuffer-prompt-end)
- (point-min)))
- (point))
- (choose-completion-delete-max-match choice))
- (insert choice)
- (remove-text-properties (- (point) (length choice)) (point)
- '(mouse-face nil))
- ;; Update point in the window that BUFFER is showing in.
- (let ((window (get-buffer-window buffer t)))
- (set-window-point window (point)))
- ;; If completing for the minibuffer, exit it with this choice.
- (and (not completion-no-auto-exit)
- (equal buffer (window-buffer (minibuffer-window)))
- minibuffer-completion-table
- ;; If this is reading a file name, and the file name chosen
- ;; is a directory, don't exit the minibuffer.
- (if (and (eq minibuffer-completion-table 'read-file-name-internal)
- (file-directory-p (field-string (point-max))))
- (let ((mini (active-minibuffer-window)))
- (select-window mini)
- (when minibuffer-auto-raise
- (raise-frame (window-frame mini))))
- (exit-minibuffer))))))
+ (unless (run-hook-with-args-until-success
+ 'choose-completion-string-functions
+ choice buffer mini-p base-size)
+ ;; Insert the completion into the buffer where it was requested.
+ (set-buffer buffer)
+ (if base-size
+ (delete-region (+ base-size (if mini-p
+ (minibuffer-prompt-end)
+ (point-min)))
+ (point))
+ (choose-completion-delete-max-match choice))
+ (insert choice)
+ (remove-text-properties (- (point) (length choice)) (point)
+ '(mouse-face nil))
+ ;; Update point in the window that BUFFER is showing in.
+ (let ((window (get-buffer-window buffer t)))
+ (set-window-point window (point)))
+ ;; If completing for the minibuffer, exit it with this choice.
+ (and (not completion-no-auto-exit)
+ (equal buffer (window-buffer (minibuffer-window)))
+ minibuffer-completion-table
+ ;; If this is reading a file name, and the file name chosen
+ ;; is a directory, don't exit the minibuffer.
+ (if (and (eq minibuffer-completion-table 'read-file-name-internal)
+ (file-directory-p (field-string (point-max))))
+ (let ((mini (active-minibuffer-window)))
+ (select-window mini)
+ (when minibuffer-auto-raise
+ (raise-frame (window-frame mini))))
+ (exit-minibuffer)))))))
(defun completion-list-mode ()
"Major mode for buffers showing lists of possible completions.
(defun completion-setup-function ()
(save-excursion
- (let ((mainbuf (current-buffer)))
+ (let ((mainbuf (current-buffer))
+ (mbuf-contents (minibuffer-contents)))
+ ;; When reading a file name in the minibuffer,
+ ;; set default-directory in the minibuffer
+ ;; so it will get copied into the completion list buffer.
+ (if minibuffer-completing-file-name
+ (with-current-buffer mainbuf
+ (setq default-directory (file-name-directory mbuf-contents))))
(set-buffer standard-output)
(completion-list-mode)
(make-local-variable 'completion-reference-buffer)
(setq completion-reference-buffer mainbuf)
- (if (eq minibuffer-completion-table 'read-file-name-internal)
+ (if minibuffer-completing-file-name
;; For file name completion,
;; use the number of chars before the start of the
;; last file name component.
(save-excursion
(set-buffer mainbuf)
(goto-char (point-max))
- (skip-chars-backward (format "^%c" directory-sep-char))
+ (skip-chars-backward "^/")
(- (point) (minibuffer-prompt-end))))
;; Otherwise, in minibuffer, the whole input is being completed.
(save-match-data
- (if (string-match "\\` \\*Minibuf-[0-9]+\\*\\'"
- (buffer-name mainbuf))
+ (if (minibufferp mainbuf)
(setq completion-base-size 0))))
(goto-char (point-min))
(if (display-mouse-p)
;; to the following event.
(defun event-apply-alt-modifier (ignore-prompt)
- "Add the Alt modifier to the following event.
+ "\\<function-key-map>Add the Alt modifier to the following event.
For example, type \\[event-apply-alt-modifier] & to enter Alt-&."
(vector (event-apply-modifier (read-event) 'alt 22 "A-")))
(defun event-apply-super-modifier (ignore-prompt)
- "Add the Super modifier to the following event.
+ "\\<function-key-map>Add the Super modifier to the following event.
For example, type \\[event-apply-super-modifier] & to enter Super-&."
(vector (event-apply-modifier (read-event) 'super 23 "s-")))
(defun event-apply-hyper-modifier (ignore-prompt)
- "Add the Hyper modifier to the following event.
+ "\\<function-key-map>Add the Hyper modifier to the following event.
For example, type \\[event-apply-hyper-modifier] & to enter Hyper-&."
(vector (event-apply-modifier (read-event) 'hyper 24 "H-")))
(defun event-apply-shift-modifier (ignore-prompt)
- "Add the Shift modifier to the following event.
+ "\\<function-key-map>Add the Shift modifier to the following event.
For example, type \\[event-apply-shift-modifier] & to enter Shift-&."
(vector (event-apply-modifier (read-event) 'shift 25 "S-")))
(defun event-apply-control-modifier (ignore-prompt)
- "Add the Ctrl modifier to the following event.
+ "\\<function-key-map>Add the Ctrl modifier to the following event.
For example, type \\[event-apply-control-modifier] & to enter Ctrl-&."
(vector (event-apply-modifier (read-event) 'control 26 "C-")))
(defun event-apply-meta-modifier (ignore-prompt)
- "Add the Meta modifier to the following event.
+ "\\<function-key-map>Add the Meta modifier to the following event.
For example, type \\[event-apply-meta-modifier] & to enter Meta-&."
(vector (event-apply-modifier (read-event) 'meta 27 "M-")))
(kp-decimal ?.)
(kp-divide ?/)
(kp-equal ?=)))
-
+\f
;;;;
;;;; forking a twin copy of a buffer.
;;;;
(setq newname (substring newname 0 (match-beginning 0))))
(when (memq (process-status process) '(run stop open))
(let* ((process-connection-type (process-tty-name process))
- (old-kwoq (process-kill-without-query process nil))
(new-process
(if (memq (process-status process) '(open))
- (apply 'open-network-stream newname
- (if (process-buffer process) (current-buffer))
- (process-contact process))
+ (let ((args (process-contact process t)))
+ (setq args (plist-put args :name newname))
+ (setq args (plist-put args :buffer
+ (if (process-buffer process)
+ (current-buffer))))
+ (apply 'make-network-process args))
(apply 'start-process newname
(if (process-buffer process) (current-buffer))
(process-command process)))))
- (process-kill-without-query new-process old-kwoq)
- (process-kill-without-query process old-kwoq)
+ (set-process-query-on-exit-flag
+ new-process (process-query-on-exit-flag process))
(set-process-inherit-coding-system-flag
new-process (process-inherit-coding-system-flag process))
(set-process-filter new-process (process-filter process))
(set-process-sentinel new-process (process-sentinel process))
+ (set-process-plist new-process (copy-sequence (process-plist process)))
new-process)))
-;; things to maybe add (currently partly covered by `funcall mode':
+;; things to maybe add (currently partly covered by `funcall mode'):
;; - syntax-table
;; - overlays
(defun clone-buffer (&optional newname display-flag)
Optional second arg NORECORD non-nil means do not put this buffer at
the front of the list of recently selected ones."
(interactive "bClone buffer in other window: ")
- (let ((popup-windows t))
+ (let ((pop-up-windows t))
(set-buffer buffer)
(clone-indirect-buffer nil t norecord)))
(define-key ctl-x-4-map "c" 'clone-indirect-buffer-other-window)
-
-
-;;; Syntax stuff.
-
-(defconst syntax-code-table
- '((?\ 0 "whitespace")
- (?- 0 "whitespace")
- (?. 1 "punctuation")
- (?w 2 "word")
- (?_ 3 "symbol")
- (?\( 4 "open parenthesis")
- (?\) 5 "close parenthesis")
- (?\' 6 "expression prefix")
- (?\" 7 "string quote")
- (?$ 8 "paired delimiter")
- (?\\ 9 "escape")
- (?/ 10 "character quote")
- (?< 11 "comment start")
- (?> 12 "comment end")
- (?@ 13 "inherit")
- (nil 14 "comment fence")
- (nil 15 "string fence"))
- "Alist of forms (CHAR CODE DESCRIPTION) mapping characters to syntax info.
-CHAR is a character that is allowed as first char in the string
-specifying the syntax when calling `modify-syntax-entry'. CODE is the
-corresponing syntax code as it is stored in a syntax cell, and
-can be used as value of a `syntax-table' property.
-DESCRIPTION is the descriptive string for the syntax.")
-
-
+\f
;;; Handling of Backspace and Delete keys.
(defcustom normal-erase-is-backspace nil
(if (interactive-p)
(message "Delete key deletes %s"
(if normal-erase-is-backspace "forward" "backward"))))
-
-
-;;; Misc
-
-(defun byte-compiling-files-p ()
- "Return t if currently byte-compiling files."
- (and (boundp 'byte-compile-current-file)
- (stringp byte-compile-current-file)))
-
-
+\f
+(defcustom idle-update-delay 0.5
+ "*Idle time delay before updating various things on the screen.
+Various Emacs features that update auxiliary information when point moves
+wait this many seconds after Emacs becomes idle before doing an update."
+ :type 'number
+ :group 'display
+ :version "21.4")
+\f
+(defvar vis-mode-saved-buffer-invisibility-spec nil
+ "Saved value of `buffer-invisibility-spec' when Visible mode is on.")
+
+(define-minor-mode visible-mode
+ "Toggle Visible mode.
+With argument ARG turn Visible mode on iff ARG is positive.
+
+Enabling Visible mode makes all invisible text temporarily visible.
+Disabling Visible mode turns off that effect. Visible mode
+works by saving the value of `buffer-invisibility-spec' and setting it to nil."
+ :lighter " Vis"
+ (when (local-variable-p 'vis-mode-saved-buffer-invisibility-spec)
+ (setq buffer-invisibility-spec vis-mode-saved-buffer-invisibility-spec)
+ (kill-local-variable 'vis-mode-saved-buffer-invisibility-spec))
+ (when visible-mode
+ (set (make-local-variable 'vis-mode-saved-buffer-invisibility-spec)
+ buffer-invisibility-spec)
+ (setq buffer-invisibility-spec nil)))
+\f
;; Minibuffer prompt stuff.
;(defun minibuffer-prompt-modification (start end)
; (message "You cannot modify the prompt")))
;
;
-;(setq minibuffer-prompt-properties
+;(setq minibuffer-prompt-properties
; (list 'modification-hooks '(minibuffer-prompt-modification)
; 'insert-in-front-hooks '(minibuffer-prompt-insertion)))
-;
+;
+(provide 'simple)
;;; simple.el ends here