From mboxrd@z Thu Jan 1 00:00:00 1970 Path: news.gmane.org!not-for-mail From: "Drew Adams" Newsgroups: gmane.emacs.devel Subject: [patch] minor patch for register.el Date: Tue, 19 Feb 2013 15:18:08 -0800 Message-ID: NNTP-Posting-Host: plane.gmane.org Mime-Version: 1.0 Content-Type: multipart/mixed; boundary="----=_NextPart_000_00F4_01CE0EB4.53682780" X-Trace: ger.gmane.org 1361315909 4042 80.91.229.3 (19 Feb 2013 23:18:29 GMT) X-Complaints-To: usenet@ger.gmane.org NNTP-Posting-Date: Tue, 19 Feb 2013 23:18:29 +0000 (UTC) To: Original-X-From: emacs-devel-bounces+ged-emacs-devel=m.gmane.org@gnu.org Wed Feb 20 00:18:50 2013 Return-path: Envelope-to: ged-emacs-devel@m.gmane.org Original-Received: from lists.gnu.org ([208.118.235.17]) by plane.gmane.org with esmtp (Exim 4.69) (envelope-from ) id 1U7wSX-00035f-JQ for ged-emacs-devel@m.gmane.org; Wed, 20 Feb 2013 00:18:50 +0100 Original-Received: from localhost ([::1]:57659 helo=lists.gnu.org) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1U7wSC-00048T-Or for ged-emacs-devel@m.gmane.org; Tue, 19 Feb 2013 18:18:28 -0500 Original-Received: from eggs.gnu.org ([208.118.235.92]:40708) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1U7wS9-00048K-LX for emacs-devel@gnu.org; Tue, 19 Feb 2013 18:18:26 -0500 Original-Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1U7wS5-0001JL-Pk for emacs-devel@gnu.org; Tue, 19 Feb 2013 18:18:25 -0500 Original-Received: from userp1040.oracle.com ([156.151.31.81]:26433) by eggs.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1U7wS5-0001IG-Fm for emacs-devel@gnu.org; Tue, 19 Feb 2013 18:18:21 -0500 Original-Received: from acsinet21.oracle.com (acsinet21.oracle.com [141.146.126.237]) by userp1040.oracle.com (Sentrion-MTA-4.3.1/Sentrion-MTA-4.3.1) with ESMTP id r1JNIEU1007508 (version=TLSv1/SSLv3 cipher=DHE-RSA-AES256-SHA bits=256 verify=OK) for ; Tue, 19 Feb 2013 23:18:15 GMT Original-Received: from acsmt358.oracle.com (acsmt358.oracle.com [141.146.40.158]) by acsinet21.oracle.com (8.14.4+Sun/8.14.4) with ESMTP id r1JNIDeH009024 (version=TLSv1/SSLv3 cipher=DHE-RSA-AES256-SHA bits=256 verify=NO) for ; Tue, 19 Feb 2013 23:18:14 GMT Original-Received: from abhmt109.oracle.com (abhmt109.oracle.com [141.146.116.61]) by acsmt358.oracle.com (8.12.11.20060308/8.12.11) with ESMTP id r1JNIDSm031775 for ; Tue, 19 Feb 2013 17:18:13 -0600 Original-Received: from dradamslap1 (/10.159.138.144) by default (Oracle Beehive Gateway v4.0) with ESMTP ; Tue, 19 Feb 2013 15:18:12 -0800 X-Mailer: Microsoft Office Outlook 11 Thread-Index: Ac4O92ENDFd7+lDwRdOP30KiSMgQ+A== X-MimeOLE: Produced By Microsoft MimeOLE V6.00.2900.6157 X-Source-IP: acsinet21.oracle.com [141.146.126.237] X-detected-operating-system: by eggs.gnu.org: GNU/Linux 2.4.x-2.6.x [generic] X-Received-From: 156.151.31.81 X-BeenThere: emacs-devel@gnu.org X-Mailman-Version: 2.1.14 Precedence: list List-Id: "Emacs development discussions." List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: emacs-devel-bounces+ged-emacs-devel=m.gmane.org@gnu.org Original-Sender: emacs-devel-bounces+ged-emacs-devel=m.gmane.org@gnu.org Xref: news.gmane.org gmane.emacs.devel:157174 Archived-At: This is a multi-part message in MIME format. ------=_NextPart_000_00F4_01CE0EB4.53682780 Content-Type: text/plain; charset="US-ASCII" Content-Transfer-Encoding: 7bit If the attached patch is OK I will send a change log entry. The patch does this: 1. Adds functions `register-insertable-p', `register-jumpable-p', and `register-printable-p'. 2. In `jump-to-register': . Use `register-jumpable-p'. . Raise error if no such register or cannot jump to it. 3. In `view-register': Raise error if no such register. 4. In `list-registers': Raise error if `register-alist' is empty. 5. In `describe-register-1': . Use `register-printable-p'. . Wrap names with `...'. 6. In `insert-register': . Use `register-insertable-p'. . Raise error if no such register or cannot insert contents. 7. In `append-to-register' and `prepend-to-register': Name the register in error msg. ------=_NextPart_000_00F4_01CE0EB4.53682780 Content-Type: application/octet-stream; name="register-2013-02-19.patch" Content-Transfer-Encoding: quoted-printable Content-Disposition: attachment; filename="register-2013-02-19.patch" diff -c -w register.el register-patched-2013-02-19.el=0A= *** register.el Tue Feb 19 10:40:22 2013=0A= --- register-patched-2013-02-19.el Tue Feb 19 15:04:08 2013=0A= ***************=0A= *** 83,90 ****=0A= :version "24.3")=0A= =0A= (defcustom register-separator nil=0A= ! "Register containing the text to put between collected texts, or nil = if none.=0A= ! =0A= When collecting text with=0A= `append-to-register' (resp. `prepend-to-register') contents of=0A= this register is added to the beginning (resp. end) of the marked=0A= --- 83,89 ----=0A= :version "24.3")=0A= =0A= (defcustom register-separator nil=0A= ! "Register containing text to put between collected texts, or nil if = none.=0A= When collecting text with=0A= `append-to-register' (resp. `prepend-to-register') contents of=0A= this register is added to the beginning (resp. end) of the marked=0A= ***************=0A= *** 106,111 ****=0A= --- 105,157 ----=0A= (push (cons register value) register-alist))=0A= value))=0A= =0A= + (defun register-insertable-p (register)=0A= + "Return non-nil if the value of REGISTER can be inserted.=0A= + That is, whether it can be passed to `insert-register' without raising=0A= + an error."=0A= + (let ((val (get-register register)))=0A= + (or (and (registerv-p val) (registerv-insert-func val))=0A= + (consp val)=0A= + (stringp val)=0A= + (numberp val)=0A= + (and (markerp val) (marker-position val))=0A= + (and (fboundp 'semantic-foreign-tag-p)=0A= + semantic-mode=0A= + (semantic-foreign-tag-p val)))))=0A= + =0A= + (defun register-jumpable-p (register &optional msgp)=0A= + "Return non-nil if the value of REGISTER can be jumped to.=0A= + That is, whether it can be passed to `jump-to-register' without=0A= + raising an error.=0A= + =0A= + Non-nil optional arg MSGP means the function can query the user=0A= + whether to revisit a file whose buffer no longer exists."=0A= + (let ((val (get-register register)))=0A= + (or (and (registerv-p val) (registerv-jump-func val))=0A= + (and (consp val)=0A= + (or (frame-configuration-p (car val))=0A= + (window-configuration-p (car val))=0A= + (eq (car val) 'file)=0A= + (and (eq (car val) 'file-query)=0A= + (or (find-buffer-visiting (nth 1 val))=0A= + (and msgp=0A= + (y-or-n-p (format "Visit file `%s' = again? "=0A= + (nth 1 val))))))))=0A= + (and (markerp val) (marker-buffer val))=0A= + (and (fboundp 'semantic-foreign-tag-p)=0A= + semantic-mode=0A= + (semantic-foreign-tag-p val)))))=0A= + =0A= + (defun register-printable-p (register)=0A= + "Return non-nil if the value of REGISTER can be printed.=0A= + That is, whether the value is a recognized register value."=0A= + (let ((val (get-register register)))=0A= + (or (and (registerv-p val) (registerv-print-func val))=0A= + (consp val) ; Includes rectangle.=0A= + (numberp val)=0A= + (markerp val)=0A= + (stringp val))))=0A= + =0A= (defun point-to-register (register &optional arg)=0A= "Store current location of point in register REGISTER.=0A= With prefix argument, store current frame configuration.=0A= ***************=0A= *** 148,159 ****=0A= delete any existing frames that the frame configuration doesn't = mention.=0A= \(Otherwise, these frames are iconified.)"=0A= (interactive "cJump to register: \nP")=0A= (let ((val (get-register register)))=0A= ! (cond=0A= ! ((registerv-p val)=0A= ! (cl-assert (registerv-jump-func val) nil=0A= ! "Don't know how to jump to register %s"=0A= ! (single-key-description register))=0A= (funcall (registerv-jump-func val) (registerv-data val)))=0A= ((and (consp val) (frame-configuration-p (car val)))=0A= (set-frame-configuration (car val) (not delete))=0A= --- 194,205 ----=0A= delete any existing frames that the frame configuration doesn't = mention.=0A= \(Otherwise, these frames are iconified.)"=0A= (interactive "cJump to register: \nP")=0A= + (unless (get-register register)=0A= + (error "No such register: `%s'" (single-key-description register)))=0A= + (unless (register-jumpable-p register (called-interactively-p = 'interactive))=0A= + (error "Cannot jump to register `%s'" (single-key-description = register)))=0A= (let ((val (get-register register)))=0A= ! (cond ((registerv-p val)=0A= (funcall (registerv-jump-func val) (registerv-data val)))=0A= ((and (consp val) (frame-configuration-p (car val)))=0A= (set-frame-configuration (car val) (not delete))=0A= ***************=0A= *** 234,264 ****=0A= (interactive "cView register: ")=0A= (let ((val (get-register register)))=0A= (if (null val)=0A= ! (message "Register %s is empty" (single-key-description register))=0A= (with-output-to-temp-buffer "*Output*"=0A= (describe-register-1 register t)))))=0A= =0A= (defun list-registers ()=0A= "Display a list of nonempty registers saying briefly what they = contain."=0A= (interactive)=0A= (let ((list (copy-sequence register-alist)))=0A= (setq list (sort list (lambda (a b) (< (car a) (car b)))))=0A= (with-output-to-temp-buffer "*Output*"=0A= (dolist (elt list)=0A= (when (get-register (car elt))=0A= (describe-register-1 (car elt))=0A= ! (terpri))))))=0A= =0A= (defun describe-register-1 (register &optional verbose)=0A= - (princ "Register ")=0A= - (princ (single-key-description register))=0A= - (princ " contains ")=0A= (let ((val (get-register register)))=0A= ! (cond=0A= ((registerv-p val)=0A= ! (if (registerv-print-func val)=0A= ! (funcall (registerv-print-func val) (registerv-data val))=0A= ! (princ "[UNPRINTABLE CONTENTS].")))=0A= =0A= ((numberp val)=0A= (princ val))=0A= --- 280,314 ----=0A= (interactive "cView register: ")=0A= (let ((val (get-register register)))=0A= (if (null val)=0A= ! (error "No such register: `%s'" (single-key-description = register))=0A= (with-output-to-temp-buffer "*Output*"=0A= (describe-register-1 register t)))))=0A= =0A= (defun list-registers ()=0A= "Display a list of nonempty registers saying briefly what they = contain."=0A= (interactive)=0A= + (if (null register-alist)=0A= + (error "No registers to describe")=0A= (let ((list (copy-sequence register-alist)))=0A= (setq list (sort list (lambda (a b) (< (car a) (car b)))))=0A= (with-output-to-temp-buffer "*Output*"=0A= (dolist (elt list)=0A= (when (get-register (car elt))=0A= (describe-register-1 (car elt))=0A= ! (terpri)))))))=0A= =0A= (defun describe-register-1 (register &optional verbose)=0A= (let ((val (get-register register)))=0A= ! (princ "Register `")=0A= ! (princ (single-key-description register))=0A= ! (princ "' contains ")=0A= ! (cond ((not (register-printable-p register))=0A= ! (if verbose=0A= ! (format "garbage (?):\n%S" val))=0A= ! "unprintable contents.")=0A= ! =0A= ((registerv-p val)=0A= ! (funcall (registerv-print-func val) (registerv-data val)))=0A= =0A= ((numberp val)=0A= (princ val))=0A= ***************=0A= *** 266,275 ****=0A= ((markerp val)=0A= (let ((buf (marker-buffer val)))=0A= (if (null buf)=0A= ! (princ "a marker in no buffer")=0A= ! (princ "a buffer position:\n buffer ")=0A= (princ (buffer-name buf))=0A= ! (princ ", position ")=0A= (princ (marker-position val)))))=0A= =0A= ((and (consp val) (window-configuration-p (car val)))=0A= --- 316,325 ----=0A= ((markerp val)=0A= (let ((buf (marker-buffer val)))=0A= (if (null buf)=0A= ! (princ "a marker in no buffer.")=0A= ! (princ "a buffer position:\n buffer `")=0A= (princ (buffer-name buf))=0A= ! (princ "', position ")=0A= (princ (marker-position val)))))=0A= =0A= ((and (consp val) (window-configuration-p (car val)))=0A= ***************=0A= *** 279,292 ****=0A= (princ "a frame configuration."))=0A= =0A= ((and (consp val) (eq (car val) 'file))=0A= ! (princ "the file ")=0A= (prin1 (cdr val))=0A= ! (princ "."))=0A= =0A= ((and (consp val) (eq (car val) 'file-query))=0A= ! (princ "a file-query reference:\n file ")=0A= (prin1 (car (cdr val)))=0A= ! (princ ",\n position ")=0A= (princ (car (cdr (cdr val))))=0A= (princ "."))=0A= =0A= --- 329,342 ----=0A= (princ "a frame configuration."))=0A= =0A= ((and (consp val) (eq (car val) 'file))=0A= ! (princ "the file `")=0A= (prin1 (cdr val))=0A= ! (princ "'."))=0A= =0A= ((and (consp val) (eq (car val) 'file-query))=0A= ! (princ "a file-query reference:\n file `")=0A= (prin1 (car (cdr val)))=0A= ! (princ "',\n position ")=0A= (princ (car (cdr (cdr val))))=0A= (princ "."))=0A= =0A= ***************=0A= *** 312,320 ****=0A= (princ "the text:\n")=0A= (princ val))=0A= (cond=0A= ! ;; Extract first N characters starting with first non-whitespace.=0A= ((string-match (format "[^ \t\n].\\{,%d\\}"=0A= ! ;; Deduct 6 for the spaces inserted below.=0A= (min 20 (max 0 (- (window-width) 6))))=0A= val)=0A= (princ "text starting with\n ")=0A= --- 362,370 ----=0A= (princ "the text:\n")=0A= (princ val))=0A= (cond=0A= ! ;; Extract first N chars, starting with first = non-whitespace.=0A= ((string-match (format "[^ \t\n].\\{,%d\\}"=0A= ! ;; Deduct 6 for spaces inserted = below.=0A= (min 20 (max 0 (- (window-width) = 6))))=0A= val)=0A= (princ "text starting with\n ")=0A= ***************=0A= *** 322,331 ****=0A= ((string-match "^[ \t\n]+$" val)=0A= (princ "whitespace"))=0A= (t=0A= ! (princ "the empty string")))))=0A= ! (t=0A= ! (princ "Garbage:\n")=0A= ! (if verbose (prin1 val))))))=0A= =0A= (defun insert-register (register &optional arg)=0A= "Insert contents of register REGISTER. (REGISTER is a character.)=0A= --- 372,378 ----=0A= ((string-match "^[ \t\n]+$" val)=0A= (princ "whitespace"))=0A= (t=0A= ! (princ "the empty string"))))))))=0A= =0A= (defun insert-register (register &optional arg)=0A= "Insert contents of register REGISTER. (REGISTER is a character.)=0A= ***************=0A= *** 334,345 ****=0A= Interactively, second arg is non-nil if prefix arg is supplied."=0A= (interactive "*cInsert register: \nP")=0A= (push-mark)=0A= (let ((val (get-register register)))=0A= ! (cond=0A= ! ((registerv-p val)=0A= ! (cl-assert (registerv-insert-func val) nil=0A= ! "Don't know how to insert register %s"=0A= ! (single-key-description register))=0A= (funcall (registerv-insert-func val) (registerv-data val)))=0A= ((consp val)=0A= (insert-rectangle val))=0A= --- 381,393 ----=0A= Interactively, second arg is non-nil if prefix arg is supplied."=0A= (interactive "*cInsert register: \nP")=0A= (push-mark)=0A= + (unless (get-register register)=0A= + (error "No such register: `%s'" (single-key-description register)))=0A= + (unless (register-insertable-p register)=0A= + (error "Cannot insert the contents of register `%s'"=0A= + (single-key-description register)))=0A= (let ((val (get-register register)))=0A= ! (cond ((registerv-p val)=0A= (funcall (registerv-insert-func val) (registerv-data val)))=0A= ((consp val)=0A= (insert-rectangle val))=0A= ***************=0A= *** 352,361 ****=0A= ((and (fboundp 'semantic-foreign-tag-p)=0A= semantic-mode=0A= (semantic-foreign-tag-p val))=0A= ! (semantic-insert-foreign-tag val))=0A= ! (t=0A= ! (error "Register does not contain text"))))=0A= ! (if (not arg) (exchange-point-and-mark)))=0A= =0A= (defun copy-to-register (register start end &optional delete-flag)=0A= "Copy region into register REGISTER.=0A= --- 400,407 ----=0A= ((and (fboundp 'semantic-foreign-tag-p)=0A= semantic-mode=0A= (semantic-foreign-tag-p val))=0A= ! (semantic-insert-foreign-tag val))))=0A= ! (unless arg (exchange-point-and-mark)))=0A= =0A= (defun copy-to-register (register start end &optional delete-flag)=0A= "Copy region into register REGISTER.=0A= ***************=0A= *** 382,388 ****=0A= (set-register=0A= register (cond ((not reg) text)=0A= ((stringp reg) (concat reg separator text))=0A= ! (t (error "Register does not contain text")))))=0A= (setq deactivate-mark t)=0A= (cond (delete-flag=0A= (delete-region start end))=0A= --- 428,435 ----=0A= (set-register=0A= register (cond ((not reg) text)=0A= ((stringp reg) (concat reg separator text))=0A= ! (t (error "Register `%s' does not contain text"=0A= ! (single-key-description register))))))=0A= (setq deactivate-mark t)=0A= (cond (delete-flag=0A= (delete-region start end))=0A= ***************=0A= *** 401,407 ****=0A= (set-register=0A= register (cond ((not reg) text)=0A= ((stringp reg) (concat text separator reg))=0A= ! (t (error "Register does not contain text")))))=0A= (setq deactivate-mark t)=0A= (cond (delete-flag=0A= (delete-region start end))=0A= --- 448,455 ----=0A= (set-register=0A= register (cond ((not reg) text)=0A= ((stringp reg) (concat text separator reg))=0A= ! (t (error "Register `%s' does not contain text"=0A= ! (single-key-description register))))))=0A= (setq deactivate-mark t)=0A= (cond (delete-flag=0A= (delete-region start end))=0A= =0A= Diff finished. Tue Feb 19 15:05:49 2013=0A= ------=_NextPart_000_00F4_01CE0EB4.53682780--