;;; simple.el --- basic editing commands for Emacs
-;; Copyright (C) 1985, 1986, 1987, 1993, 1994, 1995, 1996, 1997, 1998, 1999,
-;; 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010
-;; Free Software Foundation, Inc.
+;; Copyright (C) 1985, 1986, 1987, 1993, 1994, 1995, 1996, 1997, 1998,
+;; 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009,
+;; 2010 Free Software Foundation, Inc.
;; Maintainer: FSF
;; Keywords: internal
+;; Package: emacs
;; This file is part of GNU Emacs.
Other major modes are defined by comparison with this one."
(interactive)
(kill-all-local-variables)
- (unless delay-mode-hooks
- (run-hooks 'after-change-major-mode-hook)))
+ (run-mode-hooks 'fundamental-mode-hook))
;; Special major modes to view specially formatted data rather than files.
"Parent major mode from which special major modes should inherit."
(setq buffer-read-only t))
+;; Major mode meant to be the parent of programming modes.
+
+(defvar prog-mode-map
+ (let ((map (make-sparse-keymap)))
+ (define-key map [?\C-\M-q] 'prog-indent-sexp)
+ map)
+ "Keymap used for programming modes.")
+
+(defun prog-indent-sexp ()
+ "Indent the expression after point."
+ (interactive)
+ (let ((start (point))
+ (end (save-excursion (forward-sexp 1) (point))))
+ (indent-region start end nil)))
+
+(define-derived-mode prog-mode fundamental-mode "Prog"
+ "Major mode for editing programming language source code."
+ (set (make-local-variable 'require-final-newline) mode-require-final-newline)
+ (set (make-local-variable 'parse-sexp-ignore-comments) t))
+
;; Making and deleting lines.
(defvar hard-newline (propertize "\n" 'hard t 'rear-nonsticky '(hard))
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
- ;; try_window_id than inserting at the beginning of a line, and the textual
- ;; result is the same. So, if we're at beginning of line, pretend to be at
- ;; the end of the previous line.
- (let ((flag (and (not (bobp))
- (bolp)
- ;; Make sure no functions want to be told about
- ;; the range of the changes.
- (not after-change-functions)
- (not before-change-functions)
- ;; Make sure there are no markers here.
- (not (buffer-has-markers-at (1- (point))))
- (not (buffer-has-markers-at (point)))
- ;; Make sure no text properties want to know
- ;; where the change was.
- (not (get-char-property (1- (point)) 'modification-hooks))
- (not (get-char-property (1- (point)) 'insert-behind-hooks))
- (or (eobp)
- (not (get-char-property (point) 'insert-in-front-hooks)))
- ;; Make sure the newline before point isn't intangible.
- (not (get-char-property (1- (point)) 'intangible))
- ;; Make sure the newline before point isn't read-only.
- (not (get-char-property (1- (point)) 'read-only))
- ;; Make sure the newline before point isn't invisible.
- (not (get-char-property (1- (point)) 'invisible))
- ;; Make sure the newline before point has the same
- ;; properties as the char before it (if any).
- (< (or (previous-property-change (point)) -2)
- (- (point) 2))))
- (was-page-start (and (bolp)
- (looking-at page-delimiter)))
- (beforepos (point)))
- (if flag (backward-char 1))
- ;; Call self-insert so that auto-fill, abbrev expansion etc. happens.
- ;; Set last-command-event to tell self-insert what to insert.
- (let ((last-command-event ?\n)
- ;; Don't auto-fill if we have a numeric argument.
- ;; Also not if flag is true (it would fill wrong line);
- ;; there is no need to since we're at BOL.
- (auto-fill-function (if (or arg flag) nil auto-fill-function)))
- (unwind-protect
- (self-insert-command (prefix-numeric-value arg))
- ;; If we get an error in self-insert-command, put point at right place.
- (if flag (forward-char 1))))
- ;; Even if we did *not* get an error, keep that forward-char;
- ;; all further processing should apply to the newline that the user
- ;; thinks he inserted.
-
- ;; Mark the newline(s) `hard'.
- (if use-hard-newlines
- (set-hard-newline-properties
- (- (point) (prefix-numeric-value arg)) (point)))
- ;; If the newline leaves the previous line blank,
- ;; and we have a left margin, delete that from the blank line.
- (or flag
- (save-excursion
- (goto-char beforepos)
- (beginning-of-line)
- (and (looking-at "[ \t]$")
- (> (current-left-margin) 0)
- (delete-region (point) (progn (end-of-line) (point))))))
- ;; Indent the line after the newline, except in one case:
- ;; when we added the newline at the beginning of a line
- ;; which starts a page.
- (or was-page-start
- (move-to-left-margin nil t)))
+ ;; Call self-insert so that auto-fill, abbrev expansion etc. happens.
+ ;; Set last-command-event to tell self-insert what to insert.
+ (let* ((was-page-start (and (bolp) (looking-at page-delimiter)))
+ (beforepos (point))
+ (last-command-event ?\n)
+ ;; Don't auto-fill if we have a numeric argument.
+ (auto-fill-function (if arg nil auto-fill-function))
+ (postproc
+ ;; Do the rest in post-self-insert-hook, because we want to do it
+ ;; *before* other functions on that hook.
+ (lambda ()
+ ;; Mark the newline(s) `hard'.
+ (if use-hard-newlines
+ (set-hard-newline-properties
+ (- (point) (prefix-numeric-value arg)) (point)))
+ ;; If the newline leaves the previous line blank, and we
+ ;; have a left margin, delete that from the blank line.
+ (save-excursion
+ (goto-char beforepos)
+ (beginning-of-line)
+ (and (looking-at "[ \t]$")
+ (> (current-left-margin) 0)
+ (delete-region (point)
+ (line-end-position))))
+ ;; Indent the line after the newline, except in one case:
+ ;; when we added the newline at the beginning of a line which
+ ;; starts a page.
+ (or was-page-start
+ (move-to-left-margin nil t)))))
+ (unwind-protect
+ (progn
+ (add-hook 'post-self-insert-hook postproc)
+ (self-insert-command (prefix-numeric-value arg)))
+ ;; We first used let-binding to protect the hook, but that was naive
+ ;; since add-hook affects the symbol-default value of the variable,
+ ;; whereas the let-binding might only protect the buffer-local value.
+ (remove-hook 'post-self-insert-hook postproc)))
nil)
(defun set-hard-newline-properties (from to)
(interactive "*p")
(let* ((do-fill-prefix (and fill-prefix (bolp)))
(do-left-margin (and (bolp) (> (current-left-margin) 0)))
- (loc (point))
+ (loc (point-marker))
;; Don't expand an abbrev before point.
(abbrev-mode nil))
(newline n)
(overlay-recenter (point))
(recenter -3))))
+(defcustom delete-active-region t
+ "Whether single-char deletion commands delete an active region.
+This has an effect only if Transient Mark mode is enabled, and
+affects `delete-forward-char' and `delete-backward-char', though
+not `delete-char'.
+
+If the value is the symbol `kill', the active region is killed
+instead of deleted."
+ :type '(choice (const :tag "Delete active region" t)
+ (const :tag "Kill active region" kill)
+ (const :tag "Do ordinary deletion" nil))
+ :group 'editing
+ :version "24.1")
+
+(defun delete-backward-char (n &optional killflag)
+ "Delete the previous N characters (following if N is negative).
+If Transient Mark mode is enabled, the mark is active, and N is 1,
+delete the text in the region and deactivate the mark instead.
+To disable this, set `delete-active-region' to nil.
+
+Optional second arg KILLFLAG, if non-nil, means to kill (save in
+kill ring) instead of delete. Interactively, N is the prefix
+arg, and KILLFLAG is set if N is explicitly specified.
+
+In Overwrite mode, single character backward deletion may replace
+tabs with spaces so as to back over columns, unless point is at
+the end of the line."
+ (interactive "p\nP")
+ (unless (integerp n)
+ (signal 'wrong-type-argument (list 'integerp n)))
+ (cond ((and (use-region-p)
+ delete-active-region
+ (= n 1))
+ ;; If a region is active, kill or delete it.
+ (if (eq delete-active-region 'kill)
+ (kill-region (region-beginning) (region-end))
+ (delete-region (region-beginning) (region-end))))
+ ;; In Overwrite mode, maybe untabify while deleting
+ ((null (or (null overwrite-mode)
+ (<= n 0)
+ (memq (char-before) '(?\t ?\n))
+ (eobp)
+ (eq (char-after) ?\n)))
+ (let* ((ocol (current-column))
+ (val (delete-char (- n) killflag)))
+ (save-excursion
+ (insert-char ?\s (- ocol (current-column)) nil))))
+ ;; Otherwise, do simple deletion.
+ (t (delete-char (- n) killflag))))
+
+(defun delete-forward-char (n &optional killflag)
+ "Delete the following N characters (previous if N is negative).
+If Transient Mark mode is enabled, the mark is active, and N is 1,
+delete the text in the region and deactivate the mark instead.
+To disable this, set `delete-active-region' to nil.
+
+Optional second arg KILLFLAG non-nil means to kill (save in kill
+ring) instead of delete. Interactively, N is the prefix arg, and
+KILLFLAG is set if N was explicitly specified."
+ (interactive "p\nP")
+ (unless (integerp n)
+ (signal 'wrong-type-argument (list 'integerp n)))
+ (cond ((and (use-region-p)
+ delete-active-region
+ (= n 1))
+ ;; If a region is active, kill or delete it.
+ (if (eq delete-active-region 'kill)
+ (kill-region (region-beginning) (region-end))
+ (delete-region (region-beginning) (region-end))))
+ ;; Otherwise, do simple deletion.
+ (t (delete-char n killflag))))
+
(defun mark-whole-buffer ()
"Put point at beginning and mark at end of buffer.
You probably should not use this function in Lisp programs;
(re-search-forward "[\n\C-m]" nil 'end (1- line))
(forward-line (1- line)))))
+(defun count-words-region (start end)
+ "Print the number of words in the region.
+When called interactively, the word count is printed in echo area."
+ (interactive "r")
+ (let ((count 0))
+ (save-excursion
+ (save-restriction
+ (narrow-to-region start end)
+ (goto-char (point-min))
+ (while (forward-word 1)
+ (setq count (1+ count)))))
+ (if (interactive-p)
+ (message "Region has %d words" count))
+ count))
+
(defun count-lines-region (start end)
"Print number of lines and characters in the region."
(interactive "r")
(if command-history
(error "Argument %d is beyond length of command history" arg)
(error "There are no previous complex commands to repeat")))))
+
+(defun read-extended-command ()
+ "Read command name to invoke in `execute-extended-command'."
+ (minibuffer-with-setup-hook
+ (lambda ()
+ (set (make-local-variable 'minibuffer-default-add-function)
+ (lambda ()
+ ;; Get a command name at point in the original buffer
+ ;; to propose it after M-n.
+ (with-current-buffer (window-buffer (minibuffer-selected-window))
+ (and (commandp (function-called-at-point))
+ (format "%S" (function-called-at-point)))))))
+ ;; Read a string, completing from and restricting to the set of
+ ;; all defined commands. Don't provide any initial input.
+ ;; Save the command read on the extended-command history list.
+ (completing-read
+ (concat (cond
+ ((eq current-prefix-arg '-) "- ")
+ ((and (consp current-prefix-arg)
+ (eq (car current-prefix-arg) 4)) "C-u ")
+ ((and (consp current-prefix-arg)
+ (integerp (car current-prefix-arg)))
+ (format "%d " (car current-prefix-arg)))
+ ((integerp current-prefix-arg)
+ (format "%d " current-prefix-arg)))
+ ;; This isn't strictly correct if `execute-extended-command'
+ ;; is bound to anything else (e.g. [menu]).
+ ;; It could use (key-description (this-single-command-keys)),
+ ;; but actually a prompt other than "M-x" would be confusing,
+ ;; because "M-x" is a well-known prompt to read a command
+ ;; and it serves as a shorthand for "Extended command: ".
+ "M-x ")
+ obarray 'commandp t nil 'extended-command-history)))
+
\f
(defvar minibuffer-history nil
"Default minibuffer history list.
Like `shell-command' but if COMMAND doesn't end in ampersand, adds `&'
surrounded by whitespace and executes the command asynchronously.
-The output appears in the buffer `*Async Shell Command*'."
+The output appears in the buffer `*Async Shell Command*'.
+
+In Elisp, you will often be better served by calling `start-process'
+directly, since it offers more control and does not impose the use of a
+shell (with its need to quote arguments)."
(interactive
(list
(read-shell-command "Async shell command: " nil nil
or buffer name to which to direct the command's standard error output.
If it is nil, error output is mingled with regular output.
In an interactive call, the variable `shell-command-default-error-buffer'
-specifies the value of ERROR-BUFFER."
+specifies the value of ERROR-BUFFER.
+
+In Elisp, you will often be better served by calling `call-process' or
+`start-process' directly, since it offers more control and does not impose
+the use of a shell (with its need to quote arguments)."
(interactive
(list
(reset-this-command-lengths)
(restore-overriding-map))
\f
+;; This function is here rather than in subr.el because it uses CL.
+(defmacro with-wrapper-hook (var args &rest body)
+ "Run BODY wrapped with the VAR hook.
+VAR is a special hook: its functions are called with a first argument
+which is the \"original\" code (the BODY), so the hook function can wrap
+the original function, or call it any number of times (including not calling
+it at all). This is similar to an `around' advice.
+VAR is normally a symbol (a variable) in which case it is treated like
+a hook, with a buffer-local and a global part. But it can also be an
+arbitrary expression.
+ARGS is a list of variables which will be passed as additional arguments
+to each function, after the initial argument, and which the first argument
+expects to receive when called."
+ (declare (indent 2) (debug t))
+ ;; We need those two gensyms because CL's lexical scoping is not available
+ ;; for function arguments :-(
+ (let ((funs (make-symbol "funs"))
+ (global (make-symbol "global"))
+ (argssym (make-symbol "args")))
+ ;; Since the hook is a wrapper, the loop has to be done via
+ ;; recursion: a given hook function will call its parameter in order to
+ ;; continue looping.
+ `(labels ((runrestofhook (,funs ,global ,argssym)
+ ;; `funs' holds the functions left on the hook and `global'
+ ;; holds the functions left on the global part of the hook
+ ;; (in case the hook is local).
+ (lexical-let ((funs ,funs)
+ (global ,global))
+ (if (consp funs)
+ (if (eq t (car funs))
+ (runrestofhook
+ (append global (cdr funs)) nil ,argssym)
+ (apply (car funs)
+ (lambda (&rest ,argssym)
+ (runrestofhook (cdr funs) global ,argssym))
+ ,argssym))
+ ;; Once there are no more functions on the hook, run
+ ;; the original body.
+ (apply (lambda ,args ,@body) ,argssym)))))
+ (runrestofhook ,var
+ ;; The global part of the hook, if any.
+ ,(if (symbolp var)
+ `(if (local-variable-p ',var)
+ (default-value ',var)))
+ (list ,@args)))))
+
+(defvar filter-buffer-substring-functions nil
+ "Wrapper hook around `filter-buffer-substring'.
+The functions on this special hook are called with 4 arguments:
+ NEXT-FUN BEG END DELETE
+NEXT-FUN is a function of 3 arguments (BEG END DELETE)
+that performs the default operation. The other 3 arguments are like
+the ones passed to `filter-buffer-substring'.")
+
(defvar buffer-substring-filters nil
"List of filter functions for `filter-buffer-substring'.
Each function must accept a single argument, a string, and return
return value of `filter-buffer-substring'.
If this variable is nil, no filtering is performed.")
+(make-obsolete-variable 'buffer-substring-filters
+ 'filter-buffer-substring-functions "24.1")
-(defun filter-buffer-substring (beg end &optional delete noprops)
+(defun filter-buffer-substring (beg end &optional delete)
"Return the buffer substring between BEG and END, after filtering.
-The buffer substring is passed through each of the filter
-functions in `buffer-substring-filters', and the value from the
-last filter function is returned. If `buffer-substring-filters'
-is nil, the buffer substring is returned unaltered.
+The filtering is performed by `filter-buffer-substring-functions'.
If DELETE is non-nil, the text between BEG and END is deleted
from the buffer.
-If NOPROPS is non-nil, final string returned does not include
-text properties, while the string passed to the filters still
-includes text properties from the buffer text.
-
-Point is temporarily set to BEG before calling
-`buffer-substring-filters', in case the functions need to know
-where the text came from.
-
This function should be used instead of `buffer-substring',
`buffer-substring-no-properties', or `delete-and-extract-region'
when you want to allow filtering to take place. For example,
-major or minor modes can use `buffer-substring-filters' to
+major or minor modes can use `filter-buffer-substring-functions' to
extract characters that are special to a buffer, and should not
be copied into other buffers."
- (cond
- ((or delete buffer-substring-filters)
- (save-excursion
- (goto-char beg)
- (let ((string (if delete (delete-and-extract-region beg end)
- (buffer-substring beg end))))
- (dolist (filter buffer-substring-filters)
- (setq string (funcall filter string)))
- (if noprops
- (set-text-properties 0 (length string) nil string))
- string)))
- (noprops
- (buffer-substring-no-properties beg end))
- (t
- (buffer-substring beg end))))
+ (with-wrapper-hook filter-buffer-substring-functions (beg end delete)
+ (cond
+ ((or delete buffer-substring-filters)
+ (save-excursion
+ (goto-char beg)
+ (let ((string (if delete (delete-and-extract-region beg end)
+ (buffer-substring beg end))))
+ (dolist (filter buffer-substring-filters)
+ (setq string (funcall filter string)))
+ string)))
+ (t
+ (buffer-substring beg end)))))
;;;; Window system cut and paste hooks.
is put in the kill ring, to make the new kill available to other
programs.
-The function takes one or two arguments.
-The first argument, TEXT, is a string containing
-the text which should be made available.
-The second, optional, argument PUSH, has the same meaning as the
-similar argument to `x-set-cut-buffer', which see.")
+The function takes one argument, TEXT, which is a string containing
+the text which should be made available.")
(defvar interprogram-paste-function nil
"Function to call to get text cut from other programs.
(if yank-handler
(signal 'args-out-of-range
(list string "yank-handler specified for empty string"))))
- (when (and kill-do-not-save-duplicates
- (equal string (car kill-ring)))
- (setq replace t))
- (if (fboundp 'menu-bar-update-yank-menu)
- (menu-bar-update-yank-menu string (and replace (car kill-ring))))
+ (unless (and kill-do-not-save-duplicates
+ (equal string (car kill-ring)))
+ (if (fboundp 'menu-bar-update-yank-menu)
+ (menu-bar-update-yank-menu string (and replace (car kill-ring)))))
(when save-interprogram-paste-before-kill
(let ((interprogram-paste (and interprogram-paste-function
(funcall interprogram-paste-function))))
(when interprogram-paste
- (if (listp interprogram-paste)
- (dolist (s (nreverse interprogram-paste))
- (push s kill-ring))
- (push interprogram-paste kill-ring)))))
- (if (and replace kill-ring)
- (setcar kill-ring string)
- (push string kill-ring)
- (if (> (length kill-ring) kill-ring-max)
- (setcdr (nthcdr (1- kill-ring-max) kill-ring) nil)))
+ (dolist (s (if (listp interprogram-paste)
+ (nreverse interprogram-paste)
+ (list interprogram-paste)))
+ (unless (and kill-do-not-save-duplicates
+ (equal s (car kill-ring)))
+ (push s kill-ring))))))
+ (unless (and kill-do-not-save-duplicates
+ (equal string (car kill-ring)))
+ (if (and replace kill-ring)
+ (setcar kill-ring string)
+ (push string kill-ring)
+ (if (> (length kill-ring) kill-ring-max)
+ (setcdr (nthcdr (1- kill-ring-max) kill-ring) nil))))
(setq kill-ring-yank-pointer kill-ring)
(if interprogram-cut-function
- (funcall interprogram-cut-function string (not replace))))
+ (funcall interprogram-cut-function string)))
(set-advertised-calling-convention
'kill-new '(string &optional replace) "23.3")
(interactive
(list (read-buffer "Append to buffer: " (other-buffer (current-buffer) t))
(region-beginning) (region-end)))
- (let ((oldbuf (current-buffer)))
- (let* ((append-to (get-buffer-create buffer))
- (windows (get-buffer-window-list append-to t t))
- point)
- (save-excursion
- (with-current-buffer append-to
- (setq point (point))
- (barf-if-buffer-read-only)
- (insert-buffer-substring oldbuf start end)
- (dolist (window windows)
- (when (= (window-point window) point)
- (set-window-point window (point)))))))))
+ (let* ((oldbuf (current-buffer))
+ (append-to (get-buffer-create buffer))
+ (windows (get-buffer-window-list append-to t t))
+ point)
+ (save-excursion
+ (with-current-buffer append-to
+ (setq point (point))
+ (barf-if-buffer-read-only)
+ (insert-buffer-substring oldbuf start end)
+ (dolist (window windows)
+ (when (= (window-point window) point)
+ (set-window-point window (point))))))))
(defun prepend-to-buffer (buffer start end)
"Prepend to specified buffer the text of the region.
(marker-position (mark-marker))
(signal 'mark-inactive nil)))
-(defcustom select-active-regions nil
- "If non-nil, an active region automatically becomes the window selection."
- :type 'boolean
- :group 'killing
- :version "23.1")
-
-(declare-function x-selection-owner-p "xselect.c" (&optional selection))
-
-;; Many places set mark-active directly, and several of them failed to also
-;; run deactivate-mark-hook. This shorthand should simplify.
(defsubst deactivate-mark (&optional force)
"Deactivate the mark by setting `mark-active' to nil.
Unless FORCE is non-nil, this function does nothing if Transient
Mark mode is disabled.
This function also runs `deactivate-mark-hook'."
(when (or transient-mark-mode force)
- ;; Copy the latest region into the primary selection, if desired.
- (and select-active-regions
- mark-active
- (display-selections-p)
- (x-selection-owner-p 'PRIMARY)
- (x-set-selection 'PRIMARY (buffer-substring-no-properties
- (region-beginning) (region-end))))
+ (when (and (if (eq select-active-regions 'only)
+ (eq (car-safe transient-mark-mode) 'only)
+ select-active-regions)
+ (region-active-p)
+ (display-selections-p))
+ ;; The var `saved-region-selection', if non-nil, is the text in
+ ;; the region prior to the last command modifying the buffer.
+ ;; Set the selection to that, or to the current region.
+ (cond (saved-region-selection
+ (x-set-selection 'PRIMARY saved-region-selection)
+ (setq saved-region-selection nil))
+ ((/= (region-beginning) (region-end))
+ (x-set-selection 'PRIMARY
+ (buffer-substring-no-properties
+ (region-beginning)
+ (region-end))))))
(if (and (null force)
(or (eq transient-mark-mode 'lambda)
(and (eq (car-safe transient-mark-mode) 'only)
(when (mark t)
(setq mark-active t)
(unless transient-mark-mode
- (setq transient-mark-mode 'lambda))
- (when (and select-active-regions
- (display-selections-p))
- (x-set-selection 'PRIMARY (current-buffer)))))
+ (setq transient-mark-mode 'lambda))))
(defun set-mark (pos)
"Set this buffer's mark to POS. Don't use this function!
(progn
(setq mark-active t)
(run-hooks 'activate-mark-hook)
- (when (and select-active-regions
- (display-selections-p))
- (x-set-selection 'PRIMARY (current-buffer)))
(set-marker (mark-marker) pos (current-buffer)))
;; Normally we never clear mark-active except in Transient Mark mode.
;; But when we actually clear out the mark value too, we must
(push-mark nil nomsg t)
(setq mark-active t)
(run-hooks 'activate-mark-hook)
- (and select-active-regions (display-selections-p)
- (x-set-selection 'PRIMARY (current-buffer)))
(unless nomsg
(message "Mark activated")))))
its earlier value."
(cond ((and shift-select-mode this-command-keys-shift-translated)
(unless (and mark-active
- (eq (car-safe transient-mark-mode) 'only))
- (setq transient-mark-mode
+ (eq (car-safe transient-mark-mode) 'only))
+ (setq transient-mark-mode
(cons 'only
(unless (eq transient-mark-mode 'lambda)
transient-mark-mode)))
\"mark.*active\" at the prompt, to see the documentation of
commands which are sensitive to the Transient Mark mode."
:global t
- :init-value (not noninteractive)
- :initialize 'custom-initialize-delay
- :group 'editing-basics)
-
-;; The variable transient-mark-mode is ugly: it can take on special
-;; values. Document these here.
-(defvar transient-mark-mode t
- "*Non-nil if Transient Mark mode is enabled.
-See the command `transient-mark-mode' for a description of this minor mode.
-
-Non-nil also enables highlighting of the region whenever the mark is active.
-The variable `highlight-nonselected-windows' controls whether to highlight
-all windows or just the selected window.
-
-If the value is `lambda', that enables Transient Mark mode temporarily.
-After any subsequent action that would normally deactivate the mark
-\(such as buffer modification), Transient Mark mode is turned off.
-
-If the value is (only . OLDVAL), that enables Transient Mark mode
-temporarily. After any subsequent point motion command that is not
-shift-translated, or any other action that would normally deactivate
-the mark (such as buffer modification), the value of
-`transient-mark-mode' is set to OLDVAL.")
+ ;; It's defined in C/cus-start, this stops the d-m-m macro defining it again.
+ :variable transient-mark-mode)
(defvar widen-automatically t
"Non-nil means it is ok for commands to call `widen' when they want to.
If `widen-automatically' is nil, these commands will do something else
as a fallback, and won't change the buffer bounds.")
+(defvar non-essential nil
+ "Whether the currently executing code is performing an essential task.
+This variable should be non-nil only when running code which should not
+disturb the user. E.g. it can be used to prevent Tramp from prompting the
+user for a password when we are simply scanning a set of files in the
+background or displaying possible completions before the user even asked
+for it.")
+
(defun pop-global-mark ()
"Pop off global mark ring and jump to the top location."
(interactive)
(insert (if use-hard-newlines hard-newline "\n")))
(line-move arg nil nil try-vscroll))
(if (called-interactively-p 'interactive)
- (condition-case nil
+ (condition-case err
(line-move arg nil nil try-vscroll)
- ((beginning-of-buffer end-of-buffer) (ding)))
+ ((beginning-of-buffer end-of-buffer)
+ (signal (car err) (cdr err))))
(line-move arg nil nil try-vscroll)))
nil)
(interactive "^p\np")
(or arg (setq arg 1))
(if (called-interactively-p 'interactive)
- (condition-case nil
+ (condition-case err
(line-move (- arg) nil nil try-vscroll)
- ((beginning-of-buffer end-of-buffer) (ding)))
+ ((beginning-of-buffer end-of-buffer)
+ (signal (car err) (cdr err))))
(line-move (- arg) nil nil try-vscroll))
nil)
(let (new
(old (point))
- (line-beg (save-excursion (beginning-of-line) (point)))
+ (line-beg (line-beginning-position))
(line-end
;; Compute the end of the line
;; ignoring effectively invisible newlines.
;; that will get us to the same place on the screen
;; but with a more reasonable buffer position.
(goto-char normal-location)
- (let ((line-beg (save-excursion (beginning-of-line) (point))))
+ (let ((line-beg (line-beginning-position)))
(while (and (not (bolp)) (invisible-p (1- (point))))
(goto-char (previous-char-property-change (point) line-beg))))))))
(let ((goal-column 0)
(line-move-visual nil))
(and (line-move arg t)
+ ;; With bidi reordering, we may not be at bol,
+ ;; so make sure we are.
+ (skip-chars-backward "^\n")
(not (bobp))
(progn
(while (and (not (bobp)) (invisible-p (1- (point))))
(define-globalized-minor-mode global-visual-line-mode
visual-line-mode turn-on-visual-line-mode
:lighter " vl")
-\f
-(defun scroll-other-window-down (lines)
- "Scroll the \"other window\" down.
-For more details, see the documentation for `scroll-other-window'."
- (interactive "P")
- (scroll-other-window
- ;; Just invert the argument's meaning.
- ;; We can do that without knowing which window it will be.
- (if (eq lines '-) nil
- (if (null lines) '-
- (- (prefix-numeric-value lines))))))
-
-(defun beginning-of-buffer-other-window (arg)
- "Move point to the beginning of the buffer in the other window.
-Leave mark at previous position.
-With arg N, put point N/10 of the way from the true beginning."
- (interactive "P")
- (let ((orig-window (selected-window))
- (window (other-window-for-scrolling)))
- ;; We use unwind-protect rather than save-window-excursion
- ;; because the latter would preserve the things we want to change.
- (unwind-protect
- (progn
- (select-window window)
- ;; Set point and mark in that window's buffer.
- (with-no-warnings
- (beginning-of-buffer arg))
- ;; Set point accordingly.
- (recenter '(t)))
- (select-window orig-window))))
-
-(defun end-of-buffer-other-window (arg)
- "Move point to the end of the buffer in the other window.
-Leave mark at previous position.
-With arg N, put point N/10 of the way from the true end."
- (interactive "P")
- ;; See beginning-of-buffer-other-window for comments.
- (let ((orig-window (selected-window))
- (window (other-window-for-scrolling)))
- (unwind-protect
- (progn
- (select-window window)
- (with-no-warnings
- (end-of-buffer arg))
- (recenter '(t)))
- (select-window orig-window))))
+
\f
(defun transpose-chars (arg)
"Interchange characters around point, moving forward one character.
;; 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)))
+ (skip-syntax-backward not-syntaxes (line-beginning-position))
(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)))
+ (skip-syntax-forward not-syntaxes (line-end-position))
(setq start (point))
(skip-syntax-forward syntaxes)
(setq end (point)))
(put 'auto-fill-function 'safe-local-variable 'null)
;; FIXME: turn into a proper minor mode.
;; Add a global minor mode version of it.
-(defun auto-fill-mode (&optional arg)
+(define-minor-mode auto-fill-mode
"Toggle Auto Fill mode.
With ARG, turn Auto Fill mode on if and only if ARG is positive.
In Auto Fill mode, inserting a space at a column beyond `current-fill-column'
The value of `normal-auto-fill-function' specifies the function to use
for `auto-fill-function' when turning Auto Fill mode on."
- (interactive "P")
- (prog1 (setq auto-fill-function
- (if (if (null arg)
- (not auto-fill-function)
- (> (prefix-numeric-value arg) 0))
- normal-auto-fill-function
- nil))
- (force-mode-line-update)))
+ :variable (eq auto-fill-function normal-auto-fill-function))
;; This holds a document string used to document auto-fill-mode.
(defun auto-fill-function ()
(defvar overwrite-mode-binary (purecopy " Bin Ovwrt")
"The string displayed in the mode line when in binary overwrite mode.")
-(defun overwrite-mode (arg)
+(define-minor-mode overwrite-mode
"Toggle overwrite mode.
With prefix argument ARG, turn overwrite mode on if ARG is positive,
otherwise turn it off. In overwrite mode, printing characters typed
Before a tab, such characters insert until the tab is filled in.
\\[quoted-insert] still inserts characters in overwrite mode; this
is supposed to make it easier to insert characters when necessary."
- (interactive "P")
- (setq overwrite-mode
- (if (if (null arg) (not overwrite-mode)
- (> (prefix-numeric-value arg) 0))
- 'overwrite-mode-textual))
- (force-mode-line-update))
+ :variable (eq overwrite-mode 'overwrite-mode-textual))
-(defun binary-overwrite-mode (arg)
+(define-minor-mode binary-overwrite-mode
"Toggle binary overwrite mode.
With prefix argument ARG, turn binary overwrite mode on if ARG is
positive, otherwise turn it off. In binary overwrite mode, printing
Note that binary overwrite mode is not its own minor mode; it is a
specialization of overwrite mode, entered by setting the
`overwrite-mode' variable to `overwrite-mode-binary'."
- (interactive "P")
- (setq overwrite-mode
- (if (if (null arg)
- (not (eq overwrite-mode 'overwrite-mode-binary))
- (> (prefix-numeric-value arg) 0))
- 'overwrite-mode-binary))
- (force-mode-line-update))
+ :variable (eq overwrite-mode 'overwrite-mode-binary))
(define-minor-mode line-number-mode
"Toggle Line Number mode.
otherwise turn it off. When Size Indication mode is enabled, the
size of the accessible part of the buffer appears in the mode line."
:global t :group 'mode-line)
+
+(define-minor-mode auto-save-mode
+ "Toggle auto-saving of contents of current buffer.
+With prefix argument ARG, turn auto-saving on if positive, else off."
+ :variable ((and buffer-auto-save-file-name
+ ;; If auto-save is off because buffer has shrunk,
+ ;; then toggling should turn it on.
+ (>= buffer-saved-size 0))
+ . (lambda (val)
+ (setq buffer-auto-save-file-name
+ (cond
+ ((null val) nil)
+ ((and buffer-file-name auto-save-visited-file-name
+ (not buffer-read-only))
+ buffer-file-name)
+ (t (make-auto-save-file-name))))))
+ ;; If -1 was stored here, to temporarily turn off saving,
+ ;; turn it back on.
+ (and (< buffer-saved-size 0)
+ (setq buffer-saved-size 0)))
\f
(defgroup paren-blinking nil
"Blinking matching of parens and expressions."
:type 'boolean
:group 'paren-blinking)
+(defun blink-matching-check-mismatch (start end)
+ "Return whether or not START...END are matching parens.
+END is the current point and START is the blink position.
+START might be nil if no matching starter was found.
+Returns non-nil if we find there is a mismatch."
+ (let* ((end-syntax (syntax-after (1- end)))
+ (matching-paren (and (consp end-syntax)
+ (eq (syntax-class end-syntax) 5)
+ (cdr end-syntax))))
+ ;; For self-matched chars like " and $, we can't know when they're
+ ;; mismatched or unmatched, so we can only do it for parens.
+ (when matching-paren
+ (not (and start
+ (or
+ (eq (char-after start) matching-paren)
+ ;; The cdr might hold a new paren-class info rather than
+ ;; a matching-char info, in which case the two CDRs
+ ;; should match.
+ (eq matching-paren (cdr-safe (syntax-after start)))))))))
+
+(defvar blink-matching-check-function #'blink-matching-check-mismatch
+ "Function to check parentheses mismatches.
+The function takes two arguments (START and END) where START is the
+position just before the opening token and END is the position right after.
+START can be nil, if it was not found.
+The function should return non-nil if the two tokens do not match.")
+
(defun blink-matching-open ()
"Move cursor momentarily to the beginning of the sexp before point."
(interactive)
- (when (and (> (point) (point-min))
- blink-matching-paren
- ;; Verify an even number of quoting characters precede the close.
- (= 1 (logand 1 (- (point)
- (save-excursion
- (forward-char -1)
- (skip-syntax-backward "/\\")
- (point))))))
+ (when (and (not (bobp))
+ blink-matching-paren)
(let* ((oldpos (point))
- (message-log-max nil) ; Don't log messages about paren matching.
- (atdollar (eq (syntax-class (syntax-after (1- oldpos))) 8))
- (isdollar)
+ (message-log-max nil) ; Don't log messages about paren matching.
(blinkpos
(save-excursion
(save-restriction
(and parse-sexp-ignore-comments
(not blink-matching-paren-dont-ignore-comments))))
(condition-case ()
- (scan-sexps oldpos -1)
+ (progn
+ (forward-sexp -1)
+ ;; backward-sexp skips backward over prefix chars,
+ ;; so move back to the matching paren.
+ (while (and (< (point) (1- oldpos))
+ (let ((code (syntax-after (point))))
+ (or (eq (syntax-class code) 6)
+ (eq (logand 1048576 (car code))
+ 1048576))))
+ (forward-char 1))
+ (point))
(error nil))))))
- (matching-paren
- (and blinkpos
- ;; Not syntax '$'.
- (not (setq isdollar
- (eq (syntax-class (syntax-after blinkpos)) 8)))
- (let ((syntax (syntax-after blinkpos)))
- (and (consp syntax)
- (eq (syntax-class syntax) 4)
- (cdr syntax))))))
+ (mismatch (funcall blink-matching-check-function blinkpos oldpos)))
(cond
- ;; isdollar is for:
- ;; http://lists.gnu.org/archive/html/emacs-devel/2007-10/msg00871.html
- ((not (or (and isdollar blinkpos)
- (and atdollar (not blinkpos)) ; see below
- (eq matching-paren (char-before oldpos))
- ;; The cdr might hold a new paren-class info rather than
- ;; a matching-char info, in which case the two CDRs
- ;; should match.
- (eq matching-paren (cdr (syntax-after (1- oldpos))))))
- (if (minibufferp)
- (minibuffer-message " [Mismatched parentheses]")
- (message "Mismatched parentheses")))
- ((not blinkpos)
- (or blink-matching-paren-distance
- ;; Don't complain when `$' with no blinkpos, because it
- ;; could just be the first one typed in the buffer.
- atdollar
+ (mismatch
+ (if blinkpos
(if (minibufferp)
- (minibuffer-message " [Unmatched parenthesis]")
- (message "Unmatched parenthesis"))))
+ (minibuffer-message " [Mismatched parentheses]")
+ (message "Mismatched parentheses"))
+ (if (minibufferp)
+ (minibuffer-message " [Unmatched parenthesis]")
+ (message "Unmatched parenthesis"))))
+ ((not blinkpos) nil)
((pos-visible-in-window-p blinkpos)
;; Matching open within window, temporarily move to blinkpos but only
;; if `blink-matching-paren-on-screen' is non-nil.
(message "Matches %s"
(substring-no-properties open-paren-line-string)))))))))
-(setq blink-paren-function 'blink-matching-open)
+(defvar blink-paren-function 'blink-matching-open
+ "Function called, if non-nil, whenever a close parenthesis is inserted.
+More precisely, a char with closeparen syntax is self-inserted.")
+
+(defun blink-paren-post-self-insert-function ()
+ (when (and (eq (char-before) last-command-event) ; Sanity check.
+ (memq (char-syntax last-command-event) '(?\) ?\$))
+ blink-paren-function
+ (not executing-kbd-macro)
+ (not noninteractive)
+ ;; Verify an even number of quoting characters precede the close.
+ (= 1 (logand 1 (- (point)
+ (save-excursion
+ (forward-char -1)
+ (skip-syntax-backward "/\\")
+ (point))))))
+ (funcall blink-paren-function)))
+
+(add-hook 'post-self-insert-hook #'blink-paren-post-self-insert-function
+ ;; Most likely, this hook is nil, so this arg doesn't matter,
+ ;; but I use it as a reminder that this function usually
+ ;; likes to be run after others since it does `sit-for'.
+ 'append)
\f
;; This executes C-g typed while Emacs is waiting for a command.
;; Quitting out of a program does not go through here;
During execution of Lisp code, this character causes a quit directly.
At top-level, as an editor command, this simply beeps."
(interactive)
- (deactivate-mark)
+ ;; Avoid adding the region to the window selection.
+ (setq saved-region-selection nil)
+ (let (select-active-regions)
+ (deactivate-mark))
(if (fboundp 'kmacro-keyboard-quit)
(kmacro-keyboard-quit))
(setq defining-kbd-macro nil)
or go back to just one window (by deleting all but the selected window)."
(interactive)
(cond ((eq last-command 'mode-exited) nil)
+ ((region-active-p)
+ (deactivate-mark))
((> (minibuffer-depth) 0)
(abort-recursive-edit))
(current-prefix-arg
nil)
- ((region-active-p)
- (deactivate-mark))
((> (recursion-depth) 0)
(exit-recursive-edit))
(buffer-quit-function
(if (if (eq normal-erase-is-backspace 'maybe)
(and (not noninteractive)
(or (memq system-type '(ms-dos windows-nt))
+ (memq window-system '(ns))
(and (memq window-system '(x))
(fboundp 'x-backspace-delete-keys-p)
(x-backspace-delete-keys-p))
normal-erase-is-backspace)
1 0)))))
-(defun normal-erase-is-backspace-mode (&optional arg)
+(define-minor-mode normal-erase-is-backspace-mode
"Toggle the Erase and Delete mode of the Backspace and Delete keys.
With numeric ARG, turn the mode on if and only if ARG is positive.
have both Backspace, Delete and F1 keys.
See also `normal-erase-is-backspace'."
- (interactive "P")
- (let ((enabled (or (and arg (> (prefix-numeric-value arg) 0))
- (not (or arg
- (eq 1 (terminal-parameter
- nil 'normal-erase-is-backspace)))))))
- (set-terminal-parameter nil 'normal-erase-is-backspace
- (if enabled 1 0))
+ :variable (eq (terminal-parameter
+ nil 'normal-erase-is-backspace) 1)
+ (let ((enabled (eq 1 (terminal-parameter
+ nil 'normal-erase-is-backspace))))
(cond ((or (memq window-system '(x w32 ns pc))
(memq system-type '(ms-dos windows-nt)))
(if enabled
(progn
- (define-key local-function-key-map [delete] [?\C-d])
+ (define-key local-function-key-map [delete] [deletechar])
(define-key local-function-key-map [kp-delete] [?\C-d])
(define-key local-function-key-map [backspace] [?\C-?])
(dolist (b bindings)
(keyboard-translate ?\C-h ?\C-h)
(keyboard-translate ?\C-? ?\C-?))))
- (run-hooks 'normal-erase-is-backspace-hook)
(if (called-interactively-p 'interactive)
(message "Delete key deletes %s"
(if (eq 1 (terminal-parameter nil 'normal-erase-is-backspace))
was called."
(lexical-let ((fun fun) (args1 args))
(lambda (&rest args2) (apply fun (append args1 args2)))))
-
-;; This function is here rather than in subr.el because it uses CL.
-(defmacro with-wrapper-hook (var args &rest body)
- "Run BODY wrapped with the VAR hook.
-VAR is a special hook: its functions are called with a first argument
-which is the \"original\" code (the BODY), so the hook function can wrap
-the original function, or call it any number of times (including not calling
-it at all). This is similar to an `around' advice.
-VAR is normally a symbol (a variable) in which case it is treated like
-a hook, with a buffer-local and a global part. But it can also be an
-arbitrary expression.
-ARGS is a list of variables which will be passed as additional arguments
-to each function, after the initial argument, and which the first argument
-expects to receive when called."
- (declare (indent 2) (debug t))
- ;; We need those two gensyms because CL's lexical scoping is not available
- ;; for function arguments :-(
- (let ((funs (make-symbol "funs"))
- (global (make-symbol "global"))
- (argssym (make-symbol "args")))
- ;; Since the hook is a wrapper, the loop has to be done via
- ;; recursion: a given hook function will call its parameter in order to
- ;; continue looping.
- `(labels ((runrestofhook (,funs ,global ,argssym)
- ;; `funs' holds the functions left on the hook and `global'
- ;; holds the functions left on the global part of the hook
- ;; (in case the hook is local).
- (lexical-let ((funs ,funs)
- (global ,global))
- (if (consp funs)
- (if (eq t (car funs))
- (runrestofhook
- (append global (cdr funs)) nil ,argssym)
- (apply (car funs)
- (lambda (&rest ,argssym)
- (runrestofhook (cdr funs) global ,argssym))
- ,argssym))
- ;; Once there are no more functions on the hook, run
- ;; the original body.
- (apply (lambda ,args ,@body) ,argssym)))))
- (runrestofhook ,var
- ;; The global part of the hook, if any.
- ,(if (symbolp var)
- `(if (local-variable-p ',var)
- (default-value ',var)))
- (list ,@args)))))
\f
;; Minibuffer prompt stuff.
(provide 'simple)
-;; arch-tag: 24af67c0-2a49-44f6-b3b1-312d8b570dfd
;;; simple.el ends here