(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED "17-Jun-88 14:02:31" {ERINYES}<JAMES>LISP>ARHACK.;6 67888  

      changes to%:  (FNS EZ.MANY.CHANGES AR.DELETE.NAME)
                    (VARS ARHACKCOMS)

      previous date%: "20-Apr-88 16:43:54" {ERINYES}<JAMES>LISP>ARHACK.;4)


(* "
Copyright (c) 1984, 1985, 1986, 1987, 1988 by Xerox Corporation.  All rights reserved.
")

(PRETTYCOMPRINT ARHACKCOMS)

(RPAQQ ARHACKCOMS 
       ((VARS AR.ACC.FILE.DIR)
        (COMS                                                (* ; 
                                                       "FNS for finding things our about lots of ARs")

              (FNS AR-DELETE-NAME AR-MAKE-LIST AR.ACC.FILE.CREATE AR.DELETE.NAME AR.GET.AR.PLIST 
                   AR.GET.PLIST EZ.MANY.CHANGES)
              
          
          (* ;; "FN for finding ARs edited before a given date:")

              (FNS LAST-CHANGED-BEFORE))
        (COMS                                                (* ; 
                                                    "Grab the test cases for ARs where there is one.")

              (FNS NAB.TEST.CASES))
        (COMS                                                (* ; 
                                "For getting all the AR numbers from a Query window for use in lisp:")

              (FNS GET.NUMS.FROM.QUERY)
              
          
          (* ;; "For making an IP file from a TXT file that was generated using a Query window:")

              (FNS LANDSCAPE.QUERY.WINDOW)
              
          
          (* ;; "For nabbing AR information")

              (FNS AR.GET.SUBMITS.FROM.TDS AR.GET.FIXES.FROM.TDS COLLECT-FIXES COLLECT-SUBMISSIONS 
                   COUNT-BY-WEEK BREAKOUT-ARS-BY-TYPE))
        (COMS                                                (* ; "For hardcopying ARs")

              
          
          (* ;; "The preferred function:")

              (FNS AR.HARDCOPY)
              
          
          (* ;; "Controls how the ARs print with AR.HARDCOPY.  It's a list of lists:")

              
          
          (* ;; "(field-name same-line/CR-count)")

              
          
          (* ;; "where field-name is an AR field name, and same-line/CR-count is T if the next item will still be on this line, or a # of CRs to insert (1 if it's NIL).")

              (VARS AR.HARDCOPY.MAP)
              
          
          (* ;; "The less-convenient versions:")

              (FNS HARDCOPY.ARS MAKEPRESS.ARS)
              
          
          (* ;; "For IP-file making from the text file a query gives you:")

              (FNS AR.IP.FILE))
        (COMS                                                (* ; 
                                             "Bulk changes to the AR database (fixes, closing, etc.)")

              
          
          (* ;; "Function to mark lots of ARs fixed in one sweep.")

              (FNS FIX.MANY.ARS FIX.NO.RELEASE.NOTE)
              
          
          (* ;; 
          "Function for making changes to lots of ARs in one sweep; less convenient than above fn:")

              (FNS CHANGE.MANY.ARS)
              
          
          (* ;; "Function for closing lots of ARs:")

              (FNS CLOSE.MANY.ARS)
              
          
          (* ;; "Functions for counting info about ARs")

              (FNS LIST.NUM.STATUS.PRIORITY COUNT-ARS))
        (COMS 
          
          (* ;; "Functions for making a summary of all feature requests or hopefully-type ARs.")

              (FNS FEATURE.SUMMARY HOPE.SUMMARY FIXED.SUMMARY))
        [COMS 
          
          (* ;; 
    "Function for making lyric relevant summaries of Absolutely bugs, and a listing of all open ARs.")

              (FNS ABSOLUTELY.SUMMARIES ABS.SUMMARY)
              (INITVARS (AR.ABSOLUTELY.HACKER.NAMES '(Bane Biggs Burton Charnley Cude Daniels Fischer 
                                                           Kelley Murage Pavel Pedersen Shih Snow Sye 
                                                           SCPeters RMRichardson Sybalsky vanMelle 
                                                           Woz]
        (COMS 
          
          (* ;; 
   "Function for caching the ar index locally, and causing all later queries to use the local cache.")

              (INITVARS (LOCAL-CACHE-ORIGINAL-AR-INDEX-NAME AR.INDEX.DEFAULT.FILE.NAME))
              (FNS CACHE-ARINDEX))))

(RPAQQ AR.ACC.FILE.DIR {PHYLUM}<LISPARS>)



(* ; "FNS for finding things our about lots of ARs")

(DEFINEQ

(AR-DELETE-NAME
  [LAMBDA (AR-NUM-LIST)                                      (* ; "Edited 15-Apr-88 15:06 by ckj")

    (PROG NIL
          
          (* ;; "This function returns a list in the format CHANGE.MANY.ARS uses.  This list is composed of lists in this form (AR# 'Attn: %" %").  When the list is given as an arg to CHANGE.MANY.ARS, it will delete the name in the Attn: field of each AR in AR-NUM-LIST.")

          (RETURN (FOR X IN AR-NUM-LIST COLLECT (LIST X 'Attn%: " "])

(AR-MAKE-LIST
  [LAMBDA (AR-NUM-LIST AR-FIELD-NAME AR-FIELD-VALUE)         (* ; "Edited 15-Apr-88 15:10 by ckj")

    (PROG NIL
          
          (* ;; "This function, given a list of AR numbers, an AR field, and a new value for the AR field, will return a list of lists in the form CHANGE.MANY.ARS expects (AR# ARField Value).  This will allow to user to change the value of one field in many ARs.")

          (RETURN (FOR X IN AR-NUM-LIST COLLECT (LIST X AR-FIELD-NAME AR-FIELD-VALUE])

(AR.ACC.FILE.CREATE
  [LAMBDA (FIELDNAME NUM.VAL.PLIST)                          (* mjs " 2-May-84 16:01")
    (PROG ((NUM.PTR.LEN.ASSOC NIL)
           (ACC.STREAM (OPENSTREAM (PACKFILENAME 'NAME FIELDNAME 'EXTENSION 'ACC 'BODY 
                                          AR.ACC.FILE.DIR)
                              'OUTPUT
                              'NEW))
           DICT.BEGIN.PTR)                                   (* make sure that the numbers are in 
                                                             order)
          (SORT NUM.VAL.PLIST T)                             (* make sure that there are no 
                                                             duplicates)
          (for X on NUM.VAL.ASSOC when (EQP (CAAR X)
                                            (CAADR X)) do (ERROR "duplicate nums on list!"))
          [for X in NUM.VAL.ASSOC bind PTR when (CADR X)
             do (SETQ PTR (GETFILEPTR ACC.STREAM))
                (PRIN1 (CADR X)
                       ACC.STREAM)
                (push NUM.PTR.LEN.ASSOC (CONS (CAR X)
                                              PTR
                                              (IDIFFERENCE (GETFILEPTR ACC.STREAM)
                                                     PTR]
          (DREVERSE NUM.PTR.LEN.ASSOC)
          (SETQ DICT.BEGIN.PTR (GETFILEPTR ACC.STREAM))
          (for X in NUM.PTR.LEN.ASSOC do (AR.WOUT (CAR X)
                                                ACC.STREAM)
                                         (AR.WOUT (CADR X)
                                                ACC.STREAM)
                                         (AR.WOUT (CADDR X)
                                                ACC.STREAM))
          (AR.WOUT DICT.BEGIN.PTR ACC.STREAM)
          (CLOSEF ACC.STREAM])

(AR.DELETE.NAME
  [LAMBDA (AR-NUM-LIST)                                      (* ; "Edited 17-Jun-88 13:51 by ckj")
          
          (* ;; "This function generates a list in the form accepted by CHANGE.MANY.ARS.  The list contains lists containing an AR number, the Attn: field name, and a blank as the value of the Attn: field.  The result  when used as an argument to CHANGE.MANY.ARS is the deletion of a name from the Attn: field, usually used when an AR has been closed.")

    (LET (X)
         (for X in AR-NUM-LIST collect (LIST X 'Attn%: " "])

(AR.GET.AR.PLIST
  [LAMBDA (ARSTREAM INDEX.FIELDS AS-STRINGS?)            (* ; "Edited 21-Dec-87 12:02 by jds")
          
          (* ;; "Read thru an AR file, gathering the fields listed in INDEX.FIELDS (or all fields, if that's NIL), and returns a Prop list of field-name/field-value pairs.  If AS-STRINGS? is T, the values will be strings, otherwise symbols.")
          
          (* ;; "        (Field-Name  Starting-Fileptr  Length)")

    (PROG ((INDEX NIL)
           CHARS DONE)
          [until (EOFP ARSTREAM)
             do (BLOCK)
                   (PROG [(FIELD.NAME (PACKC (bind CHAR collect (SETQ CHAR (BIN ARSTREAM))
                                                repeatuntil (EQ CHAR (CHARCODE %:]
                         (BIN ARSTREAM)                      (* ; "skip extra space after ':'")
          
          (* ;; 
    "FIELD.NAME now contains the name of the field, e.g. %"Subject:%" -- yes, including the colon.")

                         (COND
                            [(OR (NLISTP INDEX.FIELDS)
                                 (MEMB FIELD.NAME INDEX.FIELDS))
                                                             (* ; 
                                                  "Only gather fields that the caller asked about.")

                             (SETQ DONE NIL)
                             (SETQ CHARS (while (NOT DONE) bind CHAR
                                            collect 
          
          (* ;; "Copy the field's CONTENTS to the scratch file -- everything up to the next CR.")

                                                  (SELCHARQ (SETQ CHAR (BIN ARSTREAM))
                                                       (%'   (* ; 
                                                          "' is used to escape special characters.")

                                                           (BLOCK)
                                                           (BIN ARSTREAM))
                                                       (CR   (* ; 
                                                   "There best be TWO CR's at the end of the field")

                                                           (OR (EQ (BIN ARSTREAM)
                                                                   (CHARCODE CR))
                                                               (ERROR!))
                                                           (SETQ DONE T)
                                                           NIL)
                                                       CHAR)))
          
          (* ;; "INDEX is a list of entries like (FieldName StartingLoc Length) for each field.")

                             (push INDEX (LIST FIELD.NAME (COND
                                                                 (AS-STRINGS? (CONCATCODES
                                                                               (DREMOVE NIL CHARS)))
                                                                 (T (PACKC (DREMOVE NIL CHARS]
                            (T                               (* ; 
                                          "Otherwise, skip over this field -- it's of no interest.")

                               (bind CHAR
                                  do (SELCHARQ (SETQ CHAR (BIN ARSTREAM))
                                              (%' (BLOCK)
                                                  (BIN ARSTREAM))
                                              (CR (RETURN (OR (EQ (BIN ARSTREAM)
                                                                  (CHARCODE CR))
                                                              (ERROR!))))
                                              CHAR]
          (RETURN INDEX])

(AR.GET.PLIST
  [LAMBDA (ARLIST ITEMS AS-STRINGS?)                     (* ; "Edited 21-Dec-87 12:13 by jds")
          
          (* ;; "Read ITEMS about each AR in ARLIST.  RETURN a list  of (AR# .items)...")

    (LET (LOAD.ERROR FILE ARSTREAM INFO)
         (for NUM/OR/FILE in ARLIST collect [SETQ FILE (COND
                                                                      ((NUMBERP NUM/OR/FILE)
                                                                       (AR.GET.FILENAME NUM/OR/FILE 
                                                                              NIL))
                                                                      (T (FULLNAME NUM/OR/FILE] 
                                                             (* ; 
                                                           "The file to be loading the AR from")

                                                  (SETQ ARSTREAM (OPENSTREAM FILE 'INPUT 'OLD))
                                                  (SETQ INFO (AR.GET.AR.PLIST ARSTREAM ITEMS 
                                                                    AS-STRINGS?))
                                                  (COND
                                                     ((AND ARSTREAM (OPENP ARSTREAM))
                                                      (CLOSEF ARSTREAM)))
                                                  (CONS NUM/OR/FILE
                                                        (for ITEMNAME in ITEMS
                                                           collect (CADR (ASSOC ITEMNAME INFO])

(EZ.MANY.CHANGES
  [LAMBDA (AR-NUM-LIST FIELD1 FIELD1-VALUE FIELD2 FIELD2-VALUE)
                                                             (* ; "Edited 17-Jun-88 14:02 by ckj")
          
          (* ;; "This function generates a list in the form accepted by CHANGE.MANY.ARS.  This list will contain lists consisting of a number, the field name , the value to be put into the specified field, another field name , and the value to be put into that field.")

    (LET (X)
         (for X in AR-NUM-LIST collect (LIST X FIELD1 FIELD1-VALUE FIELD2 FIELD2-VALUE])
)



(* ;; "FN for finding ARs edited before a given date:")

(DEFINEQ

(LAST-CHANGED-BEFORE
  [LAMBDA (ARLIST DATE-STRING)                           (* ; "Edited 21-Dec-87 12:16 by jds")
          
          (* ;; "Given a list of AR numbers, ARLIST, returns a list of those ARs that were last edited before the date specified in DATE-STRING (which must be acceptable to IDATE).")

    (LET ((DATE (IDATE DATE-STRING))
          RESULT EDIT-DATE SUBMIT-DATE)
         [for AR in ARLIST do (SETQ EDIT-DATE (AR.GET.PLIST (LIST AR)
                                                                 '(Edit-Date%: Date%:) T))
                                         (SETQ SUBMIT-DATE (CADDAR EDIT-DATE))
                                         (SETQ EDIT-DATE (CADAR EDIT-DATE))
                                         (COND
                                            ((STRING-EQUAL "" EDIT-DATE)
                                             (SETQ EDIT-DATE SUBMIT-DATE)))
                                         (COND
                                            ((ILEQ (IDATE EDIT-DATE)
                                                   DATE)
                                             (push RESULT AR]
         RESULT])
)



(* ; "Grab the test cases for ARs where there is one.")

(DEFINEQ

(NAB.TEST.CASES
  [LAMBDA (FIELD-TO-GET WAIT-UNTIL)                          (* ; "Edited  5-Feb-88 19:41 by ckj")

    (PROG (QFORM ARFORM ARMENU NUMS)
          (printout T "select query form window" T)
          (SETQ QFORM (WHICHW (GETPOSITION)))
          (printout T "select AR form" T)
          (SETQ ARFORM (WHICHW (GETPOSITION)))
          (printout T "select AR form menu" T)
          (SETQ ARMENU (WHICHW (GETPOSITION)))
          [AR.INDEX.DATA.CONTEXT QFORM (SETQ NUMS (for ALIST in (WINDOWPROP QFORM 'AR.ENTRY.ALIST)
                                                     collect (AR.GET.ENTRY.NUM (CAR ALIST]
          (printout T "will examine AR numbers: " NUMS T T)
          (for NUM in NUMS do (AR.FORM.MENU.ACTIONFN ARMENU 'Get NUM)
                              (SETQ FIELD-TO-GET-TEXT (AR.GET.BUTTON.FIELD.AS.TEXT ARFORM 
                                                             FIELD-TO-GET))
                              (if (NOT (EQP (NCHARS FIELD-TO-GET-TEXT)
                                            0))
                                  then (printout T NUM %,,, (AR.GET.BUTTON.FIELD.AS.TEXT ARFORM
                                                                   'Subject%:)
                                              T
                                              'System%: %, (AR.GET.BUTTON.FIELD.AS.TEXT ARFORM
                                                                  'System%:)
                                              %,,,
                                              'Subsystem%: %, (AR.GET.BUTTON.FIELD.AS.TEXT
                                                               ARFORM
                                                               'Subsystem%:)
                                              T FIELD-TO-GET %,,, FIELD-TO-GET-TEXT T T])
)



(* ; "For getting all the AR numbers from a Query window for use in lisp:")

(DEFINEQ

(GET.NUMS.FROM.QUERY
  [LAMBDA NIL                                                (* ; "Edited 28-Jan-87 21:55 by jrb:")
          
          (* ;; "Gather the AR numbers listed in a query window, and return a list of them.  Useful for getting AR numbers into Lisp for further processing.")

    (PROG (QFORM NUMS)
          (printout T "select query form window" T)
          (SETQ QFORM (WHICHW (GETPOSITION)))
          [AR.INDEX.DATA.CONTEXT QFORM (SETQ NUMS (for ALIST in (WINDOWPROP QFORM 'AR.ENTRY.ALIST)
                                                     collect (AR.GET.ENTRY.NUM (CAR ALIST]
          (RETURN NUMS])
)



(* ;; "For making an IP file from a TXT file that was generated using a Query window:")

(DEFINEQ

(LANDSCAPE.QUERY.WINDOW
  [LAMBDA (LOCALTXTFILE LOCALIPFILE)                         (* edited%: "29-Oct-86 15:48")
          
          (* This function takes the names of two files.
          LOCALTXTFILE is the file which has been created by PRINTing to a Print File in 
          a query window. LOCALIPFILE is the file that you want to be created with 
          landscaping.)

    (PROG (TXT IP)
          (SETQ TXT (OPENSTREAM LOCALTXTFILE 'INPUT 'OLD))
          [SETQ IP (OPENIMAGESTREAM LOCALIPFILE 'INTERPRESS '(LANDSCAPE T]
          (DSPFONT '(TERMINAL 6) IP)
          (for I from 1 to (GETFILEINFO TXT 'LENGTH) do (\OUTCHAR IP (\BIN TXT)))
          (CLOSEF IP)
          (CLOSEF TXT])
)



(* ;; "For nabbing AR information")

(DEFINEQ

(AR.GET.SUBMITS.FROM.TDS
  [LAMBDA (FILENAME)                                         (* ; "Edited 23-Apr-87 07:20 by jds")
          
          (* ;; "Gather the list of ARs that have been submitted from the %"Tool Driver Script%" file, where AREDIT makes note of edits that people make.")

    (PROG ((FILE (OPENSTREAM FILENAME 'INPUT 'OLD))
           (*READTABLE* FILERDTBL)
           NUMBERS)
          [SETQ NUMBERS (while (FILEPOS "  --  (" FILE NIL NIL NIL T) bind NUM?
                           when (EQ 'SUBMIT (READ FILE)) collect (LIST (READ FILE)
                                                                       (READ FILE]
          (CLOSEF FILE)
          (RETURN NUMBERS])

(AR.GET.FIXES.FROM.TDS
  [LAMBDA (FILENAME)                                         (* ; "Edited 23-Apr-87 07:56 by jds")
          
          (* ;; "Gather the list of ARs that have changed from the %"Tool Driver Script%" file, where AREDIT makes note of edits that people make.")

    (LET ((FILE (OPENSTREAM FILENAME 'INPUT 'OLD))
          (*READTABLE* FILERDTBL)
          NUMBERS STATUS EDINF)
         (SETFILEPTR FILE 0)
         (SETQ NUMBERS (while (FILEPOS "  --  (" FILE NIL NIL NIL T)
                          when (AND [EQ 'EDIT (CAR (SETQ EDINF (PROGN (\BACKFILEPTR FILE)
                                                                      (READ FILE]
                                    (MEMBER 'Status%: (CADDR EDINF))
                                    (OR [STRPOS "->Fixed" (SETQ STATUS (CAR (LISTGET1 (CADDR EDINF)
                                                                                   'Status%:]
                                        (STRPOS "->Declined" STATUS)
                                        (STRPOS "->Superseded" STATUS)
                                        (STRPOS "->Obsolete" STATUS))) collect EDINF))
         (CLOSEF FILE)
         NUMBERS])

(COLLECT-FIXES
  [LAMBDA NIL                                                (* ; "Edited 23-Apr-87 07:22 by jds")

    (for FILE in (DIRECTORY '{ERIS}<LISPARS>*.TDS-PROCESSED) join (AR.GET.FIXES.FROM.TDS FILE])

(COLLECT-SUBMISSIONS
  [LAMBDA NIL                                                (* ; "Edited 23-Apr-87 07:21 by jds")

    (for FILE in (DIRECTORY '{ERIS}<LISPARS>*.TDS-PROCESSED) join (AR.GET.SUBMITS.FROM.TDS FILE])

(COUNT-BY-WEEK
  [LAMBDA NIL                                                (* ; "Edited 23-Apr-87 14:17 by jds")

    (LET
     ((SUBMITS BETASUBMITS)
      (FIXES BETAFIXES)
      (WASFIXED (SORT SUBMITTEDFIXED))
      SUB FIX SUBFIX SD)
     (for START from (IDATE "2-FEB-87 00:00:00") by 604800 as END from (IDATE "9-FEB-87 00:00:00")
        by 604800 while (OR SUBMITS FIXES)
        do (PRINTOUT T T T "Week of " (GDATE START)
                  " - "
                  (GDATE END)
                  T T)
           [SETQ SUB
            (bind AR
               while [AND SUBMITS (IGEQ END (IDATE (CONCAT (CAR (NTH (CADR (SETQ AR (CAR SUBMITS)))
                                                                     (IDIFFERENCE (LENGTH
                                                                                   (CADR AR))
                                                                            1)))
                                                          " 00:00"] collect (CAR (pop SUBMITS]
           [SETQ FIX (bind AR while [AND FIXES (IGEQ END (IDATE (CONCAT [CADR (CADDR (SETQ AR
                                                                                      (CAR FIXES]
                                                                       " 00:00"]
                        collect (CADR (pop FIXES]
           (SETQ SUBFIX (for AR in SUB while WASFIXED when (COND
                                                              ((NULL WASFIXED)
                                                               NIL)
                                                              ((IEQP AR (CAR WASFIXED))
                                                               (pop WASFIXED)
                                                               T)
                                                              ((ILESSP AR (CAR WASFIXED))
                                                               NIL)
                                                              (T (HELP 
                                                 "Mismatch -- a sub-as-fixed ar never got submitted?"
                                                                       ))) collect AR))
           (PRINTOUT T "      Submitted: " |.I3| (LENGTH SUB)
                  ",	")
           (BREAKOUT-ARS-BY-TYPE SUB)
           (PRINTOUT T "Submitted&Fixed: " |.I3| (LENGTH SUBFIX)
                  ",	")
           (BREAKOUT-ARS-BY-TYPE SUBFIX)
           (PRINTOUT T "    Newly Fixed: " |.I3| (LENGTH FIX)
                  ",	")
           (BREAKOUT-ARS-BY-TYPE FIX)
           (PRINTOUT T T])

(BREAKOUT-ARS-BY-TYPE
  [LAMBDA (ARLIST)                                           (* ; "Edited 23-Apr-87 14:18 by jds")

    (bind FIXED NEW OPEN OTHER ABS HOPE FEAT PERF DOC AR DUNNO first (SETQ OTHER 0)
                                                                     (SETQ ABS 0)
                                                                     (SETQ HOPE 0)
                                                                     (SETQ FEAT 0)
                                                                     (SETQ PERF 0)
                                                                     (SETQ DOCABS 0)
                                                                     (SETQ DOCHOPE 0)
                                                                     (SETQ DOCOTHER 0)
                                                                     (SETQ DUNNO 0) for AR#
       in ARLIST do (SETQ AR (ASSOC AR# BETAINFO))
                    [COND
                       ((NULL AR)
                        (add DUNNO 1))
                       ((MEMBER 'Documentation AR)
                        (SELECTQ (CADDR AR)
                            (Absolutely (add DOCABS 1))
                            (Hopefully (add DOCHOPE 1))
                            (add DOCOTHER 1)))
                       ((MEMBER 'Feature AR)
                        (add FEAT 1))
                       ((MEMBER 'Performance AR)
                        (add PERF 1))
                       (T (SELECTQ (CADDR AR)
                              (Absolutely (add ABS 1))
                              (Hopefully (add HOPE 1))
                              (add OTHER 1]
       finally (PRINTOUT T "BUGS:  Abs: " |.I3| ABS "   Hope: " |.I3| HOPE "   Other: " |.I3| OTHER 
                      "  || DOC: Abs: " |.I3| DOCABS "   Hope: " |.I3| DOCHOPE "   Other: " |.I3| 
                      DOCOTHER "  || Features: " |.I3| FEAT "   Perf: " PERF
                      (COND
                         ((ZEROP DUNNO)
                          "")
                         (T (CONCAT "   Can't Tell: " DUNNO)))
                      T])
)



(* ; "For hardcopying ARs")




(* ;; "The preferred function:")

(DEFINEQ

(AR.HARDCOPY
  [LAMBDA (NUMBERS)                                          (* ; "Edited 11-Mar-87 16:11 by jds")
          
          (* ;; "Hardcopy the ARs in the list NUMBERS.")

    (for ARN inside NUMBERS bind (FIRSTTIME ← T)
                                 (TEXTSTREAM ← (OPENSTREAM '{NODIRCORE} 'BOTH))
                                 (BOLD ← (LIST 'FONT ARBOLDFONT))
                                 (WIDTH ← 468)
                                 HEADINGS TABS N BOD
       do [RESETLST (PROG ([ARSTREAM (NLSETQ (OPENSTREAM (AR.FILENAME ARN)
                                                    'INPUT
                                                    'OLD]
                           THESETABS)
                          (COND
                             ((NULL ARSTREAM)
                              (printout T "(Couldn't read AR#" |.I1| ARN ")" T)
                              (RETURN)))
                          [RESETSAVE NIL (LIST 'CLOSEF (SETQ ARSTREAM (CAR ARSTREAM]
                          (SETFILEINFO ARSTREAM 'BUFFERS (IQUOTIENT (IPLUS 511 (GETEOFPTR ARSTREAM))
                                                                512))
                                                             (* ; 
                                              "Buffer whole file, since we're going to read it twice")
                          (SETQ INFO (AR.PARSE ARSTREAM))
                          [COND
                             (FIRSTTIME (SETQ FIRSTTIME NIL))
                             (T                              (* ; "Separate AR's with pagemark")
                                (BOUT TEXTSTREAM (CHARCODE FF]
                          (for ME in AR.HARDCOPY.MAP
                             do [push HEADINGS (LIST (ADD1 (GETFILEPTR TEXTSTREAM))
                                                     (NCHARS (CAR ME]
                                (PRIN3 (CAR ME)
                                       TEXTSTREAM)
                                (COND
                                   ((SETQ BOD (CADR (ASSOC (CAR ME)
                                                           INFO)))
                                    (PRIN3 BOD TEXTSTREAM)))
                                (COND
                                   ((EQ T (CADR ME))         (* ; "Staying on same line")
                                    (push THESETABS (ADD1 (GETFILEPTR TEXTSTREAM)))
                                    (BOUT TEXTSTREAM (CHARCODE TAB)))
                                   (T (COND
                                         (THESETABS (push TABS THESETABS)
                                                (SETQ THESETABS)))
                                      (for I from 1 to (OR (CADR ME)
                                                           1) do (BOUT TEXTSTREAM (CHARCODE CR]
       finally (SETQ TEXTSTREAM (OPENTEXTSTREAM TEXTSTREAM NIL NIL NIL (LIST 'FONT ARFONT)))
             (for HEAD in HEADINGS do (TEDIT.LOOKS TEXTSTREAM BOLD (CAR HEAD)
                                             (CADR HEAD)))
             (for TB in TABS
                do                                           (* ; "Set tabstops for multifields")
                   (SETQ N (ADD1 (LENGTH TB)))
                   (TEDIT.PARALOOKS TEXTSTREAM
                          [LIST 'TABS (CONS NIL (for I from 1 to (SUB1 N)
                                                   collect (CONS (ITIMES I (IQUOTIENT WIDTH N))
                                                                 'LEFT]
                          (CAR TB)
                          1))
             (TEDIT.PARALOOKS TEXTSTREAM (LIST 'PARALEADING ARPARALEADING)
                    1
                    (GETEOFPTR TEXTSTREAM))
             (TEDIT.HARDCOPY TEXTSTREAM NIL NIL (COND
                                                   ((NLISTP NUMBERS)
                                                    (CONCAT "AR#" NUMBERS))
                                                   (T "Selected ARs"])
)



(* ;; "Controls how the ARs print with AR.HARDCOPY.  It's a list of lists:")




(* ;; "(field-name same-line/CR-count)")




(* ;; 
"where field-name is an AR field name, and same-line/CR-count is T if the next item will still be on this line, or a # of CRs to insert (1 if it's NIL)."
)


(RPAQQ AR.HARDCOPY.MAP ((Number%: T)
                        (Date%:)
                        (Submitter%: T)
                        (Source%: 2)
                        (Subject%: 2)
                        (|Assigned To:| T)
                        (Attn%: 2)
                        (Status%: T)
                        (In/By%:)
                        (|Problem Type:| T)
                        (Impact%:)
                        (Difficulty%: T)
                        (Priority%:)
                        (Frequency%: 2)
                        (System%: T)
                        (Subsystem%: 2)
                        (Machine%: T)
                        (Disk%:)
                        (|Lisp Version:| T)
                        (|Source Files:|)
                        (|Microcode Version:| T)
                        (|Memory Size:|)
                        (|File Server:| T)
                        (|Server Software Version:| 2)
                        (Disposition%: 2)
                        (|Release Note:| 2)
                        (Description%: 2)
                        (Workaround%: 2)
                        (|Test Case:| 2)
                        (Edit-By%: T)
                        (Edit-Date%:)))



(* ;; "The less-convenient versions:")

(DEFINEQ

(HARDCOPY.ARS
  [LAMBDA (NUMS)                                             (* mjs "20-Mar-86 14:15")
    (for NUM in NUMS as CNT from 1 bind ARFORM ARMENU first (PROGN (printout T "select AR form" T)
                                                                   (SETQ ARFORM (WHICHW (GETPOSITION)
                                                                                       ))
                                                                   (printout T "select AR form menu" 
                                                                          T)
                                                                   (SETQ ARMENU (WHICHW (GETPOSITION)
                                                                                       ))
                                                                   (SETQ BAD.ARS NIL))
       do (printout T "printout AR " NUM "    (" CNT "/" (LENGTH NUMS)
                 ")" T)
          (if (NLSETQ (PROGN (AR.FORM.MENU.ACTIONFN ARMENU 'Get NUM)
                             NIL))
              then (TEDIT.HARDCOPY ARFORM)
            else (printout T "error reading AR!!!" T)
                 (push BAD.ARS NUM])

(MAKEPRESS.ARS
  [LAMBDA (NUMS)                                             (* edited%: " 1-May-85 17:02")
    (for NUM in NUMS as CNT from 1 bind PFILE ARFORM ARMENU first (PROGN (printout T "select AR form" 
                                                                                T)
                                                                         (SETQ ARFORM (WHICHW (
                                                                                          GETPOSITION
                                                                                               )))
                                                                         (printout T 
                                                                                "select AR form menu" 
                                                                                T)
                                                                         (SETQ ARMENU (WHICHW (
                                                                                          GETPOSITION
                                                                                               )))
                                                                         (SETQ PFILE
                                                                          (OPENIMAGESTREAM
                                                                           '{DSK}ARS.PRESS
                                                                           'PRESS))
                                                                         (SETQ BAD.ARS NIL))
       do [if (EQP (IMOD CNT 50)
                   0)
              then (printout T "closing file and restarting new version" T)
                   (CLOSEF PFILE)
                   (SETQ PFILE (OPENIMAGESTREAM '{DSK}ARS.PRESS 'PRESS]
          (printout T "printout AR " NUM "    (" CNT "/" (LENGTH NUMS)
                 ")" T)
          (if (NLSETQ (PROGN (AR.FORM.MENU.ACTIONFN ARMENU 'Get NUM)
                             NIL))
              then (TEDIT.HARDCOPY ARFORM PFILE T)
                   (PRIN1 (CHARACTER (CHARCODE FF))
                          PFILE)
            else (printout T "error reading AR!!!" T)
                 (push BAD.ARS NUM)) finally (CLOSEF PFILE])
)



(* ;; "For IP-file making from the text file a query gives you:")

(DEFINEQ

(AR.IP.FILE
  [LAMBDA (TEXT-FILE-FOR-SUMMARY)                        (* ; "Edited  5-Jan-88 14:30 by jds")
          
          (* ;; "Given the text file containing a summary, create the corresponding IP file, landscape & in 6 point Terminal.")

    (PROG (TXT IP)
          (SETQ TXT (OPENSTREAM TEXT-FILE-FOR-SUMMARY 'INPUT 'OLD))
          [SETQ IP (OPENIMAGESTREAM (PACKFILENAME.STRING 'EXTENSION "IP" 'VERSION NIL 'BODY 
                                           TEXT-FILE-FOR-SUMMARY)
                          'INTERPRESS
                          '(LANDSCAPE T]
          (DSPFONT '(TERMINAL 6) IP)
          (for I from 1 to (GETFILEINFO TXT 'LENGTH) do (\OUTCHAR IP (\BIN TXT)))
          (CLOSEF IP)
          (CLOSEF TXT])
)



(* ; "Bulk changes to the AR database (fixes, closing, etc.)")




(* ;; "Function to mark lots of ARs fixed in one sweep.")

(DEFINEQ

(FIX.MANY.ARS
  [LAMBDA (ARLIST STATUS)                                    (* ; "Edited 11-Mar-87 16:00 by jds")
          
          (* ;; "ARLIST is a list of AR numbers.  Each AR on the list will be marked FIXED, or will be marked with the marking STATUS.  Also moves the ATTN field into the ASSIGNED-TO field and clears the ATTN field.")

    [AND STATUS (OR (MEMBER STATUS '(New Open Fixed Closed Declined Superseded Incomplete Obsolete 
                                         Wish]
    (for CHANGE in ARLIST as CNT from 1 bind PFILE ARFORM ARMENU NEWVALUE BAD.ARS
       first (PROGN (printout T "select AR form" T)
                    (SETQ ARFORM (WHICHW (GETPOSITION)))
                    (printout T "select AR form menu" T)
                    (SETQ ARMENU (WHICHW (GETPOSITION)))
                    (SETQ BAD.ARS NIL))
       do (printout T "Fixing " CHANGE T)
          (COND
             ((NLSETQ (PROGN (AR.FORM.MENU.ACTIONFN ARMENU 'Get CHANGE)
                             [AR.REPLACE.FILL.INS ARFORM `((Status%: ,(OR STATUS 'Fixed]
                             [COND
                                ([NOT (STRING-EQUAL "" (SETQ NEWVALUE (CL:STRING-TRIM
                                                                       '(#\Space)
                                                                       (AR.GET.BUTTON.FIELD.AS.TEXT
                                                                        ARFORM
                                                                        'Attn%:]
                                                             (* ; 
                           "Only change the ASSIGNED-TO field if the ATTN field had something in it.")
                                 (AR.REPLACE.FILL.INS ARFORM (LIST (LIST '|Assigned To:| NEWVALUE]
                             (AR.REPLACE.FILL.INS ARFORM (LIST (LIST 'Attn%: "")))
                             (AR.FORM.MENU.ACTIONFN ARMENU 'Put)
                             NIL))
              NIL)
             (T (printout T "error reading AR!!!" T)
                (push BAD.ARS CHANGE)))
          (TEDIT.STREAMCHANGEDP (TEXTSTREAM ARFORM)
                 T) finally (printout T "bad ARs: " BAD.ARS T])

(FIX.NO.RELEASE.NOTE
  [LAMBDA (ARLIST STATUS)                                    (* ; "Edited 11-Mar-87 16:00 by jds")
          
          (* ;; "ARLIST is a list of AR numbers.  Each AR on the list will be marked FIXED, and as note needing a release note..  Also moves the ATTN field into the ASSIGNED-TO field and clears the ATTN field. ")

    (SETQ STATUS 'Fixed)
    (for CHANGE INSIDE ARLIST as CNT from 1 bind PFILE ARFORM ARMENU NEWVALUE BAD.ARS
       first (PROGN (printout T "select AR form" T)
                    (SETQ ARFORM (WHICHW (GETPOSITION)))
                    (printout T "select AR form menu" T)
                    (SETQ ARMENU (WHICHW (GETPOSITION)))
                    (SETQ BAD.ARS NIL))
       do (printout T "Fixing " CHANGE T)
          (COND
             ((NLSETQ (PROGN (AR.FORM.MENU.ACTIONFN ARMENU 'Get CHANGE)
                             [AR.REPLACE.FILL.INS ARFORM `((Status%: ,(OR STATUS 'Fixed]
                             [COND
                                ([NOT (STRING-EQUAL "" (SETQ NEWVALUE (CL:STRING-TRIM
                                                                       '(#\Space)
                                                                       (AR.GET.BUTTON.FIELD.AS.TEXT
                                                                        ARFORM
                                                                        'Attn%:]
                                                             (* ; 
                           "Only change the ASSIGNED-TO field if the ATTN field had something in it.")
                                 (AR.REPLACE.FILL.INS ARFORM (LIST (LIST '|Assigned To:| NEWVALUE]
                             (AR.REPLACE.FILL.INS ARFORM (LIST (LIST 'Attn%: "")))
                             [AR.REPLACE.FILL.INS ARFORM (LIST (LIST 'Description%:
                                                                     (CONCAT (
                                                                          AR.GET.BUTTON.FIELD.AS.TEXT
                                                                              ARFORM
                                                                              'Description%:)
                                                                            
                                                             "

-----(NO RELEASE NOTE REQUIRED)-----"]
                             (AR.FORM.MENU.ACTIONFN ARMENU 'Put)
                             NIL))
              NIL)
             (T (printout T "error reading AR!!!" T)
                (push BAD.ARS CHANGE)))
          (TEDIT.STREAMCHANGEDP (TEXTSTREAM ARFORM)
                 T) finally (printout T "bad ARs: " BAD.ARS T])
)



(* ;; "Function for making changes to lots of ARs in one sweep; less convenient than above fn:")

(DEFINEQ

(CHANGE.MANY.ARS
  [LAMBDA (CHANGE.SPEC)                                      (* mjs "10-Jun-85 16:21")
                                                             (* the form of CHANGE.SPEC is a list 
                                                             like ((1 Status%: Closed Attn%: "")
                                                             (234 Attn%: Me)))
    (for CHANGE in CHANGE.SPEC as CNT from 1 bind PFILE ARFORM ARMENU
       first (PROGN (printout T "select AR form" T)
                    (SETQ ARFORM (WHICHW (GETPOSITION)))
                    (printout T "select AR form menu" T)
                    (SETQ ARMENU (WHICHW (GETPOSITION)))
                    (SETQ BAD.ARS NIL))
       do (printout T "doing change: " CHANGE "    (" CNT "/" (LENGTH CHANGE.SPEC)
                 ")" T)
          (if (NLSETQ (PROGN (AR.FORM.MENU.ACTIONFN ARMENU 'Get (CAR CHANGE))
                             [for X on (CDR CHANGE) by (CDDR X)
                                do (AR.REPLACE.FILL.INS ARFORM (LIST (LIST (CAR X)
                                                                           (CADR X]
                             (AR.FORM.MENU.ACTIONFN ARMENU 'Put)
                             NIL))
              then NIL
            else (printout T "error reading AR!!!" T)
                 (push BAD.ARS CHANGE))
          (TEDIT.STREAMCHANGEDP (TEXTSTREAM ARFORM)
                 T) finally (printout T "bad ARs: " BAD.ARS T])
)



(* ;; "Function for closing lots of ARs:")

(DEFINEQ

(CLOSE.MANY.ARS
  [LAMBDA (ARLIST)                                       (* ; "Edited 21-Dec-87 11:38 by jds")
          
          (* ;; "ARLIST is a list of AR numbers.  Each AR on the list will be marked CLOSED.")

    (DECLARE (SPECVARS AR.NO.MESSAGE.FLG))
    (LET ((AR.NO.MESSAGE.FLG T))
         (for CHANGE in ARLIST as CNT from 1 bind PFILE ARFORM ARMENU NEWVALUE 
                                                                   BAD.ARS
            first (PROGN (printout T "select AR form" T)
                             (SETQ ARFORM (WHICHW (GETPOSITION)))
                             (printout T "select AR form menu" T)
                             (SETQ ARMENU (WHICHW (GETPOSITION)))
                             (SETQ BAD.ARS NIL))
            do (printout T "Closing " CHANGE T)
                  (COND
                     ((NLSETQ (PROGN (AR.FORM.MENU.ACTIONFN ARMENU 'Get CHANGE)
                                     (COND
                                        ((STRING-EQUAL "Fixed" (AR.GET.BUTTON.FIELD.AS.TEXT
                                                                ARFORM
                                                                'Status%:))
                                         [AR.REPLACE.FILL.INS ARFORM `((Status%: Closed]
                                         (AR.FORM.MENU.ACTIONFN ARMENU 'Put))
                                        (T (PRINTOUT T "AR not Fixed first:  " CHANGE T)
                                           (push BAD.ARS CHANGE)))
                                     NIL))
                      NIL)
                     (T (printout T "error reading AR!!!" T)
                        (push BAD.ARS CHANGE)))
                  (TEDIT.STREAMCHANGEDP (TEXTSTREAM ARFORM)
                         T) finally (printout T "ARs not closed: " (COND
                                                                          (BAD.ARS)
                                                                          (T "None."))
                                               T])
)



(* ;; "Functions for counting info about ARs")

(DEFINEQ

(LIST.NUM.STATUS.PRIORITY
  [LAMBDA (ARLIST FIELDS)                                    (* ; "Edited 21-Apr-87 19:50 by jds")
          
          (* ;; "ARLIST is a list of AR numbers.  Returns a list of entries of the form (# fieldValue fieldValue ...). where each field is one of the names in FIELDS.")

    (for AR inside ARLIST bind PFILE ARFORM ARMENU NEWVALUE BAD.ARS STATUS PRIORITY
       first (PROGN (printout T "select AR form" T)
                    (SETQ ARFORM (WHICHW (GETPOSITION)))
                    (printout T "select AR form menu" T)
                    (SETQ ARMENU (WHICHW (GETPOSITION)))
                    (SETQ BAD.ARS NIL))
       collect (AR.FORM.MENU.ACTIONFN ARMENU 'Get AR)
             (CONS AR (for FIELD in (OR FIELDS '(Status%: Priority%: |Problem Type:| System%: 
                                                       Subsystem%:)) collect (
                                                                          AR.GET.BUTTON.FIELD.AS.TEXT
                                                                              ARFORM FIELD])

(COUNT-ARS
  [LAMBDA (ARLIST)                                           (* ; "Edited 23-Apr-87 08:10 by jds")

    (PRINTOUT T T T "For Documentation:" T T)
    (bind FIXED NEW OPEN OTHER ABS HOPE F/A F/H F/O O/A O/H O/O first (SETQ FIXED 0)
                                                                      (SETQ NEW 0)
                                                                      (SETQ OPEN 0)
                                                                      (SETQ OTHER 0)
                                                                      (SETQ ABS 0)
                                                                      (SETQ HOPE 0)
                                                                      (SETQ F/A 0)
                                                                      (SETQ F/H 0)
                                                                      (SETQ F/O 0)
                                                                      (SETQ O/A 0)
                                                                      (SETQ O/H 0)
                                                                      (SETQ O/O 0) for AR
       in ARLIST when (MEMBER 'Documentation AR) do (SELECTQ (CADR AR)
                                                        ((New Open) 
                                                             (add NEW 1)
                                                             (SELECTQ (CADDR AR)
                                                                 (Absolutely (add ABS 1)
                                                                             (add O/A 1))
                                                                 (Hopefully (add HOPE 1)
                                                                            (add O/H 1))
                                                                 (PROGN (add OTHER 1)
                                                                        (add O/O 1))))
                                                        ((Fixed Declined Obsolete Incomplete 
                                                                Superseded) 
                                                             (add FIXED 1)
                                                             (SELECTQ (CADDR AR)
                                                                 (Absolutely (add ABS 1)
                                                                             (add F/A 1))
                                                                 (Hopefully (add HOPE 1)
                                                                            (add F/H 1))
                                                                 (PROGN (add OTHER 1)
                                                                        (add F/O 1))))
                                                        (SELECTQ (CADDR AR)
                                                            (Absolutely (add ABS 1))
                                                            (Hopefully (add HOPE 1))
                                                            (add OTHER 1)))
       finally (PRINTOUT T "      NEW     FIXED" T "ABS  " O/A "     " F/A T "HOPE " O/H "     " F/H 
                      T "OTHR " O/O "     " F/O T T))
          
          (* ;; "Now FEATURES")

    (PRINTOUT T T T T "For FEATURES:" T T)
    (bind FIXED NEW OPEN OTHER ABS HOPE F/A F/H F/O O/A O/H O/O first (SETQ FIXED 0)
                                                                      (SETQ NEW 0)
                                                                      (SETQ OPEN 0)
                                                                      (SETQ OTHER 0)
                                                                      (SETQ ABS 0)
                                                                      (SETQ HOPE 0)
                                                                      (SETQ F/A 0)
                                                                      (SETQ F/H 0)
                                                                      (SETQ F/O 0)
                                                                      (SETQ O/A 0)
                                                                      (SETQ O/H 0)
                                                                      (SETQ O/O 0) for AR
       in ARLIST when (EQ 'Feature (CL:FOURTH AR))
       do (SELECTQ (CADR AR)
              ((New Open) 
                   (add NEW 1)
                   (SELECTQ (CADDR AR)
                       (Absolutely (add ABS 1)
                                   (add O/A 1))
                       (Hopefully (add HOPE 1)
                                  (add O/H 1))
                       (PROGN (add OTHER 1)
                              (add O/O 1))))
              ((Fixed Declined Obsolete Incomplete Superseded) 
                   (add FIXED 1)
                   (SELECTQ (CADDR AR)
                       (Absolutely (add ABS 1)
                                   (add F/A 1))
                       (Hopefully (add HOPE 1)
                                  (add F/H 1))
                       (PROGN (add OTHER 1)
                              (add F/O 1))))
              (SELECTQ (CADDR AR)
                  (Absolutely (add ABS 1))
                  (Hopefully (add HOPE 1))
                  (add OTHER 1)))
       finally (PRINTOUT T "      NEW     FIXED" T "ABS  " O/A "     " F/A T "HOPE " O/H "     " F/H 
                      T "OTHR " O/O "     " F/O T T))
          
          (* ;; "Now real bugs")

    (PRINTOUT T T T T "Now performance problems: " T T)
    (bind FIXED NEW OPEN OTHER ABS HOPE F/A F/H F/O O/A O/H O/O first (SETQ FIXED 0)
                                                                      (SETQ NEW 0)
                                                                      (SETQ OPEN 0)
                                                                      (SETQ OTHER 0)
                                                                      (SETQ ABS 0)
                                                                      (SETQ HOPE 0)
                                                                      (SETQ F/A 0)
                                                                      (SETQ F/H 0)
                                                                      (SETQ F/O 0)
                                                                      (SETQ O/A 0)
                                                                      (SETQ O/H 0)
                                                                      (SETQ O/O 0) for AR
       in ARLIST when (EQ 'Performance (CL:FOURTH AR))
       do (SELECTQ (CADR AR)
              ((New Open) 
                   (add NEW 1)
                   (SELECTQ (CADDR AR)
                       (Absolutely (add ABS 1)
                                   (add O/A 1))
                       (Hopefully (add HOPE 1)
                                  (add O/H 1))
                       (PROGN (add OTHER 1)
                              (add O/O 1))))
              ((Fixed Declined Obsolete Incomplete Superseded) 
                   (add FIXED 1)
                   (SELECTQ (CADDR AR)
                       (Absolutely (add ABS 1)
                                   (add F/A 1))
                       (Hopefully (add HOPE 1)
                                  (add F/H 1))
                       (PROGN (add OTHER 1)
                              (add F/O 1))))
              (SELECTQ (CADDR AR)
                  (Absolutely (add ABS 1))
                  (Hopefully (add HOPE 1))
                  (add OTHER 1)))
       finally (PRINTOUT T "      NEW     FIXED" T "ABS  " O/A "     " F/A T "HOPE " O/H "     " F/H 
                      T "OTHR " O/O "     " F/O T T))
          
          (* ;; "Now real bugs")

    (PRINTOUT T T T T " And bugs: " T T)
    (bind FIXED NEW OPEN OTHER ABS HOPE F/A F/H F/O O/A O/H O/O first (SETQ FIXED 0)
                                                                      (SETQ NEW 0)
                                                                      (SETQ OPEN 0)
                                                                      (SETQ OTHER 0)
                                                                      (SETQ ABS 0)
                                                                      (SETQ HOPE 0)
                                                                      (SETQ F/A 0)
                                                                      (SETQ F/H 0)
                                                                      (SETQ F/O 0)
                                                                      (SETQ O/A 0)
                                                                      (SETQ O/H 0)
                                                                      (SETQ O/O 0) for AR
       in ARLIST when [NOT (OR (MEMBER 'Documentation AR)
                               (EQ 'Feature (CL:FOURTH AR))
                               (EQ 'Performance (CL:FOURTH AR]
       do (SELECTQ (CADR AR)
              ((New Open) 
                   (add NEW 1)
                   (SELECTQ (CADDR AR)
                       (Absolutely (add ABS 1)
                                   (add O/A 1))
                       (Hopefully (add HOPE 1)
                                  (add O/H 1))
                       (PROGN (add OTHER 1)
                              (add O/O 1))))
              ((Fixed Declined Obsolete Incomplete Superseded) 
                   (add FIXED 1)
                   (SELECTQ (CADDR AR)
                       (Absolutely (add ABS 1)
                                   (add F/A 1))
                       (Hopefully (add HOPE 1)
                                  (add F/H 1))
                       (PROGN (add OTHER 1)
                              (add F/O 1))))
              (SELECTQ (CADDR AR)
                  (Absolutely (add ABS 1))
                  (Hopefully (add HOPE 1))
                  (add OTHER 1)))
       finally (PRINTOUT T "      NEW     FIXED" T "ABS  " O/A "     " F/A T "HOPE " O/H "     " F/H 
                      T "OTHR " O/O "     " F/O T T])
)



(* ;; "Functions for making a summary of all feature requests or hopefully-type ARs.")

(DEFINEQ

(FEATURE.SUMMARY
  [LAMBDA (INDEX-WINDOW SUMMARY.LOCAL.DIR)                   (* ; "Edited 21-May-87 11:52 by jds")

(* ;;; "Make a summary of all extant feature-request ARs:")

    (LET [(INDEX.WINDOW (OR INDEX-WINDOW (CREATEW '(0 0 200 100]
         (COND
            ((NOT INDEX-WINDOW)                              (* ; 
                                                      "If no INDEX-WINDOW was given, create our own.")

             (AR.QFORM.CREATE NIL INDEX.WINDOW T)))
         [AR.QUERY INDEX.WINDOW '(AND (OR (Status%: IS Open)
                                          (Status%: IS New))
                                      (|Problem Type:| IS Feature)
                                      (NOT (OR (System%: IS LOOPS)
                                               (System%: IS PCE)
                                               (System%: IS PROLOG)
                                               (System%: IS BusMaster)
                                               (Subsystem%: IS DEI]
         (AR.SORT INDEX.WINDOW '(System%: Subsystem%: Priority%:))
         (AR.PRINT.AND.IP.FILE INDEX.WINDOW 'FeatureSummary (OR SUMMARY.LOCAL.DIR '{DSK6})
                T)
         (COND
            ((NOT INDEX-WINDOW)                              (* ; 
                                           "If no INDEX-WINDOW was given, close the one we created..")

             (CLOSEW INDEX.WINDOW])

(HOPE.SUMMARY
  [LAMBDA (INDEX-WINDOW SUMMARY.LOCAL.DIR FIELDS-TO-PRINT)   (* ; "Edited 22-May-87 16:33 by jds")

(* ;;; "Make a summary of all Lyric Absolutely ARs:")

    (LET [(INDEX.WINDOW (OR INDEX-WINDOW (CREATEW '(0 0 200 100]
         (COND
            ((NOT INDEX-WINDOW)                              (* ; 
                                                      "If no INDEX-WINDOW was given, create our own.")

             (AR.QFORM.CREATE NIL INDEX.WINDOW T)))
         [AR.QUERY INDEX.WINDOW '(AND (OR (Status%: IS Open)
                                          (Status%: IS New))
                                      (Priority%: IS Hopefully)
                                      (NOT (OR (|Problem Type:| IS Feature)
                                               (|Problem Type:| IS Documentation)
                                               (System%: IS LOOPS)
                                               (System%: IS PCE)
                                               (System%: IS PROLOG)
                                               (System%: IS BusMaster)
                                               (Subsystem%: IS DEI]
         (AR.SORT INDEX.WINDOW '(System%: Subsystem%: Priority%:))
         (AR.PRINT.AND.IP.FILE INDEX.WINDOW 'HopeSummary (OR SUMMARY.LOCAL.DIR '{DSK6})
                T FIELDS-TO-PRINT)
         (COND
            ((NOT INDEX-WINDOW)                              (* ; 
                                           "If no INDEX-WINDOW was given, close the one we created..")

             (CLOSEW INDEX.WINDOW])

(FIXED.SUMMARY
  [LAMBDA (INDEX.WINDOW SUMMARY.LOCAL.DIR)                   (* ; "Edited 26-Feb-87 16:12 by jds")

(* ;;; "Make a summary of all ARs that are FIXED and which were edited in Feb 87")

    [AR.QUERY INDEX.WINDOW '(AND (Status%: IS Fixed)
                                 (Edit-Date%: HAS Feb-87]
    (AR.PRINT.AND.IP.FILE INDEX.WINDOW 'FixedSummary SUMMARY.LOCAL.DIR T '((Number%: 5)
                                                                           (Subject%: 60])
)



(* ;; 
"Function for making lyric relevant summaries of Absolutely bugs, and a listing of all open ARs.")

(DEFINEQ

(ABSOLUTELY.SUMMARIES
  [LAMBDA (SUMMARY.LOCAL.DIR INDIVIDUAL-SUMMARIES? INDEX-ALREADY-COPIED? THESE-NAMES-ONLY)
                                                             (* ; "Edited 10-Nov-87 12:33 by jds")

(* ;;; "Create a summary for each developer, listing the ABSOLUTELY ARs in that person's name, and an %"AllBugs%" summary of Open/New ARs.")
          
          (* ;; "If INDIVIDUAL-SUMMARIES? (or THESE-NAMES-ONLY) then produce a summary for each developer listing his/her absolutelies.  If THESE-NAMES-ONLY, then only do it for those names.")

    (LET ((LOCAL.AR.INDEX.NAME (COND
                                  (SUMMARY.LOCAL.DIR (PACK* SUMMARY.LOCAL.DIR 'AR.INDEX))
                                  (T NIL)))
          INDEX.WINDOW)
         (COND
            ((AND LOCAL.AR.INDEX.NAME (NOT INDEX-ALREADY-COPIED?))
             (printout T "copying old AR index to " LOCAL.AR.INDEX.NAME "...")
             (COPYFILE AR.INDEX.DEFAULT.FILE.NAME LOCAL.AR.INDEX.NAME)
             (printout T "done" T)))
         [SETQ INDEX.WINDOW (CREATEW '(0 0 200 100]
         (AR.QFORM.CREATE LOCAL.AR.INDEX.NAME INDEX.WINDOW T)
          
          (* ;; "Make the summary of all open/new ARs, for cleanup purposes:")

         (COND
            ((NOT THESE-NAMES-ONLY)
             [AR.QUERY INDEX.WINDOW '(AND (OR (Status%: IS Open)
                                              (Status%: IS New]
             (AR.SORT INDEX.WINDOW '(System%: Subsystem%: Status%:))
             (AR.PRINT.AND.IP.FILE INDEX.WINDOW 'AllBugsSummary SUMMARY.LOCAL.DIR T)
          
          (* ;; "Make a summary of all Lyric Absolutely ARs:")

             [AR.QUERY INDEX.WINDOW '(AND (OR (Status%: IS Open)
                                              (Status%: IS New))
                                          (Priority%: IS Absolutely)
                                          (NOT (OR (|Problem Type:| IS Feature)
                                                   (|Problem Type:| IS Documentation)
                                                   (System%: IS LOOPS)
                                                   (System%: IS PCE)
                                                   (System%: IS PROLOG)
                                                   (System%: IS BusMaster)
                                                   (Subsystem%: IS DEI]
             (AR.SORT INDEX.WINDOW '(System%: Subsystem%: Status%:))
             (AR.PRINT.AND.IP.FILE INDEX.WINDOW 'LyricAbsSummary SUMMARY.LOCAL.DIR T)))
          
          (* ;; "Make summaries for everyone:")

         [COND
            ((OR THESE-NAMES-ONLY INDIVIDUAL-SUMMARIES?)
             (for HACKER.NAME in (OR THESE-NAMES-ONLY AR.ABSOLUTELY.HACKER.NAMES) bind SEARCH.NAME
                do [SETQ SEARCH.NAME (SUBSTRING HACKER.NAME 1 (IMIN 4 (NCHARS HACKER.NAME] 
          
          (* ;; "Query on non-feature, non-doc absolutelies for this guy")

                   [AR.QUERY INDEX.WINDOW `(AND (OR (Status%: IS Open)
                                                    (Status%: IS New))
                                                (Priority%: IS Absolutely)
                                                (Attn%: HAS ,SEARCH.NAME)
                                                (NOT (OR (|Problem Type:| IS Feature)
                                                         (|Problem Type:| IS Documentation]
                   (AR.SORT INDEX.WINDOW '(System%: Subsystem%: Status%: Priority%: Impact%:)) 
          
          (* ;; "Print the summary, but don't copy it anywhere (leave it on the local summary dir)")

                   (AR.PRINT.AND.IP.FILE INDEX.WINDOW (PACK* HACKER.NAME 'Summary)
                          SUMMARY.LOCAL.DIR T) 
          
          (* ;; "Close the query window we used for this process.")
]
         (CLOSEW INDEX.WINDOW])

(ABS.SUMMARY
  [LAMBDA (INDEX-WINDOW SUMMARY.LOCAL.DIR)                   (* ; "Edited  1-Jul-87 10:27 by jds")

(* ;;; "Make a summary of all Lyric Absolutely ARs:")

    (LET [(INDEX.WINDOW (OR INDEX-WINDOW (CREATEW '(0 0 200 100]
         (COND
            ((NOT INDEX-WINDOW)                              (* ; 
                                                      "If no INDEX-WINDOW was given, create our own.")

             (AR.QFORM.CREATE NIL INDEX.WINDOW T)))
         [AR.QUERY INDEX.WINDOW '(AND (OR (Status%: IS Open)
                                          (Status%: IS New))
                                      (Priority%: IS Absolutely)
                                      (In/By%: HAS Motown)
                                      (NOT (OR (System%: IS LOOPS)
                                               (System%: IS PCE)
                                               (System%: IS PROLOG)
                                               (System%: IS BusMaster)
                                               (Subsystem%: IS DEI]
         (AR.SORT INDEX.WINDOW '(System%: Subsystem%: Status%:))
         (AR.PRINT.AND.IP.FILE INDEX.WINDOW 'LyricAbsSummary (OR SUMMARY.LOCAL.DIR '{DSK6})
                T)
         (COND
            ((NOT INDEX-WINDOW)                              (* ; 
                                           "If no INDEX-WINDOW was given, close the one we created..")

             (CLOSEW INDEX.WINDOW])
)

(RPAQ? AR.ABSOLUTELY.HACKER.NAMES 
       '(Bane Biggs Burton Charnley Cude Daniels Fischer Kelley Murage Pavel Pedersen Shih Snow Sye 
              SCPeters RMRichardson Sybalsky vanMelle Woz))



(* ;; 
"Function for caching the ar index locally, and causing all later queries to use the local cache.")


(RPAQ? LOCAL-CACHE-ORIGINAL-AR-INDEX-NAME AR.INDEX.DEFAULT.FILE.NAME)
(DEFINEQ

(CACHE-ARINDEX
  [LAMBDA (LOCALNAME)                                        (* ; "Edited  1-Jul-87 10:39 by jds")
          
          (* ;; "Copy the ar index to a LOCALNAME cache spot, and redirect the local pointers so queries operate there.")
          
          (* ;; "CAUTION:  This will cause you not to see new versions of the index, and you'll lose the cache if you reload AREDIT et al.")

    (COPYFILES LOCAL-CACHE-ORIGINAL-AR-INDEX-NAME LOCALNAME) (* ; "Copy the file")

    (SETQ AR.INDEX.DEFAULT.FILE.NAME LOCALNAME])
)
(PUTPROPS ARHACK COPYRIGHT ("Xerox Corporation" 1984 1985 1986 1987 1988))
(DECLARE%: DONTCOPY
  (FILEMAP (NIL (4654 14236 (AR-DELETE-NAME 4664 . 5176) (AR-MAKE-LIST 5178 . 5697) (AR.ACC.FILE.CREATE 
5699 . 7571) (AR.DELETE.NAME 7573 . 8155) (AR.GET.AR.PLIST 8157 . 12004) (AR.GET.PLIST 12006 . 13641) 
(EZ.MANY.CHANGES 13643 . 14234)) (14301 15501 (LAST-CHANGED-BEFORE 14311 . 15499)) (15566 17435 (
NAB.TEST.CASES 15576 . 17433)) (17520 18187 (GET.NUMS.FROM.QUERY 17530 . 18185)) (18284 19040 (
LANDSCAPE.QUERY.WINDOW 18294 . 19038)) (19085 26460 (AR.GET.SUBMITS.FROM.TDS 19095 . 19823) (
AR.GET.FIXES.FROM.TDS 19825 . 21054) (COLLECT-FIXES 21056 . 21294) (COLLECT-SUBMISSIONS 21296 . 21542)
 (COUNT-BY-WEEK 21544 . 24260) (BREAKOUT-ARS-BY-TYPE 24262 . 26458)) (26538 30669 (AR.HARDCOPY 26548
 . 30667)) (32268 35877 (HARDCOPY.ARS 32278 . 33516) (MAKEPRESS.ARS 33518 . 35875)) (35952 36732 (
AR.IP.FILE 35962 . 36730)) (36870 41912 (FIX.MANY.ARS 36880 . 39140) (FIX.NO.RELEASE.NOTE 39142 . 
41910)) (42018 43582 (CHANGE.MANY.ARS 42028 . 43580)) (43634 45757 (CLOSE.MANY.ARS 43644 . 45755)) (
45813 57654 (LIST.NUM.STATUS.PRIORITY 45823 . 46946) (COUNT-ARS 46948 . 57652)) (57750 61307 (
FEATURE.SUMMARY 57760 . 59199) (HOPE.SUMMARY 59201 . 60799) (FIXED.SUMMARY 60801 . 61305)) (61422 
66830 (ABSOLUTELY.SUMMARIES 61432 . 65341) (ABS.SUMMARY 65343 . 66828)) (67222 67790 (CACHE-ARINDEX 
67232 . 67788)))))
STOP