lisp/play/studly.el

   1 ;;; studly.el --- StudlyCaps (tm)(r)(c)(xxx)
   2
   3 ;;; This is in the public domain, since it was distributed
   4 ;;; by its author in 1986 without a copyright notice.
   5
   6 ;; This file is part of GNU Emacs.
   7
   8 ;; Maintainer: emacs-devel@gnu.org
   9 ;; Keywords: games
  10
  11 ;;; Commentary:
  12
  13 ;; Functions to studlycapsify a region, word, or buffer.  Possibly the
  14 ;; esoteric significance of studlycapsification escapes you; that is,
  15 ;; you suffer from autostudlycapsifibogotification.  Too bad.
  16
  17 ;;; Code:
  18
  19 ;;;###autoload
  20 (defun studlify-region (begin end)
  21   "Studlify-case the region."
  22   (interactive "*r")
  23   (save-excursion
  24     (goto-char begin)
  25     (setq begin (point))
  26     (while (and (<= (point) end)
  27                 (not (looking-at "\\W*\\'")))
  28       (forward-word-strictly 1)
  29       (backward-word-strictly 1)
  30       (setq begin (max (point) begin))
  31       (forward-word-strictly 1)
  32       (let ((offset 0)
  33             (word-end (min (point) end))
  34             c)
  35         (goto-char begin)
  36         (while (< (point) word-end)
  37           (setq offset (+ offset (following-char)))
  38           (forward-char 1))
  39         (setq offset (+ offset (following-char)))
  40         (goto-char begin)
  41         (while (< (point) word-end)
  42           (setq c (following-char))
  43           (if (and (= (% (+ c offset) 4) 2)
  44                    (let ((ch (following-char)))
  45                      (or (and (>= ch ?a) (<= ch ?z))
  46                          (and (>= ch ?A) (<= ch ?Z)))))
  47               (progn
  48                 (delete-char 1)
  49                 (insert (logxor c ? ))))
  50           (forward-char 1))
  51         (setq begin (point))))))
  52
  53 ;;;###autoload
  54 (defun studlify-word (count)
  55   "Studlify-case the current word, or COUNT words if given an argument."
  56   (interactive "*p")
  57   (let ((begin (point)) end rb re)
  58     (forward-word-strictly count)
  59     (setq end (point))
  60     (setq rb (min begin end) re (max begin end))
  61     (studlify-region rb re)))
  62
  63 ;;;###autoload
  64 (defun studlify-buffer ()
  65   "Studlify-case the current buffer."
  66   (interactive "*")
  67   (studlify-region (point-min) (point-max)))
  68
  69 (provide 'studly)
  70
  71 ;;; studly.el ends here