macros.el 8.52 KB
Newer Older
Linus Tolke's avatar
Linus Tolke committed
1
2
;;;;;
;;;;; $Id$
3
;;;;; Copyright (C) 1991, 1996  Lysator Academic Computer Association.
Linus Tolke's avatar
Linus Tolke committed
4
5
6
7
8
;;;;;
;;;;; This file is part of the LysKOM server.
;;;;; 
;;;;; LysKOM is free software; you can redistribute it and/or modify it
;;;;; under the terms of the GNU General Public License as published by 
9
;;;;; the Free Software Foundation; either version 2, or (at your option) 
Linus Tolke's avatar
Linus Tolke committed
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
;;;;; any later version.
;;;;; 
;;;;; LysKOM is distributed in the hope that it will be useful, but WITHOUT
;;;;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
;;;;; FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
;;;;; for more details.
;;;;; 
;;;;; You should have received a copy of the GNU General Public License
;;;;; along with LysKOM; see the file COPYING.  If not, write to
;;;;; Lysator, c/o ISY, Linkoping University, S-581 83 Linkoping, SWEDEN,
;;;;; or the Free Software Foundation, Inc., 675 Mass Ave, Cambridge, 
;;;;; MA 02139, USA.
;;;;;
;;;;; Please mail bug reports to bug-lyskom@lysator.liu.se. 
;;;;;
Per Cederqvist's avatar
.    
Per Cederqvist committed
25
26
27
28
29
30
31
32
33
;;;; ================================================================
;;;; ================================================================
;;;;
;;;; File: macros.el
;;;;
;;;; This file contains the macros which must be loaded before lyskom can
;;;; be compiled.
;;;;

34
35
36
(setq lyskom-clientversion-long
      (concat lyskom-clientversion-long
	      "$Id$\n"))
37

38
39
40
41
42
43
44
45
;;;
;;; Require parts of the widget package. We do this to avoid generating
;;; errors later on. This sucks. 
;;;

(require 'custom)
(require 'widget)

46

47
48


49
;;; ======================================================================
Per Cederqvist's avatar
.    
Per Cederqvist committed
50
;;; lyskom-traverse - traverse a sequence.
51
;;;
Per Cederqvist's avatar
.    
Per Cederqvist committed
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70

(defmacro lyskom-traverse (atom sequence &rest body)
  "Bind ATOM to each element in SEQUENCE and execute BODY.
Value returned is always nil."
  (list 'let* (list '(__i__ 0)
		    (list '__sequence__ sequence)
		    '(__len__ (length __sequence__))
		    atom)
	(list 'if '(listp __sequence__)
	      (append (list 'while '__sequence__
			    (list 'setq atom '(car __sequence__)))
		      body
		      (list '(setq __sequence__ (cdr __sequence__))))
	      (append (list 'while '(< __i__ __len__)
			    (list 'setq atom '(aref __sequence__ __i__)))
		      body
		      (list '(setq __i__ (1+ __i__)))))))


David Kågedal's avatar
David Kågedal committed
71
72
73
74
(put 'lyskom-traverse 'edebug-form-spec
     '(sexp form body))


75
76
77
;;; ======================================================================
;;; lyskom-save-excursion Does not save point and mark.
;;;
Per Cederqvist's avatar
.    
Per Cederqvist committed
78
79
80
81
82
83
84
85
86

(defmacro lyskom-save-excursion (&rest forms)
  "Save-excursion without saving point and mark."
  (list 'let (list '(__buffer__ (current-buffer)))
	(list 'unwind-protect
	      (cons 'progn
		    forms)
	      '(set-buffer __buffer__))))

David Kågedal's avatar
David Kågedal committed
87
(put 'lyskom-save-excursion 'edebug-form-spec t)
88
(put 'lyskom-provide-macro 'lisp-indent-hook 2)
David Kågedal's avatar
David Kågedal committed
89

90
91
92
;;; ======================================================================
;;; Some useful macros to make the code more readable.
;;;
Per Cederqvist's avatar
.    
Per Cederqvist committed
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109

(defmacro char-in-string (char string)
  "Return t if the character CHAR is member of STRING. Otherwise return nil."
  (list 'null
	(list 'not
	      (list 'string-match
		    (list 'regexp-quote
			  (list 'char-to-string char))
		    string))))

(defmacro ++ (var)
  "Increment the variable VAR and return the value."
  (list 'setq var (list '1+ var)))

(defmacro -- (var)
  "Decrement the variable VAR and return the value."
  (list 'setq var (list '1- var)))
110

111
112
113
114
115
116
117
118
119
120
121
122
123
124
(defmacro when (expr &rest body)
  "Execute BODY if EXPR evaluates to non-nil"
  (list 'if expr (cons 'progn body)))

(put 'when lisp-indent-function 1)
(put 'when 'edebug-form-spec t)

(defmacro unless (expr &rest body)
  "Execute BODY if EXPR evaluates to non-nil"
  (append (list 'if expr nil) body))

(put 'unless lisp-indent-function 1)
(put 'unless 'edebug-form-spec t)

125
126
127
128

;;; ======================================================================
;;; Multiple blocking read from server
;;;
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152

(defmacro blocking-do-multiple (bind-list &rest body)
  "Bind variables according to BIND-LIST and then eval BODY.
The value of the last form in BODY is returned.
Each element in BIND-LIST is a list (SYMBOL FORM) which binds SYMBOL to
the result of the server call FORM, which is the same as used in blocking-do.
All the forms in BIND-LIST are evaluated before and symbols are bound."
  (let ((bindsym 'multiple-bind-sym)
	(index 0))
    (` (let (((, bindsym)
	      (lyskom-blocking-do-multiple
	       (list (,@ (mapcar (function (lambda (x) 
					     (` (list '(, (car (car (cdr x))))
						      (,@ (cdr (car (cdr x))))))))
			   bind-list))))))
	 (let ((,@ (mapcar (function 
			    (lambda (bpat)
			      (prog1
				  (` ((, (car bpat))
				      (elt (, bindsym) (, index))))
				(setq index (1+ index)))))
			   bind-list)))
	   (,@ body))))))

David Kågedal's avatar
David Kågedal committed
153
154
(put 'blocking-do-multiple 'edebug-form-spec
     '(sexp body))
155

David Kågedal's avatar
David Kågedal committed
156
(put 'blocking-do-multiple 'lisp-indent-function 1)
David Kågedal's avatar
David Kågedal committed
157

158

159
160
161
;;; ======================================================================
;;; These macros do magic things to the compiler to avoid gratuitous
;;; compiler warnings.
162
;;;
163

164
(eval-and-compile (defvar lyskom-expected-unresolved-functions nil))
165
166
167
168
169
170
171
172
173
174

(defmacro lyskom-external-function (fn)
  (` (eval-when-compile
       (setq lyskom-expected-unresolved-functions
             (cons (quote (, fn))
                   lyskom-expected-unresolved-functions)))))

(defmacro lyskom-end-of-compilation ()
  (` 
   (eval-when-compile
175
176
177
178
     (progn
       (if (and (boundp 'byte-compile-unresolved-functions)
                (consp (car-safe byte-compile-unresolved-functions))
                (symbolp (car-safe (car-safe 
179
                                    byte-compile-unresolved-functions))))
180
181
182
183
184
185
186
187
188
189
190
191
192
           (mapcar (function (lambda (x)
                               (setq byte-compile-unresolved-functions
                                     (delq
                                      (assq x
                                            byte-compile-unresolved-functions)
                                      byte-compile-unresolved-functions))))
                   lyskom-expected-unresolved-functions))
       (if lyskom-compatibility-definitions
           (message "Compatibility definitions: %s"
                    (mapconcat '(lambda (sym)
                                  (symbol-name sym))
                               lyskom-compatibility-definitions
                               ", ")))))))
193
194
195
196
197
198
199
200
201
202
203

;;; ================================================================
;;;         Faces

(defmacro lyskom-make-face (name &rest body)
  (` (if (memq (, name) (face-list))
	 nil
       (,@ body))))

(put 'lyskom-make-face 'lisp-indent-function 1)

David Byers's avatar
X    
David Byers committed
204
205
206
207
208
209
210
211
212
213
214
215
216

;;; ============================================================
;;; Keymap handling
;;;

(defmacro lyskom-use-local-map (keymap)
  "Use keymap KEYMAP as local map in this buffer. KEYMAP is made local in
the current buffer, and its value is copied from the LysKOM buffer."
  (` (progn (make-local-variable (quote (, keymap)))
            (setq (, keymap)
                  (lyskom-default-value (quote (, keymap))))
            (use-local-map (, keymap)))))

217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232

;;; ============================================================
;;; Widget gunk
;;;

(defmacro lyskom-widget-wrapper (fn)
  (` (if (not (fboundp (quote (, fn))))
         (defun (, fn) (&rest args)
           (require 'custom)            ; lww
           (require 'widget)            ; lww
           (require 'wid-edit)          ; lww
           (require 'wid-browse)        ; lww
           (require 'cus-edit)          ; lww
           (require 'cus-face)          ; lww
           (apply (quote (, fn)) args)))))

David Byers's avatar
David Byers committed
233
(lyskom-widget-wrapper define-widget)
234
235
236
237
238
239
240
241
242
243
(lyskom-widget-wrapper widget-at)
(lyskom-widget-wrapper widget-value)
(lyskom-widget-wrapper widget-button-click)
(lyskom-widget-wrapper widget-setup)
(lyskom-widget-wrapper widget-value-set)
(lyskom-widget-wrapper widget-insert)
(lyskom-widget-wrapper widget-create)
(lyskom-widget-wrapper widget-get)
(lyskom-widget-wrapper widget-put)

244
245
246
247
248
249
250
251
252
253
254
255
;;; ============================================================
;;; Signal gunk
;;;

(defmacro lyskom-ignore-errors (&rest forms)
  (` (condition-case nil
         (progn (,@ forms))
       (error nil))))

(put 'ignore-errors 'edebug-form-spec
     '(sexp form body))

256

David Byers's avatar
X    
David Byers committed
257
258
259
260
261
262
263
264
;;; ============================================================
;;; Local variables
;;;

(defmacro lyskom-setq-default (name value)
  (` (lyskom-set-default (quote (, name))
                         (, value))))

265
266
(eval-and-compile (provide 'lyskom-macros))

267
268
;;; Local Variables: 
;;; eval: (put 'lyskom-traverse 'lisp-indent-hook 2)
269
270
;;; eval: (put 'lyskom-save-excursion 'lisp-indent-hook 2)
;;; eval: (put 'lyskom-ignore-errors 'lisp-indent-hook 2)
271
;;; end: