Nyquist / XLISP 2.0  -  Contents | Tutorials | Examples | Reference

Shell Utilities


Nyquist is not a system programming language, so Nyquist/XLISP cannot create or remove files and directories, and the system function does not work on Windows. But sometimes it helps to know the name of the current working directory, the name of the directory where the soundfiles are stored, or the names of files and sub-directories.


cd


The 'cd' function displays or changes the current working directory, it also displays the name of the *default-sf-dir* directory, where Nyquist stores its sound files:

> (cd)
;; *default-sf-dir*  = /tmp/
;; working directory = /home/edgar
NIL

> (cd "test")
;; directory changed to "test"
;; *default-sf-dir*  = /tmp/
;; working directory = /home/edgar/test
T

> (cd "..")
;; directory changed to "edgar"
;; *default-sf-dir*  = /tmp/
;; working directory = /home/edgar
T

> (cd "foo")
;; directory not changed, "foo" not found
;; *default-sf-dir*  = /tmp/
;; working directory = /home/edgar
NIL

> (cd 123)
;; directory not changed, 123 is not a string
;; *default-sf-dir*  = /tmp/
;; working directory = /home/edgar
NIL

The 'cd' function is intended for interactive use, in program code it's better to use the Nyquist setdir function.

(defun cd (&optional dirname)
  (let ((old-dir (setdir "."))
        (new-dir (when (stringp dirname) (setdir dirname))))
    (when dirname
      (if new-dir
          (when (string/= old-dir new-dir)
            (let ((string-end (length new-dir))
                  (subseq-start 0))
              (dotimes (index string-end)
                (when (char= (char new-dir index) *file-separator*)
                  (setq subseq-start index)))
              (incf subseq-start)
              (format t ";; directory changed to ~s~%"
                        (if (< subseq-start string-end)
                            (subseq new-dir subseq-start)
                            (string *file-separator*)))))
          (format t ";; directory not changed, ~s ~a~%" dirname
            (if (stringp dirname) "not found" "is not a string"))))
    (format t ";; *default-sf-dir*  = ~a~%" *default-sf-dir*)
    (format t ";; working directory = ~a~%" (setdir "."))
    (when new-dir t)))

  Back to top


ls


The 'ls' function lists files and directories:

> (ls)
;;; /home/edgar/Downloads/nyquist/svn/nyquist
;;  advantages.txt  cmt/               comp-ide.bat       convert.dsp
;;  convert.dsw     demos/             doc/               docsrc/
;;  fft/            ffts/              files.txt          howtorelease.txt
;;  jny             jnyqide.bat        jnyqide/           lib/
;;  liblo/          license.txt        lpc/               macosxproject/
;;  macproject/     Makefile           misc/              nylsf/
;;  nyqide/         nyqsrc/            nyqstk/            nyquist.dsp
;;  nyquist.dsw     nyquist.sln        nyquist.vcproj     nyqwin.dsp
;;  nyqwin.vcproj   portaudio-oldv19/  portaudio/         portaudio_test/
;;  Readme.txt      release.bat        releasenyqide.bat  releasenyqwin.bat
;;  runtime/        snd/               sys/               test/
;;  todo.txt        tran/              xlisp/             
47

The algorithm to find the number of colums is trial-and-error, for example it starts with one column:

<- maximum-width ->|
item-1 
item-2
item-3
item-4
item-5

When no line was longer than the maximum-width the layout is saved and a new test is started with two columns:

<- maximum-width ->|
item-1  item-2
item-3  item-4
item-5

When no line was longer than the maximum-width the layout is saved and a new test is started with three columns:

<- maximum-width ->|
item-1  item-2  item-3

As soon as a line becomes longer than the maximum-width, the test is aborted and the saved layout from the previous run is used.

The main reason why arrays are used instead of lists is that we need access to predefined numbers. With lists we always first need to test if an element exists because non-existent list elements are NIL and not numbers:

(< (nth 3 '(1 2)) 0)  => error: bad argument type - NIL

It's also no good idea to use setf with non-existent list elements:

(setf (nth 2 nil) 'value)  => VALUE
(nth 2 nil)                => error: bad argument type - NIL

Caution: The XLISP setf special form does not signal an error if values are assigned to non-existent places.

We use the Common Lisp 'incf' macro because the Nyquist incf macro has no 'increment' argument:

(defmacro cl:incf (place &optional (increment 1))
  `(setf ,place (+ ,place ,increment)))
(defun ls (&rest args)
  (let* ((dirname   (if (stringp (car args))
                        (prog1 (car args) (setq args (cdr args)))
                        (setdir ".")))
         (show-all (car args))
         (raw-list (listdir dirname)))
    (cond ((null raw-list)
           (format t ";; directory ~s not found~%" dirname))
          ((<= (length raw-list) 2)
           (format t ";;; ~a~%" dirname)
           (format t ";; [directory is empty]~%") 0)
          (t
           (format t ";;; ~a~%" dirname)
           (let ((file-separator (string *file-separator*))
                 (dir-list nil))
             (dolist (item raw-list)
               (when (or show-all (not (ls:hidden-p item)))
                 (if (listdir (strcat dirname file-separator item))
                     (push (strcat item "/") dir-list)
                     (push item dir-list))))
             (ls:list-items (sort dir-list #'string-lessp)))))))

(setq *ls-hidden-start* (list "." "#"))
(setq *ls-hidden-end* (list "~" "#"))

(defun ls:hidden-p (string)
  (let ((string-length (length string)))
    (or (dolist (item *ls-hidden-start* nil)
          (let ((subseq-end (length item)))
            (when (and (>= string-length subseq-end)
                       (string= item (subseq string 0 subseq-end)))
              (return t))))
        (dolist (item *ls-hidden-end* nil)
          (let ((subseq-start (- string-length (length item))))
            (when (and (<= 0 subseq-start)
                       (string= item (subseq string subseq-start)))
              (return t)))))))

(defmacro ls:reset-array (array)
  (let ((index (gensym)))
    `(dotimes (,index (length ,array))
       (setf (aref ,array ,index) 0))))

(defmacro ls:copy-array (from-array to-array end)
  (let ((index (gensym)))
    `(dotimes (,index ,end)
       (setf (aref ,to-array ,index)
             (aref ,from-array ,index)))))

(defun ls:fill-string (length)
  (let ((string ""))
    (dotimes (i length)
      (setq string (strcat string " ")))
    string))

(defun ls:list-items (item-list &optional (terminal-width 80))
  (let* ((separator 2)
         (width (- terminal-width 4))
         (width-max (+ width separator))
         (num-items (length item-list))
         (num-columns 1)     ; number of columns
         (item-array   (make-array num-items))
         (length-array (make-array num-items))
         (length-min width)  ; shortest item
         (length-max 0)      ; longest item
         (length-all 0)      ; all items + separators
         ;; the maximum possible number of columns is
         ;; width-max / (1 char + separator)
         (max-columns (/ width-max (1+ separator)))
         (column-array (make-array max-columns)))

    ;; initialize the column-array
    (ls:reset-array column-array)

    ;; copy the items from the list into the item-array
    (let ((item-index 0))
      (dolist (item item-list)
        (setf (aref item-array item-index) item)
        (incf item-index)))

    ;; find the length of all items and store them in the length-array
    (dotimes (item-index num-items)
      (let ((length-item (length (aref item-array item-index))))
        (setf (aref length-array item-index) length-item
              length-all (+ length-all length-item separator)
              length-min (min length-min length-item)
              length-max (max length-max length-item))))

    ;; find the number and widths of the columns
    (cond ((<= length-all width-max)
           ;; if all items together fit into a single line
           (setq num-columns num-items)
           (ls:copy-array length-array column-array num-items))
          ((and (> num-items 1)
                (<= (+ length-min length-max separator) width))
           ;; if there is more than one item and the
           ;; longest + shortest item + separator fit into one line
           ;; we start with two columns, one column is the fallback
           (incf num-columns)
           ;; the test-array must be 1+ because we need 1 failure-run
           (do ((test-array (make-array (1+ max-columns)))
                (item-index 0 0))
               ((progn
                  (ls:reset-array test-array)
                  ;; loop until there are no more items in the list
                  (do ((line-length 0 0))
                      ((>= item-index num-items))
                    ;; compute a complete line
                    (dotimes (column-index num-columns)
                      ;; loop through all columns in the test-array
                      (when (and (< item-index num-items)
                                 (< (aref test-array column-index)
                                    (aref length-array item-index)))  
                        ;; if there are still items in the list and the
                        ;; item is wider than the column, update the array
                        (setf (aref test-array column-index)
                              (aref length-array item-index)))
                      ;; compute the line-length from the value in the array
                      (cl:incf line-length
                               (+ (aref test-array column-index) separator))
                      (incf item-index))
                    ;; analyze the result from computing the line
                    (cond ((> line-length width-max)
                           ;; if the line is too long, abort completely, use
                           ;; the column-array values from the previous run
                           (decf num-columns)
                           (return t))  ; abort both 'do' loops
                          ((>= item-index num-items)
                           ;; if no items is left and no line was too long
                           ;; first save the test-array in the column-array
                           (ls:copy-array test-array column-array num-columns)
                           ;; then try again with one more column
                           (incf num-columns)))))))))

    ;; print the items on the screen
    (do ((item-index 0)
         (last-item (1- num-items))
         (last-column (1- num-columns))
         (line ";;  " ";;  "))
        ((>= item-index num-items))
      (dotimes (column-index num-columns)
        ;; loop through all columns
        (when (< item-index num-items)
          ;; if there are still items in the list
          (setq line
                (if (and (< column-index last-column)
                         (< item-index last-item))
                    ;; if not the last column and not the last item
                    (strcat line (aref item-array item-index)
                      ;; add a fill-string
                      (let ((column (aref column-array column-index))
                            (item   (aref length-array item-index)))
                        (ls:fill-string (+ (- column item) separator))))
                    ;; if the last column or the last item
                    (strcat line (aref item-array item-index))))
          (incf item-index)))
      ;; display the line on the screen
      (format t "~a~%" line))

    ;; return the number of items listed on the screen
    num-items))

Note: The code works, but this section is still too much mess.

  Back to top


hd


The 'hd' function prints the hexdump of a file on the screen:

> (hd "/tmp/edgar-temp.wav")
0000000000  52 49 46 46 ac 58 01 00  57 41 56 45 66 6d 74 20  RIFF.X..WAVEfmt 
0000000016  10 00 00 00 01 00 01 00  44 ac 00 00 88 58 01 00  ........D....X..
0000000032  02 00 10 00 64 61 74 61  88 58 01 00 00 00 4a 04  ....data.X....J.
0000000048  93 08 da 0c 1b 11 57 15  8b 19 b7 1d d7 21 ec 25  ......W......!.%
0000000064  f3 29 eb 2d d3 31 a9 35  6c 39 1a 3d b3 40 35 44  .).-.1.5l9.=.@5D
0000000080  9e 47 ee 4a 24 4e 3d 51  3a 54 19 57 d9 59 78 5c  .G.J$N=Q:T.W.Yx\
0000000096  f7 5e 54 61 8f 63 a6 65  99 67 67 69 10 6b 92 6c  .^Ta.c.e.ggi.k.l
0000000112  ee 6d 23 6f 31 70 16 71  d3 71 68 72 d4 72 17 73  .m#o1p.q.qhr.r.s
0000000128  31 73 23 73 eb 72 8a 72  01 72 4f 71 75 70 73 6f  1s#s.r.r.rOqupso
0000000144  49 6e f8 6c 80 6b e2 69  1f 68 36 66 29 64 f8 61  In.l.k.i.h6f)d.a
0000000160  a5 5f 2f 5d 98 5a e2 57  0b 55 17 52 05 4f d8 4b  ._/].Z.W.U.R.O.K
0000000176  8f 48 2c 45 b1 41 1f 3e  76 3a b9 36 e8 32 05 2f  .H,E.A.>v:.6.2./
0000000192  11 2b 0e 27 fe 22 e0 1e  b8 1a 86 16 4c 12 0c 0e  .+.'."......L...
0000000208  c7 09 7e 05 33 01 e9 fc  9f f8 57 f4 14 f0 d6 eb  ..~.3.....W.....
0000000224  a0 e7 72 e3 4e df 36 db  2b d7 2f d3 42 cf 67 cb  ..r.N.6.+./.B.g.
0000000240  9f c7 ea c3 4b c0 c3 bc  53 b9 fb b5 be b2 9d af  ....K...S.......
;; type "q" to quit or press Return to continue... 
(defun hd (filename &key (start 0) end)
  (cond
    ((not (stringp filename))
     (format t ";; not a string ~s~%" filename))
    ((listdir filename)
     (format t ";; not a file ~s~%" string))
    ((or (not (integerp start)) (minusp start))
     (format t ";; not a non-negative integer ~s~%" start))
    ((and end (or (not (integerp end)) (minusp end)))
     (format t ";; not a non-negative integer ~s~%" end))
    ((and end (>= start end))
     (format t ";; :start ~s is greater then :end ~s~%" start end))
    (t (let ((file-stream (open-binary filename)))
         (if (null file-stream)
             (format t ";; file not found ~s~%" filename)
             (unwind-protect
               (hd:dump file-stream start end)
               (when file-stream (close file-stream))))))))

(defun hd:dump (file-stream start end)
  (let ((file-position (hd:skip file-stream start))
        (break (+ start 255))
        (end-of-file nil)
        (end-of-dump nil))
    (if (< file-position start)
        (setq end-of-file t)
        (flet ((read-eight-bytes (start-position)
                 (let (byte-list)
                   (dotimes (offset 8)
                     (let* ((position (+ start-position offset))
                            (read-p (and (<= start position)
                                         (or (null end)
                                             (>= end position))))
                            (byte (when read-p
                                    (read-byte file-stream))))
                       (push byte byte-list)
                       (when byte (incf file-position))
                       (when (and read-p (null byte))
                         (setq end-of-file t))))
                   (reverse byte-list))))
          (read-line)
          (do ((line-start (* (/ start 16) 16) (+ line-start 16)))
              ((or end-of-file end-of-dump))
            (let* ((number  (hd:line-number line-start))
                   (list-1  (read-eight-bytes line-start))
                   (list-2  (read-eight-bytes (+ line-start 8)))
                   (bytes-1 (hd:byte-string list-1))
                   (bytes-2 (hd:byte-string list-2))
                   (chars   (hd:char-string (append list-1 list-2))))
              (format t "~a  ~a  ~a  ~a~%" number bytes-1 bytes-2 chars)
              (when (and end (> file-position end))
                (setq end-of-dump t))
              (when (> file-position break)
                (format t ";; type \"q\" to quit or press Return to continue... ")
                (if (string-equal "q" (read-line))
                    (setq end-of-dump t)
                    (setq break (+ break 256))))))))
    (when (and end (>= file-position end))
      (format t ";; reached specified :end at byte number ~a~%" end))
    (when end-of-file
      (format t ";; end of file at byte number ~a~%" file-position))))

(defun hd:line-number (integer)
  (progv '(*integer-format*) '("%.10d")
    (format nil "~s" integer)))

(defun hd:byte-string (byte-list)
  (let ((string ""))
    (dolist (byte byte-list)
      (setq string (strcat string (if byte
                                      (progv '(*integer-format*) '("%.2x")
                                        (format nil "~s " byte))
                                      "   "))))
    (subseq string 0 (1- (length string)))))

(defun hd:char-string (byte-list)
  (let ((string ""))
    (dolist (byte byte-list)
      (setq string (strcat string (if byte
                                      (if (<= 32 byte 126)
                                          (string byte)
                                          ".")
                                      " "))))
    string))

(defun hd:skip (file-stream offset)
  (if (= offset 0)
      offset
      (let ((count 0))
          (format t ";; skipping ~a bytes...~%" offset)
          (dotimes (ignore offset)
            (if (read-byte file-stream)
                (incf count)
                (return)))
        count)))

  Back to top


Nyquist / XLISP 2.0  -  Contents | Tutorials | Examples | Reference