[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

[kahua-dev:00626] frameset, frame, frame/cont/

久住と申します．

Kahuaの練習のためにWWW chatを書いてみたのですが， Kahuaには
フレームのサポートが無いようなので，　書いてみました．

また，　フレームを使うにあたって， a/cont/やform/cont/に
target属性を (a/cont/ (@@/ (target "hoge") ....
のようなかんじでつける必要がありますので，　a/cont/やform/cont/
もすこしかきかえてみました．

まだ，　よく理解していないので正しいのかどうかよくわかんないので，
ツッコミ等おねがいします．

*** server.scm	Wed Mar  3 02:33:43 2004
--- /usr/local/lib/kahua/kahua/server.scm	Thu Apr 22 19:08:54 2004
***************
*** 521,526 ****
--- 522,532 ----
                              (cons (x->string (car p)) v)))
                          kargs))))

+
+ (define (elem-cont? x)
+   (eq? (car x) 'cont))
+
+
  ;;-----------------------------------------------------------
  ;; Pre-defined element handlers
  ;;
***************
*** 617,623 ****
(kahua-bridge-name) server-type cont-id argstr)))) 

    (define (nodes path)
!     (cont `((a (@ (href ,path)) ,@contents)) context))

    (cond ((assq-ref auxs 'cont) => local-cont)
          ((assq-ref auxs 'remote-cont) => remote-cont)
--- 623,631 ----
(kahua-bridge-name) server-type cont-id argstr)))) 

    (define (nodes path)
!     (cont `((a (@ (href ,path)
! 		  ,@(remove elemt-cont? auxs))
! 	       ,@contents)) context))

    (cond ((assq-ref auxs 'cont) => local-cont)
          ((assq-ref auxs 'remote-cont) => remote-cont)
***************
*** 646,658 ****
                     kargs))))

    (let* ((clause (assq-ref auxs 'cont))
           (id     (if clause (session-cont-register (car clause)) ""))
(argstr (if clause (build-argstr&hiddens (cdr clause)) '("")))) 
      (cont
       `((form (@ (method "POST")
! (action ,(kahua-self-uri (string-append id (car argstr))))) 
               ,@(cdr argstr)
               ,@contents))
       context)))

  ;;
--- 654,685 ----
                     kargs))))

    (let* ((clause (assq-ref auxs 'cont))
+ 	 (other  (remove elem-cont? auxs))
           (id     (if clause (session-cont-register (car clause)) ""))
(argstr (if clause (build-argstr&hiddens (cdr clause)) '("")))) 
      (cont
       `((form (@ (method "POST")
! (action ,(kahua-self-uri (string-append id (car argstr)))) 
! 		,@other)
               ,@(cdr argstr)
               ,@contents))
+      context)))
+
+
+ ;;
+ ;; frame/cont
+ ;;
+ ;; `(frame/cont (@@ (cont ,closure [arg ...])))
+ ;;
+
+ (define-element frame/cont (attrs auxs contents context cont)
+   (let* ((clause (assq-ref auxs 'cont))
+ 	 (other  (remove elem-cont? auxs))
+          (id     (if clause (session-cont-register (car clause)) "")))
+     (cont
+      `((frame (@ (src ,(kahua-self-uri id))
+ 		 ,@other)
+ 	      ))
       context)))

  ;;

*** elem.scm	Mon Mar 15 13:18:13 2004
--- /usr/local/lib/kahua/kahua/elem.scm	Thu Apr 22 15:08:47 2004
***************
*** 26,36 ****
  	  form/ label/ input/ select/ optgroup/ option/ textarea/ fieldset/
  	  legend/ button/ table/ caption/ thead/ tfoot/ tbody/ colgroup/
col/ tr/ th/ td/ head/ title/ base/ meta/ style/ script/ noscript/ 
! 	  html/ pdf/
  	  @/
  	  @@/
  	  a/cont/
  	  form/cont/
            extra-header/

  	  node-list-to-node-set
--- 26,37 ----
  	  form/ label/ input/ select/ optgroup/ option/ textarea/ fieldset/
  	  legend/ button/ table/ caption/ thead/ tfoot/ tbody/ colgroup/
col/ tr/ th/ td/ head/ title/ base/ meta/ style/ script/ noscript/ 
! 	  html/ pdf/ frameset/ frame/
  	  @/
  	  @@/
  	  a/cont/
  	  form/cont/
+ 	  frame/cont/
            extra-header/

  	  node-list-to-node-set
***************
*** 42,52 ****
  	  form: label: input: select: optgroup: option: textarea: fieldset:
  	  legend: button: table: caption: thead: tfoot: tbody: colgroup:
col: tr: th: td: head: title: base: meta: style: script: noscript: 
! 	  html: pdf:
  	  @:
  	  @@:
  	  a/cont:
  	  form/cont:
            extra-header:
  ))

--- 43,54 ----
  	  form: label: input: select: optgroup: option: textarea: fieldset:
  	  legend: button: table: caption: thead: tfoot: tbody: colgroup:
col: tr: th: td: head: title: base: meta: style: script: noscript: 
! 	  html: pdf: frameset: frame:
  	  @:
  	  @@:
  	  a/cont:
  	  form/cont:
+ 	  frame/cont:
            extra-header:
  ))

***************
*** 91,96 ****
--- 93,101 ----
  (define (form/cont/ . args)
    (update (cut cons `(form/cont ,@(exec '() (node-set args))) <>)))

+ (define (frame/cont/ . args)
+   (update (cut cons `(frame/cont ,@(exec '() (node-set args))) <>)))
+
  (define (extra-header/ . args)
    (update (cut cons `(extra-header ,@(exec '() (node-set args))) <>)))

***************
*** 271,276 ****
--- 276,285 ----
    (update (cut cons `(noscript ,@(exec '() (node-set args))) <>)))
  (define (html/ . args)
    (update (cut cons `(html ,@(exec '() (node-set args))) <>)))
+ (define (frameset/ . args)
+   (update (cut cons `(frameset ,@(exec '() (node-set args))) <>)))
+ (define (frame/ . args)
+   (update (cut cons `(frame ,@(exec '() (node-set args))) <>)))
  (define (pdf/ . args)
    (update (cut cons `(pdf ,@(exec '() (node-set args))) <>)))

***************
*** 339,344 ****
--- 348,354 ----
  (define (ul: . arg) `(ul ,@(flatten arg)))
  (define (li: . arg) `(li ,@(flatten arg)))
  (define (form: . arg) `(form ,@(flatten arg)))
+
  (define (label: . arg) `(label ,@(flatten arg)))
  (define (input: . arg) `(input ,@(flatten arg)))
  (define (select: . arg) `(select ,@(flatten arg)))
***************
*** 367,372 ****
--- 377,384 ----
  (define (noscript: . arg) `(noscript ,@(flatten arg)))
  (define (html: . arg) `(html ,@(flatten arg)))
  (define (pdf: . arg) `(pdf ,@(flatten arg)))
+ (define (frameset: . arg) `(frameset ,@(flatten arg)))
+ (define (frame: . arg) `(frame ,@(flatten arg)))

  (define-syntax @:
    (syntax-rules ()
***************
*** 388,393 ****
--- 400,406 ----

  (define (a/cont: . arg) `(a/cont ,@(flatten arg)))
  (define (form/cont: . arg) `(form/cont ,@(flatten arg)))
+ (define (frame/cont: . arg) `(frame/cont ,@(flatten arg)))
  (define (extra-header: . arg) `(extra-header ,@(flatten arg)))

  (provide "kahua.elem")