hen.el

Scheme跨平台编译器

;;; HEN.EL ---  mode for editing chicken code

;; Copyright (C) 2004 Linh Dang

;; Author: Linh Dang <linhd@>
;; Maintainer: Linh Dang <linhd@>
;; Created: 19 Apr 2004
;; Version: 1
;; Keywords:

;; This program is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 1, or (at your option)
;; any later version.

;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.

;; A copy of the GNU General Public License can be obtained from this
;; program's author (send electronic mail to <linhd@>) or from the
;; Free Software Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139,
;; USA.

;; LCD Archive Entry:
;; hen|Linh Dang|<linhd@>
;; | mode for editing chicken code
;; |$Date: 2004/11/22 22:36:11 $|$Revision: 1.13 $|~/packages/hen.el

;;; Commentary:
;; Hen is a mode derived from scheme-mode and is specialized for
;; editing chicken scheme.
;; This mode assumes:
;;     - the user has chicken.info install
;;     - the csi executable can be launch as "csi"

;;
;; Changes by Micky Latowicki:
;;
;; * Added implementation of with-temp-message, which is missing from xemacs 21.4.
;; * Added trivial display-mouse-p, which is similarly missing.
;; * fixed font-lock problems.
;; * removed most calls to accept-process-output, which made
;; hen unacceptably slow.
;; * removed (apparently) redundant call to hen-proc-wait-prompt in
;; hen-proc-send
;; * updated prompt regexp pattern to include the running number.
;; * start csi with -quiet
;; * fixed completions, made them more like emacs lisp behaviour.
;; Note: completions were fixed at the cost of feeding csi the commands
;; (require 'srfi-1) and (require 'regex) before matching strings are
;; searched for. This was done because the completions-searching code
;; relies on these libraries. A true fix would be to statically link these
;; libraries into csi, because the way it works now the user cannot choose
;; to keep srfi-1 and regex out of her csi environment.

;; Changes by felix:
;;
;; * removed hen-describe-symbol
;; * various cleaning up
;; * still pretty bad...

;; Changes by Adhi Hargo:
;; 
;; * automatically raise *csi* buffer on any relevant operations, and
;;   made it a read-only buffer.
;; * changes definition-at-point evaluation command.
;; * s-exp evaluation no longer shown in minibuffer.
;; * added : + Hen-mode customization group.
;;           + Buffer evaluation command.
;;           + csi process-terminating command, partly so I can erase
;;             previous definitions and start anew.
;;           + close-parens-at-point command, from SLIME.
;;           + modification-check before compilation.

;;; Code:

(defconst hen-version (substring "$Revision: 1.13 $" 11 -2)
 "$Id: hen.el,v 1.13 2004/11/22 22:36:11 flw Exp $

Report bugs to: Felix Winkelmann <[e-mail]>")

(require 'scheme)
(require 'compile)

;;; GROUP DECLARATION ================================================

(defgroup hen nil
  "Major mode for editing Scheme programs using Chicken."
  :version "21.3"
  :group 'scheme
  :prefix "hen-")
(defgroup hen-font-face nil
  "Various font face configurations."
  :group 'hen)

(defun hen-version ()
  "Outputs Hen's current version to the minibuffer."
  (interactive)
  (message "Hen %s" hen-version))

;;; USER-CONFIGURABLE COMMANDS =======================================

(defcustom hen-csc-program "csc"
  "*Chicken compiler executable's filename."
  :group 'hen
  :type 'string)
(defcustom hen-csi-program "csi"
  "*Chicken interpreter executable's filename."
  :group 'hen
  :type 'string)
(defcustom hen-build-exec-arg ""
  "*Compiler-argument when building an executable file."
  :group 'hen
  :type 'string)
(defcustom hen-build-obj-arg ""
  "*Compiler-argument when building an object file."
  :group 'hen
  :type 'string)
(defcustom hen-eval-init-arg ""
  "*Additional interpreter argument."
  :group 'hen
  :type 'string)

(defcustom hen-autosave-buffer-before-compile nil
  "*Save modified file automatically before compilation.
The default behavior is to ask the user whether to save or not."
  :group 'hen
  :type 'boolean)

(defcustom hen-load-hook nil
  "Hook run after entering Hen mode."
  :group 'hen
  :type 'hook)


;; with-temp-message pasted from a mailing list. It's not available in my xemacs 21.4
(unless (functionp 'with-temp-message)
 (defmacro with-temp-message (message &rest body)
   "Display MESSAGE temporarily while BODY is evaluated.
The original message is restored to the echo area after BODY has finished.
The value returned is the value of the last form in BODY."
   (let ((current-message (make-symbol "current-message"))
         (temp-message (make-symbol "with-temp-message")))
     `(let ((,temp-message ,message)
            (,current-message))
        (unwind-protect
            (progn
              (when ,temp-message
                (setq ,current-message (current-message))
                (message "%s" ,temp-message))
              ,@body)
          (and ,temp-message ,current-message
               (message "%s" ,current-message)))))))

;; display-mouse-p not available in xemacs 21.4, so here's a quick fix, sort of.
(unless (functionp 'display-mouse-p)
 (defun display-mouse-p (&optional display) t))

(defconst hen-syntax-table
 (let ((tab (copy-syntax-table scheme-mode-syntax-table)))
   (modify-syntax-entry ?# "_   " tab)
   (modify-syntax-entry ?: "_   " tab)
   (modify-syntax-entry ?\[ "(]  " tab)
   (modify-syntax-entry ?\] ")[  " tab)

   tab))

(defconst hen-font-lock-keywords-1
 (eval-when-compile
   (list
    ;; Declarations
    (list (concat "\\(?:(\\|\\[\\)"
                  "\\(" (regexp-opt
                         '("define"
                           "define-class"
                           "define-external"
                           "define-constant"
                           "define-datatype"
                           "define-foreign-type"
                           "define-foreign-variable"
                           "define-foreign-record"
                           "define-generic"
                           "define-inline"
                           "define-macro"
                           "define-method"
                           "define-reader-ctor"
                           "define-record"
                           "defstruct"
                           "define-record-printer"
                           "define-record-type"
			   "define-compiler-macro"
                           "define-syntax"
                           "define-for-syntax"
                           "define-values") 1) "\\)"
                           "\\s-+(?\\(\\(\\sw\\|\\s_\\)+\\)")

          '(1 font-lock-keyword-face t t)
          '(2 font-lock-function-name-face t t))))
 "Basic font-locking for Hen mode.")

(defconst hen-font-lock-keywords-2
 (append hen-font-lock-keywords-1
  (eval-when-compile
    (list
     ;;
     ;; Control structures.
     (cons
      (concat
       "\\<" (regexp-opt
            '("begin" "begin0" "else"
              "else"
              "foreign-lambda*" "foreign-safe-lambda*" "foreign-primitive"
	      "foreign-declare" "foreign-parse" "foreign-parse/declare"
              "foreign-lambda" "foreign-safe-lambda" "foreign-code"
              "match" "match-lambda" "match-lambda*" "match-define" "match-let" "match-let*"

              "case" "case-lambda" "cond" "cond-expand" "condition-case" "select"
	      "handle-exceptions"
              "cut" "cute" "time" "regex-case"

              "do" "else" "if" "lambda" "when" "while" "if*" "unless"

	      "let-location" "location" "rec"
              "let" "let*" "let-syntax" "letrec" "letrec-syntax" "set!-values"
              "and-let*" "let-optionals" "let-optionals*" "optional"
              "fluid-let" "let-values" "let*-values" "letrec-values"
              "parameterize"
              "module" "import-only" "import" "import*"

              "and" "or" "delay" "receive"

              "assert" "ignore-errors" "ensure" "eval-when"

	      "loop" "sc-macro-transformer"

              "declare" "include" "require-extension" "require" "require-for-syntax" "use" "quasiquote"

              "syntax" "with-syntax" "syntax-case" "identifier-syntax" "syntax-rules") t)
       "\\>") 'font-lock-keyword-face)
     '("\\<set!" . font-lock-keyword-face)
     ;;
     ;;  `:' keywords as builtins.
     '("#?\\<:\\sw+\\>" . font-lock-builtin-face)
     '("\\<\\sw+:\\>" . font-lock-builtin-face)
     '(",@?\\|`" . font-lock-builtin-face)
     '("\\(##\\sw+#\\)" (1 font-lock-builtin-face t nil))
     '("#\\\\?\\sw+"  (0 font-lock-constant-face nil t))
;?      '("(\\(declare\\|require\\(-extension\\)?\\)" . font-lock-keyword-face)
     )))
 "Gaudy expressions to highlight in Hen mode.")

(defconst hen-font-lock-keywords hen-font-lock-keywords-2)

(mapc (lambda (cell)
       (put (car cell) 'scheme-indent-function (cdr cell)))
     '((begin0 . 0)

       (when . 1) (while . 1) (unless . 1)
       (and-let* . 1) (fluid-let . 1)

       (call-with-input-pipe . 1)
       (call-with-ouput-pipe . 1)
       (call-with-input-string . 1)
       (call-with-input-string . 1)

       (call-with-values . 1)

       (with-input-from-pipe . 1)
       (with-ouput-to-pipe . 0)
       (with-input-from-string . 1)
       (with-output-to-string . 0)

       (if* . 2)))

(defun hen-identifier-at-point ()
 "Return the identifier close to the cursor."
 (save-excursion
   (save-match-data
     (let ((beg (line-beginning-position))
           (end (line-end-position))
           (pos (point)))
     (cond ((progn (goto-char pos)