* term/xterm.el (xterm--query): Stop after first matching handler. (Bug#14615)
[bpt/emacs.git] / lisp / progmodes / icon.el
CommitLineData
1a06eabd
ER
1;;; icon.el --- mode for editing Icon code
2
ab422c4d 3;; Copyright (C) 1989, 2001-2013 Free Software Foundation, Inc.
9750e079 4
33069f58 5;; Author: Chris Smith <csmith@convex.com>
e5167999 6;; Created: 15 Feb 89
fd7fa35a 7;; Keywords: languages
a2535589 8
a2535589
JA
9;; This file is part of GNU Emacs.
10
b1fc2b50 11;; GNU Emacs is free software: you can redistribute it and/or modify
a2535589 12;; it under the terms of the GNU General Public License as published by
b1fc2b50
GM
13;; the Free Software Foundation, either version 3 of the License, or
14;; (at your option) any later version.
a2535589
JA
15
16;; GNU Emacs is distributed in the hope that it will be useful,
17;; but WITHOUT ANY WARRANTY; without even the implied warranty of
18;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
19;; GNU General Public License for more details.
20
21;; You should have received a copy of the GNU General Public License
b1fc2b50 22;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
a2535589 23
e5167999
ER
24;;; Commentary:
25
e41b2db1 26;; A major mode for editing the Icon programming language.
e5167999
ER
27
28;;; Code:
a2535589
JA
29
30(defvar icon-mode-abbrev-table nil
31 "Abbrev table in use in Icon-mode buffers.")
32(define-abbrev-table 'icon-mode-abbrev-table ())
33
34(defvar icon-mode-map ()
35 "Keymap used in Icon mode.")
36(if icon-mode-map
37 ()
78d7cf68
RS
38 (let ((map (make-sparse-keymap "Icon")))
39 (setq icon-mode-map (make-sparse-keymap))
40 (define-key icon-mode-map "{" 'electric-icon-brace)
41 (define-key icon-mode-map "}" 'electric-icon-brace)
42 (define-key icon-mode-map "\e\C-h" 'mark-icon-function)
43 (define-key icon-mode-map "\e\C-a" 'beginning-of-icon-defun)
44 (define-key icon-mode-map "\e\C-e" 'end-of-icon-defun)
45 (define-key icon-mode-map "\e\C-q" 'indent-icon-exp)
46 (define-key icon-mode-map "\177" 'backward-delete-char-untabify)
a1506d29 47
26ee4ca3 48 (define-key icon-mode-map [menu-bar] (make-sparse-keymap "Icon"))
78d7cf68
RS
49 (define-key icon-mode-map [menu-bar icon]
50 (cons "Icon" map))
51 (define-key map [beginning-of-icon-defun] '("Beginning of function" . beginning-of-icon-defun))
52 (define-key map [end-of-icon-defun] '("End of function" . end-of-icon-defun))
53 (define-key map [comment-region] '("Comment Out Region" . comment-region))
54 (define-key map [indent-region] '("Indent Region" . indent-region))
55 (define-key map [indent-line] '("Indent Line" . icon-indent-command))
56 (put 'eval-region 'menu-enable 'mark-active)
57 (put 'comment-region 'menu-enable 'mark-active)
58 (put 'indent-region 'menu-enable 'mark-active)))
a2535589
JA
59
60(defvar icon-mode-syntax-table nil
61 "Syntax table in use in Icon-mode buffers.")
62
63(if icon-mode-syntax-table
64 ()
65 (setq icon-mode-syntax-table (make-syntax-table))
66 (modify-syntax-entry ?\\ "\\" icon-mode-syntax-table)
67 (modify-syntax-entry ?# "<" icon-mode-syntax-table)
68 (modify-syntax-entry ?\n ">" icon-mode-syntax-table)
69 (modify-syntax-entry ?$ "." icon-mode-syntax-table)
70 (modify-syntax-entry ?/ "." icon-mode-syntax-table)
71 (modify-syntax-entry ?* "." icon-mode-syntax-table)
72 (modify-syntax-entry ?+ "." icon-mode-syntax-table)
73 (modify-syntax-entry ?- "." icon-mode-syntax-table)
74 (modify-syntax-entry ?= "." icon-mode-syntax-table)
75 (modify-syntax-entry ?% "." icon-mode-syntax-table)
76 (modify-syntax-entry ?< "." icon-mode-syntax-table)
77 (modify-syntax-entry ?> "." icon-mode-syntax-table)
78 (modify-syntax-entry ?& "." icon-mode-syntax-table)
79 (modify-syntax-entry ?| "." icon-mode-syntax-table)
80 (modify-syntax-entry ?\' "\"" icon-mode-syntax-table))
81
da37a9b4
RS
82(defgroup icon nil
83 "Mode for editing Icon code."
8ec3bce0 84 :link '(custom-group-link :tag "Font Lock Faces group" font-lock-faces)
da37a9b4
RS
85 :group 'languages)
86
87(defcustom icon-indent-level 4
fb7ada5f 88 "Indentation of Icon statements with respect to containing block."
da37a9b4
RS
89 :type 'integer
90 :group 'icon)
91
92(defcustom icon-brace-imaginary-offset 0
fb7ada5f 93 "Imagined indentation of a Icon open brace that actually follows a statement."
da37a9b4
RS
94 :type 'integer
95 :group 'icon)
96
97(defcustom icon-brace-offset 0
fb7ada5f 98 "Extra indentation for braces, compared with other text in same context."
da37a9b4
RS
99 :type 'integer
100 :group 'icon)
101
102(defcustom icon-continued-statement-offset 4
fb7ada5f 103 "Extra indent for Icon lines not starting new statements."
da37a9b4
RS
104 :type 'integer
105 :group 'icon)
106
107(defcustom icon-continued-brace-offset 0
fb7ada5f 108 "Extra indent for Icon substatements that start with open-braces.
da37a9b4
RS
109This is in addition to `icon-continued-statement-offset'."
110 :type 'integer
111 :group 'icon)
112
113(defcustom icon-auto-newline nil
fb7ada5f 114 "Non-nil means automatically newline before and after braces Icon code.
da37a9b4
RS
115This applies when braces are inserted."
116 :type 'boolean
117 :group 'icon)
118
119(defcustom icon-tab-always-indent t
fb7ada5f 120 "Non-nil means TAB in Icon mode should always reindent the current line.
da37a9b4
RS
121It will then reindent, regardless of where in the line point is
122when the TAB command is used."
8c36e648 123 :type 'boolean
da37a9b4 124 :group 'icon)
78d7cf68
RS
125
126(defvar icon-imenu-generic-expression
b0edcc39 127 '((nil "^[ \t]*procedure[ \t]+\\(\\sw+\\)[ \t]*(" 1))
da37a9b4 128 "Imenu expression for Icon mode. See `imenu-generic-expression'.")
78d7cf68
RS
129
130
a2535589 131\f
e3ead21b 132;;;###autoload
175069ef 133(define-derived-mode icon-mode prog-mode "Icon"
a2535589
JA
134 "Major mode for editing Icon code.
135Expression and list commands understand all Icon brackets.
136Tab indents for Icon code.
137Paragraphs are separated by blank lines only.
138Delete converts tabs to spaces as it moves back.
139\\{icon-mode-map}
140Variables controlling indentation style:
141 icon-tab-always-indent
142 Non-nil means TAB in Icon mode should always reindent the current line,
143 regardless of where in the line point is when the TAB command is used.
144 icon-auto-newline
145 Non-nil means automatically newline before and after braces
146 inserted in Icon code.
147 icon-indent-level
148 Indentation of Icon statements within surrounding block.
149 The surrounding block's indentation is the indentation
150 of the line on which the open-brace appears.
151 icon-continued-statement-offset
152 Extra indentation given to a substatement, such as the
153 then-clause of an if or body of a while.
154 icon-continued-brace-offset
155 Extra indentation given to a brace that starts a substatement.
073c9531 156 This is in addition to `icon-continued-statement-offset'.
a2535589
JA
157 icon-brace-offset
158 Extra indentation for line if it starts with an open brace.
159 icon-brace-imaginary-offset
160 An open brace following other text is treated as if it were
161 this far to the right of the start of its line.
162
073c9531
JB
163Turning on Icon mode calls the value of the variable `icon-mode-hook'
164with no args, if that value is non-nil."
175069ef
SM
165 :abbrev-table icon-mode-abbrev-table
166 (set (make-local-variable 'paragraph-start) (concat "$\\|" page-delimiter))
167 (set (make-local-variable 'paragraph-separate) paragraph-start)
168 (set (make-local-variable 'indent-line-function) #'icon-indent-line)
169 (set (make-local-variable 'comment-start) "# ")
170 (set (make-local-variable 'comment-end) "")
171 (set (make-local-variable 'comment-start-skip) "# *")
172 (set (make-local-variable 'comment-indent-function) 'icon-comment-indent)
7b371301 173 (set (make-local-variable 'indent-line-function) 'icon-indent-line)
78d7cf68 174 ;; font-lock support
175069ef
SM
175 (set (make-local-variable 'font-lock-defaults)
176 '((icon-font-lock-keywords
177 icon-font-lock-keywords-1 icon-font-lock-keywords-2)
178 nil nil ((?_ . "w")) beginning-of-defun
179 ;; Obsoleted by Emacs 19.35 parse-partial-sexp's COMMENTSTOP.
180 ;;(font-lock-comment-start-regexp . "#")
181 (font-lock-mark-block-function . mark-defun)))
78d7cf68 182 ;; imenu support
175069ef
SM
183 (set (make-local-variable 'imenu-generic-expression)
184 icon-imenu-generic-expression)
78d7cf68
RS
185 ;; hideshow support
186 ;; we start from the assertion that `hs-special-modes-alist' is autoloaded.
b0edcc39
RS
187 (unless (assq 'icon-mode hs-special-modes-alist)
188 (setq hs-special-modes-alist
a1506d29 189 (cons '(icon-mode "\\<procedure\\>" "\\<end\\>" nil
b0edcc39 190 icon-forward-sexp-function)
175069ef 191 hs-special-modes-alist))))
a2535589 192\f
073c9531
JB
193;; This is used by indent-for-comment to decide how much to
194;; indent a comment in Icon code based on its context.
a2535589 195(defun icon-comment-indent ()
7b371301 196 (if (looking-at "^#") 0 comment-column))
a2535589
JA
197
198(defun electric-icon-brace (arg)
199 "Insert character and correct line's indentation."
200 (interactive "P")
201 (let (insertpos)
202 (if (and (not arg)
203 (eolp)
204 (or (save-excursion
205 (skip-chars-backward " \t")
206 (bolp))
207 (if icon-auto-newline
208 (progn (icon-indent-line) (newline) t)
209 nil)))
210 (progn
1ba983e8 211 (insert last-command-event)
a2535589
JA
212 (icon-indent-line)
213 (if icon-auto-newline
214 (progn
215 (newline)
216 ;; (newline) may have done auto-fill
217 (setq insertpos (- (point) 2))
218 (icon-indent-line)))
219 (save-excursion
220 (if insertpos (goto-char (1+ insertpos)))
221 (delete-char -1))))
222 (if insertpos
223 (save-excursion
224 (goto-char insertpos)
225 (self-insert-command (prefix-numeric-value arg)))
226 (self-insert-command (prefix-numeric-value arg)))))
227\f
228(defun icon-indent-command (&optional whole-exp)
a2535589 229 "Indent current line as Icon code, or in some cases insert a tab character.
073c9531
JB
230If `icon-tab-always-indent' is non-nil (the default), always indent current
231line. Otherwise, indent the current line only if point is at the left margin
a2535589
JA
232or in the line's indentation; otherwise insert a tab.
233
073c9531
JB
234A numeric argument, regardless of its value, means indent rigidly all the
235lines of the expression starting after point so that this line becomes
236properly indented. The relative indentation among the lines of the
237expression are preserved."
279dffd6 238 (interactive "P")
a2535589
JA
239 (if whole-exp
240 ;; If arg, always indent this line as Icon
241 ;; and shift remaining lines of expression the same amount.
242 (let ((shift-amt (icon-indent-line))
243 beg end)
244 (save-excursion
245 (if icon-tab-always-indent
246 (beginning-of-line))
247 (setq beg (point))
248 (forward-sexp 1)
249 (setq end (point))
250 (goto-char beg)
251 (forward-line 1)
252 (setq beg (point)))
253 (if (> end beg)
254 (indent-code-rigidly beg end shift-amt "#")))
255 (if (and (not icon-tab-always-indent)
256 (save-excursion
257 (skip-chars-backward " \t")
258 (not (bolp))))
259 (insert-tab)
260 (icon-indent-line))))
261
262(defun icon-indent-line ()
263 "Indent current line as Icon code.
264Return the amount the indentation changed by."
265 (let ((indent (calculate-icon-indent nil))
266 beg shift-amt
267 (case-fold-search nil)
268 (pos (- (point-max) (point))))
269 (beginning-of-line)
270 (setq beg (point))
271 (cond ((eq indent nil)
272 (setq indent (current-indentation)))
0c1a49d3 273 ((looking-at "^#")
a2535589
JA
274 (setq indent 0))
275 (t
276 (skip-chars-forward " \t")
277 (if (listp indent) (setq indent (car indent)))
278 (cond ((and (looking-at "else\\b")
279 (not (looking-at "else\\s_")))
280 (setq indent (save-excursion
281 (icon-backward-to-start-of-if)
282 (current-indentation))))
283 ((or (= (following-char) ?})
284 (looking-at "end\\b"))
285 (setq indent (- indent icon-indent-level)))
286 ((= (following-char) ?{)
287 (setq indent (+ indent icon-brace-offset))))))
288 (skip-chars-forward " \t")
289 (setq shift-amt (- indent (current-column)))
290 (if (zerop shift-amt)
291 (if (> (- (point-max) pos) (point))
292 (goto-char (- (point-max) pos)))
293 (delete-region beg (point))
294 (indent-to indent)
295 ;; If initial point was within line's indentation,
296 ;; position after the indentation. Else stay at same point in text.
297 (if (> (- (point-max) pos) (point))
298 (goto-char (- (point-max) pos))))
299 shift-amt))
300
301(defun calculate-icon-indent (&optional parse-start)
302 "Return appropriate indentation for current line as Icon code.
303In usual case returns an integer: the column to indent to.
304Returns nil if line starts inside a string, t if in a comment."
305 (save-excursion
306 (beginning-of-line)
307 (let ((indent-point (point))
308 (case-fold-search nil)
309 state
310 containing-sexp
311 toplevel)
312 (if parse-start
313 (goto-char parse-start)
314 (setq toplevel (beginning-of-icon-defun)))
315 (while (< (point) indent-point)
316 (setq parse-start (point))
317 (setq state (parse-partial-sexp (point) indent-point 0))
318 (setq containing-sexp (car (cdr state))))
319 (cond ((or (nth 3 state) (nth 4 state))
320 ;; return nil or t if should not change this line
321 (nth 4 state))
322 ((and containing-sexp
323 (/= (char-after containing-sexp) ?{))
324 ;; line is expression, not statement:
325 ;; indent to just after the surrounding open.
326 (goto-char (1+ containing-sexp))
327 (current-column))
328 (t
329 (if toplevel
330 ;; Outside any procedures.
331 (progn (icon-backward-to-noncomment (point-min))
332 (if (icon-is-continuation-line)
333 icon-continued-statement-offset 0))
334 ;; Statement level.
335 (if (null containing-sexp)
336 (progn (beginning-of-icon-defun)
337 (setq containing-sexp (point))))
338 (goto-char indent-point)
339 ;; Is it a continuation or a new statement?
340 ;; Find previous non-comment character.
341 (icon-backward-to-noncomment containing-sexp)
342 ;; Now we get the answer.
343 (if (icon-is-continuation-line)
344 ;; This line is continuation of preceding line's statement;
345 ;; indent icon-continued-statement-offset more than the
346 ;; first line of the statement.
347 (progn
348 (icon-backward-to-start-of-continued-exp containing-sexp)
349 (+ icon-continued-statement-offset (current-column)
350 (if (save-excursion (goto-char indent-point)
351 (skip-chars-forward " \t")
352 (eq (following-char) ?{))
353 icon-continued-brace-offset 0)))
354 ;; This line starts a new statement.
355 ;; Position following last unclosed open.
356 (goto-char containing-sexp)
357 ;; Is line first statement after an open-brace?
358 (or
359 ;; If no, find that first statement and indent like it.
360 (save-excursion
361 (if (looking-at "procedure\\s ")
362 (forward-sexp 3)
363 (forward-char 1))
364 (while (progn (skip-chars-forward " \t\n")
365 (looking-at "#"))
366 ;; Skip over comments following openbrace.
367 (forward-line 1))
368 ;; The first following code counts
369 ;; if it is before the line we want to indent.
370 (and (< (point) indent-point)
371 (current-column)))
372 ;; If no previous statement,
373 ;; indent it relative to line brace is on.
374 ;; For open brace in column zero, don't let statement
375 ;; start there too. If icon-indent-level is zero,
376 ;; use icon-brace-offset + icon-continued-statement-offset
377 ;; instead.
378 ;; For open-braces not the first thing in a line,
379 ;; add in icon-brace-imaginary-offset.
380 (+ (if (and (bolp) (zerop icon-indent-level))
381 (+ icon-brace-offset
382 icon-continued-statement-offset)
383 icon-indent-level)
384 ;; Move back over whitespace before the openbrace.
385 ;; If openbrace is not first nonwhite thing on the line,
386 ;; add the icon-brace-imaginary-offset.
387 (progn (skip-chars-backward " \t")
388 (if (bolp) 0 icon-brace-imaginary-offset))
389 ;; Get initial indentation of the line we are on.
390 (current-indentation))))))))))
391
392;; List of words to check for as the last thing on a line.
393;; If cdr is t, next line is a continuation of the same statement,
394;; if cdr is nil, next line starts a new (possibly indented) statement.
395
396(defconst icon-resword-alist
397 '(("by" . t) ("case" . t) ("create") ("do") ("dynamic" . t) ("else")
398 ("every" . t) ("if" . t) ("global" . t) ("initial" . t)
399 ("link" . t) ("local" . t) ("of") ("record" . t) ("repeat" . t)
400 ("static" . t) ("then") ("to" . t) ("until" . t) ("while" . t)))
401
402(defun icon-is-continuation-line ()
403 (let* ((ch (preceding-char))
404 (ch-syntax (char-syntax ch)))
405 (if (eq ch-syntax ?w)
406 (assoc (buffer-substring
407 (progn (forward-word -1) (point))
408 (progn (forward-word 1) (point)))
409 icon-resword-alist)
0c1a49d3 410 (not (memq ch '(0 ?\; ?\} ?\{ ?\) ?\] ?\" ?\' ?\# ?\, ?\. ?\n))))))
a2535589
JA
411
412(defun icon-backward-to-noncomment (lim)
413 (let (opoint stop)
414 (while (not stop)
415 (skip-chars-backward " \t\n\f" lim)
416 (setq opoint (point))
417 (beginning-of-line)
418 (if (and (nth 5 (parse-partial-sexp (point) opoint))
419 (< lim (point)))
420 (search-backward "#")
421 (setq stop t)))))
422
423(defun icon-backward-to-start-of-continued-exp (lim)
424 (if (memq (preceding-char) '(?\) ?\]))
425 (forward-sexp -1))
426 (beginning-of-line)
427 (skip-chars-forward " \t")
428 (cond
429 ((<= (point) lim) (goto-char (1+ lim)))
430 ((not (icon-is-continued-line)) 0)
431 ((and (eq (char-syntax (following-char)) ?w)
432 (cdr
433 (assoc (buffer-substring (point)
434 (save-excursion (forward-word 1) (point)))
435 icon-resword-alist))) 0)
436 (t (end-of-line 0) (icon-backward-to-start-of-continued-exp lim))))
437
438(defun icon-is-continued-line ()
439 (save-excursion
440 (end-of-line 0)
441 (icon-is-continuation-line)))
442
443(defun icon-backward-to-start-of-if (&optional limit)
073c9531 444 "Move to the start of the last \"unbalanced\" if."
a2535589
JA
445 (or limit (setq limit (save-excursion (beginning-of-icon-defun) (point))))
446 (let ((if-level 1)
447 (case-fold-search nil))
448 (while (not (zerop if-level))
449 (backward-sexp 1)
450 (cond ((looking-at "else\\b")
451 (setq if-level (1+ if-level)))
452 ((looking-at "if\\b")
453 (setq if-level (1- if-level)))
454 ((< (point) limit)
455 (setq if-level 0)
456 (goto-char limit))))))
457\f
458(defun mark-icon-function ()
459 "Put mark at end of Icon function, point at beginning."
460 (interactive)
461 (push-mark (point))
462 (end-of-icon-defun)
463 (push-mark (point))
464 (beginning-of-line 0)
465 (beginning-of-icon-defun))
466
467(defun beginning-of-icon-defun ()
468 "Go to the start of the enclosing procedure; return t if at top level."
469 (interactive)
470 (if (re-search-backward "^procedure\\s \\|^end[ \t\n]" (point-min) 'move)
471 (looking-at "e")
472 t))
473
474(defun end-of-icon-defun ()
475 (interactive)
476 (if (not (bobp)) (forward-char -1))
477 (re-search-forward "\\(\\s \\|^\\)end\\(\\s \\|$\\)" (point-max) 'move)
478 (forward-word -1)
479 (forward-line 1))
480\f
481(defun indent-icon-exp ()
482 "Indent each line of the Icon grouping following point."
483 (interactive)
484 (let ((indent-stack (list nil))
485 (contain-stack (list (point)))
486 (case-fold-search nil)
e02f48d7
JB
487 outer-loop-done inner-loop-done state ostate
488 this-indent last-depth
489 at-else at-brace
a2535589
JA
490 (opoint (point))
491 (next-depth 0))
492 (save-excursion
493 (forward-sexp 1))
494 (save-excursion
495 (setq outer-loop-done nil)
496 (while (and (not (eobp)) (not outer-loop-done))
497 (setq last-depth next-depth)
498 ;; Compute how depth changes over this line
499 ;; plus enough other lines to get to one that
500 ;; does not end inside a comment or string.
501 ;; Meanwhile, do appropriate indentation on comment lines.
5b1a29ab
RS
502 (setq inner-loop-done nil)
503 (while (and (not inner-loop-done)
a2535589
JA
504 (not (and (eobp) (setq outer-loop-done t))))
505 (setq ostate state)
506 (setq state (parse-partial-sexp (point) (progn (end-of-line) (point))
507 nil nil state))
508 (setq next-depth (car state))
a2535589
JA
509 (if (or (nth 4 ostate))
510 (icon-indent-line))
511 (if (or (nth 3 state))
512 (forward-line 1)
5b1a29ab 513 (setq inner-loop-done t)))
a2535589
JA
514 (if (<= next-depth 0)
515 (setq outer-loop-done t))
516 (if outer-loop-done
517 nil
a2535589
JA
518 (while (> last-depth next-depth)
519 (setq indent-stack (cdr indent-stack)
520 contain-stack (cdr contain-stack)
521 last-depth (1- last-depth)))
522 (while (< last-depth next-depth)
523 (setq indent-stack (cons nil indent-stack)
524 contain-stack (cons nil contain-stack)
525 last-depth (1+ last-depth)))
526 (if (null (car contain-stack))
527 (setcar contain-stack (or (car (cdr state))
528 (save-excursion (forward-sexp -1)
529 (point)))))
530 (forward-line 1)
531 (skip-chars-forward " \t")
532 (if (eolp)
533 nil
534 (if (and (car indent-stack)
535 (>= (car indent-stack) 0))
536 ;; Line is on an existing nesting level.
537 ;; Lines inside parens are handled specially.
538 (if (/= (char-after (car contain-stack)) ?{)
539 (setq this-indent (car indent-stack))
540 ;; Line is at statement level.
541 ;; Is it a new statement? Is it an else?
542 ;; Find last non-comment character before this line
543 (save-excursion
544 (setq at-else (looking-at "else\\W"))
545 (setq at-brace (= (following-char) ?{))
546 (icon-backward-to-noncomment opoint)
547 (if (icon-is-continuation-line)
548 ;; Preceding line did not end in comma or semi;
549 ;; indent this line icon-continued-statement-offset
550 ;; more than previous.
551 (progn
552 (icon-backward-to-start-of-continued-exp (car contain-stack))
553 (setq this-indent
554 (+ icon-continued-statement-offset (current-column)
555 (if at-brace icon-continued-brace-offset 0))))
556 ;; Preceding line ended in comma or semi;
557 ;; use the standard indent for this level.
558 (if at-else
559 (progn (icon-backward-to-start-of-if opoint)
560 (setq this-indent (current-indentation)))
561 (setq this-indent (car indent-stack))))))
562 ;; Just started a new nesting level.
563 ;; Compute the standard indent for this level.
564 (let ((val (calculate-icon-indent
565 (if (car indent-stack)
566 (- (car indent-stack))))))
567 (setcar indent-stack
568 (setq this-indent val))))
569 ;; Adjust line indentation according to its contents
570 (if (or (= (following-char) ?})
571 (looking-at "end\\b"))
572 (setq this-indent (- this-indent icon-indent-level)))
573 (if (= (following-char) ?{)
574 (setq this-indent (+ this-indent icon-brace-offset)))
575 ;; Put chosen indentation into effect.
576 (or (= (current-column) this-indent)
577 (progn
578 (delete-region (point) (progn (beginning-of-line) (point)))
579 (indent-to this-indent)))
580 ;; Indent any comment following the text.
581 (or (looking-at comment-start-skip)
5ed619e0 582 (if (re-search-forward comment-start-skip (line-end-position) t)
a2535589
JA
583 (progn (indent-for-comment) (beginning-of-line))))))))))
584
78d7cf68
RS
585(defconst icon-font-lock-keywords-1
586 (eval-when-compile
587 (list
588 ;; Fontify procedure name definitions.
32632f66 589 '("^[ \t]*\\(procedure\\)\\>[ \t]*\\(\\sw+\\)?"
78d7cf68 590 (1 font-lock-builtin-face) (2 font-lock-function-name-face nil t))))
b0edcc39 591 "Subdued level highlighting for Icon mode.")
78d7cf68
RS
592
593(defconst icon-font-lock-keywords-2
a1506d29 594 (append
78d7cf68
RS
595 icon-font-lock-keywords-1
596 (eval-when-compile
597 (list
598 ;; Fontify all type specifiers.
7b371301
SM
599 (cons
600 (regexp-opt '("null" "string" "co-expression" "table" "integer"
601 "cset" "set" "real" "file" "list") 'words)
cd63e73b 602 'font-lock-type-face)
78d7cf68 603 ;; Fontify all keywords.
cd63e73b 604 ;;
a1506d29
JB
605 (cons
606 (regexp-opt
607 '("break" "do" "next" "repeat" "to" "by" "else" "if" "not" "return"
608 "until" "case" "of" "while" "create" "every" "suspend" "default"
7b371301 609 "fail" "record" "then") 'words)
cd63e73b 610 'font-lock-keyword-face)
a1506d29 611 ;; "end" "initial"
7b371301 612 (cons (regexp-opt '("end" "initial") 'words)
cd63e73b 613 'font-lock-builtin-face)
78d7cf68 614 ;; Fontify all system variables.
a1506d29
JB
615 (cons
616 (regexp-opt
617 '("&allocated" "&ascii" "&clock" "&col" "&collections" "&column"
cd63e73b 618 "&control" "&cset" "&current" "&date" "&dateline" "&digits" "&dump"
a1506d29
JB
619 "&e" "&error" "&errornumber" "&errortext" "&errorvalue" "&errout"
620 "&eventcode" "&eventsource" "&eventvalue" "&fail" "&features"
621 "&file" "&host" "&input" "&interval" "&lcase" "&ldrag" "&letters"
622 "&level" "&line" "&lpress" "&lrelease" "&main" "&mdrag" "&meta"
623 "&mpress" "&mrelease" "&null" "&output" "&phi" "&pi" "&pos"
624 "&progname" "&random" "&rdrag" "&regions" "&resize" "&row"
625 "&rpress" "&rrelease" "&shift" "&source" "&storage" "&subject"
cd63e73b 626 "&time" "&trace" "&ucase" "&version" "&window" "&x" "&y") t)
883212ce 627 'font-lock-constant-face)
cd63e73b 628 (cons ;; global local static declarations and link files
a1506d29 629 (concat
cd63e73b
RS
630 "^[ \t]*"
631 (regexp-opt '("global" "link" "local" "static") t)
632 "\\(\\sw+\\>\\)*")
633 '((1 font-lock-builtin-face)
634 (font-lock-match-c-style-declaration-item-and-skip-to-next
635 (goto-char (or (match-beginning 2) (match-end 1))) nil
636 (1 (if (match-beginning 2)
637 font-lock-function-name-face
638 font-lock-variable-name-face)))))
639
32632f66 640 (cons ;; $define $elif $ifdef $ifndef $undef
a1506d29 641 (concat "^"
b0edcc39
RS
642 (regexp-opt'("$define" "$elif" "$ifdef" "$ifndef" "$undef") t)
643 "\\>[ \t]*\\([^ \t\n]+\\)?")
a1506d29 644 '((1 font-lock-builtin-face)
cd63e73b 645 (4 font-lock-variable-name-face nil t)))
a1506d29
JB
646 (cons ;; $dump $endif $else $include
647 (concat
cd63e73b
RS
648 "^" (regexp-opt'("$dump" "$endif" "$else" "$include") t) "\\>" )
649 'font-lock-builtin-face)
650 (cons ;; $warning $error
b0edcc39
RS
651 (concat "^" (regexp-opt '("$warning" "$error") t)
652 "\\>[ \t]*\\(.+\\)?")
653 '((1 font-lock-builtin-face) (3 font-lock-warning-face nil t))))))
654 "Gaudy level highlighting for Icon mode.")
78d7cf68
RS
655
656(defvar icon-font-lock-keywords icon-font-lock-keywords-1
657 "Default expressions to highlight in `icon-mode'.")
658
659;;;used by hs-minor-mode
660(defun icon-forward-sexp-function (arg)
5547fcff
RS
661 (if (< arg 0)
662 (beginning-of-icon-defun)
663 (end-of-icon-defun)
664 (forward-char -1)))
78d7cf68 665
69d92b8a
RS
666(provide 'icon)
667
1a06eabd 668;;; icon.el ends here