github.com/Interlisp.medley
1
0
Fork 0
mirror of synced 2026-04-28 04:55:54 +00:00
Code Issues Projects Releases Wiki Activity

Convert LAFITE files to LF

Browse Source 
They missed the previous global conversion since they were in a subdirectory.  The only actual change is in LAFITETEDIT, it had the wrong name for the TEDITDCL file
This commit is contained in:
rmkaplan
2021-09-30 23:16:45 -07:00
parent d6173b5269
commit 9f85f4e17e
20 changed files with 10820 additions and 766 deletions
Download Patch File Download Diff File Expand all files Collapse all files

353
library/lafite/LAFITESORT
View File

@@ -1,19 +1,334 @@
(DEFINE-FILE-INFO READTABLE "INTERLISP" PACKAGE "INTERLISP")
(FILECREATED " 7-Feb-95 13:10:22" {DSK}<lispcore>lafite>parc-94>LAFITESORT.;2 12117
changes to%: (VARS LAFITESORTCOMS)
previous date%: " 7-Oct-89 14:07:49" {DSK}<lispcore>lafite>parc-94>LAFITESORT.;1)
(* ; "
Copyright (c) 1989, 1995 by Xerox Corporation. All rights reserved.
")
(PRETTYCOMPRINT LAFITESORTCOMS)
(RPAQQ LAFITESORTCOMS
[(DECLARE%: EVAL@COMPILE DONTCOPY (FILES (SOURCE)
LAFITEDECLS))
(FNS LAFITE.ASSURE.DATE.FIELDS LAFITE.PARSE.DATE.FIELD LAFITE.PARSE.DATE.FIELD.ONLY
LAFITE.SORT.BY.DATE LAFITE.SORT.MESSAGES LAFITEMSG.DATE.ORDER
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED "30-Sep-2021 22:58:58" 
{DSK}<USERS>KAPLAN>LOCAL>MEDLEY3.5>GIT-MEDLEY>LIBRARY>LAFITE>LAFITESORT.;1 19675
previous date%: " 7-Feb-95 13:10:22"
{DSK}<USERS>KAPLAN>LOCAL>MEDLEY3.5>GIT-MEDLEY>LIBRARY>LAFITE>LAFITESORT.;1)
(* ; "
Copyright (c) 1989, 1995, 2021 by Xerox Corporation.
")
(PRETTYCOMPRINT LAFITESORTCOMS)
(RPAQQ LAFITESORTCOMS
[(DECLARE%: EVAL@COMPILE DONTCOPY (FILES (SOURCE)
LAFITEDECLS))
(FNS LAFITE.ASSURE.DATE.FIELDS LAFITE.PARSE.DATE.FIELD LAFITE.PARSE.DATE.FIELD.ONLY
LAFITE.SORT.BY.DATE LAFITE.SORT.MESSAGES LAFITEMSG.DATE.ORDER
\LAFITE.SORT.BY.DATE.INTERACTIVE \LAFITE.SORT.BY.DATE.REGION)
[APPENDVARS (LAFITEEXTRAMENUITEMS ("Sort by Date" '\LAFITE.SORT.BY.DATE.INTERACTIVE
"Sort all the messages in this folder by their Date: fields."
(SUBITEMS ("Sort Entire Folder"
'\LAFITE.SORT.BY.DATE.INTERACTIVE
"Sort all the messages in this folder by their Date: fields."
)
("Sort Selected Range"
'\LAFITE.SORT.BY.DATE.REGION
"Sort only the messages between the first and last selected messages."
]
(COMS (* ; "Date hax")
(FNS GDATE1-6)
(DECLARE%: EVAL@COMPILE DONTCOPY (CONSTANTS \4YearsDays)
(GLOBALVARS \TimeZoneComp \DayLightSavings])
(DECLARE%: EVAL@COMPILE DONTCOPY
(FILESLOAD (SOURCE)
LAFITEDECLS)
)
(DEFINEQ
(LAFITE.ASSURE.DATE.FIELDS
[LAMBDA (FOLDER FIRST# LAST#) (* ; "Edited 5-May-89 15:46 by bvm")
(* ;; "Assure that messages FIRST# thru LAST# have IDATE fields. FIRST# & LAST# default.")
(for I from (OR FIRST# 1) to (OR LAST# (fetch (MAILFOLDER %#OFMESSAGES)
of FOLDER))
bind (STREAM _ (\LAFITE.OPEN.FOLDER FOLDER 'INPUT :ABORT))
(MESSAGES _ (fetch (MAILFOLDER MESSAGEDESCRIPTORS) of FOLDER))
(FAILURECNT _ 0)
(MISSING _ 0)
MSG ID PREV DATEFAILURE DATEFETCHED BABBLED
do [if (fetch (LAFITEMSG DATEFETCHED?) of (SETQ MSG (NTHMESSAGE MESSAGES I)))
then (* ; "Ok")
(if (NOT (fetch (LAFITEMSG DATEKNOWN?) of MSG))
then (add FAILURECNT 1))
else (if (NOT BABBLED)
then (* ; "Tell user what's taking so long")
(LAB.PROMPTPRINT FOLDER "Collecting dates... ")
(SETQ BABBLED T))
(if (FIXP (SETQ ID (LAFITE.PARSE.HEADER STREAM \LAPARSE.DATEFIELD
(fetch (LAFITEMSG START) of MSG)
(fetch (LAFITEMSG END) of MSG)
T)))
then (replace (LAFITEMSG IDATE) of MSG with ID)
(replace (LAFITEMSG DATEKNOWN?) of MSG with T)
(replace (LAFITEMSG DATEFETCHED?) of MSG with T)
(replace (LAFITEMSG DATE) of MSG with NIL)
(* ;
 "So it will be regenerated in canonical form")
(OR DATEFETCHED (SETQ DATEFETCHED I))
else (replace (LAFITEMSG DATEKNOWN?) of MSG with NIL)
(if LAFITEDEBUGFLG
then (LAB.FORMAT FOLDER
" ~:[Date missing for~;Could not parse date of~] msg ~D. "
ID I))
(add FAILURECNT 1)
(if (NULL ID)
then (add MISSING 1))
(if [AND (> I 1)
(fetch (LAFITEMSG DATEFETCHED?)
of (SETQ PREV (NTHMESSAGE MESSAGES (SUB1 I]
then (* ;
 "Guess that message i has date just after i-1")
(replace (LAFITEMSG IDATE) of MSG
with (ADD1 (fetch (LAFITEMSG IDATE) of PREV)))
(replace (LAFITEMSG DATEFETCHED?) of MSG with
T)
else (SETQ DATEFAILURE I]
finally (if (AND DATEFETCHED (< DATEFETCHED (fetch (MAILFOLDER TOCLASTMESSAGE#)
of FOLDER)))
then (* ;
 "Assure that the toc will be rewritten at least this far back so that we save the dates.")
(replace (MAILFOLDER TOCLASTMESSAGE#) of FOLDER with
DATEFETCHED
))
(COND
([AND DATEFAILURE (NOT (for I from (ADD1 (OR FIRST# 1))
to (fetch (MAILFOLDER %#OFMESSAGES) of FOLDER)
when (fetch (LAFITEMSG DATEFETCHED?)
of (SETQ MSG (NTHMESSAGE MESSAGES I)))
do (* ; "Got a date later on")
(SETQ ID (fetch (LAFITEMSG IDATE) of MSG))
(for J from DATEFAILURE
to (OR FIRST# 1) by -1
do (* ;
 "Store guess dates for first message(s)")
(replace (LAFITEMSG IDATE)
of (SETQ MSG (NTHMESSAGE MESSAGES J))
with (add ID -1))
(replace (LAFITEMSG DATEFETCHED?)
of MSG with T))
(RETURN T]
(LAB.PROMPTPRINT FOLDER "Could not parse dates of ANY messages in this file."))
((> FAILURECNT 0)
(LAB.FORMAT FOLDER (if (< MISSING FAILURECNT)
then
" Note: Could not parse date field of ~D of these messages."
else " Note: Missing date field for ~D of these messages.")
FAILURECNT])
(LAFITE.PARSE.DATE.FIELD
[LAMBDA (STREAM) (* ; "Edited 5-May-89 12:52 by bvm")
(LET* ((DATESTR (LAFITE.READ.TO.EOL STREAM))
(ID (IDATE DATESTR)))
(if [AND ID (> ID (CONSTANT (IDATE "1-jan-70 1200"]
then (* ; "Plausible date. Test is for those silly senders who didn't get the date set and have messages reading %"31-dec-00 ...%"")
ID
else (CONCAT (OR (SUBSTRING DATESTR 1 6 DATESTR)
DATESTR)
"?"])
(LAFITE.PARSE.DATE.FIELD.ONLY
[LAMBDA (STREAM)
(DECLARE (USEDFREE PARSERESULT)) (* ; "Edited 26-Apr-89 14:35 by bvm")
(SETQ PARSERESULT (LAFITE.PARSE.DATE.FIELD STREAM])
(LAFITE.SORT.BY.DATE
[LAMBDA (FOLDER FIRST# LAST#) (* ; "Edited 26-Apr-89 15:32 by bvm")
(WITH.MONITOR (fetch (MAILFOLDER FOLDERLOCK) of FOLDER)
(LAFITE.ASSURE.DATE.FIELDS FOLDER FIRST# LAST#)
(LAFITE.SORT.MESSAGES FOLDER (FUNCTION LAFITEMSG.DATE.ORDER)
FIRST# LAST#))])
(LAFITE.SORT.MESSAGES
[LAMBDA (FOLDER COMPAREFN FIRST# LAST#) (* ; "Edited 7-Oct-89 14:03 by bvm")
(WITH.MONITOR (fetch (MAILFOLDER FOLDERLOCK) of FOLDER)
(OR FIRST# (SETQ FIRST# 1))
(OR LAST# (SETQ LAST# (fetch (MAILFOLDER %#OFMESSAGES) of FOLDER)))
(LAB.PROMPTPRINT FOLDER "Sorting... ")
(LET* ((MESSAGES (fetch (MAILFOLDER MESSAGEDESCRIPTORS) of FOLDER))
(SORTED (CL:STABLE-SORT (for I from FIRST# to LAST#
collect (NTHMESSAGE MESSAGES I))
COMPAREFN)))
(while (AND SORTED (EQ (fetch (LAFITEMSG %#) of (CAR SORTED))
FIRST#)) do (* ;
 "Skip over the initial prefix of in-order messages")
(add FIRST# 1)
(SETQ SORTED (CDR SORTED)))
(if (NULL SORTED)
then (LAB.PROMPTPRINT FOLDER "already in order")
else (replace (MAILFOLDER FOLDEROUTOFORDER) of FOLDER with T)
(if (< FIRST# (fetch (MAILFOLDER FIRSTCHANGEDMESSAGE) of FOLDER))
then (replace (MAILFOLDER FIRSTCHANGEDMESSAGE) of FOLDER
with FIRST#))
(UNINTERRUPTABLY
(for MSG in SORTED as I from FIRST#
do (replace (LAFITEMSG %#) of MSG with I)
(SETA MESSAGES I MSG)))
[LET ((FIRSTSEL (fetch (MAILFOLDER FIRSTSELECTEDMESSAGE) of FOLDER))
(LASTSEL (fetch (MAILFOLDER LASTSELECTEDMESSAGE) of FOLDER)))
(if (>= LASTSEL FIRSTSEL)
then (if (AND (>= FIRSTSEL FIRST#)
(<= FIRSTSEL LAST#))
then (* ;
 "Start of selection was inside here, have to recompute its number")
(replace (MAILFOLDER FIRSTSELECTEDMESSAGE)
of FOLDER with (LAB.FIND.SELECTED.MSG
FOLDER FIRST# LAST#)))
(if (AND (>= LASTSEL FIRST#)
(<= LASTSEL LAST#))
then (* ;
 "End of selection was inside here, have to recompute its number")
(replace (MAILFOLDER LASTSELECTEDMESSAGE)
of FOLDER with (LAB.REV.FIND.SELECTED.MSG
FOLDER FIRST# LAST#]
(LAB.DISPLAYLINES FOLDER FIRST# LAST# NIL T)
(LAB.PROMPTPRINT FOLDER "done"))))])
(LAFITEMSG.DATE.ORDER
[LAMBDA (X Y) (* ; "Edited 26-Apr-89 14:53 by bvm")
(* ;; "True if msg X has older date than msg Y. Since date field is stored as an unboxed 32-bit integer, we open code %"<%" here to avoid boxing.")
(LET [(HIDIFF (- (LOGXOR (fetch (LAFITEMSG IDATEHI) of X)
32768)
(LOGXOR (fetch (LAFITEMSG IDATEHI) of Y)
32768]
(* ;; "HIDIFF is unsigned difference of high words")
(OR (< HIDIFF 0)
(AND (EQ HIDIFF 0)
(< (fetch (LAFITEMSG IDATELO) of X)
(fetch (LAFITEMSG IDATELO) of Y])
(\LAFITE.SORT.BY.DATE.INTERACTIVE
[LAMBDA (FOLDER FIRST# LAST#) (* ; "Edited 3-May-89 18:38 by bvm")
(if (LAB.MOUSECONFIRM FOLDER "Click LEFT to confirm sorting ~D messages by date"
(if LAST#
then (ADD1 (- LAST# FIRST#))
else (fetch (MAILFOLDER %#OFMESSAGES) of FOLDER)))
then (\LAFITE.PROCESS `(,(FUNCTION LAFITE.SORT.BY.DATE)
',FOLDER
',FIRST#
',LAST#)
"LafiteSort"])
(\LAFITE.SORT.BY.DATE.REGION
[LAMBDA (FOLDER) (* ; "Edited 28-Apr-89 16:23 by bvm")
(LET ((FIRST# (fetch (MAILFOLDER FIRSTSELECTEDMESSAGE) of FOLDER))
(LAST# (fetch (MAILFOLDER LASTSELECTEDMESSAGE) of FOLDER)))
(if (> LAST# FIRST#)
then (\LAFITE.SORT.BY.DATE.INTERACTIVE FOLDER FIRST# LAST#)
else (LAB.FORMAT FOLDER "There is ~:[no~;only one~] message selected."
(EQ LAST# FIRST#])
)
(APPENDTOVAR LAFITEEXTRAMENUITEMS ("Sort by Date" '\LAFITE.SORT.BY.DATE.INTERACTIVE
"Sort all the messages in this folder by their Date: fields."
(SUBITEMS ("Sort Entire Folder"
'\LAFITE.SORT.BY.DATE.INTERACTIVE
"Sort all the messages in this folder by their Date: fields."
)
("Sort Selected Range"
'\LAFITE.SORT.BY.DATE.REGION
"Sort only the messages between the first and last selected messages."
))))
(* ; "Date hax")
(DEFINEQ
(GDATE1-6
[LAMBDA (D) (* ; "Edited 26-Apr-89 15:24 by bvm")
(* ;; "Return a string containing the day and month given in internal date D.")
(* ;; "This is an optimization by source code simplification of (SUBSTRING (GDATE IDT) 1 6)")
(PROG ((CHECKDLS \DayLightSavings)
[DQ (IQUOTIENT (LRSH (LISP.TO.ALTO.DATE D)
1)
(CONSTANT (IQUOTIENT (TIMES 60 60)
2]
HR DAY4 YDAY WDAY YEAR4 TOTALDAYS DLS) (* ;
 "DQ is number of hours since day 0, getting us past the sign bit problem.")
(* ;; "Now we can adjust to the current time zone. Since this might cause DQ to go negative, first add in 4 years worth of hours, making the base date be Jan 1, 1897")
(SETQ HR (IREMAINDER (SETQ DQ (- (+ DQ (CONSTANT (ITIMES 24 \4YearsDays)))
\TimeZoneComp))
24))
(SETQ TOTALDAYS (IQUOTIENT DQ 24))
DTLOOP
(SETQ DAY4 (IREMAINDER TOTALDAYS \4YearsDays)) (* ;
 "DAY4 = number of days since last leap year day 0")
[SETQ DAY4 (+ DAY4 (CDR (\DTSCAN DAY4 '((789 . 3)
(424 . 2)
(59 . 1)
(0 . 0] (* ;
 "pretend every year is a leap year, adding one for days after Feb 28")
(SETQ YEAR4 (IQUOTIENT TOTALDAYS \4YearsDays)) (* ;
 "YEAR4 = number of years til that last leap year / 4")
(SETQ YDAY (IREMAINDER DAY4 366)) (* ;
 "YDAY is the ordinal day in the year (jan 1 = zero)")
(SETQ WDAY (IREMAINDER (+ TOTALDAYS 3)
7))
[COND
((AND CHECKDLS (SETQ DLS (\ISDST? YDAY HR WDAY)))
(* ;; "This date is during daylight savings, so add 1 hour. Third arg is day of the week, which we determine by taking days mod 7 plus offset. Monday = zero in this scheme. Jan 1 1897 was actually a Friday (not Thursday=3), but we're cheating--1900 was not a leap year")
(COND
((> (SETQ HR (ADD1 HR))
23)
(* ;; "overflowed into the next day. This case is too hard (we might have overflowed the month, for example), so just go back and recompute")
(SETQ TOTALDAYS (ADD1 TOTALDAYS))
(SETQ HR 0)
(SETQ CHECKDLS NIL)
(GO DTLOOP]
(RETURN (LET* [[MONTH (\DTSCAN YDAY '((335 . "Dec")
(305 . "Nov")
(274 . "Oct")
(244 . "Sep")
(213 . "Aug")
(182 . "Jul")
(152 . "Jun")
(121 . "May")
(91 . "Apr")
(60 . "Mar")
(31 . "Feb")
(0 . "Jan"]
[DAY (ADD1 (- YDAY (CAR MONTH]
(RESULT (CONCAT " " (CDR MONTH]
(\RPLRIGHT RESULT 2 DAY 1)
RESULT])
)
(DECLARE%: EVAL@COMPILE DONTCOPY
(DECLARE%: EVAL@COMPILE
(RPAQQ \4YearsDays 1461)
(CONSTANTS \4YearsDays)
)
(DECLARE%: DOEVAL@COMPILE DONTCOPY
(GLOBALVARS \TimeZoneComp \DayLightSavings)
)
)
(PUTPROPS LAFITESORT COPYRIGHT ("Xerox Corporation" 1989 1995 2021))
(DECLARE%: DONTCOPY
(FILEMAP (NIL (2020 14676 (LAFITE.ASSURE.DATE.FIELDS 2030 . 8127) (LAFITE.PARSE.DATE.FIELD 8129 . 8766
) (LAFITE.PARSE.DATE.FIELD.ONLY 8768 . 8983) (LAFITE.SORT.BY.DATE 8985 . 9345) (LAFITE.SORT.MESSAGES
9347 . 12737) (LAFITEMSG.DATE.ORDER 12739 . 13487) (\LAFITE.SORT.BY.DATE.INTERACTIVE 13489 . 14133) (
\LAFITE.SORT.BY.DATE.REGION 14135 . 14674)) (15566 19381 (GDATE1-6 15576 . 19379)))))
STOP