home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Professional / OS2PRO194.ISO / os2 / prgramer / unix / emacs / lisp / em-keys.el < prev    next >
Encoding:
Text File  |  1992-05-18  |  13.4 KB  |  353 lines
  1. ;
  2. ; em-keys.el
  3. ;
  4. ; Written by Eberhard Mattes
  5. ;
  6. (provide 'em-keys)
  7.  
  8. (defvar ext-map nil
  9.   "Keymap used for extended scan codes.")
  10. (setq ext-map (make-keymap))
  11.  
  12. (defvar em-map nil
  13.   "Keymap used for em's key definitions which are prefixed by F9.")
  14. (setq em-map (make-sparse-keymap))
  15.  
  16. (define-key ext-map "\040" 'em-dup-line)        ; A-d
  17. (define-key ext-map "\041" 'find-file)            ; A-f
  18. (define-key ext-map "\042" 'goto-line)                ; A-g
  19. (define-key ext-map "\056" 'em-copy-region)         ; A-c
  20. (define-key ext-map "\046" 'em-copy-line-as-kill)   ; A-l
  21. (define-key ext-map "\062" 'em-match-paren)         ; A-m
  22. (define-key ext-map "\030" 'open-rectangle)        ; A-o
  23. (define-key ext-map "\021" 'em-kill-word)        ; A-w
  24. (define-key ext-map "\016" 'undo)            ; A-BS
  25. (define-key ext-map "<" 'em-switch-to-nth-buffer)   ; F2
  26. (define-key ext-map "=" 'em-search-forward)        ; F3
  27. (define-key ext-map ">" 'em-search-backward)        ; F4
  28. (define-key ext-map "?" 'em-fill-paragraph)         ; F5
  29. (define-key ext-map "@" 'other-window)            ; F6
  30. (define-key ext-map "A" 'undefined)            ; F7
  31. (define-key ext-map "B" 'undefined)            ; F8
  32. (define-key ext-map "C" em-map)                ; F9
  33. (define-key ext-map "D" 'undefined)            ; F10
  34. (define-key ext-map "E" 'undefined)            ;
  35. (define-key ext-map "F" 'undefined)            ;
  36. (define-key ext-map "G" 'beginning-of-line)        ; HOME
  37. (define-key ext-map "H" 'previous-line)            ; UP
  38. (define-key ext-map "I" 'scroll-down)            ; PAGEUP
  39. (define-key ext-map "J" 'undefined)            ;
  40. (define-key ext-map "K" 'backward-char)            ; LEFT
  41. (define-key ext-map "L" 'goto-line)            ; CENTER
  42. (define-key ext-map "M" 'forward-char)            ; RIGHT
  43. (define-key ext-map "N" 'undefined)            ;
  44. (define-key ext-map "O" 'end-of-line)            ; END
  45. (define-key ext-map "P" 'next-line)            ; DOWN
  46. (define-key ext-map "Q" 'scroll-up)            ; PAGEDOWN
  47. (define-key ext-map "R" 'overwrite-mode)        ; INSERT
  48. (define-key ext-map "S" 'delete-char)            ; DELETE
  49. (define-key ext-map "T" 'describe-key)            ; S-F1
  50. (define-key ext-map "U" 'em-buffer-list)        ; S-F2
  51. (define-key ext-map "V" 'next-error)            ; S-F3
  52. (define-key ext-map "W" 'undefined)            ; S-F4
  53. (define-key ext-map "X" 'undefined)            ; S-F5
  54. (define-key ext-map "Y" 'undefined)            ; S-F6
  55. (define-key ext-map "Z" 'undefined)            ; S-F7
  56. (define-key ext-map "_" 'em-find-file-at-point)     ; C-F2
  57. (define-key ext-map "s" 'em-backward-to-word)        ; C-LEFT
  58. (define-key ext-map "t" 'em-forward-to-word)        ; C-RIGHT
  59. (define-key ext-map "u" 'kill-line)            ; C-END
  60. (define-key ext-map "v" 'em-end-of-buffer)        ; C-PAGEDOWN
  61. (define-key ext-map "w" 'em-kill-left-line)        ; C-HOME
  62. (define-key ext-map "\200" 'undefined)              ; A-9
  63. (define-key ext-map "\204" 'em-beginning-of-buffer) ; C-PAGEUP
  64. (define-key ext-map "\205" 'call-last-kbd-macro)    ; F11
  65. (define-key ext-map "\206" 'set-mark-command)        ; F12
  66. (define-key ext-map "\207" 'expand-abbrev)          ; S-F11
  67. (define-key ext-map "\215" 'em-scroll-line-down)    ; C-UP
  68. (define-key ext-map "\216" 'undefined)              ; C-NUM-
  69. (define-key ext-map "\217" 'undefined)              ; C-CENTER
  70. (define-key ext-map "\220" 'undefined)              ; C-NUM+
  71. (define-key ext-map "\221" 'em-scroll-line-up)        ; C-DOWN
  72. (define-key ext-map "\222" 'undefined)              ; C-INSERT
  73. (define-key ext-map "\231" 'undefined)              ; A-PAGEUP
  74. (define-key ext-map "\233" 'scroll-right)        ; A-LEFT
  75. (define-key ext-map "\235" 'scroll-left)        ; A-RIGHT
  76. (define-key ext-map "\241" 'scroll-other-window)    ; A-PAGEDOWN
  77. (define-key ext-map "\245" 'undefined)              ; A-TAB
  78.  
  79. (define-key em-map "c" 'compile)                ; F9 c
  80. (define-key em-map "i" 'em-reinitialize)        ; F9 i
  81. (define-key em-map "j" 'just-one-space)             ; F9 j
  82. (define-key em-map "v" 'em-buffer-file-name)        ; F9 v
  83.  
  84. (global-set-key "\e " 'set-mark-command)
  85. (global-set-key "\0" ext-map)
  86.  
  87. ;
  88. ; The following definitions avoid the insertion of unexpected
  89. ; characters into the buffer if the scan code prefix (C-@) is not a
  90. ; valid key. Otherwise, "C-X RIGHT", for instance, would be
  91. ; interpreted as C-X C-@, which is undefined, followed by "M" which
  92. ; would be inserted into the buffer.
  93. ;
  94. (define-key ctl-x-map "\0" (make-sparse-keymap))
  95. (define-key ctl-x-4-map "\0" (make-sparse-keymap))
  96. (define-key esc-map "\0" (make-sparse-keymap))
  97. (define-key mode-specific-map "\0" (make-sparse-keymap))
  98. (define-key help-map "\0" (make-sparse-keymap))
  99. (define-key em-map "\0" (make-sparse-keymap))
  100.  
  101. (defun em-forward-to-word (arg)
  102.   "Move forward until encountering the beginning of a word.
  103. With argument, do this that many times."
  104.   (interactive "p")
  105.   (or (re-search-forward "\\W\\b" nil t arg)
  106.       (goto-char (point-max))))
  107.  
  108. (defun em-backward-to-word (arg)
  109.   "Move backward until encountering the beginning of a word.
  110. With argument, do this that many times."
  111.   (interactive "p")
  112.   (backward-char)
  113.   (if (re-search-backward "\\W\\b" nil t arg) (goto-char (match-end 0))
  114.       (goto-char (point-min))))
  115.  
  116. (defun em-kill-left-line nil
  117.   "Kill from the beginning of the line to point."
  118.   (interactive "*")
  119.   (kill-line 0))
  120.  
  121. (defun em-end-of-buffer nil
  122.   "Move to end of the buffer without setting mark."
  123.   (interactive)
  124.   (goto-char (point-max)))
  125.  
  126. (defun em-beginning-of-buffer nil
  127.   "Move to the beginning of the buffer without setting mark."
  128.   (interactive)
  129.   (goto-char (point-min)))
  130.  
  131. (defun em-reinitialize ()
  132.   "Load \"~/.emacs, em-keys.el and em-misc.el\".
  133. This is used to load new versions of these files while debugging."
  134.   (interactive)
  135.   (load "~/.emacs")
  136.   (load "em-keys")
  137.   (load "em-misc" t))
  138.  
  139. (defun em-scroll-line-up (arg)
  140.   "Scroll up by one line.
  141. With argument, do this that many times."
  142.   (interactive "p")
  143.   (scroll-up arg))
  144.  
  145. (defun em-scroll-line-down (arg)
  146.   "Scroll down by one line.
  147. With argument, do this that many times."
  148.   (interactive "p")
  149.   (scroll-down arg))
  150.  
  151. (defun em-buffer-file-name ()
  152.   "Display the name of the file visited in current buffer."
  153.   (interactive)
  154.   (message "%s" (cond (buffer-file-name) (t "Not visiting a file"))))
  155.  
  156. (defun em-copy-line-as-kill (arg)
  157.   "Copy line as kill.
  158. With argument, copy that many lines."
  159.   (interactive "p")
  160.   (let ((s (point)))
  161.     (beginning-of-line)
  162.     (let ((b (point)))
  163.       (forward-line arg)
  164.       (copy-region-as-kill b (point)))
  165.     (goto-char s)))
  166.  
  167. (defun em-dup-line (arg)
  168.   "Duplicate current line.
  169. Set mark to the beginning of the new line.
  170. With argument, do this that many times."
  171.   (interactive "*p")
  172.   (setq last-command 'identity) ; Don't append to kill ring
  173.   (let ((s (point)))
  174.     (beginning-of-line)
  175.     (let ((b (point)))
  176.       (forward-line)
  177.       (if (not (eq (preceding-char) ?\n)) (insert ?\n))
  178.       (copy-region-as-kill b (point))
  179.     (while (> arg 0)
  180.       (yank)
  181.       (setq arg (1- arg)))
  182.     (goto-char s))))
  183.  
  184. (defun em-kill-word (arg)
  185.   "Delete characters until encountering the beginning of a word.
  186. With argument, do this that many times."
  187.   (interactive "*p")
  188.   (let ((b (point)))
  189.      (em-forward-to-word arg)
  190.      (kill-region b (point))))
  191.  
  192. (defvar em-search-string nil
  193.   "Search string for em-search-forward and em-search-backward.")
  194.  
  195. (defvar em-search-re nil
  196.   "Non-nil means use regular expression for em-search-forward and -backward.")
  197.  
  198. (defun em-search-forward (&optional arg)
  199.   "Search forward for a string.
  200. If prefixed by \\[universal-argument], ask for search string.
  201. If prefixed by \\[universal-argument] \\[universal-argument], use regular expression."
  202.   (interactive "P")
  203.   (em-search-fb arg 'search-forward 're-search-forward))
  204.  
  205. (defun em-search-backward (&optional arg)
  206.   "Search backward for a string.
  207. If prefixed by \\[universal-argument], ask for search string.
  208. If prefixed by \\[universal-argument] \\[universal-argument], use
  209. regular expression."
  210.   (interactive "P")
  211.   (em-search-fb arg 'search-backward 're-search-backward))
  212.  
  213. (defun em-search-fb (arg fun re-fun)
  214.   "Search forward or backward for a string.
  215. If the first argument is nil, ask for the string.
  216. The second argument is search-forward or search-backward.
  217. The third argument is re-search-forward or re-search-backward."
  218.   (if (or arg (not em-search-string))
  219.      (progn
  220.        (setq em-search-re 
  221.          (and (listp arg) (numberp (car arg)) (>= (car arg) 16)))
  222.        (setq em-search-string
  223.           (read-from-minibuffer
  224.              (if em-search-re "Re-Search forward: " "Search forward: ")
  225.              em-search-string))))
  226.   (funcall (if em-search-re re-fun fun) em-search-string))
  227.  
  228. (defun em-switch-to-nth-buffer (arg)
  229.   "Switch to the ARG'th buffer.
  230. If a numeric prefix argument is not given, the next buffer is
  231. selected. When using this function successively, the top ARG+1 buffers
  232. are rotated."
  233.   (interactive "p")
  234.   (let* ((bufs (buffer-list))
  235.          (len (length bufs))
  236.          (idx 0) buffer name (more t))
  237.     (while (and (>= arg 0) (< idx len) more)
  238.       (setq buffer (nth idx bufs))
  239.       (setq name (buffer-name buffer))
  240.       (if (/= (string-to-char name) ? )
  241.           (if (zerop arg)
  242.               (setq more nil)
  243.             (setq arg (1- arg))))
  244.       (setq idx (1+ idx)))
  245.     (if more
  246.         (error "Invalid buffer number"))
  247.     (switch-to-buffer buffer)))
  248.  
  249. (defun em-match-paren (arg)
  250.   "Go to the matching parenthesis if on parenthesis.
  251. This function uses the syntax table."
  252.   (interactive "p")
  253.   (cond ((looking-at "\\s\(") (forward-list 1) (backward-char 1))
  254.     ((looking-at "\\s\)") (forward-char 1) (backward-list 1))))
  255.  
  256. (defun em-buffer-list ()
  257.   "Display a list of names of existing buffers.
  258. Inserts it in buffer *Buffer List* and selects that.
  259. Note that buffers with names starting with spaces are omitted."
  260.   (interactive)
  261.   (list-buffers)
  262.   (select-window (get-buffer-window "*Buffer List*"))
  263.   (list-buffers))                                   ; update for *Buffer List*
  264.  
  265. (defun em-copy-region ()
  266.   "Copy region to point."
  267.   (interactive)
  268.   (copy-region-as-kill (point) (mark))
  269.   (yank))
  270.  
  271.  
  272. (defun em-fill-paragraph (arg)
  273.   "Fill paragraph at or before point using em's notion of a paragraph.
  274. Prefix arg means justify as well.
  275. Paragraphs are separated by blank lines. The indentation of the first line
  276. is used for indenting the entire paragraph. If there are two consecutive
  277. blanks in the first line of the paragraphs, everything to the left of these
  278. blanks is left as-is and the paragraph is indented to the first non-blank
  279. character after the first two consecutive blanks of the first line."
  280.   (interactive "P")
  281.   (save-excursion
  282.     (let (fill-prefix start end join column)
  283.       (while (looking-at "^$")
  284.           (forward-line -1))
  285.       (re-search-backward "^$" (point-min) 0)
  286.       (if (looking-at "^$")
  287.           (forward-char))
  288.       (setq start (point))
  289.       (re-search-forward "^$" (point-max) 0)
  290.       (or (bolp) (newline 1))
  291.       (setq end (point-marker))
  292.       (goto-char start)
  293.       (if (looking-at "^ *[^ \n]*  ")
  294.           (progn (re-search-forward "^ *[^ \n]*   *")
  295.                  (setq column (current-column))
  296.                  (split-line)
  297.                  (setq join (point))
  298.                  (forward-line 1)
  299.                  (setq start (point))
  300.                  (forward-char column)
  301.                  (setq fill-prefix
  302.                        (if (zerop column) nil
  303.                          (make-string column ? )))
  304.                  (while (and (zerop (forward-line 1))
  305.                              (< (point) (marker-position end)))
  306.                    (backward-to-indentation 0)
  307.                    (cond ((> (current-column) column)
  308.                           (delete-region (+ (point) column
  309.                                             (- (current-column))) (point)))
  310.                          ((< (current-column) column)
  311.                           (insert-char ?  (- column (current-column))))))
  312.                  (fill-region-as-paragraph start
  313.                                            (marker-position end) arg)
  314.                  (delete-region join (+ start column)))
  315.         (fill-region-as-paragraph (point) (marker-position end) arg)))))
  316.  
  317.  
  318. (defun em-extract-file-name (at-point)
  319.   "Return the file name around or before point.
  320. If AT-POINT is not nil, the file names starts at point, that is, characters
  321. before point are ignored."
  322.   (let (start end)
  323.     (save-excursion
  324.       (if at-point
  325.           (setq start (point))
  326.         (if (looking-at "[][\0- ()<>\\\"|;=*?]")
  327.             (re-search-backward "[^][\0- :()<>\\\"|;=*?]" (point-min) 0))
  328.         (cond ((bobp) (setq start (point-min)))
  329.               (t (re-search-backward "[][\0- :()<>\\\"|;=*?]" (point-min) 0)
  330.                  (if (and (looking-at ":") (not (bobp)))
  331.                      (progn
  332.                        (goto-char (1- (point)))
  333.                        (if (looking-at "[A-Za-z]:")
  334.                            (setq start (point))
  335.                          (setq start (+ 2 (point)))))
  336.                    (if (bobp)
  337.                        (setq start (point))
  338.                      (setq start (1+ (point))))))))
  339.       (goto-char start)
  340.       (if (looking-at "\\([A-Za-z]:\\|\\)[^][\0- :()<>\\\"|;=*?]*")
  341.           (setq end (match-end 0)))
  342.       (and start end  (> end start) (buffer-substring start end)))))
  343.  
  344. (defun em-find-file-at-point (arg)
  345.   "Find file whose name is around or before point.
  346. With prefix argument find file whose name starts at point."
  347.   (interactive "P")
  348.   (find-file (em-extract-file-name arg)))
  349.  
  350. ; Local Variables:
  351. ; comment-column: 52
  352. ; End:
  353.