(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) (FILECREATED "25-Feb-88 18:29:26" |{NEWTON:EUROPARC:RX}LISP>DATESORT.;2| 9298 previous date%: "11-Jun-87 10:15:34" |{NEWTON:EUROPARC:RX}LISP>DATESORT.;1|) (* " Copyright (c) 1986, 1987, 1988 by XEROX Corporation. All rights reserved. ") (PRETTYCOMPRINT DATESORTCOMS) (RPAQQ DATESORTCOMS ((UGLYVARS RQIREADTABLE) (FNS DATESORTER COMPAREDATE COMPAREDATE2 FIXNAME GETRF GETFTS DATESORT GETDATE GETINFORMATION CORRECTDATE MAKEFINALFILE) (ADDVARS (BackgroundMenuCommands ("Date Sorter" '(DATESORTER) "Sort a Mail file by date"))) (VARS (BackgroundMenu) (DEFAULTDATESORT NIL)))) (READVAR-FROM-STRING 'RQIREADTABLE "{D(9 10 11 25 31 32 39 44 63 96 124)OTHER OTHER SEPRCHAR (MACRO FIRST (LAMBDA (FILE RDTBL) (EVAL (READ FILE RDTBL)))) OTHER OTHER (MACRO FIRST READ') (MACRO FIRST READBQUOTECOMMA) (INFIX FIRST NOESCQUOTE DO?) (MACRO FIRST READBQUOTE) (INFIX ALWAYS READVBAR) } ") (DEFINEQ (DATESORTER [LAMBDA NIL (* edited%: "28-Jan-86 11:24") (ADD.PROCESS '(DATESORT) 'NAME 'DATESORTER 'INFOHOOK '(PROMPTPRINT "This is the Mail Date Sorter process" "Killing this process may leave open files, so make sure to close them" " and erase the files in {CORE}"]) (COMPAREDATE [LAMBDA (A B) (* edited%: "21-Jan-86 15:57") (PROG NIL (RETURN (OR (NOT (IDATE (CAR B))) (AND (IDATE (CAR A)) (ILESSP (IDATE (CAR A)) (IDATE (CAR B]) (COMPAREDATE2 [LAMBDA (A B) (* edited%: "23-Jan-86 17:45") (PROG NIL (RETURN (OR (NOT (IDATE (CAR A))) (AND (IDATE (CAR B)) (ILESSP (IDATE (CAR A)) (IDATE (CAR B]) (FIXNAME [LAMBDA (NAMETOFIX RVFLG) (* edited%: "23-Jan-86 14:43") (PROG NIL (RETURN (PACKFILENAME (if (MEMB 'EXTENSION (UNPACKFILENAME NAMETOFIX)) then [if RVFLG then (UNPACKFILENAME NAMETOFIX) else (for X in (UNPACKFILENAME NAMETOFIX) collect X until (EQUAL X 'VERSION] else (if RVFLG then (APPEND (UNPACKFILENAME NAMETOFIX) '(EXTENSION MAIL)) else (for X in (APPEND (UNPACKFILENAME NAMETOFIX) '(EXTENSION MAIL)) collect X until (EQUAL X 'VERSION]) (GETRF [LAMBDA (RF FTS) (* edited%: "23-Jan-86 15:04") (PROG NIL (SETQ FTS (FULLNAME (FIXNAME FTS) 'NEW)) (if (NOT RF) then (SETQ RF (MKATOM (PROMPTFORWORD "Enter name of resulting file: " FTS))) (TERPRI T)) (if [AND RF (SETQ RF (FULLNAME (FIXNAME RF) 'NEW] then (RETURN RF) else (RETURN]) (GETFTS [LAMBDA (FTS) (* edited%: "23-Jan-86 15:05") (PROG NIL (if (NOT FTS) then (SETQ FTS (MKATOM (PROMPTFORWORD "Enter name of file to be sorted: "))) (TERPRI T)) (if [AND FTS (SETQ FTS (FULLNAME (FIXNAME FTS T] then (RETURN FTS) else (RETURN]) (DATESORT [LAMBDA (FILETOSORT SORTEDFILE) (* edited%: "23-Jan-86 17:48") (PROG (COREFILE FILEINFO RESULTS) (CLRPROMPT) (* Code to check the filenames and  error if problems!!) (if (SETQ FILETOSORT (GETFTS FILETOSORT)) then (if (NOT (SETQ SORTEDFILE (GETRF SORTEDFILE FILETOSORT))) then (PRINTOUT PROMPTWINDOW "Error, no file to sort to ...aborted!" T) (FLASHWINDOW) (RETURN (CLOSEW T))) else (PRINTOUT PROMPTWINDOW "Error, no file to sort or file not found " FILETOSORT " ...aborted!" T) (FLASHWINDOW) (RETURN (CLOSEW T))) (* Error on file being open -  FATAL) (if (OPENP FILETOSORT) then (PRINTOUT PROMPTWINDOW "File to be sorted is already open ...aborted" T) (FLASHWINDOW) (RETURN (CLOSEW T))) (PRINTOUT T "Working ..." T) (SETQ COREFILE (COPYFILE FILETOSORT '{CORE}DATESORT.SCRATCH)) (SETQ COREFILE (OPENSTREAM COREFILE 'INPUT 'OLD)) (SETQ FILEINFO (GETINFORMATION COREFILE)) (CLOSEF COREFILE) (DELFILE COREFILE) (if DEFAULTDATESORT then (SORT FILEINFO 'COMPAREDATE) else (SORT FILEINFO 'COMPAREDATE2)) (BLOCK) (SETQ RESULTS (MAKEFINALFILE FILETOSORT SORTEDFILE FILEINFO)) (if RESULTS then (PRINTOUT PROMPTWINDOW " Messages sorted" T) (FLASHWINDOW PROMPTWINDOW) (CLOSEW T) (RETURN SORTEDFILE) else (PRINTOUT PROMPTWINDOW "Errors...") (FLASHWINDOW) (CLOSEW T) (RETURN "Errors..."]) (GETDATE [LAMBDA (GDFIL GDBEG GDNEXT) (* edited%: "22-Jan-86 10:25") (PROG NIL (SETFILEPTR GDFIL (FFILEPOS "DATE: " GDFIL GDBEG GDNEXT NIL NIL UPPERCASEARRAY)) (RSTRING GDFIL) (RETURN (RSTRING GDFIL RQIREADTABLE]) (GETINFORMATION [LAMBDA (SFIL) (* edited%: "23-Jan-86 17:20") (* Will return a list consisting of the Message number and the information  about it.) (PROG ((CURRENTSTART (FFILEPOS "*start*" SFIL 0)) (NEXTSTART 0) (MSGCOUNT 0) INFO) (repeatwhile (SETQ CURRENTSTART NEXTSTART) do (SETQ NEXTSTART (FFILEPOS "*start*" SFIL (ADD1 CURRENTSTART))) [SETQ INFO (APPEND INFO (LIST (LIST (GETDATE SFIL CURRENTSTART NEXTSTART) CURRENTSTART NEXTSTART] (BLOCK)) [SETQ INFO (for X in INFO collect (APPEND (LIST (CORRECTDATE (CAR X))) (CDR X] (* fixes bug when a date is of the form Wed 16 Dec...) (RETURN INFO]) (CORRECTDATE [LAMBDA (DATETOFIX) (* edited%: "22-Jan-86 09:52") (PROG (TEMP) (if (IDATE DATETOFIX) then (RETURN DATETOFIX) else (SETQ TEMP (GNC DATETOFIX)) (until (NUMBERP TEMP) do (SETQ TEMP (GNC DATETOFIX))) (RETURN (CONCAT TEMP DATETOFIX]) (MAKEFINALFILE [LAMBDA (FROMFILE TOFILE DATESLIST) (* edited%: "23-Jan-86 17:27") (PROG (ENDOFMSG) (if (OR (OPENP FROMFILE) (OPENP TOFILE)) then (PRINTOUT PROMPTWINDOW "File open in conflicting way ... aborted" T) (FLASHWINDOW) (RETURN)) (SETQ FROMFILE (OPENSTREAM FROMFILE 'INPUT 'OLD)) (SETQ TOFILE (OPENSTREAM TOFILE 'OUTPUT 'NEW)) (for X in DATESLIST do (if (SETQ ENDOFMSG (CADDR X)) then (COPYBYTES FROMFILE TOFILE (CADR X) ENDOFMSG) else (COPYBYTES FROMFILE TOFILE (CADR X) (GETEOFPTR FROMFILE))) (BLOCK)) (CLOSEF TOFILE) (CLOSEF FROMFILE) (RETURN TOFILE]) ) (ADDTOVAR BackgroundMenuCommands ("Date Sorter" '(DATESORTER) "Sort a Mail file by date")) (RPAQQ BackgroundMenu NIL) (RPAQQ DEFAULTDATESORT NIL) (PUTPROPS DATESORT COPYRIGHT ("XEROX Corporation" 1986 1987 1988)) (DECLARE%: DONTCOPY (FILEMAP (NIL (1178 9047 (DATESORTER 1188 . 1685) (COMPAREDATE 1687 . 2005) (COMPAREDATE2 2007 . 2326) (FIXNAME 2328 . 3366) (GETRF 3368 . 3899) (GETFTS 3901 . 4314) (DATESORT 4316 . 6418) (GETDATE 6420 . 6711) (GETINFORMATION 6713 . 7676) (CORRECTDATE 7678 . 8067) (MAKEFINALFILE 8069 . 9045))))) STOP