changeset 903:4a27df428c73

[xemacs-hg @ 2002-07-06 05:48:14 by andyp] sync with 21.4
author andyp
date Sat, 06 Jul 2002 05:48:22 +0000
parents 2fd2239ea63a
children 47c30044fc4e
files lisp/ChangeLog lisp/custom.el lisp/frame.el lisp/gutter-items.el lisp/menubar-items.el lisp/printer.el lisp/window-xemacs.el lwlib/ChangeLog lwlib/lwlib-Xm.c src/ChangeLog src/console-msw-impl.h src/console-msw.h src/device-msw.c src/emacs.c src/event-msw.c src/frame-msw.c src/general-slots.h src/glyphs.c src/sheap.c
diffstat 19 files changed, 964 insertions(+), 117 deletions(-) [+]
line wrap: on
line diff
--- a/lisp/ChangeLog	Fri Jul 05 22:15:04 2002 +0000
+++ b/lisp/ChangeLog	Sat Jul 06 05:48:22 2002 +0000
@@ -1,3 +1,45 @@
+2002-06-16  Andy Piper  <andy@xemacs.org>
+
+	* menubar-items.el (default-menubar): enable windows printing on
+	cygwin as well as native.
+
+2002-06-12  Andy Piper  <andy@xemacs.org>
+
+	* printer.el (generic-print-buffer): catch all errors so that the
+	print device can be cleared in all scenarios.
+	(Printer-clear-device): make sure clearing the printer allows it
+	to be used again immediately.
+	(generic-print-region): make sure the default printer face is
+	black-on-white.
+
+2002-04-23  Jerry James  <james@xemacs.org>
+
+	* window-xemacs.el (display-buffer-function): Change doc to
+	reflect new arg.
+	* window-xemacs.el (pre-display-buffer-function): Ditto.
+	* window-xemacs.el (display-buffer): New arg, shrink-to-fit.  If
+	non-nil, make the new window just big enough for its contents.
+	* frame.el (get-frame-for-buffer): Accept new arg, due to above.
+	* frame.el (show-temp-buffer-in-current-frame): Remove broken
+	temp-buffer-shrink-to-fit code.  Tell display-buffer instead.
+
+2002-06-06  Andy Piper  <andy@xemacs.org>
+
+	* gutter-items.el (buffers-tab-filter-functions): fix typo.
+
+2002-06-06  Andy Piper  <andy@xemacs.org>
+
+	* custom.el (custom-theme-set-variables): sync :set-after from FSF.
+	(defcustom): ditto.
+	(custom-handle-keyword): ditto.
+
+2002-06-04  John H Palmieri  <palmieri@math.washington.edu>
+
+	* gutter-items.el (buffers-tab-selection-function): fix
+	documentation, make obsolete.
+	* gutter-items.el (buffers-tab-filter-functions): change default
+	value (but not default behavior), reword documentation.
+
 2002-06-27  Olivier Galibert  <galibert@pobox.com>
 
 	* behavior.el (enabled-behavior-list): Sort the lists for the
--- a/lisp/custom.el	Fri Jul 05 22:15:04 2002 +0000
+++ b/lisp/custom.el	Sat Jul 06 05:48:22 2002 +0000
@@ -194,6 +194,11 @@
 :require VALUE should be a feature symbol.  Each feature will be
         required after initialization, of the user have saved this
         option.
+:version VALUE should be a string specifying that the variable was
+        first introduced, or its default value was changed, in Emacs
+        version VERSION.
+:set-after VARIABLE specifies that SYMBOL should be set after VARIABLE when
+	both have been customized.
 
 Read the section about customization in the Emacs Lisp manual for more
 information."
@@ -330,17 +335,38 @@
   "For customization option SYMBOL, handle KEYWORD with VALUE.
 Fourth argument TYPE is the custom option type."
   (cond ((eq keyword :group)
-         (custom-add-to-group value symbol type))
-        ((eq keyword :version)
-         (custom-add-version symbol value))
-        ((eq keyword :link)
-         (custom-add-link symbol value))
-        ((eq keyword :load)
-         (custom-add-load symbol value))
-        ((eq keyword :tag)
-         (put symbol 'custom-tag value))
-        (t
-         (signal 'error (list "Unknown keyword" keyword)))))
+	 (custom-add-to-group value symbol type))
+	((eq keyword :version)
+	 (custom-add-version symbol value))
+	((eq keyword :link)
+	 (custom-add-link symbol value))
+	((eq keyword :load)
+	 (custom-add-load symbol value))
+	((eq keyword :tag)
+	 (put symbol 'custom-tag value))
+ 	((eq keyword :set-after)
+	 (custom-add-dependencies symbol value))
+	(t
+	 (signal 'error (list "Unknown keyword" keyword)))))
+
+(defun custom-add-dependencies (symbol value)
+  "To the custom option SYMBOL, add dependencies specified by VALUE.
+VALUE should be a list of symbols.  For each symbol in that list,
+this specifies that SYMBOL should be set after the specified symbol, if
+both appear in constructs like `custom-set-variables'."
+  (unless (listp value)
+    (error "Invalid custom dependency `%s'" value))
+  (let* ((deps (get symbol 'custom-dependencies))
+	 (new-deps deps))
+    (while value
+      (let ((dep (car value)))
+	(unless (symbolp dep)
+	  (error "Invalid custom dependency `%s'" dep))
+	(unless (memq dep new-deps)
+	  (setq new-deps (cons dep new-deps)))
+	(setq value (cdr value))))
+    (unless (eq deps new-deps)
+      (put symbol 'custom-dependencies new-deps))))
 
 (defun custom-add-option (symbol option)
   "To the variable SYMBOL add OPTION.
@@ -466,6 +492,27 @@
 
 See `custom-set-variables' for a description of the arguments ARGS."
   (custom-check-theme theme)
+  (setq args
+	(sort args
+	      (lambda (a1 a2)
+		(let* ((sym1 (car a1))
+		       (sym2 (car a2))
+		       (1-then-2 (memq sym1 (get sym2 'custom-dependencies)))
+		       (2-then-1 (memq sym2 (get sym1 'custom-dependencies))))
+		  (cond ((and 1-then-2 2-then-1)
+			 (error "Circular custom dependency between `%s' and `%s'"
+				sym1 sym2))
+			(1-then-2 t)
+			(2-then-1 nil)
+			;; Put symbols with :require last.  The macro
+			;; define-minor-mode generates a defcustom
+			;; with a :require and a :set, where the
+			;; setter function calls the mode function.
+			;; Putting symbols with :require last ensures
+			;; that the mode function will see other
+			;; customized values rather than default
+			;; values.
+			(t (nth 3 a2)))))))
   (let ((immediate (get theme 'theme-immediate)))
     (while args * etc/custom/example-themes/example-theme.el:
       (let ((entry (car args)))
--- a/lisp/frame.el	Fri Jul 05 22:15:04 2002 +0000
+++ b/lisp/frame.el	Sat Jul 06 05:48:22 2002 +0000
@@ -1027,7 +1027,8 @@
 ;; The pre-display-buffer-function is called for effect, so this needs to
 ;; actually select the frame it wants.  Fdisplay_buffer() takes notice of
 ;; changes to the selected frame.
-(defun get-frame-for-buffer (buffer &optional not-this-window-p on-frame)
+(defun get-frame-for-buffer (buffer &optional not-this-window-p on-frame
+				    shrink-to-fit)
   "Select and return a frame in which to display BUFFER.
 Normally, the buffer will simply be displayed in the selected frame.
 But if the symbol naming the major-mode of the buffer has a 'frame-name
@@ -1106,20 +1107,13 @@
 that would otherwise be introduced by the `pre-display-buffer-function', which
 is normally set to `get-frame-for-buffer' (which see)."
   (let ((pre-display-buffer-function nil)) ; turn it off, whatever it is
-    (let ((window (display-buffer buffer)))
+    (let ((window (display-buffer buffer nil nil temp-buffer-shrink-to-fit)))
       (if (not (eq (last-nonminibuf-frame) (window-frame window)))
 	  ;; only the pre-display-buffer-function should ever do this.
 	  (error "display-buffer switched frames on its own!!"))
       (setq minibuffer-scroll-window window)
       (set-window-start window 1) ; obeys narrowing
       (set-window-point window 1)
-      (when temp-buffer-shrink-to-fit
-        (let* ((temp-window-size (round (* temp-buffer-max-height
-                                           (frame-height (window-frame window)))))
-               (size (window-displayed-height window)))
-          (when (< size temp-window-size)
-            (enlarge-window (- temp-window-size size) nil window)))
-        (shrink-window-if-larger-than-buffer window))
       nil)))
 
 (setq pre-display-buffer-function 'get-frame-for-buffer)
--- a/lisp/gutter-items.el	Fri Jul 05 22:15:04 2002 +0000
+++ b/lisp/gutter-items.el	Sat Jul 06 05:48:22 2002 +0000
@@ -49,6 +49,232 @@
 (defvar gutter-buffers-tab-orientation 'top
   "Where the buffers tab currently is. Do not set this.")
 
+(defcustom buffers-tab-max-size 6
+  "*Maximum number of entries which may appear on the \"Buffers\" tab.
+If this is 10, then only the ten most-recently-selected buffers will be
+shown.  If this is nil, then all buffers will be shown.  Setting this to
+a large number or nil will slow down tab responsiveness."
+  :type '(choice (const :tag "Show all" nil)
+		 (integer 6))
+  :group 'buffers-tab)
+
+(defcustom buffers-tab-switch-to-buffer-function 'buffers-tab-switch-to-buffer
+  "*The function to call to select a buffer from the buffers tab.
+`switch-to-buffer' is a good choice, as is `pop-to-buffer'."
+  :type '(radio (function-item switch-to-buffer)
+		(function-item pop-to-buffer)
+		(function :tag "Other"))
+  :group 'buffers-tab)
+
+(defcustom buffers-tab-omit-function 'buffers-menu-omit-invisible-buffers
+  "*If non-nil, a function specifying the buffers to omit from the buffers tab.
+This is passed a buffer and should return non-nil if the buffer should be
+omitted.  The default value `buffers-menu-omit-invisible-buffers' omits
+buffers that are normally considered \"invisible\" (those whose name
+begins with a space)."
+  :type '(choice (const :tag "None" nil)
+		 function)
+  :group 'buffers-tab)
+
+(defvar buffers-tab-selection-function 'select-buffers-tab-buffers-by-mode
+  "*If non-nil, a function specifying the buffers to select in the
+buffers tab.  This is passed two buffers and should return non-nil if
+the first buffer should be selected.  The default value
+`select-buffers-tab-buffers-by-mode' groups buffers by major mode and
+by `buffers-tab-grouping-regexp'.")
+
+(make-obsolete-variable buffers-tab-selection-function
+			"Set `buffers-tab-filter-functions' instead.")
+
+(defcustom buffers-tab-filter-functions (list 'select-buffers-tab-buffers-by-mode)
+  "*If non-nil, a list of functions specifying the buffers to include
+in the buffers tab, depending on the context.
+Each function in the list is passed two buffers, the buffer to
+potentially select and the context buffer, and should return non-nil
+if the first buffer should be selected.  The default value groups
+buffers by major mode and by `buffers-tab-grouping-regexp'."
+
+  :type '(repeat function)
+  :group 'buffers-tab)
+
+(defcustom buffers-tab-sort-function nil
+  "*If non-nil, a function specifying the buffers to select from the
+buffers tab.  This is passed the buffer list and returns the list in the
+order desired for the tab widget.  The default value `nil' leaves the
+list in `buffer-list' order (usual most-recently-selected-first)."
+
+  :type '(choice (const :tag "None" nil)
+		 function)
+  :group 'buffers-tab)
+
+(make-face 'buffers-tab "Face for displaying the buffers tab.")
+(set-face-parent 'buffers-tab 'modeline)
+
+(defcustom buffers-tab-face 'buffers-tab
+  "*Face to use for displaying the buffers tab."
+  :type 'face
+  :group 'buffers-tab)
+
+(defcustom buffers-tab-grouping-regexp 
+  '("^\\(gnus-\\|message-mode\\|mime/viewer-mode\\)"
+    "^\\(emacs-lisp-\\|lisp-\\)")
+  "*If non-nil, a list of regular expressions for buffer grouping.
+Each regular expression is applied to the current major-mode symbol
+name and mode-name, if it matches then any other buffers that match
+the same regular expression be added to the current group."
+  :type '(choice (const :tag "None" nil)
+		 sexp)
+  :group 'buffers-tab)
+
+(defcustom buffers-tab-format-buffer-line-function 'format-buffers-tab-line
+  "*The function to call to return a string to represent a buffer in the
+buffers tab.  The function is passed a buffer and should return a
+string.  The default value `format-buffers-tab-line' just returns the
+name of the buffer, optionally truncated to
+`buffers-tab-max-buffer-line-length'.  Also check out
+`slow-format-buffers-menu-line' which returns a whole bunch of info
+about a buffer."
+  :type 'function
+  :group 'buffers-tab)
+
+(defvar buffers-tab-default-buffer-line-length
+  (make-specifier-and-init 'generic '((global ((default) . 25))) t)
+  "*Maximum length of text which may appear in a \"Buffers\" tab.
+This is a specifier, use set-specifier to modify it.")
+
+(defcustom buffers-tab-max-buffer-line-length 
+  (specifier-instance buffers-tab-default-buffer-line-length)
+  "*Maximum length of text which may appear in a \"Buffers\" tab.
+Buffer names over this length will be truncated with elipses.
+If this is 0, then the full buffer name will be shown."
+  :type '(choice (const :tag "Show all" 0)
+		 (integer 25))
+  :group 'buffers-tab
+  :set #'(lambda (var val)
+	   (set-specifier buffers-tab-default-buffer-line-length val)
+	   (setq buffers-tab-max-buffer-line-length val)))
+
+(defun buffers-tab-switch-to-buffer (buffer)
+  "For use as a value for `buffers-tab-switch-to-buffer-function'."
+  (unless (eq (window-buffer) buffer)
+    ;; this used to add the norecord flag to both calls below.
+    ;; this is bogus because it is a pervasive assumption in XEmacs
+    ;; that the current buffer is at the front of the buffers list.
+    ;; for example, select an item and then do M-C-l
+    ;; (switch-to-other-buffer).  Things get way confused.
+    (if (> (length (windows-of-buffer buffer)) 0)
+	(select-window (car (windows-of-buffer buffer)))
+      (switch-to-buffer buffer))))
+
+(defun select-buffers-tab-buffers-by-mode (buffer-to-select buf1)
+  "For use as a value of `buffers-tab-selection-function'.
+This selects buffers by major mode `buffers-tab-grouping-regexp'."
+  (let ((mode1 (symbol-name (symbol-value-in-buffer 'major-mode buf1)))
+	(mode2 (symbol-name (symbol-value-in-buffer 'major-mode 
+						    buffer-to-select)))
+	(modenm1 (symbol-value-in-buffer 'mode-name buf1))
+	(modenm2 (symbol-value-in-buffer 'mode-name buffer-to-select)))
+    (cond ((or (eq mode1 mode2)
+	       (eq modenm1 modenm2)
+	       (and (string-match "^[^-]+-" mode1)
+		    (string-match
+		     (concat "^" (regexp-quote 
+				  (substring mode1 0 (match-end 0))))
+		     mode2))
+	       (and buffers-tab-grouping-regexp
+		    (find-if #'(lambda (x)
+				 (or
+				  (and (string-match x mode1)
+				       (string-match x mode2))
+				  (and (string-match x modenm1)
+				       (string-match x modenm2))))
+			     buffers-tab-grouping-regexp)))
+	   t)
+	  (t nil))))
+
+(defun format-buffers-tab-line (buffer)
+  "For use as a value of `buffers-tab-format-buffer-line-function'.
+This just returns the buffer's name, optionally truncated."
+  (let ((len (specifier-instance buffers-tab-default-buffer-line-length)))
+    (if (and (> len 0)
+	     (> (length (buffer-name buffer)) len))
+	(if (string-match ".*<.>$" (buffer-name buffer))
+	    (concat (substring (buffer-name buffer) 
+			       0 (- len 6)) "..."
+			       (substring (buffer-name buffer) -3))
+	  (concat (substring (buffer-name buffer)
+			     0 (- len 3)) "..."))
+      (buffer-name buffer))))
+
+(defsubst build-buffers-tab-internal (buffers)
+  (let ((selected t))
+    (mapcar
+     #'(lambda (buffer)
+	 (prog1
+	     (vector 
+	      (funcall buffers-tab-format-buffer-line-function
+		       buffer)
+	      (list buffers-tab-switch-to-buffer-function
+		    (buffer-name buffer))
+	      :selected selected)
+	   (when selected (setq selected nil))))
+     buffers)))
+
+;;; #### SJT would like this function to have a sort function list. I
+;;; don't see how this could work given that sorting is not
+;;; cumulative --andyp.
+(defun buffers-tab-items (&optional in-deletion frame force-selection)
+  "Return a list of tab instantiators based on the current buffers list.
+This function is used as the tab filter for the top-level buffers
+\"Buffers\" tab.  It dynamically creates a list of tab instantiators
+to use as the contents of the tab.  The contents and order of the list
+is controlled by `buffers-tab-filter-functions' which by default
+groups buffers according to major mode and removes invisible buffers.
+You can control how many buffers will be shown by setting
+`buffers-tab-max-size'.  You can control the text of the tab items by
+redefining the function `format-buffers-menu-line'."
+  (save-match-data
+    ;; NB it is too late if we run the omit function as part of the
+    ;; filter functions because we need to know which buffer is the
+    ;; context buffer before they get run.
+    (let* ((buffers (delete-if 
+		     buffers-tab-omit-function (buffer-list frame)))
+	   (first-buf (car buffers)))
+      ;; maybe force the selected window
+      (when (and force-selection
+		 (not in-deletion)
+		 (not (eq first-buf (window-buffer (selected-window frame)))))
+	(setq buffers (cons (window-buffer (selected-window frame))
+			    (delq first-buf buffers))))
+      ;; if we're in deletion ignore the current buffer
+      (when in-deletion 
+	(setq buffers (delq (current-buffer) buffers))
+	(setq first-buf (car buffers)))
+      ;; filter buffers
+      (when buffers-tab-filter-functions
+	(setq buffers
+	      (delete-if 
+	       #'null 
+	       (mapcar #'(lambda (buf)
+			   (let ((tmp-buf buf))
+			     (mapc #'(lambda (fun)
+				       (unless (funcall fun buf first-buf)
+					 (setq tmp-buf nil)))
+				   buffers-tab-filter-functions)
+			     tmp-buf))
+		       buffers))))
+      ;; maybe shorten list of buffers
+      (and (integerp buffers-tab-max-size)
+	   (> buffers-tab-max-size 1)
+	   (> (length buffers) buffers-tab-max-size)
+	   (setcdr (nthcdr (1- buffers-tab-max-size) buffers) nil))
+      ;; sort buffers in group (default is most-recently-selected)
+      (when buffers-tab-sort-function
+	(setq buffers (funcall buffers-tab-sort-function buffers)))
+      ;; convert list of buffers to list of structures used by tab widget
+      (setq buffers (build-buffers-tab-internal buffers))
+      buffers)))
+
 (defun add-tab-to-gutter ()
   "Put a tab control in the gutter area to hold the most recent buffers."
   (setq gutter-buffers-tab-orientation (default-gutter-position))
--- a/lisp/menubar-items.el	Fri Jul 05 22:15:04 2002 +0000
+++ b/lisp/menubar-items.el	Sat Jul 06 05:48:22 2002 +0000
@@ -277,7 +277,7 @@
       ["Save %_As..." write-file]
       ["Save So%_me Buffers" save-some-buffers]
       "-----"
-      ,@(if (eq system-type 'windows-nt)
+      ,@(if (valid-specifier-tag-p 'msprinter)
 	  '(["Page Set%_up..." generic-page-setup]))
       ["%_Print" generic-print-buffer
        :active (or (valid-specifier-tag-p 'msprinter)
@@ -286,7 +286,7 @@
        :suffix (if (region-active-p) "Selection..."
 		 (if put-buffer-names-in-file-menu (concat (buffer-name) "...")
 		   "..."))]
-      ,@(unless (eq system-type 'windows-nt)
+      ,@(unless (valid-specifier-tag-p 'msprinter)
 	  '(["Prett%_y-Print" ps-print-buffer-with-faces
 	     :active (fboundp 'ps-print-buffer-with-faces)
 	     :suffix (if put-buffer-names-in-file-menu (buffer-name) "")]))
--- a/lisp/printer.el	Fri Jul 05 22:15:04 2002 +0000
+++ b/lisp/printer.el	Sat Jul 06 05:48:22 2002 +0000
@@ -76,6 +76,9 @@
 				   (make-device 'msprinter printer-name))))
 
 (defun Printer-clear-device ()
+  ;; relying on GC to delete the device is too error-prone since there
+  ;; only can be one anyway.
+  (and printer-current-device (delete-device printer-current-device))
   (setq printer-current-device nil))
 
 (defcustom printer-page-header '((face bold date) nil (face bold buffer-name))
@@ -256,29 +259,30 @@
 
 If BUFFER is nil or omitted, the current buffer is used."
   (interactive (list nil (not current-prefix-arg)))
-  (let* ((print-region (and (interactive-p) (region-active-p)))
-	 (start (if print-region (region-beginning) (point-min buffer)))
-	 (end (if print-region (region-end) (point-max buffer))))
-    (if (or (not (valid-specifier-tag-p 'msprinter))
-	    (not display-print-dialog))
-	(generic-print-region start end buffer)
-      (let* ((d (Printer-get-device))
-	     (props (condition-case err
-			(make-dialog-box 'print :device d
+  (condition-case err
+      (let* ((print-region (and (interactive-p) (region-active-p)))
+	     (start (if print-region (region-beginning) (point-min buffer)))
+	     (end (if print-region (region-end) (point-max buffer))))
+	(if (or (not (valid-specifier-tag-p 'msprinter))
+		(not display-print-dialog))
+	    (generic-print-region start end buffer)
+	  (let* ((d (Printer-get-device))
+		 (props (make-dialog-box 'print :device d
 					 :allow-selection print-region
 					 :selected-page-button
-					 (if print-region 'selection 'all))
-		      (error
-		       (Printer-clear-device)
-		       (signal (car err) (cdr err))))))
-	(and props
-	     (let ((really-print-region
-		    (eq (plist-get props 'selected-page-button) 'selection)))
-	       (generic-print-region (if really-print-region start
-				       (point-min buffer))
-				     (if really-print-region end
-				       (point-max buffer))
-				     buffer d props)))))))
+					 (if print-region 'selection 'all))))
+	    (and props
+		 (let ((really-print-region
+			(eq (plist-get props 'selected-page-button) 'selection)))
+		   (generic-print-region (if really-print-region start
+					   (point-min buffer))
+					 (if really-print-region end
+					   (point-max buffer))
+					 buffer d props))))))
+    (error
+     ;; Make sure we catch all errors thrown from the native code.
+     (Printer-clear-device)
+     (signal (car err) (cdr err)))))
 
 (defun generic-print-region (start end &optional buffer print-device props)
   "Print region using a printing method appropriate to the O.S. being run.
@@ -338,7 +342,9 @@
 					 minibuffer none
 					 modeline-shadow-thickness 0
 					 vertical-scrollbar-visible-p nil
-					 horizontal-scrollbar-visible-p nil))
+					 horizontal-scrollbar-visible-p nil
+					 [default foreground] "black"
+					 [default background] "white"))
 				d))
 		       (let* ((w (frame-root-window f))
 			      (vertdpi
@@ -358,7 +364,7 @@
 					     ))))
 			      header-window
 			      footer-window)
-
+			   
 			 (when printer-page-header
 			   (let ((window-min-height 2))
 			     (setq header-window w)
@@ -366,7 +372,7 @@
 			   (setq header-buffer
 				 (generate-new-buffer " *header*"))
 			   (set-window-buffer header-window header-buffer))
-
+			   
 			 (when printer-page-footer
 			   (let ((window-min-height 2))
 			     (setq footer-window
@@ -374,9 +380,9 @@
 			   (setq footer-buffer
 				 (generate-new-buffer " *footer*"))
 			   (set-window-buffer footer-window footer-buffer))
-
+			   
 			 (setf (Print-context-window context) w)
-
+			   
 			 (let ((last-end 0) ; bufpos at end of previous page
 			       reached-end ; t if we've reached the end of the
 					; text we're printing
--- a/lisp/window-xemacs.el	Fri Jul 05 22:15:04 2002 +0000
+++ b/lisp/window-xemacs.el	Sat Jul 06 05:48:22 2002 +0000
@@ -216,11 +216,11 @@
 
 (defvar display-buffer-function nil
   "If non-nil, function to call to handle `display-buffer'.
-It will receive three args: the same as those to `display-buffer'.")
+It will receive four args: the same as those to `display-buffer'.")
 
 (defvar pre-display-buffer-function nil
   "If non-nil, function that will be called from `display-buffer'
-as the first action.  It will receive three args: the same as those
+as the first action.  It will receive four args: the same as those
 to `display-buffer'.
 This function may be used to select an appropriate frame for the buffer,
 for example.  See also the variable `display-buffer-function', which may
@@ -352,7 +352,8 @@
 ;; Can you believe that all of this crap was formerly in C?
 ;; Praise Jesus that it's not there any more.
 
-(defun display-buffer (buffer &optional not-this-window-p override-frame)
+(defun display-buffer (buffer &optional not-this-window-p override-frame
+			      shrink-to-fit)
   "Make BUFFER appear in some window on the current frame, but don't select it.
 BUFFER can be a buffer or a buffer name.
 If BUFFER is shown already in some window in the current frame,
@@ -365,6 +366,9 @@
 If OVERRIDE-FRAME is non-nil, display on that frame instead of
 the current frame (or the dedicated frame).
 
+If SHRINK-TO-FIT is non-nil and splitting the window is appropriate, give
+the new buffer less than half the space if it is small enough to fit.
+
 If `pop-up-windows' is non-nil, always use the
 current frame and create a new window regardless of whether the
 buffer has a dedicated frame, and regardless of whether
@@ -390,7 +394,8 @@
 		   (if pre-display-buffer-function
 		       (funcall pre-display-buffer-function buffer
 				not-this-window-p
-				override-frame)))
+				override-frame
+				shrink-to-fit)))
 
 	     ;; Give the user the ability to completely reimplement
 	     ;; this function via the `display-buffer-function'.
@@ -398,7 +403,8 @@
 		 (throw 'done
 			(funcall display-buffer-function buffer
 				 not-this-window-p
-				 override-frame)))
+				 override-frame
+				 shrink-to-fit)))
 
 	     ;; If the buffer has a dedicated frame, that takes
 	     ;; precedence over the current frame, and over what the
@@ -615,7 +621,9 @@
 						    (window-height window))
 						 2)
 					      (window-height upper))
-					   nil upper)))))
+					   nil upper))
+		       (if shrink-to-fit
+			   (shrink-window-if-larger-than-buffer window)))))
 
 	       (setq window (get-lru-window target-frame)))
 
--- a/lwlib/ChangeLog	Fri Jul 05 22:15:04 2002 +0000
+++ b/lwlib/ChangeLog	Sat Jul 06 05:48:22 2002 +0000
@@ -1,3 +1,11 @@
+2002-06-07  Andy Piper  <andy@xemacs.org>
+
+	* lwlib-Xm.c: (xm_safe_update_label): new function. Call
+	xm_update_label if the class is appropriate.
+	(make_menu_in_widget): use it.
+	(update_one_menu_entry): ditto.
+	(xm_update_one_widget): ditto.
+
 2002-07-02  Stephen J. Turnbull  <stephen@xemacs.org>
 
 	* XEmacs 21.5.7 "broccoflower" is released.
--- a/lwlib/lwlib-Xm.c	Fri Jul 05 22:15:04 2002 +0000
+++ b/lwlib/lwlib-Xm.c	Sat Jul 06 05:48:22 2002 +0000
@@ -301,6 +301,14 @@
     XmStringFree (val_string);
 }
 
+static void
+xm_safe_update_label (widget_instance* instance, Widget widget, widget_value* val)
+{
+  /* Don't clobber non-labels. */
+  if (XtIsSubclass (widget, xmLabelWidgetClass))
+    xm_update_label (instance, widget, val);
+}
+
 #endif /* defined (LWLIB_DIALOGS_MOTIF) || defined (LWLIB_MENUBARS_MOTIF) */
 
 /* update of list */
@@ -540,7 +548,7 @@
 	  XtSetArg (al [ac], XmNsubMenuId, menu); ac++;
 	  button = XmCreateCascadeButton (widget, cur->name, al, ac);
 
-	  xm_update_label (instance, button, cur);
+	  xm_safe_update_label (instance, button, cur);
 
 	  XtAddCallback (button, XmNcascadingCallback, xm_pull_down_callback,
 			 (XtPointer)instance);
@@ -561,7 +569,7 @@
 	  else
 	    button = XmCreatePushButtonGadget (widget, cur->name, al, ac);
 
-	  xm_update_label (instance, button, cur);
+	  xm_safe_update_label (instance, button, cur);
 
 	  /* don't add a callback to a simple label */
 	  if (cur->type == TOGGLE_TYPE || cur->type == RADIO_TYPE)
@@ -615,7 +623,8 @@
   /* update the menu button as a label. */
   if (val->change >= VISIBLE_CHANGE)
     {
-      xm_update_label (instance, widget, val);
+      xm_safe_update_label (instance, widget, val);
+
       if (XtClass (widget) == xmToggleButtonWidgetClass
 	  || XtClass (widget) == xmToggleButtonGadgetClass)
 	{
@@ -829,8 +838,7 @@
 
 #if defined (LWLIB_DIALOGS_MOTIF) || defined (LWLIB_MENUBARS_MOTIF) || defined (LWLIB_WIDGETS_MOTIF)
   /* Common to all label like widgets */
-  if (XtIsSubclass (widget, xmLabelWidgetClass))
-    xm_update_label (instance, widget, val);
+  xm_safe_update_label (instance, widget, val);
 #endif
   class = XtClass (widget);
   /* Class specific things */
--- a/src/ChangeLog	Fri Jul 05 22:15:04 2002 +0000
+++ b/src/ChangeLog	Sat Jul 06 05:48:22 2002 +0000
@@ -1,3 +1,45 @@
+2002-07-02  Paul Moore  <gustav@morpheus.demon.co.uk>
+
+	* console-msw.h:
+	* device-msw.c:
+	* device-msw.c (mswindows_init_dde):
+	* device-msw.c (mswindows_delete_device):
+	  Initialise extra DDE strings for remote execution, and change
+	  DDE initialisation to send ADVISE and REQUEST notifications.
+	
+	* emacs.c (main_1):
+	  Add symbols of event_mswindows.
+	
+	* event-msw.c:
+	* event-msw.c (mswindows_dde_callback):
+	* event-msw.c (reinit_vars_of_event_mswindows):
+	* event-msw.c (vars_of_event_mswindows):
+	* event-msw.c (syms_of_event_mswindows):
+	  Add DDE support for remote execution.
+
+2002-06-12  Andy Piper  <andy@xemacs.org>
+
+	* glyphs.c (query_string_geometry): check the string.
+
+	* glyphs-widget.c (widget_logical_unit_height): cope with nil
+	widget names.
+
+2002-06-12  Andy Piper  <andy@xemacs.org>
+
+	* frame-msw.c (msprinter_init_frame_3): calculate the frame size
+	for printing on accurately.
+
+2002-06-09  Rick Rankin <rick_rankin@yahoo.com>
+
+	* event-msw.c (mswindows_wnd_proc): Add a handler for the
+	WM_ACTIVATE message. Make sure that the frame is visible if the
+	window is visible. This seemss to fix the problem where XEmacs
+	appears to freeze after switching desktops with certain virtual
+	window managers.
+	(debug_output_mswin_message): Added code to output message
+	parameters for WM_WINDOWPOSCHANGED, 
+	WM_WINDOWPOSCHANGING, WM_MOVE, and WM_SIZE messages.
+
 2002-07-05  Jonathan Harris  <jonathan@xemacs.org>
 
 	* emacs.c (main_1): Conditionalise calls to
--- a/src/console-msw-impl.h	Fri Jul 05 22:15:04 2002 +0000
+++ b/src/console-msw-impl.h	Sat Jul 06 05:48:22 2002 +0000
@@ -55,7 +55,7 @@
  * Printer settings, aka devmode
  */
 
-typedef struct Lisp_Devmode
+struct Lisp_Devmode
 {
   struct lcrecord_header header;
 
@@ -70,7 +70,7 @@
      if not selected */
   Lisp_Object device;
 
-} Lisp_Devmode;
+};
 
 #define DEVMODE_SIZE(dm) ((dm)->dmSize + (dm)->dmDriverExtra)
 #define XDEVMODE_SIZE(x) ((x)->devmode ? DEVMODE_SIZE((x)->devmode) : 0)
--- a/src/console-msw.h	Fri Jul 05 22:15:04 2002 +0000
+++ b/src/console-msw.h	Sat Jul 06 05:48:22 2002 +0000
@@ -101,10 +101,17 @@
 int mswindows_is_dialog_msg (MSG *msg);
 
 /* win32 DDE management library */
-#define MSWINDOWS_DDE_ITEM_OPEN "Open" /* WARNING: uses of this need XETEXT */
+
+/* WARNING: uses of these constants need XETEXT */
+#define MSWINDOWS_DDE_ITEM_OPEN "Open"
+#define MSWINDOWS_DDE_TOPIC_EVAL "Eval"
+#define MSWINDOWS_DDE_ITEM_RESULT "Result"
+
 extern DWORD mswindows_dde_mlid;
 extern HSZ mswindows_dde_service;
 extern HSZ mswindows_dde_topic_system;
+extern HSZ mswindows_dde_topic_eval;
+extern HSZ mswindows_dde_item_result;
 extern HSZ mswindows_dde_item_open;
 HDDEDATA CALLBACK mswindows_dde_callback (UINT uType, UINT uFmt, HCONV hconv,
 					  HSZ hszTopic, HSZ hszItem,
--- a/src/device-msw.c	Fri Jul 05 22:15:04 2002 +0000
+++ b/src/device-msw.c	Sat Jul 06 05:48:22 2002 +0000
@@ -55,6 +55,8 @@
 int mswindows_dde_enable;
 HSZ mswindows_dde_service;
 HSZ mswindows_dde_topic_system;
+HSZ mswindows_dde_topic_eval;
+HSZ mswindows_dde_item_result;
 HSZ mswindows_dde_item_open;
 #endif
 
@@ -174,8 +176,8 @@
   mswindows_dde_mlid = 0;
   mswindows_dde_enable = 0;
   qxeDdeInitialize (&mswindows_dde_mlid, (PFNCALLBACK)mswindows_dde_callback,
-		    APPCMD_FILTERINITS|CBF_FAIL_SELFCONNECTIONS|CBF_FAIL_ADVISES|
-		    CBF_FAIL_POKES|CBF_FAIL_REQUESTS|CBF_SKIP_ALLNOTIFICATIONS,
+		    APPCMD_FILTERINITS|CBF_FAIL_SELFCONNECTIONS|
+		    CBF_FAIL_POKES|CBF_SKIP_ALLNOTIFICATIONS,
 		    0);
   
   mswindows_dde_service =
@@ -184,12 +186,22 @@
 			      XEUNICODE_P ? CP_WINUNICODE : CP_WINANSI);
   /* The following strings we Unicode-ize ourselves:
      -- SZDDESYS_TOPIC is system-provided
+     -- MSWINDOWS_DDE_TOPIC_EVAL is defined by us
+     -- MSWINDOWS_DDE_ITEM_RESULT is defined by us
      -- MSWINDOWS_DDE_ITEM_OPEN is used in internal-format comparisons
   */
   mswindows_dde_topic_system =
     qxeDdeCreateStringHandle (mswindows_dde_mlid,
 			      XETEXT (SZDDESYS_TOPIC),
 			      XEUNICODE_P ? CP_WINUNICODE : CP_WINANSI);
+  mswindows_dde_topic_eval =
+    qxeDdeCreateStringHandle (mswindows_dde_mlid,
+			      XETEXT (MSWINDOWS_DDE_TOPIC_EVAL),
+			      XEUNICODE_P ? CP_WINUNICODE : CP_WINANSI);
+  mswindows_dde_item_result =
+    qxeDdeCreateStringHandle (mswindows_dde_mlid,
+			      XETEXT (MSWINDOWS_DDE_ITEM_RESULT),
+			      XEUNICODE_P ? CP_WINUNICODE : CP_WINANSI);
   mswindows_dde_item_open =
     qxeDdeCreateStringHandle (mswindows_dde_mlid,
 			      XETEXT (MSWINDOWS_DDE_ITEM_OPEN),
@@ -229,8 +241,10 @@
 {
 #ifdef HAVE_DRAGNDROP
   DdeNameService (mswindows_dde_mlid, 0L, 0L, DNS_UNREGISTER);
+  DdeFreeStringHandle (mswindows_dde_mlid, mswindows_dde_item_result);
   DdeFreeStringHandle (mswindows_dde_mlid, mswindows_dde_item_open);
   DdeFreeStringHandle (mswindows_dde_mlid, mswindows_dde_topic_system);
+  DdeFreeStringHandle (mswindows_dde_mlid, mswindows_dde_topic_eval);
   DdeFreeStringHandle (mswindows_dde_mlid, mswindows_dde_service);
   DdeUninitialize (mswindows_dde_mlid);
 
--- a/src/emacs.c	Fri Jul 05 22:15:04 2002 +0000
+++ b/src/emacs.c	Sat Jul 06 05:48:22 2002 +0000
@@ -1345,6 +1345,7 @@
 #ifdef HAVE_MS_WINDOWS
       syms_of_console_mswindows ();
       syms_of_device_mswindows ();
+      syms_of_event_mswindows ();
 #ifdef HAVE_DIALOGS
       syms_of_dialog_mswindows ();
 #endif
--- a/src/event-msw.c	Fri Jul 05 22:15:04 2002 +0000
+++ b/src/event-msw.c	Sat Jul 06 05:48:22 2002 +0000
@@ -1733,6 +1733,191 @@
 #ifdef HAVE_DRAGNDROP
 extern int mswindows_dde_enable;
 
+EXFUN(Fread_from_string, 3);
+
+/* The following variables are used to maintain consistency of result and
+ * error reporting to the client.
+ * The basic protocol is to Execute a lisp form, and then Request one or
+ * more of the following items: Status (1 = OK, 0 = Error), Result, or Error.
+ * When the lisp form is queued, the dde_eval_pending flag is set to 1,
+ * to indicate that the items are not yet available. The dde_eval_pending
+ * flag is set to 0 when the evaluation is complete. Requests for the result
+ * items will block while the dde_eval_pending flag is 1, to avoid clients
+ * getting inconsistent results.
+ */
+static int dde_eval_pending;
+static Lisp_Object dde_eval_result;
+static Lisp_Object dde_eval_error;
+
+static Lisp_Object
+dde_error (Lisp_Object err, Lisp_Object obj)
+{
+  dde_eval_error = err;
+  return Qnil;
+}
+
+/* Read lisp forms from a string. Evaluate the forms as if they were
+ * wrapped in a progn form. Return the result of the form.
+ */
+static Lisp_Object
+dde_eval_string (Lisp_Object str)
+{
+  struct gcpro gcpro1, gcpro2;
+  Lisp_Object args[3];
+  Lisp_Object obj;
+
+  /* Heavy handed GCPROing, on the principle of it's better to be safe than
+   * sorry...
+   */
+  args[0] = Qnil;
+  args[1] = Qnil;
+  args[2] = Qnil;
+  GCPRO2 (args[0], str);
+  gcpro1.nvars = 3;
+
+  /* Wrap the user supplied string in string "(progn ...)".
+   * We can now just read-from-string a single form. If we
+   * get an error, or finish before the end of the string,
+   * we know the original string had syntax errors.
+   */
+  args[0] = build_string ("(progn ");
+  args[1] = str;
+  args[2] = build_string (")");
+  str = Fconcat (3, args);
+
+  obj = Fread_from_string (str, Qnil, Qnil);
+  UNGCPRO;
+
+  /* The following doesn't check that the length fits in an EMACS_INT.
+   * This won't be a problem in reality...?
+   *
+   * If the read didn't get to the end of the string, we have a syntax
+   * error in the string supplied by the user.
+   */
+  if (XINT (XCDR (obj)) != XSTRING_LENGTH (str))
+    return Qnil;
+
+  GCPRO1 (obj);
+  obj = Feval (XCAR (obj));
+
+  RETURN_UNGCPRO(obj);
+}
+
+/* Evaluate the supplied string as a sequence of Lisp forms, wrapped in
+ * a progn. Catch any evaluation errors. Set the evaluation status and
+ * result variables.
+ */
+static void
+dde_eval (Lisp_Object str)
+{
+  dde_eval_error = Qnil;
+  dde_eval_result = condition_case_1 (Qt, dde_eval_string, str,
+				      dde_error, Qnil);
+  dde_eval_pending = 0;
+
+  /* Re-enable callbacks in case the client is waiting on a request */
+  DdeEnableCallback (mswindows_dde_mlid, NULL, EC_ENABLEALL);
+
+  /* Post advise notifications on the result item */
+  DdePostAdvise (mswindows_dde_mlid, mswindows_dde_topic_eval,
+		 mswindows_dde_item_result);
+}
+
+/* A list of DDE advise tokens. Each token is an uninterned symbol,
+ * whose value is the DDE string handle for its name (stored as a float,
+ * as a Lisp int cannot hold a full C int).
+ * The token's 'dde-data property is used to store data for a dde-advise.
+ */
+Lisp_Object Vdde_advise_items;
+
+/* The symbol 'HSZ */
+Lisp_Object QHSZ;
+
+DEFUN("dde-alloc-advise-item", Fdde_alloc_advise_item, 0, 1, 0, /*
+Allocate an advise item, and return its token.
+*/
+      (name))
+{
+  Lisp_Object token;
+  Extbyte *str;
+  HSZ hsz;
+  struct gcpro gcpro1, gcpro2;
+
+  if (!NILP (name))
+    CHECK_STRING (name);
+  else
+    {
+      static int num = 0;
+      char buf[20];
+      sprintf (buf, "Tok%d", num);
+      ++num;
+      name = build_string (buf);
+    }
+
+  token = Qnil;
+  GCPRO2 (name, token);
+  token = Fmake_symbol (name);
+  TO_EXTERNAL_FORMAT (LISP_STRING, name, C_STRING_ALLOCA, str,
+		      Qmswindows_tstr);
+  hsz = qxeDdeCreateStringHandle (mswindows_dde_mlid, str,
+				  XEUNICODE_P ? CP_WINUNICODE : CP_WINANSI);
+
+  Fput(token, QHSZ, make_float ((int)hsz));
+  Vdde_advise_items = Fcons (token, Vdde_advise_items);
+
+  RETURN_UNGCPRO(token);
+}
+
+DEFUN("dde-free-advise-item", Fdde_free_advise_item, 1, 1, 0, /*
+Free the resources associated with advise item ITEM.
+
+Frees all resources allocated to allow clients to set up advise loops
+on ITEM. It is assumed that no active advise loops remain. However, no
+problems should arise if they do - it's just that we won't ever send any
+notifications again.
+
+If the user does not free an advise item, resources will be leaked.
+*/
+      (item))
+{
+  HSZ hsz;
+  Lisp_Object val;
+
+  CHECK_SYMBOL (item);
+  val = Fget (item, QHSZ, Qnil);
+  if (!FLOATP (val))
+    return Qnil;
+  hsz = (HSZ)(int)XFLOAT_DATA (val);
+  DdeFreeStringHandle (mswindows_dde_mlid, hsz);
+  Vdde_advise_items = delq_no_quit (item, Vdde_advise_items);
+  return Qnil;
+}
+
+DEFUN("dde-advise", Fdde_advise, 2, 2, 0, /*
+Post a DDE advise for ITEM with associated data DATA.
+
+Records the value DATA for sending back to clients waiting for
+notifications on DDE item ITEM in the system topic, and posts
+the advise transaction.
+
+ITEM must be an advise token allocated using dde-alloc-advise-item.
+*/
+      (item, data))
+{
+  HSZ hsz;
+  Lisp_Object val;
+
+  CHECK_SYMBOL (item);
+  val = Fget (item, QHSZ, Qnil);
+  if (!FLOATP (val))
+    return Qnil;
+  hsz = (HSZ)(int)XFLOAT_DATA (val);
+
+  Fset (item, data);
+  DdePostAdvise (mswindows_dde_mlid, mswindows_dde_topic_eval, hsz);
+  return Qnil;
+}
+
 HDDEDATA CALLBACK
 mswindows_dde_callback (UINT uType, UINT uFmt, HCONV hconv,
 			HSZ hszTopic, HSZ hszItem, HDDEDATA hdata,
@@ -1741,31 +1926,172 @@
   switch (uType)
     {
     case XTYP_CONNECT:
-      if (!DdeCmpStringHandles (hszTopic, mswindows_dde_topic_system))
+      if (!DdeCmpStringHandles (hszTopic, mswindows_dde_topic_system)
+          || !DdeCmpStringHandles (hszTopic, mswindows_dde_topic_eval))
 	return (HDDEDATA) TRUE;
       return (HDDEDATA) FALSE;
 
     case XTYP_WILDCONNECT:
       {
-	/* We only support one {service,topic} pair */
-	HSZPAIR pairs[2] =
+	/* We support two {service,topic} pairs */
+	HSZPAIR pairs[3] =
 	{
-	  { mswindows_dde_service, mswindows_dde_topic_system }, { 0, 0 } };
-
-	if (!(hszItem 
-	      || DdeCmpStringHandles (hszItem, mswindows_dde_service)) &&
-	    !(hszTopic
-	      || DdeCmpStringHandles (hszTopic, mswindows_dde_topic_system)))
+	  { mswindows_dde_service, mswindows_dde_topic_system },
+	  { mswindows_dde_service, mswindows_dde_topic_eval },
+	  { 0, 0 }
+	};
+
+	if ((!hszItem
+	     || !DdeCmpStringHandles (hszItem, mswindows_dde_service)) &&
+	    (!hszTopic
+	     || !DdeCmpStringHandles (hszTopic, mswindows_dde_topic_system)
+	     || !DdeCmpStringHandles (hszTopic, mswindows_dde_topic_eval)))
 	  return (DdeCreateDataHandle (mswindows_dde_mlid, (LPBYTE) pairs,
 				       sizeof (pairs), 0L, 0, uFmt, 0));
       }
       return (HDDEDATA) NULL;
 
+    case XTYP_ADVSTART:
+      if (!mswindows_dde_enable)
+	return (HDDEDATA) FALSE;
+
+      /* We only support advise loops on the eval topic for text data */
+      if (!DdeCmpStringHandles (hszTopic, mswindows_dde_topic_eval)
+	  && (uFmt == CF_TEXT || uFmt == CF_UNICODETEXT))
+	{
+	  /* Only allocated items or Result, are allowed */
+	  if (!DdeCmpStringHandles (hszItem, mswindows_dde_item_result))
+	    return (HDDEDATA) TRUE;
+
+	  {
+	    EXTERNAL_LIST_LOOP_2 (elt, Vdde_advise_items)
+	      {
+		Lisp_Object val;
+		HSZ hsz;
+		if (!SYMBOLP (elt))
+		  continue;
+		val = Fget (elt, QHSZ, Qnil);
+		if (!FLOATP (val))
+		  continue;
+		hsz = (HSZ) (int) XFLOAT_DATA (val);
+		if (!DdeCmpStringHandles (hszItem, hsz))
+		  return (HDDEDATA) TRUE;
+	      }
+	  }
+	}
+      return (HDDEDATA) FALSE;
+
+      /* Both advise requests and normal requests work the same */
+    case XTYP_ADVREQ:
+    case XTYP_REQUEST:
+      if (!mswindows_dde_enable)
+	return (HDDEDATA) NULL;
+
+      if (DdeCmpStringHandles (hszTopic, mswindows_dde_topic_eval) != 0)
+	return (HDDEDATA) NULL;
+
+      /* If this is a normal request and we're in the middle of
+       * an Execute, block until the Execute completes.
+       */
+      if (dde_eval_pending && uType == XTYP_REQUEST)
+	return (HDDEDATA) CBR_BLOCK;
+
+      /* We can only support requests for ANSI or Unicode text */
+      if (uFmt != CF_TEXT && uFmt != CF_UNICODETEXT)
+	return (HDDEDATA) NULL;
+
+      {
+	Lisp_Object args[2];
+	struct gcpro gcpro1;
+	Lisp_Object res;
+	Extbyte *result;
+	DWORD bytes;
+
+	args[0] = Qnil;
+	args[1] = Qnil;
+	GCPRO1 (args[0]);
+	gcpro1.nvars = 2;
+
+
+	if (!DdeCmpStringHandles (hszItem, mswindows_dde_item_result))
+	  {
+	    if (NILP (dde_eval_error))
+	      {
+		args[0] = build_string ("OK: %s");
+		args[1] = dde_eval_result;
+	      }
+	    else
+	      {
+		args[0] = build_string ("ERR: %s");
+		args[1] = dde_eval_error;
+	      }
+	  }
+	else
+	  {
+	    EXTERNAL_LIST_LOOP_2 (elt, Vdde_advise_items)
+	      {
+		Lisp_Object val;
+		HSZ hsz;
+		if (!SYMBOLP (elt))
+		  continue;
+		val = Fget (elt, QHSZ, Qnil);
+		if (!FLOATP (val))
+		  continue;
+		hsz = (HSZ) (int) XFLOAT_DATA (val);
+		if (!DdeCmpStringHandles (hszItem, hsz))
+		  args[1] = Fsymbol_value (elt);
+	      }
+	    args[0] = build_string ("%s");
+	  }
+
+	res = Fformat (2, args);
+	UNGCPRO;
+
+	bytes = (uFmt == CF_TEXT ? 1 : 2) * (XSTRING_LENGTH (res) + 1);
+	TO_EXTERNAL_FORMAT (LISP_STRING, res,
+			    C_STRING_ALLOCA, result,
+			    uFmt == CF_TEXT ? Qmswindows_multibyte
+			    : Qmswindows_unicode);
+
+	/* If we cannot create the data handle, this passes the null
+	 * return back to the client, which signals an error as we wish.
+	 */
+	return DdeCreateDataHandle (mswindows_dde_mlid, (LPBYTE)result,
+				    bytes, 0L, hszItem, uFmt, 0);
+      }
+
     case XTYP_EXECUTE:
       if (!mswindows_dde_enable)
 	return (HDDEDATA) DDE_FBUSY;
 
-      if (!DdeCmpStringHandles (hszTopic, mswindows_dde_topic_system))
+      if (!DdeCmpStringHandles (hszTopic, mswindows_dde_topic_eval))
+	{
+	  DWORD len;
+	  LPBYTE extcmd;
+	  Lisp_Object tmp;
+
+	  /* Grab a pointer to the raw data supplied */
+	  extcmd = DdeAccessData (hdata, &len);
+
+	  TO_INTERNAL_FORMAT (DATA, (extcmd, len),
+			      LISP_STRING, tmp,
+			      Qmswindows_tstr);
+
+	  /* Release and free the data handle */
+	  DdeUnaccessData (hdata);
+	  DdeFreeDataHandle (hdata);
+
+	  /* Set a flag to say that the evaluation isn't yet complete,
+	   * enqueue the evaluation, send a dummy event to trigger the
+	   * event loop (I've no idea why this is needed, but it works...)
+	   * and return success to the client.
+	   */
+	  dde_eval_pending = 1;
+	  enqueue_magic_eval_event (dde_eval, tmp);
+	  mswindows_enqueue_magic_event (NULL, XM_BUMPQUEUE);
+	  return (HDDEDATA) DDE_FACK;
+	}
+      else if (!DdeCmpStringHandles (hszTopic, mswindows_dde_topic_system))
 	{
 	  DWORD len = DdeGetData (hdata, NULL, 0, 0);
 	  LPBYTE extcmd = (LPBYTE) ALLOCA (len + 1);
@@ -1786,7 +2112,6 @@
 
 	  /* Check syntax & that it's an [Open("foo")] command, which we
 	   * treat like a file drop */
-	  /* #### Ought to be generalised and accept some other commands */
 	  if (*cmd == '[')
 	    cmd++;
 	  if (qxestrncasecmp_c (cmd, MSWINDOWS_DDE_ITEM_OPEN,
@@ -2966,6 +3291,70 @@
       mswindows_handle_paint (XFRAME (mswindows_find_frame (hwnd)));
       break;
 
+    case WM_ACTIVATE:
+      {
+        /*
+         * If we receive a WM_ACTIVATE message that indicates that our frame
+         * is being activated, make sure that the frame is marked visible
+         * if the window itself is visible. This seems to fix the problem
+         * where XEmacs appears to lock-up after switching desktops with
+         * some virtual window managers.
+         */
+        int state = (int)(short) LOWORD(wParam);
+#ifdef DEBUG_XEMACS
+        if (debug_mswindows_events)
+          stderr_out("state = %d\n", state);
+#endif /* DEBUG_XEMACS */
+        if (state == WA_ACTIVE || state == WA_CLICKACTIVE)
+          {
+#ifdef DEBUG_XEMACS
+            if (debug_mswindows_events)
+              stderr_out("  activating\n");
+#endif /* DEBUG_XEMACS */
+            
+            fobj = mswindows_find_frame (hwnd);
+            frame = XFRAME (fobj);
+            if (IsWindowVisible (hwnd))
+              {
+#ifdef DEBUG_XEMACS
+                if (debug_mswindows_events)
+                  stderr_out("  window is visible\n");
+#endif /* DEBUG_XEMACS */
+                if (!FRAME_VISIBLE_P (frame))
+                  {
+#ifdef DEBUG_XEMACS
+                    if (debug_mswindows_events)
+                      stderr_out("  frame is not visible\n");
+#endif /* DEBUG_XEMACS */
+                    /*
+                     * It seems that we have to enqueue the XM_MAPFRAME event
+                     * prior to setting the frame visible so that
+                     * suspend-or-iconify-emacs works properly.
+                     */
+                    mswindows_enqueue_magic_event (hwnd, XM_MAPFRAME);
+                    FRAME_VISIBLE_P (frame) = 1;
+                    FRAME_ICONIFIED_P (frame) = 0;
+                  }
+#ifdef DEBUG_XEMACS
+                else
+                  {
+                    if (debug_mswindows_events)
+                      stderr_out("  frame is visible\n");
+                  }
+#endif /* DEBUG_XEMACS */
+              }
+#ifdef DEBUG_XEMACS
+            else
+              {     
+                if (debug_mswindows_events)
+                  stderr_out("  window is not visible\n");
+              }
+#endif /* DEBUG_XEMACS */
+          }
+	return qxeDefWindowProc (hwnd, message_, wParam, lParam);
+      }
+      break;
+      
     case WM_WINDOWPOSCHANGED:
       /* This is sent before WM_SIZE; in fact, the processing of this
 	 by DefWindowProc() sends WM_SIZE.  But WM_SIZE is not sent when
@@ -3075,13 +3464,14 @@
 		}
 	      else
 		{
-		  if (!msframe->sizing && !FRAME_VISIBLE_P (frame)) {
-		    mswindows_enqueue_magic_event (hwnd, XM_MAPFRAME);
-		    /* APA: Now that the magic XM_MAPFRAME event has
-		     * been sent we can mark the frame as visible (just
-		     * like 21.1 did). */
-		    FRAME_VISIBLE_P (frame) = 1;
-		  }
+		  if (!msframe->sizing && !FRAME_VISIBLE_P (frame))
+                    {
+                      mswindows_enqueue_magic_event (hwnd, XM_MAPFRAME);
+                      /* APA: Now that the magic XM_MAPFRAME event has
+                       * been sent we can mark the frame as visible (just
+                       * like 21.1 did). */
+                      FRAME_VISIBLE_P (frame) = 1;
+                    }
 
 		  if (!msframe->sizing || mswindows_dynamic_frame_resize)
 		    redisplay ();
@@ -4725,6 +5115,25 @@
       stderr_out (" wparam=%d lparam=%d hwnd=%x frame: ",
 		  wParam, (int) lParam, (unsigned int) hwnd);
       debug_print (frame);
+      if (message_ == WM_WINDOWPOSCHANGED ||
+          message_ == WM_WINDOWPOSCHANGING)
+        {
+          WINDOWPOS *wp = (WINDOWPOS *) lParam;
+          stderr_out("  WINDOWPOS: x=%d, y=%d, h=%d, w=%d\n",
+                     wp->x, wp->y, wp->cx, wp->cy);
+        }
+      else if (message_ == WM_MOVE)
+        {
+          int x = (int)(short) LOWORD(lParam);   /* horizontal position */
+          int y = (int)(short) HIWORD(lParam);   /* vertical position */
+          stderr_out("  MOVE: x=%d, y=%d\n", x, y);
+        }
+      else if (message_ == WM_SIZE)
+        {
+          int w = (int)(short) LOWORD(lParam);   /* width */
+          int h = (int)(short) HIWORD(lParam);   /* height */
+          stderr_out("  SIZE: w=%d, h=%d\n", w, h);
+        }
     }
   else
     stderr_out ("\n");
@@ -4762,6 +5171,8 @@
   mswindows_event_stream->delete_io_streams_cb = emacs_mswindows_delete_io_streams;
   mswindows_event_stream->current_event_timestamp_cb =
     emacs_mswindows_current_event_timestamp;
+
+  dde_eval_pending = 0;
 }
 
 void
@@ -4781,6 +5192,28 @@
 
   mswindows_error_caught_in_modal_loop = 0;
 
+#ifdef HAVE_DRAGNDROP
+  Fprovide (Qdde);
+
+  DEFVAR_LISP ("dde-advise-items", &Vdde_advise_items /*
+A list of allocated DDE advise items.
+Each item is an uninterned symbol, created using dde-alloc-advise-item.
+
+The symbol's value is the data which is returned to the DDE client when
+a request for the item is made (or a dde-advise call is made).
+
+The symbol also has a 'HSZ property, which holds the DDE string handle
+for the item, as a float. This is for internal use only, and should not
+be modified.
+*/ );
+  Vdde_advise_items = Qnil;
+  
+  dde_eval_result = Qnil;
+  staticpro (&dde_eval_result);
+  dde_eval_error = Qnil;
+  staticpro (&dde_eval_error);
+#endif
+
 #ifdef DEBUG_XEMACS
   DEFVAR_INT ("debug-mswindows-events", &debug_mswindows_events /*
 If non-zero, display debug information about Windows messages that XEmacs sees.
@@ -4853,6 +5286,12 @@
 void
 syms_of_event_mswindows (void)
 {
+#ifdef HAVE_DRAGNDROP
+  DEFSYMBOL(QHSZ);
+  DEFSUBR(Fdde_alloc_advise_item);
+  DEFSUBR(Fdde_free_advise_item);
+  DEFSUBR(Fdde_advise);
+#endif
 }
 
 void
--- a/src/frame-msw.c	Fri Jul 05 22:15:04 2002 +0000
+++ b/src/frame-msw.c	Sat Jul 06 05:48:22 2002 +0000
@@ -840,52 +840,52 @@
 {
   DOCINFOW di;
   struct device *device = XDEVICE (FRAME_DEVICE (f));
-  HDC hdc;
   int frame_left, frame_top, frame_width, frame_height;
-
+  
   /* DC might be recreated in msprinter_apply_devmode,
      so do not initialize until now */
-  hdc = DEVICE_MSPRINTER_HDC (device);
+  HDC hdc = DEVICE_MSPRINTER_HDC (device);
+  int logpixelsx = GetDeviceCaps (hdc, LOGPIXELSX);
+  int logpixelsy = GetDeviceCaps (hdc, LOGPIXELSY);
+  int physicaloffsetx = GetDeviceCaps (hdc, PHYSICALOFFSETX);
+  int physicaloffsety = GetDeviceCaps (hdc, PHYSICALOFFSETY);
+  int physicalheight = GetDeviceCaps (hdc, PHYSICALHEIGHT);
+  int physicalwidth = GetDeviceCaps (hdc, PHYSICALWIDTH);
 
-  /* Compute geometry properties */
-  frame_left = (MulDiv (GetDeviceCaps (hdc, LOGPIXELSX),
-			FRAME_MSPRINTER_LEFT_MARGIN (f), 1440)
-		- GetDeviceCaps (hdc, PHYSICALOFFSETX));
-  
+  /* Compute geometry properties.
+     Conversion is from TWIPS -> inches -> pixels. */
+  frame_left = MulDiv (logpixelsx, FRAME_MSPRINTER_LEFT_MARGIN(f), 1440)
+    - physicaloffsetx;
+
   if (FRAME_MSPRINTER_CHARWIDTH (f) > 0)
     {
       char_to_real_pixel_size (f, FRAME_MSPRINTER_CHARWIDTH (f), 0,
 			       &frame_width, NULL);
-      FRAME_MSPRINTER_RIGHT_MARGIN (f) = 
-	MulDiv (GetDeviceCaps (hdc, PHYSICALWIDTH)
-		- (frame_left + frame_width), 1440,
-		GetDeviceCaps (hdc, LOGPIXELSX));
+      FRAME_MSPRINTER_RIGHT_MARGIN(f) =
+	MulDiv (physicalwidth - (frame_left + frame_width), 1440,
+		logpixelsx);
     }
   else
-    frame_width = (GetDeviceCaps (hdc, PHYSICALWIDTH)
-		   - frame_left
-		   - MulDiv (GetDeviceCaps (hdc, LOGPIXELSX),
-			     FRAME_MSPRINTER_RIGHT_MARGIN (f), 1440));
+    frame_width = physicalwidth - frame_left
+      - MulDiv (logpixelsx, FRAME_MSPRINTER_RIGHT_MARGIN(f), 1440)
+      - physicaloffsetx;
 
-  frame_top = (MulDiv (GetDeviceCaps (hdc, LOGPIXELSY),
-		       FRAME_MSPRINTER_TOP_MARGIN (f), 1440)
-	       - GetDeviceCaps (hdc, PHYSICALOFFSETY));
+  frame_top = MulDiv (logpixelsy, FRAME_MSPRINTER_TOP_MARGIN(f), 1440)
+    - physicaloffsety;
 
   if (FRAME_MSPRINTER_CHARHEIGHT (f) > 0)
     {
       char_to_real_pixel_size (f, 0, FRAME_MSPRINTER_CHARHEIGHT (f),
 			       NULL, &frame_height);
 
-      FRAME_MSPRINTER_BOTTOM_MARGIN (f) = 
-	MulDiv (GetDeviceCaps (hdc, PHYSICALHEIGHT)
-		- (frame_top + frame_height), 1440,
-		GetDeviceCaps (hdc, LOGPIXELSY));
+      FRAME_MSPRINTER_BOTTOM_MARGIN(f) =
+	MulDiv (physicalheight - (frame_top + frame_height), 1440,
+		logpixelsy);
     }
   else
-    frame_height = (GetDeviceCaps (hdc, PHYSICALHEIGHT)
-		    - frame_top
-		    - MulDiv (GetDeviceCaps (hdc, LOGPIXELSY),
-			      FRAME_MSPRINTER_BOTTOM_MARGIN (f), 1440));
+    frame_height = physicalheight - frame_top
+      - MulDiv (logpixelsy, FRAME_MSPRINTER_BOTTOM_MARGIN(f), 1440)
+      - physicaloffsety;
 
   /* Geometry sanity checks */
   if (!frame_pixsize_valid_p (f, frame_width, frame_height))
--- a/src/general-slots.h	Fri Jul 05 22:15:04 2002 +0000
+++ b/src/general-slots.h	Sat Jul 06 05:48:22 2002 +0000
@@ -90,6 +90,7 @@
 SYMBOL (Qcurrent);
 SYMBOL (Qcursor);
 SYMBOL (Qdata);
+SYMBOL (Qdde);
 SYMBOL (Qdead);
 SYMBOL (Qdebug);
 SYMBOL (Qdefault);
--- a/src/glyphs.c	Fri Jul 05 22:15:04 2002 +0000
+++ b/src/glyphs.c	Sat Jul 06 05:48:22 2002 +0000
@@ -2285,6 +2285,8 @@
   struct face_cachel *cachel;
   Lisp_Object frame = DOMAIN_FRAME (domain);
 
+  CHECK_STRING (string);
+
   /* Compute height */
   if (height)
     {
--- a/src/sheap.c	Fri Jul 05 22:15:04 2002 +0000
+++ b/src/sheap.c	Sat Jul 06 05:48:22 2002 +0000
@@ -27,7 +27,7 @@
 #include <sheap-adjust.h>
 
 #define STATIC_HEAP_BASE	0x800000
-#define STATIC_HEAP_SLOP	0x40000
+#define STATIC_HEAP_SLOP	0xf0000
 #define STATIC_HEAP_SIZE \
 (STATIC_HEAP_BASE + SHEAP_ADJUSTMENT + STATIC_HEAP_SLOP)
 #define BLOCKSIZE	(1<<12)
@@ -106,7 +106,7 @@
 }
 
 static void
-sheap_adjust_h ()
+sheap_adjust_h (long adjust)
 {
   FILE *stream = retry_fopen ("sheap-adjust.h", "w");
 
@@ -117,8 +117,7 @@
   fprintf (stream,
 	   "/*\tDo not edit this file!\n"
 	   "\tAutomatically generated by XEmacs */\n"
-	   "# define SHEAP_ADJUSTMENT (%d)\n",
-	   ((static_heap_ptr - static_heap_buffer) - STATIC_HEAP_BASE));
+	   "# define SHEAP_ADJUSTMENT (%ld)\n", adjust);
   retry_fclose (stream);
 }
 
@@ -128,17 +127,20 @@
 {
   int rc = 0;
 
-  Bytecount lost = (STATIC_HEAP_BASE + STATIC_HEAP_SLOP + SHEAP_ADJUSTMENT)
+  Bytecount lost = STATIC_HEAP_SIZE
     - (static_heap_ptr - static_heap_buffer);
   char buf[200];
-  sprintf (buf, "Static heap usage: %ld of %ld",
+  sprintf (buf, "Static heap usage: %ld of %ld, slop is %ld",
                (long) (static_heap_ptr - static_heap_buffer),
-	   (long) (STATIC_HEAP_BASE + STATIC_HEAP_SLOP + SHEAP_ADJUSTMENT));
+	   (long) (STATIC_HEAP_SIZE),
+	   (long) STATIC_HEAP_SLOP);
 
   if (lost > STATIC_HEAP_SLOP) {
     sprintf (buf + strlen (buf), " -- %ldk wasted", (long)(lost/1024));
     if (die_if_pure_storage_exceeded) {
-      sheap_adjust_h();
+      sheap_adjust_h(STATIC_HEAP_SLOP - lost);
+      sprintf (buf + strlen (buf), " -- reset to %ldk", 
+	       (long) (STATIC_HEAP_SIZE + STATIC_HEAP_SLOP - lost));
       rc = -1;
     }
     message ("%s", buf);