home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 13 / 13.iso / p / p024 / 11.img / BONUS2.LIB / FCOPY.LSP < prev    next >
Encoding:
Text File  |  1993-01-23  |  2.0 KB  |  59 lines
  1. ;;; --------------------------------------------------------------------------;
  2. ;;; FCOPY.LSP
  3. ;;;   (C) ¬⌐┼v 1988-1992  Autodesk ñ╜Ñq
  4. ;;;
  5. ;;;   Ñ╗╡{ªíñwÑ╤ Autodesk ñ╜Ñq╡∙ÑU¬⌐┼v, ╢╚⌐≤ñU¡z▒í¬pñUÑi▒┬╗P▒zíu│\ÑiívíC
  6. ;;;   ╗╒ñUñú▒oÑHÑ⌠ª≤º╬ªí╡oªµ⌐╬ÑX¬⌐ª╣╡{ªí¬║íu¡∞⌐l╜Xív; ª²ñ╣│\▒zªb»S⌐w¡lÑ═
  7. ;;;   ¬║ñuº@ñW╡▓ªXª╣╡{ªí¬║íuÑ╪¬║╜Xív¿╧Ñ╬íCª│├÷│o├■¡lÑ═ñuº@¬║▒°Ñ≤ªpñU:
  8. ;;;
  9. ;;;   ( i)  │]¡pñW╗Pñuº@ñW¼╥»┬║Θ░w╣∩ Autodesk ñ╜Ñq¬║▓ú½~íC
  10. ;;;   (ii)  ╕ⁿª│íu¬⌐┼v  (C) 1988-1992  Autodesk ñ╜Ñqív¬║¬⌐┼v│qºiíC
  11. ;;;
  12. ;;;
  13. ;;;
  14. ;;;   AUTODESKñ╜Ñq┤ú¿╤ª╣╡{ªí╢╚¿╤º@íu├■ªⁿív¬║░╤ª╥, ª╙ÑBñú▒╞░úª│Ñ⌠ª≤┐∙╗~¬║
  15. ;;;   Ñi»αíCAUTODESKñ╜Ñq»Sª╣º_╗{Ñ⌠ª≤»S⌐wÑ╬│~ñº╛A║┘⌐╩, ÑHñ╬░╙╖~╛P░Γ⌐╥┴⌠ºt
  16. ;;;   ÑX¿π¬║½O├╥íCAUTODESKñ╜ÑqªP«╔ÑτñúÑX¿πª╣╡{ªí░⌡ªµ«╔ñ@⌐wñú╖|íuññ┬_ív⌐╬
  17. ;;;   íuº╣Ñ■╡L╗~ív¬║½O├╥íC
  18. ;;;
  19. ;;;
  20. ;;; --------------------------------------------------------------------------;
  21. ;;; DESCRIPTION
  22. ;;;
  23. ;;;   This is a programming example.
  24. ;;;
  25. ;;;   This program takes two ASCII files as arguments, and copies the first
  26. ;;;   file into the second.  If the first file does not exist, an error message
  27. ;;;   is printed, however, if the second file does not exist, it is created.
  28. ;;;
  29. ;;;   Note that if the second file exists, its data will be overwritten.
  30. ;;;
  31. ;;;   Usage: (fcopy "infile.ext" "outfile.ext")
  32. ;;;
  33. ;;; --------------------------------------------------------------------------;
  34.  
  35. (defun fcopy (in out / ifp ofp l)
  36.   (cond ((null (setq ifp (open in "r"))) ; try to open in for reading
  37.      (princ "╡L¬k╢}▒╥íu")            ; if nil print error message
  38.      (princ in)
  39.      (princ "ívÑH¿╤┼¬¿·íC ")
  40.     )
  41.     (if ifp
  42.       (progn
  43.         (setq ofp (open out "w"))     ; else open out for writing
  44.         (while (setq l (read-line ifp)) ; read each line from in
  45.           (write-line l ofp)          ; and write it to out
  46.         )
  47.         (close ofp)                   ; close both files
  48.         (close ifp)
  49.       )
  50.     )
  51.   )
  52.   (princ)
  53. )
  54.  
  55. ;;; --------------------------------------------------------------------------;
  56.  
  57.  
  58.  
  59.