[xyzzy:04947] アウトラインもどき

[Seiya Suda <seiya.suda@xxxxxxxxxxx>]

みなさん、こんにちは。

ごみみたいなものですが、跳ぶ機能しかないアウトライン
もどきを、gmark をまねて、試作しました。

まだ枠とかかっこわるいので、こうしろああしろと言って
いただけるとうれしいです(機能は増えませんけど)。
署名の後にあります。

話変わりまして、バッファタブはnext-buffer と連動してい
るんですね。


--------
須田誠也(suda seiya)
seiya.suda@xxxxxxxxxxx
http://member.nifty.ne.jp/seiya-suda/


;;; -*- Mode: Lisp; Package: EDITOR -*-
;;;
;;;  Is this file part of xyzzy?
;;;
;;;  outline3.l -- あきもせず、あうとらいんもどき

;;; Code

(provide "outline3")

(in-package "editor")

(export '(outline-dialog-box *outline-regexp*))

(defvar *outline-regexp* "^[■●]")
(setq *list-box-up-char* #\p)
(setq *list-box-down-char* #\n)
(setq *list-box-def-char* #\f)
(defvar *referred-to-buffer* nil)

(defun outline-get-line ()
  (save-excursion
    (buffer-substring (progn
			(goto-bol)
			(point))
		      (progn
			(goto-eol)
			(point)))))

(defun outline-make-list (str)
  (let (result)
    (save-excursion
      (goto-char (point-max))
      (while
	  (scan-buffer str :regexp t :reverse t :no-dup t :tail nil)
	(let ((midashi (outline-get-line))
	      (point (point)))
	  (push (list midashi point) result)))
      result)
  ))

(defvar *outline-dialog-template*
  '(dialog 0 0 132 336
    (:caption "アウトラインもどき")
    (:font 10 "ＭＳ Ｐゴシック")
    (:control
     (:listbox list nil #x50a10011 2 2 130 318)
     (:button go "跳(&G)" #x50030001 2 320 30 12))))



(defun outline-dialog-box (str)
  (interactive "s見出しの正規表現: " :default0 *outline-regexp*)
  (setq *referred-to-buffer* (selected-buffer))
  (let ((strings (outline-make-list str))
	choice)
    (multiple-value-bind (result data)
	(dialog-box *outline-dialog-template*
		    (list (cons 'list strings))
		    '((list :column (40 0 -6 128) :must-match t :enable (go))))
      (cond ((eq result 'go)
	     (setq choice (caddr (assoc 'list data)))
	     (outline-goto choice))
	    (t nil)))))

(defun outline-goto (point)
  (interactive)
  (set-buffer *referred-to-buffer*)
  (goto-char point))


(global-set-key #\C-F4 'outline-dialog-box)