upstream

10 files changed, 145 insertions, 57 deletions

diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index 2bd92de45e7..5eac93fa444 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,3 +1,41 @@
+2012-06-19  Glenn Morris  <rgm@gnu.org>
+
+        * progmodes/python.el (python-mode): Derive from prog-mode.
+
+2012-06-19  Kevin Gallagher  <Kevin.Gallagher@boeing.com>
+
+        * emulation/edt.el (edt-default-menu-bar-update-buffers)
+        (edt-user-menu-bar-update-buffers): New functions.
+        (edt-default-emulation-setup, edt-user-emulation-setup): Use them.
+
+2012-06-19  Chong Yidong  <cyd@gnu.org>
+
+        * subr.el (with-selected-window): Preserve the selected window's
+        terminal's top-frame (Bug#4702).
+
+        * window.el (save-selected-window): Likewise.
+
+2012-06-18  Stefan Monnier  <monnier@iro.umontreal.ca>
+
+        * progmodes/python.el (python-rx-constituents): Move backquote.
+        (python-skeleton-define, python-define-auxiliary-skeleton):
+        Use `declare'.
+
+2012-06-18  Michael Albinus  <michael.albinus@gmx.de>
+
+        * minibuffer.el (read-file-name-default): Revert the patch from
+        2012-06-17.
+
+2012-06-18  Stefan Monnier  <monnier@iro.umontreal.ca>
+
+        * emacs-lisp/pcase.el (pcase--expand): Warn for unused pattern.
+        (pcase--u1, pcase--q1): Don't use apply-partially.
+
+2012-06-18  Glenn Morris  <rgm@gnu.org>
+
+        * progmodes/python.el (python-proc, python-buffer)
+        (python-send-receive, python-send-string): Fix obsolete versions.
+
 2012-06-18  Martin Rudalics  <rudalics@gmx.at>
 
         * window.el (special-display-p): Completely remove stringp
diff --git a/lisp/emacs-lisp/byte-run.el b/lisp/emacs-lisp/byte-run.el
index 635eef93d96..925d275386f 100644
--- a/lisp/emacs-lisp/byte-run.el
+++ b/lisp/emacs-lisp/byte-run.el
@@ -123,7 +123,8 @@ the list ARGS... as it appears in the expression,
 and the result should be a form to be evaluated instead of the original.
 DECL is a declaration, optional, of the form (declare DECLS...) where
 DECLS is a list of elements of the form (PROP . VALUES).  These are
-interpreted according to `macro-declarations-alist'."
+interpreted according to `macro-declarations-alist'.
+The return value is undefined."
        (if (stringp docstring) nil
          (if decl (setq body (cons decl body)))
          (setq decl docstring)
@@ -158,6 +159,7 @@ See also the function `interactive'.
 DECL is a declaration, optional, of the form (declare DECLS...) where
 DECLS is a list of elements of the form (PROP . VALUES).  These are
 interpreted according to `defun-declarations-alist'.
+The return value is undefined.
 
 \(fn NAME ARGLIST &optional DOCSTRING DECL &rest BODY)"
   ;; We can't just have `decl' as an &optional argument, because we need
diff --git a/lisp/emacs-lisp/pcase.el b/lisp/emacs-lisp/pcase.el
index 81cffae04bf..f91a1645e21 100644
--- a/lisp/emacs-lisp/pcase.el
+++ b/lisp/emacs-lisp/pcase.el
@@ -237,7 +237,8 @@ of the form (UPAT EXP)."
                       ;; the branch to a separate function.
                       (let ((bsym
                              (make-symbol (format "pcase-%d" (length defs)))))
-                        (push `(,bsym (lambda ,(mapcar #'car prevvars) ,@code)) defs)
+                        (push `(,bsym (lambda ,(mapcar #'car prevvars) ,@code))
+                              defs)
                         (setcar res 'funcall)
                         (setcdr res (cons bsym (mapcar #'cdr prevvars)))
                         (setcar (cddr prev) bsym)
@@ -255,17 +256,26 @@ of the form (UPAT EXP)."
                       ;; FIXME: But if some of `prevvars' are not in `vars' we
                       ;; should remove them from `prevvars'!
                       `(funcall ,res ,@args)))))))
+           (used-cases ())
            (main
             (pcase--u
              (mapcar (lambda (case)
                        `((match ,val . ,(car case))
-                         ,(apply-partially
-                           (if (pcase--small-branch-p (cdr case))
-                               ;; Don't bother sharing multiple
-                               ;; occurrences of this leaf since it's small.
-                               #'pcase-codegen codegen)
-                           (cdr case))))
+                         ,(lambda (vars)
+                            (unless (memq case used-cases)
+                              ;; Keep track of the cases that are used.
+                              (push case used-cases))
+                            (funcall
+                             (if (pcase--small-branch-p (cdr case))
+                                 ;; Don't bother sharing multiple
+                                 ;; occurrences of this leaf since it's small.
+                                 #'pcase-codegen codegen)
+                             (cdr case)
+                             vars))))
                      cases))))
+      (dolist (case cases)
+        (unless (or (memq case used-cases) (eq (car case) 'dontcare))
+          (message "Redundant pcase pattern: %S" (car case))))
       (macroexp-let* defs main))))
 
 (defun pcase-codegen (code vars)
@@ -566,7 +576,7 @@ Otherwise, it defers to REST which is a list of branches of the form
         (if (eq (car upat) 'pred) (put sym 'pcase-used t))
         (let* ((splitrest
                 (pcase--split-rest
-                 sym (apply-partially #'pcase--split-pred upat) rest))
+                 sym (lambda (pat) (pcase--split-pred upat pat)) rest))
                (then-rest (car splitrest))
                (else-rest (cdr splitrest)))
           (pcase--if (if (and (eq (car upat) 'pred) (symbolp (cadr upat)))
@@ -636,7 +646,7 @@ Otherwise, it defers to REST which is a list of branches of the form
               (let* ((elems (mapcar 'cadr (cdr upat)))
                      (splitrest
                       (pcase--split-rest
-                       sym (apply-partially #'pcase--split-member elems) rest))
+                       sym (lambda (pat) (pcase--split-member elems pat)) rest))
                      (then-rest (car splitrest))
                      (else-rest (cdr splitrest)))
                 (put sym 'pcase-used t)
@@ -693,7 +703,7 @@ Otherwise, it defers to REST which is a list of branches of the form
            (symd (make-symbol "xcdr"))
            (splitrest (pcase--split-rest
                        sym
-                       (apply-partially #'pcase--split-consp syma symd)
+                       (lambda (pat) (pcase--split-consp syma symd pat))
                        rest))
            (then-rest (car splitrest))
            (else-rest (cdr splitrest))
@@ -716,7 +726,7 @@ Otherwise, it defers to REST which is a list of branches of the form
        (pcase--u else-rest))))
    ((or (integerp qpat) (symbolp qpat) (stringp qpat))
       (let* ((splitrest (pcase--split-rest
-                         sym (apply-partially 'pcase--split-equal qpat) rest))
+                         sym (lambda (pat) (pcase--split-equal qpat pat)) rest))
              (then-rest (car splitrest))
              (else-rest (cdr splitrest)))
       (pcase--if (cond
diff --git a/lisp/emulation/edt.el b/lisp/emulation/edt.el
index fbb2359ca1f..dbd13a01a8b 100644
--- a/lisp/emulation/edt.el
+++ b/lisp/emulation/edt.el
@@ -2071,6 +2071,20 @@ created."
     (setq transient-mark-mode edt-orig-transient-mark-mode))
   (message "Original key bindings restored; EDT Emulation disabled"))
 
+(defun edt-default-menu-bar-update-buffers ()
+  ;; Update edt-default-global-map with latest copy of
+  ;; `global-buffers-menu-map' each time `menu-bar-update-buffers'
+  ;; updates global-map.
+  (define-key edt-default-global-map [menu-bar buffer]
+    (cons "Buffers" global-buffers-menu-map)))
+
+(defun edt-user-menu-bar-update-buffers ()
+  ;; We need to update edt-user-global-map with latest copy of
+  ;; `global-buffers-menu-map' each time `menu-bar-update-buffers'
+  ;; updates global-map.
+  (define-key edt-user-global-map [menu-bar buffer]
+    (cons "Buffers" global-buffers-menu-map)))
+
 (defun edt-default-emulation-setup (&optional user-setup)
   "Setup emulation of DEC's EDT editor.
 Optional argument USER-SETUP non-nil means  called from function
@@ -2110,10 +2124,8 @@ Optional argument USER-SETUP non-nil means  called from function
     (progn
       (fset 'edt-emulation-on (symbol-function 'edt-select-default-global-map))
       (edt-select-default-global-map)))
-  ;; We need to share `global-buffers-menu-map' with the saved global
-  ;; keymap, because `menu-bar-update-buffers' directly changes it.
-  (define-key (current-global-map) [menu-bar buffer]
-    (cons "Buffers" global-buffers-menu-map)))
+  ;; Keep the menu bar Buffers menu up-to-date in edt-default-global-map.
+  (add-hook 'menu-bar-update-hook 'edt-default-menu-bar-update-buffers))
 
 (defun edt-user-emulation-setup ()
   "Setup user custom emulation of DEC's EDT editor."
@@ -2134,7 +2146,9 @@ Optional argument USER-SETUP non-nil means  called from function
   ;; See Info node `edt' for more details, and sample edt-user.el file.
   (if (fboundp 'edt-setup-user-bindings)
       (edt-setup-user-bindings))
-  (edt-select-user-global-map))
+  (edt-select-user-global-map)
+  ;; Keep the menu bar Buffers menu up-to-date in edt-user-global-map.
+  (add-hook 'menu-bar-update-hook 'edt-user-menu-bar-update-buffers))
 
 (defun edt-select-default-global-map()
   "Select default EDT emulation key bindings."
diff --git a/lisp/gnus/ChangeLog b/lisp/gnus/ChangeLog
index 9d9a86ca406..0923ed4db96 100644
--- a/lisp/gnus/ChangeLog
+++ b/lisp/gnus/ChangeLog
@@ -1,3 +1,7 @@
+2012-06-18  Nelson Ferreira  <nelson.ferreira@ieee.org>  (tiny change)
+
+        * gnus-win.el (gnus-configure-frame): Pass an arg to window-dedicated-p.
+
 2012-06-17  Toke Høiland-Jørgensen  <toke@toke.dk>  (tiny change)
 
         * nnmaildir.el (nnmaildir-request-expire-articles): Ensure that `time'
diff --git a/lisp/gnus/gnus-win.el b/lisp/gnus/gnus-win.el
index efe2a319854..bd9ea10fdc4 100644
--- a/lisp/gnus/gnus-win.el
+++ b/lisp/gnus/gnus-win.el
@@ -273,7 +273,9 @@ See the Gnus manual for an explanation of the syntax used.")
               (cond
                ((eq buf (window-buffer (selected-window)))
                 (set-buffer buf))
-               ((eq t (window-dedicated-p))
+               ((eq t (window-dedicated-p
+                       ;; XEmacs version of `window-dedicated-p' requires it.
+                       (selected-window)))
                 ;; If the window is hard-dedicated, we have a problem because
                 ;; we just can't do what we're asked.  But signaling an error,
                 ;; like `switch-to-buffer' would do, is not an option because
diff --git a/lisp/minibuffer.el b/lisp/minibuffer.el
index e4453afe046..a084ed9fb4d 100644
--- a/lisp/minibuffer.el
+++ b/lisp/minibuffer.el
@@ -461,7 +461,7 @@ for use at QPOS."
            (last (last completions)))
         (when (consp last) (setcdr last nil))
         completions))
-        
+
      ((eq action 'completion--unquote)
       (let ((ustring (funcall unquote string))
             (uprefix (funcall unquote (substring string 0 pred))))
@@ -2335,8 +2335,7 @@ See `read-file-name' for the meaning of the arguments."
             (if (consp default-filename)
                 (mapcar 'abbreviate-file-name default-filename)
               (abbreviate-file-name default-filename))))
-  (let ((non-essential t)
-        (insdef (cond
+  (let ((insdef (cond
                  ((and insert-default-directory (stringp dir))
                   (if initial
                       (cons (minibuffer--double-dollars (concat dir initial))
diff --git a/lisp/progmodes/python.el b/lisp/progmodes/python.el
index dfa72a3084a..a43dc1eb1d3 100644
--- a/lisp/progmodes/python.el
+++ b/lisp/progmodes/python.el
@@ -1,4 +1,4 @@
-;;; python.el --- Python's flying circus support for Emacs
+;;; python.el --- Python's flying circus support for Emacs -*- coding: utf-8 -*-
 
 ;; Copyright (C) 2003-2012  Free Software Foundation, Inc.
 
@@ -308,29 +308,31 @@
 
 (eval-when-compile
   (defconst python-rx-constituents
-    (list
-     `(block-start          . ,(rx symbol-start
+    `((block-start          . ,(rx symbol-start
                                    (or "def" "class" "if" "elif" "else" "try"
                                        "except" "finally" "for" "while" "with")
                                    symbol-end))
-     `(decorator            . ,(rx line-start (* space) ?@ (any letter ?_)
+      (decorator            . ,(rx line-start (* space) ?@ (any letter ?_)
                                    (* (any word ?_))))
-     `(defun                . ,(rx symbol-start (or "def" "class") symbol-end))
-     `(if-name-main         . ,(rx line-start "if" (+ space) "__name__"
+      (defun                . ,(rx symbol-start (or "def" "class") symbol-end))
+      (if-name-main         . ,(rx line-start "if" (+ space) "__name__"
                                    (+ space) "==" (+ space)
                                    (any ?' ?\") "__main__" (any ?' ?\")
                                    (* space) ?:))
-     `(symbol-name          . ,(rx (any letter ?_) (* (any word ?_))))
-     `(open-paren           . ,(rx (or "{" "[" "(")))
-     `(close-paren          . ,(rx (or "}" "]" ")")))
-     `(simple-operator      . ,(rx (any ?+ ?- ?/ ?& ?^ ?~ ?| ?* ?< ?> ?= ?%)))
-     `(not-simple-operator  . ,(rx
+      (symbol-name          . ,(rx (any letter ?_) (* (any word ?_))))
+      (open-paren           . ,(rx (or "{" "[" "(")))
+      (close-paren          . ,(rx (or "}" "]" ")")))
+      (simple-operator      . ,(rx (any ?+ ?- ?/ ?& ?^ ?~ ?| ?* ?< ?> ?= ?%)))
+      ;; FIXME: rx should support (not simple-operator).
+      (not-simple-operator  . ,(rx
                                 (not
                                  (any ?+ ?- ?/ ?& ?^ ?~ ?| ?* ?< ?> ?= ?%))))
-     `(operator             . ,(rx (or "+" "-" "/" "&" "^" "~" "|" "*" "<" ">"
+      ;; FIXME: Use regexp-opt.
+      (operator             . ,(rx (or "+" "-" "/" "&" "^" "~" "|" "*" "<" ">"
                                        "=" "%" "**" "//" "<<" ">>" "<=" "!="
                                        "==" ">=" "is" "not")))
-     `(assignment-operator  . ,(rx (or "=" "+=" "-=" "*=" "/=" "//=" "%=" "**="
+      ;; FIXME: Use regexp-opt.
+      (assignment-operator  . ,(rx (or "=" "+=" "-=" "*=" "/=" "//=" "%=" "**="
                                        ">>=" "<<=" "&=" "^=" "|="))))
     "Additional Python specific sexps for `python-rx'"))
 
@@ -1569,10 +1571,10 @@ there for compatibility with CEDET.")
     (get-buffer-process proc-buffer-name)))
 
 (define-obsolete-function-alias
-  'python-proc 'python-shell-internal-get-or-create-process "23.3")
+  'python-proc 'python-shell-internal-get-or-create-process "24.2")
 
 (define-obsolete-variable-alias
-  'python-buffer 'python-shell-internal-buffer "23.3")
+  'python-buffer 'python-shell-internal-buffer "24.2")
 
 (defun python-shell-send-string (string &optional process msg)
   "Send STRING to inferior Python PROCESS.
@@ -1627,10 +1629,10 @@ Returns the output.  See `python-shell-send-string-no-output'."
    (python-shell-internal-get-or-create-process) nil))
 
 (define-obsolete-function-alias
-  'python-send-receive 'python-shell-internal-send-string "23.3")
+  'python-send-receive 'python-shell-internal-send-string "24.2")
 
 (define-obsolete-function-alias
-  'python-send-string 'python-shell-internal-send-string "23.3")
+  'python-send-string 'python-shell-internal-send-string "24.2")
 
 (defun python-shell-send-region (start end)
   "Send the region delimited by START and END to inferior Python process."
@@ -2146,6 +2148,7 @@ the if condition."
   "Define a `python-mode' skeleton using NAME DOC and SKEL.
 The skeleton will be bound to python-skeleton-NAME and will
 be added to `python-mode-abbrev-table'."
+  (declare (indent 2))
   (let* ((name (symbol-name name))
          (function-name (intern (concat "python-skeleton-" name))))
     `(progn
@@ -2156,11 +2159,11 @@ be added to `python-mode-abbrev-table'."
          ,(or doc
               (format "Insert %s statement." name))
          ,@skel))))
-(put 'python-skeleton-define 'lisp-indent-function 2)
 
 (defmacro python-define-auxiliary-skeleton (name doc &optional &rest skel)
   "Define a `python-mode' auxiliary skeleton using NAME DOC and SKEL.
 The skeleton will be bound to python-skeleton-NAME."
+  (declare (indent 2))
   (let* ((name (symbol-name name))
          (function-name (intern (concat "python-skeleton--" name)))
          (msg (format
@@ -2176,7 +2179,6 @@ The skeleton will be bound to python-skeleton-NAME."
        (unless (y-or-n-p ,msg)
          (signal 'quit t))
        ,@skel)))
-(put 'python-define-auxiliary-skeleton 'lisp-indent-function 2)
 
 (python-define-auxiliary-skeleton else nil)
 
@@ -2800,7 +2802,7 @@ Optional argument DIRECTION defines the direction to move to."
 
 
 ;;;###autoload
-(define-derived-mode python-mode fundamental-mode "Python"
+(define-derived-mode python-mode prog-mode "Python"
   "Major mode for editing Python files.
 
 \\{python-mode-map}
diff --git a/lisp/subr.el b/lisp/subr.el
index 473cc3efddd..ba9b06d495b 100644
--- a/lisp/subr.el
+++ b/lisp/subr.el
@@ -3011,24 +3011,29 @@ the buffer list ordering."
   (declare (indent 1) (debug t))
   ;; Most of this code is a copy of save-selected-window.
   `(let* ((save-selected-window-destination ,window)
+          (save-selected-window-frame
+           (window-frame save-selected-window-destination))
           (save-selected-window-window (selected-window))
-          ;; Selecting a window on another frame changes not only the
-          ;; selected-window but also the frame-selected-window of the
-          ;; destination frame.  So we need to save&restore it.
+          ;; Selecting a window on another frame also changes that
+          ;; frame's frame-selected-window.  We must save&restore it.
           (save-selected-window-other-frame
-           (unless (eq (selected-frame)
-                       (window-frame save-selected-window-destination))
-             (frame-selected-window
-              (window-frame save-selected-window-destination)))))
+           (unless (eq (selected-frame) save-selected-window-frame)
+             (frame-selected-window save-selected-window-frame)))
+          (save-selected-window-top-frame
+           (unless (eq (selected-frame) save-selected-window-frame)
+             (tty-top-frame save-selected-window-frame))))
      (save-current-buffer
        (unwind-protect
            (progn (select-window save-selected-window-destination 'norecord)
                   ,@body)
          ;; First reset frame-selected-window.
-         (if (window-live-p save-selected-window-other-frame)
-             ;; We don't use set-frame-selected-window because it does not
-             ;; pass the `norecord' argument to Fselect_window.
-             (select-window save-selected-window-other-frame 'norecord))
+         (when (window-live-p save-selected-window-other-frame)
+           ;; We don't use set-frame-selected-window because it does not
+           ;; pass the `norecord' argument to Fselect_window.
+           (select-window save-selected-window-other-frame 'norecord)
+           (and (frame-live-p save-selected-window-top-frame)
+                (not (eq (tty-top-frame) save-selected-window-top-frame))
+                (select-frame save-selected-window-top-frame 'norecord)))
          ;; Then reset the actual selected-window.
          (when (window-live-p save-selected-window-window)
            (select-window save-selected-window-window 'norecord))))))
diff --git a/lisp/window.el b/lisp/window.el
index 6ea882d1ea2..7c3fe1a082f 100644
--- a/lisp/window.el
+++ b/lisp/window.el
@@ -47,12 +47,24 @@ order of recently selected windows and the buffer list ordering
 are not altered by this macro (unless they are altered in BODY)."
   (declare (indent 0) (debug t))
   `(let ((save-selected-window-window (selected-window))
-         ;; It is necessary to save all of these, because calling
-         ;; select-window changes frame-selected-window for whatever
-         ;; frame that window is in.
+         ;; We save and restore all frames' selected windows, because
+         ;; `select-window' can change the frame-selected-window of
+         ;; whatever frame that window is in.  Each text terminal's
+         ;; top-frame is preserved by putting it last in the list.
          (save-selected-window-alist
-          (mapcar (lambda (frame) (cons frame (frame-selected-window frame)))
-                  (frame-list))))
+          (apply 'append
+                 (mapcar (lambda (terminal)
+                           (let ((frames (frames-on-display-list terminal))
+                                 (top-frame (tty-top-frame terminal))
+                                 alist)
+                             (if top-frame
+                                 (setq frames
+                                       (cons top-frame
+                                             (delq top-frame frames))))
+                             (dolist (f frames)
+                               (push (cons f (frame-selected-window f))
+                                     alist))))
+                         (terminal-list)))))
      (save-current-buffer
        (unwind-protect
            (progn ,@body)