This commit was generated by cvs2svn to compensate for changes in r524,

[elisp/tm.git] / tl-nemacs.el

diff --git a/tl-nemacs.el b/tl-nemacs.el
index d8b6a6d..78bd3b8 100644 (file)
--- a/tl-nemacs.el
+++ b/tl-nemacs.el
@@ -1,5 +1,5 @@
 ;;;
-;;; $Id: tl-nemacs.el,v 1.2 1994/10/20 00:37:15 morioka Exp $
+;;; $Id: tl-nemacs.el,v 2.0 1994/10/29 18:31:55 morioka Exp $
 ;;;
 
 (provide 'tl-nemacs)
@@ -56,3 +56,43 @@ else returns nil. [Mule compatible function in tm-nemacs]"
   (if (< chr 128)
       lc-ascii
     lc-jp))
+
+
+;; by YAMATE Keiichirou 1994/10/28
+(defun attribute-add-narrow-attribute (attr from to)
+  (or (consp (symbol-value attr))
+      (set attr (list 1)))
+  (let* ((attr-value (symbol-value attr))
+        (len (car attr-value))
+        (posfrom 1)
+        posto)
+    (while (and (< posfrom len)
+               (> from (nth posfrom attr-value)))
+      (setq posfrom (1+ posfrom)))
+    (setq posto posfrom)
+    (while (and (< posto len)
+               (> to (nth posto attr-value)))
+      (setq posto (1+ posto)))
+    (if  (= posto posfrom)
+       (if (= (% posto 2) 1)
+           (if (and (< to len)
+                    (= to (nth posto attr-value)))
+               (set-marker (nth posto attr-value) from)
+             (setcdr (nthcdr (1- posfrom) attr-value)
+                     (cons (set-marker-type (set-marker (make-marker)
+                                                        from)
+                                            'point-type)
+                           (cons (set-marker-type (set-marker (make-marker)
+                                                              to)
+                                                  nil)
+                                 (nthcdr posto attr-value))))
+             (setcar attr-value (+ len 2))))
+      (if (= (% posfrom 2) 0)
+         (setq posfrom (1- posfrom))
+       (set-marker (nth posfrom attr-value) from))
+      (if (= (% posto 2) 0)
+         nil
+       (setq posto (1- posto))
+       (set-marker (nth posto attr-value) to))
+      (setcdr (nthcdr posfrom attr-value)
+             (nthcdr posto attr-value)))))