$! ------------------ CUT HERE -----------------------
$ v='f$verify(f$trnlnm("SHARE_VERIFY"))'
$!
$! This archive created by VMS_SHARE Version 7.2-007  22-FEB-1990
$!   On 17-JUL-1992 16:23:02.44   By user UDAA055 
$!
$! This VMS_SHARE Written by:
$!    Andy Harper, Kings College London UK
$!
$! Acknowledgements to:
$!    James Gray       - Original VMS_SHARE
$!    Michael Bednarek - Original Concept and implementation
$!
$!+ THIS PACKAGE DISTRIBUTED IN 2 PARTS, TO KEEP EACH PART
$!  BELOW 32 BLOCKS
$!
$! TO UNPACK THIS SHARE FILE, CONCATENATE ALL PARTS IN ORDER
$! AND EXECUTE AS A COMMAND PROCEDURE  (  @name  )
$!
$! THE FOLLOWING FILE(S) WILL BE CREATED AFTER UNPACKING:
$!       1. [.TDIR]INIT_CLI.C;1
$!       2. [.TDIR]MAKEFILE.;43
$!       3. [.TDIR]TDIR.C;92
$!       4. [.TDIR]TDIR.HLP;11
$!       5. [.TDIR]TDIR.OPT;2
$!       6. [.TDIR]TDIR_CLD.CLD;11
$!
$set="set"
$set symbol/scope=(nolocal,noglobal)
$f=f$parse("SHARE_TEMP","SYS$SCRATCH:.TMP_"+f$getjpi("","PID"))
$e="write sys$error  ""%UNPACK"", "
$w="write sys$output ""%UNPACK"", "
$ if f$trnlnm("SHARE_LOG") then $ w = "!"
$ ve=f$getsyi("version")
$ if ve-f$extract(0,1,ve) .ges. "4.4" then $ goto START
$ e "-E-OLDVER, Must run at least VMS 4.4"
$ v=f$verify(v)
$ exit 44
$UNPACK: SUBROUTINE ! P1=filename, P2=checksum
$ if f$search(P1) .eqs. "" then $ goto file_absent
$ e "-W-EXISTS, File ''P1' exists. Skipped."
$ delete 'f'*
$ exit
$file_absent:
$ if f$parse(P1) .nes. "" then $ goto dirok
$ dn=f$parse(P1,,,"DIRECTORY")
$ w "-I-CREDIR, Creating directory ''dn'."
$ create/dir 'dn'
$ if $status then $ goto dirok
$ e "-E-CREDIRFAIL, Unable to create ''dn'. File skipped."
$ delete 'f'*
$ exit
$dirok:
$ w "-I-PROCESS, Processing file ''P1'."
$ if .not. f$verify() then $ define/user sys$output nl:
$ EDIT/TPU/NOSEC/NODIS/COM=SYS$INPUT 'f'/OUT='P1'
PROCEDURE Unpacker ON_ERROR ENDON_ERROR;SET(FACILITY_NAME,"UNPACK");SET(
SUCCESS,OFF);SET(INFORMATIONAL,OFF);f:=GET_INFO(COMMAND_LINE,"file_name");b:=
CREATE_BUFFER(f,f);p:=SPAN(" ")@r&LINE_END;POSITION(BEGINNING_OF(b));
LOOP EXITIF SEARCH(p,FORWARD)=0;POSITION(r);ERASE(r);ENDLOOP;POSITION(
BEGINNING_OF(b));g:=0;LOOP EXITIF MARK(NONE)=END_OF(b);x:=ERASE_CHARACTER(1);
IF g=0 THEN IF x="X" THEN MOVE_VERTICAL(1);ENDIF;IF x="V" THEN APPEND_LINE;
MOVE_HORIZONTAL(-CURRENT_OFFSET);MOVE_VERTICAL(1);ENDIF;IF x="+" THEN g:=1;
ERASE_LINE;ENDIF;ELSE IF x="-" THEN IF INDEX(CURRENT_LINE,"+-+-+-+-+-+-+-+")=
1 THEN g:=0;ENDIF;ENDIF;ERASE_LINE;ENDIF;ENDLOOP;t:="0123456789ABCDEF";
POSITION(BEGINNING_OF(b));LOOP r:=SEARCH("`",FORWARD);EXITIF r=0;POSITION(r);
ERASE(r);x1:=INDEX(t,ERASE_CHARACTER(1))-1;x2:=INDEX(t,ERASE_CHARACTER(1))-1;
COPY_TEXT(ASCII(16*x1+x2));ENDLOOP;WRITE_FILE(b,GET_INFO(COMMAND_LINE,
"output_file"));ENDPROCEDURE;Unpacker;QUIT;
$ delete/nolog 'f'*
$ CHECKSUM 'P1'
$ IF CHECKSUM$CHECKSUM .eqs. P2 THEN $ EXIT
$ e "-E-CHKSMFAIL, Checksum of ''P1' failed."
$ ENDSUBROUTINE
$START:
$ create 'f'
X/* init_cli.c
X
X    status = init_cli(table_addr, verb_name)
X
X`09This routine allows you to define a command as either a foreign
Xcommand (via PROG :== $<wherever>PROG), or as a real command (via the
XSET COMMAND command). "table_addr" is the address of the command tables
X(you must do a SET COMMAND/OBJECT and link the resulting object file
Xinto your code, then use "globalvalue" to reference the table.
X"verb_name" is the name of the verb (a null terminated, uppercase
Xstring).
X
X*/
X
X#include descrip
X
X/* "table" is a pointer to the internal CLD
X * "name" is a text string containing the name of the verb
X */
Xinit_cli(char *table, char *name)
X`7B
X    static struct dsc$descriptor cmd = `7B0,DSC$K_DTYPE_T,DSC$K_CLASS_D,0`7D
V;
X    static $DESCRIPTOR(verb,"$VERB");
X    static $DESCRIPTOR(line,"$LINE");
X    int i,sts;
X
X    sts = cli_get_value(&verb,&cmd);
X    if ((sts & 1) && cmd.dsc$w_length)
X    `7B
X        if (strncmp(cmd.dsc$a_pointer,name,cmd.dsc$w_length) == 0)
X        `7B
X            return(1);    /* the command must have been properly defined! */
X        `7D
X    `7D
X
X    sts = cli_get_value(&line,&cmd);
X    if (!(sts & 1))
X    `7B
X        printf("Unexpected error in INIT_CLI, error %d in retrieving $LINE\n
V");
X        return(sts);
X    `7D
X
X    /* this code assumes that the verb is shorter than than the foreign
X    symbol (which includes device:`5Bdir`5D, so, should be reasonable) */
X    for (i = 0; (i < cmd.dsc$w_length) &&
X                (cmd.dsc$a_pointer`5Bi`5D != ' ') &&
X                (cmd.dsc$a_pointer`5Bi`5D != '/'); ++i)
X    `7B
X        cmd.dsc$a_pointer`5Bi`5D = (i < strlen(name))?name`5Bi`5D:' ';
X    `7D
X
X    if (i < strlen(name))
X    `7B
X        printf(
X"Unexpected error in INIT_CLI, verb name wasn't smaller than $line prefix\n"
X        );
X    `7D
X
X    return(cli$dcl_parse(&cmd,table)); /* initialize the parse tables */
X`7D
X
Xint lib$sig_to_ret();
X
Xint cli_get_value(struct dsc$descriptor *s1, struct dsc$descriptor *s2)
X`7B
X  lib$establish(lib$sig_to_ret);
X  return cli$get_value(s1, s2);
X`7D
$ CALL UNPACK [.TDIR]INIT_CLI.C;1 1397033012
$ create 'f'
X.ifdef DEBUG
XCFLAGS =/debug/noopt
XLINKFLAGS =/debug
X.else
XCFLAGS =/optimize=noinline
XLINKFLAGS =/notrace
X.endif
X
Xtdir.exe : tdir.obj tdir_cld.obj init_cli.obj tdir.opt
X`09link $(LINKFLAGS) tdir.obj,tdir_cld.obj,init_cli.obj,tdir.opt/opt
$ CALL UNPACK [.TDIR]MAKEFILE.;43 962223705
$ create 'f'
X/*
X * TDIR - directory sorted on creation or revision date of files
X * `09  Version 4.0 - 25-Jul-1991
X *
X * Acks:
X *      Loosely based on a program filedate.pas by
X *`09`09Karsten Nyblad
X *`09`09TFL, A Danish Telecommmunication Research Laboratory
X *`09Uses init_cli.c, taken from Joe Meadows' VERB package.
X *`20
X */
X/* To be considered some time:
X * DECwindows FileView includes the option of sorting by date, either ascend
Ving
X * or descending.  It also support ascending/descending
X * `09size used
X * `09size allocated
X * `09create date
X * `09modify date
X * `09backup date
X * `09expire date
X * and it allows sorting by file name or type.
X*/
X
X#include <stdio.h>
X#include <descrip.h>
X#include <ctype.h>
X#include <ssdef.h>
X#include <stsdef.h>
X#include <iodef.h>
X#include <errno.h>
X
Xextern void`09    SYS$EXIT();
Xextern void`09    LIB$SIGNAL();
Xextern unsigned int LIB$SYS_ASCTIM();
Xextern unsigned int CLI$PRESENT();
Xextern unsigned int CLI$GET_VALUE();
X
X/* forward definitions */
Xstatic unsigned int getfiledates(char *name,
X`09`09`09`09 char *default_name,
X`09`09`09`09 int request, void user_proc());
Xstatic void get_tty_page(int *widthp, int *heightp);
Xstatic char *strndup(char *s, int max);
X
X/* Macro's */
X#define OK(i) ((i) & 1)
X/* string to lowercase */
X#define strtolower(p) \
X    do `7Bchar *t=p; while (*t) `7B*t=_tolower(*t); t++;`7D`7D while(0)
X#define strntolower(p,m) \
X    do `7Bchar *t=p; int i=m; while (*t && i-- > 0) `7B*t=_tolower(*t); t++;
V`7D *t='\0';`7D while(0)
X/* trim a VMS time string: capitalize month, remove :ss.cc */
X#define trimtime(p) \
X    do `7Bp`5B4`5D=tolower(p`5B4`5D); p`5B5`5D=tolower(p`5B5`5D); p`5B17`5D=
V'\0';`7D while (0)
X
X/* Data structures used for storing the info per file */
Xtypedef struct `7Bunsigned int l0, l1;`7D quad;
Xtypedef struct entry `7B
X    quad date;
X    int fnam_len;
X    char *fnam;
X`7D ENTRY;
X
X/* Static data for entry array anchor */
Xstatic ENTRY **base = (ENTRY **) NULL;
Xstatic int size = 0;
Xstatic int last = 0;
Xstatic int max_fnam_len = 0;
X
X#define INITSIZE 1000
X#define CHUNKSIZE 1000
X
X/***** Static data for commandline parser *****/
X/* parameter P1, label=INPUT, prompt="File" */
Xstatic $DESCRIPTOR(input_file_keyword_dsc, "INPUT");
Xstatic char input_file`5B256`5D;
Xstatic $DESCRIPTOR(input_file_dsc, input_file);
X/* qualifier ARCHAIC */
Xstatic $DESCRIPTOR(archaic_keyword_dsc, "ARCHAIC");
Xstatic int archaic = 0;
Xstatic int header = 0;
Xstatic int trailer = 0;
X/* qualifier SHOW_VERSIONS */
Xstatic $DESCRIPTOR(show_versions_keyword_dsc, "SHOW_VERSIONS");
Xstatic int show_versions = 0;
X/* qualifier CREATION_DATE */
Xstatic $DESCRIPTOR(creation_date_keyword_dsc, "CREATION_DATE");
X/* qualifier MODIFICATION_DATE */
Xstatic $DESCRIPTOR(modification_date_keyword_dsc, "MODIFICATION_DATE");
X/* qualifier REVISION_DATE (synonym) */
Xstatic $DESCRIPTOR(revision_date_keyword_dsc, "REVISION_DATE");
X/* request types */
X#define CREDAT 1
X#define REVDAT 2
Xstatic int request = CREDAT;
X/* qualifier ASCENDING */
Xstatic $DESCRIPTOR(ascending_keyword_dsc, "ASCENDING");
X/* qualifier DESCENDING */
Xstatic $DESCRIPTOR(descending_keyword_dsc, "DESCENDING");
X#define ASCENDING (1)
X#define DESCENDING (-1)
Xstatic int sort_order = DESCENDING;
X/* qualifier OUTPUT */
Xstatic $DESCRIPTOR(output_keyword_dsc, "OUTPUT");
Xstatic char output_file`5B256`5D;
X$DESCRIPTOR(output_file_dsc, output_file);
X/* qualifier PAGE */
Xstatic $DESCRIPTOR(page_keyword_dsc, "PAGE");
Xstatic int page_width = 0;
Xstatic int page_height = 0;
Xstatic int current_y = 0;
X/***** End static data for commandline parser *****/
X
Xglobalvalue TDIR_CLD;`09/* address of command tables */
X
Xstatic void parse_command()
X`7B
X    unsigned int status;
X
X    status = init_cli(TDIR_CLD, "TDIR");
X    if (!OK(status)) `7B
X`09/* the error has already been printed */
X`09SYS$EXIT(status `7C STS$M_INHIB_MSG);
X    `7D
X    status = CLI$PRESENT(&input_file_keyword_dsc);
X    if (OK(status)) `7B
X`09CLI$GET_VALUE(&input_file_keyword_dsc, &input_file_dsc);
X    `7D else `7B
X`09input_file`5B0`5D = '\0';
X    `7D
X    /* qualifier ARCHAIC */
X    if (OK(CLI$PRESENT(&archaic_keyword_dsc))) `7B
X`09archaic = 1;
X`09header = 1;
X`09trailer = 1;
X`09show_versions = 1;
X    `7D
X    /* qualifier SHOW_VERSIONS */
X    if (OK(CLI$PRESENT(&show_versions_keyword_dsc))) `7B
X`09show_versions = 1;
X    `7D
X    /* qualifier CREATION_DATE (default) */
X    if (OK(CLI$PRESENT(&creation_date_keyword_dsc))) `7B
X`09request = CREDAT;
X    `7D
X    /* qualifier MODIFICATION_DATE */
X    if (OK(CLI$PRESENT(&modification_date_keyword_dsc))) `7B
X`09request = REVDAT;
X    `7D
X    /* qualifier REVISION_DATE (synonym) */
X    if (OK(CLI$PRESENT(&revision_date_keyword_dsc))) `7B
X`09request = REVDAT;
X    `7D
X    /* qualifier ASCENDING */
X    if (OK(CLI$PRESENT(&ascending_keyword_dsc))) `7B
X`09sort_order = ASCENDING;
X    `7D
X    /* qualifier DESCENDING */
X    if (OK(CLI$PRESENT(&descending_keyword_dsc))) `7B
X`09sort_order = DESCENDING;
X    `7D
X    /* qualifier OUTPUT */
X    if (OK(CLI$PRESENT(&output_keyword_dsc))) `7B
X`09char *cp;
X`09status = CLI$GET_VALUE(&output_keyword_dsc, &output_file_dsc);
X`09cp = strchr(output_file, ' ');
X`09if (cp) *cp = '\0';
X`09stdout = freopen(output_file, "w", stdout);
X`09if (!stdout) `7B
X`09    perror(output_file);
X`09    exit(vaxc$errno);
X`09`7D
X    `7D else `7B
X`09output_file`5B0`5D = '\0';
X    `7D
X    /* qualifier PAGE */
X    if (OK(CLI$PRESENT(&page_keyword_dsc))) `7B
X`09get_tty_page(&page_width, &page_height);
X    `7D
X`7D
X
Xstatic int output_chan;
Xstatic $DESCRIPTOR (output_dsc, "SYS$OUTPUT:");
Xstatic int terminator_mask`5B2`5D = `7B 0, 0 `7D;
X
Xtypedef struct sensemode `7B
X  short status;
X  unsigned char xmit_baud;
X  unsigned char rcv_baud;
X  unsigned char crfill;
X  unsigned char lffill;
X  unsigned char parity;
X  unsigned char unused;
X  char class;
X  char type;
X  short scr_wid;
X  unsigned long tt_char : 24, scr_len : 8;
X  unsigned long tt2_char;
X`7D TERMINAL;
X
X/* Get the terminal screen sizes */
Xstatic void get_tty_page(int *widthp, int *heightp)
X`7B
X    TERMINAL sg;
X    unsigned int status;
X
X    if (! isatty(fileno(stdout))) return;
X    if (output_chan == 0) `7B
X`09status = SYS$ASSIGN (&output_dsc, &output_chan, 0, 0);
X`09if (! (status & 1))
X`09    LIB$STOP (status);
X    `7D
X    status = SYS$QIOW (0, output_chan, IO$_SENSEMODE, &sg, 0, 0,
X`09    `09       &sg.class, 12, 0, 0, 0, 0);
X    *widthp = sg.scr_wid;
X    *heightp = sg.scr_len;
X    SYS$DASSGN (output_chan);
X    return;
X`7D   `20
X
X/* Store one entry, expand array as needed */
Xstatic void store(char *fnam, int fnam_len, quad dt)
X`7B
X    ENTRY *entryp;
X    char *cp, *tmpcp;
X
X    if (++last == size) `7B
X`09base = realloc(base, (size + CHUNKSIZE) * sizeof(ENTRY *));
X`09if (base == (ENTRY **) NULL) `7B
X`09    LIB$SIGNAL(SS$_INSFMEM);
X`09    exit();
X`09`7D
X`09size += CHUNKSIZE;
X    `7D
X    entryp = malloc(sizeof(ENTRY));
X    if (entryp == (ENTRY *) NULL) `7B
X`09LIB$SIGNAL(SS$_INSFMEM);
X`09exit();
X    `7D
X    base`5Blast-1`5D = entryp;
X    entryp->date = dt;
X    if (header && last == 1) `7B
X`09/* first entry: print the dev:`5Bdirectory`5D for the header */
X`09char *dir_name = fnam;
X`09int dir_len = fnam_len;
X`09if (*fnam != '\"') `7B
X`09    /* no quote at begin, assume VMS */
X`09    cp = strchr(dir_name, '`5D');
X`09    if (cp) dir_len = cp - dir_name + 1;
X`09`7D else `7B
X`09    /* quoted filespec, try for Unix type */
X`09    dir_name++;
X`09    cp = strrchr(dir_name, '/');
X`09    if (cp) dir_len = cp - dir_name + 1;
X`09`7D
X`09printf("\nDirectory %.*s\n\n", dir_len, dir_name);
X    `7D
X    cp = strchr(fnam, '`5D');
X    if (cp) `7B
X`09cp++;
X`09fnam_len -= cp - fnam;
X`09fnam = cp;
X    `7D
X    if (! show_versions) `7B
X`09cp = strchr(fnam, ';');
X`09if (cp) `7B
X`09    *cp = '\0';
X`09    fnam_len = cp - fnam;
X`09`7D
X    `7D
X    entryp->fnam_len = fnam_len;
X    entryp->fnam = strndup(fnam, fnam_len);
X    if (fnam_len > max_fnam_len) `7B
X`09max_fnam_len = fnam_len;
X    `7D   `20
X`7D
X
X/* Compare routine for sort */
Xstatic int entry_compare(ENTRY **entrypp1, ENTRY **entrypp2)
X`7B
X    ENTRY *entryp1 = *entrypp1;
X    ENTRY *entryp2 = *entrypp2;
X    quad date1, date2;
X
X    date1 = entryp1->date;
X    date2 = entryp2->date;
X    if (date1.l1 != date2.l1) `7B
X`09return((date1.l1 - date2.l1) * sort_order);
X    `7D else `7B
X`09if (date1.l0 > date2.l0) return(1 * sort_order);
X`09else if (date1.l0 < date2.l0) return(-1 * sort_order);
X`09else return(0);
X    `7D
X`7D
X
X/* Format and print one line */
Xstatic void output(char *fnam, int fnam_len, quad dt)
X`7B
X    char dt_string`5B`5D = "17-NOV-1858 00:00:00.00";
X    $DESCRIPTOR(dt_string_dsc, dt_string);
X    unsigned int status;
X    unsigned short dt_resultant_length;
X
X    if (page_height && current_y > page_height-2) `7B
X`09char c;
X`09printf("Press <return> to continue...");
X`09fflush(stdout);
X`09c = getchar();
X`09if (c != '\n') exit();
X`09current_y = 0;
X    `7D
X    status = LIB$SYS_ASCTIM(&dt_resultant_length, &dt_string_dsc, &dt, 0);
X    if (archaic) `7B
X`09dt_string`5B20`5D = '\0';`09/* remove :cc */
X`09max_fnam_len = 28;
X    `7D else `7B
X`09trimtime(dt_string);
X`09strntolower(fnam,fnam_len);
X    `7D
X    printf("%-*.*s %s\n",
X`09    max_fnam_len, fnam_len, fnam,
X    `09    dt_string);
X    current_y++;
X`7D
X
Xmain(int argc, char *argv`5B`5D)
X`7B
X    char *name;
X    char *default_name = "SYS$DISK:`5B`5D*.*;0";
X    unsigned int status;
X
X    status = setvbuf (stdout, (char *)NULL, _IOLBF, (size_t)0);
X    /* parse command line */
X    parse_command();
X    if (archaic) default_name = "SYS$DISK:`5B`5D*.*;*";
X    name = &input_file`5B0`5D;
X    /* get an initial array */
+-+-+-+-+-+-+-+-  END  OF PART 1 +-+-+-+-+-+-+-+-