From 7023e4c7c8f158df78b5e71ddc2640290409eca1 Mon Sep 17 00:00:00 2001 From: chers Date: Fri, 31 Jul 2026 09:18:39 +0000 Subject: Update cl-bbs --- HyperSpec/Data/Map_Sym.txt | 1956 +++++++++++++++++++++++++++++++++ HyperSpec/Mop_Sym.txt | 1 + package.lisp | 4 + server/admin.lisp | 574 ++++++++++ server/handlers.lisp | 903 +++++++++++++++ server/main.lisp | 61 + server/models.lisp | 35 + server/rss.lisp | 122 ++ server/storage.lisp | 43 + server/views.lisp | 1009 +++++++++++++++++ static/about.html | 41 + static/art.ico | Bin 0 -> 32038 bytes static/errors/400.html | 21 + static/errors/403.html | 21 + static/errors/404.html | 21 + static/errors/405.html | 21 + static/errors/429.html | 14 + static/errors/500.html | 21 + static/errors/502.html | 21 + static/errors/503.html | 21 + static/errors/504.html | 21 + static/favicon.ico | Bin 0 -> 15406 bytes static/img/cloudflare.png | Bin 0 -> 82869 bytes static/img/freebsd.png | Bin 0 -> 14218 bytes static/img/gnu.png | Bin 0 -> 13357 bytes static/img/i2p.png | Bin 0 -> 9192 bytes static/img/mit-scheme.png | Bin 0 -> 16104 bytes static/img/nginx.png | Bin 0 -> 18535 bytes static/img/nocookie.png | Bin 0 -> 2191 bytes static/img/nojs.png | Bin 0 -> 17763 bytes static/img/snake.png | Bin 0 -> 15476 bytes static/img/src/freebsd.svg | 1 + static/img/src/gnu.svg | 94 ++ static/img/src/mit-scheme.svg | 599 ++++++++++ static/img/src/nginx.svg | 20 + static/img/src/sicp-snake.png | Bin 0 -> 18342 bytes static/img/tux.png | Bin 0 -> 11913 bytes static/img/valid-html.png | Bin 0 -> 2066 bytes static/index.html | 86 ++ static/jscl-snippets.js | 319 ++++++ static/larp.ico | Bin 0 -> 32038 bytes static/lisp.html | 14 + static/manifest.json | 18 + static/schemebbs.png | Bin 0 -> 2109 bytes static/styles/about.css | 82 ++ static/styles/common.css | 248 +++++ static/styles/syntax/colorful.css | 13 + static/styles/syntax/simple.css | 19 + static/styles/themes/colored.css | 6 + static/styles/themes/default.css | 288 +++++ static/styles/themes/light.css | 287 +++++ static/styles/themes/matrix.css | 423 +++++++ static/styles/themes/no.css | 1 + static/sw.js | 31 + static/userscripts/highlight.user.js | 22 + static/userscripts/localjump.user.js | 17 + static/userscripts/unvip.user.js | 18 + static/userscripts/wordfilter.user.js | 29 + 58 files changed, 7566 insertions(+) create mode 100644 HyperSpec/Data/Map_Sym.txt create mode 100644 HyperSpec/Mop_Sym.txt create mode 100644 package.lisp create mode 100644 server/admin.lisp create mode 100644 server/handlers.lisp create mode 100644 server/main.lisp create mode 100644 server/models.lisp create mode 100644 server/rss.lisp create mode 100644 server/storage.lisp create mode 100644 server/views.lisp create mode 100644 static/about.html create mode 100644 static/art.ico create mode 100644 static/errors/400.html create mode 100644 static/errors/403.html create mode 100644 static/errors/404.html create mode 100644 static/errors/405.html create mode 100644 static/errors/429.html create mode 100644 static/errors/500.html create mode 100644 static/errors/502.html create mode 100644 static/errors/503.html create mode 100644 static/errors/504.html create mode 100644 static/favicon.ico create mode 100644 static/img/cloudflare.png create mode 100644 static/img/freebsd.png create mode 100644 static/img/gnu.png create mode 100644 static/img/i2p.png create mode 100644 static/img/mit-scheme.png create mode 100644 static/img/nginx.png create mode 100644 static/img/nocookie.png create mode 100644 static/img/nojs.png create mode 100644 static/img/snake.png create mode 100644 static/img/src/freebsd.svg create mode 100644 static/img/src/gnu.svg create mode 100644 static/img/src/mit-scheme.svg create mode 100644 static/img/src/nginx.svg create mode 100644 static/img/src/sicp-snake.png create mode 100644 static/img/tux.png create mode 100644 static/img/valid-html.png create mode 100644 static/index.html create mode 100644 static/jscl-snippets.js create mode 100644 static/larp.ico create mode 100644 static/lisp.html create mode 100644 static/manifest.json create mode 100644 static/schemebbs.png create mode 100644 static/styles/about.css create mode 100644 static/styles/common.css create mode 100644 static/styles/syntax/colorful.css create mode 100644 static/styles/syntax/simple.css create mode 100644 static/styles/themes/colored.css create mode 100644 static/styles/themes/default.css create mode 100644 static/styles/themes/light.css create mode 100644 static/styles/themes/matrix.css create mode 100644 static/styles/themes/no.css create mode 100644 static/sw.js create mode 100644 static/userscripts/highlight.user.js create mode 100644 static/userscripts/localjump.user.js create mode 100644 static/userscripts/unvip.user.js create mode 100644 static/userscripts/wordfilter.user.js diff --git a/HyperSpec/Data/Map_Sym.txt b/HyperSpec/Data/Map_Sym.txt new file mode 100644 index 0000000..eb1a000 --- /dev/null +++ b/HyperSpec/Data/Map_Sym.txt @@ -0,0 +1,1956 @@ +&ALLOW-OTHER-KEYS +../Body/03_da.htm +&AUX +../Body/03_da.htm +&BODY +../Body/03_dd.htm +&ENVIRONMENT +../Body/03_dd.htm +&KEY +../Body/03_da.htm +&OPTIONAL +../Body/03_da.htm +&REST +../Body/03_da.htm +&WHOLE +../Body/03_dd.htm +* +../Body/a_st.htm +** +../Body/v__stst_.htm +*** +../Body/v__stst_.htm +*BREAK-ON-SIGNALS* +../Body/v_break_.htm +*COMPILE-FILE-PATHNAME* +../Body/v_cmp_fi.htm +*COMPILE-FILE-TRUENAME* +../Body/v_cmp_fi.htm +*COMPILE-PRINT* +../Body/v_cmp_pr.htm +*COMPILE-VERBOSE* +../Body/v_cmp_pr.htm +*DEBUG-IO* +../Body/v_debug_.htm +*DEBUGGER-HOOK* +../Body/v_debugg.htm +*DEFAULT-PATHNAME-DEFAULTS* +../Body/v_defaul.htm +*ERROR-OUTPUT* +../Body/v_debug_.htm +*FEATURES* +../Body/v_featur.htm +*GENSYM-COUNTER* +../Body/v_gensym.htm +*LOAD-PATHNAME* +../Body/v_ld_pns.htm +*LOAD-PRINT* +../Body/v_ld_prs.htm +*LOAD-TRUENAME* +../Body/v_ld_pns.htm +*LOAD-VERBOSE* +../Body/v_ld_prs.htm +*MACROEXPAND-HOOK* +../Body/v_mexp_h.htm +*MODULES* +../Body/v_module.htm +*PACKAGE* +../Body/v_pkg.htm +*PRINT-ARRAY* +../Body/v_pr_ar.htm +*PRINT-BASE* +../Body/v_pr_bas.htm +*PRINT-CASE* +../Body/v_pr_cas.htm +*PRINT-CIRCLE* +../Body/v_pr_cir.htm +*PRINT-ESCAPE* +../Body/v_pr_esc.htm +*PRINT-GENSYM* +../Body/v_pr_gen.htm +*PRINT-LENGTH* +../Body/v_pr_lev.htm +*PRINT-LEVEL* +../Body/v_pr_lev.htm +*PRINT-LINES* +../Body/v_pr_lin.htm +*PRINT-MISER-WIDTH* +../Body/v_pr_mis.htm +*PRINT-PPRINT-DISPATCH* +../Body/v_pr_ppr.htm +*PRINT-PRETTY* +../Body/v_pr_pre.htm +*PRINT-RADIX* +../Body/v_pr_bas.htm +*PRINT-READABLY* +../Body/v_pr_rda.htm +*PRINT-RIGHT-MARGIN* +../Body/v_pr_rig.htm +*QUERY-IO* +../Body/v_debug_.htm +*RANDOM-STATE* +../Body/v_rnd_st.htm +*READ-BASE* +../Body/v_rd_bas.htm +*READ-DEFAULT-FLOAT-FORMAT* +../Body/v_rd_def.htm +*READ-EVAL* +../Body/v_rd_eva.htm +*READ-SUPPRESS* +../Body/v_rd_sup.htm +*READTABLE* +../Body/v_rdtabl.htm +*STANDARD-INPUT* +../Body/v_debug_.htm +*STANDARD-OUTPUT* +../Body/v_debug_.htm +*TERMINAL-IO* +../Body/v_termin.htm +*TRACE-OUTPUT* +../Body/v_debug_.htm ++ +../Body/a_pl.htm +++ +../Body/v_pl_plp.htm ++++ +../Body/v_pl_plp.htm +- +../Body/a__.htm +/ +../Body/a_sl.htm +// +../Body/v_sl_sls.htm +/// +../Body/v_sl_sls.htm +/= +../Body/f_eq_sle.htm +1+ +../Body/f_1pl_1_.htm +1- +../Body/f_1pl_1_.htm +< +../Body/f_eq_sle.htm +<= +../Body/f_eq_sle.htm += +../Body/f_eq_sle.htm +> +../Body/f_eq_sle.htm +>= +../Body/f_eq_sle.htm +ABORT +../Body/a_abort.htm +ABS +../Body/f_abs.htm +ACONS +../Body/f_acons.htm +ACOS +../Body/f_asin_.htm +ACOSH +../Body/f_sinh_.htm +ADD-METHOD +../Body/f_add_me.htm +ADJOIN +../Body/f_adjoin.htm +ADJUST-ARRAY +../Body/f_adjust.htm +ADJUSTABLE-ARRAY-P +../Body/f_adju_1.htm +ALLOCATE-INSTANCE +../Body/f_alloca.htm +ALPHA-CHAR-P +../Body/f_alpha_.htm +ALPHANUMERICP +../Body/f_alphan.htm +AND +../Body/a_and.htm +APPEND +../Body/f_append.htm +APPLY +../Body/f_apply.htm +APROPOS +../Body/f_apropo.htm +APROPOS-LIST +../Body/f_apropo.htm +AREF +../Body/f_aref.htm +ARITHMETIC-ERROR +../Body/e_arithm.htm +ARITHMETIC-ERROR-OPERANDS +../Body/f_arithm.htm +ARITHMETIC-ERROR-OPERATION +../Body/f_arithm.htm +ARRAY +../Body/t_array.htm +ARRAY-DIMENSION +../Body/f_ar_dim.htm +ARRAY-DIMENSION-LIMIT +../Body/v_ar_dim.htm +ARRAY-DIMENSIONS +../Body/f_ar_d_1.htm +ARRAY-DISPLACEMENT +../Body/f_ar_dis.htm +ARRAY-ELEMENT-TYPE +../Body/f_ar_ele.htm +ARRAY-HAS-FILL-POINTER-P +../Body/f_ar_has.htm +ARRAY-IN-BOUNDS-P +../Body/f_ar_in_.htm +ARRAY-RANK +../Body/f_ar_ran.htm +ARRAY-RANK-LIMIT +../Body/v_ar_ran.htm +ARRAY-ROW-MAJOR-INDEX +../Body/f_ar_row.htm +ARRAY-TOTAL-SIZE +../Body/f_ar_tot.htm +ARRAY-TOTAL-SIZE-LIMIT +../Body/v_ar_tot.htm +ARRAYP +../Body/f_arrayp.htm +ASH +../Body/f_ash.htm +ASIN +../Body/f_asin_.htm +ASINH +../Body/f_sinh_.htm +ASSERT +../Body/m_assert.htm +ASSOC +../Body/f_assocc.htm +ASSOC-IF +../Body/f_assocc.htm +ASSOC-IF-NOT +../Body/f_assocc.htm +ATAN +../Body/f_asin_.htm +ATANH +../Body/f_sinh_.htm +ATOM +../Body/a_atom.htm +BASE-CHAR +../Body/t_base_c.htm +BASE-STRING +../Body/t_base_s.htm +BIGNUM +../Body/t_bignum.htm +BIT +../Body/a_bit.htm +BIT-AND +../Body/f_bt_and.htm +BIT-ANDC1 +../Body/f_bt_and.htm +BIT-ANDC2 +../Body/f_bt_and.htm +BIT-EQV +../Body/f_bt_and.htm +BIT-IOR +../Body/f_bt_and.htm +BIT-NAND +../Body/f_bt_and.htm +BIT-NOR +../Body/f_bt_and.htm +BIT-NOT +../Body/f_bt_and.htm +BIT-ORC1 +../Body/f_bt_and.htm +BIT-ORC2 +../Body/f_bt_and.htm +BIT-VECTOR +../Body/t_bt_vec.htm +BIT-VECTOR-P +../Body/f_bt_vec.htm +BIT-XOR +../Body/f_bt_and.htm +BLOCK +../Body/s_block.htm +BOOLE +../Body/f_boole.htm +BOOLE-1 +../Body/v_b_1_b.htm +BOOLE-2 +../Body/v_b_1_b.htm +BOOLE-AND +../Body/v_b_1_b.htm +BOOLE-ANDC1 +../Body/v_b_1_b.htm +BOOLE-ANDC2 +../Body/v_b_1_b.htm +BOOLE-C1 +../Body/v_b_1_b.htm +BOOLE-C2 +../Body/v_b_1_b.htm +BOOLE-CLR +../Body/v_b_1_b.htm +BOOLE-EQV +../Body/v_b_1_b.htm +BOOLE-IOR +../Body/v_b_1_b.htm +BOOLE-NAND +../Body/v_b_1_b.htm +BOOLE-NOR +../Body/v_b_1_b.htm +BOOLE-ORC1 +../Body/v_b_1_b.htm +BOOLE-ORC2 +../Body/v_b_1_b.htm +BOOLE-SET +../Body/v_b_1_b.htm +BOOLE-XOR +../Body/v_b_1_b.htm +BOOLEAN +../Body/t_ban.htm +BOTH-CASE-P +../Body/f_upper_.htm +BOUNDP +../Body/f_boundp.htm +BREAK +../Body/f_break.htm +BROADCAST-STREAM +../Body/t_broadc.htm +BROADCAST-STREAM-STREAMS +../Body/f_broadc.htm +BUILT-IN-CLASS +../Body/t_built_.htm +BUTLAST +../Body/f_butlas.htm +BYTE +../Body/f_by_by.htm +BYTE-POSITION +../Body/f_by_by.htm +BYTE-SIZE +../Body/f_by_by.htm +CAAAAR +../Body/f_car_c.htm +CAAADR +../Body/f_car_c.htm +CAAAR +../Body/f_car_c.htm +CAADAR +../Body/f_car_c.htm +CAADDR +../Body/f_car_c.htm +CAADR +../Body/f_car_c.htm +CAAR +../Body/f_car_c.htm +CADAAR +../Body/f_car_c.htm +CADADR +../Body/f_car_c.htm +CADAR +../Body/f_car_c.htm +CADDAR +../Body/f_car_c.htm +CADDDR +../Body/f_car_c.htm +CADDR +../Body/f_car_c.htm +CADR +../Body/f_car_c.htm +CALL-ARGUMENTS-LIMIT +../Body/v_call_a.htm +CALL-METHOD +../Body/m_call_m.htm +CALL-NEXT-METHOD +../Body/f_call_n.htm +CAR +../Body/f_car_c.htm +CASE +../Body/m_case_.htm +CATCH +../Body/s_catch.htm +CCASE +../Body/m_case_.htm +CDAAAR +../Body/f_car_c.htm +CDAADR +../Body/f_car_c.htm +CDAAR +../Body/f_car_c.htm +CDADAR +../Body/f_car_c.htm +CDADDR +../Body/f_car_c.htm +CDADR +../Body/f_car_c.htm +CDAR +../Body/f_car_c.htm +CDDAAR +../Body/f_car_c.htm +CDDADR +../Body/f_car_c.htm +CDDAR +../Body/f_car_c.htm +CDDDAR +../Body/f_car_c.htm +CDDDDR +../Body/f_car_c.htm +CDDDR +../Body/f_car_c.htm +CDDR +../Body/f_car_c.htm +CDR +../Body/f_car_c.htm +CEILING +../Body/f_floorc.htm +CELL-ERROR +../Body/e_cell_e.htm +CELL-ERROR-NAME +../Body/f_cell_e.htm +CERROR +../Body/f_cerror.htm +CHANGE-CLASS +../Body/f_chg_cl.htm +CHAR +../Body/f_char_.htm +CHAR-CODE +../Body/f_char_c.htm +CHAR-CODE-LIMIT +../Body/v_char_c.htm +CHAR-DOWNCASE +../Body/f_char_u.htm +CHAR-EQUAL +../Body/f_chareq.htm +CHAR-GREATERP +../Body/f_chareq.htm +CHAR-INT +../Body/f_char_i.htm +CHAR-LESSP +../Body/f_chareq.htm +CHAR-NAME +../Body/f_char_n.htm +CHAR-NOT-EQUAL +../Body/f_chareq.htm +CHAR-NOT-GREATERP +../Body/f_chareq.htm +CHAR-NOT-LESSP +../Body/f_chareq.htm +CHAR-UPCASE +../Body/f_char_u.htm +CHAR/= +../Body/f_chareq.htm +CHAR< +../Body/f_chareq.htm +CHAR<= +../Body/f_chareq.htm +CHAR= +../Body/f_chareq.htm +CHAR> +../Body/f_chareq.htm +CHAR>= +../Body/f_chareq.htm +CHARACTER +../Body/a_ch.htm +CHARACTERP +../Body/f_chp.htm +CHECK-TYPE +../Body/m_check_.htm +CIS +../Body/f_cis.htm +CLASS +../Body/t_class.htm +CLASS-NAME +../Body/f_class_.htm +CLASS-OF +../Body/f_clas_1.htm +CLEAR-INPUT +../Body/f_clear_.htm +CLEAR-OUTPUT +../Body/f_finish.htm +CLOSE +../Body/f_close.htm +CLRHASH +../Body/f_clrhas.htm +CODE-CHAR +../Body/f_code_c.htm +COERCE +../Body/f_coerce.htm +COMPILATION-SPEED +../Body/d_optimi.htm +COMPILE +../Body/f_cmp.htm +COMPILE-FILE +../Body/f_cmp_fi.htm +COMPILE-FILE-PATHNAME +../Body/f_cmp__1.htm +COMPILED-FUNCTION +../Body/t_cmpd_f.htm +COMPILED-FUNCTION-P +../Body/f_cmpd_f.htm +COMPILER-MACRO +../Body/f_docume.htm +COMPILER-MACRO-FUNCTION +../Body/f_cmp_ma.htm +COMPLEMENT +../Body/f_comple.htm +COMPLEX +../Body/a_comple.htm +COMPLEXP +../Body/f_comp_3.htm +COMPUTE-APPLICABLE-METHODS +../Body/f_comput.htm +COMPUTE-RESTARTS +../Body/f_comp_1.htm +CONCATENATE +../Body/f_concat.htm +CONCATENATED-STREAM +../Body/t_concat.htm +CONCATENATED-STREAM-STREAMS +../Body/f_conc_1.htm +COND +../Body/m_cond.htm +CONDITION +../Body/e_cnd.htm +CONJUGATE +../Body/f_conjug.htm +CONS +../Body/a_cons.htm +CONSP +../Body/f_consp.htm +CONSTANTLY +../Body/f_cons_1.htm +CONSTANTP +../Body/f_consta.htm +CONTINUE +../Body/a_contin.htm +CONTROL-ERROR +../Body/e_contro.htm +COPY-ALIST +../Body/f_cp_ali.htm +COPY-LIST +../Body/f_cp_lis.htm +COPY-PPRINT-DISPATCH +../Body/f_cp_ppr.htm +COPY-READTABLE +../Body/f_cp_rdt.htm +COPY-SEQ +../Body/f_cp_seq.htm +COPY-STRUCTURE +../Body/f_cp_stu.htm +COPY-SYMBOL +../Body/f_cp_sym.htm +COPY-TREE +../Body/f_cp_tre.htm +COS +../Body/f_sin_c.htm +COSH +../Body/f_sinh_.htm +COUNT +../Body/f_countc.htm +COUNT-IF +../Body/f_countc.htm +COUNT-IF-NOT +../Body/f_countc.htm +CTYPECASE +../Body/m_tpcase.htm +DEBUG +../Body/d_optimi.htm +DECF +../Body/m_incf_.htm +DECLAIM +../Body/m_declai.htm +DECLARATION +../Body/d_declar.htm +DECLARE +../Body/s_declar.htm +DECODE-FLOAT +../Body/f_dec_fl.htm +DECODE-UNIVERSAL-TIME +../Body/f_dec_un.htm +DEFCLASS +../Body/m_defcla.htm +DEFCONSTANT +../Body/m_defcon.htm +DEFGENERIC +../Body/m_defgen.htm +DEFINE-COMPILER-MACRO +../Body/m_define.htm +DEFINE-CONDITION +../Body/m_defi_5.htm +DEFINE-METHOD-COMBINATION +../Body/m_defi_4.htm +DEFINE-MODIFY-MACRO +../Body/m_defi_2.htm +DEFINE-SETF-EXPANDER +../Body/m_defi_3.htm +DEFINE-SYMBOL-MACRO +../Body/m_defi_1.htm +DEFMACRO +../Body/m_defmac.htm +DEFMETHOD +../Body/m_defmet.htm +DEFPACKAGE +../Body/m_defpkg.htm +DEFPARAMETER +../Body/m_defpar.htm +DEFSETF +../Body/m_defset.htm +DEFSTRUCT +../Body/m_defstr.htm +DEFTYPE +../Body/m_deftp.htm +DEFUN +../Body/m_defun.htm +DEFVAR +../Body/m_defpar.htm +DELETE +../Body/f_rm_rm.htm +DELETE-DUPLICATES +../Body/f_rm_dup.htm +DELETE-FILE +../Body/f_del_fi.htm +DELETE-IF +../Body/f_rm_rm.htm +DELETE-IF-NOT +../Body/f_rm_rm.htm +DELETE-PACKAGE +../Body/f_del_pk.htm +DENOMINATOR +../Body/f_numera.htm +DEPOSIT-FIELD +../Body/f_deposi.htm +DESCRIBE +../Body/f_descri.htm +DESCRIBE-OBJECT +../Body/f_desc_1.htm +DESTRUCTURING-BIND +../Body/m_destru.htm +DIGIT-CHAR +../Body/f_digit_.htm +DIGIT-CHAR-P +../Body/f_digi_1.htm +DIRECTORY +../Body/f_dir.htm +DIRECTORY-NAMESTRING +../Body/f_namest.htm +DISASSEMBLE +../Body/f_disass.htm +DIVISION-BY-ZERO +../Body/e_divisi.htm +DO +../Body/m_do_do.htm +DO* +../Body/m_do_do.htm +DO-ALL-SYMBOLS +../Body/m_do_sym.htm +DO-EXTERNAL-SYMBOLS +../Body/m_do_sym.htm +DO-SYMBOLS +../Body/m_do_sym.htm +DOCUMENTATION +../Body/f_docume.htm +DOLIST +../Body/m_dolist.htm +DOTIMES +../Body/m_dotime.htm +DOUBLE-FLOAT +../Body/t_short_.htm +DOUBLE-FLOAT-EPSILON +../Body/v_short_.htm +DOUBLE-FLOAT-NEGATIVE-EPSILON +../Body/v_short_.htm +DPB +../Body/f_dpb.htm +DRIBBLE +../Body/f_dribbl.htm +DYNAMIC-EXTENT +../Body/d_dynami.htm +ECASE +../Body/m_case_.htm +ECHO-STREAM +../Body/t_echo_s.htm +ECHO-STREAM-INPUT-STREAM +../Body/f_echo_s.htm +ECHO-STREAM-OUTPUT-STREAM +../Body/f_echo_s.htm +ED +../Body/f_ed.htm +EIGHTH +../Body/f_firstc.htm +ELT +../Body/f_elt.htm +ENCODE-UNIVERSAL-TIME +../Body/f_encode.htm +END-OF-FILE +../Body/e_end_of.htm +ENDP +../Body/f_endp.htm +ENOUGH-NAMESTRING +../Body/f_namest.htm +ENSURE-DIRECTORIES-EXIST +../Body/f_ensu_1.htm +ENSURE-GENERIC-FUNCTION +../Body/f_ensure.htm +EQ +../Body/f_eq.htm +EQL +../Body/a_eql.htm +EQUAL +../Body/f_equal.htm +EQUALP +../Body/f_equalp.htm +ERROR +../Body/a_error.htm +ETYPECASE +../Body/m_tpcase.htm +EVAL +../Body/f_eval.htm +EVAL-WHEN +../Body/s_eval_w.htm +EVENP +../Body/f_evenpc.htm +EVERY +../Body/f_everyc.htm +EXP +../Body/f_exp_e.htm +EXPORT +../Body/f_export.htm +EXPT +../Body/f_exp_e.htm +EXTENDED-CHAR +../Body/t_extend.htm +FBOUNDP +../Body/f_fbound.htm +FCEILING +../Body/f_floorc.htm +FDEFINITION +../Body/f_fdefin.htm +FFLOOR +../Body/f_floorc.htm +FIFTH +../Body/f_firstc.htm +FILE-AUTHOR +../Body/f_file_a.htm +FILE-ERROR +../Body/e_file_e.htm +FILE-ERROR-PATHNAME +../Body/f_file_e.htm +FILE-LENGTH +../Body/f_file_l.htm +FILE-NAMESTRING +../Body/f_namest.htm +FILE-POSITION +../Body/f_file_p.htm +FILE-STREAM +../Body/t_file_s.htm +FILE-STRING-LENGTH +../Body/f_file_s.htm +FILE-WRITE-DATE +../Body/f_file_w.htm +FILL +../Body/f_fill.htm +FILL-POINTER +../Body/f_fill_p.htm +FIND +../Body/f_find_.htm +FIND-ALL-SYMBOLS +../Body/f_find_a.htm +FIND-CLASS +../Body/f_find_c.htm +FIND-IF +../Body/f_find_.htm +FIND-IF-NOT +../Body/f_find_.htm +FIND-METHOD +../Body/f_find_m.htm +FIND-PACKAGE +../Body/f_find_p.htm +FIND-RESTART +../Body/f_find_r.htm +FIND-SYMBOL +../Body/f_find_s.htm +FINISH-OUTPUT +../Body/f_finish.htm +FIRST +../Body/f_firstc.htm +FIXNUM +../Body/t_fixnum.htm +FLET +../Body/s_flet_.htm +FLOAT +../Body/a_float.htm +FLOAT-DIGITS +../Body/f_dec_fl.htm +FLOAT-PRECISION +../Body/f_dec_fl.htm +FLOAT-RADIX +../Body/f_dec_fl.htm +FLOAT-SIGN +../Body/f_dec_fl.htm +FLOATING-POINT-INEXACT +../Body/e_floa_1.htm +FLOATING-POINT-INVALID-OPERATION +../Body/e_floati.htm +FLOATING-POINT-OVERFLOW +../Body/e_floa_2.htm +FLOATING-POINT-UNDERFLOW +../Body/e_floa_3.htm +FLOATP +../Body/f_floatp.htm +FLOOR +../Body/f_floorc.htm +FMAKUNBOUND +../Body/f_fmakun.htm +FORCE-OUTPUT +../Body/f_finish.htm +FORMAT +../Body/f_format.htm +FORMATTER +../Body/m_format.htm +FOURTH +../Body/f_firstc.htm +FRESH-LINE +../Body/f_terpri.htm +FROUND +../Body/f_floorc.htm +FTRUNCATE +../Body/f_floorc.htm +FTYPE +../Body/d_ftype.htm +FUNCALL +../Body/f_funcal.htm +FUNCTION +../Body/a_fn.htm +FUNCTION-KEYWORDS +../Body/f_fn_kwd.htm +FUNCTION-LAMBDA-EXPRESSION +../Body/f_fn_lam.htm +FUNCTIONP +../Body/f_fnp.htm +GCD +../Body/f_gcd.htm +GENERIC-FUNCTION +../Body/t_generi.htm +GENSYM +../Body/f_gensym.htm +GENTEMP +../Body/f_gentem.htm +GET +../Body/f_get.htm +GET-DECODED-TIME +../Body/f_get_un.htm +GET-DISPATCH-MACRO-CHARACTER +../Body/f_set__1.htm +GET-INTERNAL-REAL-TIME +../Body/f_get_in.htm +GET-INTERNAL-RUN-TIME +../Body/f_get__1.htm +GET-MACRO-CHARACTER +../Body/f_set_ma.htm +GET-OUTPUT-STREAM-STRING +../Body/f_get_ou.htm +GET-PROPERTIES +../Body/f_get_pr.htm +GET-SETF-EXPANSION +../Body/f_get_se.htm +GET-UNIVERSAL-TIME +../Body/f_get_un.htm +GETF +../Body/f_getf.htm +GETHASH +../Body/f_gethas.htm +GO +../Body/s_go.htm +GRAPHIC-CHAR-P +../Body/f_graphi.htm +HANDLER-BIND +../Body/m_handle.htm +HANDLER-CASE +../Body/m_hand_1.htm +HASH-TABLE +../Body/t_hash_t.htm +HASH-TABLE-COUNT +../Body/f_hash_1.htm +HASH-TABLE-P +../Body/f_hash_t.htm +HASH-TABLE-REHASH-SIZE +../Body/f_hash_2.htm +HASH-TABLE-REHASH-THRESHOLD +../Body/f_hash_3.htm +HASH-TABLE-SIZE +../Body/f_hash_4.htm +HASH-TABLE-TEST +../Body/f_hash_5.htm +HOST-NAMESTRING +../Body/f_namest.htm +IDENTITY +../Body/f_identi.htm +IF +../Body/s_if.htm +IGNORABLE +../Body/d_ignore.htm +IGNORE +../Body/d_ignore.htm +IGNORE-ERRORS +../Body/m_ignore.htm +IMAGPART +../Body/f_realpa.htm +IMPORT +../Body/f_import.htm +IN-PACKAGE +../Body/m_in_pkg.htm +INCF +../Body/m_incf_.htm +INITIALIZE-INSTANCE +../Body/f_init_i.htm +INLINE +../Body/d_inline.htm +INPUT-STREAM-P +../Body/f_in_stm.htm +INSPECT +../Body/f_inspec.htm +INTEGER +../Body/t_intege.htm +INTEGER-DECODE-FLOAT +../Body/f_dec_fl.htm +INTEGER-LENGTH +../Body/f_intege.htm +INTEGERP +../Body/f_inte_1.htm +INTERACTIVE-STREAM-P +../Body/f_intera.htm +INTERN +../Body/f_intern.htm +INTERNAL-TIME-UNITS-PER-SECOND +../Body/v_intern.htm +INTERSECTION +../Body/f_isec_.htm +INVALID-METHOD-ERROR +../Body/f_invali.htm +INVOKE-DEBUGGER +../Body/f_invoke.htm +INVOKE-RESTART +../Body/f_invo_1.htm +INVOKE-RESTART-INTERACTIVELY +../Body/f_invo_2.htm +ISQRT +../Body/f_sqrt_.htm +KEYWORD +../Body/t_kwd.htm +KEYWORDP +../Body/f_kwdp.htm +LABELS +../Body/s_flet_.htm +LAMBDA +../Body/a_lambda.htm +LAMBDA-LIST-KEYWORDS +../Body/v_lambda.htm +LAMBDA-PARAMETERS-LIMIT +../Body/v_lamb_1.htm +LAST +../Body/f_last.htm +LCM +../Body/f_lcm.htm +LDB +../Body/f_ldb.htm +LDB-TEST +../Body/f_ldb_te.htm +LDIFF +../Body/f_ldiffc.htm +LEAST-NEGATIVE-DOUBLE-FLOAT +../Body/v_most_1.htm +LEAST-NEGATIVE-LONG-FLOAT +../Body/v_most_1.htm +LEAST-NEGATIVE-NORMALIZED-DOUBLE-FLOAT +../Body/v_most_1.htm +LEAST-NEGATIVE-NORMALIZED-LONG-FLOAT +../Body/v_most_1.htm +LEAST-NEGATIVE-NORMALIZED-SHORT-FLOAT +../Body/v_most_1.htm +LEAST-NEGATIVE-NORMALIZED-SINGLE-FLOAT +../Body/v_most_1.htm +LEAST-NEGATIVE-SHORT-FLOAT +../Body/v_most_1.htm +LEAST-NEGATIVE-SINGLE-FLOAT +../Body/v_most_1.htm +LEAST-POSITIVE-DOUBLE-FLOAT +../Body/v_most_1.htm +LEAST-POSITIVE-LONG-FLOAT +../Body/v_most_1.htm +LEAST-POSITIVE-NORMALIZED-DOUBLE-FLOAT +../Body/v_most_1.htm +LEAST-POSITIVE-NORMALIZED-LONG-FLOAT +../Body/v_most_1.htm +LEAST-POSITIVE-NORMALIZED-SHORT-FLOAT +../Body/v_most_1.htm +LEAST-POSITIVE-NORMALIZED-SINGLE-FLOAT +../Body/v_most_1.htm +LEAST-POSITIVE-SHORT-FLOAT +../Body/v_most_1.htm +LEAST-POSITIVE-SINGLE-FLOAT +../Body/v_most_1.htm +LENGTH +../Body/f_length.htm +LET +../Body/s_let_l.htm +LET* +../Body/s_let_l.htm +LISP-IMPLEMENTATION-TYPE +../Body/f_lisp_i.htm +LISP-IMPLEMENTATION-VERSION +../Body/f_lisp_i.htm +LIST +../Body/a_list.htm +LIST* +../Body/f_list_.htm +LIST-ALL-PACKAGES +../Body/f_list_a.htm +LIST-LENGTH +../Body/f_list_l.htm +LISTEN +../Body/f_listen.htm +LISTP +../Body/f_listp.htm +LOAD +../Body/f_load.htm +LOAD-LOGICAL-PATHNAME-TRANSLATIONS +../Body/f_ld_log.htm +LOAD-TIME-VALUE +../Body/s_ld_tim.htm +LOCALLY +../Body/s_locall.htm +LOG +../Body/f_log.htm +LOGAND +../Body/f_logand.htm +LOGANDC1 +../Body/f_logand.htm +LOGANDC2 +../Body/f_logand.htm +LOGBITP +../Body/f_logbtp.htm +LOGCOUNT +../Body/f_logcou.htm +LOGEQV +../Body/f_logand.htm +LOGICAL-PATHNAME +../Body/a_logica.htm +LOGICAL-PATHNAME-TRANSLATIONS +../Body/f_logica.htm +LOGIOR +../Body/f_logand.htm +LOGNAND +../Body/f_logand.htm +LOGNOR +../Body/f_logand.htm +LOGNOT +../Body/f_logand.htm +LOGORC1 +../Body/f_logand.htm +LOGORC2 +../Body/f_logand.htm +LOGTEST +../Body/f_logtes.htm +LOGXOR +../Body/f_logand.htm +LONG-FLOAT +../Body/t_short_.htm +LONG-FLOAT-EPSILON +../Body/v_short_.htm +LONG-FLOAT-NEGATIVE-EPSILON +../Body/v_short_.htm +LONG-SITE-NAME +../Body/f_short_.htm +LOOP +../Body/m_loop.htm +LOOP-FINISH +../Body/m_loop_f.htm +LOWER-CASE-P +../Body/f_upper_.htm +MACHINE-INSTANCE +../Body/f_mach_i.htm +MACHINE-TYPE +../Body/f_mach_t.htm +MACHINE-VERSION +../Body/f_mach_v.htm +MACRO-FUNCTION +../Body/f_macro_.htm +MACROEXPAND +../Body/f_mexp_.htm +MACROEXPAND-1 +../Body/f_mexp_.htm +MACROLET +../Body/s_flet_.htm +MAKE-ARRAY +../Body/f_mk_ar.htm +MAKE-BROADCAST-STREAM +../Body/f_mk_bro.htm +MAKE-CONCATENATED-STREAM +../Body/f_mk_con.htm +MAKE-CONDITION +../Body/f_mk_cnd.htm +MAKE-DISPATCH-MACRO-CHARACTER +../Body/f_mk_dis.htm +MAKE-ECHO-STREAM +../Body/f_mk_ech.htm +MAKE-HASH-TABLE +../Body/f_mk_has.htm +MAKE-INSTANCE +../Body/f_mk_ins.htm +MAKE-INSTANCES-OBSOLETE +../Body/f_mk_i_1.htm +MAKE-LIST +../Body/f_mk_lis.htm +MAKE-LOAD-FORM +../Body/f_mk_ld_.htm +MAKE-LOAD-FORM-SAVING-SLOTS +../Body/f_mk_l_1.htm +MAKE-METHOD +../Body/m_call_m.htm +MAKE-PACKAGE +../Body/f_mk_pkg.htm +MAKE-PATHNAME +../Body/f_mk_pn.htm +MAKE-RANDOM-STATE +../Body/f_mk_rnd.htm +MAKE-SEQUENCE +../Body/f_mk_seq.htm +MAKE-STRING +../Body/f_mk_stg.htm +MAKE-STRING-INPUT-STREAM +../Body/f_mk_s_1.htm +MAKE-STRING-OUTPUT-STREAM +../Body/f_mk_s_2.htm +MAKE-SYMBOL +../Body/f_mk_sym.htm +MAKE-SYNONYM-STREAM +../Body/f_mk_syn.htm +MAKE-TWO-WAY-STREAM +../Body/f_mk_two.htm +MAKUNBOUND +../Body/f_makunb.htm +MAP +../Body/f_map.htm +MAP-INTO +../Body/f_map_in.htm +MAPC +../Body/f_mapc_.htm +MAPCAN +../Body/f_mapc_.htm +MAPCAR +../Body/f_mapc_.htm +MAPCON +../Body/f_mapc_.htm +MAPHASH +../Body/f_maphas.htm +MAPL +../Body/f_mapc_.htm +MAPLIST +../Body/f_mapc_.htm +MASK-FIELD +../Body/f_mask_f.htm +MAX +../Body/f_max_m.htm +MEMBER +../Body/a_member.htm +MEMBER-IF +../Body/f_mem_m.htm +MEMBER-IF-NOT +../Body/f_mem_m.htm +MERGE +../Body/f_merge.htm +MERGE-PATHNAMES +../Body/f_merge_.htm +METHOD +../Body/t_method.htm +METHOD-COMBINATION +../Body/a_method.htm +METHOD-COMBINATION-ERROR +../Body/f_meth_1.htm +METHOD-QUALIFIERS +../Body/f_method.htm +MIN +../Body/f_max_m.htm +MINUSP +../Body/f_minusp.htm +MISMATCH +../Body/f_mismat.htm +MOD +../Body/a_mod.htm +MOST-NEGATIVE-DOUBLE-FLOAT +../Body/v_most_1.htm +MOST-NEGATIVE-FIXNUM +../Body/v_most_p.htm +MOST-NEGATIVE-LONG-FLOAT +../Body/v_most_1.htm +MOST-NEGATIVE-SHORT-FLOAT +../Body/v_most_1.htm +MOST-NEGATIVE-SINGLE-FLOAT +../Body/v_most_1.htm +MOST-POSITIVE-DOUBLE-FLOAT +../Body/v_most_1.htm +MOST-POSITIVE-FIXNUM +../Body/v_most_p.htm +MOST-POSITIVE-LONG-FLOAT +../Body/v_most_1.htm +MOST-POSITIVE-SHORT-FLOAT +../Body/v_most_1.htm +MOST-POSITIVE-SINGLE-FLOAT +../Body/v_most_1.htm +MUFFLE-WARNING +../Body/a_muffle.htm +MULTIPLE-VALUE-BIND +../Body/m_multip.htm +MULTIPLE-VALUE-CALL +../Body/s_multip.htm +MULTIPLE-VALUE-LIST +../Body/m_mult_1.htm +MULTIPLE-VALUE-PROG1 +../Body/s_mult_1.htm +MULTIPLE-VALUE-SETQ +../Body/m_mult_2.htm +MULTIPLE-VALUES-LIMIT +../Body/v_multip.htm +NAME-CHAR +../Body/f_name_c.htm +NAMESTRING +../Body/f_namest.htm +NBUTLAST +../Body/f_butlas.htm +NCONC +../Body/f_nconc.htm +NEXT-METHOD-P +../Body/f_next_m.htm +NIL +../Body/a_nil.htm +NINTERSECTION +../Body/f_isec_.htm +NINTH +../Body/f_firstc.htm +NO-APPLICABLE-METHOD +../Body/f_no_app.htm +NO-NEXT-METHOD +../Body/f_no_nex.htm +NOT +../Body/a_not.htm +NOTANY +../Body/f_everyc.htm +NOTEVERY +../Body/f_everyc.htm +NOTINLINE +../Body/d_inline.htm +NRECONC +../Body/f_revapp.htm +NREVERSE +../Body/f_revers.htm +NSET-DIFFERENCE +../Body/f_set_di.htm +NSET-EXCLUSIVE-OR +../Body/f_set_ex.htm +NSTRING-CAPITALIZE +../Body/f_stg_up.htm +NSTRING-DOWNCASE +../Body/f_stg_up.htm +NSTRING-UPCASE +../Body/f_stg_up.htm +NSUBLIS +../Body/f_sublis.htm +NSUBST +../Body/f_substc.htm +NSUBST-IF +../Body/f_substc.htm +NSUBST-IF-NOT +../Body/f_substc.htm +NSUBSTITUTE +../Body/f_sbs_s.htm +NSUBSTITUTE-IF +../Body/f_sbs_s.htm +NSUBSTITUTE-IF-NOT +../Body/f_sbs_s.htm +NTH +../Body/f_nth.htm +NTH-VALUE +../Body/m_nth_va.htm +NTHCDR +../Body/f_nthcdr.htm +NULL +../Body/a_null.htm +NUMBER +../Body/t_number.htm +NUMBERP +../Body/f_nump.htm +NUMERATOR +../Body/f_numera.htm +NUNION +../Body/f_unionc.htm +ODDP +../Body/f_evenpc.htm +OPEN +../Body/f_open.htm +OPEN-STREAM-P +../Body/f_open_s.htm +OPTIMIZE +../Body/d_optimi.htm +OR +../Body/a_or.htm +OTHERWISE +../Body/m_case_.htm +OUTPUT-STREAM-P +../Body/f_in_stm.htm +PACKAGE +../Body/t_pkg.htm +PACKAGE-ERROR +../Body/e_pkg_er.htm +PACKAGE-ERROR-PACKAGE +../Body/f_pkg_er.htm +PACKAGE-NAME +../Body/f_pkg_na.htm +PACKAGE-NICKNAMES +../Body/f_pkg_ni.htm +PACKAGE-SHADOWING-SYMBOLS +../Body/f_pkg_sh.htm +PACKAGE-USE-LIST +../Body/f_pkg_us.htm +PACKAGE-USED-BY-LIST +../Body/f_pkg__1.htm +PACKAGEP +../Body/f_pkgp.htm +PAIRLIS +../Body/f_pairli.htm +PARSE-ERROR +../Body/e_parse_.htm +PARSE-INTEGER +../Body/f_parse_.htm +PARSE-NAMESTRING +../Body/f_pars_1.htm +PATHNAME +../Body/a_pn.htm +PATHNAME-DEVICE +../Body/f_pn_hos.htm +PATHNAME-DIRECTORY +../Body/f_pn_hos.htm +PATHNAME-HOST +../Body/f_pn_hos.htm +PATHNAME-MATCH-P +../Body/f_pn_mat.htm +PATHNAME-NAME +../Body/f_pn_hos.htm +PATHNAME-TYPE +../Body/f_pn_hos.htm +PATHNAME-VERSION +../Body/f_pn_hos.htm +PATHNAMEP +../Body/f_pnp.htm +PEEK-CHAR +../Body/f_peek_c.htm +PHASE +../Body/f_phase.htm +PI +../Body/v_pi.htm +PLUSP +../Body/f_minusp.htm +POP +../Body/m_pop.htm +POSITION +../Body/f_pos_p.htm +POSITION-IF +../Body/f_pos_p.htm +POSITION-IF-NOT +../Body/f_pos_p.htm +PPRINT +../Body/f_wr_pr.htm +PPRINT-DISPATCH +../Body/f_ppr_di.htm +PPRINT-EXIT-IF-LIST-EXHAUSTED +../Body/m_ppr_ex.htm +PPRINT-FILL +../Body/f_ppr_fi.htm +PPRINT-INDENT +../Body/f_ppr_in.htm +PPRINT-LINEAR +../Body/f_ppr_fi.htm +PPRINT-LOGICAL-BLOCK +../Body/m_ppr_lo.htm +PPRINT-NEWLINE +../Body/f_ppr_nl.htm +PPRINT-POP +../Body/m_ppr_po.htm +PPRINT-TAB +../Body/f_ppr_ta.htm +PPRINT-TABULAR +../Body/f_ppr_fi.htm +PRIN1 +../Body/f_wr_pr.htm +PRIN1-TO-STRING +../Body/f_wr_to_.htm +PRINC +../Body/f_wr_pr.htm +PRINC-TO-STRING +../Body/f_wr_to_.htm +PRINT +../Body/f_wr_pr.htm +PRINT-NOT-READABLE +../Body/e_pr_not.htm +PRINT-NOT-READABLE-OBJECT +../Body/f_pr_not.htm +PRINT-OBJECT +../Body/f_pr_obj.htm +PRINT-UNREADABLE-OBJECT +../Body/m_pr_unr.htm +PROBE-FILE +../Body/f_probe_.htm +PROCLAIM +../Body/f_procla.htm +PROG +../Body/m_prog_.htm +PROG* +../Body/m_prog_.htm +PROG1 +../Body/m_prog1c.htm +PROG2 +../Body/m_prog1c.htm +PROGN +../Body/s_progn.htm +PROGRAM-ERROR +../Body/e_progra.htm +PROGV +../Body/s_progv.htm +PROVIDE +../Body/f_provid.htm +PSETF +../Body/m_setf_.htm +PSETQ +../Body/m_psetq.htm +PUSH +../Body/m_push.htm +PUSHNEW +../Body/m_pshnew.htm +QUOTE +../Body/s_quote.htm +RANDOM +../Body/f_random.htm +RANDOM-STATE +../Body/t_rnd_st.htm +RANDOM-STATE-P +../Body/f_rnd_st.htm +RASSOC +../Body/f_rassoc.htm +RASSOC-IF +../Body/f_rassoc.htm +RASSOC-IF-NOT +../Body/f_rassoc.htm +RATIO +../Body/t_ratio.htm +RATIONAL +../Body/a_ration.htm +RATIONALIZE +../Body/f_ration.htm +RATIONALP +../Body/f_rati_1.htm +READ +../Body/f_rd_rd.htm +READ-BYTE +../Body/f_rd_by.htm +READ-CHAR +../Body/f_rd_cha.htm +READ-CHAR-NO-HANG +../Body/f_rd_c_1.htm +READ-DELIMITED-LIST +../Body/f_rd_del.htm +READ-FROM-STRING +../Body/f_rd_fro.htm +READ-LINE +../Body/f_rd_lin.htm +READ-PRESERVING-WHITESPACE +../Body/f_rd_rd.htm +READ-SEQUENCE +../Body/f_rd_seq.htm +READER-ERROR +../Body/e_rder_e.htm +READTABLE +../Body/t_rdtabl.htm +READTABLE-CASE +../Body/f_rdtabl.htm +READTABLEP +../Body/f_rdta_1.htm +REAL +../Body/t_real.htm +REALP +../Body/f_realp.htm +REALPART +../Body/f_realpa.htm +REDUCE +../Body/f_reduce.htm +REINITIALIZE-INSTANCE +../Body/f_reinit.htm +REM +../Body/f_mod_r.htm +REMF +../Body/m_remf.htm +REMHASH +../Body/f_remhas.htm +REMOVE +../Body/f_rm_rm.htm +REMOVE-DUPLICATES +../Body/f_rm_dup.htm +REMOVE-IF +../Body/f_rm_rm.htm +REMOVE-IF-NOT +../Body/f_rm_rm.htm +REMOVE-METHOD +../Body/f_rm_met.htm +REMPROP +../Body/f_rempro.htm +RENAME-FILE +../Body/f_rn_fil.htm +RENAME-PACKAGE +../Body/f_rn_pkg.htm +REPLACE +../Body/f_replac.htm +REQUIRE +../Body/f_provid.htm +REST +../Body/f_rest.htm +RESTART +../Body/t_rst.htm +RESTART-BIND +../Body/m_rst_bi.htm +RESTART-CASE +../Body/m_rst_ca.htm +RESTART-NAME +../Body/f_rst_na.htm +RETURN +../Body/m_return.htm +RETURN-FROM +../Body/s_ret_fr.htm +REVAPPEND +../Body/f_revapp.htm +REVERSE +../Body/f_revers.htm +ROOM +../Body/f_room.htm +ROTATEF +../Body/m_rotate.htm +ROUND +../Body/f_floorc.htm +ROW-MAJOR-AREF +../Body/f_row_ma.htm +RPLACA +../Body/f_rplaca.htm +RPLACD +../Body/f_rplaca.htm +SAFETY +../Body/d_optimi.htm +SATISFIES +../Body/t_satisf.htm +SBIT +../Body/f_bt_sb.htm +SCALE-FLOAT +../Body/f_dec_fl.htm +SCHAR +../Body/f_char_.htm +SEARCH +../Body/f_search.htm +SECOND +../Body/f_firstc.htm +SEQUENCE +../Body/t_seq.htm +SERIOUS-CONDITION +../Body/e_seriou.htm +SET +../Body/f_set.htm +SET-DIFFERENCE +../Body/f_set_di.htm +SET-DISPATCH-MACRO-CHARACTER +../Body/f_set__1.htm +SET-EXCLUSIVE-OR +../Body/f_set_ex.htm +SET-MACRO-CHARACTER +../Body/f_set_ma.htm +SET-PPRINT-DISPATCH +../Body/f_set_pp.htm +SET-SYNTAX-FROM-CHAR +../Body/f_set_sy.htm +SETF +../Body/a_setf.htm +SETQ +../Body/s_setq.htm +SEVENTH +../Body/f_firstc.htm +SHADOW +../Body/f_shadow.htm +SHADOWING-IMPORT +../Body/f_shdw_i.htm +SHARED-INITIALIZE +../Body/f_shared.htm +SHIFTF +../Body/m_shiftf.htm +SHORT-FLOAT +../Body/t_short_.htm +SHORT-FLOAT-EPSILON +../Body/v_short_.htm +SHORT-FLOAT-NEGATIVE-EPSILON +../Body/v_short_.htm +SHORT-SITE-NAME +../Body/f_short_.htm +SIGNAL +../Body/f_signal.htm +SIGNED-BYTE +../Body/t_sgn_by.htm +SIGNUM +../Body/f_signum.htm +SIMPLE-ARRAY +../Body/t_smp_ar.htm +SIMPLE-BASE-STRING +../Body/t_smp_ba.htm +SIMPLE-BIT-VECTOR +../Body/t_smp_bt.htm +SIMPLE-BIT-VECTOR-P +../Body/f_smp_bt.htm +SIMPLE-CONDITION +../Body/e_smp_cn.htm +SIMPLE-CONDITION-FORMAT-ARGUMENTS +../Body/f_smp_cn.htm +SIMPLE-CONDITION-FORMAT-CONTROL +../Body/f_smp_cn.htm +SIMPLE-ERROR +../Body/e_smp_er.htm +SIMPLE-STRING +../Body/t_smp_st.htm +SIMPLE-STRING-P +../Body/f_smp_st.htm +SIMPLE-TYPE-ERROR +../Body/e_smp_tp.htm +SIMPLE-VECTOR +../Body/t_smp_ve.htm +SIMPLE-VECTOR-P +../Body/f_smp_ve.htm +SIMPLE-WARNING +../Body/e_smp_wa.htm +SIN +../Body/f_sin_c.htm +SINGLE-FLOAT +../Body/t_short_.htm +SINGLE-FLOAT-EPSILON +../Body/v_short_.htm +SINGLE-FLOAT-NEGATIVE-EPSILON +../Body/v_short_.htm +SINH +../Body/f_sinh_.htm +SIXTH +../Body/f_firstc.htm +SLEEP +../Body/f_sleep.htm +SLOT-BOUNDP +../Body/f_slt_bo.htm +SLOT-EXISTS-P +../Body/f_slt_ex.htm +SLOT-MAKUNBOUND +../Body/f_slt_ma.htm +SLOT-MISSING +../Body/f_slt_mi.htm +SLOT-UNBOUND +../Body/f_slt_un.htm +SLOT-VALUE +../Body/f_slt_va.htm +SOFTWARE-TYPE +../Body/f_sw_tpc.htm +SOFTWARE-VERSION +../Body/f_sw_tpc.htm +SOME +../Body/f_everyc.htm +SORT +../Body/f_sort_.htm +SPACE +../Body/d_optimi.htm +SPECIAL +../Body/d_specia.htm +SPECIAL-OPERATOR-P +../Body/f_specia.htm +SPEED +../Body/d_optimi.htm +SQRT +../Body/f_sqrt_.htm +STABLE-SORT +../Body/f_sort_.htm +STANDARD +../Body/07_ffb.htm +STANDARD-CHAR +../Body/t_std_ch.htm +STANDARD-CHAR-P +../Body/f_std_ch.htm +STANDARD-CLASS +../Body/t_std_cl.htm +STANDARD-GENERIC-FUNCTION +../Body/t_std_ge.htm +STANDARD-METHOD +../Body/t_std_me.htm +STANDARD-OBJECT +../Body/t_std_ob.htm +STEP +../Body/m_step.htm +STORAGE-CONDITION +../Body/e_storag.htm +STORE-VALUE +../Body/a_store_.htm +STREAM +../Body/t_stream.htm +STREAM-ELEMENT-TYPE +../Body/f_stm_el.htm +STREAM-ERROR +../Body/e_stm_er.htm +STREAM-ERROR-STREAM +../Body/f_stm_er.htm +STREAM-EXTERNAL-FORMAT +../Body/f_stm_ex.htm +STREAMP +../Body/f_stmp.htm +STRING +../Body/a_string.htm +STRING-CAPITALIZE +../Body/f_stg_up.htm +STRING-DOWNCASE +../Body/f_stg_up.htm +STRING-EQUAL +../Body/f_stgeq_.htm +STRING-GREATERP +../Body/f_stgeq_.htm +STRING-LEFT-TRIM +../Body/f_stg_tr.htm +STRING-LESSP +../Body/f_stgeq_.htm +STRING-NOT-EQUAL +../Body/f_stgeq_.htm +STRING-NOT-GREATERP +../Body/f_stgeq_.htm +STRING-NOT-LESSP +../Body/f_stgeq_.htm +STRING-RIGHT-TRIM +../Body/f_stg_tr.htm +STRING-STREAM +../Body/t_stg_st.htm +STRING-TRIM +../Body/f_stg_tr.htm +STRING-UPCASE +../Body/f_stg_up.htm +STRING/= +../Body/f_stgeq_.htm +STRING< +../Body/f_stgeq_.htm +STRING<= +../Body/f_stgeq_.htm +STRING= +../Body/f_stgeq_.htm +STRING> +../Body/f_stgeq_.htm +STRING>= +../Body/f_stgeq_.htm +STRINGP +../Body/f_stgp.htm +STRUCTURE +../Body/f_docume.htm +STRUCTURE-CLASS +../Body/t_stu_cl.htm +STRUCTURE-OBJECT +../Body/t_stu_ob.htm +STYLE-WARNING +../Body/e_style_.htm +SUBLIS +../Body/f_sublis.htm +SUBSEQ +../Body/f_subseq.htm +SUBSETP +../Body/f_subset.htm +SUBST +../Body/f_substc.htm +SUBST-IF +../Body/f_substc.htm +SUBST-IF-NOT +../Body/f_substc.htm +SUBSTITUTE +../Body/f_sbs_s.htm +SUBSTITUTE-IF +../Body/f_sbs_s.htm +SUBSTITUTE-IF-NOT +../Body/f_sbs_s.htm +SUBTYPEP +../Body/f_subtpp.htm +SVREF +../Body/f_svref.htm +SXHASH +../Body/f_sxhash.htm +SYMBOL +../Body/t_symbol.htm +SYMBOL-FUNCTION +../Body/f_symb_1.htm +SYMBOL-MACROLET +../Body/s_symbol.htm +SYMBOL-NAME +../Body/f_symb_2.htm +SYMBOL-PACKAGE +../Body/f_symb_3.htm +SYMBOL-PLIST +../Body/f_symb_4.htm +SYMBOL-VALUE +../Body/f_symb_5.htm +SYMBOLP +../Body/f_symbol.htm +SYNONYM-STREAM +../Body/t_syn_st.htm +SYNONYM-STREAM-SYMBOL +../Body/f_syn_st.htm +T +../Body/a_t.htm +TAGBODY +../Body/s_tagbod.htm +TAILP +../Body/f_ldiffc.htm +TAN +../Body/f_sin_c.htm +TANH +../Body/f_sinh_.htm +TENTH +../Body/f_firstc.htm +TERPRI +../Body/f_terpri.htm +THE +../Body/s_the.htm +THIRD +../Body/f_firstc.htm +THROW +../Body/s_throw.htm +TIME +../Body/m_time.htm +TRACE +../Body/m_tracec.htm +TRANSLATE-LOGICAL-PATHNAME +../Body/f_tr_log.htm +TRANSLATE-PATHNAME +../Body/f_tr_pn.htm +TREE-EQUAL +../Body/f_tree_e.htm +TRUENAME +../Body/f_tn.htm +TRUNCATE +../Body/f_floorc.htm +TWO-WAY-STREAM +../Body/t_two_wa.htm +TWO-WAY-STREAM-INPUT-STREAM +../Body/f_two_wa.htm +TWO-WAY-STREAM-OUTPUT-STREAM +../Body/f_two_wa.htm +TYPE +../Body/a_type.htm +TYPE-ERROR +../Body/e_tp_err.htm +TYPE-ERROR-DATUM +../Body/f_tp_err.htm +TYPE-ERROR-EXPECTED-TYPE +../Body/f_tp_err.htm +TYPE-OF +../Body/f_tp_of.htm +TYPECASE +../Body/m_tpcase.htm +TYPEP +../Body/f_typep.htm +UNBOUND-SLOT +../Body/e_unboun.htm +UNBOUND-SLOT-INSTANCE +../Body/f_unboun.htm +UNBOUND-VARIABLE +../Body/e_unbo_1.htm +UNDEFINED-FUNCTION +../Body/e_undefi.htm +UNEXPORT +../Body/f_unexpo.htm +UNINTERN +../Body/f_uninte.htm +UNION +../Body/f_unionc.htm +UNLESS +../Body/m_when_.htm +UNREAD-CHAR +../Body/f_unrd_c.htm +UNSIGNED-BYTE +../Body/t_unsgn_.htm +UNTRACE +../Body/m_tracec.htm +UNUSE-PACKAGE +../Body/f_unuse_.htm +UNWIND-PROTECT +../Body/s_unwind.htm +UPDATE-INSTANCE-FOR-DIFFERENT-CLASS +../Body/f_update.htm +UPDATE-INSTANCE-FOR-REDEFINED-CLASS +../Body/f_upda_1.htm +UPGRADED-ARRAY-ELEMENT-TYPE +../Body/f_upgr_1.htm +UPGRADED-COMPLEX-PART-TYPE +../Body/f_upgrad.htm +UPPER-CASE-P +../Body/f_upper_.htm +USE-PACKAGE +../Body/f_use_pk.htm +USE-VALUE +../Body/a_use_va.htm +USER-HOMEDIR-PATHNAME +../Body/f_user_h.htm +VALUES +../Body/a_values.htm +VALUES-LIST +../Body/f_vals_l.htm +VARIABLE +../Body/f_docume.htm +VECTOR +../Body/a_vector.htm +VECTOR-POP +../Body/f_vec_po.htm +VECTOR-PUSH +../Body/f_vec_ps.htm +VECTOR-PUSH-EXTEND +../Body/f_vec_ps.htm +VECTORP +../Body/f_vecp.htm +WARN +../Body/f_warn.htm +WARNING +../Body/e_warnin.htm +WHEN +../Body/m_when_.htm +WILD-PATHNAME-P +../Body/f_wild_p.htm +WITH-ACCESSORS +../Body/m_w_acce.htm +WITH-COMPILATION-UNIT +../Body/m_w_comp.htm +WITH-CONDITION-RESTARTS +../Body/m_w_cnd_.htm +WITH-HASH-TABLE-ITERATOR +../Body/m_w_hash.htm +WITH-INPUT-FROM-STRING +../Body/m_w_in_f.htm +WITH-OPEN-FILE +../Body/m_w_open.htm +WITH-OPEN-STREAM +../Body/m_w_op_1.htm +WITH-OUTPUT-TO-STRING +../Body/m_w_out_.htm +WITH-PACKAGE-ITERATOR +../Body/m_w_pkg_.htm +WITH-SIMPLE-RESTART +../Body/m_w_smp_.htm +WITH-SLOTS +../Body/m_w_slts.htm +WITH-STANDARD-IO-SYNTAX +../Body/m_w_std_.htm +WRITE +../Body/f_wr_pr.htm +WRITE-BYTE +../Body/f_wr_by.htm +WRITE-CHAR +../Body/f_wr_cha.htm +WRITE-LINE +../Body/f_wr_stg.htm +WRITE-SEQUENCE +../Body/f_wr_seq.htm +WRITE-STRING +../Body/f_wr_stg.htm +WRITE-TO-STRING +../Body/f_wr_to_.htm +Y-OR-N-P +../Body/f_y_or_n.htm +YES-OR-NO-P +../Body/f_y_or_n.htm +ZEROP +../Body/f_zerop.htm diff --git a/HyperSpec/Mop_Sym.txt b/HyperSpec/Mop_Sym.txt new file mode 100644 index 0000000..8b13789 --- /dev/null +++ b/HyperSpec/Mop_Sym.txt @@ -0,0 +1 @@ + diff --git a/package.lisp b/package.lisp new file mode 100644 index 0000000..5861fe3 --- /dev/null +++ b/package.lisp @@ -0,0 +1,4 @@ +(defpackage :cl-bbs/server + (:use :cl) + (:export #:start-app + #:stop-app)) diff --git a/server/admin.lisp b/server/admin.lisp new file mode 100644 index 0000000..3864fad --- /dev/null +++ b/server/admin.lisp @@ -0,0 +1,574 @@ +(defpackage :cl-bbs-admin + (:use :cl) + (:export #:main)) + +(in-package :cl-bbs-admin) + +(defun expand-tilde (path) + (if (and (>= (length path) 2) (string= (subseq path 0 2) "~/")) + (concatenate 'string (namestring (user-homedir-pathname)) (subseq path 2)) + path)) + +(defun get-data-dir () + (let ((env (uiop:getenv "SBBS_DATADIR"))) + (if (and env (not (string= env ""))) + (namestring (uiop:ensure-absolute-pathname (expand-tilde env) (uiop:getcwd))) + (let ((root-dir (asdf:system-source-directory :cl-bbs/server))) + (if root-dir + (namestring (merge-pathnames "data/" root-dir)) + (namestring (merge-pathnames "bbs/" (user-homedir-pathname)))))))) + +(defun lookup-def (key alist) + (let ((p (assoc key alist :test (lambda (k1 k2) (string-equal (string k1) (string k2)))))) + (if p + (let ((res (cdr p))) + (cond ((string-equal (string key) "posts") res) + ((not (consp res)) res) + ((null (cdr res)) (car res)) + (t res))) + nil))) + +(defun last-element (lst) + (car (last lst))) + +(defun take-right (lst n) + (let ((len (length lst))) + (if (<= len n) + lst + (nthcdr (- len n) lst)))) + +(defun take (lst n) + (if (or (null lst) (<= n 0)) + nil + (cons (car lst) (take (cdr lst) (1- n))))) + +(defun latest-posts (posts) + (if (> (length posts) 6) + `((cl-bbs/models:truncated . ,(mapcar #'car (butlast (cdr posts) 5))) + (cl-bbs/models:posts ,(cons (car posts) (take-right posts 5)))) + `((cl-bbs/models:truncated . nil) (cl-bbs/models:posts ,posts)))) + +(defun get-flat-posts (posts) + (when posts + (let* ((cdr-val posts) + (cadr-val (and (listp cdr-val) (car cdr-val)))) + (if (and (listp cadr-val) (listp (car cadr-val))) + cadr-val + cdr-val)))) + +(defun build-list-entry (t-entry) + (let* ((id (car t-entry)) + (thread-data (cdr t-entry)) + (headline (lookup-def 'cl-bbs/models:headline thread-data)) + (posts (get-flat-posts (lookup-def 'cl-bbs/models:posts thread-data))) + (last-post (last-element posts)) + (date (lookup-def 'cl-bbs/models:date (cdr last-post))) + (messages (length posts))) + `(,id (cl-bbs/models:headline . ,headline) (cl-bbs/models:date . ,date) (cl-bbs/models:messages . ,messages)))) + +(defun build-index-entry (t-entry) + (let* ((id (car t-entry)) + (thread-data (cdr t-entry)) + (headline (lookup-def 'cl-bbs/models:headline thread-data)) + (posts (get-flat-posts (lookup-def 'cl-bbs/models:posts thread-data)))) + `(,id (cl-bbs/models:headline . ,headline) . ,(latest-posts posts)))) + +(defun read-sexp-file (path) + (with-open-file (stream path :direction :input :if-does-not-exist nil) + (if stream + (let ((*read-eval* nil)) + (read stream nil nil)) + nil))) + +(defun write-sexp-file (path data) + (with-open-file (stream path :direction :output :if-exists :supersede + :if-does-not-exist :create + :external-format :utf-8) + (write data :stream stream :pretty t) + (terpri stream))) + +(defun get-threads (dir) + (let ((threads nil)) + (loop for i from 1 + for misses = 0 then (if exists 0 (1+ misses)) + for filepath = (format nil "~A~D" dir i) + for exists = (probe-file filepath) + while (<= misses 200) + do (when exists + (let ((data (read-sexp-file filepath))) + (when data + (push (cons i data) threads))))) + threads)) + +(defun generate-index (board) + (let* ((data-dir (string-right-trim "/" (get-data-dir))) + (dir (format nil "~A/sexp/~A/" data-dir board)) + (threads-data (get-threads dir))) + (unless threads-data + (format t "No threads found for board ~A.~%" board) + (return-from generate-index nil)) + (let* ((sorted-threads + (sort threads-data + (lambda (a b) + (let* ((posts-a (get-flat-posts (lookup-def 'cl-bbs/models:posts (cdr a)))) + (posts-b (get-flat-posts (lookup-def 'cl-bbs/models:posts (cdr b)))) + (date-a (or (lookup-def 'cl-bbs/models:date (cdr (last-element posts-a))) "")) + (date-b (or (lookup-def 'cl-bbs/models:date (cdr (last-element posts-b))) ""))) + (string> date-a date-b))))) + (list-entries (mapcar #'build-list-entry sorted-threads)) + (frontpage-count 10) + (index-entries (mapcar #'build-index-entry + (if (> (length sorted-threads) frontpage-count) + (take sorted-threads frontpage-count) + sorted-threads))) + (list-path (format nil "~Alist" dir)) + (index-path (format nil "~Aindex" dir))) + (write-sexp-file list-path list-entries) + (write-sexp-file index-path index-entries) + (format t "Generated list and index for ~A~%" board)))) + +(defun get-iso-datetime () + (multiple-value-bind (second minute hour date month year) + (get-decoded-time) + (format nil "~4,'0D-~2,'0D-~2,'0DT~2,'0D:~2,'0D:~2,'0D" + year month date hour minute second))) + +(defun read-backup-metadata (archive-name) + (let ((output (make-string-output-stream))) + (handler-case + (progn + (uiop:run-program (list "tar" "-xzf" archive-name "-O" "metadata.txt") + :output output :error-output nil) + (string-trim '(#\Space #\Tab #\Newline #\Return) (get-output-stream-string output))) + (error () "")))) + +(defun list-backups () + (let* ((data-dir (string-right-trim "/" (get-data-dir))) + (backup-dir (format nil "~A/backup" data-dir)) + (backups (and (probe-file backup-dir) + (sort (directory (format nil "~A/*.tar.gz" backup-dir)) + #'string> :key #'namestring)))) + (if backups + (progn + (format t "Available backups:~%") + (dolist (b backups) + (let ((meta (read-backup-metadata (namestring b)))) + (format t " ~A ~A~%" (file-namestring b) + (if (and meta (not (string= meta ""))) + (format nil "- ~A" meta) + ""))))) + (format t "No backups found.~%")))) + +(defun ask-confirmation (prompt) + (format t "~A [y/N]: " prompt) + (force-output) + (let ((response (read-line *standard-input* nil ""))) + (or (string-equal response "y") + (string-equal response "yes")))) + +(defun backup (&optional arg1) + (let* ((data-dir (string-right-trim "/" (get-data-dir))) + (backup-dir (format nil "~A/backup" data-dir)) + (is-filename (and arg1 (uiop:string-suffix-p arg1 ".tar.gz"))) + (message (if is-filename nil arg1)) + (archive-name (if is-filename + arg1 + (format nil "~A/sbbs-~A.tar.gz" backup-dir (get-iso-datetime)))) + (metadata-file (format nil "~A/metadata.txt" backup-dir))) + (ensure-directories-exist (format nil "~A/" backup-dir)) + (when message + (with-open-file (stream metadata-file :direction :output :if-does-not-exist :create :if-exists :supersede) + (write-line message stream))) + (if message + (uiop:run-program (list "tar" "-czf" archive-name "-C" data-dir "sexp" "-C" backup-dir "metadata.txt") + :output *standard-output* :error-output *error-output*) + (uiop:run-program (list "tar" "-czf" archive-name "-C" data-dir "sexp") + :output *standard-output* :error-output *error-output*)) + (when (and message (probe-file metadata-file)) + (delete-file metadata-file)) + (format t "Backup created: ~A~%" archive-name))) + +(defun restore (&optional archive-name) + (if archive-name + (let* ((data-dir (string-right-trim "/" (get-data-dir))) + (backup-dir (format nil "~A/backup" data-dir)) + (archive-path (if (probe-file archive-name) + archive-name + (format nil "~A/~A" backup-dir archive-name)))) + (if (probe-file archive-path) + (progn + (uiop:run-program (list "tar" "-xzf" archive-path "-C" data-dir) + :output *standard-output* :error-output *error-output*) + (format t "Restore completed from: ~A~%" archive-path)) + (format t "Archive not found: ~A~%" archive-name))) + (list-backups))) + +(defun remove-post (board post-id) + (let* ((data-dir (string-right-trim "/" (get-data-dir))) + (sexp-file (format nil "~A/sexp/~A/~A" data-dir board post-id))) + (if (probe-file sexp-file) + (let* ((data (read-sexp-file sexp-file)) + (headline (lookup-def 'cl-bbs/models:headline data)) + (posts (get-flat-posts (lookup-def 'cl-bbs/models:posts data))) + (first-post (car posts)) + (date (lookup-def 'cl-bbs/models:date (cdr first-post))) + (content (lookup-def 'cl-bbs/models:content (cdr first-post)))) + (format t "Post Headline: ~A~%" headline) + (format t "Post Date: ~A~%" date) + (format t "Post Content:~%~A~%" content) + (when (ask-confirmation (format nil "Are you sure you want to remove thread ~A?" post-id)) + (backup (format nil "Before removing thread ~A from board ~A" post-id board)) + (delete-file sexp-file) + (format t "Removed thread ~A.~%" sexp-file) + (generate-index board))) + (format t "Thread ~A does not exist.~%" sexp-file)))) + +(defun remove-comment (board post-id comment-id-str) + (let* ((data-dir (string-right-trim "/" (get-data-dir))) + (sexp-file (format nil "~A/sexp/~A/~A" data-dir board post-id)) + (comment-id (parse-integer comment-id-str :junk-allowed t))) + (unless (probe-file sexp-file) + (format t "Thread ~A does not exist.~%" sexp-file) + (return-from remove-comment nil)) + (let* ((data (read-sexp-file sexp-file)) + (headline (lookup-def 'cl-bbs/models:headline data)) + (posts (get-flat-posts (lookup-def 'cl-bbs/models:posts data))) + (comment (find comment-id posts :key #'car))) + (if (not comment) + (format t "Comment ~A not found in thread ~A.~%" comment-id post-id) + (let ((comment-content (lookup-def 'cl-bbs/models:content (cdr comment))) + (comment-date (lookup-def 'cl-bbs/models:date (cdr comment)))) + (format t "Post Headline: ~A~%" headline) + (format t "Comment Date: ~A~%" comment-date) + (format t "Comment Content:~%~A~%" comment-content) + (when (ask-confirmation (format nil "Are you sure you want to remove comment ~A from thread ~A?" + comment-id post-id)) + (backup (format nil "Before removing comment ~A from thread ~A on board ~A" comment-id post-id board)) + (let ((new-posts (remove-if (lambda (p) (= (car p) comment-id)) posts))) + (if (null new-posts) + (progn + (when (probe-file sexp-file) (delete-file sexp-file)) + (format t "Removed thread ~A entirely as it has no remaining comments.~%" post-id)) + (progn + (write-sexp-file sexp-file `((cl-bbs/models:headline . ,headline) + (cl-bbs/models:posts ,new-posts))) + (format t "Removed comment ~A from thread ~A.~%" comment-id post-id))) + (generate-index board)))))))) + +(defun edit-comment (board post-id comment-id-str) + (let* ((data-dir (string-right-trim "/" (get-data-dir))) + (sexp-file (format nil "~A/sexp/~A/~A" data-dir board post-id)) + (comment-id (parse-integer comment-id-str :junk-allowed t))) + (unless (probe-file sexp-file) + (format t "Thread ~A does not exist.~%" sexp-file) + (return-from edit-comment nil)) + (let* ((data (read-sexp-file sexp-file)) + (headline (lookup-def 'cl-bbs/models:headline data)) + (posts (get-flat-posts (lookup-def 'cl-bbs/models:posts data))) + (comment (find comment-id posts :key #'car))) + (if (not comment) + (format t "Comment ~A not found in thread ~A.~%" comment-id post-id) + (let* ((content-cell (assoc 'cl-bbs/models:content (cdr comment))) + (content-value (cdr content-cell))) + (uiop:with-temporary-file (:pathname tmp-path :keep t) + (with-open-file (stream tmp-path :direction :output :if-exists :supersede + :external-format :utf-8) + (write-line content-value stream)) + (let ((editor (or (uiop:getenv "EDITOR") "vi"))) + (format t "Opening ~A with ~A...~%" tmp-path editor) + (uiop:run-program (format nil "~A ~A" editor (namestring tmp-path)) + :output :interactive + :input :interactive + :error-output :interactive) + (let ((new-content-value (uiop:read-file-string tmp-path))) + (delete-file tmp-path) + (when (and new-content-value (string/= new-content-value "")) + (backup (format nil "Before editing comment ~A from thread ~A on board ~A" + comment-id post-id board)) + (let ((new-posts (mapcar (lambda (p) + (if (= (car p) comment-id) + (cons (car p) + (mapcar (lambda (kv) + (if (eq (car kv) 'cl-bbs/models:content) + (cons (car kv) + (string-right-trim '(#\Newline #\Return) + new-content-value)) + kv)) + (cdr p))) + p)) + posts))) + (write-sexp-file sexp-file `((cl-bbs/models:headline . ,headline) + (cl-bbs/models:posts ,new-posts))) + (format t "Edited comment ~A from thread ~A.~%" comment-id post-id) + (generate-index board))))))))))) + +(defun get-next-post-id (board) + (let* ((data-dir (string-right-trim "/" (get-data-dir))) + (sexp-dir (format nil "~A/sexp/~A/" data-dir board)) + (files (and (probe-file sexp-dir) + (uiop:directory-files (uiop:ensure-absolute-pathname sexp-dir (uiop:getcwd))))) + (max-id 0)) + (dolist (file files) + (let ((id (handler-case (parse-integer (pathname-name file)) + (error () nil)))) + (when (and id (> id max-id)) + (setf max-id id)))) + (1+ max-id))) + +(defun move-post (source-board post-id target-board) + (let* ((data-dir (string-right-trim "/" (get-data-dir))) + (source-file (format nil "~A/sexp/~A/~A" data-dir source-board post-id)) + (target-dir (format nil "~A/sexp/~A/" data-dir target-board))) + (if (probe-file source-file) + (progn + (unless (uiop:directory-exists-p (uiop:ensure-absolute-pathname target-dir (uiop:getcwd))) + (format t "Target board ~A does not exist.~%" target-board) + (return-from move-post nil)) + (let* ((new-id (get-next-post-id target-board)) + (target-file (format nil "~A~A" target-dir new-id))) + (backup (format nil "Before moving thread ~A from ~A to ~A as ~A" post-id source-board target-board new-id)) + (uiop:copy-file source-file target-file) + (delete-file source-file) + (format t "Moved thread ~A from ~A to ~A as thread ~A.~%" post-id source-board target-board new-id) + (generate-index source-board) + (generate-index target-board))) + (format t "Thread ~A does not exist in board ~A.~%" post-id source-board)))) + +(defun parse-post-date (date-string) + (let ((year (parse-integer date-string :start 0 :end 4)) + (month (parse-integer date-string :start 5 :end 7)) + (day (parse-integer date-string :start 8 :end 10)) + (hour (parse-integer date-string :start 11 :end 13)) + (minute (parse-integer date-string :start 14 :end 16))) + (encode-universal-time 0 minute hour day month year 0))) + +(defun format-post-date (universal-time) + (multiple-value-bind (second minute hour day month year) + (decode-universal-time universal-time 0) + (declare (ignore second)) + (format nil "~4,'0D-~2,'0D-~2,'0D ~2,'0D:~2,'0D" year month day hour minute))) + +(defun add-timezone-offset (date-string offset-hours) + (let* ((ut (parse-post-date date-string)) + (new-ut (+ ut (* offset-hours 3600)))) + (format-post-date new-ut))) + +(defun list-all (&optional board post-id-str) + (let* ((data-dir (string-right-trim "/" (get-data-dir))) + (sexp-dir (format nil "~A/sexp/" data-dir))) + (cond + ((null board) + (let ((boards (and (probe-file sexp-dir) + (uiop:subdirectories (uiop:ensure-absolute-pathname sexp-dir (uiop:getcwd)))))) + (if boards + (progn + (format t "Boards:~%") + (dolist (b-path boards) + (format t " ~A~%" (car (last (pathname-directory b-path)))))) + (format t "No boards found in ~A~%" sexp-dir)))) + ((and board post-id-str) + (let ((sexp-file (format nil "~A/sexp/~A/~A" data-dir board post-id-str)) + (post-id (parse-integer post-id-str :junk-allowed t))) + (if (and post-id (probe-file sexp-file)) + (let* ((data (read-sexp-file sexp-file)) + (headline (lookup-def 'cl-bbs/models:headline data)) + (posts (get-flat-posts (lookup-def 'cl-bbs/models:posts data)))) + (format t "Thread ~A: ~A~%" post-id-str headline) + (dolist (p posts) + (let* ((cid (car p)) + (pdata (cdr p)) + (date (lookup-def 'cl-bbs/models:date pdata)) + (author (lookup-def 'cl-bbs/models:name pdata)) + (content (lookup-def 'cl-bbs/models:content pdata))) + (format t "~%[~A] #~A by ~A~%" date cid (or author "Anonymous")) + (format t "~A~%" content)))) + (format t "Thread ~A not found in board ~A.~%" post-id-str board)))) + (board + (let* ((board-dir (format nil "~A/sexp/~A/" data-dir board)) + (threads-data (get-threads board-dir))) + (if threads-data + (let ((sorted (sort threads-data + (lambda (a b) + (let* ((posts-a (get-flat-posts (lookup-def 'cl-bbs/models:posts (cdr a)))) + (last-a (last-element posts-a)) + (date-a (lookup-def 'cl-bbs/models:date (cdr last-a))) + (ut-a (parse-post-date date-a)) + (posts-b (get-flat-posts (lookup-def 'cl-bbs/models:posts (cdr b)))) + (last-b (last-element posts-b)) + (date-b (lookup-def 'cl-bbs/models:date (cdr last-b))) + (ut-b (parse-post-date date-b))) + (> ut-a ut-b)))))) + (progn + (format t "Threads in board ~A:~%" board) + (format t "~10A ~20A ~A~%" "ID" "Last Update" "Headline") + (format t "~v@{~A~:*~}~%" 60 "-") + (dolist (t-data sorted) + (let* ((tid (car t-data)) + (t-content (cdr t-data)) + (headline (lookup-def 'cl-bbs/models:headline t-content)) + (posts (get-flat-posts (lookup-def 'cl-bbs/models:posts t-content))) + (last-date (lookup-def 'cl-bbs/models:date (cdr (last-element posts))))) + (format t "~10D ~20A ~A~%" tid last-date headline))))) + (format t "No threads found in board ~A.~%" board))))))) + +(defun set-timezone (offset-hours) + (backup (format nil "Before setting timezone offset to ~D" offset-hours)) + (let* ((data-dir (string-right-trim "/" (get-data-dir))) + (sexp-dir (format nil "~A/sexp/" data-dir)) + (boards (uiop:subdirectories (uiop:ensure-absolute-pathname sexp-dir (uiop:getcwd))))) + (dolist (board-path boards) + (let ((board (car (last (pathname-directory board-path)))) + (threads (uiop:directory-files board-path))) + (dolist (thread threads) + (when (handler-case (parse-integer (pathname-name thread)) + (error () nil)) + (let* ((data (read-sexp-file thread)) + (headline (lookup-def 'cl-bbs/models:headline data)) + (posts (get-flat-posts (lookup-def 'cl-bbs/models:posts data))) + (new-posts (mapcar (lambda (p) + (let* ((post-id (car p)) + (post-data (cdr p)) + (old-date (lookup-def 'cl-bbs/models:date post-data)) + (new-date (add-timezone-offset old-date offset-hours))) + (cons post-id + (mapcar (lambda (kv) + (if (eq (car kv) 'cl-bbs/models:date) + (cons (car kv) new-date) + kv)) + post-data)))) + posts))) + (write-sexp-file thread `((cl-bbs/models:headline . ,headline) (cl-bbs/models:posts ,new-posts))))) + (generate-index board)))))) + +(defun find-duplicates (posts) + (let ((duplicates nil) + (prev-post (car posts))) + (dolist (curr-post (cdr posts)) + (let ((prev-content (lookup-def 'cl-bbs/models:content (cdr prev-post))) + (curr-content (lookup-def 'cl-bbs/models:content (cdr curr-post)))) + (if (equal prev-content curr-content) + (push curr-post duplicates) + (setf prev-post curr-post)))) + (nreverse duplicates))) + +(defun remove-duplicates-command () + (let* ((data-dir (string-right-trim "/" (get-data-dir))) + (sexp-dir (format nil "~A/sexp/" data-dir)) + (boards (uiop:subdirectories (uiop:ensure-absolute-pathname sexp-dir (uiop:getcwd)))) + (all-duplicates nil)) + (dolist (board-path boards) + (let ((board (car (last (pathname-directory board-path)))) + (threads (uiop:directory-files board-path))) + (dolist (thread-path threads) + (let ((thread-id (pathname-name thread-path))) + (when (handler-case (parse-integer thread-id) + (error () nil)) + (let* ((data (read-sexp-file thread-path)) + (posts (get-flat-posts (lookup-def 'cl-bbs/models:posts data))) + (dups (find-duplicates posts))) + (when dups + (push (list board thread-id dups thread-path data) all-duplicates))))))) + (if (null all-duplicates) + (format t "No sequential duplicate comments found.~%") + (progn + (format t "Found sequential duplicate comments:~%~%") + (dolist (entry (reverse all-duplicates)) + (destructuring-bind (board thread-id dups thread-path data) entry + (declare (ignore thread-path data)) + (format t "Board: ~A, Thread: ~A~%" board thread-id) + (dolist (dup dups) + (let ((comment-id (car dup)) + (content (lookup-def 'cl-bbs/models:content (cdr dup)))) + (format t " - Duplicate Comment ID: ~A~%" comment-id) + (format t " Content: ~A~%" content))))) + (format t "~%") + (when (ask-confirmation "Are you sure you want to delete these duplicate comments?") + (backup "Before removing sequential duplicate comments") + (let ((affected-boards nil)) + (dolist (entry all-duplicates) + (destructuring-bind (board thread-id dups thread-path data) entry + (let* ((headline (lookup-def 'cl-bbs/models:headline data)) + (posts (get-flat-posts (lookup-def 'cl-bbs/models:posts data))) + (dup-ids (mapcar #'car dups)) + (new-posts (remove-if (lambda (p) (member (car p) dup-ids)) posts))) + (write-sexp-file thread-path `((cl-bbs/models:headline . ,headline) + (cl-bbs/models:posts ,new-posts))) + (pushnew board affected-boards :test #'string-equal) + (format t "Removed ~D duplicates from ~A/~A~%" (length dups) board thread-id)))) + (dolist (board affected-boards) + (generate-index board))))))))) + +(defun print-help () + (format t "Usage: cl-bbs-admin [args...]~%~%") + (format t "Commands:~%") + (format t " generate-index Regenerate index and list files for a board~%") + (format t " list [board] [post-id] List boards, threads in a board, or comments in a thread~%") + (format t " remove-post Remove an entire thread/post~%") + (format t " remove-duplicates Remove sequential duplicate comments across all boards~%") + (format t " remove-comment Remove a specific comment from a thread~%") + (format t " edit Edit a specific comment using $EDITOR~%") + (format t " move Move a thread to a different board~%") + (format t " backup [\"description msg\"] Backup the sexp directory to a tarball~%") + (format t " restore [archive.tar.gz] Restore or list backups~%") + (format t " set-timezone Offset all posts timezone and recreate indices~%~%") + (format t "Environment Variables:~%") + (format t " SBBS_DATADIR Path to data directory (default: project data/)~%")) + +(defun main (&rest argv) + "Main entry point for cl-bbs-admin command line interface, parsing and dispatching command line arguments ARGV." + (handler-case + (if (null argv) + (print-help) + (let ((cmd (first argv))) + (cond + ((string= cmd "list") + (list-all (second argv) (third argv))) + ((string= cmd "generate-index") + (if (>= (length argv) 2) + (generate-index (second argv)) + (format t "Usage: cl-bbs-admin generate-index ~%"))) + ((string= cmd "remove-post") + (if (>= (length argv) 3) + (remove-post (second argv) (third argv)) + (format t "Usage: cl-bbs-admin remove-post ~%"))) + ((string= cmd "remove-duplicates") + (remove-duplicates-command)) + ((string= cmd "remove-comment") + (if (>= (length argv) 4) + (remove-comment (second argv) (third argv) (fourth argv)) + (format t "Usage: cl-bbs-admin remove-comment ~%"))) + ((string= cmd "edit") + (if (>= (length argv) 4) + (edit-comment (second argv) (third argv) (fourth argv)) + (format t "Usage: cl-bbs-admin edit ~%"))) + ((string= cmd "move") + (if (>= (length argv) 4) + (move-post (second argv) (third argv) (fourth argv)) + (format t "Usage: cl-bbs-admin move ~%"))) + ((string= cmd "backup") + (if (>= (length argv) 2) + (backup (format nil "~{~A~^ ~}" (cdr argv))) + (backup))) + ((string= cmd "restore") + (if (>= (length argv) 2) + (restore (second argv)) + (restore))) + ((string= cmd "set-timezone") + (if (>= (length argv) 2) + (let ((offset (parse-integer (second argv) :junk-allowed t))) + (if offset + (set-timezone offset) + (format t "Invalid timezone offset: ~A~%" (second argv)))) + (format t "Usage: cl-bbs-admin set-timezone ~%"))) + (t + (format t "Unknown command: ~A~%" cmd) + (print-help))))) + (#+sbcl sb-sys:interactive-interrupt + #+ccl ccl:interrupt-condition + #+clisp system:simple-interrupt-condition + #+ecl ext:interactive-interrupt + #+allegro excl:interrupt-signal + () + (progn + (format *error-output* "~&Interrupted.~%") + (uiop:quit 1))))) diff --git a/server/handlers.lisp b/server/handlers.lisp new file mode 100644 index 0000000..11ec701 --- /dev/null +++ b/server/handlers.lisp @@ -0,0 +1,903 @@ +(defpackage :cl-bbs/handlers + (:use :cl) + (:import-from :cl-bbs/storage + #:*base-dir* + #:read-sexp-file + #:write-sexp-file + #:is-board-locked + #:ensure-board-dirs) + (:import-from :cl-bbs/rss + #:generate-rss + #:get-all-boards-rss-threads) + (:import-from :cl-bbs/views + #:render-moderation + #:render-index + #:render-list + #:render-preferences + #:render-error-page + #:render-thread + #:render-search-results + #:render-playground) + (:export #:handle-request + #:*headline-limit* + #:*body-limit*)) + +(in-package :cl-bbs/handlers) + +(defparameter *headline-limit* + (or (and (uiop:getenv "SBBS_HEADLINE_LIMIT") + (parse-integer (uiop:getenv "SBBS_HEADLINE_LIMIT") :junk-allowed t)) + 128) + "Maximum character limit for post headlines.") + +(defparameter *body-limit* + (or (and (uiop:getenv "SBBS_BODY_LIMIT") + (parse-integer (uiop:getenv "SBBS_BODY_LIMIT") :junk-allowed t)) + 4096) + "Maximum character limit for post bodies.") + +(defun parse-cookies (cookie-string) + "Parses a Cookie header string like 'theme=dark; foo=bar' into an alist." + (when cookie-string + (let ((cookies '())) + (dolist (part (cl-ppcre:split ";" cookie-string)) + (let ((pair (cl-ppcre:split "=" (string-trim '(#\Space #\Tab #\Newline #\Return) part) :limit 2))) + (when (= (length pair) 2) + (let ((name (string-trim '(#\Space #\Tab #\Newline #\Return) (first pair))) + (val (string-trim '(#\Space #\Tab #\Newline #\Return) (second pair)))) + (push (cons name val) cookies))))) + (nreverse cookies)))) + +(defun sanitize-theme-name (theme-str) + "Validates and returns theme-str if it consists only of alphanumeric characters, +hyphens, and underscores. Otherwise returns nil to prevent injection/directory traversal." + (when (and theme-str (cl-ppcre:scan "^[a-zA-Z0-9_-]+$" theme-str)) + theme-str)) + +(defun sanitize-board-name (board-str) + "Validates and returns board-str if it consists only of alphanumeric characters, +hyphens, and underscores. Otherwise returns nil to prevent injection/directory traversal." + (when (and board-str (cl-ppcre:scan "^[a-zA-Z0-9_-]+$" board-str)) + board-str)) + +(defun get-default-board-from-env (env) + "Retrieves the default board name from the request cookies." + (let* ((headers (getf env :headers)) + (cookie-str (and headers (gethash "cookie" headers))) + (cookies (parse-cookies cookie-str)) + (cookie-board (sanitize-board-name (cdr (assoc "default_board" cookies :test #'string=))))) + (and (not (string= cookie-board "")) cookie-board))) + +(defun get-theme-from-env (env) + "Retrieves the active theme name from the request query parameters or cookies." + (let* ((query-str (getf env :query-string)) + (query-theme (when (and query-str (not (string= query-str ""))) + (let ((params (quri:url-decode-params query-str))) + (sanitize-theme-name (cdr (assoc "theme" params :test #'string=))))))) + (or query-theme + (let* ((headers (getf env :headers)) + (cookie-str (and headers (gethash "cookie" headers))) + (cookies (parse-cookies cookie-str)) + (cookie-theme (sanitize-theme-name (cdr (assoc "theme" cookies :test #'string=))))) + (or cookie-theme "default"))))) + +(defun get-syntax-theme-from-env (env) + "Retrieves the active syntax theme name from the request cookies." + (let* ((headers (getf env :headers)) + (cookie-str (and headers (gethash "cookie" headers))) + (cookies (parse-cookies cookie-str)) + (cookie-theme (sanitize-theme-name (cdr (assoc "syntax_theme" cookies :test #'string=))))) + (or cookie-theme "simple"))) + +(defun get-search-hide-input-from-env (env) + "Retrieves the setting for hiding search input in board view (returns \"yes\" or \"no\", default \"no\")." + (let* ((headers (getf env :headers)) + (cookie-str (and headers (gethash "cookie" headers))) + (cookies (parse-cookies cookie-str)) + (val (cdr (assoc "search_hide_input" cookies :test #'string=)))) + (if (member val '("yes" "no") :test #'string=) val "no"))) + +(defun get-search-local-only-from-env (env) + "Retrieves the setting for forcing local search in current board (returns \"yes\" or \"no\", default \"no\")." + (let* ((headers (getf env :headers)) + (cookie-str (and headers (gethash "cookie" headers))) + (cookies (parse-cookies cookie-str)) + (val (cdr (assoc "search_local_only" cookies :test #'string=)))) + (if (member val '("yes" "no") :test #'string=) val "no"))) + +(defun get-search-position-from-env (env) + "Retrieves the setting for search input placement (returns \"top\" or \"bottom\", default \"top\")." + (let* ((headers (getf env :headers)) + (cookie-str (and headers (gethash "cookie" headers))) + (cookies (parse-cookies cookie-str)) + (val (cdr (assoc "search_position" cookies :test #'string=)))) + (if (member val '("top" "bottom") :test #'string=) val "top"))) + +(defun get-board-description (board-name) + "Maps a board-name string to a friendly human-readable title." + (cond + ((string= board-name "prog") "Programming") + ((string= board-name "foo") "Foo Reference") + ((string= board-name "b") "random") + (t (string-capitalize board-name)))) + +(defun generate-boards-html-list () + (let* ((sexp-dir (merge-pathnames "sexp/" cl-bbs/storage:*base-dir*)) + (paths (and (probe-file sexp-dir) (uiop:subdirectories sexp-dir))) + (boards (sort (mapcar (lambda (path) + (car (last (pathname-directory path)))) + paths) + #'string<)) + (html-list '())) + (dolist (b boards) + (push (format nil "
  • /~a/ - ~a
  • " b b (get-board-description b)) html-list)) + (format nil "
      ~{~A~%~}
    " (nreverse html-list)))) + +(defun authenticate-admin (env) + "Checks if the request has valid admin credentials in environment variables." + (let* ((admin-user (or (uiop:getenv "SBBS_ADMIN_USER") "admin")) + (admin-password (or (uiop:getenv "SBBS_ADMIN_PASSWORD") "superchanner")) + (headers (getf env :headers)) + (auth-str (and headers (gethash "authorization" headers))) + (creds (and auth-str (cl-ppcre:regex-replace-all "^Basic " auth-str "")))) + (when creds + (let* ((decoded (handler-case (cl-base64:base64-string-to-string creds) + (error () nil))) + (parts (and decoded (cl-ppcre:split ":" decoded :limit 2)))) + (and (= (length parts) 2) + (string= (first parts) admin-user) + (string= (second parts) admin-password)))))) + +(defun delete-board-dir (board) + (let ((board-dir (merge-pathnames (format nil "sexp/~a/" board) *base-dir*))) + (when (probe-file board-dir) + (uiop:delete-directory-tree board-dir :validate t)))) + +(defun get-board-threads (dir) + (let ((threads nil)) + (loop for i from 1 + for filepath = (merge-pathnames (format nil "~D" i) dir) + for exists = (probe-file filepath) + while (or exists (<= i 200)) + do (when exists + (let ((data (read-sexp-file filepath))) + (when data + (push (cons i data) threads))))) + threads)) + +(defun search-posts (query &optional board-filter) + "Searches across all boards (or a specific board if BOARD-FILTER is provided) for posts or headlines matching QUERY." + (let ((results '()) + (sexp-dir (merge-pathnames "sexp/" *base-dir*))) + (when (and query (string/= "" (string-trim '(#\Space #\Tab #\Newline #\Return) query))) + (let ((board-dirs (if (and board-filter (string/= "" board-filter)) + (list (merge-pathnames (format nil "~a/" board-filter) sexp-dir)) + (and (probe-file sexp-dir) (uiop:subdirectories sexp-dir))))) + (dolist (board-dir board-dirs) + (let ((board-name (car (last (pathname-directory board-dir)))) + ;; Get only files whose namestring consists only of digits (which are the thread S-expression files) + (thread-files (and (probe-file board-dir) + (remove-if-not (lambda (file) + (let ((name (file-namestring file))) + (and (string/= name "") + (every #'digit-char-p name)))) + (uiop:directory-files board-dir))))) + (dolist (thread-file thread-files) + (let* ((thread-id (file-namestring thread-file)) + (thread-data (read-sexp-file thread-file)) + (raw-thread (if (and (consp thread-data) + (consp (car thread-data)) + (consp (caar thread-data))) + (car thread-data) + thread-data)) + (headline (cdr (assoc 'cl-bbs/models:headline raw-thread))) + (posts-assoc (assoc 'cl-bbs/models:posts raw-thread))) + (when posts-assoc + (let ((posts (get-flat-posts posts-assoc))) + (dolist (post posts) + (let* ((post-id (car post)) + (post-data (cdr post)) + (content (cdr (assoc 'cl-bbs/models:content post-data))) + (date (cdr (assoc 'cl-bbs/models:date post-data)))) + (when (or (and headline (search query headline :test #'char-equal)) + (and content (search query content :test #'char-equal))) + (push (list :board board-name + :thread-id thread-id + :headline (or headline "No Headline") + :post-id post-id + :date (or date "") + :content (or content "")) + results)))))))))))) + (nreverse results))) + +(defun get-flat-posts (posts-assoc) + (when posts-assoc + (let* ((cdr-val (cdr posts-assoc)) + (cadr-val (and (listp cdr-val) (car cdr-val)))) + (if (and (listp cadr-val) (listp (car cadr-val))) + cadr-val + cdr-val)))) + +(defun regenerate-board-index (board) + (let* ((board-dir (merge-pathnames (format nil "sexp/~a/" board) *base-dir*)) + (threads-data (get-board-threads board-dir))) + (if (null threads-data) + (let ((list-path (merge-pathnames "list" board-dir)) + (index-path (merge-pathnames "index" board-dir))) + (when (probe-file list-path) (delete-file list-path)) + (when (probe-file index-path) (delete-file index-path))) + (let* ((sorted-threads + (sort threads-data + (lambda (a b) + (let* ((raw-a (if (and (consp (cdr a)) (consp (cadr a)) (consp (caadr a))) (cadr a) (cdr a))) + (raw-b (if (and (consp (cdr b)) (consp (cadr b)) (consp (caadr b))) (cadr b) (cdr b))) + (posts-assoc-a (assoc 'cl-bbs/models:posts raw-a)) + (posts-assoc-b (assoc 'cl-bbs/models:posts raw-b)) + (posts-a (get-flat-posts posts-assoc-a)) + (posts-b (get-flat-posts posts-assoc-b)) + (date-a (or (cdr (assoc 'cl-bbs/models:date (cdr (car (last posts-a))))) "")) + (date-b (or (cdr (assoc 'cl-bbs/models:date (cdr (car (last posts-b))))) ""))) + (string> date-a date-b))))) + (list-entries + (mapcar (lambda (t-entry) + (let* ((id (car t-entry)) + (t-data (cdr t-entry)) + (raw-t (if (and (consp t-data) + (consp (car t-data)) + (consp (caar t-data))) + (car t-data) + t-data)) + (posts-assoc (assoc 'cl-bbs/models:posts raw-t)) + (posts (get-flat-posts posts-assoc)) + (headline (cdr (assoc 'cl-bbs/models:headline raw-t))) + (date (cdr (assoc 'cl-bbs/models:date (cdr (car (last posts)))))) + (messages (length posts))) + `(,id (cl-bbs/models:headline . ,headline) + (cl-bbs/models:date . ,date) + (cl-bbs/models:messages . ,messages)))) + sorted-threads)) + (frontpage-count (min 10 (length sorted-threads))) + (index-entries + (mapcar (lambda (t-entry) + (let* ((id (car t-entry)) + (t-data (cdr t-entry)) + (raw-t (if (and (consp t-data) + (consp (car t-data)) + (consp (caar t-data))) + (car t-data) + t-data)) + (headline (cdr (assoc 'cl-bbs/models:headline raw-t))) + (posts-assoc (assoc 'cl-bbs/models:posts raw-t)) + (posts (get-flat-posts posts-assoc)) + (truncated-ids (if (> (length posts) 6) + (mapcar #'car (butlast (cdr posts) 5)) + nil)) + (selected-posts (if (> (length posts) 6) (cons (car posts) (last posts 5)) posts))) + `(,id (cl-bbs/models:headline . ,headline) + (cl-bbs/models:truncated . ,truncated-ids) + (cl-bbs/models:posts ,selected-posts)))) + (subseq sorted-threads 0 frontpage-count))) + (list-path (merge-pathnames "list" board-dir)) + (index-path (merge-pathnames "index" board-dir))) + (write-sexp-file list-path list-entries) + (write-sexp-file index-path index-entries))))) + +(defun delete-thread-file (board thread-id) + (let ((filepath (merge-pathnames (format nil "sexp/~a/~a" board thread-id) *base-dir*))) + (when (probe-file filepath) + (delete-file filepath) + (regenerate-board-index board)))) + +(defun get-next-handler-thread-id (board) + (let* ((board-dir (merge-pathnames (format nil "sexp/~a/" board) *base-dir*)) + (files (and (probe-file board-dir) + (uiop:directory-files board-dir))) + (max-id 0)) + (dolist (file files) + (let ((id (handler-case (parse-integer (pathname-name file)) + (error () nil)))) + (when (and id (> id max-id)) + (setf max-id id)))) + (1+ max-id))) + +(defun shame-thread-file (board thread-id) + (let* ((source-file (merge-pathnames (format nil "sexp/~a/~a" board thread-id) *base-dir*)) + (target-board "shame") + (target-dir (merge-pathnames (format nil "sexp/~a/" target-board) *base-dir*))) + (when (and (probe-file source-file) (string-not-equal board target-board)) + (ensure-directories-exist target-dir) + (let* ((new-id (get-next-handler-thread-id target-board)) + (target-file (merge-pathnames (format nil "~D" new-id) target-dir))) + (uiop:copy-file source-file target-file) + (delete-file source-file) + (regenerate-board-index board) + (regenerate-board-index target-board))))) + +(defun delete-thread-comment (board thread-id comment-id) + (let ((thread-path (merge-pathnames (format nil "sexp/~a/~a" board thread-id) *base-dir*))) + (when (probe-file thread-path) + (let* ((thread-data (read-sexp-file thread-path)) + (raw-thread (if (and (consp thread-data) + (consp (car thread-data)) + (consp (caar thread-data))) + (car thread-data) + thread-data)) + (posts-assoc (assoc 'cl-bbs/models:posts raw-thread))) + (when posts-assoc + (let* ((actual-posts (get-flat-posts posts-assoc)) + (new-posts (remove-if (lambda (p) (= (car p) comment-id)) actual-posts))) + (if (null new-posts) + (delete-file thread-path) + (progn + (setf (cdr posts-assoc) (list new-posts)) + (write-sexp-file thread-path thread-data))) + (regenerate-board-index board))))))) + +(defun edit-thread-comment (board thread-id comment-id new-content &optional new-headline) + (let ((thread-path (merge-pathnames (format nil "sexp/~a/~a" board thread-id) *base-dir*))) + (when (probe-file thread-path) + (let* ((thread-data (read-sexp-file thread-path)) + (raw-thread (if (and (consp thread-data) + (consp (car thread-data)) + (consp (caar thread-data))) + (car thread-data) + thread-data)) + (posts-assoc (assoc 'cl-bbs/models:posts raw-thread))) + (when posts-assoc + (let* ((actual-posts (get-flat-posts posts-assoc)) + (new-posts (mapcar (lambda (p) + (if (= (car p) comment-id) + (cons (car p) + (mapcar (lambda (kv) + (if (eq (car kv) 'cl-bbs/models:content) + (cons (car kv) new-content) + kv)) + (cdr p))) + p)) + actual-posts))) + (setf (cdr posts-assoc) (list new-posts)) + (when (and (= comment-id 1) new-headline) + (let ((headline-assoc (assoc 'cl-bbs/models:headline raw-thread))) + (if headline-assoc + (setf (cdr headline-assoc) new-headline) + (setf raw-thread (append raw-thread (list (cons 'cl-bbs/models:headline new-headline))))))) + (write-sexp-file thread-path thread-data) + (regenerate-board-index board))))))) + +(defun get-date () + (multiple-value-bind (second minute hour date month year) + (get-decoded-time) + (format nil "~4,'0D-~2,'0D-~2,'0D ~2,'0D:~2,'0D:~2,'0D" + year month date hour minute second))) + +(defun get-next-thread-number (threads) + (if (null threads) + 1 + (1+ (apply #'max (mapcar #'car threads))))) + +(defun create-thread (path headline date message) + (let ((thread `((cl-bbs/models:headline . ,headline) + (cl-bbs/models:posts . ((1 (cl-bbs/models:date . ,date) + (cl-bbs/models:vip . nil) + (cl-bbs/models:content . ,message))))))) + (write-sexp-file path thread))) + +(defun add-thread-to-list (path thread-number headline date) + (let ((threads (read-sexp-file path))) + (write-sexp-file path + (cons `(,thread-number (cl-bbs/models:headline . ,headline) + (cl-bbs/models:date . ,date) + (cl-bbs/models:messages . 1)) + threads)))) + +(defun add-thread-to-index (path thread-number headline date message) + (let ((threads (read-sexp-file path)) + (thread `(,thread-number + (cl-bbs/models:headline . ,headline) + (cl-bbs/models:truncated . nil) + (cl-bbs/models:posts + ((1 (cl-bbs/models:date . ,date) + (cl-bbs/models:vip . nil) + (cl-bbs/models:content . ,message))))))) + (write-sexp-file path (cons thread threads)))) + +(defun update-thread-data (thread-data new-post) + (let* ((raw-thread (if (and (consp thread-data) + (consp (car thread-data)) + (consp (caar thread-data))) + (car thread-data) + thread-data)) + (posts-assoc (assoc 'cl-bbs/models:posts raw-thread))) + (if posts-assoc + (let* ((posts-list (if (listp (cdr posts-assoc)) + (if (listp (cadr posts-assoc)) + (cadr posts-assoc) + (cdr posts-assoc)) + (cdr posts-assoc))) + (actual-posts (if (listp (car posts-list)) posts-list (list posts-list))) + (updated-posts (append actual-posts (list new-post)))) + (setf (cdr posts-assoc) (list updated-posts)) + thread-data) + (append thread-data (list `(cl-bbs/models:posts (,new-post))))))) + +(defvar *app* (make-instance 'ningle:)) + +(defun normalize-path (path) + (if (stringp path) + (let ((len (length path))) + (if (and (> len 1) + (char= (char path (1- len)) #\/)) + (subseq path 0 (1- len)) + path)) + path)) + +(defun get-body-params (params env) + (let ((has-theme (assoc "theme" params :test #'string=)) + (has-epistula (assoc "epistula" params :test #'string=)) + (has-action (assoc "action" params :test #'string=))) + (if (or has-theme has-epistula has-action) + params + (let ((content-len (getf env :content-length))) + (if (and content-len (> content-len 0) (getf env :raw-body)) + (let ((body-bytes (make-array content-len :element-type '(unsigned-byte 8))) + (stream (getf env :raw-body))) + (let ((bytes-read (read-sequence body-bytes stream))) + (let ((body-str (flexi-streams:octets-to-string + body-bytes :start 0 :end bytes-read :external-format :utf-8))) + (quri:url-decode-params body-str)))) + params))))) + +(defun handle-request (env) + "Accepts a Clack request environment plist, normalizes it, and dispatches it through ningle endpoints." + (let ((normalized-env (copy-list env))) + (setf (getf normalized-env :path-info) (normalize-path (getf env :path-info))) + (unless (hash-table-p (getf normalized-env :headers)) + (setf (getf normalized-env :headers) (make-hash-table :test 'equal))) + (when (getf normalized-env :request-method) + (setf (getf normalized-env :request-method) + (intern (string-upcase (symbol-name (getf normalized-env :request-method))) :keyword))) + (let ((cl-bbs/views:*preferences* (cl-bbs/views:make-preferences + :theme (get-theme-from-env normalized-env) + :syntax-theme (get-syntax-theme-from-env normalized-env) + :default-board (or (get-default-board-from-env normalized-env) "") + :search-hide-input (get-search-hide-input-from-env normalized-env) + :search-local-only (get-search-local-only-from-env normalized-env) + :search-position (get-search-position-from-env normalized-env)))) + (lack.component:call *app* normalized-env)))) + +(defun render-main-index () + (let ((index-file (pathname (or (uiop:getenv "SBBS_INDEX_FILE") + (merge-pathnames "src/static/index.html" + (asdf:system-source-directory :cl-bbs/server)))))) + (if (probe-file index-file) + (let* ((html-content (uiop:read-file-string index-file)) + (boards-list-html (generate-boards-html-list)) + (dynamic-html (cl-ppcre:regex-replace-all "" + html-content + (lambda (match &rest regs) + (declare (ignore match regs)) + boards-list-html)))) + `(200 (:content-type "text/html; charset=utf-8" + :cache-control "no-store, no-cache, must-revalidate, max-age=0" + :pragma "no-cache" + :expires "0") + (,dynamic-html))) + `(200 (:content-type "text/plain" + :cache-control "no-store, no-cache, must-revalidate, max-age=0" + :pragma "no-cache" + :expires "0") ("SchemeBBS clone root"))))) + +;; 1. GET / +(setf (ningle:route *app* "/" :method :GET) + (lambda (params) + (declare (ignore params)) + (let* ((env (lack.request:request-env ningle:*request*)) + (default-board (get-default-board-from-env env))) + (if default-board + `(303 (:location ,(format nil "/~a/" default-board)) ("Redirecting...")) + (render-main-index))))) + +;; 1b. GET /index.html +(setf (ningle:route *app* "/index.html" :method :GET) + (lambda (params) + (declare (ignore params)) + (render-main-index))) + +;; 2. GET /about +(setf (ningle:route *app* "/about" :method :GET) + (lambda (params) + (declare (ignore params)) + (let ((about-file (pathname (merge-pathnames "src/static/about.html" + (asdf:system-source-directory :cl-bbs/server))))) + (if (probe-file about-file) + `(200 (:content-type "text/html; charset=utf-8") + (,(uiop:read-file-string about-file))) + `(404 (:content-type "text/plain") ("About page not found")))))) + +;; 3. GET /admin (Admin Control Panel) +(setf (ningle:route *app* "/admin" :method :GET) + (lambda (params) + (let ((env (lack.request:request-env ningle:*request*))) + (if (not (authenticate-admin env)) + `(401 (:content-type "text/plain" + :www-authenticate "Basic realm=\"cl-bbs Admin\"") + ("Unauthorized")) + (let* ((sexp-dir (merge-pathnames "sexp/" *base-dir*)) + (paths (and (probe-file sexp-dir) (uiop:subdirectories sexp-dir))) + (boards (sort (mapcar (lambda (path) (car (last (pathname-directory path)))) paths) #'string<)) + (board (cdr (assoc "board" params :test #'string=))) + (thread-id-str (cdr (assoc "thread" params :test #'string=))) + (threads nil) + (comments nil) + (headline nil)) + (when (and board (member board boards :test #'string=)) + (let ((list-path (merge-pathnames (format nil "sexp/~a/list" board) *base-dir*))) + (when (probe-file list-path) + (setf threads (read-sexp-file list-path))))) + (when (and board thread-id-str) + (let ((thread-path (merge-pathnames (format nil "sexp/~a/~a" board thread-id-str) *base-dir*))) + (when (probe-file thread-path) + (let* ((thread-data (read-sexp-file thread-path)) + (raw-thread (if (and (consp thread-data) + (consp (car thread-data)) + (consp (caar thread-data))) + (car thread-data) + thread-data)) + (posts-assoc (assoc 'cl-bbs/models:posts raw-thread))) + (setf headline (cdr (assoc 'cl-bbs/models:headline raw-thread))) + (when posts-assoc + (setf comments (get-flat-posts posts-assoc))))))) + `(200 (:content-type "text/html; charset=utf-8") + (,(render-moderation boards board threads thread-id-str comments + cl-bbs/views:*preferences* headline)))))))) + +;; 4. POST /admin/action (Admin Actions) +(setf (ningle:route *app* "/admin/action" :method :POST) + (lambda (params) + (let* ((env (lack.request:request-env ningle:*request*)) + (parsed-params (get-body-params params env))) + (if (not (authenticate-admin env)) + `(401 (:content-type "text/plain" + :www-authenticate "Basic realm=\"cl-bbs Admin\"") + ("Unauthorized")) + (let ((action (cdr (assoc "action" parsed-params :test #'string=))) + (board (cdr (assoc "board" parsed-params :test #'string=))) + (thread-id-str (cdr (assoc "thread" parsed-params :test #'string=))) + (comment-id-str (cdr (assoc "comment" parsed-params :test #'string=))) + (content (cdr (assoc "content" parsed-params :test #'string=)))) + (cond + ((string= action "delete-board") + (delete-board-dir board) + `(303 (:location "/admin") ("Redirecting..."))) + ((string= action "create-board") + (let ((sanitized (sanitize-board-name board))) + (if sanitized + (progn + (ensure-board-dirs sanitized) + `(303 (:location "/admin") ("Redirecting..."))) + `(400 (:content-type "text/plain") ("Invalid Board Name"))))) + ((string= action "delete-thread") + (delete-thread-file board thread-id-str) + `(303 (:location ,(format nil "/admin?board=~a" board)) ("Redirecting..."))) + ((string= action "shame-thread") + (shame-thread-file board thread-id-str) + `(303 (:location ,(format nil "/admin?board=~a" board)) ("Redirecting..."))) + ((string= action "delete-comment") + (let ((cid (and comment-id-str (parse-integer comment-id-str :junk-allowed t)))) + (when cid + (delete-thread-comment board thread-id-str cid))) + `(303 (:location ,(format nil "/admin?board=~a&thread=~a" board thread-id-str)) ("Redirecting..."))) + ((string= action "edit-comment") + (let ((cid (and comment-id-str (parse-integer comment-id-str :junk-allowed t))) + (headline (cdr (assoc "headline" parsed-params :test #'string=)))) + (when cid + (edit-thread-comment board thread-id-str cid content headline))) + `(303 (:location ,(format nil "/admin?board=~a&thread=~a" board thread-id-str)) ("Redirecting..."))) + (t + `(400 (:content-type "text/plain") ("Invalid Action"))))))))) + +;; 5. GET /sw.js +(setf (ningle:route *app* "/sw.js" :method :GET) + (lambda (params) + (declare (ignore params)) + (let ((sw-file (merge-pathnames "src/static/sw.js" + (asdf:system-source-directory :cl-bbs/server)))) + (if (probe-file sw-file) + `(200 (:content-type "application/javascript") + (,(uiop:read-file-string sw-file))) + `(404 (:content-type "text/plain") ("Service worker not found")))))) + +;; 6. GET /manifest.json +(setf (ningle:route *app* "/manifest.json" :method :GET) + (lambda (params) + (declare (ignore params)) + (let ((manifest-file (merge-pathnames "src/static/manifest.json" + (asdf:system-source-directory :cl-bbs/server)))) + (if (probe-file manifest-file) + `(200 (:content-type "application/json") + (,(uiop:read-file-string manifest-file))) + `(404 (:content-type "text/plain") ("Manifest not found")))))) + +;; 6b. GET /search +(setf (ningle:route *app* "/search" :method :GET) + (lambda (params) + (let* ((query (cdr (assoc "q" params :test #'string=))) + (board-filter (cdr (assoc "board" params :test #'string=))) + (results (if query (search-posts query board-filter) nil))) + `(200 (:content-type "text/html; charset=utf-8") + (,(render-search-results (or query "") results cl-bbs/views:*preferences*)))))) + +;; 6b-api. POST /api/colorize +(setf (ningle:route *app* "/api/colorize" :method :POST) + (lambda (params) + (let* ((env (lack.request:request-env ningle:*request*)) + (parsed-params (get-body-params params env)) + (code (cdr (assoc "code" parsed-params :test #'string=)))) + (if code + `(200 (:content-type "text/html; charset=utf-8") + (,(handler-case (colorize:html-colorization :common-lisp code) + (error () (cl-who:escape-string code))))) + `(400 (:content-type "text/plain") ("No code provided")))))) + +;; 6c. GET /playground (Global Playground) +(setf (ningle:route *app* "/playground" :method :GET) + (lambda (params) + (declare (ignore params)) + `(200 (:content-type "text/html; charset=utf-8") + (,(render-playground nil))))) + +;; 6d. GET /:board/playground (Board-scoped Playground) +(setf (ningle:route *app* "/:board/playground" :method :GET) + (lambda (params) + (let ((board (cdr (assoc :board params)))) + `(200 (:content-type "text/html; charset=utf-8") + (,(render-playground board)))))) + +;; 7. GET /:board/list +(setf (ningle:route *app* "/:board/list" :method :GET) + (lambda (params) + (let* ((board (cdr (assoc :board params))) + (list-path (merge-pathnames (format nil "sexp/~a/list" board) *base-dir*))) + (if (probe-file list-path) + (let ((list-data (read-sexp-file list-path))) + `(200 (:content-type "text/html; charset=utf-8") + (,(render-list board list-data cl-bbs/views:*preferences*)))) + `(200 (:content-type "text/html; charset=utf-8") + (,(render-list board nil cl-bbs/views:*preferences*))))))) + +;; 8. GET /:board/preferences +(setf (ningle:route *app* "/:board/preferences" :method :GET) + (lambda (params) + (let ((board (cdr (assoc :board params)))) + `(200 (:content-type "text/html; charset=utf-8") + (,(render-preferences board cl-bbs/views:*preferences*)))))) + +;; 9. POST /:board/preferences +(setf (ningle:route *app* "/:board/preferences" :method :POST) + (lambda (params) + (let* ((env (lack.request:request-env ningle:*request*)) + (parsed-params (get-body-params params env)) + (board (cdr (assoc :board params))) + (theme (cdr (assoc "theme" parsed-params :test #'string=))) + (syntax-theme (cdr (assoc "syntax_theme" parsed-params :test #'string=))) + (default-board (let ((val (cdr (assoc "default_board" parsed-params :test #'string=)))) + (if val (string-trim '(#\Space #\Tab #\Newline #\Return) val) ""))) + (search-hide-input (let ((val (cdr (assoc "search_hide_input" parsed-params :test #'string=)))) + (if (member val '("yes" "no") :test #'string=) val "no"))) + (search-local-only (let ((val (cdr (assoc "search_local_only" parsed-params :test #'string=)))) + (if (member val '("yes" "no") :test #'string=) val "no"))) + (search-position (let ((val (cdr (assoc "search_position" parsed-params :test #'string=)))) + (if (member val '("top" "bottom") :test #'string=) val "top")))) + `(303 (:location ,(format nil "/~a/preferences" board) + :set-cookie ,(format nil "theme=~a; Path=/; Max-Age=31536000" (or theme "default")) + :set-cookie ,(format nil "syntax_theme=~a; Path=/; Max-Age=31536000" (or syntax-theme "simple")) + :set-cookie ,(format nil "default_board=~a; Path=/; Max-Age=31536000" (or default-board "")) + :set-cookie ,(format nil "search_hide_input=~a; Path=/; Max-Age=31536000" search-hide-input) + :set-cookie ,(format nil "search_local_only=~a; Path=/; Max-Age=31536000" search-local-only) + :set-cookie ,(format nil "search_position=~a; Path=/; Max-Age=31536000" search-position)) + ("Redirecting..."))))) + +;; RSS Feed (All boards) +(setf (ningle:route *app* "/rss" :method :GET) + (lambda (params) + (declare (ignore params)) + (let ((env (lack.request:request-env ningle:*request*)) + (all-threads (cl-bbs/rss:get-all-boards-rss-threads 20))) + (list 200 '(:content-type "application/rss+xml; charset=utf-8") + (list (cl-bbs/rss:generate-rss "all" all-threads env)))))) + +;; RSS Feed (Specific board) +(setf (ningle:route *app* "/:board/rss" :method :GET) + (lambda (params) + (let* ((board (cdr (assoc :board params))) + (env (lack.request:request-env ningle:*request*)) + (list-path (merge-pathnames (format nil "sexp/~a/list" board) *base-dir*)) + (threads (when (probe-file list-path) (read-sexp-file list-path)))) + (list 200 '(:content-type "application/rss+xml; charset=utf-8") + (list (cl-bbs/rss:generate-rss board threads env)))))) + +;; 10. POST /:board/post (New Thread) +(setf (ningle:route *app* "/:board/post" :method :POST) + (lambda (params) + (block out + (let* ((board (cdr (assoc :board params))) + (env (lack.request:request-env ningle:*request*)) + (parsed-params (get-body-params params env)) + (epistula (cdr (assoc "epistula" parsed-params :test #'string=))) + (titulus (cdr (assoc "titulus" parsed-params :test #'string=))) + (date (get-date)) + (list-path (merge-pathnames (format nil "sexp/~a/list" board) *base-dir*)) + (index-path (merge-pathnames (format nil "sexp/~a/index" board) *base-dir*)) + (threads (read-sexp-file list-path)) + (thread-number (get-next-thread-number threads)) + (thread-path (merge-pathnames (format nil "sexp/~a/~a" board thread-number) *base-dir*))) + (cond + ((or (null epistula) + (string= "" (string-trim '(#\Space #\Tab #\Newline #\Return) epistula))) + `(400 (:content-type "text/html; charset=utf-8") + (,(render-error-page "Post body cannot be empty" cl-bbs/views:*preferences*)))) + ((and titulus (> (length titulus) *headline-limit*)) + `(400 (:content-type "text/html; charset=utf-8") + (,(render-error-page (format nil "Headline exceeds maximum length of ~D characters" *headline-limit*) + cl-bbs/views:*preferences*)))) + ((and epistula (> (length epistula) *body-limit*)) + `(400 (:content-type "text/html; charset=utf-8") + (,(render-error-page (format nil "Post body exceeds maximum length of ~D characters" *body-limit*) + cl-bbs/views:*preferences*)))) + (t + (progn + (when (is-board-locked board) + (return-from out + `(403 (:content-type "text/html; charset=utf-8") + (,(render-error-page "This board is read-only" + cl-bbs/views:*preferences*))))) + (unless (probe-file (merge-pathnames (format nil "sexp/~a/" board) *base-dir*)) + (return-from out + `(403 (:content-type "text/html; charset=utf-8") + (,(render-error-page "Only administrators can create new boards" + cl-bbs/views:*preferences*))))) + (ensure-board-dirs board) + (create-thread thread-path titulus date epistula) + (add-thread-to-list list-path thread-number titulus date) + (add-thread-to-index index-path thread-number titulus date epistula) + `(303 (:location ,(format nil "/~a/" board)) ("Redirecting..."))))))))) + +;; 11. GET /:board +(setf (ningle:route *app* "/:board" :method :GET) + (lambda (params) + (let* ((board (cdr (assoc :board params))) + (index-path (merge-pathnames (format nil "sexp/~a/index" board) *base-dir*))) + (if (probe-file index-path) + (let ((index-data (read-sexp-file index-path))) + `(200 (:content-type "text/html; charset=utf-8") + (,(render-index board index-data cl-bbs/views:*preferences*)))) + `(200 (:content-type "text/html; charset=utf-8") + (,(render-index board nil cl-bbs/views:*preferences*))))))) + +;; 12. GET /:board/:thread_id +(setf (ningle:route *app* "/:board/:thread_id" :method :GET) + (lambda (params) + (let* ((board (cdr (assoc :board params))) + (thread-id (cdr (assoc :thread_id params))) + (thread-path (merge-pathnames (format nil "sexp/~a/~a" board thread-id) *base-dir*))) + (if (probe-file thread-path) + (let ((thread-data (read-sexp-file thread-path))) + `(200 (:content-type "text/html; charset=utf-8") + (,(render-thread board thread-id thread-data nil cl-bbs/views:*preferences*)))) + `(404 (:content-type "text/plain") ("Thread not found")))))) + +;; 13. POST /:board/:thread_id/post (Reply to Thread) +(setf (ningle:route *app* "/:board/:thread_id/post" :method :POST) + (lambda (params) + (block out + (let* ((board (cdr (assoc :board params))) + (thread-id (cdr (assoc :thread_id params))) + (env (lack.request:request-env ningle:*request*)) + (parsed-params (get-body-params params env)) + (epistula (cdr (assoc "epistula" parsed-params :test #'string=))) + (date (get-date)) + (thread-path (merge-pathnames (format nil "sexp/~a/~a" board thread-id) *base-dir*))) + (cond + ((or (null epistula) + (string= "" (string-trim '(#\Space #\Tab #\Newline #\Return) epistula))) + `(400 (:content-type "text/html; charset=utf-8") + (,(render-error-page "Post body cannot be empty" cl-bbs/views:*preferences*)))) + ((and epistula (> (length epistula) *body-limit*)) + `(400 (:content-type "text/html; charset=utf-8") + (,(render-error-page (format nil "Post body exceeds maximum length of ~D characters" *body-limit*) + cl-bbs/views:*preferences*)))) + (t + (progn + (when (is-board-locked board) + (return-from out + `(403 (:content-type "text/html; charset=utf-8") + (,(render-error-page "This board is read-only" cl-bbs/views:*preferences*))))) + (if (probe-file thread-path) + (let* ((thread-data (read-sexp-file thread-path)) + (raw-thread (if (and (consp thread-data) + (consp (car thread-data)) + (consp (caar thread-data))) + (car thread-data) + thread-data)) + (posts-assoc (let ((assoc-res (assoc 'cl-bbs/models:posts raw-thread))) + (if assoc-res + assoc-res + (cadr (if (consp thread-data) + thread-data + (list thread-data)))))) + (posts-list (if (listp (cdr posts-assoc)) + (if (listp (cadr posts-assoc)) + (cadr posts-assoc) + (cdr posts-assoc)) + (cdr posts-assoc))) + (posts (if (listp (car posts-list)) posts-list (list posts-list))) + (new-post `(,(1+ (reduce #'max posts :key #'car :initial-value 0)) + (cl-bbs/models:date . ,date) + (cl-bbs/models:vip . nil) + (cl-bbs/models:content . ,epistula))) + (new-thread-data (update-thread-data thread-data new-post))) + (write-sexp-file thread-path new-thread-data) + (let* ((list-path (merge-pathnames (format nil "sexp/~a/list" board) *base-dir*)) + (threads-list (read-sexp-file list-path)) + (str-id (if (stringp thread-id) (parse-integer thread-id) thread-id)) + (target-thread-assoc (assoc str-id threads-list))) + (when target-thread-assoc + (let* ((rem-threads (remove str-id threads-list :key #'car :test #'equal)) + (raw-new-thread (if (and (consp new-thread-data) + (consp (car new-thread-data)) + (consp (caar new-thread-data))) + (car new-thread-data) + new-thread-data)) + (messages-count (length (cadr (assoc 'cl-bbs/models:posts raw-new-thread)))) + (headline-val (if (stringp (cdr (assoc 'cl-bbs/models:headline + (cdr target-thread-assoc)))) + (cdr (assoc 'cl-bbs/models:headline + (cdr target-thread-assoc))) + (cdr (assoc 'headline (cdr target-thread-assoc))))) + (updated-entry `(,str-id + (cl-bbs/models:headline . ,headline-val) + (cl-bbs/models:date . ,date) + (cl-bbs/models:messages . ,messages-count)))) + (write-sexp-file list-path (cons updated-entry rem-threads)))) + (let* ((index-path (merge-pathnames (format nil "sexp/~a/index" board) *base-dir*)) + (index-list (read-sexp-file index-path)) + (target-index-assoc (assoc str-id index-list))) + (when target-index-assoc + (let* ((rem-index (remove str-id index-list :key #'car :test #'equal)) + (raw-new-thread (if (and (consp new-thread-data) + (consp (car new-thread-data)) + (consp (caar new-thread-data))) + (car new-thread-data) + new-thread-data)) + (headline-val (if (stringp (cdr (assoc 'cl-bbs/models:headline + (cdr target-index-assoc)))) + (cdr (assoc 'cl-bbs/models:headline + (cdr target-index-assoc))) + (cdr (assoc 'headline (cdr target-index-assoc))))) + (actual-posts (get-flat-posts (assoc 'cl-bbs/models:posts raw-new-thread))) + (truncated-ids (if (> (length actual-posts) 6) + (mapcar #'car (butlast (cdr actual-posts) 5)) + nil)) + (updated-entry `(,str-id + (cl-bbs/models:headline . ,headline-val) + (cl-bbs/models:truncated . ,truncated-ids) + (cl-bbs/models:posts + ,(if (> (length actual-posts) 6) + (cons (car actual-posts) (last actual-posts 5)) + actual-posts))))) + (write-sexp-file index-path (cons updated-entry rem-index)))))) + `(303 (:location ,(format nil "/~a/" board)) ("Redirecting..."))) + `(404 (:content-type "text/plain") ("Thread not found")))))))))) + +;; 14. GET /:board/:thread_id/:range (Thread Comments with Range) +(setf (ningle:route *app* "/:board/:thread_id/:range" :method :GET) + (lambda (params) + (let* ((board (cdr (assoc :board params))) + (thread-id (cdr (assoc :thread_id params))) + (range-str (cdr (assoc :range params))) + (thread-path (merge-pathnames (format nil "sexp/~a/~a" board thread-id) *base-dir*))) + (if (probe-file thread-path) + (let ((thread-data (read-sexp-file thread-path))) + `(200 (:content-type "text/html; charset=utf-8") + (,(render-thread board thread-id thread-data range-str cl-bbs/views:*preferences*)))) + `(404 (:content-type "text/plain") ("Thread not found")))))) diff --git a/server/main.lisp b/server/main.lisp new file mode 100644 index 0000000..755d68a --- /dev/null +++ b/server/main.lisp @@ -0,0 +1,61 @@ +(in-package :cl-bbs/server) + +(defvar *server* nil) +(defvar *app* nil) + +;; Initialize colorize and HyperSpec lookup paths safely +(defun init-colorize () + (setf colorize:*debug* nil) + (handler-case + (let* ((base-dir (asdf:system-source-directory :cl-bbs/server)) + (local-clhs-dir (and base-dir (merge-pathnames "src/HyperSpec/" base-dir))) + (local-map-file (and local-clhs-dir (merge-pathnames "Data/Map_Sym.txt" local-clhs-dir))) + (mop-map-file (and local-clhs-dir (merge-pathnames "Mop_Sym.txt" local-clhs-dir)))) + (if (and local-map-file (probe-file local-map-file)) + (progn + (setf clhs-lookup::*hyperspec-pathname* local-clhs-dir) + (setf clhs-lookup::*hyperspec-map-file* local-map-file) + (setf clhs-lookup::*mop-map-file* mop-map-file)) + (setf clhs-lookup::*hyperspec-map-file* #p"nonexistent-map-sym.txt"))) + (error (e) + (declare (ignore e)) + (setf clhs-lookup::*hyperspec-map-file* #p"nonexistent-map-sym.txt")))) + + +(defun make-real-ip-middleware (app) + (lambda (env) + (let ((x-forwarded-for (gethash "x-forwarded-for" (getf env :headers)))) + ;; If X-Forwarded-For exists, update REMOTE_ADDR to the first IP in the list + (when x-forwarded-for + (let ((real-ip (first (uiop:split-string x-forwarded-for :separator '(#\,))))) + (setf (getf env :remote-addr) (string-trim " " real-ip))))) + (funcall app env))) + +(defun build-app () + (lack:builder + (:static :path "/static/" + :root (merge-pathnames "src/static/" (asdf:system-source-directory :cl-bbs/server))) + (lambda (app) (make-real-ip-middleware app)) + :accesslog + (lambda (env) + (cl-bbs/handlers:handle-request env)))) + +(defun start-app (host port &key (async t)) + "Starts the Hunchentoot server running the cl-bbs application on the specified PORT." + (init-colorize) + (when *server* + (stop-app)) + (setf *app* (build-app)) + (setf *server* (clack:clackup *app* :address host + :port port + :server :hunchentoot + :use-thread async)) + (format t "cl-bbs running on port ~a~%" port) + t) + +(defun stop-app () + "Stops the currently running Hunchentoot server instance if one exists." + (when *server* + (clack:stop *server*) + (setf *server* nil)) + t) diff --git a/server/models.lisp b/server/models.lisp new file mode 100644 index 0000000..8ee7f4d --- /dev/null +++ b/server/models.lisp @@ -0,0 +1,35 @@ +(defpackage :cl-bbs/models + (:use :cl) + (:export #:thread + #:post + #:board + #:headline + #:posts + #:truncated + #:content + #:date + #:messages + #:vip + #:name)) + +(in-package :cl-bbs/models) + +(defclass post () + ((id :initarg :id :accessor post-id) + (date :initarg :date :accessor post-date) + (vip :initarg :vip :accessor post-vip :initform nil) + (content :initarg :content :accessor post-content)) + (:documentation "Represents a single post on a message board.")) + +(defclass thread () + ((id :initarg :id :accessor thread-id) + (headline :initarg :headline :accessor thread-headline) + (date :initarg :date :accessor thread-date) + (messages :initarg :messages :accessor thread-messages :initform 1) + (truncated :initarg :truncated :accessor thread-truncated :initform nil) + (posts :initarg :posts :accessor thread-posts :initform nil)) + (:documentation "Represents a thread consisting of a series of posts.")) + +(defclass board () + ((name :initarg :name :accessor board-name)) + (:documentation "Represents a message board.")) diff --git a/server/rss.lisp b/server/rss.lisp new file mode 100644 index 0000000..aef3013 --- /dev/null +++ b/server/rss.lisp @@ -0,0 +1,122 @@ +(defpackage #:cl-bbs/rss + (:use #:cl) + (:local-nicknames (#:models #:cl-bbs/models) + (#:storage #:cl-bbs/storage)) + (:export #:generate-rss + #:get-all-boards-rss-threads)) + +(in-package #:cl-bbs/rss) + +(defun get-url-scheme (env headers) + (if (string= "https" (gethash "x-forwarded-proto" headers)) + "https" + (let ((url-scheme (getf env :url-scheme))) + (if url-scheme + (string-downcase (string url-scheme)) + "http")))) + +(defun get-request-base-url (env) + "Construct the base URL from the request environment." + (let* ((headers (getf env :headers)) + (scheme (get-url-scheme env headers)) + (host (gethash "host" headers))) + (if host + (format nil "~a://~a" scheme host) + ""))) + +(defun get-tz-offset-string () + "Returns the basic timezone offset of the machine like '-0300' or '+0000'." + (multiple-value-bind (sec min hr date month year day-of-week dst-p tz) + (get-decoded-time) + (declare (ignore sec min hr date month year day-of-week dst-p)) + (let* ((offset-hours (- tz)) + (sign (if (>= offset-hours 0) #\+ #\-)) + (abs-hours (abs offset-hours))) + (format nil "~c~2,'0d00" sign (truncate abs-hours))))) + +(defun convert-to-rfc822 (iso-8601-string) + "Convert simple ISO 8601 string to RFC1123/RFC822 retaining literal parsing and appending manual offset." + (let ((clean-string (cl-ppcre:regex-replace-all " " iso-8601-string "T"))) + (handler-case + (let* ((parsed (local-time:parse-timestring clean-string)) + (utc-str (local-time:format-rfc1123-timestring nil parsed :timezone local-time:+utc-zone+))) + (cl-ppcre:regex-replace "(?:GMT|\\+0000)$" utc-str (get-tz-offset-string))) + (error () + (let ((now-utc (local-time:format-rfc1123-timestring nil (local-time:now) :timezone local-time:+utc-zone+))) + (cl-ppcre:regex-replace "(?:GMT|\\+0000)$" now-utc (get-tz-offset-string))))))) + + + +(defun get-all-boards-rss-threads (limit) + "Fetch latest threads from all boards combining them for RSS." + (let ((all-threads nil) + (sexp-base (merge-pathnames "sexp/" storage:*base-dir*))) + (when (probe-file sexp-base) + (loop for board-dir in (uiop:subdirectories sexp-base) do + (let ((board-name (car (last (pathname-directory board-dir)))) + (list-path (merge-pathnames "list" board-dir))) + (when (probe-file list-path) + (let ((board-threads (storage:read-sexp-file list-path))) + (loop for thread in board-threads do + ;; thread is (ID (models:headline . "...") (models:date . "...")) + (push (cons (car thread) (cons `(models:board . ,board-name) (cdr thread))) all-threads))))))) + ;; Sort by date descending + (setf all-threads (sort all-threads + (lambda (a b) + (string> (cdr (assoc 'models:date (cdr a))) + (cdr (assoc 'models:date (cdr b))))))) + ;; Take top LIMIT + (if (> (length all-threads) limit) + (subseq all-threads 0 limit) + all-threads))) + +(defun generate-rss (board threads env) + "Generate an RSS feed for the given board and threads." + (let* ((now (local-time:now)) + (utc-str (local-time:format-rfc1123-timestring nil now)) + (rfc822-date utc-str) + (base-url (get-request-base-url env)) + (request-url (format nil "~a~a" base-url (getf env :request-uri)))) + (with-output-to-string (s) + (format s "~%") + (format s "~%") + (format s " ~%") + (if (string= board "all") + (progn + (format s " cl-bbs - all boards~%") + (format s " Latest threads from all boards on cl-bbs.~%")) + (progn + (format s " cl-bbs - /~a/~%" board) + (format s " Latest threads from /~a/.~%" board))) + (format s " ~a~%" request-url) + (format s " ~a~%" rfc822-date) + (format s " cl-bbs RSS generator~%") + + (loop for t-entry in threads do + (let* ((id (car t-entry)) + (thread-data (cdr t-entry)) + (board-val (if (string= board "all") + (or (cdr (assoc 'models:board thread-data)) board) + board)) + (headline (or (cdr (assoc 'models:headline thread-data)) "Untitled")) + (date (or (cdr (assoc 'models:date thread-data)) rfc822-date)) ; ISO 8601 + (pub-date (if (string= date rfc822-date) rfc822-date (convert-to-rfc822 date))) + (thread-url (if (not (string= base-url "")) + (format nil "~a/~a/~a" base-url board-val id) + (format nil "/~a/~a" board-val id))) + (thread-path (merge-pathnames (format nil "sexp/~a/~a" board-val id) storage:*base-dir*)) + (thread-full-data (when (probe-file thread-path) (storage:read-sexp-file thread-path))) + (posts (cdr (assoc 'models:posts thread-full-data))) + (first-post (when posts (cdar (car posts)))) + (content (if first-post (cdr (assoc 'models:content first-post)) ""))) + (format s " ~%") + (format s " <![CDATA[~a]]>~%" headline) + (format s " ~a~%" thread-url) + (format s " ~%" headline) ;; Fallback to headline + (format s " ~%" content) + (format s " ~a~%" pub-date) + (format s " ~a~%" thread-url) + (format s " ~%"))) + + (format s " ~%") + (format s "~%")))) diff --git a/server/storage.lisp b/server/storage.lisp new file mode 100644 index 0000000..48c57b3 --- /dev/null +++ b/server/storage.lisp @@ -0,0 +1,43 @@ +(defpackage :cl-bbs/storage + (:use :cl) + (:export #:*base-dir* + #:ensure-board-dirs + #:read-sexp-file + #:write-sexp-file + #:is-board-locked)) + +(in-package :cl-bbs/storage) + +(defvar *base-dir* + (pathname (or (uiop:getenv "SBBS_DATADIR") + (merge-pathnames "data/" (asdf:system-source-directory :cl-bbs/server))))) + +(defun ensure-board-dirs (board-name) + "Ensures that directories for storing the board S-expressions and HTML exist." + (let ((sexp-dir (merge-pathnames (format nil "sexp/~a/" board-name) *base-dir*)) + (html-dir (merge-pathnames (format nil "html/~a/" board-name) *base-dir*))) + (ensure-directories-exist sexp-dir) + (ensure-directories-exist html-dir))) + +(defun read-sexp-file (path) + "Reads a safe S-expression from the specified file path, or returns NIL if file does not exist." + (with-open-file (stream path :direction :input :if-does-not-exist nil) + (if stream + (let ((*read-eval* nil)) + (read stream nil nil)) + nil))) + +(defun write-sexp-file (path data) + "Writes the given data as a pretty-printed S-expression to the specified file path." + (with-open-file (stream path :direction :output :if-exists :supersede :if-does-not-exist :create) + (write data :stream stream :pretty t) + (terpri stream))) + +(defun is-board-locked (board-name) + "Checks if a board is locked by examining the SBBS_LOCKED_BOARDS environment variable. +BOARD-NAME can be a string or a symbol." + (let ((locked-env (uiop:getenv "SBBS_LOCKED_BOARDS")) + (board-str (if (symbolp board-name) (string-downcase (symbol-name board-name)) board-name))) + (when (and locked-env board-str) + (let ((locked-boards (cl-ppcre:split "," locked-env))) + (member board-str locked-boards :test #'string=))))) diff --git a/server/views.lisp b/server/views.lisp new file mode 100644 index 0000000..e3f035a --- /dev/null +++ b/server/views.lisp @@ -0,0 +1,1009 @@ +# (defpackage :cl-bbs/views + (:use :cl) + (:import-from :cl-who + #:with-html-output-to-string + #:htm + #:str + #:esc + #:fmt) + (:import-from :cl-bbs/storage + #:is-board-locked) + (:export #:render-index + #:render-list + #:render-thread + #:render-preferences + #:render-moderation + #:render-error-page + #:render-search-results + #:render-playground + #:preferences + #:make-preferences + #:preferences-theme + #:preferences-syntax-theme + #:preferences-default-board + #:preferences-search-hide-input + #:preferences-search-local-only + #:preferences-search-position + #:*preferences*)) + +(in-package :cl-bbs/views) + +(defstruct preferences + (theme "dark") + (syntax-theme "simple") + (default-board "") + (search-hide-input "no") + (search-local-only "no") + (search-position "top")) + +(defvar *preferences* (make-preferences)) + +(defun get-git-commit-hash () + "Gets the git commit hash from environmental dynamics (APP_COMMIT_HASH) with a fallback to uiop:run-program." + (let ((env-hash (uiop:getenv "APP_COMMIT_HASH"))) + (if (and env-hash (string/= env-hash "")) + env-hash + (or (handler-case + (string-trim '(#\Space #\Tab #\Newline #\Return) + (uiop:run-program '("git" "rev-parse" "--short" "HEAD") + :output :string)) + (error () nil)) + "unknown")))) + +(defun render-footer-html (&optional board) + "Renders the common footer HTML with cl-bbs version hash and a GitHub link." + (let ((hash (get-git-commit-hash))) + (cl-who:with-html-output-to-string (s nil :indent t) + (:p :class "footer" + "cl-bbs version:" + (:a :href (format nil "https://github.com/ryukinix/cl-bbs/commit/~a" hash) + :target "_blank" + (cl-who:esc hash)) + " - " + (:a :href (if board (format nil "/~a/rss" board) "/rss") + :target "_blank" + "RSS Feed"))))) + +(defun render-board-name (board) + (cl-who:with-html-output-to-string (s nil :indent t) + (:h1 + (cl-who:esc + (if (is-board-locked board) + (concatenate 'string board " 🔒") + board))))) + +(defun get-hash-hue (id-val) + (let ((id-num (cond ((integerp id-val) id-val) + ((stringp id-val) (or (handler-case (parse-integer id-val :junk-allowed t) + (error () nil)) + 0)) + (t 0)))) + (mod (* id-num 137) 360))) + +(defmacro layout (title class prefs &body body) + `(cl-who:with-html-output-to-string (s nil :prologue "" :indent t) + (:html + (:head + (:meta :charset "utf-8") + (:meta :name "viewport" :content "width=device-width, initial-scale=1.0") + (:title (cl-who:esc ,title)) + (:link :rel "manifest" :href "/manifest.json") + (:link :rel "icon" :href "/static/favicon.ico" :type "image/png") + (:link :rel "stylesheet" + :href (format nil "/static/styles/themes/~a.css" (or (preferences-theme ,prefs) "default")) + :type "text/css") + (:link :rel "stylesheet" + :href (format nil "/static/styles/syntax/~a.css" (or (preferences-syntax-theme ,prefs) "simple")) + :type "text/css") + (:script "if ('serviceWorker' in navigator) { + window.addEventListener('load', () => { + navigator.serviceWorker.register('/sw.js'); + }); +}") + (:script " +function validatePostForm(form, errorId) { + const content = form.epistula.value.trim(); + const errorEl = document.getElementById(errorId); + if (!content) { + if (errorEl) { + errorEl.textContent = 'Post body cannot be empty!'; + errorEl.style.display = 'block'; + } else { + alert('Post body cannot be empty!'); + } + return false; + } + if (errorEl) { + errorEl.style.display = 'none'; + } + return true; +} + +document.addEventListener('DOMContentLoaded', function() { + document.querySelectorAll('textarea[name=\"epistula\"]').forEach(function(ta) { + ta.addEventListener('keydown', function(e) { + if (e.ctrlKey && e.key === 'Enter') { + e.preventDefault(); + ta.form.requestSubmit(); + } + }); + }); +}); +") + (:script :src "/static/jscl-snippets.js" :defer t)) + (:body :class ,class + (cl-who:str (render-boards-header)) + (:hr) + (cl-who:str (progn ,@body)) + (when (show-search-at-bottom-p) + (cl-who:htm + (:hr) + (cl-who:str (render-search-form)))))))) + +(defun render-error-page (error-message &optional (prefs *preferences*)) + "Renders an HTML error page displaying the given ERROR-MESSAGE, using the specified layout PREFS." + (layout "Error - cl-bbs" "error-page" prefs + (cl-who:with-html-output-to-string (s nil :indent t) + (:h1 "Error") + (:hr) + (:div :class "error-container" + (:p :class "error-title" (cl-who:esc error-message)) + (:p "We were unable to process your post because it does not meet the validation requirements.") + (:p (:button :class "error-back-button" :onclick "history.back();" "← Go Back and Edit Post"))) + (:hr) + (cl-who:str (render-footer-html))))) + +(defun board-view-p (path) + "Checks if the given PATH represents a board-specific view." + (and path + (string/= path "/") + (string/= path "/index.html") + (not (uiop:string-prefix-p "/search" path)) + (not (uiop:string-prefix-p "/admin" path)) + (not (uiop:string-prefix-p "/about" path)) + (not (uiop:string-prefix-p "/sw.js" path)) + (not (uiop:string-prefix-p "/manifest.json" path)) + (not (uiop:string-prefix-p "/playground" path)))) + +(defun get-current-board-from-path (path) + "Extracts the board name from the request PATH." + (when (and path (string/= path "") (char= (char path 0) #\/)) + (let ((parts (cl-ppcre:split "/" path))) + (when (>= (length parts) 2) + (let ((b (second parts))) + (and (string/= b "") b)))))) + +(defun show-search-at-top-p () + "Determines whether the search form should be rendered at the top header." + (let* ((env (and (boundp 'ningle:*request*) ningle:*request* (lack.request:request-env ningle:*request*))) + (path (and env (getf env :path-info))) + (is-board (board-view-p path))) + (and (not (and is-board (string= (preferences-search-hide-input *preferences*) "yes"))) + (string= (preferences-search-position *preferences*) "top")))) + +(defun show-search-at-bottom-p () + "Determines whether the search form should be rendered at the bottom of the page." + (and (not (string= (preferences-search-hide-input *preferences*) "yes")) + (string= (preferences-search-position *preferences*) "bottom"))) + +(defun render-search-form () + "Renders the search form as a standalone block, with board filter if local search is configured." + (let* ((env (and (boundp 'ningle:*request*) ningle:*request* (lack.request:request-env ningle:*request*))) + (path (and env (getf env :path-info))) + (board (and (board-view-p path) (get-current-board-from-path path)))) + (cl-who:with-html-output-to-string (s nil :indent t) + (:form :action "/search" :method "GET" :style "margin: 1em 2%; display: inline-flex;" + (when (and (string= (preferences-search-local-only *preferences*) "yes") board) + (cl-who:htm (:input :type "hidden" :name "board" :value board))) + (:input :type "text" :name "q" :placeholder "Search posts..." + :style "padding: 2px 5px; font-size: 0.85em; margin-right: 5px;") + (:input :type "submit" :value "Search"))))) + +(defun render-boards-header () + (let* ((sexp-dir (merge-pathnames "sexp/" cl-bbs/storage:*base-dir*)) + (paths (and (probe-file sexp-dir) (uiop:subdirectories sexp-dir))) + (boards (sort (mapcar (lambda (path) + (car (last (pathname-directory path)))) + paths) + #'string<)) + (env (and (boundp 'ningle:*request*) ningle:*request* (lack.request:request-env ningle:*request*))) + (path (and env (getf env :path-info))) + (board (and (board-view-p path) (get-current-board-from-path path)))) + (cl-who:with-html-output-to-string (s nil :indent t) + (:div :style "display: flex; justify-content: space-between; align-items: center; margin: 0.5em 2% 1em 2%;" + (:p :class "boards" :style "font-size: 0.9em; margin: 0;" + "[ " + (loop for board in boards + for i from 0 + unless (zerop i) + do (cl-who:str " | ") + do (cl-who:htm (:a :href (format nil "/~a/" board) (cl-who:esc board)))) + " ]") + (when (show-search-at-top-p) + (cl-who:htm + (:form :action "/search" :method "GET" :style "margin: 0; display: inline-flex;" + (when (and (string= (preferences-search-local-only *preferences*) "yes") board) + (cl-who:htm (:input :type "hidden" :name "board" :value board))) + (:input :type "text" :name "q" :placeholder "Search posts..." + :style "padding: 2px 5px; font-size: 0.85em; margin-right: 5px;") + (:input :type "submit" :value "Search")))))))) + +(defun render-menu (board selected) + (cl-who:with-html-output-to-string (s nil :indent t) + (:p :class "nav" + (if (string= selected "front") + (cl-who:str "front") + (cl-who:htm (:a :href (format nil "/~a" board) "front"))) + " - " + (if (string= selected "list") + (cl-who:str "list") + (cl-who:htm (:a :href (format nil "/~a/list" board) "list"))) + " - " + (if (string= selected "front") + (cl-who:htm (:a :href "#newthread" "new")) + (cl-who:htm (:a :href (format nil "/~a#newthread" board) "new"))) + " - " + (:a :href (format nil "/~a/preferences" board) "preferences") + " - " + (if (string= selected "playground") + (cl-who:str "λ") + (cl-who:htm (:a :href (format nil "/~a/playground" board) "λ"))) + " - " + (:a :href "/index.html" "?")))) + +(defun render-thread-form (board) + (cl-who:with-html-output-to-string (s nil :indent t) + (:div :class "newthread-form" + (:h2 :id "newthread" "New thread") + (:p :id "newthread-error" :style "color: red; font-weight: bold; display: none;") + (:form :action (format nil "/~a/post" board) + :method "POST" + :onsubmit "return validatePostForm(this, 'newthread-error');" + (:p (:input :type "text" :name "titulus" :size 35 :placeholder "Headline")) + (:p (:textarea :name "epistula" + :rows 5 + :cols 50 + :placeholder "Message")) + (:p (:input :type "text" :name "name" :style "display:none") + (:input :type "text" :name "message" :style "display:none") + (:input :type "submit" :value "Post")))))) + +(defun unescape-html (string) + (let ((s string)) + (setf s (cl-ppcre:regex-replace-all """ s "\"")) + (setf s (cl-ppcre:regex-replace-all "<" s "<")) + (setf s (cl-ppcre:regex-replace-all ">" s ">")) + (setf s (cl-ppcre:regex-replace-all "'" s "'")) + (setf s (cl-ppcre:regex-replace-all "'" s "'")) + (setf s (cl-ppcre:regex-replace-all "'" s "'")) + (setf s (cl-ppcre:regex-replace-all "&#[xX]([0-9a-fA-F]+);" s + (lambda (match-string hex-str) + (declare (ignore match-string)) + (string (code-char (parse-integer hex-str :radix 16)))) + :simple-calls t)) + (setf s (cl-ppcre:regex-replace-all "&#([0-9]+);" s + (lambda (match-string dec-str) + (declare (ignore match-string)) + (string (code-char (parse-integer dec-str :radix 10)))) + :simple-calls t)) + (setf s (cl-ppcre:regex-replace-all "&" s "&")) + s)) + +(defun format-text (text &optional thread-id) + (let* ((escaped (cl-who:escape-string text)) + ;; 1. Extract code blocks + (code-blocks '()) + (code-block-placeholder-format "") + (placeholder-idx 0) + (processed escaped)) + (setf processed + (cl-ppcre:regex-replace-all + "(?s)```\\n*(.*?)\\n*```" + processed + (lambda (match-string &optional content &rest others) + (declare (ignore match-string others)) + (let ((placeholder (format nil code-block-placeholder-format (incf placeholder-idx)))) + (push (cons placeholder (or content "")) code-blocks) + placeholder)) + :simple-calls t)) + (setf processed + (cl-ppcre:regex-replace-all + "(?m)^>(?!>)\\s*(.*?)$" + processed + "
    \\1
    ")) + (setf processed + (cl-ppcre:regex-replace-all + "\\*\\*(.*?)\\*\\*" + processed + "\\1")) + (setf processed + (cl-ppcre:regex-replace-all + "__(.*?)__" + processed + "\\1")) + (setf processed + (cl-ppcre:regex-replace-all + "`([^`]+)`" + processed + "\\1")) + (setf processed + (cl-ppcre:regex-replace-all + "~~(.*?)~~" + processed + "\\1")) + (setf processed + (cl-ppcre:regex-replace-all + ">>(\\d+)" + processed + (lambda (match-string &optional num &rest others) + (declare (ignore match-string others)) + (let ((num-val (or num ""))) + (if thread-id + (format nil ">>~a" thread-id num-val num-val) + (format nil ">>~a" num-val num-val)))) + :simple-calls t)) + (setf processed + (cl-ppcre:regex-replace-all + "https?://[\\w\\-\\.\\/\\?\\=\\&\\%#\\+:\\;]+" + processed + "\\&")) + (setf processed + (cl-ppcre:regex-replace-all + (concatenate 'string + ".*?") + processed + (concatenate 'string + "
    " + "
    "))) + (setf processed + (cl-ppcre:regex-replace-all + "image\\+.*?" + processed + (concatenate 'string + "
    " + "
    "))) + (setf processed + (cl-ppcre:regex-replace-all + "\\r\\n" + processed + (string #\Newline))) + (setf processed + (cl-ppcre:regex-replace-all + "\\n\\n+" + processed + "

    ")) + (setf processed + (cl-ppcre:regex-replace-all + "\\n" + processed + "
    ")) + (setf processed (format nil "

    ~a

    " processed)) + (dolist (pair code-blocks) + (let ((placeholder (car pair)) + (content (cdr pair))) + (setf processed + (cl-ppcre:regex-replace-all + placeholder + processed + (lambda (match-string &optional regs) + (declare (ignore match-string regs)) + (multiple-value-bind (match-start match-end reg-starts reg-ends) + (cl-ppcre:scan "^(?i)(lisp|cl|common-lisp)\\r?\\n" content) + (declare (ignore reg-starts reg-ends)) + (if match-start + (let* ((escaped-code (subseq content match-end)) + (raw-code (unescape-html escaped-code)) + (colorized-code (handler-case (colorize:html-colorization :common-lisp raw-code) + (error () (cl-who:escape-string raw-code))))) + ;; Note: colorize already wraps the result in ... + ;; We wrap it in
     but keep a data-raw-code attribute
    +                         ;; or just use content for JS execution. JSCL needs the raw text. To avoid JSCL trying
    +                         ;; to parse HTML, we'll embed the raw code in a hidden div, or rely on JS `textContent`
    +                         ;; which extracts raw text from nested HTML elements. `textContent` works well.
    +                         (format nil "

    ~a

    " colorized-code)) + (format nil "

    ~a

    " content)))) + :simple-calls t)))) + (setf processed + (cl-ppcre:regex-replace-all + "

    \\s*

    " + processed + "")) + processed)) + +(defun render-post-form (board thread-id) + (let ((error-id (format nil "reply-error-~a" thread-id))) + (cl-who:with-html-output-to-string (s nil :indent t) + (:p :id error-id :style "color: red; font-weight: bold; display: none;") + (:form :action (format nil "/~a/~a/post" board thread-id) + :method "POST" + :onsubmit (format nil "return validatePostForm(this, '~a');" error-id) + (:p (:textarea :name "epistula" + :rows 8 + :cols 78 + :placeholder "Message") + (:br) + (:input :type "text" :name "name" :class "name" :style "display:none") + (:input :type "text" :name "message" :class "message" :style "display:none") + (:input :type "submit" :value "Post")))))) + +(defun render-frontpage-thread (board thread-data index &optional (prefs *preferences*)) + (let* ((thread-id (car thread-data)) + (props (cdr thread-data)) + (headline (cdr (assoc 'cl-bbs/models:headline props))) + (posts (second (assoc 'cl-bbs/models:posts props))) + (next-post-number (if posts (1+ (reduce #'max posts :key #'car :initial-value 0)) 1)) + (truncated (cdr (assoc 'cl-bbs/models:truncated props))) + (theme (preferences-theme prefs))) + (cl-who:with-html-output-to-string (s nil :indent t) + (:pre :class "jump" + (:a :id (format nil "d~a" index) + :href (if (= index 10) "#d1" (format nil "#d~a" (1+ index))) "↓") + (cl-who:str " ")) + (let ((heading-style (if (string= theme "colored") + (format nil (concatenate 'string + "border-left: 5px solid hsl(~D, 80%, 45%); " + "padding-left: 10px; margin-left: 2%;") + (get-hash-hue thread-id)) + ""))) + (cl-who:htm + (:h2 :style heading-style + (:a :href (format nil "/~a/~a" board thread-id) (cl-who:esc headline))))) + (:dl + (let ((prev-id nil)) + (dolist (post posts) + (let* ((post-id (car post)) + (post-data (cdr post)) + (content (cdr (assoc 'cl-bbs/models:content post-data))) + (date (cdr (assoc 'cl-bbs/models:date post-data)))) + (when (and prev-id (> post-id (1+ prev-id))) + ;; Instead of hard assumption based just on IDs, actually check via truncated list if + ;; the missing IDs are meant to be rendered as collapsed (i.e. they actually exist in the background). + ;; Find the maximum contiguous subsegment of truncated IDs bridging prev-id and post-id. + (let* ((missing-ids (loop for id from (1+ prev-id) to (1- post-id) collect id)) + (actual-missing (if (listp truncated) + (remove-if-not (lambda (id) (member id truncated)) missing-ids) + missing-ids))) + (when (>= (length actual-missing) 2) + (let ((fst (car actual-missing)) + (lst (car (last actual-missing)))) + (cl-who:htm + (:dt :class "collapsed" :style "margin: 0.5em 2%; margin-left: 0; padding-left: 0;" + (:a :href (format nil "/~a/~a#t~ap~a" board thread-id thread-id fst) + (cl-who:str (format nil "~D" fst))) + (when (> lst fst) + (cl-who:htm + (cl-who:str "...") + (:a :href (format nil "/~a/~a#t~ap~a" board thread-id thread-id lst) + (cl-who:str (format nil "~D" lst))))))))))) + (setf prev-id post-id) + (let ((post-style (if (string= theme "colored") + (let ((hue (get-hash-hue post-id))) + (format nil (concatenate 'string + "background-color: hsl(~D, 85%, 96%); " + "border-left: 4px solid hsl(~D, 85%, 45%); " + "padding: 0.5em 1em; " + "margin: 0.3em 2% 1.2em 2%; " + "border-radius: 0 4px 4px 0;") + hue hue)) + ""))) + (cl-who:htm + (:dt :style "margin: 0.5em 2%; margin-left: 0; padding-left: 0;" + (:a :href (format nil "/~a/~a#t~ap~a" board thread-id thread-id post-id) + :id (format nil "t~ap~a" thread-id post-id) + (cl-who:str (format nil "~a" post-id))) + " " + (:samp (cl-who:esc date))) + (:dd :style post-style (cl-who:str (format-text content thread-id)))))))) + (unless (is-board-locked board) + (cl-who:htm + (:dt :style "margin: 0.5em 2%; margin-left: 0; padding-left: 0;" + (:a :href (format nil "#t~ap~a" thread-id next-post-number) + :id (format nil "t~ap~a" thread-id next-post-number) + (cl-who:str (format nil "~a" next-post-number)))) + (:dd (cl-who:str (render-post-form board thread-id)))))) + (:hr)))) + +(defun render-index (board threads &optional (prefs *preferences*)) + "Renders the board index (frontpage) HTML with the list of active THREADS +and the new thread form, using layout PREFS." + (layout (format nil "/~a/" board) nil prefs + (cl-who:with-html-output-to-string (s nil :indent t) + (cl-who:str (render-board-name board)) + (cl-who:str (render-menu board "front")) + (:hr) + (loop for t-data in threads + for i from 1 + do (cl-who:htm (cl-who:str (render-frontpage-thread board t-data i prefs)))) + (unless (is-board-locked board) + (cl-who:htm (cl-who:str (render-thread-form board)))) + (:hr) + (cl-who:str (render-footer-html board))))) + +(defun render-list (board threads &optional (prefs *preferences*)) + "Renders the board thread-list HTML page, showing all THREADS in tabular format, using layout PREFS." + (layout (format nil "/~a/" board) nil prefs + (cl-who:with-html-output-to-string (s nil :indent t) + (cl-who:str (render-board-name board)) + (cl-who:str (render-menu board "list")) + (:hr) + (:table :summary "Thread list" + (:thead (:tr (:th "#") (:th "headline") (:th "posts") (:th "last update"))) + (:tbody + (loop for t-data in threads + for i from 1 + do (let* ((thread-id (car t-data)) + (props (cdr t-data)) + (headline (cdr (assoc 'cl-bbs/models:headline props))) + (messages (cdr (assoc 'cl-bbs/models:messages props))) + (date (cdr (assoc 'cl-bbs/models:date props)))) + (cl-who:htm + (:tr (:td (cl-who:str (format nil "~a" i))) + (:td (:a :href (format nil "/~a/~a" board thread-id) (cl-who:esc headline))) + (:td (cl-who:str (format nil "~a" messages))) + (:td (:samp (cl-who:esc date))))))))) + (:hr) + (cl-who:str (render-footer-html board))))) + +(defun render-thread (board thread-id thread-data &optional range-string (prefs *preferences*)) + "Renders a single thread page HTML for THREAD-ID under BOARD with THREAD-DATA (comments), +optionally filtered by RANGE-STRING, using layout PREFS." + (let* ((theme (preferences-theme prefs)) + (raw-thread (if (and (consp thread-data) + (consp (car thread-data)) + (consp (caar thread-data))) + (car thread-data) + thread-data)) + (headline (if (consp (car raw-thread)) + (cdr (assoc 'cl-bbs/models:headline raw-thread)) + (cdr (assoc 'cl-bbs/models:headline (list raw-thread))))) + (posts-assoc (if (consp (car raw-thread)) (assoc 'cl-bbs/models:posts raw-thread) (cadr thread-data))) + (posts-list (if (and posts-assoc (listp (cdr posts-assoc)) (not (keywordp (cdr posts-assoc)))) + (if (listp (cadr posts-assoc)) (cadr posts-assoc) (cdr posts-assoc)) + (cdr posts-assoc))) + (posts (if (listp (car posts-list)) posts-list (list posts-list))) + (next-post-number (if posts (1+ (reduce #'max posts :key #'car :initial-value 0)) 1)) + (filter-func (if (and range-string (string/= range-string "")) + (let ((allowed-ids (make-hash-table :test #'eql))) + (dolist (part (cl-ppcre:split "," range-string)) + (let ((subparts (cl-ppcre:split "-" part))) + (cond + ((= (length subparts) 1) + (let ((id (parse-integer (first subparts) :junk-allowed t))) + (when id + (setf (gethash id allowed-ids) t)))) + ((= (length subparts) 2) + (let ((start (parse-integer (first subparts) :junk-allowed t)) + (end (parse-integer (second subparts) :junk-allowed t))) + (when (and start end (<= start end)) + (loop for id from start to end + do (setf (gethash id allowed-ids) t)))))))) + (lambda (id) (gethash id allowed-ids))) + (lambda (id) (declare (ignore id)) t)))) + (layout (format nil "/~a/" board) "thread" prefs + (cl-who:with-html-output-to-string (s nil :indent t) + (cl-who:str (render-board-name board)) + (cl-who:str (render-menu board "thread")) + (:hr) + (let ((heading-style (if (string= theme "colored") + (format nil "border-left: 5px solid hsl(~D, 80%, 45%); padding-left: 10px;" + (get-hash-hue thread-id)) + ""))) + (cl-who:htm + (:h2 :style heading-style (cl-who:esc headline)))) + (:dl + (loop for post in posts + for post-id = (car post) + for post-data = (cdr post) + for content = (cdr (assoc 'cl-bbs/models:content post-data)) + for date = (cdr (assoc 'cl-bbs/models:date post-data)) + when (funcall filter-func post-id) + do (let ((post-style (if (string= theme "colored") + (let ((hue (get-hash-hue post-id))) + (format nil (concatenate 'string + "background-color: hsl(~D, 85%, 96%); " + "border-left: 4px solid hsl(~D, 85%, 45%); " + "padding: 0.5em 1em; margin: 0.3em 0 1.2em 0; " + "border-radius: 0 4px 4px 0;") + hue hue)) + ""))) + (cl-who:htm + (:dt (:a :href (format nil "/~a/~a#t~ap~a" board thread-id thread-id post-id) + :id (format nil "t~ap~a" thread-id post-id) + (cl-who:str (format nil "~a" post-id))) + " " + (:samp (cl-who:esc date))) + (:dd :style post-style (cl-who:str (format-text content thread-id)))))) + (unless (is-board-locked board) + (cl-who:htm + (:dt (:a :href (format nil "#t~ap~a" thread-id next-post-number) + :id (format nil "t~ap~a" thread-id next-post-number) + (cl-who:str (format nil "~a" next-post-number)))) + (:dd (cl-who:str (render-post-form board thread-id)))))) + (:hr) + (cl-who:str (render-footer-html board)))))) + +(defun render-preferences (board &optional (prefs *preferences*)) + "Renders the board preferences HTML page, allowing users to choose a custom +stylesheet THEME, default-board and search configuration." + (let* ((sexp-dir (merge-pathnames "sexp/" cl-bbs/storage:*base-dir*)) + (paths (and (probe-file sexp-dir) (uiop:subdirectories sexp-dir))) + (boards (sort (mapcar (lambda (path) + (car (last (pathname-directory path)))) + paths) + #'string<)) + (theme (preferences-theme prefs)) + (syntax-theme (preferences-syntax-theme prefs)) + (default-board (preferences-default-board prefs)) + (search-hide-input (preferences-search-hide-input prefs)) + (search-local-only (preferences-search-local-only prefs)) + (search-position (preferences-search-position prefs))) + (layout (format nil "/~a/ - Preferences" board) "preferences" prefs + (cl-who:with-html-output-to-string (s nil :indent t) + (cl-who:str (render-board-name board)) + (cl-who:str (render-menu board "preferences")) + (:hr) + (:h2 "Preferences") + (:form :action (format nil "/~a/preferences" board) :method "POST" :class "preferences-form" + (:div :style "margin-bottom: 2em;" + (:h3 :style "margin-bottom: 0.5em;" "Style Theme") + (:p :style "color: #555; font-size: 0.9em; margin-bottom: 0.8em;" + "Customize the look and feel of the textboard.") + (:div :class "theme-selector-container" + (dolist (item '("default" "dark" "no" "colored" "matrix")) + (cl-who:htm + (:label :class "theme-option-label" :style "margin-right: 15px;" + (:input :type "radio" + :name "theme" + :value item + :checked (and theme (string= theme item)) + :onchange "updateThemePreview(this.value)") + (:span :class "theme-option-text" (cl-who:str item))))))) + + (:div :style "margin-bottom: 2em;" + (:h3 :style "margin-bottom: 0.5em;" "Syntax Theme") + (:p :style "color: #555; font-size: 0.9em; margin-bottom: 0.8em;" + "Choose syntax highlighting color scheme for Lisp code.") + (:div :class "syntax-theme-selector-container" + (dolist (item '("simple" "colorful")) + (cl-who:htm + (:label :class "theme-option-label" :style "margin-right: 15px;" + (:input :type "radio" + :name "syntax_theme" + :value item + :checked (and syntax-theme (string= syntax-theme item))) + (:span :class "theme-option-text" (cl-who:str item))))))) + + (:div :style "margin-bottom: 2em;" + (:h3 :style "margin-bottom: 0.5em;" "Default Board") + (:p :style "color: #555; font-size: 0.9em; margin-bottom: 0.8em;" + "Select the board you land on when visiting the root domain.") + (:div :class "board-selector-container" + (:select :name "default_board" :style "padding: 4px; font-size: 0.95em;" + (:option :value "" + :selected (or (null default-board) (string= default-board "")) + "None (Main Page)") + (dolist (item boards) + (cl-who:htm + (:option :value item + :selected (and default-board (string= default-board item)) + (cl-who:str (format nil "/~a/" item)))))))) + + (:div :style "margin-bottom: 2em;" + (:h3 :style "margin-bottom: 0.5em;" "Search Settings") + (:p :style "color: #555; font-size: 0.9em; margin-bottom: 0.8em;" + "Configure how the search bar behaves on board indices and thread views.") + (:div :class "search-preferences-container" :style "line-height: 1.8em;" + (:div :style "margin-bottom: 0.8em;" + (:label :style "font-weight: bold;" + "Hide search input in board view: ") + (:br) + (:select :name "search_hide_input" :style "padding: 4px; font-size: 0.95em;" + (:option :value "no" :selected (string= search-hide-input "no") "No") + (:option :value "yes" :selected (string= search-hide-input "yes") "Yes"))) + (:div :style "margin-bottom: 0.8em;" + (:label :style "font-weight: bold;" + "Only make local searches in the current board: ") + (:br) + (:select :name "search_local_only" + :style "padding: 4px; font-size: 0.95em;" + (:option :value "no" + :selected (string= search-local-only "no") + "No (Global)") + (:option :value "yes" + :selected (string= search-local-only "yes") + "Yes (Local)"))) + (:div :style "margin-bottom: 0.8em;" + (:label :style "font-weight: bold;" + "Placement of search input: ") + (:br) + (:select :name "search_position" + :style "padding: 4px; font-size: 0.95em;" + (:option :value "top" + :selected (string= search-position "top") + "Top (Header)") + (:option :value "bottom" + :selected (string= search-position "bottom") + "Bottom (Footer)"))))) + + (:p :style "margin-top: 2em;" + (:input :type "submit" :value "Save Preferences"))) + (:script " +function updateThemePreview(themeValue) { + // Find all stylesheet links + const links = document.querySelectorAll('link[rel=\"stylesheet\"]'); + for (const link of links) { + if (link.href.includes('/static/styles/themes/')) { + link.href = '/static/styles/themes/' + themeValue + '.css'; + } + } +} +") + (:hr) + (cl-who:str (render-footer-html)))))) + +(defun render-moderation (boards &optional board threads thread comments (prefs *preferences*) headline) + "Renders the admin/moderation control panel HTML page showing BOARDS and allowing deletions/edits." + (layout "cl-bbs Moderation Panel" "moderation" prefs + (cl-who:with-html-output-to-string (s nil :indent t) + (:h1 "Moderation Panel") + (:p (:a :href "/" "Back to Home")) + (:hr) + (:h2 "Boards") + (:ul + (dolist (b boards) + (cl-who:htm + (:li (:strong (:a :href (format nil "/admin?board=~a" b) (cl-who:esc b))) + "   " + (:form :action "/admin/action" :method "POST" :style "display:inline;" + (:input :type "hidden" :name "action" :value "delete-board") + (:input :type "hidden" :name "board" :value b) + (:input :type "submit" :value "Delete Board" :class "delete-button" + :onclick (concatenate 'string + "return confirm('Are you sure you want to " + "delete the ENTIRE board? " + "This cannot be undone.');"))))))) + (:h2 "Create Board") + (:p "Enter a board name below to create a new board. Board names must be in " + (:strong "kebab-case") + " (only lowercase letters, numbers, and hyphens; no spaces or underlines).") + (:div :style "margin: 1em 0;" + (:form :action "/admin/action" :method "POST" :onsubmit "return validateCreateBoard()" + (:input :type "hidden" :name "action" :value "create-board") + (:input :type "text" :name "board" :id "new-board-name" :placeholder "board-name" + :style "padding: 6px; font-size: 1em; border: 1px solid #bababa; + border-radius: 4px; font-family: monospace;") + " " + (:input :type "submit" :value "Create Board")) + (:p :id "board-error" :style "color: red; font-size: 0.9em; margin: 0.5em 0; display: none;")) + (:script :type "text/javascript" + "function validateCreateBoard() { + const input = document.getElementById('new-board-name'); + const error = document.getElementById('board-error'); + const boardName = input.value.trim(); + + // Regex for kebab-case (lowercase alphanumeric and hyphens only, no start/end hyphens) + const kebabRegex = /^[a-z0-9]+(?:-[a-z0-9]+)*$/; + + if (!boardName) { + error.textContent = 'Please enter a board name.'; + error.style.display = 'block'; + return false; + } + + if (!kebabRegex.test(boardName)) { + error.textContent = 'Invalid board name! Must contain only lowercase ' + + 'alphanumeric characters and hyphens (e.g. \"lisp-board\", no spaces, ' + + 'underlines or capitals).'; + error.style.display = 'block'; + return false; + } + + error.style.display = 'none'; + return true; +}") + (when board + (cl-who:htm + (:hr) + (:h2 (cl-who:fmt "Threads in /~a/" board)) + (if threads + (cl-who:htm + (:table :border 1 :cellpadding 5 + (:thead (:tr (:th "ID") (:th "Headline") (:th "Date") (:th "Actions"))) + (:tbody + (dolist (t-data threads) + (let* ((tid (car t-data)) + (props (cdr t-data)) + (headline (cdr (assoc 'cl-bbs/models:headline props)))) + (cl-who:htm + (:tr (:td (cl-who:str (format nil "~a" tid))) + (:td (:a :href (format nil "/admin?board=~a&thread=~a" board tid) + (cl-who:esc headline))) + (:td (cl-who:str (format nil "~a" (cdr (assoc 'cl-bbs/models:date props))))) + (:td (:form :action "/admin/action" :method "POST" :style "display:inline;" + (:input :type "hidden" :name "action" :value "delete-thread") + (:input :type "hidden" :name "board" :value board) + (:input :type "hidden" :name "thread" :value tid) + (:input :type "submit" :value "Delete Thread" :class "delete-button" + :onclick + (concatenate 'string + "return confirm('Are you sure you want " + "to delete this thread?');"))) + (unless (string-equal board "shame") + (cl-who:htm + (:form :action "/admin/action" :method "POST" + :style "display:inline; margin-left: 5px;" + (:input :type "hidden" :name "action" :value "shame-thread") + (:input :type "hidden" :name "board" :value board) + (:input :type "hidden" :name "thread" :value tid) + (:input :type "submit" :value "Shame" :class "shame-button" + :onclick + (concatenate 'string + "return confirm('Are you sure you want " + "to move this thread to the shame " + "board?');"))))))))))))) + (cl-who:htm (:p "No threads found on this board."))))) + (when (and board thread) + (cl-who:htm + (:hr) + (:h2 (cl-who:fmt "Comments in Thread #~a (~a)" thread board)) + (if comments + (cl-who:htm + (:dl + (dolist (p comments) + (let* ((pid (car p)) + (pdata (cdr p)) + (content (cdr (assoc 'cl-bbs/models:content pdata))) + (date (cdr (assoc 'cl-bbs/models:date pdata)))) + (cl-who:htm + (:dt "No." (cl-who:str (format nil "~a" pid)) " " (:samp (cl-who:esc date)) + "   " + (:form :action "/admin/action" :method "POST" :style "display:inline;" + (:input :type "hidden" :name "action" :value "delete-comment") + (:input :type "hidden" :name "board" :value board) + (:input :type "hidden" :name "thread" :value thread) + (:input :type "hidden" :name "comment" :value pid) + (:input :type "submit" :value "Delete Comment" :class "delete-button" + :onclick + "return confirm('Are you sure you want to delete this comment?');"))) + (:dd + (:div :class "comment-preview" + (cl-who:str (format-text content thread))) + (:form :action "/admin/action" :method "POST" :style "margin-top: 0.5em;" + (:input :type "hidden" :name "action" :value "edit-comment") + (:input :type "hidden" :name "board" :value board) + (:input :type "hidden" :name "thread" :value thread) + (:input :type "hidden" :name "comment" :value pid) + (when (and (= pid 1) headline) + (cl-who:htm + (:p (:label :for "headline" "Thread Headline: ") + (:br) + (:input :type "text" :name "headline" :id "headline" + :size 60 :value headline)))) + (:textarea :name "content" :rows 3 :cols 60 (cl-who:str content)) + (:br) + (:input :type "submit" :value "Save Changes")))))))) + (cl-who:htm (:p "No comments found.")))))))) + +(defun render-search-results (query results &optional (prefs *preferences*)) + "Renders the search results page HTML, showing matching posts for the given QUERY, using layout PREFS." + (let ((theme (preferences-theme prefs))) + (layout (format nil "Search: ~a" query) "search-results" prefs + (cl-who:with-html-output-to-string (s nil :indent t) + (:h1 "Search Results") + (:p :style "margin: 0.5em 2%;" + (:button :class "lisp-btn" :onclick "history.back();" "← Go Back") + " - Query: " + (:strong (cl-who:esc query))) + (:hr) + (if (null results) + (cl-who:htm (:p :style "margin: 2em; text-align: center;" "No results found matching your query.")) + (cl-who:htm + (:dl :style "margin: 1em 2%;" + (dolist (match results) + (let* ((board (getf match :board)) + (thread-id (getf match :thread-id)) + (headline (getf match :headline)) + (post-id (getf match :post-id)) + (date (getf match :date)) + (content (getf match :content)) + (post-style (if (string= theme "colored") + (let ((hue (get-hash-hue post-id))) + (format nil (concatenate 'string + "background-color: hsl(~D, 85%, 96%); " + "border-left: 4px solid hsl(~D, 85%, 45%); " + "padding: 0.5em 1em; " + "margin: 0.3em 0 1.2em 0; " + "border-radius: 0 4px 4px 0;") + hue hue)) + ""))) + (cl-who:htm + (:dt :style "margin-top: 1.5em; font-size: 0.95em;" + "[" (:a :href (format nil "/~a/" board) (cl-who:esc board)) "] " + (:a :href (format nil "/~a/~a" board thread-id) (:strong (cl-who:esc headline))) + " - Post " + (:a :href (format nil "/~a/~a#t~ap~a" board thread-id thread-id post-id) + (cl-who:str (format nil "#~a" post-id))) + " " + (:samp (cl-who:esc date))) + (:dd :style post-style + (cl-who:str (format-text content thread-id))))))))) + (:hr) + (cl-who:str (render-footer-html)))))) + +(defun render-playground (&optional board (prefs *preferences*)) + "Renders the interactive Common Lisp playground view." + (layout (if board (format nil "/~a/ - Lisp Playground" board) "Lisp Playground") + "playground-page" + prefs + (cl-who:with-html-output-to-string (s nil :indent t) + (when board + (cl-who:htm (cl-who:str (render-menu board "playground")))) + (:h2 "Common Lisp Playground") + (:p :style "margin: 0.5em 2%; font-size: 0.95em;" + "Write and execute Common Lisp code directly in your browser using " + (:a :href "https://github.com/jscl-project/jscl" :target "_blank" "JSCL") + ". Everything runs completely client-side in a sandboxed environment.") + (:div :class "playground-container" :style "margin: 1.5em 2%;" + (:div :style "margin-bottom: 1em; display: flex; gap: 10px; align-items: center; flex-wrap: wrap;" + (:span "Load Example: ") + (:select :id "playground-examples" :style "padding: 4px;" + (:option :value "" "-- Select Example --") + (:option :value "hello" "Hello World") + (:option :value "fib" "Fibonacci Numbers") + (:option :value "loop" "Loop Macro") + (:option :value "clos" "Common Lisp Object System (CLOS)"))) + (:div :id "example-data-hello" :style "display:none;" + (cl-who:str (colorize:html-colorization :common-lisp "(format t \"Hello, World!~%\")"))) + (:div :id "example-data-fib" :style "display:none;" + (cl-who:str (colorize:html-colorization :common-lisp "(defun fib (n) + (if (< n 2) + n + (+ (fib (- n 1)) (fib (- n 2))))) + +(format t \"Fibonacci of 10 is: ~a~%\" (fib 10))"))) + (:div :id "example-data-loop" :style "display:none;" + (cl-who:str (colorize:html-colorization :common-lisp "(loop for x from 1 to 5 + do (format t \"Square of ~d is ~d~%\" x (* x x)))"))) + (:div :id "example-data-clos" :style "display:none;" + (cl-who:str (colorize:html-colorization :common-lisp "(defclass person () + ((name :accessor person-name :initarg :name) + (age :accessor person-age :initarg :age))) + +(defmethod introduce ((p person)) + (format t \"Hi, I am ~a and I am ~a years old.~%\" + (person-name p) + (person-age p))) + +(let ((p (make-instance 'person :name \"Alice\" :age 30))) + (introduce p))"))) + (:pre :id "playground-editor" + :class "lisp-code-block" + :contenteditable "true" + :spellcheck "false" + :style (concatenate 'string + "min-height: 200px; width: 96%; max-width: 800px; " + "font-family: monospace; font-size: 1.1em; padding: 10px; " + "border: 1px solid currentColor; background: transparent; " + "color: inherit; margin-bottom: 1em; outline: none; " + "overflow: auto; white-space: pre-wrap;") + "") + (:div :style "display: flex; gap: 10px; margin-bottom: 1em;" + (:button :id "playground-run" :class "lisp-btn" "Run Code") + (:button :id "playground-clear" :class "lisp-btn" "Clear Output")) + (:h3 "Output Console") + (:pre :id "playground-output" + :style (concatenate 'string + "display: none; padding: 10px; width: 96%; max-width: 800px; " + "border: 1px dashed currentColor; " + "background-color: rgba(128, 128, 128, 0.05); white-space: pre-wrap; " + "word-break: break-all; font-family: monospace; font-size: 1.1em; " + "line-height: 1.4em;") + "")) + (:hr) + (cl-who:str (render-footer-html))))) diff --git a/static/about.html b/static/about.html new file mode 100644 index 0000000..e19b02a --- /dev/null +++ b/static/about.html @@ -0,0 +1,41 @@ + + + + + + +cl-bbs - About + + + +

    About CL-BBS

    +
    +

    Back to Home

    + +

    A Bit of History

    +

    /prog/ was a textboard about ``programming'', hosted at world4ch.org and later dis.4chan.org. It was an odd and fascinating place that went mostly unmoderated for years. Unfortunately the owners were made to remember its existence thanks to imbecilic spammers; and without consideration for the small community that inhabited the place, the formers decided to pull the plug on a sad day of July 2014.

    If you weren't lucky enough to have been a part of it, an archive of all the posts is available at archive.org. There's a search engine for this archive which has also been entirely restored as web pages at tinychan.org.

    +

    Back then, a somewhat recurrent joke was that the BBS script, shiichan, should be rewritten in Scheme. Alyssa P. Hacker fulfilled this dream in MIT Scheme. Our project provides a complete, production-grade Common Lisp port of this textboard engine, preserving all original aesthetics and capabilities.

    + +

    More History

    +

    If you're interested in the history of textboards as a whole, here are a few interesting reads:

    + + +

    Other Textboard Scripts

    +
      +
    • bbs.cgi - The original 2ch Perl script
    • +
    • Shiichan - The PHP script that was used at world4ch
    • +
    • Kareha - Popular Perl script used by 4-ch.net among others
    • +
    • Tablecat - Tablecat's Perl script (the site is currently offline)
    • +
    • HiveBBS - A Ruby script seen at bbs.neet.tv
    • +
    • Weabot - Python script used by Bienvenido a Internet
    • +
    + +

    Bonus Track

    +

    Listening to this tune will make you enjoy writing Common Lisp code.

    +

    The SICP snake

    + + diff --git a/static/art.ico b/static/art.ico new file mode 100644 index 0000000..9e0ba21 Binary files /dev/null and b/static/art.ico differ diff --git a/static/errors/400.html b/static/errors/400.html new file mode 100644 index 0000000..e78aa17 --- /dev/null +++ b/static/errors/400.html @@ -0,0 +1,21 @@ + + + + + + +400 bad request + + +
    + _  _    ___   ___  
    +| || |  / _ \ / _ \ 
    +| || |_| | | | | | |
    +|__   _| |_| | |_| |
    +   |_|  \___/ \___/ 
    +                    
    + error 400
    + bad request
    +
    + + diff --git a/static/errors/403.html b/static/errors/403.html new file mode 100644 index 0000000..02b5256 --- /dev/null +++ b/static/errors/403.html @@ -0,0 +1,21 @@ + + + + + + +403 forbidden + + +
    +  _  _    ___ _____ 
    + | || |  / _ \___ /
    + | || |_| | | ||_ \
    + |__   _| |_| |__) |
    +    |_|  \___/____/
    +
    + error 403
    + forbidden
    +
    + + diff --git a/static/errors/404.html b/static/errors/404.html new file mode 100644 index 0000000..5ecb584 --- /dev/null +++ b/static/errors/404.html @@ -0,0 +1,21 @@ + + + + + + +404 not found + + +
    +  _  _    ___  _  _   
    + | || |  / _ \| || |
    + | || |_| | | | || |_
    + |__   _| |_| |__   _|
    +    |_|  \___/   |_|
    +
    + error 404
    + page not found
    +
    + + diff --git a/static/errors/405.html b/static/errors/405.html new file mode 100644 index 0000000..9f22a74 --- /dev/null +++ b/static/errors/405.html @@ -0,0 +1,21 @@ + + + + + + +405 method not allowed + + +
    +  _  _    ___  ____  
    + | || |  / _ \| ___|
    + | || |_| | | |___ \
    + |__   _| |_| |___) |
    +    |_|  \___/|____/
    +
    + error 405
    + method not allowed
    +
    + + diff --git a/static/errors/429.html b/static/errors/429.html new file mode 100644 index 0000000..1a625f6 --- /dev/null +++ b/static/errors/429.html @@ -0,0 +1,14 @@ + + + + + +Too Many Requests + + + +

    Cool Down

    +

    Easy on the post button. Please wait 5 seconds before submitting another POST request

    + + diff --git a/static/errors/500.html b/static/errors/500.html new file mode 100644 index 0000000..fdd75e4 --- /dev/null +++ b/static/errors/500.html @@ -0,0 +1,21 @@ + + + + + + +500 internal server error + + +
    +  ____   ___   ___
    + | ___| / _ \ / _ \
    + |___ \| | | | | | |
    +  ___) | |_| | |_| |
    + |____/ \___/ \___/
    +
    + error 500
    + internal server error
    +
    + + diff --git a/static/errors/502.html b/static/errors/502.html new file mode 100644 index 0000000..bfd6a7e --- /dev/null +++ b/static/errors/502.html @@ -0,0 +1,21 @@ + + + + + + +502 bad gateway + + +
    + ____   ___ ____  
    +| ___| / _ \___ \ 
    +|___ \| | | |__) |
    + ___) | |_| / __/ 
    +|____/ \___/_____|
    +                  
    + error 502
    + bad gateway
    +
    + + diff --git a/static/errors/503.html b/static/errors/503.html new file mode 100644 index 0000000..50abd13 --- /dev/null +++ b/static/errors/503.html @@ -0,0 +1,21 @@ + + + + + + +503 service unavailable + + +
    + ____   ___ _____ 
    +| ___| / _ \___ / 
    +|___ \| | | ||_ \ 
    + ___) | |_| |__) |
    +|____/ \___/____/ 
    +                  
    + error 503
    + service unavailable
    +
    + + diff --git a/static/errors/504.html b/static/errors/504.html new file mode 100644 index 0000000..9e892a3 --- /dev/null +++ b/static/errors/504.html @@ -0,0 +1,21 @@ + + + + + + +504 gateway timeout + + +
    + ____   ___  _  _   
    +| ___| / _ \| || |  
    +|___ \| | | | || |_ 
    + ___) | |_| |__   _|
    +|____/ \___/   |_|  
    +                    
    + error 504
    + gateway timeout
    +
    + + diff --git a/static/favicon.ico b/static/favicon.ico new file mode 100644 index 0000000..4dd119b Binary files /dev/null and b/static/favicon.ico differ diff --git a/static/img/cloudflare.png b/static/img/cloudflare.png new file mode 100644 index 0000000..ad7ff2e Binary files /dev/null and b/static/img/cloudflare.png differ diff --git a/static/img/freebsd.png b/static/img/freebsd.png new file mode 100644 index 0000000..b00e7d4 Binary files /dev/null and b/static/img/freebsd.png differ diff --git a/static/img/gnu.png b/static/img/gnu.png new file mode 100644 index 0000000..a4109c4 Binary files /dev/null and b/static/img/gnu.png differ diff --git a/static/img/i2p.png b/static/img/i2p.png new file mode 100644 index 0000000..36a9980 Binary files /dev/null and b/static/img/i2p.png differ diff --git a/static/img/mit-scheme.png b/static/img/mit-scheme.png new file mode 100644 index 0000000..076d4a9 Binary files /dev/null and b/static/img/mit-scheme.png differ diff --git a/static/img/nginx.png b/static/img/nginx.png new file mode 100644 index 0000000..389f308 Binary files /dev/null and b/static/img/nginx.png differ diff --git a/static/img/nocookie.png b/static/img/nocookie.png new file mode 100644 index 0000000..916b894 Binary files /dev/null and b/static/img/nocookie.png differ diff --git a/static/img/nojs.png b/static/img/nojs.png new file mode 100644 index 0000000..f00d277 Binary files /dev/null and b/static/img/nojs.png differ diff --git a/static/img/snake.png b/static/img/snake.png new file mode 100644 index 0000000..8f039ec Binary files /dev/null and b/static/img/snake.png differ diff --git a/static/img/src/freebsd.svg b/static/img/src/freebsd.svg new file mode 100644 index 0000000..0f331ee --- /dev/null +++ b/static/img/src/freebsd.svg @@ -0,0 +1 @@ + \ No newline at end of file diff --git a/static/img/src/gnu.svg b/static/img/src/gnu.svg new file mode 100644 index 0000000..06403cb --- /dev/null +++ b/static/img/src/gnu.svg @@ -0,0 +1,94 @@ + + + + + + + + + image/svg+xml + + + + + Aurelio A. Hecker <aurium@gmail.com> + + + GNU Head + + + + + + + + + + + + + + + + + + + + + diff --git a/static/img/src/mit-scheme.svg b/static/img/src/mit-scheme.svg new file mode 100644 index 0000000..f2e251d --- /dev/null +++ b/static/img/src/mit-scheme.svg @@ -0,0 +1,599 @@ + + + + + + + + + + image/svg+xml + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + (Y F) = (F (Y F)) + + + + + (Y F) = (F (Y F)) + + + + + (Y F) = (F (Y F)) + + + + + (Y F) = (F (Y F)) + + + + + (Y F) = (F (Y F)) + + + + + (Y F) = (F (Y F)) + + + + + (Y F) = (F (Y F)) + + + + + (Y F) = (F (Y F)) + + + + + (Y F) = (F (Y F)) + + + + + (Y F) = (F (Y F)) + + + + + (Y F) = (F (Y F)) + + + + + + + + + diff --git a/static/img/src/nginx.svg b/static/img/src/nginx.svg new file mode 100644 index 0000000..07790fe --- /dev/null +++ b/static/img/src/nginx.svg @@ -0,0 +1,20 @@ + + + + + + + + + diff --git a/static/img/src/sicp-snake.png b/static/img/src/sicp-snake.png new file mode 100644 index 0000000..66bdd5e Binary files /dev/null and b/static/img/src/sicp-snake.png differ diff --git a/static/img/tux.png b/static/img/tux.png new file mode 100644 index 0000000..bdc5b1d Binary files /dev/null and b/static/img/tux.png differ diff --git a/static/img/valid-html.png b/static/img/valid-html.png new file mode 100644 index 0000000..e6a4dc2 Binary files /dev/null and b/static/img/valid-html.png differ diff --git a/static/index.html b/static/index.html new file mode 100644 index 0000000..d2d107f --- /dev/null +++ b/static/index.html @@ -0,0 +1,86 @@ + + + + + + +kiwi larp + + + +
    + Best tilde to exist + + catto.garden + +
    +

    kiwi larp

    +
    +

    an epic and cool textboard running on cl-bbs larp til you can't no more

    +

    larping since 28/7/26
    +irc on ==> irc.larp.nz :>
    +Follow Bluesky account or My snac account For updates and IRC posting bot
    +if you want a snac account message me on irc(chers) or xmpp(chersbobers@catto.garden)/chers@larp.nz
    +you can also get an xmpp account too
    +Thank you xenia for the name! + + +

    RULES:

    +
      +1. Don't be a bigot (No homophobia, racisim, transphobia etc)
      +2. Don't post illegal content this servers at my grandmas house +
    +
    +                                                          
    +                        ░░██  ░░██                 
    +                        ████  ████                        
    +                        ████▓▓████                        
    +                        ██  ██  ██                        
    +                          ██████                          
    +                          ████                            
    +                        ██████                            
    +                        ██████░░                          
    +                      ██████████                          
    +                      ██████████                          
    +░░░░░░░░░░░░░░░░░░░░░░░░██████░░░░░░░░░░░░░░░░░░░░░░░░░░░░
    +░░░░░░░░░░░░░░░░░░░░░░░░░░██████████░░░░░░░░░░░░░░░░░░░░░░
    +░░░░░░░░░░░░░░░░░░░░░░░░░░▒▒▒▒▒▒▒▒▒▒▒▒░░░░░░░░░░░░░░░░░░░░
    +░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░██░░░░░░░░░░░░░░░░░░░░
    +
    +
    + +

    larpboards

    +
      + +
    + + +

    larpy features

    +

    One newline is a line break (<BR>), two or more newlines will start a new paragraph.

    + + + + + + + + + + + + + + + +
    inputoutput
    **bold**bold
    __italic__italic
    `monospaced`monospaced
    ~~spoiler~~spoiler
    http://c2.comhttp://c2.com
    https://example.com/pic.pngdirect link auto-renders as clickable image preview
    image+https://example.com/anyurlprefix renders as clickable image preview for any image URL (even without standard extensions)
    link to post >>7link to post >>7
    >quoted text

    quoted text

    ```
    ;;;This is a block of code
    (lambda (h)
      ((lambda (f) (f f))
       (lambda (f) (h (lambda (x) ((f f) x))))))
    ```
    ;;;This is a block of code
    +(lambda (h)
    +  ((lambda (f) (f f))
    +   (lambda (f) (h (lambda (x) ((f f) x))))))
    ```lisp
    ;;;Executable snippet
    (format t "Hello")
    ```
    (format t "Hello")

    Renders as a syntax-highlighted, client-side executable Common Lisp snippet via JSCL. You can also try out the interactive Lisp Playground by clicking the λ link in the navigation menu!

    Ctrl+EnterIn multiline inputs (post, reply, playground): submit or evaluate without leaving the keyboard.
    + +
    +

    all of this ^ was from the og site template

    +

    About cl-bbs | RSS Feed

    + + diff --git a/static/jscl-snippets.js b/static/jscl-snippets.js new file mode 100644 index 0000000..2240528 --- /dev/null +++ b/static/jscl-snippets.js @@ -0,0 +1,319 @@ +// Common Lisp Snippet Executor and Playground using JSCL +// Loaded dynamically and runs completely client-side. + +let jsclLoading = false; +let jsclLoaded = false; +const jsclCallbacks = []; + +function ensureJSCL(callback) { + if (window.jscl) { + callback(); + return; + } + jsclCallbacks.push(callback); + if (jsclLoading) return; + jsclLoading = true; + + const script = document.createElement('script'); + script.src = "https://cdn.jsdelivr.net/gh/jscl-project/jscl-project.github.io/jscl.js"; + script.onload = () => { + jsclLoaded = true; + while (jsclCallbacks.length > 0) { + const cb = jsclCallbacks.shift(); + cb(); + } + }; + script.onerror = () => { + // Try unpkg as a fallback CDN + const fallbackScript = document.createElement('script'); + fallbackScript.src = "https://unpkg.com/jscl/dist/jscl.js"; + fallbackScript.onload = () => { + jsclLoaded = true; + while (jsclCallbacks.length > 0) { + const cb = jsclCallbacks.shift(); + cb(); + } + }; + fallbackScript.onerror = (err) => { + console.error("Failed to load JSCL from both CDNs:", err); + alert("Failed to load JSCL Common Lisp compiler. Please check your internet connection."); + }; + document.head.appendChild(fallbackScript); + }; + document.head.appendChild(script); +} + +function initInlineSnippets() { + const blocks = document.querySelectorAll('pre.lisp-code-block:not(#playground-editor)'); + blocks.forEach((block) => { + // Wrap the pre element + const container = document.createElement('div'); + container.className = 'lisp-snippet-container'; + container.style.margin = '1em 0'; + + block.parentNode.insertBefore(container, block); + container.appendChild(block); + + // Create controls + const controls = document.createElement('div'); + controls.className = 'lisp-snippet-controls'; + controls.style.margin = '5px 0'; + controls.style.display = 'flex'; + controls.style.gap = '10px'; + + const runBtn = document.createElement('button'); + runBtn.textContent = 'Run'; + runBtn.className = 'lisp-btn lisp-btn-run'; + + const editBtn = document.createElement('button'); + editBtn.textContent = 'Edit'; + editBtn.className = 'lisp-btn lisp-btn-edit'; + + controls.appendChild(runBtn); + controls.appendChild(editBtn); + container.appendChild(controls); + + // Create output panel + const outputPanel = document.createElement('pre'); + outputPanel.className = 'lisp-output-panel'; + outputPanel.style.display = 'none'; + outputPanel.style.padding = '0.5em'; + outputPanel.style.marginTop = '5px'; + outputPanel.style.border = '1px dashed currentColor'; + outputPanel.style.backgroundColor = 'rgba(128, 128, 128, 0.05)'; + outputPanel.style.whiteSpace = 'pre-wrap'; + outputPanel.style.wordBreak = 'break-all'; + container.appendChild(outputPanel); + + let isEditing = false; + + editBtn.addEventListener('click', () => { + if (!isEditing) { + block.contentEditable = 'true'; + block.spellcheck = false; + block.style.outline = '1px solid currentColor'; + block.style.padding = '5px'; + block.focus(); + editBtn.textContent = 'View'; + isEditing = true; + } else { + block.contentEditable = 'false'; + block.style.outline = 'none'; + block.style.padding = ''; + editBtn.textContent = 'Edit'; + isEditing = false; + + // Fetch colorized version from backend API + const code = block.textContent; + fetch('/api/colorize', { + method: 'POST', + headers: { + 'Content-Type': 'application/x-www-form-urlencoded' + }, + body: 'code=' + encodeURIComponent(code) + }) + .then(response => response.text()) + .then(html => { + block.innerHTML = html; + }) + .catch(err => console.error("Failed to colorize snippet:", err)); + } + }); + + block.addEventListener('keydown', (e) => { + if (e.ctrlKey && e.key === 'Enter') { + e.preventDefault(); + runBtn.click(); + } + }); + + runBtn.addEventListener('click', () => { + runBtn.disabled = true; + const originalText = runBtn.textContent; + runBtn.textContent = 'Running...'; + outputPanel.style.display = 'block'; + outputPanel.textContent = 'Initializing JSCL and executing...'; + + ensureJSCL(() => { + try { + const code = block.textContent; + const wrappedCode = ` +(let ((out (make-string-output-stream))) + (let ((*standard-output* out)) + (let ((val (progn +${code} + ))) + (format nil "~A|==SEPARATOR==|~S" (get-output-stream-string out) val)))) +`; + const resRaw = window.jscl.evaluateString(wrappedCode); + let resStr = resRaw; + if (Array.isArray(resRaw)) { + resStr = resRaw.join(''); + } else if (typeof resRaw !== 'string') { + resStr = String(resRaw); + } + + let stdout = ""; + let returnValue = ""; + if (typeof resStr === 'string' && resStr.includes('|==SEPARATOR==|')) { + const parts = resStr.split('|==SEPARATOR==|'); + stdout = parts[0]; + returnValue = parts[1]; + } else { + returnValue = String(resStr); + } + + let displayResult = ""; + if (stdout) { + displayResult += stdout; + if (!stdout.endsWith('\n')) { + displayResult += '\n'; + } + } + displayResult += `=> ${returnValue}`; + + outputPanel.textContent = displayResult; + outputPanel.style.color = ''; + } catch (err) { + outputPanel.textContent = `Error: ${err.message || err}`; + outputPanel.style.color = 'red'; + } finally { + runBtn.disabled = false; + runBtn.textContent = originalText; + } + }); + }); + }); +} + +function initPlayground() { + const editor = document.getElementById('playground-editor'); + const runBtn = document.getElementById('playground-run'); + const clearBtn = document.getElementById('playground-clear'); + const examplesSelect = document.getElementById('playground-examples'); + const outputPanel = document.getElementById('playground-output'); + + if (!editor || !runBtn || !clearBtn || !examplesSelect || !outputPanel) return; + + const examples = { + hello: `(format t "Hello, World!~%")`, + fib: `(defun fib (n) + (if (< n 2) + n + (+ (fib (- n 1)) (fib (- n 2))))) + +(format t "Fibonacci of 10 is: ~a~%" (fib 10))`, + loop: `(loop for x from 1 to 5 + do (format t "Square of ~d is ~d~%" x (* x x)))`, + clos: `(defclass person () + ((name :accessor person-name :initarg :name) + (age :accessor person-age :initarg :age))) + +(defmethod introduce ((p person)) + (format t "Hi, I am ~a and I am ~a years old.~%" + (person-name p) + (person-age p))) + +(let ((p (make-instance 'person :name "Alice" :age 30))) + (introduce p))` + }; + + examplesSelect.addEventListener('change', () => { + const key = examplesSelect.value; + const exampleData = document.getElementById('example-data-' + key); + if (exampleData) { + editor.innerHTML = exampleData.innerHTML; + } else { + editor.innerHTML = ""; + } + }); + + clearBtn.addEventListener('click', () => { + outputPanel.textContent = ''; + outputPanel.style.display = 'none'; + }); + + editor.addEventListener('keydown', (e) => { + if (e.ctrlKey && e.key === 'Enter') { + e.preventDefault(); + runBtn.click(); + } + }); + + runBtn.addEventListener('click', () => { + runBtn.disabled = true; + const originalText = runBtn.textContent; + runBtn.textContent = 'Running...'; + outputPanel.style.display = 'block'; + outputPanel.textContent = 'Initializing JSCL and executing...'; + + ensureJSCL(() => { + try { + const code = editor.textContent; + const wrappedCode = ` +(let ((out (make-string-output-stream))) + (let ((*standard-output* out)) + (let ((val (progn +${code} + ))) + (format nil "~A|==SEPARATOR==|~S" (get-output-stream-string out) val)))) +`; + const resRaw = window.jscl.evaluateString(wrappedCode); + let resStr = resRaw; + if (Array.isArray(resRaw)) { + resStr = resRaw.join(''); + } else if (typeof resRaw !== 'string') { + resStr = String(resRaw); + } + + let stdout = ""; + let returnValue = ""; + if (typeof resStr === 'string' && resStr.includes('|==SEPARATOR==|')) { + const parts = resStr.split('|==SEPARATOR==|'); + stdout = parts[0]; + returnValue = parts[1]; + } else { + returnValue = String(resStr); + } + + let displayResult = ""; + if (stdout) { + displayResult += stdout; + if (!stdout.endsWith('\n')) { + displayResult += '\n'; + } + } + displayResult += `=> ${returnValue}`; + + outputPanel.textContent = displayResult; + outputPanel.style.color = ''; + + // Dynamically update the editor syntax highlighting using backend colorize API + fetch('/api/colorize', { + method: 'POST', + headers: { + 'Content-Type': 'application/x-www-form-urlencoded' + }, + body: 'code=' + encodeURIComponent(code) + }) + .then(response => response.text()) + .then(html => { + editor.innerHTML = html; + }) + .catch(err => console.error("Failed to colorize playground code:", err)); + + } catch (err) { + outputPanel.textContent = `Error: ${err.message || err}`; + outputPanel.style.color = 'red'; + } finally { + runBtn.disabled = false; + runBtn.textContent = originalText; + } + }); + }); +} + +document.addEventListener('DOMContentLoaded', () => { + initInlineSnippets(); + initPlayground(); +}); diff --git a/static/larp.ico b/static/larp.ico new file mode 100644 index 0000000..0195309 Binary files /dev/null and b/static/larp.ico differ diff --git a/static/lisp.html b/static/lisp.html new file mode 100644 index 0000000..5de8bf2 --- /dev/null +++ b/static/lisp.html @@ -0,0 +1,14 @@ +
    +
    +This is not SAX
    +Not a JSON API
    +
    +┌───┬───┐  ┌───┬───┐  ┌───┬───┐  ┌───┬───┐
    +│ ● │ ●─┼──┤ ● │ ●─┼──┤ ● │ ●─┼──┤ ● │ ╱ │
    +└─┼─┴───┘  └─┼─┴───┘  └─┼─┴───┘  └─┼─┴───┘
    +  │          │          │          │ 
    +┌─┴─┐      ┌─┴─┐      ┌─┴─┐      ┌─┴─┐ 
    +│ L │      │ I │      │ S │      │ P │
    +└───┘      └───┘      └───┘      └───┘
    +
    +
    diff --git a/static/manifest.json b/static/manifest.json new file mode 100644 index 0000000..f3faaf6 --- /dev/null +++ b/static/manifest.json @@ -0,0 +1,18 @@ +{ + "name": "cl-bbs Textboard", + "short_name": "cl-bbs", + "description": "An anonymous textboard bulletin board system", + "start_url": "/", + "display": "standalone", + "background_color": "#ffffff", + "theme_color": "#882200", + "orientation": "any", + "icons": [ + { + "src": "/static/schemebbs.png", + "sizes": "64x64", + "type": "image/png", + "purpose": "any maskable" + } + ] +} diff --git a/static/schemebbs.png b/static/schemebbs.png new file mode 100644 index 0000000..b102724 Binary files /dev/null and b/static/schemebbs.png differ diff --git a/static/styles/about.css b/static/styles/about.css new file mode 100644 index 0000000..d305c5f --- /dev/null +++ b/static/styles/about.css @@ -0,0 +1,82 @@ +@import url("common.css"); + +body { + width: 98%; + font-family: serif; + margin: 2em auto; + max-width: 800px; + padding: 0 1em; + box-sizing: border-box; + background-color: #1c2023; + color: #95aec7; +} +img { + max-width: 100%; + height: auto; +} +del { + text-decoration: none; + background-color: #95aec7; +} +del:hover { + background-color: transparent; +} +th { + text-align: left; + font-weight: normal; + text-decoration: underline; + padding-bottom: 1em; + color: #666666; +} +td { + padding: 0.2em 2em 0.2em 0; +} +pre { + background-color: #1f2427; + color: #95aec7; + padding: 0.4em; +} +blockquote { + color: #9aae86; + border-left: 2px solid #859774; + padding-left: 0.5em; + margin-left: 0; +} +h1 { + margin: 0; + padding: 0; + font-size: 2em; + font-weight: bold; + color: #c7ae95; +} +h2 { + margin: 0; + padding: 0; + font-size: 1.5em; + font-weight: bold; + overflow-wrap: break-word; + word-wrap: break-word; + color: #c7ae95; +} +h2 samp { + font-size: 0.66em; +} +hr { + border: 0; + margin: 0; + padding: 0; + height: 1px; + background-color: #716356; + color: #716356; +} +a, a:visited, a:active { + color: #c7ae95; + text-decoration: none; +} +a:hover { + text-decoration: underline; +} +a:target { + background-color: #22272a; + text-decoration: underline; +} diff --git a/static/styles/common.css b/static/styles/common.css new file mode 100644 index 0000000..8e385c2 --- /dev/null +++ b/static/styles/common.css @@ -0,0 +1,248 @@ +/* Structural and Shared Core Styles for cl-bbs */ + +/* Base alignment margins and layouts */ +h1 { + margin: 0.5em 2% 0.3em 2%; +} + +h2 { + margin: 0.5em 2%; +} + +.nav { + margin: 0.5em 2% 0.5em 2%; +} + +.preferences-form { + margin: 1.5em 2% 2em 2%; + padding: 0; + max-width: 600px; +} + +.preferences-form p { + margin: 0.5em 0; +} + +.theme-options-title { + font-weight: bold; + margin-bottom: 0.5em; +} + +.theme-selector-container { + display: flex !important; + flex-direction: column !important; + align-items: flex-start !important; + gap: 0.8em; + width: 100%; + margin: 1em 0; +} + +.theme-option-label { + display: flex !important; + width: auto !important; + align-items: center; + gap: 0.5em; + cursor: pointer; + user-select: none; + clear: both; +} + +.theme-option-text { + text-transform: capitalize; +} + +.preferences-form input[type=submit] { + cursor: pointer; +} + +/* Base mobile responsive layout changes */ +@media (max-width: 768px) { + .preferences-form { + margin: 1.5em 0; + } +} + +/* Error page styling */ +.error-container { + margin: 2em 2%; + padding: 1.5em; + border-left: 5px solid red; + background-color: #fff8f8; + font-family: serif; +} + +.error-container p { + margin: 0.5em 0; +} + +.error-container .error-title { + color: red; + font-size: 1.2em; + font-weight: bold; + margin-top: 0; +} + +.error-back-button { + padding: 8px 16px; + font-weight: bold; + border-radius: 4px; + cursor: pointer; +} + +/* Moderation Panel Styles (Theme-Adaptive) */ +body.moderation { + max-width: 900px; + margin: 0 auto !important; + padding: 1em 2% !important; +} + +body.moderation h1 { + margin-left: 0 !important; +} + +body.moderation h2 { + margin-left: 0 !important; + border-bottom: 1px solid currentColor; + padding-bottom: 0.3em; +} + +body.moderation ul { + padding-left: 1.5em; + margin-top: 1em; +} + +body.moderation li { + margin-bottom: 0.8em; + display: flex; + align-items: center; + gap: 1em; +} + +body.moderation form { + margin: 0; +} + +body.moderation table { + width: 100% !important; + margin: 1.5em 0 !important; + border-collapse: collapse; +} + +body.moderation th { + padding: 8px !important; + font-weight: bold; +} + +body.moderation td { + padding: 8px !important; + vertical-align: middle; +} + +body.moderation dd form { + margin-top: 1em; + padding: 1em; + border: 1px dashed currentColor; + opacity: 0.9; +} + +body.moderation dd form p { + margin: 0.3em 0; +} + +body.moderation input[type=submit].delete-button { + color: #ff3333 !important; + border-color: #ff3333 !important; + cursor: pointer; +} + +body.moderation input[type=submit].delete-button:hover { + background-color: #ff3333 !important; + color: white !important; +} + +body.moderation input[type=submit].shame-button { + color: #ff9900 !important; + border-color: #ff9900 !important; + cursor: pointer; +} + +body.moderation input[type=submit].shame-button:hover { + background-color: #ff9900 !important; + color: white !important; +} + +body.moderation .comment-preview { + margin-bottom: 0.5em; + padding: 0.5em; + background-color: #fafafa; + border-left: 3px solid #ccc; +} + +/* Global button reset — all submit inputs and bare buttons share the canonical style */ +input[type=submit], +button { + padding: 4px 10px; + font-size: 0.85em; + font-family: inherit; + background: transparent; + color: inherit; + border: 1px solid currentColor; + cursor: pointer; + border-radius: 3px; + user-select: none; + margin: 0.4em 0; +} + +input[type=submit]:hover, +button:hover { + background-color: rgba(128, 128, 128, 0.15); +} + +input[type=submit]:active, +button:active { + background-color: rgba(128, 128, 128, 0.3); +} + +input[type=submit]:disabled, +button:disabled { + opacity: 0.5; + cursor: not-allowed; +} + +/* Lisp Interactive Snippets & Playground Styles */ +.lisp-btn { + padding: 4px 10px; + font-size: 0.85em; + font-family: inherit; + background: transparent; + color: inherit; + border: 1px solid currentColor; + cursor: pointer; + border-radius: 3px; + user-select: none; +} + +.lisp-btn:hover { + background-color: rgba(128, 128, 128, 0.15); +} + +.lisp-btn:active { + background-color: rgba(128, 128, 128, 0.3); +} + +.lisp-btn:disabled { + opacity: 0.5; + cursor: not-allowed; +} + +@media (max-width: 768px) { + #playground-editor { + width: 100% !important; + } + #playground-output { + width: 100% !important; + } +} + +/* Syntax highlighting is now handled via separate syntax theme CSS files */ + diff --git a/static/styles/syntax/colorful.css b/static/styles/syntax/colorful.css new file mode 100644 index 0000000..217f235 --- /dev/null +++ b/static/styles/syntax/colorful.css @@ -0,0 +1,13 @@ +/* Colorful Syntax Highlighting for Lisp (Colorize output) */ +.lisp-code-block .string { color: #d14; } +.lisp-code-block .comment { color: #998; font-style: italic; } +.lisp-code-block .symbol { color: #008080; } +.lisp-code-block .keyword { color: #000080; font-weight: bold; } +.lisp-code-block .character { color: #099; } +.lisp-code-block .special { color: #0086B3; } +.lisp-code-block .paren1 { color: #aa0000; } +.lisp-code-block .paren2 { color: #00aa00; } +.lisp-code-block .paren3 { color: #0000aa; } +.lisp-code-block .paren4 { color: #aaaa00; } +.lisp-code-block .paren5 { color: #00aaaa; } +.lisp-code-block .paren6 { color: #aa00aa; } diff --git a/static/styles/syntax/simple.css b/static/styles/syntax/simple.css new file mode 100644 index 0000000..ddf0ff5 --- /dev/null +++ b/static/styles/syntax/simple.css @@ -0,0 +1,19 @@ +/* Simple Syntax Highlighting for Lisp (Colorize output) */ +.lisp-code-block { + background-color: #121214 !important; /* Rich dark background to improve contrast */ + color: #b0b0b0 !important; /* Slightly lighter/clearer gray for base code */ + padding: 10px !important; +} + +.lisp-code-block .string { color: #b0b0b0; } +.lisp-code-block .comment { color: #808080; font-style: italic; } +.lisp-code-block .symbol { color: #1e90ff; font-style: normal !important; } /* Explicitly remove italic */ +.lisp-code-block .keyword { color: #5c87ff; font-weight: bold; } /* Vibrant royalblue for dark contrast */ +.lisp-code-block .character { color: #b0b0b0; } +.lisp-code-block .special { color: #b0b0b0; } +.lisp-code-block .paren1 { color: #b0b0b0; } +.lisp-code-block .paren2 { color: #b0b0b0; } +.lisp-code-block .paren3 { color: #b0b0b0; } +.lisp-code-block .paren4 { color: #b0b0b0; } +.lisp-code-block .paren5 { color: #b0b0b0; } +.lisp-code-block .paren6 { color: #b0b0b0; } diff --git a/static/styles/themes/colored.css b/static/styles/themes/colored.css new file mode 100644 index 0000000..487d414 --- /dev/null +++ b/static/styles/themes/colored.css @@ -0,0 +1,6 @@ +@import url("default.css"); + +/* Extra styles for random theme */ +dd { + transition: background-color 0.3s ease; +} diff --git a/static/styles/themes/default.css b/static/styles/themes/default.css new file mode 100644 index 0000000..79bcd8b --- /dev/null +++ b/static/styles/themes/default.css @@ -0,0 +1,288 @@ +@import url("../common.css"); + +body { + margin: 0; + padding: 0; + background-color: #1c2023; + color: #95aec7; + font-family: serif; + font-size: 100%; +} +/* Board Name */ +h1 { + margin: 0.5em 2% 0.3em 2%; + padding: 0; + font-size: 2em; + font-weight: bold; +} +/* Headlines */ +h2 { + margin: 0.5em 2%; + padding: 0.5em 0 0 0; + font-size: 1.5em; + font-weight: bold; + overflow-wrap: break-word; + word-wrap: break-word; +} +/* Links */ +h2 samp { + font-size: 0.66em; +} +hr { + border: 0; + margin: 0; + padding: 0; + height: 1px; + background-color: #716356; + color: #716356; +} +p.newthread { + margin: 1em 2% 2em 2%; + padding: 1em 2%; + background-color: #202427; +} +/* boardlist */ +p.boardlist { + margin: 0.8em 2% 0 2%; + font-size: 0.8em; + color: #999; +} + +/* menu */ +p.nav { + margin: 0.5em 2% 0.5em 2%; + padding: 0; + font-size: .9em; + font-style: italic; +} +/* thread navigation */ +pre.jump { + margin: 0 2% -1em 0; + padding: 0; + font-size: 1em; + font-family: serif; + font-weight: bold; + word-spacing: 1em; + text-align: right; +} +pre.jump a { +text-decoration: none; +} +a, a:visited, a:active { + color: #c7ae95; + text-decoration: none; +} +a:hover { + text-decoration: underline; +} +a:target { + background-color: #22272a; + text-decoration: underline; +} +dl { + margin: 0.5em 2% 0 2%; + padding: 0; +} +dt { + margin: 0; + padding: 0; +} +/* post number */ +dt a { + font-size: 1.4em; +} +/* post date */ +dt code { + font-size: 1em; + font-family: monospace; + color: #8bafd2; +} +dt samp { + font-size: 1em; + font-family: monospace; + color: #8bafd2; + margin-left: 1%; +} + +dd { + margin: 0 2%; + padding: 0; + line-height: 1.4em; +} +dd p { + margin: 1em 0; + padding: 0; + background-color: transparent; + word-wrap: break-word; +} + +dd pre, dd code { + font-size: 1em; + font-family: monospace; +} + +dd pre { + margin: 1.2em 0; + padding: 2px; + color: #95aec7; + background-color: #1f2427; + line-height: 1.4em; + overflow: auto; +} +blockquote { + border-left: solid 2px #859774; + margin: 1em 0 1em 0; + padding: 0 0 0 1em; + background-color: inherit; + color: #9aae86; +} +blockquote:hover { + background-color: #252b2f; +} + +/* spoilers */ +del { + background-color: #95aec7; + text-decoration: none; +} +del:hover { + background-color: transparent; +} +/* thread list */ +table { + margin: 1em 2%; + padding: 0; + border-collapse: collapse; +} +th { + color: #666666; + background-color: #1c2023; + padding: 0.1em 0.5em; + font-family: monospace; + font-weight: normal; + text-align: left; + font-size: 1em; +} +td { + border: 0; + padding: 0.1em 0.5em; + line-height: 1em; +} + +tr:nth-child(odd) { + background: #252a2e; +} +tr:hover { + background-color: #536883; +} +td p, td pre, td blockquote { + margin: .5em 0; +} + +/* forms */ + +textarea { + margin: 0.2em 0 0.2em 0; + border: 1px solid #334a68; + padding: 2px; + max-width: 98%; + color: #95aec7; + background-color: #293035; + font-size: 1em; + font-family: monospace; +} +input[type=text] { + margin: 0.2em 0 0.5em 0; + border: 1px solid #334a68; + background-color: #293035; + color: #95aec7; + padding: 2px; + max-width: 98%; + font-size: 1em; + font-family: monospace; +} +input[type=checkbox] { + border: 1px solid #334a68; + background-color: #293035 !important; + vertical-align: middle; + margin: 0 2px; +} + +fieldset.comment { + display: none; +} +/* preferences */ +fieldset { + border: none; +} +ul { + margin: 0 0 1em 0; + padding: 0 0 1em 1em; +} +/* flash messages */ +p.flash { + background: transparent; + color: red; +} + +/* New Thread Form Styling */ +.newthread-form { + margin: 1.5em 2% 2em 2%; + padding: 1.5em 2%; + background-color: #202427; + border: 1px solid #334a68; + border-radius: 4px; + max-width: 600px; +} +.newthread-form h2 { + margin: 0 0 1em 0; + padding: 0; + color: #c7ae95; +} +.newthread-form p { + margin: 0.5em 0; +} +.newthread-form input[type=text], .newthread-form textarea { + width: 100%; + box-sizing: border-box; + padding: 8px; + font-size: 1em; + border: 1px solid #334a68; + background-color: #293035; + color: #95aec7; + border-radius: 4px; +} +p.footer { +font-size: 0.9em; +font-family: monospace; +background: transparent; +text-align: center; +} + +/* Dark Error page styling */ +.error-container { + background-color: #202427; + color: #95aec7; + border-left: 5px solid #ff3333; + font-family: inherit; +} + +.error-container .error-title { + color: #ff5555; +} + +.error-back-button { + background-color: #293035; + color: #95aec7; + border: 1px solid #334a68; +} + +.error-back-button:hover { + background-color: #536883; +} + +/* Dark Moderation Panel styling overrides */ +body.moderation .comment-preview { + background-color: #202427; + border-left: 3px solid #334a68; +} diff --git a/static/styles/themes/light.css b/static/styles/themes/light.css new file mode 100644 index 0000000..0e4ee47 --- /dev/null +++ b/static/styles/themes/light.css @@ -0,0 +1,287 @@ +@import url("../common.css"); + +body { + margin: 0; + padding: 0; + background-color: white; + color: #000000; + font-family: serif; + font-size: 100%; +} +/* Board Name */ +h1 { + margin: 0.5em 2% 0.3em 2%; + padding: 0; + font-size: 2em; + font-weight: bold; +} +/* Headlines */ +h2 { + margin: 0.5em 2%; + padding: 0.5em 0 0 0; + font-size: 1.5em; + font-weight: bold; + overflow-wrap: break-word; + word-wrap: break-word; +} +/* Links */ +h2 samp { + font-size: 0.66em; +} +hr { + border: 0; + margin: 0; + padding: 0; + height: 1px; + background-color: #aaaaaa; + color: #aaaaaa; +} +p.newthread { + margin: 1em 2% 2em 2%; + padding: 1em 2%; + background-color: #efefef; +} +/* menu */ +p.nav { + margin: 0.5em 2% 0.5em 2%; + padding: 0; + font-size: .9em; + font-style: italic; + background-color: white; +} +/* thread navigation */ +pre.jump { + margin: 0 2% -1em 0; + padding: 0; + background-color: white; + font-size: 1em; + font-family: serif; + font-weight: bold; + word-spacing: 1em; + text-align: right; +} +pre.jump a { +text-decoration: none; +} +a, a:visited, a:active { + color: #882200; + text-decoration: none; +} +a:hover { + text-decoration: underline; +} +a:target { + background-color: #f3f3f3; + text-decoration: underline; +} +dl { + margin: 0.5em 2% 0 2%; + padding: 0; +} +dt { + margin: 0; + padding: 0; +} +/* post number */ +dt a { + font-size: 1.4em; +} +/* post date */ +dt code { + font-size: 1em; + font-family: monospace; + color: #555555; +} +dt samp { + font-size: 1em; + font-family: monospace; + margin-left: 1%; +} + +dd { + margin: 0 2%; + padding: 0; + line-height: 1.4em; +} +dd p { + margin: 1em 0; + padding: 0; + background-color: transparent; + word-wrap: break-word; +} + +dd pre, dd code { + font-size: 1em; + font-family: monospace; +} + +dd pre { + margin: 1.2em 0; + padding: 2px; + background-color: #f7f7f7; + line-height: 1.4em; + overflow: auto; +} +blockquote { + border-left: solid 2px #cccccc; + margin: 1em 0 1em 0; + padding: 0 0 0 1em; + background-color: inherit; + color: #555555; +} +blockquote:hover { + background-color: #fafafa; +} + +/* spoilers */ +del { + background-color: #200200; + text-decoration: none; +} +del:hover { + background-color: transparent; +} +/* thread list */ +table { + margin: 1em 2%; + padding: 0; + border-collapse: collapse; +} +th { + color: #666666; + padding: 0.1em 0.5em; + font-family: monospace; + font-weight: normal; + text-align: left; + font-size: 1em; +} +td { + border: 0; + padding: 0.1em 0.5em; +// background-color: #fafafa; + line-height: 1em; +} + +tr:nth-child(odd) { + background: #fafafa; +} +tr:hover { + background-color: yellow; +} +td p, td pre, td blockquote { + margin: .5em 0; +} + +/* forms */ + +textarea { + margin: 0.2em 0 0.2em 0; + border: 1px solid #bababa; + padding: 2px; + max-width: 98%; + //overflow: hidden; + + font-size: 1em; + font-family: monospace; +} +input[type=text] { + margin: 0.2em 0 0.5em 0; + border: 1px solid #bababa; + padding: 2px; + max-width: 98%; + font-size: 1em; + font-family: monospace; +} +input[type=checkbox] { + border: 1px solid #bababa; + vertical-align: middle; + margin: 0 2px; +} + +fieldset.comment { + display: none; +} +/* preferences */ +fieldset { + border: none; +} +ul { + margin: 0 0 1em 0; + padding: 0 0 1em 1em; +} +/* flash messages */ +p.flash { + background: transparent; + color: red; +} + +p.footer { +font-size: 0.9em; +font-family: monospace; +background: transparent; +text-align: center; +} + +/* New Thread Form Styling */ +.newthread-form { + margin: 1.5em 2% 2em 2%; + padding: 1.5em 2%; + background-color: #fcfcfc; + border: 1px solid #e2e2e2; + border-radius: 4px; + max-width: 600px; +} +.newthread-form h2 { + margin: 0 0 1em 0; + padding: 0; +} +.newthread-form p { + margin: 0.5em 0; +} +.newthread-form input[type=text], .newthread-form textarea { + width: 100%; + box-sizing: border-box; + padding: 8px; + font-size: 1em; + border: 1px solid #bababa; + border-radius: 4px; +} +/* Mobile Responsiveness Rules */ +@media (max-width: 768px) { + body { + padding: 0.5em 1em; + } + h1 { + font-size: 1.8em; + margin: 0.5em 0 0.3em 0; + } + h2 { + font-size: 1.3em; + margin: 0 0 0.5em 0; + } + p.nav { + margin: 0.5em 0; + line-height: 1.5em; + } + dl { + margin: 0.5em 0; + } + dd { + margin: 0 0 1em 0; + } + textarea, input[type=text] { + width: 100% !important; + max-width: 100% !important; + box-sizing: border-box; + } + table { + display: block; + width: 100%; + overflow-x: auto; + margin: 1em 0; + } + th, td { + padding: 0.2em 0.4em; + font-size: 0.9em; + } +} diff --git a/static/styles/themes/matrix.css b/static/styles/themes/matrix.css new file mode 100644 index 0000000..b1e3766 --- /dev/null +++ b/static/styles/themes/matrix.css @@ -0,0 +1,423 @@ +@import url("../common.css"); + +body { + margin: 0; + padding: 0; + background-color: #0d0d0d; + color: #00ff41; + font-family: "Courier New", Courier, monospace; + font-size: 100%; + animation: pulse-glow 4s infinite alternate; + text-shadow: 0 0 3px #00ff41; +} + +@keyframes pulse-glow { + 0% { + text-shadow: 0 0 1px #00ff41, 0 0 3px #00ff41; + } + 100% { + text-shadow: 0 0 2px #00ff41, 0 0 4px #008f11, 0 0 8px #003b00; + } +} + +/* Board Name */ +h1 { + margin: 0.5em 2% 0.3em 2%; + padding: 0; + font-size: 2em; + font-weight: bold; + color: #d1ffdf; + text-shadow: 0 0 5px #00ff41, 0 0 10px #00ff41; + animation: glitch 1.5s ease-in-out infinite alternate; +} + +@keyframes glitch { + 0% { transform: translate(0) } + 20% { transform: translate(-2px, 1px) } + 40% { transform: translate(-1px, -1px) } + 60% { transform: translate(2px, 1px) } + 80% { transform: translate(1px, -1px) } + 100% { transform: translate(0) } +} + +/* Headlines */ +h2 { + margin: 0.5em 2%; + padding: 0.5em 0 0 0; + font-size: 1.5em; + font-weight: bold; + overflow-wrap: break-word; + word-wrap: break-word; + color: #a4ffbd; + text-shadow: 0 0 4px #00ff41; +} + +/* Links */ +h2 samp { + font-size: 0.66em; +} +hr { + border: 0; + margin: 1em 0; + padding: 0; + height: 1px; + background: linear-gradient(to right, #0d0d0d, #00ff41, #0d0d0d); +} + +p.newthread { + margin: 1em 2% 2em 2%; + padding: 1em 2%; + background-color: #051405; + border: 1px solid #00ff41; +} + +/* boardlist */ +p.boardlist { + margin: 0.8em 2% 0 2%; + font-size: 0.8em; + color: #008f11; +} + +div.newthread-form { + border: 1px solid #008f11; + padding: 1em; + margin: 1em 2%; + background-color: rgba(0, 59, 0, 0.2); + box-shadow: inset 0 0 5px #003b00; + transition: all 0.3s ease; +} + +div.newthread-form:hover { + box-shadow: inset 0 0 10px #008f11; + border-color: #00ff41; +} + + +/* menu */ +p.nav { + margin: 0.5em 2% 0.5em 2%; + padding: 0; + font-size: .9em; + font-style: italic; + font-weight: bold; + background-color: #0d0d0d; +} + +/* thread navigation */ +pre.jump { + margin: 0 2% -1em 0; + padding: 0; + background-color: transparent; + font-size: 1em; + font-family: inherit; + font-weight: bold; + word-spacing: 1em; + text-align: right; +} +pre.jump a { + text-decoration: none; + color: #d1ffdf; + transition: text-shadow 0.2s; +} + +pre.jump a:hover { + text-shadow: 0 0 8px #00ff41; +} + +a, a:visited, a:active { + color: #d1ffdf; + text-decoration: none; + font-weight: bold; + transition: color 0.3s, text-shadow 0.3s; +} +a:hover { + color: #ffffff; + text-shadow: 0 0 5px #00ff41, 0 0 10px #00ff41; + text-decoration: underline dashed #00ff41; +} +a:target { + background-color: #003b00; + text-decoration: underline dashed #00ff41; +} +dl { + margin: 0.5em 2% 0 2%; + padding: 0; +} +dt { + margin: 0; + padding: 0; +} +/* post number */ +dt a { + font-size: 1.4em; + color: #008f11; + text-shadow: none; +} +dt a:hover { + color: #00ff41; +} + +/* post date */ +dt code { + font-size: 1em; + font-family: inherit; + color: #008f11; + text-shadow: none; +} +dt samp { + font-size: 1em; + font-family: inherit; + margin-left: 1%; + color: #00ff41; + text-shadow: none; + font-weight: bold; +} + +dd { + margin: 0 2% 1em 2%; + padding: 1em; + line-height: 1.4em; + background: rgba(0, 255, 65, 0.03); + border-left: 2px solid #008f11; + transition: background 0.3s, border-color 0.3s; +} + +dd:hover { + background: rgba(0, 255, 65, 0.08); + border-left: 2px solid #00ff41; +} + +dd p { + margin: 1em 0; + padding: 0; + background-color: transparent; + word-wrap: break-word; +} + +dd pre, dd code { + font-size: 1em; + font-family: monospace; + text-shadow: none !important; +} + +dd pre { + margin: 1.2em 0; + padding: 10px; + background-color: rgba(0, 0, 0, 0.8); + border: 1px dotted #008f11; + line-height: 1.4em; + overflow: auto; + color: #00ff41; +} +blockquote { + border-left: dashed 2px #008f11; + margin: 1em 0 1em 0; + padding: 0 0 0 1em; + background-color: rgba(0, 59, 0, 0.3); + color: #8cffab; + font-style: italic; +} +blockquote:hover { + background-color: rgba(0, 89, 0, 0.4); +} + +/* spoilers */ +del { + background-color: #000; + color: #000; + text-decoration: none; + transition: all 0.5s ease; + user-select: none; +} +del:active, del:hover { + background-color: transparent; + color: #00ff41; + text-shadow: 0 0 3px #00ff41; +} + +/* thread list */ +table { + margin: 1em 2%; + padding: 0; + border-collapse: collapse; + width: 96%; +} +th { + color: #00ff41; + padding: 0.5em; + font-family: inherit; + font-weight: bold; + text-align: left; + font-size: 1em; + border-bottom: 1px solid #008f11; + text-transform: uppercase; +} +td { + border: 0; + border-bottom: 1px dashed #003b00; + padding: 0.8em 0.5em; + line-height: 1.2em; +} + +tr:nth-child(odd) { + background: rgba(0, 255, 65, 0.05); +} +tr:hover { + background-color: rgba(0, 255, 65, 0.2); +} +td p, td pre, td blockquote { + margin: .5em 0; +} + +/* forms */ + +textarea, input[type=text] { + margin: 0.2em 0 0.2em 0; + border: 1px solid #008f11; + padding: 5px; + max-width: 98%; + font-size: 1em; + font-family: inherit; + background-color: black; + color: #00ff41; +} + +textarea:focus, input[type=text]:focus { + outline: none; + border-color: #00ff41; + box-shadow: 0 0 5px rgba(0, 255, 65, 0.5); +} + +input[type=submit], button, .lisp-btn { + font-family: inherit; + font-weight: bold; + font-size: 1em; + margin: 0.6em 0; + border: 1px solid #00ff41; + padding: 5px 15px; + background-color: black; + color: #00ff41; + cursor: pointer; + text-transform: uppercase; + transition: all 0.2s; + box-shadow: 0 0 3px #008f11; +} + +input[type=submit]:hover, button:hover, .lisp-btn:hover { + background-color: #00ff41; + color: black; + box-shadow: 0 0 8px #00ff41; +} + +input[type=submit]:active, button:active, .lisp-btn:active { + transform: scale(0.95); +} + +input[type=submit]:disabled, button:disabled, .lisp-btn:disabled { + opacity: 0.5; + cursor: not-allowed; +} + +input[type=checkbox] { + border: 1px solid #00ff41; + vertical-align: middle; + margin: 0 2px; + background-color: black; +} + +fieldset.comment { + display: none; +} +/* preferences */ +fieldset { + border: 1px solid #008f11; + padding: 1em; + margin-top: 1em; +} + +legend { + color: #00ff41; + font-weight: bold; + padding: 0 5px; +} + +select { + background-color: black; + color: #00ff41; + border: 1px solid #008f11; + padding: 3px; + font-family: inherit; +} + +select:focus { + outline: none; + border-color: #00ff41; + box-shadow: 0 0 5px rgba(0, 255, 65, 0.4); +} + + +ul { + margin: 0 0 1em 0; + padding: 0 0 1em 2em; + list-style-type: square; +} + +li { + margin-bottom: 0.5em; +} + +/* flash messages */ +p.flash { + background: rgba(255, 0, 0, 0.2); + color: #ff3333; + border: 1px solid #ff0000; + padding: 10px; + text-shadow: none; +} + +p.footer { + font-size: 0.8em; + font-family: inherit; + background: transparent; + text-align: center; + color: #00aa1a; + text-shadow: none; + margin-top: 3em; + border-top: 1px solid #003b00; + padding-top: 1em; +} + +/* Matrix Error page styling */ +.error-container { + background-color: #0d0d0d; + color: #00ff41; + border-left: 5px solid #00ff41; + box-shadow: 0 0 5px #003b00; + font-family: inherit; +} + +.error-container .error-title { + color: #ff3333; + text-shadow: 0 0 3px #ff3333; +} + +.error-back-button { + background-color: black; + color: #00ff41; + border: 1px solid #00ff41; + box-shadow: 0 0 3px #008f11; +} + +.error-back-button:hover { + background-color: #00ff41; + color: black; + box-shadow: 0 0 8px #00ff41; +} + +/* Matrix Moderation Panel styling overrides */ +body.moderation .comment-preview { + background-color: rgba(0, 59, 0, 0.2); + border-left: 3px solid #008f11; + box-shadow: inset 0 0 3px #003b00; +} +\n.lisp-code-block {\n text-shadow: none !important;\n} diff --git a/static/styles/themes/no.css b/static/styles/themes/no.css new file mode 100644 index 0000000..1bf0411 --- /dev/null +++ b/static/styles/themes/no.css @@ -0,0 +1 @@ +@import url("../common.css"); diff --git a/static/sw.js b/static/sw.js new file mode 100644 index 0000000..edf8149 --- /dev/null +++ b/static/sw.js @@ -0,0 +1,31 @@ +const CACHE_NAME = 'cl-bbs-v2'; +const ASSETS = [ + '/static/styles/themes/default.css', + '/static/styles/themes/dark.css', + '/static/styles/themes/no.css', + '/static/styles/themes/colored.css', + '/static/styles/themes/matrix.css', + '/static/favicon.ico', + '/static/schemebbs.png' +]; + +self.addEventListener('install', (event) => { + event.waitUntil( + caches.open(CACHE_NAME).then((cache) => { + return cache.addAll(ASSETS); + }) + ); +}); + +self.addEventListener('fetch', (event) => { + event.respondWith( + caches.match(event.request).then((cachedResponse) => { + if (cachedResponse) { + return cachedResponse; + } + return fetch(event.request).catch(() => { + // Fallback or offline page + }); + }) + ); +}); diff --git a/static/userscripts/highlight.user.js b/static/userscripts/highlight.user.js new file mode 100644 index 0000000..94d8ba5 --- /dev/null +++ b/static/userscripts/highlight.user.js @@ -0,0 +1,22 @@ +// ==UserScript== +// @name Syntax Highlighting for textboard.org +// @namespace http://textboard.org/ +// @description Syntax Highlighting of code blocks with highlight.js +// @version 1 +// @match *://textboard.org/* +// @resource css https://cdnjs.cloudflare.com/ajax/libs/highlight.js/9.12.0/styles/default.min.css +// @require https://cdnjs.cloudflare.com/ajax/libs/highlight.js/9.12.0/highlight.min.js +// @require https://cdnjs.cloudflare.com/ajax/libs/highlight.js/9.12.0/languages/haskell.min.js +// @require https://cdnjs.cloudflare.com/ajax/libs/highlight.js/9.12.0/languages/lisp.min.js +// @require https://cdnjs.cloudflare.com/ajax/libs/highlight.js/9.12.0/languages/scheme.min.js +// @require https://cdnjs.cloudflare.com/ajax/libs/highlight.js/9.12.0/languages/javascript.min.js +// @require https://cdnjs.cloudflare.com/ajax/libs/highlight.js/9.12.0/languages/lua.min.js +// @require https://cdnjs.cloudflare.com/ajax/libs/highlight.js/9.12.0/languages/go.min.js +// @grant GM_addStyle +// @grant GM_getResourceText +// ==/UserScript== +GM_addStyle(GM_getResourceText('css')); +(function () { + 'use strict'; + hljs.initHighlighting(); +})(); diff --git a/static/userscripts/localjump.user.js b/static/userscripts/localjump.user.js new file mode 100644 index 0000000..8c6274e --- /dev/null +++ b/static/userscripts/localjump.user.js @@ -0,0 +1,17 @@ +// ==UserScript== +// @name localjump +// @author Anon +// @namespace http://textboard.org +// @description Change single post quote links inside full thread views from separate single post views to local scroll jumps within the thread +// @version 1 +// @match *://textboard.org/* +// @grant none +// ==/UserScript== +(function() { + 'use strict'; + Array.from (document.getElementsByTagName ("a")).filter (e => e.hasAttribute ("href")).forEach (e => { + var h = e.getAttribute ("href") + var s = h.replace (/^\/([^\/]+)\/(\d+)\/(\d+)$/, "/$1/$2#t$2p$3") + if (h != s) { e.setAttribute ("href", s); } +}) +})(); diff --git a/static/userscripts/unvip.user.js b/static/userscripts/unvip.user.js new file mode 100644 index 0000000..e5017cb --- /dev/null +++ b/static/userscripts/unvip.user.js @@ -0,0 +1,18 @@ +// ==UserScript== +// @name UnVIP +// @author Anon +// @namespace http://textboard.org +// @description View the thread list in update order regardless of VIPs +// @version 1 +// @match *://textboard.org/* +// @grant none +// ==/UserScript== +(function() { + 'use strict'; + const tbody = document.getElementsByTagName ("tbody") [0] + const rows = Array.from (tbody.children) + const upd = e => e.children [3].children [0].textContent + rows.sort ((a, b) => {var u = upd (a); var v = upd (b); return u < v ? 1 : u > v ? -1 : 0; }) + tbody.innerHTML = "" + rows.forEach (e => tbody.appendChild (e)) +})(); diff --git a/static/userscripts/wordfilter.user.js b/static/userscripts/wordfilter.user.js new file mode 100644 index 0000000..476706f --- /dev/null +++ b/static/userscripts/wordfilter.user.js @@ -0,0 +1,29 @@ +// ==UserScript== +// @name Word Filter for textboard.org +// @namespace http://textboard.org +// @description Replace words with other words +// @version 1 +// @match *://textboard.org/* +// @grant none +// ==/UserScript== +(function() { + 'use strict'; + var replacements, regex, key, textnodes, node, s; + replacements = { + "nigger": "mujina", + "faggot": "baku", + }; + regex = {}; + for (key in replacements) { + regex[key] = new RegExp(key, 'gi'); + } + textnodes = document.evaluate( "//body//text()", document, null, XPathResult.UNORDERED_NODE_SNAPSHOT_TYPE, null); + for (var i = 0; i < textnodes.snapshotLength; i++) { + node = textnodes.snapshotItem(i); + s = node.data; + for (key in replacements) { + s = s.replace(regex[key], replacements[key]); + } + node.data = s; + } +})(); -- cgit v1.2.3