Trailing whitepace deleted.
[bpt/emacs.git] / lisp / progmodes / icon.el
index f64ed19..df50848 100644 (file)
@@ -2,7 +2,7 @@
 
 ;; Copyright (C) 1989 Free Software Foundation, Inc.
 
-;; Author: Chris Smith <convex!csmith>
+;; Author: Chris Smith <csmith@convex.com>
 ;; Created: 15 Feb 89
 ;; Keywords: languages
 
 ;; GNU General Public License for more details.
 
 ;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs; see the file COPYING.  If not, write to
-;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
+;; along with GNU Emacs; see the file COPYING.  If not, write to the
+;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
 
 ;;; Commentary:
 
 ;; A major mode for editing the Icon programming language.
-;;
-;; Note: use
-;;  (autoload 'icon-mode "icon" nil t)
-;;  (setq auto-mode-alist (cons '("\\.icn$" . icon-mode) auto-mode-alist))
-;; if not permanently installed in your emacs
 
 ;;; Code:
 
   "Keymap used in Icon mode.")
 (if icon-mode-map
     ()
-  (setq icon-mode-map (make-sparse-keymap))
-  (define-key icon-mode-map "{" 'electric-icon-brace)
-  (define-key icon-mode-map "}" 'electric-icon-brace)
-  (define-key icon-mode-map "\e\C-h" 'mark-icon-function)
-  (define-key icon-mode-map "\e\C-a" 'beginning-of-icon-defun)
-  (define-key icon-mode-map "\e\C-e" 'end-of-icon-defun)
-  (define-key icon-mode-map "\e\C-q" 'indent-icon-exp)
-  (define-key icon-mode-map "\177" 'backward-delete-char-untabify)
-  (define-key icon-mode-map "\t" 'icon-indent-command))
+  (let ((map (make-sparse-keymap "Icon")))
+    (setq icon-mode-map (make-sparse-keymap))
+    (define-key icon-mode-map "{" 'electric-icon-brace)
+    (define-key icon-mode-map "}" 'electric-icon-brace)
+    (define-key icon-mode-map "\e\C-h" 'mark-icon-function)
+    (define-key icon-mode-map "\e\C-a" 'beginning-of-icon-defun)
+    (define-key icon-mode-map "\e\C-e" 'end-of-icon-defun)
+    (define-key icon-mode-map "\e\C-q" 'indent-icon-exp)
+    (define-key icon-mode-map "\177" 'backward-delete-char-untabify)
+
+    (define-key icon-mode-map [menu-bar] (make-sparse-keymap "Icon"))
+    (define-key icon-mode-map [menu-bar icon]
+      (cons "Icon" map))
+    (define-key map [beginning-of-icon-defun] '("Beginning of function" . beginning-of-icon-defun))
+    (define-key map [end-of-icon-defun] '("End of function" . end-of-icon-defun))
+    (define-key map [comment-region] '("Comment Out Region" . comment-region))
+    (define-key map [indent-region] '("Indent Region" . indent-region))
+    (define-key map [indent-line] '("Indent Line" . icon-indent-command))
+    (put 'eval-region 'menu-enable 'mark-active)
+    (put 'comment-region 'menu-enable 'mark-active)
+    (put 'indent-region 'menu-enable 'mark-active)))
 
 (defvar icon-mode-syntax-table nil
   "Syntax table in use in Icon-mode buffers.")
   (modify-syntax-entry ?| "." icon-mode-syntax-table)
   (modify-syntax-entry ?\' "\"" icon-mode-syntax-table))
 
-(defconst icon-indent-level 4
-  "*Indentation of Icon statements with respect to containing block.")
-(defconst icon-brace-imaginary-offset 0
-  "*Imagined indentation of a Icon open brace that actually follows a statement.")
-(defconst icon-brace-offset 0
-  "*Extra indentation for braces, compared with other text in same context.")
-(defconst icon-continued-statement-offset 4
-  "*Extra indent for lines not starting new statements.")
-(defconst icon-continued-brace-offset 0
-  "*Extra indent for substatements that start with open-braces.
-This is in addition to icon-continued-statement-offset.")
-
-(defconst icon-auto-newline nil
-  "*Non-nil means automatically newline before and after braces
-inserted in Icon code.")
-
-(defconst icon-tab-always-indent t
-  "*Non-nil means TAB in Icon mode should always reindent the current line,
-regardless of where in the line point is when the TAB command is used.")
+(defgroup icon nil
+  "Mode for editing Icon code."
+  :group 'languages)
+
+(defcustom icon-indent-level 4
+  "*Indentation of Icon statements with respect to containing block."
+  :type 'integer
+  :group 'icon)
+
+(defcustom icon-brace-imaginary-offset 0
+  "*Imagined indentation of a Icon open brace that actually follows a statement."
+  :type 'integer
+  :group 'icon)
+
+(defcustom icon-brace-offset 0
+  "*Extra indentation for braces, compared with other text in same context."
+  :type 'integer
+  :group 'icon)
+
+(defcustom icon-continued-statement-offset 4
+  "*Extra indent for Icon lines not starting new statements."
+  :type 'integer
+  :group 'icon)
+
+(defcustom icon-continued-brace-offset 0
+  "*Extra indent for Icon substatements that start with open-braces.
+This is in addition to `icon-continued-statement-offset'."
+  :type 'integer
+  :group 'icon)
+
+(defcustom icon-auto-newline nil
+  "*Non-nil means automatically newline before and after braces Icon code.
+This applies when braces are inserted."
+  :type 'boolean
+  :group 'icon)
+
+(defcustom icon-tab-always-indent t
+  "*Non-nil means TAB in Icon mode should always reindent the current line.
+It will then reindent, regardless of where in the line point is
+when the TAB command is used."
+  :type 'boolean
+  :group 'icon)
+
+(defvar icon-imenu-generic-expression
+      '((nil "^[ \t]*procedure[ \t]+\\(\\sw+\\)[ \t]*("  1))
+  "Imenu expression for Icon mode.  See `imenu-generic-expression'.")
+
+
 \f
+;;;###autoload
 (defun icon-mode ()
   "Major mode for editing Icon code.
 Expression and list commands understand all Icon brackets.
@@ -133,7 +171,7 @@ with no args, if that value is non-nil."
   (setq local-abbrev-table icon-mode-abbrev-table)
   (set-syntax-table icon-mode-syntax-table)
   (make-local-variable 'paragraph-start)
-  (setq paragraph-start (concat "^$\\|" page-delimiter))
+  (setq paragraph-start (concat "$\\|" page-delimiter))
   (make-local-variable 'paragraph-separate)
   (setq paragraph-separate paragraph-start)
   (make-local-variable 'indent-line-function)
@@ -144,23 +182,35 @@ with no args, if that value is non-nil."
   (setq comment-start "# ")
   (make-local-variable 'comment-end)
   (setq comment-end "")
-  (make-local-variable 'comment-column)
-  (setq comment-column 32)
   (make-local-variable 'comment-start-skip)
   (setq comment-start-skip "# *")
   (make-local-variable 'comment-indent-function)
   (setq comment-indent-function 'icon-comment-indent)
+  (set (make-local-variable 'indent-line-function) 'icon-indent-line)
+  ;; font-lock support
+  (setq font-lock-defaults
+       '((icon-font-lock-keywords
+          icon-font-lock-keywords-1 icon-font-lock-keywords-2)
+         nil nil ((?_ . "w")) beginning-of-defun
+         ;; Obsoleted by Emacs 19.35 parse-partial-sexp's COMMENTSTOP.
+         ;(font-lock-comment-start-regexp . "#")
+         (font-lock-mark-block-function . mark-defun)))
+  ;; imenu support
+  (make-local-variable 'imenu-generic-expression)
+  (setq imenu-generic-expression icon-imenu-generic-expression)
+  ;; hideshow support
+  ;; we start from the assertion that `hs-special-modes-alist' is autoloaded.
+  (unless (assq 'icon-mode hs-special-modes-alist)
+    (setq hs-special-modes-alist
+         (cons '(icon-mode  "\\<procedure\\>" "\\<end\\>" nil
+                            icon-forward-sexp-function)
+               hs-special-modes-alist)))
   (run-hooks 'icon-mode-hook))
 \f
 ;; This is used by indent-for-comment to decide how much to
 ;; indent a comment in Icon code based on its context.
 (defun icon-comment-indent ()
-  (if (looking-at "^#")
-      0        
-    (save-excursion
-      (skip-chars-backward " \t")
-      (max (if (bolp) 0 (1+ (current-column)))
-          comment-column))))
+  (if (looking-at "^#") 0 comment-column))
 
 (defun electric-icon-brace (arg)
   "Insert character and correct line's indentation."
@@ -237,9 +287,7 @@ Return the amount the indentation changed by."
     (setq beg (point))
     (cond ((eq indent nil)
           (setq indent (current-indentation)))
-         ((eq indent t)
-          (setq indent (calculate-icon-indent-within-comment)))
-         ((looking-at "[ \t]*#")
+         ((looking-at "^#")
           (setq indent 0))
          (t
           (skip-chars-forward " \t")
@@ -376,7 +424,7 @@ Returns nil if line starts inside a string, t if in a comment."
                (progn (forward-word -1) (point))
                (progn (forward-word 1) (point)))
               icon-resword-alist)
-      (not (memq ch '(0 ?\; ?\} ?\{ ?\) ?\] ?\" ?\' ?\n))))))
+      (not (memq ch '(0 ?\; ?\} ?\{ ?\) ?\] ?\" ?\' ?\# ?\, ?\. ?\n))))))
 
 (defun icon-backward-to-noncomment (lim)
   (let (opoint stop)
@@ -454,7 +502,7 @@ Returns nil if line starts inside a string, t if in a comment."
        (contain-stack (list (point)))
        (case-fold-search nil)
        restart outer-loop-done inner-loop-done state ostate
-       this-indent last-sexp
+       this-indent last-sexp last-depth
        at-else at-brace at-do
        (opoint (point))
        (next-depth 0))
@@ -468,8 +516,8 @@ Returns nil if line starts inside a string, t if in a comment."
        ;; plus enough other lines to get to one that
        ;; does not end inside a comment or string.
        ;; Meanwhile, do appropriate indentation on comment lines.
-       (setq innerloop-done nil)
-       (while (and (not innerloop-done)
+       (setq inner-loop-done nil)
+       (while (and (not inner-loop-done)
                    (not (and (eobp) (setq outer-loop-done t))))
          (setq ostate state)
          (setq state (parse-partial-sexp (point) (progn (end-of-line) (point))
@@ -482,7 +530,7 @@ Returns nil if line starts inside a string, t if in a comment."
              (icon-indent-line))
          (if (or (nth 3 state))
              (forward-line 1)
-           (setq innerloop-done t)))
+           (setq inner-loop-done t)))
        (if (<= next-depth 0)
            (setq outer-loop-done t))
        (if outer-loop-done
@@ -556,4 +604,87 @@ Returns nil if line starts inside a string, t if in a comment."
                (if (re-search-forward comment-start-skip (save-excursion (end-of-line) (point)) t)
                    (progn (indent-for-comment) (beginning-of-line))))))))))
 
+(defconst icon-font-lock-keywords-1
+  (eval-when-compile
+    (list
+     ;; Fontify procedure name definitions.
+       '("^[ \t]*\\(procedure\\)\\>[ \t]*\\(\\sw+\\)?"
+       (1 font-lock-builtin-face) (2 font-lock-function-name-face nil t))))
+  "Subdued level highlighting for Icon mode.")
+
+(defconst icon-font-lock-keywords-2
+  (append
+   icon-font-lock-keywords-1
+   (eval-when-compile
+     (list
+      ;; Fontify all type specifiers.
+      (cons
+       (regexp-opt  '("null" "string" "co-expression" "table" "integer"
+                     "cset"  "set" "real" "file" "list") 'words)
+       'font-lock-type-face)
+      ;; Fontify all keywords.
+      ;;
+      (cons
+       (regexp-opt
+       '("break" "do" "next" "repeat" "to" "by" "else" "if" "not" "return"
+         "until" "case" "of" "while" "create" "every" "suspend" "default"
+         "fail" "record" "then") 'words)
+       'font-lock-keyword-face)
+      ;; "end" "initial"
+      (cons (regexp-opt '("end" "initial") 'words)
+           'font-lock-builtin-face)
+      ;; Fontify all system variables.
+      (cons
+       (regexp-opt
+       '("&allocated" "&ascii" "&clock" "&col" "&collections" "&column"
+         "&control" "&cset" "&current" "&date" "&dateline" "&digits" "&dump"
+         "&e" "&error" "&errornumber" "&errortext" "&errorvalue" "&errout"
+         "&eventcode" "&eventsource" "&eventvalue" "&fail" "&features"
+         "&file" "&host" "&input" "&interval" "&lcase" "&ldrag" "&letters"
+         "&level" "&line" "&lpress" "&lrelease" "&main" "&mdrag" "&meta"
+         "&mpress" "&mrelease" "&null" "&output" "&phi" "&pi" "&pos"
+         "&progname" "&random" "&rdrag" "&regions" "&resize" "&row"
+         "&rpress" "&rrelease" "&shift" "&source" "&storage" "&subject"
+         "&time" "&trace" "&ucase" "&version" "&window" "&x" "&y") t)
+       'font-lock-constant-face)
+      (cons      ;; global local static declarations and link files
+       (concat
+       "^[ \t]*"
+       (regexp-opt '("global" "link" "local" "static") t)
+       "\\(\\sw+\\>\\)*")
+       '((1 font-lock-builtin-face)
+        (font-lock-match-c-style-declaration-item-and-skip-to-next
+         (goto-char (or (match-beginning 2) (match-end 1))) nil
+         (1 (if (match-beginning 2)
+                font-lock-function-name-face
+              font-lock-variable-name-face)))))
+
+      (cons      ;; $define $elif $ifdef $ifndef $undef
+       (concat "^"
+              (regexp-opt'("$define" "$elif" "$ifdef" "$ifndef" "$undef") t)
+              "\\>[ \t]*\\([^ \t\n]+\\)?")
+           '((1 font-lock-builtin-face)
+             (4 font-lock-variable-name-face nil t)))
+      (cons      ;; $dump $endif $else $include
+       (concat
+       "^" (regexp-opt'("$dump" "$endif" "$else" "$include") t) "\\>" )
+       'font-lock-builtin-face)
+      (cons      ;; $warning $error
+       (concat "^" (regexp-opt '("$warning" "$error") t)
+              "\\>[ \t]*\\(.+\\)?")
+       '((1 font-lock-builtin-face) (3 font-lock-warning-face nil t))))))
+  "Gaudy level highlighting for Icon mode.")
+
+(defvar icon-font-lock-keywords icon-font-lock-keywords-1
+  "Default expressions to highlight in `icon-mode'.")
+
+;;;used by hs-minor-mode
+(defun icon-forward-sexp-function (arg)
+  (if (< arg 0)
+      (beginning-of-icon-defun)
+    (end-of-icon-defun)
+    (forward-char -1)))
+
+(provide 'icon)
+
 ;;; icon.el ends here