lisp/emulation/edt.el

   1 ;;; edt.el --- EDT emulation in Emacs
   2
   3 ;; Copyright (C) 1986 Free Software Foundation, Inc.
   4 ;;  It started from public domain code by Mike Clarkson
   5 ;;  but has been greatly altered.
   6
   7 ;; This file is part of GNU Emacs.
   8
   9 ;; GNU Emacs is free software; you can redistribute it and/or modify
  10 ;; it under the terms of the GNU General Public License as published by
  11 ;; the Free Software Foundation; either version 1, or (at your option)
  12 ;; any later version.
  13
  14 ;; GNU Emacs is distributed in the hope that it will be useful,
  15 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  16 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  17 ;; GNU General Public License for more details.
  18
  19 ;; You should have received a copy of the GNU General Public License
  20 ;; along with GNU Emacs; see the file COPYING.  If not, write to
  21 ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
  22
  23 (require 'keypad)
  24
  25 (defvar edt-last-deleted-lines ""
  26   "Last text deleted by an EDT emulation `line-delete' command.")
  27 (defvar edt-last-deleted-words ""
  28   "Last text deleted by an EDT emulation `word-delete' command.")
  29 (defvar edt-last-deleted-chars ""
  30   "Last text deleted by an EDT emulation `character-delete' command.")
  31
  32 (defun delete-current-line (num)
  33   "Delete one or specified number of lines after point.
  34 This includes the newline character at the end of each line.
  35 They are saved for the EDT `undelete-lines' command."
  36   (interactive "p")
  37   (let ((beg (point)))
  38     (forward-line num)
  39     (if (not (eq (preceding-char) ?\n))
  40         (insert "\n"))
  41     (setq edt-last-deleted-lines
  42           (buffer-substring beg (point)))
  43     (delete-region beg (point))))
  44
  45 (defun delete-to-eol (num)
  46   "Delete text up to end of line.
  47 With argument, delete up to to Nth line-end past point.
  48 They are saved for the EDT `undelete-lines' command."
  49   (interactive "p")
  50   (let ((beg (point)))
  51     (forward-char 1)
  52     (end-of-line num)
  53     (setq edt-last-deleted-lines
  54           (buffer-substring beg (point)))
  55     (delete-region beg (point))))
  56
  57 (defun delete-current-word (num)
  58   "Delete one or specified number of words after point.
  59 They are saved for the EDT `undelete-words' command."
  60   (interactive "p")
  61   (let ((beg (point)))
  62     (forward-word num)
  63     (setq edt-last-deleted-words
  64           (buffer-substring beg (point)))
  65     (delete-region beg (point))))
  66
  67 (defun edt-delete-previous-word (num)
  68   "Delete one or specified number of words before point.
  69 They are saved for the EDT `undelete-words' command."
  70   (interactive "p")
  71   (let ((beg (point)))
  72     (forward-word (- num))
  73     (setq edt-last-deleted-words
  74           (buffer-substring (point) beg))
  75     (delete-region beg (point))))
  76
  77 (defun delete-current-char (num)
  78   "Delete one or specified number of characters after point.
  79 They are saved for the EDT `undelete-chars' command."
  80   (interactive "p")
  81   (setq edt-last-deleted-chars
  82         (buffer-substring (point) (min (point-max) (+ (point) num))))
  83   (delete-region (point) (min (point-max) (+ (point) num))))
  84
  85 (defun delete-previous-char (num)
  86   "Delete one or specified number of characters before point.
  87 They are saved for the EDT `undelete-chars' command."
  88   (interactive "p")
  89   (setq edt-last-deleted-chars
  90         (buffer-substring (max (point-min) (- (point) num)) (point)))
  91   (delete-region (max (point-min) (- (point) num)) (point)))
  92
  93 (defun undelete-lines ()
  94   "Yank lines deleted by last EDT `line-delete' command."
  95   (interactive)
  96   (insert edt-last-deleted-lines))
  97
  98 (defun undelete-words ()
  99   "Yank words deleted by last EDT `word-delete' command."
 100   (interactive)
 101   (insert edt-last-deleted-words))
 102
 103 (defun undelete-chars ()
 104   "Yank characters deleted by last EDT `character-delete' command."
 105   (interactive)
 106   (insert edt-last-deleted-chars))
 107
 108 (defun next-end-of-line (num)
 109   "Move to end of line; if at end, move to end of next line.
 110 Accepts a prefix argument for the number of lines to move."
 111   (interactive "p")
 112   (forward-char)
 113   (end-of-line num))
 114
 115 (defun previous-end-of-line (num)
 116   "Move EOL upward.
 117 Accepts a prefix argument for the number of lines to move."
 118   (interactive "p")
 119   (end-of-line (- 1 num)))
 120
 121 (defun forward-to-word (num)
 122   "Move to next word-beginning, or to Nth following word-beginning."
 123   (interactive "p")
 124   (forward-word (1+ num))
 125   (forward-word -1))
 126
 127 (defun backward-to-word (num)
 128   "Move back to word-end, or to Nth word-end seen."
 129   (interactive "p")
 130   (forward-word (- (1+ num)))
 131   (forward-word 1))
 132
 133 (defun backward-line (num)
 134   "Move point to start of previous line.
 135 Prefix argument serves as repeat-count."
 136   (interactive "p")
 137   (forward-line (- num)))
 138
 139 (defun scroll-window-down (num)
 140   "Scroll the display down a window-full.
 141 Accepts a prefix argument for the number of window-fulls to scroll."
 142   (interactive "p")
 143   (scroll-down (- (* (window-height) num) 2)))
 144
 145 (defun scroll-window-up (num)
 146   "Scroll the display up a window-full.
 147 Accepts a prefix argument for the number of window-fulls to scroll."
 148   (interactive "p")
 149   (scroll-up (- (* (window-height) num) 2)))
 150
 151 (defun next-paragraph (num)
 152   "Move to beginning of the next indented paragraph.
 153 Accepts a prefix argument for the number of paragraphs."
 154   (interactive "p")
 155   (while (> num 0)
 156     (next-line 1)
 157     (forward-paragraph)
 158     (previous-line 1)
 159     (if (eolp) (next-line 1))
 160     (setq num (1- num))))
 161
 162 (defun previous-paragraph (num)
 163   "Move to beginning of previous indented paragraph.
 164 Accepts a prefix argument for the number of paragraphs."
 165   (interactive "p")
 166   (while (> num 0)
 167     (backward-paragraph)
 168     (previous-line 1)
 169     (if (eolp) (next-line 1))
 170     (setq num (1- num))))
 171
 172 (defun move-to-beginning ()
 173   "Move cursor to the beginning of buffer, but don't set the mark."
 174   (interactive)
 175   (goto-char (point-min)))
 176
 177 (defun move-to-end ()
 178   "Move cursor to the end of buffer, but don't set the mark."
 179   (interactive)
 180   (goto-char (point-max)))
 181
 182 (defun goto-percent (perc)
 183   "Move point to ARG percentage of the buffer."
 184   (interactive "NGoto-percentage: ")
 185   (if (or (> perc 100) (< perc 0))
 186       (error "Percentage %d out of range 0 < percent < 100" perc)
 187     (goto-char (/ (* (point-max) perc) 100))))
 188
 189 (defun update-mode-line ()
 190   "Ensure mode-line reflects all changes."
 191   (set-buffer-modified-p (buffer-modified-p))
 192   (sit-for 0))
 193
 194 (defun advance-direction ()
 195   "Set EDT Advance mode so keypad commands move forward."
 196   (interactive)
 197   (setq edt-direction-string " ADVANCE")
 198   (define-key function-keymap "\C-c" 'isearch-forward)  ; PF3
 199   (define-key function-keymap "8" 'scroll-window-up) ; "8"
 200   (define-key function-keymap "7" 'next-paragraph)   ; "7"
 201   (define-key function-keymap "1" 'forward-to-word)  ; "1"
 202   (define-key function-keymap "2" 'next-end-of-line) ; "2"
 203   (define-key function-keymap "3" 'forward-char)     ; "3"
 204   (define-key function-keymap "0" 'forward-line)     ; "0"
 205   (update-mode-line))
 206
 207 (defun backup-direction ()
 208   "Set EDT Backup mode so keypad commands move backward."
 209   (interactive)
 210   (setq edt-direction-string " BACKUP")
 211   (define-key function-keymap "\C-c" 'isearch-backward) ; PF3
 212   (define-key function-keymap "8" 'scroll-window-down) ; "8"
 213   (define-key function-keymap "7" 'previous-paragraph) ; "7"
 214   (define-key function-keymap "1" 'backward-to-word)    ; "1"
 215   (define-key function-keymap "2" 'previous-end-of-line) ; "2"
 216   (define-key function-keymap "3" 'backward-char)    ; "3"
 217   (define-key function-keymap "0" 'backward-line)    ; "0"
 218   (update-mode-line))
 219
 220 (defun edt-beginning-of-window ()
 221   "Home cursor to top of window."
 222   (interactive)
 223   (move-to-window-line 0))
 224
 225 (defun edt-line-to-bottom-of-window ()
 226   "Move the current line to the top of the window."
 227   (interactive)
 228   (recenter -1))
 229
 230 (defun edt-line-to-top-of-window ()
 231   "Move the current line to the top of the window."
 232   (interactive)
 233   (recenter 0))
 234
 235 (defun case-flip-character (num)
 236   "Change the case of the character under the cursor.
 237 Accepts a prefix argument of the number of characters to invert."
 238   (interactive "p")
 239   (while (> num 0)
 240     (funcall (if (<= ?a (following-char))
 241                  'upcase-region 'downcase-region)
 242              (point) (1+ (point)))
 243     (forward-char 1)
 244     (setq num (1- num))))
 245
 246 (defun indent-or-fill-region ()
 247   "Fill region in text modes, indent region in programming language modes."
 248   (interactive)
 249   (if (string= paragraph-start "^$\\|^\f")
 250       (indent-region (point) (mark) nil)
 251     (fill-region (point) (mark))))
 252
 253 (defun mark-section-wisely ()
 254   "Mark the section in a manner consistent with the major-mode.
 255 Uses mark-defun for emacs-lisp, lisp,
 256 mark-c-function for C,
 257 and mark-paragraph for other modes."
 258   (interactive)
 259   (cond  ((eq major-mode 'emacs-lisp-mode)
 260           (mark-defun))
 261          ((eq major-mode 'lisp-mode)
 262           (mark-defun))
 263          ((eq major-mode 'c-mode)
 264           (mark-c-function))
 265          (t (mark-paragraph))))
 266
 267 ;;; Key Bindings
 268 ;;;###autoload
 269 (defun edt-emulation-on ()
 270   "Emulate DEC's EDT editor.
 271 Note that many keys are rebound; including nearly all keypad keys.
 272 Use \\[edt-emulation-off] to undo all rebindings except the keypad keys.
 273 Note that this function does not work if called directly from the .emacs file.
 274 Instead, the .emacs file should do \"(setq term-setup-hook 'edt-emulation-on)\"
 275 Then this function will be called at the time when it will work."
 276   (interactive)
 277   (advance-direction)
 278   (edt-bind-gold-keypad)        ;Must do this *after* $TERM.el is loaded
 279   (setq edt-mode-old-c-\\ (lookup-key global-map "\C-\\"))
 280   (global-set-key "\C-\\" 'quoted-insert)
 281   (setq edt-mode-old-delete (lookup-key global-map "\177"))
 282   (global-set-key "\177" 'delete-previous-char)      ;"Delete"
 283   (setq edt-mode-old-lisp-delete (lookup-key emacs-lisp-mode-map "\177"))
 284   (define-key emacs-lisp-mode-map "\177" 'delete-previous-char) ;"Delete"
 285   (define-key lisp-mode-map "\177" 'delete-previous-char) ;"Delete"
 286   (setq edt-mode-old-linefeed (lookup-key global-map "\C-j"))
 287   (global-set-key "\C-j" 'edt-delete-previous-word)           ;"LineFeed"
 288   (define-key esc-map "?" 'apropos))                      ;"<ESC>?"
 289
 290 (defun edt-emulation-off ()
 291   "Return from EDT emulation to normal Emacs key bindings.
 292 The keys redefined by \\[edt-emulation-on] are given their old definitions."
 293   (interactive)
 294   (setq edt-direction-string nil)
 295   (global-set-key "\C-\\" edt-mode-old-c-\\)
 296   (global-set-key "\177" edt-mode-old-delete)           ;"Delete"
 297   (define-key emacs-lisp-mode-map "\177" edt-mode-old-lisp-delete) ;"Delete"
 298   (define-key lisp-mode-map "\177" edt-mode-old-lisp-delete) ;"Delete"
 299   (global-set-key "\C-j" edt-mode-old-linefeed))           ;"LineFeed"
 300
 301 (define-key function-keymap "u" 'previous-line)         ;Up arrow
 302 (define-key function-keymap "d" 'next-line)             ;down arrow
 303 (define-key function-keymap "l" 'backward-char)         ;right arrow
 304 (define-key function-keymap "r" 'forward-char)          ;left arrow
 305 (define-key function-keymap "h" 'edt-beginning-of-window)       ;home
 306 (define-key function-keymap "\C-b" 'describe-key)       ;PF2
 307 (define-key function-keymap "\C-d" 'delete-current-line);PF4
 308 (define-key function-keymap "9" 'append-to-buffer)      ;9 keypad key, etc.
 309 (define-key function-keymap "-" 'delete-current-word)
 310 (define-key function-keymap "4" 'advance-direction)
 311 (define-key function-keymap "5" 'backup-direction)
 312 (define-key function-keymap "6" 'kill-region)
 313 (define-key function-keymap "," 'delete-current-char)
 314 (define-key function-keymap "." 'set-mark-command)
 315 (define-key function-keymap "e" 'other-window)          ;enter key
 316 (define-key function-keymap "\C-a" 'GOLD-prefix)        ;PF1 ("gold")
 317
 318 (fset 'GOLD-prefix GOLD-map)
 319
 320 (defvar GOLD-map (make-keymap)
 321    "`GOLD-map' maps the function keys on the VT100 keyboard preceeded
 322 by the PF1 key.  GOLD is the ASCII the 7-bit escape sequence <ESC>OP.")
 323
 324 (defun define-keypad-key (keymap function-keymap-slot definition)
 325   (let ((function-key-sequence (function-key-sequence function-keymap-slot)))
 326     (if function-key-sequence
 327         (define-key keymap function-key-sequence definition))))
 328
 329 ;;Bind GOLD/Keyboard keys
 330
 331 (define-key GOLD-map "\C-g"  'keyboard-quit)            ; just for safety
 332 (define-key GOLD-map "\177" 'delete-window)             ;"Delete"
 333 (define-key GOLD-map "\C-h" 'delete-other-windows)      ;"BackSpace"
 334 (define-key GOLD-map "\C-m" 'newline-and-indent)        ;"Return"
 335 (define-key GOLD-map " " 'undo)                         ;"Spacebar"
 336 (define-key GOLD-map "%" 'goto-percent)                 ; "%"
 337 (define-key GOLD-map "=" 'goto-line)                    ; "="
 338 (define-key GOLD-map "`" 'what-line)                    ; "`"
 339 (define-key GOLD-map "\C-\\" 'split-window-vertically)  ; "Control-\"
 340
 341 ; GOLD letter combinations:
 342 (define-key GOLD-map "b" 'buffer-menu)                  ; "b"
 343 (define-key GOLD-map "B" 'buffer-menu)                  ; "B"
 344 (define-key GOLD-map "d" 'delete-window)                ; "d"
 345 (define-key GOLD-map "D" 'delete-window)                ; "D"
 346 (define-key GOLD-map "e" 'compile)                      ; "e"
 347 (define-key GOLD-map "E" 'compile)                      ; "E"
 348 (define-key GOLD-map "i" 'insert-file)                  ; "i"
 349 (define-key GOLD-map "I" 'insert-file)                  ; "I"
 350 (define-key GOLD-map "l" 'goto-line)                    ; "l"
 351 (define-key GOLD-map "L" 'goto-line)                    ; "L"
 352 (define-key GOLD-map "m" 'save-some-buffers)            ; "m"
 353 (define-key GOLD-map "M" 'save-some-buffers)            ; "m"
 354 (define-key GOLD-map "n" 'next-error)                           ; "n"
 355 (define-key GOLD-map "N" 'next-error)                           ; "N"
 356 (define-key GOLD-map "o" 'switch-to-buffer-other-window)        ; "o"
 357 (define-key GOLD-map "O" 'switch-to-buffer-other-window)        ; "O"
 358 (define-key GOLD-map "r" 'revert-file)                          ; "r"
 359 (define-key GOLD-map "r" 'revert-file)                          ; "R"
 360 (define-key GOLD-map "s" 'save-buffer)                          ; "s"
 361 (define-key GOLD-map "S" 'save-buffer)                          ; "S"
 362 (define-key GOLD-map "v" 'find-file-other-window)               ; "v"
 363 (define-key GOLD-map "V" 'find-file-other-window)               ; "V"
 364 (define-key GOLD-map "w" 'write-file)                           ; "w"
 365 (define-key GOLD-map "w" 'write-file)                           ; "W"
 366 ;(define-key GOLD-map "z" 'shrink-window)                 ; "z"
 367 ;(define-key GOLD-map "Z" 'shrink-window)                 ; "z"
 368
 369 ;Bind GOLD/Keypad keys
 370 (defun edt-bind-gold-keypad ()
 371   (define-keypad-key GOLD-map ?u 'edt-line-to-top-of-window) ;"up-arrow"
 372   (define-keypad-key GOLD-map ?d 'edt-line-to-bottom-of-window) ;"down-arrow"
 373   (define-keypad-key GOLD-map ?l 'backward-sentence) ;"left-arrow"
 374   (define-keypad-key GOLD-map ?r 'forward-sentence) ;"right-arrow"
 375   (define-keypad-key GOLD-map ?\C-a 'mark-section-wisely) ;Gold     "PF1"
 376   (define-keypad-key GOLD-map ?\C-b 'describe-function) ;Help     "PF2"
 377   (define-keypad-key GOLD-map ?\C-c 'occur) ;Find     "PF3"
 378   (define-keypad-key GOLD-map ?\C-d 'undelete-lines) ;Und Line "PF4"
 379   (define-keypad-key GOLD-map ?0 'open-line) ;Open L   "0"
 380   (define-keypad-key GOLD-map ?1 'case-flip-character) ;Chgcase  "1"
 381   (define-keypad-key GOLD-map ?2 'delete-to-eol) ;Del EOL  "2"
 382   (define-keypad-key GOLD-map ?3 'copy-region-as-kill) ;Copy     "3"
 383   (define-keypad-key GOLD-map ?4 'move-to-end) ;Bottom   "4"
 384   (define-keypad-key GOLD-map ?5 'move-to-beginning) ;Top      "5"
 385   (define-keypad-key GOLD-map ?6 'yank) ;Paste    "6"
 386   (define-keypad-key GOLD-map ?7 'execute-extended-command) ;Command  "7"
 387   (define-keypad-key GOLD-map ?8 'indent-or-fill-region) ;Fill     "8"
 388   (define-keypad-key GOLD-map ?9 'replace-regexp) ;Replace  "9"
 389   (define-keypad-key GOLD-map ?- 'undelete-words) ;UND word "-"
 390   (define-keypad-key GOLD-map ?, 'undelete-chars) ;UND Char ","
 391   (define-keypad-key GOLD-map ?. 'redraw-display) ;Reset Window "."
 392   (define-keypad-key GOLD-map ?e 'shell-command)) ;"ENTER"
 393
 394 ;; Make direction of motion show in mode line
 395 ;; while EDT emulation is turned on.
 396 ;; Note that the keypad is always turned on when in Emacs.
 397
 398 (or (assq 'edt-direction-string minor-mode-alist)
 399     (setq minor-mode-alist (cons '(edt-direction-string edt-direction-string)
 400                                  minor-mode-alist)))
 401
 402 ;;; edt.el ends here