Changeset e6de219 in git for emacs/singular.el


Ignore:
Timestamp:
Jul 28, 1998, 4:44:57 PM (26 years ago)
Author:
Jens Schmidt <schmidt@…>
Branches:
(u'spielwiese', 'fe61d9c35bf7c61f2b6cbf1b56e25e2f08d536cc')
Children:
73a5d17024f576058268b69583f17de25e4a6244
Parents:
16352da6e80e3ad4aba6464692035a8e077dd04f
Message:
	* 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.


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

Legend:

Unmodified
Added
Removed

  • emacs/singular.el

    r16352d re6de219  
    11;;; singular.el --- Emacs support for Computer Algebra System Singular
    22
    3 ;; $Id: singular.el,v 1.7 1998-07-28 10:45:56 schmidt Exp $
     3;; $Id: singular.el,v 1.8 1998-07-28 14:44:57 schmidt Exp $
    44
    55;;; Commentary:
    … …  
    5959(defun singular-debug-format (string)
    6060  "Return STRING in a nicer format."
    61   (while (string-match "\n" string)
    62     (setq string (replace-match "^J" nil nil string)))
    63 
    64   (if (> (length string) 16)
    65       (concat "<" (substring string 0 7) ">...<" (substring string -8) ">")
    66     (concat "<" string ">")))
     61  (save-match-data
     62    (while (string-match "\n" string)
     63      (setq string (replace-match "^J" nil nil string)))
     64
     65    (if (> (length string) 16)
     66        (concat "<" (substring string 0 7) ">...<" (substring string -8) ">")
     67      (concat "<" string ">"))))
    6768
    6869(defmacro singular-debug (mode form &optional else-form)
    … …  
    150151(defun singular-lookup-face (face-type)
    151152  "Return face belonging to FACE-TYPE.
    152 NOT READY [should be rewritten completely]!"
     153NOT READY [should be rewritten completely.  Interface should stay the same.]!"
    153154  (cond ((eq face-type 'input) singular-input-face)
    154155        ((eq face-type 'output) singular-output-face)))
    … …  
    161162  "Key map to use in Singular interactive mode.")
    162163
    163 (if (not singular-interactive-mode-map)
    164     (progn
    165       (cond
    166        ;; Emacs
    167        ((eq singular-emacs-flavor 'emacs)
    168         (setq singular-interactive-mode-map
    169               (nconc (make-sparse-keymap) comint-mode-map)))
    170        ;; XEmacs
    171        (t
    172         (setq singular-interactive-mode-map (make-keymap))
    173         (set-keymap-parents singular-interactive-mode-map (list comint-mode-map))
    174         (set-keymap-name singular-interactive-mode-map
    175                         'singular-interactive-mode-map)))
    176       (define-key singular-interactive-mode-map "\C-m" 'singular-send-input)))
     164(if singular-interactive-mode-map
     165    ()
     166  (cond
     167   ;; Emacs
     168   ((eq singular-emacs-flavor 'emacs)
     169    (setq singular-interactive-mode-map
     170          (nconc (make-sparse-keymap) comint-mode-map)))
     171   ;; XEmacs
     172   (t
     173    (setq singular-interactive-mode-map (make-keymap))
     174    (set-keymap-parents singular-interactive-mode-map (list comint-mode-map))
     175    (set-keymap-name singular-interactive-mode-map
     176                    'singular-interactive-mode-map)))
     177  (define-key singular-interactive-mode-map "\C-m" 'singular-send-input))
    177178;;}}}
    178179
    … …  
    268269
    269270(defvar singular-simple-sec-clear-type 'input
    270   "Type of clear simple sections.")
     271  "Type of clear simple sections.
     272If nil no clear simple sections are used.")
     273
     274(defvar singular-simple-sec-last-end nil
     275  "Marker at the end of the last simple section.")
    271276
    272277(defun singular-simple-sec-init (pos)
    … …  
    289294(singular-fset 'singular-simple-sec-create
    290295               'singular-emacs-simple-sec-create
    291                'singular-emacs-simple-sec-create)
     296               'singular-xemacs-simple-sec-create)
    292297
    293298(singular-fset 'singular-simple-sec-reset-last
    294299               'singular-emacs-simple-sec-reset-last
    295                'singular-emacs-simple-sec-reset-last)
     300               'singular-xemacs-simple-sec-reset-last)
    296301
    297302(singular-fset 'singular-simple-sec-start
    298303               'singular-emacs-simple-sec-start
    299                'singular-emacs-simple-sec-start)
     304               'singular-xemacs-simple-sec-start)
    300305
    301306(singular-fset 'singular-simple-sec-end
    302307               'singular-emacs-simple-sec-end
    303                'singular-emacs-simple-sec-end)
     308               'singular-xemacs-simple-sec-end)
     309
     310(singular-fset 'singular-simple-sec-start-at
     311               'singular-emacs-simple-sec-start-at
     312               'singular-xemacs-simple-sec-start-at)
     313
     314(singular-fset 'singular-simple-sec-end-at
     315               'singular-emacs-simple-sec-end-at
     316               'singular-xemacs-simple-sec-end-at)
    304317
    305318(singular-fset 'singular-simple-sec-type
    306319               'singular-emacs-simple-sec-type
    307                'singular-emacs-simple-sec-type)
     320               'singular-xemacs-simple-sec-type)
    308321
    309322(singular-fset 'singular-simple-sec-at
    310323               'singular-emacs-simple-sec-at
    311                'singular-emacs-simple-sec-at)
     324               'singular-xemacs-simple-sec-at)
    312325
    313326(singular-fset 'singular-simple-sec-before
    314327               'singular-emacs-simple-sec-before
    315                'singular-emacs-simple-sec-before)
     328               'singular-xemacs-simple-sec-before)
    316329
    317330(singular-fset 'singular-simple-sec-in
    318331               'singular-emacs-simple-sec-in
    319                'singular-emacs-simple-sec-in)
     332               'singular-xemacs-simple-sec-in)
    320333;;}}}
    321334
    … …  
    326339Returns the new simple section or `empty' if no simple section has
    327340been created.
     341Assumes that no narrowing is in effect.
    328342Updates `singular-simple-sec-last-end'."
    329343  (let ((last-end (marker-position singular-simple-sec-last-end))
    … …  
    331345        simple-sec)
    332346
    333     ;; get beginning of line before END
    334     (setq end (let ((save-point (point)))
     347    ;; get beginning of line before END.  At this point we need that there
     348    ;; are no restrictions.
     349    (setq end (let ((old-point (point)))
    335350                (goto-char end) (beginning-of-line)
    336                 (prog1 (point) (goto-char save-point))))
     351                (prog1 (point) (goto-char old-point))))
    337352
    338353    (cond
    … …  
    360375    simple-sec))
    361376
    362 (defun singular-emacs-simple-sec-reset-last ()
    363   "Reset end of last simple section after accidental extension."
    364   (let ((simple-sec (singular-emacs-simple-sec-at singular-simple-sec-last-end)))
    365     (if simple-sec
    366         (move-overlay simple-sec (overlay-start simple-sec)
    367                       singular-simple-sec-last-end))))
     377(defun singular-emacs-simple-sec-reset-last (pos)
     378  "Reset end of last simple section to POS after accidental extension.
     379Updates `singular-simple-sec-last-end', too."
     380  (let ((simple-sec (singular-emacs-simple-sec-at pos)))
     381    (if simple-sec (move-overlay simple-sec (overlay-start simple-sec) pos))
     382    (set-marker singular-simple-sec-last-end pos)))
    368383
    369384(defun singular-emacs-simple-sec-start (simple-sec)
    … …  
    374389  "Return end of non-clear simple section SIMPLE-SEC."
    375390  (overlay-end simple-sec))
     391
     392(defun singular-emacs-simple-sec-start-at (pos)
     393  "Return start of clear section at position POS."
     394  (save-restriction
     395    (widen)
     396    (let ((previous-overlay-change (1+ (point))))
     397      ;; this `while' loop at last will run into the end of the next
     398      ;; non-clear overlay or stop at bob.  Since POS may be right at the end
     399      ;; of a previous non-clear location, we have to search at least one
     400      ;; time from POS+1 backwards.
     401      (while (not
     402              (or (singular-emacs-simple-sec-before previous-overlay-change)
     403                  (eq previous-overlay-change (point-min))))
     404        (setq previous-overlay-change
     405              (previous-overlay-change previous-overlay-change)))
     406      previous-overlay-change)))
     407
     408(defun singular-emacs-simple-sec-end-at (pos)
     409  "Return end of clear section at position POS."
     410  (save-restriction
     411    (widen)
     412    (let ((next-overlay-change (next-overlay-change (point))))
     413      ;; this `while' loop at last will run into the beginning of the next
     414      ;; non-clear overlay or stop at eob.  Since POS may not be at the
     415      ;; beginning of a non-clear simple section we may start searching
     416      ;; immediately.
     417      (while (not
     418              (or (singular-emacs-simple-sec-at next-overlay-change)
     419                  (eq next-overlay-change (point-max))))
     420        (setq next-overlay-change
     421              (next-overlay-change next-overlay-change)))
     422      next-overlay-change)))
    376423
    377424(defun singular-emacs-simple-sec-type (simple-sec)
    … …  
    415462;; sections?]!
    416463
    417 (defun singular-section-at (pos &optional raw-section)
     464(defun singular-section-at (pos &optional restricted)
    418465  "Return section at position POS.
    419 Returns section intersected with current restriction unless
    420 RAW-SECTION is non-nil."
     466Returns section intersected with current restriction if RESTRICTED is
     467non-nil."
    421468  (let* ((simple-sec (singular-simple-sec-at pos))
    422469         (type (singular-simple-sec-type simple-sec))
    … …  
    427474                  (singular-simple-sec-end simple-sec)
    428475                (singular-simple-sec-end-at pos))))
    429     (if raw-section
    430         (vector simple-sec type start end)
    431       (vector simple-sec type
    432               (max start (point-min)) (min end (point-max))))))
     476    (if restricted
     477        (vector simple-sec type
     478                (max start (point-min)) (min end (point-max)))
     479      (vector simple-sec type start end))))
    433480
    434481(defmacro singular-section-simple-sec (section)
    … …  
    453500  "Ellipsis to show for folded input or output.")
    454501
    455 (defun singular-fold-internal (start end fold)
    456   "(Un)fold region from START to END.
     502(defun singular-fold-internal (list fold)
     503  "(Un)fold regions in LIST.
     504LIST should have the format (START1 END1 START2 END2 ...).
    457505Folds if FOLD is non-nil, otherwise unfolds.
    458506Folds without affecting undo information, buffer-modified flag, and
    459 even for read-only files."
     507even for read-only files.
     508Assumes that there is no narrowing in effect."
    460509  (let ((inhibit-read-only t) (buffer-undo-list t)
    461         (save-modified (buffer-modified-p))
    462         (save-point (point)))
     510        (modified (buffer-modified-p))
     511        (old-point (point)))
    463512    (unwind-protect
    464513        ;; do it !!
    465514        (if fold
    466             (progn
    467               (goto-char start) (insert ?\r)
    468               (subst-char-in-region start end ?\n ?\r t))
    469           (goto-char start) (delete-char 1)
    470           (subst-char-in-region start end ?\r ?\n t))
     515            (while list
     516              (goto-char (car list)) (insert ?\r)
     517              (subst-char-in-region (car list) (nth 1 list) ?\n ?\r t)
     518              (setq list (cdr (cdr list))))
     519          (while list
     520            (subst-char-in-region (car list) (nth 1 list) ?\r ?\n t)
     521            (goto-char (car list)) (delete-char 1)
     522            (setq list (cdr (cdr list)))))
    471523
    472524      ;; we have to restore the point and the modified flag.  The read-only
    473525      ;; state and undo information are restored by the outer `let'.
    474526      ;; This code is unwide-protected.
    475       (goto-char save-point)
    476       (or save-modified
     527      (goto-char old-point)
     528      (or modified
    477529          (set-buffer-modified-p nil)))))
    478530
    479531(defun singular-section-foldedp (section)
    480   "Return t iff SECTION is folded."
     532  "Return t iff SECTION is folded.
     533Assumes that there is no narrowing in effect."
    481534  (eq (char-after (singular-section-start section)) ?\r))
    482535
    … …  
    486539section if called interactively."
    487540  (interactive (list (singular-section-at (point))))
    488   (let ((start (singular-section-start section)))
    489     (singular-fold-internal start
    490                             (singular-section-end section)
    491                             (not (singular-section-foldedp section)))
    492     (if (interactive-p) (goto-char start))))
     541  (let ((start (singular-section-start section))
     542        ;; we have to save restrictions this way since we change text
     543        ;; outside the restriction.  Note that we do not use a marker for
     544        ;; `old-point-min'.  This way, even partial narrowed sections are
     545        ;; folded properly if they have been narrowed at bol.  Nice but
     546        ;; dirty trick.
     547        (old-point-min (point-min))
     548        (old-point-max (point-max-marker)))
     549    (unwind-protect
     550        (progn
     551          (widen)
     552          (singular-fold-internal (list start
     553                                        (singular-section-end section))
     554                                  (not (singular-section-foldedp section))))
     555      (narrow-to-region old-point-min old-point-max)
     556      (set-marker old-point-max nil))
     557    (if (interactive-p) (goto-char (max start (point-min))))))
    493558;;}}}
    494559
    … …  
    691756                     (set-marker comint-last-input-start save-pmark))
    692757                (and (= singular-simple-sec-last-end (point))
    693                      (set-marker singular-simple-sec-last-end save-pmark)
    694                      (singular-simple-sec-reset-last))
     758                     (singular-simple-sec-reset-last save-pmark))
    695759
    696760                ;; set new markers and create/extend new simple section
Note: See TracChangeset for help on using the changeset viewer.