Skip to content
This repository

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
tree: d340de60d0
Fetching contributors…

Cannot retrieve contributors at this time

file 138 lines (115 sloc) 4.393 kb
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.
Something went wrong with that request. Please try again.