API tools faq
paste
Advertisement
Guest User

Emacs emulating TPU emulating EDT

a guest
May 14th, 2016
114
0
Never
Add comment
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
text 18.38 KB | None | 0 0
raw download clone embed print report
  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. (defvar edt-last-find-chars ""
  31. "Last text found by find-forward or find-backward.")
  32.  
  33. (defun find-forward (sstring)
  34. "Find a string in the forward direction; save the string for
  35. find-next-forward or find-next-backward."
  36. (interactive "sString: ")
  37. (setq edt-last-find-chars sstring)
  38. (search-forward edt-last-find-chars))
  39.  
  40. (defun find-next-forward ()
  41. "Find last string entered in find-forward or find-backward."
  42. (interactive)
  43. (search-forward edt-last-find-chars))
  44.  
  45. (defun find-backward (sstring)
  46. "Find a string in the forward direction; save the string for
  47. find-next-forward or find-next-backward."
  48. (interactive "sString: ")
  49. (setq edt-last-find-chars sstring)
  50. (search-backward edt-last-find-chars))
  51.  
  52. (defun find-next-backward ()
  53. "Find last string entered in find-forward or find-backward."
  54. (interactive)
  55. (search-backward edt-last-find-chars))
  56.  
  57. (defun delete-current-line (num)
  58. "Delete one or specified number of lines after point.
  59. This includes the newline character at the end of each line.
  60. They are saved for the EDT undelete-lines command."
  61. (interactive "p")
  62. (let ((beg (point)))
  63. (forward-line num)
  64. (if (not (eq (preceding-char) ?\n))
  65. (insert "\n"))
  66. (setq edt-last-deleted-lines
  67. (buffer-substring beg (point)))
  68. (delete-region beg (point))))
  69.  
  70. (defun delete-to-eol (num)
  71. "Delete text up to end of line.
  72. With argument, delete up to to Nth line-end past point.
  73. They are saved for the EDT undelete-lines command."
  74. (interactive "p")
  75. (let ((beg (point)))
  76. (forward-char 1)
  77. (end-of-line num)
  78. (setq edt-last-deleted-lines
  79. (buffer-substring beg (point)))
  80. (delete-region beg (point))))
  81.  
  82. (defun delete-current-word (num)
  83. "Delete one or specified number of words after point.
  84. They are saved for the EDT undelete-words command."
  85. (interactive "p")
  86. (let ((beg (point)))
  87. (forward-word num)
  88. (setq edt-last-deleted-words
  89. (buffer-substring beg (point)))
  90. (delete-region beg (point))))
  91.  
  92. (defun delete-previous-word (num)
  93. "Delete one or specified number of words before point.
  94. They are saved for the EDT undelete-words command."
  95. (interactive "p")
  96. (let ((beg (point)))
  97. (forward-word (- num))
  98. (setq edt-last-deleted-words
  99. (buffer-substring (point) beg))
  100. (delete-region beg (point))))
  101.  
  102. (defun delete-current-char (num)
  103. "Delete one or specified number of characters after point.
  104. They are saved for the EDT undelete-chars command."
  105. (interactive "p")
  106. (setq edt-last-deleted-chars
  107. (buffer-substring (point) (min (point-max) (+ (point) num))))
  108. (delete-region (point) (min (point-max) (+ (point) num))))
  109.  
  110. (defun delete-previous-char (num)
  111. "Delete one or specified number of characters before point.
  112. They are saved for the EDT undelete-chars command."
  113. (interactive "p")
  114. (setq edt-last-deleted-chars
  115. (buffer-substring (max (point-min) (- (point) num)) (point)))
  116. (delete-region (max (point-min) (- (point) num)) (point)))
  117.  
  118. (defun undelete-lines ()
  119. "Yank lines deleted by last EDT line-deletion command."
  120. (interactive)
  121. (insert edt-last-deleted-lines))
  122.  
  123. (defun undelete-words ()
  124. "Yank words deleted by last EDT word-deletion command."
  125. (interactive)
  126. (insert edt-last-deleted-words))
  127.  
  128. (defun undelete-chars ()
  129. "Yank characters deleted by last EDT character-deletion command."
  130. (interactive)
  131. (insert edt-last-deleted-chars))
  132.  
  133. (defun next-end-of-line (num)
  134. "Move to end of line; if at end, move to end of next line.
  135. Accepts a prefix argument for the number of lines to move."
  136. (interactive "p")
  137. (forward-char)
  138. (end-of-line num))
  139.  
  140. (defun previous-end-of-line (num)
  141. "Move EOL upward.
  142. Accepts a prefix argument for the number of lines to move."
  143. (interactive "p")
  144. (end-of-line (- 1 num)))
  145.  
  146. (defun forward-to-word (num)
  147. "Move to next word-beginning, or to Nth following word-beginning."
  148. (interactive "p")
  149. (forward-word (1+ num))
  150. (forward-word -1))
  151.  
  152. (defun backward-to-word (num)
  153. "Move back to word-end, or to Nth word-end seen."
  154. (interactive "p")
  155. (forward-word (- (1+ num)))
  156. (forward-word 1))
  157.  
  158. (defun backward-line (num)
  159. "Move point to start of previous line.
  160. Prefix argument serves as repeat-count."
  161. (interactive "p")
  162. (forward-line (- num)))
  163.  
  164. (defun scroll-window-down (num)
  165. "Scroll the display down a window-full.
  166. Accepts a prefix argument for the number of window-fulls to scroll."
  167. (interactive "p")
  168. (scroll-down (- (* (window-height) num) 2)))
  169.  
  170. (defun scroll-window-up (num)
  171. "Scroll the display up a window-full.
  172. Accepts a prefix argument for the number of window-fulls to scroll."
  173. (interactive "p")
  174. (scroll-up (- (* (window-height) num) 2)))
  175.  
  176. (defun next-paragraph (num)
  177. "Move to beginning of the next indented paragraph.
  178. Accepts a prefix argument for the number of paragraphs."
  179. (interactive "p")
  180. (while (> num 0)
  181. (next-line 1)
  182. (forward-paragraph)
  183. (previous-line 1)
  184. (if (eolp) (next-line 1))
  185. (setq num (1- num))))
  186.  
  187. (defun previous-paragraph (num)
  188. "Move to beginning of previous indented paragraph.
  189. Accepts a prefix argument for the number of paragraphs."
  190. (interactive "p")
  191. (while (> num 0)
  192. (backward-paragraph)
  193. (previous-line 1)
  194. (if (eolp) (next-line 1))
  195. (setq num (1- num))))
  196.  
  197. (defun move-to-beginning ()
  198. "Move cursor to the beginning of buffer, but don't set the mark."
  199. (interactive)
  200. (goto-char (point-min)))
  201.  
  202. (defun move-to-end ()
  203. "Move cursor to the end of buffer, but don't set the mark."
  204. (interactive)
  205. (goto-char (point-max)))
  206.  
  207. (defun goto-percent (perc)
  208. "Move point to ARG percentage of the buffer."
  209. (interactive "NGoto-percentage: ")
  210. (if (or (> perc 100) (< perc 0))
  211. (error "Percentage %d out of range 0 < percent < 100" perc)
  212. (goto-char (/ (* (point-max) perc) 100))))
  213.  
  214. (defun update-mode-line ()
  215. "Make sure mode-line in the current buffer reflects all changes."
  216. (set-buffer-modified-p (buffer-modified-p))
  217. (sit-for 0))
  218.  
  219. (setq GOLD-map (make-keymap))
  220. (fset 'GOLD-prefix GOLD-map)
  221.  
  222. (defvar GOLD-map nil
  223. "GOLD-map maps the function keys on the VT100 keyboard preceeded
  224. by the PF1 key. GOLD is the ASCII the 7-bit escape sequence <ESC>OP.")
  225.  
  226. (defun define-keypad-key (keymap function-keymap-slot definition)
  227. (let ((function-key-sequence (function-key-sequence function-keymap-slot)))
  228. (if function-key-sequence
  229. (define-key keymap function-key-sequence definition))))
  230.  
  231. (defun advance-direction ()
  232. "Set EDT Advance mode so keypad commands move forward."
  233. (interactive)
  234. (setq edt-direction-string " ADVANCE")
  235. (define-key function-keymap "\C-c" 'find-next-forward) ; PF3
  236. (define-key function-keymap "8" 'scroll-window-up) ; "8"
  237. (define-key function-keymap "7" 'scroll-window-down) ; "7"
  238. (define-key function-keymap "1" 'forward-to-word) ; "1"
  239. (define-key function-keymap "2" 'next-end-of-line) ; "2"
  240. (define-key function-keymap "3" 'backward-to-word) ; "3"
  241. (define-key function-keymap "0" 'forward-line) ; "0"
  242. (define-keypad-key GOLD-map ?\C-c 'find-forward) ;Find "PF3"
  243. (update-mode-line))
  244.  
  245. (defun backup-direction ()
  246. "Set EDT Backup mode so keypad commands move backward."
  247. (interactive)
  248. (setq edt-direction-string " BACKUP")
  249. (define-key function-keymap "\C-c" 'find-next-backward) ; PF3
  250. (define-key function-keymap "8" 'scroll-window-down) ; "8"
  251. (define-key function-keymap "7" 'scroll-window-up) ; "7"
  252. (define-key function-keymap "1" 'backward-to-word) ; "1"
  253. (define-key function-keymap "2" 'previous-end-of-line) ; "2"
  254. (define-key function-keymap "3" 'forward-to-word) ; "3"
  255. (define-key function-keymap "0" 'backward-line) ; "0"
  256. (define-keypad-key GOLD-map ?\C-c 'find-backward) ;Find "PF3"
  257. (update-mode-line))
  258.  
  259. (defun beginning-of-window ()
  260. "Home cursor to top of window."
  261. (interactive)
  262. (move-to-window-line 0))
  263.  
  264. (defun line-to-bottom-of-window ()
  265. "Move the current line to the top of the window."
  266. (interactive)
  267. (recenter -1))
  268.  
  269. (defun line-to-top-of-window ()
  270. "Move the current line to the top of the window."
  271. (interactive)
  272. (recenter 0))
  273.  
  274. (defun case-flip-character (num)
  275. "Change the case of the character under the cursor.
  276. Accepts a prefix argument of the number of characters to invert."
  277. (interactive "p")
  278. (while (> num 0)
  279. (funcall (if (<= ?a (following-char))
  280. 'upcase-region 'downcase-region)
  281. (point) (1+ (point)))
  282. (forward-char 1)
  283. (setq num (1- num))))
  284.  
  285. (defun indent-or-fill-region ()
  286. "Fill region in text modes, indent region in programming language modes."
  287. (interactive)
  288. (if (string= paragraph-start "^$\\|^ ")
  289. (indent-region (point) (mark) nil)
  290. (fill-region (point) (mark))))
  291.  
  292. (defun mark-section-wisely ()
  293. "Mark the section in a manner consistent with the major-mode.
  294. Uses mark-defun for emacs-lisp, lisp,
  295. mark-c-function for C,
  296. and mark-paragraph for other modes."
  297. (interactive)
  298. (cond ((eq major-mode 'emacs-lisp-mode)
  299. (mark-defun))
  300. ((eq major-mode 'lisp-mode)
  301. (mark-defun))
  302. ((eq major-mode 'c-mode)
  303. (mark-c-function))
  304. (t (mark-paragraph))))
  305.  
  306. ;;; Key Bindings
  307. (defun edt-emulation-on ()
  308. "Begin emulating DEC's EDT editor.
  309. Certain keys are rebound; including nearly all keypad keys.
  310. Use \\[edt-emulation-off] to undo all rebindings except the keypad keys.
  311. Note that this function does not work if called directly from the .emacs file.
  312. Instead, the .emacs file should do (setq term-setup-hook 'edt-emulation-on)
  313. Then this function will be called at the time when it will work."
  314. (interactive)
  315. (advance-direction)
  316. (edt-bind-gold-keypad) ;Must do this *after* $TERM.el is loaded
  317. (setq edt-mode-old-c-\\ (lookup-key global-map "\C-\\"))
  318. (global-set-key "\C-\\" 'quoted-insert)
  319. (setq edt-mode-old-delete (lookup-key global-map "\177"))
  320. (global-set-key "\177" 'delete-previous-char) ;"Delete"
  321. (setq edt-mode-old-lisp-delete (lookup-key emacs-lisp-mode-map "\177"))
  322. (define-key emacs-lisp-mode-map "\177" 'delete-previous-char) ;"Delete"
  323. (define-key lisp-mode-map "\177" 'delete-previous-char) ;"Delete"
  324. (setq edt-mode-old-linefeed (lookup-key global-map "\C-j"))
  325. (global-set-key "\C-j" 'delete-previous-word) ;"LineFeed"
  326. (global-set-key "\C-z" 'save-buffers-kill-emacs)
  327. (define-key esc-map "?" 'apropos) ;"<ESC>?"
  328. (global-unset-key "\C-[[")
  329. (define-key esc-map "[2~" 'yank) ; Insert
  330. (define-key esc-map "[3~" 'delete-current-char) ; Delete
  331. (define-key esc-map "[1~" 'beginning-of-line) ; Home
  332. (define-key esc-map "[4~" 'next-end-of-line) ; End
  333. (define-key esc-map "[5~" 'scroll-window-down) ; Page Up
  334. (define-key esc-map "[6~" 'scroll-window-up)) ; Page Down
  335.  
  336. (defun edt-emulation-off ()
  337. "Return from EDT emulation to normal Emacs key bindings.
  338. The keys redefined by \\[edt-emulation-on] are given their old definitions."
  339. (interactive)
  340. (setq edt-direction-string nil)
  341. (global-set-key "\C-\\" edt-mode-old-c-\\)
  342. (global-set-key "\177" edt-mode-old-delete) ;"Delete"
  343. (define-key emacs-lisp-mode-map "\177" edt-mode-old-lisp-delete) ;"Delete"
  344. (define-key lisp-mode-map "\177" edt-mode-old-lisp-delete) ;"Delete"
  345. (global-set-key "\C-j" edt-mode-old-linefeed)) ;"LineFeed"
  346.  
  347. (define-key function-keymap "u" 'previous-line) ;Up arrow
  348. (define-key function-keymap "d" 'next-line) ;down arrow
  349. (define-key function-keymap "l" 'backward-char) ;right arrow
  350. (define-key function-keymap "r" 'forward-char) ;left arrow
  351. (define-key function-keymap "h" 'beginning-of-window) ;home
  352. (define-key function-keymap "\C-b" 'describe-key) ;PF2
  353. (define-key function-keymap "\C-d" 'delete-current-line);PF4
  354. (define-key function-keymap "9" 'append-to-buffer) ;9 keypad key, etc.
  355. (define-key function-keymap "-" 'delete-current-word)
  356. (define-key function-keymap "4" 'advance-direction)
  357. (define-key function-keymap "5" 'backup-direction)
  358. (define-key function-keymap "6" 'kill-region)
  359. (define-key function-keymap "," 'delete-current-char)
  360. (define-key function-keymap "." 'set-mark-command)
  361. (define-key function-keymap "e" 'other-window) ;enter key
  362. (define-key function-keymap "\C-a" 'GOLD-prefix) ;PF1 ("gold")
  363.  
  364. ;;Bind GOLD/Keyboard keys
  365.  
  366. ;(define-key GOLD-map "\C-g" 'keyboard-quit) ; just for safety
  367. ;(define-key GOLD-map "\177" 'delete-window) ;"Delete"
  368. ;(define-key GOLD-map "\C-h" 'delete-other-windows) ;"BackSpace"
  369. ;(define-key GOLD-map "\C-m" 'newline-and-indent) ;"Return"
  370. ;(define-key GOLD-map " " 'undo) ;"Spacebar"
  371. ;(define-key GOLD-map "%" 'goto-percent) ; "%"
  372. ;(define-key GOLD-map "=" 'goto-line) ; "="
  373. ;(define-key GOLD-map "`" 'what-line) ; "`"
  374. ;(define-key GOLD-map "\C-\\" 'split-window-vertically) ; "Control-\"
  375.  
  376. ; GOLD letter combinations:
  377. ;(define-key GOLD-map "b" 'buffer-menu) ; "b"
  378. ;(define-key GOLD-map "B" 'buffer-menu) ; "B"
  379. ;(define-key GOLD-map "d" 'delete-window) ; "d"
  380. ;(define-key GOLD-map "D" 'delete-window) ; "D"
  381. ;(define-key GOLD-map "e" 'compile) ; "e"
  382. ;(define-key GOLD-map "E" 'compile) ; "E"
  383. ;(define-key GOLD-map "i" 'insert-file) ; "i"
  384. ;(define-key GOLD-map "I" 'insert-file) ; "I"
  385. ;(define-key GOLD-map "l" 'goto-line) ; "l"
  386. ;(define-key GOLD-map "L" 'goto-line) ; "L"
  387. ;(define-key GOLD-map "m" 'save-some-buffers) ; "m"
  388. ;(define-key GOLD-map "M" 'save-some-buffers) ; "m"
  389. ;(define-key GOLD-map "n" 'next-error) ; "n"
  390. ;(define-key GOLD-map "N" 'next-error) ; "N"
  391. ;(define-key GOLD-map "o" 'switch-to-buffer-other-window) ; "o"
  392. ;(define-key GOLD-map "O" 'switch-to-buffer-other-window) ; "O"
  393. ;(define-key GOLD-map "r" 'revert-file) ; "r"
  394. ;(define-key GOLD-map "r" 'revert-file) ; "R"
  395. ;(define-key GOLD-map "s" 'save-buffer) ; "s"
  396. ;(define-key GOLD-map "S" 'save-buffer) ; "S"
  397. ;(define-key GOLD-map "v" 'find-file-other-window) ; "v"
  398. ;(define-key GOLD-map "V" 'find-file-other-window) ; "V"
  399. ;(define-key GOLD-map "w" 'write-file) ; "w"
  400. ;(define-key GOLD-map "w" 'write-file) ; "W"
  401. ;(define-key GOLD-map "z" 'shrink-window) ; "z"
  402. ;(define-key GOLD-map "Z" 'shrink-window) ; "z"
  403.  
  404. (define-key GOLD-map "\C-b" 'buffer-menu) ; "Control-b"
  405. (define-key GOLD-map "b" 'switch-to-buffer) ; "b"
  406. (define-key GOLD-map "B" 'switch-to-buffer) ; "B"
  407. (define-key GOLD-map "c" 'other-window) ; "c"
  408. (define-key GOLD-map "C" 'other-window) ; "C"
  409. (define-key GOLD-map "g" 'find-file) ; "g"
  410. (define-key GOLD-map "G" 'find-file) ; "G"
  411. (define-key GOLD-map "i" 'insert-file) ; "i"
  412. (define-key GOLD-map "I" 'insert-file) ; "I"
  413. (define-key GOLD-map "x" 'split-window-vertically) ; "x"
  414. (define-key GOLD-map "X" 'split-window-vertically) ; "X"
  415. (define-key GOLD-map "z" 'delete-other-windows) ; "z"
  416. (define-key GOLD-map "Z" 'delete-other-windows) ; "Z"
  417.  
  418. ;Bind GOLD/Keypad keys
  419. (defun edt-bind-gold-keypad ()
  420. (define-keypad-key GOLD-map ?u 'line-to-top-of-window) ;"up-arrow"
  421. (define-keypad-key GOLD-map ?d 'line-to-bottom-of-window) ;"down-arrow"
  422. (define-keypad-key GOLD-map ?l 'backward-sentence) ;"left-arrow"
  423. (define-keypad-key GOLD-map ?r 'forward-sentence) ;"right-arrow"
  424. (define-keypad-key GOLD-map ?\C-a 'mark-section-wisely) ;Gold "PF1"
  425. (define-keypad-key GOLD-map ?\C-b 'describe-function) ;Help "PF2"
  426. (define-keypad-key GOLD-map ?\C-c 'find-forward) ;Find "PF3"
  427. (define-keypad-key GOLD-map ?\C-d 'undelete-lines) ;Und Line "PF4"
  428. (define-keypad-key GOLD-map ?0 'open-line) ;Open L "0"
  429. (define-keypad-key GOLD-map ?1 'case-flip-character) ;Chgcase "1"
  430. (define-keypad-key GOLD-map ?2 'delete-to-eol) ;Del EOL "2"
  431. (define-keypad-key GOLD-map ?3 'copy-region-as-kill) ;Copy "3"
  432. (define-keypad-key GOLD-map ?4 'move-to-end) ;Bottom "4"
  433. (define-keypad-key GOLD-map ?5 'move-to-beginning) ;Top "5"
  434. (define-keypad-key GOLD-map ?6 'yank) ;Paste "6"
  435. (define-keypad-key GOLD-map ?7 'execute-extended-command) ;Command "7"
  436. (define-keypad-key GOLD-map ?8 'indent-or-fill-region) ;Fill "8"
  437. (define-keypad-key GOLD-map ?9 'replace-regexp) ;Replace "9"
  438. (define-keypad-key GOLD-map ?- 'undelete-words) ;UND word "-"
  439. (define-keypad-key GOLD-map ?, 'undelete-chars) ;UND Char ","
  440. (define-keypad-key GOLD-map ?. 'redraw-display) ;Reset Window "."
  441. (define-keypad-key GOLD-map ?e 'shell-command)) ;"ENTER"
  442.  
  443. ;; Make direction of motion show in mode line
  444. ;; while EDT emulation is turned on.
  445. ;; Note that the keypad is always turned on when in Emacs.
  446.  
  447. (or (assq 'edt-direction-string minor-mode-alist)
  448. (setq minor-mode-alist (cons '(edt-direction-string edt-direction-string)
  449. minor-mode-alist)))
  450.  
  451. (setq scroll-step 1) ; Scroll the window 1 line at a time, almost like EDT
  452. (setq term-setup-hook 'edt-emulation-on)
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement
Public Pastes
Advertisement
We use cookies for various purposes including analytics. By continuing to use Pastebin, you agree to our use of cookies as described in the Cookies Policy.  OK, I Understand
Not a member of Pastebin yet?
Sign Up, it unlocks many cool features!