This file is indexed.

/usr/share/emacs/site-lisp/intercal.el is in intercal 28:0.28-5.

This file is owned by root:root, with mode 0o644.

The actual contents of the file can be viewed below.

  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
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
;;; intercal.el -- mode for editing INTERCAL code

;; This mode was written by Eric S. Raymond <esr@snark.thyrsus.com>
;; for the C-INTERCAL distribution, and is copyrighted by him 1992.  Free
;; redistribution encouraged.  Someday, maybe, this will be made part of GNU.
;; But probably not unless they take many mind-eroding drugs first.

;; This mode provides abbrevs for C-INTERCAL's statements, including COME FROM.
;; These abbrevs are context-sensitive and will generate either verb or gerund
;; form as appropriate.  The keys RET, ( and * are also bound in useful ways.

;; The intercal-politesse-level adjustment purports to assist the hapless
;; INTERCAL programmer in meeting INTERCAL's Miss Manners requirement.  In
;; INTERCAL-72 and C-INTERCAL releases after 0.7, no fewer than 1/5 and no
;; more than 1/3 of the program statements must contain a PLEASE to gratify
;; the iron whim of the INTERCAL compiler; this mode assists by randomly
;; expanding some fraction of the "do" abbrevs typed to PLEASE DO.
;; The intercal-politesse-level constant is the denominator of this fraction.

;; AIS: I corrected the READ/WRITE, IN/OUT reversal independent of the correction
;; that happened from 0.22 to 0.24 (this code was originally based on the 0.22
;; distribution and updated for 0.24 compatibility); this version is distributed
;; with C-INTERCAL 0.27.
;;
;; I also altered the code for ( so the user didn't have to go to the beginning
;; of the line, added C-c C-[a,c,r,s] for convenience when working with
;; constants, and added support for TRY AGAIN, ONCE, AGAIN, and Font Lock.
;; I added support for M-x compile so it could compile INTERCAL programs
;; correctly (assuming that ick has been installed).

;; 	$Id: intercal.el,v 1.5 1996/11/14 04:02:00 esr Exp $

(defconst intercal-politesse-level 4
  "Fraction of DOs that are automagically expanded to PLEASE DO.")

(defvar intercal-mode-map nil
  "Keymap for INTERCAL mode.")
(if intercal-mode-map
    nil
  (setq intercal-mode-map (make-sparse-keymap))
  (define-key intercal-mode-map "\t" 'tab-to-tab-stop)
  (define-key intercal-mode-map "\r" 'intercal-return)
  (define-key intercal-mode-map "\C-J" 'intercal-return)
  (define-key intercal-mode-map "\C-C\C-C" 'intercal-constant-convert) ;AIS
  (define-key intercal-mode-map "\C-C\C-R" 'intercal-constant-radix-convert) ;AIS
  (define-key intercal-mode-map "\C-C\C-S" 'intercal-char-constant-convert) ;AIS
  (define-key intercal-mode-map "\C-C\C-A" 'intercal-string-array-convert) ;AIS
  (define-key intercal-mode-map "\C-C\C-U" 'intercal-lnu) ;AIS
  (define-key intercal-mode-map "(" 'intercal-paren)
  (define-key intercal-mode-map "*" 'intercal-splat)
  (define-key intercal-mode-map "\177" 'backward-delete-char-untabify)
  )

(defvar intercal-mode-syntax-table nil
  "Syntax table in use in Intercal-mode buffers.")

(if intercal-mode-syntax-table
    nil
  (let ((table (make-syntax-table)))
    (modify-syntax-entry ?\\ "\\" table)
    (modify-syntax-entry ?+ "." table)
    (modify-syntax-entry ?- "." table)
    (modify-syntax-entry ?= "." table)
    (modify-syntax-entry ?% "." table)
    (modify-syntax-entry ?< "." table)
    (modify-syntax-entry ?> "." table)
    (modify-syntax-entry ?& "." table)
    (modify-syntax-entry ?| "." table)
    (modify-syntax-entry ?\' "\"" table)
    (setq intercal-mode-syntax-table table)))

(defvar intercal-mode-abbrev-table nil
  "*Abbrev table in use in Intercal-mode buffers.")
(if intercal-mode-abbrev-table
    nil
  (define-abbrev-table 'intercal-mode-abbrev-table ())
  (define-abbrev intercal-mode-abbrev-table "pl"  "PLEASE" nil)
  (define-abbrev intercal-mode-abbrev-table "on"  "ONCE" nil) ;AIS
  (define-abbrev intercal-mode-abbrev-table "ag"  "AGAIN" nil) ;AIS
  (define-abbrev intercal-mode-abbrev-table "ne"  "" 'intercal-ne-abbrev)
  (define-abbrev intercal-mode-abbrev-table "fo"  "" 'intercal-fo-abbrev)
  (define-abbrev intercal-mode-abbrev-table "res" "" 'intercal-res-abbrev)
  (define-abbrev intercal-mode-abbrev-table "st"  "" 'intercal-st-abbrev)
  (define-abbrev intercal-mode-abbrev-table "ret" "" 'intercal-ret-abbrev)
  (define-abbrev intercal-mode-abbrev-table "ig"  "" 'intercal-ig-abbrev)
  (define-abbrev intercal-mode-abbrev-table "rem" "" 'intercal-rem-abbrev)
  (define-abbrev intercal-mode-abbrev-table "ab"  "" 'intercal-ab-abbrev)
  (define-abbrev intercal-mode-abbrev-table "rei" "" 'intercal-rei-abbrev)
  (define-abbrev intercal-mode-abbrev-table "gi"  "" 'intercal-gi-abbrev)
  (define-abbrev intercal-mode-abbrev-table "rea" "" 'intercal-rea-abbrev)
  (define-abbrev intercal-mode-abbrev-table "wr"  "" 'intercal-wr-abbrev)
  (define-abbrev intercal-mode-abbrev-table "co"  "" 'intercal-co-abbrev)
  (define-abbrev intercal-mode-abbrev-table "do"  "" 'intercal-do-abbrev)
  (define-abbrev intercal-mode-abbrev-table "wh"  "" 'intercal-wh-abbrev) ;AIS
  (define-abbrev intercal-mode-abbrev-table "goa" "" 'intercal-goa-abbrev) ;AIS
  (define-abbrev intercal-mode-abbrev-table "gob" "" 'intercal-gob-abbrev) ;AIS
  (define-abbrev intercal-mode-abbrev-table "cr"  "" 'intercal-cr-abbrev) ;AIS
  (define-abbrev intercal-mode-abbrev-table "ma"  "MAYBE" nil) ;AIS
  (define-abbrev intercal-mode-abbrev-table "tr"  "" 'intercal-tr-abbrev) ;AIS
  (define-abbrev intercal-mode-abbrev-table "cal" "" 'intercal-cal-abbrev) ;AIS
 )

(defun use-gerund ()
  (save-excursion
    (beginning-of-line)
    (or (looking-at ".*ABSTAIN") (looking-at ".*REINSTATE"))))

(defmacro make-intercal-abbrev (sym gerund verb)
  (list 'defun sym '() (list 'insert (list 'if '(use-gerund) gerund verb))))

(make-intercal-abbrev intercal-ne-abbrev "NEXTING" "NEXT")
(make-intercal-abbrev intercal-fo-abbrev "FORGETTING" "FORGET")
(make-intercal-abbrev intercal-res-abbrev "RESUMING" "RESUME")
(make-intercal-abbrev intercal-st-abbrev "STASHING" "STASH")
(make-intercal-abbrev intercal-ret-abbrev "RETRIEVING" "RETRIEVE")
(make-intercal-abbrev intercal-ig-abbrev "IGNORING" "IGNORE")
(make-intercal-abbrev intercal-rem-abbrev "REMEMBERING" "REMEMBER")
(make-intercal-abbrev intercal-ab-abbrev "ABSTAINING" "ABSTAIN FROM")
(make-intercal-abbrev intercal-rei-abbrev "REINSTATING" "REINSTATE")
(make-intercal-abbrev intercal-gi-abbrev "GIVING UP" "GIVE UP")
(make-intercal-abbrev intercal-rea-abbrev "READING OUT" "READ OUT")
(make-intercal-abbrev intercal-wr-abbrev "WRITING IN" "WRITE IN")
(make-intercal-abbrev intercal-co-abbrev "COMING FROM" "COME FROM")
(make-intercal-abbrev intercal-tr-abbrev "TRYING AGAIN" "TRY AGAIN") ;AIS
(make-intercal-abbrev intercal-cal-abbrev "CALCULATING" "cal") ;AIS
(make-intercal-abbrev intercal-wh-abbrev "WHILING" "WHILE") ;AIS
(make-intercal-abbrev intercal-goa-abbrev "GOING AHEAD" "GO AHEAD") ;AIS
(make-intercal-abbrev intercal-gob-abbrev "GOING BACK" "GO BACK") ;AIS
(make-intercal-abbrev intercal-cr-abbrev "CREATION" "CREATE") ;AIS

(defun intercal-do-abbrev ()
  "Emit a DO (usually).  Occasionally, emit PLEASE DO."
  (insert
   (if (zerop (% (random) intercal-politesse-level))
       "PLEASE DO"
     "DO")
   ))

(defun intercal-return ()
  "Insert LFD + tab, to bring us back to code-indent level."
  (interactive)
  (if (eolp) (delete-horizontal-space))
  (insert "\n")
  (delete-horizontal-space) ;AIS
  (tab-to-tab-stop)
  (if intercal-lnu-mode (intercal-lnu)) ;AIS
  )

;; AIS: This is the old intercal-paren function, modified slightly.
(defun intercal-paren-2 ()
  "Generate an INTERCAL label if at start of line. Otherwise type '('."
  (interactive)
  (if (and (bolp) (looking-at "[ \t]\\|$"))
      (insert (format "(%d)"
		      (save-restriction
			(widen)
			(save-excursion
			  (beginning-of-line)
			  (1+ (count-lines 1 (point))))))
	      "\t")
    (insert "(")))

;; AIS: I wrote this as a better intercal-paren-2.
(defun intercal-paren ()
  "Generate an INTERCAL label or (."
  (interactive)
  (save-excursion
    (beginning-of-line)
    (if (looking-at "^[ \t]*$")
	(delete-horizontal-space)))
  (intercal-paren-2)
)

(defun intercal-splat ()
  "Begin an INTERCAL comment."
  (interactive)
  (insert "*")
  (forward-char -1)
  (delete-horizontal-space)
  (forward-char 1)
  (insert " ")
)

;; AIS: Added new abbreviations (marked ;AIS above), expanded the documentation.
(defun intercal-mode ()
  "A major editing mode for the language Intercal.
It activates the following abbrevs (each one appropriately modified to a
gerund if it occurs on a line with ABSTAIN or REINSTATE).

ab   ABSTAIN	co   COME FROM	fo   FORGET
gi   GIVE UP	ig   IGNORE	ne   NEXT
rea  READ OUT	rei  REINSTATE	rem  REMEMBER
res  RESUME	ret  RETRIEVE	st   STASH
wr   WRITE IN	pl   PLEASE     tr   TRY AGAIN
on   ONCE       ag   AGAIN      ma   MAYBE
goa  GO AHEAD   gob  GO BACK    do   DO, or sometimes PLEASE DO
cal  CALCULATE  cr   CREATE     wh   WHILE

Carriage return takes you to the first tab stop (code indent level).
Certain other single keys are bound to things which may or may not be useful.
You may consider discovering these one of the pleasures awaiting you in your
discovery of INTERCAL's unique ambience.

Typing C-c C-c converts a constant in the form #<legal C constant> to a legal
INTERCAL constant (such as #45 or #65280$#65280). If the answer is a mingled
one, it is only valid in binary.

For programmers who prefer TRI-INTERCAL, another constant conversion function
is given. Typing a number in the format (say) #3r2210210011 and pressing
C-c C-r will result in a (possibly mingled) decimal constant that works in
base 3. This works likewise for other bases, say #6r520314 would generate a
base-6 constant.

For binary I/O, C-c C-s is provided. This takes a constant of the form
#?<character> and converts it into a constant of the form #<character code>.
With a prefix argument (as in C-u C-c C-s), the output has its bottom 8 bits
reversed, and so is suitable for use with semi-standard output routines.

For longer strings, C-c C-a can produce sections of programs that store
strings in arrays. The command can give help on itself.

For information about C-c C-u and LNU, see `intercal-lnu-mode'.

Turning on Intercal mode calls the value of the variable intercal-mode-hook
with no args, if that value is non-nil."
  (interactive)
  (kill-all-local-variables)
  (use-local-map intercal-mode-map)
  (setq major-mode 'intercal-mode)
  (setq mode-name "Intercal")
  (setq local-abbrev-table intercal-mode-abbrev-table)
  (set-syntax-table intercal-mode-syntax-table)
  (make-local-variable 'comment-start)
  (setq comment-start "* ")
  (make-local-variable 'comment-end)
  (setq comment-end "")
  (make-local-variable 'comment-column)
  (setq comment-column 32)
  (make-local-variable 'require-final-newline)
  (setq require-final-newline t)
  (setq abbrev-mode t)
  (setq abbrev-all-caps t)
  (run-hooks 'intercal-mode-hook))

(provide 'intercal-mode)

;; AIS: I wrote everything from here down.

;; Line Number Update minor mode.
(defvar intercal-lnu-mode nil "Whether intercal-lnu-mode is on or not.")
(make-variable-buffer-local 'intercal-lnu-mode)

(defvar intercal-lnu-mode-initialized nil "Whether intercal-lnu-mode is initialized.")

(defun intercal-lnu-mode (arg)
"Minor mode used primarily when editing INTERCAL.
 (LNU stands for Line Number Update).
The mode tries to ensure that all line labels below 1000 are equal to the line
numbers of the lines they refer to. Renumbering is done when RET is pressed, the
mode is turned on, or C-c C-u is pressed. This mode has no effect unless
intercal-mode is also active, or its functions are called. It is inadvisable to
turn LNU mode on in long files, because line number updates take a long time to
run in long files. Instead, leave LNU mode off and use `intercal-lnu' (C-c C-u).
Labels greater than or equal to 1000 are ignored because they probably indicate
library functions."
  (interactive "P")
  (setq intercal-lnu-mode
	(if (null arg) (not intercal-lnu-mode) (> (prefix-numeric-value arg) 0)))
  (force-mode-line-update)
  (if intercal-lnu-mode (intercal-lnu))
  (if (not intercal-lnu-mode-initialized) (intercal-lnu-initialize))
)

(defun intercal-lnu-initialize ()
"Initializes INTERCAL LNU mode. See `intercal-lnu-mode'."
  (if (not intercal-lnu-mode-initialized)
      (setq minor-mode-alist (cons '(intercal-lnu-mode " LNU") minor-mode-alist)
	    intercal-lnu-mode-initialized t))
)

(defsubst cadar (x)
  "Return the car of the cdr of the car of X."
  (car (cdr (car x))))

(defun intercal-lnu ()
"Updates line numbers in an INTERCAL program. See `intercal-lnu-mode'. This
function will run even if intercal-lnu-mode is off, but intercal-mode must be
on. Running this function manually (with C-c C-u) rather than automatically is
a good idea in long files, which take a long time to update."
  (interactive)
  (if (equal major-mode 'intercal-mode)
      (save-excursion
	(let ((line-number-update-list nil))
	  (goto-char (point-min))
	  (while (re-search-forward "^(\\([0-9]+\\))" nil t)
	    (if (< (string-to-number (match-string-no-properties 1)) 1000)
		(setq line-number-update-list (cons
					       (list
						(string-to-number (match-string-no-properties 1))
						(count-lines 1 (point)))
					       line-number-update-list))))
	  (while line-number-update-list
	    (intercal-lnu-individual (caar line-number-update-list) (cadar line-number-update-list))
	    (setq line-number-update-list (cdr line-number-update-list))))
	(goto-char (point-min))
	(while (search-forward "LNUChange:" nil t)
	  (replace-match "")))
    (error "The buffer is not in intercal-mode"))
)

(defun intercal-lnu-individual (oldlabel newlabel)
"Updates all occurrences of one label in an INTERCAL program for another."
  (save-excursion
    (goto-char (point-min))
    (while (search-forward (concat "(" (number-to-string oldlabel) ")") nil t)
      (replace-match (concat "(LNUChange:" (number-to-string newlabel) ")"))))
)

;; Font Lock settings.
;; We use keyword-face for commands, builtin-face for gerunds, constant-face
;; for meshes and mingle-mesh constants, and comment-face for initially
;; abstained lines (because these are usually comments, and anyway it's good
;; for them to stand out). Only the first line of multiline comments is marked.
;; MAYBE lines aren't marked because that's a big giveaway that the line won't
;; be abstained from all program.
(defvar intercal-font-lock-keywords
  '(("^\\(([0-9]+)\\|\\)[ \t]*\\(PLEASE DO\\|DO\\|PLEASE\\)[ \t]*\\(NOT\\|N'T\\).*$" . font-lock-comment-face)
    ("\\<\\(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)
    ("\\<\\(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)
    ("[.,:;][0-9]+" . font-lock-variable-name-face)
    ("#[0-9]+\\(\\$#[0-9]+\\|\\)" . font-lock-constant-face))
  "Default expressions to highlight in Intercal mode.")

;; Find an error message produced by ick. If the famous RESUBNIT spelling error
;; is ever corrected, this will need to be corrected too.
(defvar intercal-error-regexp
  '("\\(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)
  "Regexp that identifies an INTERCAL error message, and the file and line number positions in it.")

;; Detect the line with which ick was invoked, so the filename used can be
;; used by Emacs' compile-mode to find the error. This will need to be changed
;; if command-line arguments to ick other than letters are allowed.
(defvar intercal-file-regexp '(".*ick \\(-[a-zA-Z]+ \\)*\\(.*i\\)$" 2 nil nil 0 2)
  "Regexp that identifies the line with which ick was invoked, and the filename it was used on.")

;; Helper function for the binary I/O routines.
(defun intercal-reverse-bits-if-nonnull (flag num)
  "Returns num if flag is null, or num with bits reversed if flag is nonnull."
  (if (null flag) num
    (let ((ans 0) (count 8) (num1 num))
	 (while (> count 0)
	   (setq ans (* ans 2))
	   (if (= (% num1 2) 1) (setq ans (1+ ans)))
	   (setq num1 (/ num1 2))
	   (setq count (1- count)))
	 ans))
)

;; Internal memory for inter-function communication. Yes, I know it's
;; unLispish to do this sort of thing, and breaks if the user tries to
;; convert two strings simultaneously.
(defvar intercal-string-array-convert-options-buffer-used nil
  "Variable that keeps track of a buffer used to display options
for intercal-string-array-convert.")

;; Function that inputs options for intercal-string-array-convert.
;; If the user asks for help, it pops up a help buffer and returns nil.
;; Its documentation string is the information required to appear in
;; the help buffer.
(defun intercal-string-array-convert-options (opts)
  "Options for use with intercal-string-array-convert:
   ? Display the list of options
   1 Pack the string one char/element (default)
   2 Pack the string two chars/element (unimplemented)
   4 Pack the string four chars/element (unimplemented)
   $ Pack the string in mingled format (default)
      so \"abcd\" would become \"a$b\"$\"c$d\"
   < Pack the string in shifted format
      (concatentate the codes for each character)
   R Bit-reverse each character code (default)
   W Don't bit-reverse each character code
   , Treat entered number as a tail array (default)
   ; Treat entered number as a hybrid array
   0 Each character code is based at 0 (default)
   + Each character code is based at the previous code (unimplemented)"
  (interactive "sOptions: (type ?[RET] for help)")
  (if (string= opts "?")
      (progn
	(setq intercal-string-array-convert-options-buffer-used t)
	(with-output-to-temp-buffer "*Options*"
	  (princ (documentation 'intercal-string-array-convert-options)))
	nil)
    opts)
)

;; The displaying of the help buffer is done by
;; intercal-string-array-convert-options, if required. This function holds
;; tests to put the display back as it was in two possible common situations
;; involving the user asking for help (one window active, two windows active).
(defun intercal-string-array-convert (in arr &optional opts)
  "Generate INTERCAL code to initialize an array with information
that makes it suitable for use as a string. For more information,
run the command and enter a question mark for the options."
  (interactive "*MEnter string to convert:\nnEnter number of array required:")
  (let ((cb (current-buffer)) (w1p (one-window-p)) (ow nil))
    (if (null w1p) (setq ow other-window-scroll-buffer))
    (while (null opts)
      (setq opts (call-interactively 'intercal-string-array-convert-options)))
    (if intercal-string-array-convert-options-buffer-used
	(progn
	  (select-window (get-buffer-window cb))
	  (if w1p
	      (delete-other-windows)
	    (switch-to-buffer-other-window ow))))
    (setq intercal-string-array-convert-options-buffer-used nil))
  (let ((packing 1) (basis nil) (arrtype ",") (revbits t) (mingle t))
    (while (> (length opts) 0)
      (if (string= (substring opts 0 1) "1") (setq packing 1)
      (if (string= (substring opts 0 1) "2") (error "Unimplemented") ;(setq packing 2) ;unimplemented
      (if (string= (substring opts 0 1) "4") (error "Unimplemented") ;(setq packing 4) ;unimplemented
      (if (string= (substring opts 0 1) "$") (setq mingle t)  ;unimplemented, but has no effect on option 1
      (if (string= (substring opts 0 1) "<") (setq mingle nil);unimplemented, but has no effect on option 1
      (if (string= (substring opts 0 1) "R") (setq revbits t)
      (if (string= (substring opts 0 1) "W") (setq revbits nil)
      (if (string= (substring opts 0 1) ",") (setq arrtype ",")
      (if (string= (substring opts 0 1) ";") (setq arrtype ";")
      (if (string= (substring opts 0 1) "0") (setq basis nil)
      (if (string= (substring opts 0 1) "+") (error "Unimplemented") ;(setq basis t)   ;unimplemented
	(error "Invalid option"))))))))))))
      (setq opts (substring opts 1)))
    (intercal-return)
    (intercal-do-abbrev)
    (let ((al (/ (+ (length in) packing -1) packing)))
      (insert " " arrtype (int-to-string arr) " <- #" (int-to-string al)))
    (let ((lastchar 0) (arrind 1))
      (while (> (length in) 0)
	(intercal-return)
	(intercal-do-abbrev)
	(insert " " arrtype (int-to-string arr) " SUB #" (int-to-string arrind))
	(insert " <- #?" (substring in 0 1))
	(setq in (substring in 1))
	(intercal-char-constant-convert revbits))))
)

;; Converts char to int by subtracting ! and adding 33.
(defun intercal-char-constant-convert (arg)
  "Convert a constant of the form #?<character> into a legal
INTERCAL constant representing the character's character code.
With a prefix argument, gives bit-reversed output. This routine
is intended for use with the binary I/O capabilities of INTERCAL."
  (interactive "*P") ;Check prefix arg, not read-only
  (save-excursion
    (if (re-search-backward "#" (line-beginning-position) t)
	(if (re-search-forward "#\\?\\(.\\)" (line-end-position) t)
	    (replace-match
	     (concat "#" (int-to-string (intercal-reverse-bits-if-nonnull arg
			  (+ 33 (- (string-to-char
				    (match-string-no-properties 1)) ?!)))))))))
)


;; This is simpler than the next function because we're
;; converting from the target base, so it's simply a case
;; of selecting every second character if we need to produce
;; a mingled result
(defun intercal-constant-radix-convert ()
  "Convert a constant of the form #<base>r<integer in that base>
to a legal TRI-INTERCAL constant in that base. If the number is
sufficiently small, it is converted to decimal; otherwise, it is
converted to two mingled decimal constants."
  (interactive "*")
  (save-excursion
    (if (re-search-backward "#" (line-beginning-position) t)
	(if (re-search-forward "#\\([2-7]\\)r\\([0-6]+\\)"
			       (line-end-position) t)
	    (replace-match
	     (let ((radix (string-to-number
			   (match-string-no-properties 1) 10))
		   (str (match-string-no-properties 2)) (slen 0)
		   (mingle1 "") (mingle2 "") (num1 0) (num2 0))
	       (setq slen (length str))
	       (if (or (<= (* radix slen) 32) ; Calculate max onespot length
		       (or (and (= radix 6) (= slen 6))   ;on these
			   (and (= radix 7) (= slen 5)))) ;three lines
		   (progn
		     (setq num1 (string-to-number str radix))
		     (concat "#" (number-to-string num1)))
		 (progn
		   (while (/= 0 (length str))
		     (setq mingle2 (concat (substring str -1) mingle2))
		     (setq str (substring str 0 -1))
		     (if (/= 0 (length str))
			 (progn
			   (setq mingle1 (concat (substring str -1) mingle1))
			   (setq str (substring str 0 -1)))))
		   (setq num1 (string-to-number mingle1 radix))
		   (setq num2 (string-to-number mingle2 radix))
		   (concat "#" (number-to-string num1)
			   "$#" (number-to-string num2)))))))))
)

;; The following code needs a bit of explanation. INTERCAL
;; can handle constants up to 4294967295 (0xffffffff), but
;; Emacs's constants max out somewhere between 100 million
;; and 1 billion. So, when a high number is entered, the
;; code processes the last 6 digits (in whatever base the
;; number is entered in) separately from the rest of the
;; number. This ensures that the arithmetic routines never
;; overflow if the input is a valid integer in the range
;; 0-4294967295. The calculations used do not work for
;; higher numbers, but that doesn't matter because
;; INTERCAL wouldn't accept them. Constants higher than
;; 65535 are given in mingled form (e.g. #65280$#65280).
(defun intercal-constant-convert ()
  "Convert a constant of the form #<a valid C integer> to a
legal INTERCAL constant (#<16-bit decimal integer> or
#<16-bit decimal integer>$#<16-bit decimal integer>).
Decimal (#4294967295), octal (#037777777777) and
hex (#0xffffffff) formats are all supported."
  (interactive "*")
  (save-excursion
    (if (re-search-backward "#" (line-beginning-position) t)
	(if (re-search-forward "#\\(0?[xX]?\\)\\([0-9a-fA-F]+\\)"
			       (line-end-position) t)
	    (replace-match
	     (let ((str (match-string-no-properties 2))
		   (strhi "0") (strlow "0")
		   (base (if (string= (match-string-no-properties 1) "")
			     10
			   (if (string= (match-string-no-properties 1) "0")
			       8 16))))
	       (if (<= (length str) 6) (setq strlow str)
		 (setq strlow (substring str -6) strhi (substring str 0 -6)))
	       (let ((num (string-to-number strlow base))
		     (numhi (string-to-number strhi base)))
		 (if (and (<= num 65535) (string= strhi "0"))
		     (concat "#" (number-to-string num))
		   (let ((mingle1 0) (mingle2 0) (count 16) (temp 0))
		     (while (> count 0)
		       (progn
			 (setq temp (% num 4))
			 (setq num (/ num 4))
			 (if (= (% temp 2) 1) (setq mingle2 (+ mingle2 65536)))
			 (if (> temp 1) (setq mingle1 (+ mingle1 65536)))
			 (setq mingle1 (/ mingle1 2))
			 (setq mingle2 (/ mingle2 2))
			 (setq count (- count 1))
			 (if (= count 13)
			     (setq num (+ num (* (/ (expt base 6) 64) numhi))))))
		     (concat "#" (number-to-string mingle1)
			     "$#" (number-to-string mingle2))
		     ))))
	     t t))))
)

;; This wraps around compilation-parse-errors in compile, and makes sure that
;; the first line of the compilation buffer is blank. This is to make the
;; call of ick (which is needed to determine the source file) look like an
;; error message rather than a compiler call.
(defun intercal-error-wrap (limit-search find-at-least)
  "Parse the current buffer as ick error messages. This just wraps around
'compilation-parse-errors'. See variable 'compilation-parse-errors-function'
for the interface it uses."
  (save-excursion
    (beginning-of-buffer)
    (if (looking-at "^$") nil (newline)))
  (compilation-parse-errors limit-search find-at-least)
)

(require 'compile) ;Now a prerequisite for intercal.el, so its variables can be
                   ;changed to INTERCAL values upon loading an INTERCAL file

;; This hook changes settings in fontlock and compile, so that they
;; recognize INTERCAL syntax and ick error messages. Default options to
;; ick are to optimize, but I chose not to give -b as a default (because
;; it spoils the fun). I'm slightly tempted to use -m as default, but
;; I'm not sure I'm that evil, and I left -f out for the time being because
;; it's something of a radical change to the output.
(add-hook 'intercal-mode-hook
	  (function (lambda ()
		      (make-local-variable 'font-lock-defaults)
		      (setq font-lock-defaults '(intercal-font-lock-keywords t))
		      (make-local-variable 'compile-command)
		      (setq compile-command (concat "ick -O " (buffer-name)))
		      (make-local-variable 'compilation-parse-errors-function)
		      (setq compilation-parse-errors-function 'intercal-error-wrap))))

;; In recent versions of Emacs this must apparently be set globally;
;; also, the -error-regexp and -file-regexp were merged.
(setq compilation-error-regexp-alist (cons intercal-error-regexp
					   compilation-error-regexp-alist))
(if (boundp 'compilation-file-regexp-alist)
    (setq compilation-file-regexp-alist (cons intercal-file-regexp
					      compilation-file-regexp-alist))
  (setq compilation-error-regexp-alist (cons intercal-file-regexp
					     compilation-error-regexp-alist))
  )


;; AIS: End of section I wrote.

;;; intercal.el ends here