Files.List tweak

Files.List tweak

:Namespace Files

⍝ Provides cover functions for many file operations
⍝ Eventually all will be implemented for both Windows and *nix

    (⎕IO ⎕ML)←1

    ∇ r←data Append name
     ⍝ Append data to existing file
      r←{(⎕NUNTIE ⍵)⊢data ⎕NAPPEND ⍵}Nopen name
    ∇

    ∇ r←text AppendText name;tn
     ⍝ Append text to existing file (must be single byte text)
      tn←Nopen name
      r←text ⎕NAPPEND tn(⎕DR' ')
      ⎕NUNTIE tn
    ∇

    ∇ (tn name)←{ext}CreateTemp folder;cnt
     ⍝ Create a temp file
     ⍝ folder - folder to create temp file in
     ⍝ ext - file extension
      :If 0=⎕NC'ext' ⋄ ext←'tmp' ⋄ :EndIf
      :If 0∊⍴ext ⋄ ext←'tmp' ⋄ :EndIf
      cnt←tn←0
      :Repeat
          name←folder,('/\'∊⍨¯1↑folder)↓'/',⎕A[?8⍴⍴⎕A],'.',ext
          :Trap 22 ⋄ tn←name ⎕NCREATE 0 ⋄ :EndTrap
          cnt+←1
      :Until (cnt>20)∨tn≠0
      'Unable to create temporary file'⎕SIGNAL tn↓22
    ∇

    ∇ {protect}Copy FmTo;CopyFileX;GetLastError ⍝ Copy file Fm -> To
      :Select APLVersion
      :Case '*nix'
          ∘
      :Case 'Win'
          :If 0=⎕NC'protect'     ⍝ Copy fails if <protect> and 'To' exists.
              protect←0          ⍝ Default unprotected copy.
          :EndIf
          'CopyFileX'⎕NA'I kernel32.C32∣CopyFile* <0T <0T I'
          :If 0=CopyFileX FmTo,protect
              ⎕NA'I4 kernel32.C32|GetLastError'
              11 ⎕SIGNAL⍨'CopyFile error:',⍕GetLastError
          :EndIf
      :EndSelect
    ∇

    ∇ Delete name;DeleteFileX;GetLastError;FindFirstFile;FindNextFile;FindClose;handle;rslt;ok;next;⎕IO;path
      ⎕IO←0
      :Select APLVersion
      :CaseList '*nix' 'Mac'
          _SH'rm -f ',unixfix name
      :Case 'Win'
          'DeleteFileX'⎕NA'I kernel32.C32∣DeleteFile* <0T'
          ⎕NA'I4 kernel32.C32|GetLastError'
          :If ∨/'*?'∊name ⍝ wildcards?
              path←{(⌽∨\⌽⍵∊'\/')/⍵}name
              _FindDefine
              handle rslt←_FindFirstFile name
              :If 0=handle
                  :Return ⍝ ('ntdir error:',⍕rslt)⎕SIGNAL 102      ⍝ file not found
              :EndIf
              :If '.'≠⊃6⊃rslt
                  {}DeleteFileX⊂path,6⊃rslt
              :EndIf
              :While 1=0⊃ok next←_FindNextFile handle
                  :If '.'≠⊃6⊃next
                      {}DeleteFileX⊂path,6⊃next
                  :EndIf
              :EndWhile
              :If 0 18∨.≠ok next
                  ('ntdir error:',⍕next)⎕SIGNAL 11   ⍝ DOMAIN
              :EndIf
              {}FindClose handle
          :Else
              :If 0=DeleteFileX⊂name
                  11 ⎕SIGNAL⍨'DeleteFile error:',⍕GetLastError
              :EndIf
          :EndIf
      :EndSelect
    ∇

    ∇ r←DirExists path
      r←0
      :Select APLVersion
      :CaseList '*nix' 'Mac'
          :Trap 11
              r←0<⍴_SH'ls -adl ',unixfix path
          :EndTrap
      :Case 'Win'
          r←{1≠⊃⍴⍵:0 ⋄ ⍵[1;4]}'.'List path
      :EndSelect
    ∇

    ∇ r←Exists name
     ⍝ Does file exist?
      r←1
      :Trap 22
          :Trap 19 ⍝ file access error means file exists
              ⎕NUNTIE(unixfix name)⎕NTIE 0
          :EndTrap
      :Else
          r←0
      :EndTrap
    ∇

    ∇ r←GetCurrentDirectory;GCD;GetLastError
     ⍝ Get Current Directory
      :Select APLVersion
      :CaseList '*nix' 'Mac'
          r←⊃_SH'pwd'
      :Case 'Win'
          'GCD'⎕NA'I kernel32.C32∣GetCurrentDirectory* I4 >0T'
          :If 0≠1⊃r←GCD 256 256
              r←2⊃r
          :Else
              ⎕NA'I4 kernel32.C32|GetLastError'
              11 ⎕SIGNAL⍨'GetCurrentDirectory error:',⍕GetLastError
          :EndIf
      :EndSelect
    ∇

    ∇ Chars←GetText name;nid;signature;nums;sz;b
     ⍝ Read ANSI or Unicode character file
      sz←⎕NSIZE nid←(unixfix name)⎕NTIE 0
      signature←⎕NREAD nid 83 3 0
      :If signature≡¯17 ¯69 ¯65 ⍝ UTF-8?
          nums←⎕NREAD nid 83 sz
          Chars←'UTF-8'⎕UCS 256|nums ⍝ Signed ints
      :ElseIf ∨/b←(2↑signature)∧.=2 2⍴¯1 ¯2 ¯2 ⍝ Unicode (UTF-16)
          Chars←{,⌽(2,⍨2÷⍨⍴⍵)⍴⍵}⍣(⊣/b)⎕NREAD nid 83 sz 2
          Chars←'UTF-16'⎕UCS(2*16)|163 ⎕DR Chars
      :Else ⍝ ANSI or UTF-8
          Chars←{11::⎕UCS ⍵ ⋄ 'UTF-8'⎕UCS ⍵}256|⎕NREAD nid 83 sz 0
      :EndIf
      ⎕NUNTIE nid
    ∇

    ∇ vtv←GetVTV name
     ⍝ Read ANSI or Unicode character file as vector of text vectors
      vtv←{1↓¨(v=n)⊂v←(n←⎕UCS 10),⍵}(GetText name)~⎕UCS 13
    ∇

    ∇ r←LikelyURL w
      →0↓⍨r←(⎕DR w)∊80 82
      r←{(0∊⍴⍵)<∧/⍵∊'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789%-._~:/?#[]@!$&''()*+,;='}w ⍝ identify likely URIs
    ∇

    ∇ r←{pattern}List path;z;rslt;handle;next;ok;attrs;⎕IO;FindFirstFileX;FindNextFileX;FindClose;FileTimeToLocalFileTime;FileTimeToSystemTime;GetLastError;isFile;filter;isFolder
    ⍝ path and pattern are related.
    ⍝ If there is no pattern (or pattern is empty)
    ⍝   If path ends with '/' or '\' then return information for the contents of the folder, otherwise, return information about the folder (or file) itself
    ⍝ If a non-empty pattern exists, it is used as a filter on the contents of path (path is treated as a folder name)
    ⍝ Examples:
    ⍝   List '/dir/foo'  ⍝ returns information about /dir/foo
    ⍝   List '/dir/foo/' ⍝ returns information about the contents of /dir/foo/
    ⍝   '*.dyalog' List '/dir/foo'  ⍝ returns information about the .dyalog files in /dir/foo/
    ⍝   List '/dir/foo/*.dyalog'    ⍝ also returns information about the .dyalog files in /dir/foo/

    ⍝ Information returned is:
    ⍝ [;0] Name [;1] Length [;2] LastAccessTime [;3] IsDirectory
      ⎕IO←0
      :If 0=⎕NC'pattern' ⋄ pattern←'' ⋄ :EndIf
      isFolder←'/\'∊⍨¯1↑path
      filter←''
      :If isFile←~0∊⍴pattern
          filter←isFolder↓'/',pattern
      :EndIf

      r←0 4⍴'' 0 0 0

      :Select APLVersion
      :Case '*nix'
          →(0∊⍴rslt←1 _SH'ls -al',isFolder↓'d --time-style=full-iso ',unixfix path,filter)⍴0
          rslt←↑rslt
          rslt←' ',('total '≡6⍴rslt)↓[0]rslt
          r←((1↑⍴rslt),4)⍴0
          z←∧⌿' '=rslt ⍝ entirely blank columns
          z←z∧10>+\z    ⍝ Do not split file names
          rslt←z⊂rslt
          r[;3]←'d'=(0⊃rslt)[;1]                 ⍝ IsDirectory
          r[;1]←(~r[;3])×1⊃⎕VFI,4⊃rslt ⍝ Size
          z←,(5⊃rslt),6⊃rslt ⋄ ((z∊'-:')/z)←' ' ⋄ z←((1↑⍴r),6)⍴1⊃⎕VFI z
          r[;2]←↓⌊z,1000×1|z[;5]                ⍝ Add msec to Timestamp
          r[;0]←{(⌽~∨\⌽⍵='/')/⍵}¨{(-+/∧\' '=⌽⍵)↓¨↓⍵}0 1↓8⊃rslt    ⍝ Name

      :Case 'Mac'
          →(0∊⍴rslt←1 _SH'stat -lt "%F %T %z" ',unixfix path,isFolder{0∊⍴⍵:⍺/'*' ⋄ ⍵}filter)⍴0
          r←((1↑⍴rslt),4)⍴0
          rslt←↑{⎕ML←3 ⋄ ⍵⊂⍨~{⍵∧9>+\⍵}' '=⍵}¨rslt
          r[;3]←'d'=0⊃¨rslt[;1]                         ⍝ IsDirectory
          r[;1]←(~r[;3])×1⊃¨⎕VFI¨rslt[;4]               ⍝ Size
          z←↑∊¨↓{w←⍵ ⋄ ((w∊'-:')/w)←' ' ⋄ 1⊃⎕VFI w}¨rslt[;5 6] ⍝
          r[;2]←↓z,0                                    ⍝ 0 msec for MacOS to Timestamp
          r[;0]←path∘{⍺((⍴⍺){⍵↓⍨⍺⍺×⍺≡⍺⍺⍴⍵})⍵}¨rslt[;8]  ⍝ Name

      :Case 'Win'
      ⍝ See DirX for explanations of results of _FindNextFile etc
          _FindDefine
          handle rslt←_FindFirstFile path,isFolder{0∊⍴⍵:⍺/'*' ⋄ ⍵}filter
          :If 0=handle
              :Return ⍝ ('ntdir error:',⍕rslt)⎕SIGNAL 102      ⍝ file not found
          :EndIf
          rslt←,⊂rslt
          :While 1=0⊃ok next←_FindNextFile handle
              rslt,←⊂next
          :EndWhile
          :If 0 18∨.≠ok next
              ('ntdir error:',⍕next)⎕SIGNAL 11   ⍝ DOMAIN
          :EndIf
          ok←FindClose handle
          →(0∊⍴rslt←↓[0]↑rslt)⍴0
          r←((1↑⍴0⊃rslt),4)⍴0
          (0⊃rslt)←⍉attrs←(32⍴2)⊤0⊃rslt    ⍝ Get attributes into bits
          r[;3]←(0⊃rslt)[;27]              ⍝ IsDirectory?
          r[;1]←0(2*32)⊥⍉↑4⊃rslt           ⍝ combine size elements
          r[;2]←_Filetime_to_TS¨3⊃rslt     ⍝ As ⎕TS vector
          r[;0]←6⊃rslt                     ⍝ Name
      :EndSelect
      r←r[⍋↑r[;0];]
    ∇

    ∇ MkDir path;CreateDirectory;GetLastError;err
      ⍝ Create a folder
      :Select APLVersion
      :CaseList '*nix' 'Mac'
          :If ~DirExists path
              1 _SH'mkdir ',unixfix path
              ('mkdir error on ',path)⎕SIGNAL 11/⍨~DirExists path
          :EndIf
      :Case 'Win'
          ⎕NA'I kernel32.C32∣CreateDirectory* <0T I4' ⍝ Try for best function
          →(0≠CreateDirectory path 0)⍴0 ⍝ 0 means "default security attributes"
          ⎕NA'I4 kernel32.C32|GetLastError'
          err ⎕SIGNAL⍨'CreateDirectory error:',⍕err←GetLastError
      :EndSelect
    ∇

    ∇ Move filenames;MoveFileX;MoveFileExA;GetLastError;err
    ⍝ Move (from to) - move/rename file
      :Select APLVersion
      :Case '*nix' 'Mac'
          ∘
      :Case 'Win'
          ⎕NA'I kernel32.C32∣MoveFileEx* <0T <0T I4' ⍝ Try for best function
          :If 0≠MoveFileExA filenames,3 ⍝ REPLACE_EXISTING (1) + COPY_ALLOWED (2)
              :Return
          :EndIf
          ⎕NA'I4 kernel32.C32|GetLastError'
          :Select err←GetLastError
          :Case 120                     ⍝ ERROR_CALL_NOT_IMPLIMENTED
              'MoveFileX'⎕NA'I Kernel32.C32∣MoveFile* <0T <0T' ⍝ accept 2nd best - win 95
              :If 0≠MoveFileX filenames
                  :Return
              :EndIf
              err←GetLastError
          :EndSelect
          11 ⎕SIGNAL⍨'MoveFile error:',⍕err
      :EndSelect
    ∇

    ∇ tn←Nopen name
      :Trap 0
          tn←name ⎕NCREATE 0
      :Else
          tn←name ⎕NTIE 0
      :EndTrap
    ∇

    ∇ r←data Put name
     ⍝ Write data to file
      r←{(⎕NUNTIE ⍵)⊢data ⎕NAPPEND(0 ⎕NRESIZE ⍵)(⎕DR data)}Nopen name
    ∇

    ∇ r←text PutText name;tn
     ⍝ Write text to file (must be single byte text)
      tn←Nopen name
      0 ⎕NRESIZE tn
      r←text ⎕NAPPEND tn(⎕DR' ')
      ⎕NUNTIE tn
    ∇

    ∇ RmDir path;RemoveDirectoryA;GetLastError
     ⍝ Remove folder/directory
      :Select APLVersion
      :CaseList '*nix' 'Mac'
          ∘
      :Case 'Win'
          ⎕NA'I kernel32.C32∣RemoveDirectory* <0T'
          →(0≠RemoveDirectory,⊂path)⍴0
          ⎕NA'I4 kernel32.C32|GetLastError'
          11 ⎕SIGNAL⍨'RemoveDirectory error:',⍕GetLastError
      :EndSelect
    ∇

    ∇ SetCurrentDirectory path;SCD;GetLastError
     ⍝ Set Current Directory
      :Select APLVersion
      :CaseList '*nix' 'Mac'
          ∘
      :Case 'Win'
          'SCD'⎕NA'I kernel32.C32∣SetCurrentDirectory* <0T'
          →(0≠SCD,⊂path)⍴0
          ⎕NA'I4 kernel32.C32|GetLastError'
          11 ⎕SIGNAL⍨'SetCurrentDirectory error:',⍕GetLastError
      :EndSelect
    ∇

    ∇ r←{noext}SplitFilename filename;filesep;mask;path;file;ext
    ⍝ splits a filename into: path name ext
      noext←{6::0 ⋄ noext}''
      filesep←(~isWin)↓'\/'
      mask←⌽∨\⌽filename∊filesep
      path←mask/filename
      file←(~mask)/filename
      :If noext
          r←path file
      :Else
          mask←∨\⌽<\⌽'.'=file
          ext←mask/file
          file←(~mask)/file
          r←path file ext
      :EndIf
    ∇

    :Section Windows
    ∇ rslt←_Filetime_to_TS filetime;⎕IO
      :If 1≠0⊃rslt←FileTimeToLocalFileTime filetime(⎕IO←0)
      :OrIf 1≠0⊃rslt←FileTimeToSystemTime(1⊃rslt)0
          rslt←0 0                   ⍝ if either call failed then zero the time elements
      :EndIf
      rslt←1 1 0 1 1 1 1 1/1⊃rslt    ⍝ remove day of week
    ∇

    ∇ _FindDefine;WIN32_FIND_DATA
      :If 0=⎕NC'FindFirstFileX'
          WIN32_FIND_DATA←'{I4 {I4 I4} {I4 I4} {I4 I4} {U4 U4} {I4 I4} T[260] T[14]}'
          'FindFirstFileX'⎕NA'I4 kernel32.C32|FindFirstFile* <0T >',WIN32_FIND_DATA
          'FindNextFileX'⎕NA'U4 kernel32.C32|FindNextFile* I4 >',WIN32_FIND_DATA
          ⎕NA'kernel32.C32|FindClose I4'
          ⎕NA'I4 kernel32.C32|FileTimeToLocalFileTime <{I4 I4} >{I4 I4}'
          ⎕NA'I4 kernel32.C32|FileTimeToSystemTime <{I4 I4} >{I2 I2 I2 I2 I2 I2 I2 I2}'
          ⎕NA'I4 kernel32.C32∣GetLastError'
      :EndIf
    ∇

    ∇ rslt←_FindFirstFile name;⎕IO
      rslt←FindFirstFileX name(⎕IO←0)
      :If ¯1=0⊃rslt                   ⍝ INVALID_HANDLE_VALUE
          rslt←0 GetLastError
      :Else
          (1 6⊃rslt)_FindTrim←0        ⍝ shorten the file name at the null delimiter
          (1 7⊃rslt)_FindTrim←0        ⍝ and for the alternate name
      :EndIf
    ∇

    ∇ rslt←_FindNextFile handle;⎕IO
      rslt←FindNextFileX handle(⎕IO←0)
      :If 1≠0⊃rslt
          rslt←0 GetLastError
      :Else
          (1 6⊃rslt)_FindTrim←0             ⍝ shorten the filename
          (1 7⊃rslt)_FindTrim←0             ⍝ shorten the alternate name
      :EndIf
    ∇

    ∇ name←name _FindTrim ignored;⎕IO
     ⍝ Truncates a character vector at the null delimiting byte.
     ⍝ The null is not included in the result.
      ⎕IO←0
      name↑⍨←name⍳⎕UCS 0
    ∇

    ∇ {r}←{suppress}_CMD cmd
      :If 0=⎕NC'suppress' ⋄ suppress←0 ⋄ :EndIf
      r←''
      :Trap 0
          r←⎕CMD cmd
      :Else
          ('shell command failed: ',cmd)⎕SIGNAL 11/⍨~suppress
      :EndTrap
    ∇

    ∇ r←isWin
      r←'Win'≡APLVersion
    ∇

    :endsection

    :section *nix
    ∇ {r}←{suppress}_SH cmd
    ⍝ SH cover to suppress any error messages
    ⍝ suppress will suppress error from being signaled
      :If 0=⎕NC'suppress' ⋄ suppress←0 ⋄ :EndIf
      r←''
      :Trap 0
          r←⎕SH cmd,' 2>/dev/null'
      :Else
          ('shell command failed: ',cmd)⎕SIGNAL 11/⍨~suppress
      :EndTrap
    ∇

    ∇ f←unixfix f
    ⍝ replaces Windows file separator \ with Unix file separator /
    ⍝ this approach is mindnumbingly simple and probably dangerous
    ⍝ which is why we call unixfix very cautiously
      :If (⊂APLVersion)∊'*nix' 'Mac' ⋄ ((f='\')/f)←'/' ⋄ :EndIf
    ∇

    ∇ r←APLVersion
      :Select 3↑⊃'.'⎕WG'APLVersion'
      :CaseList 'Lin' 'AIX' 'Sol'
          r←'*nix'
      :Case 'Win'
          r←'Win'
      :Case 'Mac'
          r←'Mac'
      :Else
          ∘∘∘ ⍝ unknown version
      :EndSelect
    ∇
    :endsection

    ∇ r←a FREAD w;t
      r←a{⍺{(⎕FUNTIE ⍵)⊢⎕FREAD ⍵ ⍺}w ⎕FSTIE 0}w
    ∇

    ∇ r←filename Fopen tieno
    ⍝ tieno is tie number and optionally 1 to tie exclusively
      tieno←2↑tieno ⍝ default to shares tie
      :Trap 22
          r←filename{⍵[2]:⍺ ⎕FTIE ⍵[1] ⋄ ⍺ ⎕FSTIE ⍵}tieno
      :Else
          r←filename{⍵[2]:⍵[3] ⋄ ⍺ ⎕FSTIE ⍵[2]⊣⎕FUNTIE ⍵[3]}tieno,filename ⎕FCREATE tieno[1]
      :EndTrap
    ∇
:EndNamespace

:Namespace Files

⍝ Provides cover functions for many file operations
⍝ Eventually all will be implemented for both Windows and *nix

    (⎕IO ⎕ML)←1

    ∇ r←data Append name
     ⍝ Append data to existing file
      r←{(⎕NUNTIE ⍵)⊢data ⎕NAPPEND ⍵}Nopen name
    ∇

    ∇ r←text AppendText name;tn
     ⍝ Append text to existing file (must be single byte text)
      tn←Nopen name
      r←text ⎕NAPPEND tn(⎕DR' ')
      ⎕NUNTIE tn
    ∇

    ∇ (tn name)←{ext}CreateTemp folder;cnt
     ⍝ Create a temp file
     ⍝ folder - folder to create temp file in
     ⍝ ext - file extension
      :If 0=⎕NC'ext' ⋄ ext←'tmp' ⋄ :EndIf
      :If 0∊⍴ext ⋄ ext←'tmp' ⋄ :EndIf
      cnt←tn←0
      :Repeat
          name←folder,('/\'∊⍨¯1↑folder)↓'/',⎕A[?8⍴⍴⎕A],'.',ext
          :Trap 22 ⋄ tn←name ⎕NCREATE 0 ⋄ :EndTrap
          cnt+←1
      :Until (cnt>20)∨tn≠0
      'Unable to create temporary file'⎕SIGNAL tn↓22
    ∇

    ∇ {protect}Copy FmTo;CopyFileX;GetLastError ⍝ Copy file Fm -> To
      :Select APLVersion
      :Case '*nix'
          ∘
      :Case 'Win'
          :If 0=⎕NC'protect'     ⍝ Copy fails if <protect> and 'To' exists.
              protect←0          ⍝ Default unprotected copy.
          :EndIf
          'CopyFileX'⎕NA'I kernel32.C32∣CopyFile* <0T <0T I'
          :If 0=CopyFileX FmTo,protect
              ⎕NA'I4 kernel32.C32|GetLastError'
              11 ⎕SIGNAL⍨'CopyFile error:',⍕GetLastError
          :EndIf
      :EndSelect
    ∇

    ∇ Delete name;DeleteFileX;GetLastError;FindFirstFile;FindNextFile;FindClose;handle;rslt;ok;next;⎕IO;path
      ⎕IO←0
      :Select APLVersion
      :CaseList '*nix' 'Mac'
          _SH'rm -f ',unixfix name
      :Case 'Win'
          'DeleteFileX'⎕NA'I kernel32.C32∣DeleteFile* <0T'
          ⎕NA'I4 kernel32.C32|GetLastError'
          :If ∨/'*?'∊name ⍝ wildcards?
              path←{(⌽∨\⌽⍵∊'\/')/⍵}name
              _FindDefine
              handle rslt←_FindFirstFile name
              :If 0=handle
                  :Return ⍝ ('ntdir error:',⍕rslt)⎕SIGNAL 102      ⍝ file not found
              :EndIf
              :If '.'≠⊃6⊃rslt
                  {}DeleteFileX⊂path,6⊃rslt
              :EndIf
              :While 1=0⊃ok next←_FindNextFile handle
                  :If '.'≠⊃6⊃next
                      {}DeleteFileX⊂path,6⊃next
                  :EndIf
              :EndWhile
              :If 0 18∨.≠ok next
                  ('ntdir error:',⍕next)⎕SIGNAL 11   ⍝ DOMAIN
              :EndIf
              {}FindClose handle
          :Else
              :If 0=DeleteFileX⊂name
                  11 ⎕SIGNAL⍨'DeleteFile error:',⍕GetLastError
              :EndIf
          :EndIf
      :EndSelect
    ∇

    ∇ r←DirExists path
      r←0
      :Select APLVersion
      :CaseList '*nix' 'Mac'
          :Trap 11
              r←0<⍴_SH'ls -adl ',unixfix path
          :EndTrap
      :Case 'Win'
          r←{1≠⊃⍴⍵:0 ⋄ ⍵[1;4]}'.'List path
      :EndSelect
    ∇

    ∇ r←Exists name
     ⍝ Does file exist?
      r←1
      :Trap 22
          :Trap 19 ⍝ file access error means file exists
              ⎕NUNTIE(unixfix name)⎕NTIE 0
          :EndTrap
      :Else
          r←0
      :EndTrap
    ∇

    ∇ r←GetCurrentDirectory;GCD;GetLastError
     ⍝ Get Current Directory
      :Select APLVersion
      :CaseList '*nix' 'Mac'
          r←⊃_SH'pwd'
      :Case 'Win'
          'GCD'⎕NA'I kernel32.C32∣GetCurrentDirectory* I4 >0T'
          :If 0≠1⊃r←GCD 256 256
              r←2⊃r
          :Else
              ⎕NA'I4 kernel32.C32|GetLastError'
              11 ⎕SIGNAL⍨'GetCurrentDirectory error:',⍕GetLastError
          :EndIf
      :EndSelect
    ∇

    ∇ Chars←GetText name;nid;signature;nums;sz;b
     ⍝ Read ANSI or Unicode character file
      sz←⎕NSIZE nid←(unixfix name)⎕NTIE 0
      signature←⎕NREAD nid 83 3 0
      :If signature≡¯17 ¯69 ¯65 ⍝ UTF-8?
          nums←⎕NREAD nid 83 sz
          Chars←'UTF-8'⎕UCS 256|nums ⍝ Signed ints
      :ElseIf ∨/b←(2↑signature)∧.=2 2⍴¯1 ¯2 ¯2 ⍝ Unicode (UTF-16)
          Chars←{,⌽(2,⍨2÷⍨⍴⍵)⍴⍵}⍣(⊣/b)⎕NREAD nid 83 sz 2
          Chars←'UTF-16'⎕UCS(2*16)|163 ⎕DR Chars
      :Else ⍝ ANSI or UTF-8
          Chars←{11::⎕UCS ⍵ ⋄ 'UTF-8'⎕UCS ⍵}256|⎕NREAD nid 83 sz 0
      :EndIf
      ⎕NUNTIE nid
    ∇

    ∇ vtv←GetVTV name
     ⍝ Read ANSI or Unicode character file as vector of text vectors
      vtv←{1↓¨(v=n)⊂v←(n←⎕UCS 10),⍵}(GetText name)~⎕UCS 13
    ∇

    ∇ r←LikelyURL w
      →0↓⍨r←(⎕DR w)∊80 82
      r←{(0∊⍴⍵)<∧/⍵∊'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789%-._~:/?#[]@!$&''()*+,;='}w ⍝ identify likely URIs
    ∇

    ∇ r←{pattern}List path;z;rslt;handle;next;ok;attrs;⎕IO;FindFirstFileX;FindNextFileX;FindClose;FileTimeToLocalFileTime;FileTimeToSystemTime;GetLastError;isFile;filter;isFolder
    ⍝ path and pattern are related.
    ⍝ If there is no pattern (or pattern is empty)
    ⍝   If path ends with '/' or '\' then return information for the contents of the folder, otherwise, return information about the folder (or file) itself
    ⍝ If a non-empty pattern exists, it is used as a filter on the contents of path (path is treated as a folder name)
    ⍝ Examples:
    ⍝   List '/dir/foo'  ⍝ returns information about /dir/foo
    ⍝   List '/dir/foo/' ⍝ returns information about the contents of /dir/foo/
    ⍝   '*.dyalog' List '/dir/foo'  ⍝ returns information about the .dyalog files in /dir/foo/
    ⍝   List '/dir/foo/*.dyalog'    ⍝ also returns information about the .dyalog files in /dir/foo/

    ⍝ Information returned is:
    ⍝ [;0] Name [;1] Length [;2] LastAccessTime [;3] IsDirectory
      ⎕IO←0
      :If 0=⎕NC'pattern' ⋄ pattern←'' ⋄ :EndIf
      isFolder←'/\'∊⍨¯1↑path
      filter←''
      :If isFile←~0∊⍴pattern
          filter←isFolder↓'/',pattern
      :EndIf

      r←0 4⍴'' 0 0 0

      :Select APLVersion
      :Case '*nix'
          →(0∊⍴rslt←1 _SH'ls -al',isFolder↓'d --time-style=full-iso ',unixfix path,filter)⍴0
          rslt←↑rslt
          rslt←' ',('total '≡6⍴rslt)↓[0]rslt
          r←((1↑⍴rslt),4)⍴0
          z←∧⌿' '=rslt ⍝ entirely blank columns
          z←z∧10>+\z    ⍝ Do not split file names
          rslt←z⊂rslt
          r[;3]←'d'=(0⊃rslt)[;1]                 ⍝ IsDirectory
          r[;1]←(~r[;3])×1⊃⎕VFI,4⊃rslt ⍝ Size
          z←,(5⊃rslt),6⊃rslt ⋄ ((z∊'-:')/z)←' ' ⋄ z←((1↑⍴r),6)⍴1⊃⎕VFI z
          r[;2]←↓⌊z,1000×1|z[;5]                ⍝ Add msec to Timestamp
          r[;0]←{(⌽~∨\⌽⍵='/')/⍵}¨{(-+/∧\' '=⌽⍵)↓¨↓⍵}0 1↓8⊃rslt    ⍝ Name

      :Case 'Mac'
          →(0∊⍴rslt←1 _SH'stat -lt "%F %T %z" ',unixfix path,isFolder{0∊⍴⍵:⍺/'*' ⋄ ⍵}filter)⍴0
          r←((1↑⍴rslt),4)⍴0
          rslt←↑{⎕ML←3 ⋄ ⍵⊂⍨~{⍵∧9>+\⍵}' '=⍵}¨rslt
          r[;3]←'d'=0⊃¨rslt[;1]                         ⍝ IsDirectory
          r[;1]←(~r[;3])×1⊃¨⎕VFI¨rslt[;4]               ⍝ Size
          z←↑∊¨↓{w←⍵ ⋄ ((w∊'-:')/w)←' ' ⋄ 1⊃⎕VFI w}¨rslt[;5 6] ⍝
          r[;2]←↓z,0                                    ⍝ 0 msec for MacOS to Timestamp
          r[;0]←path{⍺((⍴⍺){⍵↓⍨⍺⍺×⍺≡⍺⍺⍴⍵})⍵}¨rslt[;8]   ⍝ Name

      :Case 'Win'
      ⍝ See DirX for explanations of results of _FindNextFile etc
          _FindDefine
          handle rslt←_FindFirstFile path,isFolder{0∊⍴⍵:⍺/'*' ⋄ ⍵}filter
          :If 0=handle
              :Return ⍝ ('ntdir error:',⍕rslt)⎕SIGNAL 102      ⍝ file not found
          :EndIf
          rslt←,⊂rslt
          :While 1=0⊃ok next←_FindNextFile handle
              rslt,←⊂next
          :EndWhile
          :If 0 18∨.≠ok next
              ('ntdir error:',⍕next)⎕SIGNAL 11   ⍝ DOMAIN
          :EndIf
          ok←FindClose handle
          →(0∊⍴rslt←↓[0]↑rslt)⍴0
          r←((1↑⍴0⊃rslt),4)⍴0
          (0⊃rslt)←⍉attrs←(32⍴2)⊤0⊃rslt    ⍝ Get attributes into bits
          r[;3]←(0⊃rslt)[;27]              ⍝ IsDirectory?
          r[;1]←0(2*32)⊥⍉↑4⊃rslt           ⍝ combine size elements
          r[;2]←_Filetime_to_TS¨3⊃rslt     ⍝ As ⎕TS vector
          r[;0]←6⊃rslt                     ⍝ Name
      :EndSelect
      r←r[⍋↑r[;0];]
    ∇

    ∇ MkDir path;CreateDirectory;GetLastError;err
      ⍝ Create a folder
      :Select APLVersion
      :CaseList '*nix' 'Mac'
          :If ~DirExists path
              1 _SH'mkdir ',unixfix path
              ('mkdir error on ',path)⎕SIGNAL 11/⍨~DirExists path
          :EndIf
      :Case 'Win'
          ⎕NA'I kernel32.C32∣CreateDirectory* <0T I4' ⍝ Try for best function
          →(0≠CreateDirectory path 0)⍴0 ⍝ 0 means "default security attributes"
          ⎕NA'I4 kernel32.C32|GetLastError'
          err ⎕SIGNAL⍨'CreateDirectory error:',⍕err←GetLastError
      :EndSelect
    ∇

    ∇ Move filenames;MoveFileX;MoveFileExA;GetLastError;err
    ⍝ Move (from to) - move/rename file
      :Select APLVersion
      :Case '*nix' 'Mac'
          ∘
      :Case 'Win'
          ⎕NA'I kernel32.C32∣MoveFileEx* <0T <0T I4' ⍝ Try for best function
          :If 0≠MoveFileExA filenames,3 ⍝ REPLACE_EXISTING (1) + COPY_ALLOWED (2)
              :Return
          :EndIf
          ⎕NA'I4 kernel32.C32|GetLastError'
          :Select err←GetLastError
          :Case 120                     ⍝ ERROR_CALL_NOT_IMPLIMENTED
              'MoveFileX'⎕NA'I Kernel32.C32∣MoveFile* <0T <0T' ⍝ accept 2nd best - win 95
              :If 0≠MoveFileX filenames
                  :Return
              :EndIf
              err←GetLastError
          :EndSelect
          11 ⎕SIGNAL⍨'MoveFile error:',⍕err
      :EndSelect
    ∇

    ∇ tn←Nopen name
      :Trap 0
          tn←name ⎕NCREATE 0
      :Else
          tn←name ⎕NTIE 0
      :EndTrap
    ∇

    ∇ r←data Put name
     ⍝ Write data to file
      r←{(⎕NUNTIE ⍵)⊢data ⎕NAPPEND(0 ⎕NRESIZE ⍵)(⎕DR data)}Nopen name
    ∇

    ∇ r←text PutText name;tn
     ⍝ Write text to file (must be single byte text)
      tn←Nopen name
      0 ⎕NRESIZE tn
      r←text ⎕NAPPEND tn(⎕DR' ')
      ⎕NUNTIE tn
    ∇

    ∇ RmDir path;RemoveDirectoryA;GetLastError
     ⍝ Remove folder/directory
      :Select APLVersion
      :CaseList '*nix' 'Mac'
          ∘
      :Case 'Win'
          ⎕NA'I kernel32.C32∣RemoveDirectory* <0T'
          →(0≠RemoveDirectory,⊂path)⍴0
          ⎕NA'I4 kernel32.C32|GetLastError'
          11 ⎕SIGNAL⍨'RemoveDirectory error:',⍕GetLastError
      :EndSelect
    ∇

    ∇ SetCurrentDirectory path;SCD;GetLastError
     ⍝ Set Current Directory
      :Select APLVersion
      :CaseList '*nix' 'Mac'
          ∘
      :Case 'Win'
          'SCD'⎕NA'I kernel32.C32∣SetCurrentDirectory* <0T'
          →(0≠SCD,⊂path)⍴0
          ⎕NA'I4 kernel32.C32|GetLastError'
          11 ⎕SIGNAL⍨'SetCurrentDirectory error:',⍕GetLastError
      :EndSelect
    ∇

    ∇ r←{noext}SplitFilename filename;filesep;mask;path;file;ext
    ⍝ splits a filename into: path name ext
      noext←{6::0 ⋄ noext}''
      filesep←(~isWin)↓'\/'
      mask←⌽∨\⌽filename∊filesep
      path←mask/filename
      file←(~mask)/filename
      :If noext
          r←path file
      :Else
          mask←∨\⌽<\⌽'.'=file
          ext←mask/file
          file←(~mask)/file
          r←path file ext
      :EndIf
    ∇

    :Section Windows
    ∇ rslt←_Filetime_to_TS filetime;⎕IO
      :If 1≠0⊃rslt←FileTimeToLocalFileTime filetime(⎕IO←0)
      :OrIf 1≠0⊃rslt←FileTimeToSystemTime(1⊃rslt)0
          rslt←0 0                   ⍝ if either call failed then zero the time elements
      :EndIf
      rslt←1 1 0 1 1 1 1 1/1⊃rslt    ⍝ remove day of week
    ∇

    ∇ _FindDefine;WIN32_FIND_DATA
      :If 0=⎕NC'FindFirstFileX'
          WIN32_FIND_DATA←'{I4 {I4 I4} {I4 I4} {I4 I4} {U4 U4} {I4 I4} T[260] T[14]}'
          'FindFirstFileX'⎕NA'I4 kernel32.C32|FindFirstFile* <0T >',WIN32_FIND_DATA
          'FindNextFileX'⎕NA'U4 kernel32.C32|FindNextFile* I4 >',WIN32_FIND_DATA
          ⎕NA'kernel32.C32|FindClose I4'
          ⎕NA'I4 kernel32.C32|FileTimeToLocalFileTime <{I4 I4} >{I4 I4}'
          ⎕NA'I4 kernel32.C32|FileTimeToSystemTime <{I4 I4} >{I2 I2 I2 I2 I2 I2 I2 I2}'
          ⎕NA'I4 kernel32.C32∣GetLastError'
      :EndIf
    ∇

    ∇ rslt←_FindFirstFile name;⎕IO
      rslt←FindFirstFileX name(⎕IO←0)
      :If ¯1=0⊃rslt                   ⍝ INVALID_HANDLE_VALUE
          rslt←0 GetLastError
      :Else
          (1 6⊃rslt)_FindTrim←0        ⍝ shorten the file name at the null delimiter
          (1 7⊃rslt)_FindTrim←0        ⍝ and for the alternate name
      :EndIf
    ∇

    ∇ rslt←_FindNextFile handle;⎕IO
      rslt←FindNextFileX handle(⎕IO←0)
      :If 1≠0⊃rslt
          rslt←0 GetLastError
      :Else
          (1 6⊃rslt)_FindTrim←0             ⍝ shorten the filename
          (1 7⊃rslt)_FindTrim←0             ⍝ shorten the alternate name
      :EndIf
    ∇

    ∇ name←name _FindTrim ignored;⎕IO
     ⍝ Truncates a character vector at the null delimiting byte.
     ⍝ The null is not included in the result.
      ⎕IO←0
      name↑⍨←name⍳⎕UCS 0
    ∇

    ∇ {r}←{suppress}_CMD cmd
      :If 0=⎕NC'suppress' ⋄ suppress←0 ⋄ :EndIf
      r←''
      :Trap 0
          r←⎕CMD cmd
      :Else
          ('shell command failed: ',cmd)⎕SIGNAL 11/⍨~suppress
      :EndTrap
    ∇

    ∇ r←isWin
      r←'Win'≡APLVersion
    ∇

    :endsection

    :section *nix
    ∇ {r}←{suppress}_SH cmd
    ⍝ SH cover to suppress any error messages
    ⍝ suppress will suppress error from being signaled
      :If 0=⎕NC'suppress' ⋄ suppress←0 ⋄ :EndIf
      r←''
      :Trap 0
          r←⎕SH cmd,' 2>/dev/null'
      :Else
          ('shell command failed: ',cmd)⎕SIGNAL 11/⍨~suppress
      :EndTrap
    ∇

    ∇ f←unixfix f
    ⍝ replaces Windows file separator \ with Unix file separator /
    ⍝ this approach is mindnumbingly simple and probably dangerous
    ⍝ which is why we call unixfix very cautiously
      :If (⊂APLVersion)∊'*nix' 'Mac' ⋄ ((f='\')/f)←'/' ⋄ :EndIf
    ∇

    ∇ r←APLVersion
      :Select 3↑⊃'.'⎕WG'APLVersion'
      :CaseList 'Lin' 'AIX' 'Sol'
          r←'*nix'
      :Case 'Win'
          r←'Win'
      :Case 'Mac'
          r←'Mac'
      :Else
          ∘∘∘ ⍝ unknown version
      :EndSelect
    ∇
    :endsection

    ∇ r←a FREAD w;t
      r←a{⍺{(⎕FUNTIE ⍵)⊢⎕FREAD ⍵ ⍺}w ⎕FSTIE 0}w
    ∇

    ∇ r←filename Fopen tieno
    ⍝ tieno is tie number and optionally 1 to tie exclusively
      tieno←2↑tieno ⍝ default to shares tie
      :Trap 22
          r←filename{⍵[2]:⍺ ⎕FTIE ⍵[1] ⋄ ⍺ ⎕FSTIE ⍵}tieno
      :Else
          r←filename{⍵[2]:⍵[3] ⋄ ⍺ ⎕FSTIE ⍵[2]⊣⎕FUNTIE ⍵[3]}tieno,filename ⎕FCREATE tieno[1]
      :EndTrap
    ∇
:EndNamespace


HtmlElement.defaultArgs scalar case fix

HtmlElement.defaultArgs scalar case fix

:class HtmlElement             ⍝ this is the most basic element of a page

⍝∇:require =\JSON.dyalog

    ⎕io←⎕ml←1

    :field public shared _version←1
    :field public NL←⎕ucs 13 ⍝ 10

    :field public Tag←''      ⍝ this is the element name
    :field public Content←⍬   ⍝ content of the element - a series of strings/instances/class+parms
    :field public Handlers←'' ⍝ array of event handlers
    :field public _PageRef←'' ⍝ reference back to the page instance containing this element
    :field public NoEndTag←0  ⍝ set to 1 if this singleton element (does not have a closing tag)
    :field public Position    ⍝ has position information for this element (if position is set)
    :field public Uses←''     ⍝ resources that will be used by this object (can be overridden by derived classes)

    :field public shared readonly _true←#.JSON.true     ⍝ same definition as in #.JSON
    :field public shared readonly _false←#.JSON.false   ⍝ same definition as in #.JSON

⍝ define shortcuts to namespaces (initialized later)
    :field public _html        ⍝ reference to base HTML elements namespace
    :field public _JQ          ⍝ reference to JQuery/JQueryUI widgets namespace
    :field public _SF          ⍝ reference to SyncFusion widgets namespace
    :field public _JSS         ⍝ reference to JavaScript Snippets namespace
    :field public _DC          ⍝ reference to Dyalog Controls namespace
    :field public _            ⍝ reference to namespace that refers to all elements/widgets

   ⍝ make shortcuts for some common HTML attributes
    :field public shared readonly UNDEF←⎕NULL  ⍝ setting for undefined attributes
    :field public id←UNDEF                     ⍝ id attribute for the element
    :field public value←UNDEF                  ⍝ value attribute for the element
    :field public name←UNDEF                   ⍝ name attribute for the element
    :field public class←UNDEF                  ⍝ class attribute for the element
    :field public style←UNDEF                  ⍝ style attribute for the element
    :field public title←UNDEF                  ⍝ title attribute for the element
    :field public type←UNDEF                   ⍝ type attribute for the element

    :field public readonly CommonAttributes←'id' 'value' 'name' 'class' 'style' 'title' 'type' ⍝ element attributes that are directly accessible

    _names←_values←0⍴⊂'' ⍝ used for attributes

    :field public _styles←''

    rand←{t←16807⌶2 ⋄r←?⍵ ⋄ t←16807⌶t ⋄ r }

    ∇ r←Version
      :Access public
      r←{⍵,[1.1]{0::¯1 ⋄ ⍵._version}¨⍵}⎕CLASS ⎕THIS
    ∇

    ∇ r←context name
      :Access public shared
      :If 326=⎕DR name ⍝ ref?
          r←⎕RSI{0∊⍴⍺:'' ⋄ 16::''
              ∨/∨/¨(⊂⍵)∊¨(⊃⍺).(⎕CLASS ⎕THIS):⊃⍺
              (1↓⍺)∇ ⍵}name
      :Else
          r←⎕RSI{0∊⍴⍺:''
              ⋄ (⊃⍺){0=⍺.⎕NC⊂⍵:0
                  ⋄ ''≡t←⍺⍎⍵:0
                  ⋄ 1}⍵:⊃⍺
              ⋄ (1↓⍺)∇ ⍵}name
      :EndIf
    ∇

    ∇ r←isChar w
      :Access public shared
      r←0 2∊⍨10|⎕DR w
    ∇

    ∇ r←isString w
      :Access public shared
      :Select ≡w
      :Case 2
          :If 1=⍴,w
              r←{(isChar ⍵)∧1∊⍴⍴1/⍵}⊃w
          :Else
              r←0
          :EndIf
      :CaseList 0 1
          r←{(isChar ⍵)∧1∊⍴⍴1/⍵}w
      :Else
          r←0
      :EndSelect
    ∇

    ∇ r←quote w
      :Access public
      r←{'"'∊⍵:⍵ ⋄ '"',⍵,'"'}w
    ∇

    ∇ r←isTrue a
      :Access public shared
      →0⍴⍨r←(,1)≡,a
      →0⍴⍨r←#.JSON.true≡a
      →0⍴⍨r←'true'≡a
    ∇

    ∇ r←isFalse a
      :Access public shared
      →0⍴⍨r←(,0)≡,a
      →0⍴⍨r←#.JSON.false≡a
      →0⍴⍨r←'false'≡a
    ∇

    ∇ r←a ine w
      :Access public shared
      r←a{0∊⍴⍺:'' ⋄ ⍵}w ⍝ if not empty
    ∇
    errorIf←{⍺←⊢ ⋄ 0≠⍵:⍺ ⎕SIGNAL ⍵ ⋄ ''}

    :section Attribute Handling

    ∇ r←fixkeys w
      :Access public shared
      r←{2>|≡⍵:,⊂⍵ ⋄ ⍵}w ⍝ Enclose if simple
    ∇

    ∇ SyncAttrs arg
      :Implements Trigger id,name,class,style,title,type,value
      :If ⊃≢/arg.(NewValue OldValue)
          arg.Name Set arg.NewValue
      :EndIf
    ∇

    :property keyed Attrs       ⍝ element attributes
    :access public

        ∇ set ra;i;new;there;names;ind
          there←~new←(⍴_names)<i←_names⍳names←fixkeys⊃ra.Indexers
          (_values _names),←new∘/¨ra.NewValue names
          _values[there/i]←there/ra.NewValue
          :For i :In {⍵/⍳⍴⍵}7≥'id' 'class' 'style' 'title' 'value' 'type' 'name'⍳names
              ⍎(i⊃names),'←i⊃ra.NewValue'
          :EndFor
        ∇

        ∇ r←get ra;i;n
          ⎕SIGNAL(1<⍴i←ra.Indexers)⍴4 ⍝ RANK err
          :If 1↑ra.IndexersSpecified
              r←(_values,⊂'')[_names⍳n←fixkeys⊃⍣(2≤|≡i)+i]
          :Else
              r←↓_names,[1.1]_values
          :EndIf
        ∇
    :endproperty

    ∇ attr←{plain}ParseAttr arg;split;item;t;f;i;eq;nq;items;n
      :Access public shared
      ⍝ Parse html sttributes
⍝
⍝     1)    In only the first token, a simple string (i.e. not in the form 'abc=def') without a leading '#' or '.' is treated as an id
⍝        'foo'  > id="foo"
⍝
⍝        In all other positions, a string of this type is treated as a singleton attribute
⍝        'foo' 'goo' 'moo' > id="foo" goo="goo" moo="moo"
⍝
⍝     2)    Single simple string beginning with '#' is an id
⍝        '#foo'  > id="foo"
⍝        'goo=moo' '#foo' > goo="moo" id="foo"
⍝
⍝     3)    Single simple string beginning with '.' is treated as a class
⍝        '.foo'  > class="foo"
⍝        'foo' '.goo' 'moo' > id="foo" class="goo" moo="moo"
⍝
⍝     4)    Attributes must be paired either as in 'foo=goo' or ('foo' 'goo'), if there is a single pair, it must be enclosed
⍝        ⊂'href' '#top'  > href="#top"
⍝
⍝        The value portion of an attribute pair may begin with '#' or '.' without special interpretation
⍝        ('href' '#top') '#foo' > href="#top" id="foo"

      :If 0=⎕NC'plain' ⋄ plain←0 ⋄ :EndIf
      arg←eis,arg
      attr←⍬
      split←{0=⊢/v←∨\(≠\'"'=⍵)<'='=⍵:⍵ ⋄ ((~v)/⍵)({'"'∧.=∊1 ¯1↑¨⊂⍵:¯1↓1↓⍵ ⋄ ⍵}1↓v/⍵)}
      :For i :In ⍳⍴arg
          :Select |≡item←,i⊃arg
          :Case 1
              :If ~0∊⍴item
                  :If ∨/eq←'='=item              ⍝ any '=' (i.e.
                  :AndIf 0≠n←eq+.∧nq←~≠\'"'=item
                      :If n=1
                          attr,←⊂split item
                      :Else
                          attr,←⊃,/1 ParseAttr¨item{⎕ML←3 ⋄ ⍵⊂⍺}nq⍲item=' '
                      :EndIf
                  :ElseIf 3>f←'#.'⍳1↑item
                      attr,←⊂((f⊃'id' 'class')(1↓item))
                  :ElseIf plain<i=1
                      attr,←⊂'id'item
                  :Else
                      attr,←⊂2⍴⊂item
                  :EndIf
              :EndIf
          :Case 2
              attr,←⊂item
          :Else
              ('Invalid attribute specification: ',⍕item)⎕SIGNAL 11
          :EndSelect
      :EndFor
    ∇

    ∇ {r}←{which}Set attr
      :Access public
      :If 0≠⎕NC'which' ⋄ attr←↓(eis which),[1.1]eis attr
      :Else
          'Set cannot be called with a scalar ref'⎕SIGNAL 11/⍨(0=≡attr)∧326∊⎕DR attr

          :If 2=⍴,attr  ⍝ 'attr' 'value' is never shorthanded (e.g. given special treatment for id/class)
          :AndIf 1∧.≥≡¨attr
              attr←,⊂attr
          :EndIf

          attr←1 ParseAttr attr
      :EndIf
      :If ~0∊⍴attr
          Attrs[1⊃¨attr]←2⊃¨attr
      :EndIf
      r←⎕THIS
    ∇

    ∇ {r}←{which}SetAttribute attr
    ⍝ set attributes, treating

      :If 0≠⎕NC'which' ⋄ attr←↓(eis which),[1.1]eis attr
      :Else
          'Set cannot be called with a scalar ref'⎕SIGNAL 11/⍨(0=≡attr)∧326∊⎕DR attr
          attr←ParseAttr attr
      :EndIf
      :If ~0∊⍴attr
          Attrs[1⊃¨attr]←2⊃¨attr
      :EndIf
      r←⎕THIS
    ∇

    ∇ {r}←{which}SetAttr attr
      :Access public
      :If 0=⎕NC'which' ⋄ r←SetAttribute attr
      :Else ⋄ r←which SetAttribute attr
      :EndIf
    ∇

    ∇ {r}←DelAttr attrname;mask
      :Access public
      attrname←eis attrname
      mask←~_names∊attrname ⋄ (_names _values)←mask∘/¨_names _values
      r←⎕THIS
    ∇

    ∇ r←{proto}GetAttr attrname
      :Access public
      :If 0=⎕NC'proto' ⋄ proto←'' ⋄ :EndIf
      attrname←eis attrname
      :If 1=⍴attrname
          :Trap 3 ⍝ index error
              r←_values⊃⍨_names⍳attrname
          :Else
              r←proto
          :EndTrap
      :Else
          proto∘GetAttr¨attrname
      :EndIf
    ∇

    :EndSection

    :Section Styles

    ∇ {r}←{what}Style styles;msg
      :Access public
      msg←'Invalid style specification'
      :If 0≠⎕NC'what'
          _styles,←↓(eis what),⍪eis((⍕¨)⍣(2|⎕DR styles))styles
      :Else
          :Select ≡styles
          :Case 2
              msg errorIf 11×0≠2|⍴styles
              _styles,←↓(2,⍨0.5×⍴styles)⍴styles
          :Case 3
              msg errorIf 11×~∧/(,2)∘≡∘⍴¨styles
              _styles,←styles
          :Else
              msg ⎕SIGNAL 11
          :EndSelect
      :EndIf
      r←⎕THIS
    ∇

    ∇ r←RenderStyles;style
      r←''
      :If ~0∊⍴_styles
          :For style :In _styles
              r,←∊(⍕¨style),¨':;'
          :EndFor
          r←' style="',r,'" '
      :EndIf
    ∇

    :EndSection

  ⍝ The constructors

  ⍝ The first arg is the Tag, followed by its contents, then its attributes, if present
  ⍝ Note that attributes can be specified with the tag as in
  ⍝  button type="submit"

    :Section Constructors

    ∇ Make0
    ⍝ basic constructor
      :Implements constructor
      :Access public
      Init
    ∇

    ∇ Make1 t    ⍝ this can be any length
    ⍝ t - tag/element name (e.g. 'div' or 'table')
      :Implements constructor
      :Access public
      Tag←t
      Init
    ∇

    ∇ Make2(t arg)
    ⍝ t - tag/element name (e.g. 'div' or 'table')
    ⍝ arg - content or (content attrs)
      :Implements constructor
      :Access public
      Make2Code(t arg)
    ∇

    ∇ Make2Code(t arg);attr;content;ref
      :If 1=≡t arg                      ⍝ handle 2-character tag (e.g. 'ul' 'tr')
          Tag←t,arg
      :Else
        ⍝ If we have a couple of items, the second of which is
        ⍝ a string or VTV, then we are dealing with attributes:
          :If (,2)≡⍴arg
          :AndIf isAttr 2⊃arg
              (content attr)←arg ⋄ SetAttr attr
          :Else
              content←arg
          :EndIf
          Content,←arg
          Tag←t
      :EndIf
      Init
    ∇

    ∇ Make3(t content attr);ref
    ⍝ t - tag/element name (e.g. 'div' or 'table')
    ⍝ content - content
    ⍝ attr - attrs
      :Implements constructor
      :Access public
      :If 1=≡t content attr    ⍝ handle 3-character tag (e.g. 'pre')
          Tag←t,content,attr
      :ElseIf isClass content
          Make2Code t(content attr)
      :Else
          Tag←t
         ⍝ attr could be a ref. This means that it goes in the contents.
          Add content
          :If (0∊⍴attr)⍱ref←isRef attr
              SetAttr attr
          :ElseIf ref
              Add attr
          :EndIf
      :EndIf
      Init
    ∇

    ∇ Init
      (_html _JQ _SF _DC _JSS _)←#.(_html _JQ _SF _DC _JSS _)
      Position←⎕NS''
    ∇

    ∇ SetUse;c
      :Access public overridable
      :If ~0∊⍴Uses
          :Trap 0
              :If ''≡c←_PageRef
                  c←context'_PageRef'
                  :If ~0∊⍴c
                      c←c._PageRef
                  :EndIf
              :EndIf
              :If ~0∊⍴c
                  c.Use Uses
              :EndIf
          :EndTrap
      :EndIf
    ∇

    ∇ Use resource
      :Access public
      :If ~0∊⍴Uses ⋄ Uses←eis Uses ⋄ :EndIf
      Uses,←eis resource
    ∇

    :endsection

    :section Event Handling

    ∇ {r}←On handler
      :Access public
      handler←eis handler
      Handlers,←r←⎕NEW #._JQ.Handler
      r.(Events Callback ClientData JavaScript Delegates jQueryWrap ScriptWrap Hourglass)←8↑handler,(⍴handler)↓'' 1 '' '' '' 1 1 ¯1
      :If ¯1=r.Hourglass ⋄ r.Hourglass←(,0)≢,r.Callback ⋄ :EndIf
    ∇

    ∇ r←RenderHandlers;myid;h
      :Access public ⍝!!! remove this after testing
      r←''
      :If ~0∊⍴Handlers
          :If ∨/0∘∊∘⍴¨Handlers.Selectors
              myid←SetId
          :EndIf
          :For h :In Handlers
              :If 0∊⍴h.Selectors
                  h.Selectors←'#',myid
              :EndIf
              r,←h.Render
          :EndFor
      :EndIf
    ∇
    :endsection

    :section Rendering

⍝ Elements with no End tag (<tag></tag>).

⍝ area base basefont br col frame hr img input isindex link meta param

    fmtAttr←{' ',⍺,'=',Quote HtmlSafeText,⍕⍵}

    ∇ r←Render;av;t;vs;e;h;c;p
      :Access public
    ⍝ Render by first constructing the Tag, complete with attributes, if any
      r←RenderCore Content
      :If ~0∊⍴av←Tag
          h←RenderHandlers
          p←RenderPosition
          :If 0<⍴vs←Attrs[]
              av,←∊fmtAttr/¨vs
          :EndIf
          av,←RenderStyles
          r←(av Enclose r),h,p
      :EndIf
    ∇

    ∇ r←Postrender r
      :Access overridable
    ∇

    ∇ r←RenderCore list;e;t
      :Access public
    ⍝ do the bulk of the rendering work
      r←''
      :For e :In eis list
          :If isInstance⊃e
              r,←e.Render
          :ElseIf isClass⊃e
              r,←(⎕NEW e).Render
          :Else
              :If 1<⍴⍴t←⍕e
                  t←∊(↓t),¨⊂'
'
              :EndIf
              r,←t
          :EndIf
      :EndFor
    ∇

    ∇ r←HtmlSafeText txt;i;m;u;ucs
      :Access public shared
    ⍝ make text HTML "safe"
      r←,⎕FMT txt
      i←'&<>"#'⍳r
      i-←(i=1)∧1↓(i=5),0 ⍝ mark & that aren't &#
      m←i∊⍳4
      u←127<ucs←⎕UCS r
      (m/r)←('&' '<' '>' '"')[m/i]
      (u/r)←(~∘' ')¨↓'G<&#ZZZ9;>'⎕FMT u/ucs
      r←∊r
    ∇

    ∇ r←RenderPosition
      :Access public
      r←''
      :If 9=⎕NC'Position'
      :AndIf ~0∊⍴Position.⎕NL-2
          Uses,←⊂'JQueryUI'
          r←#.JQ.JQueryfn'position'('#',SetId)Position
          Use
      :EndIf
    ∇

    :endsection

    :section Utilities

    Bracket←{'<',⍵,'>'}

    ∇ SetInputName
      :Access public
      ⍝ for input element widgets, this will set the name to the id if not already set
      ⍝ or the id to the name if not already set
      :If (⊂name)∊UNDEF''
          :If (⊂id)∊UNDEF''
              SetId
          :EndIf
          name←id
      :ElseIf UNDEF≡id
          id←name
      :EndIf
    ∇

    ∇ r←tag Enclose txt;nl
      :Access public shared
      tag←,tag
      r←(tag{NoEndTag∧0∊⍴⍵:Bracket ⍺,'/' ⋄ (Bracket ⍺),⍵,Bracket'/',⍺↑⍨¯1+⍺⍳' '}txt),NL
    ∇

    ∇ r←{a}eis w
      :Access public shared
      r←((,∘⊂)⍣((isString w)∧2>|≡w))w ⍝ enclose if simple character
    ∇

    ∇ da←args defaultArgs defaultvalues
      :Access public shared
      da←da,(⍴,da←eis args)↓defaultvalues
    ∇

    ∇ r←Quote a;b
      :Access public shared
      b←1↓<⌿¯1 0⌽'\"'∘.=';',a   ⍝ keep \" as is
      (b/a)←⊂'"'
      r←1⌽'""',∊a
    ∇

    ∇ r←attr ParseArgs args
      :Access public
      :If ~0∊⍴r←args
          :If isClass⊃args
              r←⎕NEW∘{2<⍴,⍵:(⊃⍵)({eis ⍵}(1↓⍵)) ⋄ ⍵}args
              :If 0≠⎕NC⊂'_PageRef'
                  r._PageRef←_PageRef
              :EndIf
              :If ~0∊⍴attr
                  r.SetAttr attr
              :EndIf
          :Else ⍝If isInstance⊃args
              r←args
          :EndIf
      :EndIf
    ∇

    ∇ {r}←Push args;c;cl;attr;elm
      :Access public
      :If ~0∊⍴r←args
          (cl attr)←{2↑⍵,(⍴⍵)↓'' ''}eis args
          c←Content
          :If isClass cl
              elm←⎕NEW cl
              elm.Content←c
              :If ~0∊⍴attr
                  elm.SetAttr attr
              :EndIf
              r←Content←elm
          :ElseIf 0∊⍴attr
              r←Content,⍨←⊂cl
          :Else
              'Invalid Push arguments'⎕SIGNAL 11
          :EndIf
      :EndIf
    ∇

    ∇ {r}←{attr}Add args;cl
    ⍝ add "something" to the Content
    ⍝ args can be an instance, a class, or just html/text
      :Access public
      r←''
      :If ~0∊⍴∊args
          :If 0=⎕NC'attr' ⋄ attr←'' ⋄ :EndIf
          r←attr ParseArgs args
          :Trap 4 5 ⍝ rank and length error
              Content,←r
          :Else
              Content,←⊂r
          :EndTrap
      :EndIf
    ∇

    ∇ {r}←{attr}New args;cl
    ⍝ create a new instance
    ⍝ args can be an instance, a class, or just html/text
      :Access public shared
      r←''
      :If ~0∊⍴∊args
          :If 0=⎕NC'attr' ⋄ attr←'' ⋄ :EndIf
          r←attr ParseArgs args
      :EndIf
    ∇

    ∇ {r}←{attr}Insert args;cl
    ⍝ add "something" to the beginning of Content
    ⍝ args can be an instance, a class, or just html/text
      :Access public
      r←''
      :If ~0∊⍴∊args
          :If 0=⎕NC'attr' ⋄ attr←'' ⋄ :EndIf
          r←attr ParseArgs args
          :Trap 4 5 ⍝ rank and length error
              Content,⍨←r
          :Else
              Content,⍨←⊂r
          :EndTrap
      :EndIf
    ∇

    ∇ {r}←Last
      :Access public
      r←⊃⌽Content
    ∇

    ∇ r←isClass ao
      :Access public shared
      r←9.4∊⎕NC⊂'ao'
    ∇

    ∇ r←isInstance ao
      :Access public shared
      r←9.2∊⎕NC⊂'ao'
    ∇

    ∇ r←isRef obj
      :Access public shared
      r←9∊⎕NC'obj'
    ∇

    isattr←{isString ⍵:1 ⋄ isRef ⍵:0 ⋄ ∧/∇¨⍵}

    ∇ r←isAttr obj
      :Access public shared
      r←isattr obj
    ∇

    ∇ r←renderIt It
      :Access public shared
      r←{326=⎕DR⊃⍵:{isInstance⊃⍵:(⊃⍵).Render
              isClass⊃⍵:(⎕NEW(⊃⍵)((⊃⍣(2=⊃⍴⍵))1↓⍵)).Render
              ,⍕⍵}⍵ ⋄ ,⍕⍵}It
    ∇

    ∇ r←isHtmlElement ao
      :Access public shared
      :Trap r←0
          r←⊃∨/#.HtmlElement=⎕CLASS ao
      :EndTrap
    ∇

    ∇ r←Parse string;b;s
    ⍝ Separate each section of name="..."
      :Access public
      string←(b⍲1⌽b←' '=s)/s←' ',string
      b←(' '=string)>≠\'"'=string
      r←1↓¨b⊂string ⍝ each pair
      s←r⍳¨'='      ⍝ each is separated by =
      r←s{(¯1↓⍺↑⍵)(1↓¯1↓⍺↓⍵)}¨r
    ∇

    ∇ r←GenId
      :Access public shared
      r←'id',⍕rand ¯1+2*31
    ∇

    ∇ {myid}←SetId
      :Access public
      :If UNDEF≡myid←id
          :If ''≡myid←⊃Attrs[⊂'id']
              id←myid←GenId
          :Else
              id←myid
          :EndIf
      :EndIf
    ∇

    dtlb←{⍵{((∨\⍵)∧⌽∨\⌽⍵)/⍺}' '≠⍵}

    ∇ r←ScriptFollows
      :Access public shared
      r←∊(⎕UCS 13 10)∘,¨{⍵/⍨'⍝'≠⊃¨⍵}{1↓¨⍵/⍨∧\'⍝'=⊃¨⍵}{⍵{((∨\⍵)∧⌽∨\⌽⍵)/⍺}' '≠⍵}¨(1+2⊃⎕LC)↓↓(⊃⊃⎕CLASS 1⊃⎕RSI).(180⌶)2⊃⎕SI
    ∇

    ∇ r←WrapFollowing tag;text;SplitOnSpaceLines;Trim;FirstCommentBlock
      :Access public shared

     ⍝ USAGE:
     ⍝
     ⍝      Add WrapFollowing 'p class="bodytext"'
     ⍝      ⍝ paragraph may span
     ⍝      ⍝ several lines
     ⍝      ⍝
     ⍝      ⍝ they are separated by empty comment lines
     ⍝
     ⍝ RESULT:
     ⍝
     ⍝
paragraph may span several lines

     ⍝
they are separated by empty comment lines

     ⍝

      Trim←{(∨\' '≠⍵)/⍵}¨
      FirstCommentBlock←{1↓¨⍵/⍨∧\'⍝'=⊃¨⍵}
      SplitOnSpaceLines←{1↓¨⍵⊂⍨⍵∧.=¨' '}
      text←(1+2⊃⎕LC)↓↓(⊃⊃⎕CLASS 1⊃⎕RSI).(180⌶)2⊃⎕SI

      r←tag∘#.HTMLUtils.Enclose¨∊¨SplitOnSpaceLines' ',¨⍨' ',⌽¨Trim⌽¨FirstCommentBlock Trim text
    ∇

    ∇ r←what Subst text;names;gv;i;repl;fixL;fixR
      :Access public shared
      r←text
      fixL←'[][{}()?*.+\\^$|]'⎕R'\\\0' ⍝ precede regex metacharacters by \
      fixR←'&' '%' '\\'⎕R'\\\0'        ⍝ add \ to & % \
      :Select ⎕NC⊂'what'
      :Case 9.1 ⍝ namespace
          gv←⍒∊⍴¨names←what.⎕NL ¯2 3 ⍝ variables and functions only, sort so that 'foo' matches before 'fo'
          r←(names[gv]⎕R(fixR¨⍕¨what⍎⍕names[gv]))r
      :Case 2.1 ⍝ substitution pairs
          :If 2=|≡what ⋄ what←,⊂what ⋄ :EndIf
          :If 2≠⍴⍴what ⋄ what←↑what ⋄ :EndIf
          what←,¨what
          r←(fixL¨what[;1])⎕R(fixR¨what[;2])⊢r
      :EndSelect
    ∇

    :endsection

:endclass  ⍝ HtmlElement

:class HtmlElement             ⍝ this is the most basic element of a page

⍝∇:require =\JSON.dyalog

    ⎕io←⎕ml←1

    :field public shared _version←1
    :field public NL←⎕ucs 13 ⍝ 10

    :field public Tag←''      ⍝ this is the element name
    :field public Content←⍬   ⍝ content of the element - a series of strings/instances/class+parms
    :field public Handlers←'' ⍝ array of event handlers
    :field public _PageRef←'' ⍝ reference back to the page instance containing this element
    :field public NoEndTag←0  ⍝ set to 1 if this singleton element (does not have a closing tag)
    :field public Position    ⍝ has position information for this element (if position is set)
    :field public Uses←''     ⍝ resources that will be used by this object (can be overridden by derived classes)

    :field public shared readonly _true←#.JSON.true     ⍝ same definition as in #.JSON
    :field public shared readonly _false←#.JSON.false   ⍝ same definition as in #.JSON

⍝ define shortcuts to namespaces (initialized later)
    :field public _html        ⍝ reference to base HTML elements namespace
    :field public _JQ          ⍝ reference to JQuery/JQueryUI widgets namespace
    :field public _SF          ⍝ reference to SyncFusion widgets namespace
    :field public _JSS         ⍝ reference to JavaScript Snippets namespace
    :field public _DC          ⍝ reference to Dyalog Controls namespace
    :field public _            ⍝ reference to namespace that refers to all elements/widgets

   ⍝ make shortcuts for some common HTML attributes
    :field public shared readonly UNDEF←⎕NULL  ⍝ setting for undefined attributes
    :field public id←UNDEF                     ⍝ id attribute for the element
    :field public value←UNDEF                  ⍝ value attribute for the element
    :field public name←UNDEF                   ⍝ name attribute for the element
    :field public class←UNDEF                  ⍝ class attribute for the element
    :field public style←UNDEF                  ⍝ style attribute for the element
    :field public title←UNDEF                  ⍝ title attribute for the element
    :field public type←UNDEF                   ⍝ type attribute for the element

    :field public readonly CommonAttributes←'id' 'value' 'name' 'class' 'style' 'title' 'type' ⍝ element attributes that are directly accessible

    _names←_values←0⍴⊂'' ⍝ used for attributes

    :field public _styles←''

    rand←{t←16807⌶2 ⋄r←?⍵ ⋄ t←16807⌶t ⋄ r }

    ∇ r←Version
      :Access public
      r←{⍵,[1.1]{0::¯1 ⋄ ⍵._version}¨⍵}⎕CLASS ⎕THIS
    ∇

    ∇ r←context name
      :Access public shared
      :If 326=⎕DR name ⍝ ref?
          r←⎕RSI{0∊⍴⍺:'' ⋄ 16::''
              ∨/∨/¨(⊂⍵)∊¨(⊃⍺).(⎕CLASS ⎕THIS):⊃⍺
              (1↓⍺)∇ ⍵}name
      :Else
          r←⎕RSI{0∊⍴⍺:''
              ⋄ (⊃⍺){0=⍺.⎕NC⊂⍵:0
                  ⋄ ''≡t←⍺⍎⍵:0
                  ⋄ 1}⍵:⊃⍺
              ⋄ (1↓⍺)∇ ⍵}name
      :EndIf
    ∇

    ∇ r←isChar w
      :Access public shared
      r←0 2∊⍨10|⎕DR w
    ∇

    ∇ r←isString w
      :Access public shared
      :Select ≡w
      :Case 2
          :If 1=⍴,w
              r←{(isChar ⍵)∧1∊⍴⍴1/⍵}⊃w
          :Else
              r←0
          :EndIf
      :CaseList 0 1
          r←{(isChar ⍵)∧1∊⍴⍴1/⍵}w
      :Else
          r←0
      :EndSelect
    ∇

    ∇ r←quote w
      :Access public
      r←{'"'∊⍵:⍵ ⋄ '"',⍵,'"'}w
    ∇

    ∇ r←isTrue a
      :Access public shared
      →0⍴⍨r←(,1)≡,a
      →0⍴⍨r←#.JSON.true≡a
      →0⍴⍨r←'true'≡a
    ∇

    ∇ r←isFalse a
      :Access public shared
      →0⍴⍨r←(,0)≡,a
      →0⍴⍨r←#.JSON.false≡a
      →0⍴⍨r←'false'≡a
    ∇

    ∇ r←a ine w
      :Access public shared
      r←a{0∊⍴⍺:'' ⋄ ⍵}w ⍝ if not empty
    ∇
    errorIf←{⍺←⊢ ⋄ 0≠⍵:⍺ ⎕SIGNAL ⍵ ⋄ ''}

    :section Attribute Handling

    ∇ r←fixkeys w
      :Access public shared
      r←{2>|≡⍵:,⊂⍵ ⋄ ⍵}w ⍝ Enclose if simple
    ∇

    ∇ SyncAttrs arg
      :Implements Trigger id,name,class,style,title,type,value
      :If ⊃≢/arg.(NewValue OldValue)
          arg.Name Set arg.NewValue
      :EndIf
    ∇

    :property keyed Attrs       ⍝ element attributes
    :access public

        ∇ set ra;i;new;there;names;ind
          there←~new←(⍴_names)<i←_names⍳names←fixkeys⊃ra.Indexers
          (_values _names),←new∘/¨ra.NewValue names
          _values[there/i]←there/ra.NewValue
          :For i :In {⍵/⍳⍴⍵}7≥'id' 'class' 'style' 'title' 'value' 'type' 'name'⍳names
              ⍎(i⊃names),'←i⊃ra.NewValue'
          :EndFor
        ∇

        ∇ r←get ra;i;n
          ⎕SIGNAL(1<⍴i←ra.Indexers)⍴4 ⍝ RANK err
          :If 1↑ra.IndexersSpecified
              r←(_values,⊂'')[_names⍳n←fixkeys⊃⍣(2≤|≡i)+i]
          :Else
              r←↓_names,[1.1]_values
          :EndIf
        ∇
    :endproperty

    ∇ attr←{plain}ParseAttr arg;split;item;t;f;i;eq;nq;items;n
      :Access public shared
      ⍝ Parse html sttributes
⍝
⍝     1)    In only the first token, a simple string (i.e. not in the form 'abc=def') without a leading '#' or '.' is treated as an id
⍝        'foo'  > id="foo"
⍝
⍝        In all other positions, a string of this type is treated as a singleton attribute
⍝        'foo' 'goo' 'moo' > id="foo" goo="goo" moo="moo"
⍝
⍝     2)    Single simple string beginning with '#' is an id
⍝        '#foo'  > id="foo"
⍝        'goo=moo' '#foo' > goo="moo" id="foo"
⍝
⍝     3)    Single simple string beginning with '.' is treated as a class
⍝        '.foo'  > class="foo"
⍝        'foo' '.goo' 'moo' > id="foo" class="goo" moo="moo"
⍝
⍝     4)    Attributes must be paired either as in 'foo=goo' or ('foo' 'goo'), if there is a single pair, it must be enclosed
⍝        ⊂'href' '#top'  > href="#top"
⍝
⍝        The value portion of an attribute pair may begin with '#' or '.' without special interpretation
⍝        ('href' '#top') '#foo' > href="#top" id="foo"

      :If 0=⎕NC'plain' ⋄ plain←0 ⋄ :EndIf
      arg←eis,arg
      attr←⍬
      split←{0=⊢/v←∨\(≠\'"'=⍵)<'='=⍵:⍵ ⋄ ((~v)/⍵)({'"'∧.=∊1 ¯1↑¨⊂⍵:¯1↓1↓⍵ ⋄ ⍵}1↓v/⍵)}
      :For i :In ⍳⍴arg
          :Select |≡item←,i⊃arg
          :Case 1
              :If ~0∊⍴item
                  :If ∨/eq←'='=item              ⍝ any '=' (i.e.
                  :AndIf 0≠n←eq+.∧nq←~≠\'"'=item
                      :If n=1
                          attr,←⊂split item
                      :Else
                          attr,←⊃,/1 ParseAttr¨item{⎕ML←3 ⋄ ⍵⊂⍺}nq⍲item=' '
                      :EndIf
                  :ElseIf 3>f←'#.'⍳1↑item
                      attr,←⊂((f⊃'id' 'class')(1↓item))
                  :ElseIf plain<i=1
                      attr,←⊂'id'item
                  :Else
                      attr,←⊂2⍴⊂item
                  :EndIf
              :EndIf
          :Case 2
              attr,←⊂item
          :Else
              ('Invalid attribute specification: ',⍕item)⎕SIGNAL 11
          :EndSelect
      :EndFor
    ∇

    ∇ {r}←{which}Set attr
      :Access public
      :If 0≠⎕NC'which' ⋄ attr←↓(eis which),[1.1]eis attr
      :Else
          'Set cannot be called with a scalar ref'⎕SIGNAL 11/⍨(0=≡attr)∧326∊⎕DR attr

          :If 2=⍴,attr  ⍝ 'attr' 'value' is never shorthanded (e.g. given special treatment for id/class)
          :AndIf 1∧.≥≡¨attr
              attr←,⊂attr
          :EndIf

          attr←1 ParseAttr attr
      :EndIf
      :If ~0∊⍴attr
          Attrs[1⊃¨attr]←2⊃¨attr
      :EndIf
      r←⎕THIS
    ∇

    ∇ {r}←{which}SetAttribute attr
    ⍝ set attributes, treating

      :If 0≠⎕NC'which' ⋄ attr←↓(eis which),[1.1]eis attr
      :Else
          'Set cannot be called with a scalar ref'⎕SIGNAL 11/⍨(0=≡attr)∧326∊⎕DR attr
          attr←ParseAttr attr
      :EndIf
      :If ~0∊⍴attr
          Attrs[1⊃¨attr]←2⊃¨attr
      :EndIf
      r←⎕THIS
    ∇

    ∇ {r}←{which}SetAttr attr
      :Access public
      :If 0=⎕NC'which' ⋄ r←SetAttribute attr
      :Else ⋄ r←which SetAttribute attr
      :EndIf
    ∇

    ∇ {r}←DelAttr attrname;mask
      :Access public
      attrname←eis attrname
      mask←~_names∊attrname ⋄ (_names _values)←mask∘/¨_names _values
      r←⎕THIS
    ∇

    ∇ r←{proto}GetAttr attrname
      :Access public
      :If 0=⎕NC'proto' ⋄ proto←'' ⋄ :EndIf
      attrname←eis attrname
      :If 1=⍴attrname
          :Trap 3 ⍝ index error
              r←_values⊃⍨_names⍳attrname
          :Else
              r←proto
          :EndTrap
      :Else
          proto∘GetAttr¨attrname
      :EndIf
    ∇

    :EndSection

    :Section Styles

    ∇ {r}←{what}Style styles;msg
      :Access public
      msg←'Invalid style specification'
      :If 0≠⎕NC'what'
          _styles,←↓(eis what),⍪eis((⍕¨)⍣(2|⎕DR styles))styles
      :Else
          :Select ≡styles
          :Case 2
              msg errorIf 11×0≠2|⍴styles
              _styles,←↓(2,⍨0.5×⍴styles)⍴styles
          :Case 3
              msg errorIf 11×~∧/(,2)∘≡∘⍴¨styles
              _styles,←styles
          :Else
              msg ⎕SIGNAL 11
          :EndSelect
      :EndIf
      r←⎕THIS
    ∇

    ∇ r←RenderStyles;style
      r←''
      :If ~0∊⍴_styles
          :For style :In _styles
              r,←∊(⍕¨style),¨':;'
          :EndFor
          r←' style="',r,'" '
      :EndIf
    ∇

    :EndSection

  ⍝ The constructors

  ⍝ The first arg is the Tag, followed by its contents, then its attributes, if present
  ⍝ Note that attributes can be specified with the tag as in
  ⍝  button type="submit"

    :Section Constructors

    ∇ Make0
    ⍝ basic constructor
      :Implements constructor
      :Access public
      Init
    ∇

    ∇ Make1 t    ⍝ this can be any length
    ⍝ t - tag/element name (e.g. 'div' or 'table')
      :Implements constructor
      :Access public
      Tag←t
      Init
    ∇

    ∇ Make2(t arg)
    ⍝ t - tag/element name (e.g. 'div' or 'table')
    ⍝ arg - content or (content attrs)
      :Implements constructor
      :Access public
      Make2Code(t arg)
    ∇

    ∇ Make2Code(t arg);attr;content;ref
      :If 1=≡t arg                      ⍝ handle 2-character tag (e.g. 'ul' 'tr')
          Tag←t,arg
      :Else
        ⍝ If we have a couple of items, the second of which is
        ⍝ a string or VTV, then we are dealing with attributes:
          :If (,2)≡⍴arg
          :AndIf isAttr 2⊃arg
              (content attr)←arg ⋄ SetAttr attr
          :Else
              content←arg
          :EndIf
          Content,←arg
          Tag←t
      :EndIf
      Init
    ∇

    ∇ Make3(t content attr);ref
    ⍝ t - tag/element name (e.g. 'div' or 'table')
    ⍝ content - content
    ⍝ attr - attrs
      :Implements constructor
      :Access public
      :If 1=≡t content attr    ⍝ handle 3-character tag (e.g. 'pre')
          Tag←t,content,attr
      :ElseIf isClass content
          Make2Code t(content attr)
      :Else
          Tag←t
         ⍝ attr could be a ref. This means that it goes in the contents.
          Add content
          :If (0∊⍴attr)⍱ref←isRef attr
              SetAttr attr
          :ElseIf ref
              Add attr
          :EndIf
      :EndIf
      Init
    ∇

    ∇ Init
      (_html _JQ _SF _DC _JSS _)←#.(_html _JQ _SF _DC _JSS _)
      Position←⎕NS''
    ∇

    ∇ SetUse;c
      :Access public overridable
      :If ~0∊⍴Uses
          :Trap 0
              :If ''≡c←_PageRef
                  c←context'_PageRef'
                  :If ~0∊⍴c
                      c←c._PageRef
                  :EndIf
              :EndIf
              :If ~0∊⍴c
                  c.Use Uses
              :EndIf
          :EndTrap
      :EndIf
    ∇

    ∇ Use resource
      :Access public
      :If ~0∊⍴Uses ⋄ Uses←eis Uses ⋄ :EndIf
      Uses,←eis resource
    ∇

    :endsection

    :section Event Handling

    ∇ {r}←On handler
      :Access public
      handler←eis handler
      Handlers,←r←⎕NEW #._JQ.Handler
      r.(Events Callback ClientData JavaScript Delegates jQueryWrap ScriptWrap Hourglass)←8↑handler,(⍴handler)↓'' 1 '' '' '' 1 1 ¯1
      :If ¯1=r.Hourglass ⋄ r.Hourglass←(,0)≢,r.Callback ⋄ :EndIf
    ∇

    ∇ r←RenderHandlers;myid;h
      :Access public ⍝!!! remove this after testing
      r←''
      :If ~0∊⍴Handlers
          :If ∨/0∘∊∘⍴¨Handlers.Selectors
              myid←SetId
          :EndIf
          :For h :In Handlers
              :If 0∊⍴h.Selectors
                  h.Selectors←'#',myid
              :EndIf
              r,←h.Render
          :EndFor
      :EndIf
    ∇
    :endsection

    :section Rendering

⍝ Elements with no End tag (<tag></tag>).

⍝ area base basefont br col frame hr img input isindex link meta param

    fmtAttr←{' ',⍺,'=',Quote HtmlSafeText,⍕⍵}

    ∇ r←Render;av;t;vs;e;h;c;p
      :Access public
    ⍝ Render by first constructing the Tag, complete with attributes, if any
      r←RenderCore Content
      :If ~0∊⍴av←Tag
          h←RenderHandlers
          p←RenderPosition
          :If 0<⍴vs←Attrs[]
              av,←∊fmtAttr/¨vs
          :EndIf
          av,←RenderStyles
          r←(av Enclose r),h,p
      :EndIf
    ∇

    ∇ r←Postrender r
      :Access overridable
    ∇

    ∇ r←RenderCore list;e;t
      :Access public
    ⍝ do the bulk of the rendering work
      r←''
      :For e :In eis list
          :If isInstance⊃e
              r,←e.Render
          :ElseIf isClass⊃e
              r,←(⎕NEW e).Render
          :Else
              :If 1<⍴⍴t←⍕e
                  t←∊(↓t),¨⊂'
'
              :EndIf
              r,←t
          :EndIf
      :EndFor
    ∇

    ∇ r←HtmlSafeText txt;i;m;u;ucs
      :Access public shared
    ⍝ make text HTML "safe"
      r←,⎕FMT txt
      i←'&<>"#'⍳r
      i-←(i=1)∧1↓(i=5),0 ⍝ mark & that aren't &#
      m←i∊⍳4
      u←127<ucs←⎕UCS r
      (m/r)←('&' '<' '>' '"')[m/i]
      (u/r)←(~∘' ')¨↓'G<&#ZZZ9;>'⎕FMT u/ucs
      r←∊r
    ∇

    ∇ r←RenderPosition
      :Access public
      r←''
      :If 9=⎕NC'Position'
      :AndIf ~0∊⍴Position.⎕NL-2
          Uses,←⊂'JQueryUI'
          r←#.JQ.JQueryfn'position'('#',SetId)Position
          Use
      :EndIf
    ∇

    :endsection

    :section Utilities

    Bracket←{'<',⍵,'>'}

    ∇ SetInputName
      :Access public
      ⍝ for input element widgets, this will set the name to the id if not already set
      ⍝ or the id to the name if not already set
      :If (⊂name)∊UNDEF''
          :If (⊂id)∊UNDEF''
              SetId
          :EndIf
          name←id
      :ElseIf UNDEF≡id
          id←name
      :EndIf
    ∇

    ∇ r←tag Enclose txt;nl
      :Access public shared
      tag←,tag
      r←(tag{NoEndTag∧0∊⍴⍵:Bracket ⍺,'/' ⋄ (Bracket ⍺),⍵,Bracket'/',⍺↑⍨¯1+⍺⍳' '}txt),NL
    ∇

    ∇ r←{a}eis w
      :Access public shared
      r←((,∘⊂)⍣((isString w)∧2>|≡w))w ⍝ enclose if simple character
    ∇

    ∇ da←args defaultArgs defaultvalues
      :Access public shared
      da←da,(⍴da←eis args)↓defaultvalues
    ∇

    ∇ r←Quote a;b
      :Access public shared
      b←1↓<⌿¯1 0⌽'\"'∘.=';',a   ⍝ keep \" as is
      (b/a)←⊂'"'
      r←1⌽'""',∊a
    ∇

    ∇ r←attr ParseArgs args
      :Access public
      :If ~0∊⍴r←args
          :If isClass⊃args
              r←⎕NEW∘{2<⍴,⍵:(⊃⍵)({eis ⍵}(1↓⍵)) ⋄ ⍵}args
              :If 0≠⎕NC⊂'_PageRef'
                  r._PageRef←_PageRef
              :EndIf
              :If ~0∊⍴attr
                  r.SetAttr attr
              :EndIf
          :Else ⍝If isInstance⊃args
              r←args
          :EndIf
      :EndIf
    ∇

    ∇ {r}←Push args;c;cl;attr;elm
      :Access public
      :If ~0∊⍴r←args
          (cl attr)←{2↑⍵,(⍴⍵)↓'' ''}eis args
          c←Content
          :If isClass cl
              elm←⎕NEW cl
              elm.Content←c
              :If ~0∊⍴attr
                  elm.SetAttr attr
              :EndIf
              r←Content←elm
          :ElseIf 0∊⍴attr
              r←Content,⍨←⊂cl
          :Else
              'Invalid Push arguments'⎕SIGNAL 11
          :EndIf
      :EndIf
    ∇

    ∇ {r}←{attr}Add args;cl
    ⍝ add "something" to the Content
    ⍝ args can be an instance, a class, or just html/text
      :Access public
      r←''
      :If ~0∊⍴∊args
          :If 0=⎕NC'attr' ⋄ attr←'' ⋄ :EndIf
          r←attr ParseArgs args
          :Trap 4 5 ⍝ rank and length error
              Content,←r
          :Else
              Content,←⊂r
          :EndTrap
      :EndIf
    ∇

    ∇ {r}←{attr}New args;cl
    ⍝ create a new instance
    ⍝ args can be an instance, a class, or just html/text
      :Access public shared
      r←''
      :If ~0∊⍴∊args
          :If 0=⎕NC'attr' ⋄ attr←'' ⋄ :EndIf
          r←attr ParseArgs args
      :EndIf
    ∇

    ∇ {r}←{attr}Insert args;cl
    ⍝ add "something" to the beginning of Content
    ⍝ args can be an instance, a class, or just html/text
      :Access public
      r←''
      :If ~0∊⍴∊args
          :If 0=⎕NC'attr' ⋄ attr←'' ⋄ :EndIf
          r←attr ParseArgs args
          :Trap 4 5 ⍝ rank and length error
              Content,⍨←r
          :Else
              Content,⍨←⊂r
          :EndTrap
      :EndIf
    ∇

    ∇ {r}←Last
      :Access public
      r←⊃⌽Content
    ∇

    ∇ r←isClass ao
      :Access public shared
      r←9.4∊⎕NC⊂'ao'
    ∇

    ∇ r←isInstance ao
      :Access public shared
      r←9.2∊⎕NC⊂'ao'
    ∇

    ∇ r←isRef obj
      :Access public shared
      r←9∊⎕NC'obj'
    ∇

    isattr←{isString ⍵:1 ⋄ isRef ⍵:0 ⋄ ∧/∇¨⍵}

    ∇ r←isAttr obj
      :Access public shared
      r←isattr obj
    ∇

    ∇ r←renderIt It
      :Access public shared
      r←{326=⎕DR⊃⍵:{isInstance⊃⍵:(⊃⍵).Render
              isClass⊃⍵:(⎕NEW(⊃⍵)((⊃⍣(2=⊃⍴⍵))1↓⍵)).Render
              ,⍕⍵}⍵ ⋄ ,⍕⍵}It
    ∇

    ∇ r←isHtmlElement ao
      :Access public shared
      :Trap r←0
          r←⊃∨/#.HtmlElement=⎕CLASS ao
      :EndTrap
    ∇

    ∇ r←Parse string;b;s
    ⍝ Separate each section of name="..."
      :Access public
      string←(b⍲1⌽b←' '=s)/s←' ',string
      b←(' '=string)>≠\'"'=string
      r←1↓¨b⊂string ⍝ each pair
      s←r⍳¨'='      ⍝ each is separated by =
      r←s{(¯1↓⍺↑⍵)(1↓¯1↓⍺↓⍵)}¨r
    ∇

    ∇ r←GenId
      :Access public shared
      r←'id',⍕rand ¯1+2*31
    ∇

    ∇ {myid}←SetId
      :Access public
      :If UNDEF≡myid←id
          :If ''≡myid←⊃Attrs[⊂'id']
              id←myid←GenId
          :Else
              id←myid
          :EndIf
      :EndIf
    ∇

    dtlb←{⍵{((∨\⍵)∧⌽∨\⌽⍵)/⍺}' '≠⍵}

    ∇ r←ScriptFollows
      :Access public shared
      r←∊(⎕UCS 13 10)∘,¨{⍵/⍨'⍝'≠⊃¨⍵}{1↓¨⍵/⍨∧\'⍝'=⊃¨⍵}{⍵{((∨\⍵)∧⌽∨\⌽⍵)/⍺}' '≠⍵}¨(1+2⊃⎕LC)↓↓(⊃⊃⎕CLASS 1⊃⎕RSI).(180⌶)2⊃⎕SI
    ∇

    ∇ r←WrapFollowing tag;text;SplitOnSpaceLines;Trim;FirstCommentBlock
      :Access public shared

     ⍝ USAGE:
     ⍝
     ⍝      Add WrapFollowing 'p class="bodytext"'
     ⍝      ⍝ paragraph may span
     ⍝      ⍝ several lines
     ⍝      ⍝
     ⍝      ⍝ they are separated by empty comment lines
     ⍝
     ⍝ RESULT:
     ⍝
     ⍝
paragraph may span several lines

     ⍝
they are separated by empty comment lines

     ⍝

      Trim←{(∨\' '≠⍵)/⍵}¨
      FirstCommentBlock←{1↓¨⍵/⍨∧\'⍝'=⊃¨⍵}
      SplitOnSpaceLines←{1↓¨⍵⊂⍨⍵∧.=¨' '}
      text←(1+2⊃⎕LC)↓↓(⊃⊃⎕CLASS 1⊃⎕RSI).(180⌶)2⊃⎕SI

      r←tag∘#.HTMLUtils.Enclose¨∊¨SplitOnSpaceLines' ',¨⍨' ',⌽¨Trim⌽¨FirstCommentBlock Trim text
    ∇

    ∇ r←what Subst text;names;gv;i;repl;fixL;fixR
      :Access public shared
      r←text
      fixL←'[][{}()?*.+\\^$|]'⎕R'\\\0' ⍝ precede regex metacharacters by \
      fixR←'&' '%' '\\'⎕R'\\\0'        ⍝ add \ to & % \
      :Select ⎕NC⊂'what'
      :Case 9.1 ⍝ namespace
          gv←⍒∊⍴¨names←what.⎕NL ¯2 3 ⍝ variables and functions only, sort so that 'foo' matches before 'fo'
          r←(names[gv]⎕R(fixR¨⍕¨what⍎⍕names[gv]))r
      :Case 2.1 ⍝ substitution pairs
          :If 2=|≡what ⋄ what←,⊂what ⋄ :EndIf
          :If 2≠⍴⍴what ⋄ what←↑what ⋄ :EndIf
          what←,¨what
          r←(fixL¨what[;1])⎕R(fixR¨what[;2])⊢r
      :EndSelect
    ∇

    :endsection

:endclass  ⍝ HtmlElement


figured out how to transpose and divide up into two tracks, one for each santa

#!/usr/local/bin/apl -s

cmds ← ('<' '>' '^' 'v')
dirs ← ((¯1 0) (1 0) (0 ¯1) (0 1))

in ← ⍞
len ← ⍴ in
hlen ← { ⍵ ÷ 2 } ⍴ in
ranks ← ⍉ (hlen, 2) ⍴ (1, len) ⍴ in ⍝ divide into two rows, odds and evens
houses ← { (0 0) , { ++\⍵ } { dirs[cmds ⍳ ⍵] } ⍵ }
allhouses ← ∪ , { houses ranks[⍵;] } (1 2)

⍴ allhouses ~ 0

)OFF

#!/usr/local/bin/apl -s

cmds ← ('<' '>' '^' 'v')
dirs ← ((¯1 0) (1 0) (0 ¯1) (0 1))

in ← ⍞
len ← { ⍵ ÷ 2 } ⍴ in
ranks ← (len, 2) ⍴ in ⍝ divide into two rows, odds and evens
houses ← { (0 0) , { ++\⍵ } { dirs[cmds ⍳ ⍵] } ⍵ }
allhouses ← ∪ , { houses ranks[⍵;] } (1 2)

ranks
allhouses
⍴ allhouses

)OFF


format fixed

format fixed

:Class ejDateTimePickerAdvanced : MiPageSample
⍝ Control:: _SF.ejDateTimePicker
⍝ Description::  advance functionality.
⍝ Show 2 calendars to select reservation dates.
⍝ Display the time difference as result.

    ∇ Compose;today;fromidn;tbl;tr;td;head;todate;from;now;to
      :Access Public
      today←3↑now←⎕TS
      fromidn←dateToIDN today

      Add _.h2'R.U. Inn'_.br'Motel reservation system'

    ⍝ The in date
      from←'in'New _SF.ejDateTimePicker now'yyyy/MM/dd HH:mm'
    ⍝ The callback should return the date (value) of the argument for the IN date/time
    ⍝ and the model's value for the OUT date/time
      from.On'change' 'setNewDate',⊂('in' 'argument' 'value')('out' 'eval' '$("#out").ejDateTimePicker("model.value")')

    ⍝ The out date
      todate←IDNToDate fromidn+7
      to←'out'New _SF.ejDateTimePicker todate'yyyy/MM/dd HH:mm'
      to.On'change' 'setNewDate',⊂('out' 'argument' 'value')('in' 'eval' '$("#in").ejDateTimePicker("model.value")')

      Add #._.InputGrid('Check In' 'Check Out',⍪from to)

      'diff'Add _.div
    ∇

    newDate←{'⍎new Date("',(⍕⍵),'")'}
    dateToIDN←{d←2 ⎕NQ'.' 'datetoidn'⍵ ⋄ d+(60⊥3↓6↑⍵)÷86400}
    IDNToDate←{d←3↑2 ⎕NQ'.' 'idntodate'⍵ ⋄ d,0 60 60⊤⌊86400×1|⍵}

    ∇ r←setNewDate;in;out
      :Access public

    ⍝ Find the difference between the dates
      in←dateToIDN stringToDate Get'in'
      out←dateToIDN stringToDate Get'out'
      :If in>out
          r←'#diff'Replace'Going back in time?'
      :Else
          r←'#diff'Replace'The difference in days is: ',⍕out-in
      :EndIf
    ∇

    MONTHS←↓12 3⍴'JanFebMarAprMayJunJulAugSepOctNovDec'

    FI←{(b v)←⎕vfi ⍵ ⋄ b/v}

    ∇ dt←stringToDate str;pos;mon;t;ymd
     ⍝ str is of the genre "Wed Aug 05 2015 07:30:21 GMT-0400 (Eastern Daylight Time)"
     ⍝ We need to weed out the day of the week and the time
      str←(+/∧\' '=str)↓str           ⍝ remove the leading spaces
     ⍝ What kind of string is this?
      :If ~∧/1⊃(dt dt)←{b←~⍵∊'/-:' ⋄ ⎕VFI b\b/⍵}str  ⍝ yyyy/mm/dd hh:mm:ss ?
          :If 0∊⍴t←MONTHS ⎕S 0 3⊢str      ⍝ look for the month as a string. If not found
              ymd←3↑FI str                ⍝ grab the 1st 3 numbers found
              ymd←ymd[⍒(2×31<ymd)+ymd<12] ⍝ put in correct order
          :Else                           ⍝ otherwise (if found)
              (pos mon)←0 1+1⊃t
              :If ~0∊⍴t←FI pos↑str        ⍝ any number before the month? (e.g. 2 May 2021)
                  ymd←⌽⍣(31<⍬⍴t)⊢(1↑FI pos↓str),mon,t
              :Else
                  ymd←¯1⌽mon,2↑FI pos↓str
              :EndIf
          :EndIf
     ⍝ Now grab the time
          dt←ymd,FI⍕'(\d+):(\d+):(\d+)'⎕S'\1 \2 \3'⊢str
      :EndIf
    ∇

:EndClass

:Class ejDateTimePickerAdvanced : MiPageSample
⍝ Control:: _SF.ejDateTimePicker
⍝ Description::  advance functionality.
⍝ Show 2 calendars to select reservation dates.
⍝ Display the time difference as result.

    ∇ Compose;today;fromidn;tbl;tr;td;head;todate;from;now;to
      :Access Public
      today←3↑now←⎕TS
      fromidn←dateToIDN today

      Add _.h2'R.U. Inn'_.br'Motel reservation system'

    ⍝ The in date
      from←'in'New _SF.ejDateTimePicker now'yyyy/MM/dd HH:mm'
    ⍝ The callback should return the date (value) of the argument for the IN date/time
    ⍝ and the model's value for the OUT date/time
      from.On'change' 'setNewDate',⊂('in' 'argument' 'value')('out' 'eval' '$("#out").ejDateTimePicker("model.value")')

    ⍝ The out date
      todate←IDNToDate fromidn+7
      to←'out'New _SF.ejDateTimePicker todate'yyyy/MM/dd HH:mm'
      to.On'change' 'setNewDate',⊂('out' 'argument' 'value')('in' 'eval' '$("#in").ejDateTimePicker("model.value")')

      Add #._.InputGrid('Check In' 'Check Out',⍪from to)

      'diff'Add _.div
    ∇

    newDate←{'⍎new Date("',(⍕⍵),'")'}
    dateToIDN←{d←2 ⎕NQ'.' 'datetoidn'⍵ ⋄ d+(60⊥3↓6↑⍵)÷86400}
    IDNToDate←{d←3↑2 ⎕NQ'.' 'idntodate'⍵ ⋄ d,0 60 60⊤⌊86400×1|⍵}

    ∇ r←setNewDate;in;out
      :Access public

    ⍝ Find the difference between the dates
      in←dateToIDN stringToDate⍕Get'in'
      out←dateToIDN 6↑{b←~⍵∊'/-:' ⋄ FI b\b/⍵}Get'out'

    ⍝ If the new IN date is not before the OUT date we reset OUT to 1 week after
      :If in>out
          r←'#diff'Replace'Going back in time?'
      :Else
          r←'#diff'Replace'The difference in days is: ',⍕out-in
      :EndIf
    ∇

    MONTHS←↓12 3⍴'JanFebMarAprMayJunJulAugSepOctNovDec'

    FI←{(b v)←⎕vfi ⍵ ⋄ b/v}

    ∇ dt←stringToDate str;pos;mon;t;ymd
     ⍝ str is of the genre "Wed Aug 05 2015 07:30:21 GMT-0400 (Eastern Daylight Time)"
     ⍝ We need to weed out the day of the week and the time
      str←(+/∧\' '=str)↓str           ⍝ remove the leading spaces
      :If 0∊⍴t←MONTHS ⎕S 0 3⊢str      ⍝ look for the month as a string. If not found
          ymd←3↑FI str                ⍝ grab the 1st 3 numbers found
          ymd←ymd[⍒(2×31<ymd)+ymd<12] ⍝ put in correct order
      :Else                           ⍝ otherwise (if found)
          (pos mon)←0 1+1⊃t
          :If ~0∊⍴t←FI pos↑str        ⍝ any number before the month? (e.g. 2 May 2021)
              ymd←⌽⍣(31<⍬⍴t)⊢(1↑FI pos↓str),mon,t
          :Else
              ymd←¯1⌽mon,2↑FI pos↓str
          :EndIf
      :EndIf
     ⍝ Now grab the time
      dt←ymd,FI⍕'(\d+):(\d+):(\d+)'⎕S'\1 \2 \3'⊢str
    ∇

:EndClass