Mercurial > hg > xemacs-beta

comparison lisp/w3/w3-e19.el @ 118:7d55a9ba150c r20-1b11

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r20-1b11
author cvs
date Mon, 13 Aug 2007 09:24:17 +0200
parents fe104dbd9147
children d2f30a177268
comparison
equal deleted inserted replaced
117:578fd4947a72 118:7d55a9ba150c
1 ;;; w3-e19.el --- Emacs 19.xx specific functions for emacs-w3 1 ;;; w3-e19.el --- Emacs 19.xx specific functions for emacs-w3
2 ;; Author: wmperry 2 ;; Author: wmperry
3 ;; Created: 1997/03/12 20:07:18 3 ;; Created: 1997/04/01 19:23:18
4 ;; Version: 1.19 4 ;; Version: 1.22
5 ;; Keywords: faces, help, mouse, hypermedia 5 ;; Keywords: faces, help, mouse, hypermedia
6 6
7 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 7 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
8 ;;; Copyright (c) 1993 - 1996 by William M. Perry (wmperry@cs.indiana.edu) 8 ;;; Copyright (c) 1993 - 1996 by William M. Perry (wmperry@cs.indiana.edu)
9 ;;; Copyright (c) 1996, 1997 Free Software Foundation, Inc. 9 ;;; Copyright (c) 1996, 1997 Free Software Foundation, Inc.
102 (let ((inhibit-read-only t)) 102 (let ((inhibit-read-only t))
103 (put-text-property st nd 'read-only nil))) 103 (put-text-property st nd 'read-only nil)))
104 104
105 (defun w3-mode-version-specifics () 105 (defun w3-mode-version-specifics ()
106 ;; Emacs 19 specific stuff for w3-mode 106 ;; Emacs 19 specific stuff for w3-mode
107 (declare (special w3-face-index w3-display-background-properties))
107 (make-local-variable 'track-mouse) 108 (make-local-variable 'track-mouse)
108 (set (make-local-variable 'buffer-access-fontify-functions) 'w3-e19-no-read-only) 109 (set (make-local-variable 'buffer-access-fontify-functions) 'w3-e19-no-read-only)
109 (if w3-track-mouse (setq track-mouse t))) 110 (if w3-track-mouse (setq track-mouse t))
111 (if w3-display-background-properties
112 (let ((face (w3-make-face (intern
113 (format "w3-style-face-%05d" w3-face-index))
114 "An Emacs-W3 face... don't edit by hand." t))
115 (fore (car w3-display-background-properties))
116 (inhibit-read-only t)
117 (back (cdr w3-display-background-properties)))
118 (setq w3-face-index (1+ w3-face-index))
119 (if fore (font-set-face-foreground face fore))
120 (if back (font-set-face-background face back))
121 (fillin-text-property (point-min) (point-max) 'face 'face face))))
110 122
111 (defun w3-mouse-handler (e) 123 (defun w3-mouse-handler (e)
112 "Function to message the url under the mouse cursor" 124 "Function to message the url under the mouse cursor"
113 (interactive "e") 125 (interactive "e")
114 (let* ((pt (posn-point (event-start e))) 126 (let* ((pt (posn-point (event-start e)))
120 ;; Need to handle onmouseover, on mouseout 132 ;; Need to handle onmouseover, on mouseout
121 (setq mouse-events (w3-script-find-event-handlers pt 'mouse)) 133 (setq mouse-events (w3-script-find-event-handlers pt 'mouse))
122 (if (assq 'onmouseover mouse-events) 134 (if (assq 'onmouseover mouse-events)
123 (w3-script-evaluate-form (cdr (assq 'onmouseover mouse-events))))))) 135 (w3-script-evaluate-form (cdr (assq 'onmouseover mouse-events)))))))
124 136
125 (defun w3-color-values (color)
126 (cond
127 ((eq window-system 'x)
128 (x-color-values color))
129 ((eq window-system 'pm)
130 (pm-color-values color))
131 ((eq window-system 'ns)
132 (ns-color-values color))
133 (t nil)))
134
135 (defun w3-color-light-p (color-or-face)
136 (let (colors)
137 (cond
138 ((null window-system)
139 nil)
140 ((facep color-or-face)
141 (setq color-or-face (face-background color-or-face))
142 (if (null color-or-face)
143 (setq color-or-face (cdr-safe
144 (assq 'background-color (frame-parameters)))))
145 (setq colors (w3-color-values color-or-face)))
146 ((stringp color-or-face)
147 (setq colors (w3-color-values color-or-face)))
148 ((font-rgb-color-p color-or-face)
149 (setq colors (list (font-rgb-color-red color-or-face)
150 (font-rgb-color-green color-or-face)
151 (font-rgb-color-blue color-or-face))))
152 (t
153 (signal 'wrong-type-argument 'color-or-face-p)))
154 (not (< (apply '+ colors)
155 (/ (apply '+ (w3-color-values "white")) 3)))))
156
157
158 137
159 (provide 'w3-emacs19) 138 (provide 'w3-emacs19)
160 (provide 'w3-e19) 139 (provide 'w3-e19)