Mercurial > hg > xemacs-beta

comparison lisp/w3/w3-elisp.el @ 26:441bb1e64a06 r19-15b96

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r19-15b96
author cvs
date Mon, 13 Aug 2007 08:51:32 +0200
parents
children ec9a17fef872
comparison
equal deleted inserted replaced
25:383a494979f8 26:441bb1e64a06
1 ;;; w3-elisp.el --- Scripting support for emacs-lisp
2 ;; Author: wmperry
3 ;; Created: 1997/02/19 23:44:26
4 ;; Version: 1.5
5 ;; Keywords: hypermedia, scripting
6
7 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
8 ;;; Copyright (c) 1997 Free Software Foundation, Inc.
9 ;;;
10 ;;; This file is part of GNU Emacs.
11 ;;;
12 ;;; GNU Emacs is free software; you can redistribute it and/or modify
13 ;;; it under the terms of the GNU General Public License as published by
14 ;;; the Free Software Foundation; either version 2, or (at your option)
15 ;;; any later version.
16 ;;;
17 ;;; GNU Emacs is distributed in the hope that it will be useful,
18 ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
19 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
20 ;;; GNU General Public License for more details.
21 ;;;
22 ;;; You should have received a copy of the GNU General Public License
23 ;;; along with GNU Emacs; see the file COPYING. If not, write to the
24 ;;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
25 ;;; Boston, MA 02111-1307, USA.
26 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
27
28 (require 'cl)
29
30 (mapcar
31 (function
32 (lambda (x)
33 (put x 'w3-safe t)))
34 '(;; Any safe functions for untrusted scripts should go here.
35 ;; Basic stuff
36 message
37 format garbage-collect progn prog1 prog2 progn-with-message
38 while current-time current-time-string
39 plist-member plist-to-alist plist-get
40 assoc memq member function lambda point
41
42 ;; Device querying
43 device-pixel-height device-type device-color-cells
44 device-mm-height device-class device-bitplanes
45 device-on-window-system-p device-pixel-width
46 device-mm-width device-baud-rate
47
48 ;; Frame querying
49 frame-type frame-name frame-device frame-parameters
50 frame-height frame-pixel-width frame-pixel-height
51 frame-width frame-property
52
53 ;; Window querying
54 window-frame window-height window-width
55 window-pixel-width window-pixel-height
56
57 ;; Buffer querying
58 buffer-name buffer-substring buffer-substring-no-properties
59 buffer-size buffer-string
60
61 ;; Text properties, read-only
62 get-text-property text-properties-at text-property-bounds
63 text-property-not-all
64
65 ;; URL loading stuff
66 url-insert-file-contents url-view-url
67
68 ;; Interfacing to W3
69 w3-fetch w3-refresh-buffer w3-view-this-url
70
71 ;; Face stuff - is this really safe?
72 make-face set-face-foreground set-face-underline-p
73 set-face-doc-string set-face-parent set-face-dim-p set-face-background
74 set-face-background-pixmap set-face-property set-face-blinking-p
75 set-face-font-family set-face-reverse-p set-face-strikethru-p
76 set-face-font-size set-face-font set-face-display-table
77 set-face-highlight-p
78
79 ;; All the XEmacs event manipulation functions
80 event-live-p event-glyph-extent event-glyph-y-pixel event-x-pixel
81 event-type event-glyph event-button event-over-text-area-p
82 event-glyph-x-pixel event-buffer event-device event-properties
83 event-process event-timestamp event-modifier-bits event-console
84 event-window-y-pixel event-window event-window-x-pixel event-point
85 event-function event-over-toolbar-p event-matches-key-specifier-p
86 event-over-glyph-p event-frame event-x event-channel event-y
87 event-screen event-to-character event-over-border-p
88 event-toolbar-button event-closest-point event-object event-key
89 event-modifiers event-y-pixel event-over-modeline-p
90 event-modeline-position
91 )
92 )
93
94 (defsubst w3-elisp-safe-function (func args)
95 (let ((validator (get func 'w3-safe)))
96 (cond
97 ((eq t validator) t) ; Explicit allow
98 ((eq nil validator) nil) ; Explicit deny
99 ((fboundp validator) ; Function to call
100 (funcall validator func args))
101 ((boundp validator) ; Variable to check
102 (symbol-value validator))
103 (t nil)))) ; Fallback to unsafe
104
105 (defun w3-elisp-safe-expression (exp)
106 "Return t if-and-only-if EXP is safe to evaluate."
107 (cond
108 ((and (listp exp) (not (listp (cdr exp)))) ; A cons cell
109 t)
110 ((or ; self-quoters
111 (vectorp exp)
112 (numberp exp)
113 (symbolp exp)
114 (stringp exp)
115 (keymapp exp))
116 t)
117 ((listp exp) ; Function call - check arguments
118 (if (w3-elisp-safe-function (car exp) (cdr exp))
119 (let ((args (cdr exp))
120 (rval t))
121 (while args
122 (if (not (w3-elisp-safe-expression (pop args)))
123 (setq args nil
124 rval nil)))
125 rval)))
126 ;; How to handle the insane # of native types?
127 (t nil)))
128
129 (defun w3-elisp-safe-eval (form)
130 (and (w3-elisp-safe-expression form) (eval form)))
131
132 (provide 'w3-elisp)