-
Notifications
You must be signed in to change notification settings - Fork 2
/
Copy pathaml-elder.el
executable file
·329 lines (284 loc) · 11.4 KB
/
aml-elder.el
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
;;; aml-elder.el ---
;;;----------------------------------------------------------------------
;; Author: Antonio Menezes Leitao <aml@gia.ist.utl.pt>
;; Created on: Sat Jul 8 10:03:31 2006
;; Keywords:
;;
;; Copyright (C) 2006 Antonio Menezes Leitao
;; This program is not part of GNU Emacs
;; This program is free software; you can redistribute it and/or
;; modify it under the terms of the GNU General Public License as
;; published by the Free Software Foundation; either version 2, or (at
;; your option) any later version.
;; This program 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 GNU Emacs; see the file COPYING. If not, write to the
;; Free Software Foundation, 675 Massachusettes Ave, Cambridge, MA
;; 02139, USA.
;;; Commentary:
;;
;;; Code:
(require 'elder)
;;This will use the base mode for any <file>.<base-mode>.e
(add-to-list 'auto-mode-alist '("\\.e\\'" ignore t))
;;Utility functions for elder
(defun e-replace-text (area)
(if (string-match "\\(.+\\)$" area)
(let ((name (substring area (match-beginning 1) (match-end 1)))
(replacement (substring area (1+ (match-end 0)))))
(end-of-line)
(while (re-search-forward name nil t)
(replace-match replacement t t)))
(error "Couldn't identify the text to replace")))
(defun e-replace-rect (area)
(let ((strings (list))
(pos 0))
(while (string-match "\\(.+\\)$" area pos)
(setq pos (match-end 0))
(push (substring area (match-beginning 1) (match-end 1)) strings))
(setq strings (nreverse strings))
(if (endp strings)
(error "Couldn't identify the text to replace")
(let ((name (first strings))
(replacements (rest strings)))
(end-of-line)
(while (re-search-forward name nil t)
(replace-match "" t t)
(let ((end (point))
(start (save-excursion (beginning-of-line) (point))))
(let ((fill (buffer-substring start end)))
(delete-region start (1+ end))
(dolist (str replacements)
(insert fill)
(insert str)
(insert "\n")))))
""))))
;;And now, hook into opening and closing files.
(defvar *dont-check-elder-file* nil)
(defun find-file-for-elder ()
"Function for `find-file-hooks' activating checking of elder files."
(unless *dont-check-elder-file*
(when buffer-file-name
(let ((elder-file-name (concat buffer-file-name ".e")))
(cond ((file-exists-p elder-file-name)
(when (y-or-n-p "This seems to be an elder processed file. Shall I open the source instead? ")
;;(setq buffer-read-only t) ;;protect current file
;;even better, kill it
(kill-buffer (get-file-buffer buffer-file-name))
(find-file elder-file-name)))
;; ((string= (file-name-extension buffer-file-name) ".e") ;;this is the elder file
;; (set-auto-mode))
)))))
(defun save-file-for-elder ()
"Function for `find-file-hooks' activating checking of elder files."
(when buffer-file-name
(when (string= (file-name-extension buffer-file-name) "e") ;;this is the elder file
(when (y-or-n-p "Process this elder buffer after save?")
(if (string= (file-name-extension (file-name-sans-extension buffer-file-name)) "tex")
(elder-etex-this-file)
(let ((buff (get-file-buffer buffer-file-name)))
(elder buffer-file-name)
;; (kill-buffer buff)
))))))
(add-hook 'find-file-hooks 'find-file-for-elder)
(add-hook 'after-save-hook 'save-file-for-elder)
;; FILCAB
;; Put the elder stuff for LaTeX in an advice for TeX-command-master
(defadvice TeX-command-master
(before maybe-elder-and-TeX-command-master
preactivate compile)
"If we're in an Elder file, we'll run Elder on it and run
TeX-command-master on the resulting file"
(when (string-match "\\.e\\'" buffer-file-name)
(let ((tex-file (substring buffer-file-name 0 (match-beginning 0))))
(elder-etex-this-file)
(let ((*dont-check-elder-file* t))
(let ((buffer (find-buffer-visiting tex-file)))
(when buffer
(kill-buffer buffer)))
(find-file-read-only-other-window tex-file)))))
;; (defun maybe-elder-and-TeX-command-master ()
;; (interactive)
;; (when (string-match "\\.e\\'" buffer-file-name)
;; (let ((tex-file (substring buffer-file-name 0 (match-beginning 0))))
;; (elder-etex-this-file)
;; (let ((*dont-check-elder-file* t))
;; (let ((buffer (find-buffer-visiting tex-file)))
;; (when buffer
;; (kill-buffer buffer)))
;; (find-file-read-only-other-window tex-file))))
;; (TeX-command-master))
(defun jump-over (text)
"Remove the region."
"")
;;Tables
;;We need a model:
(defstruct table-cell
row
column
element
bold)
(defstruct table-row
cells)
(defstruct table
cell-alignment
cell-key
rows)
(defmacro* table ((&key column-alignment (cell-key '#'table-cell-element)) &rest args)
`(make-table
:rows (list ,@args)
:cell-key ,cell-key))
(defun titles (&rest args)
(make-table-row
:cells (mapcar #'(lambda (arg)
(make-table-cell :element arg :bold t))
args)))
(defun line (&rest args)
(make-table-row
:cells (mapcar #'(lambda (arg)
(make-table-cell :element arg))
args)))
(defun check-table-layout (table)
(let ((columns-cols
(mapcar (lambda (row)
(length (table-row-cells row)))
(table-rows table))))
(let ((first (first columns-cols)))
(dolist (row (rest columns-cols))
(assert (= first row) () "There are rows with a different number of collumns"))))
;;assign position
(loop for i upfrom 0
for row in (table-rows table)
do (loop for j upfrom 0
for cell in (table-row-cells row)
do (setf (table-cell-row cell) i
(table-cell-column cell) j))))
(defun transpose-table (table)
(make-table
:cell-key (table-cell-key table)
:cell-alignment (table-cell-alignment table)
:rows (apply #'mapcar*
#'(lambda (&rest args)
(make-table-row :cells args))
(mapcar #'table-row-cells (table-rows table)))))
(defun* fmt (fmt-str &rest args)
(princ (apply #'format fmt-str args)))
(defun print-table (table)
(check-table-layout table)
(with-output-to-string
(let ((columns (length (table-row-cells (first (table-rows table))))))
(fmt "\\begin{tabular}{")
(dotimes (i columns)
(fmt "@{}c@{}"))
(fmt "}\n"))
(dolist (row (table-rows table))
(print-table-row table row))
(fmt "\\end{tabular}\n")))
(defun print-table-row (table row)
(let ((first t))
(dolist (cell (table-row-cells row))
(if first
(setf first nil)
(fmt " & "))
(print-table-cell table row cell))
(fmt "\\\\\n")))
(defun print-table-cell (table row cell)
(let ((contents (funcall (table-cell-key table) cell)))
(cond (nil ;;check here multirows, multicolumns, different alignment, etc
(fmt "\\multicolumn{c}{")
(fmt "%s" contents)
(fmt "}"))
((table-cell-bold cell)
(fmt "\\textbf{")
(fmt "%s" contents)
(fmt "}"))
(t
(fmt "%s" contents)))))
;;TO BE FINISHED
;; (defun compact-lines-columns (types-ranges)
;; (mapcar #'cons
;; (mapcar #'compact-multicolumns (compact-multi-lines (mapcar #'first types-ranges)))
;; (mapcar #'rest types-ranges)))
;; (defun extend-right (item extension)
;; (multiple-value-bind (lines cols)
;; (if (consp extension)
;; (values-list (rest extension))
;; (values 1 1))
;; (if (consp item)
;; (list (first item) (second item) (+ (third item) cols))
;; (list item lines (1+ cols)))))
;; (defun compact-multi-lines (types)
;; (if (endp (first types))
;; types
;; (mapcar #'cons (compact-lines (mapcar #'first types)) (compact-multi-lines (mapcar #'rest types)))))
;; (defun compact-lines (types)
;; (maplist #'(lambda (types)
;; (cond ((eq (first types) '&)
;; '_)
;; ((eq (first (rest types)) '&)
;; (list (first types)
;; (loop :for i :from 1
;; :for type :in (rest types)
;; :while (eq type '&)
;; :finally (return i))
;; 1))
;; (t
;; (first types))))
;; types))
;; (defun compact-multicolumns (types)
;; "Translates from ... T & & ... to ... (T 1 3) ..."
;; (cond ((endp types) (list))
;; ((extend-right-p (first types))
;; (error "Unmatched right extension"))
;; ((extend-right-p (second types))
;; (compact-multicolumns
;; (if (empty-cell-p (first types))
;; (cons (first types)
;; (compact-multicolumns (cons (first types) (rest (rest types)))))
;; (cons (extend-right (first types) (second types))
;; (rest (rest types))))))
;; ((consp (first types))
;; (cons (first types)
;; (compact-multicolumns (rest types))))
;; (t
;; (cons (list (first types) 1 1)
;; (compact-multicolumns (rest types))))))
(provide 'aml-elder)
;; (print-table
;; (let ((b "Basic") (p "Pascal") (f "Fortran") (c "C") (fl "FranzLisp") (s "Scheme") (ll "LeLisp") (z "ZetaLisp") (el "EmacsLisp")
;; (cl "CommonLisp") (e "Eiffel") (cc "C++") (sm "Smalltalk") (oc "Objective-C") (j "Java"))
;; (table
;; (:cell-key (lambda (c)
;; (if (and (> (table-cell-row c) 0) (> (table-cell-column c) 0))
;; (format "\\circle{%s}" (table-cell-element c))
;; (table-cell-element c))))
;; (titles "" b p f c fl s ll z el cl e cc sm oc j)
;; (line 1981 5 0 0 0 0 0 0 0 0 0 0 0 0 0 0)
;; (line 1982 10 0 0 0 0 0 0 0 0 0 0 0 0 0 0)
;; (line 1983 10 0 0 0 0 0 0 0 0 0 0 0 0 0 0)
;; (line 1984 0 7 3 0 0 0 0 0 0 0 0 0 0 0 0)
;; (line 1985 0 10 5 0 0 0 0 0 0 0 0 0 0 0 0)
;; (line 1986 0 0 3 10 5 5 5 0 3 0 0 0 0 0 0)
;; (line 1987 0 0 0 10 10 10 10 0 5 0 0 0 0 0 0)
;; (line 1988 0 0 0 10 5 10 5 10 8 0 0 0 0 0 0)
;; (line 1989 0 0 0 10 0 10 0 10 10 0 0 0 0 0 0)
;; (line 1990 0 0 0 0 0 5 0 10 10 0 3 4 8 5 0)
;; (line 1991 0 0 0 0 0 0 0 0 10 10 0 6 0 10 0)
;; (line 1992 0 0 0 10 0 0 0 0 10 10 0 0 0 10 0)
;; (line 1993 0 0 0 0 0 0 0 0 10 10 0 0 0 5 0)
;; (line 1994 0 0 0 0 0 0 0 0 10 10 0 10 0 0 0)
;; (line 1995 0 0 0 0 0 0 0 0 10 10 0 10 0 0 0)
;; (line 1996 0 0 0 0 0 0 0 0 10 10 0 0 0 0 10)
;; (line 1997 0 0 0 0 0 0 0 0 10 10 0 0 0 0 10)
;; (line 1998 0 0 0 0 0 0 0 0 10 10 0 0 0 0 10)
;; (line 1999 0 0 0 0 0 0 0 0 10 10 0 0 0 0 10)
;; (line 2000 0 0 0 0 0 0 0 0 10 10 0 0 0 0 10)
;; (line 2001 0 0 0 0 0 0 0 0 10 10 0 0 0 0 10)
;; (line 2002 0 0 0 0 0 0 0 0 10 10 0 0 0 0 10)
;; (line 2003 0 0 0 0 0 0 0 0 10 10 0 0 0 0 10)
;; (line 2004 0 0 0 0 0 0 0 0 10 10 0 0 0 0 10)
;; (line 2005 0 0 0 0 0 0 0 0 10 10 0 0 0 0 10)
;; (line 2006 0 0 0 0 0 0 0 0 10 10 0 0 10 0 10))))