;;; -*- Mode: Common-Lisp; Package: User; Base: 10.; Patch-File: T -*-

;;; Reason: Fixed assign-bug to reflect the correct priority and bug-type.

;;;                           RESTRICTED RIGHTS LEGEND
;;;
;;; Use, duplication, or disclosure by the Government is subject to
;;; restrictions as set forth in subdivision (c)(1)(ii) of the Rights in
;;; Technical Data and Computer Software clause at 52.227-7013.
;;;
;;;   TEXAS INSTRUMENTS INCORPORATED      
;;;   P.O. BOX 2909, M/S 2151             
;;;   AUSTIN, TEXAS 78769                 
;;;
;;; Copyright (C) 1988 Texas Instruments Incorporated.
;;; All rights reserved.

;;; Written 08/18/88 16:11:33 by FISH,
;;; while running on DaVinci from band LOD2
;;; With SYSTEM 4.74, VIRTUAL-MEMORY 4.4, EH 4.5, MAKE-SYSTEM 4.6, MICRONET 4.5, Experimental LOCAL-FILE 4.2,
;;;  BASIC-PATHNAME 4.13, NETWORK-SUPPORT-COLD 4.1, NAMESPACE 4.23, NETWORK-NAMESPACE 4.3,
;;;  DISK-IO 4.16, DISK-LABEL 4.0, BASIC-FILE 4.13, MAC-PATHNAME 4.10, NETWORK-PATHNAME 4.1,
;;;  COMPILER 4.13, TV 4.93, DATALINK 4.16, CHAOSNET 4.19, GC 4.3, MEMORY-AUX 4.1,
;;;  NVRAM 4.6, SYSLOG 4.0, STREAMER-TAPE 4.8, UCL 4.1, INPUT-EDITOR 4.0, METER 4.3,
;;;  ZWEI 4.21, DEBUG-TOOLS 4.2, NETWORK-SUPPORT 4.6, NETWORK-SERVICE 4.0, DATALINK-DISPLAYS 4.0,
;;;  FONT-EDITOR 4.0, SERIAL 4.0, PRINTER 4.10, PRINTER-TYPES 4.5, IMAGEN 4.1, SUGGESTIONS 4.0,
;;;  MAIL-DAEMON 4.9, MAIL-READER 4.9, TELNET 4.1, VT100 4.6, NAMESPACE-EDITOR 4.5,
;;;  PROFILE 4.4, VISIDOC 4.5, IP 3.21, Experimental BUG 10.0, Experimental SEYMOUR3 2.0,
;;;  Experimental SLAP 3.12,  microcode 352, Band Name: 4.1-6/15-slap

#!C
; From file UPDATE-BUG.LISP#> BUG; VIRGO:
#10R USER#:
(COMPILER-LET ((*PACKAGE* (FIND-PACKAGE "USER"))
                          (SI:*LISP-MODE* :COMMON-LISP)
                          (*READTABLE* SYS:COMMON-LISP-READTABLE)
                          (SI:*READER-SYMBOL-SUBSTITUTIONS* SYS::*COMMON-LISP-SYMBOL-SUBSTITUTIONS*))
  (COMPILER#:PATCH-SOURCE-FILE "Sys: BUG; UPDATE-BUG.#"


(DEFUN retrieve-info (window ignore ignore new-value)
  "retrieves information about a bug given the bug number. This function is called as a side effect
      from the defparameter *spu-alist-for-menus*."
  (DECLARE (optimize (speed 3)))
  (SETQ
    submitters-name ""
    submitter-phone-number ""
    bug-description-1 ""
    assigned-database-priority ""
    assigned-database-type "")
  (COND
    (host-test-p 
     (CONDITION-CASE ()
	  (LET (report-string
		file-pathname
		(description-list '(:subject :bug-description :date))
		(variable-list '(submitters-name submitter-phone-number assigned-database-priority
						 assigned-database-type))		  
		(field-list '(:submitter-name :phone :priority-assigned :classification-assigned))
		(database-host "pisces:bug-info.reports;")
		)
	    (SETQ file-pathname (SEND (fs:parse-namestring
					(FORMAT nil "~Ap~A.dat#" database-host new-value))
				      :new-pathname
				      :version :newest))
	    (SETQ report-string (generate-string file-pathname))
	    (DOLIST (keyword field-list)
	      (SETF (SYMBOL-VALUE (FIRST variable-list))
		    (GET-NEXT-INFO-VALUE keyword report-string field-list))
	      (SETQ variable-list (CDR variable-list ))
	      );;dolist
	    (DOLIST (keyword description-list)
	    (WHEN  (OR (STRING-EQUAL bug-description-1 "")
		       (STRING-EQUAL bug-description-1 "no value supplied"))
	      (SETQ bug-description-1 (GET-NEXT-INFO-VALUE keyword report-string description-list t))))
	    );;let
       ((fs:file-lookup-error fs:file-operation-failure)
	(SETQ  submitters-name          "Information unavailable"
	       assigned-database-priority        "Information unavailable"
	       assigned-database-type            "Information unavailable"
	       submitter-phone-number   "Information unavailable"
	       bug-description-1        "Information unavailable"))
       ((net:local-network-error net:connection-closed sys:host-not-responding fs:no-file-system)
	(SETQ  submitters-name          "Information unavailable"
	       assigned-database-priority        "Information unavailable"
	       assigned-database-type            "Information unavailable"
	       submitter-phone-number   "Information unavailable"
	       bug-description-1        "Information unavailable"
	       host-test-p                 nil))
       );;condition-case
     (setq assigned-priority 
        (cond
           ((equalp assigned-database-priority "high") 'H)
           ((equalp assigned-database-priority "medium") 'M)
           ((equalp assigned-database-priority "low") 'L)
           (T 'M)))
     (setq assigned-type 
        (cond
           ((equalp assigned-database-type "Software Bug") 'B)
           ((equalp assigned-database-type "Documentation Deficiency") 'M)
           ((equalp assigned-database-type "Software Design Request") 'D)
           (T 'B)))    
     (SEND window :refresh)
     );;host-test-p
    );;cond
  )
))