home *** CD-ROM | disk | FTP | other *** search
/ InfoMagic Source Code 1993 July / THE_SOURCE_CODE_CD_ROM.iso / languages / elisp / interfaces / Emacs-cl-shell / cl-obvius.el < prev    next >
Encoding:
Text File  |  1991-03-25  |  4.7 KB  |  114 lines
  1. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  2. ;;; File:          cl-obvius.el
  3. ;;; Author:        Eero Simoncelli 
  4. ;;; Description:   Extensions to cl-shell.el for running OBVIUS.
  5. ;;; Creation Date: 11 March, 1988
  6. ;;;  ----------------------------------------------------------------
  7. ;;;    Object-Based Vision and Image Understanding System (OBVIUS),
  8. ;;;      Copyright 1988, Vision Science Group,  Media Laboratory,  
  9. ;;;              Massachusetts Institute of Technology.
  10. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  11.  
  12. ;;; To use this file, put the following lines in your .emacs file:
  13. ;;;
  14. ;;;   (setq load-path (cons "<directory-containing-this-file>" load-path))
  15. ;;;   (setq *obvius-program* "<pathname-of-obvius-executable>")
  16. ;;;   (autoload 'run-obvius "<pathname-of-this-file>" "" t)
  17. ;;;
  18. ;;; Then just type "M-x run-obvius" in emacs...  Note that this file
  19. ;;; requires the file cl-shell.el, which should reside in the same
  20. ;;; directory.  If you want to add more key bindings, define a
  21. ;;; function called cl-obvius-hook to do this.  Only bindings that
  22. ;;; everyone agrees on should be put in this file!
  23.  
  24. (require 'cl-shell)
  25.  
  26. (defvar *obvius-program* "obvius"
  27.   "Pathname of the OBVIUS program to be run by a call to run-obvius.")
  28.  
  29. ;;; Command to load pre-existing lisp world containing obvius
  30. (defun run-obvius ()
  31.   (interactive)
  32.   (let ((*cl-replacement-prompt* "OBVIUS> "))
  33.     (run-cl *obvius-program*))
  34.   (cl-add-obvius-key-bindings)    ;add bindings to cl-shell-mode and lisp-mode
  35.   (run-hooks 'cl-obvius-hook))
  36.  
  37. ;;; Setup local key definitions for the *lisp* buffer and all
  38. ;;; lisp-mode buffers.
  39. (defun cl-add-obvius-key-bindings ()
  40.   (define-key cl-shell-mode-map "\C-c\C-l" 'obvius-load-image)
  41.   (define-key cl-shell-mode-map "\C-c\C-s" 'obvius-save-image)
  42.   (define-key lisp-mode-map "\C-c\C-l" 'obvius-load-image)
  43.   (define-key lisp-mode-map "\C-c\C-s" 'obvius-save-image)
  44.   (define-key lisp-mode-map "\C-cf" 'obvius-compile-load-file)
  45.   )
  46.  
  47. (setq *cl-definition-regexp-alist*
  48.       (append '((CLASS . "(def\\(-simple-\\)?class[ \t\n]*%s"))
  49.           *cl-definition-regexp-alist*))
  50.  
  51. (defvar *default-obvius-directory* "/"
  52.   "*The default directory used for loading and saving OBVIUS images.")
  53.  
  54. (defun obvius-compile-load-file (pathname)
  55.   "Compile and load file of current buffer into the CL process."
  56.   (interactive
  57.    (let ((default-file-name buffer-file-name))
  58.      (list
  59.       (read-file-name "CL compile-load file: " default-file-name default-file-name t))))
  60.   (let ((buffer (get-file-buffer pathname)))
  61.     (if (and buffer 
  62.          (buffer-modified-p buffer)
  63.          (yes-or-no-p 
  64.           (concat "Buffer " (buffer-name buffer) " modified, save it first? ")))
  65.     (save-buffer buffer)))
  66.   (let ((cl-compile-load-command "(compile-load \"%s\")\n"))
  67.     (if *cl-echo-commands*
  68.     (cl-send-string-with-echo (format cl-compile-load-command pathname))
  69.     (cl-send-string
  70.      (concat "(progn "
  71.          (format cl-compile-load-command pathname)
  72.          "(values))\n")))))
  73.  
  74. ;;; Load an image into OBVIUS, making use of emacs filename completion.
  75. (defun obvius-load-image ()
  76.   "Load an image file into OBVIUS, changing the *default-obvius-directory*
  77. to the directory of the image."
  78.   (interactive)
  79.   (let ((fn (read-file-name "Image file name: "
  80.                 *default-obvius-directory* nil t)))
  81.     (cl-send-string-with-echo
  82.      (format "(load-image \"%s\")" (expand-file-name fn)))
  83.     (setq *default-obvius-directory* 
  84.       (file-name-directory (substring (expand-file-name fn) 0 -1)))))
  85.  
  86. (defun obvius-save-image ()
  87.   "Save an OBVIUS image in datfile format."
  88.   (interactive)
  89.   (let ((fn (read-string "Save to datfile: " *default-obvius-directory*)))
  90.     (cl-send-string-with-echo
  91.      (format "(save-image (getp viewable) \"%s\")" (expand-file-name fn)))))
  92.  
  93. (defun obvius-view-image ()
  94.   (interactive)
  95.   (let ((fn (read-file-name "Image file name: "
  96.                 *default-obvius-directory* nil t)))
  97.     (cl-send-string-with-echo
  98.      (format "(view-image \"%s\")" (expand-file-name fn)))
  99.     (setq *default-obvius-directory* 
  100.       (file-name-directory (substring (expand-file-name fn) 0 -1)))))
  101.  
  102. ;;; Add some more special forms to the indentation list - see
  103. ;;; cl-indent.el for more information. The number refers to
  104. ;;; the number of special forms passed as arguments.
  105. (put 'loop-over-image-pixels    'common-lisp-indent-hook 1)
  106. (put 'loop-over-image-positions 'common-lisp-indent-hook 2)
  107. (put 'def-simple-class          'common-lisp-indent-hook 'defun)
  108. (put 'with-result               'common-lisp-indent-hook 1)
  109. (put 'with-displaced-vectors    'common-lisp-indent-hook 1)
  110. (put 'with-local-arrays         'common-lisp-indent-hook 1)
  111. (put 'with-local-viewables      'common-lisp-indent-hook 1)
  112. (put 'catch-errors              'common-lisp-indent-hook 1)
  113. (put 'with-locked-pane          'common-lisp-indent-hook 1)
  114.