windows.sl 1.7 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748
  1. %
  2. % Windows.SL - Window Collection Manipulation Functions
  3. %
  4. % Author: Alan Snyder
  5. % Hewlett-Packard/CRC
  6. % Date: 12 July 1982
  7. %
  8. % This file contains functions that manipulate the set of existing
  9. % windows. It is intended that someday EMODE will be reorganized
  10. % so that all such functions will eventually be in this file.
  11. %
  12. % This file requires COMMON.
  13. %
  14. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  15. (fluid '(WindowList CurrentWindowDescriptor CurrentBufferName
  16. BufferPreviousBuffer WindowsBufferName))
  17. (de window-kill-buffer ()
  18. % This function disassociates the current window with the buffer
  19. % currently associated with that window. If the buffer is not
  20. % associated with any other window, it is killed. A new buffer
  21. % is selected to become associated with the window. The preferred
  22. % choice is the buffer's "previous buffer".
  23. (prog (buffer-needed preferred-buffer detached-buffer)
  24. (setf detached-buffer WindowsBufferName)
  25. (SelectBuffer detached-buffer) % allow access to buffer variables
  26. (setf preferred-buffer BufferPreviousBuffer)
  27. (setf buffer-needed nil)
  28. (for
  29. (in WindowDescriptor WindowList)
  30. (when (neq WindowDescriptor CurrentWindowDescriptor))
  31. (while (not buffer-needed))
  32. (do (if (and (atsoc 'WindowsBufferName WindowDescriptor)
  33. (eq (cdr (atsoc 'WindowsBufferName WindowDescriptor))
  34. detached-buffer))
  35. (setf buffer-needed t)))
  36. )
  37. (if (not buffer-needed)
  38. (buffer-kill detached-buffer))
  39. (select-buffer-if-existing preferred-buffer)
  40. (setf WindowsBufferName CurrentBufferName)
  41. (EstablishCurrentMode)
  42. (if (not buffer-needed)
  43. (write-prompt (BldMsg "Buffer %w deleted." detached-buffer)))
  44. ))