lisp/emulation/edt.el

   1 ;;; edt.el --- EDT emulation in Emacs
   2
   3 ;; Copyright (C) 1986 Free Software Foundation, Inc.
   4
   5 ;; Author: Mike Clarkson <mike@yetti.UUCP>
   6 ;; Maintainer: FSF
   7 ;; Created: 27 Aug 1986
   8 ;; Keywords: emulations
   9
  10 ;;  This started from public domain code by Mike Clarkson
  11 ;;  but has been greatly altered.
  12
  13 ;; This file is part of GNU Emacs.
  14
  15 ;; GNU Emacs is free software; you can redistribute it and/or modify
  16 ;; it under the terms of the GNU General Public License as published by
  17 ;; the Free Software Foundation; either version 2, or (at your option)
  18 ;; any later version.
  19
  20 ;; GNU Emacs is distributed in the hope that it will be useful,
  21 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  22 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  23 ;; GNU General Public License for more details.
  24
  25 ;; You should have received a copy of the GNU General Public License
  26 ;; along with GNU Emacs; see the file COPYING.  If not, write to
  27 ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
  28
  29 ;;; Commentary:
  30
  31 ;; Here's my EDT emulation for GNU Emacs that is based on the EDT emulation
  32 ;; for Gosling's Emacs sent out on the net a couple of years ago by Lynn Olson
  33 ;; at Tektronics.  This emulation was widely distributed as the file edt.ml
  34 ;; in the maclib directory of most Emacs distributions.
  35 ;;
  36 ;; I will gladly take all criticisms and complaints to heart, and will fix what
  37 ;; bugs I can find.  As this is my first Emacs Lisp hack, you may have to root
  38 ;; out a few nasties hidden in the code.  Please let me know if you find any
  39 ;; (sorry, no rewards :-).  I would also be interested if there are better,
  40 ;; cleaner, faster ways of doing some of the things that I have done.
  41 ;;
  42 ;; You must understand some design considerations that I had in mind.
  43 ;; The intention was not really to "emulate" EDT, but rather to take advantage
  44 ;; of the years of EDT experience that had accumulated in my right hand,
  45 ;; while at the same time taking advantage of EMACS.
  46 ;;
  47 ;; Some major differences are:
  48 ;;
  49 ;; HELP            is describe-key;
  50 ;; GOLD/HELP       is describe-function;
  51 ;; FIND            is isearch-forward/backward;
  52 ;; GOLD/HELP       is occur-menu, which finds all instances of a search string;
  53 ;; ENTER           is other-window;
  54 ;; SUBS            is subprocess-command.  Note that you have to change this
  55 ;;                 to `shell' if you are running Un*x;
  56 ;; PAGE            is next-paragraph, because that's more useful than page.
  57 ;; SPECINS         is copy-to-killring;
  58 ;; GOLD/GOLD       is mark-section-wisely, which is my command to mark the
  59 ;;                 section in a manner consistent with the major-mode.  It
  60 ;;                 uses mark-defun for emacs-lisp, lisp, mark-c-function for C,
  61 ;;                 and mark-paragraph for other modes.
  62 ;;
  63 ;;
  64 ;; Some subtle differences are:
  65 ;;
  66 ;; APPEND          is append-to-buffer.  One doesn't append to the kill ring
  67 ;;                 much and SPECINS is now copy-to-killring;
  68 ;; REPLACE         is replace-regexp;
  69 ;; FILL            is fill-region-wisely, which uses indent-region for C, lisp
  70 ;;                 emacs-lisp, and fill-region for others. It asks if you
  71 ;;                 really want to fill-region in TeX-mode, because I find this
  72 ;;                 to be very dangerous.
  73 ;; CHNGCASE        is case-flip for the character under the cursor only.
  74 ;;                 I felt that case-flip region is unlikely, as usually you
  75 ;;                 upcase-region or downcase region.  Also, unlike EDT it
  76 ;;                 is independent of the direction you are going, as that
  77 ;;                 drives me nuts.
  78 ;;
  79 ;; I use Emacs definition of what a word is.  This is considerably different
  80 ;; from what EDT thinks a word is.  This is not good for dyed-in-the-wool EDT
  81 ;; fans, but is probably preferable for experienced Emacs users.  My assumption
  82 ;; is that the former are a dying breed now that GNU Emacs has made it to VMS,
  83 ;; but let me know how you feel.  Also, when you undelete a word it leave the
  84 ;; point at the end of the undeleted text, rather than the beginning.  I might
  85 ;; change this as I'm not sure if I like this or not. I'm also not sure if I
  86 ;; want it to set the mark each time you delete a character or word.
  87 ;;
  88 ;; Backspace does not invoke beginning-of-line, because ^H is the help prefix,
  89 ;; and I felt it should be left as such.  You can change this if you like.
  90 ;;
  91 ;; The ADVANCE and BACKUP keys do not work as terminators for forward or
  92 ;; backward searches. In Emacs, all search strings are terminated by return.
  93 ;; The searches will however go forward or backward depending on your current
  94 ;; direction.  Also, when you change directions, the mode line will not be
  95 ;; updated immediately, but only when you next execute an emacs function.
  96 ;; Personally, I consider this to be a bug, not a feature.
  97 ;;
  98 ;; This should also work with VT-2xx's, though I haven't tested it extensively
  99 ;; on those terminals.  It assumes that the CSI-map of vt_200.el has been
 100 ;; defined.
 101 ;;
 102 ;; There are also a whole bunch of GOLD letter, and GOLD character bindings:
 103 ;; look at edtdoc.el for them, or better still, look at the edt.el lisp code,
 104 ;; because after all, in the true Lisp tradition, the source code is *assumed*
 105 ;; to be self-documenting :-)
 106 ;;
 107 ;; Mike Clarkson,            ...!allegra \             BITNET:  mike@YUYETTI or
 108 ;; CRESS, York University,   ...!decvax   \                 SYMALG@YUSOL
 109 ;; 4700 Keele Street,        ...!ihnp4     > !utzoo!yetti!mike
 110 ;; North York, Ontario,      ...!linus    /
 111 ;; CANADA M3J 1P3.           ...!watmath /      Phone: +1 (416) 736-2100 x 7767
 112 ;;
 113 ;; Note that I am not on ARPA, and must gateway any ARPA mail through BITNET or
 114 ;; UUCP.  If you have a UUCP or BITNET address please use it for communication
 115 ;; so that I can reach you directly.  If you have both, the BITNET address
 116 ;; is preferred.
 117
 118 ;;; Code:
 119
 120 (defvar edt-last-deleted-lines ""
 121   "Last text deleted by an EDT emulation `line-delete' command.")
 122 (defvar edt-last-deleted-words ""
 123   "Last text deleted by an EDT emulation `word-delete' command.")
 124 (defvar edt-last-deleted-chars ""
 125   "Last text deleted by an EDT emulation `character-delete' command.")
 126
 127 (defun delete-current-line (num)
 128   "Delete one or specified number of lines after point.
 129 This includes the newline character at the end of each line.
 130 They are saved for the EDT `undelete-lines' command."
 131   (interactive "p")
 132   (let ((beg (point)))
 133     (forward-line num)
 134     (if (not (eq (preceding-char) ?\n))
 135         (insert "\n"))
 136     (setq edt-last-deleted-lines
 137           (buffer-substring beg (point)))
 138     (delete-region beg (point))))
 139
 140 (defun delete-to-eol (num)
 141   "Delete text up to end of line.
 142 With argument, delete up to to Nth line-end past point.
 143 They are saved for the EDT `undelete-lines' command."
 144   (interactive "p")
 145   (let ((beg (point)))
 146     (forward-char 1)
 147     (end-of-line num)
 148     (setq edt-last-deleted-lines
 149           (buffer-substring beg (point)))
 150     (delete-region beg (point))))
 151
 152 (defun delete-current-word (num)
 153   "Delete one or specified number of words after point.
 154 They are saved for the EDT `undelete-words' command."
 155   (interactive "p")
 156   (let ((beg (point)))
 157     (forward-word num)
 158     (setq edt-last-deleted-words
 159           (buffer-substring beg (point)))
 160     (delete-region beg (point))))
 161
 162 (defun edt-delete-previous-word (num)
 163   "Delete one or specified number of words before point.
 164 They are saved for the EDT `undelete-words' command."
 165   (interactive "p")
 166   (let ((beg (point)))
 167     (forward-word (- num))
 168     (setq edt-last-deleted-words
 169           (buffer-substring (point) beg))
 170     (delete-region beg (point))))
 171
 172 (defun delete-current-char (num)
 173   "Delete one or specified number of characters after point.
 174 They are saved for the EDT `undelete-chars' command."
 175   (interactive "p")
 176   (setq edt-last-deleted-chars
 177         (buffer-substring (point) (min (point-max) (+ (point) num))))
 178   (delete-region (point) (min (point-max) (+ (point) num))))
 179
 180 (defun delete-previous-char (num)
 181   "Delete one or specified number of characters before point.
 182 They are saved for the EDT `undelete-chars' command."
 183   (interactive "p")
 184   (setq edt-last-deleted-chars
 185         (buffer-substring (max (point-min) (- (point) num)) (point)))
 186   (delete-region (max (point-min) (- (point) num)) (point)))
 187
 188 (defun undelete-lines ()
 189   "Yank lines deleted by last EDT `line-delete' command."
 190   (interactive)
 191   (insert edt-last-deleted-lines))
 192
 193 (defun undelete-words ()
 194   "Yank words deleted by last EDT `word-delete' command."
 195   (interactive)
 196   (insert edt-last-deleted-words))
 197
 198 (defun undelete-chars ()
 199   "Yank characters deleted by last EDT `character-delete' command."
 200   (interactive)
 201   (insert edt-last-deleted-chars))
 202
 203 (defun next-end-of-line (num)
 204   "Move to end of line; if at end, move to end of next line.
 205 Accepts a prefix argument for the number of lines to move."
 206   (interactive "p")
 207   (forward-char)
 208   (end-of-line num))
 209
 210 (defun previous-end-of-line (num)
 211   "Move EOL upward.
 212 Accepts a prefix argument for the number of lines to move."
 213   (interactive "p")
 214   (end-of-line (- 1 num)))
 215
 216 (defun forward-to-word (num)
 217   "Move to next word-beginning, or to Nth following word-beginning."
 218   (interactive "p")
 219   (forward-word (1+ num))
 220   (forward-word -1))
 221
 222 (defun backward-to-word (num)
 223   "Move back to word-end, or to Nth word-end seen."
 224   (interactive "p")
 225   (forward-word (- (1+ num)))
 226   (forward-word 1))
 227
 228 (defun backward-line (num)
 229   "Move point to start of previous line.
 230 Prefix argument serves as repeat-count."
 231   (interactive "p")
 232   (forward-line (- num)))
 233
 234 (defun scroll-window-down (num)
 235   "Scroll the display down a window-full.
 236 Accepts a prefix argument for the number of window-fulls to scroll."
 237   (interactive "p")
 238   (scroll-down (- (* (window-height) num) 2)))
 239
 240 (defun scroll-window-up (num)
 241   "Scroll the display up a window-full.
 242 Accepts a prefix argument for the number of window-fulls to scroll."
 243   (interactive "p")
 244   (scroll-up (- (* (window-height) num) 2)))
 245
 246 (defun next-paragraph (num)
 247   "Move to beginning of the next indented paragraph.
 248 Accepts a prefix argument for the number of paragraphs."
 249   (interactive "p")
 250   (while (> num 0)
 251     (next-line 1)
 252     (forward-paragraph)
 253     (previous-line 1)
 254     (if (eolp) (next-line 1))
 255     (setq num (1- num))))
 256
 257 (defun previous-paragraph (num)
 258   "Move to beginning of previous indented paragraph.
 259 Accepts a prefix argument for the number of paragraphs."
 260   (interactive "p")
 261   (while (> num 0)
 262     (backward-paragraph)
 263     (previous-line 1)
 264     (if (eolp) (next-line 1))
 265     (setq num (1- num))))
 266
 267 (defun move-to-beginning ()
 268   "Move cursor to the beginning of buffer, but don't set the mark."
 269   (interactive)
 270   (goto-char (point-min)))
 271
 272 (defun move-to-end ()
 273   "Move cursor to the end of buffer, but don't set the mark."
 274   (interactive)
 275   (goto-char (point-max)))
 276
 277 (defun goto-percent (perc)
 278   "Move point to ARG percentage of the buffer."
 279   (interactive "NGoto-percentage: ")
 280   (if (or (> perc 100) (< perc 0))
 281       (error "Percentage %d out of range 0 < percent < 100" perc)
 282     (goto-char (/ (* (point-max) perc) 100))))
 283
 284 (defun update-mode-line ()
 285   "Ensure mode-line reflects all changes."
 286   (set-buffer-modified-p (buffer-modified-p))
 287   (sit-for 0))
 288
 289 (defun advance-direction ()
 290   "Set EDT Advance mode so keypad commands move forward."
 291   (interactive)
 292   (setq edt-direction-string " ADVANCE")
 293   (global-set-key [kp-f3] 'isearch-forward)
 294   (global-set-key [kp-8] 'scroll-window-up)
 295   (global-set-key [kp-7] 'next-paragraph)
 296   (global-set-key [kp-1] 'forward-to-word)
 297   (global-set-key [kp-2] 'next-end-of-line)
 298   (global-set-key [kp-3] 'forward-char)
 299   (global-set-key [kp-0] 'forward-line)
 300   (update-mode-line))
 301
 302 (defun backup-direction ()
 303   "Set EDT Backup mode so keypad commands move backward."
 304   (interactive)
 305   (setq edt-direction-string " BACKUP")
 306   (global-set-key [kp-f3] 'isearch-backward)
 307   (global-set-key [kp-8] 'scroll-window-down)
 308   (global-set-key [kp-7] 'previous-paragraph)
 309   (global-set-key [kp-1] 'backward-to-word)
 310   (global-set-key [kp-2] 'previous-end-of-line)
 311   (global-set-key [kp-3] 'backward-char)
 312   (global-set-key [kp-9] 'backward-line)
 313   (update-mode-line))
 314
 315 (defun edt-beginning-of-window ()
 316   "Home cursor to top of window."
 317   (interactive)
 318   (move-to-window-line 0))
 319
 320 (defun edt-line-to-bottom-of-window ()
 321   "Move the current line to the top of the window."
 322   (interactive)
 323   (recenter -1))
 324
 325 (defun edt-line-to-top-of-window ()
 326   "Move the current line to the top of the window."
 327   (interactive)
 328   (recenter 0))
 329
 330 (defun case-flip-character (num)
 331   "Change the case of the character under the cursor.
 332 Accepts a prefix argument of the number of characters to invert."
 333   (interactive "p")
 334   (while (> num 0)
 335     (funcall (if (let ((ch (following-char)))
 336                    (= ch (downcase ch)))
 337                  'upcase-region 'downcase-region)
 338              (point) (1+ (point)))
 339     (forward-char 1)
 340     (setq num (1- num))))
 341
 342 (defun indent-or-fill-region ()
 343   "Fill region in text modes, indent region in programming language modes."
 344   (interactive)
 345   (if (string= paragraph-start "^$\\|^\f")
 346       (indent-region (point) (mark) nil)
 347     (fill-region (point) (mark))))
 348
 349 (defun mark-section-wisely ()
 350   "Mark the section in a manner consistent with the major-mode.
 351 Uses mark-defun for emacs-lisp, lisp,
 352 mark-c-function for C,
 353 and mark-paragraph for other modes."
 354   (interactive)
 355   (cond  ((eq major-mode 'emacs-lisp-mode)
 356           (mark-defun))
 357          ((eq major-mode 'lisp-mode)
 358           (mark-defun))
 359          ((eq major-mode 'c-mode)
 360           (mark-c-function))
 361          (t (mark-paragraph))))
 362
 363 ;;; Key Bindings
 364 ;;;###autoload
 365 (defun edt-emulation-on ()
 366   "Emulate DEC's EDT editor.
 367 Note that many keys are rebound; including nearly all keypad keys.
 368 Use \\[edt-emulation-off] to undo all rebindings except the keypad keys."
 369   (interactive)
 370   (advance-direction)
 371   (edt-bind-gold-keypad)
 372   (setq edt-mode-old-c-\\ (lookup-key global-map "\C-\\"))
 373   (global-set-key "\C-\\" 'quoted-insert)
 374   (setq edt-mode-old-delete (lookup-key global-map "\177"))
 375   (global-set-key "\177" 'delete-previous-char)      ;"Delete"
 376   (setq edt-mode-old-lisp-delete (lookup-key emacs-lisp-mode-map "\177"))
 377   (define-key emacs-lisp-mode-map "\177" 'delete-previous-char) ;"Delete"
 378   (define-key lisp-mode-map "\177" 'delete-previous-char) ;"Delete"
 379   (setq edt-mode-old-linefeed (lookup-key global-map "\C-j"))
 380   (global-set-key "\C-j" 'edt-delete-previous-word)           ;"LineFeed"
 381   (define-key esc-map "?" 'apropos))                      ;"<ESC>?"
 382
 383 (defun edt-emulation-off ()
 384   "Return from EDT emulation to normal Emacs key bindings.
 385 The keys redefined by \\[edt-emulation-on] are given their old definitions."
 386   (interactive)
 387   (setq edt-direction-string nil)
 388   (global-set-key "\C-\\" edt-mode-old-c-\\)
 389   (global-set-key "\177" edt-mode-old-delete)           ;"Delete"
 390   (define-key emacs-lisp-mode-map "\177" edt-mode-old-lisp-delete) ;"Delete"
 391   (define-key lisp-mode-map "\177" edt-mode-old-lisp-delete) ;"Delete"
 392   (global-set-key "\C-j" edt-mode-old-linefeed))           ;"LineFeed"
 393
 394 (defvar GOLD-map (make-keymap)
 395    "`GOLD-map' maps the function keys on the VT100 keyboard preceded
 396 by the PF1 key.  GOLD is the ASCII the 7-bit escape sequence <ESC>OP.")
 397
 398 (defalias 'GOLD-prefix GOLD-map)
 399
 400 (global-set-key [home] 'edt-beginning-of-window)
 401 (global-set-key [kp-f2] 'describe-key)
 402 (global-set-key [kp-f4] 'delete-current-line)
 403 (global-set-key [kp-9] 'append-to-buffer)
 404 (global-set-key [kp-subtract] 'delete-current-word)
 405 (global-set-key [kp-4] 'advance-direction)
 406 (global-set-key [kp-5] 'backup-direction)
 407 (global-set-key [kp-6] 'kill-region)
 408 (global-set-key [kp-separator] 'delete-current-char)
 409 (global-set-key [kp-decimal] 'set-mark-command)
 410 (global-set-key [kp-enter] 'other-window)
 411 (global-set-key [kp-f1] 'GOLD-prefix)
 412
 413 ;;Bind GOLD/Keyboard keys
 414
 415 (define-key GOLD-map "\C-g"  'keyboard-quit)            ; just for safety
 416 (define-key GOLD-map "\177" 'delete-window)             ;"Delete"
 417 (define-key GOLD-map "\C-h" 'delete-other-windows)      ;"BackSpace"
 418 (define-key GOLD-map "\C-m" 'newline-and-indent)        ;"Return"
 419 (define-key GOLD-map " " 'undo)                         ;"Spacebar"
 420 (define-key GOLD-map "%" 'goto-percent)                 ; "%"
 421 (define-key GOLD-map "=" 'goto-line)                    ; "="
 422 (define-key GOLD-map "`" 'what-line)                    ; "`"
 423 (define-key GOLD-map "\C-\\" 'split-window-vertically)  ; "Control-\"
 424
 425 ; GOLD letter combinations:
 426 (define-key GOLD-map "b" 'buffer-menu)                  ; "b"
 427 (define-key GOLD-map "B" 'buffer-menu)                  ; "B"
 428 (define-key GOLD-map "d" 'delete-window)                ; "d"
 429 (define-key GOLD-map "D" 'delete-window)                ; "D"
 430 (define-key GOLD-map "e" 'compile)                      ; "e"
 431 (define-key GOLD-map "E" 'compile)                      ; "E"
 432 (define-key GOLD-map "i" 'insert-file)                  ; "i"
 433 (define-key GOLD-map "I" 'insert-file)                  ; "I"
 434 (define-key GOLD-map "l" 'goto-line)                    ; "l"
 435 (define-key GOLD-map "L" 'goto-line)                    ; "L"
 436 (define-key GOLD-map "m" 'save-some-buffers)            ; "m"
 437 (define-key GOLD-map "M" 'save-some-buffers)            ; "m"
 438 (define-key GOLD-map "n" 'next-error)                           ; "n"
 439 (define-key GOLD-map "N" 'next-error)                           ; "N"
 440 (define-key GOLD-map "o" 'switch-to-buffer-other-window)        ; "o"
 441 (define-key GOLD-map "O" 'switch-to-buffer-other-window)        ; "O"
 442 (define-key GOLD-map "r" 'revert-file)                          ; "r"
 443 (define-key GOLD-map "r" 'revert-file)                          ; "R"
 444 (define-key GOLD-map "s" 'save-buffer)                          ; "s"
 445 (define-key GOLD-map "S" 'save-buffer)                          ; "S"
 446 (define-key GOLD-map "v" 'find-file-other-window)               ; "v"
 447 (define-key GOLD-map "V" 'find-file-other-window)               ; "V"
 448 (define-key GOLD-map "w" 'write-file)                           ; "w"
 449 (define-key GOLD-map "w" 'write-file)                           ; "W"
 450 ;(define-key GOLD-map "z" 'shrink-window)                 ; "z"
 451 ;(define-key GOLD-map "Z" 'shrink-window)                 ; "z"
 452
 453 ;Bind GOLD/Keypad keys
 454 (defun edt-bind-gold-keypad ()
 455   (define-key GOLD-map [up] 'edt-line-to-top-of-window)
 456   (define-key GOLD-map [down] 'edt-line-to-bottom-of-window)
 457   (define-key GOLD-map [left] 'backward-sentence)
 458   (define-key GOLD-map [right] 'forward-sentence)
 459   (define-key GOLD-map [kp-f1] 'mark-section-wisely)
 460   (define-key GOLD-map [kp-f2] 'describe-function)
 461   (define-key GOLD-map [kp-f3] 'occur)
 462   (define-key GOLD-map [kp-f4] 'undelete-lines)
 463   (define-key GOLD-map [kp-0] 'open-line)
 464   (define-key GOLD-map [kp-1] 'case-flip-character)
 465   (define-key GOLD-map [kp-2] 'delete-to-eol)
 466   (define-key GOLD-map [kp-3] 'copy-region-as-kill)
 467   (define-key GOLD-map [kp-4] 'move-to-end)
 468   (define-key GOLD-map [kp-5] 'move-to-beginning)
 469   (define-key GOLD-map [kp-6] 'yank)
 470   (define-key GOLD-map [kp-7] 'execute-extended-command)
 471   (define-key GOLD-map [kp-8] 'indent-or-fill-region)
 472   (define-key GOLD-map [kp-9] 'replace-regexp)
 473   (define-key GOLD-map [kp-subtract] 'undelete-words)
 474   (define-key GOLD-map [kp-separator] 'undelete-chars)
 475   (define-key GOLD-map [kp-decimal] 'redraw-display)
 476   (define-key GOLD-map [kp-enter] 'shell-command))
 477
 478 ;; Make direction of motion show in mode line
 479 ;; while EDT emulation is turned on.
 480 ;; Note that the keypad is always turned on when in Emacs.
 481
 482 (or (assq 'edt-direction-string minor-mode-alist)
 483     (setq minor-mode-alist (cons '(edt-direction-string edt-direction-string)
 484                                  minor-mode-alist)))
 485
 486 ;;; edt.el ends here