![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to icon.el CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [Apple XNU] / GNUtools / emacs / lisp|
Return to icon.el CVS log | Up to [Apple XNU] / GNUtools / emacs / lisp |
1.1 root 1: ;; Note: use
2: ;; (autoload 'icon-mode "icon" nil t)
3: ;; (setq auto-mode-alist (cons '("\\.icn$" . icon-mode) auto-mode-alist))
4: ;; if not permanently installed in your emacs
5:
6: ;; Icon code editing commands for Emacs
7: ;; from c-mode.el 13-Apr-88 Chris Smith; bugs to convex!csmith
8: ;; Copyright (C) 1988 Free Software Foundation, Inc.
9:
10: ;; This file is part of GNU Emacs.
11:
12: ;; GNU Emacs is free software; you can redistribute it and/or modify
13: ;; it under the terms of the GNU General Public License as published by
14: ;; the Free Software Foundation; either version 1, or (at your option)
15: ;; any later version.
16:
17: ;; GNU Emacs is distributed in the hope that it will be useful,
18: ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
19: ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
20: ;; GNU General Public License for more details.
21:
22: ;; You should have received a copy of the GNU General Public License
23: ;; along with GNU Emacs; see the file COPYING. If not, write to
24: ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
25:
26:
27: (defvar icon-mode-abbrev-table nil
28: "Abbrev table in use in Icon-mode buffers.")
29: (define-abbrev-table 'icon-mode-abbrev-table ())
30:
31: (defvar icon-mode-map ()
32: "Keymap used in Icon mode.")
33: (if icon-mode-map
34: ()
35: (setq icon-mode-map (make-sparse-keymap))
36: (define-key icon-mode-map "{" 'electric-icon-brace)
37: (define-key icon-mode-map "}" 'electric-icon-brace)
38: (define-key icon-mode-map "\e\C-h" 'mark-icon-function)
39: (define-key icon-mode-map "\e\C-a" 'beginning-of-icon-defun)
40: (define-key icon-mode-map "\e\C-e" 'end-of-icon-defun)
41: (define-key icon-mode-map "\e\C-q" 'indent-icon-exp)
42: (define-key icon-mode-map "\177" 'backward-delete-char-untabify)
43: (define-key icon-mode-map "\t" 'icon-indent-command))
44:
45: (defvar icon-mode-syntax-table nil
46: "Syntax table in use in Icon-mode buffers.")
47:
48: (if icon-mode-syntax-table
49: ()
50: (setq icon-mode-syntax-table (make-syntax-table))
51: (modify-syntax-entry ?\\ "\\" icon-mode-syntax-table)
52: (modify-syntax-entry ?# "<" icon-mode-syntax-table)
53: (modify-syntax-entry ?\n ">" icon-mode-syntax-table)
54: (modify-syntax-entry ?$ "." icon-mode-syntax-table)
55: (modify-syntax-entry ?/ "." icon-mode-syntax-table)
56: (modify-syntax-entry ?* "." icon-mode-syntax-table)
57: (modify-syntax-entry ?+ "." icon-mode-syntax-table)
58: (modify-syntax-entry ?- "." icon-mode-syntax-table)
59: (modify-syntax-entry ?= "." icon-mode-syntax-table)
60: (modify-syntax-entry ?% "." icon-mode-syntax-table)
61: (modify-syntax-entry ?< "." icon-mode-syntax-table)
62: (modify-syntax-entry ?> "." icon-mode-syntax-table)
63: (modify-syntax-entry ?& "." icon-mode-syntax-table)
64: (modify-syntax-entry ?| "." icon-mode-syntax-table)
65: (modify-syntax-entry ?\' "\"" icon-mode-syntax-table))
66:
67: (defconst icon-indent-level 4
68: "*Indentation of Icon statements with respect to containing block.")
69: (defconst icon-brace-imaginary-offset 0
70: "*Imagined indentation of a Icon open brace that actually follows a statement.")
71: (defconst icon-brace-offset 0
72: "*Extra indentation for braces, compared with other text in same context.")
73: (defconst icon-continued-statement-offset 4
74: "*Extra indent for lines not starting new statements.")
75: (defconst icon-continued-brace-offset 0
76: "*Extra indent for substatements that start with open-braces.
77: This is in addition to icon-continued-statement-offset.")
78:
79: (defconst icon-auto-newline nil
80: "*Non-nil means automatically newline before and after braces,
81: and after colons and semicolons, inserted in C code.")
82:
83: (defconst icon-tab-always-indent t
84: "*Non-nil means TAB in Icon mode should always reindent the current line,
85: regardless of where in the line point is when the TAB command is used.")
86:
87: (defun icon-mode ()
88: "Major mode for editing Icon code.
89: Expression and list commands understand all Icon brackets.
90: Tab indents for Icon code.
91: Paragraphs are separated by blank lines only.
92: Delete converts tabs to spaces as it moves back.
93: \\{icon-mode-map}
94: Variables controlling indentation style:
95: icon-tab-always-indent
96: Non-nil means TAB in Icon mode should always reindent the current line,
97: regardless of where in the line point is when the TAB command is used.
98: icon-auto-newline
99: Non-nil means automatically newline before and after braces
100: inserted in Icon code.
101: icon-indent-level
102: Indentation of Icon statements within surrounding block.
103: The surrounding block's indentation is the indentation
104: of the line on which the open-brace appears.
105: icon-continued-statement-offset
106: Extra indentation given to a substatement, such as the
107: then-clause of an if or body of a while.
108: icon-continued-brace-offset
109: Extra indentation given to a brace that starts a substatement.
110: This is in addition to icon-continued-statement-offset.
111: icon-brace-offset
112: Extra indentation for line if it starts with an open brace.
113: icon-brace-imaginary-offset
114: An open brace following other text is treated as if it were
115: this far to the right of the start of its line.
116:
117: Turning on Icon mode calls the value of the variable icon-mode-hook with no args,
118: if that value is non-nil."
119: (interactive)
120: (kill-all-local-variables)
121: (use-local-map icon-mode-map)
122: (setq major-mode 'icon-mode)
123: (setq mode-name "Icon")
124: (setq local-abbrev-table icon-mode-abbrev-table)
125: (set-syntax-table icon-mode-syntax-table)
126: (make-local-variable 'paragraph-start)
127: (setq paragraph-start (concat "^$\\|" page-delimiter))
128: (make-local-variable 'paragraph-separate)
129: (setq paragraph-separate paragraph-start)
130: (make-local-variable 'indent-line-function)
131: (setq indent-line-function 'icon-indent-line)
132: (make-local-variable 'require-final-newline)
133: (setq require-final-newline t)
134: (make-local-variable 'comment-start)
135: (setq comment-start "# ")
136: (make-local-variable 'comment-end)
137: (setq comment-end "")
138: (make-local-variable 'comment-column)
139: (setq comment-column 32)
140: (make-local-variable 'comment-start-skip)
141: (setq comment-start-skip "# *")
142: (make-local-variable 'comment-indent-hook)
143: (setq comment-indent-hook 'icon-comment-indent)
144: (run-hooks 'icon-mode-hook))
145:
146: ;; This is used by indent-for-comment
147: ;; to decide how much to indent a comment in Icon code
148: ;; based on its context.
149: (defun icon-comment-indent ()
150: (if (looking-at "^#")
151: 0 ;Existing comment at bol stays there.
152: (save-excursion
153: (skip-chars-backward " \t")
154: (max (1+ (current-column)) ;Else indent at comment column
155: comment-column)))) ; except leave at least one space.
156:
157: (defun electric-icon-brace (arg)
158: "Insert character and correct line's indentation."
159: (interactive "P")
160: (let (insertpos)
161: (if (and (not arg)
162: (eolp)
163: (or (save-excursion
164: (skip-chars-backward " \t")
165: (bolp))
166: (if icon-auto-newline
167: (progn (icon-indent-line) (newline) t)
168: nil)))
169: (progn
170: (insert last-command-char)
171: (icon-indent-line)
172: (if icon-auto-newline
173: (progn
174: (newline)
175: ;; (newline) may have done auto-fill
176: (setq insertpos (- (point) 2))
177: (icon-indent-line)))
178: (save-excursion
179: (if insertpos (goto-char (1+ insertpos)))
180: (delete-char -1))))
181: (if insertpos
182: (save-excursion
183: (goto-char insertpos)
184: (self-insert-command (prefix-numeric-value arg)))
185: (self-insert-command (prefix-numeric-value arg)))))
186:
187: (defun icon-indent-command (&optional whole-exp)
188: (interactive "P")
189: "Indent current line as Icon code, or in some cases insert a tab character.
190: If icon-tab-always-indent is non-nil (the default), always indent current line.
191: Otherwise, indent the current line only if point is at the left margin
192: or in the line's indentation; otherwise insert a tab.
193:
194: A numeric argument, regardless of its value,
195: means indent rigidly all the lines of the expression starting after point
196: so that this line becomes properly indented.
197: The relative indentation among the lines of the expression are preserved."
198: (if whole-exp
199: ;; If arg, always indent this line as Icon
200: ;; and shift remaining lines of expression the same amount.
201: (let ((shift-amt (icon-indent-line))
202: beg end)
203: (save-excursion
204: (if icon-tab-always-indent
205: (beginning-of-line))
206: (setq beg (point))
207: (forward-sexp 1)
208: (setq end (point))
209: (goto-char beg)
210: (forward-line 1)
211: (setq beg (point)))
212: (if (> end beg)
213: (indent-code-rigidly beg end shift-amt "#")))
214: (if (and (not icon-tab-always-indent)
215: (save-excursion
216: (skip-chars-backward " \t")
217: (not (bolp))))
218: (insert-tab)
219: (icon-indent-line))))
220:
221: (defun icon-indent-line ()
222: "Indent current line as Icon code.
223: Return the amount the indentation changed by."
224: (let ((indent (calculate-icon-indent nil))
225: beg shift-amt
226: (case-fold-search nil)
227: (pos (- (point-max) (point))))
228: (beginning-of-line)
229: (setq beg (point))
230: (cond ((eq indent nil)
231: (setq indent (current-indentation)))
232: ((eq indent t)
233: (setq indent (calculate-icon-indent-within-comment)))
234: ((looking-at "[ \t]*#")
235: (setq indent 0))
236: (t
237: (skip-chars-forward " \t")
238: (if (listp indent) (setq indent (car indent)))
239: (cond ((and (looking-at "else\\b")
240: (not (looking-at "else\\s_")))
241: (setq indent (save-excursion
242: (icon-backward-to-start-of-if)
243: (current-indentation))))
244: ((or (= (following-char) ?})
245: (looking-at "end\\b"))
246: (setq indent (- indent icon-indent-level)))
247: ((= (following-char) ?{)
248: (setq indent (+ indent icon-brace-offset))))))
249: (skip-chars-forward " \t")
250: (setq shift-amt (- indent (current-column)))
251: (if (zerop shift-amt)
252: (if (> (- (point-max) pos) (point))
253: (goto-char (- (point-max) pos)))
254: (delete-region beg (point))
255: (indent-to indent)
256: ;; If initial point was within line's indentation,
257: ;; position after the indentation. Else stay at same point in text.
258: (if (> (- (point-max) pos) (point))
259: (goto-char (- (point-max) pos))))
260: shift-amt))
261:
262: (defun calculate-icon-indent (&optional parse-start)
263: "Return appropriate indentation for current line as Icon code.
264: In usual case returns an integer: the column to indent to.
265: Returns nil if line starts inside a string, t if in a comment."
266: (save-excursion
267: (beginning-of-line)
268: (let ((indent-point (point))
269: (case-fold-search nil)
270: state
271: containing-sexp
272: toplevel)
273: (if parse-start
274: (goto-char parse-start)
275: (setq toplevel (beginning-of-icon-defun)))
276: (while (< (point) indent-point)
277: (setq parse-start (point))
278: (setq state (parse-partial-sexp (point) indent-point 0))
279: (setq containing-sexp (car (cdr state))))
280: (cond ((or (nth 3 state) (nth 4 state))
281: ;; return nil or t if should not change this line
282: (nth 4 state))
283: ((and containing-sexp
284: (/= (char-after containing-sexp) ?{))
285: ;; line is expression, not statement:
286: ;; indent to just after the surrounding open.
287: (goto-char (1+ containing-sexp))
288: (current-column))
289: (t
290: ;; Statement level. Is it a continuation or a new statement?
291: ;; Find previous non-comment character.
292: (if toplevel
293: (progn (icon-backward-to-noncomment (point-min))
294: (if (icon-is-continuation-line)
295: icon-continued-statement-offset 0))
296: (if (null containing-sexp)
297: (progn (beginning-of-icon-defun)
298: (setq containing-sexp (point))))
299: (goto-char indent-point)
300: (icon-backward-to-noncomment containing-sexp)
301: ;; Now we get the answer.
302: (if (icon-is-continuation-line)
303: ;; This line is continuation of preceding line's statement;
304: ;; indent icon-continued-statement-offset more than the
305: ;; first line of the statement.
306: (progn
307: (icon-backward-to-start-of-continued-exp containing-sexp)
308: (+ icon-continued-statement-offset (current-column)
309: (if (save-excursion (goto-char indent-point)
310: (skip-chars-forward " \t")
311: (eq (following-char) ?{))
312: icon-continued-brace-offset 0)))
313: ;; This line starts a new statement.
314: ;; Position following last unclosed open.
315: (goto-char containing-sexp)
316: ;; Is line first statement after an open-brace?
317: (or
318: ;; If no, find that first statement and indent like it.
319: (save-excursion
320: (if (looking-at "procedure\\s ")
321: (forward-sexp 3)
322: (forward-char 1))
323: (while (progn (skip-chars-forward " \t\n")
324: (looking-at "#"))
325: ;; Skip over comments following openbrace.
326: (forward-line 1))
327: ;; The first following code counts
328: ;; if it is before the line we want to indent.
329: (and (< (point) indent-point)
330: (current-column)))
331: ;; If no previous statement,
332: ;; indent it relative to line brace is on.
333: ;; For open brace in column zero, don't let statement
334: ;; start there too. If icon-indent-level is zero,
335: ;; use icon-brace-offset + icon-continued-statement-offset instead.
336: ;; For open-braces not the first thing in a line,
337: ;; add in icon-brace-imaginary-offset.
338: (+ (if (and (bolp) (zerop icon-indent-level))
339: (+ icon-brace-offset icon-continued-statement-offset)
340: icon-indent-level)
341: ;; Move back over whitespace before the openbrace.
342: ;; If openbrace is not first nonwhite thing on the line,
343: ;; add the icon-brace-imaginary-offset.
344: (progn (skip-chars-backward " \t")
345: (if (bolp) 0 icon-brace-imaginary-offset))
346: ;; here we are
347: (current-indentation))))))))))
348:
349: (defun icon-is-continuation-line ()
350: (let* ((ch (preceding-char))
351: (ch-syntax (char-syntax ch)))
352: (if (eq ch-syntax ?w)
353: (assoc (buffer-substring
354: (progn (forward-word -1) (point))
355: (progn (forward-word 1) (point)))
356: '(("do") ("dynamic") ("else") ("initial") ("link")
357: ("local") ("of") ("static") ("then")))
358: (not (memq ch '(0 ?\; ?\} ?\{ ?\) ?\] ?\" ?\' ?\n))))))
359:
360: (defun icon-backward-to-noncomment (lim)
361: (let (opoint stop)
362: (while (not stop)
363: (skip-chars-backward " \t\n\f" lim)
364: (setq opoint (point))
365: (beginning-of-line)
366: (if (and (search-forward "#" opoint 'move)
367: (< lim (point)))
368: (forward-char -1)
369: (setq stop t)))))
370:
371: (defun icon-backward-to-start-of-continued-exp (lim)
372: (if (memq (preceding-char) '(?\) ?\]))
373: (forward-sexp -1))
374: (while (icon-is-continued-line)
375: (end-of-line 0))
376: (beginning-of-line)
377: (if (<= (point) lim)
378: (goto-char (1+ lim)))
379: (skip-chars-forward " \t"))
380:
381: (defun icon-is-continued-line ()
382: (save-excursion
383: (end-of-line 0)
384: (icon-is-continuation-line)))
385:
386: (defun icon-backward-to-start-of-if (&optional limit)
387: "Move to the start of the last ``unbalanced'' if."
388: (or limit (setq limit (save-excursion (beginning-of-icon-defun) (point))))
389: (let ((if-level 1)
390: (case-fold-search nil))
391: (while (not (zerop if-level))
392: (backward-sexp 1)
393: (cond ((looking-at "else\\b")
394: (setq if-level (1+ if-level)))
395: ((looking-at "if\\b")
396: (setq if-level (1- if-level)))
397: ((< (point) limit)
398: (setq if-level 0)
399: (goto-char limit))))))
400:
401: (defun mark-icon-function ()
402: "Put mark at end of Icon function, point at beginning."
403: (interactive)
404: (push-mark (point))
405: (end-of-icon-defun)
406: (push-mark (point))
407: (beginning-of-line 0)
408: (beginning-of-icon-defun))
409:
410: (defun beginning-of-icon-defun ()
411: "Go to the start of the enclosing procedure; return t if at top level."
412: (interactive)
413: (if (re-search-backward "^procedure\\s \\|^end[ \t\n]" (point-min) 'move)
414: (looking-at "e")
415: t))
416:
417: (defun end-of-icon-defun ()
418: (interactive)
419: (if (not (bobp)) (forward-char -1))
420: (re-search-forward "\\(\\s \\|^\\)end\\(\\s \\|$\\)" (point-max) 'move)
421: (forward-word -1)
422: (forward-line 1))
423:
424: (defun indent-icon-exp ()
425: "Indent each line of the Icon grouping following point."
426: (interactive)
427: (let ((indent-stack (list nil))
428: (contain-stack (list (point)))
429: (case-fold-search nil)
430: restart outer-loop-done inner-loop-done state ostate
431: this-indent last-sexp
432: at-else at-brace at-do
433: (opoint (point))
434: (next-depth 0))
435: (save-excursion
436: (forward-sexp 1))
437: (save-excursion
438: (setq outer-loop-done nil)
439: (while (and (not (eobp)) (not outer-loop-done))
440: (setq last-depth next-depth)
441: ;; Compute how depth changes over this line
442: ;; plus enough other lines to get to one that
443: ;; does not end inside a comment or string.
444: ;; Meanwhile, do appropriate indentation on comment lines.
445: (setq innerloop-done nil)
446: (while (and (not innerloop-done)
447: (not (and (eobp) (setq outer-loop-done t))))
448: (setq ostate state)
449: (setq state (parse-partial-sexp (point) (progn (end-of-line) (point))
450: nil nil state))
451: (setq next-depth (car state))
452: (if (and (car (cdr (cdr state)))
453: (>= (car (cdr (cdr state))) 0))
454: (setq last-sexp (car (cdr (cdr state)))))
455: (if (or (nth 4 ostate))
456: (icon-indent-line))
457: (if (or (nth 3 state))
458: (forward-line 1)
459: (setq innerloop-done t)))
460: (if (<= next-depth 0)
461: (setq outer-loop-done t))
462: (if outer-loop-done
463: nil
464: (if (/= last-depth next-depth)
465: (setq last-sexp nil))
466: (while (> last-depth next-depth)
467: (setq indent-stack (cdr indent-stack)
468: contain-stack (cdr contain-stack)
469: last-depth (1- last-depth)))
470: (while (< last-depth next-depth)
471: (setq indent-stack (cons nil indent-stack)
472: contain-stack (cons nil contain-stack)
473: last-depth (1+ last-depth)))
474: (if (null (car contain-stack))
475: (setcar contain-stack (or (car (cdr state))
476: (save-excursion (forward-sexp -1)
477: (point)))))
478: (forward-line 1)
479: (skip-chars-forward " \t")
480: (if (eolp)
481: nil
482: (if (and (car indent-stack)
483: (>= (car indent-stack) 0))
484: ;; Line is on an existing nesting level.
485: ;; Lines inside parens are handled specially.
486: (if (/= (char-after (car contain-stack)) ?{)
487: (setq this-indent (car indent-stack))
488: ;; Line is at statement level.
489: ;; Is it a new statement? Is it an else?
490: ;; Find last non-comment character before this line
491: (save-excursion
492: (setq at-else (looking-at "else\\W"))
493: (setq at-brace (= (following-char) ?{))
494: (icon-backward-to-noncomment opoint)
495: (if (icon-is-continuation-line)
496: ;; Preceding line did not end in comma or semi;
497: ;; indent this line icon-continued-statement-offset
498: ;; more than previous.
499: (progn
500: (icon-backward-to-start-of-continued-exp (car contain-stack))
501: (setq this-indent
502: (+ icon-continued-statement-offset (current-column)
503: (if at-brace icon-continued-brace-offset 0))))
504: ;; Preceding line ended in comma or semi;
505: ;; use the standard indent for this level.
506: (if at-else
507: (progn (icon-backward-to-start-of-if opoint)
508: (setq this-indent (current-indentation)))
509: (setq this-indent (car indent-stack))))))
510: ;; Just started a new nesting level.
511: ;; Compute the standard indent for this level.
512: (let ((val (calculate-icon-indent
513: (if (car indent-stack)
514: (- (car indent-stack))))))
515: (setcar indent-stack
516: (setq this-indent val))))
517: ;; Adjust line indentation according to its contents
518: (if (or (= (following-char) ?})
519: (looking-at "end\\b"))
520: (setq this-indent (- this-indent icon-indent-level)))
521: (if (= (following-char) ?{)
522: (setq this-indent (+ this-indent icon-brace-offset)))
523: ;; Put chosen indentation into effect.
524: (or (= (current-column) this-indent)
525: (progn
526: (delete-region (point) (progn (beginning-of-line) (point)))
527: (indent-to this-indent)))
528: ;; Indent any comment following the text.
529: (or (looking-at comment-start-skip)
530: (if (re-search-forward comment-start-skip (save-excursion (end-of-line) (point)) t)
531: (progn (indent-for-comment) (beginning-of-line))))))))))
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.