;;; scalia.el --- SCOTUS rant generator

;; Author: Noah Friedman <friedman@splode.com>
;; Created: 2015-06-26
;; Public domain.

;; $Id: scalia.el,v 1.2 2015/06/27 16:37:52 friedman Exp $

;;; Commentary:

;; To use: load and execute M-x scalia-insult

;; Inspired by http://www.motherjones.com/politics/2015/06/antonin-scalia-insult-generator

;;; Code:

(defconst scalia-grammar
  '((sentence
     "*insult1 *insult2."
     )

    (insult1
     "Antonin Scalia"
     "Some ghoul in a late-night horror movie that repeatedly sits up in its grave and shuffles abroad, after being repeatedly killed and buried"
     "The Supreme Court peek-a-boo"
     "The latest stage of prophylaxis built upon prophylaxis, producing a veritable fairyland castle of imagined constitutional restriction upon law enforcement"
     "The nearest hippie"
     "The obfuscator of last resort"
     "This Alfred Hitchcock line of our jurisprudence"
     "This SCOTUScare"
     "This ad-hocery"
     "This avant-garde artiste"
     "This interpretive jiggery-pokery"
     "This legalistic argle-bargle"
     "This loaf"
     "This new, keep-what-you-want-and-throw-away-the-rest version"
     "This scruffy, bearded, sandal-wearing idiot"
     "This somersault of statutory interpretation"
     )

    (insult2
     "applied scrutiny more commonly associated with interior decorators than with the judiciary"
     "can best be described as contrived"
     "cannot be taken seriously"
     "could have used a while longer in the oven"
     "has descended from the disciplined legal reasoning of John Marshall and Joseph Story to the mystical aphorisms of the fortune cookie"
     "has mistaken a Kulturkampf for a fit of spite"
     "is SCOTUScare"
     "is Supreme Court peek-a-boo"
     "is a somersault of statutory interpretation"
     "is abominable, but commercially reasonable"
     "is ad-hocery"
     "is as pretentious as its content is egotistic"
     "is interpretive jiggery-pokery"
     "is legalistic argle-bargle"
     "is like some ghoul in a late-night horror movie that repeatedly sits up in its grave and shuffles abroad, after being repeatedly killed and buried"
     "is living in another world"
     "is not merely unnatural; it is unheard of"
     "is pure applesauce"
     "is the latest stage of prophylaxis built upon prophylaxis, producing a veritable fairyland castle of imagined constitutional restriction upon law enforcement"
     "is the obfuscator of last resort"
     "is utter nonsense"
     "taxes the credulity of the credulous"
     "will almost certainly cause more Americans to be killed"
     )))


;; This needs more work.
(defconst scalia-grammar-new
  '((sentence
     "This *noun-phrase is *is-thing."
     )

    (consequence
     "more Americans to be killed"
     )

    (noun-phrase
     "*adjective line of our *noun"
     "*adjective *noun"
     "*noun"
     "new, *adjective version"
     "*adjective, *adjective, *adjective *noun"
     "*noun of *of-thing"
     )

    (adverb
     "commercially"
     )

    (adjective
     "*adjective *adjective"

     "Alfred Hitchcock"
     "abominable"
     "avant-garde"
     "bearded"
     "commercially reasonable"
     "constitutional"
     "egotistic"
     "fairyland"
     "imagined"
     "interpretive"
     "keep-what-you-want-and-throw-away-the-rest"
     "legalistic"
     "nearest"
     "new"
     "pretentious"
     "sandal-wearing"
     "scruffy"
     "unconstitutional"
     "unnatural"
     "utter"
     "veritable"
     )

    (noun
     "*adjective *noun"
     "*noun *noun"

     "SCOTUScare"
     "ad-hocery"
     "argle-bargle"
     "castle"
     "hippie"
     "idiot"
     "jiggery-pokery"
     "jurisprudence"
     "loaf"
     "nonsense"
     "obfuscator"
     "peek-a-boo"
     "somersault"
     "restriction"
     )

    (people
     "interior decorators"
     "law enforcement"
     "artiste"
     "Supreme Court"

     )

    (of-thing
     "statutory interpretation"
     "last resort"
     "prophylaxis built upon prophylaxis"
     "*adjective *adjective *noun"
     )

    (is-thing
     "*adjective *noun"
     "the *noun of *of-thing"
     "a *noun of *of-thing"
     "*adjective, but *adjective"
     "as *adjective as its content is *adjective"
     "not merely *adjective; it is unheard of"
     "the latest stage of *of-thing, producing a *noun of *adjective *adjective restriction upon *noun"
     "applied scrutiny more commonly associated with interior decorators than with the judiciary"

     ;; This remark is just too good not to include literally.
     "like some ghoul in a late-night horror movie that repeatedly sits up in its grave and shuffles abroad, after being repeatedly killed and buried"
     "living in another world"
     )
    ))


;;;###autoload
(defun scalia-insult (&optional n insertp)
  "Generate a random flame a la Antonin Scalia.
Prefix argument N means generated a flame of N sentences.

If called interactively, the results are displayed in a temporary buffer.
 Use \\[insert-scalia-insult] to insert a flame into the current buffer.

If called from lisp, a list of N sentences is returned.
If optional arg INSERTP is non-nil, the sentences are inserted into the
 current buffer at point, formatted as a paragraph.
 \(Use `scalia-paragraph' to obtain a formatted paragraph as a string.\)"
  (interactive "p")
  (or n (setq n 1))
  (let ((l nil))
    (while (not (zerop n))
      (setq l (cons (scalia-string) l))
      (setq n (1- n)))
    (and (or insertp (interactive-p))
         (scalia-display (mapconcat 'identity l "  ") "*Scalia Insult*" insertp))
    l))

(defun insert-scalia-insult (&optional n)
  "Insert a flame into the current buffer.
Prefix argument N means insert N sentences, formatted as a paragraph."
  (interactive "p")
  (scalia-insult n t))

(defun scalia-string ()
  "Generate an inflammatory statement, and return it."
  (scalia-capitalize (scalia-substitute 'sentence) t))

(defun scalia-paragraph (&optional n)
  "Generate a paragraph of inflammatory statements, and return it.
Argument N determines how many sentences are in the paragraph."
  (let ((buf (generate-new-buffer " *scalia-paragraph*")))
    (unwind-protect
        (save-excursion
          (set-buffer buf)
          (insert-flame n)
          ;; don't return final newline
          (buffer-substring (point-min) (1- (point-max))))
      (kill-buffer buf))))


(defun scalia-display (string temp-buffer-name insertp)
  (let ((temp-buffer-show-function temp-buffer-show-function)
        (temp-buffer-show-hook (lambda () (fill-paragraph nil))))

    (cond (insertp
           (save-restriction
             (narrow-to-region (point) (point))
             (insert string)
             (fill-paragraph nil)))

          (t
           ;; Play nice with JBW's temp-buffer window height
           ;; minimization hacks
           (and (eq temp-buffer-show-function 'show-temp-buffer)
                (setq temp-buffer-show-function
                      (lambda (buf)
                        (save-excursion
                          (set-buffer buf)
                          (fill-paragraph nil))
                        (show-temp-buffer buf))))
           (with-output-to-temp-buffer temp-buffer-name
             (princ string))))))


;; Tokenize sentence so substitution words are separated.
;; The character `^' can be used to join suffixes to the end of a
;; substitution token, but do not show up in the resulting list.
;; e.g. "Many *word^s with *sub, with 2^32 at *end."
;;      => ("Many " "*word" "s with " "*sub" ", with 2^32 at " "*end" ".")
(defun scalia-split (s)
  (let ((l nil)
        (p 0)
        (len (length s))
        (md (match-data)))
    (while (and p (string-match "[*!][a-z0-9-]+" s p))
      (and (< p (match-beginning 0))
           (setq l (cons (substring s p (match-beginning 0)) l)))
      (setq l (cons (substring s (match-beginning 0) (match-end 0)) l))
      (setq p (match-end 0))
      (cond ((>= p len)
             (setq p nil))
            ((char-equal ?^ (aref s p))
             (setq p (1+ p)))))
    (and p
         (< p len)
         (setq l (cons (substring s p) l)))
    (store-match-data md)
    (nreverse l)))

;; Rudimentary pluralization correction
(defun scalia-plural-correct (l)
  (save-match-data
    (let ((case-fold-search t)
          (p l))
      (while (and p (cdr p))
        (when (and (char-equal ?s (aref (cadr p) 0))
                   (> (length (car p)) 2))
          (let ((elt (car p)))
            (cond ((string-match "\\([^ou]\\)y$" elt)
                   (setcar p (replace-match "\\1ie" nil nil elt)))

                  ((string-match "(?:[xs]|ch)$" elt)
                   (setcar p (concat elt "e")))

                  ((string-match "^(?:wo)?man$") ;; irregular form
                   (aset elt (- (length elt) 2) ?e)
                   (setcar (cdr p) (substring (cadr p) 0 -1))) ;; strip 's'

                  ((string-match "^person$") ;; irregular form
                   (setcar p "people")
                   (setcar (cdr p) (substring (cadr p) 0 -1))) ;; strip 's'
                  )))
        (setq p (cdr p)))))
  l)

;; Iterate over string STR, replacing all substrings beginning
;; with a '*' or '!'  with a random selection from the appropriate list.
(defun scalia-iterate-list (str)
  (let* ((l (scalia-split str))
         (p l)
         elt)
    (while p
      (setq elt (car p))
      (cond ((= (length elt) 1))
            ((= (aref elt 0) ?*)
             (setcar p (scalia-substitute elt)))
            ((= (aref elt 0) ?!)
             (setcar p (scalia-capitalize (scalia-substitute elt)))))
      (setq p (cdr p)))
    (mapconcat 'identity (scalia-plural-correct l) "")))

;; Return a random member of list L.
(defsubst scalia-random-member (l)
  (nth (random (length l)) l))

(defun scalia-substitute (category)
  (let ((tbl (scalia-category category)))
    (if tbl
        (scalia-iterate-list (scalia-random-member tbl))
      category)))

(defun scalia-category (category)
  (and (stringp category)
       (setq category (intern (substring category 1))))
  (cdr (assq category scalia-grammar)))

(defun scalia-capitalize (s &optional destructive)
  (or destructive
      (setq s (copy-sequence s)))
  (aset s 0 (upcase (aref s 0)))
  s)

(provide 'scalia)

;;; eof