(let ((window (screen-cursor-window screen)))
(and window (window-text-widget* window))))
-(define-integrable (minibuffer-widget? widget)
- (and (text-widget? widget)
- (not (text-widget-modeline widget))))
-
(define-integrable (car* obj) (and (pair? obj) (car obj)))
(define-integrable (cdr* obj) (and (pair? obj) (cdr obj)))
(define-method set-screen-size! ((screen <gtk-screen>) x-size y-size)
- (%trace ";((set-screen-size! <gtk-screen>) "screen" "x-size"x"y-size")\n")
+ (%trace "; (set-screen-size! <gtk-screen>) "screen" "x-size"x"y-size"\n")
(without-interrupts
(lambda ()
(set-screen-x-size! screen x-size)
(let ((widget (window-text-widget* frame)))
(if (not widget) (error "No widget:" frame))
- (%trace "; "what"...\n")
- (let ((value (operation widget)))
- (%trace "; ..."what" => "value"\n")
- value)))
+ (operation widget)))
(define-method screen/window-scroll-y-relative! ((screen <gtk-screen>)
frame delta)
(re-pack-inferiors! (reverse (window-inferiors root))
top-box '() "--")
(%trace "; -show-init "toplevel"\n")
- (gtk-widget-grab-focus (minibuffer-widget screen))
+ (gtk-widget-grab-focus (typein-widget screen))
(gtk-widget-show-all toplevel)
(%trace "; update-widgets init done\n"))
(begin
(re-pack-inferiors! (reverse (window-inferiors root))
top-box (gtk-container-children top-box)
"--")
- ;; This causes the realize callback to be invoked,
- ;; BEFORE the size_allocation callback!
- ;;
- ;; Wait for the resize idle task to do its thing? Nope.
- ;; The resizing will not include widgets that have not
- ;; been shown! It seems I must show (realize) new
- ;; widgets WITHOUT an allocation.
-
- ;; Resizing is normally top-down -- started by GtkWindow
- ;; when the window manager (luser) frobs it. Bottom-up
- ;; resizing should happen when containers remove or add
- ;; children, calling gtk_widget_queue_resize if child
- ;; and parent are visible. Unfortunately,
- ;; gtk_box_pack_start/end do NOT call _queue_resize.
- ;; gtk_box_remove DOES (as well as _set_child_packing,
- ;; _reorder_child, _set_spacing, _set_homogenous, and
- ;; _set_property). MUST CALL gtk_container_queue_resize
- ;; on box if new widgets are packed??? BUT can this
- ;; even happen? Why were there no resizes done before???
-
- ;; gtk_widget_queue_resize travels up the parent links
- ;; by default??? To the top-level??? Is that when
- ;; gtk_window_show has a shot?
-
- ;; GtkWindow's gtk_container_check_resize method just
- ;; works the gtk_window_move_resize magic.
-
- ;; This, alone, does nothing. Resizing is done before
- ;; new widgets are shown.
- ;;
- ;; (%trace "; -show-all "toplevel"\n")
- ;; (gtk-widget-show-all toplevel)
-
- ;; This also does nothing; at least it does not get any
- ;; re-allocations done. It skips the unshown?
- ;;
- ;; (%trace "; -check-resize "toplevel"\n")
- ;; (gtk-container-check-resize toplevel)
- ;; (%trace "; -show-all "toplevel"\n")
- ;; (gtk-widget-show-all toplevel)
-
- ;; Internal shows also kick off Realizes after(?) the
- ;; topmost new widget is packed. Showing the new then
- ;; packing it, or packing the new then showing it, or
- ;; packing then show-alling at the end. They all wind
- ;; up in Realize before getting an allocation.
-
(%trace "; -show-all "toplevel"\n")
- ;;(gtk-widget-grab-focus (minibuffer-widget screen))
(gtk-widget-show-all toplevel)
(%trace "; update-widgets done\n")))))
(set-fix-layout-size! widget new-width new-height))))))))
(define (pack-new! box window prefix)
- (%trace "; "prefix"pack-new! "box" "window"\n")
+ (%trace "; "prefix"pack-new! "window" in "box"\n")
(cond
((combination? window)
(let ((new (if (combination-vertical? window)
(new-prefix (string-append prefix "--")))
(for-each (lambda (i) (pack-new! new (inferior-window i) new-prefix))
(window-inferiors window))
- ;;(%trace "; "prefix"pack-new! showing "box" BEFORE packing\n")
- ;;(gtk-widget-show new)
(%trace "; "prefix"pack-new! packing "new" in "box"\n")
(gtk-box-pack-end box new #t #t 0)))
((buffer-frame? window)
(%widget-x-size window screen)
(%widget-y-size window screen))
(gtk-box-pack-end vbox scroller #f #f 0)
- ;;(%trace "; "prefix"pack-new! showing "vbox"\n")
- ;;(gtk-widget-show-all vbox)
(%trace "; "prefix"pack-new! packing "vbox" into "box"\n")
(gtk-box-pack-end box vbox #f #f 0))
;; With modeline: vbox and scroller SHOULD expand.
(begin
(gtk-box-pack-end vbox modeline #f #f 0)
(gtk-box-pack-end vbox scroller #t #t 0)
- ;;(%trace "; "prefix"pack-new! showing "vbox"\n")
- ;;(gtk-widget-show-all vbox)
(%trace "; "prefix"pack-new! packing "vbox" into "box"\n")
(gtk-box-pack-end box vbox #t #t 0)))
;;(%trace "; "prefix"pack-new! showing "vbox"\n")
))
(else (error "Unexpected Edwin window:" window))))
- (define-integrable (minibuffer-widget screen)
- (any-child (lambda (widget)
- (and (text-widget? widget)
- (eq? #f (text-widget-modeline widget))))
- (gtk-screen-toplevel screen)))
-
(main)))
+(define-integrable (typein-widget screen)
+ (let* ((top-box (car (gtk-container-reverse-children
+ (gtk-screen-toplevel screen))))
+ ;; Typein widget is always added first -- last in the reverse list.
+ (typein-frame (last (gtk-container-reverse-children top-box))))
+ (any-child text-widget? typein-frame)))
+
(define-integrable (%text-x-size window)
(%window-x-size (frame-text-inferior window)))
(define-guarantee text-widget "a <text-widget>")
(define-method initialize-instance ((widget <text-widget>) x-size y-size)
- (%trace ";((initialize-instance <text-widget>) "widget
- " "x-size" "y-size")...\n")
+;;; (%trace ";(initialize-instance <text-widget>) "widget
+;;; " "x-size" "y-size"\n")
(let ((screen (edwin-widget-screen widget)))
(call-next-method widget
(x-size->width screen x-size)
(y-size->height screen y-size)))
(let ((drawing (make-fix-drawing)))
- (%trace "; drawing: "drawing"\n")
+;;; (%trace "; drawing: "drawing"\n")
(let ((ink (make-simple-text-ink)))
(set-simple-text-ink-text! ink widget "Initial override message.")
(fix-drawing-add-ink! drawing ink)
(car (fix-drawing-display-list (text-widget-override-drawing widget))))))
(define-method fix-layout-realize-callback ((widget <text-widget>))
- (%trace ";((fix-layout-realize-callback <text-widget>) "widget")\n")
+ (%trace ";(fix-layout-realize-callback <text-widget>) "widget"\n")
(let ((geometry (fix-layout-geometry widget)))
(if (or (not (fix-rect-width geometry))
(not (fix-rect-height geometry)))
(set-gtk-widget-bg-color! widget (gtk-widget-base-color widget)))
(define-method fix-layout-new-geometry-callback ((widget <text-widget>))
- (%trace ";((fix-layout-new-geometry-callback <text-widget>) "widget")\n")
+ (%trace ";(fix-layout-new-geometry-callback <text-widget>) "widget"\n")
(call-next-method widget)
(thread-queue/queue-no-hang!
event-queue
(<edwin-widget>))
(define-method initialize-instance ((widget <modeline-widget>))
- (%trace ";((initialize-instance <modeline-widget>) "widget")...\n")
+;;; (%trace ";(initialize-instance <modeline-widget>) "widget"\n")
(let ((screen (edwin-widget-screen widget)))
(call-next-method widget -1 (y-size->height screen 1)))
(let ((drawing (make-fix-drawing)))
- (%trace ";\t drawing: "drawing"\n")
+;;; (%trace "; drawing: "drawing"\n")
(let ((ink (make-simple-text-ink)))
(set-simple-text-ink-text!
ink widget "--------Initial mode line.--------------------------------")
widget)
(define-method fix-layout-realize-callback ((widget <modeline-widget>))
- (%trace ";((fix-layout-realize-callback <modeline-widget>) "widget")\n")
+ (%trace ";(fix-layout-realize-callback <modeline-widget>) "widget"\n")
(let ((geometry (fix-layout-geometry widget)))
(if (or (not (fix-rect-width geometry))
(not (fix-rect-height geometry)))
)
(define-method initialize-instance ((widget <buffer-frame-widget>))
- (%trace ";((initialize-instance <buffer-frame-widget>) "widget")...\n")
+;;; (%trace ";(initialize-instance <buffer-frame-widget>) "widget"\n")
(call-next-method widget #f 0))
;; Assume there is one text-widget in a buffer-frame-widget.
(old-drawing (text-widget-buffer-drawing widget))
(old-buffer (and old-drawing
(buffer-drawing-buffer old-drawing))))
- (%trace ";\tnew/old buffer: "new-buffer
- "/"old-buffer" ("old-drawing")\n")
(if (and old-buffer (eq? new-buffer old-buffer)
old-drawing (drawing-match? old-drawing))
(%trace ";\tno change\n")
(let ((new-drawing (find/create-drawing widget)))
+ (%trace ";\tnew/old buffer: "new-buffer
+ "/"old-buffer" ("old-drawing")\n")
(set-text-widget-buffer-drawing! widget new-drawing)
(re-cursor widget new-drawing)
(if (not (eq? (fix-layout-drawing widget)
(eq? (%window-char-image-strings bufwin)
(buffer-drawing-char-image-strings drawing)))))
- (main))
- (%trace "; update-widget-buffer done\n"))
+ (main)))
(define (update-window widget)
(%trace "; update-window "widget"\n")
(define modeline-image "")
(define (update-modeline widget)
+ ;; Must be last in the update process. Some of its state depends on
+ ;; the final scroll position!
(%trace "; update-modeline "widget"\n")
(let* ((window (text-widget-buffer-frame widget))
;; Add a few columns so the text runs past scrollbars and
(mark-permanent-copy window-point))
(redraw-cursor widget window-point))))
;; Get cursor appearance right per current mode. An active
- ;; minibuffer looks selected, else invisible. An active buffer
+ ;; typein window looks selected, else invisible. An active buffer
;; looks selected, else visible.
(let ((selected (screen-cursor-window (window-screen window))))
(cond ((eq? window selected)
(set-box-ink-shadow! cursor 'etched-in)
(visible! cursor #t))
- ((minibuffer-widget? widget)
+ ((and (text-widget? widget)
+ (not (text-widget-modeline widget)))
(set-box-ink-shadow! cursor 'etched-out)
(visible! cursor #f))
(else ;; text widget
projects / mit-scheme.git / commitdiff