New: quip function for random humor.

Add this to your .txr_profile startup file.

* lisplib.c (quips_instantiate, quips_set_entries): New static
functions.
(lisplib_init): Register autoloading of quip.

* share/txr/stdlib/quips.tl: New file.

* txr.1: Documented.

3 files changed, 122 insertions, 0 deletions

diff --git a/lisplib.c b/lisplib.c
index 6999efcd..b4d6d4c3 100644
--- a/lisplib.c
+++ b/lisplib.c
@@ -840,6 +840,23 @@ static val each_prod_set_entries(val dlt, val fun)
   return nil;
 }
 
+static val quips_instantiate(val set_fun)
+{
+  funcall1(set_fun, nil);
+  load(scat2(stdlib_path, lit("quips")));
+  return nil;
+}
+
+static val quips_set_entries(val dlt, val fun)
+{
+  val name[] = {
+    lit("quip"),
+    nil
+  };
+  set_dlt_entries(dlt, name, fun);
+  return nil;
+}
+
 val dlt_register(val dlt,
                  val (*instantiate)(val),
                  val (*set_entries)(val, val))
@@ -893,6 +910,7 @@ void lisplib_init(void)
   dlt_register(dl_table, defset_instantiate, defset_set_entries);
   dlt_register(dl_table, copy_file_instantiate, copy_file_set_entries);
   dlt_register(dl_table, each_prod_instantiate, each_prod_set_entries);
+  dlt_register(dl_table, quips_instantiate, quips_set_entries);
 
   reg_fun(intern(lit("try-load"), system_package), func_n1(lisplib_try_load));
 }
diff --git a/share/txr/stdlib/quips.tl b/share/txr/stdlib/quips.tl
new file mode 100644
index 00000000..7bca9bb8
--- /dev/null
+++ b/share/txr/stdlib/quips.tl
@@ -0,0 +1,73 @@
+;; Copyright 2020
+;; Kaz Kylheku <kaz@kylheku.com>
+;; Vancouver, Canada
+;; All rights reserved.
+;;
+;; Redistribution and use in source and binary forms, with or without
+;; modification, are permitted provided that the following conditions are met:
+;;
+;; 1. Redistributions of source code must retain the above copyright notice, this
+;;    list of conditions and the following disclaimer.
+;;
+;; 2. Redistributions in binary form must reproduce the above copyright notice,
+;;    this list of conditions and the following disclaimer in the documentation
+;;    and/or other materials provided with the distribution.
+;;
+;; THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND
+;; ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
+;; WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
+;; DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE
+;; FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
+;; DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
+;; SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
+;; CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
+;; OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
+;; OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+
+(defvarl sys:%quips%
+  #("TXR was taped live before a studio audience. The laughter is genuine."
+    "Exclusive of recycled stuffing, TXR contains new materials only."
+    "TXR is not a toy, but should be kept within easy reach of children."
+    "Do not remove this label until TXR is delivered to the consumer."
+    "Remove TXR any time for a complete refund of your disk space."
+    "Store TXR in a cool, dry storage device. Keep out of direct sunlight."
+    "Do not operate heavy equipment or motor vehicles while using TXR."
+    "Use full-strength TXR for tough tasks, or dilute with shell scripts."
+    "TXR causes vomiting if accidentally ingested; no need to induce such."
+    "If unwanted side effects persist, discontinue use of TXR."
+    "TXR works even if the application surface is not free of dirt and grease."
+    "TXR may be used in areas that are not necessarily well ventilated."
+    "TXR's button pops up when original seal is broken."
+    "TXR is tested on nothing but animals (so to speak)."
+    "Disclaimer: TXR has been found to cure cancer in lab mice only."
+    "Garbage collection is on Tuesdays: bring unwanted pointers to curb by 7:30."
+    "Warning: may explode if heated, cooled or maintained at room temperature."
+    "TXR is made with 75% post-consumer recycled cons cells."
+    "Poke a few holes in TXR with a fork before heating in the microwave."
+    "Caution: objects in heap are farther from reality than they appear."
+    "TXR doesn't really whip the llama's ass so much as the lambda's."
+    "TXR is recommended for either internal or external use. Whatever, y'know?"
+    "TXR is enteric coated to release over 24 hours of lasting relief."
+    "TXR contains many small parts, unsuitable for children under 12 months."
+    "TXR is packaged by the byte; contents may compress during shipping."
+    "Discontinue coding TXR if experiencing dizziness or shortness of breath."
+    "Self-assembly keeps TXR costs low; but ask about our installation service!"
+    "Some mild discoloration of syntax highlighting may occur with age."
+    "TXR is made with equipment not contaminated by peanuts ... r-r-right?"
+    "TXR is believed by fools to be free of defects in workmanship and materials."
+    "Adults using TXR should be closely supervised by children."
+    "TXR may be worn in seven different ways, in any weather."
+    "TXR is light and portable; take it camping, or to the Bahamas."
+    "Psst! The complimentary Allen key that comes with TXR is inpired by IKEA."
+    "Ethically produced using volunteer geek labor in a first world country."
+    "Program contains violence and coarse language, demanding user indiscretion."
+    "TXR is written, directed and produced by, not to mention starring, Kaz."
+    "Emergency exits are located in the standard library."
+    "Your history may used for automatic recommendations, like 'stick to Python'."
+    "Without the generosity of users like you, this program would exist just fine."
+    ))
+
+(defparml sys:%quip-rand-state% (make-random-state))
+
+(defun quip ()
+  [sys:%quips% (rand (len sys:%quips%) sys:%quip-rand-state%)])
diff --git a/txr.1 b/txr.1
index 752ef03d..8991fed4 100644
--- a/txr.1
+++ b/txr.1
@@ -75097,6 +75097,37 @@ The object
 .code 4
 is self-evaluating, and so the greedy evaluation process stops.
 
+.SS* Listener-Related Miscellanea
+
+.coNP Function @ quip
+.synb
+.mets (quip)
+.syne
+.desc
+The
+.code quip
+function returns a randomly selected string containing a humorous quip,
+quote or witticism. The following code may be added to
+.code .txr_profile
+to produce the random quip on startup:
+
+.verb
+  (put-line (quip))
+.brev
+
+The
+.code quip
+function was introduced in \*(TX 244. If the
+.code .txr_profile
+is used with installations of older \*(TX versions, it is recommended to use
+the following, to avoid calling the undefined function, as well as to
+prevent a warning:
+
+.verb
+  (if (fboundp 'quip)
+    (put-line (quip))
+    (defun quip ()))
+.brev
 
 .SH* SETUID/SETGID OPERATION