medit.el 3.9 KB

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