bug#61325: 30.0.50; Jokes in GNUS manual

[No Wayman <iarchivedmywholelife@gmail.com>]

[-- Attachment #1: Type: text/plain, Size: 1925 bytes --]


I feel like this discussion is easily solved by a technical means.
What we need is an embedded document mark-up language in order for 
documentation authors to formally indicate where they are joking. 
We then define an alist of "harm categories" which users can 
register themselves with.
Before documentation is printed, the "harmfulness coefficient" is 
determined for a particular user. If it is above their 
"harmfulness threshold", we display a less offensive joke (defined 
in a separate, localized user option).

See the attached library, joke.el, which solves 99% of the 
problem.
An example usage:

#+begin_src emacs-lisp
(defconst joke-test-text
  "A closure is a function that also carries a record of the 
  lexical
environment that existed when the function was defined. When it is 
invoked, any
lexical variable references within its definition use the retained 
lexical
environment. In all other respects, closures behave much like 
ordinary
functions; in particular, they can be called in the same way as 
ordinary
functions. Speaking of which:

<joke>Why did the chicken go to Hell? It wasn't braised 
right.</joke>")

(cl-loop for (subject . categories) in '((timmy  . (agoraphobic 
child))
                                         (rachel . (religious 
                                         vegan)))
         collect (cons subject (apply #'joke-harm-by-category 
         joke-test-text
                                      categories)))

;;((timmy (agoraphobic . 0.0)
;;        (child . 12.043010752688172))
;; (rachel (religious . 12.043010752688172)
;;         (vegan . 12.043010752688172)))
#+end_src

Here we can see 12.04% of the above documentation will offend an 
agoraphobic child, such as Timmy. However, it will be doubly 
offensive to a religious vegan, such as Rachel.

If I don't hear any convincing objections within the next couple 
of hours,
I'll merge to emacs-29 branch.

Thanks.


[-- Attachment #2: joke --]
[-- Type: text/plain, Size: 1861 bytes --]

;;; Joke --- Not a joke. ;; -*- lexical-binding: t; -*-
;;; Commentary:
;; yes.
;;; Code:
(require 'cl-lib)

(defconst joke-harm-categories
  '((("chicken" "cow" "meat")            . vegetarian)
    ((vegetarian "cheese" "milk" "fish") . vegan)
    (("god" "sex" "heaven" "hell")       . religious)
    ((religious "religion")              . atheist)
    (("marketplace")                     . agoraphobic)
    ((".*")                              . child))
  "Lists of categories of people will be offended by jokes on certain topics.")

(defun joke-victims (joke)
  "Return victims of JOKE."
  (cl-loop for (spec . victim) in joke-harm-categories
           for regexps = (flatten-tree
                          (cl-loop for el in spec collect
                                   (if (symbolp el)
                                       (car (rassoc el joke-harm-categories))
                                     el)))
           when (cl-some (lambda (regexp) (string-match-p regexp joke)) regexps)
           collect victim))

(defun joke-jokes (text)
  "Return list of jokes in TEXT."
  (let ((jokes))
    (with-temp-buffer
      (insert text)
      (goto-char (point-min))
      (while (re-search-forward "\\(?:<joke>\\([^z-a]*?\\)</joke>\\)" nil 'noerror)
        (push (match-string 1) jokes))
      (nreverse jokes))))

(defun joke-harm-by-category (text &rest victims)
  "Return percentage of JOKES in TEXT which will harm VICTIMS."
  (cl-loop with jokes = (joke-jokes text)
           for victim in (or victims '(anyone))
           for harmful =
           (cl-remove-if-not (lambda (joke) (member victim (joke-victims joke)))
                             jokes)
           collect (cons victim (* 100 (/ (cl-reduce #'+ harmful :key #'length)
                                          (float (length text)))))))

(provide 'joke)
;;; joke.el ends here