home *** CD-ROM | disk | FTP | other *** search
/ BUG 15 / BUGCD1998_06.ISO / aplic / felixcad / fcaddata.z / FLX_LSTF.LSP < prev    next >
Lisp/Scheme  |  1996-10-01  |  3KB  |  104 lines
  1. ;;; FLX_LSTF.LSP
  2. ;;; =============================================================================
  3. ;;; Provided for FelixCAD
  4. ;;; =============================================================================
  5. ;;; Created: Dec 28, 1995 / vp
  6. ;;; Changed: Sep 29, 1996 / vp
  7. ;;; =============================================================================
  8. ;;; LISTFILE: Display Text File in a Dialog Box
  9. ;;; =============================================================================
  10. ;;; Arguments for the function FLX_LISTFILE:
  11. ;;;           fmsg  - Title of the dialog box
  12. ;;;           ftype - File type(s) for (getfiled ...)
  13. ;;; =============================================================================
  14.  
  15. (defun FLX_LISTFILE (fmsg ftype / fmsg ftype lang prt_list
  16.                                   DlgInit lst s0 s1 n fn pf zz x)
  17.  
  18.   ;;; Error Handler
  19.  
  20.   (defun *error*(msg)
  21.       (setq *error* nil)
  22.       (princ)
  23.   )
  24.  
  25.   ;;; Prompt List
  26.  
  27.   (setq prt_list (list
  28.        "List File"                     ;;; 0
  29.        "Reading file. Please wait..."  ;;; 1
  30.        "File too long! Truncated!"     ;;; 2
  31.        "Warning"                       ;;; 3
  32.        "lines"                         ;;; 4
  33.        "Cannot open file "             ;;; 5
  34.        "Error"                         ;;; 6
  35.   ))
  36.   (if FLX_XLANGUAGE (FLX_XLANGUAGE "_lstf" nil))
  37.  
  38.   ;;; Dialog Initialization Function
  39.   
  40.   (defun DlgInit ( / n)
  41.     (if FLX$WIN95 (foreach n 
  42.         '("IDOK" "ListBox1" "Static2" "Static3")
  43.          (Dlg_TileSetFont n 2)
  44.     ))
  45.     (Dlg_TileAction "IDOK" "(Dlg_DialogDone)")
  46.     (Dlg_TileSet "Static2" s0)   ;;; Filename
  47.     (Dlg_TileSet "Static3" s1)   ;;; No. of  lines
  48.     (Dlg_ListStart "ListBox1")
  49.     (mapcar 'Dlg_ListAdd lst)
  50.     (Dlg_ListEnd)
  51.   )
  52.  
  53.   ;;; Main
  54.   
  55.   (if (not fmsg) (setq fmsg (nth 0 prt_list))) ;;;@Display File Content
  56.   (if (not ftype)(setq ftype ""))
  57.   (setq pf (GETFILED fmsg "" ftype 4)) ;;; flag = 4 !!!
  58.   (if pf (progn
  59.     (if (setq fn (open pf "r"))
  60.       (progn
  61.         (setq lst '() n 0 x 0)
  62.         (setq zz (read-line fn))
  63.         (while zz 
  64.            (setq lst (cons zz lst) 
  65.                  zz  (read-line fn)
  66.                  n   (1+ n)
  67.                  x   (1+ x)
  68.            )
  69.            (if (= n  100) (princ (nth 1 prt_list))) ;;;@Reading file. Please wait...
  70.            (if (= x  100) (progn (princ ".")(setq x 0)))
  71.            ;;;### FILE TOO BIG !
  72.            (if (= n 1000) (progn 
  73.                (alert 
  74.                   (nth 2 prt_list) ;;;@File too long! Truncated!
  75.                   (nth 3 prt_list) ;;;@Warning
  76.                   "EXLAMATION"
  77.                )
  78.                (setq zz nil)
  79.            ))
  80.         ) ; while
  81.         (close fn)
  82.         (setq
  83.            lst (reverse lst)
  84.            s0  pf
  85.            s1  (strcat (itoa (length lst)) " " (nth 4 prt_list)) ;;;@lines
  86.         )
  87.         (if (FLX_DLGDSP "flx_dlg" "LISTFILE" "(princ)" "(DlgInit)") (princ)(exit))
  88.       )
  89.       (alert 
  90.          (strcat (nth 5 prt_list) "\n" pf "!") ;;;@Cannot open file 
  91.          (nth 6 prt_list) ;;;@Error
  92.          "STOP"
  93.       )
  94.     ) ; if
  95.   ))
  96.   
  97.   ;;; Restore system error handler
  98.  
  99.   (setq *error* nil)
  100.   (princ)
  101. )
  102.  
  103. (princ)
  104.