emacs: lisp/tutorial.el comparison

comparison lisp/tutorial.el @ 90667:dbe3f29e61d6

Merge from emacs--devo--0 Patches applied: * emacs--devo--0 (patch 505-522) - Update from CVS - Merge from gnus--rel--5.10 - Update from CVS: etc/TUTORIAL.cn: Updated. - Merge from erc--emacs--22 * gnus--rel--5.10 (patch 164-167) - Update from CVS Revision: emacs@sv.gnu.org/emacs--unicode--0--patch-137

author	Miles Bader <miles@gnu.org>
date	Tue, 21 Nov 2006 08:56:38 +0000
parents	9b8e3f194cc1
children	3cc044eb98b7

comparison

equal deleted inserted replaced

-:00d54c8fa693
+:dbe3f29e61d6
 ;;; Code:
 (require 'help-mode) ;; for function help-buffer
 (eval-when-compile (require 'cl))
+(defface tutorial-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)))
+"Face used to highlight warnings in the tutorial."
+:group 'font-lock-faces)
 (defvar tutorial--point-before-chkeys 0
 "Point before display of key changes.")
 (make-variable-buffer-local 'tutorial--point-before-chkeys)
 (key-fun (with-current-buffer tutorial-buffer (key-binding key)))
 tot-len)
 (unless (eq def-fun key-fun)
 ;; Insert key binding description:
 (when (string= key-txt explain-key-desc)
-(put-text-property 0 (length key-txt) 'face '(:background "yellow") key-txt))
+(put-text-property 0 (length key-txt)
+				     'face 'tutorial-warning-face key-txt))
 (insert "   " key-txt " ")
 (setq tot-len (length key-txt))
 (when (> 9 tot-len)
 (insert (make-string (- 9 tot-len) ? ))
 (setq tot-len 9))
 ;; described in the doc string.
 (let* ((key     (nth 1 kdf))
 (def-fun (nth 0 kdf))
 (def-fun-txt (format "%s" def-fun))
 (rem-fun (command-remapping def-fun))
-(key-fun (key-binding key))
+(key-fun (if (eq def-fun 'ESC-prefix)
+			  (lookup-key global-map [27])
+			(key-binding key)))
 (where (where-is-internal (if rem-fun rem-fun def-fun))))
-(when (eq key-fun 'ESC-prefix)
-(message "ESC-prefix!!!!"))
 (if where
 (progn
 (setq where (key-description (car where)))
 (when (and (< 10 (length where))
 (string= (substring where 0 (length "<menu-bar>"))
 "<menu-bar>"))
-(setq where "The menus")))
+(setq where "the menus")))
 (setq where ""))
 (setq remark nil)
 (unless
 (cond ((eq key-fun def-fun)
 ;; No rebinding, return t
 (current-buffer)
 ;;'tutorial-arg arg
 'action
 'tutorial--detailed-help
 'follow-link t
-'face '(:inherit link :background "yellow"))
+'face 'link)
 (insert "]\n\n" )
 (when changed-keys
 (dolist (tk changed-keys)
 (let* ((def-fun     (nth 1 tk))
 (key         (nth 0 tk))
 tot-len)
 (unless (eq def-fun key-fun)
 ;; Mark the key in the tutorial text
 (unless (string= "Same key" where)
 (let ((here (point))
+			(case-fold-search nil)
 (key-desc (key-description key)))
-(while (search-forward key-desc nil t)
+(while (re-search-forward
+			    (concat (regexp-quote key-desc)
+				    "[[:space:]]") nil t)
 (put-text-property (match-beginning 0)
 (match-end 0)
 'tutorial-remark 'only-colored)
 (put-text-property (match-beginning 0)
 (match-end 0)
-'face '(:background "yellow"))
+'face 'tutorial-warning-face)
 (forward-line)
 (let ((s  (get-lang-string tutorial--lang 'tut-chgdkey))
 (s2 (get-lang-string tutorial--lang 'tut-chgdkey2))
 (start (point))
 end)
-;;(concat "** The key " key-desc " has been rebound, but you can use " where " instead ["))
 (when (and s s2)
 (setq s (format s key-desc where s2))
 (insert s)
 (insert-button s2
 'tutorial-buffer
 ;;'tutorial-arg arg
 'action
 'tutorial--detailed-help
 'explain-key-desc key-desc
 'follow-link t
-'face '(:inherit link :background "yellow"))
+'face 'link)
 (insert "] **")
 (insert "\n")
 (setq end (point))
 (put-text-property start end 'local-map tutorial--tab-map)
 ;; Add a property so we can remove the remark:
 (put-text-property start end 'tutorial-remark t)
 (put-text-property start end
-'face '(:background "yellow" :foreground "#c00"))
+'face 'tutorial-warning-face)
 (put-text-property start end 'read-only t))))
 (goto-char here)))))))
 (setq end (point))
 ;; Make the area with information about change key
 ;; bindings stand out:
 (put-text-property start end 'tutorial-remark t)
 (put-text-property start end
-'face
+'face 'tutorial-warning-face)
-;; The default warning face does not
-;;look good in this situation. Instead
-;;try something that could be
-;;recognized from warnings in normal
-;;life:
-;; 'font-lock-warning-face
-(list :background "yellow" :foreground "#c00"))
 ;; Make it possible to use Tab/S-Tab between fields in
 ;; this area:
 (put-text-property start end 'local-map tutorial--tab-map)
 (setq tutorial--point-after-chkeys (point-marker))
 ;; Make this area read-only:

Mercurial > emacs

comparison lisp/tutorial.el @ 90667:dbe3f29e61d6