|
|
1.1 root 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:
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.