Merge from trunk.

autogen/config.in

@@ -1278,16 +1278,6 @@ along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.  */
 /* Turned on June 1996 supposing nobody will mind it.  */
 #define AMPERSAND_FULL_NAME
 
-/* If using GNU, then support inline function declarations.  */
-/* Don't try to switch on inline handling as detected by AC_C_INLINE
-   generally, because even if non-gcc compilers accept `inline', they
-   may reject `extern inline'.  */
-#if defined (__GNUC__)
-#define INLINE __inline__
-#else
-#define INLINE
-#endif
-
 /* `subprocesses' should be defined if you want to
    have code for asynchronous subprocesses
    (as used in M-x compile and M-x shell).

doc/lispref/ChangeLog

@@ -1,3 +1,8 @@
+2011-05-31  Lars Magne Ingebrigtsen  <larsi@gnus.org>
+
+	* processes.texi (Process Information): Document
+	`process-alive-p'.
+
 2011-05-29  Chong Yidong  <cyd@stupidchicken.com>
 
 	* help.texi (Accessing Documentation):

doc/lispref/processes.texi

@@ -859,6 +859,12 @@ For a network connection, @code{process-status} returns one of the symbols
 closed the connection, or Emacs did @code{delete-process}.
 @end defun
 
+@defun process-alive-p process
+This function returns nin-@code{nil} if @var{process} is alive.  A
+process is considered alive if its status is @code{run}, @code{open},
+@code{listen}, @code{connect} or @code{stop}.
+@end defun
+
 @defun process-type process
 This function returns the symbol @code{network} for a network
 connection or server, @code{serial} for a serial port connection, or

doc/misc/ChangeLog

@@ -1,3 +1,9 @@
+2011-05-31  Teodor Zlatanov  <tzz@lifelogs.com>
+
+	* gnus.texi (Store custom flags and keywords): Refer to
+	`gnus-registry-article-marks-to-{chars,names}' instead of
+	`gnus-registry-user-format-function-{M,M2}'.
+
 2011-05-18  Teodor Zlatanov  <tzz@lifelogs.com>
 
 	* gnus.texi (Gnus Registry Setup): Rename from "Setup".

doc/misc/gnus.texi

@@ -26094,10 +26094,10 @@ their @code{:char} property, or showing the marks as full strings.
 @lisp
 ;; show the marks as single characters (see the :char property in
 ;; `gnus-registry-marks'):
-;; (defalias 'gnus-user-format-function-M 'gnus-registry-user-format-function-M)
+;; (defalias 'gnus-user-format-function-M 'gnus-registry-article-marks-to-chars)
 
 ;; show the marks by name (see `gnus-registry-marks'):
-;; (defalias 'gnus-user-format-function-M 'gnus-registry-user-format-function-M2)
+;; (defalias 'gnus-user-format-function-M 'gnus-registry-article-marks-to-names)
 @end lisp
 
 

etc/NEWS

@@ -68,6 +68,10 @@ and also when HOME is set to C:\ by default.
 
 * Changes in Emacs 24.1
 
+** The inactive minibuffer has its own major mode `minibuffer-inactive-mode'.
+This is handy for minibuffer-only frames, and is also used for the "mouse-1
+pops up *Messages*" feature, which can now easily be changed.
+
 ** emacsclient changes
 
 *** New emacsclient argument --parent-id ID can be used to open a

lib-src/ChangeLog

@@ -1,3 +1,7 @@
+2011-06-01  Dan Nicolaescu  <dann@ics.uci.edu>
+
+	* emacsclient.c (socket_status): Use constant pointer.
+
 2011-05-28  Paul Eggert  <eggert@cs.ucla.edu>
 
 	Use 'inline', not 'INLINE'.

lib-src/emacsclient.c

@@ -1098,7 +1098,7 @@ find_tty (const char **tty_type, const char **tty_name, int noabort)
    0 - success: none of the above */
 
 static int
-socket_status (char *name)
+socket_status (const char *name)
 {
   struct stat statbfr;
 

lib/getopt_.h

@@ -279,5 +279,5 @@ extern int getopt_long_only (int ___argc, char *__getopt_argv_const *___argv,
 /* Make sure we later can get all the definitions and declarations.  */
 #undef __need_getopt
 
-#endif /* getopt.h */
+#endif /* _GL_GETOPT_H */
-#endif /* getopt.h */
+#endif /* _GL_GETOPT_H */

lisp/ChangeLog

@@ -1,3 +1,109 @@
+2011-06-02  Stefan Monnier  <monnier@iro.umontreal.ca>
+
+	* net/tramp.el (tramp-with-progress-reporter): Rename from
+	with-progress-reporter.  Use `declare'.
+	* net/tramp-smb.el:
+	* net/tramp-sh.el:
+	* net/tramp-gvfs.el: Update all uses.
+
+2011-06-02  Jay Belanger  <jay.p.belanger@gmail.com>
+
+	* calc/calc.el (calc-kill-stack-buffer): Make sure that the trail
+	buffer isn't killed before making it current.
+
+2011-06-01  Stefan Monnier  <monnier@iro.umontreal.ca>
+
+	Silence various byte-compiler warnings.
+	* emacs-lisp/byte-run.el (make-obsolete-variable): New argument
+	`access-type' and new obsolescence format.
+	* emacs-lisp/bytecomp.el (byte-compile-warn-obsolete): Adjust to
+	new format.
+	(byte-compile-check-variable): New `access-type' argument.
+	Only warn if the access-type is obsolete.
+	(byte-compile-dynamic-variable-bind, byte-compile-variable-ref)
+	(byte-compile-variable-set): Adjust callers.
+	* help-fns.el (describe-variable): Adjust to new obsolescence format.
+	* mail/sendmail.el (mail-mailer-swallows-blank-line): Only mark
+	setting it as obsolete.
+	* simple.el (minibuffer-completing-symbol):
+	* font-lock.el (font-lock-beginning-of-syntax-function): Only mark read
+	access as obsolete.
+	* minibuffer.el (minibuffer-completing-file-name): Don't make it
+	obsolete yet.
+	* international/quail.el (quail-mouse-choose-completion): Remove unused
+	code referring to obsolete var.
+	(quail-choose-completion-string): Remove.
+	* server.el (server-clients-with, server-kill-buffer-query-function)
+	(server-kill-emacs-query-function): Silence "unused `proc'" warnings.
+	* proced.el (proced-send-signal):
+	* emacs-lisp/lisp.el (lisp-complete-symbol):
+	Replace completion-annotate-function with completion-extra-properties.
+
+2011-06-01  Stefan Monnier  <monnier@iro.umontreal.ca>
+
+	* simple.el (goto-line): Use read-number.
+	(overriding-map-is-bound): Remove.
+	(saved-overriding-map): Change default.
+	(save&set-overriding-map): Rename from ensure-overriding-map-is-bound;
+	Take the map as argument.
+	(universal-argument, negative-argument, digit-argument): Use it.
+	(restore-overriding-map): Adjust.
+	(do-auto-fill): Use fill-forward-paragraph.
+	(keyboard-quit): Don't signal an error when debug-on-quit is non-nil.
+
+	* minibuffer.el (minibuffer-inactive-mode-map): New var.
+	(minibuffer-inactive-mode): New major mode.
+	* mouse.el (mouse-drag-region): Remove the "mouse-1 pops up
+	the *Messages* buffer" hack.
+	(mouse-popup-menubar): Don't burp if the event is a normal key.
+
+	Miscellaneous tweaks.
+	* emacs-lisp/cl-macs.el (dolist, dotimes): Use the same strategy for
+	lexical scoping as in subr.el's dolist and dotimes.
+	* emacs-lisp/bytecomp.el (byte-compile-unfold-bcf):
+	Silence compiler warning.
+	* thingatpt.el (forward-whitespace): Trivial coding style fix.
+	* subr.el (with-output-to-temp-buffer): Provide an edebug spec.
+	* international/ccl.el (ccl-compile): Trivial simplification.
+	* help-fns.el (help-do-arg-highlight): Silence compiler warning.
+	* emacs-lisp/testcover.el (testcover-end): Remove spurious
+	`printflag' argument.
+	* emacs-lisp/byte-run.el (make-obsolete, make-obsolete-variable):
+	Purecopy the whole obsolescence data.
+
+2011-06-01  Leo Liu  <sdl.web@gmail.com>
+
+	* net/rcirc.el (rcirc-decode-coding-system): Revert last change;
+	improve doc-string as suggested by Marco Pessotto
+	<melmothx@gmail.com>.
+	(rcirc-print): Fix last change.
+
+2011-05-31  Stefan Monnier  <monnier@iro.umontreal.ca>
+
+	* minibuffer.el (complete-with-action): Return nil for the metadata and
+	boundaries of non-functional tables.
+	(completion-table-dynamic): Return nil for the metadata.
+	(completion-table-with-terminator): Add default case, using
+	complete-with-action.
+	(completion--metadata): New function.
+	(completion-all-sorted-completions, minibuffer-completion-help): Use it
+	to try and avoid pathological performance problems.
+	(completion--embedded-envvar-table): Return `category' metadata.
+
+2011-05-31  Lars Magne Ingebrigtsen  <larsi@gnus.org>
+
+	* subr.el (process-alive-p): New tiny convenience function.
+
+2011-05-31  Stefan Monnier  <monnier@iro.umontreal.ca>
+
+	* emacs-lisp/debug.el (debug): Save&restore not just the buffer's
+	content but also its previous major mode.
+
+2011-05-31  Helmut Eller  <eller.helmut@gmail.com>
+
+	* debug.el (debug): Restore the previous content of the
+	*Backtrace* buffer when we exit with C-M-c.
+
 2011-05-31  Stefan Monnier  <monnier@iro.umontreal.ca>
 
 	* minibuffer.el: Add metadata method to completion tables.
@@ -30,6 +136,10 @@
 	(rcirc-decode-coding-system): Allow value nil for automatic coding
 	system detection.
 
+2011-06-01  Glenn Morris  <rgm@gnu.org>
+
+	* mail/emacsbug.el (report-emacs-bug-hook): Mailclient ignores From.
+
 2011-05-29  Chong Yidong  <cyd@stupidchicken.com>
 
 	* image.el (image-animate-max-time): Allow nil and t values.

lisp/calc/calc.el

@@ -1293,19 +1293,20 @@ the trail buffer."
     (if (not info-list)
         (progn
           (setq calc-buffer-list (delete cb calc-buffer-list))
-          (with-current-buffer calc-trail-buffer
+          (if (buffer-live-p calc-trail-buffer)
-            (if (eq cb calc-main-buffer)
+              (with-current-buffer calc-trail-buffer
-                ;; If there are other Calc stacks, make another one
+                (if (eq cb calc-main-buffer)
-                ;; the calc-main-buffer ...
+                    ;; If there are other Calc stacks, make another one
-                (if calc-buffer-list
+                    ;; the calc-main-buffer ...
-                    (setq calc-main-buffer (car calc-buffer-list))
+                    (if calc-buffer-list
-                  ;; ... otherwise kill the trail and its windows.
+                        (setq calc-main-buffer (car calc-buffer-list))
-                  (let ((wl (get-buffer-window-list calc-trail-buffer)))
+                      ;; ... otherwise kill the trail and its windows.
-                    (while wl
+                      (let ((wl (get-buffer-window-list calc-trail-buffer)))
-                      (delete-window (car wl))
+                        (while wl
-                      (setq wl (cdr wl))))
+                          (delete-window (car wl))
-                  (kill-buffer calc-trail-buffer)
+                          (setq wl (cdr wl))))
-                  (setq calc-trail-buffer nil))))
+                      (kill-buffer calc-trail-buffer)))))
+          (setq calc-trail-buffer nil)
           t))))
 
 (defun calc-mode ()

lisp/emacs-lisp/byte-run.el

@@ -120,13 +120,13 @@ convention was modified."
 The warning will say that CURRENT-NAME should be used instead.
 If CURRENT-NAME is a string, that is the `use instead' message
 \(it should end with a period, and not start with a capital).
-If provided, WHEN should be a string indicating when the function
+WHEN should be a string indicating when the function
 was first made obsolete, for example a date or a release number."
   (interactive "aMake function obsolete: \nxObsoletion replacement: ")
   (put obsolete-name 'byte-obsolete-info
        ;; The second entry used to hold the `byte-compile' handler, but
        ;; is not used any more nowadays.
-       (list (purecopy current-name) nil (purecopy when)))
+       (purecopy (list current-name nil when)))
   obsolete-name)
 (set-advertised-calling-convention
  ;; New code should always provide the `when' argument.
@@ -153,27 +153,21 @@ See the docstrings of `defalias' and `make-obsolete' for more details."
  'define-obsolete-function-alias
  '(obsolete-name current-name when &optional docstring) "23.1")
 
-(defun make-obsolete-variable (obsolete-name current-name &optional when)
+(defun make-obsolete-variable (obsolete-name current-name &optional when access-type)
   "Make the byte-compiler warn that OBSOLETE-NAME is obsolete.
 The warning will say that CURRENT-NAME should be used instead.
 If CURRENT-NAME is a string, that is the `use instead' message.
-If provided, WHEN should be a string indicating when the variable
+WHEN should be a string indicating when the variable
-was first made obsolete, for example a date or a release number."
+was first made obsolete, for example a date or a release number.
-  (interactive
+ACCESS-TYPE if non-nil should specify the kind of access that will trigger
-   (list
+  obsolescence warnings; it can be either `get' or `set'."
-    (let ((str (completing-read "Make variable obsolete: " obarray 'boundp t)))
-      (if (equal str "") (error ""))
-      (intern str))
-    (car (read-from-string (read-string "Obsoletion replacement: ")))))
   (put obsolete-name 'byte-obsolete-variable
-       (cons
+       (purecopy (list current-name access-type when)))
-	(if (stringp current-name)
-	    (purecopy current-name)
-	  current-name) (purecopy when)))
   obsolete-name)
 (set-advertised-calling-convention
  ;; New code should always provide the `when' argument.
- 'make-obsolete-variable '(obsolete-name current-name when) "23.1")
+ 'make-obsolete-variable
+ '(obsolete-name current-name when &optional access-type) "23.1")
 
 (defmacro define-obsolete-variable-alias (obsolete-name current-name
 						 &optional when docstring)

lisp/emacs-lisp/bytecomp.el

@@ -1109,7 +1109,7 @@ Each function's symbol gets added to `byte-compile-noruntime-functions'."
     (let* ((funcp (get symbol 'byte-obsolete-info))
 	   (obsolete (or funcp (get symbol 'byte-obsolete-variable)))
 	   (instead (car obsolete))
-	   (asof (if funcp (nth 2 obsolete) (cdr obsolete))))
+	   (asof (nth 2 obsolete)))
       (unless (and funcp (memq symbol byte-compile-not-obsolete-funcs))
 	(byte-compile-warn "`%s' is an obsolete %s%s%s" symbol
 			   (if funcp "function" "variable")
@@ -2991,7 +2991,7 @@ That command is designed for interactive use only" fn))
     (cond
      ((<= (+ alen alen) fmax2)
       ;; Add missing &optional (or &rest) arguments.
-      (dotimes (i (- (/ (1+ fmax2) 2) alen))
+      (dotimes (_ (- (/ (1+ fmax2) 2) alen))
         (byte-compile-push-constant nil)))
      ((zerop (logand fmax2 1))
       (byte-compile-log-warning "Too many arguments for inlined function"
@@ -3016,20 +3016,24 @@ That command is designed for interactive use only" fn))
     (assert (eq byte-compile-depth (1+ start-depth))
             nil "Wrong depth start=%s end=%s" start-depth byte-compile-depth)))
 
-(defun byte-compile-check-variable (var &optional binding)
+(defun byte-compile-check-variable (var access-type)
-  "Do various error checks before a use of the variable VAR.
+  "Do various error checks before a use of the variable VAR."
-If BINDING is non-nil, VAR is being bound."
   (when (symbolp var)
     (byte-compile-set-symbol-position var))
   (cond ((or (not (symbolp var)) (byte-compile-const-symbol-p var))
 	 (when (byte-compile-warning-enabled-p 'constants)
-	   (byte-compile-warn (if binding
+	   (byte-compile-warn (if (eq access-type 'let-bind)
 				  "attempt to let-bind %s `%s`"
 				"variable reference to %s `%s'")
 			      (if (symbolp var) "constant" "nonvariable")
 			      (prin1-to-string var))))
-	((and (get var 'byte-obsolete-variable)
+	((let ((od (get var 'byte-obsolete-variable)))
-	      (not (memq var byte-compile-not-obsolete-vars)))
+           (and od
+                (not (memq var byte-compile-not-obsolete-vars))
+                (or (case (nth 1 od)
+                      (set (not (eq access-type 'reference)))
+                      (get (eq access-type 'reference))
+                      (t t)))))
 	 (byte-compile-warn-obsolete var))))
 
 (defsubst byte-compile-dynamic-variable-op (base-op var)
@@ -3041,13 +3045,13 @@ If BINDING is non-nil, VAR is being bound."
 
 (defun byte-compile-dynamic-variable-bind (var)
   "Generate code to bind the lexical variable VAR to the top-of-stack value."
-  (byte-compile-check-variable var t)
+  (byte-compile-check-variable var 'let-bind)
   (push var byte-compile-bound-variables)
   (byte-compile-dynamic-variable-op 'byte-varbind var))
 
 (defun byte-compile-variable-ref (var)
   "Generate code to push the value of the variable VAR on the stack."
-  (byte-compile-check-variable var)
+  (byte-compile-check-variable var 'reference)
   (let ((lex-binding (assq var byte-compile--lexical-environment)))
     (if lex-binding
 	;; VAR is lexically bound
@@ -3063,7 +3067,7 @@ If BINDING is non-nil, VAR is being bound."
 
 (defun byte-compile-variable-set (var)
   "Generate code to set the variable VAR from the top-of-stack value."
-  (byte-compile-check-variable var)
+  (byte-compile-check-variable var 'assign)
   (let ((lex-binding (assq var byte-compile--lexical-environment)))
     (if lex-binding
 	;; VAR is lexically bound

lisp/emacs-lisp/cconv.el

@@ -112,16 +112,6 @@
 ;;     ,@(mapcar (lambda (binder) (if (consp binder) (cadr binder)))
 ;;               binders)))
 
-;; (defmacro letrec (binders &rest body)
-;;   ;; Only useful in lexical-binding mode.
-;;   ;; As a special-form, we could implement it more efficiently (and cleanly,
-;;   ;; making the vars actually unbound during evaluation of the binders).
-;;   `(let ,(mapcar (lambda (binder) (if (consp binder) (car binder) binder))
-;;                  binders)
-;;      ,@(delq nil (mapcar (lambda (binder) (if (consp binder) `(setq ,@binder)))
-;;                          binders))
-;;      ,@body))
-
 (eval-when-compile (require 'cl))
 
 (defconst cconv-liftwhen 6

lisp/emacs-lisp/cl-macs.el

@@ -1236,14 +1236,29 @@ Then evaluate RESULT to get return value, default nil.
 
 \(fn (VAR LIST [RESULT]) BODY...)"
   (let ((temp (make-symbol "--cl-dolist-temp--")))
-    (list 'block nil
+    ;; FIXME: Copy&pasted from subr.el.
-	  (list* 'let (list (list temp (nth 1 spec)) (car spec))
+    `(block nil
-		 (list* 'while temp (list 'setq (car spec) (list 'car temp))
+       ;; This is not a reliable test, but it does not matter because both
-			(append body (list (list 'setq temp
+       ;; semantics are acceptable, tho one is slightly faster with dynamic
-						 (list 'cdr temp)))))
+       ;; scoping and the other is slightly faster (and has cleaner semantics)
-		 (if (cdr (cdr spec))
+       ;; with lexical scoping.
-		     (cons (list 'setq (car spec) nil) (cdr (cdr spec)))
+       ,(if lexical-binding
-		   '(nil))))))
+            `(let ((,temp ,(nth 1 spec)))
+               (while ,temp
+                 (let ((,(car spec) (car ,temp)))
+                   ,@body
+                   (setq ,temp (cdr ,temp))))
+               ,@(if (cdr (cdr spec))
+                     ;; FIXME: This let often leads to "unused var" warnings.
+                     `((let ((,(car spec) nil)) ,@(cdr (cdr spec))))))
+          `(let ((,temp ,(nth 1 spec))
+                 ,(car spec))
+             (while ,temp
+               (setq ,(car spec) (car ,temp))
+               ,@body
+               (setq ,temp (cdr ,temp)))
+             ,@(if (cdr (cdr spec))
+                   `((setq ,(car spec) nil) ,@(cddr spec))))))))
 
 ;;;###autoload
 (defmacro dotimes (spec &rest body)
@@ -1253,12 +1268,30 @@ to COUNT, exclusive.  Then evaluate RESULT to get return value, default
 nil.
 
 \(fn (VAR COUNT [RESULT]) BODY...)"
-  (let ((temp (make-symbol "--cl-dotimes-temp--")))
+  (let ((temp (make-symbol "--cl-dotimes-temp--"))
-    (list 'block nil
+	(end (nth 1 spec)))
-	  (list* 'let (list (list temp (nth 1 spec)) (list (car spec) 0))
+    ;; FIXME: Copy&pasted from subr.el.
-		 (list* 'while (list '< (car spec) temp)
+    `(block nil
-			(append body (list (list 'incf (car spec)))))
+       ;; This is not a reliable test, but it does not matter because both
-		 (or (cdr (cdr spec)) '(nil))))))
+       ;; semantics are acceptable, tho one is slightly faster with dynamic
+       ;; scoping and the other has cleaner semantics.
+       ,(if lexical-binding
+            (let ((counter '--dotimes-counter--))
+              `(let ((,temp ,end)
+                     (,counter 0))
+                 (while (< ,counter ,temp)
+                   (let ((,(car spec) ,counter))
+                     ,@body)
+                   (setq ,counter (1+ ,counter)))
+                 ,@(if (cddr spec)
+                       ;; FIXME: This let often leads to "unused var" warnings.
+                       `((let ((,(car spec) ,counter)) ,@(cddr spec))))))
+          `(let ((,temp ,end)
+                 (,(car spec) 0))
+             (while (< ,(car spec) ,temp)
+               ,@body
+               (incf ,(car spec)))
+             ,@(cdr (cdr spec)))))))
 
 ;;;###autoload
 (defmacro do-symbols (spec &rest body)

lisp/emacs-lisp/debug.el

@@ -118,6 +118,10 @@ first will be printed into the backtrace buffer."
     (let (debugger-value
 	  (debug-on-error nil)
 	  (debug-on-quit nil)
+	  (debugger-previous-state
+           (if (get-buffer "*Backtrace*")
+               (with-current-buffer (get-buffer "*Backtrace*")
+                 (list major-mode (buffer-string)))))
 	  (debugger-buffer (get-buffer-create "*Backtrace*"))
 	  (debugger-old-buffer (current-buffer))
 	  (debugger-step-after-exit nil)
@@ -214,8 +218,6 @@ first will be printed into the backtrace buffer."
 	      ;; recreate it every time the debugger stops, so instead we'll
 	      ;; erase it (and maybe hide it) but keep it alive.
 	      (with-current-buffer debugger-buffer
-		(erase-buffer)
-		(fundamental-mode)
 		(with-selected-window (get-buffer-window debugger-buffer 0)
                   (when (and (window-dedicated-p (selected-window))
                              (not debugger-will-be-back))
@@ -232,7 +234,17 @@ first will be printed into the backtrace buffer."
                     ;; to be left at the top-level, still working on how
                     ;; best to do that.
                     (bury-buffer))))
-	    (kill-buffer debugger-buffer))
+            (unless debugger-previous-state
+              (kill-buffer debugger-buffer)))
+          ;; Restore the previous state of the debugger-buffer, in case we were
+          ;; in a recursive invocation of the debugger.
+          (when (and debugger-previous-state
+                     (buffer-live-p debugger-buffer))
+            (with-current-buffer debugger-buffer
+              (let ((inhibit-read-only t))
+                (erase-buffer)
+                (insert (nth 1 debugger-previous-state))
+                (funcall (nth 0 debugger-previous-state)))))
 	  (with-timeout-unsuspend debugger-with-timeout-suspend)
 	  (set-match-data debugger-outer-match-data)))
       ;; Put into effect the modified values of these variables

lisp/emacs-lisp/lisp.el

@@ -636,9 +636,8 @@ considered."
          (plist (nthcdr 3 data)))
     (if (null data)
         (minibuffer-message "Nothing to complete")
-    (let ((completion-annotate-function
+      (let ((completion-extra-properties plist))
-           (plist-get plist :annotation-function)))
+        (completion-in-region (nth 0 data) (nth 1 data) (nth 2 data)
-      (completion-in-region (nth 0 data) (nth 1 data) (nth 2 data)
                               (plist-get plist :predicate))))))
 
 

lisp/emacs-lisp/testcover.el

@@ -430,7 +430,7 @@ FUN should be `testcover-reinstrument' for compositional functions,
   "Turn off instrumentation of all macros and functions in FILENAME."
   (interactive "fStop covering file: ")
   (let ((buf (find-file-noselect filename)))
-    (eval-buffer buf t)))
+    (eval-buffer buf)))
 
 
 ;;;=========================================================================

lisp/font-lock.el

@@ -563,7 +563,7 @@ we recommend setting `syntax-begin-function' instead.
 
 This is normally set via `font-lock-defaults'.")
 (make-obsolete-variable 'font-lock-beginning-of-syntax-function
-                        'syntax-begin-function "23.3")
+                        'syntax-begin-function "23.3" 'set)
 
 (defvar font-lock-mark-block-function nil
   "*Non-nil means use this function to mark a block of text.

lisp/gnus/ChangeLog

@@ -1,3 +1,29 @@
+2011-06-01  Teodor Zlatanov  <tzz@lifelogs.com>
+
+	* gnus-registry.el (gnus-registry-remove-ignored): New function to
+	remove entries with groups we ignore.
+
+2011-05-31  Lars Magne Ingebrigtsen  <larsi@gnus.org>
+
+	* shr.el (shr-rescale-image): Add an :ascent of 100 to images so that
+	the underline comes at the bottom.
+
+2011-05-31  Teodor Zlatanov  <tzz@lifelogs.com>
+
+	* gnus-registry.el (gnus-registry-article-marks-to-chars): Rename from
+	`gnus-registry-user-format-function-M' and declare the latter obsolete.
+	(gnus-registry-article-marks-to-names): Rename from
+	`gnus-registry-user-format-function-M2'.
+
+2011-05-31  Katsumi Yamaoka  <yamaoka@jpl.org>
+
+	* gnus-sum.el (gnus-summary-exit): Make sure to kill article buffer in
+	ephemeral group.
+
+2011-05-31  Lars Magne Ingebrigtsen  <larsi@gnus.org>
+
+	* shr.el (shr-browse-image): Copy the URL if called interactively.
+
 2011-05-30  Lars Magne Ingebrigtsen  <larsi@gnus.org>
 
 	* gnus-group.el (gnus-group-mark-article-read): It's possible that we

lisp/gnus/gnus-registry.el

@@ -62,10 +62,10 @@
 
 ;; show the marks as single characters (see the :char property in
 ;; `gnus-registry-marks'):
-;; (defalias 'gnus-user-format-function-M 'gnus-registry-user-format-function-M)
+;; (defalias 'gnus-user-format-function-M 'gnus-registry-article-marks-to-chars)
 
 ;; show the marks by name (see `gnus-registry-marks'):
-;; (defalias 'gnus-user-format-function-M 'gnus-registry-user-format-function-M2)
+;; (defalias 'gnus-user-format-function-M 'gnus-registry-article-marks-to-names)
 
 ;; TODO:
 
@@ -321,6 +321,20 @@ This is not required after changing `gnus-registry-cache-file'."
     (gnus-message 5 "Saving Gnus registry (size %d) to %s...done"
                   (registry-size db) file)))
 
+(defun gnus-registry-remove-ignored ()
+  (interactive)
+  (let* ((db gnus-registry-db)
+         (grouphashtb (registry-lookup-secondary db 'group))
+         (old-size (registry-size db)))
+    (registry-reindex db)
+    (loop for k being the hash-keys of grouphashtb
+          using (hash-values v)
+          when (gnus-registry-ignore-group-p k)
+          do (registry-delete db v nil))
+    (registry-reindex db)
+    (gnus-message 4 "Removed %d ignored entries from the Gnus registry"
+                  (- old-size (registry-size db)))))
+
 ;; article move/copy/spool/delete actions
 (defun gnus-registry-action (action data-header from &optional to method)
   (let* ((id (mail-header-id data-header))
@@ -897,9 +911,12 @@ Uses `gnus-registry-marks' to find what shortcuts to install."
                  nil
                  (cons "Registry Marks" gnus-registry-misc-menus))))))
 
+(make-obsolete 'gnus-registry-user-format-function-M
+               'gnus-registry-article-marks-to-chars "24.1") ?
+
 ;; use like this:
-;; (defalias 'gnus-user-format-function-M 'gnus-registry-user-format-function-M)
+;; (defalias 'gnus-user-format-function-M 'gnus-registry-article-marks-to-chars)
-(defun gnus-registry-user-format-function-M (headers)
+(defun gnus-registry-article-marks-to-chars (headers)
   "Show the marks for an article by the :char property"
   (let* ((id (mail-header-message-id headers))
          (marks (when id (gnus-registry-get-id-key id 'mark))))
@@ -911,8 +928,8 @@ Uses `gnus-registry-marks' to find what shortcuts to install."
                marks "")))
 
 ;; use like this:
-;; (defalias 'gnus-user-format-function-M 'gnus-registry-user-format-function-M2)
+;; (defalias 'gnus-user-format-function-M 'gnus-registry-article-marks-to-names)
-(defun gnus-registry-user-format-function-M2 (headers)
+(defun gnus-registry-article-marks-to-names (headers)
   "Show the marks for an article by name"
   (let* ((id (mail-header-message-id headers))
          (marks (when id (gnus-registry-get-id-key id 'mark))))

lisp/gnus/gnus-sum.el

@@ -7194,7 +7194,11 @@ If FORCE (the prefix), also save the .newsrc file(s)."
 	 (article-buffer gnus-article-buffer)
 	 (mode major-mode)
 	 (group-point nil)
-	 (buf (current-buffer)))
+	 (buf (current-buffer))
+	 ;; `gnus-single-article-buffer' is nil buffer-locally in
+	 ;; ephemeral group of which summary buffer will be killed,
+	 ;; but the global value may be non-nil.
+	 (single-article-buffer gnus-single-article-buffer))
     (unless quit-config
       ;; Do adaptive scoring, and possibly save score files.
       (when gnus-newsgroup-adaptive
@@ -7257,7 +7261,7 @@ If FORCE (the prefix), also save the .newsrc file(s)."
 	  (gnus-configure-windows 'group 'force)))
 
       ;; If we have several article buffers, we kill them at exit.
-      (unless gnus-single-article-buffer
+      (unless single-article-buffer
 	(when (gnus-buffer-live-p article-buffer)
 	  (with-current-buffer article-buffer
 	    ;; Don't kill sticky article buffers

lisp/gnus/shr.el

@@ -183,14 +183,23 @@ redirects somewhere else."
 	(message "No image under point")
       (message "%s" text))))
 
-(defun shr-browse-image ()
+(defun shr-browse-image (&optional copy-url)
-  "Browse the image under point."
+  "Browse the image under point.
-  (interactive)
+If COPY-URL (the prefix if called interactively) is non-nil, copy
+the URL of the image to the kill buffer instead."
+  (interactive "P")
   (let ((url (get-text-property (point) 'image-url)))
-    (if (not url)
+    (cond
-	(message "No image under point")
+     ((not url)
+      (message "No image under point"))
+     (copy-url
+      (with-temp-buffer
+	(insert url)
+	(copy-region-as-kill (point-min) (point-max))
+	(message "Copied %s" url)))
+     (t
       (message "Browsing %s..." url)
-      (browse-url url))))
+      (browse-url url)))))
 
 (defun shr-insert-image ()
   "Insert the image under point into the buffer."
@@ -524,8 +533,9 @@ redirects somewhere else."
 (defun shr-rescale-image (data)
   (if (or (not (fboundp 'imagemagick-types))
 	  (not (get-buffer-window (current-buffer))))
-      (create-image data nil t)
+      (create-image data nil t
-    (let* ((image (create-image data nil t))
+		    :ascent 100)
+    (let* ((image (create-image data nil t :ascent 100))
 	   (size (image-size image t))
 	   (width (car size))
 	   (height (cdr size))
@@ -544,11 +554,13 @@ redirects somewhere else."
       (when (> (car size) window-width)
 	(setq image (or
 		     (create-image data 'imagemagick t
-				   :width window-width)
+				   :width window-width
+				   :ascent 100)
 		     image)))
       (when (and (fboundp 'create-animated-image)
 		 (eq (image-type data nil t) 'gif))
-	(setq image (create-animated-image data 'gif t)))
+	(setq image (create-animated-image data 'gif t
+					   :ascent 100)))
       image)))
 
 ;; url-cache-extract autoloads url-cache.

lisp/help-fns.el

@@ -222,7 +222,7 @@ if the variable `help-downcase-arguments' is non-nil."
 (defun help-do-arg-highlight (doc args)
   (with-syntax-table (make-syntax-table emacs-lisp-mode-syntax-table)
     (modify-syntax-entry ?\- "w")
-    (dolist (arg args doc)
+    (dolist (arg args)
       (setq doc (replace-regexp-in-string
                  ;; This is heuristic, but covers all common cases
                  ;; except ARG1-ARG2
@@ -236,7 +236,8 @@ if the variable `help-downcase-arguments' is non-nil."
                          "\\(?:-[{([<`\"].*?\\)?"; for ARG-{x}, (x), <x>, [x], `x'
                          "\\>")                  ; end of word
                  (help-highlight-arg arg)
-                 doc t t 1)))))
+                 doc t t 1)))
+    doc))
 
 (defun help-highlight-arguments (usage doc &rest args)
   (when (and usage (string-match "^(" usage))
@@ -804,7 +805,8 @@ it is displayed along with the global value."
               (when obsolete
                 (setq extra-line t)
                 (princ "  This variable is obsolete")
-                (if (cdr obsolete) (princ (format " since %s" (cdr obsolete))))
+                (if (nth 2 obsolete)
+                    (princ (format " since %s" (nth 2 obsolete))))
 		(princ (cond ((stringp use) (concat ";\n  " use))
 			     (use (format ";\n  use `%s' instead." (car obsolete)))
 			     (t ".")))

lisp/international/ccl.el

@@ -280,10 +280,10 @@ the current loop.")
 ;;;###autoload
 (defun ccl-compile (ccl-program)
   "Return the compiled code of CCL-PROGRAM as a vector of integers."
-  (if (or (null (consp ccl-program))
+  (unless (and (consp ccl-program)
-	  (null (integerp (car ccl-program)))
+               (integerp (car ccl-program))
-	  (null (listp (car (cdr ccl-program)))))
+               (listp (car (cdr ccl-program))))
-      (error "CCL: Invalid CCL program: %s" ccl-program))
+    (error "CCL: Invalid CCL program: %s" ccl-program))
   (if (null (vectorp ccl-program-vector))
       (setq ccl-program-vector (make-vector 8192 0)))
   (setq ccl-loop-head nil ccl-breaks nil)

lisp/international/quail.el

@@ -2253,12 +2253,10 @@ are shown (at most to the depth specified `quail-completion-max-depth')."
   ;; Give temporary modes such as isearch a chance to turn off.
   (run-hooks 'mouse-leave-buffer-hook)
   (let ((buffer (window-buffer))
-        choice
+        choice)
-	base-size)
     (with-current-buffer (window-buffer (posn-window (event-start event)))
       (if completion-reference-buffer
 	  (setq buffer completion-reference-buffer))
-      (setq base-size completion-base-size)
       (save-excursion
 	(goto-char (posn-point (event-start event)))
 	(let (beg end)
@@ -2272,26 +2270,23 @@ are shown (at most to the depth specified `quail-completion-max-depth')."
 	  (setq end (or (next-single-property-change end 'mouse-face)
 			(point-max)))
 	  (setq choice (buffer-substring beg end)))))
-;    (let ((owindow (selected-window)))
+    ;; (let ((owindow (selected-window)))
-;      (select-window (posn-window (event-start event)))
+    ;;   (select-window (posn-window (event-start event)))
-;      (if (and (one-window-p t 'selected-frame)
+    ;;   (if (and (one-window-p t 'selected-frame)
-;	       (window-dedicated-p (selected-window)))
+    ;;            (window-dedicated-p (selected-window)))
-;	  ;; This is a special buffer's frame
+    ;;       ;; This is a special buffer's frame
-;	  (iconify-frame (selected-frame))
+    ;;       (iconify-frame (selected-frame))
-;	(or (window-dedicated-p (selected-window))
+    ;;     (or (window-dedicated-p (selected-window))
-;	    (bury-buffer)))
+    ;;         (bury-buffer)))
-;      (select-window owindow))
+    ;;   (select-window owindow))
     (quail-delete-region)
-    (quail-choose-completion-string choice buffer base-size)
+    (setq quail-current-str choice)
+    ;; FIXME: We need to pass `base-position' here.
+    ;; FIXME: why do we need choose-completion-string with all its
+    ;; completion-specific logic?
+    (choose-completion-string choice buffer)
     (quail-terminate-translation)))
 
-;; BASE-SIZE here is for compatibility with an (unused) arg of a
-;; previous implementation.
-(defun quail-choose-completion-string (choice &optional buffer base-size)
-  (setq quail-current-str choice)
-  ;; FIXME: We need to pass `base-position' here.
-  (choose-completion-string choice buffer))
-
 (defun quail-build-decode-map (map-list key decode-map num
 					&optional maxnum ignores)
   "Build a decoding map.

lisp/mail/emacsbug.el

@@ -331,6 +331,7 @@ usually do not have translators to read other languages for them.\n\n")
 
 ;; It's the default mail mode, so it seems OK to use its features.
 (autoload 'message-bogus-recipient-p "message")
+(defvar message-send-mail-function)
 
 (defun report-emacs-bug-hook ()
   "Do some checking before sending a bug report."
@@ -343,6 +344,10 @@ usually do not have translators to read other languages for them.\n\n")
                        report-emacs-bug-orig-text)
          (error "No text entered in bug report"))
     (or report-emacs-bug-no-confirmation
+	;; mailclient.el does not handle From (at present).
+	(if (derived-mode-p 'message-mode)
+	    (eq message-send-mail-function 'message-send-mail-with-mailclient)
+	  (eq send-mail-function 'mailclient-send-it))
 	;; Not narrowing to the headers, but that's OK.
 	(let ((from (mail-fetch-field "From")))
 	  (and (or (not from)

lisp/mail/sendmail.el

@@ -470,7 +470,8 @@ by Emacs.)")
 
 (put 'mail-mailer-swallows-blank-line 'risky-local-variable t) ; gets evalled
 (make-obsolete-variable 'mail-mailer-swallows-blank-line
-			"no need to set this on any modern system." "24.1")
+			"no need to set this on any modern system."
+                        "24.1" 'set)
 
 (defvar mail-mode-syntax-table
   ;; define-derived-mode will make it inherit from text-mode-syntax-table.

lisp/minibuffer.el

@@ -26,11 +26,15 @@
 ;; internal use only.
 
 ;; Functional completion tables have an extended calling conventions:
-;; - The `action' can be (additionally to nil, t, and lambda) of the form
+;; The `action' can be (additionally to nil, t, and lambda) of the form
-;;   (boundaries . SUFFIX) in which case it should return
+;; - (boundaries . SUFFIX) in which case it should return
 ;;   (boundaries START . END).  See `completion-boundaries'.
 ;;   Any other return value should be ignored (so we ignore values returned
 ;;   from completion tables that don't know about this new `action' form).
+;; - `metadata' in which case it should return (metadata . ALIST) where
+;;   ALIST is the metadata of this table.  See `completion-metadata'.
+;;   Any other return value should be ignored (so we ignore values returned
+;;   from completion tables that don't know about this new `action' form).
 
 ;;; Bugs:
 
@@ -107,7 +111,8 @@ E.g. for simple completion tables, the result is always (0 . (length SUFFIX))
 and for file names the result is the positions delimited by
 the closest directory separators."
   (let ((boundaries (if (functionp table)
-                        (funcall table string pred (cons 'boundaries suffix)))))
+                        (funcall table string pred
+                                 (cons 'boundaries suffix)))))
     (if (not (eq (car-safe boundaries) 'boundaries))
         (setq boundaries nil))
     (cons (or (cadr boundaries) 0)
@@ -125,7 +130,8 @@ This metadata is an alist.  Currently understood keys are:
    Takes one argument (COMPLETIONS) and should return a new list
    of completions.  Can operate destructively.
 - `cycle-sort-function': function to sort entries when cycling.
-   Works like `display-sort-function'."
+   Works like `display-sort-function'.
+The metadata of a completion table should be constant between two boundaries."
   (let ((metadata (if (functionp table)
                       (funcall table string pred 'metadata))))
     (if (eq (car-safe metadata) 'metadata)
@@ -160,8 +166,8 @@ PRED is a completion predicate.
 ACTION can be one of nil, t or `lambda'."
   (cond
    ((functionp table) (funcall table string pred action))
-   ((eq (car-safe action) 'boundaries)
+   ((eq (car-safe action) 'boundaries) nil)
-    (cons 'boundaries (completion-boundaries string table pred (cdr action))))
+   ((eq action 'metadata) nil)
    (t
     (funcall
      (cond
@@ -182,7 +188,7 @@ The result of the `completion-table-dynamic' form is a function
 that can be used as the COLLECTION argument to `try-completion' and
 `all-completions'.  See Info node `(elisp)Programmed Completion'."
   (lambda (string pred action)
-    (if (eq (car-safe action) 'boundaries)
+    (if (or (eq (car-safe action) 'boundaries) (eq action 'metadata))
         ;; `fun' is not supposed to return another function but a plain old
         ;; completion table, whose boundaries are always trivial.
         nil
@@ -287,18 +293,18 @@ instead of a string, a function that takes the completion and returns the
                 (funcall terminator comp)
               (concat comp terminator))
           comp))))
-   ((eq action t)
+   ;; completion-table-with-terminator is always used for
+   ;; "sub-completions" so it's only called if the terminator is missing,
+   ;; in which case `test-completion' should return nil.
+   ((eq action 'lambda) nil)
+   (t
     ;; FIXME: We generally want the `try' and `all' behaviors to be
     ;; consistent so pcm can merge the `all' output to get the `try' output,
     ;; but that sometimes clashes with the need for `all' output to look
     ;; good in *Completions*.
     ;; (mapcar (lambda (s) (concat s terminator))
     ;;         (all-completions string table pred))))
-    (all-completions string table pred))
+    (complete-with-action action table string pred))))
-   ;; completion-table-with-terminator is always used for
-   ;; "sub-completions" so it's only called if the terminator is missing,
-   ;; in which case `test-completion' should return nil.
-   ((eq action 'lambda) nil)))
 
 (defun completion-table-with-predicate (table pred1 strict string pred2 action)
   "Make a completion table equivalent to TABLE but filtered through PRED1.
@@ -769,22 +775,33 @@ scroll the window of possible completions."
   (setq completion-cycling nil)
   (setq completion-all-sorted-completions nil))
 
+(defun completion--metadata (string base md-at-point table pred)
+  ;; Like completion-metadata, but for the specific case of getting the
+  ;; metadata at `base', which tends to trigger pathological behavior for old
+  ;; completion tables which don't understand `metadata'.
+  (let ((bounds (completion-boundaries string table pred "")))
+    (if (eq (car bounds) base) md-at-point
+      (completion-metadata (substring string 0 base) table pred))))
+
 (defun completion-all-sorted-completions ()
   (or completion-all-sorted-completions
       (let* ((start (field-beginning))
              (end (field-end))
              (string (buffer-substring start end))
+             (md (completion--field-metadata start))
              (all (completion-all-completions
                    string
                    minibuffer-completion-table
                    minibuffer-completion-predicate
                    (- (point) start)
-                   (completion--field-metadata start)))
+                   md))
              (last (last all))
              (base-size (or (cdr last) 0))
-             (all-md (completion-metadata (substring string 0 base-size)
+             (all-md (completion--metadata (buffer-substring-no-properties
-                                          minibuffer-completion-table
+                                            start (point))
-                                          minibuffer-completion-predicate))
+                                           base-size md
+                                           minibuffer-completion-table
+                                           minibuffer-completion-predicate))
              (sort-fun (completion-metadata-get all-md 'cycle-sort-function)))
         (when last
           (setcdr last nil)
@@ -1272,12 +1289,13 @@ variables.")
   (let* ((start (field-beginning))
          (end (field-end))
          (string (field-string))
+         (md (completion--field-metadata start))
          (completions (completion-all-completions
                        string
                        minibuffer-completion-table
                        minibuffer-completion-predicate
                        (- (point) (field-beginning))
-                       (completion--field-metadata start))))
+                       md)))
     (message nil)
     (if (or (null completions)
             (and (not (consp (cdr completions)))
@@ -1293,12 +1311,11 @@ variables.")
       (let* ((last (last completions))
              (base-size (cdr last))
              (prefix (unless (zerop base-size) (substring string 0 base-size)))
-             ;; FIXME: This function is for the output of all-completions,
+             (all-md (completion--metadata (buffer-substring-no-properties
-             ;; not completion-all-completions.  Often it's the same, but
+                                            start (point))
-             ;; not always.
+                                           base-size md
-             (all-md (completion-metadata (substring string 0 base-size)
+                                           minibuffer-completion-table
-                                          minibuffer-completion-table
+                                           minibuffer-completion-predicate))
-                                          minibuffer-completion-predicate))
              (afun (or (completion-metadata-get all-md 'annotation-function)
                        (plist-get completion-extra-properties
                                   :annotation-function)
@@ -1640,6 +1657,34 @@ The completion method is determined by `completion-at-point-functions'."
   (define-key map "\t" 'exit-minibuffer)
   (define-key map "?" 'self-insert-and-exit))
 
+(defvar minibuffer-inactive-mode-map
+  (let ((map (make-keymap)))
+    (suppress-keymap map)
+    (define-key map "e" 'find-file-other-frame)
+    (define-key map "f" 'find-file-other-frame)
+    (define-key map "b" 'switch-to-buffer-other-frame)
+    (define-key map "i" 'info)
+    (define-key map "m" 'mail)
+    (define-key map "n" 'make-frame)
+    (define-key map [mouse-1] (lambda () (interactive)
+				(with-current-buffer "*Messages*"
+				  (goto-char (point-max))
+				  (display-buffer (current-buffer)))))
+    ;; So the global down-mouse-1 binding doesn't clutter the execution of the
+    ;; above mouse-1 binding.
+    (define-key map [down-mouse-1] #'ignore)
+    map)
+  "Keymap for use in the minibuffer when it is not active.
+The non-mouse bindings in this keymap can only be used in minibuffer-only
+frames, since the minibuffer can normally not be selected when it is
+not active.")
+
+(define-derived-mode minibuffer-inactive-mode nil "InactiveMinibuffer"
+  :abbrev-table nil          ;abbrev.el is not loaded yet during dump.
+  ;; Note: this major mode is called from minibuf.c.
+  "Major mode to use in the minibuffer when it is not active.
+This is only used when the minibuffer area has no active minibuffer.")
+
 ;;; Completion tables.
 
 (defun minibuffer--double-dollars (str)
@@ -1673,8 +1718,8 @@ same as `substitute-in-file-name'."
         ;; other table that provides the "main" completion.  Let the
         ;; other table handle the test-completion case.
         nil)
-       ((eq (car-safe action) 'boundaries)
+       ((or (eq (car-safe action) 'boundaries) (eq action 'metadata))
-        ;; Only return boundaries if there's something to complete,
+        ;; Only return boundaries/metadata if there's something to complete,
         ;; since otherwise when we're used in
         ;; completion-table-in-turn, we could return boundaries and
         ;; let some subsequent table return a list of completions.
@@ -1684,11 +1729,13 @@ same as `substitute-in-file-name'."
         (when (try-completion (substring string beg) table nil)
           ;; Compute the boundaries of the subfield to which this
           ;; completion applies.
-          (let ((suffix (cdr action)))
+          (if (eq action 'metadata)
-            (list* 'boundaries
+              '(metadata (category . environment-variable))
-                   (or (match-beginning 2) (match-beginning 1))
+            (let ((suffix (cdr action)))
-                   (when (string-match "[^[:alnum:]_]" suffix)
+              (list* 'boundaries
-                     (match-beginning 0))))))
+                     (or (match-beginning 2) (match-beginning 1))
+                     (when (string-match "[^[:alnum:]_]" suffix)
+                       (match-beginning 0)))))))
        (t
         (if (eq (aref string (1- beg)) ?{)
             (setq table (apply-partially 'completion-table-with-terminator
@@ -1927,7 +1974,11 @@ and `read-file-name-function'."
 ;; minibuffer-completing-file-name is a variable used internally in minibuf.c
 ;; to determine whether to use minibuffer-local-filename-completion-map or
 ;; minibuffer-local-completion-map.  It shouldn't be exported to Elisp.
-(make-obsolete-variable 'minibuffer-completing-file-name nil "24.1")
+;; FIXME: Actually, it is also used in rfn-eshadow.el we'd otherwise have to
+;; use (eq minibuffer-completion-table #'read-file-name-internal), which is
+;; probably even worse.  Maybe We should add some read-file-name-setup-hook
+;; instead, but for now, let's keep this non-obsolete.
+;;(make-obsolete-variable 'minibuffer-completing-file-name nil "24.1" 'get)
 
 (defun read-file-name-default (prompt &optional dir default-filename mustmatch initial predicate)
   "Default method for reading file names.
@@ -2299,7 +2350,8 @@ PATTERN is as returned by `completion-pcm--string->pattern'."
            (case-fold-search completion-ignore-case)
            (completion-regexp-list (cons regex completion-regexp-list))
 	   (compl (all-completions
-                   (concat prefix (if (stringp (car pattern)) (car pattern) ""))
+                   (concat prefix
+                           (if (stringp (car pattern)) (car pattern) ""))
 		   table pred)))
       (if (not (functionp table))
 	  ;; The internal functions already obeyed completion-regexp-list.
@@ -2397,13 +2449,14 @@ filter out additional entries (because TABLE migth not obey PRED)."
                                    (- (length newbeforepoint)
                                       (car newbounds)))))
                   (dolist (submatch suball)
-                    (setq all (nconc (mapcar
+                    (setq all (nconc
-                                      (lambda (s) (concat submatch between s))
+                               (mapcar
-                                      (funcall filter
+                                (lambda (s) (concat submatch between s))
-                                               (completion-pcm--all-completions
+                                (funcall filter
-                                                (concat subprefix submatch between)
+                                         (completion-pcm--all-completions
-                                                pattern table pred)))
+                                          (concat subprefix submatch between)
-                                     all)))
+                                          pattern table pred)))
+                               all)))
                   ;; FIXME: This can come in handy for try-completion,
                   ;; but isn't right for all-completions, since it lists
                   ;; invalid completions.

lisp/mouse.el

@@ -278,7 +278,7 @@ The contents are the items that would be in the menu bar whether or
 not it is actually displayed."
   (interactive "@e \nP")
   (run-hooks 'activate-menubar-hook 'menu-bar-update-hook)
-  (popup-menu (mouse-menu-bar-map) event prefix))
+  (popup-menu (mouse-menu-bar-map) (unless (integerp event) event) prefix))
 (make-obsolete 'mouse-popup-menubar 'mouse-menu-bar-map "23.1")
 
 (defun mouse-popup-menubar-stuff (event prefix)
@@ -790,18 +790,9 @@ remains active.  Otherwise, it remains until the next input event.
 
 If the click is in the echo area, display the `*Messages*' buffer."
   (interactive "e")
-  (let ((w (posn-window (event-start start-event))))
+  ;; Give temporary modes such as isearch a chance to turn off.
-    (if (and (window-minibuffer-p w)
+  (run-hooks 'mouse-leave-buffer-hook)
-	     (not (minibuffer-window-active-p w)))
+  (mouse-drag-track start-event t))
-	(save-excursion
-	  ;; Swallow the up-event.
-	  (read-event)
-	  (set-buffer (get-buffer-create "*Messages*"))
-	  (goto-char (point-max))
-	  (display-buffer (current-buffer)))
-      ;; Give temporary modes such as isearch a chance to turn off.
-      (run-hooks 'mouse-leave-buffer-hook)
-      (mouse-drag-track start-event t))))
 
 
 (defun mouse-posn-property (pos property)

lisp/net/rcirc.el

@@ -314,11 +314,11 @@ Called with 5 arguments, PROCESS, SENDER, RESPONSE, TARGET and TEXT."
   :type 'boolean
   :group 'rcirc)
 
-(defcustom rcirc-decode-coding-system nil
+(defcustom rcirc-decode-coding-system 'utf-8
   "Coding system used to decode incoming irc messages.
-If nil automatically detect the coding system."
+Set to 'undecided if you want the encoding of the incoming
+messages autodetected."
   :type 'coding-system
-  :version "24.1"
   :group 'rcirc)
 
 (defcustom rcirc-encode-coding-system 'utf-8
@@ -1482,8 +1482,7 @@ record activity."
 	      (old-point (point-marker))
 	      (fill-start (marker-position rcirc-prompt-start-marker)))
 
-	  (setq text (decode-coding-string text (or rcirc-decode-coding-system
+	  (setq text (decode-coding-string text rcirc-decode-coding-system))
-						    (detect-coding-string text t))))
 	  (unless (string= sender (rcirc-nick process))
 	    ;; mark the line with overlay arrow
 	    (unless (or (marker-position overlay-arrow-position)

lisp/net/tramp-gvfs.el

@@ -541,7 +541,7 @@ is no information where to trace the message.")
   "Like `copy-file' for Tramp files."
   (with-parsed-tramp-file-name
       (if (tramp-tramp-file-p filename) filename newname) nil
-    (with-progress-reporter
+    (tramp-with-progress-reporter
 	v 0 (format "Copying %s to %s" filename newname)
       (condition-case err
 	  (let ((args
@@ -745,7 +745,7 @@ is no information where to trace the message.")
   "Like `rename-file' for Tramp files."
   (with-parsed-tramp-file-name
       (if (tramp-tramp-file-p filename) filename newname) nil
-    (with-progress-reporter
+    (tramp-with-progress-reporter
 	v 0 (format "Renaming %s to %s" filename newname)
       (condition-case err
 	  (rename-file
@@ -1203,7 +1203,7 @@ connection if a previous connection has died for some reason."
 	    (tramp-gvfs-object-path
 	     (tramp-make-tramp-file-name method user host ""))))
 
-      (with-progress-reporter
+      (tramp-with-progress-reporter
 	  vec 3
 	  (if (zerop (length user))
 	      (format "Opening connection for %s using %s" host method)

lisp/net/tramp-sh.el

@@ -1945,7 +1945,7 @@ file names."
 	(tramp-error
 	 v 'file-already-exists "File %s already exists" newname))
 
-      (with-progress-reporter
+      (tramp-with-progress-reporter
 	  v 0 (format "%s %s to %s"
 		      (if (eq op 'copy) "Copying" "Renaming")
 		      filename newname)
@@ -2454,7 +2454,8 @@ This is like `dired-recursive-delete-directory' for Tramp files."
 	       nil)
 	      ((and suffix (nth 2 suffix))
 	       ;; We found an uncompression rule.
-	       (with-progress-reporter v 0 (format "Uncompressing %s" file)
+	       (tramp-with-progress-reporter
+                   v 0 (format "Uncompressing %s" file)
 		 (when (tramp-send-command-and-check
 			v (concat (nth 2 suffix) " "
 				  (tramp-shell-quote-argument localname)))
@@ -2465,7 +2466,7 @@ This is like `dired-recursive-delete-directory' for Tramp files."
 	      (t
 	       ;; We don't recognize the file as compressed, so compress it.
 	       ;; Try gzip.
-	       (with-progress-reporter v 0 (format "Compressing %s" file)
+	       (tramp-with-progress-reporter v 0 (format "Compressing %s" file)
 		 (when (tramp-send-command-and-check
 			v (concat "gzip -f "
 				  (tramp-shell-quote-argument localname)))
@@ -2948,7 +2949,7 @@ the result will be a local, non-Tramp, filename."
 	   ;; Use inline encoding for file transfer.
 	   (rem-enc
 	    (save-excursion
-	      (with-progress-reporter
+	      (tramp-with-progress-reporter
 	       v 3 (format "Encoding remote file %s" filename)
 	       (tramp-barf-unless-okay
 		v (format rem-enc (tramp-shell-quote-argument localname))
@@ -2962,7 +2963,7 @@ the result will be a local, non-Tramp, filename."
 		  (with-temp-buffer
 		    (set-buffer-multibyte nil)
 		    (insert-buffer-substring (tramp-get-buffer v))
-		    (with-progress-reporter
+		    (tramp-with-progress-reporter
 			v 3 (format "Decoding remote file %s with function %s"
 				    filename loc-dec)
 		      (funcall loc-dec (point-min) (point-max))
@@ -2980,7 +2981,7 @@ the result will be a local, non-Tramp, filename."
 		  (let (file-name-handler-alist
 			(coding-system-for-write 'binary))
 		    (write-region (point-min) (point-max) tmpfile2))
-		  (with-progress-reporter
+		  (tramp-with-progress-reporter
 		      v 3 (format "Decoding remote file %s with command %s"
 				  filename loc-dec)
 		    (unwind-protect
@@ -3205,7 +3206,7 @@ Returns a file name in `tramp-auto-save-directory' for autosaving this file."
 		    (set-buffer-multibyte nil)
 		    ;; Use encoding function or command.
 		    (if (functionp loc-enc)
-			(with-progress-reporter
+			(tramp-with-progress-reporter
 			    v 3 (format "Encoding region using function `%s'"
 					loc-enc)
 			  (let ((coding-system-for-read 'binary))
@@ -3223,7 +3224,7 @@ Returns a file name in `tramp-auto-save-directory' for autosaving this file."
 				  (tramp-compat-temporary-file-directory)))
 			    (funcall loc-enc (point-min) (point-max))))
 
-		      (with-progress-reporter
+		      (tramp-with-progress-reporter
 			  v 3 (format "Encoding region using command `%s'"
 				      loc-enc)
 			(unless (zerop (tramp-call-local-coding-command
@@ -3237,7 +3238,7 @@ Returns a file name in `tramp-auto-save-directory' for autosaving this file."
 		    ;; Send buffer into remote decoding command which
 		    ;; writes to remote file.  Because this happens on
 		    ;; the remote host, we cannot use the function.
-		    (with-progress-reporter
+		    (tramp-with-progress-reporter
 			v 3
 			(format "Decoding region into remote file %s" filename)
 		      (goto-char (point-max))
@@ -3337,7 +3338,7 @@ Returns a file name in `tramp-auto-save-directory' for autosaving this file."
   "Like `vc-registered' for Tramp files."
   (tramp-compat-with-temp-message ""
     (with-parsed-tramp-file-name file nil
-      (with-progress-reporter
+      (tramp-with-progress-reporter
 	  v 3 (format "Checking `vc-registered' for %s" file)
 
 	;; There could be new files, created by the vc backend.  We
@@ -3431,7 +3432,7 @@ Only send the definition if it has not already been done."
   (let* ((p (tramp-get-connection-process vec))
 	 (scripts (tramp-get-connection-property p "scripts" nil)))
     (unless (member name scripts)
-      (with-progress-reporter vec 5 (format "Sending script `%s'" name)
+      (tramp-with-progress-reporter vec 5 (format "Sending script `%s'" name)
 	;; The script could contain a call of Perl.  This is masked with `%s'.
 	(tramp-barf-unless-okay
 	 vec
@@ -3595,7 +3596,8 @@ file exists and nonzero exit status otherwise."
 
 (defun tramp-open-shell (vec shell)
   "Opens shell SHELL."
-  (with-progress-reporter vec 5 (format "Opening remote shell `%s'" shell)
+  (tramp-with-progress-reporter
+      vec 5 (format "Opening remote shell `%s'" shell)
     ;; Find arguments for this shell.
     (let ((tramp-end-of-output tramp-initial-end-of-output)
 	  (alist tramp-sh-extra-args)
@@ -4247,7 +4249,7 @@ connection if a previous connection has died for some reason."
 	;; We call `tramp-get-buffer' in order to get a debug buffer for
 	;; messages from the beginning.
 	(tramp-get-buffer vec)
-	(with-progress-reporter
+	(tramp-with-progress-reporter
 	    vec 3
 	    (if (zerop (length (tramp-file-name-user vec)))
 		(format "Opening connection for %s using %s"

lisp/net/tramp-smb.el

@@ -342,7 +342,7 @@ KEEP-DATE is not handled in case NEWNAME resides on an SMB server.
 PRESERVE-UID-GID and PRESERVE-SELINUX-CONTEXT are completely ignored."
   (setq filename (expand-file-name filename)
 	newname (expand-file-name newname))
-  (with-progress-reporter
+  (tramp-with-progress-reporter
       (tramp-dissect-file-name (if (file-remote-p filename) filename newname))
       0 (format "Copying %s to %s" filename newname)
 
@@ -600,7 +600,7 @@ PRESERVE-UID-GID and PRESERVE-SELINUX-CONTEXT are completely ignored."
        v 'file-error
        "Cannot make local copy of non-existing file `%s'" filename))
     (let ((tmpfile (tramp-compat-make-temp-file filename)))
-      (with-progress-reporter
+      (tramp-with-progress-reporter
 	  v 3 (format "Fetching %s to tmp file %s" filename tmpfile)
 	(unless (tramp-smb-send-command
 		 v (format "get \"%s\" \"%s\""
@@ -837,7 +837,7 @@ target of the symlink differ."
   "Like `rename-file' for Tramp files."
   (setq filename (expand-file-name filename)
 	newname (expand-file-name newname))
-  (with-progress-reporter
+  (tramp-with-progress-reporter
       (tramp-dissect-file-name (if (file-remote-p filename) filename newname))
       0 (format "Renaming %s to %s" filename newname)
 
@@ -926,7 +926,7 @@ errors for shares like \"C$/\", which are common in Microsoft Windows."
 	   (list start end tmpfile append 'no-message lockname confirm)
 	 (list start end tmpfile append 'no-message lockname)))
 
-      (with-progress-reporter
+      (tramp-with-progress-reporter
 	  v 3 (format "Moving tmp file %s to %s" tmpfile filename)
 	(unwind-protect
 	    (unless (tramp-smb-send-command
@@ -1289,7 +1289,7 @@ connection if a previous connection has died for some reason."
 	    (setq args (append args (list "-s" tramp-smb-conf))))
 
 	  ;; OK, let's go.
-	  (with-progress-reporter
+	  (tramp-with-progress-reporter
 	      vec 3
 	      (format "Opening connection for //%s%s/%s"
 		      (if (not (zerop (length user))) (concat user "@") "")

lisp/net/tramp.el

@@ -1452,11 +1452,12 @@ If VAR is nil, then we bind `v' to the structure and `method', `user',
     (when (string-match message (or (current-message) ""))
       (tramp-compat-funcall 'progress-reporter-update reporter value))))
 
-(defmacro with-progress-reporter (vec level message &rest body)
+(defmacro tramp-with-progress-reporter (vec level message &rest body)
   "Executes BODY, spinning a progress reporter with MESSAGE.
 If LEVEL does not fit for visible messages, or if this is a
 nested call of the macro, there are only traces without a visible
 progress reporter."
+  (declare (indent 3) (debug t))
   `(let (pr tm)
      (tramp-message ,vec ,level "%s..." ,message)
      ;; We start a pulsing progress reporter after 3 seconds.  Feature
@@ -1479,10 +1480,8 @@ progress reporter."
        (if tm (tramp-compat-funcall 'cancel-timer tm))
        (tramp-message ,vec ,level "%s...done" ,message))))
 
-(put 'with-progress-reporter 'lisp-indent-function 3)
-(put 'with-progress-reporter 'edebug-form-spec t)
 (tramp-compat-font-lock-add-keywords
- 'emacs-lisp-mode '("\\<with-progress-reporter\\>"))
+ 'emacs-lisp-mode '("\\<tramp-with-progress-reporter\\>"))
 
 (eval-and-compile			;; Silence compiler.
   (if (memq system-type '(cygwin windows-nt))
@@ -2881,7 +2880,7 @@ User is always nil."
 		;; useful for "rsync".
 		(setq tramp-temp-buffer-file-name local-copy))
 
-	      (with-progress-reporter
+	      (tramp-with-progress-reporter
 		  v 3 (format "Inserting local temp file `%s'" local-copy)
 		;; We must ensure that `file-coding-system-alist'
 		;; matches `local-copy'.
@@ -2932,7 +2931,7 @@ User is always nil."
     (if (not (file-exists-p file))
 	nil
       (let ((tramp-message-show-message (not nomessage)))
-	(with-progress-reporter v 0 (format "Loading %s" file)
+	(tramp-with-progress-reporter v 0 (format "Loading %s" file)
 	  (let ((local-copy (file-local-copy file)))
 	    ;; MUST-SUFFIX doesn't exist on XEmacs, so let it default to nil.
 	    (unwind-protect

lisp/proced.el

@@ -1735,8 +1735,9 @@ After sending the signal, this command runs the normal hook
                    (pnum (if (= 1 (length process-alist))
                              "1 process"
                            (format "%d processes" (length process-alist))))
-                   (completion-annotate-function
+                   (completion-extra-properties
-                    (lambda (s) (cdr (assoc s proced-signal-list)))))
+                    '(:annotation-function
+                      (lambda (s) (cdr (assoc s proced-signal-list))))))
               (setq signal
                     (completing-read (concat "Send signal [" pnum
                                              "] (default TERM): ")

lisp/server.el

@@ -235,9 +235,10 @@ If local sockets are not supported, this is nil.")
 (defun server-clients-with (property value)
   "Return a list of clients with PROPERTY set to VALUE."
   (let (result)
-    (dolist (proc server-clients result)
+    (dolist (proc server-clients)
       (when (equal value (process-get proc property))
-	(push proc result)))))
+	(push proc result)))
+    result))
 
 (defun server-add-client (proc)
   "Create a client for process PROC, if it doesn't already have one.
@@ -1322,10 +1323,11 @@ specifically for the clients and did not exist before their request for it."
   "Ask before killing a server buffer."
   (or (not server-buffer-clients)
       (let ((res t))
-	(dolist (proc server-buffer-clients res)
+	(dolist (proc server-buffer-clients)
           (when (and (memq proc server-clients)
                      (eq (process-status proc) 'open))
-            (setq res nil))))
+            (setq res nil)))
+         res)
       (yes-or-no-p (format "Buffer `%s' still has clients; kill it? "
 			   (buffer-name (current-buffer))))))
 
@@ -1333,10 +1335,11 @@ specifically for the clients and did not exist before their request for it."
   "Ask before exiting Emacs if it has live clients."
   (or (not server-clients)
       (let (live-client)
-	(dolist (proc server-clients live-client)
+	(dolist (proc server-clients)
 	  (when (memq t (mapcar 'buffer-live-p (process-get
 						proc 'buffers)))
-	    (setq live-client t))))
+	    (setq live-client t)))
+        live-client)
       (yes-or-no-p "This Emacs session has clients; exit anyway? ")))
 
 (defun server-kill-buffer ()

lisp/simple.el

@@ -967,13 +967,11 @@ rather than line counts."
 		 (concat " in " (buffer-name buffer))
 	       "")))
        ;; Read the argument, offering that number (if any) as default.
-       (list (read-from-minibuffer (format (if default "Goto line%s (%s): "
+       (list (read-number (format (if default "Goto line%s (%s): "
-					     "Goto line%s: ")
+                                    "Goto line%s: ")
-					   buffer-prompt
+                                  buffer-prompt
-					   default)
+                                  default)
-				   nil nil t
+                          default)
-				   'minibuffer-history
-				   default)
 	     buffer))))
   ;; Switch to the desired buffer, one way or another.
   (if buffer
@@ -1158,7 +1156,7 @@ in *Help* buffer.  See also the command `describe-char'."
 
 (defvar minibuffer-completing-symbol nil
   "Non-nil means completing a Lisp symbol in the minibuffer.")
-(make-obsolete-variable 'minibuffer-completing-symbol nil "24.1")
+(make-obsolete-variable 'minibuffer-completing-symbol nil "24.1" 'get)
 
 (defvar minibuffer-default nil
   "The current default value or list of default values in the minibuffer.
@@ -2815,25 +2813,21 @@ The return value is always nil."
 `universal-argument-other-key' uses this to discard those events
 from (this-command-keys), and reread only the final command.")
 
-(defvar overriding-map-is-bound nil
+(defvar saved-overriding-map t
-  "Non-nil when `overriding-terminal-local-map' is `universal-argument-map'.")
-
-(defvar saved-overriding-map nil
   "The saved value of `overriding-terminal-local-map'.
 That variable gets restored to this value on exiting \"universal
 argument mode\".")
 
-(defun ensure-overriding-map-is-bound ()
+(defun save&set-overriding-map (map)
-  "Check `overriding-terminal-local-map' is `universal-argument-map'."
+  "Set `overriding-terminal-local-map' to MAP."
-  (unless overriding-map-is-bound
+  (when (eq saved-overriding-map t)
     (setq saved-overriding-map overriding-terminal-local-map)
-    (setq overriding-terminal-local-map universal-argument-map)
+    (setq overriding-terminal-local-map map)))
-    (setq overriding-map-is-bound t)))
 
 (defun restore-overriding-map ()
   "Restore `overriding-terminal-local-map' to its saved value."
   (setq overriding-terminal-local-map saved-overriding-map)
-  (setq overriding-map-is-bound nil))
+  (setq saved-overriding-map t))
 
 (defun universal-argument ()
   "Begin a numeric argument for the following command.
@@ -2848,7 +2842,7 @@ These commands include \\[set-mark-command] and \\[start-kbd-macro]."
   (interactive)
   (setq prefix-arg (list 4))
   (setq universal-argument-num-events (length (this-command-keys)))
-  (ensure-overriding-map-is-bound))
+  (save&set-overriding-map universal-argument-map))
 
 ;; A subsequent C-u means to multiply the factor by 4 if we've typed
 ;; nothing but C-u's; otherwise it means to terminate the prefix arg.
@@ -2873,7 +2867,7 @@ These commands include \\[set-mark-command] and \\[start-kbd-macro]."
 	(t
 	 (setq prefix-arg '-)))
   (setq universal-argument-num-events (length (this-command-keys)))
-  (ensure-overriding-map-is-bound))
+  (save&set-overriding-map universal-argument-map))
 
 (defun digit-argument (arg)
   "Part of the numeric argument for the next command.
@@ -2892,7 +2886,7 @@ These commands include \\[set-mark-command] and \\[start-kbd-macro]."
 	  (t
 	   (setq prefix-arg digit))))
   (setq universal-argument-num-events (length (this-command-keys)))
-  (ensure-overriding-map-is-bound))
+  (save&set-overriding-map universal-argument-map))
 
 ;; For backward compatibility, minus with no modifiers is an ordinary
 ;; command if digits have already been entered.
@@ -5177,8 +5171,8 @@ Returns t if it really did any work."
 		 (or (null fill-prefix) (string= fill-prefix "")))
 	(let ((prefix
 	       (fill-context-prefix
-		(save-excursion (backward-paragraph 1) (point))
+		(save-excursion (fill-forward-paragraph -1) (point))
-		(save-excursion (forward-paragraph 1) (point)))))
+		(save-excursion (fill-forward-paragraph 1) (point)))))
 	  (and prefix (not (equal prefix ""))
 	       ;; Use auto-indentation rather than a guessed empty prefix.
 	       (not (and fill-indent-according-to-mode
@@ -5660,7 +5654,8 @@ At top-level, as an editor command, this simply beeps."
   (if (fboundp 'kmacro-keyboard-quit)
       (kmacro-keyboard-quit))
   (setq defining-kbd-macro nil)
-  (signal 'quit nil))
+  (let ((debug-on-quit nil))
+    (signal 'quit nil)))
 
 (defvar buffer-quit-function nil
   "Function to call to \"quit\" the current buffer, or nil if none.

lisp/subr.el

@@ -1805,6 +1805,13 @@ Signal an error if the program returns with a non-zero exit status."
 	  (forward-line 1))
 	(nreverse lines)))))
 
+(defun process-alive-p (process)
+  "Returns non-nil if PROCESS is alive.
+A process is considered alive if its status is `run', `open',
+`listen', `connect' or `stop'."
+  (memq (process-status process)
+        '(run open listen connect stop)))
+
 ;; compatibility
 
 (make-obsolete
@@ -2919,6 +2926,7 @@ with the buffer BUFNAME temporarily current.  It runs the hook
 buffer temporarily current, and the window that was used to display it
 temporarily selected.  But it doesn't run `temp-buffer-show-hook'
 if it uses `temp-buffer-show-function'."
+  (declare (debug t))
   (let ((old-dir (make-symbol "old-dir"))
         (buf (make-symbol "buf")))
     `(let* ((,old-dir default-directory)

lisp/thingatpt.el

@@ -402,7 +402,7 @@ with angle brackets.")
       (re-search-forward "[ \t]+\\|\n" nil 'move arg)
     (while (< arg 0)
       (if (re-search-backward "[ \t]+\\|\n" nil 'move)
-	  (or (eq (char-after (match-beginning 0)) 10)
+	  (or (eq (char-after (match-beginning 0)) ?\n)
 	      (skip-chars-backward " \t")))
       (setq arg (1+ arg)))))
 

lisp/url/ChangeLog

@@ -1,3 +1,17 @@
+2011-06-01  Glenn Morris  <rgm@gnu.org>
+
+	* url-queue.el (url-queue-parallel-processes, url-queue-timeout):
+	Add :version tag for options that will be new in 24.1.
+
+2011-05-31  Lars Magne Ingebrigtsen  <larsi@gnus.org>
+
+	* url-queue.el (url-queue-parallel-processes): Increase the
+	default to 6, since 2 seems too conservative for normal usage.
+
+2011-05-31  Teodor Zlatanov  <tzz@lifelogs.com>
+
+	* url-future.el: Add general futures facility.
+
 2011-05-29  Leo Liu  <sdl.web@gmail.com>
 
 	* url-cookie.el (url-cookie): Add option :named so that

lisp/url/url-future.el

@@ -0,0 +1,126 @@
+;;; url-future.el --- general futures facility for url.el
+
+;; Copyright (C) 2011  Free Software Foundation, Inc.
+
+;; Author: Teodor Zlatanov <tzz@lifelogs.com>
+;; Keywords: data
+
+;; This file is part of GNU Emacs.
+;;
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; Make a url-future (basically a defstruct):
+;; (make-url-future :value (lambda () (calculation goes here))
+;;   :callback (lambda (future) (use future on success))
+;;   :errorback (lambda (future &rest error) (error handler)))
+
+;; Then either call it with `url-future-call' or cancel it with
+;; `url-future-cancel'.  Generally the functions will return the
+;; future itself, not the value it holds.  Also the functions will
+;; throw a url-future-already-done error if you try to call or cancel
+;; a future more than once.
+
+;; So, to get the value:
+;; (when (url-future-completed-p future) (url-future-value future))
+
+;; See the ERT tests and the code for futher details.
+
+;;; Code:
+
+(eval-when-compile (require 'cl))
+(eval-when-compile (require 'ert))
+
+(defstruct url-future callback errorback status value)
+
+(defmacro url-future-done-p (url-future)
+  `(url-future-status ,url-future))
+
+(defmacro url-future-completed-p (url-future)
+  `(eq (url-future-status ,url-future) t))
+
+(defmacro url-future-errored-p (url-future)
+  `(eq (url-future-status ,url-future) 'error))
+
+(defmacro url-future-cancelled-p (url-future)
+  `(eq (url-future-status ,url-future) 'cancel))
+
+(defun url-future-finish (url-future &optional status)
+  (if (url-future-done-p url-future)
+      (signal 'error 'url-future-already-done)
+    (setf (url-future-status url-future) (or status t))
+    ;; the status must be such that the future was completed
+    ;; to run the callback
+    (when (url-future-completed-p url-future)
+      (funcall (or (url-future-callback url-future) 'ignore)
+               url-future))
+    url-future))
+
+(defun url-future-errored (url-future errorcons)
+  (if (url-future-done-p url-future)
+      (signal 'error 'url-future-already-done)
+    (setf (url-future-status url-future) 'error)
+    (setf (url-future-value url-future) errorcons)
+    (funcall (or (url-future-errorback url-future) 'ignore)
+             url-future errorcons)))
+
+(defun url-future-call (url-future)
+  (if (url-future-done-p url-future)
+      (signal 'error 'url-future-already-done)
+    (let ((ff (url-future-value url-future)))
+      (when (functionp ff)
+        (condition-case catcher
+            (setf (url-future-value url-future)
+                  (funcall ff))
+          (error (url-future-errored url-future catcher)))
+        (url-future-value url-future)))
+    (if (url-future-errored-p url-future)
+        url-future
+      (url-future-finish url-future))))
+
+(defun url-future-cancel (url-future)
+  (if (url-future-done-p url-future)
+      (signal 'error 'url-future-already-done)
+    (url-future-finish url-future 'cancel)))
+
+(ert-deftest url-future-test ()
+  (let* ((text "running future")
+         (good (make-url-future :value (lambda () (format text))
+                                :callback (lambda (f) (set 'saver f))))
+         (bad (make-url-future :value (lambda () (/ 1 0))
+                               :errorback (lambda (&rest d) (set 'saver d))))
+         (tocancel (make-url-future :value (lambda () (/ 1 0))
+                                    :callback (lambda (f) (set 'saver f))
+                                    :errorback (lambda (&rest d)
+                                                 (set 'saver d))))
+         saver)
+    (should (equal good (url-future-call good)))
+    (should (equal good saver))
+    (should (equal text (url-future-value good)))
+    (should (url-future-completed-p good))
+    (should-error (url-future-call good))
+    (setq saver nil)
+    (should (equal bad (url-future-call bad)))
+    (should-error (url-future-call bad))
+    (should (equal saver (list bad '(arith-error))))
+    (should (url-future-errored-p bad))
+    (setq saver nil)
+    (should (equal (url-future-cancel tocancel) tocancel))
+    (should-error (url-future-call tocancel))
+    (should (null saver))
+    (should (url-future-cancelled-p tocancel))))
+
+(provide 'url-future)
+;;; url-future.el ends here

lisp/url/url-queue.el

@@ -31,13 +31,15 @@
 (eval-when-compile (require 'cl))
 (require 'browse-url)
 
-(defcustom url-queue-parallel-processes 2
+(defcustom url-queue-parallel-processes 6
   "The number of concurrent processes."
+  :version "24.1"
   :type 'integer
   :group 'url)
 
 (defcustom url-queue-timeout 5
   "How long to let a job live once it's started (in seconds)."
+  :version "24.1"
   :type 'integer
   :group 'url)
 

src/ChangeLog

@@ -1,3 +1,37 @@
+2011-06-01  Dan Nicolaescu  <dann@ics.uci.edu>
+
+	Make it possible to build with GCC-4.6+ -O2 -flto.
+
+	* emacs.c (__malloc_initialize_hook): Mark as EXTERNALLY_VISIBLE.
+
+2011-06-01  Stefan Monnier  <monnier@iro.umontreal.ca>
+
+	* minibuf.c (get_minibuffer, read_minibuf_unwind):
+	Call minibuffer-inactive-mode.
+
+2011-05-31  Juanma Barranquero  <lekktu@gmail.com>
+
+	* makefile.w32-in ($(BLD)/data.$(O), $(BLD)/editfns.$(O)):
+	Update dependencies.
+
+2011-05-31  Dan Nicolaescu  <dann@ics.uci.edu>
+
+	* data.c (init_data): Remove code for UTS, this system is not
+	supported anymore.
+
+2011-05-31  Dan Nicolaescu  <dann@ics.uci.edu>
+
+	Don't force ./temacs to start in terminal mode.
+
+	* frame.c (make_initial_frame): Initialize faces in all cases, not
+	only when CANNOT_DUMP is defined.
+	* dispnew.c (init_display): Remove CANNOT_DUMP condition.
+
+2011-05-31  Dan Nicolaescu  <dann@ics.uci.edu>
+
+	* dispnew.c (add_window_display_history): Use const for the string
+	pointer.  Remove declaration, not needed.
+
 2011-05-31  Paul Eggert  <eggert@cs.ucla.edu>
 
 	Remove arbitrary limit of 2**31 entries in hash tables.  (Bug#8771)
@@ -205,7 +239,7 @@
 
 	merge count_size_as_multibyte, parse_str_to_multibyte
 	* character.c, character.h (count_size_as_multibyte):
-	Renamed from parse_str_to_multibyte; all uses changed.
+	Rename from parse_str_to_multibyte; all uses changed.
 	Check for integer overflow.
 	* insdel.c, lisp.h (count_size_as_multibyte): Remove,
 	since it's now a duplicate of the other.  This is more of

src/bytecode.c

@@ -144,7 +144,7 @@ Lisp_Object Qbytecode;
 #define Bcurrent_column 0151
 #define Bindent_to 0152
 #ifdef BYTE_CODE_SAFE
-#define Bscan_buffer 0153 /* No longer generated as of v18 */
+#define Bscan_buffer 0153 /* No longer generated as of v18.  */
 #endif
 #define Beolp 0154
 #define Beobp 0155
@@ -956,7 +956,7 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth,
 				 save_restriction_save ());
 	  break;
 
-	case Bcatch:		/* FIXME: ill-suited for lexbind */
+	case Bcatch:		/* FIXME: ill-suited for lexbind.  */
 	  {
 	    Lisp_Object v1;
 	    BEFORE_POTENTIAL_GC ();
@@ -966,11 +966,11 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth,
 	    break;
 	  }
 
-	case Bunwind_protect:	/* FIXME: avoid closure for lexbind */
+	case Bunwind_protect:	/* FIXME: avoid closure for lexbind.  */
 	  record_unwind_protect (Fprogn, POP);
 	  break;
 
-	case Bcondition_case:	/* FIXME: ill-suited for lexbind */
+	case Bcondition_case:	/* FIXME: ill-suited for lexbind.  */
 	  {
 	    Lisp_Object handlers, body;
 	    handlers = POP;
@@ -1779,8 +1779,8 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth,
 	    PUSH (*ptr);
 	    break;
 	  }
-	  /* stack-set-0 = discard; stack-set-1 = discard-1-preserve-tos.  */
 	case Bstack_set:
+	  /* stack-set-0 = discard; stack-set-1 = discard-1-preserve-tos.  */
 	  {
 	    Lisp_Object *ptr = top - (FETCH);
 	    *ptr = POP;

src/data.c

@@ -3220,8 +3220,4 @@ init_data (void)
     return;
 #endif /* CANNOT_DUMP */
   signal (SIGFPE, arith_error);
-
-#ifdef uts
-  signal (SIGEMT, arith_error);
-#endif /* uts */
 }

src/dispnew.c

@@ -290,7 +290,6 @@ static int history_idx;
 static unsigned history_tick;
 
 static void add_frame_display_history (struct frame *, int);
-static void add_window_display_history (struct window *, char *, int);
 
 /* Add to the redisplay history how window W has been displayed.
    MSG is a trace containing the information how W's glyph matrix
@@ -298,7 +297,7 @@ static void add_window_display_history (struct window *, char *, int);
    has been interrupted for pending input.  */
 
 static void
-add_window_display_history (struct window *w, char *msg, int paused_p)
+add_window_display_history (struct window *w, const char *msg, int paused_p)
 {
   char *buf;
 
@@ -6234,11 +6233,7 @@ init_display (void)
 	}
     }
 
-  if (!inhibit_window_system && display_arg
+  if (!inhibit_window_system && display_arg)
-#ifndef CANNOT_DUMP
-     && initialized
-#endif
-     )
     {
       Vinitial_window_system = Qx;
 #ifdef HAVE_X11

src/emacs.c

@@ -678,7 +678,7 @@ malloc_initialize_hook (void)
     }
 }
 
-void (*__malloc_initialize_hook) (void) = malloc_initialize_hook;
+void (*__malloc_initialize_hook) (void) EXTERNALLY_VISIBLE = malloc_initialize_hook;
 
 #endif /* DOUG_LEA_MALLOC */
 

src/frame.c

@@ -544,10 +544,8 @@ make_initial_frame (void)
   /* The default value of menu-bar-mode is t.  */
   set_menu_bar_lines (f, make_number (1), Qnil);
 
-#ifdef CANNOT_DUMP
   if (!noninteractive)
     init_frame_faces (f);
-#endif
 
   return f;
 }

src/makefile.w32-in

@@ -654,6 +654,7 @@ $(BLD)/data.$(O) : \
 	$(SRC)/data.c \
 	$(CONFIG_H) \
 	$(EMACS_ROOT)/nt/inc/sys/time.h \
+	$(EMACS_ROOT)/lib/intprops.h \
 	$(LISP_H) \
 	$(SRC)/buffer.h \
 	$(SRC)/ccl.h \
@@ -753,6 +754,7 @@ $(BLD)/editfns.$(O) : \
 	$(EMACS_ROOT)/nt/inc/sys/time.h \
 	$(EMACS_ROOT)/lib/intprops.h \
 	$(EMACS_ROOT)/lib/strftime.h \
+	$(EMACS_ROOT)/lib/verify.h \
 	$(LISP_H) \
 	$(SRC)/atimer.h \
 	$(SRC)/blockinput.h \

src/minibuf.c

@@ -160,7 +160,7 @@ without invoking the usual minibuffer commands.  */)
 }
 
 
-/* Actual minibuffer invocation. */
+/* Actual minibuffer invocation.  */
 
 static Lisp_Object read_minibuf_unwind (Lisp_Object);
 static Lisp_Object run_exit_minibuf_hook (Lisp_Object);
@@ -266,7 +266,7 @@ read_minibuf_noninteractive (Lisp_Object map, Lisp_Object initial,
       error ("Error reading from stdin");
     }
 
-  /* If Lisp form desired instead of string, parse it. */
+  /* If Lisp form desired instead of string, parse it.  */
   if (expflag)
     val = string_to_object (val, CONSP (defalt) ? XCAR (defalt) : defalt);
 
@@ -743,7 +743,7 @@ read_minibuf (Lisp_Object map, Lisp_Object initial, Lisp_Object prompt,
 	}
     }
 
-  /* If Lisp form desired instead of string, parse it. */
+  /* If Lisp form desired instead of string, parse it.  */
   if (expflag)
     val = string_to_object (val, defalt);
 
@@ -755,7 +755,7 @@ read_minibuf (Lisp_Object map, Lisp_Object initial, Lisp_Object prompt,
 
 /* Return a buffer to be used as the minibuffer at depth `depth'.
  depth = 0 is the lowest allowed argument, and that is the value
- used for nonrecursive minibuffer invocations */
+ used for nonrecursive minibuffer invocations.  */
 
 Lisp_Object
 get_minibuffer (int depth)
@@ -793,7 +793,10 @@ get_minibuffer (int depth)
       reset_buffer (XBUFFER (buf));
       record_unwind_protect (Fset_buffer, Fcurrent_buffer ());
       Fset_buffer (buf);
-      Fkill_all_local_variables ();
+      if (!NILP (Ffboundp (intern ("minibuffer-inactive-mode"))))
+	call0 (intern ("minibuffer-inactive-mode"));
+      else
+        Fkill_all_local_variables ();
       unbind_to (count, Qnil);
     }
 
@@ -808,7 +811,7 @@ run_exit_minibuf_hook (Lisp_Object data)
 }
 
 /* This function is called on exiting minibuffer, whether normally or
-   not, and it restores the current window, buffer, etc. */
+   not, and it restores the current window, buffer, etc.  */
 
 static Lisp_Object
 read_minibuf_unwind (Lisp_Object data)
@@ -868,6 +871,12 @@ read_minibuf_unwind (Lisp_Object data)
   windows_or_buffers_changed++;
   XSETFASTINT (XWINDOW (window)->last_modified, 0);
   XSETFASTINT (XWINDOW (window)->last_overlay_modified, 0);
+
+  /* In case the previous minibuffer displayed in this miniwindow is
+     dead, we may keep displaying this buffer (tho it's inactive), so reset it,
+     to make sure we don't leave around bindings and stuff which only
+     made sense during the read_minibuf invocation.  */
+  call0 (intern ("minibuffer-inactive-mode"));
   return Qnil;
 }
 
@@ -978,7 +987,7 @@ Such arguments are used as in `read-from-minibuffer'.)  */)
 		Qnil);
 }
 
-/* Functions that use the minibuffer to read various things. */
+/* Functions that use the minibuffer to read various things.  */
 
 DEFUN ("read-string", Fread_string, Sread_string, 1, 5, 0,
        doc: /* Read a string from the minibuffer, prompting with string PROMPT.
@@ -1146,7 +1155,7 @@ function, instead of the usual behavior.  */)
       args[1] = prompt;
       args[2] = def;
       args[3] = require_match;
-      result = Ffuncall(4, args);
+      result = Ffuncall (4, args);
     }
   return unbind_to (count, result);
 }
@@ -1233,10 +1242,10 @@ is used to further constrain the set of candidates.  */)
 
   while (1)
     {
-      /* Get the next element of the alist, obarray, or hash-table. */
+      /* Get the next element of the alist, obarray, or hash-table.  */
-      /* Exit the loop if the elements are all used up. */
+      /* Exit the loop if the elements are all used up.  */
       /* elt gets the alist element or symbol.
-	 eltstring gets the name to check as a completion. */
+	 eltstring gets the name to check as a completion.  */
 
       if (type == list_table)
 	{
@@ -1278,7 +1287,7 @@ is used to further constrain the set of candidates.  */)
 	    elt = eltstring = HASH_KEY (XHASH_TABLE (collection), idx++);
 	}
 
-      /* Is this element a possible completion? */
+      /* Is this element a possible completion?  */
 
       if (SYMBOLP (eltstring))
 	eltstring = Fsymbol_name (eltstring);
@@ -1291,7 +1300,7 @@ is used to further constrain the set of candidates.  */)
 				      completion_ignore_case ? Qt : Qnil),
 	      EQ (Qt, tem)))
 	{
-	  /* Yes. */
+	  /* Yes.  */
 	  Lisp_Object regexps;
 
 	  /* Ignore this element if it fails to match all the regexps.  */
@@ -1313,7 +1322,7 @@ is used to further constrain the set of candidates.  */)
 	  }
 
 	  /* Ignore this element if there is a predicate
-	     and the predicate doesn't like it. */
+	     and the predicate doesn't like it.  */
 
 	  if (!NILP (predicate))
 	    {
@@ -1415,7 +1424,7 @@ is used to further constrain the set of candidates.  */)
   }
 
   if (NILP (bestmatch))
-    return Qnil;		/* No completions found */
+    return Qnil;		/* No completions found.  */
   /* If we are ignoring case, and there is no exact match,
      and no additional text was supplied,
      don't change the case of what the user typed.  */
@@ -1429,7 +1438,7 @@ is used to further constrain the set of candidates.  */)
     return Qt;
 
   XSETFASTINT (zero, 0);		/* Else extract the part in which */
-  XSETFASTINT (end, bestmatchsize);	/* all completions agree */
+  XSETFASTINT (end, bestmatchsize);	/* all completions agree.  */
   return Fsubstring (bestmatch, zero, end);
 }
 
@@ -1496,10 +1505,10 @@ with a space are ignored unless STRING itself starts with a space.  */)
 
   while (1)
     {
-      /* Get the next element of the alist, obarray, or hash-table. */
+      /* Get the next element of the alist, obarray, or hash-table.  */
-      /* Exit the loop if the elements are all used up. */
+      /* Exit the loop if the elements are all used up.  */
       /* elt gets the alist element or symbol.
-	 eltstring gets the name to check as a completion. */
+	 eltstring gets the name to check as a completion.  */
 
       if (type == 1)
 	{
@@ -1541,7 +1550,7 @@ with a space are ignored unless STRING itself starts with a space.  */)
 	    elt = eltstring = HASH_KEY (XHASH_TABLE (collection), idx++);
 	}
 
-      /* Is this element a possible completion? */
+      /* Is this element a possible completion?  */
 
       if (SYMBOLP (eltstring))
 	eltstring = Fsymbol_name (eltstring);
@@ -1561,7 +1570,7 @@ with a space are ignored unless STRING itself starts with a space.  */)
 				      completion_ignore_case ? Qt : Qnil),
 	      EQ (Qt, tem)))
 	{
-	  /* Yes. */
+	  /* Yes.  */
 	  Lisp_Object regexps;
 
 	  /* Ignore this element if it fails to match all the regexps.  */
@@ -1583,7 +1592,7 @@ with a space are ignored unless STRING itself starts with a space.  */)
 	  }
 
 	  /* Ignore this element if there is a predicate
-	     and the predicate doesn't like it. */
+	     and the predicate doesn't like it.  */
 
 	  if (!NILP (predicate))
 	    {
@@ -1604,7 +1613,7 @@ with a space are ignored unless STRING itself starts with a space.  */)
 		}
 	      if (NILP (tem)) continue;
 	    }
-	  /* Ok => put it on the list. */
+	  /* Ok => put it on the list.  */
 	  allmatches = Fcons (eltstring, allmatches);
 	}
     }
@@ -1810,9 +1819,9 @@ the values STRING, PREDICATE and `lambda'.  */)
 	      if (SYMBOLP (tail))
 		while (1)
 		  {
-		    if (EQ((Fcompare_strings (string, make_number (0), Qnil,
+		    if (EQ (Fcompare_strings (string, make_number (0), Qnil,
 					      Fsymbol_name (tail),
-					      make_number (0) , Qnil, Qt)),
+					      make_number (0) , Qnil, Qt),
 			   Qt))
 		      {
 			tem = tail;
@@ -1836,11 +1845,11 @@ the values STRING, PREDICATE and `lambda'.  */)
 	tem = HASH_KEY (h, i);
       else
 	for (i = 0; i < HASH_TABLE_SIZE (h); ++i)
-	  if (!NILP (HASH_HASH (h, i)) &&
+	  if (!NILP (HASH_HASH (h, i))
-	      EQ (Fcompare_strings (string, make_number (0), Qnil,
+	      && EQ (Fcompare_strings (string, make_number (0), Qnil,
-				    HASH_KEY (h, i), make_number (0) , Qnil,
+				       HASH_KEY (h, i), make_number (0) , Qnil,
-				    completion_ignore_case ? Qt : Qnil),
+				       completion_ignore_case ? Qt : Qnil),
-		  Qt))
+		     Qt))
 	    {
 	      tem = HASH_KEY (h, i);
 	      break;
@@ -1887,7 +1896,7 @@ If the argument FLAG is nil, invoke `try-completion', if it's t, invoke
 `all-completions', otherwise invoke `test-completion'.
 
 The arguments STRING and PREDICATE are as in `try-completion',
-`all-completions', and `test-completion'. */)
+`all-completions', and `test-completion'.  */)
   (Lisp_Object string, Lisp_Object predicate, Lisp_Object flag)
 {
   if (NILP (flag))