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

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

BUFFER-ACTIVATED-HOOK

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