lisp/emulation/crisp.el

   1 ;;; crisp.el --- CRiSP/Brief Emacs emulator
   2
   3 ;; Copyright (C) 1997-1999, 2001-2011  Free Software Foundation, Inc.
   4
   5 ;; Author: Gary D. Foster <Gary.Foster@Corp.Sun.COM>
   6 ;; Keywords: emulations brief crisp
   7
   8 ;; This file is part of GNU Emacs.
   9
  10 ;; GNU Emacs is free software: you can redistribute it and/or modify
  11 ;; it under the terms of the GNU General Public License as published by
  12 ;; the Free Software Foundation, either version 3 of the License, or
  13 ;; (at your option) any later version.
  14
  15 ;; GNU Emacs is distributed in the hope that it will be useful,
  16 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  18 ;; GNU General Public License for more details.
  19
  20 ;; You should have received a copy of the GNU General Public License
  21 ;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
  22
  23 ;;; Commentary:
  24
  25 ;; Keybindings and minor functions to duplicate the functionality and
  26 ;; finger-feel of the CRiSP/Brief editor.  This package is designed to
  27 ;; facilitate transitioning from Brief to (XE|E)macs with a minimum
  28 ;; amount of hassles.
  29
  30 ;; Enable this package by putting (require 'crisp) in your .emacs and
  31 ;; use M-x crisp-mode to toggle it on or off.
  32
  33 ;; This package will automatically load the scroll-all.el package if
  34 ;; you put (setq crisp-load-scroll-all t) in your .emacs before
  35 ;; loading this package.  If this feature is enabled, it will bind
  36 ;; meta-f1 to the scroll-all mode toggle.  The scroll-all package
  37 ;; duplicates the scroll-alling feature in CRiSP.
  38
  39 ;; Also, the default keybindings for brief/CRiSP override the M-x
  40 ;; key to exit the editor.  If you don't like this functionality, you
  41 ;; can prevent this behavior (or redefine it dynamically) by setting
  42 ;; the value of `crisp-override-meta-x' either in your .emacs or
  43 ;; interactively.  The default setting is t, which means that M-x will
  44 ;; by default run `save-buffers-kill-emacs' instead of the command
  45 ;; `execute-extended-command'.
  46
  47 ;; Finally, if you want to change the string displayed in the modeline
  48 ;; when this mode is in effect, override the definition of
  49 ;; `crisp-mode-modeline-string' in your .emacs.  The default value is
  50 ;; " *Crisp*" which may be a bit lengthy if you have a lot of things
  51 ;; being displayed there.
  52
  53 ;; All these overrides should go *before* the (require 'crisp) statement.
  54
  55 ;;; Code:
  56
  57 (eval-when-compile (require 'cl))
  58
  59 ;; local variables
  60
  61 (defgroup crisp nil
  62   "Emulator for CRiSP and Brief key bindings."
  63   :prefix "crisp-"
  64   :group 'emulations)
  65
  66 (defvar crisp-mode-map
  67   (let ((map (make-sparse-keymap)))
  68     (define-key map [(f1)]           'other-window)
  69
  70     (define-key map [(f2) (down)]    'enlarge-window)
  71     (define-key map [(f2) (left)]    'shrink-window-horizontally)
  72     (define-key map [(f2) (right)]   'enlarge-window-horizontally)
  73     (define-key map [(f2) (up)]      'shrink-window)
  74     (define-key map [(f3) (down)]    'split-window-vertically)
  75     (define-key map [(f3) (right)]   'split-window-horizontally)
  76
  77     (define-key map [(f4)]           'delete-window)
  78     (define-key map [(control f4)]   'delete-other-windows)
  79
  80     (define-key map [(f5)]           'search-forward-regexp)
  81     (define-key map [(f19)]          'search-forward-regexp)
  82     (define-key map [(meta f5)]      'search-backward-regexp)
  83
  84     (define-key map [(f6)]           'query-replace)
  85
  86     (define-key map [(f7)]           'start-kbd-macro)
  87     (define-key map [(meta f7)]      'end-kbd-macro)
  88
  89     (define-key map [(f8)]           'call-last-kbd-macro)
  90     (define-key map [(meta f8)]      'save-kbd-macro)
  91
  92     (define-key map [(f9)]           'find-file)
  93     (define-key map [(meta f9)]      'load-library)
  94
  95     (define-key map [(f10)]          'execute-extended-command)
  96     (define-key map [(meta f10)]     'compile)
  97
  98     (define-key map [(SunF37)]       'kill-buffer)
  99     (define-key map [(kp-add)]       'crisp-copy-line)
 100     (define-key map [(kp-subtract)]  'crisp-kill-line)
 101     ;; just to cover all the bases (GNU Emacs, for instance)
 102     (define-key map [(f24)]          'crisp-kill-line)
 103     (define-key map [(insert)]       'crisp-yank-clipboard)
 104     (define-key map [(f16)]          'crisp-set-clipboard) ; copy on Sun5 kbd
 105     (define-key map [(f20)]          'crisp-kill-region) ; cut on Sun5 kbd
 106     (define-key map [(f18)]          'crisp-yank-clipboard) ; paste on Sun5 kbd
 107
 108     (define-key map [(control f)]    'fill-paragraph-or-region)
 109     (define-key map [(meta d)]       (lambda ()
 110                                        (interactive)
 111                                        (beginning-of-line) (kill-line)))
 112     (define-key map [(meta e)]       'find-file)
 113     (define-key map [(meta g)]       'goto-line)
 114     (define-key map [(meta h)]       'help)
 115     (define-key map [(meta i)]       'overwrite-mode)
 116     (define-key map [(meta j)]       'bookmark-jump)
 117     (define-key map [(meta l)]       'crisp-mark-line)
 118     (define-key map [(meta m)]       'set-mark-command)
 119     (define-key map [(meta n)]       'bury-buffer)
 120     (define-key map [(meta p)]       'crisp-unbury-buffer)
 121     (define-key map [(meta u)]       'undo)
 122     (define-key map [(f14)]          'undo)
 123     (define-key map [(meta w)]       'save-buffer)
 124     (define-key map [(meta x)]       'crisp-meta-x-wrapper)
 125     (define-key map [(meta ?0)]      (lambda ()
 126                                        (interactive)
 127                                        (bookmark-set "0")))
 128     (define-key map [(meta ?1)]      (lambda ()
 129                                        (interactive)
 130                                        (bookmark-set "1")))
 131     (define-key map [(meta ?2)]      (lambda ()
 132                                        (interactive)
 133                                        (bookmark-set "2")))
 134     (define-key map [(meta ?3)]      (lambda ()
 135                                        (interactive)
 136                                        (bookmark-set "3")))
 137     (define-key map [(meta ?4)]      (lambda ()
 138                                        (interactive)
 139                                        (bookmark-set "4")))
 140     (define-key map [(meta ?5)]      (lambda ()
 141                                        (interactive)
 142                                        (bookmark-set "5")))
 143     (define-key map [(meta ?6)]      (lambda ()
 144                                        (interactive)
 145                                        (bookmark-set "6")))
 146     (define-key map [(meta ?7)]      (lambda ()
 147                                        (interactive)
 148                                        (bookmark-set "7")))
 149     (define-key map [(meta ?8)]      (lambda ()
 150                                        (interactive)
 151                                        (bookmark-set "8")))
 152     (define-key map [(meta ?9)]      (lambda ()
 153                                        (interactive)
 154                                        (bookmark-set "9")))
 155
 156     (define-key map [(shift delete)]    'kill-word)
 157     (define-key map [(shift backspace)] 'backward-kill-word)
 158     (define-key map [(control left)]    'backward-word)
 159     (define-key map [(control right)]   'forward-word)
 160
 161     (define-key map [(home)]            'crisp-home)
 162     (define-key map [(control home)]    (lambda ()
 163                                           (interactive)
 164                                           (move-to-window-line 0)))
 165     (define-key map [(meta home)]       'beginning-of-line)
 166     (define-key map [(end)]             'crisp-end)
 167     (define-key map [(control end)]     (lambda ()
 168                                           (interactive)
 169                                           (move-to-window-line -1)))
 170     (define-key map [(meta end)]        'end-of-line)
 171     map)
 172   "Local keymap for CRiSP emulation mode.
 173 All the bindings are done here instead of globally to try and be
 174 nice to the world.")
 175
 176 (defcustom crisp-mode-modeline-string " *CRiSP*"
 177   "String to display in the modeline when CRiSP emulation mode is enabled."
 178   :type 'string
 179   :group 'crisp)
 180
 181 ;;;###autoload
 182 (defcustom crisp-mode nil
 183   "Track status of CRiSP emulation mode.
 184 A value of nil means CRiSP mode is not enabled.  A value of t
 185 indicates CRiSP mode is enabled.
 186
 187 Setting this variable directly does not take effect;
 188 use either M-x customize or the function `crisp-mode'."
 189   :set (lambda (symbol value) (crisp-mode (if value 1 0)))
 190   :initialize 'custom-initialize-default
 191   :require 'crisp
 192   :version "20.4"
 193   :type 'boolean
 194   :group 'crisp)
 195
 196 (defcustom crisp-override-meta-x t
 197   "Controls overriding the normal Emacs M-x key binding in the CRiSP emulator.
 198 Normally the CRiSP emulator rebinds M-x to `save-buffers-exit-emacs', and
 199 provides the usual M-x functionality on the F10 key.  If this variable
 200 is non-nil, M-x will exit Emacs."
 201   :type 'boolean
 202   :group 'crisp)
 203
 204 (defcustom crisp-load-scroll-all nil
 205   "Controls loading of the Scroll Lock in the CRiSP emulator.
 206 Its default behavior is to load and enable the Scroll Lock minor mode
 207 package when enabling the CRiSP emulator.
 208
 209 If this variable is nil when you start the CRiSP emulator, it
 210 does not load the scroll-all package."
 211   :type 'boolean
 212   :group 'crisp)
 213
 214 (defcustom crisp-load-hook nil
 215   "Hooks to run after loading the CRiSP emulator package."
 216   :type 'hook
 217   :group 'crisp)
 218
 219 (defcustom crisp-mode-hook nil
 220   "Hook run by the function `crisp-mode'."
 221   :type 'hook
 222   :group 'crisp)
 223
 224 (defconst crisp-version "1.34"
 225   "The version of the CRiSP emulator.")
 226
 227 (defconst crisp-mode-help-address "gfoster@suzieq.ml.org"
 228   "The email address of the CRiSP mode author/maintainer.")
 229
 230 ;; Silence the byte-compiler.
 231 (defvar crisp-last-last-command nil
 232   "The previous value of `last-command'.")
 233
 234 ;; The cut and paste routines are different between XEmacs and Emacs
 235 ;; so we need to set up aliases for the functions.
 236
 237 (defalias 'crisp-set-clipboard
 238   (if (fboundp 'clipboard-kill-ring-save)
 239       'clipboard-kill-ring-save
 240     'copy-primary-selection))
 241
 242 (defalias 'crisp-kill-region
 243   (if (fboundp 'clipboard-kill-region)
 244       'clipboard-kill-region
 245     'kill-primary-selection))
 246
 247 (defalias 'crisp-yank-clipboard
 248   (if (fboundp 'clipboard-yank)
 249       'clipboard-yank
 250     'yank-clipboard-selection))
 251
 252 (defun crisp-region-active ()
 253   "Compatibility function to test for an active region."
 254   (if (featurep 'xemacs)
 255       zmacs-region-active-p
 256     mark-active))
 257
 258 (defun crisp-version (&optional arg)
 259   "Version number of the CRiSP emulator package.
 260 If ARG, insert results at point."
 261   (interactive "P")
 262   (let ((foo (concat "CRiSP version " crisp-version)))
 263     (if arg
 264         (insert (message foo))
 265       (message foo))))
 266
 267 (defun crisp-mark-line (arg)
 268   "Set mark at the end of the line.
 269 Arg works as in `end-of-line'."
 270   (interactive "p")
 271   (let (newmark)
 272     (save-excursion
 273       (end-of-line arg)
 274       (setq newmark (point)))
 275     (push-mark newmark nil t)))
 276
 277 (defun crisp-kill-line (arg)
 278   "Mark and kill line(s).
 279 Marks from point to end of the current line (honoring prefix arguments),
 280 copies the region to the kill ring and clipboard, and then deletes it."
 281   (interactive "*p")
 282   (if (crisp-region-active)
 283       (call-interactively 'crisp-kill-region)
 284     (crisp-mark-line arg)
 285     (call-interactively 'crisp-kill-region)))
 286
 287 (defun crisp-copy-line (arg)
 288   "Mark and copy line(s).
 289 Marks from point to end of the current line (honoring prefix arguments),
 290 copies the region to the kill ring and clipboard, and then deactivates
 291 the region."
 292   (interactive "*p")
 293     (if (crisp-region-active)
 294         (call-interactively 'crisp-set-clipboard)
 295       (crisp-mark-line arg)
 296       (call-interactively 'crisp-set-clipboard))
 297     ;; clear the region after the operation is complete
 298     ;; XEmacs does this automagically, Emacs doesn't.
 299     (if (boundp 'mark-active)
 300         (setq mark-active nil)))
 301
 302 (defun crisp-home ()
 303   "\"Home\" the point, the way CRiSP would do it.
 304 The first use moves point to beginning of the line.  Second
 305 consecutive use moves point to beginning of the screen.  Third
 306 consecutive use moves point to the beginning of the buffer."
 307   (interactive nil)
 308   (cond
 309     ((and (eq last-command 'crisp-home)
 310           (eq crisp-last-last-command 'crisp-home))
 311      (goto-char (point-min)))
 312     ((eq last-command 'crisp-home)
 313      (move-to-window-line 0))
 314     (t
 315      (beginning-of-line)))
 316   (setq crisp-last-last-command last-command))
 317
 318 (defun crisp-end ()
 319   "\"End\" the point, the way CRiSP would do it.
 320 The first use moves point to end of the line.  Second
 321 consecutive use moves point to the end of the screen.  Third
 322 consecutive use moves point to the end of the buffer."
 323   (interactive nil)
 324   (cond
 325     ((and (eq last-command 'crisp-end)
 326           (eq crisp-last-last-command 'crisp-end))
 327      (goto-char (point-max)))
 328     ((eq last-command 'crisp-end)
 329      (move-to-window-line -1)
 330      (end-of-line))
 331     (t
 332      (end-of-line)))
 333   (setq crisp-last-last-command last-command))
 334
 335 (defun crisp-unbury-buffer ()
 336   "Go back one buffer."
 337   (interactive)
 338   (switch-to-buffer (car (last (buffer-list)))))
 339
 340 (defun crisp-meta-x-wrapper ()
 341   "Wrapper function to conditionally override the normal M-x bindings.
 342 When `crisp-override-meta-x' is non-nil, M-x will exit Emacs (the
 343 normal CRiSP binding) and when it is nil M-x will run
 344 `execute-extended-command' (the normal Emacs binding)."
 345   (interactive)
 346   (if crisp-override-meta-x
 347       (save-buffers-kill-emacs)
 348     (call-interactively 'execute-extended-command)))
 349
 350 ;;;###autoload
 351 (define-minor-mode crisp-mode
 352   "Toggle CRiSP/Brief emulation minor mode.
 353 With ARG, turn CRiSP mode on if ARG is positive, off otherwise."
 354   :keymap crisp-mode-map
 355   :lighter crisp-mode-modeline-string
 356   (when crisp-mode
 357     ;; Make menu entries show M-u or f14 in preference to C-x u.
 358     (put 'undo :advertised-binding
 359          (list* [?\M-u] [f14] (get 'undo :advertised-binding)))
 360     ;; Force transient-mark-mode, so that the marking routines work as
 361     ;; expected.  If the user turns off transient mark mode, most
 362     ;; things will still work fine except the crisp-(copy|kill)
 363     ;; functions won't work quite as nicely when regions are marked
 364     ;; differently and could really confuse people.  Caveat emptor.
 365     (if (fboundp 'transient-mark-mode)
 366         (transient-mark-mode t))
 367     (if crisp-load-scroll-all
 368         (require 'scroll-all))
 369     (if (featurep 'scroll-all)
 370         (define-key crisp-mode-map [(meta f1)] 'scroll-all-mode))))
 371
 372 ;; People might use Apropos on `brief'.
 373 ;;;###autoload
 374 (defalias 'brief-mode 'crisp-mode)
 375
 376 ;; Interaction with other packages.
 377 (put 'crisp-home 'CUA 'move)
 378 (put 'crisp-end  'CUA 'move)
 379
 380 (run-hooks 'crisp-load-hook)
 381 (provide 'crisp)
 382
 383 ;;; crisp.el ends here