Mercurial > hg > xemacs-beta

comparison lisp/hyperbole/hui.el @ 24:4103f0995bd7 r19-15b95

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r19-15b95
author cvs
date Mon, 13 Aug 2007 08:51:03 +0200
parents 376386a54a3c
children 131b0175ea99
comparison
equal deleted inserted replaced
23:0edd3412f124 24:4103f0995bd7
4 ;; SUMMARY: GNU Emacs User Interface to Hyperbole 4 ;; SUMMARY: GNU Emacs User Interface to Hyperbole
5 ;; USAGE: GNU Emacs Lisp Library 5 ;; USAGE: GNU Emacs Lisp Library
6 ;; KEYWORDS: hypermedia 6 ;; KEYWORDS: hypermedia
7 ;; 7 ;;
8 ;; AUTHOR: Bob Weiner 8 ;; AUTHOR: Bob Weiner
9 ;; ORG: Brown U. 9 ;; ORG: InfoDock Associates
10 ;; 10 ;;
11 ;; ORIG-DATE: 19-Sep-91 at 21:42:03 11 ;; ORIG-DATE: 19-Sep-91 at 21:42:03
12 ;; LAST-MOD: 25-Aug-95 at 02:26:56 by Bob Weiner 12 ;; LAST-MOD: 10-Nov-96 at 01:51:13 by Bob Weiner
13 ;; 13 ;;
14 ;; This file is part of Hyperbole. 14 ;; This file is part of Hyperbole.
15 ;; Available for use and distribution under the same terms as GNU Emacs. 15 ;; Available for use and distribution under the same terms as GNU Emacs.
16 ;; 16 ;;
17 ;; Copyright (C) 1991-1995, Free Software Foundation, Inc. 17 ;; Copyright (C) 1991-1996, Free Software Foundation, Inc.
18 ;; Developed with support from Motorola Inc. 18 ;; Developed with support from Motorola Inc.
19 ;; 19 ;;
20 ;; DESCRIPTION: 20 ;; DESCRIPTION:
21 ;; DESCRIP-END. 21 ;; DESCRIP-END.
22 22
285 (interactive (list (save-excursion 285 (interactive (list (save-excursion
286 (hui:buf-writable-err 286 (hui:buf-writable-err
287 (find-file-noselect gbut:file) "gbut-modify") 287 (find-file-noselect gbut:file) "gbut-modify")
288 (hbut:label-to-key 288 (hbut:label-to-key
289 (hargs:read-match "Global button to modify: " 289 (hargs:read-match "Global button to modify: "
290 (mapcar 'list (gbut:lbl-list)) 290 (mapcar 'list (gbut:label-list))
291 nil t nil 'ebut))))) 291 nil t nil 'ebut)))))
292 (let ((lbl (hbut:key-to-label lbl-key)) 292 (let ((lbl (hbut:key-to-label lbl-key))
293 (but-buf (find-file-noselect gbut:file)) 293 (but-buf (find-file-noselect gbut:file))
294 actype but new-lbl) 294 actype but new-lbl)
295 (save-excursion 295 (save-excursion
339 (hypb:error "(hbut-act): No current button to activate.")) 339 (hypb:error "(hbut-act): No current button to activate."))
340 ((not (hbut:is-p but)) 340 ((not (hbut:is-p but))
341 (hypb:error "(hbut-act): Button is invalid; it has no attributes.")) 341 (hypb:error "(hbut-act): Button is invalid; it has no attributes."))
342 (t (or but (setq but 'hbut:current)) 342 (t (or but (setq but 'hbut:current))
343 (hui:but-flash) (hyperb:act but)))) 343 (hui:but-flash) (hyperb:act but))))
344
345 (defun hui:hbut-current-act ()
346 "Activate Hyperbole button at point or signal an error if there is no such button."
347 (interactive)
348 (let ((but (hbut:at-p)))
349 (cond ((null but)
350 (hypb:error "(hbut-act): No current button to activate."))
351 ((not (hbut:is-p but))
352 (hypb:error "(hbut-act): Button is invalid; it has no attributes."))
353 (t (hui:but-flash) (hyperb:act but)))))
344 354
345 (defun hui:hbut-help (&optional but) 355 (defun hui:hbut-help (&optional but)
346 "Checks for and explains an optional button given by symbol, BUT. 356 "Checks for and explains an optional button given by symbol, BUT.
347 BUT defaults to the button whose label point is within." 357 BUT defaults to the button whose label point is within."
348 (interactive) 358 (interactive)
754 (display-buffer buf nil)))) 764 (display-buffer buf nil))))
755 (temp-buffer-show-function temp-buffer-show-hook) 765 (temp-buffer-show-function temp-buffer-show-hook)
756 (names (htype:names htype-sym)) 766 (names (htype:names htype-sym))
757 (term (hargs:read-match 767 (term (hargs:read-match
758 (concat (capitalize tstr) 768 (concat (capitalize tstr)
759 " to describe (RTN for all): ") 769 " to describe (RET for all): ")
760 (mapcar 'list (cons "" names)) 770 (mapcar 'list (cons "" names))
761 nil t nil htype-sym)) 771 nil t nil htype-sym))
762 nm-list 772 nm-list
763 doc-list) 773 doc-list)
764 (setq nm-list 774 (setq nm-list