Menu
▾
▴
[Win32forth-cvs] win32forth/apps/Win32ForthIDE AnsLink.f, NONE, 1.1 ClassBrowser.f, NONE, 1.1 CommandID.f, NONE, 1.1 EdAbout.f, NONE, 1.1 EdCommand.f, NONE, 1.1 EdCompile.f, NONE, 1.1 EdDebug.f, NONE, 1.1 EdFindInFiles.f, NONE, 1.1 EdMenu.f, NONE, 1.1 EdRemote.f, NONE, 1.1 EdStatusbar.f, NONE, 1.1 EdTabControl.f, NONE, 1.1 EdToolbar.f, NONE, 1.1 EdVersion.f, NONE, 1.1 Main.f, NONE, 1.1 ProjectTree.f, NONE, 1.1 ScintillaHyperMDI.f, NONE, 1.1 ScintillaMDI.f, NONE, 1.1 X_SEARCH.F, NONE, 1.1
Update of /cvsroot/win32forth/win32forth/apps/Win32ForthIDE In directory sc8-pr-cvs9.sourceforge.net:/tmp/cvs-serv3383/apps/Win32ForthIDE Added Files: AnsLink.f ClassBrowser.f CommandID.f EdAbout.f EdCommand.f EdCompile.f EdDebug.f EdFindInFiles.f EdMenu.f EdRemote.f EdStatusbar.f EdTabControl.f EdToolbar.f EdVersion.f Main.f ProjectTree.f ScintillaHyperMDI.f ScintillaMDI.f X_SEARCH.F Log Message: Base commit of the new Win32Forth-Ide application. --- NEW FILE: EdTabControl.f --- \ $Id: EdTabControl.f,v 1.1 2006/06/05 09:19:00 dbu_de Exp $ \ \ Written by Dirk Busch cr .( Loading EdTabControl...) needs ExControls.f needs ListView.f needs ClassBrowser.f \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ \ some helper words \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ : GetNotifyWnd ( addr -- hWnd ) \ Get the window handle to the control sending a WM_NOTIFY message. @ ; : GetNotifyId ( addr -- Id ) \ Get the identifier of the control sending a WM_NOTIFY message. cell+ @ ; : GetNotifyCode ( addr -- Code ) \ Get the notification code of the control sending a WM_NOTIFY message. 2 cells + @ ; \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ \ the File Listview control \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ :class FileListView <super ListView LV_ITEM LvItem LV_COLUMN LvColumn LV_FINDINFO LvFindInfo :M WindowStyle: ( -- style ) WindowStyle: super WS_BORDER invert and \ remove WS_BORDER style WS_CLIPCHILDREN or [ LVS_REPORT LVS_SINGLESEL or LVS_SHOWSELALWAYS OR LVS_EDITLABELS or LVS_SORTASCENDING or ] literal or ;M :M ExWindowStyle: ( -- ) WS_EX_CLIENTEDGE ;M :M WndClassStyle: ( -- style ) \ Set the style member of the the WNDCLASS structure. CS_DBLCLKS ;M :M Start: ( Parent -- ) Start: super [ LVCF_FMT LVCF_WIDTH or LVCF_TEXT or LVCF_SUBITEM or ] literal SetMask: LvColumn LVCFMT_LEFT Setfmt: LvColumn 200 Setcx: LvColumn z" Files" SetpszText: LvColumn Addr: LvColumn 1 InsertColumn: self drop ;M :M FindFile: ( addr -- ) \ Find a file in the list view. \ addr is the object address of the mdi child window LVFI_PARAM SetFlags: LvFindInfo SetlParam: LvFindInfo Addr: LvFindInfo -1 FindItem: self ;M :M RemoveFile: ( addr -- ) \ Remove a file from the list view. \ addr is the object address of the mdi child window FindFile: self dup -1 <> if DeleteItem: self then drop ;M create $buffer 1024 allot : FileNameToBuffer { addr1 -- addr2 } \ addr1 is the object address of the mdi child window GetFileName: addr1 count "TO-PATHEND" dup 0= if drop s" Unnamed File" then $buffer place $buffer +null $buffer 1+ ; :M AddFile: { addr -- } \ Add a file to the list view. \ addr is the object address of the mdi child window addr FindFile: self -1 = if LVIF_TEXT LVIF_PARAM or SetMask: LvItem addr SetlParam: LvItem addr FileNameToBuffer SetpszText: LvItem Addr: LvItem InsertItem: self drop then ;M :M SetFileState: ( state addr -- ) \ Set the state of a file to the list view. \ addr is the object address of the mdi child window FindFile: self dup -1 <> if LVIF_STATE SetMask: LvItem Setstate: LvItem -1 SetstateMask: LvItem Addr: LvItem swap SetItemState: self drop else drop then ;M :M Handle_Notify: ( h m w l -- f ) \ Handle the notification messages of the listview control. dup GetNotifyCode LVN_ITEMCHANGED = if LVN_GetNotifyParam OnSelect else drop then false ;M ;class \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ \ the Project Treeview control \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ fload ProjectTree.f :class ProjectWindow <Super ProjectTreeViewControl :M WindowStyle: ( -- style ) WindowStyle: super WS_BORDER invert and \ remove WS_BORDER style WS_CLIPCHILDREN or ;M :M ExWindowStyle: ( -- ) WS_EX_CLIENTEDGE ;M :M WndClassStyle: ( -- style ) \ Set the style member of the the WNDCLASS structure. CS_DBLCLKS ;M :M Handle_Notify: ( h m w l -- f ) \ Handle the notification messages of the treeview control. dup GetNotifyCode NM_DBLCLK = if IDM_EXECUTEFILE DoCommand false else Handle_Notify: super then ;M ;class \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ \ an extended TabControl class \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ :class TabControlEx <super TabControl :M WndClassStyle: ( -- style ) \ Set the style member of the the WNDCLASS structure. CS_DBLCLKS ;M :M Start: ( Parent -- ) Start: super DEFAULT_GUI_FONT call GetStockObject SetFont: self ;M ;class \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ \ The Tabulator window \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ :class TabWindow <super Child-Window TabControlEx cTab FileListView cFileList ProjectWindow cProjectTree ClassBrowserWindow cClassTree ClassBrowserWindow cVocTree :M ReSize: ( -- ) \ Resize the controls within the main window. AutoSize: cTab ClientSize: cTab 2over d- ( x y w h ) 4dup Move: cFileList 4dup Move: cProjectTree 4dup Move: cClassTree Move: cVocTree ;M :M On_Size: ( -- ) \ Handle the WM_SIZE message. On_Size: super ReSize: self ;M :M AutoSize: ( -- ) \ *G Resize the control to fit in the client area of the parent window. tempRect.AddrOf GetClientRect: Parent 0 0 Right: tempRect Bottom: tempRect \ x,y,h,w Move: self ;M : ShowFiles ( -- ) SW_HIDE Show: cProjectTree SW_HIDE Show: cVocTree SW_HIDE Show: cClassTree SW_SHOW Show: cFileList ; : ShowProject ( -- ) SW_HIDE Show: cFileList SW_HIDE Show: cVocTree SW_HIDE Show: cClassTree \ TEST ONLY... s" proj\Win32ForthIDE.fpj" Prepend<home>\ SetProjectFileName: cProjectTree OpenProject: cProjectTree ExpandAll \ ... SW_SHOW Show: cProjectTree ; : ShowVocs ( -- ) SW_HIDE Show: cFileList SW_HIDE Show: cProjectTree SW_HIDE Show: cClassTree AddVocabularies: cVocTree SW_SHOW Show: cVocTree ; : ShowClasses ( -- ) SW_HIDE Show: cFileList SW_HIDE Show: cProjectTree SW_HIDE Show: cVocTree AddClasses: cClassTree SW_SHOW Show: cClassTree ; :M SelChange: ( -- ) \ Show the control for the currently selected tab. GetSelectedTab: cTab case 0 of ShowFiles endof 1 of ShowProject endof 2 of ShowVocs endof 3 of ShowClasses endof endcase ;M : selchange-func { lParam obj \ Parent -- false } \ This function es executed when the currently selected tab has changed. \ lParam is the adress of the Address of an NMHDR structure. \ obj is the address of the TabControl object that has send the \ notification message. GetParent: obj to Parent SelChange: Parent false ; :M WM_NOTIFY ( h m w l -- f ) \ Handle the notification messages of the controls. dup GetNotifyWnd GetHandle: cTab = if Handle_Notify: cTab else dup GetNotifyWnd GetHandle: cFileList = if Handle_Notify: cFileList else dup GetNotifyWnd GetHandle: cClassTree = if Handle_Notify: cClassTree else dup GetNotifyWnd GetHandle: cVocTree = if Handle_Notify: cVocTree else dup GetNotifyWnd GetHandle: cProjectTree = if Handle_Notify: cProjectTree else false then then then then then ;M :M On_Init: ( -- ) self Start: cTab self Start: cFileList self Start: cProjectTree self Start: cVocTree self Start: cClassTree \ ------------------------------------------------------------------------ ['] selchange-func IsChangeFunc: cTab TCIF_TEXT IsMask: cTab z" Files" IsPszText: cTab 1 InsertTab: cTab TCIF_TEXT IsMask: cTab z" Project" IsPszText: cTab 2 InsertTab: cTab TCIF_TEXT IsMask: cTab z" Vocabularies" IsPszText: cTab 3 InsertTab: cTab TCIF_TEXT IsMask: cTab z" Classes" IsPszText: cTab 4 InsertTab: cTab \ ------------------------------------------------------------------------ ReSize: self \ resize the controls within the main window SelChange: self \ show the control for the currently selected tab ;M :M AddFile: ( addr -- ) \ Add a file to the file list view. AddFile: cFileList ;M :M RemoveFile: ( addr -- ) \ Remove a file from the file list view. RemoveFile: cFileList ;M :M DeSelectFile: ( addr -- ) \ DeSelect a file in the file list view. cr ." DeSelectFile: " dup h. 0 swap SetFileState: cFileList ;M :M SelectFile: ( addr -- ) \ Select a file in the file list view. cr ." SelectFile: " dup h. LVIS_SELECTED swap SetFileState: cFileList ;M ;class --- NEW FILE: EdVersion.f --- \ $Id: EdVersion.f,v 1.1 2006/06/05 09:19:00 dbu_de Exp $ 10128 value sciedit_version# \ Version numbers: v.ww.rr \ \ v Major version \ ww Minor version \ rr Release \ \ Odd minor version numbers are possibly unstable beta releases. : (.sciedit_version) ( -- addr len ) sciedit_version# 0 <# # # '.' hold # # '.' hold #s #> ; create sciedit-compile-version time-len allot \ a place to save the compile time get-local-time \ save as part of compiled image time-buf sciedit-compile-version time-len move \ move time into buffer \s \ --------------------------------------------------------------------------- \ ---------------------- Initals of developers ----------------------------- \ --------------------------------------------------------------------------- DBU Dirk Busch (di...@wi...) EAB Ezra Boyce ROD Rod Oakford \ --------------------------------------------------------------------------- \ ---------------------- Known bugs ---------------------------------------- \ --------------------------------------------------------------------------- - Ctrl+a ctrl+c in the html browser window does not copy to the clipboard (jos) - In a html browser window, the filename isn't updated in the tiltlebar when a file is opened by selecting a link in the html file (dbu) - When using hyperlinking somtimes SciEdit ends in an endless loop displaying error messages in a MessageBox. (dbu) - Fixed: Samstag, August 20 2005 dbu \ --------------------------------------------------------------------------- \ ---------------------- Wish list ----------------------------------------- \ --------------------------------------------------------------------------- - Ability to compile a line or selected text (erza) - Text search with regular expressions (the sintilla control can do this) (dbu) - Search and replace text (dbu) - The hyperlinking to this source code my places the source about three lines from the bottom of the screen in a 25 lines screen. Ability much nicer to have the source code appear a few lines down from the top of the window since source code usually trails on down below the word in question (jap) - Open the last active files on startup (dbu) - Also searching backwards is useful at times. (george) - User defined color's for the Background and the Text (dbu) - Convert Tab's to spaces and spaces to Tab's (RBS) - If a second copy of a file is opend SciEdit currently activates the first copy only. It should better check if the copy on the disk is newer than the ony in memory, and ask the user to load the newer one. (dbu) - Monitor the file-system, and ask the user to reload a file if it was modified. \ --------------------------------------------------------------------------- \ ---------------------- Change Log ---------------------------------------- \ --------------------------------------------------------------------------- \ changes for Version 1.01.02 dbu Samstag, August 14 2004 - New "View" and "Options" menu - New Menu entry "Save all Files before Compile" in the "Options" menu. If this option is active all open source files will be saved before the compilation of the active file. If this option is inactive only the active file will be saved - Enhanced toolbar \ changes for Version 1.01.03 dbu Sonntag, August 15 2004 - New menu Entry "Colorize source" in the "View" menu to turn colorization on and off (new w32fScintilla.dll Version 1.6.1.4 is needed). dbu Montag, August 16 2004 - New menu Entry "Display Line numers" in the "View" menu (thank's Erza to tell me how it works). \ changes for Version 1.01.04 dbu Samstag, August 21 2004 - New Menu entry "Customize toolbar..." in the "Options" menu - made debug support work - "Search..." and "Find text in Files..." now grab the highlighted text \ changes for Version 1.01.05 dbu Sonntag, August 22 2004 - New "Close file" and "Close all" buttons in the toolbar - enable/disableing of toolbar buttos and menu entries corrected \ changes for Version 1.01.06 dbu Samstag, August 28 2004 - New Menu entries "Line cut...", "Line copy", "Line transpose", "Line duplicate", "Lowercase" and "Uppercase" in the "Edit" menu. - Little enhancement of the debug support \ changes for Version 1.01.07 dbu Sonntag, August 29 2004 - Added a recent file list to the File menu (Thank's Rod for the code) \ changes for Version 1.01.08 dbu Samstag, September 04 2004 - Fixed some Win98 bug's (I hope) as Rod sugested - Deleted some duplicated command id's (thank's Prad) - Removed the obsolate Download stuff - Changed the "Open Source files" and "The open HTML Files" dialog's to allow multiple selection of files - Fixed a bug in the recent file list (HTML files were opend for editing and not for displaying HTML) - Enabled Drag & Drop from windows explorer to open files. - Changed to open only one copy of a file. If you try to open a second copy the window of first one is activated and it beep's one time. - New menu entry "Set Tab options..." in the options menu. It opens a dialog were you can set the tab size (between 1 and 8 chars) and if you want to insert real tab's or spaces (soft tab's) \ changes for Version 1.01.09 dbu Sonntag, September 05 2004 - Fixed a bug in the Class browser; once it was closed it couldn't be opend again - New entries in the "Options" menu to hide the Toolbar and/or Statusbar of the main window dbu Montag, September 06 2004 - Added a Statusbar to the Class browser window to tell the user how to open the source for a definition - In Brwose mode the statusbar of the main window now displays a text how to use the browse mode. \ changes for Version 1.01.10 dbu Dienstag, September 07 2004 - New menu entry "Open Highlighted File" in "File" menu (it need's some more work) \ changes for Version 1.01.11 dbu Donnerstag, September 09 2004 - Fixed the WM_COMMAND handling problems (I hope) - Fixed the NewFile: method of the EditorChild class whitch was complety broken \ changes for Version 1.01.12 dbu Samstag, September 11 2004 - Accelerator table support rewritten \ changes for Version 1.01.13 dbu Samstag, September 11 2004 Sonntag, September 12 2004 - WM_COMMAND handling reworked (I hope that it's finaly working now) \ changes for Version 1.01.14 dbu Dienstag, September 14 2004 - Fixed the display of the filename in the Titlebar \ changes for Version 1.01.15 dbu Donnerstag, September 16 2004 - Fixed loading of files \ changes for Version 1.01.16 dbu Samstag, September 18 2004 - Fixed some smal bugs in the colorization support \ changes for Version 1.01.17 dbu Samstag, Oktober 02 2004 - SciEditMDI now has it's own Icon's for the Main- and the MDI-windows \ changes for Version 1.01.18 dbu Mittwoch, Oktober 06 2004 - Changed to use Rod's AcceleratorTables.f instead of my Accel.f \ changes for Version 1.01.19 dbu Montag, November 08 2004 - Update w32fScintilla.dll to use the latest Scintilla Version 1.62 - File>Exit terminated SciEdit without saving changed files; fixed \ changes for Version 1.01.20 dbu Samstag, Dezember 04 2004 - New Button's "Back" and "Forward" added to the toolbar used to navigate within HTML documents and for browseing within the source files (Hyperlinking) \ changes for Version 1.01.21 dbu Sonntag, Dezember 26 2004 - New command "Help for highlighted Win32-API function" added to the help menu. The Win32-SDK help file is needed for this command. If you don't have a copy you can download it from: http://www.borland.com/devsupport/borlandcpp/patches/BC52HLP1.ZIP Don't forget to copy the win32.hlp file into the 'doc\hlp' folder of your Win32Forth version \ changes for Version 1.01.22 dbu Freitag, August 19 2005 - SciEdit append a null byte to any file that was saved to disk. Thank's Ezra for reporting this bug. \ changes for Version 1.01.23 dbu Samstag, August 20 2005 - Fixed some bugs in the hyper-linking and in the debug-interface. EAB August 21, 2005 - Added a little integration with ForthForm. If SciEdit is open ForthForm will use it for editing/viewing sources. Modification in EdRemote.f. dbu August 21, 2005 - Made the communication beetween SciEdit and the console window work a better (I hope). - New menu entry "Handle debug messages?" in the Win32Forth menu to turn off the handling of the debug messages from the console window. \ changes for Version 1.01.24 dbu Mittwoch, August 31 2005 - New options "Remove trailing white space" and "Ensure final line ending" \ changes for Version 1.01.25 dbu Donnerstag, Dezember 08 2005 - New "Glossary" command (ALT+G), that turns the selected lines into a glossary entry (for DexH) \ changes for Version 1.01.26 dbu Sonntag, Januar 08 2006 - New "DexH" menu. - Moved "Glossary" command into the DexH menu. - New "Bold" command (ALT+B) that turns the selected text into bold style for DexH. - New "Italic" command (ALT+I) that turns the selected text into italic style for DexH. - Fixed some bugs. \ changes for Version 1.01.27 dbu Samstag, Januar 21 2006 - New "Paragraph" command (ALT+P), that turns the selected lines into a paragraph (for DexH) - New "Code paragraph" command (CTRL+ALT+C), that turns the selected lines into a paragraph that is a code example (for DexH). - New "Typewriter" command (CTRL+ALT+T) that turns the selected text into typwriter style for DexH. \ changes for Version 1.01.28 Rod Saturday, May 06 2006 - Added Print and PageSetup --- NEW FILE: CommandID.f --- \ $Id: CommandID.f,v 1.1 2006/06/05 09:19:00 dbu_de Exp $ \ File: CommandID.f \ \ Author: Dirk Busch (dbu) \ Email: dir...@wi... \ \ Created: Mittwoch, Juni 09 2004 - dbu \ Updated: Samstag, Juli 03 2004 - 10:52 - dbu \ Saturday, May 06 2006 Added Print and PageSetup - Rod cr .( Loading Menu Command ID's...) : NewID ( <name> -- ) defined IF drop ELSE count "header NextId DOCON , , THEN ; IdCounter constant IDM_FIRST \ File menu NewID IDM_NEW_SOURCE_FILE NewID IDM_OPEN_SOURCE_FILE NewID IDM_CLOSE NewID IDM_SAVE NewID IDM_SAVE_AS NewID IDM_SAVE_ALL NewID IDM_RELOAD NewID IDM_OPEN_HTML_FILE NewID IDM_PRINT NewID IDM_PAGE_SETUP NewID IDM_EXIT NewID IDM_OPEN_RECENT_FILE NewID IDM_OPEN_HIGHLIGHTED_FILE \ Edit menu NewID IDM_UNDO NewID IDM_REDO NewID IDM_CUT NewID IDM_COPY NewID IDM_PASTE NewID IDM_DELETE NewID IDM_SELECT_ALL NewID IDM_REMOVE_SELECTION NewID IDM_FIND_TEXT NewID IDM_FIND_NEXT NewID IDM_FIND_PREVIOUS NewID IDM_FIND_IN_FILES NewID IDM_INSERT_DATE NewID IDM_INSERT_DATE&TIME NewID IDM_COMMENT_BLOCK NewID IDM_UNCOMMENT_BLOCK NewID IDM_LOWERCASE NewID IDM_UPPERCASE NewID IDM_LINECUT NewID IDM_LINEDELETE NewID IDM_LINECOPY NewID IDM_LINETRANSPOSE NewID IDM_LINEDUPLICATE \ DexH menu NewID IDM_DEX_GLOSSARY NewID IDM_DEX_PARAGRAPH NewID IDM_DEX_CODE_PARAGRAPH NewID IDM_DEX_STYLE_BOLD NewID IDM_DEX_STYLE_ITALIC NewID IDM_DEX_STYLE_TYPEWRITER \ View menu NewID IDM_VIEW_EOL NewID IDM_VIEW_WHITESPACE NewID IDM_VIEW_LINE_NUMBERS NewID IDM_COLORIZE NewID IDM_BROWSE \ Options menu NewID IDM_EOL_CRLF NewID IDM_EOL_LF NewID IDM_EOL_CR NewID IDM_CREATE_BAK NewID IDM_SAVE_ALL_BEFORE_COMPILE NewID IDM_TABS NewID IDM_SHOW_TOOLBAR NewID IDM_SHOW_STATUSBAR NewID IDM_REMOVE_TRAILING_WHITE NewID IDM_ENSURE_FINAL_LINE_ENDING \ Win32Forth menu NewID IDM_COMPILE NewID IDM_DEBUG NewID IDM_HANDLEW32FMSG \ Window menu NewID IDM_TILE_HORIZONTAL NewID IDM_TILE_VERTICAL NewID IDM_ARRANGE NewID IDM_CASCADE NewID IDM_CLOSE_ALL \ Help menu NewID IDM_W32F_ANS_HELP NewID IDM_API_HELP NewID IDM_W32F_HOMEPAGE NewID IDM_W32F_FORUM NewID IDM_W32F_DOC NewID IDM_ANS_DOC NewID IDM_ABOUT \ Toolbar NewID IDM_BACK NewID IDM_FORWARD \ for the ProjectTree NewID IDM_SHOW_FILE NewID IDM_EXECUTEFILE IdCounter constant IDM_LAST : allot-erase ( n -- ) here over allot swap erase ; Create CommandTable IDM_LAST IDM_FIRST - cells allot-erase : IsCommand? ( ID -- f ) IDM_FIRST IDM_LAST within ; : >CommandTable ( ID -- addr ) dup IsCommand? if IDM_FIRST - cells CommandTable + else drop abort" error - command ID out of range" then ; : DoCommand ( ID -- ) >CommandTable @ ?dup IF execute THEN ; : SetCommand ( ID -- ) last @ name> swap >CommandTable ! ; --- NEW FILE: EdMenu.f --- \ $Id: EdMenu.f,v 1.1 2006/06/05 09:19:00 dbu_de Exp $ \ File: EdMenu.f \ \ Author: Dirk Busch (dbu) \ Email: dir...@wi... \ \ Created: Sonntag, Juli 04 2004 - dbu \ Updated: Saturday, May 06 2006 - Rod \ \ Menu support for SciEdit cr .( Loading Scintilla Menu...) needs CommandID.f needs AnsLink.f needs src/tools/SdkHelp.f MenuBar MainMenu Popup "&File" MenuItem "&New file\tCtrl+N" IDM_NEW_SOURCE_FILE DoCommand ; MenuItem "&Open file...\tCtrl+O" IDM_OPEN_SOURCE_FILE DoCommand ; :MenuItem mf_close "&Close file" IDM_CLOSE DoCommand ; MenuSeparator :MenuItem mf_save "&Save file\tCtrl+S" IDM_SAVE DoCommand ; :MenuItem mf_saveas "Save file &as..." IDM_SAVE_AS DoCommand ; :MenuItem mf_saveall "Save all files\tAlt+S" IDM_SAVE_ALL DoCommand ; MenuSeparator \ :MenuItem mf_reload "&Revert to last saved version\tCtrl+R" IDM_RELOAD DoCommand ; \ MenuSeparator :MenuItem mf_openhl "Open Highlighted File\tCtrl+Shift+O" IDM_OPEN_HIGHLIGHTED_FILE DoCommand ; MenuSeparator MENUITEM "Open &HTML File..." IDM_OPEN_HTML_FILE DoCommand ; MenuSeparator :MenuItem mf_print "&Print...\tCtrl+P" IDM_PRINT DoCommand ; :MenuItem mf_page_setup "Page Set&up..." IDM_PAGE_SETUP DoCommand ; MenuSeparator MenuItem "E&xit\tALT+F4" IDM_EXIT DoCommand ; \ MenuSeparator 8 RECENTFILES RecentFiles IDM_OPEN_RECENT_FILE DoCommand ; Popup "&Edit" :MenuItem me_undo "&Undo\tCtrl+Z" IDM_UNDO DoCommand ; :MenuItem me_redo "&Redo\tCtrl+Y" IDM_REDO DoCommand ; MenuSeparator :MenuItem me_cut "&Cut\tCtrl+X" IDM_CUT DoCommand ; :MenuItem me_copy "C&opy\tCtrl+C" IDM_COPY DoCommand ; :MenuItem me_paste "&Paste\tCtrl+V" IDM_PASTE DoCommand ; :MenuItem me_delete "&Delete\tDel" IDM_DELETE DoCommand ; MenuSeparator :MenuItem me_linecut "&Line cut\tCtrl+L" IDM_LINECUT DoCommand ; :MenuItem me_linecopy "&Line copy\tCtrl+Shift+T" IDM_LINECOPY DoCommand ; :MenuItem me_linedelete "&Line delete\tCtrl+Shift+L" IDM_LINEDELETE DoCommand ; :MenuItem me_linetranspose "&Line transpose\tCtrl+T" IDM_LINETRANSPOSE DoCommand ; :MenuItem me_lineduplicate "&Line duplicate\tCtrl+D" IDM_LINEDUPLICATE DoCommand ; MenuSeparator :MenuItem me_selectall "&Select all\tCtrl+A" IDM_SELECT_ALL DoCommand ; :MenuItem me_removesel "R&emove selection" IDM_REMOVE_SELECTION DoCommand ; MenuSeparator :MenuItem me_find "Se&arch...\tCtrl+F" IDM_FIND_TEXT DoCommand ; :MenuItem me_findnext "Search &next\tF3" IDM_FIND_NEXT DoCommand ; \ :MenuItem me_findprev "Search &prev\tShift+F3" IDM_FIND_PREVIOUS DoCommand ; MenuSeparator :MenuItem me_findinfiles "Find Text in Files..." IDM_FIND_IN_FILES DoCommand ; MenuSeparator :MenuItem me_date "&Insert Date\tAlt+D" IDM_INSERT_DATE DoCommand ; :MenuItem me_date&time "&Insert Date and Time\tAlt+T" IDM_INSERT_DATE&TIME DoCommand ; MenuSeparator :MenuItem me_commentblock "&Block comment\tAlt+C" IDM_COMMENT_BLOCK DoCommand ; :MenuItem me_uncommentblock "B&lock &uncomment\tAlt+U" IDM_UNCOMMENT_BLOCK DoCommand ; MenuSeparator :MenuItem me_lower "&Lowercase\tCtrl+U" IDM_LOWERCASE DoCommand ; :MenuItem me_upper "&Uppercase\tCtrl+Shift+U" IDM_UPPERCASE DoCommand ; Popup "&DexH" :MenuItem me_dexGlossary "&Glossary\tAlt+G" IDM_DEX_GLOSSARY DoCommand ; :MenuItem me_dexParagraph "&Paragraph\tAlt+P" IDM_DEX_PARAGRAPH DoCommand ; :MenuItem me_dexCodeParagraph "&Code paragraph\tCtrl+Alt+C" IDM_DEX_CODE_PARAGRAPH DoCommand ; MenuSeparator :MenuItem me_dexStyleBold "&Bold\tAlt+B" IDM_DEX_STYLE_BOLD DoCommand ; :MenuItem me_dexStyleItalic "&Italic\tAlt+I" IDM_DEX_STYLE_ITALIC DoCommand ; :MenuItem me_dexStyleTypewriter "&Typewriter\tCtrl+Alt+T" IDM_DEX_STYLE_TYPEWRITER DoCommand ; Popup "&View" :MenuItem mp_vieweol "Display &Line endings" IDM_VIEW_EOL DoCommand ; :MenuItem mp_viewws "Display &White space" IDM_VIEW_WHITESPACE DoCommand ; :MenuItem mp_viewln "Display Line &numbers" IDM_VIEW_LINE_NUMBERS DoCommand ; MenuSeparator :MenuItem mp_colorize "&Colorize source" IDM_COLORIZE DoCommand ; MenuSeparator :MenuItem mp_browse "&Browse\tF7" IDM_BROWSE DoCommand ; Popup "&Options" SUBMENU "&Line endings" :MenuItem mf_windows "&Windows (CR\LF)" IDM_EOL_CRLF DoCommand ; :MenuItem mf_unix "&Unix (LF)" IDM_EOL_LF DoCommand ; :MenuItem mf_mac "&Mac (CR)" IDM_EOL_CR DoCommand ; ENDSUBMENU MenuSeparator :MenuItem mp_backup "&Create Backup File (*.BAK)" IDM_CREATE_BAK DoCommand ; MenuSeparator :MenuItem mp_rtwh "&Remove trailing white space" IDM_REMOVE_TRAILING_WHITE DoCommand ; :MenuItem mp_efle "&Ensure final line ending" IDM_ENSURE_FINAL_LINE_ENDING DoCommand ; MenuSeparator :MenuItem mp_sabcompile "&Save all files before Compile" IDM_SAVE_ALL_BEFORE_COMPILE DoCommand ; MenuSeparator :MenuItem mp_tabs "&Set Tab options..." IDM_TABS DoCommand ; MenuSeparator :MenuItem mp_showsb "&Show Statusbar" IDM_SHOW_STATUSBAR DoCommand ; :MenuItem mp_showtb "&Show Toolbar" IDM_SHOW_TOOLBAR DoCommand ; :MenuItem mp_customizetb "&Customize toolbar" Customize: ControlToolbar ; Popup "&Win32Forth" :MenuItem mp_compile "&Compile\tF12" IDM_COMPILE DoCommand ; :MenuItem mp_debug "&Debug...\tF11" IDM_DEBUG DoCommand ; :MenuItem mp_HandleW32FMsg "&Handle debug messages?" IDM_HANDLEW32FMSG DoCommand ; POPUP "W&indow" :MenuItem mf_tile_hor "Tile &horizontally" IDM_TILE_HORIZONTAL DoCommand ; :MenuItem mf_tile_ver "Tile &vertically" IDM_TILE_VERTICAL DoCommand ; :MenuItem mf_arrange "&Arrange" IDM_ARRANGE DoCommand ; :MenuItem mf_cascade "Ca&scade" IDM_CASCADE DoCommand ; MenuSeparator :MenuItem mf_close_all "&Close all" IDM_CLOSE_ALL DoCommand ; Popup "&Help" :MenuItem mp_anshelp "Help for highlighted ANS-Word\tCtrl+F1" IDM_W32F_ANS_HELP DoCommand ; :MenuItem mp_apihelp "Help for highlighted Win32-API function\tShift+F1" IDM_API_HELP DoCommand ; MenuSeparator MENUITEM "Win32Forth &Documentation\tF1" IDM_W32F_DOC DoCommand ; MENUITEM "ANS Forth &Standard\tAlt+F1" IDM_ANS_DOC DoCommand ; MenuSeparator MENUITEM "Win32Forth &Project Group" IDM_W32F_HOMEPAGE DoCommand ; MENUITEM "Win32Forth &Forum" IDM_W32F_FORUM DoCommand ; MenuSeparator MENUITEM "&About..." IDM_ABOUT DoCommand ; EndBar 6 constant WINDOW-MENU : GetFileType ( -- n ) ActiveChild if GetFileType: ActiveChild else -1 then ; : IsEditWnd? ( -- f ) GetFileType FT_SOURCE = ; : IsHtmlWnd? ( -- f ) GetFileType FT_HTML = ; : NoTextToPad ( -- addr len ) \ copy empty string to PAD 0 pad ! pad count ; : SelTextToPad ( -- addr len ) \ copy the selected text into PAD \ default no Text ActiveChild 0<> 0 GetSelText: ActiveChild MAXSTRING CHARS < and \ check size of selected text if pad GetSelText: ActiveChild if pad zcount BL skip -trailing 10 -TRAILCHARS 13 -TRAILCHARS else NoTextToPad then else NoTextToPad then ; : IsAnsWordSelected? ( -- f ) SelTextToPad ?dup if BL skip BL -TRAILCHARS IsAnsWord? else drop false then ; : EnableEdit ( f -- ) \ File menu dup Enable: mf_save dup Enable: mf_saveas \ dup Enable: mf_reload dup Enable: mf_openhl dup Enable: mf_print dup Enable: mf_page_setup \ Edit menu dup Enable: me_undo dup Enable: me_redo dup Enable: me_cut dup Enable: me_copy dup Enable: me_paste dup Enable: me_delete dup Enable: me_selectall dup Enable: me_removesel dup Enable: me_find dup Enable: me_findnext \ dup Enable: me_findprev dup Enable: me_date dup Enable: me_date&time dup Enable: me_commentblock dup Enable: me_uncommentblock dup Enable: me_lower dup Enable: me_upper dup Enable: me_linecut dup Enable: me_linedelete dup Enable: me_linecopy dup Enable: me_linetranspose dup Enable: me_lineduplicate \ DexH menu dup Enable: me_dexGlossary dup Enable: me_dexParagraph dup Enable: me_dexCodeParagraph dup Enable: me_dexStyleBold dup Enable: me_dexStyleItalic dup Enable: me_dexStyleTypewriter \ View menu dup Enable: mp_vieweol dup Enable: mp_viewws dup Enable: mp_viewln dup Enable: mp_colorize dup Enable: mp_browse \ Options menu dup Enable: mf_windows dup Enable: mf_unix dup Enable: mf_mac dup Enable: mp_backup dup Enable: mp_sabcompile dup Enable: mp_tabs dup Enable: mp_rtwh dup Enable: mp_efle \ Win32Forth menu dup Enable: mp_compile dup Enable: mp_debug \ dup Enable: mp_HandleW32FMsg \ Help menu dup Enable: mp_anshelp dup Enable: mp_apihelp drop ; : EnableMenuBar ( -- ) \ enable/disable the menu items IsEditWnd? dup EnableEdit if \ File menu ?Modified: ActiveChild 0<> ?BrowseMode: ActiveChild not and Enable: mf_save ?BrowseMode: ActiveChild not Enable: mf_saveas ?Selection: ActiveChild Enable: mf_openhl GetTextLength: ActiveChild Enable: mf_print \ Edit menu CanUndo: ActiveChild Enable: me_undo CanRedo: ActiveChild Enable: me_redo ?Selection: ActiveChild Enable: me_cut ?Selection: ActiveChild Enable: me_copy CanPaste: ActiveChild Enable: me_paste ?Selection: ActiveChild Enable: me_delete GetTextLength: ActiveChild Enable: me_selectall ?Selection: ActiveChild Enable: me_removesel GetTextLength: ActiveChild Enable: me_find ?Find: ActiveChild Enable: me_findnext \ ?Find: ActiveChild Enable: me_findprev ?BrowseMode: ActiveChild not Enable: me_date ?BrowseMode: ActiveChild not Enable: me_date&time ?Selection: ActiveChild Enable: me_commentblock ?Selection: ActiveChild Enable: me_uncommentblock ?Selection: ActiveChild Enable: me_lower ?Selection: ActiveChild Enable: me_upper GetTextLength: ActiveChild Enable: me_linecut GetTextLength: ActiveChild Enable: me_linedelete GetTextLength: ActiveChild Enable: me_linecopy GetTextLength: ActiveChild Enable: me_linetranspose GetTextLength: ActiveChild Enable: me_lineduplicate \ DexH menu ?Selection: ActiveChild Enable: me_dexGlossary ?Selection: ActiveChild Enable: me_dexParagraph ?Selection: ActiveChild Enable: me_dexCodeParagraph ?Selection: ActiveChild Enable: me_dexStyleBold ?Selection: ActiveChild Enable: me_dexStyleItalic ?Selection: ActiveChild Enable: me_dexStyleTypewriter \ View menu ViewEOL? Check: mp_vieweol ViewWhiteSpace? Check: mp_viewws ViewLineNumbers? Check: mp_viewln Colorize? Check: mp_colorize ?BrowseMode: ActiveChild Check: mp_browse \ Options menu EOL SC_EOL_CRLF = Check: mf_windows EOL SC_EOL_LF = Check: mf_unix EOL SC_EOL_CR = Check: mf_mac CreateBackup? Check: mp_backup SaveAllBeforeCompile? Check: mp_sabcompile StripTrailingWhitespace? Check: mp_rtwh FinalNewLine? Check: mp_efle \ Win32Forth menu GetTextLength: ActiveChild Enable: mp_compile ActiveRemote ActiveChild = HandleW32FMsg? and Enable: mp_debug HandleW32FMsg? Check: mp_HandleW32FMsg \ Help menu IsAnsWordSelected? Enable: mp_anshelp sdk-help? Enable: mp_apihelp then ShowToolbar? Check: mp_showtb ShowStatusbar? Check: mp_showsb ShowToolbar? Enable: mp_customizetb ActiveChild 0<> dup Enable: mf_saveall dup Enable: mf_close dup Enable: mf_close_all dup Enable: mf_tile_hor dup Enable: mf_tile_ver dup Enable: mf_arrange Enable: mf_cascade 0 ; --- NEW FILE: X_SEARCH.F --- \ ----------------------------------------------------------------------------- \ X_Search.f \ \ Text Search functions for WinEd \ \ July 6th, 2003 dbu - Extracted from WinEd.f \ - changed to allow wildcard search \ July 19th, 2003 dbu - fixed some bug's in the wildcard search \ ----------------------------------------------------------------------------- \ ----------------------------------------------------------------------------- \ some helper words \ ----------------------------------------------------------------------------- needs w_search.f \ Wildcard text search written by J.v.d.Ven [UNDEFINED] 2+ [if] CODE 2+ ( n1 -- n2 ) \ add two to n1 inc ebx inc ebx next c; [then] [UNDEFINED] 2- [if] CODE 2- ( n1 -- n2 ) \ sub two from n1 dec ebx dec ebx next c; [then] \ ----------------------------------------------------------------------------- \ Findtext dialog \ ----------------------------------------------------------------------------- [UNDEFINED] FindTextDlg [if] NewEditDialog FindTextDlg "Find Text" "Search for:" "Find" "" "Case Sensitive Search" [then] \ ----------------------------------------------------------------------------- \ ----------------------------------------------------------------------------- create find-buf MAXSTRING allot find-buf off 0 value busy? \ flag to prevent reentrancy FALSE value find-label? \ are we searching for a label? \ 0 value CaseSensitive? \ case sensitive search or not? (now in w_serach.f July 8th, 2003 - 18:46 - dbu) 0 value found_len \ length of the string we found (new July 6th, 2003 - dbu) 0 value srch_len 0 value startcol \ search for sa2,sn2 within string sa1,sn1. \ (Allow ALT 0160 followed by a space as a pseudo leading space ) : (xsearch) { sa1 sn1 sa2 sn2 \ pspf ldsp1 ldsp2 trsp2 n4 -- a3 n3 flg } \ search for sa2,sn2 within string sa1,sn1. \ case sensitive selectable \ sa1 target starting address \ sn1 target initial count \ sa2 search buffer starting address \ sn2 search buffer count \ pspf pseudo-space flag \ ldsp1 count of leading spaces in target \ ldsp2 count of leading spaces in search buffer \ trsp2 count of trailing spaces in search buffer \ a3 starting address of possible matched string in target \ n3 remaining count in target \ n4 length of string matched, possibly excluding some leading or trailing spaces \ flg is truth value of search sn2 to found_len \ save the length of the string we found 0 to srch_len false to pspf 0 to ldsp2 0 to trsp2 0 to n4 sa1 sn1 bl skip drop sa1 - to ldsp1 sa2 w@ 0x20A0 = \ a pseudo-space flag? IF sa2 sn2 1 /string to sn2 to sa2 sa2 sn2 bl skip drop sa2 - to ldsp2 startcol 0= ldsp2 ldsp1 > and IF true to pspf \ only if we are at the line start THEN ELSE sa2 sn2 bl skip drop sa2 - to ldsp2 THEN sa2 sn2 -trailing sn2 over - to trsp2 \ count trailing spaces dup to sn2 \ modify sn2 to exclude trailing spaces bl skip sn2 swap - to ldsp2 drop \ count leading spaces pspf \ possible pseudo space case IF sa1 sa2 sn2 ldsp2 ldsp1 - /string \ advance search buffer pointer dup to n4 swap n4 \ ( sa1 n4 sa2 n4 ) CaseSensitive? 0= IF caps-compare ELSE compare THEN 0= \ if result is 0, string is matched to start IF \ of trailing spaces sa1 sn1 2dup n4 /string \ look for trailing spaces 2dup bl skip dup 0= IF \ We have reached the end of the target buffer 2drop nip trsp2 min n4 + dup to srch_len 0<> EXIT ELSE \ We have NOT reached the end of the target nip - nip trsp2 >= IF \ Enough trailing spaces trsp2 n4 + dup to srch_len 0<> EXIT THEN THEN THEN 2drop \ clean up stack THEN sn2 to n4 BEGIN CaseSensitive? 0= \ search IF sa1 sn1 sa2 sn2 caps-search ELSE sa1 sn1 sa2 sn2 search THEN IF \ String is matched to start of trailing spaces 2dup n4 /string \ look for trailing spaces 2dup bl skip dup 0= IF \ We have reached the end of the target buffer 2drop nip trsp2 min n4 + dup to srch_len 0<> EXIT ELSE \ We have NOT reached the end of the target nip - nip trsp2 >= IF \ Enough trailing spaces trsp2 n4 + dup to srch_len 0<> EXIT THEN THEN 1 /string dup n4 < IF \ Not enough characters left for a match 0 to srch_len 0 EXIT THEN to sn1 dup sa1 - +to startcol to sa1 ELSE \ No match possible 0 to srch_len 0 EXIT THEN AGAIN ; \ Rewritten to allow wildcard text search ( July 6th, 2003 - dbu ) \ Changed to use Jos new Version of w_search.f ( July 8th, 2003 - 18:43 - dbu ) : xsearch { sa1 sn1 sa2 sn2 \ buff$ -- a3 n3 flg } \ search for sa2,sn2 within string sa1,sn1. \ sa1 target starting address \ sn1 target initial count \ sa2 search buffer starting address \ sn2 search buffer count \ a3 starting address of possible matched string in target \ n3 remaining count in target sn1 1 < sn2 1 < or if \ there is not text to search in or no text to search for sa1 sn1 false else sa2 sn2 wildcard-char scan nip sn2 1 > and if \ there is a bug in w-search if the search string dosn't \ start with a wildcard char no text will be found \ J.v.d.Ven explaind to me that this isn't bug. So I removed the "bugfix" \ July 28th, 2003 - 17:22 dbu \ sn2 2+ LocalAlloc: buff$ \ sa2 c@ wildcard-char <> \ if 1 buff$ c! wildcard-char buff$ 1+ c! \ store wildcard char into the buffer \ sa2 sn2 buff$ +place \ and append the search string \ else \ sa2 sn2 buff$ place \ only put the search string into the buffer \ then \ buff$ count sa1 sn1 CaseSensitive? w-search 0= \ perform wildcard search sa2 sn2 sa1 sn1 CaseSensitive? w-search 0= \ perform wildcard search if \ we didn't find the text 2drop sa1 sn1 false else \ we found it to found_len \ save the length of the string we found sa1 over - sn1 + \ calc the remaining count in target true then else sa1 sn1 sa2 sn2 (xsearch) \ perform normal search then then ; \ selectably case sensitive search backwards \ rls mods January 6th, 2002 - 20:35 : -xsearch { sadr slen fadr flen \ ffnd srch_lenz -- a3 n3 n4 } 0 to ffnd sadr slen BEGIN fadr flen xsearch WHILE dup +to startcol srch_len to srch_lenz 2dup to slen to sadr 1 /string true to ffnd REPEAT srch_lenz to srch_len 2drop sadr slen ffnd ; 0 value search-till : .searching ( n1 -- ) dup 0= IF 0 to search-till FALSE to search-aborted? THEN search-till 4000 >= IF search-till 4000 = IF s" Searching: \n\nPress ESC to abort" "message THEN dup 1000 mod 0= IF s" Searching: \n\nPress ESC to abort" 2>r 0 (ud,.) 2r@ bl scan drop 1+ swap 11 min move 2r> MessageText: msg-window Refresh: msg-window key? IF key k_esc = to search-aborted? THEN ELSE drop THEN ELSE drop THEN 1 +to search-till ; \ Changed to allow wildcard text search ( July 6th, 2003 - dbu ) [defined] file-lines [if] : to-find-line ( col row -- ) \ set cursor position to the line with the text we found file-lines 1- min 0max to cursor-line to cursor-col 0 HPosition: DocWindow cursor-on-screen cursor-col found_len + screen-cols 3 - - HPosition: DocWindow cursor-line dup to hlst to hled cursor-col to hcst hcst found_len + to hced ; : find-label { line# -- flag } \ flag=TRUE if we found the label line# #line" s" <A NAME" dup>r xsearch IF r> /string \ remove leading "<A NAME" string bl skip \ skip any leading blanks '=' skip \ skip equal sign bl skip \ skip any more leading blanks 2dup '>' scan nip - \ trim text after '>' in line \ retain trailing '"' (quote) '"' skip \ strip off leading '"' (quote) drop find-buf count tuck caps-compare 0= IF 0 line# to-find-line \ if found, move to this line TRUE \ mark as all done searching ELSE FALSE \ else we continue searching THEN ELSE 2drop r>drop FALSE THEN ; \ rls mods January 6th, 2002 - 21:14 \ Changed to allow wildcard text search ( July 6th, 2003 - dbu ) : _find-text-again ( -- f1 ) \ f1=TRUE if found false busy? ?EXIT \ leave if already busy drop \ discard the boolean, we will generate another true to busy? \ now we are busy find-buf c@ IF \ put the search text into the ComboBox find-buf count InsertString: findComboEdit \ if we reached the end of file, \ jump to start beep and exit cursor-line file-lines 1- >= IF Home: DocWindow 0 >col-cursor FALSE to busy? false beep EXIT THEN cursor-line 1-line-flag: DocWindow \ mark current line to be updated \ is the text on the current line? cursor-line #line" \ get address and length of current line dup cursor-col min to cursor-col \ don't jump behind the last char in line cursor-col /string \ jump to cursor position cursor-col to startcol \ make the actual cursor position to our start position find-buf count xsearch IF cursor-line #line" rot - nip nip \ calculate column cursor-line to-find-line \ set cursor position hcst found_len + to hced \ set highlight TRUE \ leave flag on stack ELSE 2drop \ if we are on the last line of the file, we jump \ to the first one cursor-line file-lines 1- = cursor-col cursor-line #line" nip = and IF Home: DocWindow 0 to cursor-col THEN true \ put flag on stack 0 .searching \ open the search progress dialog \ do the search over the rest of the file file-lines cursor-line file-lines 1- min 1+ ?DO I .searching \ set search progress dialog find-label? IF I find-label IF 0= \ invert the flag on stack LEAVE THEN ELSE 0 to startcol I #line" find-buf count xsearch IF i #line" rot - nip nip \ calculate column i to-find-line \ set cursor position hcst found_len + to hced \ set highlight 0= \ invert the flag on stack LEAVE \ and exit ELSE 2drop THEN THEN search-aborted? ?LEAVE LOOP IF \ we didn't find the text FALSE Home: DocWindow 0 to cursor-col ELSE TRUE THEN message-off \ colse the search progress dialog THEN refresh-line ELSE FALSE THEN ReTitle: EditorWindow FALSE to busy? ; defer find-text ( -- ) : find-text-again ( -- ) \ bound to F3 in WinEd bitImage? ?EXIT find-buf c@ 0= IF find-text ELSE 1 +to cursor-col \ skip one character _find-text-again 0= IF _find-text-again ?beep THEN THEN SetFocus: DocWindow ; \ rls mods January 6th, 2002 - 21:11 \ Changed to allow wildcard text search ( July 6th, 2003 - dbu ) : _back-find-text-again ( -- f1 ) \ f1=TRUE if found false busy? ?EXIT \ leave if already busy drop \ discard the boolean, we will generate another true to busy? \ now we are busy cursor-line 0= cursor-col 0= and IF End: DocWindow cursor-line #line.len to cursor-col THEN cursor-line 1-line-flag: DocWindow 0 to startcol cursor-line #line" cursor-col min find-buf count -xsearch IF cursor-line #line" cursor-col min rot - nip nip to cursor-col 0 HPosition: DocWindow cursor-line dup to hlst to hled cursor-col to hcst hcst found_len + to hced TRUE ELSE 2drop true 0 .searching 0 cursor-line 1- 0max ?DO i .searching 0 to startcol i #line" find-buf count -xsearch IF i #line" rot - nip nip i to-find-line hcst found_len + to hced 0= LEAVE ELSE 2drop THEN search-aborted? ?LEAVE -1 +LOOP IF End: DocWindow cursor-line #line" nip to cursor-col FALSE ELSE TRUE THEN message-off THEN refresh-line ReTitle: EditorWindow FALSE to busy? ; : back-find-text-again ( -- ) bitImage? ?EXIT busy? ?EXIT \ leave if already busy find-buf c@ 0= IF TRUE to busy? find-buf EditorWindow Start: FindTextDlg dup 2 = to CaseSensitive? FALSE to busy? find-buf c@ 0= IF drop FALSE beep THEN ELSE true THEN \ -- f1 IF _back-find-text-again 0= IF _back-find-text-again ?beep THEN THEN SetFocus: DocWindow ; [then] |
