lisp/obsolete/crisp.el

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