Warning: this is an htmlized version!
The original is here, and the conversion rules are here. |
;; This file: ;; http://angg.twu.net/LISP/seibel-02.lisp.html ;; http://angg.twu.net/LISP/seibel-02.lisp ;; (find-angg "LISP/seibel-02.lisp") ;; Author: Eduardo Ochs <eduardoochs@gmail.com> ;; ;; (defun s2 () (interactive) (find-angg "LISP/seibel-02.lisp")) ;; (find-es "lisp" "seibel-cap02") * (eepitch-sbcl) * (eepitch-kill) * (eepitch-sbcl) (getf (list :a 1 :b 2 :c 3) :a) (getf (list :a 1 :b 2 :c 3) :c) (defun make-cd (title artist rating ripped) (list :title title :artist artist :rating rating :ripped ripped)) (make-cd "Roses" "Kathy Mattea" 7 t) (defvar *db* nil) (defun add-record (cd) (push cd *db*)) (add-record (make-cd "Roses" "Kathy Mattea" 7 t)) (add-record (make-cd "Fly" "Dixie Chicks" 8 t)) (add-record (make-cd "Home" "Dixie Chicks" 9 t)) *db* (defun dump-db () (dolist (cd *db*) (format t "~{~a:~10t~a~%~}~%" cd))) (dump-db) (format t "~a" "Dixie Chicks") (format t "~a" :title) (format t "~a:~10t~a" :artist "Dixie Chicks") (defun dump-db () (format t "~{~{~a:~10t~a~%~}~%~}" *db*)) (dump-db) (defun prompt-read (prompt) (format *query-io* "~a: " prompt) (force-output *query-io*) (read-line *query-io*)) (defun prompt-for-cd () (make-cd (prompt-read "Title") (prompt-read "Artist") (prompt-read "Rating") (prompt-read "Ripped [y/n]"))) (parse-integer (prompt-read "Rating")) 9 (parse-integer (prompt-read "Rating") :junk-allowed t) 9 ab (or (parse-integer (prompt-read "Rating") :junk-allowed t) 0) 9 (y-or-n-p "Ripped [y/n]: ") y (defun prompt-for-cd () (make-cd (prompt-read "Title") (prompt-read "Artist") (or (parse-integer (prompt-read "Rating") :junk-allowed t) 0) (y-or-n-p "Ripped [y/n]: "))) (defun add-cds () (loop (add-record (prompt-for-cd)) (if (not (y-or-n-p "Another? [y/n]: ")) (return)))) (add-cds) Rockin' the Suburbs Ben Folds 6 y y Give Us a Break Limpopo 10 y y Lyle Lovett Lyle Lovett 9 y n (defun save-db (filename) (with-open-file (out filename :direction :output :if-exists :supersede) (with-standard-io-syntax (print *db* out)))) (save-db "/tmp/my-cds.db") (defun load-db (filename) (with-open-file (in filename) (with-standard-io-syntax (setf *db* (read in))))) (load-db "/tmp/my-cds.db") (remove-if-not #'evenp '(1 2 3 4 5 6 7 8 9 10)) (remove-if-not #'(lambda (x) (= 0 (mod x 2))) '(1 2 3 4 5 6 7 8 9 10)) (remove-if-not #'(lambda (x) (= 1 (mod x 2))) '(1 2 3 4 5 6 7 8 9 10)) (remove-if-not #'(lambda (cd) (equal (getf cd :artist) "Dixie Chicks")) *db*) (defun select-by-artist (artist) (remove-if-not #'(lambda (cd) (equal (getf cd :artist) artist)) *db*)) (defun select (selector-fn) (remove-if-not selector-fn *db*)) (select #'(lambda (cd) (equal (getf cd :artist) "Dixie Chicks"))) (defun artist-selector (artist) #'(lambda (cd) (equal (getf cd :artist) artist))) (select (artist-selector "Dixie Chicks")) (defun foo (a b c) (list a b c)) (defun foo (&key a b c) (list a b c)) (defun foo (&key a (b 20) (c 30 c-p)) (list a b c c-p)) (defun where (&key title artist rating (ripped nil ripped-p)) #'(lambda (cd) (and (if title (equal (getf cd :title) title) t) (if artist (equal (getf cd :artist) artist) t) (if rating (equal (getf cd :rating) rating) t) (if ripped-p (equal (getf cd :ripped) ripped) t)))) (select (where :artist "Dixie Chicks")) (select (where :rating 10 :ripped nil)) (defun update (selector-fn &key title artist rating (ripped nil ripped-p)) (setf *db* (mapcar #'(lambda (row) (when (funcall selector-fn row) (if title (setf (getf row :title) title)) (if artist (setf (getf row :artist) artist)) (if rating (setf (getf row :rating) rating)) (if ripped-p (setf (getf row :ripped) ripped))) row) *db*))) (update (where :artist "Dixie Chicks") :rating 11) (select (where :artist "Dixie Chicks"))