(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) (FILECREATED "17-Sep-90 15:37:53" |{PELE:MV:ENVOS}INTERNAL>LIBRARY>AREDIT.;4| 94426 changes to%: (VARS AREDITCOMS) previous date%: " 2-Jul-90 15:15:42" |{PELE:MV:ENVOS}INTERNAL>LIBRARY>AREDIT.;3|) (* ; " Copyright (c) 1984, 1985, 1986, 1987, 1988, 1989, 1990 by Venue & Xerox Corporation. All rights reserved. ") (PRETTYCOMPRINT AREDITCOMS) (RPAQQ AREDITCOMS [(COMS (* ; "AR.FORM functions and variables") (FNS AR.FORM AR.FORM.GROUP.CREATE AR.FORM.CREATE AR.FORM.ICONFN AR.BUTTON.OBJ.CREATE AR.PROTECT.WARNING AR.INSTALL.TEDITSTREAM AR.KILL.ATTACHED.TEDIT.CLOSEFN)) (COMS (* ; "Managing buttons") (FNS AR.BUTTON.GET.MENU AR.BUTTON.GET.SUBMENU AR.BUTTONFN.DOMENU AR.BUTTONFN.DOSUBMENU AR.RESET.SEL AR.REPLACE.FIELD.VAL AR.GET.ASSOCIATED.MENU.VAL AR.BUTTONFN.SELFIELD AR.BUTTONFN.OFFER.DEFAULT AR.MAP.BUTTONS AR.FIND.BUTTON AR.GET.BUTTON.FIELD.AS.TEXT AR.GET.BUTTON.FIELD.SHAPE AR.GET.NUMBER.FIELD)) (COMS (* ; "Handling the command menu") (FNS AR.FORM.MENU.BUTTONFN AR.FORM.MENU.ACTIONFN AR.FORM.PROGRAMMATIC.GET AR.FORM.PROGRAMMATIC.PUT AR.DISCONNECT.WINDOW AR.RECONNECT.WINDOW AR.MARK.ACTIVE AR.TOBJ.ACTIVEP AR.FORM.MENU.TITLEMENUFN AR.MENU.CR.FN AR.GET.MENU.FROM.MAIN.WINDOW AR.CONFIRM)) (COMS (* ; "CLEAR") (FNS AR.MENU.FN.CLEAR AR.FORM.CLEAR AR.FORM.SET.TO.EMPTY AR.DELETE.FIELD.VAL)) (COMS (* ; "GET") (FNS AR.MENU.FN.GET AR.GET.AR AR.FETCH.AND.PARSE.AR AR.SET.FORM.NUMBER AR.GET.SCRATCH.STREAM AR.COPY.AND.INDEX.AR AR.MALFORMED.AR AR.TEXTSTREAM.LOAD AR.REPLACE.FILL.INS)) (COMS (* ; "PUT") (FNS AR.MENU.FN.PUT AR.MENU.FN.PUT&GET AR.MENU.FN.PUT&GETNEXT AR.FORM.SAVE AR.GET.SUBMIT.NUM AR.FIND.EDIT.CHANGES AR.NOTE.FIELD.CHANGED AR.SEND.MESSAGE AR.COPY.BUTTON.FIELD AR.UPDATE.AR.INFO AR.PUT.FAILED) (FNS AR.CHECK.FIELDS AR.CHECK.MENU AR.CHECK.SHORTSTRING AR.CHECK.SUBMENU)) (COMS (* ; "Special") (FNS AR.FORM.GET/PUT.FILE AR.GET.NEXT AR.FORM.FILL.IN.DEFAULTS AR.CURRENT.LISP.VERSION) (* ; "Misc") (FNS AR.PROMPT AR.PROMPT.PRINT AR.PROMPT.CLEAR AR.GET.FILENAME AR.READ.NUMBER AR.FILENAME AR.READ.BYTES AR.USERNAME)) (COMS (* ;  "These have special knowledge of TEdit I wish I didn't really need") (FNS TEDIT.FAST.RAW.INCLUDE AR.PIECE.CHANGED) (* ; "Patch for Lyric") (FNS AR.UNSELECT.ITEM)) (COMS (* ; "Hardcopying AR's") (FNS AR.DISPLAY AR.HARDCOPY AR.DISPLAY.TEXTSTREAM) (INITVARS (AR.HARDCOPY.WIDTH 504) (AR.HARDCOPY.MAXLENGTH 40000) (AR.DISPLAY.FORMAT NIL))) (COMS (* ;  "These VARS are AR-system change these to work on different AR databases") (VARS AR.FORM.FORMAT AR.FORM.SPECS AR.INTERESTING.SUBMIT.FIELDS) (VARS (AR.DIRECTORY "{AR:MV:Envos}") (AR.INFO.FILE.NAME "{AR:MV:Envos}LispARs.tds") (AR.SUBMIT.NUM.FILE.NAME "{AR:MV:Envos}LispARs.num") (AR.IDENTIFICATION.STRING "AR"))) (INITVARS (ARBUTTONFONT (FONTCREATE 'HELVETICA 12 'BOLD)) (ARFONT (FONTCREATE 'TIMESROMAN 10)) (ARBOLDFONT (FONTCREATE 'HELVETICA 10 'BOLD)) (ARHEADERFONT (FONTCREATE 'HELVETICA 8)) (AR.ICONFONT (FONTCREATE 'GACHA 8)) (AR.FILE.TRIES 10) (AR.NO.MESSAGE.FLG NIL)) (VARS (AR.NULL.BUTTON.VALUE (PACKC)) AR.FORM.MENU.TITLEMENU.ITEMS (AR.FORM.MENU.TITLEMENU) AR.FORM.ICONSPEC) [DECLARE%: EVAL@COMPILE DONTCOPY (GLOBALVARS AR.FORM.ICONSPEC AR.NULL.BUTTON.VALUE AR.HARDCOPY.PAGENO.KLUDGE.OFFSET AR.MENU.READTABLE TEDIT.READTABLE AR.FORM.MENU.TITLEMENU) (LOCALVARS . T) (P (* ;  "Need TEDITDECLS for TEDIT.FAST.RAW.INCLUDE") (OR (GET 'TEDITDECLS 'FILE) (LOAD 'TEDITDECLS] [DECLARE%: EVAL@COMPILE DOCOPY (P (CL:PROCLAIM '(CL:SPECIAL AR.INFO.FILE.NAME AR.SUBMIT.NUM.FILE.NAME AR.DIRECTORY AR.NO.MESSAGE.FLG ARBUTTONFONT ARFONT ARBOLDFONT ARHEADERFONT AR.ICONFONT AR.FILE.TRIES AR.HARDCOPY.MAXLENGTH AR.FORM.FORMAT AR.FORM.SPECS AR.HARDCOPY.WIDTH AR.DISPLAY.FORMAT AR.IDENTIFICATION.STRING AR.FORM.MENU.TITLEMENU.ITEMS AR.INTERESTING.SUBMIT.FIELDS] (FILES (SYSLOAD) ARQUERY TABLEBROWSER TEDIT READNUMBER) [VARS (AR.HARDCOPY.PAGENO.KLUDGE.OFFSET (COND ((> (IDATE TEDITSYSTEMDATE) (IDATE "23-feb-88 0000")) (* ; "Bug was fixed") 0) (T 2] (DECLARE%: DONTEVAL@LOAD DOCOPY (P (COND ((EQ MAKESYSNAME :LYRIC) (FILESLOAD (SYSLOAD) MVALUESPATCH) (MOVD? 'AR.UNSELECT.ITEM 'TB.UNSELECT.ITEM NIL T))) (PUTD 'AR.UNSELECT.ITEM NIL)) (P (* ;  "Install background menu command. Smash any previous AREdit.") [/RPLACD [OR (CL:ASSOC "AR Edit" BackgroundMenuCommands :TEST 'STRING-EQUAL) (CAR (RPAQ BackgroundMenuCommands (CONS (LIST "AR Edit") BackgroundMenuCommands))] '('(AR.FORM) "Create a new AR editor for the Lisp AR database" (SUBITEMS ("New AR form" '(AR.FORM) "Creates a new AR editor, cleared ready to submit a new AR." ) ("Load AR" '(AR.FORM (AR.READ.NUMBER)) "Creates a new AR editor and loads a specified AR into it") ("Display AR" '(AR.DISPLAY (AR.READ.NUMBER)) "Displays a specified AR in a read-only window") ("AR Query Form" '(AR.QFORM.CREATE) "Creates an AR Query Form"] (RPAQ BackgroundMenu ))) (DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS (ADDVARS (NLAMA) (NLAML) (LAMA AR.PROMPT.PRINT]) (* ; "AR.FORM functions and variables") (DEFINEQ (AR.FORM (LAMBDA (NUM) (* ; "Edited 22-Feb-88 17:13 by bvm") (ADD.PROCESS (BQUOTE ((\, (FUNCTION AR.FORM.GROUP.CREATE)) (QUOTE (\, NUM)) (QUOTE (\, (PROGN (* ; "Get region here in the mouse process so that user can ^E") (GETREGION 450 200)))))) (QUOTE NAME) (QUOTE AR.FORM.NEW))) ) (AR.FORM.GROUP.CREATE (LAMBDA (INITIAL.NUM FORMWINDOW) (* ; "Edited 4-Aug-88 15:24 by bvm") (PROG (FORMSTREAM MENUW WREG) (if (WINDOWP FORMWINDOW) then (* ; "Already have window") (SETQ WREG (WINDOWPROP FORMWINDOW (QUOTE REGION))) else (SETQ WREG (OR (REGIONP FORMWINDOW) (GETREGION 450 200))) (replace (REGION HEIGHT) of WREG with (- (fetch (REGION HEIGHT) of WREG) (HEIGHTIFWINDOW (TIMES 2 (FONTPROP DEFAULTFONT (QUOTE HEIGHT)))) 40)) (* ; "Subtract out the height for the menu and prompt windows.") (SETQ FORMWINDOW (CREATEW WREG "New Bug Report"))) (* ;; "set up main window") (WINDOWADDPROP FORMWINDOW (QUOTE CLOSEFN) (FUNCTION AR.KILL.ATTACHED.TEDIT.CLOSEFN)) (WINDOWPROP FORMWINDOW (QUOTE MINSIZE) (CONS 450 60)) (WINDOWPROP FORMWINDOW (QUOTE AR.WINDOW.PROC.NAME) (QUOTE AR.FORM)) (WINDOWPROP FORMWINDOW (QUOTE ICONFN) (FUNCTION AR.FORM.ICONFN)) (* ;; "set up menu window") (SETQ MENUW (CREATEW (create REGION LEFT _ (fetch (REGION LEFT) of WREG) BOTTOM _ (fetch (REGION PTOP) of WREG) WIDTH _ (fetch (REGION WIDTH) of WREG) HEIGHT _ 40) (CONCAT AR.IDENTIFICATION.STRING " Bug Report Editor"))) (ATTACHWINDOW MENUW FORMWINDOW (QUOTE TOP) (QUOTE JUSTIFY) NIL) (WINDOWPROP MENUW (QUOTE MAXSIZE) (CONS 0 40)) (WINDOWPROP MENUW (QUOTE MINSIZE) (CONS 0 40)) (WINDOWPROP MENUW (QUOTE AR.WINDOW.PROC.NAME) (QUOTE AR.FORM.MENU)) (if (NOT (AND (BOUNDP (QUOTE AR.MENU.READTABLE)) (READTABLEP AR.MENU.READTABLE))) then (SETQ AR.MENU.READTABLE (COPYREADTABLE TEDIT.READTABLE)) (TEDIT.SETFUNCTION (CHARCODE CR) (FUNCTION AR.MENU.CR.FN) AR.MENU.READTABLE)) (GETPROMPTWINDOW FORMWINDOW 2) (PROGN (* ; "First, install the menu. It would be nice to do this last (since you can't use it yet), but need it for setting the form number") (AR.FORM.CREATE MENUW ARBUTTONFONT (QUOTE ((New FIELDTYPE BUTTON FN AR.FORM.MENU.BUTTONFN) (Get FIELDTYPE BUTTON FN AR.FORM.MENU.BUTTONFN) (Put FIELDTYPE BUTTON FN AR.FORM.MENU.BUTTONFN) (Number%: FIELDTYPE STRING))) (QUOTE (New TAB Get TAB Put TAB Number%: TAB CR)) (LIST (QUOTE READTABLE) AR.MENU.READTABLE (QUOTE TITLEMENUFN) (FUNCTION NILL) (QUOTE PROMPTWINDOW) (QUOTE DON'T))) (AND NIL (until (WINDOWPROP MENUW (QUOTE LINES)) do (* ; "wait until the menu is totally initialized. Is this kludge necessary?") (BLOCK 1000)))) (SETQ FORMSTREAM (AR.FORM.CREATE FORMWINDOW ARBOLDFONT AR.FORM.SPECS AR.FORM.FORMAT (QUOTE DON'T))) (* ; "create AR form for main window") (if (OR (NULL INITIAL.NUM) (EQ (AR.GET.AR FORMWINDOW INITIAL.NUM FORMSTREAM) (QUOTE XCL:FILE-NOT-FOUND))) then (* ; "Either nothing to get, or AR doesn't exist, so pretend it was just a New command") (AR.FORM.CLEAR FORMSTREAM T T)) (* ; "Now that we have the textstream we want, let TEdit display it") (AR.INSTALL.TEDITSTREAM FORMWINDOW FORMSTREAM) (* ;; "Now that we're about ready, enable the title menu. You might think this was a textprop, but you'd be wrong.") (WINDOWPROP MENUW (QUOTE TEDIT.TITLEMENUFN) (FUNCTION AR.FORM.MENU.TITLEMENUFN)) (replace (TEXTOBJ MENUFLG) of (TEXTOBJ MENUW) with T) (RETURN FORMWINDOW))) ) (AR.FORM.CREATE (LAMBDA (FORMWINDOW BUTTONFONT FORM.SPECS FORM.FORMAT TEDITPROPS) (* ; "Edited 17-Feb-88 15:47 by bvm") (* ;; "Create an AR form in FORMWINDOW as specified by FORM.SPECS (button details) and FORM.FORMAT (layout of the fields). BUTTONFONT is used for buttons that don't specify their own font in FORM.SPECS. TEDITPROPS is passed on to TEdit; if it is the symbol DON'T, we don't create a TEdit process, but just return the textstream.") (LET ((FORMSTREAM (OPENTEXTSTREAM "" NIL NIL NIL (BQUOTE (FONT (\, ARFONT) PARALOOKS (PARALEADING 2) TEDIT.TENTATIVE NIL)))) (NTABS 0) (WIDTH (WINDOWPROP FORMWINDOW (QUOTE WIDTH))) (CH# 1) BUTTON.POSITIONS SELECT.POINTS TAB.CH# TABSTOPS) (for FIELD.OR.SPACE in FORM.FORMAT do (BLOCK) (if (EQ FIELD.OR.SPACE (QUOTE TAB)) then (* ; "Separates fields all on one line") (TEDIT.INSERT FORMSTREAM " " (SETQ TAB.CH# CH#)) (add NTABS 1) (add CH# 1) elseif (EQ FIELD.OR.SPACE (QUOTE CR)) then (* ; "Go to a new line. Come up with tabs to divide the space evenly among the fields") (if (> NTABS 0) then (push TABSTOPS NTABS TAB.CH#) (SETQ NTABS 0)) (TEDIT.INSERT FORMSTREAM " " CH#) (add CH# 1) elseif (STRINGP FIELD.OR.SPACE) then (TEDIT.INSERT FORMSTREAM FIELD.OR.SPACE CH#) (add CH# (NCHARS FIELD.OR.SPACE)) else (* ; "Make a button") (LET* ((BUTTONSPEC (CDR (ASSOC FIELD.OR.SPACE FORM.SPECS))) (BUTTON.TYPE (LISTGET BUTTONSPEC (QUOTE FIELDTYPE))) (BUTTON.OBJ (AR.BUTTON.OBJ.CREATE BUTTONSPEC FIELD.OR.SPACE BUTTONFONT)) (PRE.FIELD (SELECTQ BUTTON.TYPE (BUTTON "") ((MENU SUBMENU) " {") " ")) (PRE.FIELD.NCHARS (NCHARS PRE.FIELD))) (BLOCK) (TEDIT.INSERT.OBJECT BUTTON.OBJ FORMSTREAM CH#) (* ; "Insert the button object, make it unprotected") (push BUTTON.POSITIONS CH#) (add CH# 1) (if (> PRE.FIELD.NCHARS 0) then (TEDIT.INSERT FORMSTREAM PRE.FIELD CH#) (if (NOT (IMAGEOBJPROP BUTTON.OBJ (QUOTE AR.PROTECTED.FLG))) then (* ; "Allow selection after the pre-field") (push SELECT.POINTS (+ CH# (SUB1 PRE.FIELD.NCHARS)))) (add CH# PRE.FIELD.NCHARS)) (IMAGEOBJPROP BUTTON.OBJ (QUOTE AR.FIELD.START) (ADD1 PRE.FIELD.NCHARS)) (IMAGEOBJPROP BUTTON.OBJ (QUOTE AR.FIELD.LEN) 0) (* ; "Field currently empty") (SELECTQ BUTTON.TYPE ((MENU SUBMENU) (* ; "Close the braces") (TEDIT.INSERT FORMSTREAM "}" CH#) (add CH# 1)) NIL)))) (TEDIT.LOOKS FORMSTREAM (QUOTE (PROTECTED ON)) 1 CH#) (* ; "default char looks: everything is protected") (for N in BUTTON.POSITIONS do (* ; "Let buttons be touched") (TEDIT.LOOKS FORMSTREAM (QUOTE (PROTECTED OFF)) N 1)) (for N in SELECT.POINTS do (* ; "Allow selection after string buttons") (TEDIT.LOOKS FORMSTREAM (QUOTE (SELECTPOINT ON)) N 1)) (while TABSTOPS bind CACHED.TABS TB do (* ; "Process each <#tabs chpos> pair and set a tab stop there.") (SETQ NTABS (pop TABSTOPS)) (TEDIT.PARALOOKS FORMSTREAM (if (CDR (ASSOC NTABS CACHED.TABS)) else (* ; "Cache tab settings for this number of tabs") (push CACHED.TABS (CONS NTABS (SETQ TB (BQUOTE (TABS (NIL (\,@ (for I from 1 to NTABS bind (TABWIDTH _ (IQUOTIENT WIDTH (ADD1 NTABS))) collect (CONS (ITIMES I TABWIDTH) (QUOTE LEFT)))))))))) TB) (pop TABSTOPS) 1)) (TEDIT.STREAMCHANGEDP FORMSTREAM T) (if (EQ TEDITPROPS (QUOTE DON'T)) then (* ; "Don't install it") FORMSTREAM else (AR.INSTALL.TEDITSTREAM FORMWINDOW FORMSTREAM TEDITPROPS)))) ) (AR.FORM.ICONFN (LAMBDA (WINDOW OLDICON) (* ; "Edited 1-Mar-88 17:33 by bvm") (OR OLDICON (TITLEDICONW AR.FORM.ICONSPEC (WINDOWPROP WINDOW (QUOTE AR.FORM.NUMBER)) AR.ICONFONT (WINDOWPROP WINDOW (QUOTE ICONPOSITION)) NIL NIL (QUOTE FILE)))) ) (AR.BUTTON.OBJ.CREATE (LAMBDA (BUTTONSPEC BUTTON.NAME BUTTON.FONT) (* ; "Edited 4-Aug-88 15:27 by bvm") (PROG ((BUTTON.TYPE (LISTGET BUTTONSPEC (QUOTE FIELDTYPE))) OBJ FONT TEM) (if (AND (EQ BUTTON.TYPE (QUOTE STRING)) (LISTGET BUTTONSPEC (QUOTE MAXCHARS))) then (* ; "if a string has a max length given, treat it as a SHORTSTRING") (SETQ BUTTON.TYPE (QUOTE SHORTSTRING))) (SETQ OBJ (MBUTTON.CREATE BUTTON.NAME (OR (LISTGET BUTTONSPEC (QUOTE FN)) (SELECTQ BUTTON.TYPE (PROTECTEDSTRING (FUNCTION AR.PROTECT.WARNING)) ((STRING SHORTSTRING) (FUNCTION AR.BUTTONFN.SELFIELD)) (MENU (FUNCTION AR.BUTTONFN.DOMENU)) (SUBMENU (FUNCTION AR.BUTTONFN.DOSUBMENU)) (ERROR "Bad Button Type" BUTTON.TYPE))) (if (SETQ FONT (LISTGET BUTTONSPEC (QUOTE FONT))) then (FONTCREATE (if (LITATOM FONT) then (* ; "a method of indirection") (EVALV FONT) else FONT)) else BUTTON.FONT))) (IMAGEOBJPROP OBJ (QUOTE AR.CHECK.FN) (SELECTQ BUTTON.TYPE ((BUTTON PROTECTEDSTRING STRING) (FUNCTION NILL)) (SHORTSTRING (FUNCTION AR.CHECK.SHORTSTRING)) (MENU (FUNCTION AR.CHECK.MENU)) (SUBMENU (FUNCTION AR.CHECK.SUBMENU)) (ERROR "Bad Button Type" BUTTON.TYPE))) (SELECTQ BUTTON.TYPE ((BUTTON PROTECTEDSTRING MENU SUBMENU) (IMAGEOBJPROP OBJ (QUOTE AR.PROTECTED.FLG) BUTTON.TYPE)) NIL) (SELECTQ BUTTON.TYPE (SHORTSTRING (IMAGEOBJPROP OBJ (QUOTE AR.MAX.LEN) (LISTGET BUTTONSPEC (QUOTE MAXCHARS)))) (MENU (IMAGEOBJPROP OBJ (QUOTE AR.ASSOCIATED.SUBMENU) (LISTGET BUTTONSPEC (QUOTE ASSOCSUBMENU))) (IMAGEOBJPROP OBJ (QUOTE AR.MENU.LIST) (LISTGET BUTTONSPEC (QUOTE MENULIST)))) (SUBMENU (IMAGEOBJPROP OBJ (QUOTE AR.ASSOCIATED.MENU) (LISTGET BUTTONSPEC (QUOTE ASSOCMENU))) (IMAGEOBJPROP OBJ (QUOTE AR.SUBMENU.LIST) (LISTGET BUTTONSPEC (QUOTE SUBMENULIST)))) NIL) (if (SETQ TEM (LISTGET BUTTONSPEC (QUOTE INITIALVALUE))) then (IMAGEOBJPROP OBJ (QUOTE INITIALVALUE) TEM)) (if (SETQ TEM (LISTGET BUTTONSPEC (QUOTE FILLINVALUE))) then (IMAGEOBJPROP OBJ (QUOTE FILLINVALUE) TEM)) (RETURN OBJ))) ) (AR.PROTECT.WARNING (LAMBDA (OBJ SEL WINDOW) (* ; "Edited 20-Jul-88 17:04 by bvm") (AR.PROMPT.PRINT WINDOW :CLEAR "The field %"" (IMAGEOBJPROP OBJ (QUOTE MBTEXT)) "%" is not editable.")) ) (AR.INSTALL.TEDITSTREAM (LAMBDA (FORMWINDOW FORMSTREAM TEDITPROPS) (* ; "Edited 12-Feb-88 15:59 by bvm") (* ;; "Given a TEdit stream FORMSTREAM, install it in the window FORMWINDOW") (LET ((FORMWINDOW.PROC (WINDOWPROP FORMWINDOW (QUOTE PROCESS))) NEWPROC TEM) (COND ((AND FORMWINDOW.PROC (PROCESSP FORMWINDOW.PROC)) (TEDIT.KILL FORMWINDOW))) (SETQ NEWPROC (TEDIT FORMSTREAM FORMWINDOW NIL (APPEND TEDITPROPS (BQUOTE (FONT (\, ARFONT) SEL DON'T LEAVETTY T TEDIT.TENTATIVE NIL))))) (if (SETQ TEM (WINDOWPROP FORMWINDOW (QUOTE AR.WINDOW.PROC.NAME))) then (PROCESSPROP NEWPROC (QUOTE NAME) TEM)))) ) (AR.KILL.ATTACHED.TEDIT.CLOSEFN (LAMBDA (WINDOW) (* edited%: "30-Aug-84 09:58") (for AW in (ATTACHEDWINDOWS WINDOW) bind TSTREAM when (SETQ TSTREAM (WINDOWPROP AW (QUOTE TEXTSTREAM))) do (DETACHWINDOW AW) (TEDIT.KILL (TEXTOBJ TSTREAM)) (CLOSEW AW) finally (if (SETQ TSTREAM (WINDOWPROP WINDOW (QUOTE TEXTSTREAM))) then (TEDIT.KILL (TEXTOBJ TSTREAM))))) ) ) (* ; "Managing buttons") (DEFINEQ (AR.BUTTON.GET.MENU (LAMBDA (OBJ) (* ; "Edited 12-Feb-88 11:49 by bvm") (OR (IMAGEOBJPROP OBJ (QUOTE AR.MENU)) (LET ((MENU (create MENU ITEMS _ (BQUOTE ((\,@ (IMAGEOBJPROP OBJ (QUOTE AR.MENU.LIST))) (NIL (QUOTE (\, AR.NULL.BUTTON.VALUE))))) TITLE _ (IMAGEOBJPROP OBJ (QUOTE MBTEXT))))) (IMAGEOBJPROP OBJ (QUOTE AR.MENU) MENU) MENU))) ) (AR.BUTTON.GET.SUBMENU (LAMBDA (OBJ ASSOCIATED.MENU.VAL) (* ; "Edited 12-Feb-88 11:53 by bvm") (* ;; "Get the submenu from OBJ associated with ASSOCIATED.MENU.VAL. The submenus are stored as a plist on the AR.SUBMENUS prop") (LET ((SUBMENUS (IMAGEOBJPROP OBJ (QUOTE AR.SUBMENUS))) MENU) (if (LISTGET SUBMENUS ASSOCIATED.MENU.VAL) else (SETQ MENU (create MENU ITEMS _ (BQUOTE ((\,@ (LISTGET (IMAGEOBJPROP OBJ (QUOTE AR.SUBMENU.LIST)) ASSOCIATED.MENU.VAL)) (NIL (QUOTE (\, AR.NULL.BUTTON.VALUE))))) TITLE _ (IMAGEOBJPROP OBJ (QUOTE MBTEXT)))) (if SUBMENUS then (LISTPUT SUBMENUS ASSOCIATED.MENU.VAL MENU) else (IMAGEOBJPROP OBJ (QUOTE AR.SUBMENUS) (LIST ASSOCIATED.MENU.VAL MENU))) MENU))) ) (AR.BUTTONFN.DOMENU (LAMBDA (OBJ SEL WINDOW) (* ; "Edited 12-Feb-88 16:05 by bvm") (LET ((NEWVAL (MENU (AR.BUTTON.GET.MENU OBJ))) ASSOC.SUBMENU STREAM BUTTON) (if (AND NEWVAL (NOT (EQUAL NEWVAL (IMAGEOBJPROP OBJ (QUOTE AR.FIELD.VALUE))))) then (AR.REPLACE.FIELD.VAL OBJ (fetch (SELECTION CH#) of SEL) (SETQ STREAM (WINDOWPROP WINDOW (QUOTE TEXTSTREAM))) NEWVAL) (if (SETQ ASSOC.SUBMENU (IMAGEOBJPROP OBJ (QUOTE AR.ASSOCIATED.SUBMENU))) then (* ; "There is a submenu related to this button (e.g., System -> Subsystem). Need to clear the submenu value when the main value changed") (if (SETQ BUTTON (AR.FIND.BUTTON STREAM ASSOC.SUBMENU)) then (AR.REPLACE.FIELD.VAL (CAR BUTTON) (CDR BUTTON) STREAM AR.NULL.BUTTON.VALUE) (IMAGEOBJPROP (CAR BUTTON) (QUOTE AR.ASSOCIATED.MENU.VAL) NEWVAL) else (ERROR "Can't find associated submenu button" ASSOC.SUBMENU)))) (AR.RESET.SEL WINDOW))) ) (AR.BUTTONFN.DOSUBMENU (LAMBDA (OBJ SEL WINDOW) (* edited%: "30-Aug-84 09:57") (PROG ((STREAM (WINDOWPROP WINDOW (QUOTE TEXTSTREAM))) (ASSOCIATED.MENU.VAL (AR.GET.ASSOCIATED.MENU.VAL OBJ WINDOW)) NEWVAL) (SETQ NEWVAL (MENU (AR.BUTTON.GET.SUBMENU OBJ ASSOCIATED.MENU.VAL))) (if (AND NEWVAL (NOT (EQUAL NEWVAL (IMAGEOBJPROP OBJ (QUOTE AR.FIELD.VALUE))))) then (AR.REPLACE.FIELD.VAL OBJ (fetch (SELECTION CH#) of SEL) STREAM NEWVAL)) (AR.RESET.SEL WINDOW))) ) (AR.RESET.SEL (LAMBDA (WINDOW.OR.STREAM) (* ; "Edited 14-Feb-88 02:18 by bvm") (if NIL then (LET ((TOBJ (TEXTOBJ WINDOW.OR.STREAM)) SEL) (TEDIT.SHOWSEL (TEXTSTREAM TOBJ)) (if (SETQ SEL (fetch (TEXTOBJ SEL) of TOBJ)) then (* ; "Manually turn off selection, then mark current selection not set") (replace (SELECTION SET) of SEL with NIL))) else (* ;; "for now, since I can't figure out how to turn off the selection, just put the selection in the first safe place") (AR.MAP.BUTTONS WINDOW.OR.STREAM (FUNCTION (LAMBDA (TOBJ OBJ CH#) (* ; "If OBJ is unprotected, set TEdit's selection at its beginning") (if (NOT (IMAGEOBJPROP OBJ (QUOTE AR.PROTECTED.FLG))) then (TEDIT.SETSEL TOBJ (fetch (SELECTION CH#) of (MBUTTON.FIND.NEXT.FIELD TOBJ CH#)) 0 (QUOTE LEFT)) (TEDIT.SHOWSEL (TEXTSTREAM TOBJ)) (* ; "Don't let it be visible") T)))))) ) (AR.REPLACE.FIELD.VAL (LAMBDA (OBJ CH# WINDOW.OR.STREAM NEWVAL) (* ; "Edited 12-Feb-88 11:40 by bvm") (PROG ((TOBJ (TEXTOBJ WINDOW.OR.STREAM)) (NEWVAL.NCHARS (NCHARS NEWVAL)) (PROTECTEDP (IMAGEOBJPROP OBJ (QUOTE AR.PROTECTED.FLG))) OLDLEN INSERT.CH# SEL) (if PROTECTEDP then (SETQ INSERT.CH# (+ (IMAGEOBJPROP OBJ (QUOTE AR.FIELD.START)) CH#)) (SETQ OLDLEN (IMAGEOBJPROP OBJ (QUOTE AR.FIELD.LEN))) (IMAGEOBJPROP OBJ (QUOTE AR.FIELD.LEN) NEWVAL.NCHARS) (IMAGEOBJPROP OBJ (QUOTE AR.FIELD.VALUE) NEWVAL) elseif (SETQ SEL (MBUTTON.FIND.NEXT.FIELD TOBJ CH#)) then (SETQ INSERT.CH# (fetch (SELECTION CH#) of SEL)) (SETQ OLDLEN (fetch (SELECTION DCH) of SEL)) else (SHOULDNT "Can't find button field")) (TEDIT.DELETE TOBJ INSERT.CH# OLDLEN) (if (> NEWVAL.NCHARS 0) then (TEDIT.INSERT TOBJ (if (NUMBERP NEWVAL) then (MKSTRING NEWVAL) else NEWVAL) INSERT.CH#) (TEDIT.LOOKS TOBJ (CONS (QUOTE PROTECTED) (if PROTECTEDP then (QUOTE (ON)) else (QUOTE (OFF)))) INSERT.CH# NEWVAL.NCHARS)))) ) (AR.GET.ASSOCIATED.MENU.VAL (LAMBDA (OBJ WINDOW) (* edited%: "30-Aug-84 09:58") (PROG ((BUTTON (AR.FIND.BUTTON (WINDOWPROP WINDOW (QUOTE TEXTSTREAM)) (IMAGEOBJPROP OBJ (QUOTE AR.ASSOCIATED.MENU))))) (if (NULL BUTTON) then (ERROR "Can't find associated menu value" (IMAGEOBJPROP OBJ (QUOTE AR.ASSOCIATED.MENU)))) (RETURN (IMAGEOBJPROP (CAR BUTTON) (QUOTE AR.FIELD.VALUE))))) ) (AR.BUTTONFN.SELFIELD (LAMBDA (OBJ SEL WINDOW) (* ; "Edited 16-Feb-88 13:17 by bvm") (* ;; "Button function for text fields--select the current text in delete pending mode") (LET* ((TOBJ (fetch (SELECTION \TEXTOBJ) of SEL)) (FIELD.SEL (MBUTTON.FIND.NEXT.FIELD TOBJ (fetch (SELECTION CH#) of SEL))) FIELD.CH# FIELD.LEN) (TEDIT.SETSEL TOBJ (fetch (SELECTION CH#) of FIELD.SEL) (fetch (SELECTION DCH) of FIELD.SEL) (QUOTE LEFT) T))) ) (AR.BUTTONFN.OFFER.DEFAULT (LAMBDA (OBJ SEL WINDOW) (* ; "Edited 4-Aug-88 17:24 by bvm") (* ;; "AR Button function that responds to a click by filling in the default value for the field, pending-delete selected so that you can overwrite it.") (LET* ((TOBJ (fetch (SELECTION \TEXTOBJ) of SEL)) (FIELD.SEL (MBUTTON.FIND.NEXT.FIELD TOBJ (fetch (SELECTION CH#) of SEL))) (FIELD.CH# (fetch (SELECTION CH#) of FIELD.SEL)) (FIELD.LEN (fetch (SELECTION DCH) of FIELD.SEL)) INFO) (if (AND (EQ FIELD.LEN 0) (SETQ INFO (IMAGEOBJPROP OBJ (QUOTE FILLINVALUE))) (OR (NLISTP INFO) (SETQ INFO (EVAL INFO)))) then (* ; "Nothing there yet, so offer default") (TEDIT.INSERT TOBJ INFO FIELD.CH# (QUOTE (PROTECTED OFF))) (SETQ FIELD.LEN (NCHARS INFO))) (TEDIT.SETSEL TOBJ FIELD.CH# FIELD.LEN (QUOTE LEFT) T))) ) (AR.MAP.BUTTONS (LAMBDA (WINDOW.OR.STREAM MAPFN DEFAULT) (* ; "Edited 12-Feb-88 10:59 by bvm") (* ;; "Map over the buttons of the form in WINDOW.OR.STREAM, applying MAPFN to each button with args (TEXTOBJ BUTTONOBJ CH#). Return the value from the first application that returns non-NIL. Return DEFAULT if all returned NIL.") (bind (TOBJ _ (TEXTOBJ WINDOW.OR.STREAM)) (CH# _ 0) BUTTON RESULT while (SETQ BUTTON (MBUTTON.FIND.NEXT.BUTTON TOBJ (add CH# 1))) when (SETQ RESULT (CL:FUNCALL MAPFN TOBJ (CAR BUTTON) (SETQ CH# (CDR BUTTON)))) do (RETURN RESULT) finally (RETURN DEFAULT))) ) (AR.FIND.BUTTON (LAMBDA (WINDOW NAME) (* edited%: "30-Aug-84 09:57") (PROG ((TOBJ (TEXTOBJ WINDOW)) (CH# 0) OBJ BUTTON) (while (PROGN (add CH# 1) (SETQ BUTTON (MBUTTON.FIND.NEXT.BUTTON TOBJ CH#))) do (SETQ OBJ (CAR BUTTON)) (SETQ CH# (CDR BUTTON)) repeatuntil (EQ NAME (IMAGEOBJPROP OBJ (QUOTE MBTEXT)))) (RETURN BUTTON))) ) (AR.GET.BUTTON.FIELD.AS.TEXT (LAMBDA (WINDOW BUTTON.NAME) (* ; "Edited 12-Feb-88 11:05 by bvm") (* ;; "Given a button name and an AR form window, grab the value of the named button and return it as a string or symbol.") (OR (AR.MAP.BUTTONS WINDOW (FUNCTION (LAMBDA (TOBJ OBJ CH#) (if (EQ (IMAGEOBJPROP OBJ (QUOTE MBTEXT)) BUTTON.NAME) then (COND ((OR (IMAGEOBJPROP OBJ (QUOTE AR.MENU.LIST)) (IMAGEOBJPROP OBJ (QUOTE AR.SUBMENU.LIST))) (* ; "This is a multiple-choice button. Extract the value from the button itself. ") (OR (IMAGEOBJPROP OBJ (QUOTE AR.FIELD.VALUE)) "")) (T (* ; "This is a text button. Go looking for the next field and grab it from there.") (MBUTTON.NEXT.FIELD.AS.TEXT TOBJ CH#))))))) (ERROR "Can't find named button" BUTTON.NAME))) ) (AR.GET.BUTTON.FIELD.SHAPE (LAMBDA (WINDOW.OR.STREAM BUTTON.NAME) (* ; "Edited 16-Feb-88 11:36 by bvm") (* ;; "Given a button name and an AR form window, return a dotted pair (ch# . length) describing where in the tedit stream the field lives and how long it is.") (OR (AR.MAP.BUTTONS WINDOW.OR.STREAM (FUNCTION (LAMBDA (TOBJ OBJ CH#) (if (EQ (IMAGEOBJPROP OBJ (QUOTE MBTEXT)) BUTTON.NAME) then (if (IMAGEOBJPROP OBJ (QUOTE AR.PROTECTED.FLG)) then (CONS (+ (IMAGEOBJPROP OBJ (QUOTE AR.FIELD.START)) CH#) (IMAGEOBJPROP OBJ (QUOTE AR.FIELD.LEN))) else (LET ((SEL (MBUTTON.FIND.NEXT.FIELD TOBJ CH#))) (if SEL then (CONS (fetch (SELECTION CH#) of SEL) (fetch (SELECTION DCH) of SEL)) else (SHOULDNT "Can't find field for button")))))))) (ERROR "Can't find named button" BUTTON.NAME))) ) (AR.GET.NUMBER.FIELD (LAMBDA (FORMWINDOW) (* ; "Edited 5-Aug-88 11:21 by bvm") (* ;; "Return the AR number currently shown in the form's NUMBER field") (MKATOM (AR.GET.BUTTON.FIELD.AS.TEXT (OR (AR.GET.MENU.FROM.MAIN.WINDOW FORMWINDOW) FORMWINDOW) (QUOTE Number%:)))) ) ) (* ; "Handling the command menu") (DEFINEQ (AR.FORM.MENU.BUTTONFN (LAMBDA (OBJ SEL WINDOW) (* ; "Edited 5-Aug-88 11:01 by bvm") (AR.FORM.MENU.ACTIONFN (\TEDIT.PRIMARYW (fetch (SELECTION \TEXTOBJ) of SEL)) (EVAL (CADR (CL:ASSOC (IMAGEOBJPROP OBJ (QUOTE MBTEXT)) AR.FORM.MENU.TITLEMENU.ITEMS))))) ) (AR.FORM.MENU.ACTIONFN (LAMBDA (MENUWINDOW OPERATION NUM.FOR.GET OPNAME) (* ; "Edited 5-Aug-88 16:00 by bvm") (ALLOW.BUTTON.EVENTS) (PROG* ((FORMWINDOW (WINDOWPROP MENUWINDOW (QUOTE MAINWINDOW))) (MENUWINDOW.TEXTOBJ (WINDOWPROP MENUWINDOW (QUOTE TEXTOBJ))) (FORMWINDOW.TEXTOBJ (WINDOWPROP FORMWINDOW (QUOTE TEXTOBJ))) SUCCESS ARP BUSY) (AR.PROMPT.CLEAR FORMWINDOW) (if (OR (NOT (WINDOWPROP FORMWINDOW (QUOTE TEXTSTREAM))) (NULL MENUWINDOW.TEXTOBJ) (NULL FORMWINDOW.TEXTOBJ)) then (AR.PROMPT.PRINT FORMWINDOW "AR form munged!! --- Close this AR window and create another") (RETURN)) (if (SETQ BUSY (OR (SETQ ARP (AR.TOBJ.ACTIVEP MENUWINDOW.TEXTOBJ)) (AR.TOBJ.ACTIVEP FORMWINDOW.TEXTOBJ))) then (* ;; "Sometimes this spuriously prints a message, typically on a new window. Haven't figured out why.") (AR.PROMPT.PRINT FORMWINDOW (if ARP then "AR " else "Edit ") (if (EQ BUSY T) then "operation" else BUSY) " in progress -- please wait") (RETURN)) (CL:UNWIND-PROTECT (PROGN (AR.MARK.ACTIVE MENUWINDOW.TEXTOBJ (OR OPNAME (SETQ OPNAME OPERATION))) (AR.MARK.ACTIVE FORMWINDOW.TEXTOBJ OPNAME) (DSPFILL NIL 72 (QUOTE PAINT) MENUWINDOW) (CLEARW FORMWINDOW) (AR.DISCONNECT.WINDOW FORMWINDOW) (SETQ SUCCESS (NLSETQ (SELECTQ OPERATION (Get (AR.MENU.FN.GET FORMWINDOW NUM.FOR.GET)) (if (LISTP OPERATION) then (* ; "FN + extra arg") (CL:FUNCALL (CAR OPERATION) FORMWINDOW (CADR OPERATION)) else (CL:FUNCALL OPERATION FORMWINDOW))))))) (* ;; "On the way out, make sure we have success/failure indication") (if (NULL SUCCESS) then (AR.PROMPT.PRINT FORMWINDOW T "Command aborted")) (AR.MARK.ACTIVE MENUWINDOW.TEXTOBJ NIL) (AR.MARK.ACTIVE FORMWINDOW.TEXTOBJ NIL) (REDISPLAYW MENUWINDOW) (AR.RESET.SEL FORMWINDOW) (AR.RECONNECT.WINDOW FORMWINDOW) (SCROLLW FORMWINDOW 0.0 0.0))) ) (AR.FORM.PROGRAMMATIC.GET (LAMBDA (MENUW AR#) (* ; "Edited 5-Aug-88 11:03 by bvm") (AR.FORM.MENU.ACTIONFN MENUW (QUOTE Get) AR#)) ) (AR.FORM.PROGRAMMATIC.PUT (LAMBDA (MENUW) (* ; "Edited 5-Aug-88 11:23 by bvm") (AR.FORM.MENU.ACTIONFN MENUW (FUNCTION AR.MENU.FN.PUT))) ) (AR.DISCONNECT.WINDOW (LAMBDA (FORMWINDOW) (* mjs "17-Feb-85 16:03") (replace (TEXTOBJ \WINDOW) of (TEXTOBJ (WINDOWPROP FORMWINDOW (QUOTE TEXTSTREAM))) with NIL)) ) (AR.RECONNECT.WINDOW (LAMBDA (FORMWINDOW) (* ; "Edited 20-Jan-88 16:38 by ckj") (PROG ((TOBJ (TEXTOBJ (WINDOWPROP FORMWINDOW (QUOTE TEXTSTREAM))))) (replace (TEXTOBJ \WINDOW) of TOBJ with (LIST FORMWINDOW)) (replace (LINEDESCRIPTOR NEXTLINE) of (CAR (fetch (TEXTOBJ LINES) of TOBJ)) with NIL) (\TEDIT.MARK.LINES.DIRTY TOBJ 1 (ADD1 (GETEOFPTR (WINDOWPROP FORMWINDOW (QUOTE TEXTSTREAM))))) (TEDIT.UPDATE.SCREEN TOBJ))) ) (AR.MARK.ACTIVE (LAMBDA (TOBJ OP) (* edited%: "16-May-84 16:13") (if TOBJ then (replace (TEXTOBJ EDITOPACTIVE) of TOBJ with OP))) ) (AR.TOBJ.ACTIVEP (LAMBDA (TOBJ) (* edited%: "16-May-84 16:15") (if (NULL TOBJ) then NIL else (fetch (TEXTOBJ EDITOPACTIVE) of TOBJ))) ) (AR.FORM.MENU.TITLEMENUFN (LAMBDA (TEXTSTREAM) (* ; "Edited 5-Aug-88 15:55 by bvm") (LET ((OP (MENU (OR AR.FORM.MENU.TITLEMENU (SETQ AR.FORM.MENU.TITLEMENU (create MENU ITEMS _ AR.FORM.MENU.TITLEMENU.ITEMS TITLE _ "Extra AR Ops" CHANGEOFFSETFLG _ T CENTERFLG _ T WHENSELECTEDFN _ (FUNCTION CL:IDENTITY))))))) (if OP then (AR.FORM.MENU.ACTIONFN (CAR (fetch (TEXTOBJ \WINDOW) of (TEXTOBJ TEXTSTREAM))) (if (LISTP OP) then (EVAL (CADR OP)) else OP) NIL (OR (CAR (LISTP OP)) OP))))) ) (AR.MENU.CR.FN (LAMBDA (TEXTSTREAM TOBJ) (* ; "Edited 5-Aug-88 11:03 by bvm") (AR.MARK.ACTIVE TOBJ NIL) (AR.FORM.PROGRAMMATIC.GET (\TEDIT.PRIMARYW TOBJ))) ) (AR.GET.MENU.FROM.MAIN.WINDOW (LAMBDA (FORMWINDOW) (* ; "Edited 5-Aug-88 11:23 by bvm") (for W in (ATTACHEDWINDOWS FORMWINDOW) when (WINDOWPROP W (QUOTE TEXTOBJ)) do (RETURN W))) ) (AR.CONFIRM (LAMBDA (WORDS FORMWINDOW) (* mjs " 4-May-84 14:51") (AR.PROMPT WORDS FORMWINDOW) (MOUSECONFIRM NIL NIL (GETPROMPTWINDOW FORMWINDOW 2))) ) ) (* ; "CLEAR") (DEFINEQ (AR.MENU.FN.CLEAR (LAMBDA (FORMWINDOW FILL.INS) (* ; "Edited 5-Aug-88 16:03 by bvm") (if (OR (NOT (TEDIT.STREAMCHANGEDP FORMWINDOW)) (AR.CONFIRM "Form has been changed --- confirm CLEAR" FORMWINDOW)) then (CLEARW FORMWINDOW) (AR.FORM.CLEAR FORMWINDOW FILL.INS) (AR.FORM.SET.TO.EMPTY FORMWINDOW) (AR.PROMPT.PRINT FORMWINDOW :CLEAR (if FILL.INS then "New form cleared" else "Form erased.")))) ) (AR.FORM.CLEAR (LAMBDA (WINDOW.OR.STREAM FILL.INS NEWFORMP) (* ; "Edited 4-Aug-88 15:24 by bvm") (* ;;; "Create a clean, fresh AR editing window with no data in it but that shown in FILL.INS. If FILL.INS is T, fill fields that have an INITIALVALUE prop. If NEWFORMP is true, this is a new form, so don't have to erase old values.") (AR.MAP.BUTTONS WINDOW.OR.STREAM (FUNCTION (LAMBDA (TOBJ OBJ CH#) (* ; "Delete all the fields") (LET (INFO) (if (SETQ INFO (SELECTQ FILL.INS (T (* ; "Use INITIALVALUE prop") (AND (SETQ INFO (IMAGEOBJPROP OBJ (QUOTE INITIALVALUE))) (if (LISTP INFO) then (EVAL INFO) else INFO))) (NIL NIL) (CADR (ASSOC (IMAGEOBJPROP OBJ (QUOTE MBTEXT)) FILL.INS)))) then (* ; "Caller specified initial contents") (AR.REPLACE.FIELD.VAL OBJ CH# TOBJ INFO) elseif (NOT NEWFORMP) then (AR.DELETE.FIELD.VAL OBJ CH# TOBJ)) (* ; "Return NIL so that the iteration continues") NIL)))) (TEDIT.STREAMCHANGEDP (TEXTSTREAM WINDOW.OR.STREAM) T)) ) (AR.FORM.SET.TO.EMPTY (LAMBDA (FORMWINDOW) (* ; "Edited 22-Feb-88 16:14 by bvm") (* ;; "Sets window properties associated with an empty form. Usually called in conjunction with AR.FORM.CLEAR") (AR.SET.FORM.NUMBER FORMWINDOW NIL) (WINDOWPROP FORMWINDOW (QUOTE AR.FORM.SCRATCH.MAP) NIL) (WINDOWPROP FORMWINDOW (QUOTE AR.FORM.SCRATCH.STREAM) NIL) (WINDOWPROP FORMWINDOW (QUOTE AR.FORM.SCRATCH.STREAM2) NIL) (WINDOWPROP FORMWINDOW (QUOTE AR.GET/PUT.FILE.NAME) NIL) (WINDOWPROP FORMWINDOW (QUOTE TITLE) "New Bug Report")) ) (AR.DELETE.FIELD.VAL (LAMBDA (OBJ CH# WINDOW.OR.STREAM) (* ; "Edited 4-Aug-88 15:22 by bvm") (* ;; " Delete the value associated with the AR form menu button OBJ.") (LET ((TOBJ (TEXTOBJ WINDOW.OR.STREAM)) SEL LEN) (if (IMAGEOBJPROP OBJ (QUOTE AR.PROTECTED.FLG)) then (* ; "Menu objects contain information about their length and position") (if (> (SETQ LEN (IMAGEOBJPROP OBJ (QUOTE AR.FIELD.LEN))) 0) then (TEDIT.DELETE TOBJ (+ (IMAGEOBJPROP OBJ (QUOTE AR.FIELD.START)) CH#) LEN T) (IMAGEOBJPROP OBJ (QUOTE AR.FIELD.LEN) 0) (IMAGEOBJPROP OBJ (QUOTE AR.FIELD.VALUE) AR.NULL.BUTTON.VALUE)) elseif (SETQ SEL (MBUTTON.FIND.NEXT.FIELD TOBJ CH#)) then (* ; "Text fields specified by selection") (if (> (SETQ LEN (fetch (SELECTION DCH) of SEL)) 0) then (TEDIT.DELETE TOBJ (fetch (SELECTION CH#) of SEL) LEN T)) else (SHOULDNT "Can't find field for button")))) ) ) (* ; "GET") (DEFINEQ (AR.MENU.FN.GET (LAMBDA (FORMWINDOW CURR.NUM) (* ; "Edited 5-Aug-88 11:22 by bvm") (* ;; "Handles GET from the main menu") (OR CURR.NUM (SETQ CURR.NUM (AR.GET.NUMBER.FIELD FORMWINDOW))) (if (NOT (FIXP CURR.NUM)) then (AR.PROMPT.PRINT FORMWINDOW T "Bad number %"" CURR.NUM "%" -- Get aborted") elseif (OR (NULL (TEDIT.STREAMCHANGEDP FORMWINDOW)) (if (AR.CONFIRM "Form has been changed --- confirm GET" FORMWINDOW) else (AR.PROMPT.PRINT FORMWINDOW T "Get aborted") (* ; "User disconfirmed the Get") NIL)) then (AR.GET.AR FORMWINDOW CURR.NUM))) ) (AR.GET.AR (LAMBDA (FORMWINDOW NUM/OR/FILE FORMSTREAM) (* ; "Edited 4-Aug-88 15:14 by bvm") (* ;; "Get an AR into the AR editing window. FORMSTREAM defaults to the window's tedit stream, but can be explicit if this is a new window. Returns one of: NIL = success; XCL:FILE-NOT-FOUND = no such ar; else some error message (and the current form has been cleared).") (AR.PROMPT.PRINT FORMWINDOW T "Retrieving " AR.IDENTIFICATION.STRING " " NUM/OR/FILE " ...") (CL:MULTIPLE-VALUE-BIND (MAP CONDITION) (AR.FETCH.AND.PARSE.AR NUM/OR/FILE (AR.GET.SCRATCH.STREAM FORMWINDOW)) (if (OR CONDITION (PROGN (* ; "Now fill in the textstream with the appropriate fields from the AR.") (WINDOWPROP FORMWINDOW (QUOTE AR.FORM.SCRATCH.MAP) MAP) (WINDOWPROP FORMWINDOW (QUOTE AR.FORM.SCRATCH.STREAM2) NIL) (CL:MULTIPLE-VALUE-BIND (IGNORE C) (IGNORE-ERRORS (AR.TEXTSTREAM.LOAD FORMWINDOW FORMSTREAM)) (SETQ CONDITION C)))) then (* ; "Got an error") (CL:TYPECASE CONDITION (XCL:FILE-NOT-FOUND (AR.PROMPT.PRINT FORMWINDOW T AR.IDENTIFICATION.STRING " " NUM/OR/FILE " doesn't exist -- Get aborted") (QUOTE XCL:FILE-NOT-FOUND)) (T (* ; "Other unknown error--form is now inconsistent, since we have smashed the old AR's scratch stream, so reset to blank form") (AR.PROMPT.PRINT FORMWINDOW T (CL:FORMAT NIL "Failed while loading ~A ~A: ~A" AR.IDENTIFICATION.STRING NUM/OR/FILE CONDITION)) (AR.FORM.CLEAR (OR FORMSTREAM FORMWINDOW) T) (AR.FORM.SET.TO.EMPTY FORMWINDOW) T)) else (LET ((ARNUM (IMAGEOBJPROP (CAR (AR.FIND.BUTTON (OR FORMSTREAM FORMWINDOW) (QUOTE Number%:))) (QUOTE AR.FIELD.VALUE)))) (if (NUMBERP NUM/OR/FILE) then (if (NOT (= ARNUM NUM/OR/FILE)) then (CL:ERROR "Retrieved file for ~A# ~D, but file thinks it is ~A" AR.IDENTIFICATION.STRING NUM/OR/FILE ARNUM)) (AR.SET.FORM.NUMBER FORMWINDOW NUM/OR/FILE) (WINDOWPROP FORMWINDOW (QUOTE AR.GET/PUT.FILE.NAME) NIL) else (* ; "Set number according to whether the saved ar was numbered.") (AR.SET.FORM.NUMBER FORMWINDOW (SETQ ARNUM (FIXP ARNUM)))) (WINDOWPROP FORMWINDOW (QUOTE TITLE) (CONCAT "Editing " AR.IDENTIFICATION.STRING " " (OR ARNUM NUM/OR/FILE))) (AR.PROMPT.PRINT FORMWINDOW T AR.IDENTIFICATION.STRING " " NUM/OR/FILE " retrieved") (* ; "Return NIL on success") NIL)))) ) (AR.FETCH.AND.PARSE.AR (LAMBDA (NUM/OR/FILE SCRATCH.STREAM INDEX.FIELDS DONTRESET) (* ; "Edited 21-Jul-88 14:57 by bvm") (* ;; "Read AR file (or number) into SCRATCH.STREAM and returns its parse (the %"scratch map%") for each of INDEX.FIELDS, or for all fields if NIL. Returns a CONDITION as second value if there was an error. If DONTRESET is true, then doesn't reset SCRATCH.STREAM, but starts copying at its current position.") (IGNORE-ERRORS (LET ((*UPPER-CASE-FILE-NAMES* NIL) ARSTREAM) (* ; "Open the AR file and read its contents into a scratch stream, stored on the window") (CL:UNWIND-PROTECT (PROGN (* ; "Open the AR and copy it into the scratch stream") (SETQ ARSTREAM (OPENSTREAM (COND ((NUMBERP NUM/OR/FILE) (AR.GET.FILENAME NUM/OR/FILE NIL)) (T NUM/OR/FILE)) (QUOTE INPUT) (QUOTE OLD))) (OR DONTRESET (SETFILEPTR SCRATCH.STREAM 0)) (AR.COPY.AND.INDEX.AR ARSTREAM SCRATCH.STREAM INDEX.FIELDS)) (COND ((AND ARSTREAM (OPENP ARSTREAM)) (CLOSEF ARSTREAM))))))) ) (AR.SET.FORM.NUMBER (LAMBDA (FORMWINDOW N) (* ; "Edited 5-Aug-88 16:10 by bvm") (* ;; "Record N as the number of the AR currently living in FORMWINDOW") (WINDOWPROP FORMWINDOW (QUOTE AR.FORM.NUMBER) N) (LET ((ICON (WINDOWPROP FORMWINDOW (QUOTE ICONWINDOW)))) (* ; "Fix icon label if there is one") (AND ICON (ICONW.TITLE ICON (if N then (MKSTRING N) else "")))) (* ; "Change the contents of the %"Number:%" button in the menu ") (LET ((MENUW (AR.GET.MENU.FROM.MAIN.WINDOW FORMWINDOW)) (BUTTON.NAME (QUOTE Number%:)) BUTTON) (if (SETQ BUTTON (AR.FIND.BUTTON MENUW BUTTON.NAME)) then (if N then (MBUTTON.SET.FIELD (TEXTOBJ MENUW) (QUOTE Number%:) N) else (* ; "Bug in MBUTTON.SET.FIELD won't let me replace it with null string") (AR.DELETE.FIELD.VAL (CAR BUTTON) (CDR BUTTON) MENUW)) else (ERROR "Can't find named button" BUTTON.NAME)))) ) (AR.GET.SCRATCH.STREAM (LAMBDA (WINDOW) (* ; "Edited 17-Feb-88 15:07 by bvm") (* ;; "Return a nodircore stream, resuing the one on WINDOW if it's there.") (OR (WINDOWPROP WINDOW (QUOTE AR.FORM.SCRATCH.STREAM)) (LET ((S (OPENSTREAM (QUOTE {NODIRCORE}) (QUOTE BOTH)))) (WINDOWPROP WINDOW (QUOTE AR.FORM.SCRATCH.STREAM) S) S))) ) (AR.COPY.AND.INDEX.AR (LAMBDA (ARSTREAM SCRATCH.STREAM INDEX.FIELDS) (* ; "Edited 15-Feb-88 11:43 by bvm") (* ;; "Read thru an AR file, copying its contents to SCRATCH.STREAM, and building an index of where each field's data appears in the scratch file. The index is a list of entries: (Field-Name Starting-Fileptr Length)") (bind INDEX CHAR until (EOFP ARSTREAM) do (BLOCK) (LET ((FIELD.NAME (PACKC (collect (SETQ CHAR (BIN ARSTREAM)) repeatuntil (EQ CHAR (CHARCODE %:))))) (START (GETFILEPTR SCRATCH.STREAM))) (* ;; "FIELD.NAME contains the name of the next field, e.g. %"Subject:%" -- yes, including the colon.") (BIN ARSTREAM) (* ; "skip extra space after ':'") (COND ((OR (NLISTP INDEX.FIELDS) (MEMB FIELD.NAME INDEX.FIELDS)) (* ; "Only gather fields that the caller asked about.") (do (* ;; "Copy the field's CONTENTS to the scratch file -- everything up to the next CR.") (BOUT SCRATCH.STREAM (SELCHARQ (SETQ CHAR (BIN ARSTREAM)) (%' (* ; "' is used to escape special characters.") (BIN ARSTREAM)) (CR (* ; "There best be TWO CR's at the end of the field") (RETURN (OR (EQ (BIN ARSTREAM) (CHARCODE CR)) (AR.MALFORMED.AR ARSTREAM)))) CHAR))) (* ;; "INDEX is a list of entries like (FieldName StartingLoc Length) for each field.") (push INDEX (LIST FIELD.NAME START (- (GETFILEPTR SCRATCH.STREAM) START)))) (T (* ; "Otherwise, skip over this field -- it's of no interest.") (do (SELCHARQ (SETQ CHAR (BIN ARSTREAM)) (%' (BLOCK) (BIN ARSTREAM)) (CR (RETURN (OR (EQ (BIN ARSTREAM) (CHARCODE CR)) (AR.MALFORMED.AR ARSTREAM)))) CHAR))))) finally (\SETEOFPTR SCRATCH.STREAM (GETFILEPTR SCRATCH.STREAM)) (RETURN INDEX))) ) (AR.MALFORMED.AR (LAMBDA (ARSTREAM) (* ; "Edited 15-Feb-88 11:42 by bvm") (CL:ERROR "Malformed AR file"))) (AR.TEXTSTREAM.LOAD (LAMBDA (FORMWINDOW FORMSTREAM) (* ; "Edited 22-Feb-88 16:46 by bvm") (* ;; "Load the ar whose map is in FORMWINDOW into FORMSTREAM, which defaults to the textstream in the window.") (COND ((NOT FORMSTREAM) (* ; "Take stream from window, and clear its old contents first") (AR.FORM.CLEAR (SETQ FORMSTREAM (WINDOWPROP FORMWINDOW (QUOTE TEXTSTREAM)))))) (PROG ((TOBJ (TEXTOBJ FORMSTREAM)) (SCRATCH.STREAM (WINDOWPROP FORMWINDOW (QUOTE AR.FORM.SCRATCH.STREAM))) (SCRATCH.MAP (WINDOWPROP FORMWINDOW (QUOTE AR.FORM.SCRATCH.MAP))) (CH# 0) FIELD.LEN OBJ BUTTON PROTECT.FIELD.FLG FIELD.CH# SEL SCRATCH.MAP.SPEC SCRATCH.PTR) (while (SETQ BUTTON (MBUTTON.FIND.NEXT.BUTTON TOBJ (add CH# 1))) do (* ;; "Run thru the buttons in the AR form, filling in data for each one.") (BLOCK) (SETQ OBJ (CAR BUTTON)) (SETQ CH# (CDR BUTTON)) (SETQ PROTECT.FIELD.FLG (IMAGEOBJPROP OBJ (QUOTE AR.PROTECTED.FLG))) (COND (PROTECT.FIELD.FLG (SETQ FIELD.CH# (+ (IMAGEOBJPROP OBJ (QUOTE AR.FIELD.START)) CH#))) ((SETQ SEL (MBUTTON.FIND.NEXT.FIELD TOBJ CH#)) (SETQ FIELD.CH# (fetch (SELECTION CH#) of SEL))) (T (HELP "Can't find field for button"))) (SETFILEPTR FORMSTREAM (SUB1 FIELD.CH#)) (SETQ SCRATCH.MAP.SPEC (ASSOC (IMAGEOBJPROP OBJ (QUOTE MBTEXT)) SCRATCH.MAP)) (COND ((NULL SCRATCH.MAP.SPEC) (* ; "Perhaps a new field has been added to AREdit, but this is an old ar.") (PRINTOUT PROMPTWINDOW T "AR has no " (IMAGEOBJPROP OBJ (QUOTE MBTEXT)) " field") (IMAGEOBJPROP OBJ (QUOTE AR.FIELD.VALUE) NIL)) (T (* ; "Copy the field's contents from the scratch file into the form. Map entry is (field pointer length)") (SETQ FIELD.LEN (CADDR SCRATCH.MAP.SPEC)) (COND ((> FIELD.LEN 0) (TEDIT.FAST.RAW.INCLUDE FORMSTREAM SCRATCH.STREAM (SETQ SCRATCH.PTR (CADR SCRATCH.MAP.SPEC)) (+ SCRATCH.PTR FIELD.LEN) FIELD.CH#) (* ; "And protect the contents from tampering if protected") (TEDIT.LOOKS FORMSTREAM (COND (PROTECT.FIELD.FLG (QUOTE (PROTECTED ON))) (T (QUOTE (PROTECTED OFF)))) FIELD.CH# FIELD.LEN))) (COND (PROTECT.FIELD.FLG (* ; "Mostly menu buttons") (IMAGEOBJPROP OBJ (QUOTE AR.FIELD.LEN) FIELD.LEN) (if (OR (EQ (CAR SCRATCH.MAP.SPEC) (QUOTE Number%:)) (SELECTQ PROTECT.FIELD.FLG ((MENU SUBMENU) T) NIL)) then (* ; "These guys want to know the symbolic value stored in the field") (IMAGEOBJPROP OBJ (QUOTE AR.FIELD.VALUE) (if (> FIELD.LEN 0) then (PACKC (AR.READ.BYTES SCRATCH.STREAM FIELD.LEN SCRATCH.PTR)) else AR.NULL.BUTTON.VALUE)))))))) (AR.RESET.SEL FORMSTREAM) (TEDIT.STREAMCHANGEDP FORMSTREAM T))) ) (AR.REPLACE.FILL.INS (LAMBDA (STREAM.OR.WINDOW FILL.INS) (* ; "Edited 12-Feb-88 18:42 by bvm") (for X in FILL.INS bind (FORMSTREAM _ (TEXTSTREAM STREAM.OR.WINDOW)) BUTTON do (BLOCK) (if (SETQ BUTTON (AR.FIND.BUTTON FORMSTREAM (CAR X))) then (AR.REPLACE.FIELD.VAL (CAR BUTTON) (CDR BUTTON) FORMSTREAM (CADR X))))) ) ) (* ; "PUT") (DEFINEQ (AR.MENU.FN.PUT (LAMBDA (FORMWINDOW) (* ; "Edited 4-Aug-88 12:35 by bvm") (PROG ((*PRINT-BASE* 10) FILE CHECK.VALUE EDIT.CHANGES.LIST EDIT.CHANGES.STRING EDIT.CHANGES.TEXT CURR.NUM DT OPERATION USER) (if (AND (NOT (TEDIT.STREAMCHANGEDP FORMWINDOW)) (NULL (WINDOWPROP FORMWINDOW (QUOTE AR.GET/PUT.FILE.NAME))) (NOT (AR.CONFIRM "Form has NOT been changed --- confirm PUT" FORMWINDOW))) then (AR.PROMPT.PRINT FORMWINDOW T "Put aborted") (RETURN)) (SETQ EDIT.CHANGES.STRING (CONCAT (SETQ USER (AR.USERNAME)) " " (SETQ DT (DATE)))) (if (SETQ CURR.NUM (WINDOWPROP FORMWINDOW (QUOTE AR.FORM.NUMBER))) then (SETQ OPERATION (QUOTE EDIT)) (* ; "Editing an existing AR") (SETQ EDIT.CHANGES.LIST (AR.FIND.EDIT.CHANGES FORMWINDOW)) (* ; "A list of (field x), where x is either an old/new value pair, or the original length of the field (now smashed).") (LET ((TSTREAM (TEXTSTREAM FORMWINDOW)) (BUTTON (AR.FIND.BUTTON FORMWINDOW (QUOTE Disposition%:))) INSERTION DISPLEN) (* ; "BUTTON = (obj . ch#)") (SETQ EDIT.CHANGES.STRING (CONCATLIST (CONS EDIT.CHANGES.STRING (for X in EDIT.CHANGES.LIST join (LIST* " " (CAR X) (if (FIXP (CADR X)) then (push EDIT.CHANGES.TEXT X) NIL else (* ; "Parenthetically, the old and new values") (LIST (CADR X)))))))) (TEDIT.INSERT TSTREAM (SETQ INSERTION (CONCAT " [" EDIT.CHANGES.STRING "]")) (+ (CDR BUTTON) (IMAGEOBJPROP (CAR BUTTON) (QUOTE AR.FIELD.START)) (SETQ DISPLEN (IMAGEOBJPROP (CAR BUTTON) (QUOTE AR.FIELD.LEN)))) (QUOTE (PROTECTED ON)) T) (IMAGEOBJPROP (CAR BUTTON) (QUOTE AR.FIELD.LEN) (+ DISPLEN (NCHARS INSERTION))) (AR.NOTE.FIELD.CHANGED FORMWINDOW BUTTON)) (AR.REPLACE.FILL.INS FORMWINDOW (BQUOTE ((Edit-By%: (\, USER)) (Edit-Date%: (\, DT))))) (AR.NOTE.FIELD.CHANGED FORMWINDOW (AR.FIND.BUTTON FORMWINDOW (QUOTE Edit-By%:))) (AR.NOTE.FIELD.CHANGED FORMWINDOW (AR.FIND.BUTTON FORMWINDOW (QUOTE Edit-Date%:))) else (SETQ OPERATION (QUOTE SUBMIT)) (AR.PROMPT.PRINT FORMWINDOW T "Getting Submit number...") (if (NULL (SETQ CURR.NUM (AR.GET.SUBMIT.NUM FORMWINDOW))) then (AR.PUT.FAILED "Can't get AR submit number --- Put Aborted --- Try again" FORMWINDOW) (RETURN)) (AR.PROMPT.PRINT FORMWINDOW " = " CURR.NUM) (AR.REPLACE.FILL.INS FORMWINDOW (BQUOTE ((Number%: (\, CURR.NUM)) (Date%: (\, DT))))) (* ; "make sure that no one tries accessing the scratch stream") (WINDOWPROP FORMWINDOW (QUOTE AR.FORM.SCRATCH.MAP) NIL)) (if (SETQ CHECK.VALUE (AR.CHECK.FIELDS FORMWINDOW)) then (AR.PUT.FAILED (CONCAT "Bad bug report form: " CHECK.VALUE " --- Put Aborted") FORMWINDOW) (RETURN)) (if (NULL (NLSETQ (AR.UPDATE.AR.INFO FORMWINDOW OPERATION CURR.NUM EDIT.CHANGES.STRING))) then (AR.PUT.FAILED "Cannot update TDS file --- Put aborted -- try again" FORMWINDOW) (RETURN)) (CLEARW FORMWINDOW) (AR.PROMPT.PRINT FORMWINDOW T (SELECTQ OPERATION (SUBMIT "Submitting ") "Saving ") AR.IDENTIFICATION.STRING " " CURR.NUM " ...") (if (PROG1 (AR.FORM.SAVE FORMWINDOW CURR.NUM) (TEDIT.STREAMCHANGEDP FORMWINDOW T)) then (AR.SET.FORM.NUMBER FORMWINDOW CURR.NUM) (WINDOWPROP FORMWINDOW (QUOTE TITLE) (CONCAT "Saved " AR.IDENTIFICATION.STRING " " CURR.NUM)) (if (EQ OPERATION (QUOTE EDIT)) then (AR.SEND.MESSAGE FORMWINDOW (QUOTE EDIT) CURR.NUM EDIT.CHANGES.STRING EDIT.CHANGES.TEXT) else (AR.SEND.MESSAGE FORMWINDOW (QUOTE SUBMIT) CURR.NUM)) else (AR.PUT.FAILED "Unknown bug -- AR not saved -- try again" FORMWINDOW)))) ) (AR.MENU.FN.PUT&GET (LAMBDA (FORMWINDOW) (* ; "Edited 5-Aug-88 15:56 by bvm") (LET ((NUM (AR.READ.NUMBER))) (AR.MENU.FN.PUT FORMWINDOW) (AR.MENU.FN.GET FORMWINDOW NUM))) ) (AR.MENU.FN.PUT&GETNEXT (LAMBDA (FORMWINDOW) (* ; "Edited 5-Aug-88 15:57 by bvm") (AR.MENU.FN.PUT FORMWINDOW) (AR.GET.NEXT FORMWINDOW)) ) (AR.FORM.SAVE (LAMBDA (FORMWINDOW FILENAME) (* ; "Edited 20-Jul-88 17:09 by bvm") (* ;; "Save the contents of an AR window into an AR file.") (RESETLST (PROG ((*UPPER-CASE-FILE-NAMES* NIL) (FORMSTREAM (TEXTSTREAM FORMWINDOW)) (TOBJ (TEXTOBJ FORMWINDOW)) (CH# 0) BUTTON OUTSTREAM BUTTON.OBJ FIELD.START FIELD.LEN SEL TOBJ NUM) (if (FIXP FILENAME) then (SETQ NUM FILENAME) (SETQ FILENAME (AR.GET.FILENAME FILENAME T))) (RESETSAVE NIL (LIST (FUNCTION (LAMBDA (OUTSTREAM) (COND (RESETSTATE (* ; "Cleanup after faulty put") (COND ((OPENP OUTSTREAM) (CLOSEF OUTSTREAM))) (DELFILE (FULLNAME OUTSTREAM)) (AR.PROMPT.PRINT FORMWINDOW T "SAVE ERROR - bad bug report file " (FULLNAME OUTSTREAM) " deleted"))))) (SETQ OUTSTREAM (OPENSTREAM FILENAME (QUOTE OUTPUT) (QUOTE NEW))))) (if (NOT NUM) then (AR.PROMPT.PRINT FORMWINDOW T "Writing " (FULLNAME OUTSTREAM) " ...")) (LINELENGTH MAX.SMALLP OUTSTREAM) (* ; "Don't get spurious CR's in output") LP (BLOCK) (COND ((NULL (SETQ BUTTON (MBUTTON.FIND.NEXT.BUTTON TOBJ (add CH# 1)))) (AR.PROMPT.PRINT FORMWINDOW " done") (RETURN (CLOSEF OUTSTREAM)))) (SETQ CH# (CDR BUTTON)) (SETQ BUTTON.OBJ (CAR BUTTON)) (PRIN3 (IMAGEOBJPROP BUTTON.OBJ (QUOTE MBTEXT)) OUTSTREAM) (* ; "Print out the name of the field") (* ; "Because the ARFile->WIndow code does its own char-by-char reading, we DON'T want a readtable-driven print here.") (BOUT OUTSTREAM (CHARCODE SPACE)) (COND ((IMAGEOBJPROP BUTTON.OBJ (QUOTE AR.PROTECTED.FLG)) (SETQ FIELD.START (+ (IMAGEOBJPROP BUTTON.OBJ (QUOTE AR.FIELD.START)) CH#)) (SETQ FIELD.LEN (IMAGEOBJPROP BUTTON.OBJ (QUOTE AR.FIELD.LEN)))) (T (SETQ SEL (MBUTTON.FIND.NEXT.FIELD TOBJ CH#)) (SETQ FIELD.START (fetch (SELECTION CH#) of SEL)) (SETQ FIELD.LEN (fetch (SELECTION DCH) of SEL)))) (SETFILEPTR FORMSTREAM (SUB1 FIELD.START)) (for X from 1 to FIELD.LEN bind C WARNED do (SETQ C (BIN FORMSTREAM)) (COND ((NOT (FIXP C)) (if (NEQ WARNED (SETQ WARNED (IMAGEOBJPROP BUTTON.OBJ (QUOTE MBTEXT)))) then (AR.PROMPT.PRINT FORMWINDOW " [Image object(s) in " WARNED " field discarded.]"))) ((> C \MAXTHINCHAR) (* ; "Format doesn't accommodate NS chars yet") (if (NEQ WARNED (SETQ WARNED (IMAGEOBJPROP BUTTON.OBJ (QUOTE MBTEXT)))) then (AR.PROMPT.PRINT FORMWINDOW " [NS chars in " WARNED " field discarded.]")) (BOUT OUTSTREAM (CHARCODE *))) ((FMEMB C (CHARCODE (CR %: "'"))) (BLOCK) (BOUT OUTSTREAM (CHARCODE "'")) (BOUT OUTSTREAM C)) (T (BOUT OUTSTREAM C)))) (TERPRI OUTSTREAM) (TERPRI OUTSTREAM) (GO LP)))) ) (AR.GET.SUBMIT.NUM (LAMBDA (FORMWINDOW DONTINCREMENT) (* ; "Edited 20-Jul-88 16:39 by bvm") (* ;; "Obtains and increments (unless DONTINCREMENT true) the number of the next ar to be submitted. Returns NIL on various failures.") (from 1 to AR.FILE.TRIES bind SUBMIT.NUM.FILE VAL CURR.NEXT.NUM CONDITION *UPPER-CASE-FILE-NAMES* do (CL:MULTIPLE-VALUE-SETQ (SUBMIT.NUM.FILE CONDITION) (IGNORE-ERRORS (OPENSTREAM AR.SUBMIT.NUM.FILE.NAME (QUOTE BOTH) (QUOTE OLD) (QUOTE ((DON'T.CACHE T) (DON'TCACHE T)))))) (if SUBMIT.NUM.FILE then (* ; "Got the file. Read the number therein and run away") (SETQ VAL (NLSETQ (PROGN (SETFILEPTR SUBMIT.NUM.FILE 0) (SETQ CURR.NEXT.NUM (READ SUBMIT.NUM.FILE FILERDTBL)) (if (NOT (FIXP CURR.NEXT.NUM)) then (ERROR!)) (if (NOT DONTINCREMENT) then (SETFILEPTR SUBMIT.NUM.FILE 0) (PRINT (ADD1 CURR.NEXT.NUM) SUBMIT.NUM.FILE FILERDTBL))))) (CLOSEF SUBMIT.NUM.FILE) (RETURN (AND VAL CURR.NEXT.NUM)) else (CL:TYPECASE CONDITION (XCL:FILE-NOT-FOUND (* ; "Doesn't even exist?") (AR.PROMPT.PRINT FORMWINDOW T "Can't find submit number file " AR.SUBMIT.NUM.FILE.NAME) (RETURN NIL)) (T (AR.PROMPT.PRINT FORMWINDOW T (CL:FORMAT NIL "~A" CONDITION) " --- please wait") (DISMISS 5000)))) finally (AR.PROMPT.PRINT FORMWINDOW T "Gave up trying to open submit number file--try again later"))) ) (AR.FIND.EDIT.CHANGES (LAMBDA (FORMWINDOW) (* ; "Edited 16-Feb-88 12:33 by bvm") (* ;; "Find everything that's changed between the original ar and what's currently there, by comparing the tedit stream with the scratch file.") (PROG ((SCRATCH.STREAM (WINDOWPROP FORMWINDOW (QUOTE AR.FORM.SCRATCH.STREAM))) (SCRATCH.MAP (WINDOWPROP FORMWINDOW (QUOTE AR.FORM.SCRATCH.MAP))) (FORMSTREAM (WINDOWPROP FORMWINDOW (QUOTE TEXTSTREAM))) (CH# 0) SECOND.SCRATCH OBJ BUTTON BUTTON.NAME FIELD.CH# FIELD.LEN TOBJ SCRATCH.MAP.SPEC ORIGSTREAM ORIGPTR ORIGLEN EDIT.CHANGES PROTECTEDFLG SEL) (if (NULL SCRATCH.MAP) then (RETURN NIL)) (SETQ TOBJ (TEXTOBJ FORMSTREAM)) (while (SETQ BUTTON (MBUTTON.FIND.NEXT.BUTTON TOBJ (add CH# 1))) do (BLOCK) (SETQ OBJ (CAR BUTTON)) (SETQ CH# (CDR BUTTON)) (SETQ BUTTON.NAME (IMAGEOBJPROP OBJ (QUOTE MBTEXT))) (if (SETQ SCRATCH.MAP.SPEC (ASSOC BUTTON.NAME SCRATCH.MAP)) then (SETQ ORIGPTR (CADR SCRATCH.MAP.SPEC)) (SETQ ORIGLEN (CADDR SCRATCH.MAP.SPEC)) (SETQ ORIGSTREAM (if (NULL (CDDDR SCRATCH.MAP.SPEC)) then SCRATCH.STREAM else (OR SECOND.SCRATCH (WINDOWPROP FORMWINDOW (QUOTE AR.FORM.SCRATCH.STREAM2))))) else (* ; "note that you default to a zero-length field if it is not specified in the file") (SETQ ORIGPTR (SETQ ORIGLEN 0)) (SETQ ORIGSTREAM SCRATCH.STREAM)) (if (SETQ PROTECTEDFLG (IMAGEOBJPROP OBJ (QUOTE AR.PROTECTED.FLG))) then (SETQ FIELD.CH# (+ (IMAGEOBJPROP OBJ (QUOTE AR.FIELD.START)) CH#)) (SETQ FIELD.LEN (IMAGEOBJPROP OBJ (QUOTE AR.FIELD.LEN))) elseif (SETQ SEL (MBUTTON.FIND.NEXT.FIELD TOBJ CH#)) then (SETQ FIELD.CH# (fetch (SELECTION CH#) of SEL)) (SETQ FIELD.LEN (fetch (SELECTION DCH) of SEL)) else (SHOULDNT "Can't find field for button")) (if (OR (NOT (= FIELD.LEN ORIGLEN)) (AND (NEQ FIELD.LEN 0) (AR.PIECE.CHANGED TOBJ FORMSTREAM FIELD.CH# ORIGSTREAM ORIGPTR ORIGLEN))) then (* ; "we know that the current value of the field is not equal to the value when loaded") (push EDIT.CHANGES (LIST BUTTON.NAME (if (OR (EQ BUTTON.NAME (QUOTE Attn%:)) (MEMB PROTECTEDFLG (QUOTE (MENU SUBMENU)))) then (* ; "Note the old and new values") (CONCATCODES (CONS (CHARCODE "(") (NCONC (AR.READ.BYTES ORIGSTREAM ORIGLEN ORIGPTR) (APPEND (CHARCODE (- >))) (AR.READ.BYTES FORMSTREAM FIELD.LEN (SUB1 FIELD.CH#)) (CHARCODE (")"))))) else (* ; "Just note the old length, so we can retrieve what's new (maybe)") ORIGLEN))) (if (< FIELD.LEN (UNFOLD BYTESPERPAGE 2)) then (* ; "Note the field's new contents for next time around. Don't bother for long fields, since that can be expensive.") (AR.NOTE.FIELD.CHANGED FORMWINDOW BUTTON FIELD.CH# FIELD.LEN)))) (RETURN (DREVERSE EDIT.CHANGES)))) ) (AR.NOTE.FIELD.CHANGED (LAMBDA (FORMWINDOW BUTTON FIELD.CH# FIELD.LEN) (* ; "Edited 22-Feb-88 15:46 by bvm") (* ;; "Updates FORMWINDOW's %"original%" AR scratch stream with the contents of the new field, so that if we put again, we don't get the field looking changed twice. If FIELD.CH# is NIL, we'll compute it from the button, which must be an unprotected button.") (PROG ((SCRATCH.STREAM (WINDOWPROP FORMWINDOW (QUOTE AR.FORM.SCRATCH.STREAM2))) (SCRATCH.MAP (WINDOWPROP FORMWINDOW (QUOTE AR.FORM.SCRATCH.MAP))) (FORMSTREAM (WINDOWPROP FORMWINDOW (QUOTE TEXTSTREAM))) (OBJ (CAR BUTTON)) SEL) (if (NULL SCRATCH.MAP) then (* ; "New AR without map, nothing interesting to do.") (RETURN)) (if (NOT SCRATCH.STREAM) then (* ; "Need secondary scratch stream, because the primary scratch stream is being used to back the TEdit stream--the COPYBYTES below would have real trouble.") (WINDOWPROP FORMWINDOW (QUOTE AR.FORM.SCRATCH.STREAM2) (SETQ SCRATCH.STREAM (OPENSTREAM (QUOTE {NODIRCORE}) (QUOTE BOTH))))) (if (NOT FIELD.CH#) then (if (IMAGEOBJPROP OBJ (QUOTE AR.PROTECTED.FLG)) then (SETQ FIELD.CH# (IPLUS (IMAGEOBJPROP OBJ (QUOTE AR.FIELD.START)) (CDR BUTTON))) (SETQ FIELD.LEN (IMAGEOBJPROP OBJ (QUOTE AR.FIELD.LEN))) else (SETQ SEL (MBUTTON.FIND.NEXT.FIELD (TEXTOBJ FORMSTREAM) (CDR BUTTON))) (SETQ FIELD.CH# (fetch (SELECTION CH#) of SEL)) (SETQ FIELD.LEN (fetch (SELECTION DCH) of SEL)))) (SETFILEPTR SCRATCH.STREAM -1) (NLSETQ (* ; "Wrap in NLSETQ in case the COPYBYTES complains about non-ascii in the text stream") (PUTASSOC (IMAGEOBJPROP OBJ (QUOTE MBTEXT)) (PROG1 (LIST* (GETFILEPTR SCRATCH.STREAM) FIELD.LEN T) (SETFILEPTR FORMSTREAM (SUB1 FIELD.CH#)) (COPYBYTES FORMSTREAM SCRATCH.STREAM FIELD.LEN)) SCRATCH.MAP)))) ) (AR.SEND.MESSAGE (LAMBDA (FORMWINDOW OPERATION NUM EDIT.CHANGES.STRING EDIT.CHANGES.TEXT) (* ; "Edited 5-Aug-88 17:57 by bvm") (* ;; "Send a message describing what just got done to this AR.") (PROG ((FORMSTREAM (TEXTSTREAM FORMWINDOW)) RECIPIENTS TXT SUBM TEM) (COND (AR.NO.MESSAGE.FLG (RETURN)) ((OR (NOT (GETD (QUOTE LAFITEMODE))) (NOT (LAFITEMODE))) (PROMPTPRINT "Can't send AR message -- LAFITE not turned on") (RETURN))) (SETQ SUBM (AR.GET.BUTTON.FIELD.AS.TEXT FORMSTREAM (QUOTE Submitter%:))) (SETQ RECIPIENTS (AR.GET.BUTTON.FIELD.AS.TEXT FORMSTREAM (QUOTE Attn%:))) (COND ((EQUAL RECIPIENTS "") (SETQ RECIPIENTS (if (OR (NEQ OPERATION (QUOTE EDIT)) (EQUAL SUBM "")) then ">>Recipients<<" else (PROG1 SUBM (SETQ SUBM "")))))) (SETQ TXT (OPENSTREAM (QUOTE {NODIRCORE}) (QUOTE BOTH))) (* ; "Make scratch core file--faster than starting with TEdit.") (LINELENGTH MAX.SMALLP TXT) (LET ((*PRINT-BASE* 10)) (printout TXT "Subject: " (COND ((EQ OPERATION (QUOTE SUBMIT)) "Submitt") (T "Edit")) "ed " AR.IDENTIFICATION.STRING " " (OR NUM ""))) (printout TXT ": ") (AR.COPY.BUTTON.FIELD FORMSTREAM TXT (QUOTE Subject%:)) (printout TXT T "To: " RECIPIENTS T) (COND ((AND (EQ OPERATION (QUOTE EDIT)) (NOT (EQUAL SUBM ""))) (* ; "CC the submitter on edits.") (PRINTOUT TXT "cc: " SUBM T))) (TERPRI TXT) (COND ((EQ OPERATION (QUOTE SUBMIT)) (* ; "Display the ars description, plus any other interesting fields") (AR.COPY.BUTTON.FIELD FORMSTREAM TXT (QUOTE Description%:)) (TERPRI TXT) (for FIELD in AR.INTERESTING.SUBMIT.FIELDS do (AR.COPY.BUTTON.FIELD FORMSTREAM TXT FIELD T))) (T (printout TXT "[" EDIT.CHANGES.STRING "]" T) (if EDIT.CHANGES.TEXT then (* ;; "Some text fields changed, might be nice to show them here. EDIT.CHANGES.TEXT is a list of (field oldlength)") (if (SETQ TEM (ASSOC (QUOTE Description%:) EDIT.CHANGES.TEXT)) then (* ; "Show appended description") (TERPRI TXT) (AR.COPY.BUTTON.FIELD FORMSTREAM TXT (QUOTE Description%:) NIL (CADR TEM)) (TERPRI TXT)) (for PAIR in EDIT.CHANGES.TEXT when (AND (EQ (CADR PAIR) 0) (NEQ (CAR PAIR) (QUOTE Description%:))) do (* ; "Display any brand new fields") (AR.COPY.BUTTON.FIELD FORMSTREAM TXT (CAR PAIR) T))))) (TERPRI TXT) (ADD.PROCESS (BQUOTE ((\, (FUNCTION \SENDMESSAGE)) (QUOTE (\, (OPENTEXTSTREAM TXT NIL NIL NIL (LIST (QUOTE FONT) LAFITEEDITORFONT)))) (QUOTE (LEAVETTY T)))) (QUOTE NAME) (QUOTE MESSAGESENDER)))) ) (AR.COPY.BUTTON.FIELD (LAMBDA (FORMSTREAM OUTSTREAM BUTTON.NAME LABEL START) (* ; "Edited 23-Feb-88 12:30 by bvm") (* ;; "Copy the contents of the named field from FORMSTREAM to OUTSTREAM, starting at offset START (default zero). If LABEL is true, starts a new line and prints the button name in front of the text.") (DESTRUCTURING-BIND (CH# . LEN) (AR.GET.BUTTON.FIELD.SHAPE FORMSTREAM BUTTON.NAME) (if START then (add CH# START) (SETQ LEN (- LEN START))) (if (> LEN 0) then (SETFILEPTR FORMSTREAM (SUB1 CH#)) (if LABEL then (PRINTOUT OUTSTREAM T BUTTON.NAME " ") else (* ; "Let's filter leading cr's") (bind CH while (PROGN (SETQ LEN (SUB1 LEN)) (EQ (SETQ CH (BIN FORMSTREAM)) (CHARCODE CR))) do (if (<= LEN 0) then (* ; "Field entirely cr's!") (RETURN)) finally (if (FIXP CH) then (\OUTCHAR OUTSTREAM CH)))) (to LEN bind CH when (FIXP (SETQ CH (BIN FORMSTREAM))) do (* ; "Filter out image objects") (\OUTCHAR OUTSTREAM CH)) (if LABEL then (TERPRI OUTSTREAM)) (* ; "Return T to show success") T))) ) (AR.UPDATE.AR.INFO (LAMBDA (FORMWINDOW OP AR.INFO USER.INFO) (* ; "Edited 22-Feb-88 15:44 by bvm") (* ;; "Write into the TDS file a description of what happened to this AR.") (AR.PROMPT.PRINT FORMWINDOW T "Updating TDS file...") (from 1 to AR.FILE.TRIES bind INFO.FILE CONDITION MSG *UPPER-CASE-FILE-NAMES* do (CL:MULTIPLE-VALUE-SETQ (INFO.FILE CONDITION) (IGNORE-ERRORS (OPENSTREAM AR.INFO.FILE.NAME (QUOTE BOTH) (QUOTE OLD/NEW) (QUOTE ((DON'T.CACHE T) (DON'TCACHE T)))))) (if INFO.FILE then (SETFILEPTR INFO.FILE -1) (CL:UNWIND-PROTECT (LET ((*PRINT-BASE* 10)) (LINELENGTH MAX.SMALLP INFO.FILE) (printout INFO.FILE " -- " (LIST OP AR.INFO USER.INFO) T)) (CLOSEF INFO.FILE)) (AR.PROMPT.PRINT FORMWINDOW " done") (RETURN) else (if (NOT (STRING-EQUAL MSG (SETQ MSG (CL:FORMAT NIL "~A" CONDITION)))) then (AR.PROMPT.PRINT FORMWINDOW T MSG " --- please wait")) (DISMISS 5000)) finally (AR.PROMPT.PRINT FORMWINDOW T "Gave up trying to open info file--try again later") (ERROR!))) ) (AR.PUT.FAILED (LAMBDA (MSG FORMWINDOW) (* ; "Edited 18-Feb-88 11:12 by bvm") (RINGBELLS) (FLASHWINDOW FORMWINDOW 1) (AR.PROMPT.PRINT FORMWINDOW T MSG) (WINDOWPROP FORMWINDOW (QUOTE TITLE) (MKSTRING MSG))) ) ) (DEFINEQ (AR.CHECK.FIELDS (LAMBDA (FORMWINDOW) (* ; "Edited 12-Feb-88 18:38 by bvm") (* ;; "Check that the AR is well-formed. Return an error message if there is a problem.") (AR.MAP.BUTTONS FORMWINDOW (FUNCTION (LAMBDA (TOBJ OBJ CH#) (LET (FN CHECK.VALUE SEL FIELD.CH# FIELD.LEN) (if (AND (SETQ FN (IMAGEOBJPROP OBJ (QUOTE AR.CHECK.FN))) (NEQ FN (FUNCTION NILL))) then (if (IMAGEOBJPROP OBJ (QUOTE AR.PROTECTED.FLG)) then (SETQ FIELD.CH# (IPLUS (IMAGEOBJPROP OBJ (QUOTE AR.FIELD.START)) CH#)) (SETQ FIELD.LEN (IMAGEOBJPROP OBJ (QUOTE AR.FIELD.LEN))) else (SETQ SEL (MBUTTON.FIND.NEXT.FIELD TOBJ CH#)) (SETQ FIELD.CH# (fetch (SELECTION CH#) of SEL)) (SETQ FIELD.LEN (fetch (SELECTION DCH) of SEL))) (AND (SETQ CHECK.VALUE (CL:FUNCALL FN FORMWINDOW OBJ CH# FIELD.CH# FIELD.LEN)) (APPEND (LIST "Bad value for field [" (IMAGEOBJPROP OBJ (QUOTE MBTEXT)) "] --- ") CHECK.VALUE)))))))) ) (AR.CHECK.MENU (LAMBDA (FORMWINDOW OBJ CH# FIELD.CH# FIELD.LEN) (* ; "Edited 12-Feb-88 11:58 by bvm") (LET ((CLIST (AR.READ.BYTES (TEXTSTREAM FORMWINDOW) FIELD.LEN (SUB1 FIELD.CH#))) VAL) (if (NULL CLIST) then (* ; "a null menu value is always correct") NIL elseif (MEMB (SETQ VAL (PACKC CLIST)) (IMAGEOBJPROP OBJ (QUOTE AR.MENU.LIST))) then NIL else (IMAGEOBJPROP OBJ (QUOTE AR.MENU) NIL) (LIST "bad menu value: " VAL " --- please reset")))) ) (AR.CHECK.SHORTSTRING (LAMBDA (FORMWINDOW OBJ CH# FIELD.CH# FIELD.LEN) (* edited%: "27-Jul-84 10:51") (if (ILEQ FIELD.LEN (IMAGEOBJPROP OBJ (QUOTE AR.MAX.LEN))) then NIL else (LIST "max length= " (IMAGEOBJPROP OBJ (QUOTE AR.MAX.LEN)) "; current length= " FIELD.LEN))) ) (AR.CHECK.SUBMENU (LAMBDA (FORMWINDOW OBJ CH# FIELD.CH# FIELD.LEN) (* ; "Edited 12-Feb-88 12:07 by bvm") (* ;; "Check that a submenu value is correct for the value given in the main menu.") (LET ((CLIST (AR.READ.BYTES (TEXTSTREAM FORMWINDOW) FIELD.LEN (SUB1 FIELD.CH#))) VAL) (IMAGEOBJPROP OBJ (QUOTE AR.ASSOCIATED.MENU.VAL) NIL) (* ; "??") (if (NULL CLIST) then (* ; "a null menu value is always correct") NIL elseif (MEMB (SETQ VAL (PACKC CLIST)) (LISTGET (IMAGEOBJPROP OBJ (QUOTE AR.SUBMENU.LIST)) (AR.GET.ASSOCIATED.MENU.VAL OBJ FORMWINDOW))) then NIL else (IMAGEOBJPROP OBJ (QUOTE AR.SUBMENUS) NIL) (IMAGEOBJPROP OBJ (QUOTE AR.ASSOCIATED.MENU.VAL) NIL) (LIST "bad menu value: " VAL " --- please reset")))) ) ) (* ; "Special") (DEFINEQ (AR.FORM.GET/PUT.FILE (LAMBDA (FORMWINDOW OPERATION) (* ; "Edited 5-Aug-88 11:09 by bvm") (AR.PROMPT.CLEAR FORMWINDOW) (LET* ((PWINDOW (GETPROMPTWINDOW FORMWINDOW)) (FILE (PROMPTFORWORD (if (EQ OPERATION (QUOTE Get)) then "Get File: " else "Put File: ") (WINDOWPROP FORMWINDOW (QUOTE AR.GET/PUT.FILE.NAME)) NIL PWINDOW NIL (QUOTE TTY)))) (TERPRI PWINDOW) (if FILE then (WINDOWPROP FORMWINDOW (QUOTE AR.GET/PUT.FILE.NAME) FILE) (if (EQ OPERATION (QUOTE Get)) then (AR.GET.AR FORMWINDOW FILE) elseif (SETQ FILE (AR.FORM.SAVE FORMWINDOW FILE)) then (WINDOWPROP FORMWINDOW (QUOTE TITLE) (CONCAT "Saved " FILE)) (TEDIT.STREAMCHANGEDP FORMWINDOW T))))) ) (AR.GET.NEXT (LAMBDA (FORMWINDOW) (* ; "Edited 5-Aug-88 11:21 by bvm") (* ;; "Gets the next (existing) AR in numeric order after CURR.NUM (the one now in the window).") (LET ((CURR.NUM (OR (WINDOWPROP FORMWINDOW (QUOTE AR.FORM.NUMBER)) (FIXP (AR.GET.NUMBER.FIELD FORMWINDOW))))) (if (NOT CURR.NUM) then (AR.PROMPT.PRINT FORMWINDOW "Can't GetNext when there isn't a current number") else (bind *UPPER-CASE-FILE-NAMES* AR.LIMIT do (* ;; "Keep going until we find a real AR.") (SETQ CURR.NUM (ADD1 CURR.NUM)) (COND ((INFILEP (AR.FILENAME CURR.NUM)) (* ; "ar exists. Get it.") (AR.MENU.FN.GET FORMWINDOW CURR.NUM) (RETURN)) ((>= CURR.NUM (OR AR.LIMIT (SETQ AR.LIMIT (AR.GET.SUBMIT.NUM FORMWINDOW T)) (RETURN))) (* ; "next AR number is equal to the number to be assigned to the next AR submitted") (AR.PROMPT.PRINT FORMWINDOW T "Next " AR.IDENTIFICATION.STRING " hasn't been submitted yet.") (RETURN)) (T (AR.PROMPT.PRINT FORMWINDOW T AR.IDENTIFICATION.STRING " #" CURR.NUM " doesn't exist, checking next ar."))))))) ) (AR.FORM.FILL.IN.DEFAULTS (LAMBDA (FORMWINDOW) (* ; "Edited 4-Aug-88 15:36 by bvm") (LET ((FORMSTREAM (TEXTSTREAM FORMWINDOW)) ALREADY.FILLED DEFAULTS) (AR.MAP.BUTTONS FORMSTREAM (FUNCTION (LAMBDA (TOBJ OBJ CH#) (LET ((NEWVALUE (IMAGEOBJPROP OBJ (QUOTE FILLINVALUE)))) (* ; "Yes, this button has a %"Fill In Defaults%" prop") (if NEWVALUE then (push DEFAULTS (LIST (IMAGEOBJPROP OBJ (QUOTE MBTEXT)) (if (LISTP NEWVALUE) then (EVAL NEWVALUE) else NEWVALUE))) (if (> (if (IMAGEOBJPROP OBJ (QUOTE AR.PROTECTED.FLG)) then (IMAGEOBJPROP OBJ (QUOTE AR.FIELD.LEN)) else (fetch (SELECTION DCH) of (OR (MBUTTON.FIND.NEXT.FIELD TOBJ CH#) (SHOULDNT "Can't find field for button")))) 0) then (* ; "Field already has a value") (push ALREADY.FILLED (IMAGEOBJPROP OBJ (QUOTE MBTEXT))))) (* ; "Return NIL so that the iteration continues") NIL)))) (if (AND ALREADY.FILLED (NOT (MOUSECONFIRM (LET ((*PRINT-CASE* :UPCASE)) (CL:FORMAT NIL "The ~{~A ~}field~:[ is~;s are~] already non-empty" ALREADY.FILLED (CDR ALREADY.FILLED))) "Click LEFT to overwrite anyway" (GETPROMPTWINDOW FORMWINDOW)))) then (ERROR!)) (AR.REPLACE.FILL.INS FORMWINDOW DEFAULTS) (AR.PROMPT.PRINT FORMWINDOW " done"))) ) (AR.CURRENT.LISP.VERSION (LAMBDA NIL (* ; "Edited 16-Feb-88 13:15 by bvm") (CONCAT (L-CASE MAKESYSNAME T) " " (SUBSTRING MAKESYSDATE 1 (if (STRING-EQUAL MAKESYSNAME "LISPCORE") then (* ; "Give the whole gory date") NIL else (* ; "Assume only one real release per day (tee hee), so skip the time") -10)))) ) ) (* ; "Misc") (DEFINEQ (AR.PROMPT (LAMBDA (WORDS FORMWINDOW) (* ; "Edited 10-Feb-88 14:08 by bvm") (PROG ((*PRINT-BASE* 10) (PWINDOW (GETPROMPTWINDOW FORMWINDOW 2))) (CLEARW PWINDOW) (if (LISTP WORDS) then (for X in WORDS do (PRIN1 X PWINDOW)) else (PRIN1 WORDS PWINDOW)))) ) (AR.PROMPT.PRINT (LAMBDA ARGS (* ; "Edited 20-Jul-88 18:24 by bvm") (* ;; "Real arglist is (formwindow &rest strings). Prints each of strings to FORMWINDOW's prompt window. T means new line.") (LET ((*PRINT-BASE* 10) (PWINDOW (GETPROMPTWINDOW (ARG ARGS 1) 2)) STR) (for I from 2 to ARGS do (SELECTQ (SETQ STR (ARG ARGS I)) (T (FRESHLINE PWINDOW)) (:CLEAR (CLEARW PWINDOW)) (PRIN1 STR PWINDOW))))) ) (AR.PROMPT.CLEAR (LAMBDA (FORMWINDOW) (* ; "Edited 17-Feb-88 11:13 by bvm") (CLEARW (GETPROMPTWINDOW FORMWINDOW 2)))) (AR.GET.FILENAME (LAMBDA (NUM PUTFLG) (* jds " 7-Nov-86 10:48") (* ;; "Convert from an AR number to the corresponding file name") (* ;;; "PROG (FILE) (CLRPROMPT) (SETQ FILE (PROMPTFORWORD (CONCAT 'What file should I use for AR# ' NUM '? ') NIL NIL PROMPTWINDOW)) (if FILE then (RETURN (MKATOM FILE))) (if PUTFLG then (FRESHLINE PROMPTWINDOW) (printout PROMPTWINDOW 'do you really want to PUT to the lispar database?') (if (NULL (MOUSECONFIRM)) then (RETURN NIL))) (RETURN (AR.FILENAME NUM))") (COND ((FIXP NUM) (AR.FILENAME NUM)) (T NIL))) ) (AR.READ.NUMBER (LAMBDA (RETFLG) (* ; "Edited 4-Aug-88 12:37 by bvm") (RESETLST (RESETSAVE (TTY.PROCESS (THIS.PROCESS))) (PROMPTPRINT "Type or select digits of desired AR.") (RESETSAVE NIL (QUOTE (CLRPROMPT))) (OR (RNUMBER (CONCAT AR.IDENTIFICATION.STRING " number") NIL NIL NIL T NIL T T) (AND (NOT RETFLG) (ERROR!))))) ) (AR.FILENAME (LAMBDA (ARN) (* ; "Edited 12-Feb-88 16:19 by bvm") (CONCAT AR.DIRECTORY (SUBSTRING (+ 100000 ARN) -5 -1) ".AR")) ) (AR.READ.BYTES (LAMBDA (STREAM NBYTES START) (* ; "Edited 12-Feb-88 12:46 by bvm") (* ;; "Collect a list of NBYTES bytes by reading from STREAM starting at START or current position") (if START then (SETFILEPTR STREAM START)) (to NBYTES collect (BIN STREAM))) ) (AR.USERNAME (LAMBDA NIL (* ; "Edited 4-Aug-88 15:08 by bvm") (if (GETD (QUOTE FULLUSERNAME)) then (FULLUSERNAME) else (USERNAME NIL NIL T))) ) ) (* ; "These have special knowledge of TEdit I wish I didn't really need") (DEFINEQ (TEDIT.FAST.RAW.INCLUDE [LAMBDA (TEXTSTREAM INSTREAM START END INSERTCH#) (* ; "Edited 15-Jun-90 10:42 by jds") (* ;; "takes a text stream and an OPEN stream to include at character INSERTCH#. Note: Start and End are inclusive ptrs, unlike in copybytes and friends. No interpretation (alternate file type e.g. Bravo) takes place. INSTREAM is not copied, so you'd better not be changing it.") (LET* [(TEXTOBJ (TEXTOBJ TEXTSTREAM)) (PCTB (fetch (TEXTOBJ PCTB) of TEXTOBJ)) (INSPC# (OR (\CHTOPCNO INSERTCH# PCTB) (INDEX (fetch CHNUM of (\LASTNODE PCTB)) PCTB))) (INSPC (fetch PCE of (FINDNODE-INDEX PCTB INSPC#))) (LEN (- (OR END (GETEOFPTR INSTREAM)) (OR START (SETQ START 0] (* ;  "INSPC is the piece to make the insertion in") (COND ([AND (NEQ INSPC 'LASTPIECE) (> INSERTCH# (fetch CHNUM of (FINDNODE-INDEX PCTB INSPC#] (* ; "Must split the piece.") (SETQ INSPC (\SPLITPIECE INSPC INSERTCH# TEXTOBJ INSPC#)) (add INSPC# 1))) (\TEDIT.INSERT.PIECES TEXTOBJ INSERTCH# (create PIECE PFILE _ INSTREAM PFPOS _ START PLEN _ LEN PREVPIECE _ NIL NEXTPIECE _ NIL PLOOKS _ (fetch (TEXTOBJ DEFAULTCHARLOOKS) of TEXTOBJ) PPARALAST _ NIL PPARALOOKS _ (fetch (TEXTOBJ FMTSPEC) of TEXTOBJ)) LEN INSPC INSPC#) (add (fetch (TEXTOBJ TEXTLEN) of TEXTOBJ) LEN]) (AR.PIECE.CHANGED [LAMBDA (TEXTOBJ TEXTSTREAM CH# REFSTREAM START LEN) (* ; "Edited 15-Jun-90 10:42 by jds") (* ;; "Compares TEXTOBJ/TEXTSTREAM at position CH# with the contents of REFSTREAM from filepointer START for the next LEN bytes. If they're different, returns T.") (* ;; "Do this by comparing pieces. This is fast in the average case (the piece is unchanged), and takes into account the fact that the textstream may be backed by REFSTREAM, so file pointers would step on each other.") (LET* ((PCTB (fetch (TEXTOBJ PCTB) of TEXTOBJ)) (PIECE# (\CHTOPCNO CH# PCTB)) PIECE) (if (NULL PIECE#) then (* ; "Shouldn't happen") T else (SETQ PIECE (fetch PCE of (FINDNODE-INDEX PCTB PIECE#))) (do (if (ATOM PIECE) then (* ; "Shouldn't happen") (RETURN NIL)) (if [NOT (if (EQ (fetch (PIECE PFILE) of PIECE) REFSTREAM) then (* ;  "Same as reference stream--they're same if starts match, assume different otherwise") (= (fetch (PIECE PFPOS) of PIECE) START) else (* ;  "Somewhere else, so compare byte by byte") (SETFILEPTR TEXTSTREAM (SUB1 CH#)) (SETFILEPTR REFSTREAM START) (to (fetch (PIECE PLEN) of PIECE) always (EQ (BIN TEXTSTREAM) (BIN REFSTREAM] then (RETURN T)) (if (> (SETQ LEN (- LEN (fetch (PIECE PLEN) of PIECE))) 0) then (add START (fetch (PIECE PLEN) of PIECE)) (add CH# (fetch (PIECE PLEN) of PIECE)) (SETQ PIECE (fetch (PIECE NEXTPIECE) of PIECE)) else (* ;  "That's all the way to the end, so we succeeded") (RETURN NIL]) ) (* ; "Patch for Lyric") (DEFINEQ (AR.UNSELECT.ITEM (LAMBDA (BROWSER ITEM) (* ; "Edited 18-Feb-88 10:55 by bvm") (\CALLME (QUOTE TB.UNSELECT.ITEM)) (* ;; "Copy of the definition of TB.UNSELECT.ITEM for use in Lyric (where there was no such beast)") (if (ffetch (TABLEITEM TISELECTED) of (\DTEST ITEM (QUOTE TABLEITEM))) then (LET ((N (ffetch (TABLEITEM TI#) of ITEM))) (TB.DESELECTRANGE (\DTEST BROWSER (QUOTE TABLEBROWSER)) N N) (TB.SHOW.SELECTION BROWSER N (QUOTE ERASE))))) ) ) (* ; "Hardcopying AR's") (DEFINEQ (AR.DISPLAY (LAMBDA (AR# WINDOW PROMPTW) (* ; "Edited 4-Aug-88 12:40 by bvm") (* ;; "Displays AR# as a readonly textstream. Uses WINDOW if given, otherwise prompts for one. PROMPTW is optional window for error messages.") (LET ((TITLE (CONCAT AR.IDENTIFICATION.STRING " " AR#)) TS) (if WINDOW then (CLEARW WINDOW) (WINDOWPROP WINDOW (QUOTE TITLE) TITLE) else (SETQ WINDOW (CREATEW NIL TITLE)) (WINDOWPROP WINDOW (QUOTE ICONFN) (FUNCTION TEXTICON))) (if (SETQ TS (AR.DISPLAY.TEXTSTREAM AR# (WINDOWPROP WINDOW (QUOTE WIDTH)) NIL PROMPTW)) then (OPENTEXTSTREAM TS WINDOW NIL NIL (QUOTE (READONLY T SEL DON'T)))))) ) (AR.HARDCOPY (LAMBDA (NUMBERS PROMPTW) (* ; "Edited 4-Aug-88 12:43 by bvm") (* ;; "Hardcopy the ARs in the list NUMBERS. PROMPTW is window for progress output and error messages, defaults to T.") (if (AND NUMBERS (NLISTP NUMBERS)) then (SETQ NUMBERS (LIST NUMBERS))) (if (NULL PROMPTW) then (SETQ PROMPTW (GETSTREAM T (QUOTE OUTPUT)))) (for TAIL on NUMBERS bind TEXTSTREAM VALUE (TITLE _ (COND ((CDR NUMBERS) (CONCAT "Selected " AR.IDENTIFICATION.STRING "s")) (T (CONCAT AR.IDENTIFICATION.STRING "# " (CAR NUMBERS))))) (N _ 0) (PARTNO _ 0) (LASTPAGENO _ 0) NPAGES do (if (SETQ VALUE (AR.DISPLAY.TEXTSTREAM (CAR TAIL) AR.HARDCOPY.WIDTH (if TEXTSTREAM elseif (CDR NUMBERS) then (* ; "Make our own textstream with a pagelayout so we can print running headers") (* ; "Note that PY is lower than header Y because of TEdit bug in placement") (OPENTEXTSTREAM "" NIL NIL NIL (BQUOTE (FONT (\, ARFONT) PARALOOKS (PARALEADING 1) PAGEFORMAT (\, (TEDIT.SINGLE.PAGEFORMAT T -36 (- -36 AR.HARDCOPY.PAGENO.KLUDGE.OFFSET) (BQUOTE (FONT (\, ARHEADERFONT))) (QUOTE RIGHT) 72 36 72 72 NIL NIL NIL (BQUOTE ((HEADING (\, (- -36 (STRINGWIDTH (CONCAT AR.IDENTIFICATION.STRING " 99999999") ARHEADERFONT))) -36))) NIL (BQUOTE (STARTINGPAGE# (\, (ADD1 LASTPAGENO)))))) TEDIT.TENTATIVE NIL)))) PROMPTW)) then (SETQ TEXTSTREAM VALUE) (PRIN1 "." PROMPTW) (add N 1) (if (AND (CDR TAIL) (> (GETEOFPTR TEXTSTREAM) AR.HARDCOPY.MAXLENGTH)) then (* ; "That's enough for one pass, let's send it off") (FRESHLINE PROMPTW) (PRINTOUT PROMPTW "Formatting part " (add PARTNO 1)) (SETQ NPAGES (TEDIT.HARDCOPY TEXTSTREAM NIL NIL (CONCAT TITLE " [Part " PARTNO "]"))) (if (FIXP NPAGES) then (* ; "Doesn't work in Lyric") (add LASTPAGENO NPAGES)) (PRINTOUT PROMPTW "...done" T) (SETQ TEXTSTREAM NIL))) finally (RETURN (if TEXTSTREAM then (* ; "Could be empty if none of the numbers were good. Can have the Hardcopy done in its own process, since we do't need to wait for the storage to be free.") (if (NEQ PARTNO 0) then (SETQ TITLE (CONCAT TITLE " [Part " (add PARTNO 1) "]")) else (SETQ PARTNO NIL)) (ADD.PROCESS (BQUOTE ((\, (FUNCTION TEDIT.HARDCOPY)) (QUOTE (\, TEXTSTREAM)) NIL NIL (QUOTE (\, TITLE))))) (CONCAT (if (NULL (CDR NUMBERS)) then TITLE else (CL:FORMAT NIL "~D ~As~@[ in ~D parts~]" N AR.IDENTIFICATION.STRING PARTNO)) " queued for printing"))))) ) (AR.DISPLAY.TEXTSTREAM (LAMBDA (AR# WIDTH TEXTSTREAM PROMPTW) (* ; "Edited 4-Aug-88 12:44 by bvm") (* ;; "Create a textstream containing the contents of AR# layed out as in an AR edit window, but vanilla readonly text. WIDTH is the width I would like tabs layed out. If an error occurs, prints the condition to PROMPTW and returns NIL. If TEXTSTREAM is supplied, new AR is appended to it, and a header line is placed before it (this is for multiple hardcopy).") (PROG ((SCRATCH (OPENSTREAM (QUOTE {NODIRCORE}) (QUOTE BOTH))) (BOLD (LIST (QUOTE FONT) ARBOLDFONT)) (NTABS 0) CH# FIRSTCH# TABSTOPS TAB.CH# SPEC LEN MAP LASTFIELD CONDITION) (CL:MULTIPLE-VALUE-SETQ (MAP CONDITION) (AR.FETCH.AND.PARSE.AR AR# SCRATCH)) (if CONDITION then (* ; "Failed to load ar") (PRINTOUT PROMPTW T (CL:TYPECASE CONDITION (XCL:FILE-NOT-FOUND (CONCAT "Can't find " AR.IDENTIFICATION.STRING " " AR#)) (T (CL:FORMAT NIL "Failed to load ~A ~A because: ~A" AR.IDENTIFICATION.STRING AR# CONDITION)))) (RETURN NIL)) (if TEXTSTREAM then (* ; "Appending to existing stream") (SETQ CH# (SETQ FIRSTCH# (ADD1 (GETEOFPTR TEXTSTREAM)))) else (SETQ TEXTSTREAM (OPENTEXTSTREAM "" NIL NIL NIL (BQUOTE (FONT (\, ARFONT) PARALOOKS (PARALEADING 1) TEDIT.TENTATIVE NIL)))) (SETQ CH# 1)) (for FIELD in (OR AR.DISPLAY.FORMAT AR.FORM.FORMAT) do (BLOCK) (if (EQ FIELD (QUOTE TAB)) then (* ; "Separates fields all on one line") (SETQ TAB.CH# CH#) (add NTABS 1) (if (EQ LASTFIELD (QUOTE TAB)) then (* ; "two tabs in a row, I'll punt the optimization") (TEDIT.INSERT TEXTSTREAM " ") (add CH# 1)) elseif (EQ FIELD (QUOTE CR)) then (* ; "Go to a new line. Come up with tabs to divide the space evenly among the fields") (if (> NTABS 0) then (push TABSTOPS NTABS TAB.CH#) (SETQ NTABS 0)) (TEDIT.INSERT TEXTSTREAM " " CH#) (add CH# 1) elseif (NOT (LITATOM FIELD)) then (* ; "Random string to print") (if (EQ LASTFIELD (QUOTE TAB)) then (TEDIT.INSERT TEXTSTREAM " ") (add CH# 1)) (TEDIT.INSERT TEXTSTREAM FIELD CH#) (add CH# (NCHARS FIELD)) else (* ; "It's a field") (TEDIT.INSERT TEXTSTREAM (SETQ SPEC (if (EQ LASTFIELD (QUOTE TAB)) then (* ; "Pack in a saved up tab to reduce the total string usage") (CONCAT " " FIELD " ") else (CONCAT FIELD " "))) CH# BOLD) (add CH# (NCHARS SPEC)) (SETQ SPEC (ASSOC FIELD MAP)) (if (AND SPEC (> (SETQ LEN (CADDR SPEC)) 0)) then (* ; "Insert body of field") (TEDIT.FAST.RAW.INCLUDE TEXTSTREAM SCRATCH (SETQ SPEC (CADR SPEC)) (+ SPEC LEN) CH#) (add CH# LEN))) (SETQ LASTFIELD FIELD)) (while TABSTOPS bind CACHED.TABS TB do (* ; "Process each <#tabs chpos> pair and set a tab stop there.") (SETQ NTABS (pop TABSTOPS)) (TEDIT.PARALOOKS TEXTSTREAM (if (CDR (ASSOC NTABS CACHED.TABS)) else (* ; "Cache tab settings for this number of tabs") (push CACHED.TABS (CONS NTABS (SETQ TB (BQUOTE (TABS (NIL (\,@ (for I from 1 to NTABS bind (TABWIDTH _ (IQUOTIENT WIDTH (ADD1 NTABS))) collect (CONS (ITIMES I TABWIDTH) (QUOTE LEFT)))))))))) TB) (pop TABSTOPS) 1)) (if FIRSTCH# then (* ; "Insert a header paragraph in front of AR text") (LET ((HEAD (CONCAT AR.IDENTIFICATION.STRING " " AR# " "))) (TEDIT.INSERT TEXTSTREAM HEAD FIRSTCH# (BQUOTE (FONT (\, ARHEADERFONT)))) (TEDIT.PARALOOKS TEXTSTREAM (QUOTE (TYPE PAGEHEADING SUBTYPE HEADING LINELEADING 0 PARALEADING 0)) FIRSTCH# 1) (if (> FIRSTCH# 1) then (* ; "Also need page break") (TEDIT.PARALOOKS TEXTSTREAM (QUOTE (NEWPAGEBEFORE T)) (+ FIRSTCH# (NCHARS HEAD)) 1))) else (* ; "Get rid of the selection") (TEDIT.SETSEL TEXTSTREAM CH# 0 (QUOTE RIGHT))) (RETURN TEXTSTREAM))) ) ) (RPAQ? AR.HARDCOPY.WIDTH 504) (RPAQ? AR.HARDCOPY.MAXLENGTH 40000) (RPAQ? AR.DISPLAY.FORMAT NIL) (* ; "These VARS are AR-system change these to work on different AR databases") (RPAQQ AR.FORM.FORMAT (Number%: TAB Date%: CR Submitter%: TAB Source%: CR CR Subject%: CR CR |Assigned To:| TAB Attn%: CR CR Status%: TAB In/By%: CR |Problem Type:| TAB Impact%: CR Difficulty%: TAB Frequency%: CR TAB Priority%: CR CR System%: TAB Subsystem%: CR CR Machine%: TAB Disk%: CR |Lisp Version:| TAB |Source Files:| CR |Microcode Version:| TAB |Memory Size:| CR |File Server:| TAB |Server Software Version:| CR CR Disposition%: CR CR |Release Note:| CR CR Description%: CR CR Workaround%: CR |Test Case:| CR CR Edit-By%: TAB Edit-Date%: CR)) (RPAQQ AR.FORM.SPECS ((Number%: FIELDTYPE PROTECTEDSTRING) (Date%: FIELDTYPE PROTECTEDSTRING) (Submitter%: FIELDTYPE STRING INITIALVALUE (AR.USERNAME)) (Source%: FIELDTYPE STRING INITIALVALUE (AR.USERNAME)) (Subject%: FIELDTYPE STRING) (|Assigned To:| FIELDTYPE STRING) (Attn%: FIELDTYPE STRING) (Status%: FIELDTYPE MENU MENULIST (New Open Open/Unreleased Fixed Closed Declined Superseded Obsolete Incomplete Internal Wish) INITIALVALUE New) (In/By%: FIELDTYPE STRING) (|Problem Type:| FIELDTYPE MENU MENULIST (Bug |Design - Impl| Feature |Design - UI| Documentation Performance)) (Impact%: FIELDTYPE MENU MENULIST (Fatal Serious Moderate Annoying Minor)) (Difficulty%: FIELDTYPE MENU MENULIST (Easy Moderate Hard Very% Hard Impossible)) (Frequency%: FIELDTYPE MENU MENULIST (Everytime Intermittent Once)) (Priority%: FIELDTYPE MENU MENULIST (Absolutely Hopefully Perhaps Unlikely)) (System%: FIELDTYPE MENU ASSOCSUBMENU Subsystem%: MENULIST (Communications |Windows and Graphics| Operating% System Language% Support Programming% Environment Text Common% Lisp CLOS Port Maiko LOOPS PCE PROLOG 4045 Rooms Library BusMaster NoteCards Documentation Other% Software)) (Subsystem%: FIELDTYPE SUBMENU ASSOCMENU System%: SUBMENULIST (Communications (NS% Protocols NS% Filing NS% Printing PUP% Protocols PUP% FTP Grapevine Leaf RS232 VAX% Server DEI EVMS/RPC Lisp% Servers Clearinghouse TCP/IP Centronics TTYPort Chat Chat% Interface |Pup Chat Driver| |NS Chat Driver| |RS232 Chat Driver| |TTYPort Chat Driver| |Chat DM2500 Emulator| |Chat VT100 Emulator| NSMaintain Other) |Windows and Graphics| (Window% System Library Fonts Printing Color Bitmaps Demos Menus Other) Operating% System (Virtual% Memory |Generic File Operations| DLion% Disk Daybreak% Disk DLion% Floppy Daybreak% Floppy Dolphin/Dorado% Disk Processes Streams Keyboard Mouse Other) Language% Support (Arithmetic |Compiler, Code Format| For/If Microcode Storage% Formats/Mgt Garbage% Collection |Read and Print| |Stack and Interpreter| |Bootstrapping and Teleraid| Diagnostics Other) Programming% Environment (Break% Package Code% Editor DWIM Inspector File% Package History Masterscope PSW Record% Package Performance% Tools Edit% Interface Exec Presentations Stepper Other) Text (TEdit TTYIN Lafite AR% Database Other) Common% Lisp (Type% System Declarations Macros Control% Structure Evaluator Symbols/Packages Arithmetic Characters/Strings Sequences Lists Arrays Structures Hash% Tables |Streams and I/O| |File System Interface| Error% System Compiler Tamarin% Support Microcoded% Operations Common% Loops Other) CLOS (Language Browsers Methods Classes Meta% Classes Other) Port (Other) Maiko (Bytecode% Emulation Native% Code I/O% System Host% Integration |Host User Interface| |Foreign Fn Interface| Installation% Procedure Documentation Other) LOOPS (Active% Values Composite% Objects Objects Browsers User% Interface Virtual% Copy Other) PCE (Monochrome% Display Color% Display Keyboard |Emulated Rigid Disk| Floppy% Disk Printer% Port User% Interface Programmatic% Interface |File System Interface| Memory Ethernet Configuration% Tools Other) PROLOG (Arithmetic Dinfo Microcode Editor% Interface Compiler Interpreter I/O Debugging Prolog-Lisp% Interface Other) 4045 (XLPStream Remoteserver HQStream PSO Other) Rooms (Window% Types Overview Suites Buttons Documentation Other) Library (Cash-File Centronics CharCodeTables Copyfiles DEdit DatabaseFns EditBitmap |FX-80 Printer Support| Filebrowser Font% Samples GCHax GraphZoom Grapher Hash Hash-File |Image Object Interface| Kermit Masterscope% Browser MatMult |Press Printer Support| ReadNumber SameDir Sketch SysEdit/EXPORTS.ALL Tablebrowser TExec TextModules Virtual% Keyboards Where-Is Other) BusMaster (Speech Color Other) NoteCards (User% Interface Programmer's% Interface System% Interface Notefiles Links Documentation Text% Cards File% Boxes Sketch% Cards Graph% Cards Browser% Cards Search% Cards |Link Index Cards| Document% Cards Other% Cards Library) Documentation (Tools |1108 Users Guide| |1186 Users Guide| Primer |Product Descr/Tech Summary| |Hardware Installation Guide| Programmers% Introduction |Interlisp Reference Manual| |Library Package Manual| |Internal System Documentation| Other) Other% Software (Installation% Utility Release% Procedure Other))) (Machine%: FIELDTYPE MENU ASSOCSUBMENU Disk%: MENULIST (1100 1108 1132 1186) FILLINVALUE (SELECTQ (MACHINETYPE) (DANDELION 1108) (DOLPHIN 1100) (DORADO 1132) (DOVE 1186) AR.NULL.BUTTON.VALUE)) (Disk%: FIELDTYPE SUBMENU ASSOCMENU Machine%: SUBMENULIST (1100 NIL 1108 (|SA1000 (10MB)| |SA4000 (29MB)| |Q2040 (43MB)| |Q2080 (80MB)| |T80 (80MB)| |T300 (300MB)| Other) 1132 (|T80 (80MB)| Century315 Other) 1186 (|ST212 (10MB)| |TM703 (20MB)| |TM702 (20MB)| |ST4026 (20MB)| |Q530 (20MB)| |Q540 (40MB)| |Micropolis 1303 (40MB)| |Micropolis 1325 (80MB)|))) (|Lisp Version:| FIELDTYPE STRING FN AR.BUTTONFN.OFFER.DEFAULT FILLINVALUE ( AR.CURRENT.LISP.VERSION )) (|Source Files:| FIELDTYPE STRING) (|Microcode Version:| FIELDTYPE STRING FILLINVALUE (MICROCODEVERSION)) (|Memory Size:| FIELDTYPE STRING FILLINVALUE (REALMEMORYSIZE)) (|File Server:| FIELDTYPE MENU MENULIST (8037 IFS NS |VAX/VMS - 3Mb| |VAX/VMS - 10Mb| VAX/UNIX Micro% VAX/VMS Other)) (|Server Software Version:| FIELDTYPE STRING) (Disposition%: FIELDTYPE PROTECTEDSTRING) (|Release Note:| FIELDTYPE STRING) (Description%: FIELDTYPE STRING) (Workaround%: FIELDTYPE STRING) (|Test Case:| FIELDTYPE STRING) (Edit-By%: FIELDTYPE PROTECTEDSTRING) (Edit-Date%: FIELDTYPE PROTECTEDSTRING))) (RPAQQ AR.INTERESTING.SUBMIT.FIELDS (|Release Note:| Workaround%: |Test Case:|)) (RPAQ AR.DIRECTORY "{AR:MV:Envos}") (RPAQ AR.INFO.FILE.NAME "{AR:MV:Envos}LispARs.tds") (RPAQ AR.SUBMIT.NUM.FILE.NAME "{AR:MV:Envos}LispARs.num") (RPAQ AR.IDENTIFICATION.STRING "AR") (RPAQ? ARBUTTONFONT (FONTCREATE 'HELVETICA 12 'BOLD)) (RPAQ? ARFONT (FONTCREATE 'TIMESROMAN 10)) (RPAQ? ARBOLDFONT (FONTCREATE 'HELVETICA 10 'BOLD)) (RPAQ? ARHEADERFONT (FONTCREATE 'HELVETICA 8)) (RPAQ? AR.ICONFONT (FONTCREATE 'GACHA 8)) (RPAQ? AR.FILE.TRIES 10) (RPAQ? AR.NO.MESSAGE.FLG NIL) (RPAQ AR.NULL.BUTTON.VALUE (PACKC)) (RPAQQ AR.FORM.MENU.TITLEMENU.ITEMS ((Clear '(AR.MENU.FN.CLEAR NIL) "Clears all the fields of the AR") (New '(AR.MENU.FN.CLEAR T) "Same as creating a new form: sets all fields to default initial values") (Get 'Get "Retrieves the AR whose number is given in the %"Number:%" field") (GetNext 'AR.GET.NEXT "Gets the next existing AR after this one") (Put 'AR.MENU.FN.PUT "Saves an edited AR, or submits a new AR") ("Put & GetNext" 'AR.MENU.FN.PUT&GETNEXT "Stores the current AR, and Gets the next existing AR") ("Put & Get" 'AR.MENU.FN.PUT&GET "Stores the current AR, and Gets another") ("Get From File" '(AR.FORM.GET/PUT.FILE Get) "Retrieves AR from named file") ("Put To File" '(AR.FORM.GET/PUT.FILE Put) "Stores AR into named file") ("Fill In Defaults" 'AR.FORM.FILL.IN.DEFAULTS "Fills in default values for Microcode Version, Machine Type, Lisp Version, and Memory Size" ))) (RPAQQ AR.FORM.MENU.TITLEMENU NIL) (RPAQQ AR.FORM.ICONSPEC (#*(60 60)OOOOOOOOOOOOOOO@OOOOOOOOOOOOOOO@L@@@@@@@@@@@@@C@L@@@@@@@@@@@@@C@L@@@@@CO@@@@@@C@L@@@@@GOH@@@@@C@L@@@@@NAL@@@@@C@L@@CH@L@L@@@@@C@L@@OL@L@L@CN@@C@L@ALL@L@L@CO@@C@L@GHN@L@L@GCH@C@L@N@F@L@L@FAL@C@LGH@F@NAL@F@G@C@LG@@BCOOO@L@CHC@LD@@CGOOOIL@ALC@L@@@CO@@CMH@@NC@L@@@CL@@@O@@@FC@L@@@CH@@@G@@@@C@L@@@O@@@@CH@@@C@L@@@LCOCO@L@@@C@L@@@LGOCOHN@@@C@L@GAHNCCALF@@@C@L@GMHLCC@LF@@@C@L@MOHLCC@LGOL@C@LAHC@LCC@LCON@C@LAHC@LCC@LC@N@C@LC@C@OOCOLC@C@C@LC@C@OOCOLC@C@C@LF@C@LCCG@C@AHC@LF@C@LCCCHC@AHC@LF@C@LCCALC@@LC@LF@CHLCC@LF@@NC@L@@AHLCC@LF@@FC@L@@AHLCC@LF@@FC@L@@@LLCC@LL@@@C@L@AOLLCC@LON@@C@L@AOLLCC@LON@@C@L@AHN@CC@ALF@@C@L@AHF@CC@AHC@@C@L@CHF@CC@AHC@@C@L@C@C@CC@C@AH@C@L@C@CHCC@G@AH@C@L@C@AHCC@F@AH@C@L@C@@N@@AN@AL@C@L@F@@G@@CL@@L@C@L@F@@CNCOH@@N@C@L@N@@AOON@@@F@C@L@L@@@CN@@@@C@C@LAH@@@@@@@@@CHC@LAH@@@@@@@@@ALC@LC@@@@@@@@@@ALC@LF@@@@@@@@@@@NC@LF@@@@@@@@@@@FC@L@@@@@@@@@@@@@C@L@@@@@@@@@@@@@C@L@@@@@@@@@@@@@C@L@@@@@@@@@@@@@C@L@@@@@@@@@@@@@C@OOOOOOOOOOOOOOO@OOOOOOOOOOOOOOO@ NIL (15 2 30 10))) (DECLARE%: EVAL@COMPILE DONTCOPY (DECLARE%: DOEVAL@COMPILE DONTCOPY (GLOBALVARS AR.FORM.ICONSPEC AR.NULL.BUTTON.VALUE AR.HARDCOPY.PAGENO.KLUDGE.OFFSET AR.MENU.READTABLE TEDIT.READTABLE AR.FORM.MENU.TITLEMENU) ) (DECLARE%: DOEVAL@COMPILE DONTCOPY (LOCALVARS . T) ) (* ;  "Need TEDITDECLS for TEDIT.FAST.RAW.INCLUDE") (OR (GET 'TEDITDECLS 'FILE) (LOAD 'TEDITDECLS)) ) (DECLARE%: EVAL@COMPILE DOCOPY (CL:PROCLAIM '(CL:SPECIAL AR.INFO.FILE.NAME AR.SUBMIT.NUM.FILE.NAME AR.DIRECTORY AR.NO.MESSAGE.FLG ARBUTTONFONT ARFONT ARBOLDFONT ARHEADERFONT AR.ICONFONT AR.FILE.TRIES AR.HARDCOPY.MAXLENGTH AR.FORM.FORMAT AR.FORM.SPECS AR.HARDCOPY.WIDTH AR.DISPLAY.FORMAT AR.IDENTIFICATION.STRING AR.FORM.MENU.TITLEMENU.ITEMS AR.INTERESTING.SUBMIT.FIELDS)) ) (FILESLOAD (SYSLOAD) ARQUERY TABLEBROWSER TEDIT READNUMBER) (RPAQ AR.HARDCOPY.PAGENO.KLUDGE.OFFSET (COND ((> (IDATE TEDITSYSTEMDATE) (IDATE "23-feb-88 0000")) (* ; "Bug was fixed") 0) (T 2))) (DECLARE%: DONTEVAL@LOAD DOCOPY (COND ((EQ MAKESYSNAME :LYRIC) (FILESLOAD (SYSLOAD) MVALUESPATCH) (MOVD? 'AR.UNSELECT.ITEM 'TB.UNSELECT.ITEM NIL T))) (PUTD 'AR.UNSELECT.ITEM NIL) (* ;  "Install background menu command. Smash any previous AREdit.") [/RPLACD [OR (CL:ASSOC "AR Edit" BackgroundMenuCommands :TEST 'STRING-EQUAL) (CAR (RPAQ BackgroundMenuCommands (CONS (LIST "AR Edit") BackgroundMenuCommands))] '('(AR.FORM) "Create a new AR editor for the Lisp AR database" (SUBITEMS ("New AR form" '(AR.FORM) "Creates a new AR editor, cleared ready to submit a new AR.") ("Load AR" '(AR.FORM (AR.READ.NUMBER)) "Creates a new AR editor and loads a specified AR into it") ("Display AR" '(AR.DISPLAY (AR.READ.NUMBER)) "Displays a specified AR in a read-only window") ("AR Query Form" '(AR.QFORM.CREATE) "Creates an AR Query Form"] (RPAQ BackgroundMenu ) ) (DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS (ADDTOVAR NLAMA ) (ADDTOVAR NLAML ) (ADDTOVAR LAMA AR.PROMPT.PRINT) ) (PUTPROPS AREDIT COPYRIGHT ("Venue & Xerox Corporation" 1984 1985 1986 1987 1988 1989 1990)) (DECLARE%: DONTCOPY (FILEMAP (NIL (8388 18328 (AR.FORM 8398 . 8683) (AR.FORM.GROUP.CREATE 8685 . 11708) (AR.FORM.CREATE 11710 . 14971) (AR.FORM.ICONFN 14973 . 15219) (AR.BUTTON.OBJ.CREATE 15221 . 17171) (AR.PROTECT.WARNING 17173 . 17365) (AR.INSTALL.TEDITSTREAM 17367 . 17966) (AR.KILL.ATTACHED.TEDIT.CLOSEFN 17968 . 18326)) (18362 26952 (AR.BUTTON.GET.MENU 18372 . 18711) (AR.BUTTON.GET.SUBMENU 18713 . 19407) ( AR.BUTTONFN.DOMENU 19409 . 20292) (AR.BUTTONFN.DOSUBMENU 20294 . 20754) (AR.RESET.SEL 20756 . 21611) ( AR.REPLACE.FIELD.VAL 21613 . 22593) (AR.GET.ASSOCIATED.MENU.VAL 22595 . 22974) (AR.BUTTONFN.SELFIELD 22976 . 23411) (AR.BUTTONFN.OFFER.DEFAULT 23413 . 24208) (AR.MAP.BUTTONS 24210 . 24798) ( AR.FIND.BUTTON 24800 . 25128) (AR.GET.BUTTON.FIELD.AS.TEXT 25130 . 25887) (AR.GET.BUTTON.FIELD.SHAPE 25889 . 26675) (AR.GET.NUMBER.FIELD 26677 . 26950)) (26995 31179 (AR.FORM.MENU.BUTTONFN 27005 . 27263) (AR.FORM.MENU.ACTIONFN 27265 . 29030) (AR.FORM.PROGRAMMATIC.GET 29032 . 29168) ( AR.FORM.PROGRAMMATIC.PUT 29170 . 29312) (AR.DISCONNECT.WINDOW 29314 . 29482) (AR.RECONNECT.WINDOW 29484 . 29906) (AR.MARK.ACTIVE 29908 . 30043) (AR.TOBJ.ACTIVEP 30045 . 30184) ( AR.FORM.MENU.TITLEMENUFN 30186 . 30671) (AR.MENU.CR.FN 30673 . 30834) (AR.GET.MENU.FROM.MAIN.WINDOW 30836 . 31021) (AR.CONFIRM 31023 . 31177)) (31202 33954 (AR.MENU.FN.CLEAR 31212 . 31610) ( AR.FORM.CLEAR 31612 . 32566) (AR.FORM.SET.TO.EMPTY 32568 . 33091) (AR.DELETE.FIELD.VAL 33093 . 33952)) (33975 43470 (AR.MENU.FN.GET 33985 . 34534) (AR.GET.AR 34536 . 36754) (AR.FETCH.AND.PARSE.AR 36756 . 37733) (AR.SET.FORM.NUMBER 37735 . 38577) (AR.GET.SCRATCH.STREAM 38579 . 38909) (AR.COPY.AND.INDEX.AR 38911 . 40536) (AR.MALFORMED.AR 40538 . 40648) (AR.TEXTSTREAM.LOAD 40650 . 43148) (AR.REPLACE.FILL.INS 43150 . 43468)) (43491 59885 (AR.MENU.FN.PUT 43501 . 46837) (AR.MENU.FN.PUT&GET 46839 . 47015) ( AR.MENU.FN.PUT&GETNEXT 47017 . 47159) (AR.FORM.SAVE 47161 . 49619) (AR.GET.SUBMIT.NUM 49621 . 50928) ( AR.FIND.EDIT.CHANGES 50930 . 53546) (AR.NOTE.FIELD.CHANGED 53548 . 55279) (AR.SEND.MESSAGE 55281 . 57676) (AR.COPY.BUTTON.FIELD 57678 . 58685) (AR.UPDATE.AR.INFO 58687 . 59670) (AR.PUT.FAILED 59672 . 59883)) (59886 62218 (AR.CHECK.FIELDS 59896 . 60773) (AR.CHECK.MENU 60775 . 61223) ( AR.CHECK.SHORTSTRING 61225 . 61498) (AR.CHECK.SUBMENU 61500 . 62216)) (62243 65418 ( AR.FORM.GET/PUT.FILE 62253 . 62906) (AR.GET.NEXT 62908 . 63926) (AR.FORM.FILL.IN.DEFAULTS 63928 . 65104) (AR.CURRENT.LISP.VERSION 65106 . 65416)) (65440 67664 (AR.PROMPT 65450 . 65706) ( AR.PROMPT.PRINT 65708 . 66112) (AR.PROMPT.CLEAR 66114 . 66235) (AR.GET.FILENAME 66237 . 66782) ( AR.READ.NUMBER 66784 . 67111) (AR.FILENAME 67113 . 67245) (AR.READ.BYTES 67247 . 67512) (AR.USERNAME 67514 . 67662)) (67747 72497 (TEDIT.FAST.RAW.INCLUDE 67757 . 69694) (AR.PIECE.CHANGED 69696 . 72495)) (72530 72990 (AR.UNSELECT.ITEM 72540 . 72988)) (73024 79494 (AR.DISPLAY 73034 . 73653) (AR.HARDCOPY 73655 . 75981) (AR.DISPLAY.TEXTSTREAM 75983 . 79492))))) STOP