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