;;; 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-1987, 1993-2011 Free Software Foundation, Inc.
;; Maintainer: FSF
;; Keywords: internal
;;; Code:
-;; This is for lexical-let in apply-partially.
-(eval-when-compile (require 'cl))
+(eval-when-compile (require 'cl)) ;For define-minor-mode.
(declare-function widget-convert "wid-edit" (type &rest args))
(declare-function shell-mode "shell" ())
until you use it in some other buffer which uses Compilation mode
or Compilation Minor mode.
-See variables `compilation-parse-errors-function' and
-\`compilation-error-regexp-alist' for customization ideas."
+To control which errors are matched, customize the variable
+`compilation-error-regexp-alist'."
(interactive "P")
(if (consp arg) (setq reset t arg nil))
(when (setq next-error-last-buffer (next-error-find-buffer))
(define-key map " " 'scroll-up)
(define-key map "\C-?" 'scroll-down)
(define-key map "?" 'describe-mode)
+ (define-key map "h" 'describe-mode)
(define-key map ">" 'end-of-buffer)
(define-key map "<" 'beginning-of-buffer)
(define-key map "g" 'revert-buffer)
+ (define-key map "z" 'kill-this-buffer)
map))
(put 'special-mode 'mode-class 'special)
(if (looking-at "^[ \t]*\n\\'")
(delete-region (point) (point-max)))))
-(defun delete-trailing-whitespace ()
+(defun delete-trailing-whitespace (&optional start end)
"Delete all the trailing whitespace across the current buffer.
All whitespace after the last non-whitespace character in a line is deleted.
This respects narrowing, created by \\[narrow-to-region] and friends.
-A formfeed is not considered whitespace by this function."
- (interactive "*")
+A formfeed is not considered whitespace by this function.
+If the region is active, only delete whitespace within the region."
+ (interactive (progn
+ (barf-if-buffer-read-only)
+ (if (use-region-p)
+ (list (region-beginning) (region-end))
+ (list nil nil))))
(save-match-data
(save-excursion
- (goto-char (point-min))
- (while (re-search-forward "\\s-$" nil t)
- (skip-syntax-backward "-" (save-excursion (forward-line 0) (point)))
- ;; Don't delete formfeeds, even if they are considered whitespace.
- (save-match-data
- (if (looking-at ".*\f")
- (goto-char (match-end 0))))
- (delete-region (point) (match-end 0))))))
+ (let ((end-marker (copy-marker (or end (point-max))))
+ (start (or start (point-min))))
+ (goto-char start)
+ (while (re-search-forward "\\s-$" end-marker t)
+ (skip-syntax-backward "-" (save-excursion (forward-line 0) (point)))
+ ;; Don't delete formfeeds, even if they are considered whitespace.
+ (save-match-data
+ (if (looking-at ".*\f")
+ (goto-char (match-end 0))))
+ (delete-region (point) (match-end 0)))
+ (set-marker end-marker nil))))
+ ;; Return nil for the benefit of `write-file-functions'.
+ nil)
(defun newline-and-indent ()
"Insert a newline, then indent according to major mode.
(n (abs n)))
(skip-chars-backward skip-characters)
(constrain-to-field nil orig-pos)
- (dotimes (i (or n 1))
+ (dotimes (i n)
(if (= (following-char) ?\s)
(forward-char 1)
(insert ?\s)))
(goto-char (point-min))
(while (forward-word 1)
(setq count (1+ count)))))
- (if (interactive-p)
+ (if (called-interactively-p 'interactive)
(message "Region has %d words" count))
count))
(set-keymap-parent m minibuffer-local-map)
(setq read-expression-map m))
-(defvar read-expression-history nil)
-
(defvar minibuffer-completing-symbol nil
"Non-nil means completing a Lisp symbol in the minibuffer.")
current-prefix-arg))
(if (null eval-expression-debug-on-error)
- (setq values (cons (eval eval-expression-arg) values))
+ (push (eval eval-expression-arg lexical-binding) values)
(let ((old-value (make-symbol "t")) new-value)
;; Bind debug-on-error to something unique so that we can
;; detect when evaled code changes it.
(let ((debug-on-error old-value))
- (setq values (cons (eval eval-expression-arg) values))
+ (push (eval eval-expression-arg lexical-binding) values)
(setq new-value debug-on-error))
;; If evaled code has changed the value of debug-on-error,
;; propagate that change to the global binding.
(error "Shell command in progress")))
(with-current-buffer buffer
(setq buffer-read-only nil)
- (erase-buffer)
+ ;; Setting buffer-read-only to nil doesn't suffice
+ ;; if some text has a non-nil read-only property,
+ ;; which comint sometimes adds for prompts.
+ (let ((inhibit-read-only t))
+ (erase-buffer))
(display-buffer buffer)
(setq default-directory directory)
(setq proc (start-process "Shell" buffer shell-file-name
(with-output-to-string
(with-current-buffer
standard-output
- (call-process shell-file-name nil t nil shell-command-switch command))))
+ (process-file shell-file-name nil t nil shell-command-switch command))))
(defun process-file (program &optional infile buffer display &rest args)
"Process files synchronously in a separate process.
(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'.
(delete-char 1)))
(forward-char -1)
(setq count (1- count))))))
- (delete-backward-char
- (let ((skip (cond ((eq backward-delete-char-untabify-method 'hungry) " \t")
+ (let* ((skip (cond ((eq backward-delete-char-untabify-method 'hungry) " \t")
((eq backward-delete-char-untabify-method 'all)
- " \t\n\r"))))
- (if skip
- (let ((wh (- (point) (save-excursion (skip-chars-backward skip)
- (point)))))
- (+ arg (if (zerop wh) 0 (1- wh))))
- arg))
- killp))
+ " \t\n\r")))
+ (n (if skip
+ (let ((wh (- (point) (save-excursion (skip-chars-backward skip)
+ (point)))))
+ (+ arg (if (zerop wh) 0 (1- wh))))
+ arg)))
+ ;; Avoid warning about delete-backward-char
+ (with-no-warnings (delete-backward-char n killp))))
(defun zap-to-char (arg char)
"Kill up to and including ARGth occurrence of CHAR.
"When non-nil, `line-move' moves point by visual lines.
This movement is based on where the cursor is displayed on the
screen, instead of relying on buffer contents alone. It takes
-into account variable-width characters and line continuation."
+into account variable-width characters and line continuation.
+If nil, `line-move' moves point by logical lines."
:type 'boolean
- :group 'editing-basics)
+ :group 'editing-basics
+ :version "23.1")
;; Returns non-nil if partial move was done.
(defun line-move-partial (arg noerror to-end)
regexp)
:group 'fill)
-;; This function is used as the auto-fill-function of a buffer
-;; when Auto-Fill mode is enabled.
-;; It returns t if it really did any work.
-;; (Actually some major modes use a different auto-fill function,
-;; but this one is the default one.)
(defun do-auto-fill ()
+ "The default value for `normal-auto-fill-function'.
+This is the default auto-fill function, some major modes use a different one.
+Returns t if it really did any work."
(let (fc justify give-up
(fill-prefix fill-prefix))
(if (or (not (setq justify (current-justification)))
:version "23.2"
:group 'mail)
-(define-mail-user-agent 'sendmail-user-agent
- 'sendmail-user-agent-compose
- 'mail-send-and-exit)
-
(defun rfc822-goto-eoh ()
- ;; Go to header delimiter line in a mail message, following RFC822 rules
+ "If the buffer starts with a mail header, move point to the header's end.
+Otherwise, moves to `point-min'.
+The end of the header is the start of the next line, if there is one,
+else the end of the last line. This function obeys RFC822."
(goto-char (point-min))
(when (re-search-forward
"^\\([:\n]\\|[^: \t\n]+[ \t\n]\\)" nil 'move)
(goto-char (match-beginning 0))))
-(defun sendmail-user-agent-compose (&optional to subject other-headers continue
- switch-function yank-action
- send-actions)
- (if switch-function
- (let ((special-display-buffer-names nil)
- (special-display-regexps nil)
- (same-window-buffer-names nil)
- (same-window-regexps nil))
- (funcall switch-function "*mail*")))
- (let ((cc (cdr (assoc-string "cc" other-headers t)))
- (in-reply-to (cdr (assoc-string "in-reply-to" other-headers t)))
- (body (cdr (assoc-string "body" other-headers t))))
- (or (mail continue to subject in-reply-to cc yank-action send-actions)
- continue
- (error "Message aborted"))
- (save-excursion
- (rfc822-goto-eoh)
- (while other-headers
- (unless (member-ignore-case (car (car other-headers))
- '("in-reply-to" "cc" "body"))
- (insert (car (car other-headers)) ": "
- (cdr (car other-headers))
- (if use-hard-newlines hard-newline "\n")))
- (setq other-headers (cdr other-headers)))
- (when body
- (forward-line 1)
- (insert body))
- t)))
-
(defun compose-mail (&optional to subject other-headers continue
- switch-function yank-action send-actions)
+ switch-function yank-action send-actions
+ return-action)
"Start composing a mail message to send.
This uses the user's chosen mail composition package
as selected with the variable `mail-user-agent'.
original text has been inserted in this way.)
SEND-ACTIONS is a list of actions to call when the message is sent.
-Each action has the form (FUNCTION . ARGS)."
+Each action has the form (FUNCTION . ARGS).
+
+RETURN-ACTION, if non-nil, is an action for returning to the
+caller. It has the form (FUNCTION . ARGS). The function is
+called after the mail has been sent or put aside, and the mail
+buffer buried."
(interactive
(list nil nil nil current-prefix-arg))
warn-vars " "))))))
(let ((function (get mail-user-agent 'composefunc)))
- (funcall function to subject other-headers continue
- switch-function yank-action send-actions)))
+ (funcall function to subject other-headers continue switch-function
+ yank-action send-actions return-action)))
(defun compose-mail-other-window (&optional to subject other-headers continue
- yank-action send-actions)
+ yank-action send-actions
+ return-action)
"Like \\[compose-mail], but edit the outgoing message in another window."
- (interactive
- (list nil nil nil current-prefix-arg))
+ (interactive (list nil nil nil current-prefix-arg))
(compose-mail to subject other-headers continue
- 'switch-to-buffer-other-window yank-action send-actions))
-
+ 'switch-to-buffer-other-window yank-action send-actions
+ return-action))
(defun compose-mail-other-frame (&optional to subject other-headers continue
- yank-action send-actions)
+ yank-action send-actions
+ return-action)
"Like \\[compose-mail], but edit the outgoing message in another frame."
- (interactive
- (list nil nil nil current-prefix-arg))
+ (interactive (list nil nil nil current-prefix-arg))
(compose-mail to subject other-headers continue
- 'switch-to-buffer-other-frame yank-action send-actions))
+ 'switch-to-buffer-other-frame yank-action send-actions
+ return-action))
+
\f
(defvar set-variable-value-history nil
"History of values entered with `set-variable'.
(define-key map [left] 'previous-completion)
(define-key map [right] 'next-completion)
(define-key map "q" 'quit-window)
+ (define-key map "z" 'kill-this-buffer)
map)
"Local map for completion list buffers.")
buffer-invisibility-spec)
(setq buffer-invisibility-spec nil)))
\f
-;; Partial application of functions (similar to "currying").
-;; This function is here rather than in subr.el because it uses CL.
-(defun apply-partially (fun &rest args)
- "Return a function that is a partial application of FUN to ARGS.
-ARGS is a list of the first N arguments to pass to FUN.
-The result is a new function which does the same as FUN, except that
-the first N arguments are fixed at the values with which this function
-was called."
- (lexical-let ((fun fun) (args1 args))
- (lambda (&rest args2) (apply fun (append args1 args2)))))
-\f
;; Minibuffer prompt stuff.
-;(defun minibuffer-prompt-modification (start end)
-; (error "You cannot modify the prompt"))
-;
-;
-;(defun minibuffer-prompt-insertion (start end)
-; (let ((inhibit-modification-hooks t))
-; (delete-region start end)
-; ;; Discard undo information for the text insertion itself
-; ;; and for the text deletion.above.
-; (when (consp buffer-undo-list)
-; (setq buffer-undo-list (cddr buffer-undo-list)))
-; (message "You cannot modify the prompt")))
-;
-;
-;(setq minibuffer-prompt-properties
-; (list 'modification-hooks '(minibuffer-prompt-modification)
-; 'insert-in-front-hooks '(minibuffer-prompt-insertion)))
-;
+;;(defun minibuffer-prompt-modification (start end)
+;; (error "You cannot modify the prompt"))
+;;
+;;
+;;(defun minibuffer-prompt-insertion (start end)
+;; (let ((inhibit-modification-hooks t))
+;; (delete-region start end)
+;; ;; Discard undo information for the text insertion itself
+;; ;; and for the text deletion.above.
+;; (when (consp buffer-undo-list)
+;; (setq buffer-undo-list (cddr buffer-undo-list)))
+;; (message "You cannot modify the prompt")))
+;;
+;;
+;;(setq minibuffer-prompt-properties
+;; (list 'modification-hooks '(minibuffer-prompt-modification)
+;; 'insert-in-front-hooks '(minibuffer-prompt-insertion)))
\f
;;;; Problematic external packages.
HCoop / bpt / emacs.git / blobdiff