[emacs-wiki-discuss] how to font-lock a source code

[Ye Wenbin]

I use this function to publish colorize source code in html.
(require 'tp-muse-highlight nil t)
(defun ywb-muse-publish-src-tag (beg end attrs)
  (let ((mode (cdr (assoc "type" attrs))))
    (tp-muse-fontified-example-tag beg end nil
                                   (intern-soft (concat mode "-mode")))))
(add-to-list 'muse-html-markup-tags
             '("src" t t ywb-muse-publish-src-tag))

However, I want my muse file can be fontified as well. mmm-mode seems not
work in muse-mode. So I hack a function which copy the faces from a temp  
buffer
to current buffer. The problem is this function only fontify a part of  
code from beginning,
the rest is not changed. I can't work out where is the problem.
Is there anyone can help me?

(defun muse-colors-src-tag (beg end)
  "Strip properties and mark as literal."
  (muse-unhighlight-region beg end)
  (save-excursion
    (goto-char beg)
    (let ((fs 1) content face-list fe mode
          (font-lock-verbose nil))
      (when (re-search-forward "<src\\s-*type=\"\\(.*\\)\"\\s-*>" nil t)
        (setq mode (intern-soft (concat (match-string 1) "-mode"))
              beg (match-end 0))
        (when (and mode (fboundp mode))
          (goto-char end)
          (setq end
                (if (re-search-backward "</src>" nil t)
                    (match-beginning 0)
                  (point-max))
                content (buffer-substring-no-properties beg end))
          (with-temp-buffer
            (funcall mode)
            (insert content)
            (font-lock-fontify-buffer)
            (or (get-text-property fs 'face)
                (setq fs (next-single-property-change fs 'face)))
            (while (and fs (< fs (point-max)))
              (setq fe (or (next-single-property-change fs 'face)
                           (point-max))
                    face (get-text-property fs 'face))
              (and face (setq face-list (cons (list (1- fs) (1- fe) face)  
face-list)))
              (setq fs fe)))
          (when face-list
            (dolist (f (nreverse face-list))
              ;; (message "arg: %S" (list (+ beg (car f)) (+ beg (cadr f))
              ;; 'face (nth 2 f)))
              (put-text-property (+ beg (car f)) (+ beg (cadr f))
                                 'face (nth 2 f)))))))))
(add-to-list 'muse-colors-tags '("src" t nil muse-colors-src-tag))


--
Using Opera's revolutionary e-mail client: http://www.opera.com/mail/