|
996
|
1 ;;; intercal.el -- mode for editing INTERCAL code
|
|
|
2
|
|
|
3 ;; This mode was written by Eric S. Raymond <esr@snark.thyrsus.com>
|
|
|
4 ;; for the C-INTERCAL distribution, and is copyrighted by him 1992. Free
|
|
|
5 ;; redistribution encouraged. Someday, maybe, this will be made part of GNU.
|
|
|
6 ;; But probably not unless they take many mind-eroding drugs first.
|
|
|
7
|
|
|
8 ;; This mode provides abbrevs for C-INTERCAL's statements, including COME FROM.
|
|
|
9 ;; These abbrevs are context-sensitive and will generate either verb or gerund
|
|
|
10 ;; form as appropriate. The keys RET, ( and * are also bound in useful ways.
|
|
|
11
|
|
|
12 ;; The intercal-politesse-level adjustment purports to assist the hapless
|
|
|
13 ;; INTERCAL programmer in meeting INTERCAL's Miss Manners requirement. In
|
|
|
14 ;; INTERCAL-72 and C-INTERCAL releases after 0.7, no fewer than 1/5 and no
|
|
|
15 ;; more than 1/3 of the program statements must contain a PLEASE to gratify
|
|
|
16 ;; the iron whim of the INTERCAL compiler; this mode assists by randomly
|
|
|
17 ;; expanding some fraction of the "do" abbrevs typed to PLEASE DO.
|
|
|
18 ;; The intercal-politesse-level constant is the denominator of this fraction.
|
|
|
19
|
|
|
20 ;; AIS: I corrected the READ/WRITE, IN/OUT reversal independent of the correction
|
|
|
21 ;; that happened from 0.22 to 0.24 (this code was originally based on the 0.22
|
|
|
22 ;; distribution and updated for 0.24 compatibility); this version is distributed
|
|
|
23 ;; with C-INTERCAL 0.27.
|
|
|
24 ;;
|
|
|
25 ;; I also altered the code for ( so the user didn't have to go to the beginning
|
|
|
26 ;; of the line, added C-c C-[a,c,r,s] for convenience when working with
|
|
|
27 ;; constants, and added support for TRY AGAIN, ONCE, AGAIN, and Font Lock.
|
|
|
28 ;; I added support for M-x compile so it could compile INTERCAL programs
|
|
|
29 ;; correctly (assuming that ick has been installed).
|
|
|
30
|
|
|
31 ;; $Id: intercal.el,v 1.5 1996/11/14 04:02:00 esr Exp $
|
|
|
32
|
|
|
33 (defconst intercal-politesse-level 4
|
|
|
34 "Fraction of DOs that are automagically expanded to PLEASE DO.")
|
|
|
35
|
|
|
36 (defvar intercal-mode-map nil
|
|
|
37 "Keymap for INTERCAL mode.")
|
|
|
38 (if intercal-mode-map
|
|
|
39 nil
|
|
|
40 (setq intercal-mode-map (make-sparse-keymap))
|
|
|
41 (define-key intercal-mode-map "\t" 'tab-to-tab-stop)
|
|
|
42 (define-key intercal-mode-map "\r" 'intercal-return)
|
|
|
43 (define-key intercal-mode-map "\C-J" 'intercal-return)
|
|
|
44 (define-key intercal-mode-map "\C-C\C-C" 'intercal-constant-convert) ;AIS
|
|
|
45 (define-key intercal-mode-map "\C-C\C-R" 'intercal-constant-radix-convert) ;AIS
|
|
|
46 (define-key intercal-mode-map "\C-C\C-S" 'intercal-char-constant-convert) ;AIS
|
|
|
47 (define-key intercal-mode-map "\C-C\C-A" 'intercal-string-array-convert) ;AIS
|
|
|
48 (define-key intercal-mode-map "\C-C\C-U" 'intercal-lnu) ;AIS
|
|
|
49 (define-key intercal-mode-map "(" 'intercal-paren)
|
|
|
50 (define-key intercal-mode-map "*" 'intercal-splat)
|
|
|
51 (define-key intercal-mode-map "\177" 'backward-delete-char-untabify)
|
|
|
52 )
|
|
|
53
|
|
|
54 (defvar intercal-mode-syntax-table nil
|
|
|
55 "Syntax table in use in Intercal-mode buffers.")
|
|
|
56
|
|
|
57 (if intercal-mode-syntax-table
|
|
|
58 nil
|
|
|
59 (let ((table (make-syntax-table)))
|
|
|
60 (modify-syntax-entry ?\\ "\\" table)
|
|
|
61 (modify-syntax-entry ?+ "." table)
|
|
|
62 (modify-syntax-entry ?- "." table)
|
|
|
63 (modify-syntax-entry ?= "." table)
|
|
|
64 (modify-syntax-entry ?% "." table)
|
|
|
65 (modify-syntax-entry ?< "." table)
|
|
|
66 (modify-syntax-entry ?> "." table)
|
|
|
67 (modify-syntax-entry ?& "." table)
|
|
|
68 (modify-syntax-entry ?| "." table)
|
|
|
69 (modify-syntax-entry ?\' "\"" table)
|
|
|
70 (setq intercal-mode-syntax-table table)))
|
|
|
71
|
|
|
72 (defvar intercal-mode-abbrev-table nil
|
|
|
73 "*Abbrev table in use in Intercal-mode buffers.")
|
|
|
74 (if intercal-mode-abbrev-table
|
|
|
75 nil
|
|
|
76 (define-abbrev-table 'intercal-mode-abbrev-table ())
|
|
|
77 (define-abbrev intercal-mode-abbrev-table "pl" "PLEASE" nil)
|
|
|
78 (define-abbrev intercal-mode-abbrev-table "on" "ONCE" nil) ;AIS
|
|
|
79 (define-abbrev intercal-mode-abbrev-table "ag" "AGAIN" nil) ;AIS
|
|
|
80 (define-abbrev intercal-mode-abbrev-table "ne" "" 'intercal-ne-abbrev)
|
|
|
81 (define-abbrev intercal-mode-abbrev-table "fo" "" 'intercal-fo-abbrev)
|
|
|
82 (define-abbrev intercal-mode-abbrev-table "res" "" 'intercal-res-abbrev)
|
|
|
83 (define-abbrev intercal-mode-abbrev-table "st" "" 'intercal-st-abbrev)
|
|
|
84 (define-abbrev intercal-mode-abbrev-table "ret" "" 'intercal-ret-abbrev)
|
|
|
85 (define-abbrev intercal-mode-abbrev-table "ig" "" 'intercal-ig-abbrev)
|
|
|
86 (define-abbrev intercal-mode-abbrev-table "rem" "" 'intercal-rem-abbrev)
|
|
|
87 (define-abbrev intercal-mode-abbrev-table "ab" "" 'intercal-ab-abbrev)
|
|
|
88 (define-abbrev intercal-mode-abbrev-table "rei" "" 'intercal-rei-abbrev)
|
|
|
89 (define-abbrev intercal-mode-abbrev-table "gi" "" 'intercal-gi-abbrev)
|
|
|
90 (define-abbrev intercal-mode-abbrev-table "rea" "" 'intercal-rea-abbrev)
|
|
|
91 (define-abbrev intercal-mode-abbrev-table "wr" "" 'intercal-wr-abbrev)
|
|
|
92 (define-abbrev intercal-mode-abbrev-table "co" "" 'intercal-co-abbrev)
|
|
|
93 (define-abbrev intercal-mode-abbrev-table "do" "" 'intercal-do-abbrev)
|
|
|
94 (define-abbrev intercal-mode-abbrev-table "wh" "" 'intercal-wh-abbrev) ;AIS
|
|
|
95 (define-abbrev intercal-mode-abbrev-table "goa" "" 'intercal-goa-abbrev) ;AIS
|
|
|
96 (define-abbrev intercal-mode-abbrev-table "gob" "" 'intercal-gob-abbrev) ;AIS
|
|
|
97 (define-abbrev intercal-mode-abbrev-table "cr" "" 'intercal-cr-abbrev) ;AIS
|
|
|
98 (define-abbrev intercal-mode-abbrev-table "ma" "MAYBE" nil) ;AIS
|
|
|
99 (define-abbrev intercal-mode-abbrev-table "tr" "" 'intercal-tr-abbrev) ;AIS
|
|
|
100 (define-abbrev intercal-mode-abbrev-table "cal" "" 'intercal-cal-abbrev) ;AIS
|
|
|
101 )
|
|
|
102
|
|
|
103 (defun use-gerund ()
|
|
|
104 (save-excursion
|
|
|
105 (beginning-of-line)
|
|
|
106 (or (looking-at ".*ABSTAIN") (looking-at ".*REINSTATE"))))
|
|
|
107
|
|
|
108 (defmacro make-intercal-abbrev (sym gerund verb)
|
|
|
109 (list 'defun sym '() (list 'insert (list 'if '(use-gerund) gerund verb))))
|
|
|
110
|
|
|
111 (make-intercal-abbrev intercal-ne-abbrev "NEXTING" "NEXT")
|
|
|
112 (make-intercal-abbrev intercal-fo-abbrev "FORGETTING" "FORGET")
|
|
|
113 (make-intercal-abbrev intercal-res-abbrev "RESUMING" "RESUME")
|
|
|
114 (make-intercal-abbrev intercal-st-abbrev "STASHING" "STASH")
|
|
|
115 (make-intercal-abbrev intercal-ret-abbrev "RETRIEVING" "RETRIEVE")
|
|
|
116 (make-intercal-abbrev intercal-ig-abbrev "IGNORING" "IGNORE")
|
|
|
117 (make-intercal-abbrev intercal-rem-abbrev "REMEMBERING" "REMEMBER")
|
|
|
118 (make-intercal-abbrev intercal-ab-abbrev "ABSTAINING" "ABSTAIN FROM")
|
|
|
119 (make-intercal-abbrev intercal-rei-abbrev "REINSTATING" "REINSTATE")
|
|
|
120 (make-intercal-abbrev intercal-gi-abbrev "GIVING UP" "GIVE UP")
|
|
|
121 (make-intercal-abbrev intercal-rea-abbrev "READING OUT" "READ OUT")
|
|
|
122 (make-intercal-abbrev intercal-wr-abbrev "WRITING IN" "WRITE IN")
|
|
|
123 (make-intercal-abbrev intercal-co-abbrev "COMING FROM" "COME FROM")
|
|
|
124 (make-intercal-abbrev intercal-tr-abbrev "TRYING AGAIN" "TRY AGAIN") ;AIS
|
|
|
125 (make-intercal-abbrev intercal-cal-abbrev "CALCULATING" "cal") ;AIS
|
|
|
126 (make-intercal-abbrev intercal-wh-abbrev "WHILING" "WHILE") ;AIS
|
|
|
127 (make-intercal-abbrev intercal-goa-abbrev "GOING AHEAD" "GO AHEAD") ;AIS
|
|
|
128 (make-intercal-abbrev intercal-gob-abbrev "GOING BACK" "GO BACK") ;AIS
|
|
|
129 (make-intercal-abbrev intercal-cr-abbrev "CREATION" "CREATE") ;AIS
|
|
|
130
|
|
|
131 (defun intercal-do-abbrev ()
|
|
|
132 "Emit a DO (usually). Occasionally, emit PLEASE DO."
|
|
|
133 (insert
|
|
|
134 (if (zerop (% (random) intercal-politesse-level))
|
|
|
135 "PLEASE DO"
|
|
|
136 "DO")
|
|
|
137 ))
|
|
|
138
|
|
|
139 (defun intercal-return ()
|
|
|
140 "Insert LFD + tab, to bring us back to code-indent level."
|
|
|
141 (interactive)
|
|
|
142 (if (eolp) (delete-horizontal-space))
|
|
|
143 (insert "\n")
|
|
|
144 (delete-horizontal-space) ;AIS
|
|
|
145 (tab-to-tab-stop)
|
|
|
146 (if intercal-lnu-mode (intercal-lnu)) ;AIS
|
|
|
147 )
|
|
|
148
|
|
|
149 ;; AIS: This is the old intercal-paren function, modified slightly.
|
|
|
150 (defun intercal-paren-2 ()
|
|
|
151 "Generate an INTERCAL label if at start of line. Otherwise type '('."
|
|
|
152 (interactive)
|
|
|
153 (if (and (bolp) (looking-at "[ \t]\\|$"))
|
|
|
154 (insert (format "(%d)"
|
|
|
155 (save-restriction
|
|
|
156 (widen)
|
|
|
157 (save-excursion
|
|
|
158 (beginning-of-line)
|
|
|
159 (1+ (count-lines 1 (point))))))
|
|
|
160 "\t")
|
|
|
161 (insert "(")))
|
|
|
162
|
|
|
163 ;; AIS: I wrote this as a better intercal-paren-2.
|
|
|
164 (defun intercal-paren ()
|
|
|
165 "Generate an INTERCAL label or (."
|
|
|
166 (interactive)
|
|
|
167 (save-excursion
|
|
|
168 (beginning-of-line)
|
|
|
169 (if (looking-at "^[ \t]*$")
|
|
|
170 (delete-horizontal-space)))
|
|
|
171 (intercal-paren-2)
|
|
|
172 )
|
|
|
173
|
|
|
174 (defun intercal-splat ()
|
|
|
175 "Begin an INTERCAL comment."
|
|
|
176 (interactive)
|
|
|
177 (insert "*")
|
|
|
178 (forward-char -1)
|
|
|
179 (delete-horizontal-space)
|
|
|
180 (forward-char 1)
|
|
|
181 (insert " ")
|
|
|
182 )
|
|
|
183
|
|
|
184 ;; AIS: Added new abbreviations (marked ;AIS above), expanded the documentation.
|
|
|
185 (defun intercal-mode ()
|
|
|
186 "A major editing mode for the language Intercal.
|
|
|
187 It activates the following abbrevs (each one appropriately modified to a
|
|
|
188 gerund if it occurs on a line with ABSTAIN or REINSTATE).
|
|
|
189
|
|
|
190 ab ABSTAIN co COME FROM fo FORGET
|
|
|
191 gi GIVE UP ig IGNORE ne NEXT
|
|
|
192 rea READ OUT rei REINSTATE rem REMEMBER
|
|
|
193 res RESUME ret RETRIEVE st STASH
|
|
|
194 wr WRITE IN pl PLEASE tr TRY AGAIN
|
|
|
195 on ONCE ag AGAIN ma MAYBE
|
|
|
196 goa GO AHEAD gob GO BACK do DO, or sometimes PLEASE DO
|
|
|
197 cal CALCULATE cr CREATE wh WHILE
|
|
|
198
|
|
|
199 Carriage return takes you to the first tab stop (code indent level).
|
|
|
200 Certain other single keys are bound to things which may or may not be useful.
|
|
|
201 You may consider discovering these one of the pleasures awaiting you in your
|
|
|
202 discovery of INTERCAL's unique ambience.
|
|
|
203
|
|
|
204 Typing C-c C-c converts a constant in the form #<legal C constant> to a legal
|
|
|
205 INTERCAL constant (such as #45 or #65280$#65280). If the answer is a mingled
|
|
|
206 one, it is only valid in binary.
|
|
|
207
|
|
|
208 For programmers who prefer TRI-INTERCAL, another constant conversion function
|
|
|
209 is given. Typing a number in the format (say) #3r2210210011 and pressing
|
|
|
210 C-c C-r will result in a (possibly mingled) decimal constant that works in
|
|
|
211 base 3. This works likewise for other bases, say #6r520314 would generate a
|
|
|
212 base-6 constant.
|
|
|
213
|
|
|
214 For binary I/O, C-c C-s is provided. This takes a constant of the form
|
|
|
215 #?<character> and converts it into a constant of the form #<character code>.
|
|
|
216 With a prefix argument (as in C-u C-c C-s), the output has its bottom 8 bits
|
|
|
217 reversed, and so is suitable for use with semi-standard output routines.
|
|
|
218
|
|
|
219 For longer strings, C-c C-a can produce sections of programs that store
|
|
|
220 strings in arrays. The command can give help on itself.
|
|
|
221
|
|
|
222 For information about C-c C-u and LNU, see `intercal-lnu-mode'.
|
|
|
223
|
|
|
224 Turning on Intercal mode calls the value of the variable intercal-mode-hook
|
|
|
225 with no args, if that value is non-nil."
|
|
|
226 (interactive)
|
|
|
227 (kill-all-local-variables)
|
|
|
228 (use-local-map intercal-mode-map)
|
|
|
229 (setq major-mode 'intercal-mode)
|
|
|
230 (setq mode-name "Intercal")
|
|
|
231 (setq local-abbrev-table intercal-mode-abbrev-table)
|
|
|
232 (set-syntax-table intercal-mode-syntax-table)
|
|
|
233 (make-local-variable 'comment-start)
|
|
|
234 (setq comment-start "* ")
|
|
|
235 (make-local-variable 'comment-end)
|
|
|
236 (setq comment-end "")
|
|
|
237 (make-local-variable 'comment-column)
|
|
|
238 (setq comment-column 32)
|
|
|
239 (make-local-variable 'require-final-newline)
|
|
|
240 (setq require-final-newline t)
|
|
|
241 (setq abbrev-mode t)
|
|
|
242 (setq abbrev-all-caps t)
|
|
|
243 (run-hooks 'intercal-mode-hook))
|
|
|
244
|
|
|
245 (provide 'intercal-mode)
|
|
|
246
|
|
|
247 ;; AIS: I wrote everything from here down.
|
|
|
248
|
|
|
249 ;; Line Number Update minor mode.
|
|
|
250 (defvar intercal-lnu-mode nil "Whether intercal-lnu-mode is on or not.")
|
|
|
251 (make-variable-buffer-local 'intercal-lnu-mode)
|
|
|
252
|
|
|
253 (defvar intercal-lnu-mode-initialized nil "Whether intercal-lnu-mode is initialized.")
|
|
|
254
|
|
|
255 (defun intercal-lnu-mode (arg)
|
|
|
256 "Minor mode used primarily when editing INTERCAL.
|
|
|
257 (LNU stands for Line Number Update).
|
|
|
258 The mode tries to ensure that all line labels below 1000 are equal to the line
|
|
|
259 numbers of the lines they refer to. Renumbering is done when RET is pressed, the
|
|
|
260 mode is turned on, or C-c C-u is pressed. This mode has no effect unless
|
|
|
261 intercal-mode is also active, or its functions are called. It is inadvisable to
|
|
|
262 turn LNU mode on in long files, because line number updates take a long time to
|
|
|
263 run in long files. Instead, leave LNU mode off and use `intercal-lnu' (C-c C-u).
|
|
|
264 Labels greater than or equal to 1000 are ignored because they probably indicate
|
|
|
265 library functions."
|
|
|
266 (interactive "P")
|
|
|
267 (setq intercal-lnu-mode
|
|
|
268 (if (null arg) (not intercal-lnu-mode) (> (prefix-numeric-value arg) 0)))
|
|
|
269 (force-mode-line-update)
|
|
|
270 (if intercal-lnu-mode (intercal-lnu))
|
|
|
271 (if (not intercal-lnu-mode-initialized) (intercal-lnu-initialize))
|
|
|
272 )
|
|
|
273
|
|
|
274 (defun intercal-lnu-initialize ()
|
|
|
275 "Initializes INTERCAL LNU mode. See `intercal-lnu-mode'."
|
|
|
276 (if (not intercal-lnu-mode-initialized)
|
|
|
277 (setq minor-mode-alist (cons '(intercal-lnu-mode " LNU") minor-mode-alist)
|
|
|
278 intercal-lnu-mode-initialized t))
|
|
|
279 )
|
|
|
280
|
|
|
281 (defsubst cadar (x)
|
|
|
282 "Return the car of the cdr of the car of X."
|
|
|
283 (car (cdr (car x))))
|
|
|
284
|
|
|
285 (defun intercal-lnu ()
|
|
|
286 "Updates line numbers in an INTERCAL program. See `intercal-lnu-mode'. This
|
|
|
287 function will run even if intercal-lnu-mode is off, but intercal-mode must be
|
|
|
288 on. Running this function manually (with C-c C-u) rather than automatically is
|
|
|
289 a good idea in long files, which take a long time to update."
|
|
|
290 (interactive)
|
|
|
291 (if (equal major-mode 'intercal-mode)
|
|
|
292 (save-excursion
|
|
|
293 (let ((line-number-update-list nil))
|
|
|
294 (goto-char (point-min))
|
|
|
295 (while (re-search-forward "^(\\([0-9]+\\))" nil t)
|
|
|
296 (if (< (string-to-number (match-string-no-properties 1)) 1000)
|
|
|
297 (setq line-number-update-list (cons
|
|
|
298 (list
|
|
|
299 (string-to-number (match-string-no-properties 1))
|
|
|
300 (count-lines 1 (point)))
|
|
|
301 line-number-update-list))))
|
|
|
302 (while line-number-update-list
|
|
|
303 (intercal-lnu-individual (caar line-number-update-list) (cadar line-number-update-list))
|
|
|
304 (setq line-number-update-list (cdr line-number-update-list))))
|
|
|
305 (goto-char (point-min))
|
|
|
306 (while (search-forward "LNUChange:" nil t)
|
|
|
307 (replace-match "")))
|
|
|
308 (error "The buffer is not in intercal-mode"))
|
|
|
309 )
|
|
|
310
|
|
|
311 (defun intercal-lnu-individual (oldlabel newlabel)
|
|
|
312 "Updates all occurrences of one label in an INTERCAL program for another."
|
|
|
313 (save-excursion
|
|
|
314 (goto-char (point-min))
|
|
|
315 (while (search-forward (concat "(" (number-to-string oldlabel) ")") nil t)
|
|
|
316 (replace-match (concat "(LNUChange:" (number-to-string newlabel) ")"))))
|
|
|
317 )
|
|
|
318
|
|
|
319 ;; Font Lock settings.
|
|
|
320 ;; We use keyword-face for commands, builtin-face for gerunds, constant-face
|
|
|
321 ;; for meshes and mingle-mesh constants, and comment-face for initially
|
|
|
322 ;; abstained lines (because these are usually comments, and anyway it's good
|
|
|
323 ;; for them to stand out). Only the first line of multiline comments is marked.
|
|
|
324 ;; MAYBE lines aren't marked because that's a big giveaway that the line won't
|
|
|
325 ;; be abstained from all program.
|
|
|
326 (defvar intercal-font-lock-keywords
|
|
|
327 '(("^\\(([0-9]+)\\|\\)[ \t]*\\(PLEASE DO\\|DO\\|PLEASE\\)[ \t]*\\(NOT\\|N'T\\).*$" . font-lock-comment-face)
|
|
|
328 ("\\<\\(ABSTAIN\\|GIVE UP\\|READ OUT\\|RESUME\\|WRITE IN\\|PIN\\|COME\\|FROM\\|IGNORE\\|REINSTATE\\|RETRIEVE\\|PLEASE\\|DO\\|MAYBE\\|ONCE\\|AGAIN\\|FORGET\\|NEXT\\|REMEMBER\\|STASH\\|DON'T\\|NOT\\|TRY AGAIN\\|WHILE\\|GO AHEAD\\|GO BACK\\)\\>" . font-lock-keyword-face)
|
|
|
329 ("\\<\\(ABSTAINING\\|GIVING UP\\|READING OUT\\|RESUMING\\|WRITING IN\\|PINNING\\|COMING\\|IGNORING\\|REINSTATING\\|RETRIEVING\\|FORGETTING\\|NEXTING\\|REMEMBERING\\|STASHING\\|TRYING AGAIN\\|CALCULATING\\|WHILING\\|GOING AHEAD\\|GOING BACK\\)\\>" . font-lock-builtin-face)
|
|
|
330 ("[.,:;][0-9]+" . font-lock-variable-name-face)
|
|
|
331 ("#[0-9]+\\(\\$#[0-9]+\\|\\)" . font-lock-constant-face))
|
|
|
332 "Default expressions to highlight in Intercal mode.")
|
|
|
333
|
|
|
334 ;; Find an error message produced by ick. If the famous RESUBNIT spelling error
|
|
|
335 ;; is ever corrected, this will need to be corrected too.
|
|
|
336 (defvar intercal-error-regexp
|
|
|
337 '("\\(ICL[0-9][0-9][0-9][IW].*\\)\n[ \t]*ON THE WAY TO \\([0-9]+\\)\n[ \t]*\\(\\(CORRECT\\)\\|\\(RECONSIDER\\)\\) SOURCE AND RESUBNIT$" nil 2 nil (5 . nil) 1)
|
|
|
338 "Regexp that identifies an INTERCAL error message, and the file and line number positions in it.")
|
|
|
339
|
|
|
340 ;; Detect the line with which ick was invoked, so the filename used can be
|
|
|
341 ;; used by Emacs' compile-mode to find the error. This will need to be changed
|
|
|
342 ;; if command-line arguments to ick other than letters are allowed.
|
|
|
343 (defvar intercal-file-regexp '(".*ick \\(-[a-zA-Z]+ \\)*\\(.*i\\)$" 2 nil nil 0 2)
|
|
|
344 "Regexp that identifies the line with which ick was invoked, and the filename it was used on.")
|
|
|
345
|
|
|
346 ;; Helper function for the binary I/O routines.
|
|
|
347 (defun intercal-reverse-bits-if-nonnull (flag num)
|
|
|
348 "Returns num if flag is null, or num with bits reversed if flag is nonnull."
|
|
|
349 (if (null flag) num
|
|
|
350 (let ((ans 0) (count 8) (num1 num))
|
|
|
351 (while (> count 0)
|
|
|
352 (setq ans (* ans 2))
|
|
|
353 (if (= (% num1 2) 1) (setq ans (1+ ans)))
|
|
|
354 (setq num1 (/ num1 2))
|
|
|
355 (setq count (1- count)))
|
|
|
356 ans))
|
|
|
357 )
|
|
|
358
|
|
|
359 ;; Internal memory for inter-function communication. Yes, I know it's
|
|
|
360 ;; unLispish to do this sort of thing, and breaks if the user tries to
|
|
|
361 ;; convert two strings simultaneously.
|
|
|
362 (defvar intercal-string-array-convert-options-buffer-used nil
|
|
|
363 "Variable that keeps track of a buffer used to display options
|
|
|
364 for intercal-string-array-convert.")
|
|
|
365
|
|
|
366 ;; Function that inputs options for intercal-string-array-convert.
|
|
|
367 ;; If the user asks for help, it pops up a help buffer and returns nil.
|
|
|
368 ;; Its documentation string is the information required to appear in
|
|
|
369 ;; the help buffer.
|
|
|
370 (defun intercal-string-array-convert-options (opts)
|
|
|
371 "Options for use with intercal-string-array-convert:
|
|
|
372 ? Display the list of options
|
|
|
373 1 Pack the string one char/element (default)
|
|
|
374 2 Pack the string two chars/element (unimplemented)
|
|
|
375 4 Pack the string four chars/element (unimplemented)
|
|
|
376 $ Pack the string in mingled format (default)
|
|
|
377 so \"abcd\" would become \"a$b\"$\"c$d\"
|
|
|
378 < Pack the string in shifted format
|
|
|
379 (concatentate the codes for each character)
|
|
|
380 R Bit-reverse each character code (default)
|
|
|
381 W Don't bit-reverse each character code
|
|
|
382 , Treat entered number as a tail array (default)
|
|
|
383 ; Treat entered number as a hybrid array
|
|
|
384 0 Each character code is based at 0 (default)
|
|
|
385 + Each character code is based at the previous code (unimplemented)"
|
|
|
386 (interactive "sOptions: (type ?[RET] for help)")
|
|
|
387 (if (string= opts "?")
|
|
|
388 (progn
|
|
|
389 (setq intercal-string-array-convert-options-buffer-used t)
|
|
|
390 (with-output-to-temp-buffer "*Options*"
|
|
|
391 (princ (documentation 'intercal-string-array-convert-options)))
|
|
|
392 nil)
|
|
|
393 opts)
|
|
|
394 )
|
|
|
395
|
|
|
396 ;; The displaying of the help buffer is done by
|
|
|
397 ;; intercal-string-array-convert-options, if required. This function holds
|
|
|
398 ;; tests to put the display back as it was in two possible common situations
|
|
|
399 ;; involving the user asking for help (one window active, two windows active).
|
|
|
400 (defun intercal-string-array-convert (in arr &optional opts)
|
|
|
401 "Generate INTERCAL code to initialize an array with information
|
|
|
402 that makes it suitable for use as a string. For more information,
|
|
|
403 run the command and enter a question mark for the options."
|
|
|
404 (interactive "*MEnter string to convert:\nnEnter number of array required:")
|
|
|
405 (let ((cb (current-buffer)) (w1p (one-window-p)) (ow nil))
|
|
|
406 (if (null w1p) (setq ow other-window-scroll-buffer))
|
|
|
407 (while (null opts)
|
|
|
408 (setq opts (call-interactively 'intercal-string-array-convert-options)))
|
|
|
409 (if intercal-string-array-convert-options-buffer-used
|
|
|
410 (progn
|
|
|
411 (select-window (get-buffer-window cb))
|
|
|
412 (if w1p
|
|
|
413 (delete-other-windows)
|
|
|
414 (switch-to-buffer-other-window ow))))
|
|
|
415 (setq intercal-string-array-convert-options-buffer-used nil))
|
|
|
416 (let ((packing 1) (basis nil) (arrtype ",") (revbits t) (mingle t))
|
|
|
417 (while (> (length opts) 0)
|
|
|
418 (if (string= (substring opts 0 1) "1") (setq packing 1)
|
|
|
419 (if (string= (substring opts 0 1) "2") (error "Unimplemented") ;(setq packing 2) ;unimplemented
|
|
|
420 (if (string= (substring opts 0 1) "4") (error "Unimplemented") ;(setq packing 4) ;unimplemented
|
|
|
421 (if (string= (substring opts 0 1) "$") (setq mingle t) ;unimplemented, but has no effect on option 1
|
|
|
422 (if (string= (substring opts 0 1) "<") (setq mingle nil);unimplemented, but has no effect on option 1
|
|
|
423 (if (string= (substring opts 0 1) "R") (setq revbits t)
|
|
|
424 (if (string= (substring opts 0 1) "W") (setq revbits nil)
|
|
|
425 (if (string= (substring opts 0 1) ",") (setq arrtype ",")
|
|
|
426 (if (string= (substring opts 0 1) ";") (setq arrtype ";")
|
|
|
427 (if (string= (substring opts 0 1) "0") (setq basis nil)
|
|
|
428 (if (string= (substring opts 0 1) "+") (error "Unimplemented") ;(setq basis t) ;unimplemented
|
|
|
429 (error "Invalid option"))))))))))))
|
|
|
430 (setq opts (substring opts 1)))
|
|
|
431 (intercal-return)
|
|
|
432 (intercal-do-abbrev)
|
|
|
433 (let ((al (/ (+ (length in) packing -1) packing)))
|
|
|
434 (insert " " arrtype (int-to-string arr) " <- #" (int-to-string al)))
|
|
|
435 (let ((lastchar 0) (arrind 1))
|
|
|
436 (while (> (length in) 0)
|
|
|
437 (intercal-return)
|
|
|
438 (intercal-do-abbrev)
|
|
|
439 (insert " " arrtype (int-to-string arr) " SUB #" (int-to-string arrind))
|
|
|
440 (insert " <- #?" (substring in 0 1))
|
|
|
441 (setq in (substring in 1))
|
|
|
442 (intercal-char-constant-convert revbits))))
|
|
|
443 )
|
|
|
444
|
|
|
445 ;; Converts char to int by subtracting ! and adding 33.
|
|
|
446 (defun intercal-char-constant-convert (arg)
|
|
|
447 "Convert a constant of the form #?<character> into a legal
|
|
|
448 INTERCAL constant representing the character's character code.
|
|
|
449 With a prefix argument, gives bit-reversed output. This routine
|
|
|
450 is intended for use with the binary I/O capabilities of INTERCAL."
|
|
|
451 (interactive "*P") ;Check prefix arg, not read-only
|
|
|
452 (save-excursion
|
|
|
453 (if (re-search-backward "#" (line-beginning-position) t)
|
|
|
454 (if (re-search-forward "#\\?\\(.\\)" (line-end-position) t)
|
|
|
455 (replace-match
|
|
|
456 (concat "#" (int-to-string (intercal-reverse-bits-if-nonnull arg
|
|
|
457 (+ 33 (- (string-to-char
|
|
|
458 (match-string-no-properties 1)) ?!)))))))))
|
|
|
459 )
|
|
|
460
|
|
|
461
|
|
|
462 ;; This is simpler than the next function because we're
|
|
|
463 ;; converting from the target base, so it's simply a case
|
|
|
464 ;; of selecting every second character if we need to produce
|
|
|
465 ;; a mingled result
|
|
|
466 (defun intercal-constant-radix-convert ()
|
|
|
467 "Convert a constant of the form #<base>r<integer in that base>
|
|
|
468 to a legal TRI-INTERCAL constant in that base. If the number is
|
|
|
469 sufficiently small, it is converted to decimal; otherwise, it is
|
|
|
470 converted to two mingled decimal constants."
|
|
|
471 (interactive "*")
|
|
|
472 (save-excursion
|
|
|
473 (if (re-search-backward "#" (line-beginning-position) t)
|
|
|
474 (if (re-search-forward "#\\([2-7]\\)r\\([0-6]+\\)"
|
|
|
475 (line-end-position) t)
|
|
|
476 (replace-match
|
|
|
477 (let ((radix (string-to-number
|
|
|
478 (match-string-no-properties 1) 10))
|
|
|
479 (str (match-string-no-properties 2)) (slen 0)
|
|
|
480 (mingle1 "") (mingle2 "") (num1 0) (num2 0))
|
|
|
481 (setq slen (length str))
|
|
|
482 (if (or (<= (* radix slen) 32) ; Calculate max onespot length
|
|
|
483 (or (and (= radix 6) (= slen 6)) ;on these
|
|
|
484 (and (= radix 7) (= slen 5)))) ;three lines
|
|
|
485 (progn
|
|
|
486 (setq num1 (string-to-number str radix))
|
|
|
487 (concat "#" (number-to-string num1)))
|
|
|
488 (progn
|
|
|
489 (while (/= 0 (length str))
|
|
|
490 (setq mingle2 (concat (substring str -1) mingle2))
|
|
|
491 (setq str (substring str 0 -1))
|
|
|
492 (if (/= 0 (length str))
|
|
|
493 (progn
|
|
|
494 (setq mingle1 (concat (substring str -1) mingle1))
|
|
|
495 (setq str (substring str 0 -1)))))
|
|
|
496 (setq num1 (string-to-number mingle1 radix))
|
|
|
497 (setq num2 (string-to-number mingle2 radix))
|
|
|
498 (concat "#" (number-to-string num1)
|
|
|
499 "$#" (number-to-string num2)))))))))
|
|
|
500 )
|
|
|
501
|
|
|
502 ;; The following code needs a bit of explanation. INTERCAL
|
|
|
503 ;; can handle constants up to 4294967295 (0xffffffff), but
|
|
|
504 ;; Emacs's constants max out somewhere between 100 million
|
|
|
505 ;; and 1 billion. So, when a high number is entered, the
|
|
|
506 ;; code processes the last 6 digits (in whatever base the
|
|
|
507 ;; number is entered in) separately from the rest of the
|
|
|
508 ;; number. This ensures that the arithmetic routines never
|
|
|
509 ;; overflow if the input is a valid integer in the range
|
|
|
510 ;; 0-4294967295. The calculations used do not work for
|
|
|
511 ;; higher numbers, but that doesn't matter because
|
|
|
512 ;; INTERCAL wouldn't accept them. Constants higher than
|
|
|
513 ;; 65535 are given in mingled form (e.g. #65280$#65280).
|
|
|
514 (defun intercal-constant-convert ()
|
|
|
515 "Convert a constant of the form #<a valid C integer> to a
|
|
|
516 legal INTERCAL constant (#<16-bit decimal integer> or
|
|
|
517 #<16-bit decimal integer>$#<16-bit decimal integer>).
|
|
|
518 Decimal (#4294967295), octal (#037777777777) and
|
|
|
519 hex (#0xffffffff) formats are all supported."
|
|
|
520 (interactive "*")
|
|
|
521 (save-excursion
|
|
|
522 (if (re-search-backward "#" (line-beginning-position) t)
|
|
|
523 (if (re-search-forward "#\\(0?[xX]?\\)\\([0-9a-fA-F]+\\)"
|
|
|
524 (line-end-position) t)
|
|
|
525 (replace-match
|
|
|
526 (let ((str (match-string-no-properties 2))
|
|
|
527 (strhi "0") (strlow "0")
|
|
|
528 (base (if (string= (match-string-no-properties 1) "")
|
|
|
529 10
|
|
|
530 (if (string= (match-string-no-properties 1) "0")
|
|
|
531 8 16))))
|
|
|
532 (if (<= (length str) 6) (setq strlow str)
|
|
|
533 (setq strlow (substring str -6) strhi (substring str 0 -6)))
|
|
|
534 (let ((num (string-to-number strlow base))
|
|
|
535 (numhi (string-to-number strhi base)))
|
|
|
536 (if (and (<= num 65535) (string= strhi "0"))
|
|
|
537 (concat "#" (number-to-string num))
|
|
|
538 (let ((mingle1 0) (mingle2 0) (count 16) (temp 0))
|
|
|
539 (while (> count 0)
|
|
|
540 (progn
|
|
|
541 (setq temp (% num 4))
|
|
|
542 (setq num (/ num 4))
|
|
|
543 (if (= (% temp 2) 1) (setq mingle2 (+ mingle2 65536)))
|
|
|
544 (if (> temp 1) (setq mingle1 (+ mingle1 65536)))
|
|
|
545 (setq mingle1 (/ mingle1 2))
|
|
|
546 (setq mingle2 (/ mingle2 2))
|
|
|
547 (setq count (- count 1))
|
|
|
548 (if (= count 13)
|
|
|
549 (setq num (+ num (* (/ (expt base 6) 64) numhi))))))
|
|
|
550 (concat "#" (number-to-string mingle1)
|
|
|
551 "$#" (number-to-string mingle2))
|
|
|
552 ))))
|
|
|
553 t t))))
|
|
|
554 )
|
|
|
555
|
|
|
556 ;; This wraps around compilation-parse-errors in compile, and makes sure that
|
|
|
557 ;; the first line of the compilation buffer is blank. This is to make the
|
|
|
558 ;; call of ick (which is needed to determine the source file) look like an
|
|
|
559 ;; error message rather than a compiler call.
|
|
|
560 (defun intercal-error-wrap (limit-search find-at-least)
|
|
|
561 "Parse the current buffer as ick error messages. This just wraps around
|
|
|
562 'compilation-parse-errors'. See variable 'compilation-parse-errors-function'
|
|
|
563 for the interface it uses."
|
|
|
564 (save-excursion
|
|
|
565 (beginning-of-buffer)
|
|
|
566 (if (looking-at "^$") nil (newline)))
|
|
|
567 (compilation-parse-errors limit-search find-at-least)
|
|
|
568 )
|
|
|
569
|
|
|
570 (require 'compile) ;Now a prerequisite for intercal.el, so its variables can be
|
|
|
571 ;changed to INTERCAL values upon loading an INTERCAL file
|
|
|
572
|
|
|
573 ;; This hook changes settings in fontlock and compile, so that they
|
|
|
574 ;; recognize INTERCAL syntax and ick error messages. Default options to
|
|
|
575 ;; ick are to optimize, but I chose not to give -b as a default (because
|
|
|
576 ;; it spoils the fun). I'm slightly tempted to use -m as default, but
|
|
|
577 ;; I'm not sure I'm that evil, and I left -f out for the time being because
|
|
|
578 ;; it's something of a radical change to the output.
|
|
|
579 (add-hook 'intercal-mode-hook
|
|
|
580 (function (lambda ()
|
|
|
581 (make-local-variable 'font-lock-defaults)
|
|
|
582 (setq font-lock-defaults '(intercal-font-lock-keywords t))
|
|
|
583 (make-local-variable 'compile-command)
|
|
|
584 (setq compile-command (concat "ick -O " (buffer-name)))
|
|
|
585 (make-local-variable 'compilation-parse-errors-function)
|
|
|
586 (setq compilation-parse-errors-function 'intercal-error-wrap))))
|
|
|
587
|
|
|
588 ;; In recent versions of Emacs this must apparently be set globally;
|
|
|
589 ;; also, the -error-regexp and -file-regexp were merged.
|
|
|
590 (setq compilation-error-regexp-alist (cons intercal-error-regexp
|
|
|
591 compilation-error-regexp-alist))
|
|
|
592 (if (boundp 'compilation-file-regexp-alist)
|
|
|
593 (setq compilation-file-regexp-alist (cons intercal-file-regexp
|
|
|
594 compilation-file-regexp-alist))
|
|
|
595 (setq compilation-error-regexp-alist (cons intercal-file-regexp
|
|
|
596 compilation-error-regexp-alist))
|
|
|
597 )
|
|
|
598
|
|
|
599
|
|
|
600 ;; AIS: End of section I wrote.
|
|
|
601
|
|
|
602 ;;; intercal.el ends here
|
