home *** CD-ROM | disk | FTP | other *** search
/ OpenStep 4.2J (Developer) / os42jdev.iso / NextDeveloper / Source / GNU / emacs / lisp / medit.el < prev    next >
Lisp/Scheme  |  1991-01-09  |  4KB  |  117 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 free software; you can redistribute it and/or modify
  8. ;; it under the terms of the GNU General Public License as published by
  9. ;; the Free Software Foundation; either version 1, or (at your option)
  10. ;; any later version.
  11.  
  12. ;; GNU Emacs is distributed in the hope that it will be useful,
  13. ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  14. ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  15. ;; GNU General Public License for more details.
  16.  
  17. ;; You should have received a copy of the GNU General Public License
  18. ;; along with GNU Emacs; see the file COPYING.  If not, write to
  19. ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
  20.  
  21.  
  22. ;; >> This package depends on two MDL packages: MEDIT and FORKS which
  23. ;; >> can be obtained from the public (network) library at mit-ajax.
  24.  
  25. (require 'mim-mode)
  26.  
  27. (defconst medit-zap-file (concat "/tmp/" (getenv "USER") ".medit.mud")
  28.   "File name for data sent to MDL by Medit.")
  29. (defconst medit-buffer "*MEDIT*"
  30.   "Name of buffer in which Medit accumulates data to send to MDL.")
  31. (defconst medit-save-files t
  32.   "If non-nil, Medit offers to save files on return to MDL.")
  33.   
  34. (defun medit-save-define ()
  35.   "Mark the previous or surrounding toplevel object to be sent back to MDL."
  36.   (interactive)
  37.   (save-excursion
  38.       (beginning-of-DEFINE)
  39.       (let ((start (point)))
  40.     (forward-mim-object 1)
  41.     (append-to-buffer medit-buffer start (point))
  42.     (goto-char start)
  43.     (message (buffer-substring start (progn (end-of-line) (point)))))))
  44.  
  45. (defun medit-save-region (start end)
  46.   "Mark the current region to be sent to back to MDL."
  47.   (interactive "r")
  48.   (append-to-buffer medit-buffer start end)
  49.   (message "Current region saved for MDL."))
  50.  
  51. (defun medit-save-buffer ()
  52.   "Mark the current buffer to be sent back to MDL."
  53.   (interactive)
  54.   (append-to-buffer medit-buffer (point-min) (point-max))
  55.   (message "Current buffer saved for MDL."))
  56.  
  57. (defun medit-zap-define-to-mdl ()
  58.   "Return to MDL with surrounding or previous toplevel MDL object."
  59.   (indetarctive)
  60.   (medit-save-defun)
  61.   (medit-go-to-mdl))
  62.  
  63. (defun medit-zap-region-mdl (start end)
  64.   "Return to MDL with current region."
  65.   (interactive)
  66.   (medit-save-region start end)
  67.   (medit-go-to-mdl))
  68.  
  69. (defun medit-zap-buffer ()
  70.   "Return to MDL with current buffer."
  71.   (interactive)
  72.   (medit-save-buffer)
  73.   (medit-go-to-mdl))
  74.  
  75. (defun medit-goto-mdl ()
  76.   "Return from Emacs to superior MDL, sending saved code.
  77. Optionally, offers to save changed files."
  78.   (interactive)
  79.   (let ((buffer (get-buffer medit-buffer)))
  80.   (if buffer
  81.       (save-excursion
  82.     (set-buffer buffer)
  83.     (if (buffer-modified-p buffer)
  84.         (write-region (point-min) (point-max) medit-zap-file))
  85.     (set-buffer-modified-p nil)
  86.     (erase-buffer)))
  87.   (if medit-save-files (save-some-buffers))
  88.   ;; Note could handle parallel fork by giving argument "%xmdl".  Then
  89.   ;; mdl would have to invoke with "%emacs".
  90.   (suspend-emacs)))
  91.  
  92. (defconst medit-mode-map nil)
  93. (if (not medit-mode-map)
  94.     (progn
  95.       (setq medit-mode-map (copy-alist mim-mode-map))
  96.       (define-key medit-mode-map "\e\z" 'medit-save-define)
  97.       (define-key medit-mode-map "\e\^z" 'medit-save-buffer)
  98.       (define-key medit-mode-map "\^xz" 'medit-goto-mdl)
  99.       (define-key medit-mode-map "\^xs" 'medit-zap-buffer)))
  100.  
  101. (defconst medit-mode-hook (and (boundp 'mim-mode-hook) mim-mode-hook) "")
  102. (setq mim-mode-hook '(lambda () (medit-mode)))
  103.      
  104. (defun medit-mode (&optional state)
  105.   "Major mode for editing text and returning it to a superior MDL.
  106. Like Mim mode, plus these special commands:
  107. \\{medit-mode-map}"
  108.   (interactive)
  109.   (use-local-map medit-mode-map)
  110.   (run-hooks 'medit-mode-hook)
  111.   (setq major-mode 'medit-mode)
  112.   (setq mode-name "Medit"))
  113.  
  114. (mim-mode)
  115.  
  116.  
  117.