changeset 98008:4ec5decd0683

Fix bug#360.
author Vinicius Jose Latorre <viniciusjl@ig.com.br>
date Sat, 06 Sep 2008 00:19:31 +0000
parents 883843ca3292
children acd38bba28b7
files lisp/ChangeLog lisp/whitespace.el
diffstat 2 files changed, 123 insertions(+), 94 deletions(-) [+]
line wrap: on
line diff
--- a/lisp/ChangeLog	Fri Sep 05 22:13:55 2008 +0000
+++ b/lisp/ChangeLog	Sat Sep 06 00:19:31 2008 +0000
@@ -40,6 +40,15 @@
 	in a highlighted region: indent each line in region according to
 	mode.  Supply this so it works in XEmacs and older Emacs.
 
+2008-09-05  Vinicius Jose Latorre  <viniciusjl@ig.com.br>
+
+	* whitespace.el: Fix auto-cleanup on kill prevents killing read-only
+	buffers (bug#360). New version 11.2.1.
+	(whitespace-action): New value `warn-read-only' to give a warning when
+	buffer is read-only and whitespace action is cleanup or auto-cleanup.
+	(whitespace-cleanup, whitespace-cleanup-region): Code fix.
+	(whitespace-warn-read-only): New fun.
+
 2008-09-05  Chong Yidong  <cyd@stupidchicken.com>
 
 	* international/quail.el: Require help-mode.
--- a/lisp/whitespace.el	Fri Sep 05 22:13:55 2008 +0000
+++ b/lisp/whitespace.el	Sat Sep 06 00:19:31 2008 +0000
@@ -6,7 +6,7 @@
 ;; Author: Vinicius Jose Latorre <viniciusjl@ig.com.br>
 ;; Maintainer: Vinicius Jose Latorre <viniciusjl@ig.com.br>
 ;; Keywords: data, wp
-;; Version: 11.2
+;; Version: 11.2.1
 ;; X-URL: http://www.emacswiki.org/cgi-bin/wiki/ViniciusJoseLatorre
 
 ;; This file is part of GNU Emacs.
@@ -989,6 +989,10 @@
    abort-on-bogus	abort if there is any bogus whitespace and the
 			buffer is written or killed.
 
+   warn-read-only	give a warning if `cleanup' or `auto-cleanup'
+			is included in `whitespace-action' and the
+			buffer is read-only.
+
 Any other value is treated as nil."
   :type '(choice :tag "Actions"
 		 (const :tag "None" nil)
@@ -997,7 +1001,8 @@
 			  (const :tag "Cleanup When On" cleanup)
 			  (const :tag "Report On Bogus" report-on-bogus)
 			  (const :tag "Auto Cleanup" auto-cleanup)
-			  (const :tag "Abort On Bogus" abort-on-bogus))))
+			  (const :tag "Abort On Bogus" abort-on-bogus)
+			  (const :tag "Warn Read-Only" warn-read-only))))
   :group 'whitespace)
 
 
@@ -1428,18 +1433,23 @@
 
 See `whitespace-style', `indent-tabs-mode' and `tab-width' for
 documentation."
-  (interactive "@*")
-  (if (and (or transient-mark-mode
-	       current-prefix-arg)
-	   mark-active)
-      ;; region active
-      ;; PROBLEMs 1 and 2 are not handled in region
-      ;; PROBLEM 3: 8 or more SPACEs at bol
-      ;; PROBLEM 4: SPACEs before TAB
-      ;; PROBLEM 5: SPACEs or TABs at eol
-      ;; PROBLEM 6: 8 or more SPACEs after TAB
-      (whitespace-cleanup-region (region-beginning) (region-end))
-    ;; whole buffer
+  (interactive "@")
+  (cond
+   ;; read-only buffer
+   (buffer-read-only
+    (whitespace-warn-read-only "cleanup"))
+   ;; region active
+   ((and (or transient-mark-mode
+	     current-prefix-arg)
+	 mark-active)
+    ;; PROBLEMs 1 and 2 are not handled in region
+    ;; PROBLEM 3: 8 or more SPACEs at bol
+    ;; PROBLEM 4: SPACEs before TAB
+    ;; PROBLEM 5: SPACEs or TABs at eol
+    ;; PROBLEM 6: 8 or more SPACEs after TAB
+    (whitespace-cleanup-region (region-beginning) (region-end)))
+   ;; whole buffer
+   (t
     (save-excursion
       (save-match-data
 	;; PROBLEM 1: empty lines at bob
@@ -1458,7 +1468,7 @@
     ;; PROBLEM 4: SPACEs before TAB
     ;; PROBLEM 5: SPACEs or TABs at eol
     ;; PROBLEM 6: 8 or more SPACEs after TAB
-    (whitespace-cleanup-region (point-min) (point-max))))
+    (whitespace-cleanup-region (point-min) (point-max)))))
 
 
 ;;;###autoload
@@ -1501,85 +1511,89 @@
 
 See `whitespace-style', `indent-tabs-mode' and `tab-width' for
 documentation."
-  (interactive "@*r")
-  (let ((rstart           (min start end))
-	(rend             (copy-marker (max start end)))
-	(indent-tabs-mode whitespace-indent-tabs-mode)
-	(tab-width        whitespace-tab-width)
-	overwrite-mode			; enforce no overwrite
-	tmp)
-    (save-excursion
-      (save-match-data
-	;; PROBLEM 1: 8 or more SPACEs at bol
-	(cond
-	 ;; ACTION: replace 8 or more SPACEs at bol by TABs, if
-	 ;; `indent-tabs-mode' is non-nil; otherwise, replace TABs by
-	 ;; SPACEs.
-	 ((memq 'indentation whitespace-style)
-	  (let ((regexp (whitespace-indentation-regexp)))
-	    (goto-char rstart)
-	    (while (re-search-forward regexp rend t)
-	      (setq tmp (current-indentation))
-	      (goto-char (match-beginning 0))
-	      (delete-horizontal-space)
-	      (unless (eolp)
-		(indent-to tmp)))))
-	 ;; ACTION: replace 8 or more SPACEs at bol by TABs.
-	 ((memq 'indentation::tab whitespace-style)
-	  (whitespace-replace-action
-	   'tabify rstart rend
-	   (whitespace-indentation-regexp 'tab) 0))
-	 ;; ACTION: replace TABs by SPACEs.
-	 ((memq 'indentation::space whitespace-style)
-	  (whitespace-replace-action
-	   'untabify rstart rend
-	   (whitespace-indentation-regexp 'space) 0)))
-	;; PROBLEM 3: SPACEs or TABs at eol
-	;; ACTION: remove all SPACEs or TABs at eol
-	(when (memq 'trailing whitespace-style)
-	  (whitespace-replace-action
-	   'delete-region rstart rend
-	   whitespace-trailing-regexp 1))
-	;; PROBLEM 4: 8 or more SPACEs after TAB
-	(cond
-	 ;; ACTION: replace 8 or more SPACEs by TABs, if
-	 ;; `indent-tabs-mode' is non-nil; otherwise, replace TABs by
-	 ;; SPACEs.
-	 ((memq 'space-after-tab whitespace-style)
-	  (whitespace-replace-action
-	   (if whitespace-indent-tabs-mode 'tabify 'untabify)
-	   rstart rend (whitespace-space-after-tab-regexp) 1))
-	 ;; ACTION: replace 8 or more SPACEs by TABs.
-	 ((memq 'space-after-tab::tab whitespace-style)
-	  (whitespace-replace-action
-	   'tabify rstart rend
-	   (whitespace-space-after-tab-regexp 'tab) 1))
-	 ;; ACTION: replace TABs by SPACEs.
-	 ((memq 'space-after-tab::space whitespace-style)
-	  (whitespace-replace-action
-	   'untabify rstart rend
-	   (whitespace-space-after-tab-regexp 'space) 1)))
-	;; PROBLEM 2: SPACEs before TAB
-	(cond
-	 ;; ACTION: replace SPACEs before TAB by TABs, if
-	 ;; `indent-tabs-mode' is non-nil; otherwise, replace TABs by
-	 ;; SPACEs.
-	 ((memq 'space-before-tab whitespace-style)
-	  (whitespace-replace-action
-	   (if whitespace-indent-tabs-mode 'tabify 'untabify)
-	   rstart rend whitespace-space-before-tab-regexp
-	   (if whitespace-indent-tabs-mode 1 2)))
-	 ;; ACTION: replace SPACEs before TAB by TABs.
-	 ((memq 'space-before-tab::tab whitespace-style)
-	  (whitespace-replace-action
-	   'tabify rstart rend
-	   whitespace-space-before-tab-regexp 1))
-	 ;; ACTION: replace TABs by SPACEs.
-	 ((memq 'space-before-tab::space whitespace-style)
-	  (whitespace-replace-action
-	   'untabify rstart rend
-	   whitespace-space-before-tab-regexp 2)))))
-    (set-marker rend nil)))		; point marker to nowhere
+  (interactive "@r")
+  (if buffer-read-only
+      ;; read-only buffer
+      (whitespace-warn-read-only "cleanup region")
+    ;; non-read-only buffer
+    (let ((rstart           (min start end))
+	  (rend             (copy-marker (max start end)))
+	  (indent-tabs-mode whitespace-indent-tabs-mode)
+	  (tab-width        whitespace-tab-width)
+	  overwrite-mode		; enforce no overwrite
+	  tmp)
+      (save-excursion
+	(save-match-data
+	  ;; PROBLEM 1: 8 or more SPACEs at bol
+	  (cond
+	   ;; ACTION: replace 8 or more SPACEs at bol by TABs, if
+	   ;; `indent-tabs-mode' is non-nil; otherwise, replace TABs
+	   ;; by SPACEs.
+	   ((memq 'indentation whitespace-style)
+	    (let ((regexp (whitespace-indentation-regexp)))
+	      (goto-char rstart)
+	      (while (re-search-forward regexp rend t)
+		(setq tmp (current-indentation))
+		(goto-char (match-beginning 0))
+		(delete-horizontal-space)
+		(unless (eolp)
+		  (indent-to tmp)))))
+	   ;; ACTION: replace 8 or more SPACEs at bol by TABs.
+	   ((memq 'indentation::tab whitespace-style)
+	    (whitespace-replace-action
+	     'tabify rstart rend
+	     (whitespace-indentation-regexp 'tab) 0))
+	   ;; ACTION: replace TABs by SPACEs.
+	   ((memq 'indentation::space whitespace-style)
+	    (whitespace-replace-action
+	     'untabify rstart rend
+	     (whitespace-indentation-regexp 'space) 0)))
+	  ;; PROBLEM 3: SPACEs or TABs at eol
+	  ;; ACTION: remove all SPACEs or TABs at eol
+	  (when (memq 'trailing whitespace-style)
+	    (whitespace-replace-action
+	     'delete-region rstart rend
+	     whitespace-trailing-regexp 1))
+	  ;; PROBLEM 4: 8 or more SPACEs after TAB
+	  (cond
+	   ;; ACTION: replace 8 or more SPACEs by TABs, if
+	   ;; `indent-tabs-mode' is non-nil; otherwise, replace TABs
+	   ;; by SPACEs.
+	   ((memq 'space-after-tab whitespace-style)
+	    (whitespace-replace-action
+	     (if whitespace-indent-tabs-mode 'tabify 'untabify)
+	     rstart rend (whitespace-space-after-tab-regexp) 1))
+	   ;; ACTION: replace 8 or more SPACEs by TABs.
+	   ((memq 'space-after-tab::tab whitespace-style)
+	    (whitespace-replace-action
+	     'tabify rstart rend
+	     (whitespace-space-after-tab-regexp 'tab) 1))
+	   ;; ACTION: replace TABs by SPACEs.
+	   ((memq 'space-after-tab::space whitespace-style)
+	    (whitespace-replace-action
+	     'untabify rstart rend
+	     (whitespace-space-after-tab-regexp 'space) 1)))
+	  ;; PROBLEM 2: SPACEs before TAB
+	  (cond
+	   ;; ACTION: replace SPACEs before TAB by TABs, if
+	   ;; `indent-tabs-mode' is non-nil; otherwise, replace TABs
+	   ;; by SPACEs.
+	   ((memq 'space-before-tab whitespace-style)
+	    (whitespace-replace-action
+	     (if whitespace-indent-tabs-mode 'tabify 'untabify)
+	     rstart rend whitespace-space-before-tab-regexp
+	     (if whitespace-indent-tabs-mode 1 2)))
+	   ;; ACTION: replace SPACEs before TAB by TABs.
+	   ((memq 'space-before-tab::tab whitespace-style)
+	    (whitespace-replace-action
+	     'tabify rstart rend
+	     whitespace-space-before-tab-regexp 1))
+	   ;; ACTION: replace TABs by SPACEs.
+	   ((memq 'space-before-tab::space whitespace-style)
+	    (whitespace-replace-action
+	     'untabify rstart rend
+	     whitespace-space-before-tab-regexp 2)))))
+      (set-marker rend nil))))		; point marker to nowhere
 
 
 (defun whitespace-replace-action (action rstart rend regexp index)
@@ -2404,6 +2418,12 @@
 	(t
 	 nil)))
 
+
+(defun whitespace-warn-read-only (msg)
+  "Warn if buffer is read-only."
+  (when (memq 'warn-read-only whitespace-action)
+    (message "Can't %s: %s is read-only" msg (buffer-name))))
+
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;