kh-odr.l

(File "winnote.lnk" "win-odr.odr")

(File "sitelisp.lnk" "kh-odrtools.l")

001: (defun user::checklongdash ()
002:   (interactive)
003:   (let (foundp)
004:     (beginning-of-line)
005:     (setq foundp t)
006:     (block exit
007:       (while foundp
008:         (setq foundp nil)
009:         ; 次の行とその次の行で、---------------- を書いて改行して
010:         ; あって、その次の行は、* で始まらないような行を探し
011:         ; ています。re-search-forward では、改行キーを ¥n で
012:         ; 表すのではなくて、改行キーを入力します。
013:         (if (re-search-forward "^[ ]*----------+
014: [^¥¥*]")
015:             (progn
016:               (goto-char (match-end 0))
017:               (backward-char 2)
018:               (beginning-of-line)
019:               (setq foundp t)))
020:         (if foundp
021:             (progn
022:               (while (looking-at "^[ ]*-+$")
023:                 (progn
024:                   (forward-line 1)
025:                   (start-selection-as-line)
026:                   (while 
027:                       (not 
028:                        (or (looking-at "^[ ]*------+¥¥.$")
029:                            (looking-at "^[ ]*------+$")
030:                            (looking-at "^¥¥*")
031:                            )
032:                        )
033:                     (forward-line 1))
034:                   (if (looking-at "^[ ]*-+¥¥.$")
035:                       (progn
036:                         (stop-selection)
037:                         (forward-line 1)
038:                         )
039:                     (progn
040:                       (refresh-screen)
041:                       (sleep-for 2)
042:                       (stop-selection)
043:                       (forward-line 1)
044:                       (return-from exit)
045:                       )
046:                     )
047:                   ); end of if
048:                 ); end of while
049:               ); end of progn
050:           ); end of if
051:         ); end of while
052:       ); end of block
053:     ); end of let
054:   )

055: (defun following-higher-heading-line ()
056:   (interactive)
057:   (let (tmpstr nstar mstar bool)
058:     (setq *lastpos* (point))
059:     (goto-bol)
060:     (if (not (looking-at "^[¥*][¥*]* [^ ]"))
061:         (progn
062:           (my-message-box "この行は見出し行ではありません。")
063:           (return-from following-higher-heading-line)))
064:     ;
065:     ; 現在の見出し行の行頭から行末までの文字列を tmpstr に格
066:     ; 納する
067:     (setq tmpstr (buffer-substring (progn (goto-bol) (point))
068:                                    (progn (goto-eol) (point))))
069:     (goto-bol)
070:     ;
071:     ; つぎの２行で、行頭の * の個数を数えて、nstar に格納する
072:     (string-match "^¥¥([¥*][¥*]*¥¥) .*" tmpstr)
073:     (setq nstar (length (string-replace-match tmpstr "¥¥1")))
074:     ;
075:     (forward-line 1)
076:     (loop
077:       (setq bool (re-search-forward "^[¥*][¥*]* [^ ]" t))
078:       (if (not bool)
079:           (progn
080:             (my-message-box "見出し行が見つかりません。")
081:             (goto-char *lastpos*)
082:             (return-from following-higher-heading-line)))
083:       ;
084:       ; つぎの５行で、行頭の * の個数を数えて、mstar に格納する
085:       (setq tmpstr (buffer-substring (progn (goto-bol) (point))
086:                                      (progn (goto-eol) (point))))
087:       (goto-bol)
088:       (string-match "^¥¥([¥*][¥*]*¥¥) .*" tmpstr)
089:       (setq mstar (length (string-replace-match tmpstr "¥¥1")))
090:       ;
091:       (if (or (< mstar nstar) (= mstar 1))
092:           (progn
093:             (message (user::headingline))
094:             (return-from following-higher-heading-line)))
095:       (forward-line 1)
096:       )      
097:     ))

098: (defun following-samelevel-heading-line ()
099:   (interactive)
100:   (let (tmpstr nstar mstar bool)
101:     (setq *lastpos* (point))
102:     (setq *lastfunc* 'following-samelevel-heading-line)
103:     (goto-bol)
104:     (if (not (looking-at "^[¥*][¥*]* [^ ]"))
105:         (re-search-backward "^[¥*][¥*]* [^ ]"))
106:     ;
107:     ; 現在の見出し行の行頭から行末までの文字列を tmpstr に格納す
108:     ; る
109:     (setq tmpstr (buffer-substring (progn (goto-bol) (point))
110:                                    (progn (goto-eol) (point))))
111:     (goto-bol)
112:     ;
113:     ; つぎの２行で、行頭の * の個数を数えて、nstar に格納する
114:     (string-match "^¥¥([¥*][¥*]*¥¥) .*" tmpstr)
115:     (setq nstar (length (string-replace-match tmpstr "¥¥1")))
116:     ;
117:     (forward-line 1)
118:     (loop
119:       (setq bool (re-search-forward "^[¥*][¥*]* [^ ]" t))
120:       (if (not bool)
121:           (progn
122:             (my-message-box "見出し行が見つかりません。")
123:             (goto-char *lastpos*)
124:             (return-from following-samelevel-heading-line)))
125:       ;
126:       ; つぎの５行で、行頭の * の個数を数えて、mstar に格納する
127:       (setq tmpstr (buffer-substring (progn (goto-bol) (point))
128:                                      (progn (goto-eol) (point))))
129:       (goto-bol)
130:       (string-match "^¥¥([¥*][¥*]*¥¥) .*" tmpstr)
131:       (setq mstar (length (string-replace-match tmpstr "¥¥1")))
132:       ;
133:       (if (<= mstar nstar)
134:           (progn
135:             (message (user::headingline))
136:             (refresh-screen)
137:             (scroll-to-window-top)
138:             (refresh-screen)
139:             (scroll-window -6)
140:             (refresh-screen)
141:             (forward-virtual-line 6)
142:             (refresh-screen)
143:             (return-from following-samelevel-heading-line))
144:         )
145:       ; (if (< mstar nstar)
146:       ;     (progn
147:       ;       (message (user::headingline))
148:       ;       ; (message-box 
149:       ;       ;  "同じレベルの見出し行はもうありません。")
150:       ;       ; (goto-char *lastpos*)
151:       ;       (refresh-screen)
152:       ;       (return-from following-samelevel-heading-line)))
153:       (forward-line 1)
154:       )      
155:     ))

156: (defun goto-previous-heading-line ()
157:   (interactive)
158:   ; (setq *lastjumptype* "previous-headline")
159:   (setq *lastfunc* 'goto-previous-heading-line)
160:   (next-line -1) 
161:   (setq *lastpos* (point))
162:   (if (re-search-backward "¥¥(^[¥*][¥*]* +¥¥|^[;#] [¥*][¥*]* ¥¥)" t)
163: ;  (if (re-search-backward 
164: ;       "¥¥(^[¥*][¥*]* +¥¥|^[;#] [¥*][¥*]* ¥¥|^[ ]*¥¥(●¥¥||■¥¥|□¥¥|◆¥¥|◇¥¥|◎¥¥|〓¥¥)¥¥)" t)
165:           (progn
166:             (refresh-screen)
167:             ; scroll-to-window-top は siteinit.l で定義されてい
168:             ; ます。現在行を窓の一番上にスクロールします。
169:             (move-to-sixth-line)
170:             (if (looking-at "[*]+ ")
171:                 (message (user::headingline)))
172:             )
173:     (progn
174:       (my-message-box "no such string.")
175:       (next-line 1)
176:       ))
177:   )

178: (defun goto-previous-midashi-line ()
179:   (interactive)
180:   ; (setq *lastjumptype* "previous-headline")
181:   (setq *lastfunc* 'goto-previous-midashi-line)
182:   (next-line -1) 
183:   (setq *lastpos* (point))
184: ;  (if (re-search-backward "¥¥(^[¥*][¥*]* +¥¥|^[;#] [¥*][¥*]* ¥¥)" t)
185:   (if (re-search-backward 
186:        "¥¥(^[¥*][¥*]* +¥¥|^[;#] [¥*][¥*]* ¥¥|^[ ]*¥¥(●¥¥|■¥¥|※¥¥)¥¥)" t)
187:           (progn
188:             (refresh-screen)
189:             (move-to-sixth-line)
190:             (if (looking-at "[*]+ ")
191:                 (message (user::headingline)))
192:             )
193:     (progn
194:       (my-message-box "no such string.")
195:       (next-line 1)
196:       ))
197:   )

198: (defun goto-previous-star1-heading-line ()
199:   (interactive)
200:   (setq *lastpos* (point))(next-line -1) 
201:   (if (re-search-backward "^¥¥* +" t)
202:       (progn
203:         ;(setq *lastjumptype* "goto-previous-star1-heading-line")
204:         (setq *lastfunc* 'goto-previous-star1-heading-line)
205:         (refresh-screen)
206:         (scroll-to-window-top)
207:         (refresh-screen)
208:         (scroll-window -6)
209:         (refresh-screen)
210:         (forward-virtual-line 6)
211:         (refresh-screen)
212:         (if (looking-at "[*]+ ")
213:             (message (user::headingline)))
214:         )
215:     (my-message-box "no such string."))
216:   )

217: (defun goto-previous-star2-heading-line ()
218:   (interactive) 
219:   (setq *lastpos* (point)) (next-line -1) 
220:   (if ; (re-search-backward "¥¥(^¥¥*¥¥* +¥¥|^[;#] ¥¥*¥¥* ¥¥)" t)
221:       (re-search-backward "^¥¥*¥¥* +" t)
222:       (progn
223:         ;(setq *lastjumptype* "goto-previous-star2-heading-line")
224:         (setq *lastfunc* 'goto-previous-star2-heading-line)
225:         (refresh-screen)
226:         (scroll-to-window-top)
227:         (refresh-screen)
228:         (scroll-window -6)
229:         (refresh-screen)
230:         (forward-virtual-line 6)
231:         (refresh-screen)
232:         (if (looking-at "[*]+ ")
233:             (message (user::headingline)))
234:         )
235:     (my-message-box "no such string."))
236:   )

237: (defun goto-previous-star3-heading-line ()
238:   (interactive) 
239:   (setq *lastpos* (point)) (next-line -1) 
240:   (if (re-search-backward "^¥¥*¥¥*¥¥* +" t)
241:       (progn
242:         (refresh-screen)
243:         (scroll-to-window-top)
244:         (refresh-screen)
245:         (scroll-window -6)
246:         (refresh-screen)
247:         (forward-virtual-line 6)
248:         (refresh-screen)
249:         (if (looking-at "[*]+ ")
250:             (message (user::headingline)))
251:         )
252:     (my-message-box "no such string."))
253:   )

254: (defun goto-following-star1-heading-line ()
255:   (interactive) 
256:   (setq *lastpos* (point)) (next-line) 
257:   (if (re-search-forward "^¥¥* +" t)
258:       (progn
259:         ;(setq *lastjumptype* "goto-following-star1-heading-line")
260:         (setq *lastfunc* 'goto-following-star1-heading-line)
261:         (refresh-screen)
262:         (scroll-to-window-top)
263:         (refresh-screen)
264:         (scroll-window -6)
265:         (refresh-screen)
266:         (forward-virtual-line 6)
267:         (refresh-screen)
268:         (if (looking-at "[*]+ ")
269:             (message (user::headingline)))
270:         )
271:     (progn
272:       (my-message-box "見出し行が見つかりません")
273:       (next-line -1)
274:       ))
275:   )

276: (defun goto-following-star2-heading-line ()
277:   (interactive) 
278:   (setq *lastpos* (point)) (next-line) 
279:   (if (re-search-forward "^¥¥*¥¥* +" t)
280:       (progn
281:         ;(setq *lastjumptype* "goto-following-star2-heading-line")
282:         (setq *lastfunc* 'goto-following-star2-heading-line)
283:         (refresh-screen)
284:         (scroll-to-window-top)
285:         (refresh-screen)
286:         (scroll-window -6)
287:         (refresh-screen)
288:         (forward-virtual-line 6)
289:         (refresh-screen)
290:         (if (looking-at "[*]+ ")
291:             (message (user::headingline)))
292:         )
293:     (progn
294:       (my-message-box "no such string.")
295:       (my-message-box "見出し行がみつかりません")
296:       ))
297:   )

298: (defun goto-following-star3-heading-line ()
299:   (interactive) 
300:   (setq *lastpos* (point)) (next-line) 
301:   (if (re-search-forward "^¥¥*¥¥*¥¥* +" t)
302:       (progn
303:         (setq *lastjumptype* "goto-following-star3-heading-line")
304:         (refresh-screen)
305:         (scroll-to-window-top)
306:         (refresh-screen)
307:         (scroll-window -6)
308:         (refresh-screen)
309:         (forward-virtual-line 6)
310:         (refresh-screen)
311:         (if (looking-at "[*]+ ")
312:             (message (user::headingline)))
313:         )
314:     (progn
315:       (my-message-box "no such string.")
316:       (mymessage-box "見出し行がみつかりません")
317:       ))
318:   )

319: (defun goto-following-heading-line ()
320:   (interactive) (next-line) 
321:   ; (setq *lastjumptype* "next-headline")
322:   (setq *lastfunc* 'goto-following-heading-line)
323:   (setq *lastpos* (point))
324:   (if (re-search-forward 
325:        "¥¥(^[¥*][¥*]* +¥¥|^[;#] [¥*][¥*]* ¥¥)" t)
326:       (progn
327:         (refresh-screen)
328:         (scroll-to-window-top)
329:         (refresh-screen)
330:         (scroll-window -6)
331:         (refresh-screen)
332:         ; (next-line 6)
333:         (forward-virtual-line 6)
334:         (refresh-screen)
335:         (if (looking-at "[*]+ ")
336:             ;; ここでエラーが起きることがありました。
337:             ;; ~ を使っているとダメなようです。
338:             ;; ~ を ~~ に変えれば大丈夫。
339:             ;; headingline を変更しました。
340:             ;; (sfind "headingline" "sitelisp.lnk" "kh-odr.l")
341:             (message
342:               (user::headingline)
343:               ))
344:         )
345:     (progn
346:       (goto-char (point-max))
347:       ))
348:   )

349: (defun goto-following-midashi-line ()
350:   (interactive) (next-line) 
351:   (setq *lastjumptype* "next-headline")
352:   (setq *lastpos* (point))
353:   (if (re-search-forward 
354:        "¥¥(^[¥*][¥*]* +¥¥|^[;#] [¥*][¥*]* ¥¥|^[ ]*¥¥(●¥¥|■¥¥|※¥¥)¥¥)" t)
355:       (progn
356:         (refresh-screen)
357:         (scroll-to-window-top)
358:         (refresh-screen)
359:         (scroll-window -6)
360:         (refresh-screen)
361:         ; (next-line 6)
362:         (forward-virtual-line 6)
363:         (refresh-screen)
364:         (if (looking-at "[*]+ ")
365:             ;; ここでエラーが起きることがありました。
366:             ;; ~ を使っているとダメなようです。
367:             ;; ~ を ~~ に変えれば大丈夫。
368:             ;; headingline を変更しました。
369:             ;; (sfind "headingline" "sitelisp.lnk" "kh-odr.l")
370:             (message
371:               (user::headingline)
372:               ))
373:         )
374:     (progn
375:       (goto-char (point-max))
376:       ))
377:   )

378: (defun has-child-p ()
379:   (interactive)
380:   (let (tmpstr nstar mstar bool)
381:     (setq *lastpos* (point))
382:     (goto-bol)
383:     (if (not (looking-at "^[¥*][¥*]* [^ ]"))
384:         (re-search-backward "^[¥*][¥*]* [^ ]"))
385:     ; 現在の見出し行の行頭から行末までの文字列を tmpstr に格納す
386:     ; る
387:     (setq tmpstr (buffer-substring (progn (goto-bol) (point))
388:                                    (progn (goto-eol) (point))))
389:     (goto-bol)
390:     ; つぎの２行で、行頭の * の個数を数えて、nstar に格納する
391:     (string-match "^¥¥([¥*][¥*]*¥¥) .*" tmpstr)
392:     (setq nstar (length (string-replace-match tmpstr "¥¥1")))
393:     ;
394:     (forward-line 1)
395:     (setq bool (re-search-forward "^[¥*][¥*]* [^ ]" t))
396:     (if (not bool)
397:         (progn
398:           (my-message-box "次の見出し行が見つかりません。")
399:           (goto-char *lastpos*)
400:           (return-from has-child-p)))
401:     ; つぎの５行で、行頭の * の個数を数えて、mstar に格納する
402:     (setq tmpstr (buffer-substring (progn (goto-bol) (point))
403:                                    (progn (goto-eol) (point))))
404:     (goto-bol)
405:     (string-match "^¥¥([¥*][¥*]*¥¥) .*" tmpstr)
406:     (setq mstar (length (string-replace-match tmpstr "¥¥1")))
407:     ;
408:     (goto-char *lastpos*)
409:     (> mstar nstar)
410:     )
411:   )

412: ; テキストファイルの見出し行 (* で始まる行) で実行します。
413: ; 章、節、項の番号を付けた見出し行を返します。
414: ; 例えば、
415: ;    2.2.1 なんとかかんとか
416: ; のような文字列を返します。
417: (defun headingline ()
418:   (interactive)
419:   (let (clnum hdar nstar lnum (reachedp nil) 
420:               ncstar nlstar hstring n k)
421:    (save-excursion
422:      (setq clnum (current-line-number))
423:      ; (message-box (concat "line clnum = " (format nil "~D" clnum)))
424:      (goto-bol)
425:      (if (looking-at "[*]+ ")
426:          (setq nstar (- (length (match-string 0)) 1))
427:        (progn
428:          (my-message-box "見出し行ではありません。")
429:          (return-from headingline "")))
430:      ; (my-message-box (concat "nstar = " (format nil "~D" nstar)))
431:      (if (> nstar 5)
432:          (progn
433:            (my-message-box "Too many stars.")
434:            (return-from headingline "")))
435:      (setq hdar (make-array nstar :initial-element 0))
436:     
437:      (setq hstring (format nil "~D" (aref hdar 0)))
438:      (setq n 1)
439:      (while (< n nstar)
440:        (setq hstring 
441:              (concat hstring "." (format nil "~D" (aref hdar n))))
442:        (setq n (+ n 1)))
443:      ;(my-message-box (concat "hstring = " hstring))
444:     
445:      ;(my-message-box "start")
446:     
447:      (goto-char (point-min))
448:      (setq nlstar 0)
449:      (while (not reachedp)
450:        (re-search-forward "^[*]+ ")
451:        (setq lnum (current-line-number))
452:        ;(my-message-box (concat "line num = " (format nil "~D" lnum)))
453:        (if (not (looking-at "¥* abstract"))
454:            (progn
455:              (looking-at "^[*]+ ")
456:              (setq ncstar (- (length (match-string 0)) 1))
457: ;;            (my-message-box (concat "lnum = " 
458: ;;                                 (format nil "~D" lnum)
459: ;;                          " ncstar = " 
460: ;;                                 (format nil "~D" ncstar)
461: ;;                          " hstring = " hstring
462: ;;                                 ))
463:              (if (<= ncstar nstar)
464:                 (progn
465:                   (if (= ncstar nlstar)
466:                       (setf (aref hdar (- ncstar 1)) 
467:                             (+ (aref hdar (- ncstar 1)) 1))
468:                     (if (> ncstar nlstar)
469:                         (progn
470:                           (setq k (aref hdar (- ncstar 1)))
471:                           (setf (aref hdar (- ncstar 1)) (+ k 1)))
472:                       (progn
473:                         (setq k (aref hdar (- ncstar 1)))
474:                         (setf (aref hdar (- ncstar 1)) (+ k 1))
475:                         (setq n ncstar)
476:                         (while (< n nstar)
477:                           (setf (aref hdar n) 0)
478:                           (setq n (+ n 1))
479:                           )
480:                         )
481:                       )
482:                     )))
483:              (setq nlstar ncstar)
484:              )
485:          )
486:        (setq hstring (format nil "~D" (aref hdar 0)))
487:       
488:        (setq n 1)
489:        (while (< n nstar)
490:          (setq hstring 
491:                (concat hstring "." 
492:                        (format nil "~D" (aref hdar n ))))
493:          (setq n (+ n 1)))
494:        (looking-at "^[*]+ ¥¥(.*¥¥)")
495: ;;       (my-message-box 
496: ;;         (concat "line = " (format nil "~D" lnum)
497: ;;                 "  " hstring " " (match-string 1)))
498:        (if (>= lnum clnum)
499:            ; 元の行に戻って来た。
500:            (setq reachedp t)
501:          ; まだ途中
502:          (progn
503:            ; (my-message-box (concat "line num = " (format nil "~D" lnum)))
504:            (forward-line 1))))
505:      (setq hstring (format nil "~D" (aref hdar 0)))
506:      (setq n 1)
507:      (while (and (< n nstar) (> (aref hdar n) 0))
508:        (setq hstring 
509:              (concat hstring "." 
510:                      (format nil "~D" (aref hdar n ))))
511:        (setq n (+ n 1)))
512:      (looking-at "^[*]+ ¥¥(.*¥¥)")
513:      (setq hstring (concat hstring " " (match-string 1)))
514:      )
515:     ; @begin{2015-08-18 Commented out} -------------------------
516: ;;     hstring
517:     ; @end{2015-08-18 Commented out} ---------------------------
518:     ; @begin{2015-08-18 Inserted} ------------------------------
519:     (substitute-string hstring "~" "~~")
520:     ; @end{2015-08-18 Inserted} --------------------------------
521:     ))

522: (defun insert-odrpart ()
523:   (interactive)
524:   (cond ((string= mode-name "Lisp") (insert "#|¥n"))
525:         ((string= mode-name "C#") (insert "/*¥n"))
526:         (t (insert "/*")))
527:   (insert "@end{code}¥n¥n¥n¥n")
528:   ; (insert ";;; @(%) $fontcolor = ¥"crimson¥"¥n")
529:   (insert "@begin{code}{proglist}¥n")
530:   (cond ((string= mode-name "Lisp") (insert "|#¥n"))
531:         ((string= mode-name "C#") (insert "*/¥n"))
532:         (t (insert "*/")))
533:   )

534: (defun insert-odrsection ()
535:   (interactive)
536:   (let (sectionname ext prefix)
537:     (setq ext 
538:           (pathname-type 
539:            (file-namestring (get-buffer-file-name))))
540:     (if (string= 
541:          (file-namestring (get-buffer-file-name)) ".emacs")
542:         (setq ext "emacs"))
543:     (cond ((string= mode-name "Lisp")
544:            (setq sectionname 
545:                  (read-string "sectionname: "
546:                               :defautl "foo")))
547:           ((string= mode-name "C#")
548:            (setq sectionname 
549:                  (concat 
550:                   (read-string "クラス Foo : " 
551:                               :default "クラス ")
552:                   " の定義")))
553:           )
554: 
555:     (if (= (length sectionname) 0)
556:         (setq sectionname "続き"))
557:     
558:     (setq prefix "")
559:     (cond ((string= ext "el") (setq prefix ";| "))
560:           ((string= ext "emacs") (setq prefix ";| "))
561:           ((string= ext "bat") (setq prefix "::| "))
562:           )
563:     
564:     (cond ((string= mode-name "Lisp") (insert "#|¥n"))
565:           ((string= mode-name "C#") (insert "/*¥n"))
566:           ((string= ext "ps1") (insert "<#¥n"))
567:           ((string= ext "psm1") (insert "<#¥n"))
568:           ((string= ext "uws") 
569:            (insert "TextBock cmnt")
570:            (insert-random6)
571:            (insert "¥n")
572:            )
573:           ((string= ext "cpp") (insert "/*¥n"))
574:           ((string= ext "hpp") (insert "/*¥n"))
575:           ((string= ext "h") (insert "/*¥n"))
576:           ((string= ext "rb") (insert "=end¥n"))
577:           ((string= ext "ahk") (insert " /*¥n"))
578:           ((string= ext "bat") (insert "¥n"))
579:           ((string= ext "el") (insert "¥n"))
580:           ((string= ext "emacs") (insert "¥n"))
581:           (t (insert "/*¥n")))
582:     (insert (concat prefix "@end{code} "))
583:     (region-char-line #¥-)
584:     (insert prefix) (insert "¥n")
585:     (insert prefix) (region-char-line #¥-)
586:     (insert prefix) (insert (concat "* " sectionname "¥n"))
587:     (insert prefix) (insert "¥n")
588:     (insert prefix) (insert "@begin{code}{proglist} ")
589:     (region-char-line #¥-)
590:     ; (insert "¥n")
591:     (cond ((string= mode-name "Lisp") (insert "|#¥n"))
592:           ((string= mode-name "C#") (insert "*/¥n"))
593:           ((string= ext "ps1") (insert "#>¥n"))
594:           ((string= ext "psm1") (insert "#>¥n"))
595:           ((string= ext "uws") (insert "EndTextBlock¥n"))
596:           ((string= ext "cpp") (insert "*/¥n"))
597:           ((string= ext "hpp") (insert "*/¥n"))
598:           ((string= ext "h") (insert "*/¥n"))
599:           ((string= ext "ahk") (insert "*/¥n"))
600:           ((string= ext "rb") (insert "=begin¥n"))
601:           ((string= ext "bat") (insert "¥n"))
602:           ((string= ext "el") (insert "¥n"))
603:           ((string= ext "emacs") (insert "¥n"))
604:           (t (insert "*/¥n")))
605:     )
606:   )

607: (defun insert-odrsection-to-comment-region ()
608:   (interactive)
609:   (let (sectionname ext prefix)
610:     (setq ext 
611:           (pathname-type 
612:            (file-namestring (get-buffer-file-name))))
613:     (if (string= 
614:          (file-namestring (get-buffer-file-name)) ".emacs")
615:         (setq ext "emacs"))
616:     (cond ((string= mode-name "Lisp")
617:            (setq sectionname 
618:                  (read-string "sectionname: "
619:                               :defautl "foo")))
620:           ((string= mode-name "C#")
621:            (setq sectionname 
622:                  (concat 
623:                   (read-string "クラス Foo : " 
624:                               :default "クラス ")
625:                   " の定義")))
626:           )
627: 
628:     (if (= (length sectionname) 0)
629:         (setq sectionname "続き"))
630:     
631:     (setq prefix "")
632:     (cond ((string= ext "el") (setq prefix ";| "))
633:           ((string= ext "emacs") (setq prefix ";| "))
634:           ((string= ext "bat") (setq prefix "::| "))
635:           )
636:     
637:     (region-char-line #¥-)
638:     (insert prefix) (insert (concat "* " sectionname "¥n"))
639:     (insert prefix) (insert "¥n")
640:     (insert prefix) (insert "@begin{code}{proglist} ")
641:     (region-char-line #¥-)
642:     
643:     (cond ((string= mode-name "Lisp") (insert "|#¥n"))
644:           ((string= mode-name "C#") (insert "*/¥n"))
645:           ((string= ext "ps1") (insert "#>¥n"))
646:           ((string= ext "psm1") (insert "#>¥n"))
647:           ((string= ext "uws") (insert "EndTextBlock¥n"))
648:           ((string= ext "cpp") (insert "*/¥n"))
649:           ((string= ext "hpp") (insert "*/¥n"))
650:           ((string= ext "h") (insert "*/¥n"))
651:           ((string= ext "ahk") (insert "*/¥n"))
652:           ((string= ext "rb") (insert "=begin¥n"))
653:           ((string= ext "bat") (insert "¥n"))
654:           ((string= ext "el") (insert "¥n"))
655:           ((string= ext "emacs") (insert "¥n"))
656:           (t (insert "*/¥n")))
657:     
658:     (insert "¥n¥n¥n")
659:     (cond ((string= mode-name "Lisp") (insert "#|¥n"))
660:           ((string= mode-name "C#") (insert "/*¥n"))
661:           ((string= ext "ps1") (insert "<#¥n"))
662:           ((string= ext "psm1") (insert "<#¥n"))
663:           ((string= ext "uws") 
664:            (insert "TextBock cmnt")
665:            (insert-random6)
666:            (insert "¥n")
667:            )
668:           ((string= ext "cpp") (insert "/*¥n"))
669:           ((string= ext "hpp") (insert "/*¥n"))
670:           ((string= ext "h") (insert "/*¥n"))
671:           ((string= ext "rb") (insert "=end¥n"))
672:           ((string= ext "ahk") (insert " /*¥n"))
673:           ((string= ext "bat") (insert "¥n"))
674:           ((string= ext "el") (insert "¥n"))
675:           ((string= ext "emacs") (insert "¥n"))
676:           (t (insert "/*¥n")))
677:     (insert (concat prefix "@end{code} "))
678:     (region-char-line #¥-)
679:     (insert "¥n")
680:     )
681:   )

  } // end of namespace Kh

682: (defun insert-odrnamespaceend ()
683:   (interactive)
684:   (let (sectionname ext)
685:     (setq ext 
686:           (pathname-type 
687:            (file-namestring (get-buffer-file-name))))
688:     (setq sectionname (read-string "namespace Kh : " :default "namespace "))
689:     (if (= (length sectionname) 0)
690:         (setq sectionname "namespace "))
691:     (setq sectionname 
692:           (concat sectionname " の定義終了"))
693:     (cond ((string= mode-name "Lisp") (insert "#|¥n"))
694:           ((string= mode-name "C#") (insert "/*¥n"))
695:           ((string= ext "ps1") (insert "<#¥n"))
696:           (t (insert "*/")))
697:     (insert "@end{code} ")
698:     (region-char-line #¥-)
699:     ; (insert "¥n")
700:     (region-char-line #¥-)
701:     (insert (concat "** " sectionname "¥n¥n"))
702:     ; (insert ";;; @(%) $fontcolor = ¥"crimson¥"¥n")
703:     (insert "@begin{code}{proglist} ")
704:     (region-char-line #¥-)
705:     (cond ((string= mode-name "Lisp") (insert "|#¥n"))
706:           ((string= mode-name "C#") (insert "*/¥n"))
707:           ((string= ext "ps1") (insert "#>¥n"))
708:           (t (insert "*/")))
709:     (insert "¥n")
710:     )
711:   )

  } // end of definition of class Foo

712: (defun insert-odrclassend ()
713:   (interactive)
714:   (let (sectionname ext)
715:     (setq ext 
716:           (pathname-type 
717:            (file-namestring (get-buffer-file-name))))
718:     (setq sectionname (read-string "クラス Foo) : " :default "クラス "))
719:     (if (= (length sectionname) 0)
720:         (setq sectionname "クラス "))
721:     (setq sectionname 
722:           (concat sectionname " の定義終了"))
723:     (cond ((string= mode-name "Lisp") (insert "#|¥n"))
724:           ((string= mode-name "C#") (insert "/*¥n"))
725:           ((string= ext "ps1") (insert "<#¥n"))
726:           (t (insert "*/")))
727:     (insert "@end{code} ")
728:     (region-char-line #¥-)
729:     (insert "¥n")
730:     (region-char-line #¥-)
731:     (insert (concat "*** " sectionname "¥n¥n"))
732:     ; (insert ";;; @(%) $fontcolor = ¥"crimson¥"¥n")
733:     (insert "@begin{code}{proglist} ")
734:     (region-char-line #¥-)
735:     (cond ((string= mode-name "Lisp") (insert "|#¥n"))
736:           ((string= mode-name "C#") (insert "*/¥n"))
737:           ((string= ext "ps1") (insert "#>¥n"))
738:           (t (insert "*/")))
739:     (insert "¥n")
740:     )
741:   )

742: (defun insert-odrfield ()
743:   (interactive)
744:   (let (sectionname ext)
745:     (setq ext 
746:           (pathname-type 
747:            (file-namestring (get-buffer-file-name))))
748:     (setq sectionname (read-string "フィールド public int foobar : " :default "フィールド "))
749:     (if (= (length sectionname) 0)
750:         (setq sectionname "フィールド "))
751:     (setq sectionname 
752:           (concat sectionname ""))
753:     (cond ((string= mode-name "Lisp") (insert "#|¥n"))
754:           ((string= mode-name "C#") (insert "/*¥n"))
755:           ((string= ext "ps1") (insert "<#¥n"))
756:           (t (insert "*/¥n")))
757:     (insert "@end{code} ")
758:     (region-char-line #¥-)
759:     (insert "¥n")
760:     (region-char-line #¥-)
761:     (insert (concat "*** " sectionname "¥n¥n"))
762:     ; (insert ";;; @(%) $fontcolor = ¥"crimson¥"¥n")
763:     (insert "@begin{code}{proglist} ")
764:     (region-char-line #¥-)
765:     ;(insert "¥n")
766:     (cond ((string= mode-name "Lisp") (insert "|#¥n"))
767:           ((string= mode-name "C#") (insert "*/¥n"))
768:           ((string= ext "ps1") (insert "#>¥n"))
769:           (t (insert "*/")))
770:     )
771:   )

772: (defun insert-odrconstructor ()
773:   (interactive)
774:   (let (sectionname ext)
775:     (setq ext 
776:           (pathname-type 
777:            (file-namestring (get-buffer-file-name))))
778:     (setq sectionname (read-string "コンストラクタ public Foo) : " :default "コンストラクタ "))
779:     (if (= (length sectionname) 0)
780:         (setq sectionname "xxxx"))
781:     (setq sectionname 
782:           (concat sectionname ""))
783:     (cond ((string= mode-name "Lisp") (insert "#|¥n"))
784:           ((string= mode-name "C#") (insert "/*¥n"))
785:           ((string= ext "ps1") (insert "<#¥n"))
786:           (t (insert "*/¥n")))
787:     (insert "@end{code} ")
788:     (region-char-line #¥-)
789:     (insert "¥n")
790:     (region-char-line #¥-)
791:     (insert (concat "*** " sectionname "¥n¥n"))
792:     ; (insert ";;; @(%) $fontcolor = ¥"crimson¥"¥n")
793:     (insert "@begin{code}{proglist} ")
794:     (region-char-line #¥-)
795:     ;(insert "¥n")
796:     (cond ((string= mode-name "Lisp") (insert "|#¥n"))
797:           ((string= mode-name "C#") (insert "*/¥n"))
798:           ((string= ext "ps1") (insert "#>¥n"))
799:           (t (insert "*/")))
800:     )
801:   )

802: (defun insert-odrmethod ()
803:   (interactive)
804:   (let (sectionname ext)
805:     (setq ext 
806:           (pathname-type 
807:            (file-namestring (get-buffer-file-name))))
808:     (setq sectionname (read-string "メソッド名 public void foobar(int nyear)) : " :default "メソッド "))
809:     (if (= (length sectionname) 0)
810:         (setq sectionname "xxxx"))
811:     (setq sectionname 
812:           (concat sectionname ""))
813:     (cond ((string= mode-name "Lisp") (insert "#|¥n"))
814:           ((string= mode-name "C#") (insert "/*¥n"))
815:           ((string= ext "ps1") (insert "<#¥n"))
816:           (t (insert "*/¥n")))
817:     (insert "@end{code} ")
818:     (region-char-line #¥-)
819:     (insert "¥n")
820:     (region-char-line #¥-)
821:     (insert (concat "*** " sectionname "¥n¥n"))
822:     ; (insert ";;; @(%) $fontcolor = ¥"crimson¥"¥n")
823:     (insert "@begin{code}{proglist} ")
824:     (region-char-line #¥-)
825:     ;(insert "¥n")
826:     (cond ((string= mode-name "Lisp") (insert "|#¥n"))
827:           ((string= mode-name "C#") (insert "*/¥n"))
828:           ((string= ext "ps1") (insert "#>¥n"))
829:           (t (insert "*/")))
830:     )
831:   )

832: (defun kill-leaf ()
833:   (interactive)
834:   (if (has-child-p)
835:       (progn
836:         (message-box 
837:          (concat "子供の文章ブロックがあります。¥n¥n" 
838:                  "全体の構成を工夫して、子供の文章ブロックが"
839:                  "ないようにしてください。")
840:          "kill-leaf")
841:         (call-process (concat (si:system-root) "xyzzycli.exe"))
842:         (return-from kill-leaf)))
843:   ; goto-following-heading-line は、kh-base.l で定義されてい
844:   ; ます。
845:   (goto-following-heading-line)
846:   (forward-line -1)
847:   (set-mark (point))
848:   ; goto-previous-heading-line は、kh-base.l で定義されてい
849:   ; ます。
850:   (goto-previous-heading-line)
851:   (forward-line -1)
852:   (kill-region (region-beginning) (region-end))
853:   )

854: (defun kill-branch ()
855:   (interactive)
856:   (let (cpos)
857:     (beginning-of-line)
858:     (setq cpos (point))
859:     (following-samelevel-heading-line)
860:     (forward-line -1)
861:     (set-mark (point))
862:     (goto-char cpos)
863:     (forward-line -1)
864:     (kill-region (region-beginning) (region-end))
865:     )
866:   )

867: (defun previous-samelevel-heading-line ()
868:   (interactive)
869:   (let (tmpstr nstar mstar bool)
870:     (setq *lastpos* (point))
871:     (setq *lastfunc* 'previous-samelevel-heading-line)
872:     (goto-bol)
873:     (if (not (looking-at "^[¥*][¥*]* [^ ]"))
874:         (re-search-backward "^[¥*][¥*]* [^ ]"))
875:     ;
876:     ; 現在の見出し行の行頭から行末までの文字列を tmpstr に格
877:     ; 納する
878:     (setq tmpstr (buffer-substring (progn (goto-bol) (point))
879:                                    (progn (goto-eol) (point))))
880:     (goto-bol)
881:     ;
882:     ; つぎの２行で、行頭の * の個数を数えて、nstar に格納す
883:     ; る
884:     (string-match "^¥¥([¥*][¥*]*¥¥) .*" tmpstr)
885:     (setq nstar (length (string-replace-match tmpstr "¥¥1")))
886:     ;
887:     (forward-line -2)
888:     (loop
889:       (setq bool (re-search-backward "^[¥*][¥*]* [^ ]" t))
890:       (if (not bool)
891:           (progn
892:             (my-message-box "これより前には見出し行がありません。")
893:             (goto-char *lastpos*)
894:             (return-from previous-samelevel-heading-line)))
895:       ;
896:       ; つぎの５行で、行頭の * の個数を数えて、mstar に格納
897:       ; する
898:       (setq tmpstr (buffer-substring (progn (goto-bol) (point))
899:                                      (progn (goto-eol) (point))))
900:       (goto-bol)
901:       (string-match "^¥¥([¥*][¥*]*¥¥) .*" tmpstr)
902:       (setq mstar (length (string-replace-match tmpstr "¥¥1")))
903:       ;
904:       (if (= mstar nstar)
905:           (progn
906:             (message (user::headingline))
907:             (refresh-screen)
908:             (user::move-to-sixth-line)
909:             ; (refresh-screen)
910:             (return-from previous-samelevel-heading-line))
911:         )
912:       (if (< mstar nstar)
913:           (progn
914:             (message (user::headingline))
915:             (my-message-box "同じレベルの見出し行はもうありません。")
916:             (goto-char *lastpos*)
917:             (refresh-screen)
918:             (return-from previous-samelevel-heading-line)))
919:       (forward-line -1)
920:       )      
921:     ))

922: (defun previous-higher-heading-line ()
923:   (interactive)
924:   (let (tmpstr nstar mstar bool)
925:     (setq *lastpos* (point))
926:     (goto-bol)
927:     (if (not (looking-at "^[¥*][¥*]* [^ ]"))
928:         (progn
929:           (my-message-box "この行は見出し行ではありません。")
930:           (return-from previous-higher-heading-line)))
931:     ;
932:     ; 現在の見出し行の行頭から行末までの文字列を tmpstr に格
933:     ; 納する
934:     (setq tmpstr (buffer-substring (progn (goto-bol) (point))
935:                                    (progn (goto-eol) (point))))
936:     (goto-bol)
937:     ;
938:     ; つぎの２行で、行頭の * の個数を数えて、nstar に格納する
939:     (string-match "^¥¥([¥*][¥*]*¥¥) .*" tmpstr)
940:     (setq nstar (length (string-replace-match tmpstr "¥¥1")))
941:     ;
942:     (forward-line -1)
943:     (loop
944:       (setq bool (re-search-backward "^[¥*][¥*]* [^ ]" t))
945:       (if (not bool)
946:           (progn
947:             (my-message-box "見出し行が見つかりません。")
948:             (goto-char *lastpos*)
949:             (return-from previous-higher-heading-line)))
950:       ;
951:       ; つぎの５行で、行頭の * の個数を数えて、mstar に格納
952:       ; する
953:       (setq tmpstr (buffer-substring (progn (goto-bol) (point))
954:                                      (progn (goto-eol) (point))))
955:       (goto-bol)
956:       (string-match "^¥¥([¥*][¥*]*¥¥) .*" tmpstr)
957:       (setq mstar (length (string-replace-match tmpstr "¥¥1")))
958:       ;
959:       (if (or (< mstar nstar) (= mstar 1))
960:           (progn
961:             (message (user::headingline))
962:             (return-from previous-higher-heading-line)))
963:       (forward-line -1)
964:       )      
965:     ))

(File "C:/Users/me/Documents/AutoHotkeyForBANJYO.ahk")

966: (defun search-odrheading ()
967:   (interactive)
968:   (let (heading)
969:     (setq heading (get-clipboard-data))
970:     (while 
971:         (string-match 
972:          "^¥¥(.*[0-9]¥¥)¥¥([.][0-9]+¥¥)¥¥([*]*¥¥) ¥¥(.*¥¥)"
973:          heading)
974:       (setq heading 
975:             (string-replace-match heading "¥¥1*¥¥3 ¥¥4")))
976:     (if (string-match "^¥¥([0-9]+¥¥)¥¥([*]*¥¥) ¥¥(.*¥¥)" 
977:                       heading)
978:         (setq heading
979:               (string-replace-match heading "*¥¥2 ¥¥3")))
980:     (goto-char (point-min))
981:     (re-search-forward (concat "^" (regexp-quote heading)))
982:     (show-outline-heading)
983:     )
984:   )

----------------------------------------------------------
** foo

あああああ
いいい

----------------------------------------------------------
*** bar

おおお

985: (defun set-current-leaf-as-region ()
986:   (interactive)
987:   (beginning-of-line)
988:   (if (not (looking-at "[¥*]+ [^*]"))
989:         (progn
990:           (my-message-box "現在行は見出し行ではありません。")
991:           (return-from set-current-leaf-as-region)
992:           )
993:       )
994:   (goto-following-heading-line)
995:   (forward-line -1)
996:   (set-mark (point))
997:   (goto-previous-heading-line)
998:   (forward-line -1)
999:   (message "region を、M-w で記憶、C-w で削除")
1000:   )

----------------------------------------------------------
** foo

あああああ
いいい

----------------------------------------------------------
*** bar

おおお

----------------------------------------------------------
** baz

かきくけこ。

1001: (defun set-current-branch-as-region ()
1002:   (interactive)
1003:   (let (cpos)
1004:     (beginning-of-line)
1005:     (if (not (looking-at "[¥*]+ [^*]"))
1006:         (progn
1007:           (my-message-box "現在行は見出し行ではありません。")
1008:           (return-from set-current-branch-as-region)
1009:           )
1010:       )
1011:     (setq cpos (point))
1012:     (following-samelevel-heading-line)
1013:     (forward-line -1)
1014:     (set-mark (point))
1015:     (goto-char cpos)
1016:     ; (goto-previous-heading-line)
1017:     (forward-line -1)
1018:     (message "region を、M-w で記憶、C-w で削除")
1019:     ))

1020: (defun search-headline-by-index-number ()
1021:   (interactive)
1022:   (let (indexstring stringa stringb na nb nc sa)
1023:     (setq indexstring 
1024:           (read-string "見出し番号(2, 2.1, 2.1.3): "))
1025:     ; バッファの先頭に戻ってから作業開始。
1026:     (goto-char (point-min))
1027:     (re-search-forward "^¥* ")
1028:     (if (looking-at "^¥* abstract")
1029:         (forward-line 1))
1030:     (if (string-match "^[0-9]+$" indexstring)
1031:         ; "2 とか 12 とか単独の数"
1032:         (progn     
1033:           (setq na (- (parse-integer indexstring) 1))
1034:           (dotimes (sa na)
1035:             (progn
1036:               (re-search-forward "^¥* ")
1037:               (forward-char 1))
1038:             )
1039:           (re-search-forward "^¥* ")
1040:           )
1041:       (if (string-match "^¥¥([0-9]+¥¥)¥.¥¥([0-9]+¥¥)$"
1042:                         indexstring)
1043:           ; 2.1 とか。
1044:           (progn
1045:             (setq stringa (match-string 1))
1046:             (setq stringb (match-string 2))
1047:             (setq na (- (parse-integer stringa) 1))
1048:             (setq nb (- (parse-integer stringb) 1))
1049:             (dotimes (sa na)
1050:               ; sa に 0, 1, ...(na-1) を入れて繰り返します。
1051:               (progn
1052:                 (re-search-forward "^¥* ")
1053:                 (forward-line 1))
1054:               )
1055:             (re-search-forward "^¥* ")
1056:             (forward-line 1)
1057:             ;
1058:             (dotimes (sb nb)
1059:               ; sb に 0, 1, ...(nb-1) を入れて繰り返します。
1060:               (progn
1061:                 (re-search-forward "^[¥*][¥*] ")
1062:                 (forward-line 1))
1063:               )
1064:             (re-search-forward "^[¥*][¥*] ")
1065:             )
1066:         (if (string-match
1067:               "^¥¥([0-9]+¥¥)¥.¥¥([0-9]+¥¥)¥.¥¥([0-9]+¥¥)$" 
1068:               indexstring)
1069:             ; 2.1.2 とか。
1070:             (progn
1071:               (setq stringa (match-string 1))
1072:               (setq stringb (match-string 2))
1073:               (setq stringc (match-string 3))
1074:               (setq na (- (parse-integer stringa) 1))
1075:               (setq nb (- (parse-integer stringb) 1))
1076:               (setq nc (- (parse-integer stringc) 1))
1077:               (dotimes (sa na)
1078:                 (progn
1079:                   (re-search-forward "^¥* ")
1080:                   (forward-line 1))
1081:                 )
1082:               (re-search-forward "^¥* ")
1083:               (forward-line 1)
1084:               ;
1085:               (dotimes (sa nb)
1086:                 (progn
1087:                   (re-search-forward "^[¥*][¥*] ")
1088:                   (forward-line 1))
1089:                 )
1090:               (re-search-forward "^[¥*][¥*] ")
1091:               (forward-line 1)
1092:               ;
1093:               (dotimes (sa nc)
1094:                 (progn
1095:                   (re-search-forward "^[¥*][¥*][¥*] ")
1096:                   (forward-line 1))
1097:                 )
1098:               (re-search-forward "^[¥*][¥*][¥*] ")
1099:               )
1100:           (if (string-match
1101:               "^¥¥([0-9]+¥¥)¥.¥¥([0-9]+¥¥)¥.¥¥([0-9]+¥¥)¥.¥¥([0-9]+¥¥)$" 
1102:               indexstring)
1103:               ; 2.1.2.3 とか。取り扱うのはここまで。
1104:               (progn
1105:                 (setq stringa (match-string 1))
1106:                 (setq stringb (match-string 2))
1107:                 (setq stringc (match-string 3))
1108:                 (setq stringd (match-string 4))
1109:                 (setq na (- (parse-integer stringa) 1))
1110:                 (setq nb (- (parse-integer stringb) 1))
1111:                 (setq nc (- (parse-integer stringc) 1))
1112:                 (setq nd (- (parse-integer stringd) 1))
1113:                 (dotimes (sa na)
1114:                   (progn
1115:                   (re-search-forward "^¥* ")
1116:                   (forward-line 1))
1117:                   )
1118:                 (re-search-forward "^¥* ")
1119:                 (forward-line 1)
1120:                 ;
1121:                 (dotimes (sa nb)
1122:                   (progn
1123:                   (re-search-forward "^[¥*][¥*] ")
1124:                   (forward-line 1))
1125:                   )
1126:                 (re-search-forward "^[¥*][¥*] ")
1127:                 (forward-line 1)
1128:                 ;
1129:                 (dotimes (sa nc)
1130:                   (progn
1131:                     (re-search-forward "^[¥*][¥*][¥*] ")
1132:                     (forward-line 1))
1133:                   )
1134:                 (re-search-forward "^[¥*][¥*][¥*] ")
1135:                 (forward-line 1)
1136:                 ;
1137:                 (dotimes (sa nd)
1138:                   (progn
1139:                     (re-search-forward "^[¥*][¥*][¥*][¥*] ")
1140:                     (forward-line 1))
1141:                   )
1142:                 (re-search-forward "^[¥*][¥*][¥*][¥*] ")
1143:                 )
1144:             )
1145:           )
1146:         )
1147:       )
1148:     )
1149:   )

1150: (defun show-outline-heading ()
1151:   (interactive)
1152:   (let (str)
1153:     (beginning-of-line)
1154:     (if (not (looking-at "[*]+ "))
1155:         (goto-previous-heading-line))
1156:     (setq str (headingline))
1157:     (copy-to-clipboard str)
1158:     (message str)
1159:     ))

1160: (defun attachclippedimage ()
1161:   (interactive)
1162:   (let (retcode str)
1163:    (setq retcode 
1164:          (call-process 
1165:           (concat "clipimagesave.exe" 
1166:            " " 
1167:            "¥"" (get-buffer-file-name (selected-buffer))
1168:            "¥"")
1169:           :wait t))
1170:     (if (= retcode 0)
1171:         (progn
1172:             (setq str
1173:                   (concat 
1174: "@begin{frame} ----------------------------------------------¥n"
1175: "..(Xv ¥"" "./" (get-clipboard-data) "¥" ¥"30%¥" ¥"30%¥")..¥n"
1176: "¥n"
1177: "..図のタイトル..¥n"
1178: "@end{frame} ------------------------------------------------¥n"))
1179:           (insert str))
1180:       )
1181:     )
1182:   )

(File "bin.lnk" "attachfile.exe.txt")

1183: (defun attachimagefile ()
1184:   (interactive)
1185:   (let (retcode str)
1186:    (setq retcode 
1187:          (call-process 
1188:           (concat "attachfile.exe" 
1189:            " " 
1190:            "¥"" (get-buffer-file-name (selected-buffer))
1191:            "¥"")
1192:           :wait t))
1193:     (if (= retcode 0)
1194:         (progn
1195:             (setq str
1196:                   (concat 
1197: "@begin{frame} ----------------------------------------------¥n"
1198: "(Xv ¥"" "./" (get-clipboard-data) "¥")¥n"
1199: "¥n"
1200: "図のタイトル¥n"
1201: "@end{frame} ------------------------------------------------¥n"))
1202:           (insert str))
1203:       )
1204:     )
1205:   )

(File "bin.lnk" "attachfile.exe.txt")

1206: (defun attachmaterial ()
1207:   (interactive)
1208:   (let (retcode str fname)
1209:    (setq retcode 
1210:          (call-process 
1211:           (concat "attachfile.exe" 
1212:            " " 
1213:            "¥"" (get-buffer-file-name (selected-buffer))
1214:            "¥"")
1215:           :wait t))
1216:     (if (= retcode 0)
1217:       (progn
1218:         (setq fname (get-clipboard-data))
1219:         (setq str
1220:                   (concat 
1221: "@begin{frame} ----------------------------------------------¥n"
1222: "::添付資料¥n"
1223: "(File ¥"" "./" fname "¥")¥n¥n"
1224: "□ 上記のリンクをクリックしてファイルを開くか、¥n"
1225: "xyzzy を使って元の ODR 文書を開き ¥n"
1226: "(File で始まる上記のlisp式を評価して、¥n"
1227: "添付資料を開くことができます。¥n¥n"
1228: "@end{frame} ------------------------------------------------¥n"))
1229:           (insert str))
1230:       )
1231:     )
1232:   )

1233: (defun columnwidth (beg end)
1234:   (interactive "r")
1235:   (let ((wcharlen 0) (scharlen 0) (pxlen 0) 
1236:         lastcolumn currentcolumn cc cp clen)
1237:     (goto-char beg)
1238:     (setq lastcolumn (current-column))
1239:     (setq cp (point))
1240:     (while (< cp end)
1241:       (forward-char 1)
1242:       (setq cc (current-column))
1243:       (setq clen (- cc lastcolumn))
1244:       (setq lastcolumn cc)
1245:       (if (= clen 2)
1246:           (setq pxlen (+ pxlen 16))
1247:         (setq pxlen (+ pxlen 12)))
1248:       (setq cp (point))
1249:       )
1250:     (setq pxlen (+ pxlen 24))
1251:     (message-box 
1252:      ; message contents
1253:      (concat
1254:       "string ----------------¥n" 
1255:       (buffer-substring beg end) "¥n¥n"
1256:       "width -----------------¥n"
1257:       (format nil "~30D" pxlen)) 
1258:      ; window title
1259:      "columnwidth"
1260:      )
1261:     (call-process (concat (si:system-root) "xyzzycli.exe"))
1262:     )
1263:   )

1264: (defun FileNet (file)
1265:   "引数で指定するファイルを参照する"
1266:   (interactive)
1267:   (File file)
1268:   )

(File "bin.lnk" "chromeclipsearch.ahk")

1269: (defun jump-to-corresponding-chrome-line ()
1270:   (interactive)
1271:   (show-outline-heading)
1272:   (call-process "chromeclipsearch.exe")
1273:   )

(Label "2967.5114" "")
(Ref "2967.5114" "□")
;;;(Ref "2967.5114" "△")
;;;(Ref "2967.5114" "▽")

1274: (defun jumpbutton ()
1275:   (interactive)
1276:   (let (num numstring)
1277:     (setq num (random 999))
1278:     (setq numstring (concat (format nil "~3,'0D" num) "."))
1279:     (setq num (random 999))
1280:     (setq numstring 
1281:           (concat numstring (format nil "~3,'0D" num)))
1282:     (insert 
1283:      (concat "(Label ¥"" numstring "¥"" " ¥"¥")¥n"
1284:              "(Ref ¥"" numstring "¥"" " ¥"□¥")¥n"
1285:              ";;;(Ref ¥"" numstring "¥"" " ¥"△¥")¥n"
1286:              ";;;(Ref ¥"" numstring "¥"" " ¥"▽¥")¥n"
1287:              "[br]"
1288:              ))
1289:     ))

1290: (defun insert-url ()
1291:   (interactive)
1292:   (insert 
1293:    (concat 
1294:     "(Net ¥"" (get-clipboard-data) "¥")")
1295:    )
1296:   )

1297: ; 現在編集中の ODR 文書を html ファイルに変換します。
1298: ; (File "bat.lnk" "o2hc.bat")
1299: (defun kh-o2hc ()
1300:   (interactive)
1301:   (call-process 
1302:     (concat "o2hc.bat " "¥""
1303:       (map-slash-to-backslash 
1304:         (get-buffer-file-name (selected-buffer)))
1305:       "¥"") :show :minimize))

1306: ; 現在編集中の ODR ファイルまたは埋め込まれた ODR 文書を 
1307: ; html ファイルに変換して表示します。
1308: ; (File "~/bat/o2hs.bat") を呼び出します。
1309: (defun kh-o2hs ()
1310:   (interactive)
1311:   (call-process 
1312:     (concat "o2hs.bat " "¥""
1313:       (map-slash-to-backslash (get-buffer-file-name 
1314:         (selected-buffer)))
1315:       "¥"") :show :minimize))

1316: ; 現在編集中の ODR ファイルまたは埋め込まれた ODR 文書を 
1317: ; html ファイルに変換して表示します。
1318: ; (File "~/bat/o2hs.bat") を呼び出します。
1319: (defun kh-o2hsqux ()
1320:   (interactive)
1321:   (call-process 
1322:     (concat "o2hsqux.bat " "¥""
1323:       (map-slash-to-backslash (get-buffer-file-name 
1324:         (selected-buffer)))
1325:       "¥"") :show :minimize))

1326: (defun kh-o2hstest ()
1327:   (interactive)
1328:   (call-process 
1329:     (concat "o2hstest.bat " "¥""
1330:        (map-slash-to-backslash 
1331:            (get-buffer-file-name (selected-buffer))) 
1332:        "¥"") :show :minimize))

1333: ; 現在編集中のバッファの指定した範囲を、現在のディレクトリの 
1334: ; fooo2hr.odr に保存して、o2hrs.bat で処理した結果を表示しま
1335: ; す。
1336: ; 内部で (File "~/bat/o2h.bat") を呼んでいます。変換した 
1337: ; html コードを clipboard にコピーして、元のバッファに戻りま
1338: ; す。元のバッファに戻るのに数秒かかります。
1339: ;
1340: ; o2h.bat を呼び出すときに、--noheader オプションをつけ
1341: ; て起動しています。
1342: ;
1343: ; 現在編集中のファイルが補助の ruby ファイル
1344: ; を読み込んでいるときに、それが読み込まれないという問題があ
1345: ; りました。例えば、現在編集中のファイルが baz.txt だとして、
1346: ; baz.txt.rb が読み込まれないという問題があります。そういう場合
1347: ; baz.txt.rb を fooo2h.odr.rb に複写する必要があります。
1348: ;
1349: ; [2017-11-16] fooo2h.odr.rb が必要なときには作成するように
1350: ; 変更しました。
1351: (defun kh-o2hrs ()
1352:   (interactive)
1353:   (let (buf sourcefname ftxtname fhtmname str originalbuf rbfile)
1354:     ; 現在編集中のバッファがファイルに対応しているか検査します。
1355:     (setq originalbuf (selected-buffer))
1356:     (setq sourcefname (get-buffer-file-name (selected-buffer)))
1357:     (if (not sourcefname)
1358:         (progn
1359:           (my-message-box "No file corresponds to this buffer"
1360:                        (return-frome kh-o2hrs))))
1361:     ; 設定してある範囲を変数 str に保存する
1362:     (setq str (buffer-substring (region-beginning) (region-end)))
1363:     ; *temp-o2h* というバッファを作って、そこに移動
1364:     (setq buf (get-buffer-create "*temp-o2h*"))
1365:     (switch-to-buffer buf)
1366:     ; バッファの古い内容を削除
1367:     (erase-buffer (selected-buffer))
1368:     ; バッファの先頭に文字化けを防ぐために文字列を挿入する
1369:     ; (insert "= temp¥n¥n")
1370:     ; (insert "* abstract¥n¥n")
1371:     ; (insert "* sample¥n¥n")
1372:     ; 変数 str に保存していた文字列を挿入
1373:     ; @begin{Inserted at 2016-02-28 08:29:18} ----------
1374:     ; @end{Inserted at 2016-02-28 08:29:18} ------------
1375:     (insert str)
1376:     (insert "¥n")
1377:     (goto-char (point-min))
1378:     ;
1379:     ; [2017-02-20] 数式を処理するためにつぎの行を挿入しました。
1380:     (insert "$math¥n")
1381:     ;
1382:     ; [2016-02-28]
1383:     ; 変換しようとする文章の最初に見出し行があって、その見出し行
1384:     ; の * の個数が2個以上だとうまく整形できないので、* の個数を
1385:     ; 1個にしてしまいます。
1386:     ;
1387:     (while (looking-at "¥*[¥*]+[ ]")
1388:       (delete-char 1))
1389:     ; (my-replace-once "^¥*[¥*]+[ ]" "¥* ")
1390:     ; (insert "¥n¥n* enddic¥n")    ; バッファの内容をファイル ftxtname に書き出す
1391:     (setq ftxtname 
1392:           (concat (directory-namestring sourcefname) "fooo2h.odr"))
1393:     (write-file (map-backslash-to-slash ftxtname))
1394:     ; バッファが変更されたままだと kill-buffer でエラーがでるので、
1395:     ; kill-buffer する前にバッファは変更されていないことにする
1396:     (set-buffer-modified-p nil)
1397:     (kill-buffer buf)
1398:     ; 現在編集中のファイルが補助の ruby ファイルがあるか検査して
1399:     ; あればコピーします。
1400:     (setq rbfile (concat sourcefname ".rb"))
1401:     (if (file-exist-p rbfile)
1402:         (copy-file rbfile (concat ftxtname ".rb")
1403:                    :if-exists :overwrite)
1404:       )
1405:     ;
1406:     (setq fhtmname 
1407:           (concat (directory-namestring sourcefname) "qux.html"))
1408:     ; o2h.bat を呼び出して、ftxtname に収録されているテキスト
1409:     ; を html 文書に変換して、表示します。
1410:     (call-process 
1411:       (concat "o2h.bat --noheader " ftxtname 
1412:               " > " fhtmname) :show :minimize)
1413:     (sleep-for 1)
1414:     (setq buf (get-buffer-create "*temp-o2h*"))
1415:     (switch-to-buffer buf)
1416:     (erase-buffer (selected-buffer))
1417:     (insert-file fhtmname)
1418:     (copy-to-clipboard (buffer-substring (point-min) (point-max)))
1419:     (set-buffer-modified-p nil)
1420:     (kill-buffer buf)
1421:     (switch-to-buffer originalbuf)
1422:     (shell-execute fhtmname)
1423:     (sleep-for 1)
1424:     (message "The html code was stored in the clipboard.")
1425:     (call-process (concat (si:system-root) "xyzzycli.exe"))
1426:     )
1427:   )

1428: ; 現在編集中のバッファの指定した範囲を ODR 文書と考えて、html 文
1429: ; 書に変換したものをクリップボードに記憶します。
1430: ;
1431: ; html コードが欲しいときに使用します。
1432: ;
1433: ; 作業手順はつぎのようです。
1434: ;
1435: ; 1) 現在編集中のバッファの指定した範囲を、バッファに対応するフ
1436: ;    ァイルが存在するディレクトリの fooo2hr.odr に保存します。
1437: ;
1438: ; 2) o2hr.bat を用いて、その fooo2hr.odr を html コードに変換し、
1439: ;    変換した html コードを clipboard に保存します。
1440: ;
1441: ; 3) 作成した fooo2hr.odr を削除します。
1442: ;
1443: ; 元のバッファに戻るのに数秒かかります。
1444: (defun kh-o2hrc ()
1445:   (interactive)
1446:   (let (buf sourcefname ftxtname str )
1447:     ; 現在編集中のバッファがファイルに対応しているか検査します。
1448:     (setq sourcefname (get-buffer-file-name (selected-buffer)))
1449:     (if (not sourcefname)
1450:         (progn
1451:           (message-box "No file corresponds to this buffer"
1452:                        (return-frome kh-o2hr))
1453:           (call-process (concat (si:system-root) "xyzzycli.exe"))
1454:           ))
1455:     ; 設定してある範囲を変数 str に保存する
1456:     (setq str (buffer-substring (region-beginning) (region-end)))
1457:     ; *temp-o2h* というバッファを作って、そこに移動
1458:     (setq buf (get-buffer-create "*temp-o2h*"))
1459:     (switch-to-buffer buf)
1460:     ; バッファの古い内容を削除
1461:     (erase-buffer (selected-buffer))
1462:     ; 変数 str に保存していた文字列をバッファ *temp-o2h* に挿入
1463:     (insert "$math¥n")
1464:     (insert str)
1465:     (insert "¥n")
1466:     ; バッファの内容をファイル ftxtname に書き出す
1467:     (setq ftxtname 
1468:           (concat (directory-namestring sourcefname) "fooo2h.odr"))
1469:     (write-file (map-backslash-to-slash ftxtname))
1470:     ; バッファが変更されたままだと kill-buffer でエラーがでるので、
1471:     ; kill-buffer する前にバッファは変更されていないことにする
1472:     (set-buffer-modified-p nil)
1473:     ; バッファ *temp-o2h* を削除する
1474:     (kill-buffer buf)
1475:     ; o2hr.bat を呼び出して、ftxtname に収録されているテキスト
1476:     ; を html 文書に変換して、クリップボードに記憶します。
1477:     (call-process (concat "o2hr.bat " ftxtname) :show :minimize)
1478:     (sleep-for 1)
1479:     (delete-file ftxtname :if-access-denied :skip)
1480:     ;
1481:     (call-process "xyzzycli.exe")
1482:     (message "The html code was stored in the clipboard.")
1483:     )
1484:   )

1485: ; 現在編集中の ODR 文書の html ファイルを別窓に表示します。
1486: ; file-in-other-window は、kh-base.l で定義されています。
1487: ; (sfind "file-in-other-window" *my-sitelisp* "kh-base.l")
1488: (defun kh-html ()
1489:   (interactive)
1490:   (let (fname fhtml)
1491:     (setq fname (get-buffer-file-name (selected-buffer)))
1492:     (setq fhtml 
1493:           (concat (directory-namestring fname)
1494:             (pathname-name fname)
1495:                   ".html"))
1496:     (file-in-other-window fhtml)))

(File "~/bat/o2h.bat") 

1497: (defun kh-o2hrs-with-header ()
1498:   (interactive)
1499:   (let (buf sourcefname ftxtname fhtmname str originalbuf 
1500:             stars num startline)
1501:     ; 現在編集中のバッファがファイルに対応しているか検査します。
1502:     (setq originalbuf (selected-buffer))
1503:     (setq sourcefname (get-buffer-file-name (selected-buffer)))
1504:     (if (not sourcefname)
1505:         (progn
1506:           (message-box "No file corresponds to this buffer")
1507:           (call-process (concat (si:system-root) "xyzzycli.exe"))
1508:           (return-frome kh-o2hrs-with-header)
1509:           ))
1510:     ; 設定してある範囲を変数 str に保存する
1511:     (setq str (buffer-substring (region-beginning) (region-end)))
1512:     ; *temp-o2h* というバッファを作って、そこに移動
1513:     (setq buf (get-buffer-create "*temp-o2h*"))
1514:     (switch-to-buffer buf)
1515:     ; バッファの古い内容を削除
1516:     (erase-buffer (selected-buffer))
1517:     ; バッファの先頭に文字化けを防ぐために文字列を挿入する
1518:     ; str が "*** 見出し"" で始まっていたら処理していいかも。
1519: ;;     (if (string-match "^¥¥(.*¥¥)¥n" str)
1520: ;;         (progn
1521: ;;           (setq stars (match-string 1))
1522: ;;           (message-box stars)))
1523: ;;    (setq startline (firstline str))
1524:     (if (string-match "^¥¥([¥*]+¥¥) [^ ].*¥n" str)
1525:         (progn
1526:           (setq stars (match-string 1))
1527:           ; (message-box stars)
1528:           (setq num (- (length stars) 1))
1529:           (if (> num 0)
1530:               (progn
1531:                 (let (i)
1532:                   (setq i 0)
1533:                   (while (> num 0)
1534:                     (setq i (+ i 1))
1535:                     (insert 
1536:                      (concat  
1537:                       (format nil "~V@{~A~:*~}" i "*") 
1538:                       " " "補われた見出し"
1539:                       (format nil "~D" i) "¥n"))
1540:                     (setq num (- num 1)))
1541:                   ))
1542:             )
1543:           )
1544:       )
1545:     (insert str)
1546:     (insert "¥n")
1547:     ; (insert "¥n¥n* enddic¥n")
1548:     ; バッファの内容をファイル ftxtname に書き出す
1549:     (setq ftxtname 
1550:           (concat (directory-namestring sourcefname) "fooo2h.odr"))
1551:     (write-file (map-backslash-to-slash ftxtname))
1552:     ; バッファが変更されたままだと kill-buffer でエラーがでるので、
1553:     ; kill-buffer する前にバッファは変更されていないことにする
1554:     (set-buffer-modified-p nil)
1555:     (kill-buffer buf)
1556:     (setq fhtmname 
1557:           (concat (directory-namestring sourcefname) "fooo2h.html"))
1558:     ; o2h.bat を呼び出して、ftxtname に収録されているテキスト
1559:     ; を html 文書に変換して、表示します。
1560:     (call-process 
1561:       (concat "o2h.bat " ftxtname " > " fhtmname) :show :minimize)
1562:     (sleep-for 1)
1563:     (setq buf (get-buffer-create "*temp-o2h*"))
1564:     (switch-to-buffer buf)
1565:     (erase-buffer (selected-buffer))
1566:     (insert-file fhtmname)
1567:     (copy-to-clipboard (buffer-substring (point-min) (point-max)))
1568:     (set-buffer-modified-p nil)
1569:     (kill-buffer buf)
1570:     (switch-to-buffer originalbuf)
1571:     (shell-execute fhtmname)
1572:     (sleep-for 1)
1573:     (message "The html code was stored in the clipboard.")
1574:     (call-process "xyzzycli.exe")
1575:     )
1576:   )

1577: (defun o2h-second-half ()
1578:   (interactive)
1579:   (let (cpos)
1580:     (forward-line 1)
1581:     (beginning-of-line)
1582:     (goto-previous-heading-line)
1583:     (setq cpos (point))
1584:     (goto-char (point-max))
1585:     (set-mark (point))
1586:     (goto-char cpos)
1587:     ; (following-samelevel-heading-line)
1588:     ; kh-o2hrs-with-header は、
1589:     ; (File *my-sitelisp* "kh-odr.l")
1590:     ; で定義されています。
1591:     (kh-o2hrs-with-header)
1592:     (call-process "chromeActivate.exe")
1593:     ))

1594: (defun o2h-first-half ()
1595:   (interactive)
1596:   (let (cpos)
1597:     (beginning-of-line)
1598:     (setq cpos (point))
1599:     (goto-following-heading-line)
1600:     (forward-line -1)
1601:     (set-mark (point))
1602:     (goto-char (point-min))
1603:     ; (message-box "I came here 674597")
1604:     ; kh-o2hrs-with-header は、
1605:     ; 
1606:     (kh-o2hrs-with-header)
1607:     ; (message-box "I came here 318329")
1608:     (goto-char cpos)
1609:     (call-process "chromeActivate.exe")
1610:     ))

1611: (defun o2h-current-branch ()
1612:   (interactive)
1613:   (let (cpos)
1614:     (beginning-of-line)
1615:     (setq cpos (point))
1616:     (following-samelevel-heading-line)
1617:     (forward-line -1)
1618:     (set-mark (point))
1619:     (goto-char cpos)
1620:     (kh-o2hrs-with-header)
1621:     (call-process "chromeActivate.exe")
1622:     ))

1623: (defun o2h-current-leaf ()
1624:   (interactive)
1625:   (goto-following-heading-line)
1626:   (forward-line -1)
1627:   (set-mark (point))
1628:   (goto-previous-heading-line)
1629:   ; (kh-o2hrs-with-header)
1630:   (kh-o2hrs)
1631:   (call-process (concat (si:system-root) "xyzzycli.exe"))
1632:   )