Mercurial > hg > xemacs-beta
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);