Author: junrue Date: Fri Jul 7 02:34:12 2006 New Revision: 180 Modified: trunk/src/demos/textedit/textedit-window.lisp trunk/src/uitoolkit/system/system-constants.lisp trunk/src/uitoolkit/widgets/edit.lisp trunk/src/uitoolkit/widgets/event.lisp Log: some minor cleanup after a bunch of experimentation trying to use EditWordBreakProc to implement dynamically changing word wrap behavior in edit controls, which I have given up on for now Modified: trunk/src/demos/textedit/textedit-window.lisp ============================================================================== --- trunk/src/demos/textedit/textedit-window.lisp (original) +++ trunk/src/demos/textedit/textedit-window.lisp Fri Jul 7 02:34:12 2006 @@ -49,18 +49,6 @@ (setf *textedit-win* nil) (gfw:shutdown 0)) -(defun format-textedit (disp menu time) - (declare (ignore disp time)) - (gfw:check (elt (gfw:items menu) 1) - (and *textedit-control* (gfw:auto-hscroll-p *textedit-control*)))) - -(defun wordwrap-textedit (disp item time rect) - (declare (ignore disp item time rect)) - (when *textedit-control* - (let ((flag (not (gfw:auto-hscroll-p *textedit-control*)))) - ;(gfw:enable-auto-scrolling *textedit-control* flag t) - (gfw:enable-scrollbars *textedit-control* flag t)))) - (defclass textedit-win-events (gfw:event-dispatcher) ()) (defmethod gfw:event-close ((disp textedit-win-events) window time) @@ -162,9 +150,8 @@ (:item "&Go To...") (:item "" :separator) (:item "Select &All"))) - (:item "F&ormat" :callback #'format-textedit - :submenu ((:item "&Font...") - (:item "&Word Wrap" :callback #'wordwrap-textedit))) + (:item "F&ormat" + :submenu ((:item "&Font..."))) (:item "&Help" :submenu ((:item "&About TextEdit" :callback #'about-textedit))))))) (setf *textedit-win* (make-instance 'gfw:top-level :dispatcher (make-instance 'textedit-win-events) @@ -172,8 +159,7 @@ :style '(:frame))) (setf *textedit-control* (make-instance 'gfw:edit :parent *textedit-win* :style '(:multi-line - :auto-hscroll :auto-vscroll - :horizontal-scrollbar + :auto-vscroll :vertical-scrollbar :want-return))) (setf (gfw:menu-bar *textedit-win*) menubar) Modified: trunk/src/uitoolkit/system/system-constants.lisp ============================================================================== --- trunk/src/uitoolkit/system/system-constants.lisp (original) +++ trunk/src/uitoolkit/system/system-constants.lisp Fri Jul 7 02:34:12 2006 @@ -889,6 +889,10 @@ (defconstant +user-timer-maximum+ #x7FFFFFFF) (defconstant +user-timer-minimum+ #x0000000A) +(defconstant +wb-left+ 0) +(defconstant +wb-right+ 1) +(defconstant +wb-isdelimiter+ 2) + (defconstant +wm-create+ #x0001) (defconstant +wm-destroy+ #x0002) (defconstant +wm-move+ #x0003) Modified: trunk/src/uitoolkit/widgets/edit.lisp ============================================================================== --- trunk/src/uitoolkit/widgets/edit.lisp (original) +++ trunk/src/uitoolkit/widgets/edit.lisp Fri Jul 7 02:34:12 2006 @@ -74,10 +74,6 @@ (setf std-flags (logior std-flags gfs::+es-autohscroll+))) (values std-flags (if (find :no-border style) 0 gfs::+ws-ex-clientedge+)))) -(defmethod enable-auto-scrolling ((self edit) horizontal vertical) - (declare (ignore horizontal vertical)) - (error 'gfs:toolkit-error :detail "not yet implemented")) - (defmethod enable-scrollbars ((self edit) horizontal vertical) (let ((bits (gfs::get-window-long (gfs:handle self) gfs::+gwl-style+))) (if horizontal @@ -99,7 +95,9 @@ ex-style (increment-widget-id (thread-context))))) (setf (slot-value self 'gfs:handle) hwnd))) - (init-control self)) + (init-control self) + (if (find :auto-hscroll (style-of self)) + (replace-edit-wordbreak-func self))) (defmethod line-count ((self edit)) (if (gfs:disposed-p self) Modified: trunk/src/uitoolkit/widgets/event.lisp ============================================================================== --- trunk/src/uitoolkit/widgets/event.lisp (original) +++ trunk/src/uitoolkit/widgets/event.lisp Fri Jul 7 02:34:12 2006 @@ -114,8 +114,7 @@ (defun subclass-wndproc (hwnd) (if (zerop (gfs::set-window-long hwnd gfs::+gwlp-wndproc+ - (cffi:pointer-address - (cffi:get-callback 'subclassing_wndproc)))) + (cffi:pointer-address (cffi:get-callback 'subclassing_wndproc)))) (error 'gfs:win32-error :detail "set-window-long failed"))) (defun dispatch-notification (widget wparam-hi)