how to font-lock a source code

classic Classic list List threaded Threaded
1 message Options
Reply | Threaded
Open this post in threaded view
|

how to font-lock a source code

Ye Wenbin-2
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/


_______________________________________________
emacs-wiki-discuss mailing list
[hidden email]
http://lists.nongnu.org/mailman/listinfo/emacs-wiki-discuss