blob: 656388425c1ae4a84e30698dc60734431be806f4 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
|
;;; geek.el --- annoy lusers who think the geek code is wAY ko0l RADIKuL D00D!1
;; Copyright (C) 1995 American Telephone & Telegraph, Inc.
;; Author: Noah Friedman <friedman@prep.ai.mit.edu>
;; Maintainer: friedman@prep.ai.mit.edu
;; Created: 1995-01-07
;; $Id: geek.el,v 1.1 2004/12/16 01:44:34 mwolson Exp $
;; This software is is guaranteed to do nothing useful, except when it
;; does. You may sell it, burn it, use it, modify it, or give it away, at
;; your leisure. You may even require that other people use it. You may
;; also require that people not use it, as you see fit. Government
;; agencies are encouraged to integrate this software into weapons control
;; systems and other instruments of destruction.
;;; Commentary:
;;; Code:
(defvar geek-header "X-Geek-Code")
(defvar geek-suffix-single-chars ["?" "@" "$" "!" "*"])
(defvar geek-suffix-long-chars [?+ ?- ?+ ?- ?+ ?- ?+ ?- ?+ ?- ?+ ?- ?'])
(defvar geek-infix-chars [">" ":"])
(defvar geek-letters
["A" "B" "C" "D" "E" "F" "G" "H" "I" "J" "K" "L" "M" "N" "O" "P" "Q" "R"
"S" "T" "U" "V" "W" "X" "Y" "Z"
"a" "b" "c" "d" "e" "f" "g" "h" "i" "j" "k" "l" "m" "n" "o" "p" "q" "r"
"s" "t" "u" "v" "w" "x" "y" "z"
"0" "1" "2" "3" "4" "5" "6" "7" "8" "9"])
(if (string-lessp emacs-version "19")
(defun geek-random (&optional n)
(if (numberp n)
(abs (% (random) n))
(random n)))
(defalias 'geek-random 'random))
(defun geek-item (v)
(aref v (geek-random (length v))))
(defun geek-code ()
(let ((ncodes (+ 10 (geek-random 40)))
(codes "")
(nflavors (+ 4 (geek-random 8)))
(flavors "")
letter
len len1
char char1
tem
i
(vmajor (int-to-string (1+ (geek-random 8))))
(vminor (int-to-string (geek-random 100))))
(setq i nflavors)
(while (not (zerop i))
(setq flavors (concat flavors "/"))
(setq len (1+ (geek-random 2)))
(while (not (zerop len))
(setq tem (geek-item geek-letters))
(setq flavors (concat flavors tem))
(setq len (1- len)))
(setq i (1- i)))
(aset flavors 0 ?G)
(setq i ncodes)
(while (not (zerop i))
(setq letter (geek-item geek-letters))
(and (zerop (geek-random 10))
(setq letter (concat letter (geek-item geek-letters))))
(setq len (geek-random 5))
(setq char (geek-item geek-suffix-long-chars))
(setq letter (concat letter (make-string len char)))
(cond
((zerop len))
((= char ?'))
((zerop (geek-random 5))
(setq char1 (geek-item geek-infix-chars))
(setq letter (concat letter char1))
(setq len1 (1+ (geek-random 4)))
(setq char1 char)
(while (= char char1)
(setq char1 (geek-item geek-suffix-long-chars)))
(setq letter (concat letter (make-string len1 char1)))))
(cond
((zerop len)
(and (zerop (geek-random 3))
(setq letter (concat letter
(geek-item geek-suffix-single-chars)))))
((zerop (geek-random 5))
(setq len1 (1+ (geek-random 2)))
(setq letter (concat letter "(" (make-string len1 ?*) ")"))))
(setq codes (concat codes " " letter))
(setq i (1- i)))
(setq codes (concat "(V" vmajor "." vminor ") "
flavors codes))
codes))
(defun geek-replace-header (s)
(save-excursion
(cond
((mail-position-on-field geek-header 'soft)
(let* ((data (match-data))
(end (point))
(beg (progn
(re-search-backward (concat geek-header ": "))
(match-end 0)))
(orig (buffer-substring beg end))
;; avoid creating any permanent undo boundaries
(buffer-undo-list nil))
(store-match-data (match-data))
(delete-region beg end)
(goto-char beg)
(insert s)
orig)))))
(defun geek-subvert-header ()
(let ((s (geek-replace-header (geek-code))))
(add-hook 'mail-send-actions (list 'geek-restore-header s) 'append)))
(defun geek-restore-header (s)
(and s (geek-replace-header s)))
;; mib is an extra special twit.
(cond
((and (string= (user-login-name) "mib")
(fboundp 'add-hook))
(add-hook 'mail-send-hook 'geek-subvert-header 'append)))
(provide 'geek)
;;; geek.el ends here.
|
