From 0295d2ad2a73e9a88b5213c7b861d49853c9430f Mon Sep 17 00:00:00 2001 From: "Eric S. Raymond" Date: Thu, 2 Sep 2010 00:56:55 -0400 Subject: [PATCH] Improved website content and machinery for updating it. --- .gitignore | 5 - website/.gitignore | 5 + website/Makefile | 13 ++ website/calc-intercal.el | 385 +++++++++++++++++++++++++++++++++++++++ website/index.html | 4 + website/upload | 29 +++ 6 files changed, 436 insertions(+), 5 deletions(-) create mode 100644 website/.gitignore create mode 100644 website/Makefile create mode 100644 website/calc-intercal.el create mode 100755 website/upload diff --git a/.gitignore b/.gitignore index c101d5c..4f4705e 100644 --- a/.gitignore +++ b/.gitignore @@ -18,11 +18,6 @@ buildaux/missing buildaux/ylwrap src/bconfigh.in src/configh.in -# Uploading the web page lands a copy here -index.html -README.html -NEWS.html -BUGS.html # Executables produced by standard build bin2c convickt diff --git a/website/.gitignore b/website/.gitignore new file mode 100644 index 0000000..a6c5f12 --- /dev/null +++ b/website/.gitignore @@ -0,0 +1,5 @@ +.upload-stamp +index.html +README.html +NEWS.html +BUGS.html diff --git a/website/Makefile b/website/Makefile new file mode 100644 index 0000000..f43db85 --- /dev/null +++ b/website/Makefile @@ -0,0 +1,13 @@ +# Make the derived forms of documentation for upload + +all: README.html NEWS.html BUGS.html + +clean: + rm -f README.html NEWS.html BUGS.html + +README.html: ../README + asciidoc - <../README >README.html +BUGS.html: ../BUGS + asciidoc - <../BUGS >BUGS.html +NEWS.html: ../NEWS + asciidoc - <../NEWS >NEWS.html diff --git a/website/calc-intercal.el b/website/calc-intercal.el new file mode 100644 index 0000000..c798c3b --- /dev/null +++ b/website/calc-intercal.el @@ -0,0 +1,385 @@ +;;; INTERCAL operators for the GNU Emacs Calculator. +;;; Copyright (C) 1993 Jon Ferro + +;;; This file is not part of GNU, and it's doubtful if they +;;; would even admit to its existence. + +;;; This file is distributed in the hope that it will be useful, +;;; but WITHOUT ANY WARRANTY. No author or distributor +;;; accepts responsibility to anyone for the consequences of using it +;;; or for whether it serves any particular purpose or works at all, +;;; unless he says so in writing. Refer to the GNU Emacs General Public +;;; License for full details. + +;;; Everyone is granted permission to copy, modify and redistribute +;;; this file, but only under the conditions described in the +;;; GNU Emacs General Public License. A copy of this license is +;;; supposed to have been given to you along with GNU Emacs so you +;;; can know your rights and responsibilities. It should be in a +;;; file named COPYING. Among other things, the copyright notice +;;; and this notice must be preserved on all copies. + +;; "YIX" sets the base for future operations, defaults to 2 (72-standard). +;; "YI" is prefix for binary ops $ and ~, and unary ops &, V, @, ?, and ^. +;; See the INTERCAL manual for explanation of these operators. + +;; A prefix argument will cause the following operation to treat its +;; operands as large numbers, for whatever suffices as "large" in the +;; current radix. Otherwise, the "small" version of the operation will be +;; performed if all appropriate operands fit in small variables. Higher +;; order whirls are specified by setting the Hyperbolic flag, in which case +;; the order is the first value from the stack and the operand is second. +;; (E.g., in quinary, say, #3@500 is calculated as a 12-quint value by +;; "500 RET 3 H C-u Y I @". No, I have no clue what that comes out to.) + +(require 'calc-ext) +(require 'calc-macs) +(defun calc-Need-calc-intercal () 'shyeah-right-as-if nil) + +;; Basic key (after the "third-party enhancement" prefix, "Y") +;; for Intercal commands. +(defvar calc-intercal-key "I") + +;; Initial radix for Intercal calculations. +(defvar calc-intercal-radix 2) + +;; Number of digits in a small number, by radix. (Double for large.) +(defconst calc-intercal-sizes-by-radix '(0 0 16 10 8 6 6 5)) +;; Name for a digit in each radix. (Null for the default, 2). +(defconst calc-intercal-names-by-radix + '("" "" "" "Trits " "Quarts " "Quints " "Sexts " "Septs ")) +;; Other counts of the current radix size, set for the default, 2. +(defvar calc-intercal-digits 16) +(defvar calc-intercal-small-size (calc-eval "2^16" 'raw)) +(defvar calc-intercal-large-size (calc-eval "2^32" 'raw)) +;; A further assumption of the default radix being 2 is that +;; calc-intercal-update-radix-display is not called until the +;; radix is actually changed. + + +;;; Package setup + +(define-key calc-mode-map (format "Y%s$" calc-intercal-key) + 'calc-intercal-mingle) +(define-key calc-mode-map (format "Y%s~" calc-intercal-key) + 'calc-intercal-select) +(define-key calc-mode-map (format "Y%s&" calc-intercal-key) + 'calc-intercal-ampersand) +(define-key calc-mode-map (format "Y%sV" calc-intercal-key) + 'calc-intercal-book) +(define-key calc-mode-map (format "Y%s@" calc-intercal-key) + 'calc-intercal-whirl) +(define-key calc-mode-map (format "Y%s?" calc-intercal-key) + 'calc-intercal-what) +(define-key calc-mode-map (format "Y%s^" calc-intercal-key) + 'calc-intercal-shark) +(define-key calc-mode-map (format "Y%sX" calc-intercal-key) + 'calc-intercal-set-radix) + +(setq calc-Y-help-msgs + (append (list (format "Intercal: %s + set-radiX, $ (mingle), ~ (select)" calc-intercal-key) + (format "Intercal: %s + & (and), V (or), @ (but)" calc-intercal-key) + (format "Intercal: %s + ^ (add-w/o-carry), ? (subtract-w/o-borrow)" calc-intercal-key)) + calc-Y-help-msgs)) + + +;;; Wrappers for functions accessible in the calculator. + +;; All of these wrappers are as identical as possible, to minimize fuss, +;; but some of the calcFunc-intercal-* ignore their prefix argument. + +(defun calc-intercal-mingle (n) + (interactive "P") + (calc-wrapper + (calc-enter-result 2 "ick$" + (append '(calcFunc-intercal-mingle) + (calc-top-list-n 2) + (and n (list (prefix-numeric-value n))))))) + +(defun calc-intercal-select (n) + (interactive "P") + (calc-wrapper + (calc-enter-result 2 "ick~" + (append '(calcFunc-intercal-select) + (calc-top-list-n 2) + (and n (list (prefix-numeric-value n))))))) + +(defun calc-intercal-ampersand (n) + (interactive "P") + (calc-wrapper + (calc-enter-result 1 "ick&" + (append '(calcFunc-intercal-ampersand) + (calc-top-list-n 1) + (and n (list (prefix-numeric-value n))))))) + +(defun calc-intercal-book (n) + (interactive "P") + (calc-wrapper + (calc-enter-result 1 "ickV" + (append '(calcFunc-intercal-book) + (calc-top-list-n 1) + (and n (list (prefix-numeric-value n))))))) + +(defun calc-intercal-whirl (n) + (interactive "P") + (calc-wrapper + (let ((hyp (if (calc-is-hyperbolic) 2 1))) + (calc-enter-result hyp "ick@" + (append '(calcFunc-intercal-whirl) + (calc-top-list-n hyp) + (if (calc-is-hyperbolic) nil '(1)) + (and n (list (prefix-numeric-value n)))))))) + +(defun calc-intercal-what (n) + (interactive "P") + (calc-wrapper + (calc-enter-result 1 "ick?" + (append '(calcFunc-intercal-what) + (calc-top-list-n 1) + (and n (list (prefix-numeric-value n))))))) + +(defun calc-intercal-shark (n) + (interactive "P") + (calc-wrapper + (calc-enter-result 1 "ick^" + (append '(calcFunc-intercal-shark) + (calc-top-list-n 1) + (and n (list (prefix-numeric-value n))))))) + +;;; Radix operations + +(defun calc-intercal-set-radix (n) + (interactive "NIntercal calculation radix (2-7): ") + (calc-wrapper + (if (and (>= n 2) (<= n 7)) + (progn + (setq calc-intercal-radix n) + (setq calc-intercal-digits + (nth calc-intercal-radix calc-intercal-sizes-by-radix)) + (setq calc-intercal-small-size + (math-pow calc-intercal-radix calc-intercal-digits)) + (setq calc-intercal-large-size + (math-pow calc-intercal-radix (* 2 calc-intercal-digits))) + (calc-intercal-update-radix-display)) + (setq n calc-intercal-radix)) + (message "Intercal radix is %d." n))) + +(defun calc-intercal-update-radix-display () + (let ((names calc-intercal-names-by-radix) + (end nil)) + ;; Look for one of our modes, and replace if found. + (while (and names (not end)) + (let ((top (member (car names) calc-other-modes))) + (if top + (progn + (rplaca top (nth calc-intercal-radix + calc-intercal-names-by-radix)) + (setq end t)))) + (setq names (cdr names))) + ;; If loop was exited because no radix name was found, add one. + (or end (setq calc-other-modes + (cons (nth calc-intercal-radix + calc-intercal-names-by-radix) + calc-other-modes))))) + +;;; Binary operators + +(defun calcFunc-intercal-mingle (a b &optional n) + ;; Check args. + (or (math-natnump a) + (math-reject-arg a 'natnump)) + (or (math-natnump b) + (math-reject-arg b 'natnump)) + (let ((r (reverse (calc-intercal-mince a))) + (s (reverse (calc-intercal-mince b)))) + ;; Check Intercal variable sizing. + (or (<= (length r) calc-intercal-digits) + (math-reject-arg a calc-intercal-size-err-msg)) + (or (<= (length s) calc-intercal-digits) + (math-reject-arg b calc-intercal-size-err-msg)) + (let ((result nil)) + ;; Alternate digits from each arg, until no more. + (while (or r s) + (setq result (cons (if (null s) 0 (car s)) result)) + (setq s (cdr s)) + (setq result (cons (if (null r) 0 (car r)) result)) + (setq r (cdr r))) + (calc-intercal-liquefy result)))) + +(defun calcFunc-intercal-select (a b &optional n) + ;; Check args. + (or (math-natnump a) + (math-reject-arg a 'natnump)) + (or (math-natnump b) + (math-reject-arg b 'natnump)) + (let ((r (reverse (calc-intercal-mince a))) + (s (reverse (calc-intercal-mince b)))) + ;; Check Intercal variable sizing. + (or (<= (length r) (* 2 calc-intercal-digits)) + (math-reject-arg a calc-intercal-size-err-msg)) + (or (<= (length s) (* 2 calc-intercal-digits)) + (math-reject-arg b calc-intercal-size-err-msg)) + (let ((result nil) + (rt r) + (st s) + (i (- calc-intercal-radix 1))) + ;; Iterate downward through selector bits... + (while (> i 0) + (setq r rt) + (setq s st) + ;; ... selecting and packing down the ones that match each iteration. + (while s + (if (= (car s) i) + (setq result (cons (calc-intercal-make-julienne-fries + (car r) (car s) 0) + result))) + (setq s (cdr s)) + (setq r (cdr r))) + (setq i (1- i))) + (calc-intercal-liquefy result)))) + + +;;; Unary operators + +(defun calcFunc-intercal-whirl (a o &optional n) + ;; Check args. + (or (math-natnump a) + (math-reject-arg a 'natnump)) + ;; Check intercal variable sizing. + ;; Note that O is technically not a second arg, but rather + ;; a specification of the ordinality of the whirl, which makes this + ;; function capable of handling 7 different unary operations. + (or (and (math-fixnatnump o) (<= o (- calc-intercal-radix 1))) + (math-reject-arg o calc-intercal-arg-err-msg)) + (let ((r (calc-intercal-mince a)) + (s nil)) + (or (<= (length r) (* 2 calc-intercal-digits)) + (math-reject-arg a calc-intercal-size-err-msg)) + ;; Prepare args for merging. + (setq r (calc-intercal-whip r n)) + (setq s (calc-intercal-puree r)) + (setq r (nreverse r)) + (setq s (nreverse s)) + (let* ((result nil)) + (while r + (setq result (cons (calc-intercal-make-julienne-fries + (car r) (car s) o) + result)) + (setq r (cdr r)) + (setq s (cdr s))) + (calc-intercal-liquefy result)))) + +(defun calcFunc-intercal-ampersand (a &optional n) + (calcFunc-intercal-whirl a 0 n)) + +(defun calcFunc-intercal-book (a &optional n) + (calcFunc-intercal-whirl a (- calc-intercal-radix 1) n)) + + +;;; More unary operators + +(defun calcFunc-intercal-shark (a &optional n) + ;; Check args. + (or (math-natnump a) + (math-reject-arg a 'natnump)) + ;; Check intercal variable sizing. + (let ((r (calc-intercal-mince a)) + (s nil)) + (or (<= (length r) (* 2 calc-intercal-digits)) + (math-reject-arg a calc-intercal-size-err-msg)) + ;; Prepare args for merging. + (setq r (calc-intercal-whip r n)) + (setq s (calc-intercal-puree r)) + (setq r (nreverse r)) + (setq s (nreverse s)) + (let* ((result nil)) + (while r + (setq result (cons (calcFunc-mod (+ (car s) (car r)) + calc-intercal-radix) + result)) + (setq r (cdr r)) + (setq s (cdr s))) + (calc-intercal-liquefy result)))) + +(defun calcFunc-intercal-what (a &optional n) + ;; Check args. + (or (math-natnump a) + (math-reject-arg a 'natnump)) + ;; Check intercal variable sizing. + (let ((r (calc-intercal-mince a)) + (s nil)) + (or (<= (length r) (* 2 calc-intercal-digits)) + (math-reject-arg a calc-intercal-size-err-msg)) + ;; Prepare args for merging. + (setq r (calc-intercal-whip r n)) + (setq s (calc-intercal-puree r)) + (setq r (nreverse r)) + (setq s (nreverse s)) + (let* ((result nil)) + (while r + (setq result (cons (calcFunc-mod (- (car s) (car r)) + calc-intercal-radix) + result)) + (setq r (cdr r)) + (setq s (cdr s))) + (calc-intercal-liquefy result)))) + +;;; Internals + +;; Just what Intercal needs: more internal operations +;; with gratuitous names! + +(defun calc-intercal-mince (a) + ;; Turn a calculator number into a list of digits in the current radix. + (let ((digits nil)) + (while (not (math-zerop a)) + (let ((val (math-idivmod a calc-intercal-radix))) + (setq digits (cons (cdr val) digits)) + (setq a (car val)))) + digits)) + +(defun calc-intercal-liquefy (l) + ;; Turn a list of digits into a number for the calculator. + (let ((a 0)) + (while l + (setq a (math-add (car l) (math-mul a calc-intercal-radix))) + (setq l (cdr l))) + a)) + +(defun calc-intercal-whip (l d) + ;; "Sign extend" a list of digits by padding out to the appropriate + ;; size with extra zeros. Extend to the small size unless the list + ;; is already too long or the second arg D is non-nil. + (let ((len (length l)) + (goal (nth calc-intercal-radix calc-intercal-sizes-by-radix))) + (if (or d (> len goal)) + (setq goal (* 2 goal))) + (while (< (length l) goal) + (setq l (cons 0 l))) + l)) + +(defun calc-intercal-puree (l) + ;; Rotate the argument one to the right. + (let (result) + (while (cdr l) + (setq result (cons (car l) result)) + (setq l (cdr l))) + (cons (car l) (nreverse result)))) + +(defun calc-intercal-make-julienne-fries (a b m) + ;; Closest to the actual retail price without going over... + (cond ((and (<= a m) (<= b m)) (max a b)) + ((<= a m) a) + ((<= b m) b) + (t (max a b)))) + +;; Still not used: +;; blend fold beat mix stir fluff +;; grate dice shred shave tenderize grind chop slice +;; chew swallow digest ingest masticate gnaw lick donotlick suck + +;; Error messages. +(defconst calc-intercal-size-err-msg + "533 YOU WANT MAYBE WE SHOULD IMPLEMENT 64-BIT VARIABLES?") +(defconst calc-intercal-arg-err-msg + "997 ILLEGAL POSSESSION OF A CONTROLLED UNARY OPERATOR") diff --git a/website/index.html b/website/index.html index 42a8bbe..c746945 100644 --- a/website/index.html +++ b/website/index.html @@ -82,6 +82,10 @@ international community of technomasochists.

Documentation

+

You can browse the README, +NEWS, and BUGS +files from the distribution from here.

+

You can download either a Postscript or flat diff --git a/website/upload b/website/upload new file mode 100755 index 0000000..f973893 --- /dev/null +++ b/website/upload @@ -0,0 +1,29 @@ +#!/bin/sh +# +# Upload C-INTERCAL website contents. +# Please do not introduce bashims into this script. +# +webdir=login.ibiblio.org:/public/html/catb/esr/intercal + +# Ensure all derived HTML and checksums are up to date. +make + +if [ $1 ] +then + for f in $*; do scp $f $webdir/$f; done +else + eligible=`ls *.html *.png` + if [ -e .upload-stamp ] + then + eligible=`find $eligible -newer .upload-stamp` + fi + if [ -z "$eligible" ] + then + echo "Website is up to date." + else + scp $eligible $webdir && touch .upload-stamp + fi +fi + +# End + -- 2.43.0