|
26
|
1 ;;; w3-elisp.el --- Scripting support for emacs-lisp
|
|
|
2 ;; Author: wmperry
|
|
30
|
3 ;; Created: 1997/03/07 14:14:02
|
|
|
4 ;; Version: 1.7
|
|
26
|
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 ;; All the XEmacs event manipulation functions
|
|
|
72 event-live-p event-glyph-extent event-glyph-y-pixel event-x-pixel
|
|
|
73 event-type event-glyph event-button event-over-text-area-p
|
|
|
74 event-glyph-x-pixel event-buffer event-device event-properties
|
|
|
75 event-process event-timestamp event-modifier-bits event-console
|
|
|
76 event-window-y-pixel event-window event-window-x-pixel event-point
|
|
|
77 event-function event-over-toolbar-p event-matches-key-specifier-p
|
|
|
78 event-over-glyph-p event-frame event-x event-channel event-y
|
|
|
79 event-screen event-to-character event-over-border-p
|
|
|
80 event-toolbar-button event-closest-point event-object event-key
|
|
|
81 event-modifiers event-y-pixel event-over-modeline-p
|
|
|
82 event-modeline-position
|
|
|
83 )
|
|
|
84 )
|
|
|
85
|
|
|
86 (defsubst w3-elisp-safe-function (func args)
|
|
|
87 (let ((validator (get func 'w3-safe)))
|
|
|
88 (cond
|
|
|
89 ((eq t validator) t) ; Explicit allow
|
|
|
90 ((eq nil validator) nil) ; Explicit deny
|
|
|
91 ((fboundp validator) ; Function to call
|
|
|
92 (funcall validator func args))
|
|
|
93 ((boundp validator) ; Variable to check
|
|
|
94 (symbol-value validator))
|
|
|
95 (t nil)))) ; Fallback to unsafe
|
|
|
96
|
|
|
97 (defun w3-elisp-safe-expression (exp)
|
|
|
98 "Return t if-and-only-if EXP is safe to evaluate."
|
|
|
99 (cond
|
|
|
100 ((and (listp exp) (not (listp (cdr exp)))) ; A cons cell
|
|
|
101 t)
|
|
|
102 ((or ; self-quoters
|
|
|
103 (vectorp exp)
|
|
|
104 (numberp exp)
|
|
|
105 (symbolp exp)
|
|
|
106 (stringp exp)
|
|
|
107 (keymapp exp))
|
|
|
108 t)
|
|
|
109 ((listp exp) ; Function call - check arguments
|
|
|
110 (if (w3-elisp-safe-function (car exp) (cdr exp))
|
|
|
111 (let ((args (cdr exp))
|
|
|
112 (rval t))
|
|
|
113 (while args
|
|
|
114 (if (not (w3-elisp-safe-expression (pop args)))
|
|
|
115 (setq args nil
|
|
|
116 rval nil)))
|
|
|
117 rval)))
|
|
|
118 ;; How to handle the insane # of native types?
|
|
|
119 (t nil)))
|
|
|
120
|
|
|
121 (defun w3-elisp-safe-eval (form)
|
|
30
|
122 (if (w3-elisp-safe-expression form)
|
|
|
123 (condition-case ()
|
|
|
124 (eval form)
|
|
|
125 (error nil))))
|
|
26
|
126
|
|
|
127 (provide 'w3-elisp)
|
