Menu
▾
▴
[Win32forth-cvs] win32forth/apps/WinEd Ed_About.F,NONE,1.1 Ed_Clipboard.F,NONE,1.1 Ed_Colorize.F,NONE,1.1 Ed_Debug.F,NONE,1.1 Ed_Defaults.F,NONE,1.1 Ed_Do-Html-Link.F,NONE,1.1 Ed_EditWindow.F,NONE,1.1 Ed_EditWindowObj.F,NONE,1.1 Ed_EditorWords.F,NONE,1.1 Ed_FileFuncs.F,NONE,1.1 Ed_FileStack.F,NONE,1.1 Ed_FindInFiles.F,NONE,1.1 Ed_Findrepl.F,NONE,1.1 Ed_FrameWindowObj.F,NONE,1.1 Ed_Globals.F,NONE,1.1 Ed_Gotoline.F,NONE,1.1 Ed_HyperLink.F,NONE,1.1 Ed_ImageDC.F,NONE,1.1 Ed_KeyCMD.F,NONE,1.1 Ed_Keys.F,NONE,1.1 Ed_LineFuncs.F,NONE,1.1 Ed_LoadFileFuncs.F,NONE,1.1 Ed_Menu.F,NONE,1.1 Ed_MenuFuncs.F,NONE,1.1 Ed_MessageBrodcast.F,NONE,1.1 Ed_MiscFunc.F,NONE,1.1 Ed_MouseHighlight.F,NONE,1.1 Ed_Remote.F,NONE,1.1 Ed_Search.F,NONE,1.1 Ed_Sfont.F,NONE,1.1 Ed_Statbar.F,NONE,1.1 Ed_Sub_Dirs.F,NONE,1.1 Ed_SubjectListObj.F,NONE,1.1 Ed_ToolBar.F,NONE,1.1 Ed_Url.F,NONE,1.1 Ed_Version.F,NONE,1.1 HYPER.F,1.1,1.2 WinEd.f,1.2,1.3
Update of /cvsroot/win32forth/win32forth/apps/WinEd In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv27654/apps/WinEd Modified Files: HYPER.F WinEd.f Added Files: Ed_About.F Ed_Clipboard.F Ed_Colorize.F Ed_Debug.F Ed_Defaults.F Ed_Do-Html-Link.F Ed_EditWindow.F Ed_EditWindowObj.F Ed_EditorWords.F Ed_FileFuncs.F Ed_FileStack.F Ed_FindInFiles.F Ed_Findrepl.F Ed_FrameWindowObj.F Ed_Globals.F Ed_Gotoline.F Ed_HyperLink.F Ed_ImageDC.F Ed_KeyCMD.F Ed_Keys.F Ed_LineFuncs.F Ed_LoadFileFuncs.F Ed_Menu.F Ed_MenuFuncs.F Ed_MessageBrodcast.F Ed_MiscFunc.F Ed_MouseHighlight.F Ed_Remote.F Ed_Search.F Ed_Sfont.F Ed_Statbar.F Ed_Sub_Dirs.F Ed_SubjectListObj.F Ed_ToolBar.F Ed_Url.F Ed_Version.F Log Message: dbu: Andrew Stephenson's WinEd changes uploaded --- NEW FILE: Ed_EditorWords.F --- \ $Id: Ed_EditorWords.F,v 1.1 2005/03/12 09:29:20 dbu_de Exp $ \ defer ?wrap-word defer back-delete-character defer save-text defer save-bitmap-as defer close-text defer ?save-text defer "+open-text defer before-bye defer open-previous : ?line-tbl-ok ( -- ) line-tbl ?EXIT TRUE s" Line-TBL not initialized" ?terminatebox ; : end.addr ( -- a1 ) ?line-tbl-ok line-tbl file-lines cells+ @ ; : #line.addr ( n1 -- a1 ) ?line-tbl-ok line-tbl swap 0max file-lines min cells+ @ ; : #line.bytes ( n1 -- n2 ) \ the real line length, including CRLF line-tbl IF line-tbl swap 0max file-lines 1- min cells+ 2@ - ELSE drop 0 THEN ; : #line" ( n1 -- a1 n2 ) \ get line # n1, return address and length dup file-lines >= IF drop \ discard requested line number end.addr 0 ELSE line-tbl swap 0max cells+ 2@ tuck - 0max lend-len IF 2dup + lend-len - c@ lend-char = IF lend-len - 0max THEN THEN THEN ; \ rls January 11th, 2001 - 23:19 \ Used in Rectangular Paste : #line+" ( n1 offset -- a1 n2 ) \ get line # n1, return address and length over file-lines >= IF 2drop \ discard requested line number end.addr 0 ELSE >r line-tbl swap 0max cells+ 2@ r@ + tuck swap r> + swap - 0max lend-len IF 2dup + lend-len - c@ lend-char = IF lend-len - 0max THEN THEN THEN ; : #line.len ( n1 -- n2 ) \ the line length without CRLF line-tbl IF #line" nip ELSE drop 0 THEN ; : text-length ( -- n1 ) \ total text length in buffer line-tbl IF file-lines #line.addr text-ptr - ELSE 0 THEN ; : LastPage ( -- n ) \ rls February 3rd, 2002 - 10:00 file-lines 1- PRINTER-ROWS / 1+ ; 0 value warned? defer warn-to-save defer must-save defer primitive-save-text \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ \ 4 Colons-only code \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ 40 value maxscrlines create colontbl maxscrlines cells allot \ to xlate scrline to fileline 0 value colons-only : line#>indx ( l# -- indx#) colons-only if 0 screen-rows 0 do over colontbl i cells+ @ = if i + leave then loop nip else line-cur - then ; : indx>line# ( scrln# -- filel#) colons-only if dup colontbl +cells @ dup 0= if swap 0> if drop file-lines then else nip then else line-cur + then ; : setcolontbl ( -- ) \ table holds #filelines each screen \ line is from the fileline# of screen line# zero colons-only if line-cur colontbl dup maxscrlines cells erase screen-rows 0 ?DO over file-lines >= if leave then over #line" drop c@ ascii : = if 2dup ! \ remember scrline#s cell+ 1 else 0 then >r 1 0 d+ r> +LOOP 2drop then ; : +line-cur { nn \ dd -- } \ change line# of top of screen nn dup abs / to dd line-cur colons-only if nn abs 0 ?do dd + dup 0< over file-lines >= or if dd - leave then dup #line" drop c@ ascii : = abs +loop else nn + file-lines screen-rows 2 / - min 0max then to line-cur setcolontbl ; : +cursor-line ( n1 -- fl) \ changeline fl:true=>update scrn dup cursor-line line#>indx dup>r + 0 screen-rows 1- between if r> + 0 swap else +line-cur true r> then indx>line# to cursor-line ; \ ---------- end colons-only ----------- \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ \ 5 Editor words \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ : #line! { caddr clen cline \ cbuf$ cdiff -- } LMAXSTRING localAlloc: cbuf$ cbuf$ LMAXSTRING blank \ prefill with blanks caddr clen cbuf$ LPLACE \ save string in a temp lend-len 2 = \ two char line terminator? IF crlf$ count cbuf$ +LPLACE \ then append CRLF ELSE lend-len 1 = \ are we using a line terminator? IF lend-char cbuf$ C+LPLACE \ append single line terminator ELSE \ otherwise no line terminator, BLOCKLINE-SIZE cbuf$ ! \ set length to 64 THEN THEN cline #line.bytes cbuf$ @ - to cdiff \ difference in lengths cline 1+ #line.addr \ source dup cdiff - \ destination end.addr cline 1+ #line.addr - move \ move rest of doc cdiff negate to cdiff file-lines 2 + cline 1+ ?DO cdiff line-tbl i cells+ +! LOOP cbuf$ LCOUNT cline #line.addr swap move \ move the line into buffer text-length 4000 + text-blen > \ check for buffer full warned? 0= and \ and haven't warned used? IF GetStack: DocWindow entry-console = IF TRUE to edit-changed? \ SET changed flag primitive-save-text ELSE beep IF beep warn-to-save true to warned? \ we warned you! THEN THEN THEN text-length 1000 + text-blen > IF must-save THEN ; : page>line ( page -- startline ) \ rls - page 0max file-lines min cells page-tbl + @ 0x0FFFFF and ; \ rls - page : this-page { line \ lopage hipage loline hiline page -- page } 0 to lopage num-pages to hipage lopage to page BEGIN lopage page>line to loline hipage page>line to hipage hipage lopage 1+ > WHILE hipage lopage - line loline - hiline loline - */mod IF 1+ THEN +to page page page>line line >= IF page to lopage ELSE page to hipage THEN REPEAT page ; : get-cursor-line ( -- ) \ get the current line from file cursor-line #line" "LCLIP" cur-buf LPLACE \ Use MAXSTRING minus one since there is a count byte at the \ beginning of the buffer that isn't accounted for any other way. cur-buf LCOUNT LMAXSTRING CELL- swap /string blank ; \ add trailing blanks : put-cursor-line ( -- ) cur-buf LCOUNT cursor-line #line! ; : -trailing-blanks ( -- ) cursor-line #line" 2dup -trailing nip - nip IF get-cursor-line cur-buf LCOUNT -trailing nip cur-buf ! put-cursor-line THEN ; : set-mirrored { m-entry# -- } \ if n1<>-1 then mark current as mirrored m-entry# -1 <> IF text-ptr ?dup IF release 0 to text-ptr THEN line-tbl ?dup IF release 0 to line-tbl THEN m-entry# entry-#bytes * entry-buffer + entry# entry-#bytes * entry-buffer + entry-#bytes move \ move master to mirror THEN ; : update-mirrors { \ open$ -- } \ make mirrors have same flags entry# entry-max > ?EXIT MAXSTRING LocalAlloc: open$ cur-filename count open$ place entry# entry-max 0 DO i to entry# dup i <> \ not myself \ and matching filename cur-filename count open$ count caps-compare 0= and cur-filename c@ 0<> and IF dup entry-#bytes * entry-buffer + i entry-#bytes * entry-buffer + mirror# move \ move master to mirror file-lines cursor-line < \ if other copies are beyond end of file IF file-lines 1- 0max to cursor-line cursor-line Height: DocWindow CharHeight: DocWindow / - 1+ to line-cur THEN THEN LOOP to entry# ; \ f1 = -1 if not found, else ENTRY# if found : update-mirror-browse { \ open$ browse?? edit-changed?? -- } \ make mirror browse flags the same entry# entry-max > ?EXIT MAXSTRING LocalAlloc: open$ cur-filename count open$ place entry# browse? to browse?? edit-changed? to edit-changed?? entry-max 0 DO i to entry# \ select the hyper file index \ if they match dup i <> \ not myself \ and matching filename cur-filename count open$ count caps-compare 0= and cur-filename c@ 0<> and IF edit-changed?? to edit-changed? browse?? to browse? THEN LOOP to entry# ; \ f1 = -1 if not found, else ENTRY# if found : "already-open# { adr len \ open$ -- n1 } \ return number of times it's open len 0= IF 0 EXIT \ leave if null filename THEN MAXSTRING LocalAlloc: open$ adr len open$ place open$ count "path-file drop open$ place open$ ?defext 0 \ non open with this name entry# >r entry-max 0 DO i to entry# \ select the hyper file index \ if they match cur-filename count open$ count caps-compare 0= cur-filename c@ 0<> and IF 1+ THEN LOOP r> to entry# ; \ f1 = -1 if not found, else ENTRY# if found : sync-mirrors { \ open$ -- } \ copy new pointers to mirrors entry# entry-max > ?EXIT MAXSTRING LocalAlloc: open$ cur-filename count open$ place entry# entry-max 0 DO i to entry# \ select the hyper file index \ if they match dup i <> \ not myself \ and matching filename cur-filename count open$ count caps-compare 0= and cur-filename c@ 0<> and IF dup entry-#bytes * entry-buffer + i entry-#bytes * entry-buffer + mirror# move \ move master to mirror THEN LOOP to entry# ; : file-has-changed ( -- ) save-minutes 0> IF NULL save-minutes 60000 * SAVE_TIMER Gethandle: EditorWindow Call SetTimer drop THEN edit-changed? 0= \ -- f1 ; not already changed? true to edit-changed? \ mark as changed IF \ f1 -- ; then update mirrors update-mirrors THEN EditMode: Win-EdToolbar ; \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ \ 6 Beep \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ : beeper ( -- ) 700 50 tone ; ' beeper is beep : ?beep ( f1 -- ) \ if f1=FALSE, then BEEP 0= IF beep THEN ; --- NEW FILE: Ed_ImageDC.F --- \ $ Id: Ed_ImageDc.f,v 3.1 2005/02/01 21:15:56 aws Exp $ \ \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ \ 7 Drawing into the Image DC \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ : moveto ( x y -- ) \ Move to the x y position in the editor imageDC MoveTo: [ ] ; : lineto ( x y -- ) \ How does this differ from the above imageDC LineTo: [ ] ; : line ( x1 y1 x2 y2 -- ) \ move the line from xy to x2y2 2swap moveto lineto ; : line-color ( color_object -- ) ?ColorCheck imageDC LineColor: [ ] ; --- NEW FILE: Ed_FrameWindowObj.F --- \ $Id: Ed_FrameWindowObj.F,v 1.1 2005/03/12 09:29:20 dbu_de Exp $ \ \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ \ 58 Define the main window for the application \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ :Object FrameWindow <super window Rectangle EditRect Rectangle ClientRect MAXSTRING bytes StatusBuf : abs-create-frame-window ( -- hwnd ) 0 0 \ adjust x,y relative to zero, zero StartSize: [ self ] \ width, height SetRect: EditRect ^base \ creation parameters appInst \ program instance NULL LoadMenu: [ self ] \ menu ParentWindow: [ self ] \ parent window handle Bottom: EditRect Top: EditRect - \ adjusted height Right: EditRect Left: EditRect - \ adjusted width StartPos: [ self ] swap \ y, x starting position WindowStyle: [ self ] \ the window style WindowTitle: [ self ] rel>abs \ the window title WindowClassName 1+ rel>abs \ class name ExWindowStyle: [ self ] \ extended window style Call CreateWindowEx EraseRect: EditRect ; :M DefaultIcon: ( -- hIcon ) \ return the default icon handle for window s" src\res\WinEd.ico" Prepend<home>\ LoadIconFile ;M :M Start: ( -- ) \ create a new window object hWnd 0= IF s" EditorWindow" SetClassName: self \ set the class name default-window-class \ over-ride the default background (WHITE) color NULL to hbrBackground register-the-class drop abs-create-frame-window to hWnd SW_SHOWNORMAL Show: self Update: self ELSE SetFocus: self THEN ;M MACRO -status " 19 -" ( n1 -- n2 ) 0 value vdraging? 0 value hdraging? : in-vdrag? ( -- f1 ) \ in vert drag bar hWnd get-mouse-xy nip drag-barV dup drag-thick + 2 + 1 - between show-console? and ; : in-hdrag? ( -- f1 ) \ in horizontal drag bar hWnd get-mouse-xy \ -- x y ;mouse position show-console? IF edit-top drag-barV between ELSE edit-top Height -status between THEN swap drag-barH dup drag-thick + 2 + between and ; \ mouse click routines for FrameWindow to track the dragbar movement : MheditW-track ( -- ) mousedown? 0= ?EXIT vdraging? IF mousey drag-thick 2/ - Height drag-thick 2 + - -status 1 - 0max min StartSize: Win-EdToolbar nip max to drag-barV set-console-height drag-barV edit-top listHeightDefault + <= Hide: Subjectlist THEN hdraging? IF mousex drag-thick 2/ - 0max Width edit-min - 0max min 0max to drag-barH THEN Showing: SubjectList IF 0 edit-top drag-barH 1- 160 Move: SubjectList THEN Refresh: EditorWindow WINPAUSE ; : MheditW-click ( -- ) mousedown? 0= IF hWnd Call SetCapture drop THEN true to mousedown? in-vdrag? to vdraging? in-hdrag? to hdraging? MheditW-track ; : MheditW-unclick ( -- ) mousedown? IF Call ReleaseCapture drop THEN false to mousedown? false to vdraging? false to hdraging? ; : dbl-click-vdrag ( -- ) show-console? 0= ?EXIT in-vdrag? 0= ?EXIT drag-barV drag-thick 2 / + StartSize: Win-EdToolbar nip drag-thick + 2 + Height -status 0max between IF StartSize: Win-EdToolbar nip to drag-barV ConsoleWindow to DocWindow ELSE Height drag-thick 2 + - -status 1 - 0max to drag-barV EditWindow to DocWindow THEN GetStack: DocWindow to entry# set-console-height show-console? IF drag-barV edit-top listHeightDefault + <= Hide: Subjectlist THEN ; : dbl-click-hdrag ( -- ) in-hdrag? 0= ?EXIT drag-barH 8 > IF 0 to drag-barH ELSE 132 Width 2/ min to drag-barH THEN Showing: SubjectList IF 0 edit-top drag-barH 1- 160 Move: SubjectList THEN ; : MheditW-dblclick ( -- ) \ highlight the current word false to mousedown? mousey StartSize: Win-EdToolbar nip < ?EXIT dbl-click-vdrag dbl-click-hdrag SetFocus: DocWindow Refresh: EditorWindow ; :M Classinit: ( -- ) ClassInit: super \ init super class 3 to OriginX 3 to OriginY self to EditorWindow \ make myself the cur window 8 Width: sFont 14 Height: sFont s" Courier" SetFaceName: sFont \ default to Courier min-Edit-Tool-Bar to Win-EdToolbar ['] MheditW-click SetClickFunc: self ['] MheditW-unclick SetUnClickFunc: self ['] MheditW-track SetTrackFunc: self ['] MheditW-dblclick SetDblClickFunc: self ;M :M On_Init: ( -- ) \ initialize the class On_Init: super \ first init super class Create: sFont \ create the font for file list second-copy? 0= show-console? and IF Height 4 / SetTopOf: ConsoleWindow \ set the console window's top 1 SetId: ConsoleWindow \ then the child window self Start: ConsoleWindow \ then startup child window 2 SetId: SplitterV self Start: SplitterV z" RMOT" @ ed-console-remote ! \ set remote IO operations ed-forth-count @ 0= IF z" HIDN" @ ed-console-hidden ! \ flag Forth to hide console StartUpForth ELSE 0 WM_REMOTEIO win32forth-message THEN ELSE FALSE to show-console? THEN min-tool-bar? IF min-Edit-Tool-Bar to Win-EdToolbar ELSE max-Edit-Tool-Bar to Win-EdToolbar THEN tool-bar? IF 3 SetId: Win-EdToolbar \ then the next child window self Start: Win-EdToolbar \ then startup child window THEN edit-top SetTopOf: EditWindow \ set the edit window's top 4 SetId: EditWindow \ then the child window self Start: EditWindow \ then startup child window 5 SetId: SplitterH self Start: SplitterH self Start: SubjectList FilesList InitSubject: SubjectList \ we start with files subject GetHandle: self StartStatusBar \ start the status bar window-list BEGIN dup @ ?dup WHILE >r self Start: [ r@ ] TRUE Hide: [ r> ] cell+ REPEAT DROP FALSE Hide: FilesList FALSE Hide: Subjectlist \ then hide SubjectList Edit-Menu-Bar SetMenuBar: self min-ToolBar-Popup-bar SetPopupBar: min-Edit-Tool-Bar max-ToolBar-Popup-bar SetPopupBar: max-Edit-Tool-Bar Edit-Popup-Bar SetPopupBar: EditWindow Console-Popup-Bar SetPopupBar: ConsoleWindow show-console? EnableDisplayMenu ;M : set-col/rows { theWindow -- } entry# >r GetHandle: theWindow IF GetStack: theWindow to entry# screen-cols >r Width: theWindow CharWidth: theWindow / to screen-cols Height: theWindow CharHeight: theWindow / to screen-rows r> screen-cols 2dup < IF 2dup - col-cur + 0max to col-cur THEN 2drop THEN r> to entry# ; : adjust-col/rows ( -- ) EditWindow set-col/rows ConsoleWindow set-col/rows ; :M SetMultiStatus: ( a1 n1 a2 n1 -- ) \ set the current text on statusbar SetMulti: Win-EdStatusbar \ set statusbar to show multiparts s" Column: " StatusBuf place cursor-col 1+ 0 <# #s #> StatusBuf +place s" of " StatusBuf +place max-cols 0 <# #s #> StatusBuf +place StatusBuf +null StatusBuf 1+ 0 SetText: Win-EdStatusbar s" Line: " StatusBuf place cursor-line 1+ 0 (ud,.) StatusBuf +place s" of " StatusBuf +place file-lines 0 (ud,.) StatusBuf +place StatusBuf +null StatusBuf 1+ 1 SetText: Win-EdStatusbar s" Size: " StatusBuf place text-length 0 (ud,.) StatusBuf +place s" Characters" StatusBuf +place lend-len 0= IF s" (" StatusBuf place text-length BLOCK-SIZE /mod 0 (ud,.) StatusBuf +place s" Blocks, " StatusBuf +place BLOCKLINE-SIZE /mod 0 (ud,.) StatusBuf +place s" Lines, " StatusBuf +place 0 (ud,.) StatusBuf +place s" Chars) " StatusBuf +place THEN StatusBuf +null StatusBuf 1+ 2 SetText: Win-EdStatusbar s" Forth Instances: " StatusBuf place ed-forth-count @ 0 (d.) StatusBuf +place StatusBuf +null StatusBuf 1+ 3 SetText: Win-EdStatusbar overstrike @ if s" <OvrStrk>" else s" <Insert>" then StatusBuf place StatusBuf +null StatusBuf 1+ 4 SetText: Win-EdStatusbar ;M :M SetSimpleStatus: ( a1 n1 a2 n1 -- ) \ set the current text on statusbar SetSingle: Win-EdStatusbar \ set statusbar to show single-part StatusBuf place StatusBuf +place StatusBuf +null StatusBuf 1+ 0 SetText: Win-EdStatusbar ;M :M Refresh: ( -- ) minimized? 0= IF show-console? IF Height console-height - StartSize: Win-EdToolbar nip max ELSE Height THEN to drag-barV drag-barH Width edit-min - 0max min to drag-barH edit-top SetTopOf: EditWindow drag-barV SetTopOf: ConsoleWindow (( The peculiar calculations for window positions and sizes, result from the fact that Windows places windows "inside" of the window space specified, and was thus leaving unrefreshed lines between all my child windows if I didn't fill in the space with an extra pixel here and there. tjz February 24th, 1997 )) all-lines: EditWindow drag-barH drag-thick + 1+ edit-top Width drag-barH drag-thick + - show-console? IF drag-barV edit-top - ELSE Height edit-top - -status THEN Move: EditWindow window-list BEGIN dup @ ?dup WHILE >r Showing: [ r@ ] IF 0 edit-top listHeight + dup>r drag-barH 1- show-console? IF drag-barV r> - ELSE Height r> - -status THEN Move: [ r@ ] THEN r>drop cell+ REPEAT drop drag-barH 1- edit-top 1- drag-thick 2 + show-console? IF drag-barV edit-top - 2 + ELSE Height edit-top - 2 + -status THEN Move: SplitterH show-console? IF all-lines: ConsoleWindow -1 drag-barV Width 2 + drag-thick 2 + Move: SplitterV -1 drag-barV drag-thick + 2 + dup>r Width 2 + Height r> - -status Move: ConsoleWindow THEN Showing: SubjectList IF 0 edit-top drag-barH 1- 160 -status Move: SubjectList THEN adjust-col/rows THEN ;M :M StartToolBar: ( -- ) tool-bar? 0= Floating: Win-EdToolbar 0= and IF TRUE to tool-bar? GetSize: EditorWindow nip 2/ to drag-barV set-console-height self Start: Win-EdToolbar \ then startup child window LoadFindStrings Refresh: self ELSE tool-bar? 0= \ if flagged as not open Floating: Win-EdToolbar and \ but flagged as floating IF SetFocus: Win-EdToolbar \ then bring to front THEN THEN ;M :M CloseToolBar: ( -- ) tool-bar? Floating: Win-EdToolbar or IF SaveFindStrings Close: Win-EdToolbar FALSE to tool-bar? Refresh: self THEN ;M :M SwitchToolBar: ( -- ) Floating: Win-EdToolbar >r CloseToolBar: self Win-EdToolbar max-Edit-Tool-Bar = IF min-Edit-Tool-Bar to Win-EdToolbar TRUE to min-tool-bar? ELSE max-Edit-Tool-Bar to Win-EdToolbar FALSE to min-tool-bar? THEN StartToolBar: self r> IF Float: Win-EdToolbar THEN ;M :M StartConsole: ( -- ) second-copy? 0= IF Height 4 / \ console is a quarter screen SetTopOf: ConsoleWindow \ set the console window's top self Start: ConsoleWindow \ then startup child window self Start: SplitterV TRUE to show-console? \ must be before the ">F" below console-text end-doc TRUE EnableDisplayMenu >F Refresh: self z" RMOT" @ ed-console-remote ! \ set remote IO operations ed-forth-count @ 0= IF z" HIDN" @ ed-console-hidden ! \ flag Forth to hide console StartUpForth ELSE 0 WM_REMOTEIO win32forth-message THEN ELSE FALSE to show-console? THEN ;M :M CloseConsole: ( -- ) save-console FALSE to show-console? >E-unminimize Close: ConsoleWindow Close: SplitterV FALSE EnableDisplayMenu Refresh: self Retitle: [ self ] 0 ed-console-remote ! 0 ed-console-hidden ! ;M :M On_Done: ( h m w l -- res ) Delete: sFont 0 call PostQuitMessage drop \ terminate application On_Done: super \ cleanup the super class 0 ;M :M WM_CLOSE ( h m w l -- res ) before-bye term-canceled? 0= \ if we didn't cancel the close IF bye \ then just terminate the program 0 ELSE 1 \ abort program termination FALSE to term-canceled? THEN ;M :M StartSize: ( -- width height ) \ starting window size start-width SM_CXSCREEN Call GetSystemMetrics 4 - StartPos: self drop - min \ screen width start-height SM_CYSCREEN Call GetSystemMetrics 4 - StartPos: self nip - min \ screen height ;M :M StartPos: ( -- x y ) OriginX 0max OriginY 0max ;M :M MinSize: ( -- width height ) \ minimum window size 0 -20 ;M :M WindowTitle: ( -- Zstring ) \ window caption z" WinEd" ;M :M On_Paint: ( -- ) On_Paint: super tool-bar? IF 0 0 StartSize: Win-EdToolbar Move: Win-EdToolbar LTGRAY_BRUSH Call GetStockObject StartSize: Win-EdToolbar drop 0 \ x,y origin Width StartSize: Win-EdToolbar nip 1+ SetRect: EditRect AddrOf: EditRect GetHandle: dc call FillRect ?win-error WHITE LineColor: dc \ white color Left: EditRect Top: EditRect MoveTo: dc \ horiz StartSize: self drop Width max 0 LineTo: dc \ line BLACK LineColor: dc Left: EditRect Bottom: EditRect 2 - dup>r MoveTo: dc \ horiz StartSize: self drop Width max r> LineTo: dc \ line EraseRect: EditRect THEN ListHeight \ Only if SubjectList is turned on IF \ line below the subject selection dropdown list BLACK LineColor: dc 0 edit-top listHeight + 2 - MoveTo: dc drag-barH edit-top listHeight + 2 - LineTo: dc WHITE LineColor: dc 0 edit-top listHeight + 1- MoveTo: dc drag-barH edit-top listHeight + 1- LineTo: dc THEN ;M :M WM_SETCURSOR ( h m w l -- ) EraseRect: ClientRect \ init to zeros AddrOf: ClientRect GetClientRect: self hWnd get-mouse-xy Top: ClientRect Bottom: ClientRect between swap Left: ClientRect Right: ClientRect between and IF in-vdrag? IF splitv-cursor 1 ELSE in-hdrag? IF splith-cursor 1 ELSE arrow-cursor 1 THEN ELSE DefWindowProc: [ self ] THEN ELSE DefWindowProc: [ self ] THEN 1 ;M :M ReTitle: { \ title$ pad$ -- } LMAXSTRING localAlloc: title$ 32 localAlloc: pad$ pad 32 - pad$ 32 move \ save PAD entry# >r \ save entry entry# entry-console = IF s" Win32Forth Console" title$ lplace ELSE GetStack: EditWindow to entry# Edname$ count title$ lplace (.wined_version) title$ +lplace s" - " title$ +lplace from-web? IF URL$ lcount title$ +lplace ELSE cur-filename count title$ +lplace THEN THEN title$ lcount 255 min SetTitle: self EditMode: Win-EdToolbar \ update statusbar SetMultiStatus: EditorWindow r> to entry# \ restore entry pad$ pad 32 - 32 move \ restore PAD ;M :M WinEdMessageBox: ( szText szTitle style -- result ) MB_TASKMODAL or -rot swap ( hWnd ) NULL Call MessageBox ;M \ the l parameter has already been removed by WINDOW.F, and put \ into Height and Width :M On_Size: ( h m w -- ) \ handle resize message dup SIZE_MINIMIZED = to minimized? \ w is sub-message Redraw: Win-EdStatusbar Refresh: self ;M :M ReSize: ( -- ) entry# >r GetStack: EditWindow to entry# Width: EditWindow CharWidth: EditWindow / to screen-cols Height: EditWindow CharHeight: EditWindow / 1- to screen-rows Paint: self r> to entry# ;M :M On_SetFocus: ( h m w l -- ) On_SetFocus: super SetFocus: edit-window ;M :M On_KillFocus: ( h m w l -- ) On_KillFocus: super ;M : reflect-window { wparam \ theWindow -- WID } \ return ID of reflected window window-list BEGIN dup @ dup to theWindow WHILE Showing: theWindow IF wparam LOWORD ( ID ) GetID: theWindow = IF DROP \ May 9th, 1998 tjz added DROP theWindow EXIT THEN THEN cell+ REPEAT drop FALSE ; :M WM_COMMAND { hwnd msg wparam lparam -- res } wparam reflect-window ?dup IF \ if message is from a listbox, then reflect it \ back to the listbox for processing >r hwnd msg wparam lparam WM_COMMAND WM: [ r> ] ELSE hwnd msg wparam lparam WM_COMMAND WM: Super \ We must send others to 'Super', so that keyboard \ processing will work properly, since 'Super' \ handles keyboard WM_COMMAND messages THEN ;M :M WM_SYSCOMMAND ( hwnd msg wparam lparam -- res ) \ All SC_xxxx command types always have the high nibble set to 0xF over 0xF000 and 0xF000 <> IF over LOWORD DoMenu: CurrentMenu 0 ELSE DefWindowProc: [ self ] THEN ;M \ 59 Support for Drag and Drop files from File Manager to WinEd \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ :M ExWindowStyle: ( -- ) ExWindowStyle: super WS_EX_ACCEPTFILES or \ allow files to be dropped on WinEd WS_EX_OVERLAPPEDWINDOW or ;M :M WM_DROPFILES { hndl message wParam lParam \ cFiles drop$ -- res } MAXSTRING LocalAlloc: drop$ >E-unminimize SetForegroundWindow: self 0 NULL -1 wParam \ HDROP structure Call DragQueryFile to cFiles \ -- count of files dropped RefreshOff: EditWindow FALSE defext_on? dup @ >r ! \ save, but reset the default extension \ addition cFiles 0 ?DO MAXCOUNTED drop$ 1+ i wParam Call DragQueryFile drop$ c! drop$ count "+open-text LOOP r> defext_on? ! \ restore the default extension additon wParam Call DragFinish drop RefreshOn: EditWindow ;M |
