From 381b7a0fc3f06d89134a3f74dbf0281542d3826d Mon Sep 17 00:00:00 2001 From: Barry Kane Date: Sat, 4 May 2024 02:23:05 +0100 Subject: [PATCH] Added Commmon Lisp Bits & Pieces. --- .../Chapter-02/hello-world.fasl | Bin 0 -> 1085 bytes .../Chapter-02/hello-world.lisp | 4 + Common-Lisp-Bits-And-Pieces/Chapter-03/cds.db | 2 + .../Chapter-03/cds.fasl | Bin 0 -> 14678 bytes .../Chapter-03/cds.lisp | 94 +++++++++++++++++ .../Chapter-09/testing-framework.fasl | Bin 0 -> 8099 bytes .../Chapter-09/testing-framework.lisp | 38 +++++++ .../Chapter-15/barra-filename-library.fasl | Bin 0 -> 8109 bytes .../Chapter-15/barra-filename-library.lisp | 99 ++++++++++++++++++ Common-Lisp-Bits-And-Pieces/GTK-Test.lisp | 34 ++++++ Common-Lisp-Bits-And-Pieces/Web-Chat.lisp | 88 ++++++++++++++++ 11 files changed, 359 insertions(+) create mode 100644 Common-Lisp-Bits-And-Pieces/Chapter-02/hello-world.fasl create mode 100644 Common-Lisp-Bits-And-Pieces/Chapter-02/hello-world.lisp create mode 100644 Common-Lisp-Bits-And-Pieces/Chapter-03/cds.db create mode 100644 Common-Lisp-Bits-And-Pieces/Chapter-03/cds.fasl create mode 100644 Common-Lisp-Bits-And-Pieces/Chapter-03/cds.lisp create mode 100644 Common-Lisp-Bits-And-Pieces/Chapter-09/testing-framework.fasl create mode 100644 Common-Lisp-Bits-And-Pieces/Chapter-09/testing-framework.lisp create mode 100644 Common-Lisp-Bits-And-Pieces/Chapter-15/barra-filename-library.fasl create mode 100644 Common-Lisp-Bits-And-Pieces/Chapter-15/barra-filename-library.lisp create mode 100644 Common-Lisp-Bits-And-Pieces/GTK-Test.lisp create mode 100644 Common-Lisp-Bits-And-Pieces/Web-Chat.lisp diff --git a/Common-Lisp-Bits-And-Pieces/Chapter-02/hello-world.fasl b/Common-Lisp-Bits-And-Pieces/Chapter-02/hello-world.fasl new file mode 100644 index 0000000000000000000000000000000000000000..0f65f7b458f9a7609814eeb14878571ef511dfc1 GIT binary patch literal 1085 zcmbW0&rcIU6vt<$GyMTVTL|*Qpv%_AN|`QFLNL+9?e4VOxIb!lD;&J=qex?akS(AG z4@kp-5aVCK)vFf|YQjZNBpy7Qc=DnNR}*e^ru+!Oo0FY4@4bEVX7=;V#>V80rYA2} z>T+{&sVWlET=FVw>s>K1t2joNC@wW>Yn5twSzPfNHBpjR8?~~$xZrsUvf8NC8g*h+ znrpJUy0Erh_Q>RvyjreS8{~Pzt1hRi?488AY&0wNr=pWl4RN#VH7kv}IF(ALX2?`( zWhs5PtL+B>%+Jn{nQ4o8d|YAkV$CRv6FF+BIh8dcu3n^y#=Vl2S8a{nUQYkV<*@YQ z&->r}JowUysJ3a^7BTWpfs`CtbO!~U8iq~g?4qGT==j-rdCPVCeNMJysczo3pc%4C zhS9=iY}|1bOH+y(u}f~D;|VKzwnvIQ1K0RP zSWz;(pGzYk;H2Qk!uOB{a2%p;DOm$SAHS=ICxdu{8whK75@QtV?ej6yi?|VROoh_I zmdyJBb9k`GlM?|7LtXF)oVUR7`FNlL9>T9Q(Ry9l144u!aHnkGqlK$ zM*0wB54wsH5G7D389vC#fL;gL0H9GJ8xSx=A*M~_1-Q}CW|PZ;LJ&onE?BaLPQDIG z^B~=E5qEE$xFgY_Ey2%eK{o#Z-`lA=Hw^qm==$FM&kXJ<=XaMlf8g8N-}G?iC$G43 sc*_4m{!9f9UhIHRG4M#91qht~7)iJf(iqn9B*Fqp_Y!XUg$L7r0j-7cga7~l literal 0 HcmV?d00001 diff --git a/Common-Lisp-Bits-And-Pieces/Chapter-02/hello-world.lisp b/Common-Lisp-Bits-And-Pieces/Chapter-02/hello-world.lisp new file mode 100644 index 0000000..832b828 --- /dev/null +++ b/Common-Lisp-Bits-And-Pieces/Chapter-02/hello-world.lisp @@ -0,0 +1,4 @@ +(defun hello-world () + (format t "Hello, world!")) + +(hello-world) diff --git a/Common-Lisp-Bits-And-Pieces/Chapter-03/cds.db b/Common-Lisp-Bits-And-Pieces/Chapter-03/cds.db new file mode 100644 index 0000000..9c9b6cd --- /dev/null +++ b/Common-Lisp-Bits-And-Pieces/Chapter-03/cds.db @@ -0,0 +1,2 @@ + +((:TITLE "Jailbreak" :ARTIST "Thin Lizzy" :RATING 10 :RIPPED T) (:TITLE "Lateralus" :ARTIST "TOOL" :RATING 10 :RIPPED T) (:TITLE "Poopenfarten" :ARTIST "Zweibrüder" :RATING 11 :RIPPED T) (:TITLE "Ride The Lightning" :ARTIST "Metallica" :RATING 9 :RIPPED T) (:TITLE "The Sound Of Rancid Juices Sloshing Around Your Coffin" :ARTIST "Last Days Of Humanity" :RATING 5 :RIPPED T)) \ No newline at end of file diff --git a/Common-Lisp-Bits-And-Pieces/Chapter-03/cds.fasl b/Common-Lisp-Bits-And-Pieces/Chapter-03/cds.fasl new file mode 100644 index 0000000000000000000000000000000000000000..45b7c38b56cb4fedc70c5590b1b2abfeb5953d44 GIT binary patch literal 14678 zcmd^m4R}=5o%j7XXJ+y_lMn<%WSk@rNQUsGwHn<_GB>%S^JQiNp~ba<3=kVg%m-jA zn2@A)_L_=xZLO9TZ9v-9uKUrgXi=!N_`$XqpVll}x9oP?H*8$X)-UjF$^QQ5&YcM) zQulq{_j#Xv_G;$-@4f$X&OP`1&+q?9@imn_U7eNdTDMeoty|yb_IkV4ceZwPXBWHc ze6e7*+r7Shb4P1iqQ$+TvwgGMQ@N>qbE0xxb7yCBWo`TB&Fx#f!Pc&h%GyoM9o>me z@6r{O>sz{(wBeoyt$Vs!w`_FBYHEY-t%=UA*7hy# z`s=*ctqg;rBNu;@dFJ7|tX>P(*4LsVZ(MKCe14)D!-3j}Ut82t{$F@0?m4&YduM1I z<(`QBzP+<$36I(Ec7bp_J|inu*BGvi2O?n=#{dsy)keax zejd&dorm+xzQcKD*EoxwnW8YIob4}hlw4IZyF}vUw!<4&I%^Ked_g%sJR!-7%EJY* zxG(JYHTXTQw`8dVQ(}sTT}5*P$vkX!isT+fPjN7thn1yBb*)46TjMmnt4v{ha8dV9stumCf!X>zuljeEAk-o*&R0 z{pTId!6UfThZ1LXLpvKZMuNsm0Yh`?N$p%Hxw$N0G&Ti?cJ+cObffke=Y3x$DycQ~ zzGByn9|jHHJuxv6Oje)Q`;VYi^?wAD(F|?y+b?;nC$~?2TsP%$$K=PAmpl$8_4E4i zYI&9{MMKLrmvt*AvR*#-;tAI#dc!gNNuN5?j7CJ6hYP30l0%Z&H8Uld#K-R^dE#=d zzmF%b@wK#EBrfjmc6axtguA7=yLnx6S7Hfg*=ipT6~wgL8X@&sKQGVTE2}v?E1TQp zY#zS`J$Yl1hPbz8jn@>?x$6uDR_rNpn6F6E zR3_J4kom%L1=2)o?%1zLZafBCE`(*fB)M8xAg+b@T7{R-I=t}{^5FMnc7PwN++$Ou zJuW8iQMtkwmZEXx6N)J?Yz}0F&Baf-dbI2}kN?BkQ{w(405jadbgitBYK^Y7rR6*mFU@~;pk|^Ea z&th@>M)i9UgOvsP&rJlK{%YCRdoIg4@Dp@o%AD4u4|TW#H}*i_p2OWhvZpDSbU@4; z!J%rqweq@=_gQpj-1S~iep~Oqd7@{gZXDH*j%An9JNbUh7~bM8IheFz)|a6)(bqjK+uS>1QySrMM;#&)^7cVbreTD|`**CB=;^khYeZoDPrDrkhTNAf}c-lg2HIs zlI9|zW;dz30D$4fU=SkB_DZU1&NYyjU$)_DZtY8((&q zd!vfY!-lC}fro4!e|DcrUqh|9 z^qn*3Gz=!|4IcviUwy-8Z_B1em!FC?+TdAChUR6pnlgF%to>tle6N84;>G2O2I)kD zJM}f*_`}4+3s=y@jB8&9edy9jg7sON8K9bsA6lL>+wkSnE4ust^Lpmtt^e5fGR5P6 z!g|_&pIJ{8^hd7enR1B32^W;Db&ysl6YBOeq;6+H-9|#uxR*Q^ScK*kjKQ)fe5wv8 z*A4BR(3|8dwI$qbty>cA_6_iz5}i<@9X;JkU=CW21X~!&TjdKjYB4qBtcgT|nlH?5 z8sPmrGzW^aR!eEZ!q5yF4!%uTD-6wC3}dokjW-Zk%x-1t6t?anYjCMt^Ie%2Gqwy` z&Gn`%xiJIqSjsCt%hJA3Zp%E5*^=}y6d8-HWxRaO;f+;tX{Dkb;H6h9GU+9Cf5`zp zcojpJWFM~lWy+z**oSPMr9*;0tBN_Nt90G*QR{=$x_KSC?Rz*tT{Uz zlsPK1<#M);DW?0et}rw=>T8H;!|V2u|8guT&1rW7W4ytTV6!4o!LXLoB? zH;9JjZfpS_o^wlM_*Snk7>ume{E7UA){YL?lb^o3a?9xm~A`!t`5Ghoz#0F$Yc8__x zUxwt~Y0_V$`*D+A2llEo*;||<3yQy}x~Ox8ztkX-uTVTq|G?@PeAzh|$8*T$NlPwM zYUvx0uPHLq>3D%Ok#77#H-1IJtS5J*1a@Z6$7ygH4MtNV1pj!0z6lzxJ5TSMh>*Q9 zNV=Vxzd*Bip6*S7*WM3j>BjG1FN4$R#~b#XObs{=yqz*7-RLF@kxK?=e?S$K%rjJqUhs$)aXYbzD+P&!_RA<==tHJi+du1gHQVH2DHaE{bg{-&` zl2e#)`L?tpKG69m8TsEMD{PO99l#FPm)ErNVjFD$*Oz5!E?&`mbQRnbmZ$JMI9Vz$ zQf$}?b8WEu8Mpgk?AwG?mp}B;z>Gl8n%-J;h%SW)uQ2Iii0VR`PD)mmc2X~+Q=-VHJ`fJsRuAZcTOjLke!~Vg-eY0 zAkZ_N-*3{oDKaaMtFjM&HSljsV(p#e-fnBpgzylcY3tb3ye`q*x}Ka`5tAYBl}8#_ zO~@XK_&uPTbmYp zly>JeVs}1ct} zh&4tv=u^MOD#AIw8ie**^8FeNL$@_a1ltbFms)n;ff?p7ExUhUk{jQNmMQ$*pK9vyjn7M8>3!K+PjRi$Hn< zP5SR;kDPrHuOdmfxm6JC1Z}xbnDi@T0aTjw2+`#x{Tk6JTs=vhiEz)=91dVqagaR0!r}v+?-Rm%p z9zCt-i;n5Z*f~As}~<5WV}kziBR&&fbnl*WS0kx zp53|;dKhn{^wY0OapO z+e{Zr4hmqkP!MfXZN^ezjUMG?ywzRe)8Y$@HJ@T=k(M2QW0C`V66-=rvktj9nT^Ra zW$|k{3_w!hSprnq3v$98Y;U$w8dg-;Octi0^r&2JgNGpJC~y!eSe0qx{77a$mT3#W zZ35`M>=n5Xdj)9=>c5ax6=IuF_TqKf0y=A80NvXc1050?e+h`m5qK}1hS%h;HqbZzw2RKK%2M6KYi-dDogme4UQO1gaN#GFL2^{PL zfpd9>?XQB*Ma~Cb3FyocNcSSOFp-Y^BK>7D;AS=kxD8JOZq&s*&)3}KBDN_BSnHi9Kn7nOsFiKfRmjy`5R(L|y)6j#E*jj%rhvK< zlYT`mSUAR91YI0|q9>evA|)YM#E%78%cp^?l!0)1ss;G}3Y7Bkn*R+!iTtGhb5Nq# zcN&y@dS-2iN<$K%bPAHDHOh^=EO=&q!}nfD9t-qeKV5z-IOLN9Nz~ML zctO~NUEo;X4d-q{&zAL+>wJegUPZeY>Sr1+fXw^6K5F>KlB&pY3J|b_#?n``>ZW)1HL>1#sU>FjD~YO@ zShn<{iV~LQbXL+$`Sun!YElq;oqmC#wh#moiOQ7P3e8O~uQwb)77|*jf<1~Qest0j z^TQiUk_b9TBFq6H!aD6@mKK*BA{lN+PRF>8?WP}YK5wKYs-jB#dD$hZ(SFy3fC{{l}e zXzYMdkw~o%R?FI;$S!AAQaI@BDTU?3OJ`2{anVl!e!c*w3NwjYaX-l;#}c)JMOnj zEtn+nsE0~Y`QFkp+`_S7hPe#9{F=S>JN%XYT>lk*?#~)wS=l4GTs>99PhFYSAWMFw z28fUwc7_7sK*$$_4D9%lUG#yT(*{dR!4mjDA;!uj{^b6XJn+T?Q%n8bvo8h$dk{@oAz#eS-E2%!iMup7iQgi zpm3lddmuk=Am25RKVu-9mqged!@0wSlz%R|xAf|wJCJ*J6r9Q~7|G`Or;74Nig?bc ztMUH;QqwNv1cuqMC3~_MO%ma!{8Hvzz+4MiL9tr=zl+)09EyP)RWN020#oX{)0yXT z<>={&eb1+hNd_^A->}^Z6(hYOBpe3Hb0)Dy`nn+456EBpLWY*^%Fw-^PSY-Fg`hos zIpgAU!x7tMe)q!)^1gNvfh88fhO>{X<4FfJBqFc_t*Ru!AJ}@6-*_$X!Kqt@S{^#6 z8~>p9kK49h86FBg z4zBGE8CAPNM)xiZc!ULSyp~~e_wbPM)A4FtU4YW2tK;L#adl2y1&oRD5?uX`uCkva z*DqjvFkTSo6INgkEP*%1)qwF6eelT6eZA+idaj_fG9`C0os*c!OM3G5Bjfpc--q;? zJ^y^d!%ke2))qAuHMha5`YjKNaXP8F$YC*P;fd=p&@3($-Ko)osgwW(@OBwu|E zffy=1wWer;7K@?I2?d^Y0WC;{o+6!!P;j-G^@3iZqSxlm)-IR^mcf_G(Qar>w6(aK zx8TpcwYjY)L1j)Tc|yS}(zK{@Iv}&$evZg0D+%SGgbzSI0{t-}^atuWMa^ZITJtx+ z!94a?GCTM}m3u4HW5c2?1%1nZF~ttd_;*b) z5+wjWD(=ik6o__l3lP^R2sWx9)>L8APs*?y6cNy;8)>-vh!F7Kfd^=H4pn#7#x|uN z0n4F|rDi=HVG-5S`FdYMoa6|qDbG{iR{5rGTsugDoSamLIZe@}RU4`gb&7tsg{V)n zDD=`UCs&7x^3UlCIPY94_Pwv^%z6x;y86`kQ}k}uL0h##ST4U3;#7XAIK`-Pm@0#X zB*pr8q9QFqBoLIv7m_iZKy?XmS;)Sxm_cSmhFvm3RzGStN0dVLYlzLSVN<%z_o1~f zmut>p?ek5e@^J;0FLXJW9AJVA=wiPSZo{Iz8&}8!rOLnzHc*5_Jgm!stCV4FIB(c- zOd3`nmj@I+!Wr@l=uMcL!zfQuR_WJHz4*Ub$e#Gm0=fi8(Di z6iu9TSl&MA5eUy|_z{-ykVbfhP&69V5iYco=0kn(nZE{WTA786*MiB$F{?1>Z}H43 z46^R+75BEM%bB2+PER#g1=wpCzj4e0{Fb2_)I;^$erZ+cwpAo;deQ|^bI=Q-Tr`c} zLE|R@3Mu^-7KlgE@FLL8ka zv6Mt7l`mXIChwO&8N>htZt8c5kRY5-qzLsflZf_yQ4nkc0B@a1_Nf58I+N~IA-^f` z`?XRq_neYv$!=PH^95`AN60VoUsP~NuG1wY$G#z-D5?7Z4Fbk(qMUBB)ge&FG&DkI zg}6BfUjpx?BImsCS?Ynr?zk9RPev~)Mm8JlK;`nb6w-br)u6ifr>K=bekm*hX=hJC zT2u>Of{q!at#Jo#)IPH@rwhE+4x*H(fB^l8^ zb5jOh?+_Nqoo?|BJ~jRqVqVsd1B6$A?T`xjk1=G>YUA@BP~(xPH>j=Bf}%h;?u5$* z2WXYAA(V4lV+1~A#V#J7|9~2cG*b0bFj9+urV$B4R`;k1e84?wqBM>?pH;lv)lL2+ zkol72-x9uy58@Bv{pT`!P%Vt-nL{;(3*$2$P-#@LCkqjJPPzS%xn6SupXEyx&b|uo zk`=QmRKeUsd3Z#GDZGuq4m^K&aR5o|FZKZvQywU8(G>sg0!@|h`tHRz>*q2oHh>E+YRW5HoTwf_^%cVNIqXSZn{d!5~`c^q|ihvvzuvuA0Z>^gh4=E$*Z&HX`cK#d%m{FS!Z`@b6s_ImsU_vXD@)KMitVouiK>gDt75s;mTP> zUnPa>7F~2K^~~mqr%4(V+YWK6CW(q&0U(IrH%XgJ`s*s_s7XHxy7$HmEu|83;(pTwOZLG^wur*yEVWsTcsC4)?Ok9}w-@)m5u>lQ!fDGznwOPSprtDw^ zpqS+(K@6B@(vF7%gyy@zJ6Q`}%=j*KZZbAsmhtrrWA$Yj|2o4s|FVn^W*9HPC;8}i z?8q>_d0ECthVciNWn7YBeDt!6c^SsfU6%1JJWYMaHJ4?4HN$xQWf{MdVVreY#$<-^ zeX3Vw5QLPkd+}Ot$}s-yvW)c^#=jMQ-L>B%{z-++lRGx0=TYLAJz<_6HcwwLPyY+41aN-e ZJblAFJz$=C#G|$1_mkq+EmuFK{wKbIi5~y} literal 0 HcmV?d00001 diff --git a/Common-Lisp-Bits-And-Pieces/Chapter-03/cds.lisp b/Common-Lisp-Bits-And-Pieces/Chapter-03/cds.lisp new file mode 100644 index 0000000..a8de58e --- /dev/null +++ b/Common-Lisp-Bits-And-Pieces/Chapter-03/cds.lisp @@ -0,0 +1,94 @@ +;;;; Simple CD Database program: +(defvar *cd-database* nil "The current state of the CD database.") + +(defun make-cd (title artist rating ripped) + "Creates a CD record." + (list :title title :artist artist :rating rating :ripped ripped)) + +(defun add-cd (cd) + "Adds a CD record to the database." + (push cd *cd-database*) (setf *cd-database* (sort *cd-database* #'cd-sort-by-title))) + +(defun print-cd-database (&optional database) + "Prints the current CD database, or, optionally, a passed in database." + (if database + (dolist (cd database) + (format t "~{~a: ~10t~a~%~}~%" cd)) + (dolist (cd *cd-database*) + (format t "~{~a: ~10t~a~%~}~%" cd)))) + +(defun prompt-read (prompt) + "Prompts for a single line of user input." + (format *query-io* "~a: " prompt) + (force-output *query-io*) + (read-line *query-io*)) + +(defun prompt-for-cd () + "Creates a CD record using user input." + (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 () + "Adds one or more CDs to the database with user input." + (loop (add-cd (prompt-for-cd)) + (if (not (y-or-n-p "Another? [y/n]: ")) (return)))) + +(defun cd-sort-by-title (a b) + "Sorts two CD records alphabetically." + (string< (getf a :title) (getf b :title))) + +(defun save-cds (filename) + "Saves the CD database to a file." + (with-open-file + (file-output filename + :direction :output + :if-exists :supersede) + (with-standard-io-syntax + (print *cd-database* file-output)))) + +(defun read-cds (filename) + "Loads a CD database from a file." + (with-open-file + (file-input filename) + (with-standard-io-syntax + (print-cd-database (setf *cd-database* (read file-input)))))) + +(defun delete-cds (selector-function) + "Deletes CD records according to a selector function." + (print-cd-database (setq *cd-database* (remove-if selector-function *cd-database*)))) + +(defun select (selector-function) + "Select records from a database based on a selector function." + (print-cd-database (remove-if-not selector-function *cd-database*))) + +(defun update (selector-function &key title artist rating (ripped nil ripped-p)) + "Update selected records in a database." + (setf *cd-database* + (mapcar + #'(lambda (row) + (when (funcall selector-function 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) *cd-database*))) + +(defun make-comparison-expression (field value) + "Create a comparison function for a field and a value in a plist." + `(equal (getf cd ,field) ,value)) + +(defun make-comparisons-list (fields) + "Create a list of plist comparison functions." + (loop while fields + collecting (make-comparison-expression (pop fields) (pop fields)))) + +(defmacro where (&rest clauses) + "Create an expression where all plist comparisons must be true." + `#'(lambda (row) (and ,@(make-comparisons-list clauses)))) + +;; Load up the CD database on startup: +(read-cds "~/.cds.db") +(print-cd-database) diff --git a/Common-Lisp-Bits-And-Pieces/Chapter-09/testing-framework.fasl b/Common-Lisp-Bits-And-Pieces/Chapter-09/testing-framework.fasl new file mode 100644 index 0000000000000000000000000000000000000000..f34baaf303bcc89813bc1fb9444578af87e76628 GIT binary patch literal 8099 zcmbVR4{#LMdEY;8?@s)?ldvK%Cag}91&Bl9kFlt+tJU3}_RQ|xakmEolNuqNK(_wn zBmwn=j^HHQHyfpPlSw+xki-}hoVFfM)1<%*0TUUpOB0!KW7X5fxVBp~(2nY)ElSd; z-}m0GbP|YUx;J~_j}*>ZCPn`Ur(lbZ(C<|&)(*CIS}Y+&a`#+&MT9{ zN>ZOE%gtRK-EHmZ7P&Rk)gk+<_jh%qtM@i#GELRNu8xkb&Vb(5(_J0h-_+fk&ID>U zSNEoSdfPhp1zIyr9qEHznWxvbLk~aL>gxf$oU9M(@_}@wr>(0~UcYw3+D(D=Yg?N) zY@Rpi;yA9cc2i)}#wbX5EP!u*pXG4AvO$do8-idcU}_0f389pVMuM@Bx~gUK|9gs( z|M-`GIEJGNUrG|N88nykW-K1i)$OVt2*(me(hcf}5!cNUu_B~~<4SO=(xA4K)GLXE z5-`=I8HqLo!U@Gtcf=A~C1d`!RLoR`qY`n`kE>;VFlHFBXh4r7x3cD z3PRF_gGEhqu{Rk`MT2G}78Q(wXiC?!5+OxIA_ZhV;rx6*PMYJMmTClvEE33~-JDeA zI@eIC?g_i43L#pUG?i#bNre2Kmw0Z42)B4Zs`0=e9a4=Xk>W+mMEF@sB>(d~GbZ>O zxeyfzDZKv_Pf+iCQLikbty4dLs(Q4c^zDeH`m~&STOSIQk89am`!%chwaLlJ^CdhN z*R21E`!>y|(DHBMUzZ|Cw2RyQUEBX2tMX5}z63(!``>5FG<6T2Og77EIjc%e`3LL z{)BLX3~=HJakzF^yvPp=7bP4+ILC%qb5`U$=oA@riaz`y#R9n>Tto7I85%}lRKd?@ zZ_?rXy!fdtWPi?tICqH(WTW55onpGC{>@Y{EBTa<&=LxOmdKF_?B^Z$2B-{c8<>iKsb3hm4)9sEQ6H-F8IP!Yyw43| zha6~fKHZXT{dRIv&((SKp}5;v*Rir!xLR=MHOHo}(Jt3{a3nA|eStL^u`X$E-k4Vb z9XaI^AuvRkSB4b4y@4lT6|N@Ab*rA&tdE%aRHHUjFGpZX2V)VKj&>PWjni}WK0Wu$ z5@;;Za`m46ccw-GoLx=GxY}0}+*RLGKDv^PV;jKw)X6S9k!j1Wn}5Lp8ad8SF&RWm z%BHsz(1CP$R01R+w9MktxPrWCs);0nOZq4uO1HLkrsXCXcNMv{ud}%qwvDy&j<(+Y zZJo3A^1-y++|&u*_IB8BCDVad*rSRY(#0fvUz{H`RPizw@c3Sb;@m>Eo}$d zTKbyWX@9)Bxv3}JvsNN&NPwthEx@>eXgIS$iMWgcbY)|q5|69VkXcf?8t*26ce0vn zH0HzYrJ^J(knn7H|B6Uugls}&zbtVwtPJ#VkWC);b6Y@#+6IL51IO|p-BKd9jEg*j z@HGPH1WS*Ar8Tce48UXyV)wBb0KUX4k+=8|1@JTA;_xVVvDX%|9gb$7BkXaSb~>6Q z6XN}As6gWWct67~;5}~RokT&KMe`gnK-zt0d3B|;-ej>ejLmn z22Z>P=67K89hfIzhG9MpE(n{;9GJhR4AoQ2F9b7&^*8`E0YIH_)W3k)8P+bQo(8YX z!21cdQnb)n>p9H_fLvk&vVu6|zH46$6s1`g?^uZ3p}ZAn%#*b{ zR)aFz%BzW$)8xh|tZ{5HtcA^IjbjaXQbWm2**W%1e$!ic;xOWG@>^tN#5%@^V{tg4 zoLEXZu@N{?KvtYzN;gUf2`fRS0q0REy*2^-lx}L?FQ*T6XVN`1a0c?LZ0*W)^i;}C zJq`~dV^P9#nafHOYCM)O0}#EWbkkf>3Snn`B&ynqB-t&H-Tv}gy5uzUsN(C7Lg*ne zZu(1+D}y%ZL+n1tO%Jf{5O9Q%o#b=-Ht@p>238RWHE!jF8UlnG)yPw54;iZJbvwkk z8$*2uyzV^!B7_*?Ejj|k8cv8Ie&}dMnc(BT$AmZ+rvhU(221CtDCzJfFU|f9Flg$85f2+thNk4pLzw49*jGIzugwGco!82cB53xm~@W1mB~I6(Ts^vSN9ujc{h zDH}MX2_W-FX$3M;NM+M9Z2K|*rLVoWM_vi=*xS|Bo^I;wStWP1%IO15?R`y{qD~ND%D=&TFo?g!moM<} z$N6&M1Fw64BPYa)KP3D~X*dWFgCM}gf`DUl2La^;ZwUHl;Deut5(e@IL8NiO7i}Sn zu8*2*v(xkiN3-40#F-H19;O0p{yVt}CT1Y+{|qf~u=W3l3giHYf6l~S|IYrkOk9Ui zzlvoZxn z9*UhQKw>eTH&vTFzG4qMMILb z!kruCEFzgBRG3~1e1x;sVkUW9nu9!8Hp0jQ9+Lvu2qbkje<0;GQ2y{fcOF)Ya!9U3 zyWBwY9b`WzdckL{SwG8v*qZfO9u3jF#{1l$V}|86;4U{Hr-3*rGe>?iz5hE5H2S}J zbTo-44r{edvzF30_H8_KF8X--f)->zz=oy+%<*}*V9=LaV>iWGdzKy&!xA7E| z2Im<0?6!GG_jhZxQsWT6+td5jTqBHafr(%BUBxouj01DfY6`<|Q5Zs<6}I_p#^Tj> ziFdX6s5cymhM>?KQlWCEh5~j=AeIQ|v80+VnX3qVRLatVE|hGK^B7KG>3F-6C^8rG zDAFonk-3oSQ_&*w3Qu0y!-AK1y@V45drA2CnUMEm4x z_K*9ZK|e^g`@WwK;O*`cAhss@f#SV%t2rt=!_Z|r}C$)`}Z^5mX8`H4I^ z$mH+x5KY)2#LECEyY>kS1$N3u_h=h*}1(pFN8{TX4?(pePlKE;ppE9_Ek-#m~Wr5XH}M$g(Yh-y=STEgZPy z=cxep3h#S?m+)~qU)o^*+$D$9tWR-)&*CG#i=WI4L0Bdv+nLbU@nPOA6MD)wc^@s> z?z%ZjN5&#>!w?(@WFrIz$UDYTN=7yXMcuHFM}cD?D_I_j1r%Km!0U_p zn4UD1zXibRMpKD|HxOc89FptM1Bg7 z_99Q-gGc)w@As5*+!CJi!Q3Ejsj5BJP$`v&E=iOMiAy5V5(4`^Sx=z^kzG zg@hk0@tl+fiVCEX0+&<}Dj+UM!l18V~XzYW*4rXgxdO@jm-^^knO3c4D6Q*pJ*K=%3ijow1(-hs{>9C1MjDdk9Ry9nm{G_VcgUk zi2wiq literal 0 HcmV?d00001 diff --git a/Common-Lisp-Bits-And-Pieces/Chapter-09/testing-framework.lisp b/Common-Lisp-Bits-And-Pieces/Chapter-09/testing-framework.lisp new file mode 100644 index 0000000..b93dafc --- /dev/null +++ b/Common-Lisp-Bits-And-Pieces/Chapter-09/testing-framework.lisp @@ -0,0 +1,38 @@ +(defpackage :BARRA-TESTING-FRAMEWORK + (:use :common-lisp)) + +(in-package "BARRA-TESTING-FRAMEWORK") + +(defvar *test-name* nil) + +(defmacro with-gensyms ((&rest names) &body body) +`(let ,(loop for n in names collect `(,n (gensym))) + ,@body)) + +(defmacro deftest (name parameters &body body) + "Define a test function. Within a test function we can call + other test functions or use 'check' to run individual test + cases." + `(defun ,name ,parameters + (let ((*test-name* (append *test-name* (list ',name)))) + ,@body))) + +(defmacro check (&body forms) + "Run each expression in 'forms' as a test case." + `(combine-results + ,@(loop for f in forms collect `(report-result ,f ',f)))) + +(defmacro combine-results (&body forms) + "Combine the results (as booleans) of evaluating 'forms' in order." + (with-gensyms (result) + `(let ((,result t)) + ,@(loop for f in forms collect `(unless ,f (setf ,result nil))) + ,result))) + +(defun report-result (result form) + "Report the results of a single test case. Called by 'check'." + (format t "~:[FAIL~;PASS~] - ~a: ~a~%" result *test-name* form) + result) + +(let ((pack (find-package :foo))) + (do-all-symbols (sym pack) (when (eql (symbol-package sym) pack) (export sym)))) diff --git a/Common-Lisp-Bits-And-Pieces/Chapter-15/barra-filename-library.fasl b/Common-Lisp-Bits-And-Pieces/Chapter-15/barra-filename-library.fasl new file mode 100644 index 0000000000000000000000000000000000000000..b6f582b99dd7b796462adea49f4b48d1dd95c965 GIT binary patch literal 8109 zcmbtZd2kfhneXGhIdsh-31I`)FuIWBL0l$yjUDx9dNdunXC^Z(8zuMoPlVrA|4c;o3?bMRBT?mVRwped=4LBqUb_MLkhLG%QPs z9?zbEzI{EtU7emM2M78*-ln|+eO*nvI|c_knpy_>`Ud)aYR~?CO)Yyn_6>Cn`ZnIj z8huYfr~Zz#0`w^|pvE3(rwvHUBJ~g)I?Hi-diu5|7d`nr^XlmO_0r5|+cd zFB+5M<}d9m3n($UMUTYVVN5;52B)3n*@6`JWm#yaGrt~JLp$BsX5S-<8fcMX0oqxN zZ9aLY64&FtDD5nP)#&*Hl{_M;JMt=ifD5&d^ny1E6Hpd}xCO-#*7ef6;=#6Xi>^e% zf@Tl5sp>c-#7!u%lTuPnI4?hng5|iU=mvq3l>%A0i=&N})2&T%chE{}gs>~FOW^=4 z&+9zKbCn{f;c2?T2GjJ>4V03~k{S^nRfKw9O`RWT4?;^y&;38=*(zr{YjU}hM zoA`vCB<#XFG$D$#t_IlaVw?>W#tDO{v0;3WN`X{^-e}bWf;T#f-V4KRaFy;gwS=X# z7CET^OSucQGk!}L-he6!8J}dd6dL;ir8Z;-0-1+x87ZEMK>ghH^Iy`k4Vc!O(tH4< zDVTqHeSOX$vfdKaTp1cg*VIT4bE2JCDQSS0ex7QpGR;18K{sh|=T+(LQK)JbNVB&Z z=Y$I^yL%n)|0z$aM6wA5`Vr50paFP@0|bSngaX}kxO)qqETczh(n*feM6r0po}kub zneCFBSmCz7ZOYnm#QGYa5X9GTP?Y+;zvE4@3*Pysl#?oVPvbf z9Skf}J6g@ipsQk*FFT-2%L8@wK$S*LLI2)S}4_aEvuXHkDVc-?b=Cvu~6#X z>X7mAEcOMjaxSg}4+xFj&S>*Cs&Dv-(c2Zn3iAJ%1C_x*LyK(V$F}qEj~0R|sxr+Y zVw#2CSfAByemK?bX1(c4#7CrY+DO1Gc(96Q(<+DrTF*CxP$aIqwaV;h0r_F2MRsd7 zxtdHk2R1VXqdCR(m=bPv>kd(hM&)o|6O5@zJ1~u~knaxLap-U{8!%j&HQ}%w2MF8I z1j8=KNK%`s$4N{eu?4ocf%m^9(kf!wqVxA6v&EQ~Y);!^+{@+6lF-K1!`<7NS=M;0 zBHE?pNO8h$OP1NeQdbsSqNMmz1u061j+&KDer82W;moQwTQw~aC(Dk~YMX_BheLyf zNzqofd@L?$tKO@E-C5*xa)Os1zkyc6ftmi^B*-qXjRnkdd80USQ-NAkQ*# zH;}(%WCxHZ8TkZ+pPw@FaTx44BOe9whm3?NxThKUO{nc=lpl)}ptdMPB#(RDajNm;};5}1c@}8;1j*@DFTp}M2rDV)cOL#_} zHx+|hp*J~_ahL}j!I5mi3771fYMWiI@ygPT%zqt;Gw_D0aVEp4rsT_u-a|Fy%UY@r zlHkbB&_t_Kc|d-`@%?{-o=QsI8A?@z&bHbx95jz!uxcCo)(r{g?Kq-hTwD-Mj5DWD zpdn*q_UDYyu7pzBwa{6ag`1Ro1?bCW+gbS{jtS*+>GE{Cd;-fSQA6{?HWTt?mVbw( zpSkLRTn<6$I3#Q{i2S9~ob2(derUj<@~&J8?}g~1*W{&}4F1v`Sc#5{v84^8iolDM z#8^~`xyfU0B9Yx;JN6)ZNGItRNPo_uAzxSX{$W~0S#EiW=T^fKfTai`I=sA-3}9|? zo$lVuCri` zi>g~wzYrCZeE_P6PqSlnCK*^L={MD;Rid)8A=?*qlYY0Bi`1aeuDX_ve$POE?*R|& zi-usA)xT%3YpBc9*)!O+XJ}yXfCo2E``1%)P#_0$`etAv1+mn^6n;DnCJyGngsJdK z1}0G9cA6}+%-G7Psdrm~lF5prfW|B)a(H8D^#gL~;2uWFaay4qi$!8!1|hRdl04}4 zK1TNgnZ^$Z-nHu79RNg$$(em*LLi3SKOI1@I5Ygvk{*h-FyTiVup9oY3D}xUqsi!) z^)7D*hh1b$8U1G#igv(o0jRVfoDsetA0#Ds1WM$a?zkN`j6395 zSXTAoqkN4j#r2JD*rl}TNV-YTOY9!`y#H|T3Aq1RwB%JOWoj$ z)m9fo-)g}nCd-^NUs+jZK?qeo<6pI6rZ#zBX@c4j*xQ(c+G;`dTP`dEm;O(%7h(JY zM;-ky(`dlk{J~_(gEGfWXKWR8cZ>UAh`C+ zjGV%O4Ms~)eSnd#L-lAMqX9EW+BoQ&=hPP^>WhMF0Xz zha=b)Wg7Fb%Y^^dlw(LdAG3vw*e&F^(@QLi#xmp1F6s$+5Yt+E-aEBJV-7rBGu010 zvPlu-mIY2H5yNBxCjcHcYWemrmXDp-tKLkXZ?HfCp<+$_!h<9-pws$bShLseklXc& zEI3kN6J)Q~;i;9kM8bF!q^s@Xb8yU*q=M$koGytXIl+f3GW#Fs20XC+fsQ~VsU|i+ zX0{v_sOz!%0OV2946use7QR@OG=D(S3TxqbO^+7hb2D_NN|&p% zHCgk^F(Ba_3-A~OuY+y^2TW)9@LEY#BaiqZdPt5zENhPw$q(mrGAz-v@MQtq{WISv zPFB}c+p5>$X;*iz)&DaKt+F?Yhar?w@O0IxQts+s3-H6Cb!tG0&y z(ninW)&qg6012!J(11NqFhgiSoGBtRE9^0z3kZHd3HGov~y$g~6#2D#kCXsDBh6`GAL&CaBlu$t{Oll@8Ld29g#Lfq-oT*!vPL^AwMP zx$SV>OQMA&S7T5vx8a7hC{gT4u6A8=62}qy5qolzduFxMaijoHk&qBAuzkhQTRd5L z)SbAiWYRNZb(Kw4Krpu@xbjJ7!ePTLti28vd`LWIwb%$pF7TwXk({=^XvLRX2Tk*q zV^(n`C^6IYcV-hDr+qPx@A{$@+HI7}KdCX#Z16E;9+%1&X+(g!Vo`Z zoH7F@5Eu|)YdmHo(nR6ojA-YqCIOhSeRKwy@SLfgn`C4RLjPVy{+5T>|2U)1Aia~( z)4Z#G+Umwcn12LhHo`+%k)hbHiR6gmxo3cRXiLEOwQ^(TYZIL>oCq2J9vYvsJbia~ zLVdw0Z=8-8WqdeQMwIbsh$C~t@E<~{;aBDe1okP_cvm$(3{M1pIIE0bB@n`|XcOQ1 zLb>rDC+x6qGf!bReiSl33>oi9*MBKElFz{ObJCNCBF6UP5o6bJn=<|@qKtips~VeVrWj-Z{F0Bu&(0wAtEZq7a>RBRwy-cnZ?PA zi-I!(RNTd@#-k@x1INZ`Fkg*ao*4YR`TDOM!z+wI{(6uKL&c^TjI*$$%X8NA_tJ78B*LC8Zg z9H9r{-l`aXm|cULYjZmXe7J0wL7MosImOV?^RexqL)>^n-eeg&`}QH@Z2meYcK-4D z+m0dYELy{yI3N9-34Vbz90?cBw`in=hZf5Zb@c<#duE6~Z4sHnlFc}|(PqlPTsx#$ zHkl)d%btJYb4a*{qy!dn7nlG#Oxg@)>-Q38vi4H446nF-kw`h#}`6#%(y;eZS%9)fwg#TSYB)JR+=kbuX{Z#`r+xxu^j zV)MIKTNuCXT<1vx=2y}WdG>i8;5S5WvYkXp9~mKsc=8jT{3B03<;iWxt+z31-VYyq zc)5ZPT6uZ15VQ)iR}5N3*-L^}B6}%(3X;8+pw%LKtwF0*_S%A0o9wj*t#-(!l@Lmu zZ;0&U5b@@pcUKp*metm?i^6vy?xHCd@)-}`h~CQ4-0L}d^lx%BcQ8kf_T*@;Ek}jZ5({f%zP+rEP&woDR&qD6kjC#y(p78B3R!AQ|+f42<6H5gpzr1L-_e0_VW+y c=Wp511p9f$k literal 0 HcmV?d00001 diff --git a/Common-Lisp-Bits-And-Pieces/Chapter-15/barra-filename-library.lisp b/Common-Lisp-Bits-And-Pieces/Chapter-15/barra-filename-library.lisp new file mode 100644 index 0000000..1a51fc5 --- /dev/null +++ b/Common-Lisp-Bits-And-Pieces/Chapter-15/barra-filename-library.lisp @@ -0,0 +1,99 @@ +(defpackage BARRA-FILENAME-PACKAGE + (:use common-lisp) + (:export + :component-present-p + :directory-pathname-p + :pathname-as-directory + :pathname-as-file + :directory-wildcard + :file-exists-p + :list-directory + :walk-directory)) + +(in-package BARRA-FILENAME-PACKAGE) + +(defun component-present-p (value) + (and value (not (eql value :unspecified)))) + +(defun directory-pathname-p (pathname) + (and + (not (component-present-p (pathname-name pathname))) + (not (component-present-p (pathname-type pathname))))) + +(defun pathname-as-directory (path) + (let ((pathname (pathname path))) + (if + (directory-pathname-p pathname) + pathname + (make-pathname + :host (pathname-host pathname) + :device (pathname-device pathname) + :directory (append (or (pathname-directory pathname) (file-namestring pathname)) + (list (file-namestring pathname))) + :name nil + :type nil + :defaults pathname)))) + +(defun directory-wildcard (dirname) + (make-pathname + :name :wild + :type #-clisp :wild #+clisp nil + :defaults (pathname-as-directory dirname))) + +(defun list-directory (dirname) + (when (wild-pathname-p dirname) + (error "Can only list concrete directory names.")) + (directory (directory-wildcard dirname))) + +(defun file-exists-p (pathname) + #+(or sbcl lispworks openmcl) + (probe-file pathname) + + #+(or allegro cmu) + (or (probe-file (pathname-as-directory pathname)) + (probe-file pathname)) + + #+clisp + (or (ignore-errors + (probe-file (pathname-as-file pathname))) + (ignore-errors + (let ((directory-form (pathname-as-directory pathname))) + (when (ext:probe-directory directory-form) + directory-form)))) + + #-(or sbcl cmu lispworks openmcl allegro clisp) + (error "list-directory not implemented")) + +#+clisp +(defun clisp-subdirectories-wildcard (wildcard) + (make-pathname + :directory (append (pathname-directory wildcard) (list :wild)) + :name nil + :type nil + :defaults wildcard)) + +(defun pathname-as-file (name) + (let ((pathname (pathname name))) + (when (wild-pathname-p pathname) + (error "Can't reliably convert wild pathnames.")) + (if (directory-pathname-p name) + (let* ((directory (pathname-directory pathname)) + (name-and-type (pathname (first (last directory))))) + (make-pathname + :directory (butlast directory) + :name (pathname-name name-and-type) + :type (pathname-type name-and-type) + :defaults pathname)) + pathname))) + +(defun walk-directory (dirname fn &key directories (test (constantly t))) + (labels + ((walk (name) + (cond + ((directory-pathname-p name) + (when (and directories (funcall test name)) + (funcall fn name)) + (dolist (x (list-directory name)) (walk x))) + ((funcall test name) (funcall fn name))))) + (walk (pathname-as-directory dirname)))) + diff --git a/Common-Lisp-Bits-And-Pieces/GTK-Test.lisp b/Common-Lisp-Bits-And-Pieces/GTK-Test.lisp new file mode 100644 index 0000000..1d92c8f --- /dev/null +++ b/Common-Lisp-Bits-And-Pieces/GTK-Test.lisp @@ -0,0 +1,34 @@ +(ql:quickload :cl-cffi-gtk) + +; Main window +(defvar window (make-instance 'gtk:gtk-window :type :toplevel :title "GTK Test")) +(defvar vbox (make-instance 'gtk:gtk-box :orientation :vertical + :spacing 10 + :margin 10)) + +(defvar text-panel-box (make-instance 'gtk:gtk-box :orientation :horizontal :spacing 1 :margin 10)) +(defvar panel-left-window (make-instance 'gtk:gtk-scrolled-window :height-request 500 :width-request 100)) +(defvar panel-left (make-instance 'gtk:gtk-text-view :height-request 300 :width-request 100 :wrap-mode :word-char :vscroll-policy :natural)) +(defvar panel-right-window (make-instance 'gtk:gtk-scrolled-window :height-request 500 :width-request 300)) +(defvar panel-right (make-instance 'gtk:gtk-text-view :height-request 300 :width-request 300 :wrap-mode :word-char :vscroll-policy :natural)) + +(gtk:gtk-box-pack-start vbox text-panel-box) +(gtk:gtk-container-add panel-left-window panel-left) +(gtk:gtk-box-pack-start text-panel-box panel-left-window) +(gtk:gtk-container-add panel-right-window panel-right) +(gtk:gtk-box-pack-end text-panel-box panel-right-window) + +(gtk:within-main-loop + ; Quit program when window closed + (gobject:g-signal-connect window "destroy" (lambda (widget) + (declare (ignore widget)) + (gtk:leave-gtk-main))) + ; Display GUI + (gtk:gtk-container-add window vbox) + (gtk:gtk-widget-show-all window)) + +(loop + (sleep 3) +(setf (gtk:gtk-text-buffer-text (gtk:gtk-text-view-buffer panel-right)) (format nil "~a~a" (gtk:gtk-text-buffer-text (gtk:gtk-text-view-buffer panel-right)) " +Hello, world! +"))) diff --git a/Common-Lisp-Bits-And-Pieces/Web-Chat.lisp b/Common-Lisp-Bits-And-Pieces/Web-Chat.lisp new file mode 100644 index 0000000..2d792f8 --- /dev/null +++ b/Common-Lisp-Bits-And-Pieces/Web-Chat.lisp @@ -0,0 +1,88 @@ +(ql:quickload '(clack websocket-driver alexandria)) + +(defvar *connections* (make-hash-table)) + +(defun handle-new-connection (con) + (setf (gethash con *connections*) + (format nil "user-~a" (random 100000)))) + +(defun broadcast-to-room (connection message) + (let ((message (format nil "~a: ~a" + (gethash connection *connections*) + message))) + (loop :for con :being :the :hash-key :of *connections* :do + (websocket-driver:send con message)))) + +(defun handle-close-connection (connection) + (let ((message (format nil " .... ~a has left." + (gethash connection *connections*)))) + (remhash connection *connections*) + (loop :for con :being :the :hash-key :of *connections* :do + (websocket-driver:send con message)))) + +(defun chat-server (env) + (let ((ws (websocket-driver:make-server env))) + (websocket-driver:on :open ws + (lambda () (handle-new-connection ws))) + + (websocket-driver:on :message ws + (lambda (msg) + (broadcast-to-room ws msg))) + + (websocket-driver:on :close ws + (lambda (&key code reason) + (declare (ignore code reason)) + (handle-close-connection ws))) + (lambda (responder) + (declare (ignore responder)) + (websocket-driver:start-connection ws)))) + +(defvar *html* + " + + + + + LISP-CHAT + + + +
    +
+
+ +
+ + + +") + +(defun client-server (env) + (declare (ignore env)) + `(200 (:content-type "text/html") + (,*html*))) + +(defvar *chat-handler* (clack:clackup #'chat-server :port 12345)) +(defvar *client-handler* (clack:clackup #'client-server :port 8080)) +