From:	MERC::"uunet!CRVAX.SRI.COM!RELAY-INFO-VAX" 12-JUL-1992 20:30:49.68
To:	info-vax@kl.sri.com
CC:	
Subj:	Re: Utility for chronological directory in DCL? [in C]

Please find below our version of a program that displays a directory
sorted on date. Supported qualifiers include

 /SHOW_VERSIONS /CREATION_DATE /MODIFICATION_DATE
 /ASCENDING     /DESCENDING    /OUTPUT      /PAGE

See the help file for more information.

Enjoy,
					Henk

$! ------------------ CUT HERE -----------------------
$!
$! This archive created by VMS_SHARE Version 7.1-001  26-JUN-1989
$!   On 10-JUL-1992 15:16:57.45   By user HDAVIDS 
$!
$! This VMS_SHARE Written by:
$!    Andy Harper, Kings College London UK
$!
$! Acknowledgements to:
$!    James Gray       - Original VMS_SHARE
$!    Michael Bednarek - Original Concept and implementation
$!
$! 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. INIT_CLI.C;1
$!       2. MAKEFILE.;43
$!       3. TDIR.C;92
$!       4. TDIR.HLP;11
$!       5. TDIR.OPT;2
$!       6. TDIR_CLD.CLD;11
$!
$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 = "!"
$ if f$getsyi("version") .ges. "4.4" then $ goto START
$ e "-E-OLDVER, Must run at least VMS 4.4"
$ 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/nolog '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/nolog 'f'*
$ exit
$dirok:
$ w "-I-PROCESS, Processing file ''P1'."
$ 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");
buff:=CREATE_BUFFER(f,f);p:=SPAN(" ")@r&LINE_END;POSITION(BEGINNING_OF(buff))
;LOOP EXITIF SEARCH(p,FORWARD)=0;POSITION(r);ERASE(r);ENDLOOP;POSITION(
BEGINNING_OF(buff));g:=0;LOOP EXITIF MARK(NONE)=END_OF(buff);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 g:=0;ENDIF;ERASE_LINE;
ENDIF;ENDLOOP;p:="`";POSITION(BEGINNING_OF(buff));LOOP r:=SEARCH(p,FORWARD);
EXITIF r=0;POSITION(r);ERASE(r);COPY_TEXT(ASCII(INT(ERASE_CHARACTER(3))));
ENDLOOP;o:=GET_INFO(COMMAND_LINE,"output_file");WRITE_FILE(buff,o);
ENDPROCEDURE;Unpacker;EXIT;
$ delete/nolog 'f'*
$ CHECKSUM 'P1'
$ IF CHECKSUM$CHECKSUM .eqs. P2 THEN $ EXIT
$ e "-E-CHKSMFAIL, Checksum of ''P1' failed."
$ ENDSUBROUTINE
$START:
$ create/nolog 'f'
X/* init_cli.c
X
X    status = init_cli(table_addr, verb_name)
X
X`009This 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`123
X    static struct dsc$descriptor cmd = `1230,DSC$K_DTYPE_T,DSC$K_CLASS_D,0`1
V25;
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    `123
X        if (strncmp(cmd.dsc$a_pointer,name,cmd.dsc$w_length) == 0)
X        `123
X            return(1);    /* the command must have been properly defined! */
X        `125
X    `125
X
X    sts = cli_get_value(&line,&cmd);
X    if (!(sts & 1))
X    `123
X        printf("Unexpected error in INIT_CLI, error %d in retrieving $LINE\n
V");
X        return(sts);
X    `125
X
X    /* this code assumes that the verb is shorter than than the foreign
X    symbol (which includes device:`091dir`093, so, should be reasonable) */
X    for (i = 0; (i < cmd.dsc$w_length) &&
X                (cmd.dsc$a_pointer`091i`093 != ' ') &&
X                (cmd.dsc$a_pointer`091i`093 != '/'); ++i)
X    `123
X        cmd.dsc$a_pointer`091i`093 = (i < strlen(name))?name`091i`093:' ';
X    `125
X
X    if (i < strlen(name))
X    `123
X        printf(
X"Unexpected error in INIT_CLI, verb name wasn't smaller than $line prefix\n"
X        );
X    `125
X
X    return(cli$dcl_parse(&cmd,table)); /* initialize the parse tables */
X`125
X
Xint lib$sig_to_ret();
X
Xint cli_get_value(struct dsc$descriptor *s1, struct dsc$descriptor *s2)
X`123
X  lib$establish(lib$sig_to_ret);
X  return cli$get_value(s1, s2);
X`125
$ CALL UNPACK INIT_CLI.C;1 1397033012
$ create/nolog '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`009link $(LINKFLAGS) tdir.obj,tdir_cld.obj,init_cli.obj,tdir.opt/opt
$ CALL UNPACK MAKEFILE.;43 962223705
$ create/nolog 'f'
X/*
X * TDIR - directory sorted on creation or revision date of files
X * `009  Version 4.0 - 25-Jul-1991
X *
X * Acks:
X *      Loosely based on a program filedate.pas by
X *`009`009Karsten Nyblad
X *`009`009TFL, A Danish Telecommmunication Research Laboratory
X *`009Uses init_cli.c, taken from Joe Meadows' VERB package.
X *`032
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 * `009size used
X * `009size allocated
X * `009create date
X * `009modify date
X * `009backup date
X * `009expire 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`009    SYS$EXIT();
Xextern void`009    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`009`009`009`009 char *default_name,
X`009`009`009`009 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 `123char *t=p; while (*t) `123*t=_tolower(*t); t++;`125`125 while(0)
X#define strntolower(p,m) \
X    do `123char *t=p; int i=m; while (*t && i-- > 0) `123*t=_tolower(*t); t+
V+;`125 *t='\0';`125 while(0)
X/* trim a VMS time string: capitalize month, remove :ss.cc */
X#define trimtime(p) \
X    do `123p`0914`093=tolower(p`0914`093); p`0915`093=tolower(p`0915`093); p
V`09117`093='\0';`125 while (0)
X
X/* Data structures used for storing the info per file */
Xtypedef struct `123unsigned int l0, l1;`125 quad;
Xtypedef struct entry `123
X    quad date;
X    int fnam_len;
X    char *fnam;
X`125 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`091256`093;
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`091256`093;
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;`009/* address of command tables */
X
Xstatic void parse_command()
X`123
X    unsigned int status;
X
X    status = init_cli(TDIR_CLD, "TDIR");
X    if (!OK(status)) `123
X`009/* the error has already been printed */
X`009SYS$EXIT(status `124 STS$M_INHIB_MSG);
X    `125
X    status = CLI$PRESENT(&input_file_keyword_dsc);
X    if (OK(status)) `123
X`009CLI$GET_VALUE(&input_file_keyword_dsc, &input_file_dsc);
X    `125 else `123
X`009input_file`0910`093 = '\0';
X    `125
X    /* qualifier ARCHAIC */
X    if (OK(CLI$PRESENT(&archaic_keyword_dsc))) `123
X`009archaic = 1;
X`009header = 1;
X`009trailer = 1;
X`009show_versions = 1;
X    `125
X    /* qualifier SHOW_VERSIONS */
X    if (OK(CLI$PRESENT(&show_versions_keyword_dsc))) `123
X`009show_versions = 1;
X    `125
X    /* qualifier CREATION_DATE (default) */
X    if (OK(CLI$PRESENT(&creation_date_keyword_dsc))) `123
X`009request = CREDAT;
X    `125
X    /* qualifier MODIFICATION_DATE */
X    if (OK(CLI$PRESENT(&modification_date_keyword_dsc))) `123
X`009request = REVDAT;
X    `125
X    /* qualifier REVISION_DATE (synonym) */
X    if (OK(CLI$PRESENT(&revision_date_keyword_dsc))) `123
X`009request = REVDAT;
X    `125
X    /* qualifier ASCENDING */
X    if (OK(CLI$PRESENT(&ascending_keyword_dsc))) `123
X`009sort_order = ASCENDING;
X    `125
X    /* qualifier DESCENDING */
X    if (OK(CLI$PRESENT(&descending_keyword_dsc))) `123
X`009sort_order = DESCENDING;
X    `125
X    /* qualifier OUTPUT */
X    if (OK(CLI$PRESENT(&output_keyword_dsc))) `123
X`009char *cp;
X`009status = CLI$GET_VALUE(&output_keyword_dsc, &output_file_dsc);
X`009cp = strchr(output_file, ' ');
X`009if (cp) *cp = '\0';
X`009stdout = freopen(output_file, "w", stdout);
X`009if (!stdout) `123
X`009    perror(output_file);
X`009    exit(vaxc$errno);
X`009`125
X    `125 else `123
X`009output_file`0910`093 = '\0';
X    `125
X    /* qualifier PAGE */
X    if (OK(CLI$PRESENT(&page_keyword_dsc))) `123
X`009get_tty_page(&page_width, &page_height);
X    `125
X`125
X
Xstatic int output_chan;
Xstatic $DESCRIPTOR (output_dsc, "SYS$OUTPUT:");
Xstatic int terminator_mask`0912`093 = `123 0, 0 `125;
X
Xtypedef struct sensemode `123
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`125 TERMINAL;
X
X/* Get the terminal screen sizes */
Xstatic void get_tty_page(int *widthp, int *heightp)
X`123
X    TERMINAL sg;
X    unsigned int status;
X
X    if (! isatty(fileno(stdout))) return;
X    if (output_chan == 0) `123
X`009status = SYS$ASSIGN (&output_dsc, &output_chan, 0, 0);
X`009if (! (status & 1))
X`009    LIB$STOP (status);
X    `125
X    status = SYS$QIOW (0, output_chan, IO$_SENSEMODE, &sg, 0, 0,
X`009    `009       &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`125   `032
X
X/* Store one entry, expand array as needed */
Xstatic void store(char *fnam, int fnam_len, quad dt)
X`123
X    ENTRY *entryp;
X    char *cp, *tmpcp;
X
X    if (++last == size) `123
X`009base = realloc(base, (size + CHUNKSIZE) * sizeof(ENTRY *));
X`009if (base == (ENTRY **) NULL) `123
X`009    LIB$SIGNAL(SS$_INSFMEM);
X`009    exit();
X`009`125
X`009size += CHUNKSIZE;
X    `125
X    entryp = malloc(sizeof(ENTRY));
X    if (entryp == (ENTRY *) NULL) `123
X`009LIB$SIGNAL(SS$_INSFMEM);
X`009exit();
X    `125
X    base`091last-1`093 = entryp;
X    entryp->date = dt;
X    if (header && last == 1) `123
X`009/* first entry: print the dev:`091directory`093 for the header */
X`009char *dir_name = fnam;
X`009int dir_len = fnam_len;
X`009if (*fnam != '\"') `123
X`009    /* no quote at begin, assume VMS */
X`009    cp = strchr(dir_name, '`093');
X`009    if (cp) dir_len = cp - dir_name + 1;
X`009`125 else `123
X`009    /* quoted filespec, try for Unix type */
X`009    dir_name++;
X`009    cp = strrchr(dir_name, '/');
X`009    if (cp) dir_len = cp - dir_name + 1;
X`009`125
X`009printf("\nDirectory %.*s\n\n", dir_len, dir_name);
X    `125
X    cp = strchr(fnam, '`093');
X    if (cp) `123
X`009cp++;
X`009fnam_len -= cp - fnam;
X`009fnam = cp;
X    `125
X    if (! show_versions) `123
X`009cp = strchr(fnam, ';');
X`009if (cp) `123
X`009    *cp = '\0';
X`009    fnam_len = cp - fnam;
X`009`125
X    `125
X    entryp->fnam_len = fnam_len;
X    entryp->fnam = strndup(fnam, fnam_len);
X    if (fnam_len > max_fnam_len) `123
X`009max_fnam_len = fnam_len;
X    `125   `032
X`125
X
X/* Compare routine for sort */
Xstatic int entry_compare(ENTRY **entrypp1, ENTRY **entrypp2)
X`123
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) `123
X`009return((date1.l1 - date2.l1) * sort_order);
X    `125 else `123
X`009if (date1.l0 > date2.l0) return(1 * sort_order);
X`009else if (date1.l0 < date2.l0) return(-1 * sort_order);
X`009else return(0);
X    `125
X`125
X
X/* Format and print one line */
Xstatic void output(char *fnam, int fnam_len, quad dt)
X`123
X    char dt_string`091`093 = "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) `123
X`009char c;
X`009printf("Press <return> to continue...");
X`009fflush(stdout);
X`009c = getchar();
X`009if (c != '\n') exit();
X`009current_y = 0;
X    `125
X    status = LIB$SYS_ASCTIM(&dt_resultant_length, &dt_string_dsc, &dt, 0);
X    if (archaic) `123
X`009dt_string`09120`093 = '\0';`009/* remove :cc */
X`009max_fnam_len = 28;
X    `125 else `123
X`009trimtime(dt_string);
X`009strntolower(fnam,fnam_len);
X    `125
X    printf("%-*.*s %s\n",
X`009    max_fnam_len, fnam_len, fnam,
X    `009    dt_string);
X    current_y++;
X`125
X
Xmain(int argc, char *argv`091`093)
X`123
X    char *name;
X    char *default_name = "SYS$DISK:`091`093*.*;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:`091`093*.*;*";
X    name = &input_file`0910`093;
X    /* get an initial array */
X    base = (ENTRY **) malloc(INITSIZE * sizeof(ENTRY *));
X    if (base == (ENTRY **) NULL) `123
X`009LIB$SIGNAL(SS$_INSFMEM);
X`009exit();
X    `125
X    size = INITSIZE;
X    status = getfiledates(name, default_name, request, store);
X    if (last > 0) `123
X`009int index;
X`009qsort(base, last, sizeof(ENTRY *), entry_compare);
X`009for (index = 0; index < last; index++) `123
X`009    ENTRY *current = base`091index`093;
X`009    output(current->fnam, current->fnam_len, current->date);
X`009`125
X`009if (trailer) `123
X`009    printf("\nTotal of %d files\n\n", last);
X`009`125
X    `125
X    /* Should we not free all that malloced memory? */
X`125
X
X/****************** utilities *******************/
X/*
X * Duplicate a string a la strncpy
X */
Xstatic char    *
Xstrndup(char *s, int max)
X`123
X    int             count;
X    char           *cp;
X
X    cp = malloc(max + 1);
X    if (cp == NULL) `123
X`009LIB$SIGNAL(SS$_INSFMEM);
X`009exit();
X    `125
X    cp`091max`093 = '\0';
X    return (strncpy(cp, s, max));
X`125
X/***************************************************************************
V**\
X* `009`009`009`009`009`009`009`009`009      *
X* Getfiledates: use LIB$FILE_SCAN to extract the creation or revision dates
V   *
X* of files. Does not open the files but uses ACP QIO to retrieve the`009
V      *
X* information for local files, so`009`009`009`009       `009      *
X* a. the performance should be ok, and`009`009`009`009`009      *
X* b. we will even get dates for files that are locked.`009`009`009      *
X* `009`009`009`009`009`009`009`009`009      *
X\***************************************************************************
V**/
X#include iodef
X#include rms
X#include devdef
X#include fibdef
X#include atrdef
X#include ssdef
X
X/* Static data for communication between getfiledates and error/sucess */
Xstatic int user_request;
Xstatic quad date;
Xstatic struct atrdef attrl`0913`093;
X
Xextern unsigned int
XLIB$FILE_SCAN(struct FAB *fab,
X`009      unsigned int success(),
X`009      unsigned int error(),
X`009      unsigned int *context);
X`009     `032
Xextern unsigned int
XLIB$FILE_SCAN_END(struct FAB *fab,
X`009`009  unsigned int *context);
Xextern void
XLIB$SIGNAL(unsigned int status);
X
Xstatic unsigned int error(struct FAB *fab);
X
X#define OK(i) ((i) & 1)
X#define checkstatus(status) \
X    do `123if (! OK(status)) `123fab->fab$l_stv = status; return(error(fab))
V;`125`125 while (0)
X `032
X/* Success routine, called by LIB$FILE_SCAN */
Xstatic unsigned int success(struct FAB *fab)
X`123
X    struct NAM *nam = fab->fab$l_nam;
X    void (*user_proc)() = (void (*)()) fab->fab$l_ctx;
X    struct fibdef fib;
X    struct `123
X        short length;
X        short dummy;
X`009struct fibdef *addr;
X    `125 fib_descr;
X    $DESCRIPTOR(devicename_dsc, "");
X    unsigned short channel;
X    struct `123
X`009short status;
X`009short len;
X`009int dummy;
X    `125 iosb;
X    unsigned int status1, status2;
X    int i;
X    unsigned char *fib_ptr = (unsigned char *) &fib;
X    char *name_ptr;
X    int name_length;
X   `032
X    /* lacking a cc$rms_fib, we need to init it here */
X    for (i=0; i<FIB$C_LENGTH; i++) `123
X`009*fib_ptr++ = 0;
X    `125
X    if (! fab->fab$l_dev & DEV$M_DIR &&
X        ! nam->nam$v_node) `123
X`009   checkstatus(SS$_NOTFILEDEV);
X    `125
X    if (fab->fab$l_dev & DEV$M_FOR) `123
X        checkstatus(SS$_DEVFOREIGN);
X    `125
X    if (! nam->nam$v_node) `123
X        fib_descr.length = sizeof(fib);
X        fib_descr.addr = &fib;
X        devicename_dsc.dsc$a_pointer = &nam->nam$t_dvi`0911`093;
X        devicename_dsc.dsc$w_length = (short) nam->nam$t_dvi`0910`093;
X        status1 = SYS$ASSIGN(&devicename_dsc, &channel, 0, 0);
X        checkstatus(status1);
X        fib.fib$r_fid_overlay.fib$w_fid`0910`093 = nam->nam$w_fid`0910`093;
X        fib.fib$r_fid_overlay.fib$w_fid`0911`093 = nam->nam$w_fid`0911`093;
X        fib.fib$r_fid_overlay.fib$w_fid`0912`093 = nam->nam$w_fid`0912`093;
X        status1 = SYS$QIOW(0, channel, IO$_ACCESS, &iosb,
X        `009`009   0,0,
X `009`009`009   &fib_descr,
X `009`009`009   0,0,0,
X `009`009`009   &attrl,0,0);
X        status2 = SYS$DASSGN(channel);
X        checkstatus(status2);
X        checkstatus(status1);
X        checkstatus(iosb.status);
X    `125 else `123
X`009/* node present in name - info already in xab */
X        checkstatus(fab->fab$l_sts);
X        if (fab->fab$l_stv != 0) `123
X`009    checkstatus(fab->fab$l_stv);
X`009`125
X`009if (user_request == CREDAT)
X`009    date = ((struct XABDAT *)fab->fab$l_xab)->xab$q_cdt;
X`009else
X            date = ((struct XABDAT *)fab->fab$l_xab)->xab$q_rdt;
X    `125
X    name_ptr = nam->nam$l_name;
X    name_length = nam->nam$b_dev + nam->nam$b_dir;
X    if (name_length) name_ptr = nam->nam$l_dev;
X    name_length += nam->nam$b_name + nam->nam$b_type + nam->nam$b_ver;
X    user_proc(name_ptr, name_length, date);
X    return(SS$_NORMAL); /* keep going */
X`125
X
Xglobalref CTL$GB_MSGMASK;`009/* Address of current message mask */
X`009`009`009`009/* Needs link with
X`009`009`009`009   sys$system:sys.stb/selective_search */
Xextern int LIB$SYS_GETMSG();
X
X/* Error routine, called by LIB$FILE_SCAN */
Xstatic unsigned int error(struct FAB *fab)
X`123
X    struct NAM *nam = fab->fab$l_nam;
X    char error_message`091255`093;
X    unsigned short message_length;
X    unsigned char message_level = CTL$GB_MSGMASK; /* user preference mask */
X    unsigned long message_flags = (unsigned long) message_level;
X    $DESCRIPTOR(error_message_dsc, error_message);
X
X    message_flags = (unsigned long) 1;`009/* text of message only */
X    strntolower(nam->nam$l_name, (nam->nam$b_name +
X`009`009`009`009  nam->nam$b_type +
X`009`009`009`009  nam->nam$b_ver));
X    fprintf(stderr, "%s - ", nam->nam$l_name);
X
X    /* print the secondary error status message, if any */
X    if (fab->fab$l_stv != 0) `123
X`009(void) LIB$SYS_GETMSG(&fab->fab$l_stv, &message_length, &error_message_d
Vsc, &message_flags);
X`009fprintf(stderr, "%.*s\n", message_length,
X`009`009`009          error_message_dsc.dsc$a_pointer);
X    `125 else `123
X`009/* print the primary error status message */
X`009(void) LIB$SYS_GETMSG(&fab->fab$l_sts, &message_length, &error_message_d
Vsc, &message_flags);
X        fprintf(stderr, "%.*s\n", message_length,
X`009`009`009      `009  error_message_dsc.dsc$a_pointer);
X    `125
X    /* ignore */  `032
X    return(SS$_NORMAL); /* keep going */
X`125
X
X/* Main routine to retrieve the filedates */
Xstatic unsigned int
Xgetfiledates(char *name, char *default_name, int requesttype, void user_proc
V())
X`123
X    struct FAB fab = cc$rms_fab;
X    struct NAM nam = cc$rms_nam;
X    struct XABDAT xabdat = cc$rms_xabdat;
X    char esa`091NAM$C_MAXRSS`093;
X    char rsa`091NAM$C_MAXRSS`093;
X    int context;
X    int status;
X
X    user_request = requesttype;
X    context = 0;
X    fab.fab$l_fna = name;
X    fab.fab$b_fns = strlen(name);
X    fab.fab$l_dna = default_name;
X    fab.fab$b_dns = strlen(default_name);
X    fab.fab$l_nam = &nam;
X    fab.fab$l_xab = &xabdat;
X    fab.fab$l_ctx = user_proc;
X    fab.fab$l_fop = FAB$M_NAM;
X    nam.nam$l_esa = esa;
X    nam.nam$b_ess = sizeof(esa);
X    nam.nam$l_rsa = rsa;
X    nam.nam$b_rss = sizeof(rsa);
X    nam.nam$b_nop = NAM$M_SRCHXABS;
X    /* init attrl for use by success() */
X    if (user_request == CREDAT)
X`009attrl`0910`093.atr$w_type = ATR$C_CREDATE;
X    else
X`009attrl`0910`093.atr$w_type = ATR$C_REVDATE;
X    attrl`0910`093.atr$w_size = sizeof(date);
X    attrl`0910`093.atr$l_addr = &date;
X    attrl`0911`093.atr$w_type = 0;
X    attrl`0911`093.atr$w_size = 0;
X    attrl`0911`093.atr$l_addr = (quad *) NULL;
X    status = LIB$FILE_SCAN(&fab, success, error, &context);
X    if (status == RMS$_NMF) status = SS$_NORMAL;
X    if (! OK(status)) `123
X `009return(status);
X    `125
X    status = LIB$FILE_SCAN_END(&fab, &context);
X    if (! OK(status)) `123
X `009return(status);
X    `125
X    return(SS$_NORMAL);
X`125
$ CALL UNPACK TDIR.C;92 1280089862
$ create/nolog 'f'
X1 TDIRECTORY
X  Syntax
X
X  `009TDIRECTORY `091files`093 `091qualifiers`093
X
X  TDIRECTORY will display a list of the specified files (default for files
X  is SYS$DISK:`091`093*.*;0) sorted by date. The default date used is the cr
Veation
X  date, but that may be changed.
X  The output contains the filename and type, and if /SHOW_VERSIONS has been
X  specified the version number, followed by the date. Between filespec and
X  date, just enough spaces will be inserted to get nice columns.
X  In the output, filename and type will be printed in lowercase, the month
X  will be capitalized. The time will be given as hh:mm.
X `032
X2 Qualifiers
X/ARCHAIC
X  Use the output format of the V3.0 TDIR command, in particular:
X  - use SYS$DISK:`091`093*.*;* as default file spec
X  - print a header and trailer;
X  - output the date starting in column 30;
X  - keep the seconds in the time-string;
X  - make /SHOW_VERSIONS default.
X  - display filename, type and month in uppercase.
X/SHOW_VERSIONS
X  When printing the filename, include the version number in the output.
X  By default, version numbers will not be shown.
X/CREATION_DATE`032
X  Use the creation date of the files for sorting. Default.
X/MODIFICATION_DATE`032
X  Use the modifcation date of the files for sorting.
X  This is the same as the revision date.
X/REVISION_DATE`032
X  Use the revision date of the files for sorting.
X  This is the same as the modification date. `032
X/ASCENDING
X  Sort the files with the date in ascending order.
X/DESCENDING`032
X  Sort the files with the date in descending order. Default.
X/OUTPUT`032
X  /OUTPUT=<output-file-spec>
X  Use <output-file-spec> for the output. Default output goes to SYS$OUTPUT.
X/PAGE
X  When outputting on a terminal, stop after a full screen and display
X  the prompt
X
X  `009"Press <return> to continue..."
X
X  Any other input than a <return> will terminate the program.
X2 Release_notes
X  This is version 4.0 of the TDIR command. At this time there are no known
X  bugs.
$ CALL UNPACK TDIR.HLP;11 1499716516
$ create/nolog 'f'
Xsys$system:sys.stb/selective_search
Xsys$share:vaxcrtl.exe/share
$ CALL UNPACK TDIR.OPT;2 390939567
$ create/nolog 'f'
X! CLD file to define TDIRECTORY command
X
Xdefine verb TDIR
X   parameter P1, label=INPUT, prompt="File"
X      value (list,impcat,type=$infile)
X   qualifier ARCHAIC, nonnegatable
X   qualifier SHOW_VERSIONS, nonnegatable
X   qualifier CREATION_DATE, nonnegatable
X   qualifier MODIFICATION_DATE, nonnegatable
X   qualifier REVISION_DATE, nonnegatable
X   qualifier ASCENDING,nonnegatable
X   qualifier DESCENDING, nonnegatable
X   qualifier OUTPUT, nonnegatable
X      value (required, type=$outfile)
X   qualifier PAGE
X   disallow any2 (CREATION_DATE, MODIFICATION_DATE, REVISION_DATE)
X   disallow any2 (OUTPUT, PAGE)
X   disallow any2 (ASCENDING, DESCENDING)
$ CALL UNPACK TDIR_CLD.CLD;11 22567363
$ EXIT

