diff lisp/subr.el @ 83561:dc002877ce12

Merged from emacs@sv.gnu.org Patches applied: * emacs@sv.gnu.org/emacs--devo--0--patch-674 Merge from gnus--rel--5.10 * emacs@sv.gnu.org/emacs--devo--0--patch-675 Update from CVS * emacs@sv.gnu.org/emacs--devo--0--patch-676 Update from CVS * emacs@sv.gnu.org/emacs--devo--0--patch-677 Update from CVS * emacs@sv.gnu.org/emacs--devo--0--patch-678 Update from CVS * emacs@sv.gnu.org/emacs--devo--0--patch-679 Update from CVS * emacs@sv.gnu.org/emacs--devo--0--patch-680 Update from CVS * emacs@sv.gnu.org/emacs--devo--0--patch-681 Update from CVS * emacs@sv.gnu.org/emacs--devo--0--patch-682 Update from CVS * emacs@sv.gnu.org/emacs--devo--0--patch-683 Update from CVS * emacs@sv.gnu.org/emacs--devo--0--patch-684 Update from CVS * emacs@sv.gnu.org/emacs--devo--0--patch-685 Merge from gnus--rel--5.10 * emacs@sv.gnu.org/emacs--devo--0--patch-686 Update from CVS * emacs@sv.gnu.org/emacs--devo--0--patch-687 Release ERC 5.2. * emacs@sv.gnu.org/emacs--devo--0--patch-688 Update from CVS * emacs@sv.gnu.org/emacs--devo--0--patch-689 Update from CVS * emacs@sv.gnu.org/emacs--devo--0--patch-690 Update from CVS * emacs@sv.gnu.org/emacs--devo--0--patch-691 Update from CVS * emacs@sv.gnu.org/emacs--devo--0--patch-692 Update from CVS * emacs@sv.gnu.org/emacs--devo--0--patch-693 Update from CVS * emacs@sv.gnu.org/emacs--devo--0--patch-694 Update from CVS * emacs@sv.gnu.org/emacs--devo--0--patch-695 Merge from gnus--rel--5.10 * emacs@sv.gnu.org/emacs--devo--0--patch-696 Update from CVS * emacs@sv.gnu.org/emacs--devo--0--patch-697 Merge from gnus--rel--5.10 * emacs@sv.gnu.org/emacs--devo--0--patch-698 Update from CVS * emacs@sv.gnu.org/emacs--devo--0--patch-699 Update from CVS * emacs@sv.gnu.org/emacs--devo--0--patch-700 Update from CVS * emacs@sv.gnu.org/emacs--devo--0--patch-701 Update from CVS * emacs@sv.gnu.org/gnus--rel--5.10--patch-209 Merge from emacs--devo--0 * emacs@sv.gnu.org/gnus--rel--5.10--patch-210 Update from CVS * emacs@sv.gnu.org/gnus--rel--5.10--patch-211 Update from CVS * emacs@sv.gnu.org/gnus--rel--5.10--patch-212 Merge from emacs--devo--0 * emacs@sv.gnu.org/gnus--rel--5.10--patch-213 Update from CVS * emacs@sv.gnu.org/gnus--rel--5.10--patch-214 Merge from emacs--devo--0 * emacs@sv.gnu.org/gnus--rel--5.10--patch-215 Update from CVS git-archimport-id: lorentey@elte.hu--2004/emacs--multi-tty--0--patch-601
author Karoly Lorentey <karoly@lorentey.hu>
date Sun, 22 Apr 2007 12:42:47 +0000
parents 738ce3540ffb 055a54275ec3
children 41aaac7180d5
line wrap: on
line diff
--- a/lisp/subr.el	Sun Apr 22 12:12:29 2007 +0000
+++ b/lisp/subr.el	Sun Apr 22 12:42:47 2007 +0000
@@ -579,7 +579,7 @@
 ;;;; substitute-key-definition and its subroutines.
 
 (defvar key-substitution-in-progress nil
- "Used internally by `substitute-key-definition'.")
+  "Used internally by `substitute-key-definition'.")
 
 (defun substitute-key-definition (olddef newdef keymap &optional oldmap prefix)
   "Replace OLDDEF with NEWDEF for any keys in KEYMAP now defined as OLDDEF.
@@ -821,11 +821,11 @@
 (defun posn-set-point (position)
   "Move point to POSITION.
 Select the corresponding window as well."
-    (if (not (windowp (posn-window position)))
-	(error "Position not in text area of window"))
-    (select-window (posn-window position))
-    (if (numberp (posn-point position))
-	(goto-char (posn-point position))))
+  (if (not (windowp (posn-window position)))
+      (error "Position not in text area of window"))
+  (select-window (posn-window position))
+  (if (numberp (posn-point position))
+      (goto-char (posn-point position))))
 
 (defsubst posn-x-y (position)
   "Return the x and y coordinates in POSITION.
@@ -949,20 +949,26 @@
 ;;;; Obsolescence declarations for variables, and aliases.
 
 (make-obsolete-variable 'directory-sep-char "do not use it." "21.1")
-(make-obsolete-variable 'mode-line-inverse-video "use the appropriate faces instead." "21.1")
-(make-obsolete-variable 'unread-command-char
-  "use `unread-command-events' instead.  That variable is a list of events
+(make-obsolete-variable
+ 'mode-line-inverse-video
+ "use the appropriate faces instead."
+ "21.1")
+(make-obsolete-variable
+ 'unread-command-char
+ "use `unread-command-events' instead.  That variable is a list of events
 to reread, so it now uses nil to mean `no event', instead of -1."
-  "before 19.15")
+ "before 19.15")
 
 ;; Lisp manual only updated in 22.1.
 (define-obsolete-variable-alias 'executing-macro 'executing-kbd-macro
-			      "before 19.34")
+  "before 19.34")
 
 (defvaralias 'x-lost-selection-hooks 'x-lost-selection-functions)
-(make-obsolete-variable 'x-lost-selection-hooks 'x-lost-selection-functions "22.1")
+(make-obsolete-variable 'x-lost-selection-hooks
+			'x-lost-selection-functions "22.1")
 (defvaralias 'x-sent-selection-hooks 'x-sent-selection-functions)
-(make-obsolete-variable 'x-sent-selection-hooks 'x-sent-selection-functions "22.1")
+(make-obsolete-variable 'x-sent-selection-hooks
+			'x-sent-selection-functions "22.1")
 
 (defvaralias 'messages-buffer-max-lines 'message-log-max)
 
@@ -1534,7 +1540,7 @@
 
 (when (featurep 'make-network-process)
   (defun open-network-stream (name buffer host service)
-  "Open a TCP connection for a service to a host.
+    "Open a TCP connection for a service to a host.
 Returns a subprocess-object to represent the connection.
 Input and output work as for subprocesses; `delete-process' closes it.
 
@@ -1548,14 +1554,15 @@
 HOST is name of the host to connect to, or its IP address.
 SERVICE is name of the service desired, or an integer specifying
  a port number to connect to."
-  (make-network-process :name name :buffer buffer
-			:host host :service service)))
+    (make-network-process :name name :buffer buffer
+				     :host host :service service)))
 
 ;; compatibility
 
-(make-obsolete 'process-kill-without-query
-               "use `process-query-on-exit-flag' or `set-process-query-on-exit-flag'."
-               "22.1")
+(make-obsolete
+ 'process-kill-without-query
+ "use `process-query-on-exit-flag' or `set-process-query-on-exit-flag'."
+ "22.1")
 (defun process-kill-without-query (process &optional flag)
   "Say no query needed if PROCESS is running when Emacs is exited.
 Optional second argument if non-nil says to require a query.
@@ -1588,8 +1595,8 @@
  'read-quoted-char-radix 8
  "*Radix for \\[quoted-insert] and other uses of `read-quoted-char'.
 Legitimate radix values are 8, 10 and 16."
-  :type '(choice (const 8) (const 10) (const 16))
-  :group 'editing-basics)
+ :type '(choice (const 8) (const 10) (const 16))
+ :group 'editing-basics)
 
 (defun read-quoted-char (&optional prompt)
   "Like `read-char', but do not allow quitting.
@@ -2232,9 +2239,9 @@
 	     (text-properties-at (1- end)))
 	(put-text-property (1- end) end 'rear-nonsticky t))
 
-    (if (eq yank-undo-function t)  ;; not set by FUNCTION
+    (if (eq yank-undo-function t)		   ;; not set by FUNCTION
 	(setq yank-undo-function (nth 3 handler))) ;; UNDO
-    (if (nth 4 handler) ;; COMMAND
+    (if (nth 4 handler)				   ;; COMMAND
 	(setq this-command (nth 4 handler)))))
 
 (defun insert-buffer-substring-no-properties (buffer &optional start end)
@@ -2497,6 +2504,20 @@
        (let ((combine-after-change-calls t))
 	 . ,body)
      (combine-after-change-execute)))
+
+(defmacro with-case-table (table &rest body)
+  "Execute the forms in BODY with TABLE as the current case table.
+The value returned is the value of the last form in BODY."
+  (declare (indent 1) (debug t))
+  (let ((old-case-table (make-symbol "table"))
+	(old-buffer (make-symbol "buffer")))
+    `(let ((,old-case-table (current-case-table))
+	   (,old-buffer (current-buffer)))
+       (unwind-protect
+	   (progn (set-case-table ,table)
+		  ,@body)
+	 (with-current-buffer ,old-buffer
+	   (set-case-table ,old-case-table))))))
 
 ;;;; Constructing completion tables.
 
@@ -2765,7 +2786,7 @@
     newstr))
 
 (defun replace-regexp-in-string (regexp rep string &optional
-                                 fixedcase literal subexp start)
+					fixedcase literal subexp start)
   "Replace all matches for REGEXP with REP in STRING.
 
 Return a new string containing the replacements.
@@ -2815,7 +2836,7 @@
 				       rep
 				     (funcall rep (match-string 0 str)))
 				   fixedcase literal str subexp)
-		    (cons (substring string start mb)       ; unmatched prefix
+		    (cons (substring string start mb) ; unmatched prefix
 			  matches)))
 	(setq start me))
       ;; Reconstruct a string from the pieces.
@@ -2836,7 +2857,8 @@
 (defun remove-from-invisibility-spec (element)
   "Remove ELEMENT from `buffer-invisibility-spec'."
   (if (consp buffer-invisibility-spec)
-    (setq buffer-invisibility-spec (delete element buffer-invisibility-spec))))
+      (setq buffer-invisibility-spec
+	    (delete element buffer-invisibility-spec))))
 
 ;;;; Syntax tables.
 
@@ -3182,7 +3204,7 @@
 
 (defvar version-regexp-alist
   '(("^[-_+ ]?a\\(lpha\\)?$"   . -3)
-    ("^[-_+]$"                 . -3)	; treat "1.2.3-20050920" and "1.2-3" as alpha releases
+    ("^[-_+]$"                 . -3) ; treat "1.2.3-20050920" and "1.2-3" as alpha releases
     ("^[-_+ ]cvs$"             . -3)	; treat "1.2.3-CVS" as alpha release
     ("^[-_+ ]?b\\(eta\\)?$"    . -2)
     ("^[-_+ ]?\\(pre\\|rc\\)$" . -1))
@@ -3256,7 +3278,7 @@
   ;; Change .x.y to 0.x.y
   (if (and (>= (length ver) (length version-separator))
 	   (string-equal (substring ver 0 (length version-separator))
-		    version-separator))
+			 version-separator))
       (setq ver (concat "0" ver)))
   (save-match-data
     (let ((i 0)