kh-myregion.l

@begin{foo} ----------------------------------------------
...
@end{foo} ------------------------------------------------

@begin{foo}{bar} -----------------------------------------
...
@end{foo} ------------------------------------------------

'(#¥C-c #¥r #¥a #¥o) 'region-add-optionstring)

'(#¥C-c #¥r #¥c #¥d) 'region-captiononly-date)
'(#¥C-c #¥r #¥c #¥n) 'region-change-name)
'(#¥C-c #¥r #¥c #¥o) 'region-change-optionstring)
'(#¥C-c #¥r #¥c #¥t) 'region-captiononly-time)

'(#¥C-c #¥r #¥d #¥m) 'region-delete-marks)

'(#¥C-c #¥r #¥e #¥m) 'region-end-mark)

'(#¥C-c #¥r #¥i #¥.) 'region-insert-dotregion)
'(#¥C-c #¥r #¥i #¥d) 'region-insert-marks-with-date)
'(#¥C-c #¥r #¥i #¥m) 'region-insert-marks)
'(#¥C-c #¥r #¥i #¥t) 'region-insert-marks-with-time)

'(#¥C-c #¥r #¥j #¥m) 'region-jump-to-match-marks)

'(#¥C-c #¥r #¥s #¥r) 'region-set-region)

001: (require "kh-base")
002: (require "kh-insertnum")

003: (defvar *myregion-markstring* "a")
004: (defvar *myregion-startstring* "@begin{")
005: (defvar *myregion-endstring* "@end{")
006: (defvar *myregion-startstring-with-mark* *myregion-startstring*)
007: (defvar *myregion-endstring-with-mark* *myregion-endstring*)
008: 
009: (setq *myregion-startstring* "@begin{")
010: (setq *myregion-endstring* "@end{")
011: (setq *myregion-startstring-with-mark* *myregion-startstring*)
012: (setq *myregion-endstring-with-mark* *myregion-endstring*)

   @begin{memo} --------------------------------------------
   abcdefg
   bbb
   cccc

   @begin{memo} --------------------------------------------
   abcdefg
   bbb
   cccc
   @end{memo} ----------------------------------------------

   @begin{code}{bgcolor: beige} ----------------------------
   abcdefg
   bbb
   cccc
   @end{code} ----------------------------------------------

013: (defun region-insert-marks ()
014:   "insert myregion marks"
015:   (interactive)
016:   (let (prefix-string pos option)
017:     (auto-fill-mode nil)
018:     (clear-kill-ring)
019:     ; (auto-fill-mode t)
020:     ; (message "漢字1文字14, 13文字で182, 余白8")
021:     (if (string= *myregion-markstring* "a")
022:         (setq *myregion-markstring* "tcTable"))
023:     (setq *myregion-markstring*
024:           (read-string
025:            (concat "Enter mark string (ex. "
026:                    *myregion-markstring* " ) : ")
027:            :default *myregion-markstring*
028:            ))
029:     ; *myregion-markstring* として、abc を読み取った
030:     (setq *myregion-startstring-with-mark*
031:           (concat *myregion-startstring* 
032:                   *myregion-markstring* "}"))
033:     ; これで、@begin{abc} までできました。
034:     (setq *myregion-endstring-with-mark*
035:           (concat *myregion-endstring* *myregion-markstring* "}"))
036:     ; これで、*myregion-endstring-with-mark* は@end{abc} に。
037:     ;
038:     ; @begin{Inserted at 20160715 11:01}--------------------
039:     (cond
040:      ((or (string= *myregion-markstring* "tcTable")
041:           (string= *myregion-markstring* "twTable"))
042:       (message "漢字1文字14, 13文字で182, 余白8, 合計190")
043:       (setq optionstring
044:             (read-string
045:              "Option (C-q % for %, 14 for 1漢字): " :default "100% 190")))
046:      ; 190 = 14 (/文字) * 13文字 + 8
047:      ((or (string= *myregion-markstring* "cTable")
048:           (string= *myregion-markstring* "wTable"))
049:       (message "漢字1文字14, 13文字で182, 余白8, 合計190")
050:       (setq optionstring
051:             (read-string
052:              "Option (C-q % for %, 14 for 1漢字): " :default "100% 190 20% null")))
053:      ((string= *myregion-markstring* "subTable")
054:       (setq optionstring
055:             (read-string
056:              "Option (C-q % for %, 14 for 1漢字): " :default "bgc: beige 100% 190 null")))
057:      (t (setq optionstring
058:               (read-string
059:                  "Option string (RET if not needed. C-q % for %): ")))
060:      )
061:     ; @end{Inserted at 20160715 11:01}----------------------
062:     (setq pos (point))
063:     (beginning-of-line)
064:     (setq prefix-string (buffer-substring (point) pos))
065:     (beginning-of-line)
066:     (insert prefix-string)
067:     (insert *myregion-startstring-with-mark*)
068:     ; (message "漢字1文字14, 13文字で182, 余白8, 合計190")
069:     (if (> (length optionstring) 0)
070:         (insert (concat "{" optionstring "}")))
071:     (insert " ")
072:     (region-char-line #¥-)
073:     (message "")
074:     (if (not (string-match "^[ ]*$" prefix-string))
075:         (progn
076:           (kill-line 1)
077:           (clear-kill-ring)))
078:     ; (delete-horizontal-spaces)
079:     (insert prefix-string)
080:     (insert *myregion-endstring-with-mark* " ")
081:     (region-char-line #¥-)
082:     ; (delete-horizontal-spaces)
083:     ; (insert prefix-string)
084:     (beginning-of-line)
085:     (forward-line -1)
086:     (beginning-of-line)
087:     (kill-line 1)
088:     (auto-fill-mode t)
089:     ))

@begin{Inserted at 2015-05-27 21:52:31} ------------------
ここが
サンプルです。
@end{Inserted at 2015-05-27 21:52:31} --------------------

090: (defun region-insert-marks-with-time (markstring)
091:   (interactive 
092:       "sEnter mark string (ex. Inserted at) : "
093:       :default0 "Inserted at "
094:     )
095:   (let (prefix-string pos)
096:     (setq *myregion-markstring* markstring)
097:     (auto-fill-mode nil)
098:     (clear-kill-ring)
099:     (setq *myregion-markstring* 
100:           (concat *myregion-markstring* " "
101:                   (format-date-string "%Y-%m-%d %H:%M:%S")))
102:     (setq *myregion-startstring-with-mark*
103:           (concat *myregion-startstring* *myregion-markstring* "}"))
104:     (setq *myregion-endstring-with-mark*
105:           (concat *myregion-endstring* *myregion-markstring* "}"))
106:     (setq pos (point))
107:     (beginning-of-line)
108:     (setq prefix-string (buffer-substring (point) pos))
109:     (beginning-of-line)
110:     (insert prefix-string)
111:     (insert *myregion-startstring-with-mark* " ")
112:     (region-char-line #¥-)
113:     ; (delete-horizontal-spaces)
114:     (insert prefix-string)
115:     (insert *myregion-endstring-with-mark* " ")
116:     (region-char-line #¥-)
117:     ; (delete-horizontal-spaces)
118:     ; (insert prefix-string)
119:     (beginning-of-line)
120:     (forward-line -1)
121:     (beginning-of-line)
122:     (kill-line 1)
123:     (auto-fill-mode t)
124:     ))

125: (defun region-insert-marks-with-date ()
126:   "insert my special region mark"
127:   (interactive)
128:   (let (prefix-string pos)
129:     (auto-fill-mode nil)
130:     (clear-kill-ring)
131:     (setq *myregion-markstring*
132:           (read-string
133:            (concat "Enter mark string (ex. "
134:                    "Inserted on) : ")
135:            :default "Inserted on"))
136:     (setq *myregion-markstring* 
137:           (concat *myregion-markstring* " "
138:                   (format-date-string "%Y-%m-%d")))
139:     (setq *myregion-startstring-with-mark*
140:           (concat *myregion-startstring* *myregion-markstring* "}"))
141:     (setq *myregion-endstring-with-mark*
142:           (concat *myregion-endstring* *myregion-markstring* "}"))
143:     (setq pos (point))
144:     (beginning-of-line)
145:     (setq prefix-string (buffer-substring (point) pos))
146:     (goto-char pos)
147:     (beginning-of-line)
148:     (insert prefix-string)
149:     (insert *myregion-startstring-with-mark* " ")
150:     (region-char-line #¥-)
151:     ; (delete-horizontal-spaces)
152:     (insert prefix-string)
153:     (insert *myregion-endstring-with-mark* " ")
154:     (region-char-line #¥-)
155:     ; (delete-horizontal-spaces)
156:     ; (insert prefix-string)
157:     (beginning-of-line)
158:     (forward-line -1)
159:     (beginning-of-line)
160:     (kill-line 1)
161:     (auto-fill-mode t)
162:     ))

163: (defun region-start-mark ()
164:   "insert my start region mark"
165:   (interactive)
166:   (setq *myregion-markstring*
167:         (read-string (concat "Enter mark string (ex. " 
168:                                *myregion-markstring* " ) : ")))
169:   (setq *myregion-startstring-with-mark*
170:     (concat *myregion-startstring* *myregion-markstring* "}"))
171:   (insert *myregion-startstringwith-mark*)
172:   ; これで、@begin{abc} までできました。
173:   (setq optionstring
174:     (read-string
175:      "Option string? (if not needed, just return) : "))
176:   (if (> (length optionstring) 0)
177:       (insert (concat "{" optionstring "}")))
178:   (insert " ")
179:   (region-char-line #¥-)
180:   (beginning-of-line)
181:   )

182: (defun region-end-mark ()
183:   "insert my end region mark"
184:   (interactive)
185:   (setq *myregion-markstring*
186:     (read-string 
187:       (concat "Enter mark string (ex. "
188:                              *myregion-markstring* " ) : ")
189:       :default *myregion-markstring*
190:      ))
191:   (setq *myregion-endstring-with-mark*
192:         (concat *myregion-endstring* *myregion-markstring* "}"))
193:   (insert *myregion-endstring-with-mark* " ")
194:   (region-char-line #¥-)
195:   (backward-char)
196:   (beginning-of-line)
197:   )

198: (defun region-delete-marks ()
199:   "delete my special region mark"
200:   (interactive)
201:   (let (m1 region-mark 
202:            cstartstring-with-mark cendstring-with-mark)
203:     (beginning-of-line)
204:     (setq m1 (make-marker))
205:     (set-marker m1 (point))
206:     (if (not 
207:          (looking-at 
208:           (concat "^.*?" *myregion-startstring*
209:                  "¥¥(.*¥}$¥¥|.*¥} [-]+$¥¥)")))
210:         (progn
211:           (message-box "No begin line")
212:           (call-process (concat (si:system-root) "xyzzycli.exe"))
213:           (return-from region-delete-marks)))
214:     (looking-at 
215:      (concat "^¥¥(.*?¥¥)"
216:              *myregion-startstring*
217:              "¥¥([^}]*¥¥)¥}"))
218:     (setq prefix-string (match-string 1))
219:     (setq region-mark (match-string 2))
220:     (kill-line 1)
221:     (re-search-forward 
222:      (concat "^" (regexp-quote prefix-string) 
223:              *myregion-endstring*
224:              (regexp-quote region-mark) "¥}"))
225:     (kill-line 1)
226:     (goto-marker m1)
227:   ))
228: 
229: (defalias 'region-remove-marks 'region-delete-marks)

230: ;; region-set-region は、カーソル位置を含む @begin ... @end 
231: ;; を範囲指定します。開始マークがある行と終了マークのある行の(*内
232: ;; 側*)が範囲指定されます。
233: ;; @begin{ の文字列の上、またはそれより後（それより後の行でも構
234: ;; いません）にカーソルを置いてから呼び出してください。
235: ;;
236: ;; (H "オプション文字列がある形") にも対応しています。
237: ;;
238: ;; C-u を前置すれば、@begin, @end の行も含めてマークします。
239: (defun region-set-region (&optional num)
240:   "set the inside of marks as region"
241:   (interactive "P")
242:   (let (cstartstring-with-mark cendstring-with-mark cpos apos mstring proglistp)
243:     (end-of-line)
244:     (setq cpos (point))
245:     ; *myregion-startstring* は、"@begin{" です。
246:     (search-backward *myregion-startstring*)
247:     (search-forward "{")
248:     (forward-char 1)
249:     (setq apos (point))
250:     (search-forward "}")
251:     (setq mstring (buffer-substring apos (point)))
252:     (setq *myregion-markstring* mstring)
253:     (setq cstartstring-with-mark (concat *myregion-startstring* *myregion-markstring* "}"))
254:     (setq cendstring-with-mark (concat *myregion-endstring* *myregion-markstring* "}"))
255:     (goto-char cpos)
256:     (search-backward cstartstring-with-mark)
257:     (beginning-of-line)
258:     (setq proglistp (looking-at ".*proglist.*$"))
259:     (if num
260:         ; つぎの行でマークしているのは、@begin の行の行頭。
261:         (set-mark (point))
262:       (progn
263:         (next-line 1)
264:         ; つぎの行でマークしているのは、@begin のつぎの行の
265:         ; 行頭。@begin の行に proglist があれば、一行飛ばす。
266:         (if proglistp
267:             (next-line 1))
268:         (set-mark (point))
269:         ))
270:     (search-forward cendstring-with-mark)
271:     (beginning-of-line)
272:     ; ここでカーソルがあるのは、@end の行の行頭。
273:     (if num
274:         ; ここでカーソルがあるのは @end の行の次の行の行頭
275:         (next-line 1)
276:       (progn
277:         ; @begin の行に proglist があれば、もう一行前の行を
278:         ; マーク。
279:         (if proglistp
280:             (forward-line -1)))
281:       )
282:     (exchange-point-and-mark)
283:     (message 
284:      "region を、M-w で記憶、C-w で削除、M-x clip-without-linenaum で番号除外記憶")
285:     ))

286: (defun region-jump-to-match-marks ()
287:   "jump to corresponding region mark"
288:    (interactive)
289:    (let ((pos (point)) limitpos begpos endpos)
290:      (end-of-line)
291:      (setq limitpos (point))
292:      (beginning-of-line)
293:      (if (mysearch-forward-in-line *myregion-startstring*)
294:      ;; *myregion-startstring* は "@begin{"
295:          (progn
296:       ; (message-box *myregion-startstring*)
297:       (search-forward "{")
298:       (forward-char 1)
299:           (setq begpos (point))
300:           (search-forward "}" t)
301:           ; (backward-char 1)
302:           (setq endpos (point))
303:           (setq *myregion-markstring* (buffer-substring begpos endpos))
304:           (setq cendstring-with-mark (concat *myregion-endstring* *myregion-markstring* "}"))
305:       ; (message-box cendstring-with-mark)
306:           (search-forward cendstring-with-mark)
307:           (beginning-of-line)
308:           (message *myregion-markstring*)
309:           )
310:        (if (mysearch-forward-in-line *myregion-endstring*)
311:            (progn
312:          ; (message-box *myregion-endstring*)
313:          (search-forward "{")
314:          (forward-char 1)
315:              (setq begpos (point))
316:              (search-forward "}" t)
317:              ; (backward-char 1)
318:              (setq endpos (point))
319:              (setq *myregion-markstring* (buffer-substring begpos endpos))
320:              (setq cstartstring-with-mark
321:                    (concat *myregion-startstring* *myregion-markstring* "}"))
322:              (search-backward cstartstring-with-mark)
323:              (beginning-of-line)
324:          (message (concat "markstring: " *myregion-markstring*))
325:          )
326:          (progn
327:            (goto-char pos)
328:            (error "no region mark exists in this line."))
329:          )
330:        )
331:      )
332:   )

333: (defun region-char-line (char)
334:    "fill a character repeatedly to the end of the line"
335:    (interactive "cEnter a character to fill. ")
336:         (let (col dif lenline)
337:           (setq col (current-column))
338:       (setq lenline fill-column)
339:       (if (> fill-column 64)
340:         (setq lenline 64))
341:           (setq dif (- lenline col))
342:           (while (> dif 0)
343:                 (progn
344:                   (insert char)
345:                   (setq dif (- dif 1))))
346:           (newline)))

347: ; ----------------------------------------------------------
348: ; .....
349: ; ....
350: ;
351: ; で囲むために、..... と .... を挿入します。
352: ;
353: ;   aaaaa
354: ;   bbb
355: ;   cccc
356: ;
357: ; を囲むとすると、aaaaa の最初の a の位置にカーソルを置いて、
358: ; この関数を呼び出します。この結果
359: ;
360: ;   .....
361: ;   aaaaa
362: ;   bbb
363: ;   cccc
364: ;
365: ; のように ..... が挿入されます。範囲の最後の行頭にカーソル
366: ; を移動して、C-y をタイプすると .... が挿入されます。
367: ;
368: ;   .....
369: ;   aaaaa
370: ;   bbb
371: ;   cccc
372: ;   ....
373: ;
374: (defun region-insert-dotregion ()
375:   "insert dot region"
376:   (interactive)
377:   (let (prefix-string pos)
378:     (auto-fill-mode nil)
379:     (setq pos (point))
380:     (beginning-of-line)
381:     (setq prefix-string (buffer-substring (point) pos))
382:     (goto-char pos)
383:     (insert ".....¥n")
384:     (beginning-of-line)
385:     (insert (concat prefix-string "....¥n"))
386:     (insert prefix-string)
387:     (beginning-of-line)
388:     (previous-line 1)
389:     (kill-line 1)
390:     (auto-fill-mode t)
391:   ))

392: (defun region-insert-threecommas ()
393:   "insert threecommas region"
394:   (interactive)
395:   (let (prefix-string pos)
396:     (auto-fill-mode nil)
397:     (setq pos (point))
398:     (beginning-of-line)
399:     (setq prefix-string (buffer-substring (point) pos))
400:     (goto-char pos)
401:     (insert ",,,~ ")
402:     (cline)
403:     (beginning-of-line)
404:     (insert (concat prefix-string ",,,. "))
405:     (cline)
406:     (insert prefix-string)
407:     (beginning-of-line)
408:     (previous-line 1)
409:     (kill-line 1)
410:     (auto-fill-mode t)
411:   ))

412: (defun region-enclose-by-string ()
413:   "enclose the region by a string which you specify"
414:   (interactive)
415:   (let (prefix-string pos str)
416:     (auto-fill-mode nil)
417:     (setq pos (point))
418:     (beginning-of-line)
419:     (setq prefix-string (buffer-substring (point) pos))
420:     (goto-char pos)
421:     (setq str (read-string
422:                "Enter string (ex. ,,) "))
423:     (insert (concat str "¥n"))
424:     (beginning-of-line)
425:     (insert (concat prefix-string str "¥n"))
426:     (insert prefix-string)
427:     (beginning-of-line)
428:     (previous-line 1)
429:     (kill-line 1)
430:     (auto-fill-mode t)
431:   ))

432: (defun region-enclose-by-dotregion ()
433:   "enclose ..... and ..... to make a dotregion"
434:   (interactive)
435:   (let ((cp (current-column)))
436:     (beginning-of-line)
437:     (insert (concat
438:      (make-sequence 'string cp :initila-element (code-char 32))
439:      ".....¥n"))
440:     (re-search-forward "^[ 　¥t]*$")
441:     (beginning-of-line)
442:     (insert (concat
443:      (make-sequence 'string cp :initial-element (code-char 32))
444:      "....¥n"))
445:     )
446:   )

  @begin{code} ---------------------------------------------
  abcd
  bb
  cccccccccc
  @end{code} -----------------------------------------------

447: (defun region-enclose-marks ()
448:   "enclose the region by my special region mark"
449:   (interactive)
450:   (let (prefix-string pos (cp (current-column)))
451:     (setq *myregion-markstring*
452:           (read-string (concat "Enter mark string (ex. "
453:                                *myregion-markstring* ") : ")))
454:     (cond ((string= "." *myregion-markstring*)
455:            (myregion-enclose-by-dotregion)
456:            )
457:           ((string= "table" *myregion-markstring*) 
458:            (setq *myregion-startstring-with-mark*
459:                  (concat *myregion-startstring* *myregion-markstring* "}"))
460:            (setq *myregion-endstring-with-mark*
461:                  (concat *myregion-endstring* *myregion-markstring* "}"))
462:            (setq pos (point))
463:            (beginning-of-line)
464:            (setq prefix-string (buffer-substring (point) pos))
465:            (goto-char pos)
466:            (insert *myregion-startstring-with-mark* "{}¥n")
467:            (re-search-forward "^[ 　¥t]*$")
468:            (insert prefix-string)
469:            (insert *myregion-endstring-with-mark* "¥n")
470:            (beginning-of-line)
471:            (goto-char pos)
472:            (end-of-line)
473:            (backward-char)
474:            )
475:           (t
476:            (setq *myregion-startstring-with-mark* (concat *myregion-startstring* *myregion-markstring* "}"))
477:            (setq *myregion-endstring-with-mark* (concat *myregion-endstring* *myregion-markstring* "}"))
478:            (setq pos (point))
479:            (beginning-of-line)
480:            (setq prefix-string (buffer-substring (point) pos))
481:            (goto-char pos)
482:            (insert *myregion-startstring-with-mark* " ")
483:            (region-char-line #¥-)
484:            (insert prefix-string)
485:            (beginning-of-line)
486:            (re-search-forward "^[ 　¥t]*$")
487:            (beginning-of-line)
488:            (insert prefix-string)
489:            (insert *myregion-endstring-with-mark* " ")
490:            (region-char-line #¥-)
491:            (beginning-of-line)
492:            )
493:     )))

494: (defun region-clear ()
495:   "remove the lines up to the end line with a mark string which you specify"
496:   (interactive)
497:   (let (markstr pos begpos endpos)
498:     (beginning-of-line)
499:     (setq pos (point))
500:     (search-forward *myregion-endstring*)
501:     (setq begpos (point))
502:     (search-forward "}")
503:     (backward-char 1)
504:     (setq markstr (buffer-substring begpos (point)))
505:     (goto-char pos)
506:     (setq markstr
507:           (read-string (concat "Enter mark string (ex. " *myregion-markstring* ") : ")))
508:     (setq *myregion-endstring-with-mark* (concat *myregion-endstring* markstr "}"))
509:     (search-forward *myregion-endstring-with-mark*)
510:     (beginning-of-line)
511:     (kill-region pos (point))))

512: (defun exec-region (beg end)
513:   "execute the script writtern in the specified region"
514:   (interactive "r")
515:   (let* (string buf
516:                 (scriptfile (make-temp-name "./script-")))
517:     (setq string (buffer-substring beg end))
518:     (save-excursion
519:       (set-buffer (find-file-noselect scriptfile))
520:       (erase-buffer)
521:       (insert string)
522:       (goto-char (point-min))
523:       (while (looking-at " ")
524:         (delete-char 1))
525:       (save-buffer)
526:       (kill-buffer (current-buffer)))
527:     (shell-command (concat "chmod +x " scriptfile))
528:     (shell-command scriptfile)
529:     (shell-command 
530:      (concat "echo ¥"if [ -e "
531:              (expand-file-name scriptfile) " ]; then rm "
532:              (expand-file-name scriptfile)
533:              "; fi¥" >> "
534:              (expand-file-name "~/clean.sh")))
535: ))

  @@_foo.txt

  foo.txt

sample.html
@begin{code} -----------------------------------------------
<html>
<head>
<title>サンプル</title>
</head>
<body>
<script type="text/javascript">
<!--
document.write("Hello Write-code World!!");
// -->
</script>
</body>
</html>
@end{code} -------------------------------------------------

samplea.html
@begin{code} -----------------------------------------------
001: <html>
002: <head>
003: <title>サンプル</title>
004: </head>
005: <body>
006: <script type="text/javascript">
007: <!--
008: document.write("Hello Write-code World!!");
009: // -->
010: </script>
011: </body>
012: </html>
@end{code} -------------------------------------------------

536: (defun region-write-code ()
537:   (interactive)
538:   (let (beglinep currentline beginline cpos apos fname buf 
539: string dir bp ep enc)
540:     (if (not (si::getenv "HTEMP"))
541:         (progn
542:           (message-box 
543:            (concat "環境変数 HTEMP が定義されていません。")
544:            "fk-base"
545:            '(:information))
546:           (call-process (concat (si:system-root) "xyzzycli.exe"))
547:           (return-from region-write-code))
548:       ); end of if
549:     (if (not (file-directory-p (si::getenv "HTEMP")))
550:         (progn
551:           (message-box 
552:            (concat (si::getenv "HTEMP") " が存在しません。")
553:            "fk-base"
554:            '(:information))
555:           (call-process (concat (si:system-root) "xyzzycli.exe"))
556:           (return-from region-write-code))
557:       ); end of if
558:     
559:     ; 編集中のファイルの漢字コードをencに記憶します。
560:     (setq enc (buffer-fileio-encoding (selected-buffer)))
561:     (setq dir (map-backslash-to-slash (si::getenv "HTEMP")))
562:     ; (message-box dir)
563:     ; (call-process (concat (si:system-root) "xyzzycli.exe"))
564:     (setq cpos (point))
565:     (if (looking-at "[ ]*$")
566:       (progn
567:         (message-box "現在の行は空白行です。")
568:         (call-process (concat (si:system-root) "xyzzycli.exe"))
569:         (return-from region-write-code))
570:       )
571:     (setq beglinep nil)
572:     (beginning-of-line)
573:     (if (looking-at (concat "[ ]*" *myregion-startstring*))
574:         ; @begin の行でした。
575:         (progn
576:           (setq 
577:            fname
578:            (read-string 
579:             "region を書き込む先のファイル名は? ex. foo.html: "
580:             :default "foo.html"))
581:           )
582:       (progn
583:         ; ファイル名を読み取ります。
584:         (setq beginlinep nil)
585:         (skip-chars-forward " ")
586:         (if (looking-at "@@_")
587:             (forward-char 3))
588:         (setq apos (point))
589:         (re-search-forward "[ ]*$")
590:         (setq fname (buffer-substring apos (point)))
591:         (forward-line 1)
592:         (beginning-of-line)
593:         )
594:       )
595:     (region-set-region); これで範囲指定。cbar が定義した関数。
596:     ; ここまでの操作で、カーソルは、@begin の行の次の行に居ます。
597:     ; (message-box fname)
598:     (setq bp (region-beginning))
599:     (setq ep (region-end))
600:     (goto-char bp)
601:     ; (forward-line -1)
602:     ; (show-current-line)
603:     ; @begin{Cmnted out at 20180821 18:30}------------------
604:     ; (if (looking-at ".*proglist")
605:     ;     (progn
606:     ;       (goto-char bp)
607:     ;       (forward-line 1)
608:     ;       (setq bp (point))
609:     ;       (goto-char ep)
610:     ;       (forward-line -1)
611:     ;       (setq ep (point))
612:     ;       ))
613:     ; @end{Cmnted out at 20180821 18:30}--------------------
614:     ;@begin{Cmnted out at 20180821 16:13}-------------------
615:     ;(setq string 
616:     ;      (buffer-substring (region-beginning) (region-end)))
617:     ;@end{Cmnted out at 20180821 16:13}---------------------
618:     ;
619:     ;@begin{Inserted at 20180821 16:13}---------------------
620:     (setq string 
621:           (buffer-substring bp ep))
622:     ;@end{Inserted at 20180821 16:13}-----------------------
623:     
624:     (setq fname (concat dir "/" fname))
625:     (setq buf (get-buffer-create "*temp-file*"))
626:     (switch-to-buffer buf)
627:     ; 新規に作成したバッファの漢字コードを元のバッファの漢字
628:     ; コードと同じにするために enc にします。
629:     (set-buffer-fileio-encoding enc)
630:     (erase-buffer (selected-buffer))
631:     (insert string)
632:     ; [2016-06-04]
633:     (set-mark (point-max))
634:     (goto-char (point-min))
635:     (remove-linenum)
636:     ;
637:     (write-file fname)
638:     (set-buffer-modified-p nil)
639:     (kill-buffer buf)
640:     (goto-char cpos)
641:     (message-box (concat fname " was created."))
642:     (call-process (concat (si:system-root) "xyzzycli.exe"))
643:     (activate-powershell)
644:     ))

645: (defun region-change-name ()
646:   "change the myregion name part"
647:   (interactive)
648:   (let (apos bpos cpos mstring nstring prefix-string pos)
649:     (beginning-of-line)
650:     (setq cpos (point)); cpos は行頭
651:     (if (not (looking-at "^.*¥@begin¥{"))
652:         (progn
653:           (message-box "No begin line.")
654:           (call-process (concat (si:system-root) "xyzzycli.exe"))
655:           (return-from region-change-name)))
656:     (myre-search-forward-in-line "^.*@begin¥{")
657:     (goto-char (match-end 0))
658:     (setq bpos (point)); @begin{ の { の後ろの位置が bpos
659:     (re-search-backward "¥@begin¥{")
660:     (setq apos (point)); @begin{ の @ の位置が apos
661:     (setq prefix-string (buffer-substring cpos apos))
662:     ; (message-box prefix-string)
663:     (search-forward "}")
664:     (setq mstring (buffer-substring bpos (point)))
665:     (kill-region bpos (point))
666:     (setq nstring
667:           (read-string "文字列を入力してください。: " 
668:                        :default mstring))
669:     (insert nstring)
670:     (search-forward "}")
671:     
672:     (if (looking-at ".*} -")
673:         (progn
674:           (search-forward "-")
675:           (kill-line)
676:           (char-line "-")))
677:     
678:     (re-search-forward
679:      (concat "^" 
680:              (regexp-quote prefix-string) 
681:              "¥@end¥{" mstring "¥}"))
682:     (beginning-of-line)
683:     (re-search-forward "end¥{")
684:     (goto-char (match-end 0))
685:     (setq apos (point))
686:     (search-forward "}")
687:     (kill-region apos (point))
688:     (insert nstring)
689:     (search-forward "}")
690:     (if (looking-at ".*} -")
691:          (progn
692:            (search-forward "-")
693:            (kill-line)
694:            (char-line "-")))
695:     
696:     (goto-char cpos)
697:     )
698:   )

  abc
  def

  # @begin{Cmnted out at 20160417 15:41}--------------------
  # abc
  # def
  # @end{Cmnted out at 20160417 15:41}----------------------
  # 
  # @begin{Inserted at 20160417 15:41}----------------------
  abc
  def
  # @end{Inserted at 20160417 15:41}------------------------

699: (defun revise-code ()
700:   (interactive)
701:   (let (prefix startposition endposition startline 
702:                lastline cline column markstring spaces)
703:     (auto-fill-mode 0)
704:     (setq prefix (read-string "prefix-string: "))
705:     (setq startposition (region-beginning))
706:     (setq endposition (region-end))
707:     (setq startline (count-lines 1 startposition))
708:     (setq lastline (count-lines 1 endposition))
709:     (copy-region-as-kill startposition endposition)
710:     ;
711:     (goto-char startposition)
712:     (back-to-indentation)
713:     ;
714:     (setq column (current-column))
715:     (setq timestring (format-date-string "%Y%m%d %H:%M"))
716:     (setq spaces
717:           (make-sequence 
718:            'string column :initial-element (code-char 32)))
719:     ;
720:     ;
721:     (goto-char startposition)
722:     (setq cline startline)
723:     (while (< cline lastline)
724:       (beginning-of-line)
725:       (forward-char column)
726:       (insert prefix)
727:       (beginning-of-line)
728:       (setq cline (+ cline 1))
729:       (forward-line 1))
730:     (beginning-of-line)
731:     (insert 
732:      (concat spaces
733:              prefix 
734:              *myregion-endstring*
735:              "Cmnted out at "
736:              timestring
737:              "}"))
738:     (region-char-line #¥-)
739: ;;    (delete-line)
740:     (beginning-of-line)
741:     (insert (concat spaces prefix "¥n"))
742:     (beginning-of-line)
743:     (insert 
744:      (concat spaces prefix 
745:              *myregion-startstring*
746:              "Inserted at "
747:              timestring
748:              "}"))
749:     (region-char-line #¥-)
750: ;;    (delete-line)
751:     (yank)
752:     (beginning-of-line)
753:     (insert 
754:      (concat spaces prefix 
755:              *myregion-endstring*
756:              "Inserted at "
757:              timestring
758:              "}"))
759:     (region-char-line #¥-)
760: ;;     (delete-line)
761:     (goto-char startposition)
762:     (beginning-of-line)
763:     (insert 
764:       (concat spaces prefix *myregion-startstring*
765:              "Cmnted out at "
766:              timestring
767:              "}"))
768:     (region-char-line #¥-)
769:     (goto-char startposition)
770:     (auto-fill-mode 0)
771:     )
772:   )

773: (defun comment-out-code ()
774:   (interactive)
775:   (let (prefix startposition endposition startline 
776:                lastline cline column markstring spaces)
777:     (setq prefix (read-string "prefix-string: "))
778:     (setq startposition (region-beginning))
779:     (setq endposition (region-end))
780:     (setq startline (count-lines 1 startposition))
781:     (setq lastline (count-lines 1 endposition))
782:     (copy-region-as-kill startposition endposition)
783:     ;
784:     (goto-char startposition)
785:     (back-to-indentation)
786:     ;
787:     (setq column (current-column))
788:     (setq timestring (format-date-string "%Y%m%d %H:%M"))
789:     (setq spaces
790:           (make-sequence 
791:            'string column :initial-element (code-char 32)))
792:     ;
793:     ;
794:     (goto-char startposition)
795:     (setq cline startline)
796:     (while (< cline lastline)
797:       (beginning-of-line)
798:       (forward-char column)
799:       (insert prefix)
800:       (beginning-of-line)
801:       (setq cline (+ cline 1))
802:       (forward-line 1))
803:     (beginning-of-line)
804:     (insert 
805:      (concat spaces
806:              prefix 
807:              *myregion-endstring*
808:              "Cmnted out at "
809:              timestring
810:              "}"))
811:     (region-char-line #¥-)
812:     (goto-char startposition)
813:     (beginning-of-line)
814:     (insert 
815:       (concat spaces prefix *myregion-startstring*
816:              "Cmnted out at "
817:              timestring
818:              "}"))
819:     (region-char-line #¥-)
820:     (goto-char startposition)
821:     ) 
822:   )

# @begin{Inserted at 20160312 20:00}------------------------
# @end{Inserted at 20160312 20:00}--------------------------

823: (defun insert-code ()
824:   (interactive)
825:   (let (cpos prefix timestring)
826:     (setq timestring (format-date-string "%Y%m%d %H:%M"))
827:     (setq cpos (point))
828:     (beginning-of-line)
829:     (setq prefix (buffer-substring (point) cpos))
830:     (goto-char cpos)
831:     (auto-fill-mode 0)
832:     (insert 
833:      (concat *myregion-startstring* 
834:              "Inserted at "
835:              timestring
836:              "}"))
837:     (region-char-line #¥-)
838:     (beginning-of-line)
839:     (insert 
840:      (concat prefix
841:              *myregion-endstring* 
842:              "Inserted at "
843:              timestring
844:              "}"))
845:     (region-char-line #¥-)
846:     (goto-char cpos)
847:     (auto-fill-mode 1)
848:     )
849:   )

850: (defun region-change-optionstring ()
851:   "reset optionstring"
852:   (interactive)
853:   (let (apos cpos mstring nstring prefix-string pos)
854:     (beginning-of-line)
855:     (setq cpos (point))
856:     (if (not (looking-at "^.*@begin¥{.*¥}¥{"))
857:         (if (looking-at "^.*@begin¥{[^}]*?¥} ")
858:             (progn
859:               (call-interactively 'region-add-optionstring)
860:               (return-from region-change-optionstring))
861:           (progn
862:             (message-box "region-change-optionstring: No begin line with an option string.")
863:             (call-process (concat (si:system-root) "xyzzycli.exe"))
864:             (return-from region-change-optionstring))))
865:     (end-of-line)
866:     (search-backward *myregion-startstring*)
867:     (re-search-forward "{.*?}{")
868:     (goto-char (match-end 0))
869:     (setq apos (point))
870:     (search-forward "}")
871:     (setq mstring (buffer-substring apos (point)))
872:     (kill-region apos (point))
873:     (message "漢字1文字14, 13文字で182, 余白8, 合計190")
874:     (setq nstring
875:           (read-string "Enter ¥"optionstring¥": " 
876:                        :default mstring))
877:     (if (> (length nstring) 0)
878:         (progn
879:           (insert nstring)
880:           (search-forward "}"))
881:       (progn
882:         (backward-char 1)
883:         (delete-char 2)
884:         (backward-char 1)
885:         ))
886:     (if (looking-at "} -")
887:         (progn
888:           (search-forward "-")
889:           (kill-line)
890:           (char-line "-")))
891:     (beginning-of-line)
892:     )
893:   )

894: (defun region-add-optionstring()
895:   "add the option string part"
896:   (interactive)
897:   (let (cpos optionstring pos)
898:     (beginning-of-line)
899:     (setq cpos (point)); cpos は行頭
900:     (if (not (looking-at "^.*@begin¥{[^}]*?¥} "))
901:         (progn
902:           (message-box "No begin line or inadequate line.")
903:           (call-process (concat (si:system-root) "xyzzycli.exe"))
904:           (return-from region-add-optionstring)))
905:     (myre-search-forward-in-line "^.*@begin¥{.*?¥}")
906:     (goto-char (match-end 0))
907:     (setq bpos (point)); @begin{...} の } の後ろの位置が bpos
908:     (setq optionstring
909:           (read-string "Enter an option string: ")) 
910:     (if (> (length optionstring) 0)
911:       (progn
912:         (insert (concat "{" optionstring "} "))
913:         (kill-line)
914:         (char-line "-")
915:         )
916:       )
917:     (goto-char cpos)
918:     )
919:   )

920: (defun region-captiononly-date ()
921:   (interactive)
922:   (let (num spaces)
923:     (setq num (current-column))
924:     (setq spaces "")
925:     (if (> num 0)
926:         (setq spaces (make-sequence 
927:                       'string num :initial-element 
928:                       (code-char 32))))
929:     (insert ";;; @(%) $caponly = ¥"Inserted on ")
930:     (insert-date)
931:     ; (File *my-sitelisp* "kh-base.l") で定義されています。
932:     ;
933:     (insert "¥"¥n")
934:     (insert spaces)
935:     (insert "@begin{frame}{double} ")
936:     (region-char-line #¥-)
937:     (insert "@end{frame} ")
938:     (region-char-line #¥-)
939:     (forward-line -1)
940:     )
941:   )

942: (defun region-captiononly-time ()
943:   (interactive)
944:   (let (num spaces)
945:     (setq num (current-column))
946:     (setq spaces "")
947:     (if (> num 0)
948:         (setq spaces (make-sequence 
949:                       'string num :initial-element 
950:                       (code-char 32))))
951:     (insert ";;; @(%) $caponly = ¥"Inserted at ")
952:     (insert-time)
953:     (insert "¥"¥n")
954:     (insert spaces)
955:     (insert "@begin{frame}{double} ")
956:     (region-char-line #¥-)
957:     (insert "@end{frame} ")
958:     (region-char-line #¥-)
959:     (forward-line -1)
960:     )
961:   )

962: (defun region-replace-dialog (num)
963:   (interactive "P")
964:   (if num
965:     ; C-u を前置して呼び出されたときは、此処に来ます。
966:     (region-set-region)
967:     )
968:   (narrow-to-region (mark) (point))
969:   (beginning-of-buffer)
970:   (replace-dialog)
971:   (message "C-x w (widen) とタイプし、ファイルを保存してください。")
972:   (widen)
973:   )

974: (defun kh-eval-lisp-code ()
975:   (interactive)
976:   (let (buf string)
977:     ; カーソルがある行の @begin 行を開始行とし、対応する @end 
978:     ; 行までの範囲の @begin ... @end の内側を region として指
979:     ; 定します。
980:     (call-interactively 'region-set-region)
981:     ; 指定した範囲を変数 string に記憶します。
982:     (setq string
983:           (buffer-substring (region-beginning) (region-end)))
984:     (setq buf (get-buffer-create "*temp-buffer*"))
985:     (switch-to-buffer buf)
986:     ; 作成したバッファ buf に移動して、string に記憶した
987:     ; ソースコードを挿入します。
988:     (erase-buffer (selected-buffer))
989:     (insert string)
990:     (set-mark (point-max))
991:     (goto-char (point-min))
992:     (remove-linenum)
993:     (eval-buffer (selected-buffer))
994:     (set-buffer-modified-p nil)
995:     (kill-buffer buf)
996:     )
997:   )

998: (defun goto-endmark ()
999:   (interactive)
1000:   (let (foundp)
1001:     (setq foundp (re-search-forward "^[ ]*@end{.*}"))
1002:     (if foundp
1003:         (progn
1004:           (forward-line 1)
1005:           (beginning-of-line)
1006:           ))
1007:     ))

1008: (defun beginend-check ()
1009:   "reset optionstring"
1010:   (interactive)
1011:   (kh-occur "¥¥(@begin{.*[ ].*}¥¥|@end{.*[ ].*}¥¥)")
1012:    )

1013: (provide "kh-myregion")