Mercurial > hg > xemacs-beta
diff lisp/hyperbole/hbut.el @ 70:131b0175ea99 r20-0b30
Import from CVS: tag r20-0b30
author | cvs |
---|---|
date | Mon, 13 Aug 2007 09:02:59 +0200 |
parents | 4103f0995bd7 |
children | 4be1180a9e89 |
line wrap: on
line diff
--- a/lisp/hyperbole/hbut.el Mon Aug 13 09:00:04 2007 +0200 +++ b/lisp/hyperbole/hbut.el Mon Aug 13 09:02:59 2007 +0200 @@ -6,15 +6,15 @@ ;; KEYWORDS: extensions, hypermedia ;; ;; AUTHOR: Bob Weiner -;; ORG: InfoDock Associates +;; ORG: Brown U. ;; ;; ORIG-DATE: 18-Sep-91 at 02:57:09 -;; LAST-MOD: 17-Feb-97 at 15:31:03 by Bob Weiner +;; LAST-MOD: 25-Oct-95 at 04:12:59 by Bob Weiner ;; ;; This file is part of Hyperbole. ;; Available for use and distribution under the same terms as GNU Emacs. ;; -;; Copyright (C) 1991-1996, Free Software Foundation, Inc. +;; Copyright (C) 1991-1995, Free Software Foundation, Inc. ;; Developed with support from Motorola Inc. ;; ;; DESCRIPTION: @@ -46,17 +46,6 @@ "Maximum length of a hyper-button label.") -(defun ebut:act (label) - "Activates Hyperbole explicit button with LABEL from the current buffer." - (interactive (list (hargs:read-match "Activate explicit button labeled: " - (ebut:alist) - nil t nil 'ebut))) - (let* ((lbl-key (hbut:label-to-key label)) - (but (ebut:get lbl-key))) - (if but - (hbut:act but) - (error "(ebut:act): No explicit button labeled: %s" label)))) - (defun ebut:alist (&optional file) "Returns alist with each element a list containing a button label. For use as a completion table. Gets labels from optional FILE or current @@ -348,7 +337,7 @@ ;; Normalize label spacing (ebut:key-to-label (ebut:label-to-key lbl)))))))) - (if loc-p buts (if buts (nreverse (set:create buts)))))))) + (if loc-p buts (nreverse (set:create buts))))))) (fset 'map-ebut 'ebut:map) (defun ebut:map (but-func &optional start-delim end-delim @@ -623,7 +612,7 @@ (defun gbut:act (label) "Activates Hyperbole global button with LABEL." (interactive (list (hargs:read-match "Activate global button labeled: " - (mapcar 'list (gbut:label-list)) + (mapcar 'list (gbut:lbl-list)) nil t nil 'ebut))) (let* ((lbl-key (hbut:label-to-key label)) (but (ebut:get lbl-key nil gbut:file))) @@ -634,7 +623,7 @@ (defun gbut:help (label) "Displays help for Hyperbole global button with LABEL." (interactive (list (hargs:read-match "Report on global button labeled: " - (mapcar 'list (gbut:label-list)) + (mapcar 'list (gbut:lbl-list)) nil t nil 'ebut))) (let* ((lbl-key (hbut:label-to-key label)) (but (ebut:get lbl-key nil gbut:file))) @@ -642,10 +631,6 @@ (hbut:report but) (error "(gbut:help): No global button labeled: %s" label)))) -(defun gbut:label-list () - "Returns list of global button labels." - (mapcar 'hbut:key-to-label (gbut:key-list))) - ;;; ------------------------------------------------------------------------ (defun gbut:key-list () "Returns list of global button label keys." @@ -661,6 +646,10 @@ (error nil)) gbuts))))) +(defun gbut:lbl-list () + "Returns list of global button labels." + (mapcar 'hbut:key-to-label (gbut:key-list))) + ;;; ======================================================================== ;;; hattr class ;;; ======================================================================== @@ -786,7 +775,7 @@ (fset 'hattr:summarize 'hattr:report) (defvar hattr:filename - (if hyperb:microcruft-os-p "_hypb" ".hypb") + (if (memq system-type '(ms-windows windows-nt ms-dos)) "_hypb" ".hypb") "Per directory file name in which explicit button attributes are stored. If you change its value, you will be unable to use buttons created by others who use a different value!") @@ -797,8 +786,8 @@ (defun hbut:act (hbut) "Performs action for explicit or implicit Hyperbole button symbol HBUT." - (if hbut (apply 'actype:act (hattr:get hbut 'actype) - (hattr:get hbut 'args)))) + (and hbut (apply 'actype:act (hattr:get hbut 'actype) + (hattr:get hbut 'args)))) (defun hbut:action (hbut) "Returns appropriate action for Hyperbole button symbol HBUT." @@ -976,7 +965,7 @@ "Returns Hyperbole source buffer or file given at point. If a file, always returns a full path if optional FULL is non-nil." (goto-char (match-end 0)) - (cond ((looking-at "#<buffer \"?\\([^ \n\"]+\\)\"?>") + (cond ((looking-at "#<buffer \\([^ \n]+\\)>") (get-buffer (buffer-substring (match-beginning 1) (match-end 1)))) ((looking-at "\".+\"") @@ -1124,10 +1113,9 @@ (defun ibut:label-set (label &optional start end) "Sets current implicit button attributes from LABEL and START, END position. -Returns label. START and END are optional. When given, they specify the -region in the buffer to flash when this implicit button is activated or -queried for its attributes. If LABEL is a list, it is assumed to contain all -arguments." +START and END are optional. When given, they specify the region in the buffer +to flash when this implicit button is activated or queried for its attributes. +If LABEL is a list, it is assumed to contain all arguments." (cond ((stringp label) (hattr:set 'hbut:current 'lbl-key (hbut:label-to-key label)) (and start (hattr:set 'hbut:current 'lbl-start start)) @@ -1137,7 +1125,7 @@ (hattr:set 'hbut:current 'lbl-start (nth 1 label)) (hattr:set 'hbut:current 'lbl-end (nth 2 label))) (t (error "(ibut:label-set): Invalid label arg: '%s'" label))) - label) + t) ;;; ======================================================================== ;;; ibtype class - Implicit button types