Changeset e8f1f9 in git

Timestamp:

Aug 6, 1998, 2:24:46 PM (26 years ago)

Author:

Tim Wichmann <wichmann@…>

Branches:

(u'spielwiese', 'fe61d9c35bf7c61f2b6cbf1b56e25e2f08d536cc')

Children:

07c212cf798802e7865868eb06dba81881d3711a

Parents:

3610c28d8a05e7aef00bd0ee95069a76d0f6ee3e

Message:

	* 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-xemacs-simple-sec-in): Written
	(singular-section-in): Written
	(singular-do-folding): Finished


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

File:

• emacs/singular.el (modified) (9 diffs)

emacs/singular.el

@@ -1 +1 @@
 ;;; singular.el --- Emacs support for Computer Algebra System Singular
 
-;; $Id: singular.el,v 1.18 1998-08-05 20:42:58 wichmann Exp $
+;; $Id: singular.el,v 1.19 1998-08-06 12:24:46 wichmann Exp $
 
 ;;; Commentary:
@@ -329 +329 @@
      ;; XEmacs
      ((eq singular-emacs-flavor 'xemacs)
-      (message "installing main-menu")
       (add-submenu nil 
                    '("Singular"
@@ -421 +420 @@
       (setq which (list (singular-section-at (point)))))
      ((eq where 'all)
-      (setq which (singular-section-in (point-min) (point-max))))
+      (setq which (singular-section-in (point-min) (point-max)))
+
+      ;; just use the output sections:
+      (let (newwhich)
+        (while which
+          (if (eq (singular-section-type (car which)) 'output)
+              (setq newwhich (append (list (car which)) newwhich)))
+          (setq which (cdr which)))
+        (setq which newwhich)))
+
      (t 
-      (message "singular-do-folding: wrong argument")))
+      (singular-debug 'interactive
+                      (message "singular-do-folding: wrong argument"))))
     (while which
       (let* ((current (car which))
@@ -739 +748 @@
   "Return start of clear section at position POS.
 Assumes that no narrowing is in effect."
-  (let ((previous-overlay-change (1+ (point))))
+  (let ((previous-overlay-change (1+ pos)))
     ;; this `while' loop at last will run into the end of the next
     ;; non-clear overlay or stop at bob.  Since POS may be right at the end
@@ -753 +762 @@
   "Return end of clear section at position POS.
 Assumes that no narrowing is in effect."
-  (let ((next-overlay-change (next-overlay-change (point))))
+  (let ((next-overlay-change (next-overlay-change pos)))
     ;; this `while' loop at last will run into the beginning of the next
     ;; non-clear overlay or stop at eob.  Since POS may not be at the
@@ -860 +869 @@
   ;; if previous-extent-change is called with an argument bigger
   ;; than (1+ (buffer-size))  (not (point-max)!), we get an error!
-  (let ((previous-extent-change (if (> (point) (buffer-size))
-                                    (point)
-                                  (1+ (point)))))
+  (let ((previous-extent-change (if (> pos (buffer-size))
+                                    pos
+                                  (1+ pos))))
     ;; this `while' loop at last will run into the end of the next
     ;; non-clear extent or stop at bob.  Since POS may be right at the end
@@ -876 +885 @@
   "Return end of clear section at position POS.
 Assumes that no narrowing is in effect."
-  (let ((next-extent-change (next-extent-change (point))))
+  (let ((next-extent-change (next-extent-change pos)))
     ;; this `while' loop at last will run into the beginning of the next
     ;; non-clear extent or stop at eob.  Since POS may not be at the
@@ -912 +921 @@
 The result contains both clear and non-clear simple sections in the
 order they appear in the region."
-  ;; NOT READY
-  nil)
+  ;; NOT READY [order of sections???]
+  (let ((extent-list))
+    (map-extents 
+     (function (lambda (ext arg)
+
+                 ;; if start of first extent is not point-min, insert
+                 ;; a clear-simple-sec first:
+                 (or extent-list 
+                     (= (extent-start-position ext) (point-min))
+                     (setq extent-list (append (list nil) extent-list)))
+
+                 ;; if end of previous simple-sec is not equal start of
+                 ;; current simple-sec than we have to insert a
+                 ;; clear-simple-sec first:
+                 (and (car extent-list)
+                      (not (= (extent-end-position (car extent-list))
+                              (extent-start-position ext)))
+                      (setq extent-list (append (list nil) extent-list)))
+
+                 ;; finally insert this non-clear simple-sec:
+                 (setq extent-list (append (list ext) extent-list))
+                 nil))
+     (current-buffer) beg end nil nil 'singular-type)
+
+    ;; if extent-list is still nil at this point, then no non-clear
+    ;; simple-sec intersects with region (BEG END). 
+    ;; Then insert a clear simple-sec:
+    (or extent-list
+        (setq extent-list '(nil)))
+
+    ;; if last inserted simple-sec is non-clear and its end is smaller
+    ;; than END, then insert another clear simple sec:
+    (and (car extent-list)
+         (<= (extent-end-position (car extent-list)) end)
+         (setq extent-list (append (list nil) extent-list)))
+
+    ;; we set up the list in decreasing order, so reverse the list
+    (reverse extent-list)))
 ;;}}}
 
@@ -962 +1007 @@
 non-nil."
   (singular-section-at (max 1 (1- pos)) restricted))
+
+(defun singular-section-in (reg-beg reg-end)
+  "NOT READY [docu]"
+  (let ((simple-secs (singular-simple-sec-in reg-beg reg-end))
+        sections current last-end 
+        type beg end)
+    (save-restriction
+      (widen)
+      (while simple-secs
+        (setq current (car simple-secs))
+        (setq type (singular-simple-sec-type current))
+        (if current
+            ;; current is a non-clear simple-sec
+            (setq beg (singular-simple-sec-start current)
+                  end (singular-simple-sec-end current)
+                  last-end end)
+          ;; current is a clear simple-sec
+          (setq beg (singular-simple-sec-start-at (or last-end
+                                                        (point-min)))
+                end (singular-simple-sec-end-at (or last-end
+                                                    (point-min)))))
+        ;; NOT READY [RESTRICTED]
+        (setq sections (append sections (list (vector current type beg end))))
+        (setq simple-secs (cdr simple-secs))))
+    sections))
 
 (defmacro singular-section-simple-sec (section)