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