[emacs-wiki-discuss] Extension for muse-colour

[Phillip Lord]

This is a suggested extension for muse-color. It's just makes the 
syntax highlighting for emphasis customizable and changes the default
colouration. 

The reason for this is that I thought the highlighting wasn't working
but this turns out to be because the font I was using doesn't
have an italic characters, so *emph* looks normal.

I've stolen these colours from gnus citation faces which 
uses colours to highlight citation levels. Of course
they could be changed bback to italic, bold and bold-italic to retain
the current UI. 

These changes are on top of 3.02 release.






(defun muse-colors-emphasized ()
  ;; Here we need to check four different points - the start and end
  ;; of the leading *s, and the start and end of the trailing *s.  We
  ;; allow the outsides to be surrounded by whitespace or punctuation,
  ;; but no word characters, and the insides must not be surrounded by
  ;; whitespace or punctuation.  Thus the following are valid:
  ;;
  ;; " *foo bar* "
  ;; "**foo**,"
  ;; and the following is invalid:
  ;; "** testing **"
  (let* ((beg (match-beginning 0))
         (e1 (match-end 0))
         (leader (- e1 beg))
         b2 e2 multiline)
    (unless (eq (get-text-property beg 'invisible) 'muse)
      ;; check if it's a header
      (if (eq (char-after e1) ?\ )
          (when (or (= beg (point-min))
                    (eq (char-before beg) ?\n))
            (add-text-properties
             (muse-line-beginning-position) (muse-line-end-position)
             (list 'face (intern (concat "muse-header-"
                                         (int-to-string leader))))))
        ;; beginning of line or space or symbol
        (when (or (= beg (point-min))
                  (eq (char-syntax (char-before beg)) ?\ )
                  (memq (char-before beg)
                        '(?\- ?\[ ?\< ?\( ?\' ?\` ?\" ?\n)))
          (save-excursion
            (skip-chars-forward "^*<>\n" end)
            (when (eq (char-after) ?\n)
              (setq multiline t)
              (skip-chars-forward "^*<>" end))
            (setq b2 (point))
            (skip-chars-forward "*" end)
            (setq e2 (point))
            ;; Abort if space exists just before end
            ;; or bad leader
            ;; or no '*' at end
            ;; or word constituent follows
            (unless (or (> leader 5)
                        (not (eq leader (- e2 b2)))
                        (eq (char-syntax (char-before b2)) ?\ )
                        (not (eq (char-after b2) ?*))
                        (and (not (eobp))
                             (eq (char-syntax (char-after (1+ b2)))
?w)))
              (add-text-properties beg e1 '(invisible muse))
              (add-text-properties
               e1 b2 (list 'face (cond ((= leader 1) '(face
muse-emphasis-1))
                                       ((= leader 2) '(face
muse-emphasis-2))
                                       ((= leader 3) '(face
muse-emphasis-3)))))
              (add-text-properties b2 e2 '(invisible muse))
              (when multiline
                (add-text-properties
                 beg e2 '(font-lock-multiline t))))))))))




(defface muse-emphasis-1 '((((class color)
                              (background dark))
                             (:foreground "light blue"))
                            (((class color)
                              (background light))
                             (:foreground "MidnightBlue"))
                            (t
                             (:italic t)))
  "Emphasis 1 (Strong)")

(defface muse-emphasis-2 '((((class color)
                              (background dark))
                             (:foreground "light cyan"))
                            (((class color)
                              (background light))
                             (:foreground "firebrick"))
                            (t
                             (:italic t)))
  "Emphasis 2 (Stronger)")

(defface muse-emphasis-3 '((((class color)
                              (background dark))
                             (:foreground "light yellow"))
                            (((class color)
                              (background light))
                             (:foreground "dark green"))
                            (t
                             (:italic t)))
  "Emphasis 3 (Strongest)")