;;; -*- Mode: Common-Lisp; Package: User; Base: 10.; Patch-File: T -*- ;;; Reason: Add an extra line to fix description so it can now be 5-80 character lines long ;;; 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) 1989 Texas Instruments Incorporated. ;;; All rights reserved. ;;; Written 03/14/89 08:48:40 by SILLS, ;;; while running on URSA from band LODC ;;; With Experimental SYSTEM 6.0, Experimental VIRTUAL-MEMORY 6.0, Experimental EH 6.0, ;;; Experimental MAKE-SYSTEM 6.0, Experimental MICRONET 6.0, Experimental LOCAL-FILE 6.0, ;;; Experimental BASIC-PATHNAME 6.0, Experimental NETWORK-SUPPORT-COLD 6.0, Experimental BASIC-NAMESPACE 6.0, ;;; Experimental NETWORK-NAMESPACE 6.0, Experimental DISK-IO 6.0, Experimental DISK-LABEL 6.0, ;;; Experimental BASIC-FILE 6.0, Experimental MAC-PATHNAME 6.0, Experimental NETWORK-PATHNAME 6.0, ;;; Experimental COMPILER 6.0, Experimental TV 6.0, Experimental DATALINK 6.0, Experimental CHAOSNET 6.0, ;;; Experimental GC 6.0, Experimental MEMORY-AUX 6.0, Experimental NVRAM 6.0, Experimental SYSLOG 6.0, ;;; Experimental STREAMER-TAPE 6.0, Experimental CLEH 1.0, Experimental UCL 6.0, ;;; Experimental INPUT-EDITOR 6.0, Experimental METER 6.0, Experimental ZWEI 6.0, ;;; Experimental DEBUG-TOOLS 6.0, Experimental NETWORK-SUPPORT 6.0, Experimental NETWORK-SERVICE 6.0, ;;; Experimental DATALINK-DISPLAYS 6.0, Experimental FONT-EDITOR 6.0, Experimental SERIAL 6.0, ;;; Experimental PRINTER 6.0, Experimental MAC-PRINTER-TYPES 6.0, Experimental PRINTER-TYPES 6.0, ;;; Experimental IMAGEN 6.0, Experimental SUGGESTIONS 6.0, Experimental MAIL-DAEMON 6.0, ;;; Experimental MAIL-READER 6.0, Experimental TELNET 6.0, Experimental VT100 6.0, ;;; Experimental NAMESPACE-EDITOR 6.0, Experimental PROFILE 6.0, Experimental VISIDOC 6.0, ;;; Experimental BUG 11.1, IP 3.41, Experimental TI-CLOS 14.20, Experimental CLX 3.0, ;;; Experimental X11M 1.11, Experimental CLUE 16.0, Experimental RPC 6.0, NFS 3.4, ;;; microcode 418, Band Name: Release 6.0 2/16 #!C ; From file UPDATE-BUG.LISP#> BUG; BUG: #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 "bug: BUG; UPDATE-BUG.#" (DEFUN analysts-comments (&optional (release-name "release_3")) "this function exposes a window which provides information about the bug and allows the analtst to enter comments on that bug." (LET ((abort-p nil) (continue nil) (command '("!release3")) command-list bug-info-list) (DECLARE (SPECIAL abort-p continue)) (reset-values) (SETQ analysts-comments "") (w:choose-variable-values (APPEND *spu-alist-for-menus* *analysts-comments-info*) :Label "Analysts Comments" :superior w:mouse-sheet :width 100 :margin-choices '("do it" ("do it and continue" (SETQ continue t)) ("abort" (SETF abort-p t))));;window (WHEN abort-p (THROW 'start (update-bug t nil) )) (WHEN (= release-number 2) (SETQ command '("!release2") release-name "release_2") ) (check-format 4) (SETQ analysts-comments (parse-description analysts-comments 240)) (SETQ bug-info-list (LIST ();; nil list is for the benifit of the dolist in the function update-bug-database (LIST (CONS "analyst_comments_1 = " (FIFTH analysts-comments)) (CONS "analyst_comments_2 = " (FOURTH analysts-comments)) (CONS "analyst_comments_3 = " (THIRD analysts-comments)) ) )) (SETQ command-list (LIST command bug-info-list)) ;;; sends a list of the form - ( (command list) (() (field names and corresponding values)) ) - to update-bug-database ;;; (IF continue (do-it-and-continue command-list release-name 4) ;;else (update-bug-database command-list nil release-name 4) );;if );;let ) )) #!C ; From file UPDATE-BUG.LISP#> BUG; PISCES: #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 "bug: BUG; UPDATE-BUG.#" (DEFUN fix-updates (&optional (release-name "release_3")) "this function exposes a window which provides information about the bug and allows the user to enter a description of the fix that was done for that bug." (LET ((abort-p nil) (continue nil) (command '("!release3")) command-list bug-info-list fix_description) (DECLARE (SPECIAL abort-p continue)) (reset-values) (SETQ fix-date (SUBSEQ (time:print-current-time nil :mm/dd/yy) 0 8)) (w:choose-variable-values (APPEND *spu-alist-for-menus* *fix-bug-info*) :Label "Update Fix" :superior w:mouse-sheet :width 100 :margin-choices '("do it" ("do it and continue" (SETQ continue t)) ("abort" (SETF abort-p t))));;window (WHEN abort-p (THROW 'start (update-bug t nil) )) (WHEN (= release-number 2) (SETQ command '("!release2") release-name "release_2") );;if (SETQ fix_description (parse-description description-of-fix)) (check-format 5) (SETQ bug-info-list (LIST (LIST (CONS "fix_date = " (LIST (FIRST (FIRST *fix-bug-info*)))) (CONS "fix_name = " (LIST (FIRST (SECOND *fix-bug-info*)))) (CONS "patch_name = " (LIST (FIRST (SECOND *fix-bug-info*)))) (CONS "fix_type = " (LIST (FIRST (THIRD *fix-bug-info*)))) (CONS "patch_number = " (LIST (FIRST (FOURTH *fix-bug-info*)))) (CONS "patch_date = " (LIST (FIRST (FIRST *fix-bug-info*)))) ) (LIST (CONS "fix_description_line_1 = " (FIFTH fix_description)) (CONS "fix_description_line_2 = " (FOURTH fix_description)) (CONS "fix_description_line_3 = " (THIRD fix_description)) (CONS "fix_description_line_4 = " (SECOND fix_description)) (CONS "fix_description_line_5 = " (FIRST fix_description)) ))) (SETQ command-list (LIST command bug-info-list)) ;;; sends a list of the form - ( (command list) ((field names and corresponding values) (fix description {consists of 4 lists}) ) - ;;; to the function ubdate-bug-database. ;;; (IF continue (do-it-and-continue command-list release-name 5) ;;else (update-bug-database command-list nil release-name 5) );;if );;let );;fix updates )) #!C ; From file UPDATE-BUG.LISP#> BUG; PISCES: #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 "bug: BUG; UPDATE-BUG.#" (DEFUN parse-description (function-description &optional (max-characters 400)) "Parses the text sent into, at most, four lines of 75 characters" (LET ((description) (space-location 0) (old-newstring-location 0)) (SETQ description (SUBSTITUTE #\space #\newline function-description)) (SETQ description (SUBSTITUTE #\space #\tab description )) (SETQ description (SUBSTITUTE #\' #\" description )) (WHEN (> (LENGTH description) max-characters) (SETQ description (SUBSEQ description 0 max-characters)));;if truncates all characters over max allowed. (SETQ function-description ()) ;the dotimes parses the fix description into, at most, 5 80 character lines. (DO ((counter 0 (+ counter 1))) ((NULL space-location) function-description) (setq space-location (POSITION #\space description :from-end t :start old-newstring-location :end (+ old-newstring-location 80))) (if (NULL space-location) (SETF function-description (cons (list (subseq description old-newstring-location)) function-description)) (progn (SETF function-description (cons (list (subseq description old-newstring-location space-location)) function-description)) (SETF old-newstring-location (+ space-location 1))))) (DO ((counter 0 (+ counter 1))) ((>= 5 (length function-description)) function-description) (setf function-description (cdr function-description))) (DOTIMES (counter (- 5 (length function-description)) function-description) (SETQ function-description (CONS '("") function-description));; );;dotimes fills empty description lines with a string instead of nil );;let );;parse-description ))