source: trunk/j/src/org/armedbear/lisp/j.lisp @ 4969

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

Removed RESTORE-FOCUS from exports.

File size: 4.2 KB
Line 
1;;; j.lisp
2
3(in-package "J")
4
5(push :j *features*)
6
7(export '(set-global-property
8          reset-display
9          log-debug
10          add-hook
11          invoke-hook
12          update-display
13          update-location-bar
14          location-bar-cancel-input
15          status
16          defcommand
17          open-file-hook
18          after-save-hook
19          key-pressed-hook
20          variable-value
21          with-editor
22          with-other-editor
23          with-single-undo))
24
25(defun set-global-property (&rest args)
26  (let ((count (length args)) key value)
27    (cond ((oddp count)
28           (error "odd number of arguments to SET-GLOBAL-PROPERTY"))
29          ((= count 2)
30           (%set-global-property (string (first args)) (second args)))
31          (t
32           (do ((args args (cddr args)))
33               ((null args) (values))
34             (%set-global-property (string (first args)) (second args)))))))
35
36(defun reset-display ()
37  (jstatic "resetDisplay" "org.armedbear.j.Editor"))
38
39(defun log-debug (control-string &rest args)
40  (%log-debug (apply 'format nil control-string args)))
41
42(defun add-hook (hook function)
43  (when (symbolp hook)
44    (unless (boundp hook) (set hook nil))
45    (let ((hook-functions (symbol-value hook)))
46      (unless (memq function hook-functions)
47        (setq hook-functions (cons function hook-functions))
48        (set hook hook-functions)))))
49
50(defun invoke-hook (hook &rest args)
51  (when (symbolp hook)
52    (unless (boundp hook) (set hook nil))
53    (let ((hooks (symbol-value hook)))
54      (dolist (function hooks)
55        (apply function args)))))
56
57(defun update-display (&optional ed)
58  (let ((method (jmethod "org.armedbear.j.Editor" "updateDisplay"))
59        (ed (or ed (current-editor))))
60    (jcall method ed)))
61
62(defun update-location-bar (&optional ed)
63  (let ((method (jmethod "org.armedbear.j.Editor" "updateLocation"))
64        (ed (or ed (current-editor))))
65    (jcall method ed)))
66
67(defun location-bar-cancel-input ()
68  (jstatic "cancelInput" "org.armedbear.j.LocationBar"))
69
70(defun status (string &optional ed)
71  (let ((method (jmethod "org.armedbear.j.Editor" "status" "java.lang.String"))
72        (ed (or ed (current-editor))))
73    (jcall method ed string)))
74
75;; Internal.
76(defun execute-command (command &optional ed)
77  (let ((method (jmethod "org.armedbear.j.Editor"
78                         "executeCommand" "java.lang.String"))
79        (ed (or ed (current-editor))))
80    (jcall method ed command)
81    (update-display ed)))
82
83(defmacro defcommand (name &optional (command nil))
84  (unless command
85    (setq command (remove #\- (string `,name))))
86  `(setf (symbol-function ',name)
87         (lambda () (execute-command ,command))))
88
89(defvar open-file-hook nil)
90
91(defvar after-save-hook nil)
92
93(defvar key-pressed-hook nil)
94
95(defun variable-value (name &optional (kind :current) where)
96  (%variable-value name kind where))
97
98(defun set-variable-value (name kind &rest rest)
99  (let (where new-value)
100    (case (length rest)
101      (1
102       (setq where nil
103             new-value (car rest)))
104      (2
105       (setq where (car rest)
106             new-value (cadr rest)))
107      (t
108       (error 'program-error "SET-VARIABLE-VALUE: wrong number of arguments")))
109    (%set-variable-value name kind where new-value)))
110
111(defsetf variable-value set-variable-value)
112
113(defsetf current-editor %set-current-editor)
114
115(defmacro with-editor (editor &rest forms)
116  (let ((old-editor (gensym)))
117  `(let ((,old-editor (current-editor)))
118     (unwind-protect
119      (progn
120        (setf (current-editor) ,editor)
121        ,@forms)
122      (update-display ,editor)
123      (setf (current-editor) ,old-editor)))))
124
125(defmacro with-other-editor (&rest forms)
126  (let ((old-editor (gensym))
127        (other-editor (gensym)))
128    `(let ((,old-editor (current-editor))
129           (,other-editor (other-editor)))
130       (unless ,other-editor
131         (error "there is no other editor"))
132       (unwind-protect
133        (progn
134          (setf (current-editor) ,other-editor)
135          ,@forms)
136        (update-display ,other-editor)
137        (setf (current-editor) ,old-editor)))))
138
139(defmacro with-single-undo (&rest forms)
140  (let ((info (gensym)))
141    `(let ((,info (begin-compound-edit)))
142       (unwind-protect
143        (progn ,@forms)
144        (end-compound-edit ,info)))))
145
146(in-package "COMMON-LISP-USER")
147(use-package "J")
Note: See TracBrowser for help on using the repository browser.