home *** CD-ROM | disk | FTP | other *** search
/ Mac Easy 2010 May / Mac Life Ubuntu.iso / casper / filesystem.squashfs / usr / share / guile / 1.8 / lang / elisp / interface.scm < prev    next >
Encoding:
Text File  |  2008-12-17  |  4.8 KB  |  129 lines
  1. (define-module (lang elisp interface)
  2.   #:use-module (lang elisp internals evaluation)
  3.   #:use-module (lang elisp internals fset)
  4.   #:use-module ((lang elisp internals load) #:select ((load . elisp:load)))
  5.   #:use-module ((lang elisp transform) #:select (transformer))
  6.   #:export (eval-elisp
  7.         translate-elisp
  8.         elisp-function
  9.         elisp-variable
  10.         load-elisp-file
  11.         load-elisp-library
  12.         use-elisp-file
  13.         use-elisp-library
  14.         export-to-elisp
  15.         load-emacs))
  16.  
  17. ;;; This file holds my ideas for the mechanisms that would be useful
  18. ;;; to exchange definitions between Scheme and Elisp.
  19.  
  20. (define (eval-elisp x)
  21.   "Evaluate the Elisp expression @var{x}."
  22.   (eval x the-elisp-module))
  23.  
  24. (define (translate-elisp x)
  25.   "Translate the Elisp expression @var{x} to equivalent Scheme code."
  26.   (transformer x))
  27.  
  28. (define (elisp-function sym)
  29.   "Return the procedure or macro that implements @var{sym} in Elisp.
  30. If @var{sym} has no Elisp function definition, return @code{#f}."
  31.   (fref sym))
  32.  
  33. (define (elisp-variable sym)
  34.   "Return the variable that implements @var{sym} in Elisp.
  35. If @var{sym} has no Elisp variable definition, return @code{#f}."
  36.   (module-variable the-elisp-module sym))
  37.  
  38. (define (load-elisp-file file-name)
  39.   "Load @var{file-name} into the Elisp environment.
  40. @var{file-name} is assumed to name a file containing Elisp code."
  41.   ;; This is the same as Elisp's `load-file', so use that if it is
  42.   ;; available, otherwise duplicate the definition of `load-file' from
  43.   ;; files.el.
  44.   (let ((load-file (elisp-function 'load-file)))
  45.     (if load-file
  46.     (load-file file-name)
  47.     (elisp:load file-name #f #f #t))))
  48.  
  49. (define (load-elisp-library library)
  50.   "Load library @var{library} into the Elisp environment.
  51. @var{library} should name an Elisp code library that can be found in
  52. one of the directories of @code{load-path}."
  53.   ;; This is the same as Elisp's `load-file', so use that if it is
  54.   ;; available, otherwise duplicate the definition of `load-file' from
  55.   ;; files.el.
  56.   (let ((load-library (elisp-function 'load-library)))
  57.     (if load-library
  58.     (load-library library)
  59.     (elisp:load library))))
  60.  
  61. (define export-module-name
  62.   (let ((counter 0))
  63.     (lambda ()
  64.       (set! counter (+ counter 1))
  65.       (list 'lang 'elisp
  66.         (string->symbol (string-append "imports:"
  67.                        (number->string counter)))))))
  68.  
  69. (define-macro (use-elisp-file file-name . imports)
  70.   "Load Elisp code file @var{file-name} and import its definitions
  71. into the current Scheme module.  If any @var{imports} are specified,
  72. they are interpreted as selection and renaming specifiers as per
  73. @code{use-modules}."
  74.   (let ((export-module-name (export-module-name)))
  75.     `(begin
  76.        (fluid-set! ,elisp-export-module (resolve-module ',export-module-name))
  77.        (beautify-user-module! (resolve-module ',export-module-name))
  78.        (load-elisp-file ,file-name)
  79.        (use-modules (,export-module-name ,@imports))
  80.        (fluid-set! ,elisp-export-module #f))))
  81.  
  82. (define-macro (use-elisp-library library . imports)
  83.   "Load Elisp library @var{library} and import its definitions into
  84. the current Scheme module.  If any @var{imports} are specified, they
  85. are interpreted as selection and renaming specifiers as per
  86. @code{use-modules}."
  87.   (let ((export-module-name (export-module-name)))
  88.     `(begin
  89.        (fluid-set! ,elisp-export-module (resolve-module ',export-module-name))
  90.        (beautify-user-module! (resolve-module ',export-module-name))
  91.        (load-elisp-library ,library)
  92.        (use-modules (,export-module-name ,@imports))
  93.        (fluid-set! ,elisp-export-module #f))))
  94.  
  95. (define (export-to-elisp . defs)
  96.   "Export procedures and variables specified by @var{defs} to Elisp.
  97. Each @var{def} is either an object, in which case that object must be
  98. a named procedure or macro and is exported to Elisp under its Scheme
  99. name; or a symbol, in which case the variable named by that symbol is
  100. exported under its Scheme name; or a pair @var{(obj . name)}, in which
  101. case @var{obj} must be a procedure, macro or symbol as already
  102. described and @var{name} specifies the name under which that object is
  103. exported to Elisp."
  104.   (for-each (lambda (def)
  105.           (let ((obj (if (pair? def) (car def) def))
  106.             (name (if (pair? def) (cdr def) #f)))
  107.         (cond ((procedure? obj)
  108.                (or name
  109.                (set! name (procedure-name obj)))
  110.                (if name
  111.                (fset name obj)
  112.                (error "No procedure name specified or deducible:" obj)))
  113.               ((macro? obj)
  114.                (or name
  115.                (set! name (macro-name obj)))
  116.                (if name
  117.                (fset name obj)
  118.                (error "No macro name specified or deducible:" obj)))
  119.               ((symbol? obj)
  120.                (or name
  121.                (set! name obj))
  122.                (module-add! the-elisp-module name
  123.                     (module-ref (current-module) obj)))
  124.               (else
  125.                (error "Can't export this kind of object to Elisp:" obj)))))
  126.         defs))
  127.  
  128. (define load-emacs (elisp-function 'load-emacs))
  129.