home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 22 gnu / 22-gnu.zip / gwm18a.zip / contrib / scripts / find-bar-nils next >
Lisp/Scheme  |  1995-07-03  |  2KB  |  85 lines
  1. #!/usr/local/bin/klone
  2. ;;Skeleton of a typical klone script
  3. ;;(stack-dump-on-error t)
  4. ;;(kdb t)
  5.  
  6. (defvar ExpressionToFind '(bar-make ()))
  7.  
  8. (setq files (getopts "USAGE: find-bar-nils files...
  9. prints usage of (bar-make ()) which will conflict with the new syntax"
  10.     ("-v" () verbose "verbose operation")
  11. ))
  12.  
  13. (setq *quote-inlines* t)
  14.  
  15. (defun main (&aux
  16.   )
  17.   (dolist (file files)
  18.     (catch 'ALL
  19.       (process-file file)
  20.     )
  21.   )
  22. )
  23.  
  24. (defun process-file (file &aux
  25.     (fd (open file))
  26.     expr
  27.   )
  28.   (catch 'EOF
  29.     (while t
  30.       (setq expr (read fd))
  31.       (setq is-in-expr:count 0)
  32.       (if (is-in-expr expr ExpressionToFind)
  33.     (print-format "%0:%1: %2 occurences in: %3\n"
  34.       file (file-lineno fd) is-in-expr:count (truncate-to expr 40)
  35. )))))
  36.  
  37. ;; find current line in file
  38. (defun file-lineno (fd &aux
  39.     (cur-pos (file-position fd))
  40.     (line 0)
  41.   )
  42.   (file-position fd 0)            ;rewind
  43.   (catch 'EOF
  44.     (while (< (file-position fd) cur-pos)    ;count from start
  45.       (read-line fd)
  46.       (incf line)
  47.   ))
  48.   (file-position fd cur-pos)
  49.   line
  50. )
  51.  
  52. (defvar is-in-expr:count 0)
  53.  
  54. (defun is-in-expr (expr subexpr)
  55.   (if (= expr subexpr)
  56.     (incf is-in-expr:count)
  57.     (if (typep expr List)
  58.       (catch 'Found
  59.     (dolist (se expr)
  60.       (if (is-in-expr se subexpr)
  61.         (throw 'Found t)
  62.     ))
  63.     ()
  64.       )
  65.       () 
  66. )))
  67.  
  68. (defun truncate-to (expr N &aux
  69.     (s (print-format String "%0" expr))
  70.   )
  71.   (if (> (length s) N)
  72.     (subseq s 0 N)
  73.     s
  74.   )
  75. )
  76.  
  77.  
  78. (main)
  79.  
  80. ;;; EMACS MODES
  81. ;;; Local Variables: ***
  82. ;;; mode:lisp ***
  83. ;;; End: ***
  84.  
  85.