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

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

LOG.DEBUG => LOG-DEBUG

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