;; ----------------------------------------- ;;
;; skeledit.l   kanji-skeleton-editor ver 0.2 ;;
;;                                           ;;
;; You need load `ulx' (UtiLisp X interface) ;;
;;                                           ;;
;; You need (reload-skeleton)                ;;
;; ----------------------------------------- ;;
(comment
 $Revision: 1.1 $
 )

;; ----------------- ;;
;; for compiler bug? ;;
;; ----------------- ;;
(defun ulx-magic ()
  )

;; --------------------- ;;
;; get window properties ;;
;; --------------------- ;;
(defun width-win (win)
  (get-winprop win 'width))

(defun height-win (win)
  (get-winprop win 'height))

(defun move-win (win x y)
  (setf (drawable-x win) x)
  (setf (drawable-y win) y))

;; --------------- ;;
;; make menu macro ;;
;; --------------- ;;
(defun create-menu (parent x y black white fnt cursor
			   item-list (colnum 1))
  (lets ((mw     (create-win parent x y 10 10 black white fnt))
	 (wins   (mapcar item-list
			 #'(lambda (x) 
			     (create-menu-item-win mw    (second x) 
						   0     0
						   black white
						   fnt   cursor))))
	 (item-num (length item-list))
	 (item-height (apply #'max
			     (mapcar wins #'drawable-height)))
	 (item-width  (apply #'max
			     (mapcar wins #'drawable-width)))
	 (linnum   (// (1- (+ item-num colnum)) colnum))
	 (mw-height (+ (* linnum item-height) *menu-margin*))
	 (mw-width  (+ (* colnum (+ *menu-margin* item-width))
		       (* 2 *menu-margin*))))
    (do ((item-wins wins)
	 (y 0 (+ y item-height)))
	((endp item-wins))
	(do ((x *menu-margin* (+ x (+ item-width *menu-margin*)))
	     (c 0 (1+ c)))
	    ((or (>= c colnum) (endp item-wins)))
	    (move-win (car item-wins) x y)
	    (setq item-wins (cdr item-wins))))
    
    (do ((items item-list (cdr items))
	 (windefs wins (cdr windefs)))
	((or (endp items) (endp windefs)))
	(comment (princ (caar items)) (princ " "))
	(set (caar items) (car windefs)))

    (mapcar wins #'(lambda (x) (resize-win x item-width item-height)))
    (resize-win mw mw-width mw-height)
    mw))

;; ------------------------------------ ;;
;; window-handler of addition primitive ;;
;; ------------------------------------ ;;
(defmacro connect-element-win (window editor prim eleme)
  `(put-winprop ,window 'button-press-handler
		(function
		 (lambda (win code x y)
		   (select-window win code x y)
		   (put-winprop 
		    ,editor 
		    'button-press-handler
		    (function
		     (lambda (win code x y)
		       (setq ,prim 
			     (add-skeleton-element win 
						  code x y 
						  ,prim ',eleme)))))))))

;; ----------- ;;
;; initializer ;;
;; ----------- ;;
(defun initialize-skeleton-edit-sub ()
  (comment
   (unless (boundp '*near-cos-see-angle*)
     (setq *near-cos-see-angle* (cos (//$ (*$ 160.0 (arccos 0.0)) 90.0)))))
  
  (unless (boundp '*near-range*)
    (setq *near-range* 400))
  (unless (boundp '*menu-margin*)
    (setq *menu-margin* 2))
  
  (unless (boundp '*end-mode*)
    (setq *end-mode* 3))
  (unless (boundp '*select-nearest*)
    (setq *select-nearest* 2))
  (when (or (eq *end-mode* *select-nearest*)
	    (<= *end-mode* 0)
	    (<= *select-nearest* 0)
	    (> *end-mode* 3)
	    (> *select-nearest* 3))
    (princ "*end-mode* or *select-nearest* out of range... set default")
    (terpri)
    (setq *select-nearest* 2)
    (setq *end-mode* 3))
  
  (unless (boundp '*link-near-range*)
    (setq *link-near-range* 16))
  (unless (boundp '*default-hirawidth*)
    (setq *default-hirawidth* 8))
  
  (unless (boundp '*default-slider-length*)
    (setq *default-slider-length* 200))
  
  (if (or (not (boundp '*range-too-large*))
	  (> *near-range* *range-too-large*))
      (setq *range-too-large* (* 10 *near-range*)))
  
  (unless (boundp '*end-by-release*)
    (setq *end-by-release* t))

  (if (boundp 'editor)
      (put-winprop editor 'button-press-handler nil))
  
  ;; init-status is move-point-selected 
  (if (and (boundp '*selected-window*) *selected-window*)
      (normal-win *selected-window*))
  (setq *selected-window* nil)

  )

;; ---------------- ;;
;; window selection ;;
;; ---------------- ;;
(defun select-window (win code x y)
  (resize-win skeleditor
	      *width-of-skeleton-editor*
	      *height-of-skeleton-editor*)
  (cond ((neq win *selected-window*)
	 (if *selected-window* (normal-win *selected-window*))
	 (setq *selected-window* win)
	 (highlight-win *selected-window*)))
  (display-force-output (window-display win))
  
  (setf (window-event-mask editor) '(:exposure
				     :pointer-motion
				     :button-release
				     :button-press))
  (put-winprop editor 'button-press-handler nil)
  (put-winprop editor 'button-release-handler nil)
  (put-winprop editor 'motion-notify-handler nil)
  (redraw-win editor))

;; -------------- ;;
;; motion-handler ;;
;; -------------- ;;
(defun print-pointer-position (win x y)
  (print (list win x y)))

;; -------------- ;;
;; window example ;;
;; -------------- ;;

(defun initialize-skeleton-editor ()
  (initialize-skeleton-editor))

(defun initialize-skeleton-editor ()
  (ulx-magic)
  (setup-display)
  (print 'setup-display)
  
  (initialize-skeleton-edit-sub)
  (print 'initialize)
  
  (make-skeledit-windows))

(defun initialize-kanji-edittee (name)
  (setq edittee-name name)
  (setq niti (shapeup-skeleton (applykanji name) t))
  (setq joint-prim-def nil)
  (setq joint-prim-symbol nil)
  (initialize-editor-screen)
  (activate-menu edit-kana-kanji-primitive-menu)
  (handle-button-press move-point 1 0 0))

(defun force-kana-kanji-edittee ()
  (setq edittee-name joint-prim-symbol)
  (setq niti (shapeup-skeleton (applykanji joint-prim-def) t))
  (setq joint-prim-def nil)
  (setq joint-prim-symbol nil)
  (initialize-editor-screen)
  (activate-menu edit-kana-kanji-primitive-menu)
  (handle-button-press move-point 1 0 0))

(defun initialize-kana-edittee (name)
  (initialize-kanji-edittee name))

(defun initialize-jointed-edittee (name)
  (setq edittee-name name)
  (setq joint-prim-symbol name)
  (setq joint-prim-def (recursive-copy (expandkanji joint-prim-symbol)))
  (setq niti joint-prim-def)
  (initialize-editor-screen)
  (activate-menu edit-jointed-primitive-menu)
  (handle-button-press move-joint-prim 1 0 0))

(defun initialize-anonymous-edittee ((init nil))
  (print 'anonymous)
  (setq edittee-name 'anonymous)
  (setq niti (if init 
		 (shapeup-skeleton (applykanji init) t)
	       '(nil nil)))
  (setq joint-prim-def nil)
  (setq joint-prim-symbol nil)
  (initialize-editor-screen)
  (activate-menu edit-kana-kanji-primitive-menu)
  (handle-button-press add-ten 1 0 0))

(defun initialize-editor-screen ()
  (setf (window-cursor editor) please-wait-cursor)
  (put-winprop editor 'motion-notify-handler #'(lambda (win x y)))
  
  (setf (window-cursor editor) hair-cross-cursor)

  (clear-win editor)
  (if grid (grid-win editor))
  (if niti
      (draw-skeleton-win editor niti))

  (redraw-win editor)
  (display-force-output display))

(defun save-edittee-to-file (output-file-name message)
  (when (not (null niti))
    (call (string-append "touch " output-file-name ">& /dev/null"))
    (call (string-append "chmod og+w " output-file-name ">& /dev/null"))
    (let* ((standard-output 
	    (appendopen (stream output-file-name))))
      (prind (list 'comment edittee-name
		   (getenv "USER") (date-time)
		   (cond ((pure-primitive-name? edittee-name)
			  'pure-primitive)
			 ((eq (car niti) 'joint)
			  'jointed-primitives)
			 (t 'composite-primitive))))
      
      (if (not (symbolp edittee-name))
	  (setq edittee-name 'anonymous))
      
      (if (neq (car niti) 'joint)
	  (prind (list (if (pure-primitive-name? edittee-name)
			   'setq
			 'comment)
		       edittee-name (list 'quote niti)))
	(print-in-detail (list (if (pure-primitive-name? edittee-name)
				   'setq
				 'comment)
			       edittee-name (list 'quote niti)))
	(terpri))
      
      (terpri)
      (close standard-output))
    (print-message-win 
     message
     (zenkaku-string
      (string-append "「" (string edittee-name)
		     "」を" output-file-name "に出力しました")))
    (redraw-win message)
    (display-force-output display)))

(setq niti nil)

(defun auto-select-and-initialize (nit)
  (cond ((kanji-primitive-name-? nit)
	 (initialize-kanji-edittee nit))
	((kana-primitive-name-? nit)
	 (initialize-kana-edittee nit))
	((jointed-primitive-name-? nit)
	 (initialize-jointed-edittee nit))
	((list-primitive-? nit)
	 (initialize-anonymous-edittee nit))
	(t
	 (initialize-anonymous-edittee))))

(defun skeleton-edit ((nit 'unknown-primitive) (opname "/tmp/prim.out"))
  (skeleton-edit nit opname))

(defun skeleton-edit ((nit 'unknown-primitive) (opname "/tmp/prim.out"))
  (setq output-file-name opname)
  (when (and (= (call (string-append "test -f " output-file-name)) 0)
	     (= (call (string-append "test ! -w " output-file-name)) 0))
    (beep editor)
    (princ (string-append "file " output-file-name " is not writable"))
    (terpri)
    (funcall err:open-close))
  
  (initialize-skeleton-edit-sub)
  
  (clear-win message)

  (auto-select-and-initialize nit)
  
  (initialize-editor-screen)
  
  (print 'initialize)
  
  (main-loop display
	     #'(lambda () (eq *selected-window* syuuryou))
	     editor)
  
  (setq niti (shapeup-skeleton niti))
  
  (display-force-output display)
  niti)

(defun connect-window-handlers ()
  
  (put-winprop move-point 'button-press-handler 
	       #'(lambda (win code x y)
		   (select-window win code x y)
		   (put-winprop 
		    editor 
		    'button-press-handler
		    (function 
		     (lambda (win code x y)
		       (setq niti 
			     (move-skeleton-point win code x y niti)))))))
  
  (put-winprop toggle-link 'button-press-handler
	       #'(lambda (win code x y)
		   (select-window win code x y)
		   (put-winprop 
		    editor 
		    'button-press-handler
		    (function
		     (lambda (win code x y)
		       (setq niti 
			     (toggle-skeleton-link win 
						  code x y niti)))))))
  
  
  (put-winprop delete-element 'button-press-handler
	       #'(lambda (win code x y)
		   (select-window win code x y)
		   (put-winprop
		    editor
		    'motion-notify-handler
		    #'(lambda (win x y)
			(nearest-line-dotted win x y niti)))
		   (put-winprop 
		    editor 
		    'button-press-handler
		    (function
		     (lambda (win code x y)
		       (setq niti 
			     (delete-skeleton-element win 
						     code x y niti)))))
		   (setf (window-event-mask editor) '(:exposure
						      :button-press
						      :pointer-motion))))
  
  (put-winprop nikuduke-min 'button-press-handler
	       #'(lambda (win code x y)
		   (when niti
		     (select-window win code x y)
		     (setf (window-cursor editor) please-wait-cursor)
		     (setf (window-cursor win)    please-wait-cursor)
		     (display-force-output (window-display editor))
		     (setq niti (shapeup-skeleton niti))
		     (draw-nikuduked-skeleton editor niti 'mincho)
		     (setf (window-cursor editor) hair-cross-cursor)
		     (setf (window-cursor win)    roupe-cursor)
		     (display-force-output (window-display editor)))))
	       
; added by tanaka 1993/9/18
  (put-winprop show-min 'button-press-handler
	       #'(lambda (win code x y)
		   (when niti
		     (select-window win code x y)
		     (setf (window-cursor editor) please-wait-cursor)
		     (setf (window-cursor win)    please-wait-cursor)
		     (display-force-output (window-display editor))
		     (setq niti (shapeup-skeleton niti))
		     (show-nikuduked-skeleton editor niti 'mincho)
		     (setf (window-cursor editor) hair-cross-cursor)
		     (setf (window-cursor win)    roupe-cursor)
		     (display-force-output (window-display editor)))))
  (put-winprop toggle-grid 'button-press-handler
	       #'(lambda (win code x y)
;		   (select-window win code x y)
		   (cond (grid (setq grid nil))(t (setq grid t)))
		   (clear-win editor)
		   (if grid (grid-win editor))
		   (if niti
		       (draw-skeleton-win editor niti))
		   (redraw-win editor)
		   (display-force-output (window-display editor))
		   ))
  
  (put-winprop nikuduke-got 'button-press-handler
	       #'(lambda (win code x y)
		   (when niti
		     (select-window win code x y)
		     (setf (window-cursor editor) please-wait-cursor)
		     (setf (window-cursor win)    please-wait-cursor)
		     (display-force-output (window-display editor))
		     (setq niti (shapeup-skeleton niti))
		     (draw-nikuduked-skeleton editor niti 'gothic)
		     (setf (window-cursor editor) hair-cross-cursor)
		     (setf (window-cursor win)    roupe-cursor)
		     (display-force-output (window-display editor)))))
  
  (put-winprop hira-width 'button-press-handler
	       #'(lambda (win code x y)
		   (select-window win code x y)
		   (put-winprop 
		    editor 
		    'button-press-handler
		    #'(lambda (win code x y)
			(setq niti 
			      (change-hira-width win code x y niti))))))
  
  (put-winprop hira-lengthen 'button-press-handler
	       #'(lambda (win code x y)
		   (select-window win code x y)
		   (put-winprop
		    editor
		    'motion-notify-handler
		    #'(lambda (win x y)
			(nearest-line-dotted win x y niti)))
		   (put-winprop 
		    editor 
		    'button-press-handler
		    #'(lambda (win code x y)
			(setq niti 
			      (make-hira-element-long win code x y niti))))
		   (setf (window-event-mask editor) '(:exposure
						      :button-release
						      :button-press
						      :pointer-motion))))
  
  (put-winprop part-move 'button-press-handler
	       #'(lambda (win code x y)
		   (select-window win code x y)
		   (put-winprop
		    editor
		    'button-press-handler
		    #'(lambda (win code x y) 
			(setq niti
			      (move-some-points win code x y niti
						*end-by-release*))))))
  
  (put-winprop part-resize 'button-press-handler
	       #'(lambda (win code x y)
		   (select-window win code x y)
		   (put-winprop 
		    editor 
		    'button-press-handler
		    #'(lambda (win code x y)
			(setq niti 
			      (resize-some-points win code x y niti
						  *end-by-release*))))))

  (put-winprop syuuryou 'button-press-handler
	       #'(lambda (win code x y)
		   (select-window win code x y)
		   (save-edittee-to-file output-file-name message)
		   (when current-selected-menu
		     (unmap-menu current-selected-menu))
		   (setq current-selected-menu nil)
		   ))
  
  (put-winprop hira-long-pnt-add 'button-press-handler
	       #'(lambda (win code x y)
		   (select-window win code x y)
		   (setup-add-hira-point)
		   (put-winprop editor 'button-press-handler
				#'(lambda (win code x y)
				    (setq niti 
					  (add-hira-point win x y niti))))))
  
  (put-winprop 
   move-joint-prim 'button-press-handler
   #'(lambda (win code x y)
       (select-window win code x y)
       (put-winprop editor 'button-press-handler
		    #'(lambda (win code x y)
			(setq joint-prim-def
			      (move-primitive-of-jointed-primitive
			       win code x y))
			(setq niti joint-prim-def)))))
  
  (put-winprop 
   resize-joint-prim 'button-press-handler
   #'(lambda (win code x y)
       (select-window win code x y)
       (put-winprop editor 'button-press-handler
		    #'(lambda (win code x y)
			(setq joint-prim-def
			      (resize-primitive-of-jointed-primitive
			       win code x y))
			(setq niti joint-prim-def)))))
  
  (put-winprop hira-shorten 'button-press-handler
	       #'(lambda (win code x y)
		   (select-window win code x y)
		   (setup-del-hira-point)
		   (put-winprop editor 'button-press-handler
				#'(lambda (win code x y)
				    (setq niti
					  (del-hira-point editor x y niti))))))
  
  (put-winprop ed-xyunit 'button-press-handler
	       #'(lambda (win code x y)
		   (select-window win code x y)
		   (resize-win skeleditor
			       (+ (width-win skeleditor)
				  (width-win temporary-window)
				  *menu-margin*)
			       (max (height-win skeleditor)
				    (height-win temporary-window)))
		   (when (or (null (get-prim-info niti 'xunit))
			     (null (get-prim-info niti 'yunit)))
		     (setq niti (add-unit niti))
		     (clear-win editor)
		     (if grid (grid-win editor))
		     (draw-skeleton-win editor niti)
		     (redisplay-win editor))
		   (put-winprop 
		    editor 'button-press-handler
		    #'(lambda (win code x y)
			(setq niti 
			      (edit-xyunit-of-primitive win x y niti))))))
  
  (put-winprop recomp-xyunit 'button-press-handler
	       #'(lambda (win code x y)
		   (select-window win code x y)
		   (if (ask-y-n skeleditor "ユニットを既定値にします")
		       (setq niti (add-default-xyunit niti)))
		   (clear-win editor)
		   (if grid (grid-win editor))
		   (draw-skeleton-win editor niti)
		   (redisplay-win editor)))
		     
  (put-winprop etc-1 'button-press-handler
	       #'(lambda (win code x y)
		   (select-window win code x y)))
  
  (put-winprop etc-2 'button-press-handler
	       #'(lambda (win code x y)
		   (select-window win code x y)))
  
  (connect-element-win add-ten    editor niti ten)
  (connect-element-win add-tate   editor niti tate)
  (connect-element-win add-yoko   editor niti yoko)
  (connect-element-win add-migiue editor niti migiue)
  (connect-element-win add-hidari editor niti hidari)
  
  (connect-element-win add-tatehidari editor niti tatehidari)
  (connect-element-win add-migi editor niti migi)
  (connect-element-win add-kozato editor niti kozato)
  (connect-element-win add-tatehane editor niti tatehane)
  (connect-element-win add-tsukurihane editor niti tsukurihane)
  
  (connect-element-win add-sanzui editor niti sanzui)
  (connect-element-win add-kokoro editor niti kokoro)
  (connect-element-win add-tasuki editor niti tasuki)
  (connect-element-win add-magaritate editor niti magaritate)
  (connect-element-win add-kagi editor niti kagi)
  
  (connect-element-win add-shinnyuu editor niti shin-nyuu)
  
  (connect-element-win add-hira-long editor niti hira-long)
  (connect-element-win add-hira-short editor niti hira-short)
  (connect-element-win add-hira-maru editor niti hira-circle)
  (connect-element-win add-outline editor niti outline)
  
  (put-winprop editor 'button-press-handler nil)

  (put-winprop force-primitive 'button-press-handler
	       #'(lambda (win code x y)
		   (cond ((null joint-prim-def)
			  (beep editor))
			 (t
			  (and (ask-y-n skeleditor
					"プリミティブに変換します")
			       (force-kana-kanji-edittee))))))
  
  (put-winprop change-name 'button-press-handler
	       #'(lambda (win code x y)
		   (let ((sym (intern (read-string-from-kinput skeleditor))))
		     (save-edittee-to-file output-file-name message)
		     (auto-select-and-initialize sym))))
  nil)

(defun activate-menu (menu (at-first t))
  (when (and current-selected-menu at-first)
    (unmap-menu current-selected-menu))
  
  (when menu
    (map-subwindows menu)
    (map-window menu)
    (mapcar (get-winprop menu 'next-menu)
	    #'(lambda (m) (activate-menu m nil))))

  (if at-first (setq current-selected-menu menu)))

(defun kanji-primitive-name-? (sym)
  (and (symbolp sym)
       (boundp sym)
       (eq sym (expandkanji sym))
       (let ((sym-string (string sym)))
	 (not (and (= (string-length sym-string) 2)
		   (or (= (sref sym-string 0) 164)
		       (= (sref sym-string 0) 165)))))))

(defun kana-primitive-name-? (sym)
  (and (symbolp sym)
       (boundp sym)
       (eq sym (expandkanji sym))
       (print sym)
       (let ((sym-string (string sym)))
	 (and (= (string-length sym-string) 2)
	      (or (= (sref sym-string 0) 164)
		  (= (sref sym-string 0) 165))))))

(defun list-primitive-? (nit)
  (and (not (symbolp nit))
       (setq nit (applykanji nit))
       (listp nit)
       (listp (car nit))
       (listp (caar nit))
       (numberp (caaar nit))))

(defun jointed-primitive-name-? (sym)
  (let ((ex nil))
    (or (and (listp sym)
	     (symbolp (car sym)))
	(and (symbolp sym)
	     (boundp sym)
	     (neq sym (setq ex (expandkanji sym)))
	     (listp ex)
	     (eq (car ex) 'joint)))))

(defun make-skeledit-windows ()	     
  (let ((menu-width 0)
	(menu-height 0)
	(edit-menus nil)
	(y 0))
    
    (setq skeleditor (create-win root 0 0 10 10 black white kanji-font))
    (setf (window-event-mask skeleditor) '(:exposure :property-change))
    (setf (wm-name skeleditor) "skeleton editor")
    (print 'skeleditor)
    
    (setq edit-common-menu
	  (create-menu skeleditor 0 0 black white kanji-font roupe-cursor
		       '((change-name     "次の編集")
			 (nikuduke-min    "肉付（明朝）")
			 (show-min    "輪郭（明朝）")
			 (nikuduke-got    "肉付（ゴシック）")
			 (etc-1           "テスト用１")
			 (etc-2           "テスト用２")
			 (syuuryou        "終わり"))))
    (incr y (+ (height-win edit-common-menu) *menu-margin*))
    
    (setq edit-kana-kanji-primitive-menu 
	  (create-menu skeleditor 0 y black white kanji-font roupe-cursor
		       '((move-point      "点の移動")
			 (toggle-link     "点の接続／非接続")
			 (delete-element  "線の削除")
			 (toggle-grid     "グリッド")
			 (part-move       "一部を平行移動")
			 (part-resize     "一部を拡大縮小")
			 (ed-xyunit       "ユニットの編集")
			 (recomp-xyunit   "ユニット再計算"))))
    (let ((yy (+ y (height-win edit-kana-kanji-primitive-menu) *menu-margin*)))
      (setq edit-kana-kanji-primitive-menu-sub-1
	    (create-menu skeleditor 0 yy black white kanji-font roupe-cursor
			 '((add-ten         "点")
			   (add-tate        "縦棒")
			   (add-yoko        "横棒")
			   (add-migiue      "右上撥")
			   (add-hidari      "左払")
			   (add-tatehidari  "縦左払")
			   (add-migi        "右払")
			   (add-kozato      "阜一部")
			   (add-tatehane    "縦撥")
			   (add-tsukurihane "旁撥")
			   (add-sanzui      "三水下")
			   (add-kokoro      "心一部"))))
      (setq edit-kana-kanji-primitive-menu-sub-2
	    (create-menu skeleditor 
			 (+ (width-win edit-kana-kanji-primitive-menu-sub-1)
			    *menu-margin*)
			 yy black white kanji-font roupe-cursor
			 '((add-tasuki      "たすき")
			   (add-magaritate  "曲り縦棒")
			   (add-kagi        "かぎ")
			   (add-shinnyuu    "之繞")
			   (add-hira-long     "長い仮名")
			   (add-hira-short    "短い仮名")
			   (add-hira-maru     "仮名の丸")
			   (add-outline     "輪郭線")
			   (hira-width        "仮名の太")
			   (hira-lengthen     "仮名長く")
			   (hira-long-pnt-add "仮名追加")
			   (hira-shorten      "仮名削除"))))
      (put-winprop edit-kana-kanji-primitive-menu 'next-menu
		   (list edit-kana-kanji-primitive-menu-sub-1
			 edit-kana-kanji-primitive-menu-sub-2)))
    
    (setq edit-jointed-primitive-menu
	  (create-menu skeleditor 0 y black white kanji-font roupe-cursor
		       '((move-joint-prim     "組合せ内の移動")
			 (resize-joint-prim   "組合せ内の拡縮")
			 (force-primitive     "プリミティブ変換"))))
    
    (incr y (+ (max (+ (height-win edit-kana-kanji-primitive-menu)
		       (max (height-win edit-kana-kanji-primitive-menu-sub-1)
			    (height-win edit-kana-kanji-primitive-menu-sub-2)))
		    (height-win edit-jointed-primitive-menu))
	       *menu-margin*))
    
    (setq edit-menus (list edit-common-menu
			   edit-kana-kanji-primitive-menu
			   edit-jointed-primitive-menu))
    
    (mapcar edit-menus
	    #'(lambda (menu)
		(setf (window-event-mask menu) '(:exposure))))
    
    (print 'menus)
    
    (setq menu-width 
	  (max (apply #'max 
		      (mapcar edit-menus 
			      #'(lambda (menu) (width-win menu))))
	       (+ (width-win edit-kana-kanji-primitive-menu-sub-1)
		  (width-win edit-kana-kanji-primitive-menu-sub-2))))
    
    (setq menu-height y)
    
    (setq editor (create-win skeleditor 
			     (+ menu-width *menu-margin*)
			     0
			     400 400 black white kanji-font))
    (setf (window-event-mask editor) '(:exposure :button-press))
    (setf (window-cursor editor) hair-cross-cursor)
    (print 'editor)
    
    (setq width-sliders
	  (create-slider-menu skeleditor
			      0 
			      (+ (max menu-height (height-win editor))
				 *menu-margin*)
			      black white kanji-font
			      (min-wid "明朝基準太さ　　" 
				       5.0 30.0 'minchowidth 20.0)
			      (got-wid "ゴシック基準太さ" 
				       5.0 30.0 'gothicwidth 13.0)
			      (hir-wid "平仮名基準太さ　" 
				       0.0 1.5 'hirawidth 0.6)))
    (print 'sliders)
    
    (setq message (create-win skeleditor 
			      0
			      (+ (drawable-y width-sliders) *menu-margin*
				 (height-win width-sliders))
			      500 50 black white kanji-font))
    (print 'message)
    
    (resize-win skeleditor
		(max (+ menu-width 
			(width-win editor) (* *menu-margin* 4))
		     (width-win message))
		(max (+ (max menu-height (height-win editor))
			(height-win width-sliders)
			(height-win message)
			(* *menu-margin* 4))
		     (height-win skeleditor)))

    (setq *width-of-skeleton-editor* (width-win skeleditor))
    (setq *height-of-skeleton-editor* (height-win skeleditor))
    
    (setq temporary-window 
	  (create-win skeleditor 
		      (width-win skeleditor) 0
		      400 400
		      black white kanji-font))

    (connect-window-handlers)
    
    (map-subwindows edit-common-menu)
    (map-subwindows width-sliders)
    (map-subwindows skeleditor)
    (unmap-menu edit-kana-kanji-primitive-menu)
    (unmap-menu edit-jointed-primitive-menu)
    (setq current-selected-menu nil)
    (map-window skeleditor)))

(defun unmap-menu (menu)
  (mapcar (get-winprop menu 'next-menu) 
	  #'(lambda (m) 
	      (unmap-menu m)))
  (unmap-subwindows menu)
  (unmap-window menu))

(defun print-in-detail (p)
  (cond ((stringp p) (prind p) (princ " "))
	((vectorp p)
	 (princ "#(")
	 (do ((len (vector-length p))
	      (i 0 (1+ i)))
	     ((>= i len))
	     (print-in-detail (vref p i))
	     (princ " "))
	 (princ ") "))
	((listp p) 
	 (princ "(")
	 (let ((last (do ((rest p (cdr rest)))
			 ((endp rest) rest)
			 (print-in-detail (car rest)))))
	   (if (null last)
	       (princ ") ")
	     (princ " . ")
	     (princ last)
	     (princ " ) "))))
	((atom p) (princ p) (princ " "))
	(t (prind p)))
  nil)

;;
;; (defun takobeya ()
;;   (initialize-skeleton-editor)
;;   (setq boo (skeleton-edit boo))
;;   (setq foo (skeleton-edit foo))
;;   (setq woo (skeleton-edit woo))
;;      ...
;;