← Back to branch summary

~ubuntu-branches/ubuntu/intrepid/ecl/intrepid

« back to all changes in this revision

Viewing changes to src/util/emacs.el

  • Committer: Bazaar Package Importer
  • Author(s): Peter Van Eynde
  • Date: 2006-05-17 02:46:26 UTC
  • Revision ID: james.westby@ubuntu.com-20060517024626-lljr08ftv9g9vefl
Tags: upstream-0.9h-20060510
Import upstream version 0.9h-20060510

Show diffs side-by-side

added added

removed removed

Lines of Context:
src/util/emacs.el
 
1
(require 'cl)
 
2
 
 
3
(defun replace-in-files (matches files)
 
4
  (save-excursion
 
5
    (mapc (lambda (file)
 
6
            (switch-to-buffer (or (find-buffer-visiting file) (find-file file)))
 
7
            (mapc (lambda (x)
 
8
                    (beginning-of-buffer)
 
9
                    (let ((case-fold-search nil))
 
10
                      (print x)
 
11
                      (while (search-forward-regexp (car x) nil t)
 
12
                        (replace-match (cdr x) nil t)))
 
13
                    (save-buffer)
 
14
                    )
 
15
                  matches))
 
16
          files)))
 
17
 
 
18
(defun ecl-load-symbols ()
 
19
  (interactive)
 
20
  (beginning-of-buffer)
 
21
  (while (re-search-forward ";;; Address = \\([0-9a-f]*\\)" nil t)
 
22
    (let ((address (buffer-substring (match-beginning 1)
 
23
                                     (match-end 1))))
 
24
      (re-search-backward ";;; Loading \\(/.*\.o\\)$")
 
25
      (let ((file (buffer-substring (match-beginning 1)
 
26
                                    (match-end 1))))
 
27
        (print file) (print address)
 
28
        (save-excursion
 
29
          (gud-call (format "add-symbol-file %s 0x%s" file address))))
 
30
      (next-line 2))))
 
31
 
 
32
(defvar ecl-search-string)
 
33
 
 
34
(defun query-replace-ecl (from-string to-string &optional delimited start end)
 
35
  (interactive (query-replace-read-args "Query replace" nil))
 
36
  (setq ecl-search-string from-string)
 
37
  (let ((remaining (member (buffer-file-name (current-buffer)) ecl-files)))
 
38
    (dolist (i (or remaining ecl-files))
 
39
      (let ((b (find-buffer-visiting i)))
 
40
        (unless (equal b (current-buffer))
 
41
          (switch-to-buffer b)
 
42
          (beginning-of-buffer)))
 
43
      (perform-replace from-string to-string t nil delimited nil nil
 
44
                       start end))))
 
45
 
 
46
(defun search-ecl (string)
 
47
  (interactive "sString: ")
 
48
  (setq ecl-search-string string)
 
49
  (let ((remaining (member (buffer-file-name (current-buffer)) ecl-files)))
 
50
    (dolist (i (or remaining ecl-files))
 
51
      (let ((b (find-buffer-visiting i)))
 
52
        (unless (equal b (current-buffer))
 
53
          (print b)
 
54
          (switch-to-buffer b)
 
55
          (beginning-of-buffer)))
 
56
      (print '*)
 
57
      (setq case-fold-search t)
 
58
      (if (search-forward string nil t)
 
59
          (return)))))
 
60
 
 
61
(defun rewrite-ecl ()
 
62
  (interactive)
 
63
  (save-excursion
 
64
    (let ((case-fold-search nil))
 
65
      (while (re-search-forward "\\bL\\([XA_a-z=<>/0-9*]+\\)" nil t)
 
66
        (let* ((b (buffer-substring (match-beginning 0) (match-end 0)))
 
67
               (a (buffer-substring (match-beginning 1) (match-end 1))))
 
68
          (dotimes (i (length a))
 
69
            (case (aref a i)
 
70
              (?_ (aset a i ?-))
 
71
              (?X (aset a i ?*))
 
72
              (?A (aset a i ?&))))
 
73
          (setq a (concat "@" a))
 
74
          (when (y-or-n-p (concat "Replace " b " with " a " "))
 
75
            (replace-match a t t))))))
 
76
  (save-excursion
 
77
    (let ((case-fold-search nil))
 
78
      (while (re-search-forward "\\bsiL\\([XA_a-z=<>/0-9*]+\\)" nil t)
 
79
        (let* ((b (buffer-substring (match-beginning 0) (match-end 0)))
 
80
               (a (buffer-substring (match-beginning 1) (match-end 1))))
 
81
          (dotimes (i (length a))
 
82
            (case (aref a i)
 
83
              (?_ (aset a i ?-))
 
84
              (?X (aset a i ?*))
 
85
              (?A (aset a i ?&))))
 
86
          (setq a (concat "@si::" a))
 
87
          (when (y-or-n-p (concat "Replace " b " with " a " "))
 
88
            (replace-match a t t))))))
 
89
  (save-excursion
 
90
    (let ((case-fold-search nil))
 
91
      (while (re-search-forward "\\bS\\([XA_a-z=<>/0-9*]+\\)" nil t)
 
92
        (let* ((b (buffer-substring (match-beginning 0) (match-end 0)))
 
93
               (a (buffer-substring (match-beginning 1) (match-end 1))))
 
94
          (dotimes (i (length a))
 
95
            (case (aref a i)
 
96
              (?_ (aset a i ?-))
 
97
              (?X (aset a i ?*))
 
98
              (?A (aset a i ?&))))
 
99
          (setq a (concat "@'" a "'"))
 
100
          (when (y-or-n-p (concat "Replace " b " with " a " "))
 
101
            (replace-match a t t))))))
 
102
  (save-excursion
 
103
    (let ((case-fold-search nil))
 
104
      (while (re-search-forward "\\bclS\\([XA_a-z=<>/0-9*]+\\)" nil t)
 
105
        (let* ((b (buffer-substring (match-beginning 0) (match-end 0)))
 
106
               (a (buffer-substring (match-beginning 1) (match-end 1))))
 
107
          (dotimes (i (length a))
 
108
            (case (aref a i)
 
109
              (?_ (aset a i ?-))
 
110
              (?X (aset a i ?*))
 
111
              (?A (aset a i ?&))))
 
112
          (setq a (concat "@'" a "'"))
 
113
          (when (y-or-n-p (concat "Replace " b " with " a " "))
 
114
            (replace-match a t t))))))
 
115
  (save-excursion
 
116
    (let ((case-fold-search nil))
 
117
      (while (re-search-forward "\\bV\\([XA_a-z=<>/0-9*]+\\)" nil t)
 
118
        (let* ((b (buffer-substring (match-beginning 0) (match-end 0)))
 
119
               (a (buffer-substring (match-beginning 1) (match-end 1))))
 
120
          (dotimes (i (length a))
 
121
            (case (aref a i)
 
122
              (?_ (aset a i ?-))
 
123
              (?X (aset a i ?*))
 
124
              (?A (aset a i ?&))))
 
125
          (setq a (concat "@'*" a "*'"))
 
126
          (when (y-or-n-p (concat "Replace " b " with " a " "))
 
127
            (replace-match a t t))))))
 
128
  (save-excursion
 
129
    (let ((case-fold-search nil))
 
130
      (while (re-search-forward "\\bsiS\\([XA_a-z=<>/0-9*]+\\)" nil t)
 
131
        (let* ((b (buffer-substring (match-beginning 0) (match-end 0)))
 
132
               (a (buffer-substring (match-beginning 1) (match-end 1))))
 
133
          (dotimes (i (length a))
 
134
            (case (aref a i)
 
135
              (?_ (aset a i ?-))
 
136
              (?X (aset a i ?*))
 
137
              (?A (aset a i ?&))))
 
138
          (setq a (concat "@'si::" a "'"))
 
139
          (when (y-or-n-p (concat "Replace " b " with " a " "))
 
140
            (replace-match a t t))))))
 
141
  (save-excursion
 
142
    (let ((case-fold-search nil))
 
143
      (while (re-search-forward "\\bsiV\\([XA_a-z=<>/0-9*]+\\)" nil t)
 
144
        (let* ((b (buffer-substring (match-beginning 0) (match-end 0)))
 
145
               (a (buffer-substring (match-beginning 1) (match-end 1))))
 
146
          (dotimes (i (length a))
 
147
            (case (aref a i)
 
148
              (?_ (aset a i ?-))
 
149
              (?X (aset a i ?*))
 
150
              (?A (aset a i ?&))))
 
151
          (setq a (concat "@'si::*" a "*'"))
 
152
          (when (y-or-n-p (concat "Replace " b " with " a " "))
 
153
            (replace-match a t t))))))
 
154
  (save-excursion
 
155
    (let ((case-fold-search nil))
 
156
      (while (re-search-forward "\\bK\\([XA_a-z=<>/0-9*]+\\)" nil t)
 
157
        (let* ((b (buffer-substring (match-beginning 0) (match-end 0)))
 
158
               (a (buffer-substring (match-beginning 1) (match-end 1))))
 
159
          (dotimes (i (length a))
 
160
            (case (aref a i)
 
161
              (?_ (aset a i ?-))
 
162
              (?X (aset a i ?*))
 
163
              (?A (aset a i ?&))))
 
164
          (setq a (concat "@':" a "'"))
 
165
          (when (y-or-n-p (concat "Replace " b " with " a " "))
 
166
            (replace-match a t t)))))))
 
167
 
 
168
(defun search-next-ecl ()
 
169
  (interactive)
 
170
  (search-ecl ecl-search-string))
 
171
 
 
172
(defun back-to-emacs ()
 
173
  (interactive)
 
174
  (switch-to-buffer "emacs.el"))
 
175
 
 
176
(defun next-ecl ()
 
177
  (interactive)
 
178
  (let ((remaining (member (buffer-file-name (current-buffer)) ecl-files)))
 
179
    (when (cdr remaining)
 
180
      (switch-to-buffer (find-buffer-visiting (cadr remaining))))))
 
181
 
 
182
(global-set-key [?\221 ?\C-i] 'back-to-emacs)
 
183
(global-set-key [?\221 ?\C-s] 'search-ecl)
 
184
(global-set-key [?\221 ?\C-n] 'search-next-ecl)
 
185
(global-set-key [?\221 ?\C-m] 'next-ecl)
 
186
(global-set-key [?\221 ?\C-p] 'ecl-load-symbols)
 
187
 
 
188
(global-set-key [?\M-p ?\C-i] 'back-to-emacs)
 
189
(global-set-key [?\M-p ?\C-s] 'search-ecl)
 
190
(global-set-key [?\M-p ?\C-n] 'search-next-ecl)
 
191
(global-set-key [?\M-p ?\C-m] 'next-ecl)
 
192
(global-set-key [?\M-p ?\C-p] 'ecl-load-symbols)
 
193
 
 
194
(setq auto-mode-alist (acons "\\.d\\'" 'c-mode auto-mode-alist))
 
195
 
 
196
(setq ecl-files
 
197
      (mapcar (lambda (x)
 
198
                (set-buffer "emacs.el")
 
199
                (concat (subseq (buffer-file-name (current-buffer)) 0 -13) x))
 
200
              '(
 
201
"h/object.h"
 
202
"h/eval.h"
 
203
"h/external.h"
 
204
"h/stacks.h"
 
205
"c/character.d"
 
206
"c/gfun.d"
 
207
"c/num_comp.d"
 
208
"c/string.d"
 
209
"c/hash.d"
 
210
"c/num_log.d"
 
211
"c/structure.d"
 
212
"c/num_pred.d"
 
213
"c/symbol.d"
 
214
"c/cmpaux.d"
 
215
"c/instance.d"
 
216
"c/num_rand.d"
 
217
"c/all_symbols.d"
 
218
"c/symbols_list.h"
 
219
"c/num_sfun.d"
 
220
"c/tcp.d"
 
221
"c/alloc.d"
 
222
"c/number.d"
 
223
"c/time.d"
 
224
"c/alloc_2.d"
 
225
"c/dosdummy.d"
 
226
"c/package.d"
 
227
"c/apply.d"
 
228
"c/dostimes.d"
 
229
"c/list.d"
 
230
"c/pathname.d"
 
231
"c/array.d"
 
232
"c/dpp.c"
 
233
"c/load.d"
 
234
"c/predicate.d"
 
235
"c/typespec.d"
 
236
"c/assignment.d"
 
237
"c/earith.d"
 
238
"c/print.d"
 
239
;"c/unify.d"
 
240
"c/backq.d"
 
241
"c/error.d"
 
242
"c/macros.d"
 
243
"c/profile.d"
 
244
"c/unixfsys.d"
 
245
"c/big.d"
 
246
"c/eval.d"
 
247
"c/main.d"
 
248
"c/unixint.d"
 
249
"c/file.d"
 
250
"c/mapfun.d"
 
251
"c/read.d"
 
252
"c/unixsys.d"
 
253
"c/format.d"
 
254
"c/reference.d"
 
255
"c/num_arith.d"
 
256
"c/sequence.d"
 
257
"c/cfun.d"
 
258
"c/gbc.d"
 
259
"c/num_co.d"
 
260
"c/stacks.d"
 
261
"c/interpreter.d"
 
262
"c/compiler.d"
 
263
"c/disassembler.d"
 
264
"c/multival.d"
 
265
"c/threads.d"
 
266
"c/ffi.d"
 
267
"lsp/arraylib.lsp"
 
268
"lsp/assert.lsp"
 
269
"lsp/autoload.lsp"
 
270
"lsp/cmpinit.lsp"
 
271
"lsp/cmuutil.lsp"
 
272
"lsp/format.lsp"
 
273
"lsp/defmacro.lsp"
 
274
"lsp/defpackage.lsp"
 
275
"lsp/defstruct.lsp"
 
276
"lsp/describe.lsp"
 
277
"lsp/evalmacros.lsp"
 
278
"lsp/export.lsp"
 
279
"lsp/helpfile.lsp"
 
280
"lsp/iolib.lsp"
 
281
"lsp/listlib.lsp"
 
282
"lsp/loop.lsp"
 
283
"lsp/loop2.lsp"
 
284
"lsp/mislib.lsp"
 
285
"lsp/module.lsp"
 
286
"lsp/numlib.lsp"
 
287
"lsp/packlib.lsp"
 
288
"lsp/pprint.lsp"
 
289
"lsp/predlib.lsp"
 
290
"lsp/proclaim.lsp"
 
291
"lsp/seq.lsp"
 
292
"lsp/seqlib.lsp"
 
293
"lsp/setf.lsp"
 
294
"lsp/mp.lsp"
 
295
"lsp/top.lsp"
 
296
"lsp/trace.lsp"
 
297
"lsp/util.lsp"
 
298
"lsp/ffi.lsp"
 
299
"clos/boot.lsp"
 
300
"clos/builtin.lsp"
 
301
"clos/change.lsp"
 
302
"clos/cmpinit.lsp"
 
303
"clos/combin.lsp"
 
304
"clos/defclass.lsp"
 
305
"clos/fixup.lsp"
 
306
"clos/generic.lsp"
 
307
"clos/init.lsp"
 
308
"clos/inspect.lsp"
 
309
"clos/kernel.lsp"
 
310
"clos/macros.lsp"
 
311
"clos/method.lsp"
 
312
"clos/precomp.lsp"
 
313
"clos/print.lsp"
 
314
"clos/slot.lsp"
 
315
"clos/standard.lsp"
 
316
"clos/stdmethod.lsp"
 
317
"clos/walk.lsp"
 
318
"clos/conditions.lsp"
 
319
"cmp/cmpbind.lsp"
 
320
"cmp/cmpblock.lsp"
 
321
"cmp/cmpcall.lsp"
 
322
"cmp/cmpcatch.lsp"
 
323
"cmp/cmpdefs.lsp"
 
324
"cmp/cmpenv.lsp"
 
325
"cmp/cmpeval.lsp"
 
326
"cmp/cmpexit.lsp"
 
327
"cmp/cmpffi.lsp"
 
328
"cmp/cmpflet.lsp"
 
329
"cmp/cmpfun.lsp"
 
330
"cmp/cmpif.lsp"
 
331
"cmp/cmpinline.lsp"
 
332
"cmp/cmplam.lsp"
 
333
"cmp/cmplet.lsp"
 
334
"cmp/cmploc.lsp"
 
335
"cmp/cmpmac.lsp"
 
336
"cmp/cmpmain.lsp"
 
337
"cmp/cmpmap.lsp"
 
338
"cmp/cmpmulti.lsp"
 
339
"cmp/cmpspecial.lsp"
 
340
"cmp/cmptag.lsp"
 
341
"cmp/cmptest.lsp"
 
342
"cmp/cmptop.lsp"
 
343
"cmp/cmptype.lsp"
 
344
"cmp/cmputil.lsp"
 
345
"cmp/cmpvar.lsp"
 
346
"cmp/cmpwt.lsp"
 
347
"cmp/sysfun.lsp"
 
348
"clx/attributes.lisp"
 
349
"clx/buffer.lisp"
 
350
"clx/bufmac.lisp"
 
351
"clx/clx.lisp"
 
352
"clx/depdefs.lisp"
 
353
"clx/dependent.lisp"
 
354
"clx/display.lisp"
 
355
"clx/clx.lisp"
 
356
"clx/fonts.lisp"
 
357
"clx/gcontext.lisp"
 
358
"clx/graphics.lisp"
 
359
"clx/image.lisp"
 
360
"clx/input.lisp"
 
361
"clx/keysyms.lisp"
 
362
"clx/macros.lisp"
 
363
"clx/manager.lisp"
 
364
"clx/package.lisp"
 
365
"clx/requests.lisp"
 
366
"clx/resource.lisp"
 
367
"clx/shape.lisp"
 
368
"clx/text.lisp"
 
369
"clx/translate.lisp"
 
370
)))
 
371
 
 
372
(mapcar 'find-file ecl-files)
 
373
 
 
374
(defun ecl-revert ()
 
375
  (interactive)
 
376
  (mapcar '(lambda (x) (let ((a (find-buffer-visiting x)))
 
377
                         (and a (switch-to-buffer a)
 
378
                              (revert-buffer t t))))
 
379
          ecl-files))