From 9badea61736f94fa7e823c8b8d43b29e4351663a Mon Sep 17 00:00:00 2001
From: Arthur Gleckler <edu/mit/csail/zurich/arthur>
Date: Tue, 6 Aug 1991 22:04:26 +0000
Subject: [PATCH] Jokes.

---
 v7/src/edwin/modefs.scm |  7 ++++++-
 v7/src/edwin/motcom.scm | 30 ++++++++++++++++++++++++++++--
 2 files changed, 34 insertions(+), 3 deletions(-)

diff --git a/v7/src/edwin/modefs.scm b/v7/src/edwin/modefs.scm
index b0f541d1b..a342e0e08 100644
--- a/v7/src/edwin/modefs.scm
+++ b/v7/src/edwin/modefs.scm
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;;	$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/modefs.scm,v 1.129 1991/08/06 15:37:47 arthur Exp $
+;;;	$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/modefs.scm,v 1.130 1991/08/06 22:04:19 arthur Exp $
 ;;;
 ;;;	Copyright (c) 1985, 1989-91 Massachusetts Institute of Technology
 ;;;
@@ -146,7 +146,12 @@ Like Fundamental mode, but no self-inserting characters.")
 (define-key 'fundamental #\c-^ 'control-prefix)
 (define-key 'fundamental #\c-_ 'undo)
 (define-key 'fundamental #\c-rubout 'backward-delete-char-untabify)
+;;; Jokes
 (define-key 'fundamental #\h-space 'hyper-space)
+(define-key 'fundamental #\s-menu 'super-menu)
+(define-key 'fundamental #\t-$ 'top-dollar)
+(define-key 'fundamental #\t-hat 'top-hat)
+(define-key 'fundamental (make-special-key 'malesymbol 4) 'super-man)
 
 (define-key 'fundamental #\m-space 'just-one-space)
 (define-key 'fundamental #\m-% 'query-replace)
diff --git a/v7/src/edwin/motcom.scm b/v7/src/edwin/motcom.scm
index 35f3146f3..45e894520 100644
--- a/v7/src/edwin/motcom.scm
+++ b/v7/src/edwin/motcom.scm
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;;	$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/motcom.scm,v 1.42 1991/08/06 15:37:33 arthur Exp $
+;;;	$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/motcom.scm,v 1.43 1991/08/06 22:04:26 arthur Exp $
 ;;;
 ;;;	Copyright (c) 1985, 1989-91 Massachusetts Institute of Technology
 ;;;
@@ -170,8 +170,34 @@ Continuation lines are skipped."
 			   column)))
       (set-command-message! temporary-goal-column-tag column))))
 
+;;; Jokes
+
 (define-command hyper-space
   "Engage warp drive."
   ()
   (lambda ()
-    (message "Sorry, but superluminal travel is not available now.")))
\ No newline at end of file
+    (message "Sorry, but superluminal travel is not available now.")))
+
+(define-command top-hat
+  "Deliver tophat joke."
+  ()
+  (lambda ()
+    (message "No party in progress.")))
+
+(define-command super-man
+  "Deliver super man joke."
+  ()
+  (lambda ()
+    (message "It's a bird... It's a plane... No, it's #\S-man!")))
+
+(define-command super-menu
+  "Deliver super menu joke."
+  ()
+  (lambda ()
+    (message "Big Mac, Medium Fries, Small Coke")))
+
+(define-command top-dollar
+  "Deliver top dollar joke."
+  ()
+  (lambda ()
+    (message "Real Estate in Monaco.")))
\ No newline at end of file
-- 
2.25.1