home *** CD-ROM | disk | FTP | other *** search
/ SGI Freeware 1999 August / SGI Freeware 1999 August.iso / dist / fw_xemacs.idb / usr / freeware / lib / xemacs-20.4 / lisp / w3 / w3-elisp.el.z / w3-elisp.el
Encoding:
Text File  |  1998-05-21  |  4.1 KB  |  128 lines
  1. ;;; w3-elisp.el --- Scripting support for emacs-lisp
  2. ;; Author: wmperry
  3. ;; Created: 1997/03/07 14:14:02
  4. ;; Version: 1.7
  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)
  122.   (if (w3-elisp-safe-expression form)
  123.       (condition-case ()
  124.       (eval form)
  125.     (error nil))))
  126.  
  127. (provide 'w3-elisp)
  128.