Now on revision 104632.
------------------------------------------------------------
revno: 104632
committer: martin rudalics <rudalics@gmx.at>
branch nick: trunk
timestamp: Sun 2011-06-19 12:17:56 +0200
message:
  Provide functions for saving window configurations as Lisp objects.
  
  * window.el (window-list-no-nils, window-state-ignored-parameters)
  (window-state-get-1, window-state-get, window-state-put-list)
  (window-state-put-1, window-state-put-2, window-state-put): New
  functions.
diff:
=== modified file 'lisp/ChangeLog'
--- lisp/ChangeLog	2011-06-19 09:59:58 +0000
+++ lisp/ChangeLog	2011-06-19 10:17:56 +0000
@@ -19,6 +19,10 @@
 	display-buffer-normalize-options-inhibit is non-nil.
 	(frame-auto-delete): New option.
 	(window-deletable-p): Use frame-auto-delete.
+	(window-list-no-nils, window-state-ignored-parameters)
+	(window-state-get-1, window-state-get, window-state-put-list)
+	(window-state-put-1, window-state-put-2, window-state-put): New
+	functions.
 
 2011-06-18  Chong Yidong  <cyd@stupidchicken.com>
 

=== modified file 'lisp/window.el'
--- lisp/window.el	2011-06-19 09:59:58 +0000
+++ lisp/window.el	2011-06-19 10:17:56 +0000
@@ -3500,6 +3500,311 @@
     ;; (bw-finetune wins)
     ;; (message "Done in %d rounds" round)
     ))
+
+;;; Window states, how to get them and how to put them in a window.
+(defsubst window-list-no-nils (&rest args)
+  "Like LIST but do not add nil elements of ARGS."
+  (delq nil (apply 'list args)))
+
+(defvar window-state-ignored-parameters '(quit-restore)
+  "List of window parameters ignored by `window-state-get'.")
+
+(defun window-state-get-1 (window &optional markers)
+  "Helper function for `window-state-get'."
+  (let* ((type
+	  (cond
+	   ((window-vchild window) 'vc)
+	   ((window-hchild window) 'hc)
+	   (t 'leaf)))
+	 (buffer (window-buffer window))
+	 (selected (eq window (selected-window)))
+	 (head
+	  (window-list-no-nils
+	   type
+	   (unless (window-next window) (cons 'last t))
+	   (cons 'clone-number (window-clone-number window))
+	   (cons 'total-height (window-total-size window))
+	   (cons 'total-width (window-total-size window t))
+	   (cons 'normal-height (window-normal-size window))
+	   (cons 'normal-width (window-normal-size window t))
+	   (cons 'splits (window-splits window))
+	   (cons 'nest (window-nest window))
+	   (let (list)
+	     (dolist (parameter (window-parameters window))
+	       (unless (memq (car parameter)
+			     window-state-ignored-parameters)
+		 (setq list (cons parameter list))))
+	     (when list
+	       (cons 'parameters list)))
+	   (when buffer
+	     ;; All buffer related things go in here - make the buffer
+	     ;; current when retrieving `point' and `mark'.
+	     (with-current-buffer (window-buffer window)
+	       (let ((point (if selected (point) (window-point window)))
+		     (start (window-start window))
+		     (mark (mark)))
+		 (window-list-no-nils
+		  'buffer (buffer-name buffer)
+		  (cons 'selected selected)
+		  (when window-size-fixed (cons 'size-fixed window-size-fixed))
+		  (cons 'hscroll (window-hscroll window))
+		  (cons 'fringes (window-fringes window))
+		  (cons 'margins (window-margins window))
+		  (cons 'scroll-bars (window-scroll-bars window))
+		  (cons 'vscroll (window-vscroll window))
+		  (cons 'dedicated (window-dedicated-p window))
+		  (cons 'point (if markers (copy-marker point) point))
+		  (cons 'start (if markers (copy-marker start) start))
+		  (when mark
+		    (cons 'mark (if markers (copy-marker mark) mark)))))))))
+	 (tail
+	  (when (memq type '(vc hc))
+	    (let (list)
+	      (setq window (window-child window))
+	      (while window
+		(setq list (cons (window-state-get-1 window markers) list))
+		(setq window (window-right window)))
+	      (nreverse list)))))
+    (append head tail)))
+
+(defun window-state-get (&optional window markers)
+  "Return state of WINDOW as a Lisp object.
+WINDOW can be any window and defaults to the root window of the
+selected frame.
+
+Optional argument MARKERS non-nil means use markers for sampling
+positions like `window-point' or `window-start'.  MARKERS should
+be non-nil only if the value is used for putting the state back
+in the same session (note that markers slow down processing).
+
+The return value can be used as argument for `window-state-put'
+to put the state recorded here into an arbitrary window.  The
+value can be also stored on disk and read back in a new session."
+  (setq window
+	(if window
+	    (if (window-any-p window)
+		window
+	      (error "%s is not a live or internal window" window))
+	  (frame-root-window)))
+  ;; The return value is a cons whose car specifies some constraints on
+  ;; the size of WINDOW.  The cdr lists the states of the subwindows of
+  ;; WINDOW.
+  (cons
+   ;; Frame related things would go into a function, say `frame-state',
+   ;; calling `window-state-get' to insert the frame's root window.
+   (window-list-no-nils
+    (cons 'min-height (window-min-size window))
+    (cons 'min-width (window-min-size window t))
+    (cons 'min-height-ignore (window-min-size window nil t))
+    (cons 'min-width-ignore (window-min-size window t t))
+    (cons 'min-height-safe (window-min-size window nil 'safe))
+    (cons 'min-width-safe (window-min-size window t 'safe))
+    ;; These are probably not needed.
+    (when (window-size-fixed-p window) (cons 'fixed-height t))
+    (when (window-size-fixed-p window t) (cons 'fixed-width t)))
+   (window-state-get-1 window markers)))
+
+(defvar window-state-put-list nil
+  "Helper variable for `window-state-put'.")
+
+(defun window-state-put-1 (state &optional window ignore totals)
+  "Helper function for `window-state-put'."
+  (let ((type (car state)))
+    (setq state (cdr state))
+    (cond
+     ((eq type 'leaf)
+      ;; For a leaf window just add unprocessed entries to
+      ;; `window-state-put-list'.
+      (setq window-state-put-list
+	    (cons (cons window state) window-state-put-list)))
+     ((memq type '(vc hc))
+      (let* ((horizontal (eq type 'hc))
+	     (total (window-total-size window horizontal))
+	     (first t)
+	     size new)
+	(dolist (item state)
+	  ;; Find the next child window.  WINDOW always points to the
+	  ;; real window that we want to fill with what we find here.
+	  (when (memq (car item) '(leaf vc hc))
+	    (if (assq 'last item)
+		;; The last child window.  Below `window-state-put-1'
+		;; will put into it whatever ITEM has in store.
+		(setq new nil)
+	      ;; Not the last child window, prepare for splitting
+	      ;; WINDOW.  SIZE is the new (and final) size of the old
+	      ;; window.
+	      (setq size
+		    (if totals
+			;; Use total size.
+			(cdr (assq (if horizontal 'total-width 'total-height) item))
+		      ;; Use normalized size and round.
+		      (round (* total
+				(cdr (assq
+				      (if horizontal 'normal-width 'normal-height)
+				      item))))))
+
+	      ;; Use safe sizes, we try to resize later.
+	      (setq size (max size (if horizontal
+				       window-safe-min-height
+				     window-safe-min-width)))
+
+	      (if (window-sizable-p window (- size) horizontal 'safe)
+		  (let* ((window-nest (assq 'nest item)))
+		    ;; We must inherit the nesting, otherwise we might mess
+		    ;; up handling of atomic and side window.
+		    (setq new (split-window window size horizontal)))
+		;; Give up if we can't resize window down to safe sizes.
+		(error "Cannot resize window %s" window))
+
+	      (when first
+		(setq first nil)
+		;; When creating the first child window add for parent
+		;; unprocessed entries to `window-state-put-list'.
+		(setq window-state-put-list
+		      (cons (cons (window-parent window) state)
+			    window-state-put-list))))
+
+	    ;; Now process the current window (either the one we've just
+	    ;; split or the last child of its parent).
+	    (window-state-put-1 item window ignore totals)
+	    ;; Continue with the last window split off.
+	    (setq window new))))))))
+
+(defun window-state-put-2 (ignore)
+  "Helper function for `window-state-put'."
+  (dolist (item window-state-put-list)
+    (let ((window (car item))
+	  (clone-number (cdr (assq 'clone-number item)))
+	  (splits (cdr (assq 'splits item)))
+	  (nest (cdr (assq 'nest item)))
+	  (parameters (cdr (assq 'parameters item)))
+	  (state (cdr (assq 'buffer item))))
+      ;; Put in clone-number.
+      (when clone-number (set-window-clone-number window clone-number))
+      (when splits (set-window-splits window splits))
+      (when nest (set-window-nest window nest))
+      ;; Process parameters.
+      (when parameters
+	(dolist (parameter parameters)
+	  (set-window-parameter window (car parameter) (cdr parameter))))
+      ;; Process buffer related state.
+      (when state
+	;; We don't want to raise an error here so we create a buffer if
+	;; there's none.
+	(set-window-buffer window (get-buffer-create (car state)))
+	(with-current-buffer (window-buffer window)
+	  (set-window-hscroll window (cdr (assq 'hscroll state)))
+	  (apply 'set-window-fringes
+		 (cons window (cdr (assq 'fringes state))))
+	  (let ((margins (cdr (assq 'margins state))))
+	    (set-window-margins window (car margins) (cdr margins)))
+	  (let ((scroll-bars (cdr (assq 'scroll-bars state))))
+	    (set-window-scroll-bars
+	     window (car scroll-bars) (nth 2 scroll-bars) (nth 3 scroll-bars)))
+	  (set-window-vscroll window (cdr (assq 'vscroll state)))
+	  ;; Adjust vertically.
+	  (if (memq window-size-fixed '(t height))
+	      ;; A fixed height window, try to restore the original size.
+	      (let ((delta (- (cdr (assq 'total-height item))
+			      (window-total-height window)))
+		    window-size-fixed)
+		(when (window-resizable-p window delta)
+		  (resize-window window delta)))
+	    ;; Else check whether the window is not high enough.
+	    (let* ((min-size (window-min-size window nil ignore))
+		   (delta (- min-size (window-total-size window))))
+	      (when (and (> delta 0)
+			 (window-resizable-p window delta nil ignore))
+		(resize-window window delta nil ignore))))
+	  ;; Adjust horizontally.
+	  (if (memq window-size-fixed '(t width))
+	      ;; A fixed width window, try to restore the original size.
+	      (let ((delta (- (cdr (assq 'total-width item))
+			      (window-total-width window)))
+		    window-size-fixed)
+		(when (window-resizable-p window delta)
+		  (resize-window window delta)))
+	    ;; Else check whether the window is not wide enough.
+	    (let* ((min-size (window-min-size window t ignore))
+		   (delta (- min-size (window-total-size window t))))
+	      (when (and (> delta 0)
+			 (window-resizable-p window delta t ignore))
+		(resize-window window delta t ignore))))
+	  ;; Set dedicated status.
+	  (set-window-dedicated-p window (cdr (assq 'dedicated state)))
+	  ;; Install positions (maybe we should do this after all windows
+	  ;; have been created and sized).
+	  (ignore-errors
+	    (set-window-start window (cdr (assq 'start state)))
+	    (set-window-point window (cdr (assq 'point state)))
+	    ;; I'm not sure whether we should set the mark here, but maybe
+	    ;; it can be used.
+	    (let ((mark (cdr (assq 'mark state))))
+	      (when mark (set-mark mark))))
+	  ;; Select window if it's the selected one.
+	  (when (cdr (assq 'selected state))
+	    (select-window window)))))))
+
+(defun window-state-put (state &optional window ignore)
+  "Put window state STATE into WINDOW.
+STATE should be the state of a window returned by an earlier
+invocation of `window-state-get'.  Optional argument WINDOW must
+specify a live window and defaults to the selected one.
+
+Optional argument IGNORE non-nil means ignore minimum window
+sizes and fixed size restrictions.  IGNORE equal `safe' means
+subwindows can get as small as `window-safe-min-height' and
+`window-safe-min-width'."
+  (setq window (normalize-live-window window))
+  (let* ((frame (window-frame window))
+	 (head (car state))
+	 ;; We check here (1) whether the total sizes of root window of
+	 ;; STATE and that of WINDOW are equal so we can avoid
+	 ;; calculating new sizes, and (2) if we do have to resize
+	 ;; whether we can do so without violating size restrictions.
+	 (totals
+	  (and (= (window-total-size window)
+		  (cdr (assq 'total-height state)))
+	       (= (window-total-size window t)
+		  (cdr (assq 'total-width state)))))
+	 (min-height (cdr (assq 'min-height head)))
+	 (min-width (cdr (assq 'min-width head)))
+	 window-splits selected)
+    (if (and (not totals)
+	     (or (> min-height (window-total-size window))
+		 (> min-width (window-total-size window t)))
+	     (or (not ignore)
+		 (and (setq min-height
+			    (cdr (assq 'min-height-ignore head)))
+		      (setq min-width
+			    (cdr (assq 'min-width-ignore head)))
+		      (or (> min-height (window-total-size window))
+			  (> min-width (window-total-size window t)))
+		      (or (not (eq ignore 'safe))
+			  (and (setq min-height
+				     (cdr (assq 'min-height-safe head)))
+			       (setq min-width
+				     (cdr (assq 'min-width-safe head)))
+			       (or (> min-height
+				      (window-total-size window))
+				   (> min-width
+				      (window-total-size window t))))))))
+	;; The check above might not catch all errors due to rounding
+	;; issues - so IGNORE equal 'safe might not always produce the
+	;; minimum possible state.  But such configurations hardly make
+	;; sense anyway.
+	(error "Window %s too small to accomodate state" window)
+      (setq state (cdr state))
+      (setq window-state-put-list nil)
+      ;; Work on the windows of a temporary buffer to make sure that
+      ;; splitting proceeds regardless of any buffer local values of
+      ;; `window-size-fixed'.  Release that buffer after the buffers of
+      ;; all live windows have been set by `window-state-put-2'.
+      (with-temp-buffer
+	(set-window-buffer window (current-buffer))
+	(window-state-put-1 state window nil totals)
+	(window-state-put-2 ignore))
+      (window-check frame))))
 
 ;;; Displaying buffers.
 (defconst display-buffer-default-specifiers
------------------------------------------------------------
revno: 104631
committer: martin rudalics <rudalics@gmx.at>
branch nick: trunk
timestamp: Sun 2011-06-19 11:59:58 +0200
message:
  Sanitize processing of display specifiers; new option frame-auto-delete.
  
  * window.el (display-buffer-other-window-means-other-frame):
  Call display-buffer-normalize-alist.
  (display-buffer-normalize-specifiers-1): Rename to
  display-buffer-normalize-argument.  New argument other-frame.
  Rewrite.
  (display-buffer-normalize-specifiers-2): Rename to
  display-buffer-normalize-options.
  (display-buffer-normalize-alist-1): New function.
  (display-buffer-normalize-specifiers-3): Rename to
  display-buffer-normalize-alist.  Call
  display-buffer-normalize-alist-1.
  (display-buffer-normalize-options-inhibit): New variable.
  (display-buffer-normalize-specifiers): Rewrite calling
  display-buffer-normalize-alist,
  display-buffer-normalize-argument, and
  display-buffer-normalize-options.  Don't call the latter if
  display-buffer-normalize-options-inhibit is non-nil.
  (frame-auto-delete): New option.
  (window-deletable-p): Use frame-auto-delete.
diff:
=== modified file 'lisp/ChangeLog'
--- lisp/ChangeLog	2011-06-18 21:12:33 +0000
+++ lisp/ChangeLog	2011-06-19 09:59:58 +0000
@@ -1,3 +1,25 @@
+2011-06-19  Martin Rudalics  <rudalics@gmx.at>
+
+	* window.el (display-buffer-other-window-means-other-frame):
+	Call display-buffer-normalize-alist.
+	(display-buffer-normalize-specifiers-1): Rename to
+	display-buffer-normalize-argument.  New argument other-frame.
+	Rewrite.
+	(display-buffer-normalize-specifiers-2): Rename to
+	display-buffer-normalize-options.
+	(display-buffer-normalize-alist-1): New function.
+	(display-buffer-normalize-specifiers-3): Rename to
+	display-buffer-normalize-alist.  Call
+	display-buffer-normalize-alist-1.
+	(display-buffer-normalize-options-inhibit): New variable.
+	(display-buffer-normalize-specifiers): Rewrite calling
+	display-buffer-normalize-alist,
+	display-buffer-normalize-argument, and
+	display-buffer-normalize-options.  Don't call the latter if
+	display-buffer-normalize-options-inhibit is non-nil.
+	(frame-auto-delete): New option.
+	(window-deletable-p): Use frame-auto-delete.
+
 2011-06-18  Chong Yidong  <cyd@stupidchicken.com>
 
 	* emacs-lisp/rx.el (rx-constituents): Add support for numbered

=== modified file 'lisp/window.el'
--- lisp/window.el	2011-06-18 15:14:35 +0000
+++ lisp/window.el	2011-06-19 09:59:58 +0000
@@ -2244,6 +2244,28 @@
 	(next-window base-window (if nomini 'arg) all-frames))))
 
 ;;; Deleting windows.
+(defcustom frame-auto-delete 'automatic
+  "If non-nil, quitting a window can delete it's frame.
+If this variable is nil, functions that quit a window never
+delete the associated frame.  If this variable equals the symbol
+`automatic', a frame is deleted only if it the window is
+dedicated or was created by `display-buffer'.  If this variable
+is t, a frame can be always deleted, even if it was created by
+`make-frame-command'.  Other values should not be used.
+
+Note that a frame will be effectively deleted if and only if
+another frame still exists.
+
+Functions quitting a window and consequently affected by this
+variable are `switch-to-prev-buffer', `delete-windows-on',
+`replace-buffer-in-windows' and `quit-restore-window'."
+  :type '(choice
+	  (const :tag "Never" nil)
+	  (const :tag "Automatic" automatic)
+	  (const :tag "Always" t))
+  :group 'windows
+  :group 'frames)
+
 (defun window-deletable-p (&optional window)
   "Return t if WINDOW can be safely deleted from its frame.
 Return `frame' if deleting WINDOW should delete its frame
@@ -2259,9 +2281,12 @@
 	(quit-restore (window-parameter window 'quit-restore)))
     (cond
      ((frame-root-window-p window)
-      (when (and (or dedicated
-		     (and (eq (car-safe quit-restore) 'new-frame)
-			  (eq (nth 1 quit-restore) (window-buffer window))))
+      (when (and (or (eq frame-auto-delete t)
+		     (and (eq frame-auto-delete 'automatic)
+			  (or dedicated
+			      (and (eq (car-safe quit-restore) 'new-frame)
+				   (eq (nth 1 quit-restore)
+				       (window-buffer window))))))
 		 (other-visible-frames-p frame))
 	;; WINDOW is the root window of its frame.  Return `frame' but
 	;; only if WINDOW is (1) either dedicated or quit-restore's car
@@ -4940,6 +4965,19 @@
 	  (set-window-parameter window 'window-slot slot))
 	(display-buffer-in-window buffer window specifiers)))))
 
+(defun normalize-buffer-to-display (buffer-or-name)
+  "Normalize BUFFER-OR-NAME argument for buffer display functions.
+If BUFFER-OR-NAME is nil, return the curent buffer.  Else, if a
+buffer specified by BUFFER-OR-NAME exists, return that buffer.
+If no such buffer exists, create a buffer with the name
+BUFFER-OR-NAME and return that buffer."
+  (if buffer-or-name
+      (or (get-buffer buffer-or-name)
+	  (let ((buffer (get-buffer-create buffer-or-name)))
+	    (set-buffer-major-mode buffer)
+	    buffer))
+    (current-buffer)))
+
 (defun display-buffer-other-window-means-other-frame (buffer-or-name &optional label)
   "Return non-nil if BUFFER shall be preferably displayed in another frame.
 BUFFER must be a live buffer or the name of a live buffer.
@@ -4954,30 +4992,17 @@
 The calculation of the return value is exclusively based on the
 user preferences expressed in `display-buffer-alist'."
   (let* ((buffer (normalize-live-buffer buffer-or-name))
-	 (list (display-buffer-normalize-specifiers-3
-		(buffer-name buffer) label))
+	 (list (display-buffer-normalize-alist (buffer-name buffer) label))
 	 (value (assq 'other-window-means-other-frame
 		      (or (car list) (cdr list)))))
     (when value (cdr value))))
 
-(defun normalize-buffer-to-display (buffer-or-name)
-  "Normalize BUFFER-OR-NAME argument for buffer display functions.
-If BUFFER-OR-NAME is nil, return the curent buffer.  Else, if a
-buffer specified by BUFFER-OR-NAME exists, return that buffer.
-If no such buffer exists, create a buffer with the name
-BUFFER-OR-NAME and return that buffer."
-  (if buffer-or-name
-      (or (get-buffer buffer-or-name)
-	  (let ((buffer (get-buffer-create buffer-or-name)))
-	    (set-buffer-major-mode buffer)
-	    buffer))
-    (current-buffer)))
-
-(defun display-buffer-normalize-specifiers-1 (specifiers buffer-name label)
-  "Subroutine of `display-buffer-normalize-specifiers'.
-SPECIFIERS is a list of buffer display specfiers.  BUFFER-NAME is
-the name of the buffer that shall be displayed, LABEL the same
-argument of `display-buffer'."
+(defun display-buffer-normalize-argument (buffer-name specifiers label other-frame)
+  "Normalize second argument of `display-buffer'.
+BUFFER-NAME is the name of the buffer that shall be displayed,
+SPECIFIERS is the second argument of `display-buffer'.  LABEL the
+same argument of `display-buffer'.  OTHER-FRAME non-nil means use
+other-frame for other-windo."
   (let (normalized entry)
     (cond
      ((not specifiers)
@@ -4990,10 +5015,10 @@
 	  (setq normalized (cons specifier normalized)))
 	 ((eq specifier 'other-window)
 	  ;; `other-window' must be treated separately.
-	  (let* ((other-frame (display-buffer-other-window-means-other-frame
-			       buffer-name label))
-		 (entry (assq (if other-frame 'other-frame 'other-window)
-			      display-buffer-macro-specifiers)))
+	  (let ((entry (assq (if other-frame
+				 'other-frame
+			       'other-window)
+			     display-buffer-macro-specifiers)))
 	    (dolist (item (cdr entry))
 	      (setq normalized (cons item normalized)))))
 	 ((symbolp specifier)
@@ -5008,15 +5033,14 @@
      ((setq entry (assq specifiers display-buffer-macro-specifiers))
       ;; A macro specifier.
       (cdr entry))
-     ((or (display-buffer-other-window-means-other-frame buffer-name label)
-	  (with-no-warnings pop-up-frames))
+     ((or other-frame (with-no-warnings pop-up-frames))
       ;; Pop up another frame.
       (cdr (assq 'other-frame display-buffer-macro-specifiers)))
      (t
       ;; In any other case pop up a new window.
       (cdr (assq 'same-frame-other-window display-buffer-macro-specifiers))))))
 
-(defun display-buffer-normalize-specifiers-2 (&optional buffer-or-name)
+(defun display-buffer-normalize-options (buffer-or-name)
   "Subroutine of `display-buffer-normalize-specifiers'.
 BUFFER-OR-NAME is the buffer to display.  This routine provides a
 compatibility layer for the now obsolete Emacs 23 buffer display
@@ -5127,8 +5151,37 @@
 
       specifiers)))
 
-(defun display-buffer-normalize-specifiers-3 (buffer-name label)
-  "Subroutine of `display-buffer-normalize-specifiers'."
+(defun display-buffer-normalize-alist-1 (specifiers label)
+  "Subroutine of `display-buffer-normalize-alist'.
+SPECIFIERS is a list of buffer display specfiers.  LABEL is the
+same argument of `display-buffer'."
+  (let (normalized entry)
+    (cond
+     ((not specifiers)
+      nil)
+     ((listp specifiers)
+      ;; If SPECIFIERS is a list, we assume it is a list of specifiers.
+      (dolist (specifier specifiers)
+	(cond
+	 ((consp specifier)
+	  (setq normalized (cons specifier normalized)))
+	 ((symbolp specifier)
+	  ;; Might be a macro specifier, try to expand it (the cdr is a
+	  ;; list and we have to reverse it later, so do it one at a
+	  ;; time).
+	  (let ((entry (assq specifier display-buffer-macro-specifiers)))
+	    (dolist (item (cdr entry))
+	      (setq normalized (cons item normalized)))))))
+      ;; Reverse list.
+      (nreverse normalized))
+     ((setq entry (assq specifiers display-buffer-macro-specifiers))
+      ;; A macro specifier.
+      (cdr entry)))))
+
+(defun display-buffer-normalize-alist (buffer-name label)
+  "Normalize `display-buffer-alist'.
+BUFFER-NAME must be the name of the buffer that shall be displayed.
+LABEL the corresponding argument of `display-buffer'."
   (let (list-1 list-2)
     (dolist (entry display-buffer-alist)
       (when (and (listp entry)
@@ -5143,10 +5196,10 @@
 					(string-match-p value buffer-name))
 				   (and (eq type 'label) (eq value label)))
 			   (throw 'match t)))))))
-	(let* ((raw (cdr entry))
+	(let* ((specifiers (cdr entry))
 	       (normalized
-		(display-buffer-normalize-specifiers-1 raw buffer-name label)))
-	  (if (assq 'override raw)
+		(display-buffer-normalize-alist-1 specifiers label)))
+	  (if (assq 'override specifiers)
 	      (setq list-1
 		    (if list-1
 			(append list-1 normalized)
@@ -5158,6 +5211,9 @@
 
     (cons list-1 list-2)))
 
+(defvar display-buffer-normalize-options-inhibit nil
+  "If non-nil, `display-buffer' doesn't process obsolete options.")
+
 (defun display-buffer-normalize-specifiers (buffer-name specifiers label)
   "Return normalized specifiers for a buffer matching BUFFER-NAME or LABEL.
 BUFFER-NAME must be a string specifying a valid buffer name.
@@ -5179,14 +5235,18 @@
   component is not set.
 
 - `display-buffer-default-specifiers'."
-  (let* ((list (display-buffer-normalize-specifiers-3 buffer-name label)))
+  (let* ((list (display-buffer-normalize-alist buffer-name label))
+	 (other-frame (assq 'other-window-means-other-frame
+			    (or (car list) (cdr list)))))
     (append
      ;; Overriding user specifiers.
      (car list)
      ;; Application specifiers.
-     (display-buffer-normalize-specifiers-1 specifiers buffer-name label)
+     (display-buffer-normalize-argument
+      buffer-name specifiers label other-frame)
      ;; Emacs 23 compatibility specifiers.
-     (display-buffer-normalize-specifiers-2 buffer-name)
+     (unless display-buffer-normalize-options-inhibit
+       (display-buffer-normalize-options buffer-name))
      ;; Non-overriding user specifiers.
      (cdr list)
      ;; Default specifiers.
------------------------------------------------------------
revno: 104630
author: Teodor Zlatanov <tzz@lifelogs.com>
committer: Katsumi Yamaoka <yamaoka@jpl.org>
branch nick: trunk
timestamp: Sat 2011-06-18 22:23:55 +0000
message:
  auth-source.el (auth-source-netrc-use-gpg-tokens): Replace `auth-source-save-secrets' with a more sensitive alist that can be configured per file.  Experimental, so defaults to 'never.
   (auth-source-netrc-create): Use it.  Still experimental code.
   (with-auth-source-epa-overrides): Use `find-file-hooks' if `find-file-hook' is unbound (XEmacs fix).  Fix backquoting bug.
diff:
=== modified file 'lisp/gnus/ChangeLog'
--- lisp/gnus/ChangeLog	2011-06-16 06:18:18 +0000
+++ lisp/gnus/ChangeLog	2011-06-18 22:23:55 +0000
@@ -1,3 +1,12 @@
+2011-06-18  Teodor Zlatanov  <tzz@lifelogs.com>
+
+	* auth-source.el (auth-source-netrc-use-gpg-tokens): Replace
+	`auth-source-save-secrets' with a more sensitive alist that can be
+	configured per file.  Experimental, so defaults to 'never.
+	(auth-source-netrc-create): Use it.  Still experimental code.
+	(with-auth-source-epa-overrides): Use `find-file-hooks' if
+	`find-file-hook' is unbound (XEmacs fix).  Fix backquoting bug.
+
 2011-06-16  Teodor Zlatanov  <tzz@lifelogs.com>
 
 	* auth-source.el (auth-source-save-secrets): New variable to control if

=== modified file 'lisp/gnus/auth-source.el'
--- lisp/gnus/auth-source.el	2011-06-16 06:18:18 +0000
+++ lisp/gnus/auth-source.el	2011-06-18 22:23:55 +0000
@@ -154,15 +154,30 @@
           (const :tag "Never save" nil)
           (const :tag "Ask" ask)))
 
-(defcustom auth-source-save-secrets nil
-  "If set, auth-source will respect it for password tokens behavior."
+;; TODO: make the default (setq auth-source-netrc-use-gpg-tokens `((,(if (boundp 'epa-file-auto-mode-alist-entry) (car (symbol-value 'epa-file-auto-mode-alist-entry)) "\\.gpg\\'") never) (t gpg)))
+;; TODO: or maybe leave as (setq auth-source-netrc-use-gpg-tokens 'never)
+
+(defcustom auth-source-netrc-use-gpg-tokens 'never
+  "Set this to tell auth-source when to create GPG password
+tokens in netrc files.  It's either an alist or `never'."
   :group 'auth-source
   :version "23.2" ;; No Gnus
   :type `(choice
-          :tag "auth-source new password token behavior"
-          (const :tag "Use GPG tokens" gpg)
-          (const :tag "Save unencrypted" nil)
-          (const :tag "Ask" ask)))
+          (const :tag "Always use GPG password tokens" (t gpg))
+          (const :tag "Never use GPG password tokens" never)
+          (repeat :tag "Use a lookup list"
+                  (list
+                   (choice :tag "Matcher"
+                           (const :tag "Match anything" t)
+                           (const :tag "The EPA encrypted file extensions"
+                                  ,(if (boundp 'epa-file-auto-mode-alist-entry)
+                                       (car (symbol-value
+                                             'epa-file-auto-mode-alist-entry))
+                                     "\\.gpg\\'"))
+                           (regexp :tag "Regular expression"))
+                   (choice :tag "What to do"
+                           (const :tag "Save GPG-encrypted password tokens" gpg)
+                           (const :tag "Don't encrypt tokens" never))))))
 
 (defvar auth-source-magic "auth-source-magic ")
 
@@ -247,9 +262,11 @@
                                           ,@auth-source-protocols-customize))
                                         (list :tag "User" :inline t
                                               (const :format "" :value :user)
-                                              (choice :tag "Personality/Username"
+                                              (choice
+                                               :tag "Personality/Username"
                                                       (const :tag "Any" t)
-                                                      (string :tag "Name")))))))))
+                                                      (string
+                                                       :tag "Name")))))))))
 
 (defcustom auth-source-gpg-encrypt-to t
   "List of recipient keys that `authinfo.gpg' encrypted to.
@@ -950,8 +967,10 @@
                 (remove (symbol-value 'epa-file-handler)
                         file-name-handler-alist)
               file-name-handler-alist))
-         (find-file-hook
-          ',(remove 'epa-file-find-file-hook find-file-hook))
+         (,(if (boundp 'find-file-hook) 'find-file-hook 'find-file-hooks)
+          ',(remove
+             'epa-file-find-file-hook
+             (if (boundp 'find-file-hook) 'find-file-hook 'find-file-hooks)))
          (auto-mode-alist
           ',(if (boundp 'epa-file-auto-mode-alist-entry)
                 (remove (symbol-value 'epa-file-auto-mode-alist-entry)
@@ -1206,19 +1225,34 @@
               (cond
                ((and (null data) (eq r 'secret))
                 ;; Special case prompt for passwords.
-                ;; Respect `auth-source-save-secrets'
-                (let* ((ep (format "Do you want GPG password tokens? (%s)"
-                                   "see `auth-source-save-secrets'"))
+;; TODO: make the default (setq auth-source-netrc-use-gpg-tokens `((,(if (boundp 'epa-file-auto-mode-alist-entry) (car (symbol-value 'epa-file-auto-mode-alist-entry)) "\\.gpg\\'") nil) (t gpg)))
+;; TODO: or maybe leave as (setq auth-source-netrc-use-gpg-tokens 'never)
+                (let* ((ep (format "Use GPG password tokens in %s?" file))
                        (gpg-encrypt
-;;; FIXME: this relies on .gpg files being handled by EPA/EPG
-                        ;; don't put GPG tokens in GPG-encrypted files
-                        (and (not (equal "gpg" (file-name-extension file)))
-                             (or (eq auth-source-save-secrets 'gpg)
-                                 (and (eq auth-source-save-secrets 'ask)
-                                      (setq auth-source-save-secrets
-                                            (and (y-or-n-p ep) 'gpg))))))
+                        (cond
+                         ((eq auth-source-netrc-use-gpg-tokens 'never)
+                          'never)
+                         ((listp auth-source-netrc-use-gpg-tokens)
+                          (let ((check (copy-sequence
+                                        auth-source-netrc-use-gpg-tokens))
+                                item ret)
+                            (while check
+                              (setq item (pop check))
+                              (when (or (eq (car item) t)
+                                        (string-match (car item) file))
+                                (setq ret (cdr item))
+                                (setq check nil)))))
+                         (t 'never)))
                         (plain (read-passwd prompt)))
-                  (if (eq auth-source-save-secrets 'gpg)
+                  ;; ask if we don't know what to do (in which case
+                  ;; auth-source-netrc-use-gpg-tokens must be a list)
+                  (unless gpg-encrypt
+                    (setq gpg-encrypt (if (y-or-n-p ep) 'gpg 'never))
+                    ;; TODO: save the defcustom now? or ask?
+                    (setq auth-source-netrc-use-gpg-tokens
+                          (cons `(,file ,gpg-encrypt)
+                                auth-source-netrc-use-gpg-tokens)))
+                  (if (eq gpg-encrypt 'gpg)
                       (auth-source-epa-make-gpg-token plain file)
                     plain)))
                ((null data)
------------------------------------------------------------
revno: 104629
committer: Chong Yidong <cyd@stupidchicken.com>
branch nick: trunk
timestamp: Sat 2011-06-18 17:12:33 -0400
message:
  Add rx.el support for numbered groups (Bug#8776).
  
  * lisp/emacs-lisp/rx.el (rx-constituents): Add support for numbered groups.
  (rx-submatch-n): New function.
  (rx): Document it.
diff:
=== modified file 'etc/NEWS'
--- etc/NEWS	2011-06-11 17:54:53 +0000
+++ etc/NEWS	2011-06-18 21:12:33 +0000
@@ -1051,6 +1051,9 @@
 ** `set-auto-mode' now respects mode: local variables at the end of files,
 as well as those in the -*- line.
 
+---
+** rx.el has a new `group-n' construct for explicitly numbered groups.
+
 
 * Changes in Emacs 24.1 on non-free operating systems
 

=== modified file 'lisp/ChangeLog'
--- lisp/ChangeLog	2011-06-18 20:17:30 +0000
+++ lisp/ChangeLog	2011-06-18 21:12:33 +0000
@@ -1,5 +1,10 @@
 2011-06-18  Chong Yidong  <cyd@stupidchicken.com>
 
+	* emacs-lisp/rx.el (rx-constituents): Add support for numbered
+	groups (Bug#8776).
+	(rx-submatch-n): New function.
+	(rx): Document it.
+
 	* dired-x.el (dired-mark-unmarked-files): Fix interactive spec
 	(Bug#8768).
 

=== modified file 'lisp/emacs-lisp/rx.el'
--- lisp/emacs-lisp/rx.el	2011-01-25 04:08:28 +0000
+++ lisp/emacs-lisp/rx.el	2011-06-18 21:12:33 +0000
@@ -130,6 +130,8 @@
     (**			. (rx-** 2 nil))   ; SRE
     (submatch		. (rx-submatch 1 nil)) ; SRE
     (group		. submatch)     ; sregex
+    (submatch-n		. (rx-submatch-n 2 nil))
+    (group-n		. submatch-n)
     (zero-or-more	. (rx-kleene 1 nil))
     (one-or-more	. (rx-kleene 1 nil))
     (zero-or-one	. (rx-kleene 1 nil))
@@ -690,6 +692,16 @@
             (mapconcat (lambda (re) (rx-form re ':)) (cdr form) nil))
           "\\)"))
 
+(defun rx-submatch-n (form)
+  "Parse and produce code from FORM, which is `(submatch-n N ...)'."
+  (let ((n (nth 1 form)))
+    (concat "\\(?" (number-to-string n) ":"
+	    (if (= 3 (length form))
+		;; Only one sub-form.
+		(rx-form (nth 2 form))
+	      ;; Several sub-forms implicitly concatenated.
+	      (mapconcat (lambda (re) (rx-form re ':)) (cddr form) nil))
+	    "\\)")))
 
 (defun rx-backref (form)
   "Parse and produce code from FORM, which is `(backref N)'."
@@ -1072,6 +1084,11 @@
      like `and', but makes the match accessible with `match-end',
      `match-beginning', and `match-string'.
 
+`(submatch-n N SEXP1 SEXP2 ...)'
+`(group-n N SEXP1 SEXP2 ...)'
+     like `group', but make it an explicitly-numbered group with
+     group number N.
+
 `(or SEXP1 SEXP2 ...)'
 `(| SEXP1 SEXP2 ...)'
      matches anything that matches SEXP1 or SEXP2, etc.  If all
------------------------------------------------------------
revno: 104628
committer: Chong Yidong <cyd@stupidchicken.com>
branch nick: trunk
timestamp: Sat 2011-06-18 16:17:30 -0400
message:
  * dired-x.el (dired-mark-unmarked-files): Fix interactive spec (Bug#8768).
diff:
=== modified file 'lisp/ChangeLog'
--- lisp/ChangeLog	2011-06-18 19:21:16 +0000
+++ lisp/ChangeLog	2011-06-18 20:17:30 +0000
@@ -1,5 +1,10 @@
 2011-06-18  Chong Yidong  <cyd@stupidchicken.com>
 
+	* dired-x.el (dired-mark-unmarked-files): Fix interactive spec
+	(Bug#8768).
+
+	* replace.el (occur-mode-map): Set occur-edit-mode binding to "e".
+
 	* textmodes/fill.el (default-justification): Add :safe (Bug#8879).
 
 	* cus-face.el (custom-declare-face): Call custom-theme-recalc face

=== modified file 'lisp/dired-x.el'
--- lisp/dired-x.el	2011-04-19 13:44:55 +0000
+++ lisp/dired-x.el	2011-06-18 20:17:30 +0000
@@ -546,11 +546,14 @@
 ;; Returns t if any work was done, nil otherwise.
 (defun dired-mark-unmarked-files (regexp msg &optional unflag-p localp)
   "Mark unmarked files matching REGEXP, displaying MSG.
-REGEXP is matched against the entire file name.
-Does not re-mark files which already have a mark.
+REGEXP is matched against the entire file name.  When called
+interactively, prompt for REGEXP.
 With prefix argument, unflag all those files.
 Optional fourth argument LOCALP is as in `dired-get-filename'."
-  (interactive "P")
+  (interactive
+   (list (dired-read-regexp
+	  "Mark unmarked files matching regexp (default all): ")
+	 nil current-prefix-arg nil))
   (let ((dired-marker-char (if unflag-p ?\s dired-marker-char)))
     (dired-mark-if
      (and
------------------------------------------------------------
revno: 104627
committer: Chong Yidong <cyd@stupidchicken.com>
branch nick: trunk
timestamp: Sat 2011-06-18 15:21:16 -0400
message:
  * lisp/textmodes/fill.el (default-justification): Add :safe (Bug#8879).
diff:
=== modified file 'lisp/ChangeLog'
--- lisp/ChangeLog	2011-06-18 18:49:19 +0000
+++ lisp/ChangeLog	2011-06-18 19:21:16 +0000
@@ -1,5 +1,7 @@
 2011-06-18  Chong Yidong  <cyd@stupidchicken.com>
 
+	* textmodes/fill.el (default-justification): Add :safe (Bug#8879).
+
 	* cus-face.el (custom-declare-face): Call custom-theme-recalc face
 	anytime existing face settings are present (Bug#8889).
 

=== modified file 'lisp/textmodes/fill.el'
--- lisp/textmodes/fill.el	2011-01-25 04:08:28 +0000
+++ lisp/textmodes/fill.el	2011-06-18 19:21:16 +0000
@@ -1054,6 +1054,7 @@
 		 (const full)
 		 (const center)
 		 (const none))
+  :safe 'symbolp
   :group 'fill)
 (make-variable-buffer-local 'default-justification)
------------------------------------------------------------
revno: 104626
committer: Chong Yidong <cyd@stupidchicken.com>
branch nick: trunk
timestamp: Sat 2011-06-18 15:15:06 -0400
message:
  Fixes for GLYPH_DEBUG.
  
  * dispnew.c (add_window_display_history): Use BVAR.
  
  * xdisp.c (debug_method_add): Use BVAR.
  (check_window_end, dump_glyph_matrix, dump_glyph)
  (dump_glyph_row, dump_glyph_string): Convert arglist to ANSI C.
  
  * xfaces.c (check_lface_attrs, check_lface, dump_realized_face):
  Likewise.
  
  * xfns.c (Fx_create_frame, x_create_tip_frame): Delay image cache
  check till after the cache is created in init_frame_faces.
diff:
=== modified file 'src/ChangeLog'
--- src/ChangeLog	2011-06-17 15:18:54 +0000
+++ src/ChangeLog	2011-06-18 19:15:06 +0000
@@ -1,3 +1,17 @@
+2011-06-18  Chong Yidong  <cyd@stupidchicken.com>
+
+	* dispnew.c (add_window_display_history): Use BVAR.
+
+	* xdisp.c (debug_method_add): Use BVAR.
+	(check_window_end, dump_glyph_matrix, dump_glyph)
+	(dump_glyph_row, dump_glyph_string): Convert arglist to ANSI C.
+
+	* xfaces.c (check_lface_attrs, check_lface, dump_realized_face):
+	Likewise.
+
+	* xfns.c (Fx_create_frame, x_create_tip_frame): Delay image cache
+	check till after the cache is created in init_frame_faces.
+
 2011-06-17  Stefan Monnier  <monnier@iro.umontreal.ca>
 
 	* fns.c (Fsafe_length): Yet another int/Lisp_Object mixup.

=== modified file 'src/dispnew.c'
--- src/dispnew.c	2011-06-10 06:55:18 +0000
+++ src/dispnew.c	2011-06-18 19:15:06 +0000
@@ -310,8 +310,8 @@
 	   history_tick++,
 	   w,
 	   ((BUFFERP (w->buffer)
-	     && STRINGP (XBUFFER (w->buffer)->name))
-	    ? SSDATA (XBUFFER (w->buffer)->name)
+	     && STRINGP (BVAR (XBUFFER (w->buffer), name)))
+	    ? SSDATA (BVAR (XBUFFER (w->buffer), name))
 	    : "???"),
 	   paused_p ? " ***paused***" : "");
   strcat (buf, msg);

=== modified file 'src/xdisp.c'
--- src/xdisp.c	2011-06-14 18:57:19 +0000
+++ src/xdisp.c	2011-06-18 19:15:06 +0000
@@ -2248,8 +2248,7 @@
    to be---the last row in the current matrix displaying text.  */
 
 static void
-check_window_end (w)
-     struct window *w;
+check_window_end (struct window *w)
 {
   if (!MINI_WINDOW_P (w)
       && !NILP (w->window_end_valid))
@@ -11147,8 +11146,8 @@
     fprintf (stderr, "%p (%s): %s\n",
 	     w,
 	     ((BUFFERP (w->buffer)
-	       && STRINGP (XBUFFER (w->buffer)->name))
-	      ? SSDATA (XBUFFER (w->buffer)->name)
+	       && STRINGP (BVAR (XBUFFER (w->buffer), name)))
+	      ? SSDATA (BVAR (XBUFFER (w->buffer), name))
 	      : "no buffer"),
 	     buffer);
 }
@@ -16277,9 +16276,7 @@
    GLYPHS > 1 means show glyphs in long form.  */
 
 void
-dump_glyph_matrix (matrix, glyphs)
-     struct glyph_matrix *matrix;
-     int glyphs;
+dump_glyph_matrix (struct glyph_matrix *matrix, int glyphs)
 {
   int i;
   for (i = 0; i < matrix->nrows; ++i)
@@ -16291,10 +16288,7 @@
    the glyph row and area where the glyph comes from.  */
 
 void
-dump_glyph (row, glyph, area)
-     struct glyph_row *row;
-     struct glyph *glyph;
-     int area;
+dump_glyph (struct glyph_row *row, struct glyph *glyph, int area)
 {
   if (glyph->type == CHAR_GLYPH)
     {
@@ -16387,9 +16381,7 @@
    GLYPHS > 1 means show glyphs in long form.  */
 
 void
-dump_glyph_row (row, vpos, glyphs)
-     struct glyph_row *row;
-     int vpos, glyphs;
+dump_glyph_row (struct glyph_row *row, int vpos, int glyphs)
 {
   if (glyphs != 1)
     {
@@ -20470,8 +20462,7 @@
 #if GLYPH_DEBUG
 
 void
-dump_glyph_string (s)
-     struct glyph_string *s;
+dump_glyph_string (struct glyph_string *s)
 {
   fprintf (stderr, "glyph string\n");
   fprintf (stderr, "  x, y, w, h = %d, %d, %d, %d\n",

=== modified file 'src/xfaces.c'
--- src/xfaces.c	2011-06-13 05:15:27 +0000
+++ src/xfaces.c	2011-06-18 19:15:06 +0000
@@ -1858,8 +1858,7 @@
 /* Check consistency of Lisp face attribute vector ATTRS.  */
 
 static void
-check_lface_attrs (attrs)
-     Lisp_Object *attrs;
+check_lface_attrs (Lisp_Object *attrs)
 {
   xassert (UNSPECIFIEDP (attrs[LFACE_FAMILY_INDEX])
 	   || IGNORE_DEFFACE_P (attrs[LFACE_FAMILY_INDEX])
@@ -1930,8 +1929,7 @@
 /* Check consistency of attributes of Lisp face LFACE (a Lisp vector).  */
 
 static void
-check_lface (lface)
-     Lisp_Object lface;
+check_lface (Lisp_Object lface)
 {
   if (!NILP (lface))
     {
@@ -2008,24 +2006,6 @@
 }
 
 
-
-#if 0				/* Seems to be unused.  */
-static Lisp_Object
-internal_resolve_face_name (nargs, args)
-     int nargs;
-     Lisp_Object *args;
-{
-  return Fget (args[0], args[1]);
-}
-
-static Lisp_Object
-resolve_face_name_error (ignore)
-     Lisp_Object ignore;
-{
-  return Qnil;
-}
-#endif
-
 /* Resolve face name FACE_NAME.  If FACE_NAME is a string, intern it
    to make it a symbol.  If FACE_NAME is an alias for another face,
    return that face's name.
@@ -6331,8 +6311,7 @@
 /* Print the contents of the realized face FACE to stderr.  */
 
 static void
-dump_realized_face (face)
-     struct face *face;
+dump_realized_face (struct face *face)
 {
   fprintf (stderr, "ID: %d\n", face->id);
 #ifdef HAVE_X_WINDOWS

=== modified file 'src/xfns.c'
--- src/xfns.c	2011-06-15 18:07:38 +0000
+++ src/xfns.c	2011-06-18 19:15:06 +0000
@@ -3156,10 +3156,6 @@
 
   /* With FRAME_X_DISPLAY_INFO set up, this unwind-protect is safe.  */
   record_unwind_protect (unwind_create_frame, frame);
-#if GLYPH_DEBUG
-  image_cache_refcount = FRAME_IMAGE_CACHE (f)->refcount;
-  dpyinfo_refcount = dpyinfo->reference_count;
-#endif /* GLYPH_DEBUG */
 
   /* These colors will be set anyway later, but it's important
      to get the color reference counts right, so initialize them!  */
@@ -3314,6 +3310,11 @@
      happen.  */
   init_frame_faces (f);
 
+#if GLYPH_DEBUG
+  image_cache_refcount = FRAME_IMAGE_CACHE (f)->refcount;
+  dpyinfo_refcount = dpyinfo->reference_count;
+#endif /* GLYPH_DEBUG */
+
   /* The X resources controlling the menu-bar and tool-bar are
      processed specially at startup, and reflected in the mode
      variables; ignore them here.  */
@@ -4606,10 +4607,6 @@
 #endif /* USE_TOOLKIT_SCROLL_BARS */
   f->icon_name = Qnil;
   FRAME_X_DISPLAY_INFO (f) = dpyinfo;
-#if GLYPH_DEBUG
-  image_cache_refcount = FRAME_IMAGE_CACHE (f)->refcount;
-  dpyinfo_refcount = dpyinfo->reference_count;
-#endif /* GLYPH_DEBUG */
   f->output_data.x->parent_desc = FRAME_X_DISPLAY_INFO (f)->root_window;
   f->output_data.x->explicit_parent = 0;
 
@@ -4721,6 +4718,11 @@
      happen.  */
   init_frame_faces (f);
 
+#if GLYPH_DEBUG
+  image_cache_refcount = FRAME_IMAGE_CACHE (f)->refcount;
+  dpyinfo_refcount = dpyinfo->reference_count;
+#endif /* GLYPH_DEBUG */
+
   f->output_data.x->parent_desc = FRAME_X_DISPLAY_INFO (f)->root_window;
 
   x_figure_window_size (f, parms, 0);
------------------------------------------------------------
revno: 104625
committer: Chong Yidong <cyd@stupidchicken.com>
branch nick: trunk
timestamp: Sat 2011-06-18 14:49:19 -0400
message:
  Fix for disable-theme/defface interaction (Bug#8889).
  
  * lisp/cus-face.el (custom-declare-face): Call custom-theme-recalc face
  anytime existing face settings are present.
diff:
=== modified file 'lisp/ChangeLog'
--- lisp/ChangeLog	2011-06-18 16:23:11 +0000
+++ lisp/ChangeLog	2011-06-18 18:49:19 +0000
@@ -1,5 +1,8 @@
 2011-06-18  Chong Yidong  <cyd@stupidchicken.com>
 
+	* cus-face.el (custom-declare-face): Call custom-theme-recalc face
+	anytime existing face settings are present (Bug#8889).
+
 	* progmodes/delphi.el (delphi-mode-syntax-table): Use defvar.
 	(delphi-mode): Use define-derived-mode to inherit from prog-mode.
 	Remove unused argument.

=== modified file 'lisp/cus-face.el'
--- lisp/cus-face.el	2011-05-08 20:07:38 +0000
+++ lisp/cus-face.el	2011-06-18 18:49:19 +0000
@@ -34,30 +34,33 @@
 (defun custom-declare-face (face spec doc &rest args)
   "Like `defface', but FACE is evaluated as a normal argument."
   (unless (get face 'face-defface-spec)
-    (unless (facep face)
-      ;; If the user has already created the face, respect that.
-      (let ((value (or (get face 'saved-face) spec))
-	    (have-window-system (memq initial-window-system '(x w32))))
-	;; Create global face.
-	(make-empty-face face)
-	;; Create frame-local faces
-	(dolist (frame (frame-list))
-	  (face-spec-set-2 face frame value)
-	  (when (memq (window-system frame) '(x w32 ns))
-	    (setq have-window-system t)))
-	;; When making a face after frames already exist
-	(if have-window-system
-	    (make-face-x-resource-internal face))))
-    ;; Don't record SPEC until we see it causes no errors.
-    (put face 'face-defface-spec (purecopy spec))
-    (push (cons 'defface face) current-load-list)
-    (when (and doc (null (face-documentation face)))
-      (set-face-documentation face (purecopy doc)))
-    (custom-handle-all-keywords face args 'custom-face)
-    (run-hooks 'custom-define-hook)
-    ;; If the face has an existing theme setting, recalculate it.
-    (if (get face 'theme-face)
-	(custom-theme-recalc-face face)))
+    (let ((facep (facep face)))
+      (unless facep
+	;; If the user has already created the face, respect that.
+	(let ((value (or (get face 'saved-face) spec))
+	      (have-window-system (memq initial-window-system '(x w32))))
+	  ;; Create global face.
+	  (make-empty-face face)
+	  ;; Create frame-local faces
+	  (dolist (frame (frame-list))
+	    (face-spec-set-2 face frame value)
+	    (when (memq (window-system frame) '(x w32 ns))
+	      (setq have-window-system t)))
+	  ;; When making a face after frames already exist
+	  (if have-window-system
+	      (make-face-x-resource-internal face))))
+      ;; Don't record SPEC until we see it causes no errors.
+      (put face 'face-defface-spec (purecopy spec))
+      (push (cons 'defface face) current-load-list)
+      (when (and doc (null (face-documentation face)))
+	(set-face-documentation face (purecopy doc)))
+      (custom-handle-all-keywords face args 'custom-face)
+      (run-hooks 'custom-define-hook)
+      ;; If the face had existing settings, recalculate it.  For
+      ;; example, the user might load a theme with a face setting, and
+      ;; later load a library defining that face.
+      (if facep
+	  (custom-theme-recalc-face face))))
   face)
 
 ;;; Face attributes.
------------------------------------------------------------
revno: 104624
committer: Chong Yidong <cyd@stupidchicken.com>
branch nick: trunk
timestamp: Sat 2011-06-18 12:23:11 -0400
message:
  Use define-derived-mode in delphi-mode.
  
  * lisp/progmodes/delphi.el (delphi-mode-syntax-table): Use defvar.
  (delphi-mode): Use define-derived-mode to inherit from prog-mode.
  Remove unused argument.
diff:
=== modified file 'lisp/ChangeLog'
--- lisp/ChangeLog	2011-06-18 15:14:35 +0000
+++ lisp/ChangeLog	2011-06-18 16:23:11 +0000
@@ -1,3 +1,9 @@
+2011-06-18  Chong Yidong  <cyd@stupidchicken.com>
+
+	* progmodes/delphi.el (delphi-mode-syntax-table): Use defvar.
+	(delphi-mode): Use define-derived-mode to inherit from prog-mode.
+	Remove unused argument.
+
 2011-06-18  Martin Rudalics  <rudalics@gmx.at>
 
 	* window.el (display-buffer-default-specifiers): Remove

=== modified file 'lisp/progmodes/delphi.el'
--- lisp/progmodes/delphi.el	2011-04-22 18:44:26 +0000
+++ lisp/progmodes/delphi.el	2011-06-18 16:23:11 +0000
@@ -1959,12 +1959,12 @@
     kmap)
   "Keymap used in Delphi mode.")
 
-(defconst delphi-mode-syntax-table (make-syntax-table)
+(defvar delphi-mode-syntax-table nil
   "Delphi mode's syntax table.  It is just a standard syntax table.
 This is ok since we do our own keyword/comment/string face coloring.")
 
 ;;;###autoload
-(defun delphi-mode (&optional skip-initial-parsing)
+(define-derived-mode delphi-mode prog-mode "Delphi"
   "Major mode for editing Delphi code. \\<delphi-mode-map>
 \\[delphi-tab]\t- Indents the current line (or region, if Transient Mark mode
 \t  is enabled and the region is active) of Delphi code.
@@ -2007,14 +2007,6 @@
 
 Turning on Delphi mode calls the value of the variable `delphi-mode-hook'
 with no args, if that value is non-nil."
-  (interactive)
-  (kill-all-local-variables)
-  (use-local-map delphi-mode-map)
-  (setq major-mode 'delphi-mode)        ;FIXME: Use define-derived-mode.
-  (setq mode-name "Delphi")
-
-  (setq local-abbrev-table delphi-mode-abbrev-table)
-  (set-syntax-table delphi-mode-syntax-table)
 
   ;; Buffer locals:
   (mapc #'(lambda (var)
@@ -2033,12 +2025,12 @@
   (add-hook 'after-change-functions 'delphi-after-change nil t)
 
   (widen)
-  (unless skip-initial-parsing
-    (delphi-save-excursion
-     (let ((delphi-verbose t))
-       (delphi-progress-start)
-       (delphi-parse-region (point-min) (point-max))
-       (delphi-progress-done))))
+
+  (delphi-save-excursion
+   (let ((delphi-verbose t))
+     (delphi-progress-start)
+     (delphi-parse-region (point-min) (point-max))
+     (delphi-progress-done)))
 
   (run-mode-hooks 'delphi-mode-hook))
------------------------------------------------------------
revno: 104623
committer: martin rudalics <rudalics@gmx.at>
branch nick: trunk
timestamp: Sat 2011-06-18 17:14:35 +0200
message:
  One more fix for display-buffer-normalize-specifiers-1.
  
  * window.el (display-buffer-normalize-specifiers-1): Fix thinko.
diff:
=== modified file 'lisp/ChangeLog'
--- lisp/ChangeLog	2011-06-18 14:23:14 +0000
+++ lisp/ChangeLog	2011-06-18 15:14:35 +0000
@@ -9,6 +9,7 @@
 	pop-up-windows is unset.  Add a reuse-window specifier for the
 	case popping up a new window fails.
 	(special-display-popup-frame): Remove double quoting.
+	(display-buffer-normalize-specifiers-1): Fix thinko.
 
 2011-06-17  Stefan Monnier  <monnier@iro.umontreal.ca>
 

=== modified file 'lisp/window.el'
--- lisp/window.el	2011-06-18 14:23:14 +0000
+++ lisp/window.el	2011-06-18 15:14:35 +0000
@@ -5009,7 +5009,8 @@
       ;; A macro specifier.
       (cdr entry))
      ((or (display-buffer-other-window-means-other-frame buffer-name label)
-	  (with-no-warnings (not pop-up-frames)))
+	  (with-no-warnings pop-up-frames))
+      ;; Pop up another frame.
       (cdr (assq 'other-frame display-buffer-macro-specifiers)))
      (t
       ;; In any other case pop up a new window.
------------------------------------------------------------
revno: 104622
committer: martin rudalics <rudalics@gmx.at>
branch nick: trunk
timestamp: Sat 2011-06-18 16:23:14 +0200
message:
  Additional fixes in handling of buffer display specifiers.
  
  * window.el (display-buffer-default-specifiers): Remove
  pop-up-frame.  Add pop-up-window-min-height,
  pop-up-window-min-width, and another reuse-window specifier
  (Bug#8882).  Reported by Dan Nicolaescu <dann@gnu.org>.
  (display-buffer-normalize-specifiers-2): Handle
  split-height-threshold and split-width-threshold also when
  pop-up-windows is unset.  Add a reuse-window specifier for the
  case popping up a new window fails.
  (special-display-popup-frame): Remove double quoting.
diff:
=== modified file 'lisp/ChangeLog'
--- lisp/ChangeLog	2011-06-17 18:52:46 +0000
+++ lisp/ChangeLog	2011-06-18 14:23:14 +0000
@@ -1,3 +1,15 @@
+2011-06-18  Martin Rudalics  <rudalics@gmx.at>
+
+	* window.el (display-buffer-default-specifiers): Remove
+	pop-up-frame.  Add pop-up-window-min-height,
+	pop-up-window-min-width, and another reuse-window specifier
+	(Bug#8882).  Reported by Dan Nicolaescu <dann@gnu.org>.
+	(display-buffer-normalize-specifiers-2): Handle
+	split-height-threshold and split-width-threshold also when
+	pop-up-windows is unset.  Add a reuse-window specifier for the
+	case popping up a new window fails.
+	(special-display-popup-frame): Remove double quoting.
+
 2011-06-17  Stefan Monnier  <monnier@iro.umontreal.ca>
 
 	* shell.el (shell-completion-vars): Set pcomplete-termination-string

=== modified file 'lisp/window.el'
--- lisp/window.el	2011-06-17 16:07:55 +0000
+++ lisp/window.el	2011-06-18 14:23:14 +0000
@@ -3480,10 +3480,13 @@
 (defconst display-buffer-default-specifiers
   '((reuse-window nil same visible)
     (pop-up-window (largest . nil) (lru . nil))
-    (pop-up-frame)
+    (pop-up-window-min-height . 40)
+    (pop-up-window-min-width . 80)
+    (reuse-window other nil nil)
     (pop-up-frame-alist
      (height . 24) (width . 80) (unsplittable . t))
     (reuse-window nil other visible)
+    (reuse-window nil nil t)
     (reuse-window-even-sizes . t))
   "Buffer display default specifiers.
 The value specified here is used when no other specifiers have
@@ -5045,15 +5048,23 @@
 	    (min-width (if (numberp split-width-threshold)
 			   (/ split-width-threshold 2)
 			 1.0)))
-	(when pop-up-window
+	;; Create an entry only if a default value was changed.
+	(when (or pop-up-window
+		  (not (equal split-height-threshold 80))
+		  (not (equal split-width-threshold 160)))
+	  ;; `reuse-window' (needed as fallback when popping up the new
+	  ;; window fails).
+	  (setq specifiers
+		(cons (list 'reuse-window 'other nil nil)
+		      specifiers))
+	  ;; `split-width-threshold'
+	  (setq specifiers
+		(cons (cons 'pop-up-window-min-width min-width)
+		      specifiers))
 	  ;; `split-height-threshold'
 	  (setq specifiers
 		(cons (cons 'pop-up-window-min-height min-height)
 		      specifiers))
-	  ;; `split-width-threshold'
-	  (setq specifiers
-		(cons (cons 'pop-up-window-min-width min-width)
-		      specifiers))
 	  ;; `pop-up-window'
 	  (setq specifiers
 		(cons (list 'pop-up-window
@@ -5663,7 +5674,7 @@
        ;; Reuse the current window if the user requested it.
        (when (cdr (assq 'same-window args))
 	 (display-buffer-reuse-window
-	  buffer '(same nil nil) '((reuse-dedicated . 'weak))))
+	  buffer '(same nil nil) '((reuse-dedicated . weak))))
        ;; Stay on the same frame if requested.
        (when (or (cdr (assq 'same-frame args))
 		 (cdr (assq 'same-window args)))
------------------------------------------------------------
revno: 104621
committer: Stefan Monnier <monnier@iro.umontreal.ca>
branch nick: trunk
timestamp: Fri 2011-06-17 14:52:46 -0400
message:
  * lisp/pcomplete.el: Convert to lexical binding and fix bug#8819.
  (pcomplete-suffix-list): Mark as obsolete.
  (pcomplete-completions-at-point): Capture pcomplete-norm-func and
  pcomplete-seen in the closure.
  (pcomplete-comint-setup): Setup completion-at-point as well.
  (pcomplete--entries): New function.
  (pcomplete--env-regexp): New var.
  (pcomplete-entries): Rewrite to work with partial-completion and
  without relying on pcomplete-suffix-list.
  (pcomplete-pare-list): Remove, unused.
  * lisp/shell.el (shell-completion-vars): Set pcomplete-termination-string
  according to comint-completion-addsuffix.
diff:
=== modified file 'lisp/ChangeLog'
--- lisp/ChangeLog	2011-06-17 14:50:11 +0000
+++ lisp/ChangeLog	2011-06-17 18:52:46 +0000
@@ -1,3 +1,19 @@
+2011-06-17  Stefan Monnier  <monnier@iro.umontreal.ca>
+
+	* shell.el (shell-completion-vars): Set pcomplete-termination-string
+	according to comint-completion-addsuffix.
+
+	* pcomplete.el: Convert to lexical binding and fix bug#8819.
+	(pcomplete-suffix-list): Mark as obsolete.
+	(pcomplete-completions-at-point): Capture pcomplete-norm-func and
+	pcomplete-seen in the closure.
+	(pcomplete-comint-setup): Setup completion-at-point as well.
+	(pcomplete--entries): New function.
+	(pcomplete--env-regexp): New var.
+	(pcomplete-entries): Rewrite to work with partial-completion and
+	without relying on pcomplete-suffix-list.
+	(pcomplete-pare-list): Remove, unused.
+
 2011-06-17  Martin Rudalics  <rudalics@gmx.at>
 
 	* window.el (display-buffer-alist): Set pop-up-window-min-height

=== modified file 'lisp/pcomplete.el'
--- lisp/pcomplete.el	2011-05-24 02:45:50 +0000
+++ lisp/pcomplete.el	2011-06-17 18:52:46 +0000
@@ -1,4 +1,4 @@
-;;; pcomplete.el --- programmable completion
+;;; pcomplete.el --- programmable completion -*- lexical-binding: t -*-
 
 ;; Copyright (C) 1999-2011 Free Software Foundation, Inc.
 
@@ -154,6 +154,7 @@
   "A list of characters which constitute a proper suffix."
   :type '(repeat character)
   :group 'pcomplete)
+(make-obsolete-variable 'pcomplete-suffix-list nil "24.1")
 
 (defcustom pcomplete-recexact nil
   "If non-nil, use shortest completion if characters cannot be added.
@@ -501,18 +502,16 @@
                  ;; practice it should work just fine (fingers crossed).
                  (let ((prefixes (pcomplete--common-quoted-suffix
                                   pcomplete-stub buftext)))
-                   (apply-partially
-                    'pcomplete--table-subvert
-                    completions
-                    (cdr prefixes) (car prefixes))))
+                   (apply-partially #'pcomplete--table-subvert
+                                    completions
+                                    (cdr prefixes) (car prefixes))))
                 (t
-                 (lexical-let ((completions completions))
-                   (lambda (string pred action)
-                     (let ((res (complete-with-action
-                                 action completions string pred)))
-                       (if (stringp res)
-                           (pcomplete-quote-argument res)
-                         res)))))))
+                 (lambda (string pred action)
+                   (let ((res (complete-with-action
+                               action completions string pred)))
+                     (if (stringp res)
+                         (pcomplete-quote-argument res)
+                       res))))))
               (pred
                ;; Pare it down, if applicable.
                (when (and pcomplete-use-paring pcomplete-seen)
@@ -521,12 +520,13 @@
                                  (funcall pcomplete-norm-func
                                           (directory-file-name f)))
                                pcomplete-seen))
-                 (lambda (f)
-                   (not (when pcomplete-seen
-                          (member
-                           (funcall pcomplete-norm-func
-                                    (directory-file-name f))
-                           pcomplete-seen)))))))
+                 ;; Capture the dynbound values for later use.
+                 (let ((norm-func pcomplete-norm-func)
+                       (seen pcomplete-seen))
+                   (lambda (f)
+                     (not (member
+                           (funcall norm-func (directory-file-name f))
+                           seen)))))))
           (when pcomplete-ignore-case
             (setq table
                   (apply-partially #'completion-table-case-fold table)))
@@ -780,6 +780,8 @@
 this is `comint-dynamic-complete-functions'."
   (set (make-local-variable 'pcomplete-parse-arguments-function)
        'pcomplete-parse-comint-arguments)
+  (add-hook 'completion-at-point-functions
+            'pcomplete-completions-at-point nil 'local)
   (set (make-local-variable completef-sym)
        (copy-sequence (symbol-value completef-sym)))
   (let* ((funs (symbol-value completef-sym))
@@ -887,15 +889,46 @@
 
 (defsubst pcomplete-dirs-or-entries (&optional regexp predicate)
   "Return either directories, or qualified entries."
-  ;; FIXME: pcomplete-entries doesn't return a list any more.
   (pcomplete-entries
    nil
-   (lexical-let ((re regexp)
-                 (pred predicate))
-     (lambda (f)
-       (or (file-directory-p f)
-           (and (if (not re) t (string-match re f))
-                (if (not pred) t (funcall pred f))))))))
+   (lambda (f)
+     (or (file-directory-p f)
+         (and (or (null regexp) (string-match regexp f))
+              (or (null predicate) (funcall predicate f)))))))
+
+(defun pcomplete--entries (&optional regexp predicate)
+  "Like `pcomplete-entries' but without env-var handling."
+  (let* ((ign-pred
+          (when (or pcomplete-file-ignore pcomplete-dir-ignore)
+            ;; Capture the dynbound value for later use.
+            (let ((file-ignore pcomplete-file-ignore)
+                  (dir-ignore pcomplete-dir-ignore))
+              (lambda (file)
+                (not
+                 (if (eq (aref file (1- (length file))) ?/)
+                     (and dir-ignore (string-match dir-ignore file))
+                   (and file-ignore (string-match file-ignore file))))))))
+         (reg-pred (if regexp (lambda (file) (string-match regexp file))))
+         (pred (cond
+                ((null (or ign-pred reg-pred))  predicate)
+                ((null (or ign-pred predicate)) reg-pred)
+                ((null (or reg-pred predicate)) ign-pred)
+                (t (lambda (f)
+                     (and (or (null reg-pred)  (funcall reg-pred f))
+                          (or (null ign-pred)  (funcall ign-pred f))
+                          (or (null predicate) (funcall predicate f))))))))
+    (lambda (s p a)
+      (if (and (eq a 'metadata) pcomplete-compare-entry-function)
+          `(metadata (cycle-sort-function
+                      . ,(lambda (comps)
+                           (sort comps pcomplete-compare-entry-function)))
+                     ,@(cdr (completion-file-name-table s p a)))
+        (let ((completion-ignored-extensions nil))
+          (completion-table-with-predicate
+           'completion-file-name-table pred 'strict s p a))))))
+
+(defconst pcomplete--env-regexp
+  "\\(?:\\`\\|[^\\]\\)\\(?:\\\\\\\\\\)*\\(\\$\\(?:{\\([^}]+\\)}\\|\\(?2:[[:alnum:]_]+\\)\\)\\)")
 
 (defun pcomplete-entries (&optional regexp predicate)
   "Complete against a list of directory candidates.
@@ -905,65 +938,48 @@
 \(files for which the PREDICATE returns nil will be excluded).
 If no directory information can be extracted from the completed
 component, `default-directory' is used as the basis for completion."
-  (let* ((name (substitute-env-vars pcomplete-stub))
-         (completion-ignore-case pcomplete-ignore-case)
-	 (default-directory (expand-file-name
-			     (or (file-name-directory name)
-				 default-directory)))
-	 above-cutoff)
-    (setq name (file-name-nondirectory name)
-	  pcomplete-stub name)
-    (let ((completions
-	   (file-name-all-completions name default-directory)))
-      (if regexp
-	  (setq completions
-		(pcomplete-pare-list
-		 completions nil
-		 (function
-		  (lambda (file)
-		    (not (string-match regexp file)))))))
-      (if predicate
-	  (setq completions
-		(pcomplete-pare-list
-		 completions nil
-		 (function
-		  (lambda (file)
-		    (not (funcall predicate file)))))))
-      (if (or pcomplete-file-ignore pcomplete-dir-ignore)
-	  (setq completions
-		(pcomplete-pare-list
-		 completions nil
-		 (function
-		  (lambda (file)
-		    (if (eq (aref file (1- (length file)))
-			    ?/)
-			(and pcomplete-dir-ignore
-			     (string-match pcomplete-dir-ignore file))
-		      (and pcomplete-file-ignore
-			   (string-match pcomplete-file-ignore file))))))))
-      (setq above-cutoff (and pcomplete-cycle-cutoff-length
-			     (> (length completions)
-				pcomplete-cycle-cutoff-length)))
-      (sort completions
-	    (function
-	     (lambda (l r)
-	       ;; for the purposes of comparison, remove the
-	       ;; trailing slash from directory names.
-	       ;; Otherwise, "foo.old/" will come before "foo/",
-	       ;; since . is earlier in the ASCII alphabet than
-	       ;; /
-	       (let ((left (if (eq (aref l (1- (length l)))
-				   ?/)
-			       (substring l 0 (1- (length l)))
-			     l))
-		     (right (if (eq (aref r (1- (length r)))
-				    ?/)
-				(substring r 0 (1- (length r)))
-			      r)))
-		 (if above-cutoff
-		     (string-lessp left right)
-		   (funcall pcomplete-compare-entry-function
-			    left right)))))))))
+  ;; FIXME: The old code did env-var expansion here, so we reproduce this
+  ;; behavior for now, but really env-var handling should be performed globally
+  ;; rather than here since it also applies to non-file arguments.
+  (let ((table (pcomplete--entries regexp predicate)))
+    (lambda (string pred action)
+      (let ((strings nil)
+            (orig-length (length string)))
+        ;; Perform env-var expansion.
+        (while (string-match pcomplete--env-regexp string)
+          (push (substring string 0 (match-beginning 1)) strings)
+          (push (getenv (match-string 2 string)) strings)
+          (setq string (substring string (match-end 1))))
+        (if (not (and strings
+                      (or (eq action t)
+                          (eq (car-safe action) 'boundaries))))
+            (let ((newstring
+                   (mapconcat 'identity (nreverse (cons string strings)) "")))
+              ;; FIXME: We could also try to return unexpanded envvars.
+              (complete-with-action action table newstring pred))
+          (let* ((envpos (apply #'+ (mapcar #' length strings)))
+                 (newstring
+                  (mapconcat 'identity (nreverse (cons string strings)) ""))
+                 (bounds (completion-boundaries newstring table pred
+                                                (or (cdr-safe action) ""))))
+            (if (>= (car bounds) envpos)
+                ;; The env-var is "out of bounds".
+                (if (eq action t)
+                    (complete-with-action action table newstring pred)
+                  (list* 'boundaries
+                         (+ (car bounds) (- orig-length (length newstring)))
+                         (cdr bounds)))
+              ;; The env-var is in the file bounds.
+              (if (eq action t)
+                  (let ((comps (complete-with-action
+                                action table newstring pred))
+                        (len (- envpos (car bounds))))
+                    ;; Strip the part of each completion that's actually
+                    ;; coming from the env-var.
+                    (mapcar (lambda (s) (substring s len)) comps))
+                (list* 'boundaries
+                       (+ envpos (- orig-length (length newstring)))
+                       (cdr bounds))))))))))
 
 (defsubst pcomplete-all-entries (&optional regexp predicate)
   "Like `pcomplete-entries', but doesn't ignore any entries."
@@ -1343,25 +1359,6 @@
 
 ;; general utilities
 
-(defun pcomplete-pare-list (l r &optional pred)
-  "Destructively remove from list L all elements matching any in list R.
-Test is done using `equal'.
-If PRED is non-nil, it is a function used for further removal.
-Returns the resultant list."
-  (while (and l (or (and r (member (car l) r))
-		    (and pred
-			 (funcall pred (car l)))))
-    (setq l (cdr l)))
-  (let ((m l))
-    (while m
-      (while (and (cdr m)
-		  (or (and r (member (cadr m) r))
-		      (and pred
-			   (funcall pred (cadr m)))))
-	(setcdr m (cddr m)))
-      (setq m (cdr m))))
-  l)
-
 (defun pcomplete-uniqify-list (l)
   "Sort and remove multiples in L."
   (setq l (sort l 'string-lessp))

=== modified file 'lisp/shell.el'
--- lisp/shell.el	2011-06-04 12:31:34 +0000
+++ lisp/shell.el	2011-06-17 18:52:46 +0000
@@ -398,6 +398,12 @@
   (set (make-local-variable 'pcomplete-parse-arguments-function)
        ;; FIXME: This function should be moved to shell.el.
        #'pcomplete-parse-comint-arguments)
+  (set (make-local-variable 'pcomplete-termination-string)
+       (cond ((not comint-completion-addsuffix) "")
+             ((stringp comint-completion-addsuffix)
+              comint-completion-addsuffix)
+             ((not (consp comint-completion-addsuffix)) " ")
+             (t (cdr comint-completion-addsuffix))))
   ;; Don't use pcomplete's defaulting mechanism, rely on
   ;; shell-dynamic-complete-functions instead.
   (set (make-local-variable 'pcomplete-default-completion-function) #'ignore)