diff lisp/emacs-lisp/lisp.el @ 89943:4c90ffeb71c5

Revision: [e-mail]--gnu-2004/emacs--unicode--0--patch-15 Merge from emacs--cvs-trunk--0 Patches applied: * [e-mail]--gnu-2004/emacs--cvs-trunk--0--patch-218 - [e-mail]--gnu-2004/emacs--cvs-trunk--0--patch-220 Update from CVS * [e-mail]--gnu-2004/emacs--cvs-trunk--0--patch-221 Restore deleted tagline in etc/TUTORIAL.ru * [e-mail]--gnu-2004/emacs--cvs-trunk--0--patch-222 - [e-mail]--gnu-2004/emacs--cvs-trunk--0--patch-228 Update from CVS * [e-mail]--gnu-2004/emacs--cvs-trunk--0--patch-229 Remove TeX output files from the archive * [e-mail]--gnu-2004/emacs--cvs-trunk--0--patch-230 - [e-mail]--gnu-2004/emacs--cvs-trunk--0--patch-247 Update from CVS * [e-mail]--gnu-2004/emacs--cvs-trunk--0--patch-248 src/lisp.h (CYCLE_CHECK): Macro moved from xfaces.c * [e-mail]--gnu-2004/emacs--cvs-trunk--0--patch-249 - [e-mail]--gnu-2004/emacs--cvs-trunk--0--patch-256 Update from CVS * [e-mail]--gnu-2004/emacs--cvs-trunk--0--patch-258 - [e-mail]--gnu-2004/emacs--cvs-trunk--0--patch-263 Update from CVS * [e-mail]--gnu-2004/emacs--cvs-trunk--0--patch-264 Update from CVS: lispref/display.texi: emacs -> Emacs. * [e-mail]--gnu-2004/emacs--cvs-trunk--0--patch-265 - [e-mail]--gnu-2004/emacs--cvs-trunk--0--patch-274 Update from CVS * [e-mail]--gnu-2004/emacs--cvs-trunk--0--patch-275 Update from CVS: man/makefile.w32-in: Revert last change * [e-mail]--gnu-2004/emacs--cvs-trunk--0--patch-276 - [e-mail]--gnu-2004/emacs--cvs-trunk--0--patch-295 Update from CVS * [e-mail]--gnu-2004/emacs--cvs-trunk--0--patch-296 Allow restarting an existing debugger session that's exited * [e-mail]--gnu-2004/emacs--cvs-trunk--0--patch-297 - [e-mail]--gnu-2004/emacs--cvs-trunk--0--patch-299 Update from CVS * [e-mail]--gnu-2004/emacs--cvs-trunk--0--patch-300 - [e-mail]--gnu-2004/emacs--cvs-trunk--0--patch-327 Update from CVS * [e-mail]--gnu-2004/emacs--cvs-trunk--0--patch-328 Update from CVS: src/.gdbinit (xsymbol): Fix last change. * [e-mail]--gnu-2004/emacs--cvs-trunk--0--patch-329 - [e-mail]--gnu-2004/emacs--cvs-trunk--0--patch-344 Update from CVS * [e-mail]--gnu-2004/emacs--cvs-trunk--0--patch-345 Tweak source regexps so that building in place won't cause problems * [e-mail]--gnu-2004/emacs--cvs-trunk--0--patch-346 - [e-mail]--gnu-2004/emacs--cvs-trunk--0--patch-351 Update from CVS * [e-mail]--gnu-2004/emacs--cvs-trunk--0--patch-352 Update from CVS: lisp/flymake.el: New file. * [e-mail]--gnu-2004/emacs--cvs-trunk--0--patch-353 - [e-mail]--gnu-2004/emacs--cvs-trunk--0--patch-361 Update from CVS * [e-mail]--gnu-2004/emacs--cvs-trunk--0--patch-362 Support " [...]" style defaults in minibuffer-electric-default-mode * [e-mail]--gnu-2004/emacs--cvs-trunk--0--patch-363 (read-number): Use canonical format for default in prompt. * [e-mail]--gnu-2004/emacs--cvs-trunk--0--patch-364 - [e-mail]--gnu-2004/emacs--cvs-trunk--0--patch-367 Update from CVS * [e-mail]--gnu-2004/emacs--cvs-trunk--0--patch-368 Improve display-supports-face-attributes-p on non-ttys * [e-mail]--gnu-2004/emacs--cvs-trunk--0--patch-369 Rewrite face-differs-from-default-p * [e-mail]--gnu-2004/emacs--cvs-trunk--0--patch-370 Move `display-supports-face-attributes-p' entirely into C code * [e-mail]--gnu-2004/emacs--cvs-trunk--0--patch-371 Update from CVS * [e-mail]--gnu-2004/emacs--cvs-trunk--0--patch-372 Simplify face-differs-from-default-p; don't consider :stipple. * [e-mail]--gnu-2004/emacs--cvs-trunk--0--patch-373 Update from CVS * [e-mail]--gnu-2004/emacs--cvs-trunk--0--patch-374 (tty_supports_face_attributes_p): Ensure attributes differ from default * [e-mail]--gnu-2004/emacs--cvs-trunk--0--patch-375 - [e-mail]--gnu-2004/emacs--cvs-trunk--0--patch-376 Update from CVS * [e-mail]--gnu-2004/emacs--cvs-trunk--0--patch-377 (Fdisplay_supports_face_attributes_p): Work around bootstrapping problem * [e-mail]--gnu-2004/emacs--cvs-trunk--0--patch-378 - [e-mail]--gnu-2004/emacs--cvs-trunk--0--patch-380 Update from CVS * [e-mail]--gnu-2004/emacs--cvs-trunk--0--patch-381 Face merging cleanups * [e-mail]--gnu-2004/emacs--cvs-trunk--0--patch-382 - [e-mail]--gnu-2004/emacs--cvs-trunk--0--patch-384 Update from CVS * [e-mail]--gnu-2004/emacs--cvs-trunk--0--patch-385 src/xfaces.c (push_named_merge_point): Return 0 if a cycle is detected * [e-mail]--gnu-2004/emacs--cvs-trunk--0--patch-386 - [e-mail]--gnu-2004/emacs--cvs-trunk--0--patch-395 Update from CVS * [e-mail]--gnu-2004/emacs--cvs-trunk--0--patch-396 Tweak arch tagging to make build/install-in-place less annoying * [e-mail]--gnu-2004/emacs--cvs-trunk--0--patch-397 Work around vc-arch problems when building eshell * [e-mail]--gnu-2004/emacs--cvs-trunk--0--patch-398 Tweak permissions * [e-mail]--gnu-2004/emacs--cvs-trunk--0--patch-399 Tweak directory permissions * [e-mail]--gnu-2004/emacs--cvs-trunk--0--patch-400 Update from CVS * [e-mail]--gnu-2004/emacs--cvs-trunk--0--patch-401 More build-in-place tweaking of arch tagging * [e-mail]--gnu-2004/emacs--cvs-trunk--0--patch-402 Update from CVS * [e-mail]--gnu-2004/emacs--cvs-trunk--0--patch-403 Yet more build-in-place tweaking of arch tagging * [e-mail]--gnu-2004/emacs--cvs-trunk--0--patch-404 - [e-mail]--gnu-2004/emacs--cvs-trunk--0--patch-409 Update from CVS * [e-mail]--gnu-2004/emacs--cvs-trunk--0--patch-410 Make sure image types are initialized for lookup too * [e-mail]--gnu-2004/emacs--cvs-trunk--0--patch-411 - [e-mail]--gnu-2004/emacs--cvs-trunk--0--patch-416 Update from CVS

--- a/lisp/emacs-lisp/lisp.el	Sat May 29 02:17:09 2004 +0000
+++ b/lisp/emacs-lisp/lisp.el	Mon Jun 28 07:56:49 2004 +0000
@@ -175,6 +175,8 @@
 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)))
   (and (beginning-of-defun-raw arg)
        (progn (beginning-of-line) t)))
 
@@ -223,6 +225,8 @@
 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)))
   (if (or (null arg) (= arg 0)) (setq arg 1))
   (if end-of-defun-function
       (if (> arg 0)
@@ -277,15 +281,31 @@
 	    (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.
@@ -294,37 +314,112 @@
   (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)))))
+      (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.
+No argument is equivalent to zero: just insert characters
+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.
 
-(defun insert-parentheses (arg)
+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 (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.
 If `parens-require-spaces' is non-nil, this command also inserts a space
-before and after, depending on the surrounding characters."
+before and after, depending on the surrounding characters.
+If region is active, insert enclosing characters at region boundaries."
   (interactive "P")
-  (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)) '(?w ?_ ?\) ))
-       (insert " "))
-  (insert ?\()
-  (save-excursion
-    (or (eq arg 0) (forward-sexp arg))
-    (insert ?\))
-    (and parens-require-spaces
-	 (not (eobp))
-	 (memq (char-syntax (following-char)) '(?w ?_ ?\( ))
-	 (insert " "))))
+  (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."