TeXで階層imenu(適当)

my-tex-imenu.el

; -*- coding: utf-8 -*-

;;; my-tex-imenu.el ---

;;; Commentary:

;; 

;;; Code:



(require 'imenu)
(which-func-mode t)
(setq imenu-space-replacement " ")
(setq imenu-auto-rescan t)



(defun find-corresponding-paren (open close point)
"Search corresponding paren beggining at the POINT or after.
Return a pair (point of open paren . point of close paren + 1).
If there is no open paren, return nil"
  (save-excursion
    (progn
      (goto-char point)
      (let ((begin (re-search-forward open (point-max) t)))
        (if (not begin)
            nil
          (let ((end (find-corresponding-paren-aux open close begin)))
            (if end
                (cons (1- begin) end)
              nil)))))))
(defun find-corresponding-paren-aux (open close begin)
  (let ((next-open (progn
                     (goto-char begin)
                     (re-search-forward open (point-max) t)))
        (next-close (progn
                      (goto-char begin)
                      (re-search-forward close (point-max) t))))
    (if (or (not next-open)
            (< next-close next-open))
        next-close
      (let ((next-corr (find-corresponding-paren open close begin)))
        (if next-corr
            (find-corresponding-paren-aux open close (cdr next-corr))
          nil)))))

;; (goto-char (cdr (find-corresponding-paren "\\[" "\\]" (point))))
;(let ((x (find-corresponding-paren "\\[" "\\]" (point))))
;  (concat "foo " (replace-regexp-in-string "\n" ""
;                                           (buffer-substring-no-properties (1+ (car x)) (1- (cdr x))))))
;; [ [[][
;; ]] hogehoge]
;; ] ] ]
;; (() ((point)))


;(find-corresponding-paren open close begin))


(defvar latex-imenu-always-increase-indent nil)
;(defvar latex-imenu-type-pattern-list
(setq latex-imenu-type-pattern-list
  `((part
     :pattern ,(rx "\\" (group "part") "{" (group (* (not (any "}")))) "}")
     :child chapter)
    (chapter
     :pattern ,(rx "\\" (group "chapter") "{" (group (* (not (any "}")))) "}")
     :child section)
    (section
     :pattern ,(rx "\\" (group "section") "{" (group (* (not (any "}")))) "}")
     :child subsection)
    (subsection
     :pattern ,(rx "\\" (group "subsection") "{" (group (* (not (any "}")))) "}")
     :child paragraph)
    (paragraph
     :pattern ,(rx "\\" (group "paragraph") "{" (group (* (not (any "}")))) "}")
     :child subparagraph)
    (subparagraph
     :pattern ,(rx "\\" (group "subparagraph") "{" (group (* (not (any "}")))) "}")
     :child theorems)
    (theorems
     :pattern ,(rx "\\begin{" (group (or "theorem" "proposition" "lemma" "corollary" "remark" "example")) "}")
     :make-tag
     (let* ((name (match-string-no-properties 1))
            (p-begin (match-beginning 0))
            (p (match-end 0))
            (x (find-corresponding-paren "\\[" "\\]" (point)))
            (option (if (and x (eq p (car x)))
                        (replace-regexp-in-string
                         (rx (? " ") "\\cite" (* (not (any "}"))) "}" (? ",")) ""
                         (replace-regexp-in-string
                          "\n" ""
                          (replace-regexp-in-string
                           (rx "\\" eol) ""
                           (buffer-substring-no-properties (1+ (car x)) (1- (cdr x))))))
                      nil))
            (p (if option
                   (cdr x)
                 p))
            (p-end (cdr (find-corresponding-paren (rx "\\begin") (rx "\\end") p-begin)))
            (label (progn
                     (goto-char p)
                     (re-search-forward (rx "\\label{"
                                            (* (not (any ":"))) ": "
                                            (group (* (not (any "}")))) "}")
                                        p-end t)
                     (match-string-no-properties 1))))
;       (concat name " - " (or option "") " - " (or label ""))))
       (concat name
               (if option
                   (concat " [ " option " ]")
                 "")
               (if label
                   (concat " - " label)
                 ""))))
    ))

(defvar latex-imenu-indent-string "  ")
(defvar latex-imenu-default-make-tag
;(setq latex-imenu-default-make-tag
  '(concat (match-string-no-properties 1) " - " (match-string-no-properties 2)))

(defun get-corresponding-value-with-keyword (record keyword &optional for-no-value throw-error)
  (let ((x (memq keyword record)))
    (if x
        (cadr x)
      (if throw-error
          (error for-no-value)
        for-no-value))))

(defun latex-create-imenu-index-aux (name begin end)
  (save-excursion
    (let* ((record (loop for i in latex-imenu-type-pattern-list
                         if (eq name (car i))
                         return i))
           (pattern (get-corresponding-value-with-keyword record :pattern "need pattern" t))
           (make-tag (get-corresponding-value-with-keyword record :make-tag latex-imenu-default-make-tag))
           (child-name (get-corresponding-value-with-keyword record :child)))
      (progn
        (goto-char end)
        (let ((result '())
              (last-found end))
          (progn
            (while (re-search-backward pattern begin t)
              (let* ((found (match-beginning 0))
                     (tag (save-excursion (eval make-tag))))
                (progn
                  (when child-name
                    (setq result
                          (append (mapcar (lambda (x)
                                            (cons (concat latex-imenu-indent-string (car x)) (cdr x)))
                                          (latex-create-imenu-index-aux child-name found last-found))
                                  result)))
                  (push (cons tag found)
                        result)
                  (setq last-found found)
                  )))
            (when child-name
              (setq result
                    (append (mapcar (lambda (x)
                                      (cons (concat (if latex-imenu-always-increase-indent
                                                        latex-imenu-indent-string
                                                      "")
                                                    (car x)) (cdr x)))
                                    (latex-create-imenu-index-aux child-name begin last-found))
                            result)))
            result))))))

(defun latex-create-imenu-index ()
  (latex-create-imenu-index-aux 'part (point-min) (point-max)))

;(defun latex-create-imenu-index ()
;  (let ((index '())
;;	(pattern (concat latex-ec-regexp "\\(" latex-sectioning-regexp "\\)\\*?{\\(.*\\)}")))
;; "\\(part\\|chapter\\*?\\|\\(sub\\)*\\(section\\|paragraph\\)\\)\\(\\*\\|\\b\\)"
;	(pattern (rx "\\" (group (or "part" "chapter" "section" "subsection" "paragraph" "subparagraph"))
;                     "{" (group (* (not (any "}")))) "}"))
;        )
;    (goto-char (point-min))
;    (while (re-search-forward pattern (point-max) t)
;      (push (cons (concat (match-string-no-properties 1) " - " (match-string-no-properties 2))
;                  (match-beginning 0))
;            index))
;    (nreverse index)))
;
;(defun latex-create-imenu-index ()
;  (let ((index '())
;	(pattern (rx "\\" (group (or "part" "chapter" "section" "subsection" "paragraph" "subparagraph"))
;                     "{" (group (* (not (any "}")))) "}"))
;        )
;    (goto-char (point-max))
;    (while (re-search-backward pattern (point-min) t)
;      (push (cons (concat (match-string-no-properties 1) " - " (match-string-no-properties 2))
;                  (match-beginning 0))
;            index))
;    index))
;
(add-hook 'yatex-mode-hook
          '(lambda ()
             (setq imenu-create-index-function 'latex-create-imenu-index)))
(push 'yatex-mode which-func-modes)



(provide 'my-tex-imenu)
;;; my-tex-imenu.el ends here