[graphic-forms-cvs] r180 - in trunk/src: demos/textedit uitoolkit/system uitoolkit/widgets
junrue at common-lisp.net
junrue at common-lisp.net
Fri Jul 7 06:34:12 UTC 2006
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)
More information about the Graphic-forms-cvs
mailing list