| 1 : |
ktanaka |
1.1 |
;; ----------------------------------------- ;; |
| 2 : |
ktanaka |
1.2 |
;; skeledit.l kanji-skeleton-editor ver 0.2 ;; |
| 3 : |
ktanaka |
1.1 |
;; ;; |
| 4 : |
|
|
;; You need load `ulx' (UtiLisp X interface) ;; |
| 5 : |
|
|
;; ;; |
| 6 : |
|
|
;; You need (reload-skeleton) ;; |
| 7 : |
|
|
;; ----------------------------------------- ;; |
| 8 : |
|
|
(comment |
| 9 : |
ktanaka |
1.2 |
$Revision: 1.1.1.1 $ |
| 10 : |
ktanaka |
1.1 |
) |
| 11 : |
|
|
|
| 12 : |
|
|
;; ----------------- ;; |
| 13 : |
|
|
;; for compiler bug? ;; |
| 14 : |
|
|
;; ----------------- ;; |
| 15 : |
|
|
(defun ulx-magic () |
| 16 : |
|
|
) |
| 17 : |
|
|
|
| 18 : |
|
|
;; --------------------- ;; |
| 19 : |
|
|
;; get window properties ;; |
| 20 : |
|
|
;; --------------------- ;; |
| 21 : |
|
|
(defun width-win (win) |
| 22 : |
|
|
(get-winprop win 'width)) |
| 23 : |
|
|
|
| 24 : |
|
|
(defun height-win (win) |
| 25 : |
|
|
(get-winprop win 'height)) |
| 26 : |
|
|
|
| 27 : |
|
|
(defun move-win (win x y) |
| 28 : |
|
|
(setf (drawable-x win) x) |
| 29 : |
|
|
(setf (drawable-y win) y)) |
| 30 : |
|
|
|
| 31 : |
|
|
;; --------------- ;; |
| 32 : |
|
|
;; make menu macro ;; |
| 33 : |
|
|
;; --------------- ;; |
| 34 : |
|
|
(defun create-menu (parent x y black white fnt cursor |
| 35 : |
|
|
item-list (colnum 1)) |
| 36 : |
|
|
(lets ((mw (create-win parent x y 10 10 black white fnt)) |
| 37 : |
|
|
(wins (mapcar item-list |
| 38 : |
|
|
#'(lambda (x) |
| 39 : |
|
|
(create-menu-item-win mw (second x) |
| 40 : |
|
|
0 0 |
| 41 : |
|
|
black white |
| 42 : |
|
|
fnt cursor)))) |
| 43 : |
|
|
(item-num (length item-list)) |
| 44 : |
|
|
(item-height (apply #'max |
| 45 : |
|
|
(mapcar wins #'drawable-height))) |
| 46 : |
|
|
(item-width (apply #'max |
| 47 : |
|
|
(mapcar wins #'drawable-width))) |
| 48 : |
|
|
(linnum (// (1- (+ item-num colnum)) colnum)) |
| 49 : |
|
|
(mw-height (+ (* linnum item-height) *menu-margin*)) |
| 50 : |
|
|
(mw-width (+ (* colnum (+ *menu-margin* item-width)) |
| 51 : |
|
|
(* 2 *menu-margin*)))) |
| 52 : |
|
|
(do ((item-wins wins) |
| 53 : |
|
|
(y 0 (+ y item-height))) |
| 54 : |
|
|
((endp item-wins)) |
| 55 : |
|
|
(do ((x *menu-margin* (+ x (+ item-width *menu-margin*))) |
| 56 : |
|
|
(c 0 (1+ c))) |
| 57 : |
|
|
((or (>= c colnum) (endp item-wins))) |
| 58 : |
|
|
(move-win (car item-wins) x y) |
| 59 : |
|
|
(setq item-wins (cdr item-wins)))) |
| 60 : |
|
|
|
| 61 : |
|
|
(do ((items item-list (cdr items)) |
| 62 : |
|
|
(windefs wins (cdr windefs))) |
| 63 : |
|
|
((or (endp items) (endp windefs))) |
| 64 : |
|
|
(comment (princ (caar items)) (princ " ")) |
| 65 : |
|
|
(set (caar items) (car windefs))) |
| 66 : |
|
|
|
| 67 : |
|
|
(mapcar wins #'(lambda (x) (resize-win x item-width item-height))) |
| 68 : |
|
|
(resize-win mw mw-width mw-height) |
| 69 : |
|
|
mw)) |
| 70 : |
|
|
|
| 71 : |
|
|
;; ------------------------------------ ;; |
| 72 : |
|
|
;; window-handler of addition primitive ;; |
| 73 : |
|
|
;; ------------------------------------ ;; |
| 74 : |
|
|
(defmacro connect-element-win (window editor prim eleme) |
| 75 : |
|
|
`(put-winprop ,window 'button-press-handler |
| 76 : |
|
|
(function |
| 77 : |
|
|
(lambda (win code x y) |
| 78 : |
|
|
(select-window win code x y) |
| 79 : |
|
|
(put-winprop |
| 80 : |
|
|
,editor |
| 81 : |
|
|
'button-press-handler |
| 82 : |
|
|
(function |
| 83 : |
|
|
(lambda (win code x y) |
| 84 : |
|
|
(setq ,prim |
| 85 : |
ktanaka |
1.2 |
(add-skeleton-element win |
| 86 : |
ktanaka |
1.1 |
code x y |
| 87 : |
|
|
,prim ',eleme))))))))) |
| 88 : |
|
|
|
| 89 : |
|
|
;; ----------- ;; |
| 90 : |
|
|
;; initializer ;; |
| 91 : |
|
|
;; ----------- ;; |
| 92 : |
ktanaka |
1.2 |
(defun initialize-skeleton-edit-sub () |
| 93 : |
ktanaka |
1.1 |
(comment |
| 94 : |
|
|
(unless (boundp '*near-cos-see-angle*) |
| 95 : |
|
|
(setq *near-cos-see-angle* (cos (//$ (*$ 160.0 (arccos 0.0)) 90.0))))) |
| 96 : |
|
|
|
| 97 : |
|
|
(unless (boundp '*near-range*) |
| 98 : |
|
|
(setq *near-range* 400)) |
| 99 : |
|
|
(unless (boundp '*menu-margin*) |
| 100 : |
|
|
(setq *menu-margin* 2)) |
| 101 : |
|
|
|
| 102 : |
|
|
(unless (boundp '*end-mode*) |
| 103 : |
|
|
(setq *end-mode* 3)) |
| 104 : |
|
|
(unless (boundp '*select-nearest*) |
| 105 : |
|
|
(setq *select-nearest* 2)) |
| 106 : |
|
|
(when (or (eq *end-mode* *select-nearest*) |
| 107 : |
|
|
(<= *end-mode* 0) |
| 108 : |
|
|
(<= *select-nearest* 0) |
| 109 : |
|
|
(> *end-mode* 3) |
| 110 : |
|
|
(> *select-nearest* 3)) |
| 111 : |
|
|
(princ "*end-mode* or *select-nearest* out of range... set default") |
| 112 : |
|
|
(terpri) |
| 113 : |
|
|
(setq *select-nearest* 2) |
| 114 : |
|
|
(setq *end-mode* 3)) |
| 115 : |
|
|
|
| 116 : |
|
|
(unless (boundp '*link-near-range*) |
| 117 : |
|
|
(setq *link-near-range* 16)) |
| 118 : |
|
|
(unless (boundp '*default-hirawidth*) |
| 119 : |
|
|
(setq *default-hirawidth* 8)) |
| 120 : |
|
|
|
| 121 : |
|
|
(unless (boundp '*default-slider-length*) |
| 122 : |
|
|
(setq *default-slider-length* 200)) |
| 123 : |
|
|
|
| 124 : |
|
|
(if (or (not (boundp '*range-too-large*)) |
| 125 : |
|
|
(> *near-range* *range-too-large*)) |
| 126 : |
|
|
(setq *range-too-large* (* 10 *near-range*))) |
| 127 : |
|
|
|
| 128 : |
|
|
(unless (boundp '*end-by-release*) |
| 129 : |
|
|
(setq *end-by-release* t)) |
| 130 : |
|
|
|
| 131 : |
|
|
(if (boundp 'editor) |
| 132 : |
|
|
(put-winprop editor 'button-press-handler nil)) |
| 133 : |
|
|
|
| 134 : |
|
|
;; init-status is move-point-selected |
| 135 : |
|
|
(if (and (boundp '*selected-window*) *selected-window*) |
| 136 : |
|
|
(normal-win *selected-window*)) |
| 137 : |
|
|
(setq *selected-window* nil) |
| 138 : |
|
|
|
| 139 : |
|
|
) |
| 140 : |
|
|
|
| 141 : |
|
|
;; ---------------- ;; |
| 142 : |
|
|
;; window selection ;; |
| 143 : |
|
|
;; ---------------- ;; |
| 144 : |
|
|
(defun select-window (win code x y) |
| 145 : |
|
|
(resize-win skeleditor |
| 146 : |
ktanaka |
1.2 |
*width-of-skeleton-editor* |
| 147 : |
|
|
*height-of-skeleton-editor*) |
| 148 : |
ktanaka |
1.1 |
(cond ((neq win *selected-window*) |
| 149 : |
|
|
(if *selected-window* (normal-win *selected-window*)) |
| 150 : |
|
|
(setq *selected-window* win) |
| 151 : |
|
|
(highlight-win *selected-window*))) |
| 152 : |
|
|
(display-force-output (window-display win)) |
| 153 : |
|
|
|
| 154 : |
|
|
(setf (window-event-mask editor) '(:exposure |
| 155 : |
|
|
:pointer-motion |
| 156 : |
|
|
:button-release |
| 157 : |
|
|
:button-press)) |
| 158 : |
|
|
(put-winprop editor 'button-press-handler nil) |
| 159 : |
|
|
(put-winprop editor 'button-release-handler nil) |
| 160 : |
|
|
(put-winprop editor 'motion-notify-handler nil) |
| 161 : |
|
|
(redraw-win editor)) |
| 162 : |
|
|
|
| 163 : |
|
|
;; -------------- ;; |
| 164 : |
|
|
;; motion-handler ;; |
| 165 : |
|
|
;; -------------- ;; |
| 166 : |
|
|
(defun print-pointer-position (win x y) |
| 167 : |
|
|
(print (list win x y))) |
| 168 : |
|
|
|
| 169 : |
|
|
;; -------------- ;; |
| 170 : |
|
|
;; window example ;; |
| 171 : |
|
|
;; -------------- ;; |
| 172 : |
|
|
|
| 173 : |
ktanaka |
1.2 |
(defun initialize-skeleton-editor () |
| 174 : |
ktanaka |
1.1 |
(initialize-skeleton-editor)) |
| 175 : |
|
|
|
| 176 : |
|
|
(defun initialize-skeleton-editor () |
| 177 : |
|
|
(ulx-magic) |
| 178 : |
|
|
(setup-display) |
| 179 : |
|
|
(print 'setup-display) |
| 180 : |
|
|
|
| 181 : |
ktanaka |
1.2 |
(initialize-skeleton-edit-sub) |
| 182 : |
ktanaka |
1.1 |
(print 'initialize) |
| 183 : |
|
|
|
| 184 : |
|
|
(make-skeledit-windows)) |
| 185 : |
|
|
|
| 186 : |
|
|
(defun initialize-kanji-edittee (name) |
| 187 : |
|
|
(setq edittee-name name) |
| 188 : |
ktanaka |
1.2 |
(setq niti (shapeup-skeleton (applykanji name) t)) |
| 189 : |
ktanaka |
1.1 |
(setq joint-prim-def nil) |
| 190 : |
|
|
(setq joint-prim-symbol nil) |
| 191 : |
|
|
(initialize-editor-screen) |
| 192 : |
|
|
(activate-menu edit-kana-kanji-primitive-menu) |
| 193 : |
|
|
(handle-button-press move-point 1 0 0)) |
| 194 : |
|
|
|
| 195 : |
|
|
(defun force-kana-kanji-edittee () |
| 196 : |
|
|
(setq edittee-name joint-prim-symbol) |
| 197 : |
ktanaka |
1.2 |
(setq niti (shapeup-skeleton (applykanji joint-prim-def) t)) |
| 198 : |
ktanaka |
1.1 |
(setq joint-prim-def nil) |
| 199 : |
|
|
(setq joint-prim-symbol nil) |
| 200 : |
|
|
(initialize-editor-screen) |
| 201 : |
|
|
(activate-menu edit-kana-kanji-primitive-menu) |
| 202 : |
|
|
(handle-button-press move-point 1 0 0)) |
| 203 : |
|
|
|
| 204 : |
|
|
(defun initialize-kana-edittee (name) |
| 205 : |
|
|
(initialize-kanji-edittee name)) |
| 206 : |
|
|
|
| 207 : |
|
|
(defun initialize-jointed-edittee (name) |
| 208 : |
|
|
(setq edittee-name name) |
| 209 : |
|
|
(setq joint-prim-symbol name) |
| 210 : |
|
|
(setq joint-prim-def (recursive-copy (expandkanji joint-prim-symbol))) |
| 211 : |
|
|
(setq niti joint-prim-def) |
| 212 : |
|
|
(initialize-editor-screen) |
| 213 : |
|
|
(activate-menu edit-jointed-primitive-menu) |
| 214 : |
|
|
(handle-button-press move-joint-prim 1 0 0)) |
| 215 : |
|
|
|
| 216 : |
|
|
(defun initialize-anonymous-edittee ((init nil)) |
| 217 : |
|
|
(print 'anonymous) |
| 218 : |
|
|
(setq edittee-name 'anonymous) |
| 219 : |
|
|
(setq niti (if init |
| 220 : |
ktanaka |
1.2 |
(shapeup-skeleton (applykanji init) t) |
| 221 : |
ktanaka |
1.1 |
'(nil nil))) |
| 222 : |
|
|
(setq joint-prim-def nil) |
| 223 : |
|
|
(setq joint-prim-symbol nil) |
| 224 : |
|
|
(initialize-editor-screen) |
| 225 : |
|
|
(activate-menu edit-kana-kanji-primitive-menu) |
| 226 : |
|
|
(handle-button-press add-ten 1 0 0)) |
| 227 : |
|
|
|
| 228 : |
|
|
(defun initialize-editor-screen () |
| 229 : |
|
|
(setf (window-cursor editor) please-wait-cursor) |
| 230 : |
|
|
(put-winprop editor 'motion-notify-handler #'(lambda (win x y))) |
| 231 : |
|
|
|
| 232 : |
|
|
(setf (window-cursor editor) hair-cross-cursor) |
| 233 : |
|
|
|
| 234 : |
|
|
(clear-win editor) |
| 235 : |
|
|
(if grid (grid-win editor)) |
| 236 : |
|
|
(if niti |
| 237 : |
ktanaka |
1.2 |
(draw-skeleton-win editor niti)) |
| 238 : |
ktanaka |
1.1 |
|
| 239 : |
|
|
(redraw-win editor) |
| 240 : |
|
|
(display-force-output display)) |
| 241 : |
|
|
|
| 242 : |
|
|
(defun save-edittee-to-file (output-file-name message) |
| 243 : |
|
|
(when (not (null niti)) |
| 244 : |
|
|
(call (string-append "touch " output-file-name ">& /dev/null")) |
| 245 : |
|
|
(call (string-append "chmod og+w " output-file-name ">& /dev/null")) |
| 246 : |
|
|
(let* ((standard-output |
| 247 : |
|
|
(appendopen (stream output-file-name)))) |
| 248 : |
|
|
(prind (list 'comment edittee-name |
| 249 : |
|
|
(getenv "USER") (date-time) |
| 250 : |
|
|
(cond ((pure-primitive-name? edittee-name) |
| 251 : |
|
|
'pure-primitive) |
| 252 : |
|
|
((eq (car niti) 'joint) |
| 253 : |
|
|
'jointed-primitives) |
| 254 : |
|
|
(t 'composite-primitive)))) |
| 255 : |
|
|
|
| 256 : |
|
|
(if (not (symbolp edittee-name)) |
| 257 : |
|
|
(setq edittee-name 'anonymous)) |
| 258 : |
|
|
|
| 259 : |
|
|
(if (neq (car niti) 'joint) |
| 260 : |
|
|
(prind (list (if (pure-primitive-name? edittee-name) |
| 261 : |
|
|
'setq |
| 262 : |
|
|
'comment) |
| 263 : |
|
|
edittee-name (list 'quote niti))) |
| 264 : |
|
|
(print-in-detail (list (if (pure-primitive-name? edittee-name) |
| 265 : |
|
|
'setq |
| 266 : |
|
|
'comment) |
| 267 : |
|
|
edittee-name (list 'quote niti))) |
| 268 : |
|
|
(terpri)) |
| 269 : |
|
|
|
| 270 : |
|
|
(terpri) |
| 271 : |
|
|
(close standard-output)) |
| 272 : |
|
|
(print-message-win |
| 273 : |
|
|
message |
| 274 : |
|
|
(zenkaku-string |
| 275 : |
|
|
(string-append "「" (string edittee-name) |
| 276 : |
|
|
"」を" output-file-name "に出力しました"))) |
| 277 : |
|
|
(redraw-win message) |
| 278 : |
|
|
(display-force-output display))) |
| 279 : |
|
|
|
| 280 : |
|
|
(setq niti nil) |
| 281 : |
|
|
|
| 282 : |
|
|
(defun auto-select-and-initialize (nit) |
| 283 : |
|
|
(cond ((kanji-primitive-name-? nit) |
| 284 : |
|
|
(initialize-kanji-edittee nit)) |
| 285 : |
|
|
((kana-primitive-name-? nit) |
| 286 : |
|
|
(initialize-kana-edittee nit)) |
| 287 : |
|
|
((jointed-primitive-name-? nit) |
| 288 : |
|
|
(initialize-jointed-edittee nit)) |
| 289 : |
|
|
((list-primitive-? nit) |
| 290 : |
|
|
(initialize-anonymous-edittee nit)) |
| 291 : |
|
|
(t |
| 292 : |
|
|
(initialize-anonymous-edittee)))) |
| 293 : |
|
|
|
| 294 : |
ktanaka |
1.2 |
(defun skeleton-edit ((nit 'unknown-primitive) (opname "/tmp/prim.out")) |
| 295 : |
ktanaka |
1.1 |
(skeleton-edit nit opname)) |
| 296 : |
|
|
|
| 297 : |
|
|
(defun skeleton-edit ((nit 'unknown-primitive) (opname "/tmp/prim.out")) |
| 298 : |
|
|
(setq output-file-name opname) |
| 299 : |
|
|
(when (and (= (call (string-append "test -f " output-file-name)) 0) |
| 300 : |
|
|
(= (call (string-append "test ! -w " output-file-name)) 0)) |
| 301 : |
|
|
(beep editor) |
| 302 : |
|
|
(princ (string-append "file " output-file-name " is not writable")) |
| 303 : |
|
|
(terpri) |
| 304 : |
|
|
(funcall err:open-close)) |
| 305 : |
|
|
|
| 306 : |
ktanaka |
1.2 |
(initialize-skeleton-edit-sub) |
| 307 : |
ktanaka |
1.1 |
|
| 308 : |
|
|
(clear-win message) |
| 309 : |
|
|
|
| 310 : |
|
|
(auto-select-and-initialize nit) |
| 311 : |
|
|
|
| 312 : |
|
|
(initialize-editor-screen) |
| 313 : |
|
|
|
| 314 : |
|
|
(print 'initialize) |
| 315 : |
|
|
|
| 316 : |
|
|
(main-loop display |
| 317 : |
|
|
#'(lambda () (eq *selected-window* syuuryou)) |
| 318 : |
|
|
editor) |
| 319 : |
|
|
|
| 320 : |
ktanaka |
1.2 |
(setq niti (shapeup-skeleton niti)) |
| 321 : |
ktanaka |
1.1 |
|
| 322 : |
|
|
(display-force-output display) |
| 323 : |
|
|
niti) |
| 324 : |
|
|
|
| 325 : |
|
|
(defun connect-window-handlers () |
| 326 : |
|
|
|
| 327 : |
|
|
(put-winprop move-point 'button-press-handler |
| 328 : |
|
|
#'(lambda (win code x y) |
| 329 : |
|
|
(select-window win code x y) |
| 330 : |
|
|
(put-winprop |
| 331 : |
|
|
editor |
| 332 : |
|
|
'button-press-handler |
| 333 : |
|
|
(function |
| 334 : |
|
|
(lambda (win code x y) |
| 335 : |
|
|
(setq niti |
| 336 : |
ktanaka |
1.2 |
(move-skeleton-point win code x y niti))))))) |
| 337 : |
ktanaka |
1.1 |
|
| 338 : |
|
|
(put-winprop toggle-link 'button-press-handler |
| 339 : |
|
|
#'(lambda (win code x y) |
| 340 : |
|
|
(select-window win code x y) |
| 341 : |
|
|
(put-winprop |
| 342 : |
|
|
editor |
| 343 : |
|
|
'button-press-handler |
| 344 : |
|
|
(function |
| 345 : |
|
|
(lambda (win code x y) |
| 346 : |
|
|
(setq niti |
| 347 : |
ktanaka |
1.2 |
(toggle-skeleton-link win |
| 348 : |
ktanaka |
1.1 |
code x y niti))))))) |
| 349 : |
|
|
|
| 350 : |
|
|
|
| 351 : |
|
|
(put-winprop delete-element 'button-press-handler |
| 352 : |
|
|
#'(lambda (win code x y) |
| 353 : |
|
|
(select-window win code x y) |
| 354 : |
|
|
(put-winprop |
| 355 : |
|
|
editor |
| 356 : |
|
|
'motion-notify-handler |
| 357 : |
|
|
#'(lambda (win x y) |
| 358 : |
|
|
(nearest-line-dotted win x y niti))) |
| 359 : |
|
|
(put-winprop |
| 360 : |
|
|
editor |
| 361 : |
|
|
'button-press-handler |
| 362 : |
|
|
(function |
| 363 : |
|
|
(lambda (win code x y) |
| 364 : |
|
|
(setq niti |
| 365 : |
ktanaka |
1.2 |
(delete-skeleton-element win |
| 366 : |
ktanaka |
1.1 |
code x y niti))))) |
| 367 : |
|
|
(setf (window-event-mask editor) '(:exposure |
| 368 : |
|
|
:button-press |
| 369 : |
|
|
:pointer-motion)))) |
| 370 : |
|
|
|
| 371 : |
|
|
(put-winprop nikuduke-min 'button-press-handler |
| 372 : |
|
|
#'(lambda (win code x y) |
| 373 : |
|
|
(when niti |
| 374 : |
|
|
(select-window win code x y) |
| 375 : |
|
|
(setf (window-cursor editor) please-wait-cursor) |
| 376 : |
|
|
(setf (window-cursor win) please-wait-cursor) |
| 377 : |
|
|
(display-force-output (window-display editor)) |
| 378 : |
ktanaka |
1.2 |
(setq niti (shapeup-skeleton niti)) |
| 379 : |
|
|
(draw-nikuduked-skeleton editor niti 'mincho) |
| 380 : |
ktanaka |
1.1 |
(setf (window-cursor editor) hair-cross-cursor) |
| 381 : |
|
|
(setf (window-cursor win) roupe-cursor) |
| 382 : |
|
|
(display-force-output (window-display editor))))) |
| 383 : |
|
|
|
| 384 : |
|
|
; added by tanaka 1993/9/18 |
| 385 : |
|
|
(put-winprop show-min 'button-press-handler |
| 386 : |
|
|
#'(lambda (win code x y) |
| 387 : |
|
|
(when niti |
| 388 : |
|
|
(select-window win code x y) |
| 389 : |
|
|
(setf (window-cursor editor) please-wait-cursor) |
| 390 : |
|
|
(setf (window-cursor win) please-wait-cursor) |
| 391 : |
|
|
(display-force-output (window-display editor)) |
| 392 : |
ktanaka |
1.2 |
(setq niti (shapeup-skeleton niti)) |
| 393 : |
|
|
(show-nikuduked-skeleton editor niti 'mincho) |
| 394 : |
ktanaka |
1.1 |
(setf (window-cursor editor) hair-cross-cursor) |
| 395 : |
|
|
(setf (window-cursor win) roupe-cursor) |
| 396 : |
|
|
(display-force-output (window-display editor))))) |
| 397 : |
|
|
(put-winprop toggle-grid 'button-press-handler |
| 398 : |
|
|
#'(lambda (win code x y) |
| 399 : |
|
|
; (select-window win code x y) |
| 400 : |
|
|
(cond (grid (setq grid nil))(t (setq grid t))) |
| 401 : |
|
|
(clear-win editor) |
| 402 : |
|
|
(if grid (grid-win editor)) |
| 403 : |
|
|
(if niti |
| 404 : |
ktanaka |
1.2 |
(draw-skeleton-win editor niti)) |
| 405 : |
ktanaka |
1.1 |
(redraw-win editor) |
| 406 : |
|
|
(display-force-output (window-display editor)) |
| 407 : |
|
|
)) |
| 408 : |
|
|
|
| 409 : |
|
|
(put-winprop nikuduke-got 'button-press-handler |
| 410 : |
|
|
#'(lambda (win code x y) |
| 411 : |
|
|
(when niti |
| 412 : |
|
|
(select-window win code x y) |
| 413 : |
|
|
(setf (window-cursor editor) please-wait-cursor) |
| 414 : |
|
|
(setf (window-cursor win) please-wait-cursor) |
| 415 : |
|
|
(display-force-output (window-display editor)) |
| 416 : |
ktanaka |
1.2 |
(setq niti (shapeup-skeleton niti)) |
| 417 : |
|
|
(draw-nikuduked-skeleton editor niti 'gothic) |
| 418 : |
ktanaka |
1.1 |
(setf (window-cursor editor) hair-cross-cursor) |
| 419 : |
|
|
(setf (window-cursor win) roupe-cursor) |
| 420 : |
|
|
(display-force-output (window-display editor))))) |
| 421 : |
|
|
|
| 422 : |
|
|
(put-winprop hira-width 'button-press-handler |
| 423 : |
|
|
#'(lambda (win code x y) |
| 424 : |
|
|
(select-window win code x y) |
| 425 : |
|
|
(put-winprop |
| 426 : |
|
|
editor |
| 427 : |
|
|
'button-press-handler |
| 428 : |
|
|
#'(lambda (win code x y) |
| 429 : |
|
|
(setq niti |
| 430 : |
|
|
(change-hira-width win code x y niti)))))) |
| 431 : |
|
|
|
| 432 : |
|
|
(put-winprop hira-lengthen 'button-press-handler |
| 433 : |
|
|
#'(lambda (win code x y) |
| 434 : |
|
|
(select-window win code x y) |
| 435 : |
|
|
(put-winprop |
| 436 : |
|
|
editor |
| 437 : |
|
|
'motion-notify-handler |
| 438 : |
|
|
#'(lambda (win x y) |
| 439 : |
|
|
(nearest-line-dotted win x y niti))) |
| 440 : |
|
|
(put-winprop |
| 441 : |
|
|
editor |
| 442 : |
|
|
'button-press-handler |
| 443 : |
|
|
#'(lambda (win code x y) |
| 444 : |
|
|
(setq niti |
| 445 : |
|
|
(make-hira-element-long win code x y niti)))) |
| 446 : |
|
|
(setf (window-event-mask editor) '(:exposure |
| 447 : |
|
|
:button-release |
| 448 : |
|
|
:button-press |
| 449 : |
|
|
:pointer-motion)))) |
| 450 : |
|
|
|
| 451 : |
|
|
(put-winprop part-move 'button-press-handler |
| 452 : |
|
|
#'(lambda (win code x y) |
| 453 : |
|
|
(select-window win code x y) |
| 454 : |
|
|
(put-winprop |
| 455 : |
|
|
editor |
| 456 : |
|
|
'button-press-handler |
| 457 : |
|
|
#'(lambda (win code x y) |
| 458 : |
|
|
(setq niti |
| 459 : |
|
|
(move-some-points win code x y niti |
| 460 : |
|
|
*end-by-release*)))))) |
| 461 : |
|
|
|
| 462 : |
|
|
(put-winprop part-resize 'button-press-handler |
| 463 : |
|
|
#'(lambda (win code x y) |
| 464 : |
|
|
(select-window win code x y) |
| 465 : |
|
|
(put-winprop |
| 466 : |
|
|
editor |
| 467 : |
|
|
'button-press-handler |
| 468 : |
|
|
#'(lambda (win code x y) |
| 469 : |
|
|
(setq niti |
| 470 : |
|
|
(resize-some-points win code x y niti |
| 471 : |
|
|
*end-by-release*)))))) |
| 472 : |
|
|
|
| 473 : |
|
|
(put-winprop syuuryou 'button-press-handler |
| 474 : |
|
|
#'(lambda (win code x y) |
| 475 : |
|
|
(select-window win code x y) |
| 476 : |
|
|
(save-edittee-to-file output-file-name message) |
| 477 : |
|
|
(when current-selected-menu |
| 478 : |
|
|
(unmap-menu current-selected-menu)) |
| 479 : |
|
|
(setq current-selected-menu nil) |
| 480 : |
|
|
)) |
| 481 : |
|
|
|
| 482 : |
|
|
(put-winprop hira-long-pnt-add 'button-press-handler |
| 483 : |
|
|
#'(lambda (win code x y) |
| 484 : |
|
|
(select-window win code x y) |
| 485 : |
|
|
(setup-add-hira-point) |
| 486 : |
|
|
(put-winprop editor 'button-press-handler |
| 487 : |
|
|
#'(lambda (win code x y) |
| 488 : |
|
|
(setq niti |
| 489 : |
|
|
(add-hira-point win x y niti)))))) |
| 490 : |
|
|
|
| 491 : |
|
|
(put-winprop |
| 492 : |
|
|
move-joint-prim 'button-press-handler |
| 493 : |
|
|
#'(lambda (win code x y) |
| 494 : |
|
|
(select-window win code x y) |
| 495 : |
|
|
(put-winprop editor 'button-press-handler |
| 496 : |
|
|
#'(lambda (win code x y) |
| 497 : |
|
|
(setq joint-prim-def |
| 498 : |
|
|
(move-primitive-of-jointed-primitive |
| 499 : |
|
|
win code x y)) |
| 500 : |
|
|
(setq niti joint-prim-def))))) |
| 501 : |
|
|
|
| 502 : |
|
|
(put-winprop |
| 503 : |
|
|
resize-joint-prim 'button-press-handler |
| 504 : |
|
|
#'(lambda (win code x y) |
| 505 : |
|
|
(select-window win code x y) |
| 506 : |
|
|
(put-winprop editor 'button-press-handler |
| 507 : |
|
|
#'(lambda (win code x y) |
| 508 : |
|
|
(setq joint-prim-def |
| 509 : |
|
|
(resize-primitive-of-jointed-primitive |
| 510 : |
|
|
win code x y)) |
| 511 : |
|
|
(setq niti joint-prim-def))))) |
| 512 : |
|
|
|
| 513 : |
|
|
(put-winprop hira-shorten 'button-press-handler |
| 514 : |
|
|
#'(lambda (win code x y) |
| 515 : |
|
|
(select-window win code x y) |
| 516 : |
|
|
(setup-del-hira-point) |
| 517 : |
|
|
(put-winprop editor 'button-press-handler |
| 518 : |
|
|
#'(lambda (win code x y) |
| 519 : |
|
|
(setq niti |
| 520 : |
|
|
(del-hira-point editor x y niti)))))) |
| 521 : |
|
|
|
| 522 : |
|
|
(put-winprop ed-xyunit 'button-press-handler |
| 523 : |
|
|
#'(lambda (win code x y) |
| 524 : |
|
|
(select-window win code x y) |
| 525 : |
|
|
(resize-win skeleditor |
| 526 : |
|
|
(+ (width-win skeleditor) |
| 527 : |
|
|
(width-win temporary-window) |
| 528 : |
|
|
*menu-margin*) |
| 529 : |
|
|
(max (height-win skeleditor) |
| 530 : |
|
|
(height-win temporary-window))) |
| 531 : |
|
|
(when (or (null (get-prim-info niti 'xunit)) |
| 532 : |
|
|
(null (get-prim-info niti 'yunit))) |
| 533 : |
|
|
(setq niti (add-unit niti)) |
| 534 : |
|
|
(clear-win editor) |
| 535 : |
|
|
(if grid (grid-win editor)) |
| 536 : |
ktanaka |
1.2 |
(draw-skeleton-win editor niti) |
| 537 : |
ktanaka |
1.1 |
(redisplay-win editor)) |
| 538 : |
|
|
(put-winprop |
| 539 : |
|
|
editor 'button-press-handler |
| 540 : |
|
|
#'(lambda (win code x y) |
| 541 : |
|
|
(setq niti |
| 542 : |
|
|
(edit-xyunit-of-primitive win x y niti)))))) |
| 543 : |
|
|
|
| 544 : |
|
|
(put-winprop recomp-xyunit 'button-press-handler |
| 545 : |
|
|
#'(lambda (win code x y) |
| 546 : |
|
|
(select-window win code x y) |
| 547 : |
|
|
(if (ask-y-n skeleditor "ユニットを既定値にします") |
| 548 : |
|
|
(setq niti (add-default-xyunit niti))) |
| 549 : |
|
|
(clear-win editor) |
| 550 : |
|
|
(if grid (grid-win editor)) |
| 551 : |
ktanaka |
1.2 |
(draw-skeleton-win editor niti) |
| 552 : |
ktanaka |
1.1 |
(redisplay-win editor))) |
| 553 : |
|
|
|
| 554 : |
|
|
(put-winprop etc-1 'button-press-handler |
| 555 : |
|
|
#'(lambda (win code x y) |
| 556 : |
|
|
(select-window win code x y))) |
| 557 : |
|
|
|
| 558 : |
|
|
(put-winprop etc-2 'button-press-handler |
| 559 : |
|
|
#'(lambda (win code x y) |
| 560 : |
|
|
(select-window win code x y))) |
| 561 : |
|
|
|
| 562 : |
|
|
(connect-element-win add-ten editor niti ten) |
| 563 : |
|
|
(connect-element-win add-tate editor niti tate) |
| 564 : |
|
|
(connect-element-win add-yoko editor niti yoko) |
| 565 : |
|
|
(connect-element-win add-migiue editor niti migiue) |
| 566 : |
|
|
(connect-element-win add-hidari editor niti hidari) |
| 567 : |
|
|
|
| 568 : |
|
|
(connect-element-win add-tatehidari editor niti tatehidari) |
| 569 : |
|
|
(connect-element-win add-migi editor niti migi) |
| 570 : |
|
|
(connect-element-win add-kozato editor niti kozato) |
| 571 : |
|
|
(connect-element-win add-tatehane editor niti tatehane) |
| 572 : |
|
|
(connect-element-win add-tsukurihane editor niti tsukurihane) |
| 573 : |
|
|
|
| 574 : |
|
|
(connect-element-win add-sanzui editor niti sanzui) |
| 575 : |
|
|
(connect-element-win add-kokoro editor niti kokoro) |
| 576 : |
|
|
(connect-element-win add-tasuki editor niti tasuki) |
| 577 : |
|
|
(connect-element-win add-magaritate editor niti magaritate) |
| 578 : |
|
|
(connect-element-win add-kagi editor niti kagi) |
| 579 : |
|
|
|
| 580 : |
|
|
(connect-element-win add-shinnyuu editor niti shin-nyuu) |
| 581 : |
|
|
|
| 582 : |
|
|
(connect-element-win add-hira-long editor niti hira-long) |
| 583 : |
|
|
(connect-element-win add-hira-short editor niti hira-short) |
| 584 : |
|
|
(connect-element-win add-hira-maru editor niti hira-circle) |
| 585 : |
|
|
(connect-element-win add-outline editor niti outline) |
| 586 : |
|
|
|
| 587 : |
|
|
(put-winprop editor 'button-press-handler nil) |
| 588 : |
|
|
|
| 589 : |
|
|
(put-winprop force-primitive 'button-press-handler |
| 590 : |
|
|
#'(lambda (win code x y) |
| 591 : |
|
|
(cond ((null joint-prim-def) |
| 592 : |
|
|
(beep editor)) |
| 593 : |
|
|
(t |
| 594 : |
|
|
(and (ask-y-n skeleditor |
| 595 : |
|
|
"プリミティブに変換します") |
| 596 : |
|
|
(force-kana-kanji-edittee)))))) |
| 597 : |
|
|
|
| 598 : |
|
|
(put-winprop change-name 'button-press-handler |
| 599 : |
|
|
#'(lambda (win code x y) |
| 600 : |
|
|
(let ((sym (intern (read-string-from-kinput skeleditor)))) |
| 601 : |
|
|
(save-edittee-to-file output-file-name message) |
| 602 : |
|
|
(auto-select-and-initialize sym)))) |
| 603 : |
|
|
nil) |
| 604 : |
|
|
|
| 605 : |
|
|
(defun activate-menu (menu (at-first t)) |
| 606 : |
|
|
(when (and current-selected-menu at-first) |
| 607 : |
|
|
(unmap-menu current-selected-menu)) |
| 608 : |
|
|
|
| 609 : |
|
|
(when menu |
| 610 : |
|
|
(map-subwindows menu) |
| 611 : |
|
|
(map-window menu) |
| 612 : |
|
|
(mapcar (get-winprop menu 'next-menu) |
| 613 : |
|
|
#'(lambda (m) (activate-menu m nil)))) |
| 614 : |
|
|
|
| 615 : |
|
|
(if at-first (setq current-selected-menu menu))) |
| 616 : |
|
|
|
| 617 : |
|
|
(defun kanji-primitive-name-? (sym) |
| 618 : |
|
|
(and (symbolp sym) |
| 619 : |
|
|
(boundp sym) |
| 620 : |
|
|
(eq sym (expandkanji sym)) |
| 621 : |
|
|
(let ((sym-string (string sym))) |
| 622 : |
|
|
(not (and (= (string-length sym-string) 2) |
| 623 : |
|
|
(or (= (sref sym-string 0) 164) |
| 624 : |
|
|
(= (sref sym-string 0) 165))))))) |
| 625 : |
|
|
|
| 626 : |
|
|
(defun kana-primitive-name-? (sym) |
| 627 : |
|
|
(and (symbolp sym) |
| 628 : |
|
|
(boundp sym) |
| 629 : |
|
|
(eq sym (expandkanji sym)) |
| 630 : |
|
|
(print sym) |
| 631 : |
|
|
(let ((sym-string (string sym))) |
| 632 : |
|
|
(and (= (string-length sym-string) 2) |
| 633 : |
|
|
(or (= (sref sym-string 0) 164) |
| 634 : |
|
|
(= (sref sym-string 0) 165)))))) |
| 635 : |
|
|
|
| 636 : |
|
|
(defun list-primitive-? (nit) |
| 637 : |
|
|
(and (not (symbolp nit)) |
| 638 : |
|
|
(setq nit (applykanji nit)) |
| 639 : |
|
|
(listp nit) |
| 640 : |
|
|
(listp (car nit)) |
| 641 : |
|
|
(listp (caar nit)) |
| 642 : |
|
|
(numberp (caaar nit)))) |
| 643 : |
|
|
|
| 644 : |
|
|
(defun jointed-primitive-name-? (sym) |
| 645 : |
|
|
(let ((ex nil)) |
| 646 : |
|
|
(or (and (listp sym) |
| 647 : |
|
|
(symbolp (car sym))) |
| 648 : |
|
|
(and (symbolp sym) |
| 649 : |
|
|
(boundp sym) |
| 650 : |
|
|
(neq sym (setq ex (expandkanji sym))) |
| 651 : |
|
|
(listp ex) |
| 652 : |
|
|
(eq (car ex) 'joint))))) |
| 653 : |
|
|
|
| 654 : |
|
|
(defun make-skeledit-windows () |
| 655 : |
|
|
(let ((menu-width 0) |
| 656 : |
|
|
(menu-height 0) |
| 657 : |
|
|
(edit-menus nil) |
| 658 : |
|
|
(y 0)) |
| 659 : |
|
|
|
| 660 : |
|
|
(setq skeleditor (create-win root 0 0 10 10 black white kanji-font)) |
| 661 : |
|
|
(setf (window-event-mask skeleditor) '(:exposure :property-change)) |
| 662 : |
|
|
(setf (wm-name skeleditor) "skeleton editor") |
| 663 : |
|
|
(print 'skeleditor) |
| 664 : |
|
|
|
| 665 : |
|
|
(setq edit-common-menu |
| 666 : |
|
|
(create-menu skeleditor 0 0 black white kanji-font roupe-cursor |
| 667 : |
|
|
'((change-name "次の編集") |
| 668 : |
|
|
(nikuduke-min "肉付（明朝）") |
| 669 : |
|
|
(show-min "輪郭（明朝）") |
| 670 : |
|
|
(nikuduke-got "肉付（ゴシック）") |
| 671 : |
|
|
(etc-1 "テスト用１") |
| 672 : |
|
|
(etc-2 "テスト用２") |
| 673 : |
|
|
(syuuryou "終わり")))) |
| 674 : |
|
|
(incr y (+ (height-win edit-common-menu) *menu-margin*)) |
| 675 : |
|
|
|
| 676 : |
|
|
(setq edit-kana-kanji-primitive-menu |
| 677 : |
|
|
(create-menu skeleditor 0 y black white kanji-font roupe-cursor |
| 678 : |
|
|
'((move-point "点の移動") |
| 679 : |
|
|
(toggle-link "点の接続／非接続") |
| 680 : |
|
|
(delete-element "線の削除") |
| 681 : |
|
|
(toggle-grid "グリッド") |
| 682 : |
|
|
(part-move "一部を平行移動") |
| 683 : |
|
|
(part-resize "一部を拡大縮小") |
| 684 : |
|
|
(ed-xyunit "ユニットの編集") |
| 685 : |
|
|
(recomp-xyunit "ユニット再計算")))) |
| 686 : |
|
|
(let ((yy (+ y (height-win edit-kana-kanji-primitive-menu) *menu-margin*))) |
| 687 : |
|
|
(setq edit-kana-kanji-primitive-menu-sub-1 |
| 688 : |
|
|
(create-menu skeleditor 0 yy black white kanji-font roupe-cursor |
| 689 : |
|
|
'((add-ten "点") |
| 690 : |
|
|
(add-tate "縦棒") |
| 691 : |
|
|
(add-yoko "横棒") |
| 692 : |
|
|
(add-migiue "右上撥") |
| 693 : |
|
|
(add-hidari "左払") |
| 694 : |
|
|
(add-tatehidari "縦左払") |
| 695 : |
|
|
(add-migi "右払") |
| 696 : |
|
|
(add-kozato "阜一部") |
| 697 : |
|
|
(add-tatehane "縦撥") |
| 698 : |
|
|
(add-tsukurihane "旁撥") |
| 699 : |
|
|
(add-sanzui "三水下") |
| 700 : |
|
|
(add-kokoro "心一部")))) |
| 701 : |
|
|
(setq edit-kana-kanji-primitive-menu-sub-2 |
| 702 : |
|
|
(create-menu skeleditor |
| 703 : |
|
|
(+ (width-win edit-kana-kanji-primitive-menu-sub-1) |
| 704 : |
|
|
*menu-margin*) |
| 705 : |
|
|
yy black white kanji-font roupe-cursor |
| 706 : |
|
|
'((add-tasuki "たすき") |
| 707 : |
|
|
(add-magaritate "曲り縦棒") |
| 708 : |
|
|
(add-kagi "かぎ") |
| 709 : |
|
|
(add-shinnyuu "之繞") |
| 710 : |
|
|
(add-hira-long "長い仮名") |
| 711 : |
|
|
(add-hira-short "短い仮名") |
| 712 : |
|
|
(add-hira-maru "仮名の丸") |
| 713 : |
|
|
(add-outline "輪郭線") |
| 714 : |
|
|
(hira-width "仮名の太") |
| 715 : |
|
|
(hira-lengthen "仮名長く") |
| 716 : |
|
|
(hira-long-pnt-add "仮名追加") |
| 717 : |
|
|
(hira-shorten "仮名削除")))) |
| 718 : |
|
|
(put-winprop edit-kana-kanji-primitive-menu 'next-menu |
| 719 : |
|
|
(list edit-kana-kanji-primitive-menu-sub-1 |
| 720 : |
|
|
edit-kana-kanji-primitive-menu-sub-2))) |
| 721 : |
|
|
|
| 722 : |
|
|
(setq edit-jointed-primitive-menu |
| 723 : |
|
|
(create-menu skeleditor 0 y black white kanji-font roupe-cursor |
| 724 : |
|
|
'((move-joint-prim "組合せ内の移動") |
| 725 : |
|
|
(resize-joint-prim "組合せ内の拡縮") |
| 726 : |
|
|
(force-primitive "プリミティブ変換")))) |
| 727 : |
|
|
|
| 728 : |
|
|
(incr y (+ (max (+ (height-win edit-kana-kanji-primitive-menu) |
| 729 : |
|
|
(max (height-win edit-kana-kanji-primitive-menu-sub-1) |
| 730 : |
|
|
(height-win edit-kana-kanji-primitive-menu-sub-2))) |
| 731 : |
|
|
(height-win edit-jointed-primitive-menu)) |
| 732 : |
|
|
*menu-margin*)) |
| 733 : |
|
|
|
| 734 : |
|
|
(setq edit-menus (list edit-common-menu |
| 735 : |
|
|
edit-kana-kanji-primitive-menu |
| 736 : |
|
|
edit-jointed-primitive-menu)) |
| 737 : |
|
|
|
| 738 : |
|
|
(mapcar edit-menus |
| 739 : |
|
|
#'(lambda (menu) |
| 740 : |
|
|
(setf (window-event-mask menu) '(:exposure)))) |
| 741 : |
|
|
|
| 742 : |
|
|
(print 'menus) |
| 743 : |
|
|
|
| 744 : |
|
|
(setq menu-width |
| 745 : |
|
|
(max (apply #'max |
| 746 : |
|
|
(mapcar edit-menus |
| 747 : |
|
|
#'(lambda (menu) (width-win menu)))) |
| 748 : |
|
|
(+ (width-win edit-kana-kanji-primitive-menu-sub-1) |
| 749 : |
|
|
(width-win edit-kana-kanji-primitive-menu-sub-2)))) |
| 750 : |
|
|
|
| 751 : |
|
|
(setq menu-height y) |
| 752 : |
|
|
|
| 753 : |
|
|
(setq editor (create-win skeleditor |
| 754 : |
|
|
(+ menu-width *menu-margin*) |
| 755 : |
|
|
0 |
| 756 : |
|
|
400 400 black white kanji-font)) |
| 757 : |
|
|
(setf (window-event-mask editor) '(:exposure :button-press)) |
| 758 : |
|
|
(setf (window-cursor editor) hair-cross-cursor) |
| 759 : |
|
|
(print 'editor) |
| 760 : |
|
|
|
| 761 : |
|
|
(setq width-sliders |
| 762 : |
|
|
(create-slider-menu skeleditor |
| 763 : |
|
|
0 |
| 764 : |
|
|
(+ (max menu-height (height-win editor)) |
| 765 : |
|
|
*menu-margin*) |
| 766 : |
|
|
black white kanji-font |
| 767 : |
|
|
(min-wid "明朝基準太さ " |
| 768 : |
|
|
5.0 30.0 'minchowidth 20.0) |
| 769 : |
|
|
(got-wid "ゴシック基準太さ" |
| 770 : |
|
|
5.0 30.0 'gothicwidth 13.0) |
| 771 : |
|
|
(hir-wid "平仮名基準太さ " |
| 772 : |
|
|
0.0 1.5 'hirawidth 0.6))) |
| 773 : |
|
|
(print 'sliders) |
| 774 : |
|
|
|
| 775 : |
|
|
(setq message (create-win skeleditor |
| 776 : |
|
|
0 |
| 777 : |
|
|
(+ (drawable-y width-sliders) *menu-margin* |
| 778 : |
|
|
(height-win width-sliders)) |
| 779 : |
|
|
500 50 black white kanji-font)) |
| 780 : |
|
|
(print 'message) |
| 781 : |
|
|
|
| 782 : |
|
|
(resize-win skeleditor |
| 783 : |
|
|
(max (+ menu-width |
| 784 : |
|
|
(width-win editor) (* *menu-margin* 4)) |
| 785 : |
|
|
(width-win message)) |
| 786 : |
|
|
(max (+ (max menu-height (height-win editor)) |
| 787 : |
|
|
(height-win width-sliders) |
| 788 : |
|
|
(height-win message) |
| 789 : |
|
|
(* *menu-margin* 4)) |
| 790 : |
|
|
(height-win skeleditor))) |
| 791 : |
|
|
|
| 792 : |
ktanaka |
1.2 |
(setq *width-of-skeleton-editor* (width-win skeleditor)) |
| 793 : |
|
|
(setq *height-of-skeleton-editor* (height-win skeleditor)) |
| 794 : |
ktanaka |
1.1 |
|
| 795 : |
|
|
(setq temporary-window |
| 796 : |
|
|
(create-win skeleditor |
| 797 : |
|
|
(width-win skeleditor) 0 |
| 798 : |
|
|
400 400 |
| 799 : |
|
|
black white kanji-font)) |
| 800 : |
|
|
|
| 801 : |
|
|
(connect-window-handlers) |
| 802 : |
|
|
|
| 803 : |
|
|
(map-subwindows edit-common-menu) |
| 804 : |
|
|
(map-subwindows width-sliders) |
| 805 : |
|
|
(map-subwindows skeleditor) |
| 806 : |
|
|
(unmap-menu edit-kana-kanji-primitive-menu) |
| 807 : |
|
|
(unmap-menu edit-jointed-primitive-menu) |
| 808 : |
|
|
(setq current-selected-menu nil) |
| 809 : |
|
|
(map-window skeleditor))) |
| 810 : |
|
|
|
| 811 : |
|
|
(defun unmap-menu (menu) |
| 812 : |
|
|
(mapcar (get-winprop menu 'next-menu) |
| 813 : |
|
|
#'(lambda (m) |
| 814 : |
|
|
(unmap-menu m))) |
| 815 : |
|
|
(unmap-subwindows menu) |
| 816 : |
|
|
(unmap-window menu)) |
| 817 : |
|
|
|
| 818 : |
|
|
(defun print-in-detail (p) |
| 819 : |
|
|
(cond ((stringp p) (prind p) (princ " ")) |
| 820 : |
|
|
((vectorp p) |
| 821 : |
|
|
(princ "#(") |
| 822 : |
|
|
(do ((len (vector-length p)) |
| 823 : |
|
|
(i 0 (1+ i))) |
| 824 : |
|
|
((>= i len)) |
| 825 : |
|
|
(print-in-detail (vref p i)) |
| 826 : |
|
|
(princ " ")) |
| 827 : |
|
|
(princ ") ")) |
| 828 : |
|
|
((listp p) |
| 829 : |
|
|
(princ "(") |
| 830 : |
|
|
(let ((last (do ((rest p (cdr rest))) |
| 831 : |
|
|
((endp rest) rest) |
| 832 : |
|
|
(print-in-detail (car rest))))) |
| 833 : |
|
|
(if (null last) |
| 834 : |
|
|
(princ ") ") |
| 835 : |
|
|
(princ " . ") |
| 836 : |
|
|
(princ last) |
| 837 : |
|
|
(princ " ) ")))) |
| 838 : |
|
|
((atom p) (princ p) (princ " ")) |
| 839 : |
|
|
(t (prind p))) |
| 840 : |
|
|
nil) |
| 841 : |
|
|
|
| 842 : |
|
|
;; |
| 843 : |
|
|
;; (defun takobeya () |
| 844 : |
ktanaka |
1.2 |
;; (initialize-skeleton-editor) |
| 845 : |
|
|
;; (setq boo (skeleton-edit boo)) |
| 846 : |
|
|
;; (setq foo (skeleton-edit foo)) |
| 847 : |
|
|
;; (setq woo (skeleton-edit woo)) |
| 848 : |
ktanaka |
1.1 |
;; ... |
| 849 : |
|
|
;; |
| 850 : |
|
|
|
Annotation of /lisp/tools/skeledit.l
Parent Directory
| 
Revision Log