changeset 3162:6e11554a16aa

[xemacs-hg @ 2005-12-23 11:40:32 by stephent] Add rename function to buffer mode. <87hd902gcp.fsf@tleepslib.sk.tsukuba.ac.jp>
author stephent
date Fri, 23 Dec 2005 11:40:39 +0000
parents 78cf83b934a0
children 04a435415e1d
files lisp/ChangeLog lisp/buff-menu.el lisp/derived.el lisp/mule/mule-charset.el
diffstat 4 files changed, 94 insertions(+), 16 deletions(-) [+]
line wrap: on
line diff
--- a/lisp/ChangeLog	Fri Dec 23 11:33:39 2005 +0000
+++ b/lisp/ChangeLog	Fri Dec 23 11:40:39 2005 +0000
@@ -1,3 +1,8 @@
+2005-12-22  Stephen J. Turnbull  <stephen@xemacs.org>
+
+	* buff-menu.el (Buffer-menu-rename): New command.
+	(Buffer-menu-mode-map): Bind it to ?r.
+
 2005-12-18  Stephen J. Turnbull  <stephen@xemacs.org>
 
 	* XEmacs 21.5.24 "dandelion" is released.
--- a/lisp/buff-menu.el	Fri Dec 23 11:33:39 2005 +0000
+++ b/lisp/buff-menu.el	Fri Dec 23 11:40:39 2005 +0000
@@ -91,6 +91,7 @@
   (define-key Buffer-menu-mode-map "k" 'Buffer-menu-delete)
   (define-key Buffer-menu-mode-map "\C-d" 'Buffer-menu-delete-backwards)
   (define-key Buffer-menu-mode-map "\C-k" 'Buffer-menu-delete)
+  (define-key Buffer-menu-mode-map "r" 'Buffer-menu-rename)
   (define-key Buffer-menu-mode-map "x" 'Buffer-menu-execute)
   (define-key Buffer-menu-mode-map " " 'next-line)
   (define-key Buffer-menu-mode-map "n" 'next-line)
@@ -261,6 +262,18 @@
   (while (looking-at " [-M]")
     (forward-line 1)))
 
+(defun Buffer-menu-rename (newname unique)
+  "Rename buffer on this line to NEWNAME, immediately.
+If given a prefix argument, automatically uniquify.  See `rename-buffer'."
+  (interactive "sNew name for buffer: \np")
+  (beginning-of-line)
+  (if (looking-at " [-M]")		;header lines
+      (ding)
+    (save-excursion
+      (set-buffer (Buffer-menu-buffer t))
+      (rename-buffer newname unique))
+    (revert-buffer)))
+
 (defun Buffer-menu-save ()
   "Mark buffer on this line to be saved by \\<Buffer-menu-mode-map>\\[Buffer-menu-execute] command."
   (interactive)
--- a/lisp/derived.el	Fri Dec 23 11:33:39 2005 +0000
+++ b/lisp/derived.el	Fri Dec 23 11:40:39 2005 +0000
@@ -419,22 +419,13 @@
   ;; (set-char-table-parent new old) here.
   ;; We use map-char-table, not map-syntax-table, so we can explicitly
   ;; check for inheritance.
-  (map-char-table
-   #'(lambda (key value)
-       (let ((newval (get-range-char-table key new 'multi)))
-	 (cond ((eq newval 'multi)	; OK, dive into the class hierarchy
-		(map-char-table
-		 #'(lambda (key1 value1)
-		     (when (eq ?@ (char-syntax-from-code
-				   (get-range-char-table key new ?@)))
-		       (put-char-table key1 value new))
-		     nil)
-		 new
-		 key))
-	       ((eq ?@ (char-syntax-from-code newval)) ;; class at once
-		(put-char-table key value new))))
-       nil)
-   old))
+  (map-char-table #'(lambda (range value)
+		      (when (eq ?@ (char-syntax-from-code value))
+			(map-char-table #'(lambda (rng val)
+					    (put-char-table rng val new))
+					old
+					range)))
+		  new))
 
 ;; Merge an old abbrev table into a new one.
 ;; This function requires internal knowledge of how abbrev tables work,
--- a/lisp/mule/mule-charset.el	Fri Dec 23 11:33:39 2005 +0000
+++ b/lisp/mule/mule-charset.el	Fri Dec 23 11:40:39 2005 +0000
@@ -62,6 +62,67 @@
 	  (forward-char))))
     list))
 
+(defun fixed-charsets-in-region (start end &optional buffer)
+  "Return a list of the charsets in the region between START and END.
+BUFFER defaults to the current buffer if omitted."
+  (let (list)
+    (save-excursion
+      (if buffer
+	  (set-buffer buffer))
+      (save-restriction
+	(narrow-to-region start end)
+	(goto-char (point-min))
+	(let ((prev-charset nil))
+	  (while (not (eobp))
+	    (let* ((charset (char-charset (char-after (point)))))
+	      (if (not (eq prev-charset charset))
+		  (progn
+		    (setq prev-charset charset)
+		    (or (memq charset list)
+			(setq list (cons charset list))))))
+	    (forward-char)))))
+    list))
+
+(defun list-charsets-in-region (start end &optional buffer)
+  "Return a list of the charsets in the region between START and END.
+BUFFER defaults to the current buffer if omitted."
+  (let (list)
+    (save-excursion
+      (if buffer
+	  (set-buffer buffer))
+      (save-restriction
+	(narrow-to-region start end)
+	(goto-char (point-min))
+	;; this could be optimized by maintaining prev-charset and checking
+	;; for equality, but memq is not that slow for a short list.
+	(while (not (eobp))
+	  (let* ((charset (char-charset (char-after (point)))))
+	    (or (memq charset list)
+		(setq list (cons charset list))))
+	  (forward-char))))
+    list))
+
+(defun hash-charsets-in-region (start end &optional buffer)
+  "Return a list of the charsets in the region between START and END.
+BUFFER defaults to the current buffer if omitted."
+  (let ((ht (make-hash-table :size 10)))
+    (save-excursion
+      (if buffer
+	  (set-buffer buffer))
+      (save-restriction
+	(narrow-to-region start end)
+	(goto-char (point-min))
+	(while (not (eobp))
+	  (puthash (char-charset (char-after (point))) t ht)
+	  (forward-char))))
+    (hash-table-key-list ht)))
+
+(defun c-charsets-in-region (start end &optional buffer)
+  "Return a list of the charsets in the region between START and END.
+BUFFER defaults to the current buffer if omitted."
+  (setq buffer (or buffer (current-buffer)))
+  (charsets-in-region-internal buffer start end))
+
 (defun charsets-in-string (string)
   "Return a list of the charsets in STRING."
   (let (list)
@@ -73,7 +134,15 @@
 	  string)
     list))
 
+(defun c-charsets-in-string (string)
+  "Return a list of the charsets in STRING."
+  (charsets-in-string-internal string nil nil))
+
+(or (fboundp 'charsets-in-string)
+    (defalias 'charsets-in-string 'c-charsets-in-string))
 (defalias 'find-charset-string 'charsets-in-string)
+(or (fboundp 'charsets-in-region)
+    (defalias 'charsets-in-region 'c-charsets-in-region))
 (defalias 'find-charset-region 'charsets-in-region)