REM >Director:Menu.System.Switch
REM >Version 1.10 02Aug2001

REM *********************** Setup ******************************
REM This routine requires MODIFIED (supplied) versions of both
REM DoClose and Close to work!
REM
REM The routine may be attached to either filters or menus
REM Menus:   "Dynamic:/Director:Menus.System.Switch -do Menu"
REM Filters: "Dynamic:/Director:Menus.System.Switch"

REM *********************** History ****************************
REM 1.00 22Sep95 -- created by Russel Thickings
REM 1.01 27Sep95 -- modified by Nick Craig-Wood
REM   Create a back window of our own to get rid of Director$Switch
REM   Sort the windows with task titles
REM   Break too long titles at . or :
REM   Have a -sub on each title which shows the close menu

REM 1.02 14Jul2000 -- tweaked by H.Bazley
REM   Filter out a few more back windows
REM   improve <untitled> handling
REM 1.03 29Dec2000
REM   Fix endless loop for null indirected window titles
REM 1.10 02Aug2001
REM   'RISC OS 4-compatible' version - uses underline instead of
REM    coloured background
REM   Strips out task names from window titles if present
REM   Attempts to split long titles at nearest 'whole word'
REM 1.11 29Sep2003
REM
REM *********************** !Help ******************************
REM The routine creates a menu containing a list of ALL active
REM windows (not iconised or pinned) and the task the window
REM belongs to.
REM Clicking on any option in the menu brings the window to the
REM top of the stack. The window from which the menu was
REM initiated (if any) will have a tick in front of its option.
REM The menu options are also colour coded, with Filer windows
REM in blue, and other tasks in black. Any window containing
REM modified data is red, untitled windows in green.
REM If the window title exceeds 64 characters it is shortened to
REM the last 63 characters, but preceded with an ellipsis to
REM indicate that the true title is longer.

ON ERROR PROCerror
SYS "XHourglass_On"
buffer_size%=1023
DIM buffer% buffer_size%
do$="":arg$=""

SYS "OS_GetEnv" TO in$
do$=FNarg(in$,"-do","")
IF do$="Sub" THEN
  owin%=VAL(FNread("Director$SwitchMenu"))
ELSE
  owin%=VAL(FNread("Director$Window"))
ENDIF

SYS "XOS_GetEnv" TO comm%
SYS "XOS_ReadArgs",",quit,do/a/k,window,",comm%,buffer%,1023 TO ;F%
IF (F% AND 1)= 0 THEN
  do$=FNlcase(FNstring(buffer%!8))
  arg$=FNlcase(FNstring(buffer%!12))
  IF do$="submenu" THEN
    owin%=VAL(arg$)
  ENDIF
ENDIF


Menu%=FNswi_number("Director_Menu")
Option%=FNswi_number("Director_Option")
Command%=FNswi_number("Director_Command")



directorWindow%=0
directorWindow%=VAL(FNread("Director$Window"))
Menu$="""Switch to Window..."" Switch -temp"

SYS "Wimp_Initialise",310,&4B534154,"Switch" TO ,handle%

win%=FNcreate_back_window
REM Get first Window in front of Iconbar/Director: Keys
buffer%!0=win%
SYS "Wimp_GetWindowInfo",,buffer% OR 1
win%=buffer%!28

SYS Menu%,Menu$

max_n%=200
DIM option$(max_n%),command$(max_n%)

n%=0
WHILE win%<>-1 AND n%<max_n%
  REM next window
  buffer%!0=win%
  SYS "Wimp_GetWindowInfo",,buffer% OR 1
  old_win%=win%
  win%=buffer%!28
  REM Is window draggable?   (If not, probably back window)
  REM Is window a pane?
  IF (buffer%!32 AND 1<<1) AND ( (buffer%!32 AND 1<<5) =0) THEN

    REM what task does it belong to ?
    SYS "Wimp_SendMessage",0,buffer%,old_win%,0 TO ,,task_handle%
    SYS "XTaskManager_TaskNameFromHandle",task_handle% TO task$;flags%
    REM Ignore CoolSwitch
    IF (flags% AND 1)=0 AND task$<>"CoolSwitch" THEN
      REM obtain window title
      a%=((buffer%!60) AND &100): REM title direct/indirect ?

      IF a% THEN
        IF buffer%!76>1 THEN
          SYS "Wimp_TransferBlock",task_handle%,buffer%!76,handle%,buffer%,256
          title$ = FN0(buffer%)
          IF title$="" THEN title$="<untitled>"
        ELSE
          title$="<untitled>"
        ENDIF
      ELSE
          title$ = FN0(buffer%+76)
        ENDIF

      REM Ignore known hidden/keys windows
      IF NOT ((task$="Task Manager" AND title$="Grab keys") OR (task$="Virtual Desktop" AND title$="Dummy") OR (task$="Director" AND title$="Keys")) THEN
        REM remove leading spaces
        WHILE LEFT$(title$,1)<=" " AND LEN(title$)>0
        title$=MID$(title$,2)
        ENDWHILE

        REM convert "
        a%=INSTR(title$,"""")
        char$=""
        WHILE a%
          title$=LEFT$(title$,a%-1)+char$+MID$(title$,a%+1)
          a%=INSTR(title$,"""",a%)
          IF char$="" THEN char$="" ELSE char$=""
        ENDWHILE

        REM obtain Task name
        IF INSTR(title$,task$)=1 THEN title$=FNstrip(title$,task$)

        REM create menu text, colours, tick etc..
        col$=""
        IF task$="Filer" THEN col$=" -fg 8"
        a%=INSTR(title$,"<",a%)
        WHILE a%<>0
          title$=LEFT$(title$,a%-1)+"|"+MID$(title$,a%)
          a%=INSTR(title$,"<",a%+2)
        ENDWHILE

        IF INSTR(title$,"<Untitled")<>0 OR INSTR(title$,"<untitled")<>0THEN col$=" -fg 13"

        IF INSTR(title$," *") THEN col$=" -fg 11"
        IF old_win%=owin% THEN col$=col$+" -tick"

        REM maximum menu width includes <CR> at end of string, remember!
        REM if greater preceed menu option with dots
        IF (LEN(title$)+3)>63 THEN title$=""+FNsplittitle(RIGHT$(title$,64-3))
          REM menu width, minus <CR>, minus "", minus length of task$,
          REM  minus " - "
          title$=task$+" - "+title$+""""+col$

          REM create menu option and command
          option$(n%)=title$+" -sub ""Dynamic:Set Director$Window "+STR$(old_win%)+"||M/Director:Menus.System.Close"""
          command$(n%)="/Director:Menus.System.DoClose -do Top -window "+STR$(old_win%)
          n%+=1
        ENDIF
      ENDIF
    ENDIF
  ENDIF
ENDWHILE

SYS "Wimp_CloseDown",handle%,&4B534154

IF n%>0 THEN
  PROCqsort(0,n%-1)

a%=INSTR(option$(0),"-")
old_task$=LEFT$(option$(0),a%-1)

  FOR i%=1 TO n%
    a%=INSTR(option$(i%),"-")
    task$=LEFT$(option$(i%),a%-1)
    title$=MID$(option$(i%),a%+1)
    SYS Option%,""""+option$(i%-1)
    IF old_task$<>task$ AND i%<>n% THEN SYS"Director_Dash"
    SYS Command%,command$(i%-1)
    old_task$=task$
  NEXT i%
ELSE
  SYS Option%,"""No windows"" -grey"
ENDIF
*EndMenu
*Set Director$Menu Switch
SYS "Hourglass_Off"
END

DEF FN0(a%)
LOCAL s$
s$=""
WHILE (?a%>=32)
 s$+=CHR$?a%
 a%+=1
ENDWHILE
=s$

DEF FNread(a$)
LOCAL read%
  ?buffer%=13
  SYS "XOS_ReadVarVal",a$,buffer%,buffer_size%,0,3 TO ,,read%
  buffer%?read%=13
=$buffer%

DEF PROCwrite(a$,val%)
  $buffer%=STR$(val%)
  SYS "OS_SetVarVal",a$,buffer%,buffer_size%,0,3
ENDPROC

DEF FNswi_number(name$)
LOCAL a%
  SYS "OS_SWINumberFromString",,name$ TO a%
=a%

DEF FNarg(str$,arg$,def$)
LOCAL i%,j%
i%=INSTR(str$,arg$)
IF i%=0 THEN =def$
i%+=LEN arg$+1
j%=INSTR(str$+" <"," ",i%)
=MID$(str$,i%,j%-i%)

DEF FNcreate_back_window
  LOCAL handle%
  DIM block% 256

  RESTORE +0
  DATA &00000190, &000002E0, &0000022C, &000002E4
  DATA &00000000, &00000000, &FFFFFFFE, &84001852
  DATA &01070207, &000C0103, &00000000, &FFFFFC00
  DATA &00000500, &00000000, &2700003D, &00003000
  DATA &00000001, &00000001, &6B636142, &0000000D
  DATA &00000000, &00000000

  FOR i%=block%+4 TO block%+4+22*4-1 STEP 4
    READ !i%
  NEXT i%
  SYS "Wimp_CreateWindow",,block%+4 TO handle%
  !block%=handle%
  SYS "Wimp_OpenWindow",,block%
=handle%

DEF PROCqsort(from%,to%)
  LOCAL i%,j%,pivot$
  pivot$=option$((from%+to%)/2)
  i%=from%
  j%=to%
  REPEAT
    WHILE option$(i%) < pivot$
      i%=i%+1
    ENDWHILE
    WHILE option$(j%) > pivot$
      j%=j%-1
    ENDWHILE
    IF i% <= j% THEN
      SWAP option$(i%),option$(j%)
      SWAP command$(i%),command$(j%)
      i%=i%+1
      j%=j%-1
    ENDIF
  UNTIL i% > j%
  IF i% < to% THEN
    PROCqsort(i%,to%)
  ENDIF
  IF j% > from% THEN
    PROCqsort(from%,j%)
  ENDIF
ENDPROC

DEF FNstrip(a$,start$)
LOCAL keep$
keep$=a$
a$=MID$(a$,LEN(start$)+1)
REM remove "Fireworkz"/"WebsterXL" etc
WHILE INSTR(" -:",LEFT$(a$,1)) AND LEN(a$)>1
REM check first character against list of characters to strip
  a$=MID$(a$,2)
ENDWHILE
IF LEN(a$)<=1 THEN a$=keep$
=a$

DEF FNsplittitle(line$)
REM clip to nearest'whole word'
WHILE INSTR(":/. ",LEFT$(line$,1))=0 AND line$<>""
  line$=MID$(line$,2)
ENDWHILE
=MID$(line$,2)

DEF FNlcase(text$)
LOCAL Loop%,text2$
text2$=""
FOR Loop%=1 TO LEN(text$)
  chr%=ASC(MID$(text$,Loop%,1))
  IF chr%>64 AND chr%<91 chr%=chr%+32
  text2$+=CHR$(chr%)
NEXT
=text2$

DEF FNstring(ptr%):LOCAL a$:a$=""
WHILE ?ptr%>31
  a$+=CHR$(?ptr%):ptr%+=1
ENDWHILE:=a$

DEF PROCerror
ON ERROR OFF
SYS "XHourglass_Smash"
VDU 4
PRINT "Error in: !Director.Menus.System.Switch"
PRINT "Report:   ";REPORT$
PRINT "Line:     ";ERL
IF file%<>0 CLOSE#file%
END
