home *** CD-ROM | disk | FTP | other *** search
/ Education Sampler 1992 [NeXTSTEP] / Education_1992_Sampler.iso / NeXT / GnuSource / emacs-15.0.3 / lisp / medit.el < prev    next >
Lisp/Scheme  |  1990-07-19  |  4KB  |  118 lines
  1. ;; Lisp interface between GNU Emacs and MEDIT package. Emacs under MDL.
  2. ;; Copyright (C) 1985 Free Software Foundation, Inc.
  3. ;; Principal author K. Shane Hartman
  4.  
  5. ;; This file is part of GNU Emacs.
  6.  
  7. ;; GNU Emacs is distributed in the hope that it will be useful,
  8. ;; but WITHOUT ANY WARRANTY.  No author or distributor
  9. ;; accepts responsibility to anyone for the consequences of using it
  10. ;; or for whether it serves any particular purpose or works at all,
  11. ;; unless he says so in writing.  Refer to the GNU Emacs General Public
  12. ;; License for full details.
  13.  
  14. ;; Everyone is granted permission to copy, modify and redistribute
  15. ;; GNU Emacs, but only under the conditions described in the
  16. ;; GNU Emacs General Public License.   A copy of this license is
  17. ;; supposed to have been given to you along with GNU Emacs so you
  18. ;; can know your rights and responsibilities.  It should be in a
  19. ;; file named COPYING.  Among other things, the copyright notice
  20. ;; and this notice must be preserved on all copies.
  21.  
  22.  
  23. ;; >> This package depends on two MDL packages: MEDIT and FORKS which
  24. ;; >> can be obtained from the public (network) library at mit-ajax.
  25.  
  26. (require 'mim-mode)
  27.  
  28. (defconst medit-zap-file (concat "/tmp/" (getenv "USER") ".medit.mud")
  29.   "File name for data sent to MDL by Medit.")
  30. (defconst medit-buffer "*MEDIT*"
  31.   "Name of buffer in which Medit accumulates data to send to MDL.")
  32. (defconst medit-save-files t
  33.   "If non-nil, Medit offers to save files on return to MDL.")
  34.   
  35. (defun medit-save-define ()
  36.   "Mark the previous or surrounding toplevel object to be sent back to MDL."
  37.   (interactive)
  38.   (save-excursion
  39.       (beginning-of-DEFINE)
  40.       (let ((start (point)))
  41.     (forward-mim-object 1)
  42.     (append-to-buffer medit-buffer start (point))
  43.     (goto-char start)
  44.     (message (buffer-substring start (progn (end-of-line) (point)))))))
  45.  
  46. (defun medit-save-region (start end)
  47.   "Mark the current region to be sent to back to MDL."
  48.   (interactive "r")
  49.   (append-to-buffer medit-buffer start end)
  50.   (message "Current region saved for MDL."))
  51.  
  52. (defun medit-save-buffer ()
  53.   "Mark the current buffer to be sent back to MDL."
  54.   (interactive)
  55.   (append-to-buffer medit-buffer (point-min) (point-max))
  56.   (message "Current buffer saved for MDL."))
  57.  
  58. (defun medit-zap-define-to-mdl ()
  59.   "Return to MDL with surrounding or previous toplevel MDL object."
  60.   (indetarctive)
  61.   (medit-save-defun)
  62.   (medit-go-to-mdl))
  63.  
  64. (defun medit-zap-region-mdl (start end)
  65.   "Return to MDL with current region."
  66.   (interactive)
  67.   (medit-save-region start end)
  68.   (medit-go-to-mdl))
  69.  
  70. (defun medit-zap-buffer ()
  71.   "Return to MDL with current buffer."
  72.   (interactive)
  73.   (medit-save-buffer)
  74.   (medit-go-to-mdl))
  75.  
  76. (defun medit-goto-mdl ()
  77.   "Return from Emacs to superior MDL, sending saved code.
  78. Optionally, offers to save changed files."
  79.   (interactive)
  80.   (let ((buffer (get-buffer medit-buffer)))
  81.   (if buffer
  82.       (save-excursion
  83.     (set-buffer buffer)
  84.     (if (buffer-modified-p buffer)
  85.         (write-region (point-min) (point-max) medit-zap-file))
  86.     (set-buffer-modified-p nil)
  87.     (erase-buffer)))
  88.   (if medit-save-files (save-some-buffers))
  89.   ;; Note could handle parallel fork by giving argument "%xmdl".  Then
  90.   ;; mdl would have to invoke with "%emacs".
  91.   (suspend-emacs)))
  92.  
  93. (defconst medit-mode-map nil)
  94. (if (not medit-mode-map)
  95.     (progn
  96.       (setq medit-mode-map (copy-alist mim-mode-map))
  97.       (define-key medit-mode-map "\e\z" 'medit-save-define)
  98.       (define-key medit-mode-map "\e\^z" 'medit-save-buffer)
  99.       (define-key medit-mode-map "\^xz" 'medit-goto-mdl)
  100.       (define-key medit-mode-map "\^xs" 'medit-zap-buffer)))
  101.  
  102. (defconst medit-mode-hook (and (boundp 'mim-mode-hook) mim-mode-hook) "")
  103. (setq mim-mode-hook '(lambda () (medit-mode)))
  104.      
  105. (defun medit-mode (&optional state)
  106.   "Major mode for editing text and returning it to a superior MDL.
  107. Like Mim mode, plus these special commands:
  108. \\{medit-mode-map}"
  109.   (interactive)
  110.   (use-local-map medit-mode-map)
  111.   (run-hooks 'medit-mode-hook)
  112.   (setq major-mode 'medit-mode)
  113.   (setq mode-name "Medit"))
  114.  
  115. (mim-mode)
  116.  
  117.  
  118.