From mboxrd@z Thu Jan 1 00:00:00 1970 Path: main.gmane.org!not-for-mail From: Masatake YAMATO Newsgroups: gmane.emacs.devel Subject: Re: Using overlay in register Date: Sun, 21 Mar 2004 23:03:22 +0900 (JST) Sender: emacs-devel-bounces+emacs-devel=quimby.gnus.org@gnu.org Message-ID: <20040321.230322.85700391.jet@gyve.org> References: <20040318.193346.21592706.jet@gyve.org> NNTP-Posting-Host: deer.gmane.org Mime-Version: 1.0 Content-Type: Text/Plain; charset=us-ascii Content-Transfer-Encoding: 7bit X-Trace: sea.gmane.org 1079877922 10840 80.91.224.253 (21 Mar 2004 14:05:22 GMT) X-Complaints-To: usenet@sea.gmane.org NNTP-Posting-Date: Sun, 21 Mar 2004 14:05:22 +0000 (UTC) Cc: emacs-devel@gnu.org Original-X-From: emacs-devel-bounces+emacs-devel=quimby.gnus.org@gnu.org Sun Mar 21 15:05:10 2004 Return-path: Original-Received: from quimby.gnus.org ([80.91.224.244]) by deer.gmane.org with esmtp (Exim 3.35 #1 (Debian)) id 1B53Ze-0006Su-00 for ; Sun, 21 Mar 2004 15:05:10 +0100 Original-Received: from monty-python.gnu.org ([199.232.76.173]) by quimby.gnus.org with esmtp (Exim 3.35 #1 (Debian)) id 1B53Ze-0005tp-00 for ; Sun, 21 Mar 2004 15:05:10 +0100 Original-Received: from localhost ([127.0.0.1] helo=monty-python.gnu.org) by monty-python.gnu.org with esmtp (Exim 4.30) id 1B53Z9-0008Lv-DV for emacs-devel@quimby.gnus.org; Sun, 21 Mar 2004 09:04:39 -0500 Original-Received: from list by monty-python.gnu.org with tmda-scanned (Exim 4.30) id 1B53Yd-0008JK-Qw for emacs-devel@gnu.org; Sun, 21 Mar 2004 09:04:07 -0500 Original-Received: from mail by monty-python.gnu.org with spam-scanned (Exim 4.30) id 1B53Y7-0008H0-9j for emacs-devel@gnu.org; Sun, 21 Mar 2004 09:04:06 -0500 Original-Received: from [210.130.136.40] (helo=r-maa.spacetown.ne.jp) by monty-python.gnu.org with esmtp (Exim 4.30) id 1B53Xw-0008Fd-Dx; Sun, 21 Mar 2004 09:03:24 -0500 Original-Received: from localhost (h220-215-187-110.catv01.itscom.jp [220.215.187.110]) by r-maa.spacetown.ne.jp (8.11.6) with ESMTP id i2LE3H721417; Sun, 21 Mar 2004 23:03:18 +0900 (JST) Original-To: rms@gnu.org In-Reply-To: X-Mailer: Mew version 4.0.62 on Emacs 21.3.50 / Mule 5.0 (SAKAKI) X-BeenThere: emacs-devel@gnu.org X-Mailman-Version: 2.1.4 Precedence: list List-Id: "Emacs development discussions." List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: emacs-devel-bounces+emacs-devel=quimby.gnus.org@gnu.org Xref: main.gmane.org gmane.emacs.devel:20680 X-Report-Spam: http://spam.gmane.org/gmane.emacs.devel:20680 > This is a very good idea. Thanks for working on it. > > I see a possible bug here: > > +(defun register-put-overlay-at-point (register) > + "Put a overlay associated with REGISTER at the point." > + (let ((overlay (make-overlay (point) > + (1+ (point)) > + (current-buffer) > > This will get an error at the end of the buffer. > > What should it do at the end? Make an empty overlay? > It could have a before-string, perhaps. Thank you for reviwing and suggestion. I have used after-string. If the point is at the end of line, set a space to an overlay's 'after-string property. I have added an function: With mouse-3 on an overlay(or after-string " "), you can clear the overlay. > What should it do at the end? Make an empty overlay? > It could have a before-string, perhaps. > > +(defun register-get-overlay-position (overlay) > + "Get the position for OVERLAY." > + (min (overlay-start overlay) (overlay-end overlay))) > > What's the purpose of using min here? > Why not just use overlay-start? > (In some places you did so.) I have seen emacs's strange behaviors twice; Emacs returned an overlay whose start is greater than its end. I cannot find the way to reproduce it. (overlay-start overlay) < (overlay-end overlay) is guaranteed? Masatake YAMATO Index: lisp/register.el =================================================================== RCS file: /cvsroot/emacs/emacs/lisp/register.el,v retrieving revision 1.48 diff -u -r1.48 register.el --- lisp/register.el 16 Mar 2004 09:52:36 -0000 1.48 +++ lisp/register.el 21 Mar 2004 13:44:58 -0000 @@ -31,9 +31,20 @@ ;;; Code: +(defgroup register () + "register commands for Emacs." + :group 'editing + :prefix "register-") + +(defface register-point + '((((class color)) (:box "blue")) + (t (:underline t))) + "Face for the overlay associated with register." + :group 'register) + (defvar register-alist nil "Alist of elements (NAME . CONTENTS), one for each Emacs register. -NAME is a character (a number). CONTENTS is a string, number, marker or list. +NAME is a character (a number). CONTENTS is a string, number, overlay or list. A list of strings represents a rectangle. A list of the form (file . NAME) represents the file named NAME. A list of the form (file-query NAME POSITION) represents position POSITION @@ -50,23 +61,80 @@ (defun set-register (register value) "Set contents of Emacs register named REGISTER to VALUE. Returns VALUE. See the documentation of the variable `register-alist' for possible VALUE." + ;; If the old value is overlay, delete it first. + (let ((overlay (get-register register))) + (if (overlayp overlay) + (delete-overlay overlay))) (let ((aelt (assq register register-alist))) (if aelt (setcdr aelt value) (push (cons register value) register-alist)) value)) +(defun register-clear-register (register) + (interactive "cClear register: ") + (set-register register nil)) + +(defun register-clear-overlay-at-point (event) + "Clear the register associated with an overlay pointed by EVENT." + (interactive "e") + (save-excursion + (mouse-set-point event) + (let ((overlays (overlays-in (point) + (+ (point) (if (eolp) 0 1)))) + o + r) + ;; Search 'register property from the all overlays. + (while (and overlays (null r)) + (setq o (car overlays) + r (overlay-get o 'register) + overlays (cdr overlays)) + (when r + (register-clear-register r))) + (unless r + (error "No overlay for register at this point."))))) + +(defun register-put-overlay-at-point (register) + "Put a overlay associated with REGISTER at the point." + (let* ((help (format "Register: %s\nType \"%s %s\" to jump here.\nMouse-3 to clear this register." + (single-key-description register) + (substitute-command-keys "\\[jump-to-register]") + (single-key-description register))) + (overlay (make-overlay (point) + (+ (point) (if (eolp) 0 1)) + (current-buffer) + t)) + (keymap '(keymap (mouse-3 . register-clear-overlay-at-point)))) + (overlay-put overlay 'register register) + (if (eolp) + ;; Zero length overlay with " ". + (overlay-put overlay 'after-string + (propertize " " + 'face 'register-point + 'help-echo help + 'mouse-face 'highlight + 'keymap keymap)) + (overlay-put overlay 'face 'register-point) + (overlay-put overlay 'help-echo help) + (overlay-put overlay 'mouse-face 'highlight) + (overlay-put overlay 'keymap keymap)) + overlay)) + +(defun register-get-overlay-position (overlay) + "Get the position for OVERLAY." + (min (overlay-start overlay) (overlay-end overlay))) + (defun point-to-register (register &optional arg) "Store current location of point in register REGISTER. With prefix argument, store current frame configuration. Use \\[jump-to-register] to go to that location or restore that configuration. Argument is a character, naming the register." (interactive "cPoint to register: \nP") - ;; Turn the marker into a file-ref if the buffer is killed. + ;; Turn the overlay into a file-ref if the buffer is killed. (add-hook 'kill-buffer-hook 'register-swap-out nil t) (set-register register (if arg (list (current-frame-configuration) (point-marker)) - (point-marker)))) + (register-put-overlay-at-point register)))) (defun window-configuration-to-register (register &optional arg) "Store the window configuration of the selected frame in register REGISTER. @@ -106,11 +174,11 @@ ((and (consp val) (window-configuration-p (car val))) (set-window-configuration (car val)) (goto-char (cadr val))) - ((markerp val) - (or (marker-buffer val) + ((overlayp val) + (or (overlay-buffer val) (error "That register's buffer no longer exists")) - (switch-to-buffer (marker-buffer val)) - (goto-char val)) + (switch-to-buffer (overlay-buffer val)) + (goto-char (register-get-overlay-position val))) ((and (consp val) (eq (car val) 'file)) (find-file (cdr val))) ((and (consp val) (eq (car val) 'file-query)) @@ -123,15 +191,15 @@ (error "Register doesn't contain a buffer position or configuration"))))) (defun register-swap-out () - "Turn markers into file-query references when a buffer is killed." + "Turn overlays into file-query references when a buffer is killed." (and buffer-file-name (dolist (elem register-alist) - (and (markerp (cdr elem)) - (eq (marker-buffer (cdr elem)) (current-buffer)) + (and (overlayp (cdr elem)) + (eq (overlay-buffer (cdr elem)) (current-buffer)) (setcdr elem (list 'file-query buffer-file-name - (marker-position (cdr elem)))))))) + (overlay-start (cdr elem)))))))) (defun number-to-register (number register) "Store a number in a register. @@ -187,14 +255,14 @@ ((numberp val) (princ val)) - ((markerp val) - (let ((buf (marker-buffer val))) + ((overlayp val) + (let ((buf (overlay-buffer val))) (if (null buf) - (princ "a marker in no buffer") + (princ "a overlay in no buffer") (princ "a buffer position:\n buffer ") (princ (buffer-name buf)) (princ ", position ") - (princ (marker-position val))))) + (princ (register-get-overlay-position val))))) ((and (consp val) (window-configuration-p (car val))) (princ "a window configuration.")) @@ -264,8 +332,8 @@ (insert-for-yank val)) ((numberp val) (princ val (current-buffer))) - ((and (markerp val) (marker-position val)) - (princ (marker-position val) (current-buffer))) + ((and (overlayp val) (overlay-start val)) + (princ (register-get-overlay-position val) (current-buffer))) (t (error "Register does not contain text")))) (if (not arg) (exchange-point-and-mark)))