Artifact bb9c41baf7936cd61d4a0adc73995bfe26d92553f5ffd8897d5989fb097eb122:


%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%
% Browser-Support.SL - General Browser Support
% 
% Author:      Alan Snyder
%              Hewlett-Packard/CRC
% Date:        18 October 1982
% Revised:     14 March 1983
%
% 14-Mar-83 Alan Snyder
%  Added functions to find existing browsers.  New functions:
%  browser-current-item, browser-view-buffer, browser-edit-buffer,
%  browser-help-command, browser-exit, current-browser, kill-browser,
%  kill-browser-command, browser-update.  Change browser-enter to take browser
%  as arg instead of buffer.  Fix browser-enter and browser-exit to
%  restore old buffers upon exit.
% 4-Mar-83 Alan Snyder
%  New functions: browser-add-item, browser-add-items.
% 3-Feb-83 Alan Snyder
%  Revised to use Browser objects.
%
% This file contains support functions for browsers, such as the Buffer
% Browser and DIRED.  A browser is a buffer that displays a set of items, one
% item per line, and allows the individual items to be manipulated.
%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

(compiletime (load numeric-operators))
(on fast-integers)

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% External variables:
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

(fluid '(nmode-top-window
	 nmode-bottom-window
	 nmode-current-buffer
	 nmode-current-window
	 nmode-command-argument
	 nmode-command-argument-given
	 ))

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% User options:
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

(fluid '(
  browser-split-screen
  ))
(setf browser-split-screen NIL)

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% Internal Static Variables:
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

(fluid '(nmode-active-browsers))

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% General Browser Support Functions
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

(de nmode-register-browser (browser)
  % Add the specified browser to the list of active browsers.  This list is
  % used to create the items for the browser browser, for example.  This
  % function is called by create-browser.

  (if (unboundp 'nmode-active-browsers)
    (setf nmode-active-browsers ()))
  (when (not (memq browser nmode-active-browsers))
    (setf nmode-active-browsers (cons browser nmode-active-browsers)))
  )

(de nmode-unregister-browser (browser)
  % Remove the specified browser from the list of active browsers.

  (if (unboundp 'nmode-active-browsers)
    (setf nmode-active-browsers ()))
  (when (memq browser nmode-active-browsers)
    (setf nmode-active-browsers (delq browser nmode-active-browsers)))
  )

(de browser-is-active? (browser)
  (memq browser nmode-active-browsers)
  )

(de browser-enter (browser)
  % Start up a browser.
  (let ((wp (nmode-window-position)))
    (=> browser put 'window-status wp)
    (=> browser put 'old-top (=> (=> nmode-top-window buffer) name))
    (=> browser put 'old-bottom
	(when browser-split-screen (=> (=> nmode-bottom-window buffer) name)))
    (if browser-split-screen
      (if (eq wp 'bottom) (nmode-switch-windows))
      (nmode-1-window)
      ))
  (=> browser enter)
  )

(de browser-exit (browser)
  % Exit the browser, which means to detach its buffers from windows and
  % restore the window to its previous state.

  (let* ((ws (=> browser get 'window-status))
	 (old-top (=> browser get 'old-top))
	 (old-bottom (=> browser get 'old-bottom))
	 )
    (nmode-set-window-position ws)
    (when old-top
      (window-select-buffer nmode-top-window (buffer-find old-top)))
    (when old-bottom
      (window-select-buffer nmode-bottom-window (buffer-find old-bottom)))
    (=> browser exit)
    ))

(de kill-browser (browser)
  % Kill the browser, which means exit it and then remove it from the list
  % of active browsers (which should allow it to be garbage collected).

  (=> browser exit)
  (nmode-unregister-browser browser)
  )

(de all-browsers ()
  % Return a list of all active browsers.  The list should not be modified.

  nmode-active-browsers
  )

(de all-browsers-of-a-kind (browser-kind-id)
  % Return a list of all existing browsers of the specified kind.

  (for (in br (all-browsers))
       (when (eq (=> br browser-kind) browser-kind-id))
       (collect br)
       ))

(de find-browser (browser-kind-id info-string)
  % Search for a browser of the specified kind with the specified info string.

  (for (in br (all-browsers-of-a-kind browser-kind-id))
       (when (equal (=> br browser-info-string) info-string))
       (do (exit br))
       ))

(de browser-update (browser)
  (=> browser update-items)
  )

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% Browser commands: attach these to keys in your browser mode
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

(de browser-kill-and-exit-command ()
  (browser-kill-deleted-items-command)
  (browser-exit-command)
  )

(de browser-exit-command ()
  % Exit the current browser.  This removes the browser from the display,
  % but does not destroy it (it can be reentered).

  (let ((browser (current-browser)))
    (when browser
      (browser-exit browser)
      )))

(de kill-browser-command ()
  % Kill the current browser.  This removes the browser from the display,
  % and removes it from the active browser list (it cannot be reentered).

  (let ((browser (current-browser)))
    (when browser
      (kill-browser browser)
      )))

(de browser-delete-command ()
  % Mark items as 'deleted'.
  (browser-do-repeated-command 'delete-item () nil)
  )

(de browser-undelete-command ()
  % Mark items as not 'deleted'.
  (browser-do-repeated-command 'undelete-item () nil)
  )
  
(de browser-undelete-backwards-command ()
  % Mark items as not 'deleted'.
  (setf nmode-command-argument (- nmode-command-argument))
  (browser-do-repeated-command 'undelete-item () nil)
  )
  
(de browser-kill-command ()
  % Kill items.
  (browser-do-repeated-command 'kill-item () t)
  )

(de browser-ignore-command ()
  % Ignore items: filter them out.
  (browser-do-repeated-command 'ignore-item () t)
  )
  
(de browser-view-command ()
  % View the current item.
  (let ((buffer (browser-view-item-in-buffer)))
    (if buffer
      (browser-view-buffer buffer nmode-command-argument-given)
      (Ding)
      )))
  
(de browser-edit-command ()
  % Edit the current item.
  (let ((buffer (browser-view-item-in-buffer)))
    (if buffer
      (browser-edit-buffer buffer nmode-command-argument-given)
      (Ding)
      )))

(de browser-kill-deleted-items-command ()
  (let ((browser (current-browser)))
    (=> browser kill-deleted-items)
    ))

(de browser-undo-filter-command ()
  (let* ((browser (current-browser))
	 (filter (=> browser undo-filter))
	 )
    (if filter
      (set-prompt (bldmsg "Application of %w undone." filter))
      (nmode-error "No filters have been applied to create this list.")
      )))

(de browser-help-command ()
  (let ((browser (current-browser)))
    (when browser
      (=> browser display-documentation)
      )))

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% Browser functions: use these in browser commands
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

(de current-browser ()
  (=> nmode-current-buffer get 'browser))

(de browser-sort (prompt sorter)
  (let ((browser (current-browser)))
    (=> browser sort sorter)
    (write-prompt prompt)
    ))

(de browser-current-item ()
  % Return the current item, if any, NIL otherwise.

  (let ((browser (current-browser)))
    (when browser
      (=> browser current-item)
      )))

(de browser-view-item (w)
  % View the current item in the specified window.  Return T if successful,
  % NIL otherwise.

  (let ((buffer (browser-view-item-in-buffer)))
    (when buffer
      (=> buffer set-previous-buffer nmode-current-buffer)
      (window-select-buffer w buffer)
      T
      )))

(de browser-view-item-in-buffer ()
  % View the current item in a buffer.  Return the buffer if successful,
  % NIL otherwise.  The buffer is not attached to any window.

  (let ((browser (current-browser)))
    (when browser
      (=> browser view-item)
      )))

(de browser-view-buffer (b invert-split-screen-option)
  % View the buffer B like an item is viewed.
  (let* ((use-other (xor browser-split-screen invert-split-screen-option))
	 (w (if use-other (nmode-other-window) nmode-current-window))
	 )
    (=> b set-previous-buffer nmode-current-buffer)
    (window-select-buffer w b)
    (if use-other
      (nmode-2-windows) % display the other window
      (set-message "C-M-L returns to browser.")
      )))
  
(de browser-edit-buffer (b invert-split-screen-option)
  % Edit the buffer B like an item is edited.
  (let* ((use-other (xor browser-split-screen invert-split-screen-option))
	 (w (if use-other (nmode-other-window) nmode-current-window))
	 )
    (=> b set-previous-buffer nmode-current-buffer)
    (window-select-buffer w b)
    (cond (use-other
	   (nmode-2-windows) % display the other window
	   (nmode-select-window w)
	   (set-message "C-X O returns to browser.")
	   )
	  (t
	   (set-message "C-M-L returns to browser.")
	   ))))

(de browser-add-item-and-view (new-item)
  % Add the item to the current browser.  Then, if in split screen mode,
  % view the item.

  (browser-add-item new-item)
  (when browser-split-screen
    (setf nmode-command-argument-given NIL)
    (browser-view-command)
    ))

(de browser-add-item (new-item)
  % Add the item to the current browser.

  (let ((browser (current-browser)))
    (when browser
      (=> browser add-item new-item)
      T
      )))

(de browser-add-items (new-item-list)
  % Add the items to the current browser.

  (let ((browser (current-browser)))
    (when browser
      (=> browser add-items new-item-list)
      T
      )))

(de browser-do-repeated-command (msg args removes?)
  % Perform a browser command that takes a signed numeric argument to mean
  % a repetition count.  On each iteration, the browser is sent
  % the specified message with the specified arguments.  If REMOVES? is
  % true, then the browser operation may remove the current item and
  % it will return true if it does.

  (let ((browser (current-browser)))
    (if (> nmode-command-argument 0)
      (for (from i 1 nmode-command-argument)
	   (do (when (not (=> browser current-item))
		 (Ding) (exit))
	       (if (not (and (lexpr-send browser msg args) removes?))
		 (move-to-next-line)
		 )))
      (for (from i 1 (- nmode-command-argument))
	   (do (when (current-line-is-first?)
		 (Ding) (exit))
	       (move-to-previous-line)
	       (when (not (=> browser current-item))
		 (move-to-next-line) (Ding) (exit))
	       (lexpr-send browser msg args)
	       ))
      )))

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

(off fast-integers)


REDUCE Historical
REDUCE Sourceforge Project | Historical SVN Repository | GitHub Mirror | SourceHut Mirror | NotABug Mirror | Chisel Mirror | Chisel RSS ]