220APA2< H0p\H,DLh D@ |DH-t>@Zt(q\LV (U42 a@X.(E@ |!\*S~X\ :l  P( |` ,TH,Ht| p  P \\||`hDH7xLTS,ad<f@gddg,gHgdX':' lamp after colon? [77] :if (1E)F could be a line label? [78] :andif ':'=1DLB (+/^\EG)E this takes advantage of the fact that ^/IJ [79] :andif ''=1DLB (E':')E lamp immediately follows colon [80] :continue leave this line alone [81] :end [82] :end [83] [84] Watch out for lamps in quotes [85] [86] :if ((X'''"')1); will save as a matrix' [32] :end [33] [34] v(-4'.APL'UCASE 4v)v for ]kedit [35] bv'[]' [36] vDLTB(b\b)/v delete leading [wsid] and trailing [f=] [37] [38] ((f='')/f)'+' [39] ((f='')/f)AV[178] that's the plus-or-minus symbol [40] aNFILE f read the file [41] aAV[AV2ANSIa] xlate back to APL [42] a(-tcnl=1a)a remove trailing tcnl, to avoid trailing blank line [43] [44] AV2ANSI cycle changes (y umlaut) to (high minus) [45] ((a=AV[224])/a)AV[254] ((a='')/a)'' [46] AV2ANSI cycle changes AV[255] (modulo) to AV[180] (looks like modulo) [47] ((a=AV[180])/a)AV[255] [48] [49] :if /',#'v file component? [50] ((v',#')/v)' ' [51] vfi v [52] v'TN',(1v),'CN',(2v) [53] :end [54] [55] :if /',#'v file component? [56] c5 fake class [57] :else [58] cNC v NC does not fail on invalid names [59] :if 4c 4=invalid [60] :orif 1c too many/few names [61] '*** Invalid variable name: ',v [62] 0 [63] :end [64] [65] sSI[;1] first column of SI [66] s(~s'><')/s ditch SI levels that don't have matching IDLOC columns [67] us']' how much UCMD crap is there [68] uu*us or 1 if no ] (non-UCMD) [69] :if u(1,IDLOC v)1 [70] '*** Shadowed: ',v [71] 0 [72] :end [73] [74] :if c1 3 label or function [75] cc'label' '' 'function' [76] '*** Cannot define <',v,'> as a variable because already defined as a ',c [77] 0 [78] :end [79] :end [80] [81] :if k=0 [82] [83] uv [84] ((u='')/u)'+' [85] ((u='')/u)AV[178] that's the plus-or-minus symbol [86] p'Don''t know original rank of' [87] pp,TCNL,TCNL,' ',u [88] pp,TCNL,TCNL,'OK to save as a Matrix?' [89] pp,TCNL,TCNL,'Yes for Matrix, No for Vector with newlines, or Cancel for neither' [90] [91] h'#' wi 'hwndmain' [92] xwcall 'MessageBox' h p 'DIFF' 'MB_ICONQUESTION MB_YESNOCANCEL' [93] [94] :if x=6 6=IDYES [95] k2 [96] :elseif x=7 7=IDNO [97] k1 [98] :else 2=IDCANCEL [99] 'Nothing done' [100] 0 [101] :end [102] [103] :end [104] [105] :if k=2 [106] a[2]1(1,a=tcnl)PENCLOSE ' ',a EV neutral [107] :end [108] [109] 'Saving <',v,'> as a ',k'vector with TCNLs' 'matrix' [110] [111] :if c=5 [112] ((v',#')/v)' ' [113] vfi v [114] a freplace v [115] ' = ',a [116] :else [117] v,'a' [118] '',v,' = ',a [119] :end [120] 2++ CMDAUTOSAVE A;ft;g;i;k;tm;w;x;wself;wsid [1] Automatically )SAVE a copy of the active workspace every so often [2] [3] ]AutoSave turn it on [4] ]AutoSave /on turn it on [5] ]AutoSave /off turn it off [6] ]AutoSave /i query save interval [7] ]AutoSave /i=5 set save interval (in minutes; default is 5) [8] ]AutoSave /q query if AutoSave is running [9] ]AutoSave /log view log file [10] [11] Every interval, the active ws is saved with .BAK appended to the wsid. [12] [13] I don't want to actually save the active ws (like Ctrl+Shift+S). Sometimes I [14] )SAVE manually, do 15 minutes worth of editing, and then decide to abandon the [15] whole thing. I want to be able to re-)LOAD and get back to my check point. [16] [17] I could save the active ws into a single backup ws, such as AUTOSAVE.W3. But [18] I remember that I once lost a bunch of work by typing Alt,F,2 while thinking [19] that another application had the focus, when in fact APL had the focus! If I [20] did that while AutoSave was running, and the interval happened to tick right [21] afterward, I could be left with not very useful backup. So I like using more [22] than one name, even though it clutters up )WSLIB and the File MRU menu. [23] [24] A log file 'AutoSave.log' holds a record of all saves. [25] [26]  Do we really need this? Provides a way to confirm that it's running. [27] [28] If you execute '#' wi 'Reset' that will kill the AutoSave timer. [29] (The AutoSave timer will notify you that it is being deleted, but it will [30] be gone nevertheless.) If you use a ]reset utility, you should consider [31] turning AutoSave back on. [32] [33]  No, now this version detects attempts to delete it and restarts itself! [34] [35] A big problem with this Timer approach: if there is a suspension in your SI [36] stack, it stops working because all callbacks are ignored while suspended! [37] [38] Periodic cleanup: ERASE *.BAK.W3 [39] ERASE AutoSave.log [40] [41] 01 Dec 2006 Rex Swain, Independent Consultant, www.rexswain.com [42] [43] tm'tmAutoSave' timer name [44] ft925195289 log file tie number [45] [46] :if A^.=' ' [47] :orif 1=A GETOPT '/ON' [48] :orif 1=A GETOPT '/DELETED' [49] [50] :if tm wi 'self' [51] :if tm wi 'opened' [52] 'AutoSave is already running' [53] :else [54] tm wi 'Open' [55] 'AutoSave opened' [56] :end [57] 0 [58] :end [59] [60] wselftm wi 'New' 'Timer' [61] wi 'onTimer' "UCMD ']AutoSave /Save'" UCMD [62] wi 'onClose' "' Warning: ]AutoSave timer is being closed '" stops the timer [63] wi 'onDelete' "' Warning: ]AutoSave timer is being deleted '" [64] wi 'onClose' "wres0  'AutoSave refusing Close; to really stop it, ]AutoSave /off'" which would stop the timer [65] wi 'onDelete' "'#' wi 'Defer' 'ucmd '']AutoSave /deleted'''" [66] [67] iwcall 'W_Ini' '[UCMDSREX] AutoSave' [68] :if (,1)VI i [69] i1FI i [70] :else [71] i5 [72] :end [73] wi 'interval' (i601000) minutes to milliseconds [74] [75] Log file [76] gfirst /wcall 'GetModuleFileName' '' (255tcnul) 255 d:\path\aplw.exe [77] g(\g='\')/g d:\path\ [78] gg,'AutoSave.log' [79] wi 'logfile' g [80] [81] :try [82] g xncreate ft it's okay for this to fail (already exists) [83] ('APL+Win ]AutoSave log file',tcnl,tclf) nappend ft [84] :catchall :try requires at least one :catch [85] noop [86] :end [87] [88] :try [89] g xntie ft this must work [90] :catchall [91] '*** Could not tie log file ',g,' : ',(^\TCNLDM)/DM [92] 0 [93] :end [94] [95] Note that the user command processor will untie the log file [96] [97] :if 1=A GETOPT '/DELETED' [98] 'AutoSave restarted after being deleted; to really stop it, ]AutoSave /off' [99] :else [100] 'OK, AutoSave is now running' [101] :end [102] [103] :elseif 1=A GETOPT '/SAVE' [104] [105] wDEB WSID [106] ww,(w'')/'CLEARWS' [107] ww,'.BAK' [108] [109] x(4 0 3 0 3 0 3 0 3 0 3 0 4 0TS),' saving ',w,tcnl,tclf [110] [111] gwi 'logfile' [112] :try [113] g xntie ft file has probably been untied by ucmd processor [114] x nappend ft [115] :catchall file might be erased [116] :try [117] g xncreate ft [118] ('APL+Win ]AutoSave log file',tcnl,tclf) nappend ft [119] x nappend ft [120] :catchall [121] '*** ]AutoSave unable to write to log file ',g [122] :end [123] :end [124] [125] 'RESET' SAVE w wsid this changes wsid, but wsid is localized! [126] [127] Note that SAVE acts like )SAVEOVER [128] [129] :elseif 1=A GETOPT '/OFF' [130] [131] :if tm wi 'self' [132] tm wi 'onDelete' '' avoid warning [133] tm wi 'Delete' [134] 'OK, AutoSave turned off' [135] :else [136] 'AutoSave was not running' [137] :end [138] [139] :elseif 1=iA GETOPT '/I' note embedded i [140] [141] :if i^.=' ' [142] iwcall 'W_Ini' '[UCMDSREX] AutoSave' [143] :if ~(,1)VI i [144] i5 [145] :end [146] 'AutoSave interval is ',(i),' minutes' [147] 0 [148] :end [149] [150] :if ~(,1)VI i [151] '*** Invalid AutoSave interval: ',i [152] 0 [153] :end [154] [155] i1FI i [156] kwcall 'W_Ini' ('[UCMDSREX] AutoSave=',i) [157] [158] :if tm wi 'self' [159] tm wi 'interval' (i601000) [160] 'OK, AutoSave interval changed to ',(i),' minutes' [161] :else [162] 'OK, AutoSave interval set to ',(i),' minutes (although AutoSave is not running now)' [163] :end [164] [165] :elseif 1=A GETOPT '/Q' [166] [167] :if tm wi 'self' [168] :andif tm wi 'opened' [169] itm wi 'interval' [170] 'AutoSave is running; interval is ',(i601000),' minutes' [171] :else [172] 'AutoSave is not running' [173] :end [174] [175] :elseif 1=A GETOPT '/LOG' [176] [177] :if tm wi 'self' [178] :andif tm wi 'opened' [179] itm wi 'interval' [180] 'AutoSave is running; interval is ',(i601000),' minutes' [181] gwi 'logfile' [182] :else [183] 'Note: AutoSave is not running' [184] gfirst /wcall 'GetModuleFileName' '' (255tcnul) 255 d:\path\aplw.exe [185] g(\g='\')/g d:\path\ [186] gg,'AutoSave.log' [187] :end [188] [189] kwcall 'ShellExecute' 0 'open' g 0 0 'SW_SHOWNORMAL' probably NotePad [190] [191] :else [192] [193] '*** Unanticipated CMDAUTOSAVE argument:' A [194] [195] :end [196] 2__ CMDCLIPDOC X;A;C;F;H;I;K;L;M;P;S;T;W;Z [1] Show formats currently available from the Windows clipboard [2] Use /F= option to return contents of specified format number [3] Use /* option to display entire contents of all formats [4] Use /M option to ]DISPLAY the CF_TEXT as a matrix [5] [6] 06 Apr 2003 Rex Swain, Independent Consultant, www.rexswain.com [7] 21 Nov 2003 Use FFATC [8] 26 Mar 2005 Evlevel-neutral [9] 05 Jul 2005 Added /F= option [10] 16 Jul 2005 Added /* option [11] 23 Mar 2006 Added /M option [12] [13] W'#' wi 'hwndmain' get the handle for APL [14] Kwcall 'OpenClipboard' W open the clipboard [15] :if 0=K [16] 'Cannot open clipboard' [17] 0 [18] :end [19] [20] Handle /F= case [21] [22] F,X GETOPT '/F' [23] :if (,1)VI F [24] F1FI F [25] Zwcall 'IsClipboardFormatAvailable' F [26] :if Z=0 [27] 'Format not available in clipboard' [28] L9 [29] :end [30] Hwcall 'GetClipboardData' F get a handle to the clipboard data [31] :if 0=H [32] 'Could not get handle to clipboard data' [33] L9 [34] :end [35] Zwcall 'GlobalSize' H get the size of the data [36] Pwcall 'GlobalLock' H get a far pointer to the memory [37] :if 0=P [38] 'Could not get GlobalLock' [39] L9 [40] :end [41] Twcall 'W_Mem' (P 82 Z) [42] Kwcall 'GlobalUnlock' H unlock the memory [43] RESULTT [44] L9 [45] :end [46] [47] Handle /M case [48] [49] :if 1=X GETOPT '/M' [50] F1 1=CF_TEXT [51] Zwcall 'IsClipboardFormatAvailable' F [52] :if Z=0 [53] 'CF_TEXT format not available in clipboard' [54] L9 [55] :end [56] Hwcall 'GetClipboardData' F get a handle to the clipboard data [57] :if 0=H [58] 'Could not get handle to clipboard data' [59] L9 [60] :end [61] Zwcall 'GlobalSize' H get the size of the data [62] Pwcall 'GlobalLock' H get a far pointer to the memory [63] :if 0=P [64] 'Could not get GlobalLock' [65] L9 [66] :end [67] Cwcall 'W_Mem' (P 82 Z) clipboard text [68] Kwcall 'GlobalUnlock' H unlock the memory [69] [70] Convert to a matrix [71] CC~TCLF CR,LF to CR [72] CC~TCNUL delete possible trailing NUL [73] CC,(TCNL1C)/TCNL make sure it ends with CR [74] C1C put CRs at start of each line [75] C1(C=TCNL) PENCLOSE C make each line be an item [76] W+/C=TCHT num cells in each line [77] CC,((/W)-W)TCHT make each line have same number of cells [78] CTCHT,C start with Tab [79] C1MIX(C=TCHT)PENCLOSEC matrix of cells [80] UCMD ']DISPLAY C' [81] L9 [82] :end [83] [84] Handle normal case [85] [86] Fwcall 'CountClipboardFormats' [87] but CountClipboardFormats does not include the registered clipboard formats! [88] [89] L1=X GETOPT '/*' show all? [90] [91] M0 5 '' Format Hex Name Bytes Value [92] F0 [93] :repeat [94] Fwcall 'EnumClipboardFormats' F [95] :if F=0 [96] :leave [97] :end [98] MM '' [99] Ifirst M [100] M[I;1] F [101] M[I;2] D2X F [102] Hwcall 'GetClipboardFormatName' F (80' ') 80 [103] Afirst /H name [104] :select F [105] :case 1  C'CF_TEXT' [106] :case 2  C'CF_BITMAP' [107] :case 3  C'CF_METAFILEPICT' [108] :case 4  C'CF_SYLK' [109] :case 5  C'CF_DIF' [110] :case 6  C'CF_TIFF' [111] :case 7  C'CF_OEMTEXT' [112] :case 8  C'CF_DIB' [113] :case 9  C'CF_PALETTE' [114] :case 10  C'CF_PENDATA' [115] :case 11  C'CF_RIFF' [116] :case 12  C'CF_WAVE' [117] :case 13  C'CF_UNICODETEXT' [118] :case 14  C'CF_ENHMETAFILE' [119] :else  C'' [120] :end [121] AA,((C)/((A)/' '),' '),C [122] M[I;3] A [123] [124] Hwcall 'GetClipboardData' F get a handle to the clipboard data [125] :if 0=H [126] S'(Could not get handle)' [127] T'' [128] :else [129] Zwcall 'GlobalSize' H get the size of the data [130] SDLB,'CI12' FMT Z [131] [132] Pwcall 'GlobalLock' H get a far pointer to the memory [133] :if 0=P [134] T'(Could not get GlobalLock)' [135] :else [136] Twcall 'W_Mem' (P 82 Z) [137] Kwcall 'GlobalUnlock' H unlock the memory [138] :end [139] :end [140] :if L /* [141] '' [142] ' Format=',(F),' Hex=',(D2X F),' Name=',A,' Bytes=',S [143] '' [144] FFATC T [145] :else [146] T(PWT)T avoid WS FULL [147] TFFATC T [148] M[I;4 5]S T [149] :end [150] :end [151] [152] :if L /* [153] L9 [154] :end [155] [156] WfirstM [157] WW6 3 4 5 5 [158] WW1 1 1 1 1 [159] [160] M[;1]W[1]M[;1] [161] M[;2]W[2]M[;2] [162] M[;3]W[3]M[;3] [163] M[;4]W[4]M[;4] [164] W[5]W[5]PW-(+/1W)+5 5=one blank before each column [165] M[;5]W[5]M[;5] [166] [167] M((W)'-')M [168] M(W'Format' 'Hex' 'Name' 'Bytes' 'Value')M [169] [170] M [171] [172] L9: [173] [174] Kwcall 'CloseClipboard' close the clipboard [175] U2sFF CMDCSICLIP A;H;I;K;T;V;beg;end;first;i;ind;lev;line;line_level;none;stmt;stmts [1] Control Structure Indent via the Clipboard [2] [3] Attach this ucmd to a function key with OptionsTools: [4] Menu Item: Control Structure Indent F12 [5] Command: ]CSICLIP [6] Then, in the APL editor, select a block of comment lines, and press F12. [7] [8] Uses logic from FmtCS2 by TrackView (Brent Hildebrand) [9] 25 Oct 2006 Rex Swain, Independent Consultant, www.rexswain.com [10] [11] To do: Operate on just selected block of code [12] Preserve clipboard (but would that break the Undo capability?) [13] I like to indent :CASE (see Brent's FmtCS5 for this) [14] How to preserve indented wi's ??? [15] [16] *** See Brent's FMTCS41.W3 for later versions of his logic *** [17] [18] [19] H'#' wi 'hwndmain' handle for main session window [20] [21] Query tab width from .INI file [22] [23] IFIRST FI wcall 'W_Ini' '[Editor] Tab Width' [24] II+4I=0 default to 4 if not in ini file [25] [26] Copy from editor with CTRL+A and Ctrl+V [27] [28] KWCALL 'SendMessage' H 'WM_COMMAND' 57642 0 ID_EDIT_SELECT_ALL = 0xE12A = 57642 [29] KWCALL 'SendMessage' H 'WM_COMMAND' 57634 0 ID_EDIT_COPY = 0xE122 = 57634 [30] [31] VClipGet [32] [33] VV~TCLF change CR,LF to CR [34] [35] :if 0=V~TCNL,' ' [36] KWCALL 'MessageBox' H 'Clipboard contains no text!' 'CSI Clip' 'MB_ICONSTOP MB_OK' [37] 0 [38] :end [39] [40] If tool accidentally run in session rather than in editor... [41] [42] :if ~^/VAV2ANSI [43] KWCALL 'MessageBox' H 'Clipboard contains non-APL characters!' 'CSI Clip' 'MB_ICONSTOP MB_OK' [44] 0 [45] :end [46] [47] VAV[AV2ANSIV] [48] VTCNL,V add leadling delimiter [49] [50] TTCNL=1V remember if there was a trailing CR [51] [52] A(QC V)/V APL code (quotes and comments removed) thanks, Zark! [53] [54] AWCALL 'CharUpper' A so easy to match :if or :IF [55] A1(TCNL=A) PENCLOSE A items (we want to keep empty lines) [56] ADLTB  A [57] [58] none1 no control structures found at all? [59] lev0 current indent level [60] ind(A)0 accumulate indent levels for each line [61] :for i :in A [62] lineiA function line [63] stmts'' Words line diamondized statements in function line [64] line_levellev [65] beg0 [66] end0 [67] first0 [68] :for stmt :in stmts [69] firstfirst+1 [70] :if 1+/( stmt) SS  ':IF' ':FOR' ':WHILE' ':REPEAT' ':SELECT' ':TRY' [71] levlev+1 [72] beg1 [73] none0 [74] :end [75] :if 1+/( stmt) SS  ':END' ':UNTIL' note this matches all flavors of :ENDxxx [76] levlev-1 [77] end1 [78] :if (0=beg)^1=first [79] line_levelline_level-1 [80] :end [81] :end [82] :if 1+/( stmt) SS  ':CASE' ':ELSE' ':CATCH' [83] line_levellev-1 [84] :end [85] :if 1+/( stmt) SS  ':ORIF' ':ANDIF' [86] :if 0=end [87] line_levelline_level-1 [88] :end [89] :end [90] :end [91] ind[i]line_level [92] :end [93] [94] :if none [95] KWCALL 'MessageBox' H 'No control structures found' 'CSI Clip' 'MB_ICONINFORMATION MB_OK' [96] 0 [97] :end [98] [99] Alter original V (not A) [100] [101] VDLTB  1(TCNL=V) PENCLOSE V items (we want to keep empty lines) [102] [103] V((Iind)' '),V do the indenting [104] [105] V1ENLIST TCNL,V vector like VR without line numbers [106] VV,TTCNL restore trailing CR [107] [108] VAV2ANSI[AVV] [109] [110] ClipCopy V write text into clipboard [111] [112] Paste into editor with Ctrl+V [113] [114] KWCALL 'SendMessage' H 'WM_COMMAND' 57637 0 ID_EDIT_PASTE = 0xE125 = 57637 [115] 2E CMDDEF A;a;m;r;v [1] Read a native file and DEF the function in it [2] Use after ]DIFF and save from Araxis Merge to get and define changed function [3] See also: ]ASSIGN [4] Syntax: ]DEF filename [5] 25 Apr 2003 Rex Swain, Independent Consultant, www.rexswain.com [6] 05 May 2003 Correct modulo translation [7] 03 May 2005 Remove trailing tcnl, to avoid trailing blank line [8] 07 Mar 2006 Display error message if DEF fails [9] [10] ADLTB,A [11] ((A='')/A)'+' [12] ((A='')/A)AV[177+IO] that's the plus-or-minus symbol [13] vNFILE A [14] aAV[AV2ANSIv] [15] [16] a(-tcnl=1a)a remove trailing tcnl, to avoid trailing blank line [17] [18] AV2ANSI cycle changes (y umlaut) to (high minus) [19] ((a=AV[224])/a)AV[254] ((a='')/a)'' [20] AV2ANSI cycle changes AV[255] (modulo) to AV[180] (looks like modulo) [21] ((a=AV[180])/a)AV[255] [22] [23] m1(+\1,a=tcnl) ' ',a EV2 [24] m[2]1(1,a=tcnl)PENCLOSE ' ',a EV neutral [25] [26] rDEF m [27] [28] :if 82=DR r [29] r [30] :else [31] '*** Error ',(r),' from DEF on file ',A [32] :end [33] [34] ?2fVV CMDDIFF A;B;C;D;E;F;G;I;J;K;M;N;S;T;U;V;W;X;Y;a;c;e;f;h;i;j;k;m;peek;r;t;u;v;w;z;elx;ELX;WSELF [1] Compare (show the DIFFerences between) two functions or variables [2] [3] Syntax: ]DIFF object1 ; object2 [4] Where each object may be: [5] Active ws: [6] FOO object name (function or variable) [7] Saved ws: [8] UTILS FOO wsid, object name [9] 9 STUFF FOO library number, wsid, object name [10] \EUDORA\ATTACH\UTIL FOO path, wsid, object name [11] User command file: [12] FOO /F=UCMDS object name and ucmd file to get it from [13] FOO /F=19 UCMDS object name and ucmd file with library number [14] FOO /F object name, from first ]UFILE file [15] APL file component: [16] tn,cn tie number, component number [17] tn#cn tie number, component number [18] You may use "=" for the second wsid or object name [19] Example: ]DIFF FOO;UTILS = [20] [21] Special case syntax with only one name: [22] ]DIFF object [23] Compares object to same name in saved version of active ws [24] [25] Alternate syntax (borrowed from ]COMP) with no semicolon: [26] ]DIFF object1 object2 [27] Each object may be one of the following types: [28] fnname [/F[=cmdfile]] function [29] varname [/F[=cmdfile]] variable [30] tn,cn APL file: tie number, component number [31] tn#cn APL file: tie number, component number [32] Examples: [33] ]DIFF FUN GUN [34] ]DIFF FUN FUN /F=5 UCMDS [35] ]DIFF FUN /F=5 UCMDS GUN [36] ]DIFF FUN /F=5 UCMDS GUN /F=9 MYUCMDS [37] You may use "=" for the second object name [38] Note that you may not specify WSIDs when using this no-semicolon syntax [39] [40] Execute ]DIFF /ERASE occasionally to clean up temp files [41] (Sorry, this feature does not work with Win98) [42] [43] You may establish a list of user command files with [44] ]DIFF /ULIST=file1;file2;file3 [45] and query it with [46] ]DIFF /ULIST [47] Then use [48] ]DIFF FOO;= /U [49] /U triggers a search through the list of files established above [50] for the first object named FOO [51] [52] This tool automatically sets APLFONT as the Araxis Merge file comparison font. [53] Use something like ]DIFF /AMFONT=10.Courier New to return to a non-APL font. [54] [55] Requires: Araxis Merge 2001, Standard Edition, version 6.0 [56] or: Araxis Merge Standard Edition, version 6.5 [57] See [58] If you have version 6.0, swap comments on two lines with E'ActiveObject ...' [59] [60] See also ]DEF and ]ASSIGN which will define changed objects in the active ws [61] [62] After similar by JVM and Patrick Parks [63] 06 Apr 2003 Rex Swain, Independent Consultant, www.rexswain.com [64] 16 Apr 2003 Added /F support; EVLEVEL-neutral [65] 25 Apr 2003 Allow ]COMP syntax [66] 29 Apr 2003 Added /ERASE (such as it is) [67] 30 Apr 2003 Added /ULIST and /U [68] 01 May 2003 Maximize AM if "Maximize application on start-up" [69] 27 Jul 2003 Correct SI/IDLOC alignment [70] 07 Jun 2005 Added one-name compare, active ws vs. saved ws [71] 06 Oct 2005 Don't allow -options (because filespecs may contain hyphens) [72] 13 Mar 2006 Prompt to save changes made via Merge (suggested by Patrick Parks) [73] Use APL font specified in APLW.INI [UCMDSREX] [74] Added /AMFONT= to reset Araxis Merge font [75] [76] elxELX [77] [78] ADEB,A [79] [80] (A'::')LT kludge for internal timer callback [81] (A'')L9 empty arg? [82] [83] E'ActiveObject Merge2000.Application' Araxis Merge 2001 (version 6.0) [84] E'ActiveObject Merge65.Application' Araxis Merge version 6.5 [85] [86] Patrick suggests that I could query [87] '#' wi 'XInfo' 'Merge65.Application' [88] '#' wi 'XInfo' 'Merge2000.Application' [89] and use the first one available. But each query takes 0.3 seconds on my system. [90] [91] [92] XFIRST /wcall 'GetModuleFileName' '' (255tcnul) 255 C:\APLWin50\aplw.exe [93] D(\X='\')/X C:\APLWin50\ [94] D(D,'Diff1\') (D,'Diff2\') C:\APLWin50\Diff1\ C:\APLWin50\Diff2\ [95] F2 '' APL file names [96] S2 '' ANSI file names [97] [98] CUCASE A [99] ('/ERASE' C)L8 cleanup? [100] ('/ULIST=' 7C)L7 set ucmd file list [101] ('/ULIST' 6C)L6 query ucmd file list [102] ('/AMFONT='8C)L5 reset Merge font [103] [104] :if ';'A semicolon makes it easy [105] V(A';') A EV2 [106] V1(1,A=';')PENCLOSE ';',A EV neutral [107] (2=V)L9,L2 [108] :end [109] V1(1,A=' ')PENCLOSE ' ',A [110] (3V)L1 L2 L3 how many words [111] [112] L1: One word [113] VV, DEB WSID,' =' [114] L2 [115] [116] L3: Do it the hard way [117]  begin code from CMDCOMP [118] AMATRIFY A  MA  V0 2''  T  Y1 0 0 0  I1 [119] 1: next word [120] JY[I]  (J>M)10 no more words? [121] Y[I+1]J+1  XA[J;]  VVX ''  TT,0 [122] 2: [123] T[I]NC X  (T[I]0 2 3)4 [124] (0=X MATIOTA '=')3 [125] (I=1)9 [126] XFIRST V[I-1;1]  A[J;]X  V[I;1] X  2 [127] 3: [128] B'_#,:\.'X  (1B)9  T[I]1B/2 2 3/10 12 17 [129] 8 [130] 4: [131] CA[MJ+1;]  (('/'=1C)^'F='UCASE 21C)5 [132] C3C  Y[I+1]J+2  ((,1)VI C)6 [133] Y[I+1]J+3  CC,' ',A[MJ+2;] [134] V[I;2] ' /F=',C RHS [135] 6 [136] 5: [137] (((1C)'/-')^'F'=UCASE 11C)7 [138] cUCASE 2C  (( c)'/F' '/U')7 RHS [139] Y[I+1]J+2 [140] CUFILES[1;] [141] V[I;2] ' ',c RHS [142] 8 RHS [143] 6: [144] 'F',(I),'C'  T[I]13 [145] V[I;2] ' /F=',C RHS [146] 8 [147] 7: [148] (T[I]2 3)8  'Undefined object: ',X  0 [149] 8: [150] II+1  (I3)1 [151] N1V  (M3)9 [156] N1V  (N>1)11 [157] (T[1]13)9 [158] AAA[1;]  N2  TT,NC A[1;] [159] (~(1T)0 2 3)9 [160] VV(A[1;]) '' [161] 11: [162]  end code from CMDCOMP [163] [164] VDEB,/V this is the only thing we take away from all that [165] (2V)9 [166] [167] L2: [168] [169] vSI[;1] first column of SI [170] v(~v'><')/v ditch SI levels that don't have matching IDLOC columns [171] Uv']' how much UCMD crap is there [172] UU*Uv or 1 if no ] (non-UCMD) [173] [174] C' ' name classes [175] K0 0 variable ranks [176] [177] :for I :in 2 I [178] [179] vIV [180] ((v'')/v)' ' might be from ]SYMFIND [181] vDEB v possibly problem here with LFNs...? [182] e'Problem with argument ',(I),' ... ',v,' ... ' [183] ELX'e,(^\DMTCNL)/DM  0' [184] u'' /F= and ucmd fileid [185] :if '/'v [186] i1+v'/' [187] uDLB iv all options [188] vDTB iv [189] :if ~(11u)'fFuU' [190] e,'Invalid option: ',u [191] 0 [192] :end [193] :end [194] i1+(v)' ' length of last word (object name) [195] j(-i)v object name [196] w(-i+1)v wsid [197] [198] :if I=1 [199] (W J)w j [200] :elseif w,'=' [201] wW [202] :elseif j,'=' [203] jJ [204] :end [205] [206] :if u ----- get from ucmd file ----- [207] [208] :if (11u)'fF' '/F'2u [209] [210] :if w.' ' [211] e,'Cannot specify a WSID and /F= too' [212] 0 [213] :end [214] [215] cUCMD ']UNAMES ',j,' ',u possible FILE NOT FOUND here [216] c(,c)~' ' [217] :if /c SS '' [218] e,'Object not found in UCMD file' [219] 0 [220] :end [221] c1c [222] :if ~c'' [223] e,'Unanticipated name class: ',c [224] 0 [225] :end [226] [227] :elseif (11u)'uU' '/U'2u [228] [229] :if w.' ' [230] e,'Cannot specify a WSID and /U too' [231] 0 [232] :end [233] [234] mwcall 'W_Ini' '[DIFF] ULIST' [235] :if m^.=' ' [236] 'ULIST not set; use ]DIFF /ULIST=...' [237] 0 [238] :end [239] m(m';') m EV2 [240] m1(1,m=';')PENCLOSE ';',m EV neutral [241] v1 not found [242] :for i :in m [243] cUCMD ']UNAMES ',j,' /F=',i possible FILE NOT FOUND here [244] c(,c)~' ' [245] :if /c SS '' [246] :continue [247] :end [248] c1c [249] :if ~c'' [250] e,'Unanticipated name class: ',c [251] 0 [252] :end [253] v0 found [254] :leave [255] :end [256] :if v [257] e,'Object not found in ULIST files' [258] 0 [259] :end [260] u'/F=',i [261] [262] :else [263] [264] 'Unanticipated u: ',u [265] 0 [266] [267] :end [268] [269] vUCMD ']UREAD ',j,' ',u [270] [271] :if c='' function [272] kDEF[2]('rpeek v;',j) 'rCR DEF v' peek convert VR to CR [273] rpeek v [274] :else variable [275] K[I](82=DR v)v [276] rv [277] :end [278] [279] C[I]c remember class [280] [281] :elseif /',#'j ----- get from APL file ----- [282] [283] c~j',#' [284] cFI c\c/j [285] vFREAD c [286] K[I](82=DR v)v [287] rv [288] C[I]'' note that we don't know the name or class of this object [289] [290] :elseif w^.=' ' ----- get from active ws ----- [291] [292] :if U(1,IDLOC j)1 [293] e,'Shadowed: ',j [294] 0 [295] :end [296] [297] :select FIRST NC j [298] :case 2 var [299] C[I]'' remember class [300] vj [301] K[I](82=DR v)v [302] rv [303] :case 3 fn [304] C[I]'' remember class [305] rCR j [306] :else [307] e,'Not found in active ws: ',j [308] 0 [309] :end [310] [311] w'Active Ws' for file name (don't use wsid -- saved ws could be different) [312] [313] :else ----- copy from another ws ----- [314] [315] X 'rw peek j;v;ELX;',j [316] XX, 'r99' [317] XX, 'ELX"0"' [318] XX, 'rfirst j copy w' [319] XX, ':select r' [320] XX, ':case 1' [321] XX, ' C[I]""' [322] XX, ' rCR j' [323] XX, ':case 2' [324] XX, ' v',j [325] XX, ' C[I]""' [326] XX, ' K[I](82=DR v)v' C[I] K[I] [327] XX, ' rv' [328] XX, ':else' [329] XX, ' 0' [330] XX, ':end' [331] kDEF[2]X [332] rw peek j [333] :if 0=r [334] ke,"Error from '",j,"' COPY '",w,"' : " [335] :select r 1=fn copied 2=var copied [336] :case 0  k,'Object not found' [337] :case 127  k,'Duplicate name in objlist should not get here!' [338] :case 2  k,'Object too large for available space' [339] :case 3  k,'Name defined as a label; cannot be changed' [340] :case 4  k,'Insufficient space in symbol table and workspace too full to expand symbol table' [341] :case 6  k,'Insufficient free space to carry out command' [342] :case 99  k,(^\DMTCNL)/DM [343] :else  e,'Unanticipated COPY return code: ',r [344] :end [345] 0 [346] :end [347] [348] :end [349] [350] Cook up a good file name [351] m(w)/'[',w,'] ' prefix with wsid [352] mm,j add object name [353] mm,(u)/' [',(u~'/'),']' add /F= or /U= (but a "/" will create a subdirectory) [354] m[(m'\:/')/m]' ' [355] mDEB m [356] mm,(C[I]'')/'.',K[I] record rank if simple character vector or matrix, 0 otherwise [357] mm,(''C[I])'.var' '.fn' '.fc' [358] [359] (IF)(ID),m file name (for ]DEF or ]ASSIGN) before fixing deltas [360] (IF) display for ]DEF [361] WGIVE 0 let that output appear [362] [363] ((m='')/m)'#' might be a system variable [364] ((m='')/m)'+' fyi, WSIDs can contain and symbols! [365] ((m='')/m)AV[178] that's the plus-or-minus symbol [366] (IS)(ID),m save the ANSI version of the file name [367] [368] rAV2ANSI[AVr] translate [369] [370] r NFILE IS write the file [371] [372] :end [373] [374] ELXelx [375] [376] f'aoDIFF_AM' [377] [378] :if f wi 'self' [379] :andif f wi 'visible' [380] [381] Merge is already running [382] [383] wselff [384] wi 'xActive' 0 [385] wi 'xActive' 1 make it the active app (thanks, Patrick!) [386] [387] :else [388] [389] Create new Merge object [390] [391] wselff wi 'Create' E 'ActiveObject Merge65.Application' [392] [393] Araxis Merge never starts maximized when invoked via ActiveX, even if you [394] have the "Maximize application on start-up" option checked. We can look at [395] the AM preferences, but only after AM starts -- and if we maximize it then, [396] you'll see the maximization happening. Oh well. [397] [398] wi 'Preferences > .prefs' [399] '.prefs' wi 'Longs > .longs' [400] e'.prefs.longs' wi 'xItem' 'clAppMax' [401] :if e [402] wi 'xMaximized' e maximize the app (if belatedly) [403] :end [404] [405] Set APL fonts [406] [407] Get value of key k from APLW.INI section [UCMDSREX]; default to d [408] kex 'G' [409] kfx [2] 'vk G d' "vwcall 'W_Ini' ('[UCMDSREX] ',k)  (v'')0  vd" G [410] [411] tUCASE 'FontName' G 'APLFONT' [412] z1fi 'FontSize' G '11' [413] [414] :if t'APLFONT' [415] :orif t'APLCODE' [416] Symbol font (so something like "11.APLFONT" won't work) [417] hwcall 'GetDC' 0 handle of device context of display [418] iwcall 'GetDeviceCaps' h 'LOGPIXELSY' pixels per vertical logical inch [419] z0.5+(zi)72 height [420] z'-',z negative means character height (as opposed to cell height) [421] tz,',0,0,0,400,0,0,0,255,1,2,1,49,',t [422] or, use WChooseFont '' in the TOOLS\WINDOWS workspace to get a logfont spec [423] :else [424] TrueType font [425] t(z),'.',t e.g., '12.APLHELP' [426] :end [427] 'font  ',t debug [428] [429] '.prefs' wi 'Strings > .strings' [430] I 'csUnchangedFont' 'csChangedFont' 'csInsertedFont' 'csRemovedFont' left window [431] II,'csUnchangedFont2' 'csChangedFont2' 'csInsertedFont2' 'csRemovedFont2' right panel [432] :for i :in I [433] '.prefs.strings' wi 'xItem' i t [434] :end [435] [436] Save method: Saves preferences to the Registry, and propogates them to [437] other running instances of Merge. Without this method, preferences are [438] only saved to the Registry when Merge exits. [439] [440] '.prefs' wi 'XSave' [441] [442] :end [443] [444] Initiate the file comparison [445] [446] wi 'xFileComparison > .filecomp' [447] '.filecomp' wi 'xCompare' (1S) (2S) Compare! [448] GiveUserControl: Gives control over the lifetime of the comparison window to [449] the user. Merge will not automatically close the window when outstanding [450] automation references are released. [451] '.filecomp' wi 'xGiveUserControl' enables tabs for multiple comparisons [452] '.filecomp' wi 'xVisible' 1 [453] wi 'xVisible' 1 [454] [455] Maybe I should creating more than one FileComparison object. [456] Then could I tell when user does ]diff on the same object? [457] [458] f'fmDIFF_AM' [459] :if ''f wi 'self' [460] wselff wi 'Create' 'Form' 'Hide' [461] wi 'f' (0 '' '' ' ' (0 0)) ANSI file, APL file, class, timestamp [462] m0 4'' '' ' ' (0 0) ANSI file, APL file, class, timestamp [463] wi 'h' ('#' wi 'hwndmain') [464] t"(('#' wi 'hwndmain')=(wcall 'GetActiveWindow'))/'CMDDIFF ''::'''" debug [465] t"(('#' wi 'hwndmain')=(wcall 'GetActiveWindow'))/'UCMD '']DIFF ::'''" [466] k'.tm' wi 'New' 'Timer' ('interval' 500) ('onTimer' t) [467] :else [468] wselff [469] mwi 'f' [470] :end [471] [472] :for I :in 2 [473] fIS [474] hwcall 'CreateFile' f 'GENERIC_READ' 'FILE_SHARE_READ' 0 'OPEN_EXISTING' 0 0 [475] Assert hwcall 'W_Const' 'INVALID_HANDLE_VALUE' [476] twcall 'GetFileTime' h    get create, access, write times [477] Assert 0first t [478] kwcall 'CloseHandle' h [479] t4t write time [480] u~( f)m[;1] [481] mum if file is already being compared, remove it [482] mmf (IF) (IC) t [483] :end [484] wi 'f' m [485] m debug [486] [487] 0 [488] [489] L5: /AMFONT [490] [491] t8A what's after /AMFONT= e.g. '10.Courier New' [492] f'aoDIFF_AM' [493] :if ~''f wi 'self' [494] :andif f wi 'visible' [495] Merge is already running [496] wselff [497] :else [498] Create new Merge object [499] wselff wi 'Create' E 'ActiveObject Merge65.Application' [500] :end [501] wi 'Preferences > .prefs' [502] wi '.prefs.Strings > .strings' [503] I 'csUnchangedFont' 'csChangedFont' 'csInsertedFont' 'csRemovedFont' left window [504] II,'csUnchangedFont2' 'csChangedFont2' 'csInsertedFont2' 'csRemovedFont2' right panel [505] :for i :in I [506] '.prefs.strings' wi 'xItem' i t [507] :end [508] '.prefs' wi 'XSave' [509] f wi 'Delete' [510] 'Okay, Merge font set to: ',t [511] 0 [512] [513] L6: /ULIST [514] [515] uwcall 'W_Ini' '[DIFF] ULIST' [516] :if u2TCNL [517] 'ULIST is undefined; to define it, run',TCNL,' ]DIFF /ULIST=file1;file2;...' [518] :else [519] '/ULIST=',u [520] :end [521] 0 [522] [523] L7: /ULIST= [524] [525] u7A what's after /ULIST= [526] kwcall 'W_Ini' ('[DIFF] ULIST=',u) [527] 'Okay, /ULIST=',u [528] 0 [529] [530] L8: /ERASE [531] [532] " Note this doesn't work with Win98; you''ll have to erase the directories yourself" [533] 3 CMD 'RMDIR ',(1D),' /S /Q' [534] 3 CMD 'RMDIR ',(2D),' /S /Q' [535] 0 [536] [537] L9: Say syntax [538] [539] r'DIFF syntax is:',TCNL,' ]DIFF object1 ; object2' [540] rr,TCNL,'For details, see:',TCNL,' ]DIFF ?' [541] r [542] 0 [543] [544] LT: Internal timer callback [545] [546] wself is the Timer object [547] Bail unless we have returned to the APL session [548] [549]  We now do this test in the onTimer expression to avoid ucmd overhead [550] (('#' wi 'hwndmain') = (wcall 'GetActiveWindow'))0 [551] [552] Check for changed file timestamps [553] [554] F':' wi 'f' [555] :for I :in 1F [556] (f a c w)F[I;] [557] hwcall 'CreateFile' f 'GENERIC_READ' 'FILE_SHARE_READ' 0 'OPEN_EXISTING' 0 0 [558] Assert hwcall 'W_Const' 'INVALID_HANDLE_VALUE' [559] twcall 'GetFileTime' h    get create, access, write times [560] Assert 0first t [561] kwcall 'CloseHandle' h [562] t4t write time [563] :if ~tw [564] [565] We're not going to ask again, regardless of answer [566] F[I;4] t [567] ':' wi 'f' F [568] [569] V(~\f='\')/f delete leading path [570] BV'[]' [571] VDLTB(B\B)/V delete leading [wsid] and trailing [f=] [572] V(^\V'.')/V delete trailing extension [573] [574] X'The timestamp on the file' [575] XX,TCNL,' ',f [576] XX,TCNL,'which contains ',((''c)'variable' 'function' 'file component') [577] XX,TCNL,' ',V [578] XX,TCNL,'has changed' [579] XX,TCNL [580] :if c'' [581] XX,TCNL,'Define changed object in active ws?' [582] :else [583] XX,TCNL,'Replace changed array in file component?' [584] :end [585] [586] h'#' wi 'hwndmain' [587] kwcall 'MessageBox' h X 'DIFF' 'MB_ICONQUESTION MB_YESNOCANCEL' MB_DEFBUTTON2 [588] :if k=6 6=IDYES [589] :if c='' [590] UCMD ']DEF ',a use APL file name -- DEF will translate [591] :else c'' [592] UCMD ']ASSIGN ',a [593] :end [594] :elseif k=7 7=IDNO [595] noop [596] :else 2=IDCANCEL [597] :leave [598] :end [599] :end [600] :end [601] [602] If Merge has been closed, shut down monitoring [603] [604] f'aoDIFF_AM' [605] :if ''f wi 'self' somebody else deleted it [606] :orif 0=f wi 'visible' user closed it thanks, Patrick! [607] Use of Defer solves localization problems with wself [608] '#' wi 'Defer' "'fmDIFF_AM' wi 'Delete'" [609] '#' wi 'Defer' "'aoDIFF_AM' wi 'Delete'" [610] :end [611] 2UU b CMDFILEDOC f;B;C;c;cv;cw;D;d;done;e;elx;h;I;i;k;m;max;n;oldi;oldr;oldu;oldv;p;q;r;S;T;t;tn;U;u;uw;v;w;z;ELX;wself [1] File documentation [2] Syntax: [3] ]FileDoc tienumber [4] ]FileDoc filename [5] Options: [6] /C=2 5 Do just components 2 through 5 (inclusive) [7] /C=6 * Do just components 6 through last component [8] /C=* 6 Do just first component through component 6 [9] /C=6 Same as /C=* 6 [10] View options (see also View menu): [11] /B Bytes [12] /T Timestamp (YYYY/MM/DD HH:MM:SS) [13] You may double-click a row to display the value [14] This uses )EDIT, so it does not work for nested values [15] Any changes are NOT replaced [16] You may click on a column heading to sort by that column [17] Click twice for descending order [18] [19] 13 Jan 2003 Rex Swain, Independent Consultant, www.rexswain.com [20] 20 Jan 2003 Auto-detect UCMD files [21] 18 Feb 2003 Make UCMD column at least 10 wide [22] 05 Apr 2003 Handle .sf file names; simple component error handler [23] 25 Apr 2003 Remember window size and position [24] 02 May 2003 Added use of ]PKGDOC for peeking at PACKAGEs in ucmd files [25] 06 May 2003 Improved peeking at fns and vars in ucmd files [26] 06 Jul 2003 Keep already-tied files tied to their original tie numbers [27] 28 Mar 2004 Handle long file names: translate '9 LongFName' to 'path\LongFName.sf' [28] 25 Sep 2004 Use font settings in APLW.INI [UCMDSREX] [29] 26 Mar 2005 Evlevel-neutral [30] 20 Jun 2005 Added peek for runtime (see FILEDOC.W3) [31] 18 Sep 2005 Most recent minor change [32] 14 Oct 2005 New logic for FSTIE and XFSTIE attempts [33] 27 Oct 2005 Handle no components with runtime FileDoc [34] [35] To do: [36] Print [37] Better error handler for components (WS FULL, FILE DATA ERROR, etc.) [38] Need to flag the error, then don't wrap quotes around message, say ? for shape, etc. [39] File/Open [40] /C=9999 9999 forces just the last comp ; should we report error instead? [41] Improve peeking at values that )EDIT won't allow [42] ]PKGDOC needs to handle multiple instances too [43] Support for colossal files [44] [45] (NC 'b')L6 dummy left arg means callback [46] [47] 28 Jul 2003 [48] I gave up trying to allow multiple instances. [49] First I added a kludge to handle the callbacks: [50] hVR 'CMDFILEDOC' [51] h[(h'C')+0 1 2]'' change function name 'CMD' to '' [52] wi 'vr' h [53] h"(0=NC 'FILEDOC')/'0 0DEF WI '':vr'''   FILEDOC wevent" CMDFILEDOC [54] wi 'onClose' h [55] wi 'onDestroy' "ERASE 'FILEDOC'" [56] This is yucky, and isn't even sufficient because all of FILEDOC's subroutines [57] may be needed too. [58] Another complication is that the user command processor unties any ties made [59] during the execution of a user command. So I had to introduce code to [60] detect and recover from that. [61] Conclusion: User commands need to Wait, not Show. [62] If you run APL+Win with the "Multiple Execution" option, you can still have [63] several instances, but only the top one will be enabled. [64] [65] fENLIST f arg might be numeric in development mode [66] [67] :if f^.=' ' no argument? [68] OUT 'For help, execute',tcnl,' ]FILEDOC ?' [69] 0 [70] :end [71] [72] max256 max width of FFA display [73] [74] elxELX [75] [76] Bfirst 1=f GETOPT '/B' bytes [77] Tfirst 1=f GETOPT '/T' timestamp [78] C f GETOPT '/C' component range [79] fDLTB (^\f'/')/f delete all options [80] [81] D1 depth [82] S1 shape [83] [84] :if (,1)VI f just a tie number? [85] tnfirst FI f [86] :if tnFNUMS [87] nFNAMES[FNUMStn;] [88] L4 [89] :elseif tnXFNUMS [90] nXFNAMES[XFNUMStn;] [91] L4 [92] :else [93] OUT 'No component file tied to ',tn [94] 0 [95] :end [96] :end [97] [98] '9 FOO' could be an F file in library 9, or a XF file named '9 FOO' [99] in the current directory, so we pretty much just have to experiment. [100] Since this utility was born in the era of F files, try that first. [101] [102] F file names cannot contain '.' (although their path can) [103] An F file may have long names in its path, but not the name itself [104] XF and CF file names may or may not have an extension [105] An F file may be tied by XFTIE [106] F files are exclusive-tied on create; others are share-tied [107] '9 FOO' could be an F file in lib 9, or a XF file named '9 FOO' in current dir! [108] You can 'FOO.SF' XFCREATE and then later 'FOO' FTIE, but only if .SF is in upper case! [109] You can 'FOO.SF' XFCREATE 1 and then 'FOO' FSTIE 2 and have the same file tied twice! [110] If a file is tied already, you can tell whether it's a share or exclusive tie by trying [111] to rename it to itself; if that fails, it's a share tie. [ELE] [112] [113] e'' error message(s) [114] [115] m(~<\f'\:')/f filename[.ext] [116] ('.'m)L2 skip the FSTIE attempt if the file has an extension [117] [118] Try FSTIE [119] [120] dFNUMS [121] tnfirst (999)~d,XFNUMS remember, F and XF share pool of tie numbers [122] ELX'',L1 [123] f FSTIE tn [124] ELXelx [125] Okay, it worked; 2 possibilities: new tie, or re-tied to a different tie number [126] Assert ~FNUMSd [127] Assert (FNUMS)d [128] :if (FNUMS)>d easy case: new tie has been created [129] It's possible that we have now ftied a file that was already xftied, [130] but I see how we can detect this situation. [131] :else file was already tied; be polite and restore original tie number [132] tnfirst d~FNUMS [133] f FSTIE tn if first tie worked, will this always work too? [134] :end [135] nFNAMES[FNUMStn;] [136] L4 [137] [138] L1: FSTIE failed [139] [140] ee,tcnl,'Error from FSTIE: ',(^\DMTCNL)/DM [141] [142] L2: Try XFSTIE (same logic as FSTIE) [143] [144] dXFNUMS [145] tnfirst (999)~FNUMS,d [146] ELX'',L3 [147] f XFSTIE tn [148] ELXelx [149] :if (XFNUMS)=d [150] tnfirst d~XFNUMS [151] f XFSTIE tn [152] :end [153] nXFNAMES[XFNUMStn;] [154] L4 [155] [156] L3: XFSTIE failed [157] [158] ee,tcnl,'Error from XFSTIE: ',(^\DMTCNL)/DM [159] 1e [160] 0 [161] [162] L4: Okay, we have tied the file! [163] [164] nDLTB n [165] [166] zFSIZE tn [167] (i e)2z first, 1+last [168] zDEB,'CI15' FMT z [169] [170] :if i=e no components? [171] :andif ~sys[21] not runtime? [172] OUT 'No components in file ',n,' - Tie ',(tn),' - Size ',z [173] 0 [174] :end [175] [176] uw0 [177] oldu'' [178] [179] See if it's a user command file [180] [181] U0 pessimist [182] m((e-1),0)'' [183] ELX'',L5 [184] [185] qFREAD tn,2 pointers to directories [186] kFREAD tn,q[2] char directory of objects (names) [187] vFREAD tn,q[3] num directory of objects (nc, comp, date mod, arch date) [188] k(\' '.k)/k DTBC no subroutine because of ELX [189] kk,' ?'[v[;1]] [190] cv[;2] component numbers [191] uw10first 1k [192] m((e-1),uw)' ' user command files always start with comp 1 [193] m[c;]uw[2]k [194] m[1 ;]uw'[fileid]' [195] m[2 ;]uw'[head]' [196] m[q[1];]uw'[usage]' [197] m[q[2];]uw'[names]' [198] m[q[3];]uw'[numinfo]' [199] m[3 ;]uw'[bootfn]' [200] m[4 ;]uw'[upath]' [201] m[5 ;]uw'[bootpkg]' [202] m[5+5;](5,uw)uw'[reserved]' [203] U1 [204] [205] L5: [206] [207] ELXelx [208] [209] :if 1=C [210] C2FI C [211] qC=0 [212] C[q/2]q/i,e-1 [213] CC[C] [214] CiCe-1 [215] (i e)C+0 1 [216] :end [217] [218] Get value of key k from APLW.INI section [UCMDSREX]; default to d [219] kfx [2]'vk I d;z' "vwcall 'W_Ini' ('[UCMDSREX] ',k)  (v'')0  vd" I [220] [221] wFI 'FileDoc-Place' I '2 5 20 70' [222] vFI 'FileDoc-Visible' I '1' [223] vv-v=2 1=normal 2=minimized 3=maximized; don't start minimized [224] [225] If there are other instances of Filedoc running, cascade windows a little bit [226] :for wself :in '#' wi 'children' [227] :if 'Form'wi 'class' [228] :andif 'fmFiledoc'9wi 'name' [229] w[1 2]w[1 2]1.5 3+2wi 'place' [230] :end [231] :end [232] [233] wself('fmFiledoc',tn) wi 'Create' 'Form' 'Hide' [234] wi 'inifile' f [235] wi 'caption' ('FileDoc ',(tn),' - ',n,' - Size ',z) [236] wi 'place' w [237] wi 'visible' v [238] h' CMDFILEDOC wevent' [239] wi 'onClose' h [240] [241] wself':mFile' wi 'New' 'Menu' [242] wi 'caption' '&File' [243] [244] wself':mFile.mPeek' wi 'New' 'Menu' [245] wi 'caption' '&Peek...' [246] wi 'shortcut' 'P' 2 [247] wi 'onClick' " CMDFILEDOC 'Peek'" [248] [249] wself':mFile.mExit' wi 'New' 'Menu' [250] wi 'caption' 'E&xit' [251] wi 'shortcut' 'X' 2 [252] wi 'onClick' "0 0':' wi 'Close'" [253] [254] wself':mView' wi 'New' 'Menu' [255] wi 'caption' '&View' [256] [257] wself':mView.mUcmd' wi 'New' 'Menu' [258] wi 'caption' '&UCMD Info' [259] wi 'shortcut' 'U' 2 [260] wi 'style' 1 [261] wi 'value' U [262] wi 'data' 3 [263] wi 'onClick' h [264] wi 'visible' U [265] wi 'enabled' U [266] [267] wself':mView.mTime' wi 'New' 'Menu' [268] wi 'caption' '&Timestamp' [269] wi 'shortcut' 'T' 2 [270] wi 'style' 1 [271] wi 'value' T [272] wi 'data' 4 [273] wi 'onClick' h [274] [275] wself':mView.mBytes' wi 'New' 'Menu' [276] wi 'caption' '&Bytes' [277] wi 'shortcut' 'B' 2 [278] wi 'style' 1 [279] wi 'value' B [280] wi 'data' 5 [281] wi 'onClick' h [282] [283] wself':mView.mDepth' wi 'New' 'Menu' [284] wi 'caption' '&Depth' [285] wi 'shortcut' 'D' 2 [286] wi 'style' 1 [287] wi 'value' D [288] wi 'data' 6 [289] wi 'onClick' h [290] [291] wself':mView.mShape' wi 'New' 'Menu' [292] wi 'caption' '&Shape' [293] wi 'shortcut' 'S' 2 [294] wi 'style' 1 [295] wi 'value' S [296] wi 'data' 7 [297] wi 'onClick' h [298] [299] wself':bn' wi 'New' 'Button' [300] wi 'caption' 'Stop' [301] wi 'size' 1.25 8 [302] wi 'style' 2 2=cancel [303] wi 'onClick' 'done1' done [304] [305] wself':l' wi 'New' 'Label' [306] wi 'caption' '' [307] wi 'size' 1 9 [308] wi 'style' 2 [309] [310] wself':pb' wi 'New' 'Progress' [311] wi 'style' 1 1=smooth [312] wi 'value' 0 (1e-i) 1 0 1 in case empty file [313] [314] cw1+2first e-1 component number display width [315] cw4cw at least 'Comp' [316] [317] 1=label 2=width 3=just 4=col id 5=col order 6=header image 7=header style [318] c0 30 [319] cc' ' 0 'left' 1 first col must be left justified [320] cc((4+5cw9)'Component') (1.5+4+5cw9 ) 'right' 2 [321] cc'UCMD' uw 'left' 3 [322] cc'Timestamp' 20 'left' 4 [323] cc'Bytes' 8 'right' 5 [324] cc'' (1.5+1) 'right' 6 [325] cc'Shape' 8 'right' 7 [326] cc'Value' 80 'left' 8 [327] [328] wself':' [329] [330] cv0 1 U T B D S 1 [331] c[(~cv)/cv;2]0 [332] wi 'cv' cv [333] [334] wi 'tn' tn [335] [336] Get value of key k; if undefined, write default to the ini file [337] kfx [2]( [2] cr 'I'), "zwcall 'W_Ini' ('[UCMDSREX] ',k,'=',d)" I [338] [339] wself':lv' wi 'New' 'Listview' [340] [341] wi 'columndisplay' c [342] [343] wi 'font' 'APLFONT' 11 0 'default' [344] f 'FontName' I 'APLFONT' [345] ff,FI 'FontSize' I '11' [346] ff,FI 'FontStyle' I '0' [347] ff, 'FontCharset' I 'default' [348] wi 'scale' 3 font size will be specified in points [349] wi 'font' f [350] [351] wi 'where' 0.5 1 [352] wi 'style' 1 2 4 1024 4096 1024=reorder cols 4096=gridlines [353] wi 'onColClick' h [354] wi 'onDblClick' h [355] wi 'onKeyPress' h [356] [357] wself':' [358] wi 'onResize' h [359]  CMDFILEDOC 'Resize' [360] [361] wself':lv' [362] wi 'Focus' [363] [364] (i=e)L7 no components? [365] [366] v0 in case just one component [367] r0 [368] u'' [369] t0 [370] b0 [371] [372] oldii [373] oldvFREAD tn,i read first component, save for flush [374] oldrFRDCI tn,i [375] oldum[i;] [376] [377] done0 repeat until done [378] [379] :repeat [380] [381] ':l' wi 'caption' (,'CI9' FMT i) [382] ':pb' wi 'Stepit' [383] ii+1 [384] :if i1 [408] cc,'',i-1 [409] :end [410] [411] Timestamp [412] t,'I4,,ZI2,,ZI2,< >,ZI2,<:>,ZI2,<:>,ZI2' fmt 1 63oldr [413] [414] Bytes [415] bDLB,'CI15' FMT oldr[1] [416] [417] Depth [418] doldv [419] dd [420] [421] Shape [422] poldv shape [423] kp rank [424] p(p),(k=0)/'' format shape [425] [426] Value [427] fFFA oldv [428] fmax FFAW oldv [429] f(maxf)f [430] qf'' [431] :if qf [432] :andif q1 [616] :orif (v)>2 [617] :orif ^/0 ' 'TYPE enlist v [618] vFFA v but can get "Line too long" error from W_Edit [619] vUCMD 'DISPLAY v' well, it's better than nothing! [620] :end [621] kDEF "n p ",n,tcnl,"[1] kWCALL 'W_Edit' n " [622] n p v [623] :end [624] [625] :CASE 'RT_Edit' [626] [627] (tn i)b [628] vFREAD tn,i the value [629] vCVR v simple character (thanks, Roy!) [630] [631] Get value of key k from APLW.INI section [UCMDSREX]; default to d [632] kfx [2]'vk I d;z' "vwcall 'W_Ini' ('[UCMDSREX] ',k)  (v'')0  vd" I [633] [634] f 'FontName' I 'APLFONT' [635] ff,FI 'FontSize' I '11' [636] ff,FI 'FontStyle' I '0' [637] ff, 'FontCharset' I 'default' [638] [639] wFI 'FileDocPeek-Place' I '2 5 20 70' [640] [641] wself('fmPeek',i) wi 'Create' 'Form' 'Hide' [642] wi 'caption' ('FileDoc ',(tn),' - Component ',i) [643] wi 'border' 2 16 64 2=sizeable 3=modal 16=sys menu 64=max [644] wi 'limitwhere' 10 30 minimum size [645] wi 'onClose' " CMDFILEDOC 'RT_Close'" [646] wi 'onResize' " CMDFILEDOC 'RT_Resize'" [647] [648] wself':ed' wi 'New' 'Edit' [649] wi 'where' 0.75 1 10 30 [650] wi 'scale' 3 font size will be specified in points [651] wi 'font' f [652] wi 'color' (256255 255 255) [653] wi 'style' 4 16 64 2048 4096 4=multi-line 16=vscroll 64=hscroll 2048=APL 4096=read-only [654] wi 'text' v [655] [656] wi 'Defer' "wi 'selection' 0" who knows why Defer is necessary... [657] [658] wself':bn' wi 'New' 'Button' [659] wi 'size' 1.25 9 [660] wi 'caption' 'Close' [661] wi 'style' 2 1=default (enter key); 2=cancel (escape key)  onClose [662] [663] wself':' [664] wi 'where' w triggers onResize handler [665] kwi 'Show' don't Wait; Show permits several peeks [666] [667] :ELSE [668] [669] '*** Unanticipated CMDFILEDOC callback! ',f wself wevent warg [670] [671] :ENDSELECT [672] 2`` XCMDFNREPL A;B;C;D;E;F;FILT;G;H;I;J;K;L;M;N;P;Q;QC;R;S;SYN;T;U;UP;V;W;Z;a;d;g;h;i;m;p;q;r;t;u;y [1] Find (and optionally replace) strings in functions [2] [3] Syntax: [4] [5] ]fnrepl target Search (if target begins with a letter) [6] ]fnrepl target/options Ditto, with options [7] Any non-alpha delimiter character may be used in place of the slashes shown below [8] ]fnrepl /target Search (exactly 1 delimiter) [9] ]fnrepl /target/ Search (exactly 2 delimiters) [10] ]fnrepl /target/options Ditto, with options [11] ]fnrepl /target/replacement/ Replace (exactly 3 delimiters) [12] ]fnrepl /target/replacement/options Ditto, with options [13] Multiple targets (not allowed in replace mode): [14] ]fnrepl /t1/^/t2/options Find only lines with both matches [15] ]fnrepl /t1/\t2\ Find lines with either match; delimiters may be different [16] ]fnrepl /t1/&~/t2/ Logical not; & and are also permitted [17] ]fnrepl /t1/>/t2/ Can use any of <=>^& and ~ [18] ]fnrepl /t1/^~/t2//t3/ Evaluated as APL would ("right to left") [19] [20] Default is to perform case-sensitive, syntactic (name) search, on all global functions [21] [22] Options: [23] [24] To loosen match criteria: [25] / Non-syntactic search (ANY occurrence) (Alt+S for non-Syntactic) [26] / Ignore case (upper/lower/underscore) (Alt+C for Case) [27] To limit functions searched: [28] /f1 f2 Only look in named functions [29] /f* Fn names with wildcards (foo* *old fm*def etc.) [30] /~f1 f2 Look in all but named functions [31] To limit search scope (using all three is equivalent to using none): [32] / Find only in comments [33] /' Find only in character constants (or /") [34] / Find only in APL (not comments/quotes) [35] To expand search scope: [36] / Find strings anywhere in a function -- not necessarily on the same line. [37] Only useful with multiple targets. Doesn't change behavior of /t1//t2/. [38] Display from /t1/^/t2/ is similar to /t1//t2/ but only shows functions [39] that contain at least one hit on both strings. [40] Other: [41] / Auto reply Yes to the replacement confirmation prompt [42] /? Prompt before each replacement [43] / Suppress display; return fn names [44] [45] Nice features: [46] Both single- and double-quotes are handled (thanks, Zark!) [47] Searches for system names (such as io) are automatically case-insensitive [48] [49] Outstanding issues: [50] Search for '2' should not match '1E2' [51] Search for 'if' should match "':if' wi 'Create' 'Image'" [52] Search for 'if' should not match ':if a>b' [53] Search for ':if' should be automatically case-insensitive [54] [55] 15 Dec 1987 Rex Swain, Independent Consultant [56] 19 May 1988 Detect and display changed function names [57] 16 May 1991 Erase old version when fn name changed [58] 27 Aug 1993 Added (ignore case) option [59] 26 Nov 1994 Adapted for Dyalog APL/W, added # and ## and  options [60] 29 Dec 1998 Adapted for APL+Win 3.0, removed # and ## and  options [61] 10 Nov 1999 Added colon as leading identifier char for APL+Win [62] 18 Nov 1999 Added case-insensitive treatment for APL+Win key names [63] 03 Dec 2001 Removed colon -- it can OPTIONALLY begin an identifier [64] 04 Apr 2003 Report total number of hits [65] 18 May 2003 Added ~ feature [66] 14 May 2004 Added ? feature [67] 29 Aug 2004 Added * feature [68] 26 Mar 2005 Evlevel-neutral (sigh) [69] 11 Jul 2005 Use QC (derived from Zark's ParseVR) to handle ' and " quotes [70] 21 Jul 2005 Created CMDFNREPL from fnrepl [71] 07 Oct 2005 Fixed FILT bug -- H>QC should be H^QC ! [72] 06 Feb 2006 Added multiple target feature [73] 04 Mar 2006 Added option [74] 18 Dec 2006 Most recent update [75] [76] AENLIST A arg might be numeric in development mode [77] [78] ADLTB A user command may pass in leading/trailing blanks [79] [80] :if A'' [81] 'For help, see' [82] ' ]fnrepl ?' [83] 0 [84] :end [85] [86] Allow simple word search without delimiters [87] If arg is 'foo', make it '/foo'; if arg is 'foo/xx' make it '/foo/xx' [88] E1A first delimiter [89] :if E'1234567890abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ' [90] E'/' [91] AE,A [92] :end [93] Allow no trailing delimiter for search with no options [94] If arg is '/foo', make it '/foo/' [95] :if 1=+/A=E [96] AA,E [97] :end [98] [99] Parse argument [100] [101] G0 '' targets [102] S0 '' functions [103] [104] :repeat [105] D1A delimiter [106] A1A [107] IAD find second delimiter (might not be one) [108] :if I=1 [109] 'Empty target string is not a good idea' [110] 0 [111] :end [112] G( (I-1)A),G target (note we accumulate them right to left) [113] ADLB IA [114] P1A function or option [115] :if ~P'<=>^&' [116] :leave [117] :end [118] P('^',P)['&'P] [119] ADLB 1A [120] :if '~'=1A [121] PP,'~' [122] ADLB 1A [123] :end [124] S( P),S function and possible ~ [125] :if A'' [126] 'Multiple target syntax error' [127] 0 [128] :end [129] :end [130] [131] DFIRST G number of targets [132] [133] :if D>1 multiple targets? [134] FA options (old left argument) [135] p0 not replace mode [136] S'',S to save repeated (J-1)S below [137] :else one target [138] P1(1,E=A) PENCLOSE E,A note we look for original first delimiter [139] NFIRST P [140] :if N>2 [141] 'Argument should have 2 or 3 delimiters' [142] 0 [143] :end [144] pN=2 replace mode? [145] :if p [146] (r F)P replacement string, options [147] hFIRST r need this repeatedly [148] d(FIRST 1G)-h length difference (scalar for :select :case) [149] :else find mode [150] F1P options [151] :end [152] :end [153] [154] Define FILT for APL/quoted strings/comments [155] [156] Z''''F [157] Z[2]Z[2]'"'F [158] Z2Z [159] E~Z0 8 not all or none: we need to filter [160] [161] :if E unless all or none [162] L "rQC v;c;i;n;p;q;s;t;u;x;z;IO" [163] LL, " Quotes and Comments" [164] LL, " Right arg is a VR" [165] LL, " Result is a boolean vector with 0's marking all quoted strings and comments" [166] LL, " Extracted from Zark's ParseVR" [167] LL, " 21 Mar 2002 Rex Swain, Independent Consultant, www.rexswain.com" [168] LL, "IO0 origin 0 is convenient" [169] LL, "xvTCNL,'''""' important delimiters" [170] LL, "sx/v just those important chars" [171] LL, "ns=TCNL flag newlines" [172] LL, "qc(s)0 to flag quotes/comments" [173] LL, "i0,n/n inds of chars last evaluated" [174] LL, "p(i)TCNL and what those chars were" [175] LL, "ss,TCNL include an all-done newline" [176] LL, "L1:" [177] LL, "ii+1 examine next char" [178] LL, " Omit those starting a new line:" [179] LL, "zs[i]" [180] LL, "tTCNLz" [181] LL, "(0t)L2 skip if none" [182] LL, "(i p z)t/i p z" [183] LL, "(0=z)/L5 exit if none left" [184] LL, "L2:" [185] LL, " Branch if no genuine comments:" [186] LL, "t(z='')^p=TCNL" [187] LL, "(1t)L3" [188] LL, " Flag and omit them:" [189] LL, "c[t/i]1" [190] LL, "(i p z)(~t)/i p z" [191] LL, "(0=z)/L5 exit if none left" [192] LL, "L3:" [193] LL, " Branch if no starting quotes:" [194] LL, "tp=TCNL" [195] LL, "(1t)L4" [196] LL, " Flag and record them:" [197] LL, "q[t/i]1" [198] LL, "(t/p)t/z" [199] LL, "L4:" [200] LL, "ttc' 2 = ' Quoted strings: not in comments [217] PP, 'rqc' 3 = ' = ' [218] PP, 'rqc' 4 = = ' [219] PP, 'r~q' 5 = = ~' [220] PP, 'r~c' 6 = ' = ~ [221] LL,P[Z] [222] KFX[2]L QC [223] :end [224] [225] L 'RFILT' [226] LL, ' Raw hit filter' [227] LL, ' V=VR, P=partition flags' [228] LL, 'R~P ANDSCAN V''[1234567890]''' not line numbers [229] LL,E/ 'RR^QC V' QC filter for ' [230] [231] KFX[2]L FILT ANDSCAN QC [232] [233] Define SYN for syntactic search [234] [235] Z''F non-syntactic search? [236] [237] Token alphabet: chars that can be anywhere in a token [238] a'._' Dilemma: period helps for numbers, but not PLUS.TIMES [239] a'_' [240] aa,'ABCDEFGHIJKLMNOPQRSTUVWXYZ' [241] aa,'abcdefghijklmnopqrstuvwxyz' [242] aa,'0123456789' [243] Token alphabet, including chars that can only begin a token [244] qa,'' [245] [246] Q 'HA SYN H;B;I' [247] QQ, ' Syntactic hit filter' [248] QQ, ' Requires: V=VR, a,q=alphabet' [249] QQ, 'IH/H' [250]  Note that if target starts with then we don't care what's to the [251] left of it, so ((1A)a) is correct. [252] QQ, ':if (1A)a' [253] QQ, ' H[(('' '',V)[I]q)/I]0' [254] QQ, ':end' [255] QQ, ':if (1A)q' [256] QQ, ' H[((V,'' '')[I+A]a)/I]0' [257] QQ, ':end' [258] :if Z=1 Neither? [259] Q1Q noop [260] :end [261] KFX[2]Q SYN a q [262] [263] Define UP for case-insensitive filter [264] [265] Z''F ignore case when finding target? [266] [267] :if ~/(ENLIST G)'abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ' [268] Noop if no letters in targets [269] KFX[2]'VUP V' ' noop' [270] :elseif Z [271] Q'abcdefghijklmnopqrstuvwxyz' [272] L'ABCDEFGHIJKLMNOPQRSTUVWXYZ' [273] uAV [274] u[uQ]L [275] KFX[2]'VUP V' 'Vu[AVV]' UP u [276] :else [277] m'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789_' mixed [278] u'ABCDEFGHIJKLMNOPQRSTUVWXYZABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789_' upper [279] Q 'VUP V;B;I;L;S' [280] QQ, ' Force APL+Win keyword names to upper case' [281] QQ, ' In APL+Win, quad and control-structure names are case insensitive!' [282] QQ, ' RHS 11/18/99' [283] QQ, '' [284] QQ, 'BV'':'' find key symbols' no! -- see comments below [285] QQ, 'BV'''' find key symbols' [286] QQ, '(1B)0 quit if none' [287] QQ, '' [288] QQ, 'LVm flag all letters (any case)' [289] QQ, 'BB>10,L flag symbols preceded by a non-letter' [290] QQ, 'BL^10,B flag letters preceded by a symbol preceded by a non-letter' [291] QQ, '(1B)0 quit if none' [292] QQ, '' [293] QQ, 'SL10,L letter state changes (S next L)' [294] QQ, 'IS/B flag those which are candidates' [295] QQ, 'IS\I10,I name start-stop flags for \ (S S\ next I)' [296] QQ, 'I\I name mask' [297] QQ, 'II/I indices' [298] QQ, '' [299] QQ, 'V[I]u[mV[I]] translate' [300] KFX[2]Q [301] RHS 3/19/01 [302] V':' causes trouble for things like ':fMain' wi ... [303] when searching for 'fMain'. [304] List of keywords? No, could have ':end' wi 'New' ... [305] I think we need to upper-case just the part of the vr [306] RHS 2/06/06 [307] I often search for fappend or io. [308] I cannot recall EVER having searched for :repeat. [309] So let's not worry about control structure keywords. [310] :end [311] [312] GUPG targets to uppercase, if appropriate [313] A1G last (and typically only) target [314] [315] Options setup [316] [317] R''F suppress display, just return result? [318] X0 '' initialize result [319] [320] T'~'F all but named fns? [321] y''F auto reply Yes to replacement confirmation prompt? [322] [323] i'?'F interactive prompt mode? [324] :if i^~p [325] 'Prompt mode "?" is only useful in replace mode' [326] 0 [327] :end [328] [329] g''F global fn matching? [330] :if g^D=1 [331] 'FYI, the option has no effect with just one target string' [332] g0 [333] :end [334] [335] Strip flags from function list [336] [337] E'*'F any function name wildcards? [338] F(~F'''~?^')/F note we do not remove asterisk [339] FWords F [340] [341] Default to all fns [342] [343] :if T^0=F [344] 'Tilde with no names means "not all functions"' [345] 0 [346] :end [347] [348] :if ET0=F [349] [350] You could have a global function that is localized but undefined [351] IDLIST 1+2+8 will not pick up that name, so... [352] [353] NSINL [354] N(~N[;1]'><')N no local names at these levels [355] N(,\N=' ')/,N discard FOO[3], keep names to the right [356] NWords N all localized names [357] NN~ ,'*' the asterisk next to suspended fn is not a name [358] N(''FIRSTN)/N avoid picking up system vars (UCMD2 localizes PW and CT) [359] [360] MIDLIST 1+2+8 all visible names [361] MWords M [362] MM,N add all localized names [363] M((MM)=M)/M there might be dups [364] [365] N,SI [366] N(1+N'[')N name of self RHS 8/31/99 [367] MM~ N remove self [368] [369] PIDLOC [2]M what are they [370] PP[;0P] global definition [371] M(P=1)/M functions only [372] [373] Now we have all global functions (though some could be shadowed) [374] [375] :if 0=F [376] FM [377] :elseif E which implies 0F [378] :while '*'ENLIST F [379] P('*'F)1 [380] UPF [381] [382] VM indices of matches [383] C' ',M,' ' candidates [384] U('*'=1U)' ',U,('*'=1U)' ' [385] :for L :in '*' Words U [386] BC SS L [387] H/B [388] C((H/B)1)H/C [389] VH/V [390] :if V  :leave  :end [391] :end [392] CM[V] [393] [394] F((P-1)F),C,PF [395] :end [396] F((FF)=F)/F in case wildcards picked up dup fns [397] :end [398] :if T [399] FM~F [400] :end [401] :end [402] [403] Discard invalid names [404] [405] CNC [2]F [406] :if 4C [407] N(C=4)/F [408] '*** Not searched, invalid name',(1=N)'s:',N [409] F(C4)/F [410] :end [411] [412] Discard shadowed names [413] [414] LIDLOC [2]F what are names [415] L0 1L disregard global level [416] CL^.=1 [417] :if 0C [418] N(~C)/F [419] '*** Shadowed:',N [420] FC/F [421] :end [422] [423] Discard non-functions [424] [425] C3=NC [2]F [426] :if 0C [427] N(~C)/F [428] '*** Not function',(1=N)'s:',N [429] FC/F [430] :end [431] [432] Discard locked functions [433] [434] KEX 'L' [435] KFX [2] 'RL F' "R0first CRL F,'[0]'" L [436] CLF yuck, but I wanted to get this check out of the function loop [437] KEX 'L' [438] :if 0C [439] N(~C)/F [440] '*** Locked function',(1=N)'s:',N [441] FC/F [442] :end [443] [444] NF how many fns [445] :if 0=F [446] '*** No functions to search!' [447] 0 [448] :end [449] [450] :if p [451] :andif ~y [452] 'Sure you want to search ',(N),' function',(N=1)'s and replace "',A,'" with "',r,'" ? ' [453] ARBOUT '' an oldie but a goodie [454] (/'Yy')0 default is No [455] :end [456] [457] VDLTB WSID [458] :if V'' [459] V'CLEAR WS' [460] :end [461] [462] 'Searching ',(N),' function',(N=1)'s in ',V,' ...' [463] [464] WGIVE 0 let that message display [465] [466] T0 accumulate hits [467] E0 accumulate lines [468] U0 accumulate functions [469] [470] :for N :in F inspect next function [471] [472] VVR N [473] LUP V [474] [475] Search VR [476] [477] HL SS A the heart of the matter [478] [479] :if D=1 single target? [480] :andif ~1H no raw hits? [481] :continue next function [482] :end [483] [484] Syntactic filter [485] [486] HA SYN H V a q [487] [488] :if D=1 single target? [489] :andif ~1H no more hits? [490] :continue next function [491] :end [492] [493] Filter for APL / quoted strings / comments [494] [495] P1,1V SS TCNL,'[' partition on "[" (with trailing CRs); force header line [496] P[5+V]1 force end of last line [497] [498] IFILT P V ANDSCAN [499] HH^I [500] [501] :if D=1 single target? [502] :andif ~1H no more hits? [503] :continue next function [504] :end [505] [506] :if D>1 multiple targets [507] HP ORRED H shift hits to leading "[" [508] We have already done the last target; now step through the others [509] Note that they are in reverse order so functions work like APL [510] :if g [511] t/H [512] :for J :in 1D [513] WL SS JG raw search [514] WW^I FILT [515] WP ORRED W shift hits to leading "[" [516] HWH lines to show [517] t'(/W)',(JS),'t' apply function [518] :end [519] :if ~t no hits? [520] :continue next function [521] :end [522] :else [523] :for J :in 1D [524] WL SS JG raw search [525] W(JG) SYN W SYN [526] WW^I FILT [527] WP ORRED W shift hits to leading "[" [528] H'W',(JS),'H' apply function [529] :end [530] :if ~1H no hits remaining? [531] :continue next function [532] :end [533] :end [534] Note that when D>1, H flags lines not hits [535] :end [536] [537] Got some hits; if interactive mode, confirm them [538] [539] :if i interactive replace mode? [540] '==> ',N,' (',(+/H),')' name of function, total hits [541] M1+P/P partition starts [542] L1+(1M,1+V)-M partition lengths [543] :for C :in H/H hit starting positions [544] B+/C>M [545] N,V[M[B]+L[B]] [546] (((N)+1+C-M[B])' ') , ((A)'') , ' replace? [Y] ' [547] ARBOUT '' an oldie but a goodie [548] H[C]~/'Nn' default is Yes [549] :end [550] :if ~1H no hits remaining? [551] :continue next function [552] :end [553] :end [554] [555] Got some hits; now display, or replace and then display [556] [557] :if p replace mode? [558] [559] LH/H hit starting positions [560] CL how many hits [561] M(C,h)r replacements [562] [563] Replace, depending on length difference [564] [565] :select d [566] :case 0 replacement is same length as target [567] V[L.+1+h]M [568] :case 1 replacement is longer than target [569] LL+(d)1+C [570] B((V)+Cd)1 [571] B[L.+d]0 [572] VB\V [573] V[L.+1+h]M [574] HB\H [575] PB\P [576] :case 1 replacement is shorter than target [577] H1H move hits left so not deleted [578] V[L.+1+h]M [579] B(V)1 [580] B[L.+h+1+d]0 [581] VB/V [582] HB/H [583] PB/P [584] :end [585] [586] Redefine function [587] [588] QDEF V [589] :if ~QN function name changed? [590] :if 0=10Q [591] APL+Win: Q is error code, line number [line 1 = header!] [592] '*** DEFN ERROR on ',N,': ',Q [593] 1((+\P)=Q[2])/V [594] :continue [595] :end [596] KEX N erase old version [597] '* Warning: name of ',N,' has been changed to ',Q [598] NQ [599] :end [600] [601] :end [602] [603] Ready to display hits [604] [605] :if D=1 [606] TT++/H accumulate total hits [607] EE++/P ORRED H accumulate lines with hits [608] :else [609] EE++/H accumulate lines with hits [610] :end [611] [612] UU+1 accumulate functions with hits [613] XX, N add function name to result [614] [615] :if R if result-only mode [616] :continue next function [617] :end [618] [619] Display hits [620] [621] '==> ',N,' (',(+/H),')' name of function, total hits [622] [623] :if i interactive replace mode? [624] :continue next function [625] :end [626] [627] :if D=1 [628] HP ORRED H any hits per line? [629] :end [630] [631] HH/H line numbers to display (origin 1) [632] PP/P partition starts [633] L(1P,1+V)-P partition lengths [634] PP[H]-1 compensate for + with IO1 [635] LL[H]-1 not incl trailing CR [636] WH number of lines with hits [637] :for B :in W [638] APL+Win: Show fn name too so can double-click to edit at that line [639] N,V[P[B]+L[B]] faster than take/drop approach [640] :end [641] WGIVE 0 allow display [642] [643] :end next function [644] [645] :if D=1 [646] '==> Totals: ',(T),' hit',(T=1)'s on ',(E),' line',(E=1)'s in ',(U),(-U=1)' functions' [647] :else [648] '==> Total: ',(E),' line',(E=1)'s in ',(U),(-U=1)' functions' [649] :end [650] [651] R0 quit if result-only mode [652] [653] KEX 'X' [654] 2@2u CMDFNSS N [1] )fns string search [2] Syntax: [3] ]FNSS foo find function names containing substring foo [4] Use semicolons to delimit multiple names and to retain leading/trailing blanks [5] ]FNSS ; foo names beginning with foo [6] ]FNSS foo ; names ending with foo [7] ]FNSS ; foo ; names matching foo [8] ]FNSS foo;goo names containing foo or goo [9] Options: [10] /C case-sensitive [11] /N name matching -- shorthand for ]FNSS ; Foo ; /c [12] /M return a matrix (display in a one-column list) [13] 23 Nov 2002 Rex Swain, Independent Consultant, www.rexswain.com [14] 09 Mar 2004 Added /M option [15] [16] 1 NLSS N 2.. L CMDKEYS A;D;F;H;I;K;M;P;V;c;d;i;j;k;m;s;w [1] Displays a list of APL+Win keyboard shortcuts [2] See ATN401.DOC for info on some of these [3] Also shows keys that have an APL Tool assigned [4] [5] You can assign an APL tool to override some standard Windows keys (eg Alt+F4) [6] But some keys cannot be overridden (eg Alt+Tab) [7] [8] 20 Jun 2005 Rex Swain, Independent Consultant, www.rexswain.com [9] [10] To do: Filter by string in Edit box [11] [12] (NC 'L')L1 L any left arg means callback [13] [14] K0 5 [15] Alt Ctrl Shift Key Default [16] [17] KK0 0 0 'F1' 'Help' [18] KK0 0 0 'F2' 'Jump to next bookmark' [19] KK0 1 0 'F2' 'Bookmark toggle' [20] KK0 0 1 'F2' 'Jump to previous bookmark' [21] KK0 1 1 'F2' 'Remove all bookmarks' [22] KK0 0 0 'F3' 'Repeat find' [23] KK0 0 1 'F3' 'Repeat find backward' [24] KK0 1 0 'F3' 'Find current selection' [25] KK0 1 1 'F3' 'Find current selection backward' [26] KK1 0 0 'F3' 'Find dialog (same as Ctrl+F)' [27] KK0 0 0 'F4' '' [28] KK1 0 0 'F4' 'End APL session' [29] KK0 0 0 'F5' 'Run [CW]' [30] KK0 1 0 'F5' 'Set next statement [CW]' [31] KK0 0 0 'F6' '' [32] KK0 1 0 'F6' 'Next window' [33] KK0 1 1 'F6' 'Previous window' [34] KK0 0 0 'F7' '' [35] KK0 1 0 'F7' 'Run to cursor or below [CW]' [36] KK0 1 1 'F7' 'Run to cursor [CW]' [37] KK0 0 0 'F8' '' [38] KK0 0 0 'F9' 'Recall previous line backward' [39] KK0 0 1 'F9' 'Recall previous line forward' [40] KK0 1 0 'F9' 'Recall line dialog' [41] KK1 0 0 'F9' 'Jump to previous executed line' [42] KK1 0 1 'F9' 'Jump to next executed line' [43] KK0 0 0 'F10' 'Step to next statement [CW]' [44] KK0 0 1 'F10' 'Step to next line [CW]' [45] KK0 1 0 'F10' 'Step over by primitive [CW]' [46] KK0 0 0 'F11' 'Step into function [CW]' [47] KK0 0 1 'F11' 'Step out of function [CW]' [48] KK0 1 0 'F11' 'Step into by primitive [CW]' [49] KK0 0 0 'F12' 'Copy code to APL session [CW]' [50] KK0 1 0 'F12' 'Edit pending function' [51] [52] KK0 1 0 'A' 'Select all' [53] KK0 1 1 'A' ')SAVE As dialog' [54] KK0 1 0 'B' 'Breakpoint set' I think that's an error [55] KK0 1 0 'C' 'Copy' [56] KK0 1 1 'C' ')COPY dialog' [57] KK0 1 1 'D' ')DROP dialog' [58] KK0 1 0 'E' 'End and save edit' [59] KK0 1 0 'F' 'Find dialog' [60] KK0 1 0 'G' 'Get (Fetch dialog)' [61] KK0 1 1 'G' 'Gather selected executed lines to clipboard' [62] KK0 1 0 'J' 'Jump dialog' [63] KK0 1 1 'J' 'Jump to column dialog' [64] KK0 1 0 'K' 'Show/hide Code Walker' [65] KK1 1 0 'K' 'Show/hide code window [CW]' [66] KK0 1 1 'K' 'Show/hide state indicator window [CW]' [67] KK0 1 0 'L' 'Localize toggle' [68] KK0 1 1 'L' ')LOAD dialog' [69] KK0 1 0 'M' 'Match paren/quote/bracket' [70] KK0 1 1 'M' 'Match paren/quote/bracket and select' [71] KK0 1 0 'N' 'New edit' [72] KK0 1 0 'O' 'Open edit dialog' [73] KK0 1 1 'O' 'Open edit session on object at caret' [74] KK0 1 0 'P' 'Print dialog' [75] KK0 1 1 'P' ')PCOPY dialog' [76] KK0 1 0 'Q' 'Quit edit' [77] KK0 1 0 'R' 'Replace dialog' [78] KK0 1 1 'R' ')CLEAR dialog' [79] KK0 1 0 'S' 'Save edit' [80] KK0 1 0 'T' 'Toggle edit and session' [81] KK0 1 0 'V' 'Paste' [82] KK0 1 0 'W' 'Watchpoints dialog' [83] KK0 1 0 'X' 'Cut' [84] KK0 1 0 'Z' 'Undo' [85] [86] KK0 1 0 '' 'Scroll down without moving caret' [87] KK0 1 1 '' 'Move the cursor line to the bottom of the page' [88] KK0 1 0 '' 'Scroll up without moving caret' [89] KK0 1 1 '' 'Move the cursor line to the top of the page' [90] KK0 1 1 'End' 'Select from caret to end' [91] KK1 0 1 'End' 'Erase from caret to end of session log' [92] KK0 1 1 'Home' 'Select from caret to beginning' [93] KK0 1 0 'PgDn' 'Scroll left' [94] KK0 1 0 'PgUp' 'Scroll right' [95] KK0 0 0 'Tab' 'Insert tab indent' [96] KK0 0 1 'Tab' 'Remove tab indent' [97] KK0 1 0 'Tab' 'Next window' [98] KK0 1 1 'Tab' 'Previous window' [99] KK1 0 0 'Tab' 'Next application [XX]' [100] KK0 1 0 'Space' 'Insert space indent' [101] KK0 1 1 'Space' 'Remove space indent' [102] KK1 0 0 'Bksp' 'Undo (same as Ctrl+Z)' [103] KK0 0 1 'Del' 'Cut (same as Ctrl+X)' [104] KK0 0 1 'Ins' 'Paste (same as Ctrl+V)' [105] KK0 1 0 'Ins' 'Copy (same as Ctrl+C)' [106] KK0 1 0 'Enter' 'Insert line in session (without execution)' [107] KK0 1 1 'Enter' 'Move the cursor line to the middle of the page' [108] KK0 1 0 '/' 'Insert lamp' [109] KK0 1 1 '/' 'Remove lamp' [110] KK0 1 0 '+' 'Increase font size' [111] KK0 1 1 '+' 'Decrease font size' [112] KK0 1 0 '.' 'Stop toggle' [113] KK0 1 0 ',' 'Trace toggle' [114] KK0 1 1 '.' 'Stop remove' [115] KK0 1 1 ',' 'Trace remove' [116] [117] KK0 1 0 'Num *' 'Top of stack [CW]' [118] KK0 1 0 'Num -' 'Up one stack level [CW]' [119] KK0 1 0 'Num +' 'Down one stack level [CW]' [120] KK0 1 0 'Num /' 'Bottom of stack [CW]' [121] [122] K[;4],K[;4] else Listview has a fit [123] [124] k [2] K[;4] [125] Assert (kk)^.=k no dups [126] [127] [Tools] [128] Command1=0 inbuf ')edit ',((,1[io]si)~'*'),tcnl [129] MenuItem1=&Edit Suspended Function F11 [130] Command2=)RESET [131] MenuItem2=Quit &All Suspended Functions F4 [132] Command3=)edit [133] MenuItem3=Edit &Current Object F5 [134] [135] For case-insensitive match below [136] dK[;4] [137] d[;4]UCASEd[;4] [138] d [2] d [139] [140] KK, '' [141] [142] s0 0 0 '' [143] :for i :in 32 [144] mwcall 'W_Ini' ('[Tools] MenuItem',i) [145] :if m'' [146] :leave [147] :end [148] cwcall 'W_Ini' ('[Tools] Command',i) [149] mDEB m [150] k(^\m' ')/m last word 'ctrl+f9' [151] w(^\k'+')/k word after last + 'f9' [152] (1w)UCASE 1w mixed -- this works unless PgUp or TAB [153] kUCASE k upper all for matching [154] s[1]/k SS 'ALT+' [155] s[2]/k SS 'CTRL+' [156] s[3]/k SS 'SHIFT+' [157] s[4] UCASE w [158] Is it really a key? [159] :if /3s [160] :orif ('F'=1w)^(1FI 1w)12 [161] m(-1+k)m [162] m0 WinAmps m [163] jd s [164] :if jd [165] K[j;6] m [166] display K[j;] [167] :else [168] KK(3s),w '' m [169] display (3s),w '' m [170] :end [171] :end [172] :end [173] [174] Create the form [175] [176] Get value of key K from APLW.INI section [UCMDSREX]; default to d [177] erase 'I' [178] kfx [2] 'vk I d;z' "vwcall 'W_Ini' ('[UCMDSREX] ',k)  (v'')0  vd" I [179] [180] wFI 'Keys-Where' I '4 10 20 78' [181] [182] wself'fmKeys' wi 'Create' 'Form' 'Close' [183] wi 'caption' 'Keys' [184] wi 'where' w [185] wi 'limitwhere' 8 20 [186] wi 'onResize' '0 CMDKEYS wevent' [187] wi 'onClose' '0 CMDKEYS wevent' [188] [189] wself':mFile' wi 'New' 'Menu' ('caption' '&File') [190] k'.mExit' wi 'New' 'Menu' ('caption' 'E&xit') ('onClick' 'k":" wi "Close"') ('shortcut' 27 0) [191] [192] wself':mEdit' wi 'New' 'Menu' ('caption' '&Edit') [193] k'.mCW' wi 'New' 'Menu' ('caption' 'Remove code &walker keys') ('onClick' '0 CMDKEYS "CW"') ('shortcut' 'W' 2) [194] k'.mCopy' wi 'New' 'Menu' ('caption' '&Copy list to clipboard') ('onClick' '0 CMDKEYS "Copy"') ('shortcut' 'C' 2) [195] [196] Get value of key k; if undefined, write default to the ini file [197] kfx [2] ( [2] cr 'I'), "zwcall 'W_Ini' ('[UCMDSREX] ',k,'=',d)" I [198] [199] wself':lv' wi 'New' 'Listview' ('style' 1 2 4 4096) 4096=gridlines [200] [201] This allows user to type a letter to jump in the Key column [202] d0 5 4=col id (ptr into list), 5=col order [203] dd'Key' 2 'left' 5 5 [204] dd'A' 2 'left' 1 1 [205] dd'C' 2 'left' 2 2 [206] dd'S' 2 'left' 3 3 [207] dd'Shifts' 20 'right' 4 4 [208] dd'Default' 30 'left' 6 6 [209] dd'Tool' 30 'left' 7 7 [210] [211] wi 'columndisplay' d [212] [213] wi 'font' 'APLFONT' 11 0 'default' [214] F 'FontName' I 'APLFONT' [215] FF,FI 'FontSize' I '11' [216] FF,FI 'FontStyle' I '0' [217] FF, 'FontCharset' I 'default' [218] wi 'scale' 3 font size will be specified in points [219] wi 'font' F [220] [221] MK[;1 1 1 1 4 5 6] [222] M[;1]K[;1]'A' [223] M[;2]K[;2]'C' [224] M[;3]K[;3]'S' [225] M[;4]((4K[;1]) 'Alt+') , ((5K[;2]) 'Ctrl+') , ((6K[;3]) 'Shift+') [226] [227] wi 'list' (0,1,M) [228] [229] wi 'onColClick' '0 CMDKEYS "Sort"' [230] wi 'onDblClick' '0 CMDKEYS "Detail"' [231] wi 'onOpen' "wi 'AutoFit' 'header' 'all'" [232] wi 'onKeyPress' '0 CMDKEYS wevent' [233] [234] wself':' [235] kwi 'Wait' [236] wi 'Delete' [237] 0 [238] [239] L1: [240] [241] :SELECT A [242] [243] :CASE 'Resize' [244] [245] ':lv' wi 'where' (0 0,2warg) [246] [247] :CASE 'Sort' [248] [249] Dwi 'sortorder' current order [250] Ifirst warg column number [251] M[2] ,wi 'GetCells' D I the data [252] F( I,3)wi 'columndisplay' justification [253] :if I=5 Key [254] IAVM ascending order [255] L11=+/M[I;]' ' first, one-letter keys [256] LL+(M[I;1]='F')FI ,'0',0 1M[I;],' ' second, function keys, in numeric order [257] LL+99L=0 then the rest [258] II[L] [259] :elseif F'right' numeric column? [260] M(-+/^\M=' ')M RJUST [261] IAVM descending [262] :else text column [263] IAVM ascending order [264] :end [265] [266] :if II  II  :end reverse sort [267] [268] wi 'sortorder' (D[I]) reset the sortorder [269] [270] :CASE 'KeyPress' [271] [272] :if warg=13 Enter key? [273] 0 CMDKEYS 'Detail' [274] :end [275] [276] :CASE 'Close' [277] [278] Set value of key k in APLW.INI section [UCMDSREX] [279] Kfx [2] 'k I v;z' "zwcall 'W_Ini' ('[UCMDSREX] ',k,'=',v)" I [280] [281] 'Keys-Where' I wi 'where' [282] [283] :CASE 'CW' [284] [285] wi 'enabled' 0 [286] [287] wself':lv' [288] Dwi 'sortorder' row order [289] Mwi 'GetCells' D (7) [290] P/M[;6] SS '[CW]' [291] wi 'SetCells' (P/D) 6 ((+/P) '') [292] Don't delete if a Tool is defined [293] PP^M[;7] '' [294] Or if it's an unshifted F key [295] PP>('F'=enlist 1M[;5])^((enlist 11M[;5])'123456789')^M[;4] '' [296] wi 'DeleteRows' (P/D) [297] [298] :CASE 'Copy' [299] [300] wself':lv' [301] Dwi 'sortorder' row order [302] Lwi 'columndisplay' [303] Mwi 'GetCells' D (1L) the data [304] ML[L[;5];1]M add column headings, in column order [305] MTCHT,M [306] MM, TCNL,TCLF [307] Venlist 1enlistsplit M [308] VAV2ANSI[AVV] [309] Hwcall 'GlobalAlloc' 'GMEM_MOVEABLE' (1+first V) [310] error (H=0)/'Unable to allocate memory for copy' [311] Pwcall 'GlobalLock' H [312] error (P=0)/'Unable to lock memory for copy' [313] Kwcall 'W_Mem' (P,0,1, V,tcnul) [314] Kwcall 'GlobalUnlock' H [315] w'#' wi 'hwndmain' [316] error (0=wcall 'OpenClipboard' w)/'Clipboard busy' [317] Kwcall 'EmptyClipboard' [318] Kwcall 'SetClipboardData' 'CF_TEXT' H [319] Kwcall 'CloseClipboard' [320] [321] :ELSE [322] [323] '*** Unanticipated CMDKEYS case: ',A [324] [325] :END 2EE RL CMDMF A;D;F;I;K;M;N;O;T;h;p;v;w;WSELF [1] Displays MF timing information [2] ]MF show summary for entire ws [3] ]MF foo go directly to details on foo [4] ]MF /ON turn on monitoring for all fns (reset if already on) [5] ]MF /OFF turn off monitoring for all fns [6] Click on report column headings to sort; click again to reverse [7] Double-click (or Enter) summary report row to see function detail [8] [9] Inspired by CMDWSTIME from APL2000 [10] [11] 23 Jun 2003 Rex Swain, Independent Consultant, www.rexswain.com [12] 19 Jul 2003 ColClick sorts numeric columns in descending order first [13] 27 Jul 2003 Correct SI/IDLOC alignment [14] 25 Sep 2004 Use font settings in APLW.INI [UCMDSREX] [15] 17 Jan 2005 EVLEVEL neutral [16] 18 Jan 2005 Added Edit/Copy [17] 16 May 2005 Commented out Print -- ]wprint doesn't work with 'scale' 3 [18] [19] (NC 'L')L1 L any left arg means callback [20] [21] Aenlist A arg could be numeric in development mode ? [22] [23] :if 1=A GETOPT '/ON' [24] O1 [25] :elseif 1=A GETOPT '/OFF' [26] O0 [27] :else [28] O1 [29] :end [30] [31] ADEB (^\A'/')/A delete all options [32] [33] Roy says: MF 3 seems to introduce more noise than repeatability. [34] It also makes MF 1 return slightly inconsistent results from execution to [35] execution. Using MF 2 saves me from capturing it just once and saving it. [36] [37] MF 3 use CPU clock rate timer, based on the Pentium Read Time Stamp Counter [38] MF 2 use high resolution timer, based on the Win32 QueryPerformanceCounter() API [39] [40] Harder than it should be: Find names of all non-localized functions [41] [42] FSI[;1] first column of SI [43] F(~F'><')/F ditch SI levels that don't have matching IDLOC columns [44] TF']' how much UCMD crap is there [45] TT*TF or 1 if no ] (non-UCMD) [46] [47] Sidebar: If function name given, go straight to the details [48] [49] :if ~A'' [50] DNC A NC tolerates bad names [51] :if 4D [52] :orif 10)M [241] :else unhide lines [242] Mwi 'list' get old list [243] :end [244] wi 'list' M [245] [246] :CASE 'Res' [247] [248] This works for both Forms (and Listviews) [249] (1=wi 'value')0 already checked? [250] (wi 'siblings')wi 'value' 0 turn off all checks [251] wi 'value' 1 turn my check on [252] [253] Dwi 'caption' [254] D(^\DTCHT)/D ditch possible shortcut [255] DD~'&' ditch possible key [256] [257] ':mRes' wi 'caption' ('&Resolution (',D,')') [258] [259] T1=':mView.mHide' wi 'value' hide zero lines? [260] [261] wself':lv' [262] [263] :if T [264] Mwi 'list' [265] :else [266] Mwi 'list' [267] :end [268] [269] DFI enlist M[;2+8]  M[;2+2](D L) CMDMF 'FmtTicks' [270] DFI enlist M[;2+9]  M[;2+3](D L) CMDMF 'FmtTicks' [271] [272] :if T hide zero lines [273] wi 'list' M [274] M(D>0)M [275] :end [276] [277] wi 'list' M [278] wi 'AutoFit' 'header' 2 3 [279] [280] :CASE 'FmtTicks' [281] [282] (T F)L raw ticks, format [283] :select F [284] :case 1 raw ticks [285] RSPLIT 'CI19' FMT T [286] :case 2 milliseconds [287] R3TMF 1 [288] :case 3 seconds [289] RSPLIT 'G' FMT 0 100 100 10000 60 60 1000 0.5+TMF 1 [290] :else tilt [291] 0 [292] :end [293] ((T<0)/R) '' missing data [294] RR~' ' DLB [295] [296] :CASE 'Resize' [297] [298] This works for both Forms (and Listviews) [299] ':lv' wi 'where' (0 0,2warg) [300] [301] :CASE 'Sort' [302] [303] This works for both Listviews [304] Dwi 'sortorder' current order [305] Ifirst warg column number [306] M[2] ,wi 'GetCells' D I the data [307] F( I,3)wi 'columndisplay' justification [308] :if F'right' numeric column? [309] M(-+/^\M=' ')M RJUST [310] IAVM descending [311] :else text column [312] IAVM ascending order [313] :end [314] [315] :if II  II  :end reverse sort [316] wi 'sortorder' (D[I]) reset the sortorder [317] [318] :CASE 'KeyPress' [319] [320] :if warg=13 Enter key? [321] 0 CMDMF 'Detail' [322] :end [323] [324] :CASE 'Detail' [325] [326] wself':lv' [327] Ifirst wi 'value' selected row [328] :if I=0 [329] Ifirst wi 'sortorder' first in list [330] (I=0)0 [331] :end [332] Ffirst wi 'GetCells' I 1 function name [333] DMF F [334] :if 0D [335] Kwcall 'MessageBeep' 0 ding [336] 0 [337] :end [338] F D CMDMF 'FnDetail' [339] [340] :CASE 'FnDetail' [341] [342] (F D)L function name, MF data [343] Nfirst D [344] M(N,9) '' 9 cols, like summary form [345] We want these to sort correctly, so we don't left-justify them like VR does [346] T'<',F,'[>,Q<]>I',1+N-1 here's a technique from the old days [347] M[;1]split T FMT 1+N [348] M[1;1] F I prefer no [0] since these are totals [349] Time spent "here" on header line is negligible [350] Much more interesting is sum of time spent here on all lines [351] D[1;2]+/D[;2] [352] M[;4]D[;3] iterations [353] TVR F [354] M[;5]1(TTCNL) Partition T drop trailing line [355] M[;8]split 'I17' FMT D[;1] [356] M[;9]split 'I17' FMT D[;2] [357] [358] TF for caption [359] ((T='')/T)'+' [360] ((T='')/T)AV[249+IO] for a Form caption, that yields the plus-or-minus symbol [361] [362] Get value of key k from APLW.INI section [UCMDSREX]; default to d [363] erase 'I' [364] Kfx [2] 'vk I d;z' "vwcall 'W_Ini' ('[UCMDSREX] ',k)  (v'')0  vd" I [365] [366] wFI 'MFDetail-Place' I '3 15 24 70' [367] vFI 'MFDetail-Visible' I '1' [368] vv-v=2 1=normal 2=minimized 3=maximized; don't start minimized [369] [370] wself'fmMFDetail' wi 'Create' 'Form' 'Close' [371] wi 'caption' ('MF detail for function: ',T) [372] wi 'place' w [373] wi 'visible' v [374] wi 'limitwhere' 8 20 [375] wi 'border' 2 16 64 [376] wi 'onResize' '0 CMDMF wevent' [377] wi 'onClose' '0 CMDMF wevent' [378] wself':mFile' wi 'New' 'Menu' ('caption' '&File') [379] K'.mPrint' wi 'New' 'Menu' ('caption' '&Print...') ('onClick' '0 CMDMF "Print"') ('shortcut' 'P' 2) [380] K'.mSep1' wi 'New' 'Menu' ('separator' 1) [381] K'.mExit' wi 'New' 'Menu' ('caption' 'E&xit') ('onClick' 'K":" wi "Close"') ('shortcut' 27 0) [382] wself':mEdit' wi 'New' 'Menu' ('caption' '&Edit') [383] K'.mCopy' wi 'New' 'Menu' ('caption' '&Copy entire list to clipboard') ('onClick' '0 CMDMF "Copy"') ('shortcut' 'C' 2) [384] wself':mView' wi 'New' 'Menu' ('caption' '&View') [385] K'.mHide' wi 'New' 'Menu' ('caption' '&Hide lines with no time') ('onClick' '0 CMDMF "Hide"') ('style' 1) ('shortcut' 'H' 2) [386] wself':mRes' wi 'New' 'Menu' ('caption' '&Resolution') [387] K'.mRaw' wi 'New' 'Menu' ('caption' '&Raw Ticks') ('