home *** CD-ROM | disk | FTP | other *** search
/ BUG 15 / BUGCD1998_06.ISO / aplic / felixcad / fcaddata.z / FLX_TEST.LSP < prev    next >
Lisp/Scheme  |  1996-10-01  |  3KB  |  85 lines
  1. ;;; FLX_TEST.LSP
  2. ;;; ===============================================================
  3. ;;; (C)opyright Felix Computer Aided Technologies GmbH 1995-96
  4. ;;; Created: Jan 20, 1996 vp
  5. ;;; Changed: May 05, 1996 8:15 vp
  6. ;;; Changed: Sep 28, 1996 vp
  7. ;;; ===============================================================
  8. ;;; This file is called by F#_STUP.LSP
  9. ;;; ===============================================================
  10. ;;; ATOMS_FAMILY FUNCTIONS (for Technical Support and Testing Lisp Files)
  11. ;;; FLX_AF  - Display built-in atoms-family
  12. ;;; FLX_CAF - Current atoms-family
  13. ;;; FLX_TAF - Test atoms-family
  14. ;;; These functions are also a sample to see how to control dialogs
  15. ;;; ===============================================================
  16.  
  17. (defun FLX_AF ( / p2 lst DlgInit)
  18.   (defun DlgInit()
  19.      (if FLX$WIN95 (foreach n 
  20.        '("IDCANCEL" "IDOK" "IDHELP" "copyclip" "info" "ListBox1" "selection") 
  21.        (Dlg_TileSetFont n 2)
  22.      ))
  23.      (Dlg_TileAction "IDOK" "(Dlg_DialogDone)")
  24.      (Dlg_TileAction "copyclip" "(COPYCLIPBOARD)")
  25.      (Dlg_TileSet "info" (strcat
  26.         "LISP ATOMS (" (itoa (length FLX$ATOMS_FAMILY)) ")"
  27.      ))
  28.      (Dlg_ListSetTabstops "ListBox1" "20 40")
  29.      (Dlg_ListStart "ListBox1")(mapcar 'Dlg_ListAdd FLX$ATOMS_FAMILY)(Dlg_ListEnd)
  30.   )
  31.   (if (/= (type FLX$ATOMS_FAMILY) 'LIST)
  32.     (setq FLX$ATOMS_FAMILY (atoms-family 1))
  33.   )
  34.   (setq lst FLX$ATOMS_FAMILY)
  35.   (if (FLX_DLGDSP "flx_dlg" "TABLES" "(princ)" "(DlgInit)") (princ) )
  36.   (princ)
  37. )
  38.  
  39. (defun FLX_CAF ( / DlgInit lst CURR_ATOMS_FAMILY)
  40.    (defun DlgInit ()
  41.      (if FLX$WIN95 (foreach n 
  42.        '("IDCANCEL" "IDOK" "IDHELP" "copyclip" "info" "ListBox1" "selection") 
  43.        (Dlg_TileSetFont n 2)
  44.      ))
  45.      (Dlg_TileAction "IDOK" "(Dlg_DialogDone)")
  46.      (Dlg_TileAction "copyclip" "(COPYCLIPBOARD)")
  47.      (Dlg_TileSet "info" (strcat 
  48.         "CURRENT LISP ATOMS (" (itoa (length CURR_ATOMS_FAMILY)) ")"
  49.      ))
  50.      (Dlg_ListSetTabstops "ListBox1" "20 40")
  51.      (Dlg_ListStart "ListBox1")(mapcar 'Dlg_ListAdd CURR_ATOMS_FAMILY)(Dlg_ListEnd)
  52.    )
  53.    (setq CURR_ATOMS_FAMILY (atoms-family 1))
  54.    (setq lst CURR_ATOMS_FAMILY)
  55.    (if (FLX_DLGDSP "flx_dlg" "TABLES" "(princ)" "(DlgInit)") (princ) )
  56.    (princ)
  57. )
  58.  
  59. (defun FLX_TAF ( / DlgInit lst CURR_ATOMS_FAMILY  TEST_ATOMS_FAMILY)
  60.    (defun DlgInit ()
  61.      (if FLX$WIN95 (foreach n 
  62.        '("IDCANCEL" "IDOK" "IDHELP" "copyclip" "info" "ListBox1" "selection") 
  63.        (Dlg_TileSetFont n 2)
  64.      ))
  65.      (Dlg_TileAction "IDOK" "(Dlg_DialogDone)")
  66.      (Dlg_TileAction "copyclip" "(COPYCLIPBOARD)")
  67.      (Dlg_TileSet "info" (strcat 
  68.           "TEST LISP ATOMS (" (itoa (length TEST_ATOMS_FAMILY)) ")"
  69.      ))
  70.      (Dlg_ListSetTabstops "ListBox1" "20 40")
  71.      (Dlg_ListStart "ListBox1")(mapcar 'Dlg_ListAdd TEST_ATOMS_FAMILY)(Dlg_ListEnd)
  72.    )
  73.    (setq CURR_ATOMS_FAMILY (atoms-family 1))
  74.    (setq lst '())
  75.    (foreach n CURR_ATOMS_FAMILY (progn
  76.       (if (not (member n FLX$ATOMS_FAMILY))(setq lst (cons n lst)))
  77.    ))
  78.    (setq lst (reverse lst))
  79.    (setq TEST_ATOMS_FAMILY lst)
  80.    (if (FLX_DLGDSP "flx_dlg" "TABLES" "(princ)" "(DlgInit)") (princ) )
  81.    (princ)
  82. )
  83.  
  84. (princ)
  85.