Merge from trunk.

9 files changed, 98 insertions, 33 deletions

diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index f57bd437af6..38c536af62c 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,3 +1,27 @@
+2011-08-18  Chong Yidong  <cyd@stupidchicken.com>
+
+        * international/characters.el: Add L and R categories.
+
+        * subr.el (bidi-string-mark-left-to-right): Rename from
+        string-mark-left-to-right.  Use category search.
+
+        * buff-menu.el (Buffer-menu-buffer+size): Callers changed.
+
+2011-08-18  Juri Linkov  <juri@jurta.org>
+
+        * faces.el (error, warning, success): New faces with definitions
+        copied from old default values of `font-lock-warning-face',
+        `compilation-warning', `compilation-info' (bug#6117).
+
+        * font-lock.el (font-lock-warning-face): Inherit from `error'.
+
+        * progmodes/compile.el (compilation-error): Inherit from `error'.
+        (compilation-warning): Inherit from `warning'.
+        (compilation-info): Inherit from `success'.
+
+        * dired.el (dired-marked): Inherit from `warning'.
+        (dired-flagged): Inherit from `error'.
+
 2011-08-17  Lars Magne Ingebrigtsen  <larsi@gnus.org>
 
         * mail/smtpmail.el (auth-source): Require to avoid problems with
diff --git a/lisp/buff-menu.el b/lisp/buff-menu.el
index a5b45921d28..2eac33d8157 100644
--- a/lisp/buff-menu.el
+++ b/lisp/buff-menu.el
@@ -681,9 +681,9 @@ For more information, see the function `buffer-menu'."
                           (string-width tail)
                           2))
                       Buffer-menu-short-ellipsis
-                      (string-mark-left-to-right tail))))
+                      (bidi-string-mark-left-to-right tail))))
     ;; Don't put properties on (buffer-name).
-    (setq name (string-mark-left-to-right name)))
+    (setq name (bidi-string-mark-left-to-right name)))
   (add-text-properties 0 (length name) name-props name)
   (add-text-properties 0 (length size) size-props size)
   (let ((name+space-width (- Buffer-menu-buffer+size-width
diff --git a/lisp/dired.el b/lisp/dired.el
index 746c16ff148..ecb626a275e 100644
--- a/lisp/dired.el
+++ b/lisp/dired.el
@@ -342,7 +342,7 @@ Subexpression 2 must end right before the \\n or \\r.")
   "Face name used for dired marks.")
 
 (defface dired-marked
-  '((t (:inherit font-lock-warning-face)))
+  '((t (:inherit warning)))
   "Face used for marked files."
   :group 'dired-faces
   :version "22.1")
@@ -350,7 +350,7 @@ Subexpression 2 must end right before the \\n or \\r.")
   "Face name used for marked files.")
 
 (defface dired-flagged
-  '((t (:inherit font-lock-variable-name-face)))
+  '((t (:inherit error)))
   "Face used for files flagged for deletion."
   :group 'dired-faces
   :version "22.1")
diff --git a/lisp/emacs-lisp/tabulated-list.el b/lisp/emacs-lisp/tabulated-list.el
index 9b485b58608..75c9a01323d 100644
--- a/lisp/emacs-lisp/tabulated-list.el
+++ b/lisp/emacs-lisp/tabulated-list.el
@@ -283,7 +283,7 @@ of column descriptors."
              (> (length label) width)
              (setq label (concat (substring label 0 (- width 3))
                                  "...")))
-        (setq label (string-mark-left-to-right label))
+        (setq label (bidi-string-mark-left-to-right label))
         (if (stringp desc)
             (insert (propertize label 'help-echo help-echo))
           (apply 'insert-text-button label (cdr desc)))
diff --git a/lisp/faces.el b/lisp/faces.el
index 9a78ab69caa..404bd7b6609 100644
--- a/lisp/faces.el
+++ b/lisp/faces.el
@@ -2413,6 +2413,39 @@ Note: Other faces cannot inherit from the cursor face."
 It is used for characters of no fonts too."
   :version "24.1"
   :group 'basic-faces)
+
+(defface error
+  '((((class color) (min-colors 88) (background light)) (:foreground "Red1" :weight bold))
+    (((class color) (min-colors 88) (background dark)) (:foreground "Pink" :weight bold))
+    (((class color) (min-colors 16) (background light)) (:foreground "Red1" :weight bold))
+    (((class color) (min-colors 16) (background dark)) (:foreground "Pink" :weight bold))
+    (((class color) (min-colors 8)) (:foreground "red"))
+    (t (:inverse-video t :weight bold)))
+  "Basic face used to highlight errors and to denote failure."
+  :version "24.1"
+  :group 'basic-faces)
+
+(defface warning
+  '((((class color) (min-colors 16)) (:foreground "DarkOrange" :weight bold))
+    (((class color)) (:foreground "yellow" :weight bold))
+    (t (:weight bold)))
+  "Basic face used to highlight warnings."
+  :version "24.1"
+  :group 'basic-faces)
+
+(defface success
+  '((((class color) (min-colors 16) (background light))
+     (:foreground "Green3" :weight bold))
+    (((class color) (min-colors 88) (background dark))
+     (:foreground "Green1" :weight bold))
+    (((class color) (min-colors 16) (background dark))
+     (:foreground "Green" :weight bold))
+    (((class color)) (:foreground "green" :weight bold))
+    (t (:weight bold)))
+  "Basic face used to indicate successful operation."
+  :version "24.1"
+  :group 'basic-faces)
+
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;; Manipulating font names.
diff --git a/lisp/font-lock.el b/lisp/font-lock.el
index 6902ce98ab1..9cf889e1aec 100644
--- a/lisp/font-lock.el
+++ b/lisp/font-lock.el
@@ -1959,12 +1959,7 @@ Sets various variables using `font-lock-defaults' and
   :group 'font-lock-faces)
 
 (defface font-lock-warning-face
-  '((((class color) (min-colors 88) (background light)) (:foreground "Red1" :weight bold))
-    (((class color) (min-colors 88) (background dark)) (:foreground "Pink" :weight bold))
-    (((class color) (min-colors 16) (background light)) (:foreground "Red1" :weight bold))
-    (((class color) (min-colors 16) (background dark)) (:foreground "Pink" :weight bold))
-    (((class color) (min-colors 8)) (:foreground "red"))
-    (t (:inverse-video t :weight bold)))
+  '((t :inherit error))
   "Font Lock mode face used to highlight warnings."
   :group 'font-lock-faces)
 
diff --git a/lisp/international/characters.el b/lisp/international/characters.el
index a9657c17b9f..47426784e51 100644
--- a/lisp/international/characters.el
+++ b/lisp/international/characters.el
@@ -114,6 +114,16 @@ A character which can't be placed at end of line.")
 Base characters (Unicode General Category L,N,P,S,Zs)")
 (define-category ?^ "Combining
 Combining diacritic or mark (Unicode General Category M)")
+
+;; bidi types
+(define-category ?R "Right-to-left (strong)
+Characters with \"strong\" right-to-left directionality, i.e.
+with R, AL, RLE, or RLO Unicode bidi character type.")
+
+(define-category ?L "Left-to-right (strong)
+Characters with \"strong\" left-to-right directionality, i.e.
+with L, LRE, or LRO Unicode bidi character type.")
+
 
 ;;; Setting syntax and category.
 
@@ -478,6 +488,16 @@ Combining diacritic or mark (Unicode General Category M)")
                   (modify-category-entry x category))
               chars)))))
 
+;; Bidi categories
+
+(map-char-table (lambda (key val)
+                  (cond
+                   ((memq val '(R AL RLO RLE))
+                    (modify-category-entry key ?R))
+                   ((memq val '(L LRE LRO))
+                    (modify-category-entry key ?L))))
+                (unicode-property-table-internal 'bidi-class))
+
 ;; Latin
 
 (modify-category-entry '(#x80 . #x024F) ?l)
diff --git a/lisp/progmodes/compile.el b/lisp/progmodes/compile.el
index 503698f0f7b..f3b873c8b1e 100644
--- a/lisp/progmodes/compile.el
+++ b/lisp/progmodes/compile.el
@@ -647,19 +647,19 @@ starting the compilation process.")
 (defvar compile-history nil)
 
 (defface compilation-error
-  '((t :inherit font-lock-warning-face))
+  '((t :inherit error))
   "Face used to highlight compiler errors."
   :group 'compilation
   :version "22.1")
 
 (defface compilation-warning
-  '((t :inherit font-lock-variable-name-face))
+  '((t :inherit warning))
   "Face used to highlight compiler warnings."
   :group 'compilation
   :version "22.1")
 
 (defface compilation-info
-  '((t :inherit font-lock-type-face))
+  '((t :inherit success))
   "Face used to highlight compiler information."
   :group 'compilation
   :version "22.1")
diff --git a/lisp/subr.el b/lisp/subr.el
index a4251b6fee6..9aa895b0e94 100644
--- a/lisp/subr.el
+++ b/lisp/subr.el
@@ -3539,30 +3539,23 @@ to case differences."
   (eq t (compare-strings str1 nil nil
                          str2 0 (length str1) ignore-case)))
 
-(defun string-mark-left-to-right (str)
+(defun bidi-string-mark-left-to-right (str)
   "Return a string that can be safely inserted in left-to-right text.
-If STR contains right-to-left (RTL) script, return a string
-consisting of STR followed by a terminating invisible
-left-to-right mark (LRM) character.
 
-The LRM character marks the end of an RTL segment, and resets the
-display direction of any subsequent text to left-to-right.
-\(Otherwise, some of that text might be displayed as part of the
-RTL segment, based on the bidirectional display algorithm.)
+Normally, inserting a string with right-to-left (RTL) script into
+a buffer may cause some subsequent text to be displayed as part
+of the RTL segment (usually this affects punctuation characters).
+This function returns a string which displays as STR but forces
+subsequent text to be displayed as left-to-right.
 
-If STR contains no RTL characters, return STR."
+If STR contains any RTL character, this function returns a string
+consisting of STR followed by an invisible left-to-right mark
+\(LRM) character.  Otherwise, it returns STR."
   (unless (stringp str)
     (signal 'wrong-type-argument (list 'stringp str)))
-  (let ((len (length str))
-        (n 0)
-        rtl-found)
-    (while (and (not rtl-found) (< n len))
-      (setq rtl-found (memq (get-char-code-property
-                             (aref str n) 'bidi-class) '(R AL RLO))
-            n (1+ n)))
-    (if rtl-found
-        (concat str (propertize (string ?\x200e) 'invisible t))
-      str)))
+  (if (string-match "\\cR" str)
+      (concat str (propertize (string ?\x200e) 'invisible t))
+    str))
 
 ;;;; invisibility specs