;;; -*- Mode:Common-Lisp; Package:PROFILE; Fonts:(CPTFONT HL10B TR10BI); Base:10 -*-

;;;                           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
;;;                           AUSTIN, TEXAS 78769
;;;                                 MS 2151
;;;
;;; Copyright (c) 1984- 1989 Texas Instruments Incorporated.  All Rights Reserved.

;;;
;;; GLOBAL VARIABLES
;;; 

(DEFPARAMETER *profile-frame* () "Entire Profile Frame")

(DEFPARAMETER *CLICK-HERE-MSG* "Click Here to Change") 

(DEFPARAMETER *VARIABLE-CLASSES* ()
   "List of all of the classes of profile variables.  Each element is an instance of a CLASS defstruct.") 


(DEFPARAMETER *ALLOW-ILLEGAL-CVV-TYPES-P* :WARN
   "Non-NIL if undefined CVV type keywords can be used when declaring profile variables.
If :WARN, undefined CVV types are allowed by the user is warned when the profile variable is declared.") 


(DEFPARAMETER *ALLOW-NO-DOCUMENTATION-P* :WARN
   "If NIL, it is an error to declare a profile variable that doesn't have documentation somewhere
If :WARN, the user is warned that there is no documentation for the variable.") 


(DEFPARAMETER *ALLOW-UNBOUND-SYMBOLS-P* T
   "Non-NIL if unbound variables can be declared as profile variables.(although they are ignored.") 



(DEFPARAMETER *VARIABLES-THAT-TAKE-A-LONG-TIME-TO-UPDATE* ()
   "This is the list of variables (symbols) that require more than a few seconds to
execute their set effects (eg, changhing the number of mouse doc lines).") 

(DEFVAR *EXTRA-CONSTRAINT-FUNCTIONS* ()
   "This is a list of extra constraint functions that are funcalled
by the Profile facility when variables are changed.
The first element of each sublist is the constraint function.
The rest of the list consists of the class variables in which
this constraint function must be used.")


(DEFPARAMETER *PROGRAM-NAME* "PROFILE") 


(DEFPARAMETER *PROFILE-DEFAULT-FILETYPE* (SYSTEM:LOCAL-BINARY-FILE-TYPE)
   "This is the filetype of the file written by the profile utility.") 

;;Revoved FS:USER-LOGIN-MACHINE in Profile 2.2 -dlc

(DEFPARAMETER *VARIABLES-NOT-TO-BE-DUMPED* (QUOTE NIL)
   "These are variables that should not be written to an init file.
Ideally, this list should be NIL, but there are some variables that just aren't
worth keeping for the work they entail.") 

;;;
;;; MACROS, SUBSTS, AND STRUCTURE DEFINITIONS
;;; 


(DEFSTRUCT (CLASS (:CONC-NAME CLASS-) (:CALLABLE-CONSTRUCTORS NIL) (:ALTERANT ALTER-CLASS)
	(:PREDICATE NIL) (:COPIER NIL) (:TYPE :LIST))
  "A Class (category) of profile variables."
  KEYWORD
  VARIABLE
  NAME
  DOCUMENTATION) 

;;; Get global variable binding, not local - Profile 2.2 -dlc

(DEFUN VARIABLE-CURRENT-VALUE (VARIABLE)
  "Returns the current value of the VARIABLE.  Same as SYMEVAL."
  (LET ((GET-VALUE-PROPERTY (GET VARIABLE 'GET-VALUE)))
    (IF GET-VALUE-PROPERTY
;      (TRANSL::WARNING "Make sure that the argument to eval is a common lisp form")
	 (EVAL GET-VALUE-PROPERTY)
      (SYMEVAL-GLOBALLY VARIABLE)))) 
;  (IF ((ASSQ variable *stupid-variables*)
;      (stupid-variable-real-value variable)
;      (SYMEVAL variable)))



(DEFSETF VARIABLE-CURRENT-VALUE (VARIABLE) (VALUE)
  `(PROGN
     (SET ,VARIABLE ,VALUE)
     (EVAL (GET ,VARIABLE 'SET-EFFECT))
     (variable-current-value ,variable))) 


(DEFSUBST VARIABLE-DOCUMENTATION (VARIABLE)
  "Returns the Profile documentation for this VARIABLE."
  (OR (DOCUMENTATION VARIABLE 'PROFILE-VARIABLE)
      (DOCUMENTATION VARIABLE 'VARIABLE)
     (GET VARIABLE 'ZWEI::DOCUMENTATION-PROPERTY))) 


(DEFSETF VARIABLE-DOCUMENTATION (VARIABLE) (DOC-STRING)
  `(SETF (DOCUMENTATION ,VARIABLE 'PROFILE-VARIABLE) ,DOC-STRING)) 



(DEFSUBST VARIABLE-INITIAL-VALUE (VARIABLE)
  "Returns the initial value of the VARIABLE."
  (GET VARIABLE 'VARIABLE-INIT)) 


(DEFSETF VARIABLE-INITIAL-VALUE (VARIABLE) (VALUE)
  `(setf (get ,VARIABLE 'VARIABLE-INIT) ,VALUE)) 


(DEFSUBST VARIABLE-TYPE (VARIABLE)
  "Returns the CVV list or function."
;  (DECLARE (RETURN-LIST CVV-TYPE))
  (DECLARE (:RETURN-LIST CVV-TYPE))
  (OR (GET VARIABLE 'TYPE))) 


  

(DEFSETF VARIABLE-TYPE (VARIABLE) (KEYWORD)
  `(setf (get ,VARIABLE 'TYPE)  ,KEYWORD)) 


(DEFSUBST VARIABLE-NAME (VARIABLE)
  "Returns the name of the variable."
  ;  (OR (GET variable 'variable-name)
  ;      (GET variable 'zwei:variable-name)
  ;      (symbol-pretty-name variable)))
  (FORMAT () "~S" VARIABLE)) 


(DEFSETF VARIABLE-NAME (VARIABLE) (NEW-NAME)
  `(setf (get ,VARIABLE 'VARIABLE-NAME) ,NEW-NAME)) 



(DEFSUBST VARIABLE-CLASSES (VARIABLE)
  "Returns the classes that the profile VARIABLE belongs to."
  (GET VARIABLE 'CLASSES)) 


(DEFSETF VARIABLE-CLASSES (VARIABLE) (CLASSES)
  `(SETF (GET ,VARIABLE 'CLASSES) ,CLASSES))