--- a/lisp/utils/facemenu.el	Mon Aug 13 09:00:04 2007 +0200
+++ b/lisp/utils/facemenu.el	Mon Aug 13 09:02:59 2007 +0200
@@ -1,31 +1,29 @@
 ;;; facemenu.el --- create a face menu for interactively adding fonts to text
-;; Copyright (c) 1994, 1995, 1996 Free Software Foundation, Inc.
+;; Copyright (c) 1994, 1995 Free Software Foundation, Inc.
 
 ;; XEmacs version: Mike Sperber <sperber@informatik.uni-tuebingen.de>
 ;; Original author: Boris Goldowsky <boris@gnu.ai.mit.edu>
 ;; Keywords: faces
 
-;; This file is part of XEmacs.
+;; This file is part of GNU Emacs.
 
-;; XEmacs is free software; you can redistribute it and/or modify it
-;; under the terms of the GNU General Public License as published by
+;; GNU Emacs is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
 ;; the Free Software Foundation; either version 2, or (at your option)
 ;; any later version.
 
-;; XEmacs is distributed in the hope that it will be useful, but
-;; WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
-;; General Public License for more details.
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
 
 ;; You should have received a copy of the GNU General Public License
-;; along with XEmacs; see the file COPYING.  If not, write to the Free
-;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
-;; 02111-1307, USA.
+;; along with GNU Emacs; see the file COPYING.  If not, write to
+;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
 
-;;; Synched up with: FSF 19.34.
+;;; Synched up with: FSF 19.30.
 
 ;;; Commentary:
-
 ;; This file defines a menu of faces (bold, italic, etc) which allows you to
 ;; set the face used for a region of the buffer.  Some faces also have
 ;; keybindings, which are shown in the menu.  Faces with names beginning with
@@ -39,6 +37,11 @@
 ;; The menu also contains submenus for indentation and justification-changing
 ;; commands.
 
+;;; Installation:
+;; Just do a (require 'facemenu).
+;; If you want the menu bound to a mouse button under XEmacs, do
+;; (define-key global-map '(control button2) 'facemenu-menu)
+
 ;;; Usage:
 ;; Selecting a face from the menu or typing the keyboard equivalent will
 ;; change the region to use that face.  If you use transient-mark-mode and the
@@ -50,28 +53,6 @@
 ;; The standard keybindings are M-g (or ESC g) + letter:
 ;; M-g i = "set italic",  M-g b = "set bold", etc.
 
-;;; Customization:
-;; An alternative set of keybindings that may be easier to type can be set up
-;; using "Alt" or "Hyper" keys.  This requires that you either have or create
-;; an Alt or Hyper key on your keyboard.  On my keyboard, there is a key
-;; labeled "Alt", but to make it act as an Alt key I have to put this command
-;; into my .xinitrc:
-;;    xmodmap -e "add Mod3 = Alt_L"
-;; Or, I can make it into a Hyper key with this:
-;;    xmodmap -e "keysym Alt_L = Hyper_L" -e "add Mod2 = Hyper_L"
-;; Check with local X-perts for how to do it on your system.
-;; Then you can define your keybindings with code like this in your .emacs:
-;;   (setq facemenu-keybindings
-;;    '((default     . [?\H-d])
-;;      (bold        . [?\H-b])
-;;      (italic      . [?\H-i])
-;;      (bold-italic . [?\H-l])
-;;      (underline   . [?\H-u])))
-;;   (setq facemenu-keymap global-map)
-;;   (setq facemenu-key nil)
-;;   (define-key global-map [?\H-c] 'facemenu-set-foreground) ; set fg color
-;;   (define-key global-map [?\H-C] 'facemenu-set-background) ; set bg color
-;;   (require 'facemenu)
 ;;
 ;; The order of the faces that appear in the menu and their keybindings can be
 ;; controlled by setting the variables `facemenu-keybindings' and
@@ -97,7 +78,6 @@
 
 (provide 'facemenu)
 
-;; XEmacs
 (require 'easymenu)
 
 ;;; Provide some binding for startup:
@@ -131,7 +111,6 @@
 This should be nil to put them at the top of the menu, or t to put them
 just before \"Other\" at the end.")
 
-;; XEmacs -- additional faces
 (defvar facemenu-unlisted-faces
   '(modeline region secondary-selection highlight scratch-face
     gui-button-face isearch hyperlink
@@ -235,22 +214,6 @@
 requested in `facemenu-keybindings'.")
 (defalias 'facemenu-keymap facemenu-keymap)
 
-
-(defvar facemenu-add-face-function nil
-  "Function called at beginning of text to change or `nil'.
-This function is passed the FACE to set and END of text to change, and must
-return a string which is inserted.  It may set `facemenu-end-add-face'.")
-
-(defvar facemenu-end-add-face nil
-  "String to insert or function called at end of text to change or `nil'.
-This function is passed the FACE to set, and must return a string which is
-inserted.")
-
-(defvar facemenu-remove-face-function nil
-  "When non-`nil' function called to remove faces.
-This function is passed the START and END of text to change.
-May also be `t' meaning to use `facemenu-add-face-function'.")
-
 ;;; Internal Variables
 
 (defvar facemenu-color-alist nil
@@ -296,10 +259,10 @@
 inserted.  Moving point or switching buffers before
 typing a character to insert cancels the specification." 
   (interactive (list (read-face-name "Use face: ")))
-  (setq zmacs-region-stays t) ; XEmacs
+  (setq zmacs-region-stays t)
   (barf-if-buffer-read-only)
   (facemenu-add-new-face face)
-  (facemenu-update-facemenu-menu) ; XEmacs
+  (facemenu-update-facemenu-menu)
   (if (and (facemenu-region-active-p)
 	   (not current-prefix-arg))
       (let ((start (or start (region-beginning)))
@@ -340,7 +303,7 @@
     (facemenu-set-face face start end)))
 
 ;;;###autoload
-(defun facemenu-set-face-from-menu (face start end)
+(defun facemenu-set-face-from-menu (face)
   "Set the face of the region or next character typed.
 This function is designed to be called from a menu; the face to use
 is the menu item's name.
@@ -351,21 +314,19 @@
 Otherwise, this command specifies the face for the next character
 inserted.  Moving point or switching buffers before
 typing a character to insert cancels the specification." 
-  (interactive (list last-command-event
-		     (if (and (facemenu-region-active-p)
-			      (not current-prefix-arg))
-			 (region-beginning))
-		     (if (and (facemenu-region-active-p)
-			      (not current-prefix-arg))
-			 (region-end))))
-  (barf-if-buffer-read-only)
-  (setq zmacs-region-stays t) ; XEmacs
-  (facemenu-get-face face)
-  (if start
-      (facemenu-add-face face start end)
-    (facemenu-self-insert-face face))) ; XEmacs
+  (let ((start (if (and (facemenu-region-active-p)
+			(not current-prefix-arg))
+		   (region-beginning)))
+	(end (if (and (facemenu-region-active-p)
+		      (not current-prefix-arg))
+		 (region-end))))
+    (barf-if-buffer-read-only)
+    (setq zmacs-region-stays t)
+    (facemenu-get-face face)
+    (if start
+	(facemenu-add-face face start end)
+      (facemenu-self-insert-face face))))
 
-;; XEmacs
 (defun facemenu-self-insert-face (face)
   (setq self-insert-face (cond
 			  ((null self-insert-face) face)
@@ -455,8 +416,7 @@
 		      (facemenu-sized-face (facemenu-face-strip-size face)
 					    size))
 		  face))
-   ;;[BV  9-Feb-97] strip-face from this face too, please!
-   (t (facemenu-sized-face (facemenu-face-strip-size face) size))))
+   (t (facemenu-sized-face face size))))
 
 (defun facemenu-adjust-size (from to)
   "Adjust the size of the text between FROM and TO according
@@ -499,7 +459,7 @@
   "Make the region invisible.
 This sets the `invisible' text property; it can be undone with
 `facemenu-remove-special'."
-  (interactive "_r")
+  (interactive "r")
   (put-text-property start end 'invisible t))
 
 ;;;###autoload
@@ -507,7 +467,7 @@
   "Make the region intangible: disallow moving into it.
 This sets the `intangible' text property; it can be undone with
 `facemenu-remove-special'."
-  (interactive "_r")
+  (interactive "r")
   (put-text-property start end 'intangible t))
 
 ;;;###autoload
@@ -515,7 +475,7 @@
   "Make the region unmodifiable.
 This sets the `read-only' text property; it can be undone with
 `facemenu-remove-special'."
-  (interactive "_r")
+  (interactive "r")
   (put-text-property start end 'read-only t))
 
 ;;;###autoload
@@ -540,35 +500,15 @@
 (defun list-text-properties-at (p)
   "Pop up a buffer listing text-properties at LOCATION."
   (interactive "d")
-  (let ((props (text-properties-at p))
-	category
-	str)
+  (let ((props (text-properties-at p)))
     (if (null props)
 	(message "None")
-      (if (and (not (cdr (cdr props)))
-	       (not (eq (car props) 'category))
-	       (< (length (setq str (format "Text property at %d:  %s  %S"
-					    p (car props) (car (cdr props)))))
-		  (frame-width)))
-	  (message "%s" str)
-	(with-output-to-temp-buffer "*Text Properties*"
-	  (princ (format "Text properties at %d:\n\n" p))
-	  (while props
-	    (if (eq (car props) 'category)
-		(setq category (car (cdr props))))
-	    (princ (format "%-20s %S\n"
-			   (car props) (car (cdr props))))
-	    (setq props (cdr (cdr props))))
-	  (if category
-	      (progn
-		(setq props (symbol-plist category))
-		(princ (format "\nCategory %s:\n\n" category))
-		(while props
-		  (princ (format "%-20s %S\n"
-				 (car props) (car (cdr props))))
-		  (if (eq (car props) 'category)
-		      (setq category (car (cdr props))))
-		  (setq props (cdr (cdr props)))))))))))
+      (with-output-to-temp-buffer "*Text Properties*"
+	(princ (format "Text properties at %d:\n\n" p))
+	(while props
+	  (princ (format "%-20s %S\n"
+			 (car props) (car (cdr props))))
+	  (setq props (cdr (cdr props))))))))
 
 ;;;###autoload
 (defun facemenu-read-color (&optional prompt)
@@ -655,7 +595,7 @@
 	((and (equal (facemenu-color-values a)
 		     (facemenu-color-values b))))))
 
-(defun facemenu-add-face (face &optional start end)
+(defun facemenu-add-face (face start end)
   "Add FACE to text between START and END.
 For each section of that region that has a different face property, FACE will
 be consed onto it, and other faces that are completely hidden by that will be
@@ -665,48 +605,22 @@
 text property.  Otherwise, selecting the default face would not have any
 effect."
   (interactive "*_xFace:\nr")
-  (if (and (eq face 'default)
-	   (not (eq facemenu-remove-face-function t)))
-      (if facemenu-remove-face-function
-	  (funcall facemenu-remove-face-function start end)
-	(if (and start (< start end))
-	    (remove-text-properties start end '(face default))
-	  (setq self-insert-face 'default
-		self-insert-face-command this-command)))
-    (if facemenu-add-face-function
-	(save-excursion
-	  (if end (goto-char end))
-	  (save-excursion
-	    (if start (goto-char start))
-	    (insert-before-markers
-	     (funcall facemenu-add-face-function face end)))
-	  (if facemenu-end-add-face
-	      (insert (if (stringp facemenu-end-add-face)
-			  facemenu-end-add-face
-			(funcall facemenu-end-add-face face)))))
-      (if (and start (< start end))
-	  (let ((part-start start) part-end)
-	    (while (not (= part-start end))
-	      (setq part-end (next-single-property-change part-start 'face
-							  nil end))
-	      (let ((prev (get-text-property part-start 'face)))
-		(put-text-property part-start part-end 'face
-				   (if (null prev)
-				       face
-				     (facemenu-active-faces
-				      (cons face
-					    (if (listp prev)
-						prev
-					      (list prev)))))))
-	      (setq part-start part-end)))
-	(setq self-insert-face (if (eq last-command self-insert-face-command)
-				   (cons face (if (listp self-insert-face)
-						  self-insert-face
-						(list self-insert-face)))
-				 face)
-	      self-insert-face-command this-command)))))
+  (if (eq face 'default)
+      (remove-text-properties start end '(face default))
+    (let ((part-start start) part-end)
+      (while (not (= part-start end))
+	(setq part-end (next-single-property-change part-start 'face nil end))
+	(let* ((prev (get-text-property part-start 'face))
+	       (size (get-text-property part-start 'size))
+	       (face (if size (facemenu-sized-face face size) face)))
+	  (put-text-property part-start part-end 'face
+			     (if (null prev)
+				 face
+			       (facemenu-active-faces
+				(cons face
+				      (if (listp prev) prev (list prev)))))))
+	(setq part-start part-end)))))
 
-;; XEmacs
 (defun facemenu-face-attributes (face)
   "Create a vector of the relevant face attributes of face FACE."
   (if (string-match "XEmacs" emacs-version)