source: trunk/j/examples/key-pressed.lisp @ 2783

Last change on this file since 2783 was 2783, checked in by piso, 18 years ago

Work in progress.

File size: 5.0 KB
Line 
1;;; key-pressed.lisp
2;;;
3;;; Copyright (C) 2003 Peter Graves
4;;; $Id: key-pressed.lisp,v 1.4 2003-07-05 02:03:36 piso Exp $
5;;;
6;;; This program is free software; you can redistribute it and/or
7;;; modify it under the terms of the GNU General Public License
8;;; as published by the Free Software Foundation; either version 2
9;;; of the License, or (at your option) any later version.
10;;;
11;;; This program is distributed in the hope that it will be useful,
12;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
13;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
14;;; GNU General Public License for more details.
15;;;
16;;; You should have received a copy of the GNU General Public License
17;;; along with this program; if not, write to the Free Software
18;;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA  02111-1307, USA.
19
20(unless (find-package "KEY-PRESSED")
21  (make-package "KEY-PRESSED" :nicknames '("KP") :use '("CL" "J")))
22
23(in-package "KEY-PRESSED")
24
25;; No exports.
26
27(defcommand open-file)
28(defcommand open-file-in-other-window)
29(defcommand open-file-in-other-frame)
30(defcommand new-buffer)
31(defcommand recent-files)
32(defcommand save)
33(defcommand save-as)
34(defcommand save-copy)
35(defcommand save-all)
36(defcommand kill-buffer)
37(defcommand properties)
38(defcommand next-buffer)
39(defcommand prev-buffer)
40(defcommand new-frame)
41(defcommand my-execute-command "executeCommand")
42(defcommand j-print "print")
43(defcommand save-all-exit)
44(defcommand quit)
45(defcommand jump-to-line)
46(defcommand jump-to-column)
47(defcommand j-find "find")
48(defcommand incremental-find)
49(defcommand list-occurrences)
50(defcommand find-in-files)
51(defcommand list-files)
52(defcommand sidebar-list-tags)
53(defcommand j-replace "replace")
54(defcommand replace-in-files)
55(defcommand dir)
56(defcommand goto-bookmark)
57(defcommand help)
58(defcommand describe-key)
59(defcommand next-frame)
60(defcommand select-word)
61(defcommand kill-frame)
62(defcommand toggle-sidebar)
63(defcommand sidebar-list-buffers)
64(defcommand split-window)
65(defcommand unsplit-window)
66(defcommand other-window)
67(defcommand shell)
68
69(defvar *table* (make-hash-table :test #'equalp))
70
71;;; Object can be a symbol or a function.
72(defun assign-key (key object)
73  (setf (gethash key *table*) object))
74
75;;; The hook function.
76(defun key-pressed (&rest args)
77  (let* ((key (car args))
78         (value (gethash key *table*)))
79    (cond ((and value (symbolp value))
80           (funcall (symbol-function value)))
81          ((functionp value)
82           (funcall value)))))
83
84;;; Key assignments.
85(assign-key "Ctrl O"
86            #'(lambda ()
87               (location-bar-cancel-input)
88               (update-location-bar)
89               (open-file)))
90(assign-key "Ctrl Alt O"
91            #'(lambda () (open-file-in-other-window) (update-location-bar)))
92(assign-key "Ctrl Shift O" 'open-file-in-other-frame)
93;; Ctrl N is used for history in textfields.
94;; (assign-key "Ctrl N" 'new-buffer)
95(assign-key "Alt R" 'recent-files)
96(assign-key "Ctrl S" 'save)
97(assign-key "Ctrl Shift S" 'save-as)
98(assign-key "Ctrl Alt S" 'save-copy)
99(assign-key "F2" 'save-all)
100(assign-key "Ctrl F4" 'kill-buffer)
101(assign-key "Ctrl W" 'kill-buffer)
102(assign-key "Alt P" 'properties)
103(assign-key "Alt NumPad Right"
104            #'(lambda () (restore-focus) (next-buffer)))
105(assign-key "Alt Right"
106            #'(lambda () (restore-focus) (next-buffer)))
107(assign-key "Alt NumPad Left"
108            #'(lambda () (restore-focus) (prev-buffer)))
109(assign-key "Alt Left"
110            #'(lambda () (restore-focus) (prev-buffer)))
111(assign-key "Ctrl Shift N" 'new-frame)
112(assign-key "Alt X" 'my-execute-command)
113;; Ctrl P is used for history in textfields.
114;; (assign-key "Ctrl P" 'j-print)
115(assign-key "Ctrl Shift Q" 'save-all-exit)
116(assign-key "Ctrl Q" 'quit)
117(assign-key "Ctrl J" 'jump-to-line)
118(assign-key "Ctrl Shift J" 'jump-to-column)
119(assign-key "Alt F3" 'j-find)
120(assign-key "Ctrl F" 'incremental-find)
121(assign-key "Alt L" 'list-occurrences)
122(assign-key "F6" 'find-in-files)
123(assign-key "Ctrl Shift F" 'find-in-files)
124(assign-key "Ctrl L" 'list-files)
125(assign-key "Ctrl Shift L" 'sidebar-list-tags)
126(assign-key "Ctrl R" 'j-replace)
127(assign-key "Ctrl Shift R" 'replace-in-files)
128(assign-key "Ctrl D" 'dir)
129(assign-key "Ctrl 0" 'goto-bookmark)
130(assign-key "Ctrl 1" 'goto-bookmark)
131(assign-key "Ctrl 2" 'goto-bookmark)
132(assign-key "Ctrl 3" 'goto-bookmark)
133(assign-key "Ctrl 4" 'goto-bookmark)
134(assign-key "Ctrl 5" 'goto-bookmark)
135(assign-key "Ctrl 6" 'goto-bookmark)
136(assign-key "Ctrl 7" 'goto-bookmark)
137(assign-key "Ctrl 8" 'goto-bookmark)
138(assign-key "Ctrl 9" 'goto-bookmark)
139(assign-key "F1" 'help)
140(assign-key "Alt K" 'describe-key)
141(assign-key "Alt N" 'next-frame)
142(assign-key "Alt W" 'select-word)
143(assign-key "Ctrl Shift W" 'kill-frame)
144(assign-key "Alt =" 'toggle-sidebar)
145(assign-key "Alt B" 'sidebar-list-buffers)
146(assign-key "F10" 'split-window)
147(assign-key "Shift F10" 'unsplit-window)
148(assign-key "Alt O" 'other-window)
149(assign-key "Alt F9"
150            #'(lambda () (restore-focus) (shell)))
151
152;;; Enable the hook.
153(add-hook 'key-pressed-hook 'key-pressed)
154(setf (variable-value 'enable-key-pressed-hook :global) t)
Note: See TracBrowser for help on using the repository browser.