(or arg (setq arg 1))
(forward-sexp (- arg)))
-(defun mark-sexp (&optional arg)
+(defun mark-sexp (&optional arg allow-extend)
"Set mark ARG sexps from point.
The place mark goes is the same place \\[forward-sexp] would
move to with the same argument.
-If this command is repeated, it marks the next ARG sexps after the ones
-already marked."
- (interactive "p")
- (cond ((and (eq last-command this-command) (mark t))
+Interactively, if this command is repeated
+or (in Transient Mark mode) if the mark is active,
+it marks the next ARG sexps after the ones already marked."
+ (interactive "P\np")
+ (cond ((and allow-extend
+ (or (and (eq last-command this-command) (mark t))
+ (and transient-mark-mode mark-active)))
+ (setq arg (if arg (prefix-numeric-value arg)
+ (if (< (mark) (point)) -1 1)))
(set-mark
(save-excursion
- (goto-char (mark))
- (forward-sexp (or arg 1))
- (point))))
+ (goto-char (mark))
+ (forward-sexp arg)
+ (point))))
(t
(push-mark
(save-excursion
- (forward-sexp (or arg 1))
+ (forward-sexp (prefix-numeric-value arg))
(point))
nil t))))
Negative arg -N means kill N sexps after the cursor."
(interactive "p")
(kill-sexp (- (or arg 1))))
+
+;; After Zmacs:
+(defun kill-backward-up-list (&optional arg)
+ "Kill the form containing the current sexp, leaving the sexp itself.
+A prefix argument ARG causes the relevant number of surrounding
+forms to be removed."
+ (interactive "*p")
+ (let ((current-sexp (thing-at-point 'sexp)))
+ (if current-sexp
+ (save-excursion
+ (backward-up-list arg)
+ (kill-sexp)
+ (insert current-sexp))
+ (error "Not at a sexp"))))
\f
(defvar beginning-of-defun-function nil
"If non-nil, function for `beginning-of-defun-raw' to call.
If variable `beginning-of-defun-function' is non-nil, its value
is called as a function to find the defun's beginning."
(interactive "p")
- (and (eq this-command 'beginning-of-defun)
- (or (eq last-command 'beginning-of-defun) (push-mark)))
+ (or (not (eq this-command 'beginning-of-defun))
+ (eq last-command 'beginning-of-defun)
+ (and transient-mark-mode mark-active)
+ (push-mark))
(and (beginning-of-defun-raw arg)
(progn (beginning-of-line) t)))
If variable `end-of-defun-function' is non-nil, its value
is called as a function to find the defun's end."
(interactive "p")
- (and (eq this-command 'end-of-defun)
- (or (eq last-command 'end-of-defun) (push-mark)))
+ (or (not (eq this-command 'end-of-defun))
+ (eq last-command 'end-of-defun)
+ (and transient-mark-mode mark-active)
+ (push-mark))
(if (or (null arg) (= arg 0)) (setq arg 1))
(if end-of-defun-function
(if (> arg 0)
(goto-char (point-min)))))
(setq arg (1+ arg))))))
-(defun mark-defun ()
+(defun mark-defun (&optional allow-extend)
"Put mark at end of this defun, point at beginning.
The defun marked is the one that contains point or follows point.
-If this command is repeated, marks more defuns after the ones
-already marked."
- (interactive)
- (cond ((and (eq last-command this-command) (mark t))
+
+Interactively, if this command is repeated
+or (in Transient Mark mode) if the mark is active,
+it marks the next defun after the ones already marked."
+ (interactive "p")
+ (cond ((and allow-extend
+ (or (and (eq last-command this-command) (mark t))
+ (and transient-mark-mode mark-active)))
(set-mark
(save-excursion
(goto-char (mark))
(end-of-defun)
(point))))
(t
- ;; Do it in this order for the sake of languages with nested
- ;; functions where several can end at the same place as with
- ;; the offside rule, e.g. Python.
- (push-mark (point))
- (beginning-of-defun)
- (push-mark (point) nil t)
- (end-of-defun)
- (exchange-point-and-mark)
- (re-search-backward "^\n" (- (point) 1) t))))
+ (let ((opoint (point))
+ beg end)
+ (push-mark opoint)
+ ;; Try first in this order for the sake of languages with nested
+ ;; functions where several can end at the same place as with
+ ;; the offside rule, e.g. Python.
+ (beginning-of-defun)
+ (setq beg (point))
+ (end-of-defun)
+ (setq end (point))
+ (while (looking-at "^\n")
+ (forward-line 1))
+ (if (> (point) opoint)
+ (progn
+ ;; We got the right defun.
+ (push-mark beg nil t)
+ (goto-char end)
+ (exchange-point-and-mark))
+ ;; beginning-of-defun moved back one defun
+ ;; so we got the wrong one.
+ (goto-char opoint)
+ (end-of-defun)
+ (push-mark (point) nil t)
+ (beginning-of-defun))
+ (re-search-backward "^\n" (- (point) 1) t)))))
(defun narrow-to-defun (&optional arg)
"Make text outside current defun invisible.
(interactive)
(save-excursion
(widen)
- ;; Do it in this order for the sake of languages with nested
- ;; functions where several can end at the same place as with the
- ;; offside rule, e.g. Python.
- (beginning-of-defun)
- (let ((beg (point)))
+ (let ((opoint (point))
+ beg end)
+ ;; Try first in this order for the sake of languages with nested
+ ;; functions where several can end at the same place as with
+ ;; the offside rule, e.g. Python.
+ (beginning-of-defun)
+ (setq beg (point))
(end-of-defun)
- (narrow-to-region beg (point)))))
-
-(defun insert-pair (arg &optional open close)
+ (setq end (point))
+ (while (looking-at "^\n")
+ (forward-line 1))
+ (unless (> (point) opoint)
+ ;; beginning-of-defun moved back one defun
+ ;; so we got the wrong one.
+ (goto-char opoint)
+ (end-of-defun)
+ (setq end (point))
+ (beginning-of-defun)
+ (setq beg (point)))
+ (goto-char end)
+ (re-search-backward "^\n" (- (point) 1) t)
+ (narrow-to-region beg end))))
+
+(defvar insert-pair-alist
+ '((?\( ?\)) (?\[ ?\]) (?\{ ?\}) (?\< ?\>) (?\" ?\") (?\' ?\') (?\` ?\'))
+ "Alist of paired characters inserted by `insert-pair'.
+Each element looks like (OPEN-CHAR CLOSE-CHAR) or (COMMAND-CHAR
+OPEN-CHAR CLOSE-CHAR). The characters OPEN-CHAR and CLOSE-CHAR
+of the pair whose key is equal to the last input character with
+or without modifiers, are inserted by `insert-pair'.")
+
+(defun insert-pair (&optional arg open close)
"Enclose following ARG sexps in a pair of OPEN and CLOSE characters.
Leave point after the first character.
A negative ARG encloses the preceding ARG sexps instead.
and leave point between.
If `parens-require-spaces' is non-nil, this command also inserts a space
before and after, depending on the surrounding characters.
-If region is active, insert enclosing characters at region boundaries."
+If region is active, insert enclosing characters at region boundaries.
+
+If arguments OPEN and CLOSE are nil, the character pair is found
+from the variable `insert-pair-alist' according to the last input
+character with or without modifiers. If no character pair is
+found in the variable `insert-pair-alist', then the last input
+character is inserted ARG times."
(interactive "P")
- (if arg (setq arg (prefix-numeric-value arg))
- (setq arg 0))
- (or open (setq open ?\())
- (or close (setq close ?\)))
- (if (and transient-mark-mode mark-active)
- (progn
- (save-excursion (goto-char (region-end)) (insert close))
- (save-excursion (goto-char (region-beginning)) (insert open)))
- (cond ((> arg 0) (skip-chars-forward " \t"))
- ((< arg 0) (forward-sexp arg) (setq arg (- arg))))
- (and parens-require-spaces
- (not (bobp))
- (memq (char-syntax (preceding-char)) (list ?w ?_ (char-syntax close)))
- (insert " "))
- (insert open)
- (save-excursion
- (or (eq arg 0) (forward-sexp arg))
- (insert close)
- (and parens-require-spaces
- (not (eobp))
- (memq (char-syntax (following-char)) (list ?w ?_ (char-syntax open)))
- (insert " ")))))
-
-(defun insert-parentheses (arg)
+ (if (not (and open close))
+ (let ((pair (or (assq last-command-char insert-pair-alist)
+ (assq (event-basic-type last-command-event)
+ insert-pair-alist))))
+ (if pair
+ (if (nth 2 pair)
+ (setq open (nth 1 pair) close (nth 2 pair))
+ (setq open (nth 0 pair) close (nth 1 pair))))))
+ (if (and open close)
+ (if (and transient-mark-mode mark-active)
+ (progn
+ (save-excursion (goto-char (region-end)) (insert close))
+ (save-excursion (goto-char (region-beginning)) (insert open)))
+ (if arg (setq arg (prefix-numeric-value arg))
+ (setq arg 0))
+ (cond ((> arg 0) (skip-chars-forward " \t"))
+ ((< arg 0) (forward-sexp arg) (setq arg (- arg))))
+ (and parens-require-spaces
+ (not (bobp))
+ (memq (char-syntax (preceding-char)) (list ?w ?_ (char-syntax close)))
+ (insert " "))
+ (insert open)
+ (save-excursion
+ (or (eq arg 0) (forward-sexp arg))
+ (insert close)
+ (and parens-require-spaces
+ (not (eobp))
+ (memq (char-syntax (following-char)) (list ?w ?_ (char-syntax open)))
+ (insert " "))))
+ (insert-char (event-basic-type last-command-event)
+ (prefix-numeric-value arg))))
+
+(defun insert-parentheses (&optional arg)
"Enclose following ARG sexps in parentheses. Leave point after open-paren.
A negative ARG encloses the preceding ARG sexps instead.
No argument is equivalent to zero: just insert `()' and leave point between.
(interactive "P")
(insert-pair arg ?\( ?\)))
+(defun delete-pair ()
+ "Delete a pair of characters enclosing the sexp that follows point."
+ (interactive)
+ (save-excursion (forward-sexp 1) (delete-char -1))
+ (delete-char 1))
+
+(defun raise-sexp (&optional arg)
+ "Raise ARG sexps higher up the tree."
+ (interactive "p")
+ (let ((s (if (and transient-mark-mode mark-active)
+ (buffer-substring (region-beginning) (region-end))
+ (buffer-substring
+ (point)
+ (save-excursion (forward-sexp arg) (point))))))
+ (backward-up-list 1)
+ (delete-region (point) (save-excursion (forward-sexp 1) (point)))
+ (save-excursion (insert s))))
+
(defun move-past-close-and-reindent ()
"Move past next `)', delete indentation before it, then indent after it."
(interactive)