🚀 go-pugleaf

  初めまして.
  nakamura といいます.


At Sat, 07 Oct 2000 07:03:05 +0900,
Chee <chee@subdimension.com> wrote:
> 
> Meadow 1.13 beta1 (Emacs 20.6.1) で perl-mode-hookに入れて
> 使ってます（何千行にもならないので快適）ですが、複数行の
> リージョンペースト後に表示が崩れてしまうのが残念ですね。
> 

  setnu.el に関して, 複数行を yank したときの動作が私も気になっていたの
で, その辺を改良して今使っています. よかったらどうぞ.

  一応, 区別しておくために接頭辞に my- を付けてます.

  何千行にもなるコードだとやっぱり最初に開くとき時間かかるんですよね.
  fast-lock みたいにキャッシュに保存できたりしたら速くなるかな?



-- code 

;;; Original author: Kyle E. Jones  --  kyle@wonderworks.com
;;; Additional code by: Naoki Nakamura <naoki.y.nakamura@nifty.com>

(provide 'my-setnu)

(defconst my-setnu-on-xemacs
  (or (string-match "XEmacs" emacs-version)
      (string-match "Lucid" emacs-version)))

(defconst my-setnu-mode-version "1.0"
  "Version number for this release of my-setnu-mode.")

(defvar my-setnu-mode nil
  "Non-nil if my-setnu-mode is active in the current buffer.")
(make-variable-buffer-local 'my-setnu-mode)

(defvar my-setnu-start-extent nil
  "First extent of a chain of extents used by my-setnu-mode.
Each line has its own extent.  Each line extent has a
`my-setnu-next-extent' property that points to the next extent in
the chain, which is the extent for the next line in the buffer.
There is also a `my-setnu-prev-extent' that points at the previous
extent in the chain.  To distinguish them from other extents the
my-setnu-mode extents all have a non-nil `my-setnu' property.")
(make-variable-buffer-local 'my-setnu-start-extent)

(defvar my-setnu-glyph-obarray (make-vector 401 0)
  "Obarray of symbols whose values are line number glyphs.
Each symbol name is the string represnetation of a number, perhaps
passed with spaces.  The value of the symbol is a glyph that can
be made the begin glyph of an extent to display as a line number.")

(defvar my-setnu-begin-glyph-property (if (fboundp 'extent-property)
				       'begin-glyph
				     'before-string)
  "Property name to use to set the begin glyph of an extent.")

(defvar my-setnu-line-number-format (if my-setnu-on-xemacs "%4d" "%4d|")
  "String suitable for `format' that will generate a line number string.
`format' will be called with this string and one other argument
which will be an integer, the line number.")

(defvar my-setnu-line-number-face 'bold
  "*Face used to display the line numbers.
Currently this works for XEmacs 19.12 and later versions only.")

(defun my-setnu-mode (&optional arg)
  "Toggle my-setnu-mode.
With prefix argument, turn my-setnu-mode on if argument is positive.
When my-setnu-mode is enabled, a line number will appear at the left
margin of each line."
  (interactive "P")
  (let ((oldmode (not (not my-setnu-mode)))
        (inhibit-quit t))
    (setq my-setnu-mode (or (and arg (> (prefix-numeric-value arg) 0))
                            (and (null arg) (null my-setnu-mode))))
    (if (not (eq oldmode my-setnu-mode))
        (if my-setnu-mode
            (my-setnu-mode-on)
          (my-setnu-mode-off)))))

(defun turn-on-my-setnu-mode ()
  "Turn on my-setnu-mode.
Useful for adding to a major-mode hook variable.
Example:
    (add-hook 'text-mode-hook 'turn-on-my-setnu-mode)
to automatically turn on line numbering when enterting text-mode."
  (my-setnu-mode 1))

;;; Internal functions

;;; The program is written using XEmacs terminology,
;;; e.g. extents, glyphs, etc.  Functions are defined to twist
;;; the FSF Emacs overlay API into the XEmacs model.

(if my-setnu-on-xemacs
    (progn
      (fset 'my-setnu-make-extent 'make-extent)
      (fset 'my-setnu-delete-extent 'delete-extent)
      (fset 'my-setnu-extent-property 'extent-property)
      (fset 'my-setnu-set-extent-property 'set-extent-property)
      (fset 'my-setnu-set-extent-endpoints 'set-extent-endpoints)
      (fset 'my-setnu-extent-end-position 'extent-end-position)
      (fset 'my-setnu-extent-start-position 'extent-start-position)
      (defun my-setnu-set-extent-begin-glyph (e g)
        (set-extent-begin-glyph e g 'outside-margin)))
  (progn
    (fset 'my-setnu-make-extent 'make-overlay)
    (fset 'my-setnu-delete-extent 'delete-overlay)
    (fset 'my-setnu-extent-property 'overlay-get)
    (fset 'my-setnu-set-extent-property 'overlay-put)
    (fset 'my-setnu-set-extent-endpoints 'move-overlay)
    (fset 'my-setnu-extent-end-position 'overlay-end)
    (fset 'my-setnu-extent-start-position 'overlay-start)
    (defun my-setnu-set-extent-begin-glyph (e g)
      (overlay-put e my-setnu-begin-glyph-property g))))
    
(fset 'my-setnu-make-glyph (if my-setnu-on-xemacs 'make-glyph 'identity))

(cond ((and my-setnu-on-xemacs (fboundp 'set-glyph-face))
       (fset 'my-setnu-set-glyph-face 'set-glyph-face))
      (my-setnu-on-xemacs
       (fset 'my-setnu-set-glyph-face 'ignore))
      (t                                ; FSF Emacs
       (defun my-setnu-set-glyph-face (g face)
         (put-text-property 0 (length g) 'face face g))))

(defun my-setnu-mode-off ()
  "Internal shutdown of my-setnu-mode.
Deletes the extents associated with my-setnu-mode."
  (if (and my-setnu-on-xemacs
           (fboundp 'remove-specifier))
      (remove-specifier left-margin-width (current-buffer)))
  (let ((match-data (match-data))
        e ee)
    (unwind-protect
        (save-excursion
          (save-restriction
            (widen)
            (setq e (overlays-in (point-min) (point-max)))
            (while e
              (setq ee (car e))
              (if (my-setnu-extent-property ee 'my-setnu)
                  (my-setnu-delete-extent ee) nil)
              (setq e (cdr e)))))
      (store-match-data match-data) ))
  (setq my-setnu-start-extent nil))

(defun my-setnu-mode-on ()
  "Internal startup of my-setnu-mode.
Sets up the extents associated with my-setnu-mode."
  (if (and my-setnu-on-xemacs
           (fboundp 'set-specifier))
      (set-specifier left-margin-width 6 (current-buffer)))
  (let ((done nil)
        (curr-e nil)
        (n 1)
        (match-data (match-data))
        e start numstr)
    (unwind-protect
        (save-excursion
          (save-restriction
            (widen)
            (goto-char (point-min))
            (setq start (point))
            (while (not done)
              (setq done (null (search-forward "\n" nil 0)))
              (setq e (my-setnu-make-my-setnu-extent start (point)))
              (if (null my-setnu-start-extent)
                  (setq my-setnu-start-extent e
                        curr-e e)
                (my-setnu-set-extent-property curr-e 'my-setnu-next-extent e)
                (my-setnu-set-extent-property e 'my-setnu-prev-extent curr-e)
                (setq curr-e e))
              (setq numstr (format my-setnu-line-number-format n))
              (my-setnu-set-extent-property e 'line-number numstr)
              (my-setnu-set-extent-begin-glyph e (my-setnu-number-glyph numstr))
              (setq n (1+ n)
                    start (point)))))
      (store-match-data match-data))))


(defvar my-setnu-del-lf-flag nil)
(make-variable-buffer-local 'my-setnu-del-lf-flag)
(defvar my-setnu-start-e nil)
(make-variable-buffer-local 'my-setnu-start-e)
(defvar my-setnu-end-e nil)
(make-variable-buffer-local 'my-setnu-end-e)
(defvar my-setnu-saved-next nil)
(make-variable-buffer-local 'my-setnu-saved-next)

(defun my-setnu-before-change-function (start end)
  "Before change function for my-setnu-mode.
Notices when a delete is about to delete some lines and adjusts
the line number extents accordingly."
  (if (or (not my-setnu-mode) (= start end))
      ();; not in my-setnu-mode or this is an insertion
    (let ((inhibit-quit t)
          (match-data (match-data)))
      (unwind-protect
          (save-excursion
            (save-restriction
              (widen)
              (goto-char start)
              (if (search-forward "\n" end t)
                  (progn
                    (setq my-setnu-del-lf-flag t)
                    (setq my-setnu-start-e (my-setnu-extent-at-create start nil)
                          my-setnu-saved-next (my-setnu-extent-property
                                               my-setnu-start-e
                                               'my-setnu-next-extent))
                    (setq my-setnu-end-e (my-setnu-extent-at-create end nil)))
                (setq my-setnu-del-lf-flag nil))))
        (store-match-data match-data)))))

(defun my-setnu-after-change-function (start end length)
  "After change function for my-setnu-mode.
Notices when an insert has added some lines and adjusts
the line number extents accordingly."
  (if my-setnu-mode
      (if (= start end)
          ;; this is a deletion
          (if my-setnu-del-lf-flag
              (let ((inhibit-quit t)
                    (start-e nil)
                    (match-data (match-data))
                    end-e saved-next e ee)
                (unwind-protect
                    (save-excursion
                      (save-restriction
                        (widen)
                        (goto-char start)
                        (if my-setnu-start-e
                            (progn
                              (my-setnu-set-extent-endpoints
                               my-setnu-start-e
                               (my-setnu-extent-start-position my-setnu-start-e)
                               (my-setnu-extent-end-position my-setnu-end-e))
                              (my-setnu-set-extent-property
                               my-setnu-start-e 'my-setnu-next-extent
                               (my-setnu-extent-property my-setnu-end-e 'my-setnu-next-extent))
                              (setq e (my-setnu-extent-property my-setnu-start-e 'my-setnu-next-extent)
                                    ee my-setnu-saved-next)
                              (while (and e (my-setnu-extent-property e 'my-setnu-next-extent))
                                (setq e (my-setnu-extent-property e 'my-setnu-next-extent)
                                      ee (my-setnu-extent-property ee 'my-setnu-next-extent)))
                              (while (and e (not (eq ee my-setnu-start-e)))
                                (my-setnu-set-extent-begin-glyph
                                 e (my-setnu-extent-property ee 'before-string))
                                (my-setnu-set-extent-property
                                 e 'line-number (my-setnu-extent-property ee 'line-number))
                                (setq e (my-setnu-extent-property e 'my-setnu-prev-extent)
                                      ee (my-setnu-extent-property ee 'my-setnu-prev-extent)))
                              (setq my-setnu-end-e (my-setnu-extent-property my-setnu-start-e
                                                                             'my-setnu-next-extent))
                              (and my-setnu-end-e
                                   (my-setnu-set-extent-property my-setnu-end-e
                                                                 'my-setnu-prev-extent
                                                                 my-setnu-start-e))
                              (setq e my-setnu-saved-next)
                              (while (not (eq e my-setnu-end-e))
                                (setq ee e
                                      e (my-setnu-extent-property e 'my-setnu-next-extent))
                                (my-setnu-delete-extent ee))))
                        (setq my-setnu-start-e nil)))
                  (store-match-data match-data))))
        ;; this is a insertion
        (let ((inhibit-quit t)
              (ee nil)
              (match-data (match-data))
              (new-lines 0)
              start-e e saved-end saved-next n numstr)
          (unwind-protect
              (save-excursion
                (save-restriction
                  (widen)
                  (setq start-e (my-setnu-extent-at-create start nil))
                  (if (< (my-setnu-extent-end-position start-e) (point))
                      ;; bogus!  insertion didn't put the text into
                      ;; the extent because,
                      ;; a. the extent was zero length or
                      ;; b. this is FSF Emacs which means chars
                      ;;    inserted at the end position of an extent
                      ;;    are not inserted into the extent.
                      (my-setnu-set-extent-endpoints
                       start-e
                       (my-setnu-extent-start-position start-e)
                       end))
                  (setq saved-next (my-setnu-extent-property start-e
                                                             'my-setnu-next-extent)
                        saved-end (my-setnu-extent-end-position start-e)
                        e start-e)
                  (goto-char start)
                  (while (search-forward "\n" end 0)
                    (my-setnu-set-extent-endpoints e
                                                   (my-setnu-extent-start-position e)
                                                   (point))
                    (setq ee (my-setnu-make-my-setnu-extent (point) (point)))
                    (my-setnu-set-extent-property e 'my-setnu-next-extent ee)
                    (my-setnu-set-extent-property ee 'my-setnu-prev-extent e)
                    (setq e ee new-lines (1+ new-lines)))
                  (if ee
                      (progn
                        (my-setnu-set-extent-endpoints
                         e (my-setnu-extent-start-position e) saved-end)
                        (my-setnu-set-extent-property e 'my-setnu-next-extent saved-next)
                        (and saved-next
                             (my-setnu-set-extent-property
                              saved-next 'my-setnu-prev-extent e))
                        (setq e (my-setnu-extent-property start-e 'my-setnu-next-extent)
                              ee saved-next)
                        (while ee
                          (my-setnu-set-extent-begin-glyph
                           e (my-setnu-extent-property ee my-setnu-begin-glyph-property))
                          (my-setnu-set-extent-property
                           e 'line-number (my-setnu-extent-property ee 'line-number))
                          (setq e (my-setnu-extent-property e 'my-setnu-next-extent)
                                ee (my-setnu-extent-property ee 'my-setnu-next-extent)))
                        (setq n (1+ (string-to-int
                                     (my-setnu-extent-property
                                      (my-setnu-extent-property e 'my-setnu-prev-extent)
                                      'line-number))))
                        (while e
                          (setq numstr (format my-setnu-line-number-format n))
                          (my-setnu-set-extent-property e 'line-number numstr)
                          (my-setnu-set-extent-begin-glyph
                           e (my-setnu-number-glyph numstr))
                          (setq e (my-setnu-extent-property e 'my-setnu-next-extent)
                                n (1+ n)))))))
            (store-match-data match-data))))))

(defun my-setnu-number-glyph (number-string)
  (let ((sym (intern number-string my-setnu-glyph-obarray)))
    (if (boundp sym)
        (symbol-value sym)
      (let ((g (my-setnu-make-glyph number-string)))
        (set sym g)
        (my-setnu-set-glyph-face g my-setnu-line-number-face)
        g ))))

(defun my-setnu-make-my-setnu-extent (beg end)
  "Create an extent and set some properties that all my-setnu extents have."
  (let ((e (my-setnu-make-extent beg end)))
    (my-setnu-set-extent-property e 'my-setnu t)
    (my-setnu-set-extent-property e 'priority 0)
    ;;    (my-setnu-set-extent-property e 'begin-glyph-layout 'outside-margin)
    (my-setnu-set-extent-property e 'detachable nil)
    (my-setnu-set-extent-property e 'evaporate nil)
    e ))

(cond ((fboundp 'overlays-in);; expect to see this in 19.30
       (defun my-setnu-extent-at (pos buf)
         "Finds the my-setnu extent at the position POS in the buffer BUF."
         (catch 'done
           (save-excursion
             (and buf (set-buffer buf))
             (let ((o-list (overlays-in pos (1+ pos))))
               (while o-list
                 (if (overlay-get (car o-list) 'my-setnu)
                     (throw 'done (car o-list)))
                 (setq o-list (cdr o-list)))
               nil )))))
      ((fboundp 'overlays-at)
       (defun my-setnu-extent-at (pos buf)
         "Finds the my-setnu extent at the position POS in the buffer BUF."
         (catch 'done
           (save-excursion
             (and buf (set-buffer buf))
             (let ((o-list (overlays-at pos)) o-lists)
               ;; search what overlays-at returns first.  for all
               ;; but zero length extents this will return the
               ;; extent we want.
               (while o-list
                 (if (overlay-get (car o-list) 'my-setnu)
                     (throw 'done (car o-list)))
                 (setq o-list (cdr o-list)))
               ;; No luck.  Search the lists returned by
               ;; overlay-lists.  Use overlays-recenter so we only
               ;; have to search the `before' lobe of the return
               ;; value.
               (overlay-recenter (1- pos))
               (setq o-lists (overlay-lists))
               (setq o-list (cdr o-lists))
               (while o-list
                 (if (and (overlay-get (car o-list) 'my-setnu)
                          (or (and (= pos (overlay-start (car o-list)))
                                   (= pos (overlay-end (car o-list))))
                              (and (>= pos (overlay-start (car o-list)))
                                   (< pos (overlay-end (car o-list))))))
                     (throw 'done (car o-list)))
                 (setq o-list (cdr o-list)))
               nil )))))
      ((fboundp 'map-extents)
       (defun my-setnu-extent-at (pos buf)
         "Finds the my-setnu extent at the position POS in the buffer BUF."
         (map-extents (function (lambda (e maparg)
                                  (if (my-setnu-extent-property e 'my-setnu)
                                      e
                                    nil)))
                      buf pos pos)))
      (t (error "can't find overlays-in, overlays-at, or map-extents!")))

(defun my-setnu-extent-at-create (pos buf)
  "Like `my-setnu-extent-at' except if an extent isn't found, then
it is created based on where the extent failed to be found."
  (let ((e (my-setnu-extent-at pos buf)) ee beg numstr)
    (if e
        e
      ;; no extent found so one must be created.
      (save-excursion
        (goto-char pos)
        (beginning-of-line)
        (setq e (my-setnu-extent-at (point) buf))
        (cond (e
               ;; found one.  extend it to cover this whole line.
               ;; this takes care of zero length extents that
               ;; might exist at bob or eob that can't be
               ;; inserted into.
               (setq beg (point))
               (forward-line 1)
               (my-setnu-set-extent-endpoints e beg (point))
               e )
              ((bobp)
               ;; we are at bob and there's no extent.
               ;;
               ;; this is because the extent that was there got
               ;; detached because all the text in the buffer was
               ;; deleted.  so we create a new extent and make it
               ;; contain the whole buffer, since there can be no
               ;; other attached extents.
               (setq e (my-setnu-make-my-setnu-extent (point-min) (point-max))
                     numstr (format my-setnu-line-number-format 1))
               (my-setnu-set-extent-property e 'line-number numstr)
               (my-setnu-set-extent-begin-glyph e (my-setnu-number-glyph numstr))
               (setq my-setnu-start-extent e)
               e )
              (t
               ;; we must be at eob and there's no extent.
               ;; 
               ;; this is because the extent that was there
               ;; shrank to zero length and was detached.  create
               ;; a new extent that contains all text from point
               ;; to pos.
               (setq e (my-setnu-make-my-setnu-extent (point) pos))
               (setq ee (my-setnu-extent-at (1- (point)) buf))
               (my-setnu-set-extent-property e 'my-setnu-prev-extent ee)
               (my-setnu-set-extent-property ee 'my-setnu-next-extent e)
               (setq numstr
                     (format my-setnu-line-number-format
                             (1+ (string-to-int
                                  (my-setnu-extent-property ee 'line-number)))))
               (my-setnu-set-extent-property e 'line-number numstr)
               (my-setnu-set-extent-begin-glyph e (my-setnu-number-glyph numstr))
               e ))))))

(add-hook 'before-change-functions 'my-setnu-before-change-function)
(add-hook 'after-change-functions 'my-setnu-after-change-function)