🚀 go-pugleaf

cheeです。

好意でせっかくアップしていただいたものに、難癖つけるようで
気がひけてしまうのですが、WindowsのMeadow(MULE/4.1 相当)では
Undoの際に表示が崩れてしまいました。単独でyankの操作は
うまくいきました。

At Sun, 08 Oct 2000 02:59:51 +0900, Naoki Nakamura wrote >
>   初めまして.
>   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)