macros.el 7.1 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
;;; ======================================================================
Per Cederqvist's avatar
.    
Per Cederqvist committed
42
;;; lyskom-traverse - traverse a sequence.
43
;;;
Per Cederqvist's avatar
.    
Per Cederqvist committed
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62

(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
63
64
65
66
(put 'lyskom-traverse 'edebug-form-spec
     '(sexp form body))


67
68
69
;;; ======================================================================
;;; lyskom-save-excursion Does not save point and mark.
;;;
Per Cederqvist's avatar
.    
Per Cederqvist committed
70
71
72
73
74
75
76
77
78

(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
79
80
(put 'lyskom-save-excursion 'edebug-form-spec t)

81
82
83
;;; ======================================================================
;;; Some useful macros to make the code more readable.
;;;
Per Cederqvist's avatar
.    
Per Cederqvist committed
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100

(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)))
101

102
103
104
105
106
107
108
109
110
111
112
113
114
115
(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)

116
117
118
119

;;; ======================================================================
;;; Multiple blocking read from server
;;;
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143

(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
144
145
(put 'blocking-do-multiple 'edebug-form-spec
     '(sexp body))
146

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

149

150
151
152
;;; ======================================================================
;;; These macros do magic things to the compiler to avoid gratuitous
;;; compiler warnings.
153
;;;
154

David Kågedal's avatar
David Kågedal committed
155
156
;; (eval-when-compile (defvar lyskom-expected-unresolved-functions nil))
(defvar lyskom-expected-unresolved-functions nil)
157
158
159
160
161
162
163
164
165
166

(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
167
168
169
170
     (progn
       (if (and (boundp 'byte-compile-unresolved-functions)
                (consp (car-safe byte-compile-unresolved-functions))
                (symbolp (car-safe (car-safe 
171
                                    byte-compile-unresolved-functions))))
172
173
174
175
176
177
178
179
180
181
182
183
184
           (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
                               ", ")))))))
185
186
187
188
189
190
191
192
193
194
195

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

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

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

David Kågedal's avatar
David Kågedal committed
196
(provide 'lyskom-macros)
197

David Byers's avatar
X    
David Byers committed
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219

;;; ============================================================
;;; 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)))))

;;; ============================================================
;;; Local variables
;;;

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


220
221
222
;;; Local Variables: 
;;; eval: (put 'lyskom-traverse 'lisp-indent-hook 2)
;;; end: