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.
The 'cd' function displays or changes the current working directory, it
also displays the name of the *
> (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)))
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
<- maximum-width ->| item-1 item-2 item-3 item-4 item-5
When no line was longer than the
<- maximum-width ->| item-1 item-2 item-3 item-4 item-5
When no line was longer than the
<- maximum-width ->| item-1 item-2 item-3
As soon as a line becomes longer than the
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
(< (nth 3 '(1 2)) 0) => error: bad argument type - NIL
It's also no good idea to use setf
with
(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
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.
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)))