Annotation of 43BSDReno/contrib/emacs-18.55/lisp/edt.el, revision 1.1.1.1

1.1       root        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)))

unix.superglobalmegacorp.com

This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.