home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / INFO / LISP / PDLISP.ZIP / DIRLIB.L < prev    next >
Encoding:
Text File  |  1986-05-27  |  4.2 KB  |  204 lines
  1. ; dirlib.l - Copyright (c) 1984 by David Morein
  2. ; this file contains a library of directory functions for unxlisp.
  3. ;
  4. ; note - this is an initialization file, see the manual for more info.
  5. ;
  6. (status dir_prefix_flag t)        ;set the colon prefix flag to T
  7. (status control_c_hook '/sys/const/control_c_label)    ;set the ^C hook
  8. ;
  9. ;
  10. ; global functions:
  11. ;
  12. (global
  13. 'add-to-path 
  14. 'dir 
  15. 'dirq
  16. 'getpath
  17. 'globalp
  18. 'localp
  19. 'local
  20. 'pd
  21. 'pdq
  22. 'popd
  23. 'poppath
  24. 'pushpath
  25. 'remove-from-path
  26. 'rmdir
  27. 'rmdirq
  28. 'setpath
  29. 'toplevel)
  30. ;
  31. ; dirq - lists a directory, quoting its argument.
  32. (def dirq (nlambda (&optional (oblist nil))
  33.     (dir oblist)))
  34. ;
  35. ; dir - lists a directory.
  36. ;
  37. (defun dir (&optional (oblist nil))
  38.     (cond 
  39.         ((null oblist)    (eval (status current_dir)))
  40.         (t
  41.             (cond
  42.                 ((dirp oblist) (eval oblist))
  43.                 (t (break "***> DIR or DIRQ: arg not a directory"))))))
  44. ;
  45. ;
  46. ; cdstr - gets the current directory encoded as a string
  47. ;
  48. (defun cdstr ()
  49.     (pathstr (status current_dir)))
  50. ;
  51. ;
  52. ; pd - (stands for "push directory")
  53. ;      changes the current directory and
  54. ;      saves the current one on a stack.
  55. ;
  56. (defun pd (newdir)
  57.     (pdq newdir))
  58. ;
  59. ;
  60. ; pdq - same as pd except that it quotes its argument
  61. ;
  62. (def pdq (nlambda (newdir)
  63.     (progn
  64. ;
  65. ;save current directory.
  66. ;
  67.         (pushprop 'directory (status current_dir) 'dirstack)
  68. ;
  69. ;change to new directory.
  70. ;
  71.         (mcd newdir)
  72.         t)))
  73. ;
  74. ;
  75. ; popd - (stands for "pop directory") 
  76. ;         returns to the previous directory
  77. ;
  78. (defun popd ()
  79.     (progn
  80.         (cd (get 'directory 'dirstack))
  81.         (popprop 'directory 'dirstack)))
  82. ;
  83. ;
  84. ; setpath - sets the reader's search path
  85. ;
  86. (defun setpath (x)
  87.     (status reader_search_path x))
  88. ;
  89. ;
  90. ; getpath - retrieves the reader's search path
  91. ;
  92. (defun getpath ()
  93.     (status reader_search_path))
  94. ;
  95. ;
  96. ; remove-from-path - removes a specified directory from
  97. ;                     the reader's search path.
  98. ;
  99. (defun remove-from-path (x)
  100.     (cond
  101.         ((dirp x)
  102.          (status reader_search_path (delete x (status reader_search_path))))
  103.         (t
  104.          (err "***> REMOVE-FROM-PATH: arg not a directory."))))
  105. ;
  106. ;
  107. (def rmdirq (nlambda (x)
  108.     (rmdir x)))
  109. ;
  110. (defun rmdir (x)
  111.     (cond
  112.         ((dirp x)
  113.          (progn
  114.             (remove-from-path x)
  115.             (srmdir x)))
  116.         (t
  117.          (err "***> RMDIR: arg not a directory."))))
  118. ;
  119. ;
  120. ; add-to-path - adds a directory to the reader's search path
  121. ; if it is not already on it.
  122. ;
  123. (defun add-to-path (x)
  124.     (cond
  125.     ((member x (getpath)) (getpath))
  126.         (t (pushpath x))))
  127. ;
  128. ;
  129. ; pushpath - pushes a directory onto the front of
  130. ;              the reader-search-path.
  131. ;
  132. (defun pushpath (x)
  133.     (cond
  134.         ((dirp x)
  135.          (status reader_search_path (cons x (status reader_search_path))))
  136.         (t
  137.          (err "***> PUSHPATH: arg not a directory."))))
  138. ;
  139. ;
  140. ; poppath - pops a directory off the reader-search-path
  141. ;
  142. (def poppath (nlambda ()
  143.     (status reader_search_path (cdr (status reader_search_path)))))
  144. ;
  145. ;
  146. ; toplevel - user-defined top-level
  147. ;
  148. (def toplevel (nlambda (&aux e)
  149.     (catch ('?*toplevel*?  'control_c_label)
  150.     (progn
  151.         (outprompt)
  152.         (setq e (read))
  153.         (prin1 (eval e))
  154.     ))))
  155. ;
  156. ;
  157. ; outprompt - outputs a prompt
  158. ;
  159. (def outprompt (nlambda ()
  160.     (progn
  161.         (terpri)
  162.     (prntflp (status current_dir))    ;print current directory
  163.         (princ "->")
  164.         t)))
  165. ;
  166. ;
  167. ; set the system prompt hook:
  168. ;
  169. (status top_level_hook 'toplevel)
  170. ;
  171. ; note - the following functions are hacks until
  172. ;        bitwise logical functions are implemented:
  173. ;
  174. ; globalp - returns T iff its arg is a global symbol:
  175. ;
  176. (defun globalp (x)
  177.     (> (getmode x) 0))
  178. ;
  179. ;
  180. ; localp - returns T iff its arg is a local symbol:
  181. ;
  182. (defun localp (x)
  183.     (not (globalp x)))
  184. ;
  185. ;
  186. ; local - makes its list of args local
  187. ;
  188. (defun local (&rest x)
  189.     (mapcar 'auxlocal x))
  190. ;
  191. ;
  192. ; auxlocal - clears the mode bits associated with a symbol
  193. ;
  194. (defun auxlocal (x)
  195.     (setmode x 0x0000))
  196. ;
  197. ;
  198. ; turn on the parenthesis counting flag:
  199. ;
  200. (status pcount_flag t)
  201. ;
  202. ;
  203. ; *************************** end of dirlib.l *****************************
  204.