;;; 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, 2011 Free Software Foundation, Inc.
;; Maintainer: FSF
;; Keywords: internal
(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))
+ (set (make-local-variable 'parse-sexp-ignore-comments) t)
+ ;; Any programming language is always written left to right.
+ (setq bidi-paragraph-direction 'left-to-right))
;; Making and deleting lines.
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)
(constrain-to-field nil orig-pos)))))
(defun just-one-space (&optional n)
- "Delete all spaces and tabs around point, leaving one space (or N spaces)."
+ "Delete all spaces and tabs around point, leaving one space (or N spaces).
+If N is negative, delete newlines as well."
(interactive "*p")
- (let ((orig-pos (point)))
- (skip-chars-backward " \t")
+ (unless n (setq n 1))
+ (let ((orig-pos (point))
+ (skip-characters (if (< n 0) " \t\n\r" " \t"))
+ (n (abs n)))
+ (skip-chars-backward skip-characters)
(constrain-to-field nil orig-pos)
(dotimes (i (or n 1))
(if (= (following-char) ?\s)
(delete-region
(point)
(progn
- (skip-chars-forward " \t")
+ (skip-chars-forward skip-characters)
(constrain-to-field nil orig-pos t)))))
\f
(defun beginning-of-buffer (&optional arg)
(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")
(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
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.
Optional second argument REPLACE non-nil means that STRING will replace
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, if non-nil, is stored as a `yank-handler' text property on STRING).
-
When `save-interprogram-paste-before-kill' and `interprogram-paste-function'
are non-nil, saves the interprogram paste string(s) into `kill-ring' before
STRING.
(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")
(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.
-Optional third argument YANK-HANDLER, if non-nil, 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, this function
-adds the combined string to the kill ring as a new element,
-instead of replacing the last kill with it.
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)))
+(set-advertised-calling-convention 'kill-append '(string before-p) "23.3")
(defcustom yank-pop-change-selection nil
"If non-nil, rotating the kill ring changes the window system selection."
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.
-
-In Lisp code, optional third arg YANK-HANDLER, if non-nil,
-specifies the yank-handler text property to be set on the killed
-text. See `insert-for-yank'."
+to make one entry in the kill ring."
;; Pass point first, then mark, because the order matters
;; when calling kill-append.
(interactive (list (point) (mark)))
(barf-if-buffer-read-only)
;; If the buffer isn't read-only, the text is.
(signal 'text-read-only (list (current-buffer)))))))
+(set-advertised-calling-convention 'kill-region '(beg end) "23.3")
;; copy-region-as-kill no longer sets this-command, because it's confusing
;; to get two copies of the text when the user accidentally types M-w and
(marker-position (mark-marker))
(signal 'mark-inactive nil)))
-(declare-function x-selection-owner-p "xselect.c" (&optional selection))
-
(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.*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.
(or (and (= (vertical-motion
(cons (or goal-column
(if (consp temporary-goal-column)
- (truncate (car temporary-goal-column))
+ (car temporary-goal-column)
temporary-goal-column))
arg))
arg)
(goto-char (next-char-property-change (point))))
;; Move a line.
;; We don't use `end-of-line', since we want to escape
- ;; from field boundaries ocurring exactly at point.
+ ;; from field boundaries occurring exactly at point.
(goto-char (constrain-to-field
(let ((inhibit-field-text-motion t))
(line-end-position))
(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))))))))
;; 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)))
: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
(condition-case ()
(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.
(memq (char-syntax last-command-event) '(?\) ?\$))
blink-paren-function
(not executing-kbd-macro)
- (not noninteractive))
+ (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
: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
(goto-char (point-min))
"^\\([:\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'.
(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)
(provide 'simple)
-;; arch-tag: 24af67c0-2a49-44f6-b3b1-312d8b570dfd
;;; simple.el ends here
HCoop / bpt / emacs.git / blobdiff