[Date Prev] [Date Index] [Date Next]
[Thread Prev] [Thread Index] [Thread Next]

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



須田さん、亀井さん、こんにちは。逸見 です。

須田さんのコードを改造してみました。
(provide "outline")
(in-package "editor")
(export '(outline outline-jump outline-margin *outline-pattern*))

(defvar *outline-pattern* "^[■◆◇●○・]")
(defun outline-margin () 20)

(defvar *outline-mode-map* nil)
(unless *outline-mode-map*
  (setq *outline-mode-map* (make-sparse-keymap))
  (define-key *outline-mode-map* #\F12 'outline-jump)
)

(defun outline-buffer-name (buf-or-string)
  (if (bufferp buf-or-string)
      (setq buf-or-string (buffer-name buf-or-string)))
  (concat "Outline-" buf-or-string))

(defun outline ()
  (interactive)
  (let ((sb (selected-buffer))
	ob obname)
    (setq obname (outline-buffer-name sb))
    (save-excursion
      (setq ob (get-buffer-create obname))
      (set-buffer ob)
      (setq buffer-read-only nil)
      (delete-region (point-min) (point-max))
      ;;
      (set-buffer sb)
      (with-output-to-buffer (obname nil)
        (goto-char (point-min))
        (while (scan-buffer *outline-pattern* :regexp t)
          (format t "~A~%"
            (buffer-substring (progn (goto-bol) (point))
	  	              (progn (goto-eol) (point))))
          (or (forward-char 1)
	      (return))))
      ;;
      (set-buffer ob)
      (setq buffer-read-only t)
      (set-buffer-modified-p nil)
      (setq buffer-mode 'outline-mode)
      (setq mode-name "Outline")
      (use-keymap *outline-mode-map*)
    )
    (message "completed.")
    (split-window-vertically (outline-margin))
    (set-buffer ob)
  )
)


(defun outline-jump ()
  (interactive)
  (let ((bname (substring (buffer-name (selected-buffer)) 8))
	(string nil))
    (save-excursion
      (setq string (buffer-substring (progn (goto-bol) (point))
				     (progn (goto-eol) (point))))
    )
    (cond ((= (count-windows 'foo) 1)
	   (split-window-vertically (outline-margin))
	   (other-window)
	   (set-buffer bname))
	  (t (pop-to-buffer bname)))
    (goto-char (point-min))
    (scan-buffer string)
  )
)

(global-set-key #\C-F12 'outline)

------------------------------------------------------------
逸見雅人        Email   henmi@xxxxxxxxxxxxx
Masahito Henmi 

Index Home