Mercurial > hg > xemacs-beta

comparison lisp/hyperbole/hui.el @ 70:131b0175ea99 r20-0b30

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r20-0b30
author cvs
date Mon, 13 Aug 2007 09:02:59 +0200
parents 4103f0995bd7
children 4be1180a9e89
comparison
equal deleted inserted replaced
69:804d1389bcd6 70:131b0175ea99
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: InfoDock Associates 9 ;; ORG: Brown U.
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: 10-Nov-96 at 01:51:13 by Bob Weiner 12 ;; LAST-MOD: 25-Aug-95 at 02:26:56 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-1996, Free Software Foundation, Inc. 17 ;; Copyright (C) 1991-1995, 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:label-list)) 290 (mapcar 'list (gbut:lbl-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)))))
354 344
355 (defun hui:hbut-help (&optional but) 345 (defun hui:hbut-help (&optional but)
356 "Checks for and explains an optional button given by symbol, BUT. 346 "Checks for and explains an optional button given by symbol, BUT.
357 BUT defaults to the button whose label point is within." 347 BUT defaults to the button whose label point is within."
358 (interactive) 348 (interactive)
764 (display-buffer buf nil)))) 754 (display-buffer buf nil))))
765 (temp-buffer-show-function temp-buffer-show-hook) 755 (temp-buffer-show-function temp-buffer-show-hook)
766 (names (htype:names htype-sym)) 756 (names (htype:names htype-sym))
767 (term (hargs:read-match 757 (term (hargs:read-match
768 (concat (capitalize tstr) 758 (concat (capitalize tstr)
769 " to describe (RET for all): ") 759 " to describe (RTN for all): ")
770 (mapcar 'list (cons "" names)) 760 (mapcar 'list (cons "" names))
771 nil t nil htype-sym)) 761 nil t nil htype-sym))
772 nm-list 762 nm-list
773 doc-list) 763 doc-list)
774 (setq nm-list 764 (setq nm-list