Changeset f50151 in git


Ignore:
Timestamp:
Aug 10, 1999, 7:45:56 PM (25 years ago)
Author:
Tim Wichmann <wichmann@…>
Branches:
(u'fieker-DuVal', '117eb8c30fc9e991c4decca4832b1d19036c4c65')(u'spielwiese', 'b4f17ed1d25f93d46dbe29e4b499baecc2fd51bb')
Children:
a8ce1600806f2e83f49c100d155de49bdb28c736
Parents:
12ce63682151db9a17fbfe965f46cae11f39e725
Message:
1999-08-09  Jens Schmidt  <schmidt@de.oracle.com>

	* singular.el: doc fixes

1999-08-08  Jens Schmidt  <schmidt@de.oracle.com>

	* .emacs (singular-interactive-mode-hook): key bindings for
	  scrolling commands changed

	* singular.el (singular-current-output-section): bug fix.
	  `save-restriction' added.

	* singular.el (singular-folding-toggle-fold-latest-output):
	  completely rewritten
	  (singular-folding-toggle-fold-at-point,
	  singular-folding-toggle-fold-all-output): removed
	  (singular-folding-toggle-fold-at-point-or-all): new function

	* singular.el (singular-folding-fold): checks that section is
	  unfolded before folding
	  (singular-folding-unfold): checks that section is folded before
	  unfolding.  Uses optional argument
	  INVISIBILITY-OVERLAY-OR-EXTENT.

	* singular.el (singular-xemacs-folding-unfold-internal): assumes
	  that section is folded and uses optional argument
	  INVISIBILITY-EXTENT
	  (singular-xemacs-folding-fold-internal): assumes that section is
	  unfolded
	  (singular-emacs-folding-fold-internal,
	  singular-emacs-folding-unfold-internal):  same changes as for
	  XEmacs

	* singular.el (singular-xemacs-folding-foldedp-internal,
	  singular-emacs-folding-foldedp-internal):  cosmetical changes

	* singular.el (singular-font-lock-singular-types): initialization
	  moved out of `defconst' for Byte Compiler to recognize

	* singular.el (singular-keep-region-active): new function
	  (singular-section-goto-beginning, singular-section-goto-end,
	  singular-section-backward, singular-section-forward): calls to
	  that function added

	* singular.el: new folding `Miscellaneous' in folding `Code common
	  to both modes' added

	* singular.el: Folding `Simple section stuff ...' and `Section
	  stuff' renamed to `Simple section API ...' and `Section API',
	  respectively.  New foldings `Section miscellaneous' and `Section
	  miscellaneous interactive'.  Folding `Getting section contents'
	  removed, contents moved to `Section miscellaneous'.  Folding
	  `Input and output filters' removed, contents moved to `Skipping
	  and stripping ...'.
	* singular.el.decl: changed accordingly

	* singular.el.decl: docu on access specifiers and types added,
	  declarations re-checked and updated.

1999-08-07  Jens Schmidt  <schmidt@de.oracle.com>

	* singular.el: preliminary and experimental version of online help
	  stuff added

	* singular.el: doc fixes.  I almost forgot about them.

	* singular.el (singular-time-stamp-difference): new function

	* singular.el (singular-interactive-mode-map): bindings added for
	  `singular-folding-toggle-fold-at-point',
	  `singular-folding-toggle-fold-latest-output', and
	  `singular-folding-toggle-fold-all-output'
	* singular.el (singular-folding-unfold): new function
	  (singular-folding-toggle-fold-at-point,
	  singular-folding-toggle-fold-latest-output,
	  singular-folding-toggle-fold-all-output): new functions

	* singular.el (singular-interactive-mode-map): bindings added for
	  `comint-previous-matching-input' and
	  `comint-next-matching-input'

1999-08-01  Jens Schmidt  <schmidt@de.oracle.com>

	* .emacs (singular-interactive-mode-hook): Font Lock mode turned
	  on for Singular interactive mode

	* .emacs (singular-interactive-mode-hook): key-bindings added

1999-07-31  Jens Schmidt  <schmidt@de.oracle.com>

	* singular.el: `Skipping and stripping prompts and newlines and
	  other things' moved

	* singular.el (singular-exit-sentinel): bug fix.

	* singular.el (singular-prompt-skip-forward): renamed from
	  `singular-prompt-skip-forward'.  All references replaced.

	* singular.el (singular-history-ignoredups, singular-history-size,
	  singular-history-filter-regexp,
	  singular-history-explicit-file-name): new defcustoms
	  (singular-history-read, singular-history-write,
	  singular-history-insert, singular-history-init): new functions.
	  Calls added to the necessary functions.

	* singular.el: new folding `Miscellaneous interactive' introduced

	* singular.el (singular-recenter,
	  singular-reposition-point-and-window): new functions
	  (singular-toggle-truncate-lines): uses
	  `singular-reposition-point-and-window' instead of recenter
	  (singular-scroll-previous-amount): new variable
	  (singular-scroll-right, singular-scroll-left): new variables

	* singular.el (singular-process, singular-process-mark): accept
	  optional argument NO-ERROR now and throw an error if Singular is
	  not alive
	  (singular-load-file, singular-load-library): rely on errors from
	  `singular-process' to catch dead processes

	* singular.el (singular-buffer-name-to-process-name,
	  singular-process-name-to-buffer-name,
	  singular-run-hook-with-arg-and-value, singular-process,
	  singular-process-mark): declared as `defsubst'

	* singular.el: almost all key bindings thrown out.  Needs to be
	  re-designed.

	* singular.el: more doc fixes

	* singular.el: doc fixes and cosmetical changes

1999-07-29  Jens Schmidt  <schmidt@de.oracle.com>

	* singular.el: Folding `Last input and output section' moved

	* singular.el.decl: changes from singular.el included

	* singular.el (singular-demo-load): uses
	  `singular-demo-load-directory' to load files
	  (singular-demo-load): behaviour on running new demo if there is
	  old one made customizable
	  (singular-demo-load): bug fix for Emacs which moves pointers on
	  file insertion

	* singular.el (singular-demo-command-on-enter,
	  singular-demo-command-on-leave): variables removed.  Instead,
	  hooks are run now in `singular-demo-exit-internal' and
	  `singular-demo-load'.

	* singular.el (singular-demo-mode): function disolved to a number
	  of smaller functions.  See below.
	  (singular-demo-exit-internal): new function
	  (singular-demo-exit): completely rewritten

	* singular.el (singular-demo-show-next-chunk): bug fix in white
	  space stripping at end of demo

	* singular.el (singular-demo-mode-init): new function.  Call added
	  to `singular-interactive-mode'.

	* singular.el (singular-demo-chunk-regexp): made a defcustom
	  (singular-demo-insert-into-history): new custom
	  (singular-demo-print-messages): made a defcustom
	  (singular-demo-exit-on-load): new custom
	  (singular-demo-load-directory): new custom

	* singular.el (singular-interactive-mode): sets `comint-mode-hook'
	  to nil before calling `comint-mode'
	  (singular-exec): does not run hooks on `comint-exec-hook' any
	  longer

	* singular.el: new folding for Comint stuff
	  folding `Customizing variables of comint' removed
	  folding `History' added

	* singular.el (singular-demo-mode): new group

	* singular.el: doc fixes

1999-07-25  Jens Schmidt  <schmidt@de.oracle.com>

	* .emacs (transient-mark-mode): switched on

	* singular.el.decl: all foldings updated to revision 1.38.
	  Section stuff and Key map revised.

	* singular.el: doc fixes and cosmetical changes

1999-07-25-b  Jens Schmidt  <schmidt@de.oracle.com>

	* singular.el: Key binding stuff almost completely rewritten.
	  Features now: new customs `singular-history-keys',
	  `singular-cursor-keys' and back-end functions
	  `singular-history-cursor-keys-set' and
	  `singular-history-cursor-key-set'.  New function
	  `singular-interactive-mode-map-init' added and call to that
	  function in `singular-interactive-mode'.  Key map does not
	  inherit keymap from `comint-mode' any longer.  New prefix maps
	  used.

	* singular.el (singular-demo-load): uses
	  `insert-file-contents-literally' now

	* singular.el (singular-section-goto-beginning,
	  singular-section-goto-end, singular-section-backward,
	  singular-section-forward: new functions

	* singular.el (singular-section-face-alist,
	  singular-folding-ellipsis,
	  singular-folding-line-move-ignore-folding): cosmetical changes

	* singular.el: menu and logo stuff moved to respective folding
	  (singular-interactive-mode-menu-init): new function
	  (singular-interactive-mode): call to that function added

	* singular.el (singular-interactive-font-lock-defaults):
	  SYNTAX-BEGIN set to `singular-section-goto-beginning'

	* singular.el (singular-interactive-miscellaneous): new group
	* singular.el (singular-map-buffer): moved to Customization
	  folding

	* singular.el: doc fixes

	* .emacs (singular-cursor-keys, singular-history-keys): settings
	  added

	* .emacs: work around for face problems on XEmacs added

1999-07-25-a  Jens Schmidt  <schmidt@de.oracle.com>

	* singular.el (singular-section-face-alist,
	  singular-section-input-face, singular-section-output-face): new
	  customs

	* singular.el (singular-emacs-simple-sec-in,
	  singular-section-mapsection): rewritten.  Much more beautiful
	  now

	* singular.el: doc fixes

1999-07-24  Jens Schmidt  <schmidt@de.oracle.com>

	* singular.el (singular-debug-pre-input-filter,
	  singular-debug-post-input-filter,
	  singular-debug-pre-output-filter,
	  singular-debug-post-output-filter): cosmetical changes
	  (singular-debug-filter-init): new function.
	  (singular-interactive-mode): calls that function instead of
	  initializing the filters on itself

	* .bashrc: new file

	* .emacs (custom-file): set

	* .emacs: loads and starts Singular interactive mode

	* .emacs-customize: renamed to .emacs

1999-07-24-b  Jens Schmidt  <schmidt@de.oracle.com>

	* singular.el: Font Lock mode support completely re-written:
	  Faces defined with `defface', regular expressions simplified,
	  call to `regexp-opt' added, `eval-when-compile' hack included,
	  doc strings re-written to official wording, function
	  `singular-interactive-font-lock-init' added, everything (except
	  faces) renamed to prefix "singular-interactive-font-lock", etc.

	* singular.el (singular-simple-sec-lookup-face): new subst.  Calls
	  added in `singular-emacs-simple-sec-create' and
	  `singular-xemacs-simple-sec-create'
	  (singular-section-face-alist): new custom
	  (singular-section-input-face, singular-section-input-face): new
	  faces

	* singular.el: doc fixes

	* .emacs-customize (show-paren-mode): new file

1999-07-24-a  Jens Schmidt  <schmidt@de.oracle.com>

	* singular.el (singular-xemacs-simple-sec-create): slightly
	  rewritten
	  (singular-xemacs-simple-sec-start-at): Handles imagenary clear
	  simple section at eob correctly now
	  (singular-xemacs-simple-sec-end-at,
	  singular-xemacs-simple-sec-at): cosmetical changes
	  (singular-xemacs-simple-sec-in): completely rewritten

	* singular.el (singular-faces, singular-sections-and-foldings):
	  new groups
	* singular.el (singular-folding-ellipsis,
	  singular-folding-line-move-ignore-folding): moved to group
	  `singular-sections-and-foldings'

	* singular.el: doc fixes, of course

1999-07-23  Jens Schmidt  <schmidt@de.oracle.com>

	* singular.el (singular-folding-fold-at-point,
	  singular-folding-unfold-at-point,
	  singular-folding-fold-latest-output,
	  singular-folding-unfold-latest-output,
	  singular-folding-fold-all-output,
	  singular-folding-unfold-all-output): (re-)new functions

	* singular.el (singular-folding-fold): accepts optional argument
	  NO-ERROR

	* singular.el (singular-folding-line-move-ignore-folding): new
	  defcustom

	* singular.el (singular-section-mapsection): new function

	* singular.el (singular-map-buffer): new function

	* singular.el (singular-folding-init): adapted to XEmacs
	  (singular-xemacs-folding-fold-internal,
	  singular-xemacs-folding-foldedp-internal,
	  singular-xemacs-folding-unfold-internal): new functions

	* singular.el: doc fixes (what else?)

1999-07-22  Jens Schmidt  <schmidt@de.oracle.com>

	* singular.el-07-22 (singular-emacs-folding-fold-internal): bug
	  fix

	* singular.el-07-22 (singular-folding-ellipsis): sets ellipsis in
	  already running Singulars
	  (singular-folding-set-ellipsis-in-singular-buffers,
	  singular-folding-set-ellipsis): new
	  functions

	* singular.el-07-22 (singular-section-in): restriction algorithm
	  changed.  Restricts to whole sections now.
	  (singular-section-in-internal): new function used by
	  `singular-section-in'

	* singular.el-07-22 (singular-emacs-simple-sec-in): bug fix

	* singular.el-07-22: doc fixes, of course

1999-07-19  Jens Schmidt  <schmidt@de.oracle.com>

	* singular.el: Folding stuff completely rewritten.
	  (singular-interactive-mode): Folding stuff initialization moved
	  to new function `singular-folding-init'

	* singular.el (singular-process, singular-process-mark,
	  singular-simple-sec-last-end-position): bug fixes

	* singular.el (singular-interactive): new group

	* singular.el: face initialization for XEmacs slightly
	  re-organized

	* singular.el (singular-mode-syntax-table-init): new function.
	  Called from `singular-interactive-mode'.

	* singular.el: doc fixes, of course.

1999-07-18-a  Jens Schmidt  <schmidt@de.oracle.com>

	* singular.el (singular-section-in): completely rewritten.
	  Handles restrictions now.

	* singular.el (singular-section-at): handles degenerate
	  restriction cases correctly now

	* singular.el (singular-section-simple-sec, singular-section-type,
	  singular-section-start, singular-section-end): defined as subst

	* singular.el (singular-section-create): new subst.  Used in all
	  instances where new sections are generated.

	* singular.el: A number of changes in the XEmacs simple section
	  stuff.  However, there are still some changes from the Emacs
	  simple section stuff that have to be re-done for the XEmacs
	  stuff, too.

	* singular.el (singular-emacs-simple-sec-in): implemented

	* singular.el (singular-simple-sec-end,
	  singular-simple-sec-start, singular-simple-sec-type,
	  singular-simple-sec-before): defined as subst

	* singular.el (singular-emacs-simple-sec-create): slightly
	  rewritten.  Should be a little bit faster now.

	* singular.el (singular-simple-sec-reset-last,
	  singular-xemacs-simple-sec-reset-last,
	  singular-emacs-simple-sec-reset-last): removed

	* singular.el (singular-simple-sec-last-end-position): new macro.
	  Used whenever position of last simple section is accessed.

	* singular.el (singular-input-section-to-string): cosmetical
	  changes

	* singular.el (singular-mode-syntax-table): (my own) bug fixed in
	  initialization

	* singular.el: doc fixes.  A *lot* of doc fixes.

1999-07-17  Jens Schmidt  <schmidt@de.oracle.com>

	* singular.el (singular-load-file, singular-load-library): checks
	  added whether process is running

	* singular.el (singular-interactive-mode-map): settings for
	  singular-demo-exit uncommented.  Does not work on Emacs.

	* singular.el (font-lock-singular-prompt-face): bug fix.  Was
	  font-lock-singular-warn-face.

	* singular.el (singular-interactive-mode-syntax-table,
	  singular-mode-syntax-table): renamed and moved to common code
	  section, same for initialization of syntax table
	  (singular-mode-syntax-table): back tics added as strings

	* singular.el (singular-fset): support for Emacs 19 removed
	  (singular-set-version): ditto

	* singular.el: doc fixes

1998-08-14  T. Wichmann  <wichmann@itwm.uni-kl.de>

	* singular.el : commented code for singular-logo on startup in
	XEmacs. This code needs some rethinking...

1998-08-10  T. Wichmann  <wichmann@itwm.uni-kl.de>

	* singular.el (singular-toggle-truncate-lines): Added (recenter)
	according to function definition in XEmacs.
	(singular-other): Added check on unique buffer name.
	Added comments to functions and variables.

1998-08-07  T. Wichmann  <wichmann@itwm.uni-kl.de>
	*singular (singular-send-or-copy-input): Print message if demo
	mode is active
	Added variable singular-demo-mode-print-messages

	* singular.el (singular-demo-mode): changed message text
	(singular-other): if singular options are read from minibuffer, do
	not display the "-t" option. Add it automatically.
	(singular-other): Changed minibuffer text
	(singular-exit-singular): Added (kill-buffer)

	* singular.el (singular-do-folding): Added (recenter) to prevent
	error in subst-char-in-region. Temporary?

	* singular.el (singular-other): Added

1998-08-06  T. Wichmann  <wichmann@itwm.uni-kl.de>

        * singular.el: added key-bindings
	Introduced new variable singular-start-menu (temporary)
	Updated submenu "load library"

        * singular.el: set-face for new font-lock faces now uses argument
	'append for XEmacs
	Changed (get-buffer-process (cur...)) to (singular-process)
	(singular-demo-mode): added message on enter

	* singular.el (singular-emacs-simple-sec-start-at): Removed error:
       	(point) was used instead of pos
	(singular-emacs-simple-sec-end-at): Removed error: (point) was
	used instead of pos

	* singular.el (singular-interactive-mode-syntax-table): Added
	additional entries

	* singular.el (singular-font-lock-keywords-1): Added new regexps
	(font-lock-singular-error-face): Added new face
	(font-lock-singular-warn-face): Added new face
	(font-lock-singular-prompt-face): Added new face

	*singular.el: set-face for section faces put in comments

	* singular.el (singular-xemacs-simple-sec-in): Written
	(singular-section-in): Written
	(singular-do-folding): Finished

Thu Jul 30 11:45:28 1998  Jens Schmidt  <schmidt@mathematik.uni-kl.de>

	* singular.el (singular-process): new macro

	* singular.el (singular-demo-command-on-enter,
	  singular-demo-command-on-exit): new variables
 	  (singular-demo-mode): sends commands on entering and exiting

	* singular.el (singular-demo-mode-init): function removed.
	  Functionality moved to `singular-demo-mode'.
	  (singular-demo-mode): more versatile.  Knows how to enter and to
	  exit, too.  All callers adapted.
	  (singular-demo-exit): new function
	  (singular-demo-show-next-chunk): leaves demo mode after showing
	  last chunk
	  (singular-demo-load): does not show first chunk on startup

	* singular.el (singular-remove-prompt-regexp): new variable
	  (singular-remove-prompt): new function

	* singular.el (singular-string-start-anchored-prompt-regexp):
	  renamed to `singular-strip-leading-prompt-regexp'
	  (singular-strip-prompts): renamed to
	  `singular-strip-leading-prompt'
	  (singular-prompt-sequence-regexp): renamed to
	  `singular-skip-prompt-forward-regexp'

	* singular.el (singular-fold-internal): bug fix.  Keeping undo
	  information not up-to-date leads to a corrupt undo list.
	  (singular-demo-show-next-chunk): ditto
	  (singular-exit-sentinel): switches off demo mode on exit

1998-07-31  T. Wichmann  <wichmann@itwm.uni-kl.de>

	* singular.el: simple-secs for XEmacs, second version

1998-07-29  T. Wichmann  <wichmann@itwm.uni-kl.de>

	* singular.el : simple-secs for XEmacs partially implemented

Wed Jul 29 10:50:47 1998  Jens Schmidt  <schmidt@mathematik.uni-kl.de>

	* singular.el (singular-extended-prompt-regexp,
	  singular-string-start-anchored-prompt-regexp,
	  singular-prompt-sequence-regexp): new constants
	  (singular-strip-white-space, singular-strip-prompts,
	  singular-skip-prompt-forward): new functions

	* singular.el (singular-emacs-simple-sec-end-at): bug fix
	  (singular-fold-internal, singular-demo-show-next-chunk): do not
	  save buffer-modified flag and do not switch off read only state
	  (singular-output-filter): does not switch off read only state
	  (singular-input-section-to-string): new function

	* singular.el (singular-send-input): sends old input sections
	  (singular-send-input): renamed to
	  `singular-send-or-copy-input'.  All references changed.
	  (singular-get-old-input): new function

	* singular.el (singular-demo-end): new variable
	  (singular-demo-mode-init, singular-interactive-mode): new
	  function.  Call added in mode initialization.
	  (singular-demo-load): sets `singular-demo-end'
	  (singular-demo-show-next-chunk): is smarter concerning end of
	  demo file

	* singular.el (singular-demo-chunk-regexp): new variable
	  (singular-demo-mode, singular-demo-old-mode-name,
	  singular-interactive-mode): new local variables.  Localization
	  added.
	  (singular-demo-mode, singular-demo-show-next-chunk,
	  singular-demo-load): new function
	  (singular-send-input): supports demo mode

	* singular.el (singular-fold-internal, singular-fold-section):
	  again takes only a single region instead of a list.  All callers
	  changed.

	* singular.el (singular-fold-section): doc fix
	  (singular-exec): takes care about undo information when
	  retrieving start file
	  (singular-emacs-simple-sec-before): doc fix
	  (singular-exec): cosmetic changes
	  (singular-output-filter): cosmetic changes
	  (singular-simple-sec-last-end): doc fix
	  (singular-send-input): argument STRING changed to
	  SEND-FULL-SECTION.  Semantics not implemented yet.

	* singular.el (singular-section-before): new function

Tue Jul 28 08:49:05 1998  Jens Schmidt  <schmidt@mathematik.uni-kl.de>

	* singular.el (singular-emacs-simple-sec-start-at,
	  singular-emacs-simple-sec-end-at):  assume that buffer is
	  already widened
	  (singular-section-at): widens buffer before determining start
 	  and end of clear simple sections

	* singular.el (singular-fold-section): doc fix
	  (singular-emacs-simple-sec-create): doc fix
	  (singular-simple-sec-last-end): doc fix
	  explanations for sections and simple sections added

	* singular.el (singular-fold-internal, singular-fold-section):
	  uses a list of regions instead of one region.  All callers
 	  changed.

	* singular.el (singular-fold-internal): doc fix
	  (singular-section-foldedp): doc fix
	  (singular-fold-section): saves restrictions before folding

	* singular.el (singular-section-at): argument `raw-section'
	  renamed to `restricted' and its semantic inverted

	* singular.el (singular-emacs-simple-sec-start-at,
	  singular-emacs-simple-sec-end-at): new functions.  `fset's for
 	  the flavor-independent functions added.

	* singular.el (singular-emacs-simple-sec-reset-last): new argument
	  `pos'.  Resets `singular-simple-sec-last-end', too.
	  (singular-output-filter): does not set
	  `singular-simple-sec-last-end'

	* singular.el (singular-simple-sec-last-end): new variable
	  (singular-debug-format): wrapped by a `save-match-data'
	  (singular-simple-sec-clear-type): doc fix
	  (singular-emacs-simple-sec-create): doc fix
	  (singular-emacs-simple-sec-create): cosmetic changes
	  (singular-fold-internal): cosmetic changes
	  (singular-fold-internal): bug fix.  Order of `delete-char' and
	  `subst-char-in-region' exchanged.

	* singular.el (singular-section-at): new function
	  (singular-section-simple-sec, singular-section-start,
	  singular-section-end, singular-section-type): new macros

	* singular.el (singular-fold-internal, singular-fold-section,
	  singular-section-foldedp): new functions

	* singular.el (singular-output-filter): sets `inhibit-read-only'
	  instead of `buffer-read-only'

	* singular.el (singular-simple-sec-clear-type): new variable
	  (singular-simple-sec-init): new function
	  (singular-emacs-simple-sec-create,
 	  singular-emacs-simple-sec-reset-last,
 	  singular-emacs-simple-sec-start, singular-emacs-simple-sec-end,
 	  singular-emacs-simple-sec-type, singular-emacs-simple-sec-at,
 	  singular-emacs-simple-sec-before, singular-emacs-simple-sec-in
 	  ): new functions.  `fset's for the flavor-independent functions
	  added.

Mon Jul 27 12:39:04 1998  Jens Schmidt  <schmidt@mathematik.uni-kl.de>

	* singular.el (singular-output-filter): new function
	  (singular-send-input): new function
	  (singular-interactive-mode-map): `singular-send-input' bound to
	  `"\C-m"'

	* singular.el (singular-debug-input-filter,
	  singular-debug-output-filter):  completely rewritten.  Bogus
	  call counting removed.  Debug checks added.
	  (singular-debug-bogus-output-filter-cnt): variable removed

	* singular.el (singular): code for creation of new singular
	  process moved to `singular-exec'
	  (singular-exec): new function

	* singular.el (singular-process-mark): new macro
	  (singular-exit-sentinel): debug message fix
	  (singular): arguments names changed
	  (singular-set-version): message fix
	  (singular-bogus-output-filter-calls): variable removed
	  (singular-debug): optional argument `else-form' added
	  (singular-debug-format): uses `replace-match' to replace
	  newlines

	* singular.el (singular-folding-ellipsis): new variable
	  (singular-interactive-mode): selective display stuff added

	* singular.el (singular-input-face, singular-output-face): new
	  variables
	  (singular-lookup-face): new function

Thu Jul 23 10:28:53 1998  Jens Schmidt  <schmidt@mathematik.uni-kl.de>

	* singular.el (singular): initializes the markers
	  `comint-last-input-start', `comint-last-input-end', and
	  `comint-last-output-start'
	  (singular): goes to point max after Singular startup

	* singular.el (singular-interactive-mode):
	  `comint-truncate-buffer' is not longer added unconditionally to
	  `comint-output-filter-functions'
	  (singular): runs `comint-exec' instead of `make-comint'

	* singular.el (comint-mode): advice removed
	  (singular-interactive-mode): `comint-mode' is called now in a
	  more regular way

	* singular.el (singular-debug-output-filter): doc fix

	* singular.el (singular-bogus-output-filter-calls): new variable

	* singular.el (singular-interactive-mode-map): code for XEmacs
	  added

	* singular.el (singular-emacs-flavor,
	  singular-emacs-major-version, singular-emacs-minor-version): new
 	  variables
	  (singular-set-version, singular-fset): new functions

	* singular.el (singular-debug-format): new function
	  (singular-debug-bogus-output-filter-cnt): new variable
	  (singular-debug-input-filter, singular-debug-output-filter): new
	  variables
	  (singular-interactive-mode): conditionally adds debugging
	  filters

	* singular.el: style and coding conventions added

Wed Jul 22 11:45:56 1998  Jens Schmidt  <schmidt@mathematik.uni-kl.de>

	* singular.el (singular-interactive-mode):
	  `comint-truncate-buffer' is added to `comint-truncate-buffer'
	  via a local `add-hook'
	  (singular-interactive-mode): doc fix
	  (singular-interactive-mode): `mode-name' fixed
	  (singular): doc fix

	* singular.el (comint-mode): new advice
	  `singular-interactive-mode'
	  (singular-interactive-mode): call to `comint-mode' re-added
	  (singular-interactive-mode): call to `comint-read-input-ring'
	  moved to `singular'
	  (singular): almost completely rewritten.  Runs
	  `singular-interactive-mode' only on creation of a new buffer.
	  Runs hooks on `singular-exec-hook'.  Reads input ring on
	  creation of a new process.

	* singular.el (singular-prompt-regexp): doc fix
	  (singular-input-ignoredups, singular-maximum-buffer-size):
	  unmade customizable

	* singular.el (singular-history-filter-regexp): new variable
	  (singular-history-filter): new variable
	  (singular-interactive-mode): sets `comint-input-filter' to
	  `singular-history-filter'

	* singular.el (singular-interactive-mode): adds
	  `comint-truncate-buffer' to `comint-output-filter-functions'.
	  `singular-buffer-maximum-size' unmade buffer local.

	* singular.el (singular-interactive-mode): does not run
	  `comint-mode'.  Mode name changed to `"Singular Interactive".

	* singular.el (singular-debug): doc fix
	  (singular-debug): recognition of mode `all' added
	  (singular-interactive-mode): `singular-debug' unmade buffer
	  local

	* singular.el (singular-exit-sentinel): debug messages added

	* singular.el (singular-start-file): doc fix
	  (singular-default-executable, singular-default-name,
	  singular-default-switches): doc fix
	  (singular, singular-interactive-mode): doc fix
	  (singular-delimiter-argument-list, singular-input-ignoredups,
	  singular-buffer-maximum-size, singular-input-ring-size): doc fix


git-svn-id: file:///usr/local/Singular/svn/trunk@3417 2c84dea3-7e68-4137-9b89-c4e89433aadc
File:
1 edited

Legend:

Unmodified
Added
Removed
  • emacs/singular.el

    r12ce63 rf50151  
    11;;; singular.el --- Emacs support for Computer Algebra System Singular
    22
    3 ;; $Id: singular.el,v 1.29 1999-07-19 10:25:16 obachman Exp $
     3;; $Id: singular.el,v 1.30 1999-08-10 17:45:56 wichmann Exp $
    44
    55;;; Commentary:
     
    1616;;   strings, and messages.  As part of symbols, it is written with
    1717;;   a lower-case `s'.
    18 ;; - use a `fill-column' of 70 for doc strings and comments
     18;; - When referring to the Singular interactive mode, do it in that
     19;;   wording.  Use the notation `singular-interactive-mode' only when
     20;;   really referring to the lisp object.
     21;; - use a `fill-column' of 75 for doc strings and comments
     22;; - mark incomplete doc strings or code with `NOT READY' optionally
     23;;   followed by an explanation what exactly is missing
     24;;
    1925;; - use foldings to structure the source code but try not to exceed a
    20 ;;   maximal depth of two folding (one folding in another folding which is
    21 ;;   on top-level)
     26;;   maximum depth of two foldings
    2227;; - use lowercase folding titles except for first word
    2328;; - folding-marks are `;;{{{' and `;;}}}' resp., for sake of standard
    2429;;   conformity
    25 ;; - mark incomplete doc strings or code with `NOT READY' (optionally
    26 ;;   followed by an explanation what exactly is missing)
    27 ;; - documentation on the customization of the modes is in the
    28 ;;   doc-strings to `singular-mode-configuration' and
    29 ;;   `singular-interactive-mode-configuration', resp.
     30;; - use the foldings to modularize code.  That is, each folding should be,
     31;;   as far as possible, self-content.  Define a function `singular-*-init'
     32;;   in the folding to do the initialization of the module contained in
     33;;   that folding.  Call that function from `singular-interactive-mode',
     34;;   for example, instead of initializing the module directly from
     35;;   `singular-interactive-mode'.  Look at the code how it is done for the
     36;;   simple section or for the folding stuff.
    3037;;
    3138;; - use `singular' as prefix for all global symbols
    3239;; - use `singular-debug' as prefix for all global symbols concerning
    3340;;   debugging.
     41;; - use, whenever possible without names becoming too clumsy, some unique
     42;;   prefix inside a folding
    3443;;
    3544;; - mark dependencies on Emacs flavor/version with a comment of the form
    36 ;;   `;; Emacs[ <version>]'     resp.
    37 ;;   `;; XEmacs[ <version>][ <nasty comment>]' (in that order, if
    38 ;;   possible)
     45;;   `;; Emacs[ <version> ]'     resp.
     46;;   `;; XEmacs[ <version> ][ <nasty comment> ]'
     47;;   specified in that order, if possible
    3948;; - use a `cond' statement to execute Emacs flavor/version-dependent code,
    4049;;   not `if'.  This is to make such checks more extensible.
    41 ;; - try to define different functions for different flavors/version
    42 ;;   and use `singular-fset' at library-loading time to set the function
    43 ;;   you really need.  If the function is named `singular-<basename>', the
     50;; - try to define different functions for different flavors/version and
     51;;   use `singular-fset' at library-loading time to set the function you
     52;;   really need.  If the function is named `singular-<basename>', the
    4453;;   flavor/version-dependent functions should be named
    4554;;   `singular-<flavor>[-<version>]-<basename>'.
    46 
     55;;
    4756;; - use `singular-debug' for debugging output/actions
    4857;; - to switch between buffer and process names, use the functions
    4958;;   `singular-process-name-to-buffer-name' and
    5059;;   `singular-buffer-name-to-process-name'
     60;; - call the function `singular-keep-region-active' as last statement in
     61;;   an interactive function that should keep the region active (for
     62;;   example, in functions that move the point).  This is necessary to keep
     63;;   XEmacs' zmacs regions active.
     64;; - to get the process of the current buffer, use `singular-process'.  To
     65;;   get the current process mark, use `singular-process-mark'.  Both
     66;;   functions check whether Singular is alive and throw an error if not,
     67;;   so you do not have to care about that yourself.  If you do not want an
     68;;   error specify non-nil argument NO-ERROR.  But use them anyway.
    5169;; - we assume that the buffer is *not* read-only
    5270
    5371;;}}}
    5472
    55 (require 'comint)
    56 
    5773;;{{{ Code common to both modes
     74;;{{{ Customizing
     75(defgroup singular-faces nil
     76  "Faces in Singular mode and Singular interactive mode."
     77  :group 'faces
     78  :group 'singular-interactive)
     79;;}}}
     80
    5881;;{{{ Debugging stuff
    5982(defvar singular-debug nil
    60   "*List of modes to debug or t to debug all modes.
    61 Currently, there are the modes `interactive', `interactive-filter',
    62 `interactive-simple-secs', and `interactive-sections'.")
     83  "List of modes to debug or t to debug all modes.
     84Currently, the following modes are supported:
     85  `interactive',
     86  `interactive-filter'.")
    6387
    6488(defun singular-debug-format (string)
     
    85109(defvar singular-emacs-flavor nil
    86110  "A symbol describing the current Emacs.
    87 Currently, only Emacs \(`emacs') and XEmacs are supported \(`xemacs').")
     111Currently, only Emacs \(`emacs') and XEmacs \(`xemacs') are supported.")
    88112
    89113(defvar singular-emacs-major-version nil
     
    91115
    92116(defvar singular-emacs-minor-version nil
    93   "An integer describing the major version of the current emacs.")
    94 
    95 (defun singular-fset (real-function emacs-function xemacs-function
    96                                     &optional emacs-19-function)
     117  "An integer describing the minor version of the current emacs.")
     118
     119(defun singular-fset (real-function emacs-function xemacs-function)
    97120  "Set REAL-FUNCTION to one of the functions, in dependency on Emacs flavor and version.
    98121Sets REAL-FUNCTION to XEMACS-FUNCTION if `singular-emacs-flavor' is
    99 `xemacs'.  Sets REAL-FUNCTION to EMACS-FUNCTION if `singular-emacs-flavor'
    100 is `emacs' and `singular-emacs-major-version' is 20.  Otherwise, sets
    101 REAL-FUNCTION to EMACS-19-FUNCTION which defaults to EMACS-FUNCTION.
    102 
    103 This is not as common as would be desirable.  But it is sufficient so far."
     122`xemacs', otherwise sets REAL-FUNCTION to EMACS-FUNCTION.
     123
     124This is not as common as it would be desirable.  But it is sufficient so
     125far."
    104126  (cond
    105127   ;; XEmacs
    106128   ((eq singular-emacs-flavor 'xemacs)
    107129    (fset real-function xemacs-function))
    108    ;; Emacs 20
    109    ((eq singular-emacs-major-version 20)
    110     (fset real-function emacs-function))
    111    ;; Emacs 19
     130   ;; Emacs
    112131   (t
    113     (fset real-function (or emacs-19-function emacs-function)))))
     132    (fset real-function emacs-function))))
    114133
    115134(defun singular-set-version ()
    116135  "Determine flavor, major version, and minor version of current emacs.
    117 singular.el is guaranteed to run on Emacs 19.34, Emacs 20.2, and XEmacs
    118 20.2.  It should run on newer version and on slightly older ones, too."
    119 
     136singular.el is guaranteed to run on Emacs 20.3 and XEmacs 20.3.
     137It should run on newer version and on slightly older ones, too.
     138
     139This function is called exactly once when singular.el is loaded."
    120140  ;; get major and minor versions first
    121141  (if (and (boundp 'emacs-major-version)
     
    128148features from singular.el will not work properly.  Consider upgrading to a
    129149more recent version of Emacs or XEmacs.  singular.el is guaranteed to run
    130 on Emacs 19.34, Emacs 20.2, and XEmacs 20.2."))
     150on Emacs 20.3 and XEmacs 20.3."))
    131151    ;; assume the oldest version we support
    132     (setq singular-emacs-major-version 19
    133           singular-emacs-minor-version 34))
     152    (setq singular-emacs-major-version 20
     153          singular-emacs-minor-version 3))
    134154
    135155  ;; get flavor
     
    141161;;}}}
    142162
    143 ;;{{{ Faces
     163;;{{{ Syntax table
     164(defvar singular-mode-syntax-table nil
     165  "Syntax table for `singular-interactive-mode' resp. `singular-mode'.")
     166
     167(if singular-mode-syntax-table
     168    ()
     169  (setq singular-mode-syntax-table (make-syntax-table))
     170  ;; stolen from cc-mode.el except for back-tics which are special to Singular
     171  (modify-syntax-entry ?_  "_"          singular-mode-syntax-table)
     172  (modify-syntax-entry ?\\ "\\"         singular-mode-syntax-table)
     173  (modify-syntax-entry ?+  "."          singular-mode-syntax-table)
     174  (modify-syntax-entry ?-  "."          singular-mode-syntax-table)
     175  (modify-syntax-entry ?=  "."          singular-mode-syntax-table)
     176  (modify-syntax-entry ?%  "."          singular-mode-syntax-table)
     177  (modify-syntax-entry ?<  "."          singular-mode-syntax-table)
     178  (modify-syntax-entry ?>  "."          singular-mode-syntax-table)
     179  (modify-syntax-entry ?&  "."          singular-mode-syntax-table)
     180  (modify-syntax-entry ?|  "."          singular-mode-syntax-table)
     181  (modify-syntax-entry ?\' "\""         singular-mode-syntax-table)
     182  (modify-syntax-entry ?\` "\""         singular-mode-syntax-table)
     183  ;; block and line-oriented comments
     184  (cond
     185   ;; Emacs
     186   ((eq singular-emacs-flavor 'emacs)
     187    (modify-syntax-entry ?/  ". 124b"   singular-mode-syntax-table)
     188    (modify-syntax-entry ?*  ". 23"     singular-mode-syntax-table))
     189   ;; XEmacs
     190   (t
     191    (modify-syntax-entry ?/  ". 1456"   singular-mode-syntax-table)
     192    (modify-syntax-entry ?*  ". 23"     singular-mode-syntax-table)))
     193  (modify-syntax-entry ?\n "> b"        singular-mode-syntax-table)
     194  (modify-syntax-entry ?\^m "> b"       singular-mode-syntax-table))
     195
     196(defun singular-mode-syntax-table-init ()
     197  "Initialize syntax table of current buffer.
     198
     199This function is called at mode initialization time."
     200  (set-syntax-table singular-mode-syntax-table))
     201;;}}}
     202
     203;;{{{ Miscellaneous
     204(defsubst singular-keep-region-active ()
     205  "Do whatever is necessary to keep the region active in XEmacs.
     206Ignore byte-compiler warnings you might see.  This is not needed for
     207Emacs."
     208  ;; XEmacs.  We do not use the standard way here to test for flavor
     209  ;; because it is presumably faster with that test on `boundp'.
     210  (and (boundp 'zmacs-region-stays)
     211       (setq zmacs-region-stays t)))
     212;;}}}
     213;;}}}
     214
     215;;{{{ Singular interactive mode
     216;;{{{ Customizing
    144217
    145218;; Note:
    146219;;
    147 ;; These fonts look quite good:
    148 ;; "-adobe-courier-bold-r-*-*-18-*-*-*-*-*-*-*" for input
    149 ;; "-adobe-courier-bold-o-*-*-18-*-*-*-*-*-*-*" for output
     220;; Some notes on Customize:
    150221;;
    151 ;; For my (Jens) Emacs a quite good variant is:
    152 ;; "-misc-fixed-bold-*-*-*-15-*-*-*-*-*-*-*" for input
    153 ;; "-misc-fixed-medium-*-*-*-15-*-*-*-*-*-*-*" for output
    154 
    155 (make-face 'singular-input-face)
    156 ;(set-face-background 'singular-input-face "Orange")
    157 (defvar singular-input-face 'singular-input-face
    158   "Face for user input.
    159 This face should have set background only.")
    160 
    161 (make-face 'singular-output-face)
    162 ;(set-face-font 'singular-output-face "-adobe-courier-bold-o-*-*-18-*-*-*-*-*-*-*")
    163 ;(set-face-background 'singular-output-face "Wheat")
    164 (defvar singular-output-face 'singular-output-face
    165   "Face for Singular output.
    166 This face should have set background only.")
    167 
    168 (defun singular-lookup-face (face-type)
    169   "Return face belonging to FACE-TYPE.
    170 NOT READY [should be rewritten completely.  Interface should stay the same.]!"
    171   (cond ((eq face-type 'input) singular-input-face)
    172         ((eq face-type 'output) singular-output-face)))
    173 
    174 ;; Additional faces for font locking
    175 (make-face 'font-lock-singular-error-face)
    176 
    177 (defvar font-lock-singular-error-face 'font-lock-singular-error-face
    178   "Additional font-lock face for singular errors.")
    179 
    180 (cond
    181  ;; XEmacs
    182  ((eq singular-emacs-flavor 'xemacs)
    183   ;; That 'append avoids to overwrite the face if it is already set
    184   (set-face-foreground 'font-lock-singular-error-face "Red"
    185                        'global nil 'append)))
    186 
    187 (make-face 'font-lock-singular-warn-face)
    188 
    189 (defvar font-lock-singular-warn-face 'font-lock-singular-warn-face
    190   "Additional font-lock face for singular warnings.")
    191 
     222;; - The documentation states that for the `:initialize' option of
     223;;   `defcustom' the default value is `custom-initialize-set'.  However, in
     224;;   the source code of Customize `custom-initialize-reset' is used.  So
     225;;   better always specify the `:initialize' option explicitly.
     226;; - Customize is bad at setting buffer-local variables or properties.
     227;;   This is quite natural since Customize itself uses its own buffer.  So
     228;;   changing buffer-local variables and properties with Customize is
     229;;   possible only at a "Singular-global" level.  That is, for all buffers
     230;;   currently having Singular interactive mode as major mode.  The function
     231;;   `singular-map-buffer' helps to do such customization.
     232;;
     233;; Some common customizing patterns:
     234;;
     235;; - How to customize buffer-local properties?
     236;;   First, the `defcustom' itself must not set anything buffer-local since
     237;;   at time of its definition (most likely) no Singular buffers will be
     238;;   around.  If there are Singular buffers we do not care about them.  But
     239;;   anyhow, at definition of the `defcustom' the global default has to be
     240;;   set.  Hence, the `:initialize' option should be set to
     241;;   `custom-initialize-default'.
     242;;   The buffer-local initialization has to be done at mode initialization
     243;;   time.  The global default value should then be used to set the local
     244;;   properties.
     245;;   At last, the function specified with the `:set' option should set the
     246;;   local properties in all Singular buffers to the new, customized value.
     247;;   Most likely, the function `singular-map-buffer' may be used for that.
     248;;   In addition, the function should, of course, set the global value via
     249;;   `set-default'.
     250;;   For an example, see `singular-folding-line-move-ignore-folding'.
     251;;
     252;; - How to encapsulate other mode's global variables into Singular
     253;;   interactive mode variables?
     254;;   Set them always.  That is, set them if the `defcustom' is evaluated
     255;;   (use `custom-initialize-reset' as `:initial' function) and set them
     256;;   when the Singular interactive mode variable is customized (by means
     257;;   of an appropriate `:set' function).
     258;;   For an example, see `singular-section-face-alist' (which does not
     259;;   encapsulate another mode's variable, but Singular interactive mode's
     260;;   own variable `singular-simple-sec-clear-type').
     261
     262(defgroup singular-interactive nil
     263  "Running Singular with Emacs or XEmacs as front end."
     264  :group 'processes)
     265
     266(defgroup singular-sections-and-foldings nil
     267  "Sections and foldings in Singular interactive mode."
     268  :group 'singular-interactive)
     269
     270(defgroup singular-interactive-miscellaneous nil
     271  "Miscellaneous settings for Singular interactive mode."
     272  :group 'singular-interactive)
     273
     274(defgroup singular-demo-mode nil
     275  "Settings concerning Singular demo mode."
     276  :group 'singular-interactive)
     277
     278(defun singular-map-buffer (func &rest args)
     279  "Apply FUNC to ARGS in all existing Singular buffers.
     280That is, in all buffers having Singular interactive major mode.  The
     281function is executed in the context of the buffer.  This is a must-have for
     282the customizing stuff to change buffer-local properties."
     283  (save-excursion
     284    (mapcar (function
     285             (lambda (buffer)
     286               (set-buffer buffer)
     287               (if (eq major-mode 'singular-interactive-mode)
     288                   (apply func args))))
     289            (buffer-list))))
     290;;}}}
     291
     292;;{{{ Comint
     293
     294;; Note:
     295;;
     296;; We require Comint, but we really do not use it too much.  One may argue
     297;; that this is bad since Comint is a standardized way to communicate with
     298;; external processes.  One may argue further that many experienced Emacs
     299;; users are forced now to re-do their Comint customization for Singular
     300;; interactive mode.  However, we believe that the intersection between
     301;; experienced Emacs users and users of Singular interactive mode is almost
     302;; empty.
     303;;
     304;; In fact, we used Comint really much in the beginning of this project.
     305;; Later during development it turned at that using Comint's input and
     306;; output processing is to inflexible and not appropriate for Singular
     307;; interactive mode with its input and output sections.  So we begun to
     308;; rewrite large portions of Comint to adapt it to our needs.  At some
     309;; point it came clear that it would be best to throw out Comint
     310;; alltogether, would not have been there some auxilliary functions which
     311;; are really useful but annoying to rewrite.  These are, for example, the
     312;; command line history functions or the completion stuff offered by
     313;; Comint.
     314;;
     315;; Our policy with regard to these remainders of Comint is: Use the
     316;; functions to bind them to keys, but do not use them internally.
     317;; Encapsulate Comint customization into Singular interactive mode
     318;; customization.  In particular, do not take care about Comint settings
     319;; which already may be present, overwrite them.  Hide Comint from the
     320;; user.
     321;;
     322;; Here is how exactly we use Comint:
     323;;
     324;; - All variables necessary to use Comint's input ring are properly
     325;;   initialized.  One may find this in the `History' folding.
     326;; - `comint-prompt-regexp' is initialized since it is used in some
     327;;   of the functions regarding input ring handling.  Furthermore, its
     328;;   initialization enables us to use functions as `comint-bol', etc.
     329;;   Initialization is done in the `Skipping and stripping prompts ...'
     330;;   folding.
     331;; - We call `comint-mode' as first step in `singular-interactive-mode'.
     332;;   Most of the work done there is to initialize the local variables as
     333;;   necessary.  Besides that, the function does nothing that interferes
     334;;   with Singular interactive mode.  To be consequent we set
     335;;   `comint-mode-hook' temporarily to nil when calling `comint-mode'.
     336;; - In `singular-exec', we use `comint-exec-1' to fire up the process.
     337;;   Furthermore, we set `comint-ptyp' there as it is used in the signal
     338;;   sending commands of Comint.  All that `comint-exec-1' does is that it
     339;;   sets up the process environment (it adds or modifies the setting of
     340;;   the 'TERM' variable), sets the execution directory, and does some
     341;;   magic with the process coding stuff.
     342;; - One more time the most important point: we do *not* use Comint's
     343;;   output and input processing.  In particular, we do not run any of
     344;;   Comint's hooks on input or output.  Anyway, we do better, don't we?
     345
     346(require 'comint)
     347;;}}}
     348
     349;;{{{ Font-locking
     350(defvar singular-font-lock-error-face 'singular-font-lock-error-face
     351  "Face name to use for Singular errors.")
     352
     353(defvar singular-font-lock-warning-face 'singular-font-lock-warning-face
     354  "Face name to use for Singular warnings.")
     355
     356(defvar singular-font-lock-prompt-face 'singular-font-lock-prompt-face
     357  "Face name to use for Singular prompts.")
     358
     359(defface singular-font-lock-error-face
     360  '((((class color)) (:foreground "Red" :bold t))
     361    (t (:inverse-video t :bold t)))
     362  "*Font Lock mode face used to highlight Singular errors."
     363  :group 'singular-faces)
     364
     365(defface singular-font-lock-warning-face
     366  '((((class color)) (:foreground "OrangeRed" :bold nil))
     367    (t (:inverse-video t :bold t)))
     368  "*Font Lock mode face used to highlight Singular warnings."
     369  :group 'singular-faces)
     370
     371(defface singular-font-lock-prompt-face
     372  '((((class color) (background light)) (:foreground "Blue" :bold t))
     373    (((class color) (background dark)) (:foreground "LightSkyBlue" :bold t))
     374    (t (:inverse-video t :bold t)))
     375  "*Font Lock mode face used to highlight Singular prompts."
     376  :group 'singular-faces)
     377
     378(defconst singular-font-lock-singular-types nil
     379  "List of Singular types.")
     380
     381(eval-when-compile
     382  (setq singular-font-lock-singular-types
     383        '("def" "ideal" "int" "intmat" "intvec" "link" "list" "map" "matrix"
     384          "module" "number" "poly" "proc" "qring" "resolution" "ring" "string"
     385          "vector")))
     386
     387(defconst singular-interactive-font-lock-keywords-1
     388  '(
     389    ("^\\([>.]\\) " 1 singular-font-lock-prompt-face t)
     390    ("^   [\\?].*" 0 singular-font-lock-error-face t)
     391    ("^// \\*\\*.*" 0 singular-font-lock-warning-face t)
     392    )
     393  "Subdued level highlighting for Singular interactive mode")
     394
     395(defconst singular-interactive-font-lock-keywords-2
     396  (append
     397   singular-interactive-font-lock-keywords-1
     398   (eval-when-compile
     399     (list
     400      (cons
     401       (concat "\\<" (regexp-opt singular-font-lock-singular-types t) "\\>")
     402       'font-lock-type-face))))
     403  "Medium level highlighting for Singular interactive mode")
     404
     405(defconst singular-interactive-font-lock-keywords-3
     406  (append
     407   singular-interactive-font-lock-keywords-2
     408   '(
     409     ("^   [\\?].*`\\(\\sw\\sw+\\)`" 1 font-lock-reference-name-face t)
     410     ))
     411  "Gaudy level highlighting for Singular interactive mode.")
     412
     413(defconst singular-interactive-font-lock-keywords singular-interactive-font-lock-keywords-1
     414  "Default highlighting for Singular interactive mode.")
     415
     416(defconst singular-interactive-font-lock-defaults
     417  '((singular-interactive-font-lock-keywords
     418     singular-interactive-font-lock-keywords-1
     419     singular-interactive-font-lock-keywords-2
     420     singular-interactive-font-lock-keywords-3)
     421    ;; KEYWORDS-ONLY (do not fontify strings & comments if non-nil)
     422    nil
     423    ;; CASE-FOLD (ignore case if non-nil)
     424    nil
     425    ;; SYNTAX-ALIST (add this to Font Lock's syntax table)
     426    ((?_ . "w"))
     427    ;; SYNTAX-BEGIN
     428    singular-section-goto-beginning)
     429  "Default expressions to highlight in Singular interactive mode.")
     430
     431(defun singular-interactive-font-lock-init ()
     432  "Initialize Font Lock mode for Singular interactive mode.
     433
     434For XEmacs, this function is called exactly once when singular.el is
     435loaded.
     436For Emacs, this function is called  at mode initialization time."
     437  (cond
     438   ;; Emacs
     439   ((eq singular-emacs-flavor 'emacs)
     440    (singular-debug 'interactive (message "Setting up Font Lock mode for Emacs"))
     441    (set (make-local-variable 'font-lock-defaults)
     442         singular-interactive-font-lock-defaults))
     443   ;; XEmacs
     444   ((eq singular-emacs-flavor 'xemacs)
     445    (singular-debug 'interactive (message "Setting up Font Lock mode for XEmacs"))
     446    (put 'singular-interactive-mode
     447         'font-lock-defaults singular-interactive-font-lock-defaults))))
     448
     449;; XEmacs Font Lock mode initialization
    192450(cond
    193451 ;; XEmacs
    194452 ((eq singular-emacs-flavor 'xemacs)
    195   ;; That 'append avoids to overwrite the face if it is already set
    196   (set-face-foreground 'font-lock-singular-warn-face "Orange"
    197                        'global nil 'append)))
    198 
    199 (make-face 'font-lock-singular-prompt-face)
    200 
    201 (defvar font-lock-singular-warn-face 'font-lock-singular-prompt-face
    202   "Addition font-lock face for the singular prompt.")
    203 
    204 (cond
    205  ;; XEmacs
    206  ((eq singular-emacs-flavor 'xemacs)
    207   ;; That 'append avoids to overwrite the face if it is already set
    208   (set-face-foreground 'font-lock-singular-prompt-face "Gray50"
    209                        'global nil 'append)))
    210 ;;}}}
    211 
    212 ;;{{{ Font-locking
    213 ;(make-regexp '("def" "ideal" "int"  "intmat" "intvec" 
    214 ;              "link" "list" "map" "matrix" "module"
    215 ;              "number" "poly" "proc" "qring" "resolution"
    216 ;              "ring" "string" "vector"))
    217 
    218 (defvar singular-font-lock-keywords-1
    219   '(
    220     ("^\\(> \\|\\. \\)" . font-lock-singular-prompt-face)
    221     ("^   [\\?].*" 0 font-lock-singular-error-face t)
    222     ("^// \\(\\*\\*.*\\)" 1 font-lock-singular-warn-face t)
    223     )
    224   "Subdued level for highlighting in singular-(interactive)-mode")
    225 
    226 (defvar singular-font-lock-keywords-2
    227   (append
    228    singular-font-lock-keywords-1
    229    '(
    230      ("\\<\\(def\\|i\\(deal\\|nt\\(\\|mat\\|vec\\)\\)\\|li\\(nk\\|st\\)\\|m\\(a\\(p\\|trix\\)\\|odule\\)\\|number\\|p\\(oly\\|roc\\)\\|qring\\|r\\(esolution\\|ing\\)\\|string\\|vector\\)\\>" . font-lock-type-face)
    231      ))
    232   "Medium level for highlighting in singular-(interactive)-mode")
    233 
    234 (defvar singular-font-lock-keywords-3
    235   (append
    236    singular-font-lock-keywords-2
    237    '(
    238      ("^   [\\?].*`\\(\\sw\\sw+\\)`" 1 font-lock-reference-name-face t)
    239 ;;     ()))
    240      ))
    241   "Gaudy level for highlihgting in singular-(interactive)-mode")
    242 
    243 (defvar singular-font-lock-keywords singular-font-lock-keywords-1
    244   "Default highlighting for singular-(interactive)-mode")
    245 
    246 (defvar singular-font-lock-defaults
    247   '((singular-font-lock-keywords
    248      singular-font-lock-keywords-1 singular-font-lock-keywords-2
    249      singular-font-lock-keywords-3)
    250     nil                   ;; KEYWORDS-ONLY
    251     nil                   ;; CASE-FOLD (ignore case when non-nil)
    252     ((?_ . "w"))          ;; SYNTAX-ALIST
    253     (beginning-of-line))  ;; SYNTAX_BEGIN
    254   "Emacs-default for font-lock-mode in singular-(interactive)-mode")
    255 
    256 (cond
    257  ;; XEmacs
    258  ((eq singular-emacs-flavor 'xemacs)
    259   (singular-debug 'interactive (message "setting up font-lock for XEmacs"))
    260   (put 'singular-interactive-mode 'font-lock-defaults
    261        singular-font-lock-defaults)))
    262 ;;}}}
    263 
    264 ;;}}}
    265 
    266 ;;{{{ Singular interactive mode
    267 
    268 ;;{{{ Key map and menus
    269 (defvar singular-interactive-mode-map ()
     453  (singular-interactive-font-lock-init)))
     454;;}}}
     455
     456;;{{{ Key map
     457(defvar singular-interactive-mode-map nil
    270458  "Key map to use in Singular interactive mode.")
    271459
    272460(if singular-interactive-mode-map
    273461    ()
     462  ;; create empty keymap first
    274463  (cond
    275464   ;; Emacs
    276465   ((eq singular-emacs-flavor 'emacs)
    277     (setq singular-interactive-mode-map
    278           (nconc (make-sparse-keymap) comint-mode-map)))
     466    (setq singular-interactive-mode-map (make-sparse-keymap)))
    279467   ;; XEmacs
    280468   (t
    281469    (setq singular-interactive-mode-map (make-keymap))
    282     (set-keymap-parents singular-interactive-mode-map (list comint-mode-map))
    283470    (set-keymap-name singular-interactive-mode-map
    284471                     'singular-interactive-mode-map)))
    285   (define-key singular-interactive-mode-map "\C-m" 'singular-send-or-copy-input)
    286   (define-key singular-interactive-mode-map "\t" 'singular-dynamic-complete)
    287   (define-key singular-interactive-mode-map "\C-c\C-f" 'singular-load-file)
    288   (define-key singular-interactive-mode-map "\C-c\C-l" 'singular-load-library)
    289   (define-key singular-interactive-mode-map "\C-c\C-d" 'singular-demo-load)
    290   (define-key singular-interactive-mode-map "\C-c\C-c\C-d" 'singular-demo-exit)
    291   (define-key singular-interactive-mode-map "\C-c\C-t" 'singular-toggle-truncate-lines)
    292   (define-key singular-interactive-mode-map "\C-c$" 'singular-exit-singular)
    293   (define-key singular-interactive-mode-map "\C-cfl" 'singular-fold-last-output)
    294   (define-key singular-interactive-mode-map "\C-cfa" 'singular-fold-all-output)
    295   (define-key singular-interactive-mode-map "\C-cfp" 'singular-fold-at-point)
    296   (define-key singular-interactive-mode-map "\C-cul" 'singular-unfold-last-output)
    297   (define-key singular-interactive-mode-map "\C-cua" 'singular-unfold-all-output)
    298   (define-key singular-interactive-mode-map "\C-cup" 'singular-unfold-at-point))
    299 
     472
     473  ;; define keys
     474  (define-key singular-interactive-mode-map [?\C-m]     'singular-send-or-copy-input)
     475  (define-key singular-interactive-mode-map [?\M-r]     'comint-previous-matching-input)
     476  (define-key singular-interactive-mode-map [?\M-s]     'comint-next-matching-input)
     477
     478  ;; C-c prefix
     479  (define-key singular-interactive-mode-map [?\C-c ?\C-f] 'singular-folding-toggle-fold-at-point-or-all)
     480  (define-key singular-interactive-mode-map [?\C-c ?\C-o] 'singular-folding-toggle-fold-latest-output)
     481  (define-key singular-interactive-mode-map [?\C-c ?\C-l] 'singular-recenter))
     482
     483(defcustom singular-history-keys '(meta)
     484  "Keys to use for history access.
     485Should be a list describing which keys or key combinations to use for
     486history access in Singular interactive mode.  Valid entries are `control',
     487`cursor', and `meta'.
     488
     489For more information one should refer to the documentation of
     490`singular-history-keys'.
     491
     492Changing this variable has an immediate effect only if one uses
     493\\[customize] to do so."
     494  :type '(set (const :tag "Cursor keys" cursor)
     495              (const :tag "C-p, C-n" control)
     496              (const :tag "M-p, M-n" meta))
     497  :initialize 'custom-initialize-default
     498  :set (function
     499        (lambda (var value)
     500          (singular-history-cursor-keys-set value singular-cursor-keys)
     501          (set-default var value)))
     502  :group 'singular-interactive-miscellaneous)
     503
     504(defcustom singular-cursor-keys '(control cursor)
     505  "Keys to use for cursor movement.
     506Should be a list describing which keys or key combinations to use for
     507cursor movement in Singular interactive mode.  Valid entries are `control',
     508`cursor', and `meta'.
     509
     510An experienced Emacs user would prefer setting `singular-cursor-keys' to
     511`(control cursor)' and `singular-history-keys' to `(meta)'.  This means
     512that C-p, C-n, and the cursor keys move the cursor, whereas M-p and M-n
     513scroll through the history of Singular commands.
     514
     515On the other hand, an user used to running Singular in a, say, xterm, would
     516prefer the other way round: Setting the variable `singular-history-keys' to
     517`(control cursor)' and `singular-cursor-keys' to `(meta)'.
     518
     519Keys which are not mentioned in both lists are not modified from their
     520standard settings.  Naturally, the lists `singular-cursor-keys' and
     521`singular-history-keys' should be disjunct.
     522
     523Changing this variable has an immediate effect only if one uses
     524\\[customize] to do so."
     525  :type '(set (const :tag "Cursor keys" cursor)
     526              (const :tag "C-p, C-n" control)
     527              (const :tag "M-p, M-n" meta))
     528  :initialize 'custom-initialize-default
     529  :set (function
     530        (lambda (var value)
     531          (singular-history-cursor-keys-set singular-history-keys value)
     532          (set-default var value)))
     533  :group 'singular-interactive-miscellaneous)
     534
     535(defun singular-history-cursor-key-set (key function-spec)
     536  "Set keys corresponding to KEY and according to FUNCTION-SPEC.
     537FUNCTION-SPEC should be a cons cell of the format (PREV-FUNC . NEXT-FUNC)."
     538  (cond
     539   ((eq key 'control)
     540    (define-key singular-interactive-mode-map [?\C-p]   (car function-spec))
     541    (define-key singular-interactive-mode-map [?\C-n]   (cdr function-spec)))
     542   ((eq key 'meta)
     543    (define-key singular-interactive-mode-map [?\M-p]   (car function-spec))
     544    (define-key singular-interactive-mode-map [?\M-n]   (cdr function-spec)))
     545   ((eq key 'cursor)
     546    (define-key singular-interactive-mode-map [up]      (car function-spec))
     547    (define-key singular-interactive-mode-map [down]    (cdr function-spec)))))
     548
     549(defun singular-history-cursor-keys-set (history-keys cursor-keys)
     550  "Set the keys according to HISTORY-KEYS and CURSOR-KEYS.
     551Checks whether HISTORY-KEYS and CURSOR-KEYS are disjunct.  Throws an error
     552if not."
     553  ;; do the check first
     554  (if (memq nil (mapcar (function (lambda (elt) (not (memq elt history-keys))))
     555                        cursor-keys))
     556      (error "History keys and cursor keys are not disjunct (see `singular-cursor-keys')"))
     557
     558  ;; remove old bindings first
     559  (singular-history-cursor-key-set 'cursor '(nil . nil))
     560  (singular-history-cursor-key-set 'control '(nil . nil))
     561  (singular-history-cursor-key-set 'meta '(nil . nil))
     562
     563  ;; set new bindings
     564  (mapcar (function
     565           (lambda (key)
     566             (singular-history-cursor-key-set key '(comint-previous-input . comint-next-input))))
     567          history-keys)
     568  (mapcar (function
     569           (lambda (key)
     570             (singular-history-cursor-key-set key '(previous-line . next-line))))
     571          cursor-keys))
     572
     573;; static initialization.  Deferred to this point since at the time where
     574;; the defcustoms are defined not all necessary functions and variables are
     575;; available.
     576(singular-history-cursor-keys-set singular-history-keys singular-cursor-keys)
     577
     578(defun singular-interactive-mode-map-init ()
     579  "Initialize key map for Singular interactive mode.
     580
     581This function is called  at mode initialization time."
     582  (use-local-map singular-interactive-mode-map))
     583;;}}}
     584
     585;;{{{ Menus and logos
    300586(defvar singular-interactive-mode-menu-1 nil
    301587  "NOT READY [docu]")
     
    383669      (add-submenu nil
    384670                   singular-start-menu-definition))))
    385 ;;}}}
    386 
    387 ;;{{{ Syntax table
    388 (defvar singular-interactive-mode-syntax-table nil
    389   "Syntax table for singular-interactive-mode")
    390 
    391 (if singular-interactive-mode-syntax-table
    392     ()
    393   (setq singular-interactive-mode-syntax-table (make-syntax-table))
    394   ;; rest taken from cc-mode.el
    395   (modify-syntax-entry ?_  "_"     singular-interactive-mode-syntax-table)
    396   (modify-syntax-entry ?\\ "\\"    singular-interactive-mode-syntax-table)
    397   (modify-syntax-entry ?+  "."     singular-interactive-mode-syntax-table)
    398   (modify-syntax-entry ?-  "."     singular-interactive-mode-syntax-table)
    399   (modify-syntax-entry ?=  "."     singular-interactive-mode-syntax-table)
    400   (modify-syntax-entry ?%  "."     singular-interactive-mode-syntax-table)
    401   (modify-syntax-entry ?<  "."     singular-interactive-mode-syntax-table)
    402   (modify-syntax-entry ?>  "."     singular-interactive-mode-syntax-table)
    403   (modify-syntax-entry ?&  "."     singular-interactive-mode-syntax-table)
    404   (modify-syntax-entry ?|  "."     singular-interactive-mode-syntax-table)
    405   (modify-syntax-entry ?\' "\""    singular-interactive-mode-syntax-table)
     671
     672  ;; remove existing singular-start-menu from menu (XEmacs)
     673  ;, NOT READY
     674  ;; This is mayby just temporary
     675;  (cond
     676;   ;; XEmacs
     677;   ((eq singular-emacs-flavor 'xemacs)
     678;    (delete-menu-item '("Singular"))))
     679
     680            ;; NOT READY: SINGULAR-LOGO
     681;           (cond
     682;            ((eq singular-emacs-flavor 'xemacs)
     683;             (set-extent-begin-glyph (make-extent (point-min) (point-min))
     684;                                     singular-logo)
     685;             (insert "\n")))
     686
     687;; NOT READY: SINGULAR-LOGO
     688;(cond
     689; ((eq singular-emacs-flavor 'xemacs)
     690;  (defvar singular-logo (make-glyph))
     691;  (set-glyph-image singular-logo
     692;                  (concat "~/" "singlogo.xpm")
     693;                  'global 'x)))
     694
     695(defun singular-interactive-mode-menu-init ()
     696  "Initialize menus for Singular interactive mode.
     697
     698This function is called  at mode initialization time."
    406699  (cond
    407    ;; Emacs
    408    ((eq singular-emacs-flavor 'emacs)
    409     (modify-syntax-entry ?/  ". 124b" singular-interactive-mode-syntax-table))
    410700   ;; XEmacs
    411    (t
    412     (modify-syntax-entry ?/  ". 1456" singular-interactive-mode-syntax-table)))
    413   (modify-syntax-entry ?*  ". 23"   singular-interactive-mode-syntax-table)
    414   (modify-syntax-entry ?\n "> b"    singular-interactive-mode-syntax-table)
    415   (modify-syntax-entry ?\^m "> b"    singular-interactive-mode-syntax-table))
    416 
    417 ;;}}}
    418 
    419 ;;{{{ Miscellaneous
    420 
    421 ;; Note:
    422 ;;
    423 ;; We assume a one-to-one correspondance between Singular buffers
    424 ;; and Singular processes.  We always have
    425 ;; (equal buffer-name (concat "*" process-name "*")).
    426 
    427 (defun singular-buffer-name-to-process-name (buffer-name)
    428   "Create the process name for BUFFER-NAME.
    429 The process name is the buffer name with surrounding `*' stripped
    430 off."
    431   (substring buffer-name 1 -1))
    432 
    433 (defun singular-process-name-to-buffer-name (process-name)
    434   "Create the buffer name for PROCESS-NAME.
    435 The buffer name is the process name with surrounding `*'."
    436   (concat "*" process-name "*"))
    437 
    438 (defun singular-run-hook-with-arg-and-value (hook value)
    439   "Call functions on HOOK.
    440 Provides argument VALUE.  If a function returns a non-nil value it
    441 replaces VALUE as new argument to the functions.  Returns final
    442 VALUE."
    443   (let (result)
    444     (while hook
    445       (setq result (funcall (car hook) value))
    446       (and result (setq value result))
    447       (setq hook (cdr hook)))
    448     value))
    449 
    450 (defmacro singular-process ()
    451   "Return process of current buffer."
    452   (get-buffer-process (current-buffer)))
    453 
    454 (defmacro singular-process-mark ()
    455   "Return process mark of current buffer."
    456   (process-mark (get-buffer-process (current-buffer))))
    457 
    458 (defun singular-load-file (file &optional noexpand)
    459   "Read a file in Singular (via '< \"FILE\";').
    460 If optional argument NOEXPAND is nil, FILE is expanded using
    461 `expand-file-name'."
    462   (interactive "fLoad file: ")
    463   (let* ((filename (if noexpand file (expand-file-name file)))
    464          (string (concat "< \"" filename "\";"))
    465          (process (singular-process)))
    466     (singular-input-filter process string)
    467     (singular-send-string process string)))
    468 
    469 (defun singular-load-library (file &optional noexpand)
    470   "Read a Singular library (via 'LIB \"FILE\";').
    471 If optional argument NOEXPAND is nil, FILE is expanded using
    472 `expand-file-name'."
    473   (interactive "fLoad Library: ")
    474   (let* ((filename (if noexpand file (expand-file-name file)))
    475          (string (concat "LIB \"" filename "\";"))
    476          (process (singular-process)))
    477     (singular-input-filter process string)
    478     (singular-send-string process string)))
    479 
    480 (defun singular-exit-singular ()
    481   "Exit Singular and kill Singular buffer.
    482 Sends string \"quit;\" to Singular process."
    483   (interactive)
    484   (let ((string "quit;")
    485         (process (singular-process)))
    486     (singular-input-filter process string)
    487     (singular-send-string process string))
    488   (kill-buffer (current-buffer)))
    489 
    490 ;; The function `singular-toggle-truncate-lines' is obsolete in XEmacs
    491 ;; but not in Emacs. So define it anyway.
    492 (defun singular-toggle-truncate-lines ()
    493   "Toggle truncate-lines."
    494   (interactive)
    495   (setq truncate-lines (not truncate-lines))
    496   (recenter))
    497 ;;}}}
    498 
    499 ;;{{{ Customizing variables of comint
    500 
    501 ;; Note:
    502 ;;
    503 ;; In contrast to the variables from comint.el, all the variables
    504 ;; below are global variables.  It would not make any sense to make
    505 ;; them buffer-local since
    506 ;; o they are read only when Singular interactive mode comes up;
    507 ;; o since they are Singular-dependent and not user-dependent, i.e.,
    508 ;;   the user would not mind to change them.
    509 ;;
    510 ;; For the same reasons these variables are not marked as
    511 ;; "customizable" by a leading `*'.
    512 
    513 (defvar singular-prompt-regexp "^> "
    514   "Regexp to match prompt patterns in Singular.
    515 Should not match the continuation prompt \(`.'), only the regular
    516 prompt \(`>').
    517 
    518 This variable is used to initialize `comint-prompt-regexp' when
    519 Singular interactive mode starts up.")
    520 
    521 (defvar singular-delimiter-argument-list '(?= ?\( ?\) ?, ?;)
    522   "List of characters to recognize as separate arguments.
    523 
    524 This variable is used to initialize `comint-delimiter-argument-list'
    525 when Singular interactive mode starts up.")
    526 
    527 (defvar singular-input-ignoredups t
    528   "If non-nil, don't add input matching the last on the input ring.
    529 
    530 This variable is used to initialize `comint-input-ignoredups' when
    531 Singular interactive mode starts up.")
    532 
    533 (defvar singular-buffer-maximum-size 2048
    534   "The maximum size in lines for Singular buffers.
    535 
    536 This variable is used to initialize `comint-buffer-maximum-size' when
    537 Singular interactive mode starts up.")
    538 
    539 (defvar singular-input-ring-size 64
    540   "Size of input history ring.
    541 
    542 This variable is used to initialize `comint-input-ring-size' when
    543 Singular interactive mode starts up.")
    544 
    545 (defvar singular-history-filter-regexp "\\`\\(..?\\|\\s *\\)\\'"
    546   "Regular expression to filter strings *not* to insert in the history.
    547 By default, input consisting of less than three characters and input
    548 consisting of white-space only is not added to the history.")
    549 
    550 (defvar singular-history-filter
    551   (function (lambda (string)
    552               (not (string-match singular-history-filter-regexp string))))
    553   "Predicate for filtering additions to input history.
    554 
    555 This variable is used to initialize `comint-input-filter' when
    556 Singular interactive mode starts up.")
    557 
    558 (defvar singular-completion-addsuffix '("/" . "")
    559   "*Specifies suffixes to be added on completed file names and directories.
    560 If a cons pair, it should be of the form (DIRSUFFIX . FILESUFFIX) where
    561 DIRSUFFIX and FILESUFFIX are strings added on unambiguous or exact completion.
    562 If non-nil, add a `/' to completed directories, ` ' to file names.
    563 This mirrors the optional behavior of tcsh.
    564 
    565 This variable is used to initialize `comint-completion-addsuffix' when
    566 Singular interactive mode starts up.")
     701   ((eq singular-emacs-flavor 'xemacs)
     702    (easy-menu-add singular-interactive-mode-menu-1)
     703    (easy-menu-add singular-interactive-mode-menu-2))))
    567704;;}}}
    568705
     
    632769  "Matches an arbitary sequence of Singular prompts.")
    633770
    634 (defun singular-skip-prompt-forward ()
     771(defun singular-prompt-skip-forward ()
    635772  "Skip forward over prompts."
    636773  (looking-at singular-skip-prompt-forward-regexp)
     
    640777  "Skip backward over prompts."
    641778  (while (re-search-backward singular-extended-prompt-regexp (- (point) 2) t)))
    642 ;;}}}
    643 
    644 ;;{{{ Simple section stuff for both Emacs and XEmacs
     779
     780(defun singular-remove-prompt-filter (beg end simple-sec-start)
     781  "Strip prompts from last simple section."
     782  (if simple-sec-start (singular-remove-prompt simple-sec-start end)))
     783
     784(defvar singular-prompt-regexp "^> "
     785  "Regexp to match prompt patterns in Singular.
     786Should not match the continuation prompt \(`.'), only the regular
     787prompt \(`>').
     788
     789This variable is used to initialize `comint-prompt-regexp' when
     790Singular interactive mode starts up.")
     791;;}}}
     792
     793;;{{{ Miscellaneous
     794
     795;; Note:
     796;;
     797;; We assume a one-to-one correspondence between Singular buffers and
     798;; Singular processes.  We always have (equal buffer-name (concat "*"
     799;; process-name "*")).
     800
     801(defsubst singular-buffer-name-to-process-name (buffer-name)
     802  "Create the process name for BUFFER-NAME.
     803The process name is the buffer name with surrounding `*' stripped off."
     804  (substring buffer-name 1 -1))
     805
     806(defsubst singular-process-name-to-buffer-name (process-name)
     807  "Create the buffer name for PROCESS-NAME.
     808The buffer name is the process name with surrounding `*'."
     809  (concat "*" process-name "*"))
     810
     811(defsubst singular-run-hook-with-arg-and-value (hook value)
     812  "Call functions on HOOK.
     813Provides argument VALUE to the functions.  If a function returns a non-nil
     814value it replaces VALUE as new argument to the remaining functions.
     815Returns final VALUE."
     816  (while hook
     817    (setq value (or (funcall (car hook) value) value)
     818          hook (cdr hook)))
     819  value)
     820
     821(defsubst singular-process (&optional no-error)
     822  "Return process of current buffer.
     823If no process is active this function silently returns nil if optional
     824argument NO-ERROR is non-nil, otherwise it throws an error."
     825  (cond ((get-buffer-process (current-buffer)))
     826        (no-error nil)
     827        (t (error "No Singular running in this buffer"))))
     828
     829(defsubst singular-process-mark (&optional no-error)
     830  "Return process mark of current buffer.
     831If no process is active this function silently returns nil if optional
     832argument NO-ERROR is non-nil, otherwise it throws an error."
     833  (let ((process (singular-process no-error)))
     834    (and process
     835         (process-mark process))))
     836
     837(defun singular-time-stamp-difference (new-time-stamp old-time-stamp)
     838  "Return the number of seconds between NEW-TIME-STAMP and OLD-TIME-STAMP.
     839Both NEW-TIME-STAMP and OLD-TIME-STAMP should be in the format
     840that is returned, for example, by `current-time'.
     841Does not return a difference larger than 2^17 seconds."
     842  (let ((high-difference (min 1 (- (car new-time-stamp) (car old-time-stamp))))
     843        (low-difference (- (cadr new-time-stamp) (cadr old-time-stamp))))
     844    (+ (* high-difference 131072) low-difference)))
     845;;}}}
     846
     847;;{{{ Miscellaneous interactive
     848(defun singular-recenter (&optional arg)
     849  "Center point in window and redisplay frame.  With ARG, put point on line ARG.
     850The desired position of point is always relative to the current window.
     851Just C-u as prefix means put point in the center of the window.
     852If ARG is omitted or nil, erases the entire frame and then redraws with
     853point in the center of the current window.
     854Scrolls window to the left margin and moves point to beginning of line."
     855  (interactive "P")
     856  (singular-reposition-point-and-window)
     857  (recenter arg))
     858
     859(defun singular-reposition-point-and-window ()
     860  "Scroll window to the left margin and move point to beginning of line."
     861  (interactive)
     862  (set-window-hscroll (selected-window) 0)
     863  (move-to-column 0)
     864  ;; be careful where to place point
     865  (singular-prompt-skip-forward))
     866
     867(defun singular-toggle-truncate-lines ()
     868  "Toggle `truncate-lines'.
     869A non-nil value of `truncate-lines' means do not display continuation
     870lines\; give each line of text one screen line.
     871Repositions window and point after toggling `truncate-lines'."
     872  (interactive)
     873  (setq truncate-lines (not truncate-lines))
     874  ;; reposition so that user does not get confused
     875  (singular-reposition-point-and-window))
     876
     877;; this is not a buffer-local variable even if at first glance it seems
     878;; that it should be one.  But if one changes buffer the contents of this
     879;; variable becomes irrelevant since the last command is no longer a
     880;; horizontal scroll command.  The same is true for the initial value, so
     881;; we set it to nil.
     882(defvar singular-scroll-previous-amount nil
     883  "Amount of previous horizontal scroll command.")
     884
     885(defun singular-scroll-right (&optional scroll-amount)
     886  "Scroll selected window SCROLL-AMOUNT columns right.
     887SCROLL-AMOUNT defaults to amount of previous horizontal scroll command.  If
     888the command immediately preceding this command has not been a horizontal
     889scroll command SCROLL-AMOUNT defaults to window width minus 2.
     890Moves point to leftmost visible column."
     891  (interactive "P")
     892
     893  ;; get amount to scroll
     894  (setq singular-scroll-previous-amount
     895        (cond (scroll-amount (prefix-numeric-value scroll-amount))
     896              ((eq last-command 'singular-scroll-horizontal)
     897               singular-scroll-previous-amount)
     898              (t (- (frame-width) 2)))
     899        this-command 'singular-scroll-horizontal)
     900
     901  ;; scroll
     902  (scroll-right singular-scroll-previous-amount)
     903  (move-to-column (window-hscroll))
     904  ;; be careful where to place point.  But what if `(current-column)'
     905  ;; equals, say, one?  Well, we simply do not care about that case.
     906  ;; Should not happen to often.
     907  (if (eq (current-column) 0)
     908      (singular-prompt-skip-forward)))
     909
     910(defun singular-scroll-left (&optional scroll-amount)
     911  "Scroll selected window SCROLL-AMOUNT columns left.
     912SCROLL-AMOUNT defaults to amount of previous horizontal scroll command.  If
     913the command immediately preceding this command has not been a horizontal
     914scroll command SCROLL-AMOUNT defaults to window width minus 2.
     915Moves point to leftmost visible column."
     916  (interactive "P")
     917
     918  ;; get amount to scroll
     919  (setq singular-scroll-previous-amount
     920        (cond (scroll-amount (prefix-numeric-value scroll-amount))
     921              ((eq last-command 'singular-scroll-horizontal)
     922               singular-scroll-previous-amount)
     923              (t (- (frame-width) 2)))
     924        this-command 'singular-scroll-horizontal)
     925
     926  ;; scroll
     927  (scroll-left singular-scroll-previous-amount)
     928  (move-to-column (window-hscroll))
     929  ;; be careful where to place point.  But what if `(current-column)'
     930  ;; equals, say, one?  Well, we simply do not care about that case.
     931  ;; Should not happen to often.
     932  (if (eq (current-column) 0)
     933      (singular-prompt-skip-forward)))
     934
     935(defun singular-load-file (file &optional noexpand)
     936  "Read a file into Singular (via '< \"FILE\";').
     937If optional argument NOEXPAND is non-nil, FILE is left as it is entered by
     938the user, otherwise it is expanded using `expand-file-name'."
     939  (interactive "fLoad file: ")
     940  (let* ((filename (if noexpand file (expand-file-name file)))
     941         (string (concat "< \"" filename "\";"))
     942         (process (singular-process)))
     943    (singular-input-filter process string)
     944    (singular-send-string process string)))
     945
     946(defun singular-load-library (file &optional noexpand)
     947  "Read a Singular library (via 'LIB \"FILE\";').
     948If optional argument NOEXPAND is non-nil, FILE is left as it is entered by
     949the user, otherwise it is expanded using `expand-file-name'."
     950  (interactive "fLoad Library: ")
     951  (let* ((filename (if noexpand file (expand-file-name file)))
     952         (string (concat "LIB \"" filename "\";"))
     953         (process (singular-process)))
     954    (singular-input-filter process string)
     955    (singular-send-string process string)))
     956
     957(defun singular-exit-singular ()
     958  "Exit Singular and kill Singular buffer.
     959Sends string \"quit;\" to Singular process."
     960  (interactive)
     961  (let ((string "quit;")
     962        (process (singular-process)))
     963    (singular-input-filter process string)
     964    (singular-send-string process string))
     965  (kill-buffer (current-buffer)))
     966;;}}}
     967
     968;;{{{ History
     969(defcustom singular-history-ignoredups t
     970  "If non-nil, do not add input matching the last on the input history."
     971  :type 'boolean
     972  :initialize 'custom-initialize-default
     973  :group 'singular-interactive-miscellaneous)
     974
     975;; this variable is used to set Comint's `comint-input-ring-size'
     976(defcustom singular-history-size 64
     977  "Size of the input history.
     978
     979Changing this variable has no immediate effect even if one uses
     980\\[customize] to do so.  The new value will be used only in new Singular
     981interactive mode buffers."
     982  :type 'integer
     983  :initialize 'custom-initialize-default
     984  :group 'singular-interactive-miscellaneous)
     985
     986(defcustom singular-history-filter-regexp "\\`\\(..?\\|\\s *\\)\\'"
     987  "Regular expression to filter strings *not* to insert in the input history.
     988By default, input consisting of less than three characters and input
     989consisting of white-space only is not inserted into the input history."
     990  :type 'regexp
     991  :initialize 'custom-initialize-default
     992  :group 'singular-interactive-miscellaneous)
     993
     994(defcustom singular-history-explicit-file-name nil
     995  "If non-nil, use this as file name to load and save the input history.
     996If this variable equals nil, the `SINGULARHIST' environment variable is
     997used to determine the file name.
     998One should note that the input history is saved to file only on regular
     999termination of Singular; that is, if one leaves Singular using the commands
     1000`quit\;' or `exit\;'."
     1001  :type '(choice (const nil) file)
     1002  :initialize 'custom-initialize-default
     1003  :group 'singular-interactive-miscellaneous)
     1004
     1005(defun singular-history-read ()
     1006  "Read the input history from file.
     1007If `singular-history-explicit-file-name' is non-nil, uses that as file
     1008name, otherwise tries environment variable `SINGULARHIST'.
     1009This function is called from `singular-exec' every time a new Singular
     1010process is started."
     1011  (singular-debug 'interactive (message "Reading input ring"))
     1012  (let ((comint-input-ring-file-name (or singular-history-explicit-file-name
     1013                                         (getenv "SINGULARHIST"))))
     1014    ;; `comint-read-input-ring' does nothing if
     1015    ;; `comint-input-ring-file-name' equals nil
     1016    (comint-read-input-ring t)))
     1017
     1018(defun singular-history-write ()
     1019  "Write back the input history to file.
     1020If `singular-history-explicit-file-name' is non-nil, uses that as file
     1021name, otherwise tries environment variable `SINGULARHIST'.
     1022This function is called from `singular-exit-sentinel' every time a Singular
     1023process terminates regularly."
     1024  (singular-debug 'interactive (message "Writing input ring back"))
     1025  (let ((comint-input-ring-file-name (or singular-history-explicit-file-name
     1026                                         (getenv "SINGULARHIST"))))
     1027    ;; `comint-write-input-ring' does nothing if
     1028    ;; `comint-input-ring-file-name' equals nil
     1029    (comint-write-input-ring)))
     1030
     1031(defun singular-history-insert (input)
     1032  "Insert string INPUT into the input history if necessary."
     1033  (if (and (not (string-match singular-history-filter-regexp input))
     1034           (or singular-demo-insert-into-history
     1035               (not singular-demo-mode))
     1036           (or (not singular-history-ignoredups)
     1037               (not (ring-p comint-input-ring))
     1038               (ring-empty-p comint-input-ring)
     1039               (not (string-equal (ring-ref comint-input-ring 0) input))))
     1040      (ring-insert comint-input-ring input))
     1041  (setq comint-input-ring-index nil))
     1042
     1043(defun singular-history-init ()
     1044  "Initialize variables concerning the input history.
     1045
     1046This function is called at mode initialization time."
     1047  (setq comint-input-ring-size singular-history-size))
     1048;;}}}
     1049
     1050;;{{{ Simple section API for both Emacs and XEmacs
    6451051
    6461052;; Note:
     
    6521058;; In general, simple sections are more or less Emacs' overlays or XEmacs
    6531059;; extents, resp.  But they are more than simply an interface to overlays
    654 ;; or sections.
     1060;; or extents.
    6551061;;
    6561062;; - Simple sections are non-empty portions of text.  They are interpreted
     
    6771083;;   effect.
    6781084;; - After creation, simple sections are not modified any further.
     1085;; - There is one nasty little corner case: what if a non-clear simple
     1086;;   section spans up to end of buffer?  By definition, eob is not included
     1087;;   in that section since they are right-opened intervals.  Most of the
     1088;;   functions react as if there is an imagenary empty clear simple section
     1089;;   at eob.
     1090;; - Even though by now there are only two types of different simple
     1091;;   sections there may be an arbitrary number of them.  Furthermore,
     1092;;   simple sections of different types may appear in arbitrary order.
    6791093;;
    6801094;; - In `singular-interactive-mode', the whole buffer is covered with
     
    6871101(defvar singular-simple-sec-clear-type 'input
    6881102  "Type of clear simple sections.
    689 If nil no clear simple sections are used.")
     1103If nil no clear simple sections are used.
     1104
     1105One should not set this variable directly.  Rather, one should customize
     1106`singular-section-face-alist'.")
    6901107
    6911108(defvar singular-simple-sec-last-end nil
    6921109  "Marker at the end of the last simple section.
    6931110Should be initialized by `singular-simple-sec-init' before any calls to
    694 `singular-simple-sec-create' are done.
     1111`singular-simple-sec-create' are done.  Instead of accessing this variable
     1112directly one should use the macro `singular-simple-sec-last-end-position'.
    6951113
    6961114This variable is buffer-local.")
    6971115
    6981116(defun singular-simple-sec-init (pos)
    699   "Initialize global variables belonging to simple section management.
     1117  "Initialize variables belonging to simple section management.
    7001118Creates the buffer-local marker `singular-simple-sec-last-end' and
    701 initializes it to POS."
     1119initializes it to POS.  POS should be at beginning of a line.
     1120
     1121This function is called every time a new Singular session is started."
    7021122  (make-local-variable 'singular-simple-sec-last-end)
    7031123  (if (not (markerp singular-simple-sec-last-end))
    7041124      (setq singular-simple-sec-last-end (make-marker)))
    7051125  (set-marker singular-simple-sec-last-end pos))
     1126
     1127(defmacro singular-simple-sec-last-end-position ()
     1128  "Return the marker position of `singular-simple-sec-last-end'.
     1129This macro exists more or less for purposes of information hiding only."
     1130  '(marker-position singular-simple-sec-last-end))
     1131
     1132(defsubst singular-simple-sec-lookup-face (type)
     1133  "Return the face to use for simple sections of type TYPE.
     1134This accesses the `singular-section-type-alist'.  It does not harm if nil
     1135is associated with TYPE in that alist: In this case, this function will
     1136never be called for that TYPE."
     1137  (cdr (assq type singular-section-face-alist)))
    7061138
    7071139;; Note:
     
    7161148               'singular-xemacs-simple-sec-create)
    7171149
    718 (singular-fset 'singular-simple-sec-reset-last
    719                'singular-emacs-simple-sec-reset-last
    720                'singular-xemacs-simple-sec-reset-last)
     1150(singular-fset 'singular-simple-sec-at
     1151               'singular-emacs-simple-sec-at
     1152               'singular-xemacs-simple-sec-at)
    7211153
    7221154(singular-fset 'singular-simple-sec-start
     
    7281160               'singular-xemacs-simple-sec-end)
    7291161
     1162(singular-fset 'singular-simple-sec-type
     1163               'singular-emacs-simple-sec-type
     1164               'singular-xemacs-simple-sec-type)
     1165
     1166(singular-fset 'singular-simple-sec-before
     1167               'singular-emacs-simple-sec-before
     1168               'singular-xemacs-simple-sec-before)
     1169
    7301170(singular-fset 'singular-simple-sec-start-at
    7311171               'singular-emacs-simple-sec-start-at
     
    7361176               'singular-xemacs-simple-sec-end-at)
    7371177
    738 (singular-fset 'singular-simple-sec-type
    739                'singular-emacs-simple-sec-type
    740                'singular-xemacs-simple-sec-type)
    741 
    742 (singular-fset 'singular-simple-sec-at
    743                'singular-emacs-simple-sec-at
    744                'singular-xemacs-simple-sec-at)
    745 
    746 (singular-fset 'singular-simple-sec-before
    747                'singular-emacs-simple-sec-before
    748                'singular-xemacs-simple-sec-before)
    749 
    7501178(singular-fset 'singular-simple-sec-in
    7511179               'singular-emacs-simple-sec-in
     
    7531181;;}}}
    7541182
    755 ;;{{{ Simple section stuff for Emacs
     1183;;{{{ Simple section API for Emacs
     1184(defsubst singular-emacs-simple-sec-start (simple-sec)
     1185  "Return start of non-clear simple section SIMPLE-SEC.
     1186Narrowing has no effect on this function."
     1187  (overlay-start simple-sec))
     1188
     1189(defsubst singular-emacs-simple-sec-end (simple-sec)
     1190  "Return end of non-clear simple section SIMPLE-SEC.
     1191Narrowing has no effect on this function."
     1192  (overlay-end simple-sec))
     1193
     1194(defsubst singular-emacs-simple-sec-type (simple-sec)
     1195  "Return type of SIMPLE-SEC.
     1196Returns nil if SIMPLE-SEC happens to be an overlay but not a simple
     1197section.
     1198Narrowing has no effect on this function."
     1199  (if simple-sec
     1200      (overlay-get simple-sec 'singular-type)
     1201    singular-simple-sec-clear-type))
     1202
     1203(defsubst singular-emacs-simple-sec-before (pos)
     1204  "Return simple section before buffer position POS.
     1205This is the same as `singular-simple-sec-at' except if POS falls on a
     1206section border.  In this case `singular-simple-section-before' returns the
     1207previous simple section instead of the current one.  If POS falls on
     1208beginning of buffer, the simple section at beginning of buffer is returned.
     1209Narrowing has no effect on this function."
     1210  (singular-emacs-simple-sec-at (max 1 (1- pos))))
     1211
    7561212(defun singular-emacs-simple-sec-create (type end)
    7571213  "Create a new simple section of type TYPE.
    758 Creates the section from end of previous simple section up to END.
    759 END should be larger than `singular-simple-sec-last-end'.
    760 Returns the new simple section or `empty' if no simple section has
    761 been created.
    762 Assumes that no narrowing is in effect.
    763 Updates `singular-simple-sec-last-end'."
    764   (let ((last-end (marker-position singular-simple-sec-last-end))
     1214Creates the section from end of previous simple section up to the first
     1215beginning of line before END.  That position should be larger than or equal
     1216to `singular-simple-sec-last-end'.  Updates `singular-simple-sec-last-end'.
     1217Returns the new simple section or `empty' if no simple section has been
     1218created.
     1219Assumes that no narrowing is in effect."
     1220  (let ((last-end (singular-simple-sec-last-end-position))
    7651221        ;; `simple-sec' is the new simple section or `empty'
    7661222        simple-sec)
     
    7741230    (cond
    7751231     ;; do not create empty sections
    776      ((eq end last-end) (setq simple-sec 'empty))
    777      ;; create only non-clear simple sections
     1232     ((eq end last-end)
     1233      'empty)
     1234     ;; non-clear simple sections
    7781235     ((not (eq type singular-simple-sec-clear-type))
    779       ;; if type has not changed we only have to extend the previous
    780       ;; simple section
     1236      ;; if type has not changed we only have to extend the previous simple
     1237      ;; section.  If `last-end' happens to be 1 (meaning that we are
     1238      ;; creating the first non-clear simple section in the buffer), then
     1239      ;; `singular-simple-sec-before' returns nil,
     1240      ;; `singular-simple-sec-type' returns the type of clear simple
     1241      ;; sections that definitely does not equal TYPE, and a new simple
     1242      ;; section is created as necessary.
    7811243      (setq simple-sec (singular-emacs-simple-sec-before last-end))
    7821244      (if (eq type (singular-emacs-simple-sec-type simple-sec))
     
    7881250        (overlay-put simple-sec 'singular-type type)
    7891251        ;; set face
    790         (overlay-put simple-sec 'face (singular-lookup-face type))
     1252        (overlay-put simple-sec 'face (singular-simple-sec-lookup-face type))
    7911253        ;; evaporate empty sections
    792         (overlay-put simple-sec 'evaporate t))))
    793            
    794     ;; update end of last simple section
    795     (set-marker singular-simple-sec-last-end end)
    796     simple-sec))
    797 
    798 (defun singular-emacs-simple-sec-reset-last (pos)
    799   "Reset end of last simple section to POS after accidental extension.
    800 Updates `singular-simple-sec-last-end', too."
    801   (let ((simple-sec (singular-emacs-simple-sec-at pos)))
    802     (if simple-sec (move-overlay simple-sec (overlay-start simple-sec) pos))
    803     (set-marker singular-simple-sec-last-end pos)))
    804 
    805 (defun singular-emacs-simple-sec-start (simple-sec)
    806   "Return start of non-clear simple section SIMPLE-SEC."
    807   (overlay-start simple-sec))
    808 
    809 (defun singular-emacs-simple-sec-end (simple-sec)
    810   "Return end of non-clear simple section SIMPLE-SEC."
    811   (overlay-end simple-sec))
     1254        (overlay-put simple-sec 'evaporate t))
     1255      ;; update `singular-simple-sec-last-end' and return new simple
     1256      ;; section
     1257      (set-marker singular-simple-sec-last-end end)
     1258      simple-sec)
     1259     ;; clear simple sections
     1260     (t
     1261      ;; update `singular-simple-sec-last-end' and return nil
     1262      (set-marker singular-simple-sec-last-end end)
     1263      nil))))
    8121264
    8131265(defun singular-emacs-simple-sec-start-at (pos)
    814   "Return start of clear section at position POS.
    815 Assumes that no narrowing is in effect."
    816   (let ((previous-overlay-change (1+ pos)))
     1266  "Return start of clear simple section at position POS.
     1267Assumes the existence of an imagenary empty clear simple section if POS is
     1268at end of buffer and there is non-clear simple section immediately ending
     1269at POS.
     1270Assumes that no narrowing is in effect (since `previous-overlay-change'
     1271imlicitly does so)."
     1272  ;; yes, this `(1+ pos)' is OK at eob for
     1273  ;; `singular-emacs-simple-sec-before' as well as
     1274  ;; `previous-overlay-change'
     1275  (let ((previous-overlay-change-pos (1+ pos)))
    8171276    ;; this `while' loop at last will run into the end of the next
    818     ;; non-clear overlay or stop at bob.  Since POS may be right at the end
    819     ;; of a previous non-clear location, we have to search at least one
    820     ;; time from POS+1 backwards.
    821     (while (not (or (singular-emacs-simple-sec-before previous-overlay-change)
    822                     (eq previous-overlay-change (point-min))))
    823       (setq previous-overlay-change
    824             (previous-overlay-change previous-overlay-change)))
    825     previous-overlay-change))
     1277    ;; non-clear simple section or stop at bob.  Since POS may be right at
     1278    ;; the end of a previous non-clear location, we have to search at least
     1279    ;; one time from POS+1 backwards.
     1280    (while (not (or (singular-emacs-simple-sec-before previous-overlay-change-pos)
     1281                    (eq previous-overlay-change-pos 1)))
     1282      (setq previous-overlay-change-pos
     1283            (previous-overlay-change previous-overlay-change-pos)))
     1284    previous-overlay-change-pos))
    8261285
    8271286(defun singular-emacs-simple-sec-end-at (pos)
    828   "Return end of clear section at position POS.
    829 Assumes that no narrowing is in effect."
    830   (let ((next-overlay-change (next-overlay-change pos)))
     1287  "Return end of clear simple section at position POS.
     1288Assumes the existence of an imagenary empty clear simple section if POS is
     1289at end of buffer and there is non-clear simple section immediately ending
     1290at POS.
     1291Assumes that no narrowing is in effect (since `next-overlay-change'
     1292imlicitly does so)."
     1293  (let ((next-overlay-change-pos (next-overlay-change pos)))
    8311294    ;; this `while' loop at last will run into the beginning of the next
    832     ;; non-clear overlay or stop at eob.  Since POS may not be at the
    833     ;; beginning of a non-clear simple section we may start searching
     1295    ;; non-clear simple section or stop at eob.  Since POS may not be at
     1296    ;; the beginning of a non-clear simple section we may start searching
    8341297    ;; immediately.
    835     (while (not (or (singular-emacs-simple-sec-at next-overlay-change)
    836                     (eq next-overlay-change (point-max))))
    837       (setq next-overlay-change
    838             (next-overlay-change next-overlay-change)))
    839     next-overlay-change))
    840 
    841 (defun singular-emacs-simple-sec-type (simple-sec)
    842   "Return type of SIMPLE-SEC."
    843   (if simple-sec
    844       (overlay-get simple-sec 'singular-type)
    845     singular-simple-sec-clear-type))
     1298    (while (not (or (singular-emacs-simple-sec-at next-overlay-change-pos)
     1299                    (eq next-overlay-change-pos (point-max))))
     1300      (setq next-overlay-change-pos
     1301            (next-overlay-change next-overlay-change-pos)))
     1302    next-overlay-change-pos))
    8461303
    8471304(defun singular-emacs-simple-sec-at (pos)
    848   "Return simple section at position POS."
     1305  "Return simple section at buffer position POS.
     1306Assumes the existence of an imagenary empty clear simple section if POS is
     1307at end of buffer and there is non-clear simple section immediately ending
     1308at POS.
     1309Narrowing has no effect on this function."
     1310  ;; at eob, `overlays-at' always returns nil so everything is OK for this
     1311  ;; case, too
    8491312  (let ((overlays (overlays-at pos)) simple-sec)
    8501313    ;; be careful, there may be other overlays!
     
    8551318    simple-sec))
    8561319
    857 (defun singular-emacs-simple-sec-before (pos)
    858   "Return simple section before position POS.
    859 This is the same as `singular-simple-section-at' except if POS falls
    860 on a section border.  In this case `singular-simple-section-before'
    861 returns the previous simple section instead of the current one."
    862   (singular-emacs-simple-sec-at (max 1 (1- pos))))
    863 
    8641320(defun singular-emacs-simple-sec-in (beg end)
    8651321  "Return a list of all simple sections intersecting with the region from BEG to END.
    866 A simple section intersects the region if the section and the region
    867 have at least one character in common.
    868 The result contains both clear and non-clear simple sections in the
    869 order in that the appear in the region."
    870   ;; NOT READY
    871   nil)
    872 ;;}}}
    873 
    874 ;;{{{ Simple section stuff for XEmacs
     1322A simple section intersects the region if the section and the region have
     1323at least one character in common.  The sections are returned with
     1324startpoints in increasing order and clear simple sections (that is, nil's)
     1325inserted as necessary.  BEG is assumed to be less than or equal to END.
     1326The imagenary empty clear simple section at end of buffer is never included
     1327in the result.
     1328Narrowing has no effect on this function."
     1329  (let (overlays overlay-cursor)
     1330    (if (= beg end)
     1331        ;; `overlays-in' seems not be correct with respect to this case
     1332        nil
     1333      ;; go to END since chances are good that the overlays come in correct
     1334      ;; order, then
     1335      (setq overlays (let ((old-point (point)))
     1336                       (goto-char end)
     1337                       (prog1 (overlays-in beg end)
     1338                         (goto-char old-point)))
     1339
     1340      ;; now, turn overlays that are not simple sections into nils
     1341            overlays (mapcar (function
     1342                              (lambda (overlay)
     1343                                (and (singular-emacs-simple-sec-type overlay)
     1344                                     overlay)))
     1345                             overlays)
     1346      ;; then, remove nils from list
     1347            overlays (delq nil overlays)
     1348      ;; now, we have to sort the list since documentation of `overlays-in'
     1349      ;; does not state anything about the order the overlays are returned in
     1350            overlays
     1351            (sort overlays
     1352                  (function
     1353                   (lambda (a b)
     1354                     (< (overlay-start a) (overlay-start b))))))
     1355
     1356      ;; at last, we have the list of non-clear simple sections.  Now, go and
     1357      ;; insert clear simple sections as necessary.
     1358      (if (null overlays)
     1359          ;; if there are no non-clear simple sections at all there can be
     1360          ;; only one large clear simple section
     1361          '(nil)
     1362        ;; we care about inside clear simple section first
     1363        (setq overlay-cursor overlays)
     1364        (while (cdr overlay-cursor)
     1365          (if (eq (overlay-end (car overlay-cursor))
     1366                  (overlay-start (cadr overlay-cursor)))
     1367              (setq overlay-cursor (cdr overlay-cursor))
     1368            ;; insert nil
     1369            (setcdr overlay-cursor
     1370                    (cons nil (cdr overlay-cursor)))
     1371            (setq overlay-cursor (cddr overlay-cursor))))
     1372        ;; now, check BEG and END for clear simple sections
     1373        (if (> (overlay-start (car overlays)) beg)
     1374            (setq overlays (cons nil overlays)))
     1375        ;; `overlay-cursor' still points to the end
     1376        (if (< (overlay-end (car overlay-cursor)) end)
     1377            (setcdr overlay-cursor (cons nil nil)))
     1378        overlays))))
     1379;;}}}
     1380
     1381;;{{{ Simple section API for XEmacs
     1382(defsubst singular-xemacs-simple-sec-start (simple-sec)
     1383  "Return start of non-clear simple section SIMPLE-SEC.
     1384Narrowing has no effect on this function."
     1385  (extent-start-position simple-sec))
     1386
     1387(defsubst singular-xemacs-simple-sec-end (simple-sec)
     1388  "Return end of non-clear simple section SIMPLE-SEC.
     1389Narrowing has no effect on this function."
     1390  (extent-end-position simple-sec))
     1391
     1392(defsubst singular-xemacs-simple-sec-type (simple-sec)
     1393  "Return type of SIMPLE-SEC.
     1394Returns nil if SIMPLE-SEC happens to be an extent but not a simple
     1395section.
     1396Narrowing has no effect on this function."
     1397  (if simple-sec
     1398      (extent-property simple-sec 'singular-type)
     1399    singular-simple-sec-clear-type))
     1400
     1401(defsubst singular-xemacs-simple-sec-before (pos)
     1402  "Return simple section before buffer position POS.
     1403This is the same as `singular-simple-sec-at' except if POS falls on a
     1404section border.  In this case `singular-simple-section-before' returns the
     1405previous simple section instead of the current one.  If POS falls on
     1406beginning of buffer, the simple section at beginning of buffer is returned.
     1407Narrowing has no effect on this function."
     1408  (singular-xemacs-simple-sec-at (max 1 (1- pos))))
     1409
    8751410(defun singular-xemacs-simple-sec-create (type end)
    8761411  "Create a new simple section of type TYPE.
    877 Creates the section from end of previous simple section up to END.
    878 END should be larger than `singular-simple-sec-last-end'.
    879 Returns the new simple section or `empty' if no simple section has
    880 been created.
    881 Assumes that no narrowing is in effect.
    882 Updates `singular-simple-sec-last-end'."
    883   (let ((last-end (marker-position singular-simple-sec-last-end))
     1412Creates the section from end of previous simple section up to the first
     1413beginning of line before END.  That position should be larger than or equal
     1414to `singular-simple-sec-last-end'.  Updates `singular-simple-sec-last-end'.
     1415Returns the new simple section or `empty' if no simple section has been
     1416created.
     1417Assumes that no narrowing is in effect."
     1418  (let ((last-end (singular-simple-sec-last-end-position))
    8841419        ;; `simple-sec' is the new simple section or `empty'
    8851420        simple-sec)
     
    8931428    (cond
    8941429     ;; do not create empty sections
    895      ((eq end last-end) (setq simple-sec 'empty))
    896      ;; create only non-clear simple sections
     1430     ((eq end last-end)
     1431      'empty)
     1432     ;; non-clear simple sections
    8971433     ((not (eq type singular-simple-sec-clear-type))
    898       ;; if type has not changed we only have to extend the previous
    899       ;; simple section
     1434      ;; if type has not changed we only have to extend the previous simple
     1435      ;; section.  If `last-end' happens to be 1 (meaning that we are
     1436      ;; creating the first non-clear simple section in the buffer), then
     1437      ;; `singular-simple-sec-before' returns nil,
     1438      ;; `singular-simple-sec-type' returns the type of clear simple
     1439      ;; sections that definitely does not equal TYPE, and a new simple
     1440      ;; section is created as necessary.
    9001441      (setq simple-sec (singular-xemacs-simple-sec-before last-end))
    9011442      (if (eq type (singular-xemacs-simple-sec-type simple-sec))
     
    9071448        ;; set type property
    9081449        (set-extent-property simple-sec 'singular-type type)
    909         ;; set face
    910         (set-extent-property simple-sec 'face (singular-lookup-face type)))))
    911            
    912     ;; update end of last simple section
    913     (set-marker singular-simple-sec-last-end end)
    914     simple-sec))
    915 
    916 (defun singular-xemacs-simple-sec-reset-last (pos)
    917   "Reset end of last simple section to POS after accidental extension.
    918 Updates `singular-simple-sec-last-end', too."
    919   (let ((simple-sec (singular-xemacs-simple-sec-at pos)))
    920     (if simple-sec
    921         (set-extent-endpoints simple-sec (extent-start-position simple-sec) pos))
    922     (set-marker singular-simple-sec-last-end pos)))
    923 
    924 (defun singular-xemacs-simple-sec-start (simple-sec)
    925   "Return start of non-clear simple section SIMPLE-SEC."
    926   (extent-start-position simple-sec))
    927 
    928 (defun singular-xemacs-simple-sec-end (simple-sec)
    929   "Return end of non-clear simple section SIMPLE-SEC."
    930   (extent-end-position simple-sec))
     1450        ;; set face.  In contrast to Emacs, we do not need to set somethin
     1451        ;; like `evaporate'.  `detachable' is set by XEmacs by default.
     1452        (set-extent-property simple-sec 'face (singular-simple-sec-lookup-face type)))
     1453      ;; update `singular-simple-sec-last-end' and return new simple
     1454      ;; section
     1455      (set-marker singular-simple-sec-last-end end)
     1456      simple-sec)
     1457     ;; clear simple sections
     1458     (t
     1459      ;; update `singular-simple-sec-last-end' and return nil
     1460      (set-marker singular-simple-sec-last-end end)
     1461      nil))))
    9311462
    9321463(defun singular-xemacs-simple-sec-start-at (pos)
    933   "Return start of clear section at position POS.
    934 Assumes that no narrowing is in effect."
    935   ;; if previous-extent-change is called with an argument bigger
    936   ;; than (1+ (buffer-size))  (not (point-max)!), we get an error!
    937   (let ((previous-extent-change (if (> pos (buffer-size))
    938                                     pos
    939                                   (1+ pos))))
    940     ;; this `while' loop at last will run into the end of the next
    941     ;; non-clear extent or stop at bob.  Since POS may be right at the end
    942     ;; of a previous non-clear location, we have to search at least one
    943     ;; time from POS+1 backwards.
    944     (while (not (or (singular-xemacs-simple-sec-before previous-extent-change)
    945                     (eq previous-extent-change (point-min))))
    946       (setq previous-extent-change
    947             (previous-extent-change previous-extent-change)))
    948     previous-extent-change))
     1464  "Return start of clear simple section at position POS.
     1465Assumes the existence of an imagenary empty clear simple section if POS is
     1466at end of buffer and there is non-clear simple section immediately ending
     1467at POS.
     1468Assumes that no narrowing is in effect (since `previous-extent-change'
     1469imlicitly does so)."
     1470  ;; get into some hairy details at end of buffer.  Look if there is a
     1471  ;; non-clear simple section immediately ending at end of buffer and
     1472  ;; return the start of the imagenary empty clear simple section in that
     1473  ;; case.  If buffer is empty this test fails since
     1474  ;; `singular-xemacs-simple-sec-before' (corretly) returns nil.  But in
     1475  ;; that case the following loop returns the correct result.
     1476  (if (and (eq pos (point-max))
     1477           (singular-xemacs-simple-sec-before pos))
     1478      pos
     1479    (let ((previous-extent-change-pos (min (1+ pos) (point-max))))
     1480      ;; this `while' loop at last will run into the end of the next
     1481      ;; non-clear simple section or stop at bob.  Since POS may be right at
     1482      ;; the end of a previous non-clear location, we have to search at least
     1483      ;; one time from POS+1 backwards.
     1484      (while (not (or (singular-xemacs-simple-sec-before previous-extent-change-pos)
     1485                      (eq previous-extent-change-pos 1)))
     1486        (setq previous-extent-change-pos
     1487              (previous-extent-change previous-extent-change-pos)))
     1488      previous-extent-change-pos)))
    9491489
    9501490(defun singular-xemacs-simple-sec-end-at (pos)
    951   "Return end of clear section at position POS.
    952 Assumes that no narrowing is in effect."
    953   (let ((next-extent-change (next-extent-change pos)))
     1491  "Return end of clear simple section at position POS.
     1492Assumes the existence of an imagenary empty clear simple section if POS is
     1493at end of buffer and there is non-clear simple section immediately ending
     1494at POS.
     1495Assumes that no narrowing is in effect (since `next-extent-change'
     1496imlicitly does so)."
     1497  (let ((next-extent-change-pos (next-extent-change pos)))
    9541498    ;; this `while' loop at last will run into the beginning of the next
    955     ;; non-clear extent or stop at eob.  Since POS may not be at the
    956     ;; beginning of a non-clear simple section we may start searching
     1499    ;; non-clear simple section or stop at eob.  Since POS may not be at
     1500    ;; the beginning of a non-clear simple section we may start searching
    9571501    ;; immediately.
    958     (while (not (or (singular-xemacs-simple-sec-at next-extent-change)
    959                     (eq next-extent-change (point-max))))
    960       (setq next-extent-change
    961             (next-extent-change next-extent-change)))
    962     next-extent-change))
    963 
    964 (defun singular-xemacs-simple-sec-type (simple-sec)
    965   "Return type of SIMPLE-SEC."
    966   (if simple-sec
    967       (extent-property simple-sec 'singular-type)
    968     singular-simple-sec-clear-type))
     1502    (while (not (or (singular-xemacs-simple-sec-at next-extent-change-pos)
     1503                    (eq next-extent-change-pos (point-max))))
     1504      (setq next-extent-change-pos
     1505            (next-extent-change next-extent-change-pos)))
     1506    next-extent-change-pos))
    9691507
    9701508(defun singular-xemacs-simple-sec-at (pos)
    971   "Return simple section at position POS."
     1509  "Return simple section at buffer position POS.
     1510Assumes the existence of an imagenary empty clear simple section if POS is
     1511at end of buffer and there is non-clear simple section immediately ending
     1512at POS.
     1513Narrowing has no effect on this function."
     1514  ;; at eob, `map-extent' always returns nil so everything is OK for this
     1515  ;; case, too.  Do not try to use `extent-at' at this point.  `extent-at'
     1516  ;; does not return extents outside narrowed text.
    9721517  (map-extents (function (lambda (ext args) ext))
    973                ;; is this pos-pos-region OK? I think so.
    974                (current-buffer) pos pos nil nil 'singular-type))
    975 
    976 (defun singular-xemacs-simple-sec-before (pos)
    977   "Return simple section before position POS.
    978 This is the same as `singular-simple-section-at' except if POS falls
    979 on a section border.  In this case `singular-simple-section-before'
    980 returns the previous simple section instead of the current one."
    981   (singular-xemacs-simple-sec-at (max 1 (1- pos))))
     1518               nil pos pos nil nil 'singular-type))
    9821519
    9831520(defun singular-xemacs-simple-sec-in (beg end)
    9841521  "Return a list of all simple sections intersecting with the region from BEG to END.
    985 A simple section intersects the region if the section and the region
    986 have at least one character in common.
    987 The result contains both clear and non-clear simple sections in the
    988 order they appear in the region."
    989   ;; NOT READY [order of sections???]
    990   (let ((extent-list))
    991     (map-extents
    992      (function (lambda (ext arg)
    993 
    994                  ;; if start of first extent is not point-min, insert
    995                  ;; a clear-simple-sec first:
    996                  (or extent-list
    997                      (= (extent-start-position ext) (point-min))
    998                      (setq extent-list (append (list nil) extent-list)))
    999 
    1000                  ;; if end of previous simple-sec is not equal start of
    1001                  ;; current simple-sec than we have to insert a
    1002                  ;; clear-simple-sec first:
    1003                  (and (car extent-list)
    1004                       (not (= (extent-end-position (car extent-list))
    1005                               (extent-start-position ext)))
    1006                       (setq extent-list (append (list nil) extent-list)))
    1007 
    1008                  ;; finally insert this non-clear simple-sec:
    1009                  (setq extent-list (append (list ext) extent-list))
    1010                  nil))
    1011      (current-buffer) beg end nil nil 'singular-type)
    1012 
    1013     ;; if extent-list is still nil at this point, then no non-clear
    1014     ;; simple-sec intersects with region (BEG END).
    1015     ;; Then insert a clear simple-sec:
    1016     (or extent-list
    1017         (setq extent-list '(nil)))
    1018 
    1019     ;; if last inserted simple-sec is non-clear and its end is smaller
    1020     ;; than END, then insert another clear simple sec:
    1021     (and (car extent-list)
    1022          (<= (extent-end-position (car extent-list)) end)
    1023          (setq extent-list (append (list nil) extent-list)))
    1024 
    1025     ;; we set up the list in decreasing order, so reverse the list
    1026     (reverse extent-list)))
    1027 ;;}}}
    1028 
    1029 ;;{{{ Section stuff
     1522A simple section intersects the region if the section and the region have
     1523at least one character in common.  The sections are returned with
     1524startpoints in increasing order and clear simple sections (that is, nil's)
     1525inserted as necessary.  BEG is assumed to be less than or equal to END.
     1526The imagenary empty clear simple section at end of buffer is never included
     1527in the result.
     1528Narrowing has no effect on this function."
     1529  (let (extents extent-cursor)
     1530    (if (= beg end)
     1531        ;; `mapcar-extents' may return some extents in this case, so
     1532        ;; exclude it
     1533        nil
     1534      ;; OK, that's a little bit easier than for Emacs ...
     1535      (setq extents (mapcar-extents 'identity nil nil beg end nil 'singular-type))
     1536
     1537      ;; now we have the list of non-clear simple sections.  Go and
     1538      ;; insert clear simple sections as necessary.
     1539      (if (null extents)
     1540          ;; if there are no non-clear simple sections at all there can be
     1541          ;; only one large clear simple section
     1542          '(nil)
     1543        ;; we care about inside clear simple section first
     1544        (setq extent-cursor extents)
     1545        (while (cdr extent-cursor)
     1546          (if (eq (extent-end-position (car extent-cursor))
     1547                  (extent-start-position (cadr extent-cursor)))
     1548              (setq extent-cursor (cdr extent-cursor))
     1549            ;; insert nil
     1550            (setcdr extent-cursor
     1551                    (cons nil (cdr extent-cursor)))
     1552            (setq extent-cursor (cddr extent-cursor))))
     1553        ;; now, check BEG and END for clear simple sections
     1554        (if (> (extent-start-position (car extents)) beg)
     1555            (setq extents (cons nil extents)))
     1556        ;; `extent-cursor' still points to the end
     1557        (if (< (extent-end-position (car extent-cursor)) end)
     1558            (setcdr extent-cursor (cons nil nil)))
     1559        extents))))
     1560;;}}}
     1561
     1562;;{{{ Section API
    10301563
    10311564;; Note:
     
    10401573;;   created.
    10411574;; - Buffer narrowing does not restrict the extent of completely or
    1042 ;;   partially inaccessible sections.  In contrast to simple sections
    1043 ;;   the functions concerning sections do not assume that there is no
    1044 ;;   narrowing in effect.
     1575;;   partially inaccessible sections.  In contrast to simple sections the
     1576;;   functions concerning sections do not assume that there is no narrowing
     1577;;   in effect.  However, most functions provide an optional argument
     1578;;   RESTRICTED that restricts the start and end point of the returned
     1579;;   sections to the currently active restrictions.  Of course, that does
     1580;;   not affect the range of the underlying simple sections, only the
     1581;;   additional start and end points being returned.  One should note that
     1582;;   by restricting sections one may get empty sections, that is, sections
     1583;;   for which the additional start and end point are equal.
    10451584;; - Sections are independent from implementation dependencies.  There are
    10461585;;   no different versions of the functions for Emacs and XEmacs.
     1586;; - Whenever possible, one should not access simple section directly.
     1587;;   Instead, one should use the section API.
     1588
     1589(defcustom singular-section-face-alist '((input . nil)
     1590                                         (output . singular-section-output-face))
     1591  "*Alist that maps section types to faces.
     1592Should be a list consisting of elements (SECTION-TYPE . FACE-OR-NIL), where
     1593SECTION-TYPE is either `input' or `output'.
     1594
     1595At any time, the Singular interactive mode buffer is completely covered by
     1596sections of two different types: input sections and output sections.  This
     1597variable determines which faces are used to display the different sections.
     1598
     1599If for type SECTION-TYPE the value FACE-OR-NIL is a face it is used to
     1600display the contents of all sections of that particular type.
     1601If instead FACE-OR-NIL equals nil sections of that type become so-called
     1602clear sections.  The content of clear sections is displayed as regular
     1603text, with no faces at all attached to them.
     1604
     1605Some notes and restrictions on this variable (believe them or not):
     1606o Changing this variable during a Singular session may cause unexpected
     1607  results (but not too serious ones, though).
     1608o There may be only one clear section type defined at a time.
     1609o Choosing clear input sections is a good idea.
     1610o Choosing clear output sections is a bad idea.
     1611o Consequence: Not to change this variable is a good idea."
     1612  ;; to add new section types, simply extend the `list' widget.
     1613  ;; The rest should work unchanged.  Do not forget to update docu.
     1614  :type '(list (cons :tag "Input sections"
     1615                     (const :format "" input)
     1616                     (choice :format
     1617"Choose either clear or non-clear input sections.  For non-clear sections,
     1618select or modify a face (preferably `singular-section-input-face') used to
     1619display the sections.
     1620%[Choice%]
     1621%v
     1622"
     1623                             (const :tag "Clear sections" nil)
     1624                             (face :tag "Non-clear sections")))
     1625               (cons :tag "Output sections"
     1626                     (const :format "" output)
     1627                     (choice :format
     1628"Choose either clear or non-clear ouput sections.  For non-clear sections,
     1629select or modify a face (preferably `singular-section-output-face') used to
     1630display the sections.
     1631%[Choice%]
     1632%v
     1633"
     1634                             (const :tag "Clear sections" nil)
     1635                             (face :tag "Non-clear sections"))))
     1636  :initialize 'custom-initialize-reset
     1637  ;; this function checks for validity (only one clear section
     1638  ;; type) and sets `singular-simple-sec-clear-type' accordingly.
     1639  ;; In case of an error, nothing is set or modified.
     1640  :set (function (lambda (var value)
     1641                   (let* ((cdrs-with-nils (mapcar 'cdr value))
     1642                          (cdrs-without-nils (delq nil (copy-sequence cdrs-with-nils))))
     1643                     (if (> (- (length cdrs-with-nils) (length cdrs-without-nils)) 1)
     1644                         (error "Only one clear section type allowed (see `singular-section-face-alist')")
     1645                       (set-default var value)
     1646                       (setq singular-simple-sec-clear-type (car (rassq nil value)))))))
     1647  :group 'singular-faces
     1648  :group 'singular-sections-and-foldings)
     1649
     1650(defface singular-section-input-face '((t nil))
     1651  "*Face to use for input sections.
     1652It may be not sufficient to modify this face to change the appearance of
     1653input sections.  See `singular-section-face-alist' for more information."
     1654  :group 'singular-faces
     1655  :group 'singular-sections-and-foldings)
     1656
     1657(defface singular-section-output-face '((t (:bold t)))
     1658  "*Face to use for output sections.
     1659It may be not sufficient to modify this face to change the appearance of
     1660output sections.  See `singular-section-face-alist' for more information."
     1661  :group 'singular-faces
     1662  :group 'singular-sections-and-foldings)
     1663
     1664(defsubst singular-section-create (simple-sec type start end)
     1665  "Create and return a new section."
     1666  (vector simple-sec type start end))
     1667
     1668(defsubst singular-section-simple-sec (section)
     1669  "Return underlying simple section of SECTION."
     1670  (aref section 0))
     1671
     1672(defsubst singular-section-type (section)
     1673  "Return type of SECTION."
     1674  (aref section 1))
     1675
     1676(defsubst singular-section-start (section)
     1677  "Return start of SECTION."
     1678  (aref section 2))
     1679
     1680(defsubst singular-section-end (section)
     1681  "Return end of SECTION."
     1682  (aref section 3))
    10471683
    10481684(defun singular-section-at (pos &optional restricted)
     
    10601696        (setq start (singular-simple-sec-start-at pos)
    10611697              end (singular-simple-sec-end-at pos))))
    1062     (if restricted
    1063         (vector simple-sec type
    1064                 (max start (point-min)) (min end (point-max)))
    1065       (vector simple-sec type start end))))
     1698    (cond
     1699     ;; not restricted first
     1700     ((not restricted)
     1701      (singular-section-create simple-sec type start end))
     1702     ;; restricted and degenerated
     1703     ((and restricted
     1704           (< end (point-min)))
     1705      (singular-section-create simple-sec type (point-min) (point-min)))
     1706     ;; restricted and degenerated
     1707     ((and restricted
     1708           (> start (point-max)))
     1709      (singular-section-create simple-sec type (point-max) (point-max)))
     1710     ;; restricted but not degenrated
     1711     (t
     1712      (singular-section-create simple-sec type
     1713                               (max start (point-min))
     1714                               (min end (point-max)))))))
    10661715
    10671716(defun singular-section-before (pos &optional restricted)
    10681717  "Return section before position POS.
    1069 This is the same as `singular-section-at' except if POS falls on a
    1070 section border.  In this case `singular-section-before' returns the
    1071 previous section instead of the current one.
     1718This is the same as `singular-section-at' except if POS falls on a section
     1719border.  In this case `singular-section-before' returns the previous
     1720section instead of the current one.  If POS falls on beginning of buffer,
     1721the section at beginning of buffer is returned.
    10721722Returns section intersected with current restriction if RESTRICTED is
    10731723non-nil."
    10741724  (singular-section-at (max 1 (1- pos)) restricted))
    10751725
    1076 (defun singular-section-in (reg-beg reg-end)
    1077   "NOT READY [docu]"
    1078   (let ((simple-secs (singular-simple-sec-in reg-beg reg-end))
    1079         sections current last-end
    1080         type beg end)
    1081     (save-restriction
    1082       (widen)
    1083       (while simple-secs
    1084         (setq current (car simple-secs))
    1085         (setq type (singular-simple-sec-type current))
    1086         (if current
    1087             ;; current is a non-clear simple-sec
    1088             (setq beg (singular-simple-sec-start current)
    1089                   end (singular-simple-sec-end current)
    1090                   last-end end)
    1091           ;; current is a clear simple-sec
    1092           (setq beg (singular-simple-sec-start-at (or last-end
    1093                                                         (point-min)))
    1094                 end (singular-simple-sec-end-at (or last-end
    1095                                                     (point-min)))))
    1096         ;; NOT READY [RESTRICTED]
    1097         (setq sections (append sections (list (vector current type beg end))))
    1098         (setq simple-secs (cdr simple-secs))))
    1099     sections))
    1100 
    1101 (defmacro singular-section-simple-sec (section)
    1102   "Return underlying simple section of SECTION."
    1103   `(aref ,section 0))
    1104 
    1105 (defmacro singular-section-type (section)
    1106   "Return type of SECTION."
    1107   `(aref ,section 1))
    1108 
    1109 (defmacro singular-section-start (section)
    1110   "Return start of SECTION."
    1111   `(aref ,section 2))
    1112 
    1113 (defmacro singular-section-end (section)
    1114   "Return end of SECTION."
    1115   `(aref ,section 3))
    1116 ;;}}}
    1117 
    1118 ;;{{{ Getting section contents
     1726(defun singular-section-in (beg end &optional restricted)
     1727  "Return a list of all sections intersecting with the region from BEG to END.
     1728A section intersects with the region if the section and the region have at
     1729least one character in common.  The sections are returned in increasing
     1730order.
     1731If optional argument RESTRICTED is non-nil only sections which are
     1732completely in the intersection of the region and the current restriction
     1733are returned."
     1734  ;; exchange BEG and END if necessary as a special service to our users
     1735  (let* ((reg-beg (min beg end))
     1736         (reg-end (max beg end))
     1737         ;; we need these since we widen the buffer later on
     1738         (point-min (point-min))
     1739         (point-max (point-max))
     1740         simple-sections)
     1741    (if (and restricted
     1742             (or (> reg-beg point-max) (< reg-end point-min)))
     1743        ;; degenerate restrictions
     1744        nil
     1745      ;; do the intersection if necessary and get simple sections
     1746      (setq reg-beg (if restricted (max reg-beg point-min) reg-beg)
     1747            reg-end (if restricted (min reg-end point-max) reg-end)
     1748            simple-sections (singular-simple-sec-in reg-beg reg-end))
     1749      ;; we still have REG-BEG <= REG-END in any case.  SIMPLE-SECTIONS
     1750      ;; contains the list of simple sections intersecting with the region
     1751      ;; from REG-BEG and REG-END.
     1752
     1753      (if (null simple-sections)
     1754          nil
     1755        ;; and here we even have REG-BEG < REG-END
     1756        (save-restriction
     1757          (widen)
     1758          ;; get sections intersecting with the region from REG-BEG to
     1759          ;; REG-END
     1760          (let* ((sections (singular-section-in-internal simple-sections
     1761                                                         reg-beg reg-end))
     1762                 first-section-start last-section-end)
     1763            (if (not restricted)
     1764                sections
     1765              (setq first-section-start (singular-section-start (car sections))
     1766                    last-section-end (singular-section-end (car (last sections))))
     1767              ;; popping off first element is easy ...
     1768              (if (< first-section-start point-min)
     1769                  (setq sections (cdr sections)))
     1770              ;; ... but last element is harder to pop off
     1771              (cond
     1772               (;; no elements left
     1773                (null sections)
     1774                nil)
     1775               (;; one element left
     1776                (null (cdr sections))
     1777                (if (> last-section-end point-max)
     1778                    nil
     1779                  sections))
     1780               (;; more than one element left
     1781                t
     1782                (if (> last-section-end point-max)
     1783                    (setcdr (last sections 2) nil))
     1784                sections)))))))))
     1785
     1786(defun singular-section-in-internal (simple-sections reg-beg reg-end)
     1787  "Create a list of sections from SIMPLE-SECTIONS.
     1788This is the back-end for `singular-section-in'.
     1789First simple section should be such that it contains REG-BEG, last simple
     1790section should be such that it contains or ends at REG-END.  These
     1791arguments are used to find the start resp. end of clear simple sections of
     1792terminal clear simple sections in SIMPLE-SECTIONS.
     1793Assumes that REG-BEG < REG-END.
     1794Assumes that SIMPLE-SECTIONS is not empty.
     1795Assumes that no narrowing is in effect."
     1796  (let* (;; we pop off the extra nil at the end of the loop
     1797         (sections (cons nil nil))
     1798         (sections-end sections)
     1799         (simple-section (car simple-sections))
     1800         type start end)
     1801
     1802    ;; first, get unrestricted start
     1803    (setq start (if simple-section
     1804                    (singular-simple-sec-start simple-section)
     1805                  ;; here we need that no narrowing is in effect
     1806                  (singular-simple-sec-start-at reg-beg)))
     1807
     1808    ;; loop through all simple sections but last
     1809    (while (cdr simple-sections)
     1810      (setq simple-section (car simple-sections)
     1811            type (singular-simple-sec-type simple-section)
     1812            end (if simple-section
     1813                    (singular-simple-sec-end simple-section)
     1814                  (singular-simple-sec-start (cadr simple-sections)))
     1815
     1816            ;; append the new section to `sections-end'
     1817            sections-end
     1818            (setcdr sections-end
     1819                    (cons (singular-section-create simple-section type start end) nil))
     1820
     1821            ;; get next simple section and its start
     1822            simple-sections (cdr simple-sections)
     1823            start end))
     1824
     1825    ;; care about last simple section
     1826    (setq simple-section (car simple-sections)
     1827          type (singular-simple-sec-type simple-section)
     1828          end (if simple-section
     1829                  (singular-simple-sec-end simple-section)
     1830                ;; the `1-' is OK since REG-BEG < REG-END.
     1831                ;; here we need that no narrowing is in effect
     1832                (singular-simple-sec-end-at (1- reg-end))))
     1833    (setcdr sections-end
     1834            (cons (singular-section-create simple-section type start end) nil))
     1835
     1836    ;; we should not forget to pop off our auxilliary cons-cell
     1837    (cdr sections)))
     1838
     1839(defun singular-section-mapsection (func sections &optional type-filter negate-filter)
     1840  "Apply FUNC to each section in SECTIONS, and make a list of the results.
     1841If optional argument TYPE-FILTER is non-nil it should be a list of section
     1842types.  FUNC is then applied only to those sections with type occuring in
     1843TYPE-FILTER.  If in addition optional argument NEGATE-FILTER is non-nil
     1844FUNC is applied only to those sections with type not occuring in
     1845TYPE-FILTER.
     1846
     1847In any case the length of the list this function returns equals the
     1848number of sections actually processed."
     1849  (if (not type-filter)
     1850      (mapcar func sections)
     1851    ;; copy the list first
     1852    (let ((sections (copy-sequence sections)))
     1853      ;; filter elements and turn them to t's
     1854      (setq sections
     1855            (mapcar (function
     1856                     (lambda (section)
     1857                       ;; that strange expression evaluates to t iff the
     1858                       ;; section should be removed.  The `not' is to
     1859                       ;; canonize boolean values to t or nil, resp.
     1860                       (or (eq (not (memq (singular-section-type section) type-filter))
     1861                               (not negate-filter))
     1862                           section)))
     1863                    sections)
     1864
     1865      ;; remove t's now
     1866            sections (delq t sections))
     1867
     1868      ;; call function for remaining sections
     1869      (mapcar func sections))))
     1870;;}}}
     1871
     1872;;{{{ Section miscellaneous
    11191873(defun singular-input-section-to-string (section &optional end raw)
    1120   "Get content of SECTION as string.
    1121 Returns text between start of SECTION and END if optional argument END
    1122 is non-nil.  END should be a position inside SECTION.
     1874  "Get content of input section SECTION as string.
     1875Returns text between start of SECTION and END if optional argument END is
     1876non-nil, otherwise text between start and end of SECTION.  END should be a
     1877position inside SECTION.
    11231878Strips leading prompts and trailing white space unless optional argument
    11241879RAW is non-nil."
    11251880  (save-restriction
    11261881    (widen)
    1127     (let ((string (if end
    1128                       (buffer-substring (singular-section-start section) end)
    1129                     (buffer-substring (singular-section-start section)
    1130                                       (singular-section-end section)))))
    1131       (if raw string
    1132         (singular-strip-leading-prompt
    1133          (singular-strip-white-space string t))))))
     1882    (let ((string (buffer-substring (singular-section-start section)
     1883                                    (or end (singular-section-end section)))))
     1884      (if raw
     1885          string
     1886        (singular-strip-leading-prompt (singular-strip-white-space string t))))))
     1887;;}}}
     1888
     1889;;{{{ Section miscellaneous interactive
     1890(defun singular-section-goto-beginning ()
     1891  "Move point to beginning of current section."
     1892  (interactive)
     1893  (goto-char (singular-section-start (singular-section-at (point))))
     1894  (singular-keep-region-active))
     1895
     1896(defun singular-section-goto-end ()
     1897  "Move point to end of current section."
     1898  (interactive)
     1899  (goto-char (singular-section-end (singular-section-at (point))))
     1900  (singular-keep-region-active))
     1901
     1902(defun singular-section-backward (n)
     1903  "Move backward until encountering the beginning of a section.
     1904With argument, do this that many times.  With N less than zero, call
     1905`singular-section-forward' with argument -N."
     1906  (interactive "p")
     1907  (while (> n 0)
     1908    (goto-char (singular-section-start (singular-section-before (point))))
     1909    (setq n (1- n)))
     1910  (if (< n 0)
     1911      (singular-section-forward (- n))
     1912    (singular-keep-region-active)))
     1913
     1914(defun singular-section-forward (n)
     1915  "Move forward until encountering the end of a section.
     1916With argument, do this that many times.  With N less than zero, call
     1917`singular-section-backward' with argument -N."
     1918  (interactive "p")
     1919  (while (> n 0)
     1920    (goto-char (singular-section-end (singular-section-at (point))))
     1921    (setq n (1- n)))
     1922  (if (< n 0)
     1923      (singular-section-backward (- n))
     1924    (singular-keep-region-active)))
     1925;;}}}
     1926
     1927;;{{{ Folding sections for both Emacs and XEmacs
     1928(defcustom singular-folding-ellipsis "Singular I/O ..."
     1929  "*Ellipsis to show for folded input or output.
     1930Changing this variable has an immediate effect only if one uses
     1931\\[customize] to do so.
     1932However, even then it may be necessary to refresh display completely (using
     1933\\[recenter], for example) for the new settings to be visible."
     1934  :type 'string
     1935  :initialize 'custom-initialize-default
     1936  :set (function
     1937        (lambda (var value)
     1938          ;; set in all singular buffers
     1939          (singular-map-buffer 'singular-folding-set-ellipsis value)
     1940          (set-default var value)))
     1941  :group 'singular-sections-and-foldings)
     1942
     1943(defcustom singular-folding-line-move-ignore-folding t
     1944  "*If non-nil, ignore folded sections when moving point up or down.
     1945This variable is used to initialize `line-move-ignore-invisible'.  However,
     1946documentation states that setting `line-move-ignore-invisible' to a non-nil
     1947value may result in a slow-down when moving the point up or down.  One
     1948should try to set this variable to nil if point motion seems too slow.
     1949
     1950Changing this variable has an immediate effect only if one uses
     1951\\[customize] to do so."
     1952  :type 'boolean
     1953  :initialize 'custom-initialize-default
     1954  :set (function
     1955        (lambda (var value)
     1956          ;; set in all singular buffers
     1957          (singular-map-buffer 'set 'line-move-ignore-invisible value)
     1958          (set-default var value)))
     1959  :group 'singular-sections-and-foldings)
     1960
     1961(defun singular-folding-set-ellipsis (ellipsis)
     1962  "Set ellipsis to show for folded input or output in current buffer."
     1963  (cond
     1964   ;; Emacs
     1965   ((eq singular-emacs-flavor 'emacs)
     1966    (setq buffer-display-table (or (copy-sequence standard-display-table)
     1967                                   (make-display-table)))
     1968    (set-display-table-slot buffer-display-table
     1969                            'selective-display (vconcat ellipsis)))
     1970   ;; XEmacs
     1971   (t
     1972    (set-glyph-image invisible-text-glyph ellipsis (current-buffer)))))
     1973
     1974(defun singular-folding-init ()
     1975  "Initializes folding of sections for the current buffer.
     1976That includes setting `buffer-invisibility-spec' and the ellipsis to show
     1977for hidden text.
     1978
     1979This function is called at mode initialization time."
     1980  ;; initialize `buffer-invisibility-spec' first
     1981  (let ((singular-invisibility-spec (cons 'singular-interactive-mode t)))
     1982    (if (and (listp buffer-invisibility-spec)
     1983             (not (member singular-invisibility-spec buffer-invisibility-spec)))
     1984        (setq buffer-invisibility-spec
     1985              (cons singular-invisibility-spec buffer-invisibility-spec))
     1986      (setq buffer-invisibility-spec (list singular-invisibility-spec))))
     1987  ;; ignore invisible lines on movements
     1988  (set (make-local-variable 'line-move-ignore-invisible)
     1989       singular-folding-line-move-ignore-folding)
     1990  ;; now for the ellipsis
     1991  (singular-folding-set-ellipsis singular-folding-ellipsis))
     1992
     1993(defun singular-folding-fold (section &optional no-error)
     1994  "Fold section SECTION if it is not already folded.
     1995Does not fold sections that do not end in a newline or that are restricted
     1996either in part or as a whole.  Rather fails with an error in such cases
     1997or silently fails if optional argument NO-ERROR is non-nil.
     1998This is for safety only: In both cases the result may be confusing to the
     1999user."
     2000  (let* ((start (singular-section-start section))
     2001         (end (singular-section-end section)))
     2002    (cond ((or (< start (point-min))
     2003               (> end (point-max)))
     2004           (unless no-error
     2005             (error "Folding not possible: section is restricted in part or as a whole")))
     2006          ((not (eq (char-before end) ?\n))
     2007           (unless no-error
     2008             (error "Folding not possible: section does not end in newline")))
     2009          ((not (singular-folding-foldedp section))
     2010           ;; fold but only if not already folded
     2011           (singular-folding-fold-internal section)))))
     2012
     2013(defun singular-folding-unfold (section &optional no-error invisibility-overlay-or-extent)
     2014  "Unfold section SECTION if it is not already unfolded.
     2015Does not unfold sections that are restricted either in part or as a whole.
     2016Rather fails with an error in such cases or silently fails if optional
     2017argument NO-ERROR is non-nil.  This is for safety only: The result may be
     2018confusing to the user.
     2019If optional argument INVISIBILITY-OVERLAY-OR_EXTENT is non-nil it should be
     2020the invisibility overlay or extent, respectively, of the section to
     2021unfold."
     2022  (let* ((start (singular-section-start section))
     2023         (end (singular-section-end section)))
     2024    (cond ((or (< start (point-min))
     2025               (> end (point-max)))
     2026           (unless no-error
     2027             (error "Unfolding not possible: section is restricted in part or as a whole")))
     2028          ((or invisibility-overlay-or-extent
     2029               (setq invisibility-overlay-or-extent (singular-folding-foldedp section)))
     2030           ;; unfold but only if not already unfolded
     2031           (singular-folding-unfold-internal section invisibility-overlay-or-extent)))))
     2032
     2033(defun singular-folding-fold-at-point ()
     2034  "Fold section point currently is in.
     2035Does not fold sections that do not end in a newline or that are restricted
     2036either in part or as a whole.  Rather fails with an error in such cases."
     2037  (interactive)
     2038  (singular-folding-fold (singular-section-at (point))))
     2039
     2040(defun singular-folding-unfold-at-point ()
     2041  "Unfold section point currently is in.
     2042Does not unfold sections that are restricted either in part or as a whole.
     2043Rather fails with an error in such cases."
     2044  (interactive)
     2045  (singular-folding-unfold (singular-section-at (point))))
     2046
     2047(defun singular-folding-fold-latest-output ()
     2048  "Fold latest output section.
     2049Does not fold sections that do not end in a newline or that are restricted
     2050either in part or as a whole.  Rather fails with an error in such cases."
     2051  (interactive)
     2052  (singular-folding-fold (singular-latest-output-section)))
     2053
     2054(defun singular-folding-unfold-latest-output ()
     2055  "Unfolds latest output section.
     2056Does not unfold sections that are restricted either in part or as a whole.
     2057Rather fails with an error in such cases."
     2058  (interactive)
     2059  (singular-folding-unfold (singular-latest-output-section)))
     2060
     2061(defun singular-folding-fold-all-output ()
     2062  "Fold all complete, unfolded output sections.
     2063That is, all output sections that are not restricted in part or as a whole
     2064and that end in a newline."
     2065  (interactive)
     2066  (singular-section-mapsection (function (lambda (section) (singular-folding-fold section t)))
     2067                               (singular-section-in (point-min) (point-max) t)
     2068                               '(output)))
     2069
     2070(defun singular-folding-unfold-all-output ()
     2071  "Unfold all complete, folded output sections.
     2072That is, all output sections that are not restricted in part or as a whole."
     2073  (interactive)
     2074  (singular-section-mapsection (function (lambda (section) (singular-folding-unfold section t)))
     2075                               (singular-section-in (point-min) (point-max) t)
     2076                               '(output)))
     2077
     2078(defun singular-folding-toggle-fold-at-point-or-all (&optional arg)
     2079  "Fold or unfold section point currently is in or all output sections.
     2080Without prefix argument, folds unfolded sections and unfolds folded
     2081sections.  With prefix argument, folds all output sections if argument is
     2082positive, otherwise unfolds all output sections.
     2083Does neither fold nor unfold sections that do not end in a newline or that
     2084are restricted either in part or as a whole.  Rather fails with an error in
     2085such cases."
     2086  (interactive "P")
     2087    (cond ((not arg)
     2088           ;; fold or unfold section at point
     2089           (let* ((section (singular-section-at (point)))
     2090                  (invisibility-overlay-or-extent (singular-folding-foldedp section)))
     2091             (if invisibility-overlay-or-extent
     2092                 (singular-folding-unfold section nil invisibility-overlay-or-extent)
     2093               (singular-folding-fold section))))
     2094          ((> (prefix-numeric-value arg) 0)
     2095           (singular-folding-fold-all-output))
     2096          (t
     2097           (singular-folding-unfold-all-output))))
     2098
     2099(defun singular-folding-toggle-fold-latest-output (&optional arg)
     2100  "Fold or unfold latest output section.
     2101Folds unfolded sections and unfolds folded sections.
     2102Does neither fold nor unfold sections that do not end in a newline or that
     2103are restricted either in part or as a whole.  Rather fails with an error in
     2104such cases."
     2105  (interactive)
     2106  (let* ((section (singular-latest-output-section))
     2107         (invisibility-overlay-or-extent (singular-folding-foldedp section)))
     2108    (if invisibility-overlay-or-extent
     2109        (singular-folding-unfold section nil invisibility-overlay-or-extent)
     2110      (singular-folding-fold section))))
     2111
     2112;; Note:
     2113;;
     2114;; The rest of the folding is either marked as
     2115;; Emacs
     2116;; or
     2117;; XEmacs
     2118
     2119(singular-fset 'singular-folding-fold-internal
     2120               'singular-emacs-folding-fold-internal
     2121               'singular-xemacs-folding-fold-internal)
     2122
     2123(singular-fset 'singular-folding-unfold-internal
     2124               'singular-emacs-folding-unfold-internal
     2125               'singular-xemacs-folding-unfold-internal)
     2126
     2127(singular-fset 'singular-folding-foldedp
     2128               'singular-emacs-folding-foldedp-internal
     2129               'singular-xemacs-folding-foldedp-internal)
     2130;;}}}
     2131
     2132;;{{{ Folding sections for Emacs
     2133
     2134;; Note:
     2135;;
     2136;; For Emacs, we use overlays to hide text (so-called "invisibility
     2137;; overlays").  In addition to their `invisible' property, they have the
     2138;; `singular-invisible' property set.  Setting the intangible property does
     2139;; not work very well for Emacs.  We use the variable
     2140;; `line-move-ignore-invisible' which works quite well.
     2141
     2142(defun singular-emacs-folding-fold-internal (section)
     2143  "Fold section SECTION.
     2144SECTION should end in a newline.  That terminal newline is not
     2145folded or otherwise ellipsis does not appear.
     2146SECTION should be unfolded."
     2147  (let* ((start (singular-section-start section))
     2148         ;; do not make trailing newline invisible
     2149         (end (1- (singular-section-end section)))
     2150         invisibility-overlay)
     2151    ;; create new overlay and add properties
     2152    (setq invisibility-overlay (make-overlay start end))
     2153    ;; mark them as invisibility overlays
     2154    (overlay-put invisibility-overlay 'singular-invisible t)
     2155    ;; set invisible properties
     2156    (overlay-put invisibility-overlay 'invisible 'singular-interactive-mode)
     2157    ;; evaporate empty invisibility overlays
     2158    (overlay-put invisibility-overlay 'evaporate t)))
     2159
     2160(defun singular-emacs-folding-unfold-internal (section &optional invisibility-overlay)
     2161  "Unfold section SECTION.
     2162SECTION should be folded.
     2163If optional argument INVISIBILITY-OVERLAY is non-nil it should be the
     2164invisibility overlay of the section to unfold."
     2165  (let ((invisibility-overlay
     2166         (or invisibility-overlay
     2167             (singular-emacs-folding-foldedp-internal section))))
     2168    ;; to keep number of overlays low we delete it
     2169    (delete-overlay invisibility-overlay)))
     2170
     2171(defun singular-emacs-folding-foldedp-internal (section)
     2172  "Returns non-nil iff SECTION is folded.
     2173More specifically, returns the invisibility overlay if there is one.
     2174Narrowing has no effect on this function."
     2175  (let* ((start (singular-section-start section))
     2176         (overlays (overlays-at start))
     2177         invisibility-overlay)
     2178    ;; check for invisibility overlay
     2179    (while (and overlays (not invisibility-overlay))
     2180      (if (overlay-get (car overlays) 'singular-invisible)
     2181          (setq invisibility-overlay (car overlays))
     2182        (setq overlays (cdr overlays))))
     2183    invisibility-overlay))
     2184;;}}}
     2185
     2186;;{{{ Folding sections for XEmacs
     2187
     2188;; Note:
     2189;;
     2190;; For XEmacs, we use extents to hide text (so-called "invisibility
     2191;; extents").  In addition to their `invisible' property, they have the
     2192;; `singular-invisible' property set.  To ignore invisible text we use the
     2193;; variable `line-move-ignore-invisible' which works quite well.
     2194
     2195(defun singular-xemacs-folding-fold-internal (section)
     2196  "Fold section SECTION.
     2197SECTION should end in a newline.  That terminal newline is not
     2198folded or otherwise ellipsis does not appear.
     2199SECTION should be unfolded."
     2200  (let* ((start (singular-section-start section))
     2201         ;; do not make trailing newline invisible
     2202         (end (1- (singular-section-end section)))
     2203         invisibility-extent)
     2204    ;; create new extent and add properties
     2205    (setq invisibility-extent (make-extent start end))
     2206    ;; mark them as invisibility extents
     2207    (set-extent-property invisibility-extent 'singular-invisible t)
     2208    ;; set invisible properties
     2209    (set-extent-property invisibility-extent 'invisible 'singular-interactive-mode)))
     2210
     2211(defun singular-xemacs-folding-unfold-internal (section &optional invisibility-extent)
     2212  "Unfold section SECTION.
     2213SECTION should be folded.
     2214If optional argument INVISIBILITY-EXTENT is non-nil it should be the
     2215invisibility extent of the section to unfold."
     2216  (let ((invisibility-extent
     2217         (or invisibility-extent
     2218             (singular-xemacs-folding-foldedp-internal section))))
     2219    ;; to keep number of extents low we delete it
     2220    (delete-extent invisibility-extent)))
     2221
     2222(defun singular-xemacs-folding-foldedp-internal (section)
     2223  "Returns non-nil iff SECTION is folded.
     2224More specifically, returns the invisibility extent if there is one.
     2225Narrowing has no effect on this function."
     2226  ;; do not try to use `extent-at' at this point.  `extent-at' does not
     2227  ;; return extents outside narrowed text.
     2228  (let* ((start (singular-section-start section))
     2229         (invisibility-extent (map-extents
     2230                            (function (lambda (ext args) ext))
     2231                            nil start start nil nil 'singular-invisible)))
     2232    invisibility-extent))
     2233;;}}}
     2234
     2235;;{{{ Online help
     2236
     2237;; Note:
     2238;;
     2239;; Catching user's help commands to Singular and translating them to calls
     2240;; to `info' is quite a difficult task due to the asynchronous
     2241;; communication with Singular.  We use an heuristic approach which should
     2242;; work in most cases:
     2243
     2244(require 'info)
     2245
     2246(defcustom singular-help-same-window 'default
     2247  "Specifies how to open the window for Singular online help.
     2248If this variable equals `default', the standard Emacs behaviour to open the
     2249Info buffer is adopted (which very much depends on the settings of
     2250`same-window-buffer-names').
     2251If this variable is non-nil, Singular online help comes up in the selected
     2252window.
     2253If this variable equals nil, Singular online help comes up in another
     2254window."
     2255  :initialize 'custom-initialize-default
     2256  :type '(choice (const :tag "This window" t)
     2257                 (const :tag "Other window" nil)
     2258                 (const :tag "Default" default))
     2259  :group 'singular-interactive-miscellaneous)
     2260
     2261(defcustom singular-help-explicit-file-name nil
     2262  "Specifies the file name of the Singular online manual.
     2263If non-nil, this variable overrides all other possible ways to determine
     2264the file name of the Singular online manual.
     2265For more information one should refer to the `singular-help' function."
     2266  :initialize 'custom-initialize-default
     2267  :type 'file
     2268  :group 'singular-interactive-miscellaneous)
     2269
     2270(defvar singular-help-time-stamp 0
     2271  "A time stamp set by `singular-help-pre-input-hook'.
     2272This time stamp is set to `(current-time)' when the user issues a help
     2273command.  To be true, not the whole time stamp is stored, only the less
     2274significant half.
     2275
     2276This variable is buffer-local.")
     2277
     2278(defvar singular-help-response-pending nil
     2279  "If non-nil, Singulars response has not been completely received.
     2280
     2281This variable is buffer-local.")
     2282
     2283(defvar singular-help-topic nil
     2284  "If non-nil, contains help topic to dhow in post output filter.
     2285
     2286This variable is buffer-local.")
     2287
     2288(defconst singular-help-command-regexp "^\\s-*shelp\\>"
     2289  "Regular expression to match Singular help commands.")
     2290
     2291(defconst singular-help-response-line-1
     2292  "^Your help command could not be executed.  Use\n"
     2293  "Regular expression that matches the first line of Singulars response.")
     2294
     2295(defconst singular-help-response-line-2
     2296  "^C-h C-s \\(.*\\)\n")
     2297
     2298(defconst singular-help-response-line-3
     2299  "^to enter the Singular online help\.  For general\n"
     2300  "Regular expression that matches the first line of Singulars response.")
     2301
     2302(defconst singular-help-response-line-4
     2303  "^information on Singular running on Emacs, type C-h m\.\n"
     2304  "Regular expression that matches the first line of Singulars response.")
     2305
     2306(defun singular-help-pre-input-filter (input)
     2307  "Check user's input for help commands.
     2308Sets time stamp if one is found."
     2309  (if (string-match singular-help-command-regexp input)
     2310      (setq singular-help-time-stamp (cadr (current-time))))
     2311  ;; return nil so that input passes unchanged
     2312  nil)
     2313
     2314(defun singular-help-pre-output-filter (output)
     2315  "Check for Singular's response on a help command.
     2316Removes it and fires up `(info)' to handle the help command."
     2317  ;; check first
     2318  ;; - whether a help statement has been issued less than one second ago, or
     2319  ;; - whether there is a pending response.
     2320  ;;
     2321  ;; Only if one of these conditions is met we go on and check text for a
     2322  ;; response on a help command.  Checking uncoditionally every piece of
     2323  ;; output would be far too expensive.
     2324  ;;
     2325  ;; If check fails nil is returned, what is exactly what we need for the
     2326  ;; filter.
     2327  (if (or (= (cadr (current-time)) singular-help-time-stamp)
     2328          singular-help-response-pending)
     2329      ;; if response is pending for more than five seconds, give up
     2330      (if (and singular-help-response-pending
     2331               (> (singular-time-stamp-difference (current-time) singular-help-time-stamp) 5))
     2332          ;; this command returns nil, what is exactly what we need for the filter
     2333          (setq singular-help-response-pending nil)
     2334          ;; go through output, removing the response.  If there is a
     2335          ;; pending response we nevertheless check for all lines, not only
     2336          ;; for the pending one.  At last, pending responses should not
     2337          ;; occur to often.
     2338          (when (string-match singular-help-response-line-1 output)
     2339            (setq output (replace-match "" t t output))
     2340            (setq singular-help-response-pending t))
     2341          (when (string-match singular-help-response-line-2 output)
     2342            ;; after all, we found what we are looking for
     2343            (setq singular-help-topic (substring output (match-beginning 1) (match-end 1)))
     2344            (setq output (replace-match "" t t output))
     2345            (setq singular-help-response-pending t))
     2346          (when (string-match singular-help-response-line-3 output)
     2347            (setq output (replace-match "" t t output))
     2348            (setq singular-help-response-pending t))
     2349          (when (string-match singular-help-response-line-4 output)
     2350            (setq output (replace-match "" t t output))
     2351            ;; we completely removed the help from output!
     2352            (setq singular-help-response-pending nil))
     2353
     2354          ;; return modified OUTPUT
     2355          output)))
     2356
     2357(defun singular-help-post-output-filter (&rest ignore)
     2358  (when singular-help-topic
     2359    (save-excursion (singular-help singular-help-topic))
     2360    (setq singular-help-topic nil)))
     2361
     2362(defun singular-help (&optional help-topic)
     2363  "Show help on HELP-TOPIC in Singular online manual."
     2364 
     2365  (interactive "s")
     2366
     2367  ;; check for empty help topic and convert it to top node
     2368  (if (or (null help-topic) (string= help-topic ""))
     2369      (setq help-topic "Top"))
     2370
     2371  (let ((same-window-buffer-names
     2372         (cond
     2373          ((null singular-help-same-window)
     2374           nil)
     2375          ((eq singular-help-same-window 'default)
     2376           same-window-buffer-names)
     2377          (t
     2378           '("*info*"))))
     2379        (node-name (concat "(" (or singular-help-explicit-file-name
     2380                                   singular-help-file-name)
     2381                           ")" help-topic)))
     2382    (pop-to-buffer "*info*")
     2383    (Info-goto-node node-name)))
     2384   
     2385
     2386(defun singular-help-init ()
     2387  "Initialize online help support for Singular interactive mode.
     2388
     2389This function is called at mode initialization time."
     2390  (make-local-variable 'singular-help-time-stamp)
     2391  (make-local-variable 'singular-help-response-pending)
     2392  (make-local-variable 'singular-help-topic)
     2393  (add-hook 'singular-pre-input-filter-functions 'singular-help-pre-input-filter)
     2394  (add-hook 'singular-pre-output-filter-functions 'singular-help-pre-output-filter)
     2395  (add-hook 'singular-post-output-filter-functions 'singular-help-post-output-filter))
     2396;;}}}
     2397
     2398;;{{{ Debugging filters
     2399(defun singular-debug-pre-input-filter (string)
     2400  "Display STRING and some markers in mini-buffer."
     2401  (singular-debug 'interactive-filter
     2402                  (message "Pre-input filter: %s (li %S ci %S lo %S co %S)"
     2403                           (singular-debug-format string)
     2404                           (marker-position singular-last-input-section-start)
     2405                           (marker-position singular-current-input-section-start)
     2406                           (marker-position singular-last-output-section-start)
     2407                           (marker-position singular-current-output-section-start)))
     2408  nil)
     2409
     2410(defun singular-debug-post-input-filter (beg end)
     2411  "Display BEG, END, and some markers in mini-buffer."
     2412  (singular-debug 'interactive-filter
     2413                  (message "Post-input filter: (beg %S end %S) (li %S ci %S lo %S co %S)"
     2414                           beg end
     2415                           (marker-position singular-last-input-section-start)
     2416                           (marker-position singular-current-input-section-start)
     2417                           (marker-position singular-last-output-section-start)
     2418                           (marker-position singular-current-output-section-start))))
     2419
     2420(defun singular-debug-pre-output-filter (string)
     2421  "Display STRING and some markers in mini-buffer."
     2422  (singular-debug 'interactive-filter
     2423                  (message "Pre-output filter: %s (li %S ci %S lo %S co %S)"
     2424                           (singular-debug-format string)
     2425                           (marker-position singular-last-input-section-start)
     2426                           (marker-position singular-current-input-section-start)
     2427                           (marker-position singular-last-output-section-start)
     2428                           (marker-position singular-current-output-section-start)))
     2429  nil)
     2430
     2431(defun singular-debug-post-output-filter (beg end simple-sec-start)
     2432  "Display BEG, END, SIMPLE-SEC-START, and some markers in mini-buffer."
     2433  (singular-debug 'interactive-filter
     2434                  (message "Post-output filter: (beg %S end %S sss %S) (li %S ci %S lo %S co %S)"
     2435                           beg end simple-sec-start
     2436                           (marker-position singular-last-input-section-start)
     2437                           (marker-position singular-current-input-section-start)
     2438                           (marker-position singular-last-output-section-start)
     2439                           (marker-position singular-current-output-section-start))))
     2440
     2441(defun singular-debug-filter-init ()
     2442  "Add debug filters to the necessary hooks.
     2443
     2444This function is called at mode initialization time."
     2445  (add-hook 'singular-pre-input-filter-functions
     2446            'singular-debug-pre-input-filter nil t)
     2447  (add-hook 'singular-post-input-filter-functions
     2448            'singular-debug-post-input-filter nil t)
     2449  (add-hook 'singular-pre-output-filter-functions
     2450            'singular-debug-pre-output-filter nil t)
     2451  (add-hook 'singular-post-output-filter-functions
     2452            'singular-debug-post-output-filter nil t))
     2453;;}}}
     2454
     2455;;{{{ Demo mode
     2456(defcustom singular-demo-chunk-regexp "\\(\n\\s *\n\\)"
     2457  "Regular expressions to recognize separate chunks of a demo file.
     2458If there is a subexpression specified its contents is removed when the
     2459chunk is displayed.
     2460The default value is \"\\\\(\\n\\\\s *\\n\\\\)\" which means that chunks are
     2461separated by a blank line which is removed when the chunks are displayed."
     2462  :type 'regexp
     2463  :group 'singular-demo-mode)
     2464
     2465(defcustom singular-demo-insert-into-history nil
     2466  "If non-nil, insert input into history even while demo mode is on.
     2467Otherwise, demo chunks and other commands executed during demo mode are not
     2468inserted into the history."
     2469  :type 'boolean
     2470  :group 'singular-demo-mode)
     2471
     2472(defcustom singular-demo-print-messages nil
     2473  "If non-nil, print message on how to continue demo mode."
     2474  :type 'boolean
     2475  :group 'singular-demo-mode)
     2476
     2477(defcustom singular-demo-exit-on-load nil
     2478  "If non-nil, a running demo is automatically discarded when a new one is loaded.
     2479Otherwise, the load is aborted with an error."
     2480  :type 'boolean
     2481  :group 'singular-demo-mode)
     2482
     2483(defcustom singular-demo-load-directory nil
     2484  "Directory where demo files reside.
     2485If non-nil, this directory is offered as a starting point to search for
     2486demo files when `singular-demo-load' is called interactively.
     2487If this variable equals nil whatever Emacs offers is used as starting
     2488point.  In general, this is the directory where Singular has been started
     2489in."
     2490  :type '(choice (const nil) (file))
     2491  :group 'singular-demo-mode)
     2492
     2493(defvar singular-demo-mode nil
     2494  "Non-nil if Singular demo mode is on.
     2495
     2496This variable is buffer-local.")
     2497
     2498(defvar singular-demo-old-mode-name nil
     2499  "Used to store previous `mode-name' before switching to demo mode.
     2500
     2501This variable is buffer-local.")
     2502
     2503(defvar singular-demo-end nil
     2504  "Marker pointing to end of demo file.
     2505
     2506This variable is buffer-local.")
     2507
     2508(defun singular-demo-load (demo-file)
     2509  "Load demo file DEMO-FILE and enter Singular demo mode.
     2510NOT READY."
     2511  (interactive
     2512   (list
     2513    (cond
     2514     ;; Emacs
     2515     ((eq singular-emacs-flavor 'emacs)
     2516      (read-file-name "Load demo file: "
     2517                      singular-demo-load-directory
     2518                      nil t))
     2519     ;; XEmacs
     2520     (t
     2521      ;; there are some problems with the window being popped up when this
     2522      ;; function is called from a menu.  It does not display the contents
     2523      ;; of `singular-demo-load-directory' but of `default-directory'.
     2524      (let ((default-directory (or singular-demo-load-directory
     2525                                   default-directory)))
     2526        (read-file-name "Load demo file: "
     2527                        singular-demo-load-directory
     2528                        nil t))))))
     2529
     2530  ;; check for running demo
     2531  (if singular-demo-mode
     2532      (if singular-demo-exit-on-load
     2533          ;; silently exit running demo
     2534          (singular-demo-exit)
     2535        (error "There already is a demo running, exit with `singular-demo-exit' first")))
     2536
     2537  ;; load new demo
     2538  (let ((old-point-min (point-min)))
     2539    (unwind-protect
     2540        (progn
     2541          (goto-char (point-max))
     2542          (widen)
     2543          (cond
     2544           ;; XEmacs
     2545           ((eq singular-emacs-flavor 'xemacs)
     2546            ;; load file and remember its end
     2547            (set-marker singular-demo-end
     2548                        (+ (point) (nth 1 (insert-file-contents-literally demo-file)))))
     2549           ;; Emacs
     2550           (t
     2551            ;; Emacs does something like an `insert-before-markers' so
     2552            ;; save all essential markers
     2553            (let ((pmark-pos (marker-position (singular-process-mark)))
     2554                  (sliss-pos (marker-position singular-last-input-section-start))
     2555                  (sciss-pos (marker-position singular-current-input-section-start))
     2556                  (sloss-pos (marker-position singular-last-output-section-start))
     2557                  (scoss-pos (marker-position singular-current-output-section-start)))
     2558
     2559              (unwind-protect
     2560                  ;; load file and remember its end
     2561                  (set-marker singular-demo-end
     2562                              (+ (point) (nth 1 (insert-file-contents-literally demo-file))))
     2563
     2564                ;; restore markers.
     2565                ;; This is unwind-protected.
     2566                (set-marker (singular-process-mark) pmark-pos)
     2567                (set-marker singular-last-input-section-start sliss-pos)
     2568                (set-marker singular-current-input-section-start sciss-pos)
     2569                (set-marker singular-last-output-section-start sloss-pos)
     2570                (set-marker singular-current-output-section-start scoss-pos))))))
     2571
     2572      ;; completely hide demo file.
     2573      ;; This is unwind-protected.
     2574      (narrow-to-region old-point-min (point))))
     2575
     2576  ;; switch demo mode on
     2577  (setq singular-demo-old-mode-name mode-name
     2578        mode-name "Singular Demo"
     2579        singular-demo-mode t)
     2580  (run-hooks 'singular-demo-mode-enter-hook)
     2581  (if singular-demo-print-messages (message "Hit RET to start demo"))
     2582  (force-mode-line-update))
     2583
     2584(defun singular-demo-exit-internal ()
     2585  "Exit Singular demo mode.
     2586Recovers the old mode name, sets `singular-demo-mode' to nil, runs
     2587the hooks on `singular-demo-mode-exit-hook'."
     2588  (setq mode-name singular-demo-old-mode-name
     2589        singular-demo-mode nil)
     2590  (run-hooks 'singular-demo-mode-exit-hook)
     2591  (force-mode-line-update))
     2592
     2593(defun singular-demo-exit ()
     2594  "Prematurely exit Singular demo mode.
     2595Cleans up everything that is left from the demo.
     2596Runs the hooks on `singular-demo-mode-exit-hook'.
     2597Does nothing when Singular demo mode is turned off."
     2598  (interactive)
     2599  (when singular-demo-mode
     2600    ;; clean up hidden rest of demo file
     2601    (let ((old-point-min (point-min))
     2602          (old-point-max (point-max)))
     2603      (unwind-protect
     2604          (progn
     2605            (widen)
     2606            (delete-region old-point-max singular-demo-end))
     2607        ;; this is unwind-protected
     2608        (narrow-to-region old-point-min old-point-max)))
     2609    (singular-demo-exit-internal)))
     2610
     2611(defun singular-demo-show-next-chunk ()
     2612  "Show next chunk of demo file at input prompt.
     2613Assumes that Singular demo mode is on.
     2614Moves point to end of buffer and widenes the buffer such that the next
     2615chunk of the demo file becomes visible.
     2616Finds and removes chunk separators as specified by
     2617`singular-demo-chunk-regexp'.
     2618Leaves demo mode after showing last chunk.  In that case runs hooks on
     2619`singular-demo-mode-exit-hook'."
     2620  (let ((old-point-min (point-min)))
     2621    (unwind-protect
     2622        (progn
     2623          (goto-char (point-max))
     2624          (widen)
     2625          (if (re-search-forward singular-demo-chunk-regexp singular-demo-end 'limit)
     2626              (if (match-beginning 1)
     2627                  (delete-region (match-beginning 1) (match-end 1)))
     2628            ;; remove trailing white-space.  We may not use
     2629            ;; `(skip-syntax-backward "-")' since newline is has no white
     2630            ;; space syntax.  The solution down below should suffice in
     2631            ;; almost all cases ...
     2632            (skip-chars-backward " \t\n\r")
     2633            (delete-region (point) singular-demo-end)
     2634            (singular-demo-exit-internal)))
     2635
     2636      ;; this is unwind-protected
     2637      (narrow-to-region old-point-min (point)))))
     2638
     2639(defun singular-demo-mode-init ()
     2640  "Initialize variables belonging to Singular demo mode.
     2641Creates some buffer-local variables and the buffer-local marker
     2642`singular-demo-end'.
     2643
     2644This function is called  at mode initialization time."
     2645  (make-local-variable 'singular-demo-mode)
     2646  (make-local-variable 'singular-demo-mode-old-name)
     2647  (make-local-variable 'singular-demo-mode-end)
     2648  (if (not (and (boundp 'singular-demo-end)
     2649                singular-demo-end))
     2650      (setq singular-demo-end (make-marker))))
     2651;;}}}
     2652     
     2653;;{{{ Some lengthy notes on input and output
     2654
     2655;; NOT READY[so sorry]!
     2656
    11342657;;}}}
    11352658
     
    11422665        (last-input-end (marker-position singular-current-output-section-start)))
    11432666    (cond ((and last-input-start last-input-end)
    1144            (vector (singular-simple-sec-at last-input-start) 'input
    1145                    last-input-start last-input-end))
     2667           (singular-section-create (singular-simple-sec-at last-input-start) 'input
     2668                                    last-input-start last-input-end))
    11462669          (no-error nil)
    11472670          (t (error "No last input section defined")))))
     
    11532676  (let ((current-output-start (marker-position singular-current-output-section-start))
    11542677        (current-output-end (save-excursion
    1155                               (goto-char (singular-process-mark))
    1156                               (singular-skip-prompt-backward)
    1157                               (and (bolp) (point)))))
     2678                              (save-restriction
     2679                                (widen)
     2680                                (goto-char (singular-process-mark))
     2681                                (singular-skip-prompt-backward)
     2682                                (and (bolp) (point))))))
    11582683    (cond ((and current-output-start current-output-end)
    1159            (vector (singular-simple-sec-at current-output-start) 'output
    1160                    current-output-start current-output-end))
     2684           (singular-section-create (singular-simple-sec-at current-output-start) 'output
     2685                                    current-output-start current-output-end))
    11612686          (no-error nil)
    11622687          (t (error "No current output section defined")))))
     
    11692694        (last-output-end (marker-position singular-last-input-section-start)))
    11702695    (cond ((and last-output-start last-output-end)
    1171            (vector (singular-simple-sec-at last-output-start) 'output
    1172                    last-output-start last-output-end))
     2696           (singular-section-create (singular-simple-sec-at last-output-start) 'output
     2697                                    last-output-start last-output-end))
    11732698          (no-error nil)
    11742699          (t (error "No last output section defined")))))
     
    11852710          nil
    11862711        (error "No latest output section defined"))))
    1187 ;;}}}
    1188 
    1189 ;;{{{ Folding sections
    1190 (defvar singular-folding-ellipsis "Singular I/O ..."
    1191   "Ellipsis to show for folded input or output.")
    1192 
    1193 (defun singular-fold-internal (start end fold)
    1194   "(Un)fold region from START to END.
    1195 Folds if FOLD is non-nil, otherwise unfolds.
    1196 Folding affects undo information and buffer modified flag.
    1197 Assumes that there is no narrowing in effect."
    1198   (save-excursion
    1199     (if fold
    1200         (progn
    1201           (goto-char start) (insert ?\r)
    1202           (subst-char-in-region start end ?\n ?\r t))
    1203       (subst-char-in-region start end ?\r ?\n t)
    1204       (goto-char start) (delete-char 1))))
    1205 
    1206 (defun singular-section-foldedp (section)
    1207   "Return t iff SECTION is folded.
    1208 Assumes that there is no narrowing in effect."
    1209   (eq (char-after (singular-section-start section)) ?\r))
    1210 
    1211 (defun singular-fold-section (section)
    1212   "\(Un)fold SECTION.
    1213 \(Un)folds section at point and goes to beginning of section if called
    1214 interactively.
    1215 Unfolds folded sections and folds unfolded sections."
    1216   (interactive (list (singular-section-at (point))))
    1217   (let ((start (singular-section-start section))
    1218         ;; we have to save restrictions this way since we change text
    1219         ;; outside the restriction.  Note that we do not use a marker for
    1220         ;; `old-point-min'.  This way, even partial narrowed sections are
    1221         ;; folded properly if they have been narrowed at bol.  Nice but
    1222         ;; dirty trick: The insertion of a `?\r' at beginning of section
    1223         ;; advances the beginning of the restriction such that it displays
    1224         ;; the `?\r' immediately before bol.  Seems worth it.
    1225         (old-point-min (point-min))
    1226         (old-point-max (point-max-marker)))
    1227     (unwind-protect
    1228         (progn
    1229           (widen)
    1230           (singular-fold-internal start (singular-section-end section)
    1231                                   (not (singular-section-foldedp section))))
    1232       ;; this is unwide-protected
    1233       (narrow-to-region old-point-min old-point-max)
    1234       (set-marker old-point-max nil))
    1235     (if (interactive-p) (goto-char (max start (point-min))))))
    1236 
    1237 (defun singular-do-folding (where &optional unfold)
    1238   "Fold or unfold certain sections.
    1239 WHERE may be 'last, 'all, or 'at-point. If WHERE equals 'last or
    1240 'all, only output sections are affected. If WHERE equals 'at-point,
    1241 the section at point is affected (input or output).
    1242 If optional argument UNFOLD is non-nil, then unfold section instead
    1243 of folding it."
    1244   (let (which)
    1245     (cond
    1246      ((eq where 'last)
    1247       (setq which (list (singular-latest-output-section t))))
    1248 
    1249      ((eq where 'at-point)
    1250       (setq which (list (singular-section-at (point)))))
    1251 
    1252      ((eq where 'all)
    1253       (setq which (singular-section-in (point-min) (point-max)))
    1254 
    1255       ;; just use the output sections:
    1256       (let (newwhich)
    1257         (while which
    1258           (if (eq (singular-section-type (car which)) 'output)
    1259               (setq newwhich (append (list (car which)) newwhich)))
    1260           (setq which (cdr which)))
    1261         (setq which newwhich)))
    1262 
    1263      (t
    1264       (singular-debug 'interactive
    1265                       (message "singular-do-folding: wrong argument"))))
    1266     (while which
    1267       (let* ((current (car which))
    1268             (is-folded (singular-section-foldedp current)))
    1269         (and (if unfold is-folded (not is-folded))
    1270              (singular-fold-section current)))
    1271       (setq which (cdr which))))
    1272   ;; NOT READY: HACK: recenter (because of error in subst-char-in-region!?!)
    1273   (recenter))
    1274 
    1275 (defun singular-fold-last-output ()
    1276   "Fold last output section.
    1277 If it is already folded, do nothing."
    1278   (interactive)
    1279   (singular-do-folding 'last))
    1280 
    1281 (defun singular-fold-all-output ()
    1282   "Fold all output sections."
    1283   (interactive)
    1284   (singular-do-folding 'all))
    1285 
    1286 (defun singular-fold-at-point
    1287   "Fold section at point (input or output section).
    1288 If it is already folded, do nothing."
    1289   (interactive)
    1290   (singular-do-folding 'at-point))
    1291 
    1292 (defun singular-unfold-last-output ()
    1293   "Unfold last output section.
    1294 If it is already unfolded, do nothing."
    1295   (interactive)
    1296   (singular-do-folding 'last 'unfold))
    1297 
    1298 (defun singular-unfold-all-output ()
    1299   "Unfold all output section."
    1300   (interactive)
    1301   (singular-do-folding 'all 'unfold))
    1302 
    1303 (defun singular-unfold-at-point ()
    1304   "Unfold section at point (input or output section).
    1305 If it is already unfolded, do nothing."
    1306   (interactive)
    1307   (singular-do-folding 'at-point 'unfold))
    1308 ;;}}}
    1309 
    1310 ;;{{{ Input and output filters
    1311 
    1312 ;; debugging filters
    1313 (defun singular-debug-pre-input-filter (string)
    1314   "Display STRING and some markers in mini-buffer."
    1315   (singular-debug 'interactive-filter
    1316                   (message "Pre-input filter: %s"
    1317                            (singular-debug-format string)))
    1318   (singular-debug 'interactive-filter
    1319                   (message "Pre-input filter: (li %S ci %S lo %S co %S)"
    1320                            (marker-position singular-last-input-section-start)
    1321                            (marker-position singular-current-input-section-start)
    1322                            (marker-position singular-last-output-section-start)
    1323                            (marker-position singular-current-output-section-start)))
    1324   nil)
    1325 
    1326 (defun singular-debug-post-input-filter (beg end)
    1327   "Display BEG, END, and some markers in mini-buffer."
    1328   (singular-debug 'interactive-filter
    1329                   (message "Post-input filter: (beg %S end %S)" beg end))
    1330   (singular-debug 'interactive-filter
    1331                   (message "Post-input filter: (li %S ci %S lo %S co %S)"
    1332                            (marker-position singular-last-input-section-start)
    1333                            (marker-position singular-current-input-section-start)
    1334                            (marker-position singular-last-output-section-start)
    1335                            (marker-position singular-current-output-section-start))))
    1336 
    1337 (defun singular-debug-pre-output-filter (string)
    1338   "Display STRING and some markers in mini-buffer."
    1339   (singular-debug 'interactive-filter
    1340                   (message "Pre-output filter: %s"
    1341                            (singular-debug-format string)))
    1342   (singular-debug 'interactive-filter
    1343                   (message "Pre-output filter: (li %S ci %S lo %S co %S)"
    1344                            (marker-position singular-last-input-section-start)
    1345                            (marker-position singular-current-input-section-start)
    1346                            (marker-position singular-last-output-section-start)
    1347                            (marker-position singular-current-output-section-start)))
    1348   nil)
    1349 
    1350 (defun singular-debug-post-output-filter (beg end simple-sec-start)
    1351   "Display BEG, END, SIMPLE-SEC-START, and some markers in mini-buffer."
    1352   (singular-debug 'interactive-filter
    1353                   (message "Post-output filter: (beg %S end %S sss %S)"
    1354                            beg end simple-sec-start))
    1355   (singular-debug 'interactive-filter
    1356                   (message "Post-output filter: (li %S ci %S lo %S co %S)"
    1357                            (marker-position singular-last-input-section-start)
    1358                            (marker-position singular-current-input-section-start)
    1359                            (marker-position singular-last-output-section-start)
    1360                            (marker-position singular-current-output-section-start))))
    1361 
    1362 ;; stripping prompts
    1363 (defun singular-remove-prompt-filter (beg end simple-sec-start)
    1364   "Strip prompts from last simple section."
    1365   (if simple-sec-start (singular-remove-prompt simple-sec-start end)))
    1366 ;;}}}
    1367 
    1368 ;;{{{ Demo mode
    1369 (defvar singular-demo-chunk-regexp "\\(\n\n\\)"
    1370   "Regular expressions to recognize chunks of a demo file.
    1371 If there is a subexpression specified its content is removed when the
    1372 chunk is displayed.")
    1373 
    1374 (defvar singular-demo-print-messages t
    1375   "If non-nil, print message on how to continue demo mode")
    1376 
    1377 (defvar singular-demo-mode nil
    1378   "Non-nil if Singular demo mode is on.
    1379 
    1380 This variable is buffer-local.")
    1381 
    1382 (defvar singular-demo-old-mode-name nil
    1383   "Used to store previous `mode-name' before switching to demo mode.
    1384 
    1385 This variable is buffer-local.")
    1386 
    1387 (defvar singular-demo-end nil
    1388   "Marker pointing to end of demo file.
    1389 
    1390 This variable is buffer-local.")
    1391 
    1392 (defvar singular-demo-command-on-enter nil
    1393   "Singular command to send when entering demo mode or nil if no string to send.")
    1394 
    1395 (defvar singular-demo-command-on-leave nil
    1396   "Singular command to send when leaving demo mode or nil if no string to send.")
    1397  
    1398 (defun singular-demo-mode (mode)
    1399   "Switch between demo mode states.
    1400 MODE may be either:
    1401 - `init' to initialize global variables;
    1402 - `exit' to clean up demo and leave Singular demo mode;
    1403 - `enter' to enter Singular demo mode;
    1404 - `leave' to leave Singular demo mode.
    1405 
    1406 Modifies the global variables `singular-demo-mode',
    1407 `singular-demo-end', and `singular-demo-old-mode-name' to reflect the
    1408 new state of Singular demo mode."
    1409   (cond
    1410    ;; initialization.  Should be called only once.
    1411    ((eq mode 'init)
    1412     (make-local-variable 'singular-demo-mode)
    1413     (make-local-variable 'singular-demo-mode-old-name)
    1414     (make-local-variable 'singular-demo-mode-end)
    1415     (if (not (and (boundp 'singular-demo-end)
    1416                   singular-demo-end))
    1417         (setq singular-demo-end (make-marker))))
    1418 
    1419    ;; final exit.  Clean up demo.
    1420    ((and (eq mode 'exit)
    1421          singular-demo-mode)
    1422     (setq mode-name singular-demo-old-mode-name
    1423           singular-demo-mode nil)
    1424     ;; clean up hidden rest of demo file if existent
    1425     (let ((old-point-min (point-min))
    1426           (old-point-max (point-max)))
    1427       (unwind-protect
    1428           (progn
    1429             (widen)
    1430             (delete-region old-point-max singular-demo-end))
    1431         ;; this is unwide-protected
    1432         (narrow-to-region old-point-min old-point-max)))
    1433     (if (and singular-demo-command-on-leave
    1434              (singular-process))
    1435         (send-string (singular-process) singular-demo-command-on-leave))
    1436     (force-mode-line-update))
    1437 
    1438    ;; enter demo mode
    1439    ((and (eq mode 'enter)
    1440          (not singular-demo-mode))
    1441     (setq singular-demo-old-mode-name mode-name
    1442           mode-name "Singular Demo"
    1443           singular-demo-mode t)
    1444     (if singular-demo-command-on-enter
    1445         (send-string (singular-process) singular-demo-command-on-enter))
    1446     (if singular-demo-print-messages
    1447         (message "Hit RET to start demo"))
    1448     (force-mode-line-update))
    1449 
    1450    ;; leave demo mode
    1451    ((and (eq mode 'leave)
    1452          singular-demo-mode)
    1453     (setq mode-name singular-demo-old-mode-name
    1454           singular-demo-mode nil)
    1455     (if singular-demo-command-on-leave
    1456         (send-string (singular-process) singular-demo-command-on-leave))
    1457     (force-mode-line-update))))
    1458 
    1459 (defun singular-demo-exit ()
    1460   "Prematurely exit singular demo mode."
    1461   (interactive)
    1462   (singular-demo-mode 'exit))
    1463 
    1464 (defun singular-demo-show-next-chunk ()
    1465   "Show next chunk of demo file at input prompt.
    1466 Moves point to end of buffer and widenes the buffer such that the next
    1467 chunk of the demo file becomes visible.
    1468 Finds and removes chunk separators as specified by
    1469 `singular-demo-chunk-regexp'.
    1470 Removing chunk separators affects undo information and buffer-modified
    1471 flag.
    1472 Leaves demo mode after showing last chunk."
    1473   (let ((old-point-min (point-min)))
    1474     (unwind-protect
    1475         (progn
    1476           (goto-char (point-max))
    1477           (widen)
    1478           (if (re-search-forward singular-demo-chunk-regexp singular-demo-end 'limit)
    1479               (and (match-beginning 1)
    1480                    (delete-region (match-beginning 1) (match-end 1)))
    1481             ;; remove trailing white-space
    1482             (skip-syntax-backward "-")
    1483             (delete-region (point) singular-demo-end)
    1484             (singular-demo-mode 'leave)))
    1485 
    1486       ;; this is unwind-protected
    1487       (narrow-to-region old-point-min (point)))))
    1488 
    1489 (defun singular-demo-load (demo-file)
    1490   "Load demo file DEMO-FILE and enter Singular demo mode.
    1491 For a description of the Singular demo mode one should refer to the
    1492 doc-string of `singular-interactive-mode'.
    1493 Moves point to end of buffer and inserts contents of DEMO-FILE there."
    1494   (interactive "fLoad demo file: ")
    1495 
    1496   ;; check for running demo
    1497   (and singular-demo-mode
    1498        (singular-demo-exit))
    1499 
    1500   (let ((old-point-min (point-min)))
    1501     (unwind-protect
    1502         (progn
    1503           (goto-char (point-max))
    1504           (widen)
    1505           ;; load file and remember its end
    1506           (set-marker singular-demo-end
    1507                       (+ (point) (nth 1 (insert-file-contents demo-file)))))
    1508 
    1509       ;; completely hide demo file.
    1510       ;; This is unwide protected.
    1511       (narrow-to-region old-point-min (point)))
    1512 
    1513     ;; switch demo mode on
    1514     (singular-demo-mode 'enter)))
    1515 ;;}}}
    1516      
    1517 ;;{{{ Some lengthy notes on input and output
    1518 
    1519 ;; NOT READY[so sorry]!
    1520 
    15212712;;}}}
    15222713
     
    16302821                ;; get end of last simple section (equals start of
    16312822                ;; current)
    1632                       simple-sec-start (marker-position singular-simple-sec-last-end))
     2823                      simple-sec-start (singular-simple-sec-last-end-position))
    16332824
    16342825                ;; prepare for insertion
     
    16862877    (save-excursion
    16872878      (beginning-of-line)
    1688       (singular-skip-prompt-forward)
     2879      (singular-prompt-skip-forward)
    16892880      (let ((old-point (point)))
    16902881        (end-of-line)
     
    17242915           (message "Hit RET to continue demo"))
    17252916
    1726       ;; go to desired position
    1727       (if comint-eol-on-send (end-of-line))
    1728       (if send-full-section (goto-char (point-max)))
    1729 
    1730       ;; do history expansion
    1731       (if (eq comint-input-autoexpand 'input)
    1732           (comint-replace-by-expanded-history t))
     2917      ;; go to desired position.  NOT READY.
     2918      ;(if singular-eol-on-send (end-of-line))
     2919      ;(if send-full-section (goto-char (point-max)))
     2920
    17332921      (let* ((input (buffer-substring pmark (point))))
    1734 
    1735         ;; insert input into history
    1736         (if (and (funcall comint-input-filter input)
    1737                  (or (null comint-input-ignoredups)
    1738                      (not (ring-p comint-input-ring))
    1739                      (ring-empty-p comint-input-ring)
    1740                      (not (string-equal (ring-ref comint-input-ring 0) input))))
    1741             (ring-insert comint-input-ring input))
    1742         (setq comint-input-ring-index nil)
    1743 
    1744         ;; send string to process ...
     2922        ;; insert string into history
     2923        (singular-history-insert input)
     2924        ;; send string to process
    17452925        (singular-send-string process input)
    1746         ;; ... and insert it into buffer ...
     2926        ;; "insert" it into buffer
    17472927        (singular-input-filter process (point)))))))
    17482928;;}}}
     
    18353015                ;; get end of last simple section (equals start of
    18363016                ;; current)
    1837                       simple-sec-start (marker-position singular-simple-sec-last-end)
     3017                      simple-sec-start (singular-simple-sec-last-end-position)
    18383018
    18393019                ;; get string to insert
     
    18803060;;}}}
    18813061
    1882 ;;{{{ Filename, Command, and Help Completion
    1883 ;; NOT READY
    1884 ;; how to find and load the completion files?
    1885 (load-file "cmd-cmpl.el")
    1886 (load-file "hlp-cmpl.el")
    1887 
    1888 (defun singular-dynamic-complete ()
    1889   "NOT READY: docu"
    1890   (interactive)
    1891   (if (eq (buffer-syntactic-context) 'string)
    1892       ;; then: expand filename
    1893       (comint-dynamic-complete-as-filename)
    1894     ;; else: expand command or help
    1895     (let ((end (point))
    1896           beg
    1897           pattern
    1898           completion-list
    1899           completion)
    1900       (save-excursion
    1901         (beginning-of-line)
    1902         (if (re-search-forward (concat singular-prompt-regexp
    1903                                        "[ \t]*\\([\\?]\\|help \\)[ \t]*\\(.*\\)")
    1904                                end t)
    1905             (setq pattern (match-string 2)
    1906                   beg (match-beginning 2)
    1907                   completion-list singular-completion-hlp-list)
    1908           (goto-char end)
    1909           (skip-chars-backward "a-zA-Z0-9")
    1910           (setq pattern (buffer-substring (point) end)
    1911                 beg (point)
    1912                 completion-list singular-completion-cmd-list)))
    1913      
    1914       (setq completion (try-completion pattern
    1915                                        completion-list))
    1916       (cond ((eq completion t)
    1917              (message "[Sole completion]"))  ;; nothing to complete
    1918             ((null completion)               ;; no completion found
    1919              (message "Can't find completion for \"%s\"" pattern)
    1920              (ding))
    1921             ((not (string= pattern completion))
    1922              (delete-region beg end)
    1923              (insert completion))
    1924             (t
    1925              (message "Making completion list...")
    1926              (let ((list (all-completions pattern
    1927                                           completion-list)))
    1928                (with-output-to-temp-buffer "*Completions*"
    1929                  (display-completion-list list)))
    1930              (message "Making completion list...%s" "done"))))))
    1931 ;;}}}
    1932 
    19333062;;{{{ Singular interactive mode
    19343063(defun singular-interactive-mode ()
     
    19413070\\{singular-interactive-mode-map}
    19423071Customization: Entry to this mode runs the hooks on `comint-mode-hook'
    1943 and `singular-interactive-mode-hook' \(in that order).  Before each
    1944 input, the hooks on `comint-input-filter-functions' are run.  After
    1945 each Singular output, the hooks on `comint-output-filter-functions'
    1946 are run.
     3072and `singular-interactive-mode-hook' \(in that order).
    19473073
    19483074NOT READY [much more to come.  See shell.el.]!"
    19493075  (interactive)
    19503076
    1951   ;; remove existing singular-start-menu from menu (XEmacs)
    1952   ;, NOT READY
    1953   ;; This is mayby just temporary
    1954 ;  (cond
    1955 ;   ;; XEmacs
    1956 ;   ((eq singular-emacs-flavor 'xemacs)
    1957 ;    (delete-menu-item '("Singular"))))
     3077  ;; uh-oh, we have to set `comint-input-ring-size' before we call
     3078  ;; `comint-mode'
     3079  (singular-history-init)
    19583080
    19593081  ;; run comint mode and do basic mode setup
    1960   (comint-mode)
     3082  (let (comint-mode-hook)
     3083    (comint-mode))
    19613084  (setq major-mode 'singular-interactive-mode)
    19623085  (setq mode-name "Singular Interaction")
    19633086
    19643087  ;; key bindings, syntax tables and menus
    1965   (use-local-map singular-interactive-mode-map)
    1966   (set-syntax-table singular-interactive-mode-syntax-table)
    1967   (cond
    1968    ;; XEmacs
    1969    ((eq singular-emacs-flavor 'xemacs)
    1970     (easy-menu-add singular-interactive-mode-menu-1)
    1971     (easy-menu-add singular-interactive-mode-menu-2)))
     3088  (singular-interactive-mode-map-init)
     3089  (singular-mode-syntax-table-init)
     3090  (singular-interactive-mode-menu-init)
    19723091
    19733092  (setq comment-start "// ")
     
    19753094  (setq comment-end "")
    19763095
    1977   ;; customize comint for Singular
    1978   (setq comint-prompt-regexp singular-prompt-regexp)
    1979   (setq comint-delimiter-argument-list singular-delimiter-argument-list)
    1980   (setq comint-input-ignoredups singular-input-ignoredups)
    1981   (make-local-variable 'comint-buffer-maximum-size)
    1982   (setq comint-buffer-maximum-size singular-buffer-maximum-size)
    1983   (setq comint-input-ring-size singular-input-ring-size)
    1984   (setq comint-input-filter singular-history-filter)
    1985   (setq comint-completion-addsuffix singular-completion-addsuffix)
    1986 
    1987   ;; get name of history file (if any)
    1988   (setq comint-input-ring-file-name (getenv "SINGULARHIST"))
    1989   (if (or (not comint-input-ring-file-name)
    1990           (equal comint-input-ring-file-name "")
    1991           (equal (file-truename comint-input-ring-file-name) "/dev/null"))
    1992       (setq comint-input-ring-file-name nil))
     3096;  (singular-prompt-init)
    19933097
    19943098  ;; initialize singular demo mode, input and output filters
    1995   (singular-demo-mode 'init)
     3099  (singular-demo-mode-init)
    19963100  (make-local-variable 'singular-pre-input-filter-functions)
    19973101  (make-local-hook 'singular-post-input-filter-functions)
     
    19993103  (make-local-hook 'singular-post-output-filter-functions)
    20003104
    2001   ;; selective display
    2002   (setq selective-display t)
    2003   (setq selective-display-ellipses t)
     3105  ;; folding sections
     3106  (singular-folding-init)
     3107
     3108  ;; debugging filters
     3109  (singular-debug 'interactive-filter (singular-debug-filter-init))
     3110
     3111  (singular-help-init)
     3112
     3113  ;; other input or output filters
     3114  (add-hook 'singular-post-output-filter-functions
     3115            'singular-remove-prompt-filter nil t)
     3116
     3117  ;; Emacs Font Lock mode initialization
    20043118  (cond
    20053119   ;; Emacs
    20063120   ((eq singular-emacs-flavor 'emacs)
    2007     (setq buffer-display-table (or (copy-sequence standard-display-table)
    2008                                    (make-display-table)))
    2009     (set-display-table-slot buffer-display-table
    2010      'selective-display (vconcat singular-folding-ellipsis)))
    2011     ;; XEmacs
    2012    (t
    2013     (set-glyph-image invisible-text-glyph singular-folding-ellipsis (current-buffer))))
    2014 
    2015   ;; debugging filters
    2016   (singular-debug 'interactive-filter
    2017                   (add-hook 'singular-pre-input-filter-functions
    2018                             'singular-debug-pre-input-filter nil t))
    2019   (singular-debug 'interactive-filter
    2020                   (add-hook 'singular-post-input-filter-functions
    2021                             'singular-debug-post-input-filter nil t))
    2022   (singular-debug 'interactive-filter
    2023                   (add-hook 'singular-pre-output-filter-functions
    2024                             'singular-debug-pre-output-filter nil t))
    2025   (singular-debug 'interactive-filter
    2026                   (add-hook 'singular-post-output-filter-functions
    2027                             'singular-debug-post-output-filter nil t))
    2028 
    2029   ;; other input or output filters
    2030   (add-hook 'singular-post-output-filter-functions
    2031             'singular-remove-prompt-filter nil t)
    2032 
    2033   ;; font-locking
    2034   (cond
    2035    ;; Emacs
    2036    ((eq singular-emacs-flavor 'emacs)
    2037     (make-local-variable 'font-lock-defaults)
    2038     (singular-debug 'interactive (message "Setting up font-lock for emacs"))
    2039     (setq font-lock-defaults singular-font-lock-defaults)))
     3121    (singular-interactive-font-lock-init)))
    20403122
    20413123  (run-hooks 'singular-interactive-mode-hook))
     
    20693151                    (message "Sentinel: %s" (substring message 0 -1)))
    20703152    ;; exit demo mode if necessary
    2071     (singular-demo-mode 'exit)
     3153    (singular-demo-exit)
    20723154    (if (string-match "finished\\|exited" message)
    20733155        (let ((process-buffer (process-buffer process)))
     
    20753157                   (buffer-name process-buffer)
    20763158                   (set-buffer process-buffer))
    2077               (progn
    2078                 (singular-debug 'interactive (message "Writing input ring back"))
    2079                 (comint-write-input-ring)))))))
     3159              ;; write back history
     3160              (singular-history-write))))))
    20803161
    20813162(defun singular-exec (buffer name executable start-file switches)
     
    20893170Moves point to the end of BUFFER.
    20903171Initializes all important markers and the simple sections.
    2091 Runs `comint-exec-hook' and `singular-exec-hook' (in that order).
     3172Runs the hooks on `singular-exec-hook'.
    20923173Returns BUFFER."
    20933174  (let ((old-buffer (current-buffer)))
     
    21163197            (singular-output-filter-init (point))
    21173198            (singular-simple-sec-init (point))
    2118 
    2119             ;; NOT READY: SINGULAR-LOGO
    2120 ;           (cond
    2121 ;            ((eq singular-emacs-flavor 'xemacs)
    2122 ;             (set-extent-begin-glyph (make-extent (point-min) (point-min))
    2123 ;                                     singular-logo)
    2124 ;             (insert "\n")))
    21253199
    21263200            ;; feed process with start file and read input ring.  Take
     
    21343208                  (delete-region (point) (point-max))
    21353209                  (send-string process start-string)))
    2136             (singular-debug 'interactive (message "Reading input ring"))
    2137             (comint-read-input-ring t)
     3210
     3211            ;; read history if present
     3212            (singular-history-read)
    21383213
    21393214            ;; execute hooks
    2140             (run-hooks 'comint-exec-hook)
    21413215            (run-hooks 'singular-exec-hook))
    21423216         
     
    21443218      ;; this code is unwide-protected
    21453219      (set-buffer old-buffer))))
    2146 
    2147 ;; NOT READY: SINGULAR-LOGO
    2148 ;(cond
    2149 ; ((eq singular-emacs-flavor 'xemacs)
    2150 ;  (defvar singular-logo (make-glyph))
    2151 ;  (set-glyph-image singular-logo
    2152 ;                  (concat "~/" "singlogo.xpm")
    2153 ;                  'global 'x)))
    21543220
    21553221;; Note:
     
    21763242
    21773243Every time `singular' starts a new Singular process it runs the hooks
    2178 on `comint-exec-hook' and `singular-exec-hook' \(in that order).
     3244on `singular-exec-hook'.
    21793245
    21803246Type \\[describe-mode] in the Singular buffer for a list of commands."
     
    22883354(provide 'singular)
    22893355
     3356;;; Local Variables:
     3357;;; fill-column: 75
     3358;;; End:
     3359
    22903360;;; singular.el ends here.
Note: See TracChangeset for help on using the changeset viewer.