Mercurial > hg > xemacs-beta

comparison lisp/about.el @ 482:f4f05bb53234

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
[xemacs-hg @ 2001-04-24 14:40:09 by hrvojen] Use compose-mail for mailto links. Published in <sxsoftm4b29.fsf@florida.arsdigita.de>.
author hrvojen
date Tue, 24 Apr 2001 14:40:10 +0000
parents 1662439f54c2
children 991f80dc633d
comparison
equal deleted inserted replaced
481:1662439f54c2 482:f4f05bb53234
240 :button-suffix "" 240 :button-suffix ""
241 :help-echo help-echo 241 :help-echo help-echo
242 :tag (or text-to-insert url) 242 :tag (or text-to-insert url)
243 url)) 243 url))
244 244
245 ;; Insert a mailto: link in the buffer. 245 ;; Insert a mail link in the buffer.
246 (defun about-mailto-link (address) 246 (defun about-mailto-link (address)
247 (about-url-link 247 (lexical-let ((address address))
248 (concat "mailto:" address) address 248 (widget-create 'link
249 (concat "Send mail to " address) 249 :tag address
250 )) 250 :button-prefix ""
251 :button-suffix ""
252 :action (lambda (widget &optional event)
253 (compose-mail address))
254 :help-echo (format "Send mail to %s" address))))
251 255
252 ;; Attach a face to a string, in order to be inserted into the buffer. 256 ;; Attach a face to a string, in order to be inserted into the buffer.
253 ;; Make sure that the extent is duplicable, but unique. Returns the 257 ;; Make sure that the extent is duplicable, but unique. Returns the
254 ;; string. 258 ;; string.
255 (defun about-with-face (string face) 259 (defun about-with-face (string face)
289 (set-specifier left-margin-width about-left-margin (current-buffer)) 293 (set-specifier left-margin-width about-left-margin (current-buffer))
290 (set (make-local-variable 'widget-button-face) 'about-link-face) 294 (set (make-local-variable 'widget-button-face) 'about-link-face)
291 nil))) 295 nil)))
292 296
293 ;; Set up the stuff needed by widget. Allowed types are `bury' and 297 ;; Set up the stuff needed by widget. Allowed types are `bury' and
294 ;; `kill'. 298 ;; `kill'. The reason why we offer both types is performance: when a
299 ;; large buffer is merely buried, `about' will find it again when the
300 ;; user requests it, instead of recreating it. Small buffers can be
301 ;; killed because it is cheap to generate their contents.
302
295 (defun about-finish-buffer (&optional type) 303 (defun about-finish-buffer (&optional type)
296 (or type (setq type 'bury)) 304 (or type (setq type 'bury))
297 (widget-insert "\n") 305 (widget-insert "\n")
298 (if (eq type 'bury) 306 (if (eq type 'bury)
299 (widget-create 'link :help-echo "Bury buffer" 307 (widget-create 'link
300 :action (lambda (&rest ignore) 308 :help-echo "Bury this buffer"
301 (bury-buffer)) 309 :action (lambda (widget event)
302 "Remove") 310 ;; For some reason,
303 (widget-create 'link :help-echo "Kill buffer" 311 ;; (bury-buffer (event-buffer event))
304 :action (lambda (&rest ignore) 312 ;; doesn't work.
305 (kill-buffer (current-buffer))) 313 (with-selected-window (event-window event)
306 "Kill")) 314 (bury-buffer)))
315 :tag "Bury")
316 (widget-create 'link
317 :help-echo "Kill this buffer"
318 :action (lambda (widget event)
319 (kill-buffer (event-buffer event)))
320 :tag "Kill"))
307 (widget-insert " this buffer and return to previous.\n") 321 (widget-insert " this buffer and return to previous.\n")
308 (use-local-map (make-sparse-keymap)) 322 (use-local-map (make-sparse-keymap))
309 (set-keymap-parent (current-local-map) widget-keymap) 323 (set-keymap-parent (current-local-map) widget-keymap)
310 (if (eq type 'bury) 324 (if (eq type 'bury)
311 (progn 325 (progn