From 298ef96c4143eb66abb1c66fc8857b5126ef6fda Mon Sep 17 00:00:00 2001 From: goffioul Date: Mon, 13 Jun 2005 08:39:41 +0000 Subject: [PATCH] - Make "Prev/Next Window" menu items dynamic - Add interface for library (un)loading - Make it possible to use richtext component instead of basic edit component --- contrib/win32/txtedit.lisp | 41 +++++++++++++++++++++++--------------- contrib/win32/win32.lisp | 11 +++++++++- 2 files changed, 35 insertions(+), 17 deletions(-) diff --git a/contrib/win32/txtedit.lisp b/contrib/win32/txtedit.lisp index 82bac6b87..e44434b00 100644 --- a/contrib/win32/txtedit.lisp +++ b/contrib/win32/txtedit.lisp @@ -22,6 +22,7 @@ (defvar *txtedit-tab* *NULL*) (defvar *txtedit-tab-proc* *NULL*) (defvar *txtedit-current* nil) +(defvar *txtedit-rich-p* nil) (defstruct txtedit (handle *NULL*) title dirty) (defvar *txtedit-default-title* "ECL Text Editor") @@ -169,7 +170,7 @@ Copyright (c) 2005, Michael Goffioul.") (with-foreign-object (r 'RECT) (getclientrect parent r) (sendmessage *txtedit-tab* *TCM_ADJUSTRECT* *FALSE* (make-lparam r)) - (let ((new-editor (make-txtedit :handle (createwindowex *WS_EX_CLIENTEDGE* "EDIT" "" + (let ((new-editor (make-txtedit :handle (createwindowex *WS_EX_CLIENTEDGE* (if *txtedit-rich-p* *RICHEDIT_CLASS* "EDIT") "" (logior *WS_CHILD* *WS_HSCROLL* *WS_VSCROLL* *WS_VISIBLE* *WS_CLIPSIBLINGS* *ES_AUTOHSCROLL* *ES_AUTOVSCROLL* *ES_MULTILINE* *ES_LEFT*) (get-slot-value r 'RECT 'left) @@ -178,6 +179,7 @@ Copyright (c) 2005, Michael Goffioul.") (- (get-slot-value r 'RECT 'bottom) (get-slot-value r 'RECT 'top)) *txtedit-tab* (make-ID +EDITCTL_ID+) *NULL* *NULL*)))) (sendmessage (txtedit-handle new-editor) *WM_SETFONT* (make-wparam (getstockobject *SYSTEM_FIXED_FONT*)) 0) + (and *txtedit-rich-p* (sendmessage (txtedit-handle new-editor) *EM_SETEVENTMASK* 0 *ENM_CHANGE*)) (with-foreign-object (tab 'TCITEM) (setf (get-slot-value tab 'TCITEM 'mask) *TCIF_TEXT*) (setf (get-slot-value tab 'TCITEM 'pszText) (tab-name new-editor)) @@ -283,20 +285,24 @@ Copyright (c) 2005, Michael Goffioul.") )))) 0) ((= umsg *WM_INITMENUPOPUP*) - (when (= (loword lparam) 2) - (let* ((wMenu (make-handle wparam)) - (nPos (loword lparam)) - (nItems (getmenuitemcount wMenu))) - (dotimes (j (- nItems 2)) - (deletemenu wMenu 2 *MF_BYPOSITION*)) - (when *txtedit-edit* - (appendmenu wMenu *MF_SEPARATOR* 0 "") - (loop for e in *txtedit-edit* - for k from 0 - do (progn - (appendmenu wMenu *MF_STRING* (+ +IDM_WINDOW_FIRST+ k) (tab-name e)) - (when (= k *txtedit-current*) - (checkmenuitem wMenu (+ k 3) (logior *MF_BYPOSITION* *MF_CHECKED*)))))))) + (case (loword lparam) + (2 (let* ((wMenu (make-handle wparam)) + (nPos (loword lparam)) + (nItems (getmenuitemcount wMenu))) + (dotimes (j (- nItems 2)) + (deletemenu wMenu 2 *MF_BYPOSITION*)) + (when *txtedit-edit* + (appendmenu wMenu *MF_SEPARATOR* 0 "") + (loop for e in *txtedit-edit* + for k from 0 + do (progn + (appendmenu wMenu *MF_STRING* (+ +IDM_WINDOW_FIRST+ k) (tab-name e)) + (when (= k *txtedit-current*) + (checkmenuitem wMenu (+ k 3) (logior *MF_BYPOSITION* *MF_CHECKED*)))))) + (enablemenuitem wMenu +IDM_PREVWINDOW+ (if (= *txtedit-current* 0) *MF_GRAYED* *MF_ENABLED*)) + (enablemenuitem wMenu +IDM_NEXTWINDOW+ (if (< *txtedit-current* (1- (length *txtedit-edit*))) *MF_ENABLED* *MF_GRAYED*)) + )) + ) 0) ((= umsg *WM_COMMAND*) (let ((ctrl-ID (loword wparam)) @@ -366,6 +372,8 @@ Copyright (c) 2005, Michael Goffioul.") (defun register-txtedit-class () (unless *txtedit-class-registered* + (when (and *txtedit-rich-p* (null-pointer-p (loadlibrary "riched20.dll"))) + (error "Cannot load WIN32 library: riched20.dll")) (make-wndclass "SimpleTextEditor" :lpfnWndProc #'txtedit-proc) (setq *txtedit-class-registered* t))) @@ -373,9 +381,10 @@ Copyright (c) 2005, Michael Goffioul.") (defun unregister-txtedit-class () (when *txtedit-class-registered* (unregisterclass "SimpleTextEditor" *NULL*) + (and *txtedit-rich-p* (freelibrary (getmodulehandle "riched20.dll"))) (setq *txtedit-class-registered* nil))) -(defun txtedit (&optional fname) +(defun txtedit (&optional fname &key rich-p &aux (*txtedit-rich-p* rich-p)) (register-txtedit-class) (let* ((fname-str (if fname (convert-to-foreign-string (coerce fname 'simple-string)) diff --git a/contrib/win32/win32.lisp b/contrib/win32/win32.lisp index b34d9add9..f21534383 100644 --- a/contrib/win32/win32.lisp +++ b/contrib/win32/win32.lisp @@ -19,6 +19,7 @@ (clines "#define WINVER 0x500") (clines "#include ") (clines "#include ") +(clines "#include ") ;; Windows types @@ -67,6 +68,7 @@ (define-win-constant *WS_EX_CLIENTEDGE* "WS_EX_CLIENTEDGE") +(define-win-constant *RICHEDIT_CLASS* "RICHEDIT_CLASS" LPCSTR) (define-win-constant *WC_LISTVIEW* "WC_LISTVIEW" LPCSTR) (define-win-constant *WC_TABCONTROL* "WC_TABCONTROL" LPCSTR) @@ -96,9 +98,11 @@ (define-win-constant *ES_MULTILINE* "ES_MULTILINE") (define-win-constant *EM_CANUNDO* "EM_CANUNDO") +(define-win-constant *EM_SETEVENTMASK* "EM_SETEVENTMASK") (define-win-constant *EM_SETSEL* "EM_SETSEL") (define-win-constant *EM_UNDO* "EM_UNDO") (define-win-constant *EN_CHANGE* "EN_CHANGE") +(define-win-constant *ENM_CHANGE* "ENM_CHANGE") (define-win-constant *TCIF_IMAGE* "TCIF_IMAGE") (define-win-constant *TCIF_PARAM* "TCIF_PARAM") @@ -162,6 +166,7 @@ (define-win-constant *MF_CHECKED* "MF_CHECKED") (define-win-constant *MF_DISABLED* "MF_DISABLED") (define-win-constant *MF_ENABLED* "MF_ENABLED") +(define-win-constant *MF_GRAYED* "MF_GRAYED") (define-win-constant *MF_MENUBREAK* "MF_MENUBREAK") (define-win-constant *MF_POPUP* "MF_POPUP") (define-win-constant *MF_SEPARATOR* "MF_SEPARATOR") @@ -261,7 +266,7 @@ (nMaxFilter :unsigned-int) (nFilterIndex :unsigned-int) (lpstrFile LPCSTR) (nMaxFile :unsigned-int) (lpstrFileTitle LPCSTR) (nMaxFileTitle :unsigned-int) (lpstrInitialDir LPCSTR) (lpstrTitle LPCSTR) (Flags :unsigned-int) (nFileOffset :unsigned-short) (nFileExtension :unsigned-short) (lpstrDefExt LPCSTR) (lCustData :int) (lpfnHook HANDLE) (lpTemplateName LPCSTR) - (pvReserved :pointer-void) (dwReserved :unsigned-int) (FlagsEx :unsigned-int)) + #|(pvReserved :pointer-void) (dwReserved :unsigned-int) (FlagsEx :unsigned-int)|#) (def-struct ACCEL (fVirt :byte) (key :unsigned-short) (cmd :unsigned-short)) (def-struct TCITEM (mask :unsigned-int) (dwState :unsigned-int) (dwStateMask :unsigned-int) (pszText :cstring) (cchTextMax :int) (iImage :int) (lParam :long)) @@ -316,6 +321,9 @@ LRESULT CALLBACK WndProc_proxy(HWND hwnd, UINT uMsg, WPARAM wParam, LPARAM lPara `(let ((,var (make-pointer ,ptr ',type))) ,@body)) (def-function ("ZeroMemory" zeromemory) ((Destination :pointer-void) (Length :unsigned-int)) :returning :void) +(def-function ("LoadLibrary" loadlibrary) ((lpLibFileName LPCSTR)) :returning HANDLE) +(def-function ("FreeLibrary" freelibrary) ((hLibModule HANDLE)) :returning :int) +(def-function ("GetModuleHandle" getmodulehandle) ((lpModuleName LPCSTR)) :returning HANDLE) (def-function ("GetStockObject" getstockobject) ((fnObject :int)) :returning HANDLE) (def-function ("GetTextMetrics" gettextmetrics) ((hdc HANDLE) (lptm (* TEXTMETRIC))) :returning :int) (def-function ("GetDC" getdc) ((hWnd HANDLE)) :returning HANDLE) @@ -399,6 +407,7 @@ LRESULT CALLBACK WndProc_proxy(HWND hwnd, UINT uMsg, WPARAM wParam, LPARAM lPara (def-function ("RemoveMenu" removemenu) ((hMenu HANDLE) (uPosition :unsigned-int) (uFlags :unsigned-int)) :returning :int) (def-function ("GetMenuItemCount" getmenuitemcount) ((hMenu HANDLE)) :returning :int) (def-function ("CheckMenuItem" checkmenuitem) ((hMenu HANDLE) (uIDCheckItem :unsigned-int) (uCheck :unsigned-int)) :returning :int) +(def-function ("EnableMenuItem" enablemenuitem) ((hMenu HANDLE) (uIDCheckItem :unsigned-int) (uCheck :unsigned-int)) :returning :int) (def-function ("CreateAcceleratorTable" createacceleratortable) ((lpaccl (* ACCEL)) (cEntries :int)) :returning HANDLE) (def-function ("TranslateAccelerator" translateaccelerator) ((hWnd HANDLE) (hAccTable HANDLE) (lpMsg (* MSG))) :returning :int) (def-function ("DestroyAcceleratorTable" destroyacceleratortable) ((hAccTable HANDLE)) :returning :int)