home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
BUG 15
/
BUGCD1998_06.ISO
/
aplic
/
felixcad
/
fcaddata.z
/
FLX_LSTF.LSP
< prev
next >
Wrap
Lisp/Scheme
|
1996-10-01
|
3KB
|
104 lines
;;; FLX_LSTF.LSP
;;; =============================================================================
;;; Provided for FelixCAD
;;; =============================================================================
;;; Created: Dec 28, 1995 / vp
;;; Changed: Sep 29, 1996 / vp
;;; =============================================================================
;;; LISTFILE: Display Text File in a Dialog Box
;;; =============================================================================
;;; Arguments for the function FLX_LISTFILE:
;;; fmsg - Title of the dialog box
;;; ftype - File type(s) for (getfiled ...)
;;; =============================================================================
(defun FLX_LISTFILE (fmsg ftype / fmsg ftype lang prt_list
DlgInit lst s0 s1 n fn pf zz x)
;;; Error Handler
(defun *error*(msg)
(setq *error* nil)
(princ)
)
;;; Prompt List
(setq prt_list (list
"List File" ;;; 0
"Reading file. Please wait..." ;;; 1
"File too long! Truncated!" ;;; 2
"Warning" ;;; 3
"lines" ;;; 4
"Cannot open file " ;;; 5
"Error" ;;; 6
))
(if FLX_XLANGUAGE (FLX_XLANGUAGE "_lstf" nil))
;;; Dialog Initialization Function
(defun DlgInit ( / n)
(if FLX$WIN95 (foreach n
'("IDOK" "ListBox1" "Static2" "Static3")
(Dlg_TileSetFont n 2)
))
(Dlg_TileAction "IDOK" "(Dlg_DialogDone)")
(Dlg_TileSet "Static2" s0) ;;; Filename
(Dlg_TileSet "Static3" s1) ;;; No. of lines
(Dlg_ListStart "ListBox1")
(mapcar 'Dlg_ListAdd lst)
(Dlg_ListEnd)
)
;;; Main
(if (not fmsg) (setq fmsg (nth 0 prt_list))) ;;;@Display File Content
(if (not ftype)(setq ftype ""))
(setq pf (GETFILED fmsg "" ftype 4)) ;;; flag = 4 !!!
(if pf (progn
(if (setq fn (open pf "r"))
(progn
(setq lst '() n 0 x 0)
(setq zz (read-line fn))
(while zz
(setq lst (cons zz lst)
zz (read-line fn)
n (1+ n)
x (1+ x)
)
(if (= n 100) (princ (nth 1 prt_list))) ;;;@Reading file. Please wait...
(if (= x 100) (progn (princ ".")(setq x 0)))
;;;### FILE TOO BIG !
(if (= n 1000) (progn
(alert
(nth 2 prt_list) ;;;@File too long! Truncated!
(nth 3 prt_list) ;;;@Warning
"EXLAMATION"
)
(setq zz nil)
))
) ; while
(close fn)
(setq
lst (reverse lst)
s0 pf
s1 (strcat (itoa (length lst)) " " (nth 4 prt_list)) ;;;@lines
)
(if (FLX_DLGDSP "flx_dlg" "LISTFILE" "(princ)" "(DlgInit)") (princ)(exit))
)
(alert
(strcat (nth 5 prt_list) "\n" pf "!") ;;;@Cannot open file
(nth 6 prt_list) ;;;@Error
"STOP"
)
) ; if
))
;;; Restore system error handler
(setq *error* nil)
(princ)
)
(princ)