/*************************** N O T I C E ******************************/
/* Author:  Alan Altmark                                    OCT/1986  */
/*          IBM Corporation                                 JAN/2015  */
/*          Endicott, NY                                              */
/*                                                                    */
/* This program is distributed on an "as is" basis without warranty   */
/* of any kind either express or implied.                             */
/*                                                                    */
/* THIS NOTICE (INCLUDING AUTHOR INFORMATION) MUST BE REMOVED (OR     */
/* MODIFIED, AS APPROPRIATE) IF THIS PROGRAM IS MADE AVAILABLE TO     */
/* PERSONS OUTSIDE OF IBM.                                            */
/**********************************************************************/
/*                                                                    */
/* Function:  This program will do a formatted display of your        */
/*            accessed disks.  An 'arrow' to the left of the mode     */
/*            letter means the disk is accessed read/write.           */
/*                                                                    */
/* Format:  QSRCH <mode>       default is all disks                   */
/*                                                                    */
/* This exec is intended to run with SET TEXT ON.                     */
/*                                                                    */
/*          +---------------------------------+                       */
/*          | 0 1 2 3 4 5 6 7 8 9 A B C D E F |                       */
/*      +---+---------------------------------+---+                   */
/*      | 4 |     โ ไ เ แ ใ ๅ ็ ๑ ข . < ( + | | 4 |                   */
/*      | 5 | & ้ ๊ ๋ ่ ํ ๎ ๏ ์ ฿ ! $ * ) ; ^ | 5 |                   */
/*      | 6 | - / ย ฤ ภ ม ร ล ว ั ฆ , % _ > ? | 6 |                   */
/*      | 7 | ๘ ษ ส ห ศ อ ฮ ฯ ฬ ` : # @ ' = " | 7 |                   */
/*      | 8 | ุ a b c d e f g h i ซ ป ๐ � � ฑ | 8 |                   */
/*      | 9 | ฐ j k l m n o p q r ช บ ๆ ธ ฦ ค | 9 |                   */
/*      | A | ต ~ s t u v w x y z ก ฟ ะ [ � ฎ | A |                   */
/*      | B | ฌ ฃ ฅ ท ฉ ง ถ ผ ฝ พ � จ ฏ ] ด ื | B |                   */
/*      | C | { A B C D E F G H I ญ ๔ ๖ ๒ ๓ ๕ | C |                   */
/*      | D | } J K L M N O P Q R น ๛ � ๙ ๚ � | D |                   */
/*      | E | \ ๗ S T U V W X Y Z ฒ ิ ึ า ำ ี | E |                   */
/*      | F | 0 1 2 3 4 5 6 7 8 9 ณ � � ู ฺ Ÿ | F |                   */
/*      +---+---------------------------------+---+                   */
/*          | 0 1 2 3 4 5 6 7 8 9 A B C D E F |                       */
/*          +---------------------------------+                       */
/*                                                                    */
/**********************************************************************/
 
arg diskmode
address command
 
"PIPE command QUERY DISPLAY | spec w2 | var scrH"
"PIPE command QUERY DISPLAY | spec w3 | var scrW"
 
/**********************************************************************/
/* Exec can be used with or without fullscreen, within XEDIT or not.  */
/**********************************************************************/
inxedit? = 0
do i = 2 by 1
   Call CSL "DMSCALLR cslrc caller i"
   if cslrc <> 0                   then leave
   if left(caller,8) == "CMS     " then iterate
   if left(caller,8) == "XEDIT   " then inxedit? = 1
   leave
end
 
if inxedit? = 0 then
  do
    "QUERY VSCREEN CMS (LIFO"
    if rc <> 0 then
      do
        "QUERY SEARCH"
        exit
      end
  end
else
  "QUERY VSCREEN XEDIT (LIFO"
 
pull . . . . rtop rbot .
 
nrows = scrH - rtop - rbot             /* Maximum rows avail          */
 
widest = 0
"PIPE (endchar ?)",
  "command QUERY SEARCH",      /* Get accssed disks and directories */
  "| a: count maxline",
  "| stem search.",
  "?",
  "a:",
  "| var widest"
widest = widest - 25                   /* Just get the directory name */
 
"VSCREEN DELETE QSRCH"
"VSCREEN DEFINE QSRCH" nrows*2 widest+19 "0 0 (BLUE PROT"
"WINDOW  DELETE QSRCH"
"WINDOW  DEFINE QSRCH" nrows widest+20 rtop+1 scrW-widest-20 "(VAR POP NOBORDER"
"WINDOW  SHOW   QSRCH ON QSRCH"
"SET LOCATION   QSRCH OFF"
 
/*        |...+....1....+....2....+....3....+....4....+....5..        */
/*                      width is max(dirname)  + 18                   */
head1  = "ะืืืืืืฒืืืืืืฒื" ||copies("ื",   widest) || "ืฏ"
head2  = "ณ Mode ณ Addr ณ " ||left("Label", widest) || " ณ"
linec  = " 76666   5555   " ||copies("2",   widest)
head3  = "ำืืืืืืฑืืืืืืฑื" ||copies("ื",   widest) || "ืี"
foot1  = "ฟืืืืืืิืืืืืืิื" ||copies("ื",   widest) || "ืจ"
 
write = "VSCREEN WRITE QSRCH 0 0" widest+18 "(FIELD"
color = "VSCREEN WRITE QSRCH 0 0" widest+18 "(COLOR"
 
write head1
write head2
color linec
write head3
 
Do i = 1 to search.0
  parse var search.i label addr mode rw dirid .
   mode = left(mode, 3)
   rw = translate(right(rw,1), "40DF"x, "OW")
   if addr = "DIR" then
     do
       label = strip(dirid)
       addr = "    "
     end
   addr = right(addr,4)
   write "ณ"rw mode "ณ" addr "ณ" left(label, widest) "ณ"
   color linec
End
 
if search.0 = 0 then
  "VSCREEN DELETE QSRCH"
else
  write foot1