Artifact 8ffcd3690867bfa4dc23f1fbb34a98f18b36327df083cdec7888d97c5fca6e9c:

• File psl-1983/nmode/modes.sl — part of check-in [eb17ceb7f6] at 2020-04-21 19:40:01 on branch master — Add Reduce 3.0 to the historical section of the archive, and some more
  files relating to version sof PSL from the early 1980s. Thanks are due to
  Paul McJones and Nelson Beebe for these, as well as to all the original
  authors.

  git-svn-id: https://svn.code.sf.net/p/reduce-algebra/code/historical@5328 2bfe0521-f11c-4a00-b80e-6202646ff360 (user: arthurcnorman@users.sourceforge.net, size: 4668) [annotate] [blame] [check-ins using] [more...]

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%
% MODES.SL - NMODE Mode Manipulation Functions
% 
% Author:      Alan Snyder
%              Hewlett-Packard/CRC
% Date:        14 September 1982
%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

(CompileTime (load objects extended-char))

% Global variables:

(fluid '(nmode-default-mode
         nmode-minor-modes % list of active minor modes (don't modify inplace!)
	 ))

% Internal static variables:

(fluid '(nmode-defined-modes
	 nmode-file-modes
	 ))

(setf nmode-default-mode NIL)
(setf nmode-defined-modes ())
(setf nmode-file-modes ())
(setf nmode-minor-modes ())

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%
% Mode Definition:
%
% The following function is used to define a mode (either major or minor):
%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

(de nmode-define-mode (name establish-expressions)
  (let* ((mode (make-instance 'mode
			      'name name
			      'establish-expressions establish-expressions
			      ))
	 (pair (Ass
		(function string-equal)
		name
		nmode-defined-modes
		)))
    (if pair
      (rplacd pair mode)
      (setf nmode-defined-modes
	(cons (cons name mode) nmode-defined-modes)
	))
    mode
    ))

(defflavor mode (
		name
  		establish-expressions
		)
  ()
  gettable-instance-variables
  initable-instance-variables
  )

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%
% File Modes
%
% The following functions associate a default mode with certain
% filename extensions.
%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

(de nmode-declare-file-mode (file-type mode)
  (let ((pair (Ass
		(function string-equal)
		file-type
		nmode-file-modes
		)))
    (if pair
      (rplacd pair mode)
      (setf nmode-file-modes
	(cons (cons file-type mode) nmode-file-modes)
	))
    ))

(de pathname-default-mode (pn)
  (setf pn (pathname pn))
  (let ((pair (Ass
		(function string-equal)
		(pathname-type pn)
		nmode-file-modes
		)))
    (if pair (cdr pair) nmode-default-mode)
    ))

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%
% Minor Modes
%
% A minor mode is a mode that can be turned on or off independently of the
% current buffer or the current major mode.
%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

(de minor-mode-active? (m)
  % M is a mode object.  Return T if it is an active minor mode.
  (memq m nmode-minor-modes)
  )

(de activate-minor-mode (m)
  % M is a mode object.  Make it active (if it isn't already).
  (when (not (minor-mode-active? m))
    (setf nmode-minor-modes (cons m nmode-minor-modes))
    (nmode-establish-current-mode)
    ))

(de deactivate-minor-mode (m)
  % M is a mode object.  If it is active, deactivate it.
  (when (minor-mode-active? m)
    (setf nmode-minor-modes (delq m nmode-minor-modes))
    (nmode-establish-current-mode)
    ))

(de toggle-minor-mode (m)
  % M is a mode object.  If it is active, deactivate it and return T;
  % otherwise, activate it and return NIL.

  (let ((is-active? (minor-mode-active? m)))
    (if is-active?
      (deactivate-minor-mode m)
      (activate-minor-mode m)
      )
    is-active?
    ))

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%
% Manipulating mode lists:
%
% The following functions are provided for use in user init files.  They are
% not used in NMODE.  See the file -CUSTOMIZING.TXT for information on how to
% customize NMODE.
%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

(de add-to-command-list (listname command func)
  (let* ((old-list (eval listname))
	 (old-binding (assoc command old-list))
	 (binding (cons command func))
	 )
    (cond
        % If the binding isn't already in the a-list.
        ((null old-binding)
          % Add the new binding
	  (set listname (aconc old-list binding)))
        % Otherwise, replace the old operation in the binding.
        (T
          (setf (cdr old-binding) func)))
    NIL
    ))

(de remove-from-command-list (listname command)
  (let* ((old-list (eval listname))
	 (old-binding (assoc command old-list))
	 )
    (cond (old-binding
	   (set listname (DelQ old-binding old-list))
	   NIL
	   ))))

(de set-text-command (command func)

  % This function is a shorthand for modifying text mode.  The arguments are as
  % for ADD-TO-COMMAND-LIST.  The change takes effect immediately.

  (add-to-command-list 'Text-Command-List command func)
  (nmode-establish-current-mode))