gooブログはじめました!

写真付きで日記や趣味を書くならgooブログ

emacs の番号つけなおし

2016-02-14 08:41:00 | パソコン・インターネット
emacsのテキストの箇条書きの番号を振りなおすための、lisp プログラムをさがしていたが、ようやく発見。少し手を加えた。

; -*- Mode: Lisp -*-

;;     renumber-sections.el  v.0.51 (renumber-sections for Emacs)
;;
;;     $ Last modified: Fri Sep 12 17:18:13 2003 ::arbos::
;;     Author: OHBA Masahiro  http://www.venus.dti.ne.jp/~arbos/

;; ■ renumber-sections.elとは何か
;;
;;       numbered-outline.elのre-number機能だけを実現します。こんな感じ。
;;
;;           %%% #2                  %%% #1
;;           %%% #3                  %%% #2
;;           %%% #7.5        ->      %%% #2.1
;;           %%% #1.6.5              %%% #2.1.1
;;           %%% #565                %%% #3

;; ■ インストール
;;
;;     1. renumber-sections???.el を renumber-sections.el にリネームし、
;;        $EMACS-DIR$/site-lisp にコピーして以下を .emacs に記入してください。
;;
;;        (require 'renumber-sections)
;;
;;     2. M-x renumber-sections で実行します
;;
;;     3. save-buffer 時に自動で実行する場合は、以下を追記してください。
;;
;;          (add-hook 'write-file-hook* 'renumber-sections-auto-save)
;;          (setq *renumber-sections-auto-save-active* t)
;;
;;        ☆ save出来なくなった場合、または一時的にauto-saveを切りたい場合
;;             M-x renumber-sections-toggle-auto-save
;;           を実行してください。(カレントバッファにのみ影響します。)
;;
;;     4. 特定のmodeでだけauto-saveを有効にしたい場合、以下を加えてください。
;;           例: yatex-mode, text-modeで有効にしたい場合
;;          (setq *renumber-sections-auto-save-mode-list*
;;                      '(yatex-mode text-mode))
;;               
;;
;; ■ カスタマイズ
;;
;;     以下の変数を.emacsで設定してください。(例はデフォルト値)
;;
;;     1. section numbersの正規表現 *renumber-sections-regexp* は以下のとおりです。
;;
;;              "\\(^%%% #\\)\\([0-9]+\\)\\(\\.[0-9]+\\)*"
;;                  ^^^^^^      ^^^^^^^^^^^^^^^^^^^^^
;;                 ヘッダー             numbers
;;         (行頭から) `%%% #'          `1.2.3'
;;
;;       (setq *renumber-sections-regexp* "\\(^%%%\\ #\\)\\([0-9]+\\)\\(\\.[0-9]+\\)*"))
;;
;;     2. 行頭から数字のみにしたい場合は次の変数を以下のように変更してください。
;;
;;          (setq *renumber-sections-regexp* "\\(^[0-9]+\\)\\(\\.[0-9]+\\)*")
;;          (setq *renumber-sections-header-type* 1)
;;
;;     6. numberの最初が `000' の時、次から番号をふり直します
;;          (setq  *renumber-sections-init-number* "000")
;;
;;     7. re-number後、階層が飛んだ行に跳ぶか
;;          (setq *renumber-sections-goto-error-line* t)

;; -
;; ■ 変更履歴
;;    Author: HY
;;      Sat Feb 13 2016 v.0.6  
;;        * カーソルより下だけ処理するように変更
;;        * (a)(b)(c)のようなアルファベット小文字のリナンバーを
;;      をするために renumber-sections-alphabet を追加。
;;
;;    Author: OHBA Masahiro  http://www.venus.dti.ne.jp/~arbos/
;;      Fri Sep 12 01:03:21 2003 v.0.51
;;        * リストを作る方法を簡略化して不要な変数を廃止
;;        * *renumber-sections-dont-mind* を廃止
;;        * *renumber-sections-goto-error-line*を追加
;;
;;      Fri Sep 05 23:25:06 2003 v.0.5
;;        * xyzzy版を移植。

;; -
;; ■ 本体

(require 'cl)
(provide 'renumber-sections)

;; ◇ default settings
(defun renumber-sections-vars-setting (alphabet)
  (if alphabet
      (if (boundp '*renumber-sections-alphabet-regexp*)
      (setq renumber-sections-regexp *renumber-sections-alphabet-regexp*)
        (setq renumber-sections-regexp* "\\(^[ ]*\\)\\(([a-z])\\)\\(\\.([a-z])\\)*"))
    (if (boundp '*renumber-sections-regexp*)
    (setq renumber-sections-regexp *renumber-sections-regexp*)
      (setq renumber-sections-regexp "\\(^%%%\\ #\\)\\([0-9]+\\)\\(\\.[0-9]+\\)*")))

  (if (boundp '*renumber-sections-header-type*)
      (setq renumber-sections-header-type *renumber-sections-header-type*)
    (setq renumber-sections-header-type 2))

  (if (boundp '*renumber-sections-auto-save-active*)
      (setq renumber-sections-auto-save-active *renumber-sections-auto-save-active*)
    (setq renumber-sections-auto-save-active nil))

  (if (boundp '*renumber-sections-init-number*)
      (setq renumber-sections-init-number *renumber-sections-init-number*)
    (setq renumber-sections-init-number "000"))

  (if (boundp '*renumber-sections-goto-error-line*)
      (setq renumber-sections-goto-error-line *renumber-sections-goto-error-line*)
    (setq renumber-sections-goto-error-line t))
  )


;; ◇ Re-number headings in buffer.
(defun renumber-sections ()
  "Re-number section numbers"
  (interactive)
  (renumber-sections-vars-setting nil)
  (renumber-sections-main nil))

;; ◇ Re-number headings by alphabet in buffer.
(defun renumber-sections-alphabet ()
  "Re-number section numbers"
  (interactive)
  (renumber-sections-vars-setting t)
  (renumber-sections-main t))

;; ◇ renumber-sections-main
(defun renumber-sections-main (alphabet)
  (save-excursion
;    (renumber-sections-vars-setting alphabet)
    (setq bad-line 0)
    (setq section-numbers-list '(0))
;    (goto-char (point-min))
    (while (re-search-forward renumber-sections-regexp nil t)
      (cond ((string-equal (match-string renumber-sections-header-type)
               renumber-sections-init-number)
         (setq section-numbers-list '(0))
         (goto-char (point-at-eol)))
        (t
         (renumber-sections-make-new-num-list section-numbers-list (match-string 0))
         (let ((i (match-beginning renumber-sections-header-type))
           (j (match-end 0)))
           (if alphabet
           (renumber-sections-insert-alphabet i j section-numbers-list)
           (renumber-sections-insert i j section-numbers-list))
           )
         )))
    )
  (unless (zerop bad-line)
    (when renumber-sections-goto-error-line
      (goto-char bad-line))
    (message "階層が飛んでいます"))
  )

;; ◇ 新しいnumbersのリストを作る
(defun renumber-sections-make-new-num-list  (pre-num-list new-num-str)
  (let ((j pre-num-list) (i (count-depth new-num-str)) (k nil))
    (cond ((< (list-length j) i) ;深い時
       (setq k j)
       (setq i (- i (list-length j)))
       (when (> i 1); 深すぎた時
         (and (zerop bad-line)
          (setq bad-line (point))))
       (while (> i 1)
         (setq k (append k '(0)))
         (decf i))
       (setq k (append k '(1))))
      (t                      ;同じ深さか、浅い時
       (while (> i 1)
         (setq k (append k (list (car j))))
         (setq j (cdr j))
         (decf i))
       (setq k (append k (list (+ (car j) i))))))
    
    (setq section-numbers-list k)
    ))


;; ◇ 階層の深さを調べる
(defun count-depth (heading)
  (1+ (loop for c across heading count (eq c ?.))))

;; ◇ 書き込む
(defun renumber-sections-insert (start end integer-list)
  (goto-char start)
  (delete-region start end)
  (let ((j 1))
    (dolist (i integer-list)
      (cond ((> (list-length integer-list) j)
         (insert (format "%d." i)))
        (t  
         (insert (format "%d" i))))
      (incf j)))
  )

;; ◇ toggle auto save
(defun renumber-sections-toggle-auto-save ()
  (interactive)
  "toggle *renumber-sections-auto-save-active*"
  (make-local-variable '*renumber-sections-auto-save-active*)
  (setq *renumber-sections-auto-save-active* (not *renumber-sections-auto-save-active*))
  )

;; ◇ save-buffer の時に re-number
(defun renumber-sections-auto-save ()
  "exec (renumber-sections) befor (save-buffer)"
  (interactive)
  (renumber-sections-vars-setting)
  (when renumber-sections-auto-save-active
    (when (buffer-modified-p)
      (cond ((boundp '*renumber-sections-auto-save-mode-list*)
         (when (find major-mode *renumber-sections-auto-save-mode-list*)
           (renumber-sections-main)))
        (t
         (renumber-sections-main)))))
  nil)

;----- end of renumber-sections.el ----------
; (format "%c" 97)
; "a"
;(defun renum-alphabet ()
;  (interactive)
;  (replace-regexp "[ ]*- " "\\, (abc \\#)") )

;; ◇ alhpabet を書き込む
(defun renumber-sections-insert-alphabet (start end integer-list)
  (goto-char start)
  (delete-region start end)
  (let ((j 1))
    (dolist (i integer-list)
      (cond ((> (list-length integer-list) j)
         (insert (format "(%c)" (+ 96 i))))
        (t  
         (insert (format "(%c)" (+ 96 i)))))
      (incf j)))
  )

;;----------------------------------------------------

;;  行頭から空白+数字にしたい場合は次の変数を以下のように変更してください。
;;  行頭から空白+(a)~(z)にしたい場合は次の変数を以下のように変更してください。

(setq *renumber-sections-regexp* "\\(^[ ]*\\)\\([0-9]+\\)\\(\\.[0-9]+\\)*")
(setq *renumber-sections-alphabet-regexp* "\\(^[ ]*\\)\\(([a-z])\\)\\(\\.([a-z])\\)*")

(setq *renumber-sections-header-type* 2)

;----------  setting for pindex ---------------
;; $1 pindex-local-keyword-regexp: \(^;; [■◇#-].*\)
;; $2 pindex-local-ignore-keyword: ;; -
;; $3 pindex-show-next-line-local: 0
;----------------------------------------------