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