Implementing the eval tags like <lisp> in Muse.

This commit is contained in:
Carsten Dominik 2008-04-28 22:47:04 +02:00
parent ea9f9df4a9
commit 3b5e243e21
5 changed files with 162 additions and 1 deletions

View File

@ -1,3 +1,19 @@
2008-04-28 Carsten Dominik <dominik@science.uva.nl>
* lisp/org-exp.el (org-export-preprocess-hook): New hook.
(org-export-preprocess-string): Call
`org-export-preprocess-hook'.
* lisp/org.el (org-font-lock-hook): New variable.
(org-font-lock-hook): New function.
(org-set-font-lock-defaults): Call `org-font-lock-hook'.
----------------------------------------------------------------------
Installed in Emacs 23 as 6.02b
2008-04-25 Carsten Dominik <dominik@science.uva.nl>
* lisp/org-archive.el (org-extract-archive-file): Handle the

130
contrib/lisp/org-eval.el Normal file
View File

@ -0,0 +1,130 @@
;;; org-eval.el --- Display result of evaluating code in various languanges
;; Copyright (C) 2008 Free Software Foundation, Inc.
;;
;; Author: Carsten Dominik <carsten at orgmode dot org>
;; Keywords: outlines, hypermedia, calendar, wp
;; Homepage: http://orgmode.org
;; Version: 0.01
;;
;; This file is not yet part of GNU Emacs.
;;
;; GNU Emacs is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 3, or (at your option)
;; any later version.
;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs; see the file COPYING. If not, write to the
;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
;; Boston, MA 02110-1301, USA.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;;; Commentary:
(require 'org)
;;; Customization
(defgroup org-eval nil
"Options concerning global entry identifiers in Org-mode."
:tag "Org ID"
:group 'org)
(defface org-eval
(org-compatible-face nil
'((((class color grayscale) (min-colors 88) (background light))
(:foreground "grey20"))
(((class color grayscale) (min-colors 88) (background dark))
(:foreground "grey80"))
(((class color) (min-colors 8) (background light))
(:foreground "green"))
(((class color) (min-colors 8) (background dark))
(:foreground "yellow"))))
"Face for fixed-with text like code snippets."
:group 'org-eval
:group 'org-faces
:version "22.1")
(defun org-eval-handle-snippets (limit &optional replace)
(let (a)
(while (setq a (text-property-any (point) (or limit (point-max))
'org-eval t))
(remove-text-properties
a (next-single-property-change a 'org-eval nil limit)
'(display t intangible t org-eval t))))
(while (re-search-forward "<\\(lisp\\)>\\([^\000]+?\\)</\\1>" limit t)
(let* ((beg (match-beginning 0))
(end (match-end 0))
(kind (match-string 1))
(code (match-string 2))
(value (org-eval-code kind code)))
(if replace
(replace-match value t t)
(add-text-properties
beg end
(list 'display value 'intangible t 'font-lock-multiline t
'face 'org-eval
'org-eval t))))))
(defun org-eval-replace-snippts ()
"Replace EVAL snippets in the entire buffer.
This should go into the `org-export-preprocess-hook'."
(goto-char (point-min))
(org-eval-handle-snippets nil 'replace))
(add-hook 'org-export-preprocess-hook 'org-eval-replace-snippts)
(add-hook 'org-font-lock-hook 'org-eval-handle-snippets)
(defun org-eval-code (interpreter code)
(cond
((equal interpreter "lisp")
(org-eval-lisp (concat "(progn\n" code "\n)")))
(t (error "Cannot evaluate code type %s" interpreter))))
(defun org-eval-lisp (form)
"Evaluate the given form and return the result as a string."
(require 'pp)
(save-match-data
(condition-case err
(let ((object (eval (read form))))
(cond
((stringp object) object)
((and (listp object)
(not (eq object nil)))
(let ((string (pp-to-string object)))
(substring string 0 (1- (length string)))))
((numberp object)
(number-to-string object))
((eq object nil) "")
(t
(pp-to-string object))))
(error
(org-display-warning (format "%s: Error evaluating %s: %s"
"???" form err))
"; INVALID LISP CODE"))))
(defun org-display-warning (message)
"Display the given MESSAGE as a warning."
(if (fboundp 'display-warning)
(display-warning 'org message
(if (featurep 'xemacs)
'warning
:warning))
(let ((buf (get-buffer-create "*Org warnings*")))
(with-current-buffer buf
(goto-char (point-max))
(insert "Warning (Org): " message)
(unless (bolp)
(newline)))
(display-buffer buf)
(sit-for 0))))
(provide 'org-eval)
;;; org-eval.el ends here

View File

@ -677,7 +677,7 @@ symbols specifying conditions when the grid should be displayed:
today show grid on current date, independent of daily/weekly display
require-timed show grid only if at least one item has a time specification
The second item is a string which will be places behing the grid time.
The second item is a string which will be placed behind the grid time.
The third item is a list of integers, indicating the times that should have
a grid line."

View File

@ -229,6 +229,10 @@ drawer names to export."
(repeat :tag "Selected drawers"
(string :tag "Drawer name"))))
(defvar org-export-preprocess-hook nil
"Hook for preprocessing an export buffer.
Pretty much the first thing when exporting is running this hook.")
(defgroup org-export-translation nil
"Options for translating special ascii sequences for the export backends."
:tag "Org Export Translation"
@ -1175,6 +1179,9 @@ on this string to produce the exported version."
(with-current-buffer (get-buffer-create " org-mode-tmp")
(erase-buffer)
(insert string)
;; Call the hook
(run-hooks 'org-export-preprocess-hook)
;; Remove license-to-kill stuff
;; The caller markes some stuff fo killing, stuff that has been
;; used to create the page title, for example.

View File

@ -3584,11 +3584,19 @@ between words."
(defconst org-property-re (org-re "^[ \t]*\\(:\\([[:alnum:]_]+\\):\\)[ \t]*\\([^ \t\r\n].*\\)")
"Regular expression matching a property line.")
(defvar org-font-lock-hook nil
"Functions to be called for special font loch stuff.")
(defun org-font-lock-hook (limit)
(run-hook-with-args 'org-font-lock-hook limit))
(defun org-set-font-lock-defaults ()
(let* ((em org-fontify-emphasized-text)
(lk org-activate-links)
(org-font-lock-extra-keywords
(list
;; Call the hook
'(org-font-lock-hook)
;; Headlines
'("^\\(\\**\\)\\(\\* \\)\\(.*\\)" (1 (org-get-level-face 1))
(2 (org-get-level-face 2)) (3 (org-get-level-face 3)))