[uim-commit] r968 - branches/composer/scm

[yamaken at freedesktop.org]

Author: yamaken
Date: 2005-07-12 04:26:53 -0700 (Tue, 12 Jul 2005)
New Revision: 968

Modified:
   branches/composer/scm/ng-action.scm
   branches/composer/scm/ustr.scm
   branches/composer/scm/util.scm
Log:
* scm/util.scm
  - (sublist-rel): Support -1 for len which means end of original lst
  - (take-right): New SRFI procedure

* scm/ustr.scm
  - (ustr-dup): Fix broken code caused by the change of object
    representation in r961

* scm/ng-action.scm
  - (actionset-fetch-action-skeleton, actionset-handle-event): Accept
    #f as actset object


Modified: branches/composer/scm/ng-action.scm
===================================================================
--- branches/composer/scm/ng-action.scm	2005-07-11 11:32:00 UTC (rev 967)
+++ branches/composer/scm/ng-action.scm	2005-07-12 11:26:53 UTC (rev 968)
@@ -156,7 +156,8 @@
 
 (define actionset-fetch-action-skeleton
   (lambda (actset act-id)
-    ((actionset-fetcher actset) act-id (actionset-opaque actset))))
+    (and actset
+	 ((actionset-fetcher actset) act-id (actionset-opaque actset)))))
 
 (define actionset-fetch-action
   (lambda (actset owner act-id)
@@ -166,15 +167,16 @@
 
 (define actionset-handle-event
   (lambda (actset owner ev)
-    (case (event-type ev)
-      ((action)
-       (let* ((act-id (action-event-action-id ev))
-	      (act (actionset-fetch-action actset owner act-id)))
-	 (and act
-	      (action-activate! act))))
+    (and actset
+	 (case (event-type ev)
+	   ((action)
+	    (let* ((act-id (action-event-action-id ev))
+		   (act (actionset-fetch-action actset owner act-id)))
+	      (and act
+		   (action-activate! act))))
 
-      (else
-       #f))))
+	   (else
+	    #f)))))
 
 
 ;;

Modified: branches/composer/scm/ustr.scm
===================================================================
--- branches/composer/scm/ustr.scm	2005-07-11 11:32:00 UTC (rev 967)
+++ branches/composer/scm/ustr.scm	2005-07-12 11:26:53 UTC (rev 968)
@@ -118,7 +118,8 @@
 ;; TODO: write test 
 (define ustr-dup
   (lambda (ustr)
-    (copy-list ustr)))
+    (cons (ustr-former ustr)
+	  (ustr-latter ustr))))
 
 ;; ignores cursor position
 (define ustr=

Modified: branches/composer/scm/util.scm
===================================================================
--- branches/composer/scm/util.scm	2005-07-11 11:32:00 UTC (rev 967)
+++ branches/composer/scm/util.scm	2005-07-12 11:26:53 UTC (rev 968)
@@ -113,9 +113,12 @@
 	       start)))
 
 ;; TODO: write test
+;; .parameter len Length to get. -1 means end of original lst
 (define sublist-rel
   (lambda (lst start len)
-    (sublist lst start (+ start len))))
+    (if (negative? len)
+	(list-tail lst start)
+	(sublist lst start (+ start len)))))
 
 (define alist-replace
   (lambda (kons alist)
@@ -348,10 +351,15 @@
 
 ;;(define take)
 ;;(define drop)
-;;(define take-right)
 ;;(define drop-right)
 ;;(define split-at)
 
+;; TODO: write test, make efficient
+(define take-right
+  (lambda (lst i)
+    (let ((ndrop (- (length lst) i)))
+      (list-tail lst ndrop))))
+
 (define list-tabulate
   (lambda (n init-proc)
     (if (< n 0)