
(require (quote hmoccur))

(require (quote hbmap))

(require (quote htz))

(require (quote hbdata))

(require (quote hact))

(defvar ebut:hattr-save t "\
*Non-nil value saves button data when button source is saved.
Nil disables saving.")

(defconst ebut:max-len 100 "\
Maximum length of a hyper-button 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
buffer." (mapcar (quote list) (ebut:list file)))

(defun ebut:at-p (&optional start-delim end-delim) "\
Returns explicit Hyperbole button at point or nil.
Assumes point is within first line of button label, if at all.
Optional START-DELIM and END-DELIM are strings that override default
button delimiters." (byte-code "ÄÁ
#… Å!)‡" [key nil start-delim end-delim ebut:label-p ebut:get] 4))

(defun ebut:create (&optional but-sym) "\
Creates Hyperbole explicit button based on optional BUT-SYM.
Default is 'hbut:current'.
Button should hold the following attributes (see 'hattr:set'): 
   lbl-key (normalized button label string),
   loc     (filename or buffer where button is located),
   dir     (directory name where button is located),
   actype  (action type that provides a default action for the button),
   action  (optional action that overrides the default),
   args    (list of arguments for action, if action takes a single
            argument of the button lbl-key, args may be nil).

If successful returns any instance number to append to button label
except when instance number would be 1, then returns t.  On failure,
returns nil.

If successful, leaves point in button data buffer, so caller should use
'save-excursion'.  Does not save button data buffer." (byte-code "ÃÁ
\"ÄÅ!ˆ)‡" [lbl-instance nil but-sym hbdata:write run-hooks ebut:create-hook] 3))

(defun ebut:delete (&optional but-sym) "\
Deletes Hyperbole explicit button based on optional BUT-SYM.
Default is 'hbut:current'.
Returns entry deleted (a list of attribute values) or nil." (byte-code "?… Ä‰ˆÅ!…$ ÆÇ\"ÆÂ\"È	
\"ÉÊ!ˆ+‡" [but-sym but-key loc entry hbut:current ebut:is-p hattr:get lbl-key hbdata:delete-entry run-hooks ebut:delete-hook] 6))

(defun ebut:get (&optional lbl-key buffer key-src) "\
Returns explicit Hyperbole button symbol given by LBL-KEY and BUFFER.
KEY-SRC is given when retrieving global buttons and is full source pathname.
Retrieves button data, converts into a button object and returns a symbol
which references the button.

All arguments are optional.  When none are given, returns symbol for
button that point is within or nil.  BUFFER defaults to the current
buffer." (byte-code "ÈÉ!ˆŠÇÇÇÇ† Ê ‰ˆ…) Ë!ƒ% q‚) ÌÍ\"ˆƒ3 Ç‚R ÎÊ \"ƒ? Ç‚E ebˆÏ!ˆÐÑ!‰…R p‰ˆ;…Z …ç ;…n Ò!Ó!‰ˆ…~ Ô†| 	#‰ˆ
?ƒŠ Ç‚ç ÕÉÄ#ˆÕÉÖ#ˆÕÉ×Ø#ˆÕÉÙÇ#ˆÕÉÃÚÛ
!‰!#ˆGÜU…½ ÕÉÝÞ
!#ˆÕÉßà
!#ˆÕÉáâ
!#ˆÕÉãä
!#ˆÕÉåæ
!#ˆÕÉçè
!#ˆÉ,)‡" [key-file key-dir but-data actype lbl-key buffer key-src nil hattr:clear hbut:current ebut:label-p bufferp error "(ebut:get): Invalid buffer argument: %s" equal ebut:next-occurrence ebut:key-src full file-name-directory file-name-nondirectory hbdata:get-entry hattr:set loc categ explicit action intern hbdata:actype 2 referent hbdata:referent args hbdata:args creator hbdata:creator create-time hbdata:create-time modifier hbdata:modifier mod-time hbdata:mod-time] 33))

(defun ebut:is-p (object) "\
Returns non-nil if OBJECT denotes an explicit Hyperbole button." (byte-code "9… ÁÂ\"Ã=‡" [object hattr:get categ explicit] 3))

(defun ebut:key-of-label-p (key label) "\
Returns t iff KEY matches to LABEL in a case insensitive manner." (byte-code ";… 	;… ÂÃÄ	!!\"‡" [key label equal downcase ebut:label-to-key] 5))

(defun ebut:key-src (&optional full) "\
Return key source (usually unqualified) for current Hyperbole button.
Also sets current buffer to key source.
With optional FULL when source is a pathname, the full pathname is returned." (byte-code "Ç ƒ	 p‚B È †B ŠŒÉ ˆÊ	ÂÃ#…$ hËU†$ `eU…* Ì!))†B ƒA ƒ; ‚> Í!‚B pÂ…e Î!ƒU q‚c ÏÐ!‰!…c Ñ!qˆ*‡" [src hbut:source-prefix nil t full buffer-file-name buf hmail:mode-is-p ebut:key-src-fmt widen search-backward 10 hbut:source file-name-nondirectory bufferp file-readable-p hpath:symlink-referent find-file-noselect] 11))

(defun ebut:key-src-fmt nil "\
Returns unformatted filename associated with formatted current buffer.
This is used to obtain the source of explicit buttons for buffers that
represent the output of particular document formatters." (byte-code "Ã=† ÄÅÆ \"…8 
… 
ÇÄÈ
\"OÉ	ÊP!ƒ( 	ÊP‚7 É	ËP!ƒ6 	ËP‚7 p)‡" [major-mode src buffer-file-name Info-mode string-match "\\.info\\(-[0-9]+\\)?$" buffer-name 0 "\\.[^.]+$" file-exists-p ".texinfo" ".texi"] 7))

(defun ebut:key-to-label (lbl-key) "\
Unnormalizes LBL-KEY and returns a label string approximating actual label." (byte-code "…L ÅGÆÆ	
W…I 	HÇUƒ< 	T
U†, È	THÇ\"ƒ3 É‚9 	T‰ˆÊ‚? Ë!P	T‰ˆ‚ ˆ,‡" [lbl-key pos len lbl c 0 nil 95 /= " " "_" char-to-string] 5))

(defun ebut:label-p (&optional as-label start-delim end-delim pos-flag) "\
Returns key for Hyperbole button label that point is within.
Returns nil if not within a label.
Assumes point is within first line of button label, if at all.
If optional AS-LABEL is non-nil, label is returned rather than the key
derived from the label.  Optional START-DELIM and END-DELIM are strings
that override default button delimiters.  With optional POS-FLAG non-nil,
returns list of label-or-key, but-start-position, but-end-position.
Positions include delimiters." (byte-code "``TÑÍÍÍÍÍ† 	‰ˆ
†( ‰
ˆŠÒ ˆÓ
Ô!P	Ì#…A Ì‰ˆ‚- ˆ…P ÓÕÔ
!P	Ì#…Z Í‰ˆ‚- ˆ…Ç `Ö×!‰ˆØÙh!Uƒw ÍÚÛ�‚z SbˆÓ
Ô
!P\\Ì#…Ç ``
GZÜ\"‰…Ç ƒ» ƒ° E‚¸ Ý!E‚Ç ƒÄ ‚Ç Ý!).‡" [opoint npoint quoted start label end but-start but-end start-delim ebut:start end-delim ebut:end t nil ebut:max-len pos-flag as-label "\\(^\\|[^\\{]\\)" beginning-of-line re-search-forward regexp-quote "[^\\{]" match-end 1 40 char-syntax (byte-code "ÀÁ!ˆÂ ˆÀÃ!‡" [forward-char -1 forward-list -2] 4) ((error (goto-char (1- opoint)))) buffer-substring ebut:label-to-key] 14))

(defun ebut:label-regexp (lbl-key &optional no-delim) "\
Unnormalizes LBL-KEY.  Returns regular expr matching delimited but label.
Optional NO-DELIM leaves off delimiters and leading and trailing space." (byte-code "…{ ËGÌÍÎƒ Ï‚ Ð!PÌ		
W…c 	HÑUƒS 	T
U†C Ò	THÑ\"ƒJ ‚P 	T‰ˆÓ‚X ÐÔ!!P	T‰ˆ‚# ˆƒn ‚y Ð
!Q‰.‡" [lbl-key pos len c sep0 sep regexp no-delim ebut:start case-fold-search ebut:end 0 nil "[ 	
]*" "[ 	
]+" "" regexp-quote 95 /= "_" char-to-string] 8))

(defun ebut:label-to-key (label) "\
Normalizes LABEL for use as a Hyperbole button key and returns key.
Eliminates any fill prefix in the middle of the label, replaces '_' with
'__', removes leading and trailing whitespace and replaces each other
whitespace sequence with '_'." (byte-code "?ƒ	 Á‚\" Ã!ÄÅÆ#ÄÇÈÂ$‰ˆÄÉÇÂ$‡" [label nil t hbut:fill-prefix-remove hypb:replace-match-string "\\`[ 	
]+\\|[ 	
]+\\'" "" "_" "__" "[ 	
]+"] 8))

(defun ebut:list (&optional file loc-p) "\
Returns list of button labels from given FILE or current buffer.
Removes duplicate labels if optional LOC-P is omitted.  With LOC-P, returns
list of elements (label start end) where start and end are the buffer
positions at which the starting button delimiter begins and ends." (interactive) (byte-code "ƒ Ã!… Ä!‚ p‰ˆ…5 qˆÅ
ƒ$ Æ‚% Ç!
ƒ/ 	‚4 ÈÉ	!!)‡" [file buts loc-p file-exists-p find-file-noselect ebut:map (lambda (lbl start end) (list (ebut:key-to-label (ebut:label-to-key lbl)) start end)) (lambda (lbl start end) (ebut:key-to-label (ebut:label-to-key lbl))) nreverse set:create] 6))

(fset (quote map-ebut) (quote ebut:map))

(defun ebut:map (but-func &optional start-delim end-delim regexp-match include-delims) "\
Applies BUT-FUNC to buttons delimited by optional START-DELIM and END-DELIM.
If REGEXP-MATCH is non-nil, only buttons which matching this argument are
operated upon.
Maps over portion of buffer visible under any current restriction.
BUT-FUNC must take precisely three arguments: the button label, the
start position of the delimited button label and its end position (positions
include delimiters when INCLUDE-DELIMS is non-nil).
If END-DELIM is a symbol, e.g. t, then START-DELIM is taken as a regular
expression which matches an entire button string." (byte-code "† 	‰ˆ
† ‰ˆ
9† 
ÑÍOÍÍÍÍ	Í
ÍŠebˆƒ; Ò‚< Ó‰ˆÔƒI ‚T ÕÖ!×ØÖ
!%ÍÎ#…Â Ù!Ú!	ÛÙÒ!ÚÒ!\"
ÛÙÓ!ÚÓ!\"‰ˆŠbˆhÜU†Š hÝU…‘ Î‰)ˆƒŸ Í‰‚¾ ?†« Þ
\"…¾ ß	$B‰ˆ‚@ )ˆà!.‡" [start-delim ebut:start end-delim ebut:end regexp end-sym rtn quoted start end but lbl include-delims nil t regexp-match but-func -1 0 1 re-search-forward concat regexp-quote "\\([^" "]+\\)" match-beginning match-end buffer-substring 92 123 string-match funcall nreverse] 19))

(defun ebut:modify (&optional lbl-key but-sym) "\
Modifies existing Hyperbole button from optional LBL-KEY and BUT-SYM.
Defaults are the key for any button label at point and 'hbut:current'.
If successful, returns button's instance number except when instance
number is 1, then returns t.  On failure, as when button does not exist,
returns nil.

If successful, leaves point in button data buffer, so caller should use
'save-excursion'.  Does not save button data buffer." (byte-code "ŠÃ	
\"ÄÅ!ˆ))‡" [lbl-instance lbl-key but-sym hbdata:write run-hooks ebut:modify-hook] 3))

(defun ebut:next-occurrence (lbl-key &optional buffer) "\
Moves point to next occurrence of button with LBL-KEY in optional BUFFER.
BUFFER defaults to current buffer.  It may be a buffer name.
Returns non-nil iff occurrence is found.

Remember to use (goto-char (point-min)) before calling this in order to
move to the first occurrence of the button." (byte-code "…  Å!† ;… Æ!?ƒ ÇÈ\"‚  É!ˆÊË	!ÂÃ#…2 ÌÍ!G\\b‡" [buffer lbl-key nil t ebut:start bufferp get-buffer error "(ebut:next-occurrence): Invalid buffer arg: %s" switch-to-buffer re-search-forward ebut:label-regexp match-beginning 0] 9))

(defun ebut:operate (curr-label new-label) "\
Operates on a new or existing Hyperbole button given by CURR-LABEL.
When NEW-LABEL is non-nil, this is substituted for CURR-LABEL and the
associated button is modified.  Otherwise, a new button is created.
Returns instance string appended to label to form unique label, nil if
label is already unique.  Signals an error when no such button is found
in the current buffer." (byte-code "Ñ	!Ò!Ç† 	‰ˆÓÔÀÑ!#ˆŠƒ' Õ!‚) Ö ‰…5 × …5 Ø )ˆƒƒy ÙÇÇÇÚ$Û@Ñ!\"…a ÜÝ8Þ8#ˆßàÇÇ
á%†u †u âã	\"*‚É ÇÇÇ
	ä …› Ûå 	æ 
ç	
\"‰	\"ƒ¢ Ç‚À èé	!!ƒ¶ `	êë!‰
‚À `		cˆ`‰
ˆÜ	
#+ˆÑ!ÛÙ \"ƒê ìÝ!ˆíÇÌ#ˆêë!b‚Ò!îÇÌ#†ÿ ïÇÌ#)…ðë!G\\b)ˆ;…‚âñ\",‡" [lbl-key curr-label lbl-regexp modify new-label instance-flag but-key-and-pos nil at-but start end buf-lbl t new-key ebut:start regexp hattr:filename ebut:label-to-key ebut:label-regexp hattr:set hbut:current ebut:modify ebut:create hmail:editor-p hmail:msg-narrow ebut:label-p pos equal ebut:delimit 1 2 ebut:map (lambda (lbl start end) (byte-code "Ä	\"ˆÅ`
cˆ`#‡" [start end new-label instance-flag delete-region ebut:delimit] 5)) include-delims hypb:error "(ebut:operate): No button matching: %s" mark region-beginning region-end buffer-substring looking-at regexp-quote match-end 0 forward-char search-backward re-search-forward re-search-backward match-beginning "(ebut:operate): Operation failed.  Check button attribute permissions: %s"] 37))

(defun ebut:search (string out-buf &optional match-part) "\
Writes explicit button lines matching STRING to OUT-BUF.
Uses Hyperbole space into which user has written buttons for the search.
By default, only matches for whole button labels are found, optional MATCH-PART
enables partial matches." (byte-code "ØÙÚ \"ÛÅŠqˆÅ‰ˆÜ ˆÝ ˆÅÅÅÅÅ
	…ƒ@;…7 …C Þ!?A‰ˆƒf ß!…Z à!á!‰
‚m â!‰ˆ…† …† ãŽä#‰	)ˆ	…ÅÅ	…~	@‰ˆ?ƒ¨ Å‚z	A	å@
\"AÞ!?†Ö ß!…Ö à!‰ˆ?ƒì qˆæçè#‚zqˆéŽŠÜ ˆêbˆÐë\"Ð‰ˆìÅÐ#…l	T‰ˆíe`\"îï\"ÅÅÅð ˆ`ñÛ!bˆò ˆ`ó\"‰ˆbˆŠqˆ
…_æôõ$ˆÅ‰ˆæ\")-ˆ‚ˆqˆ
?…wöc*))ˆ‚’ *ˆ‚' -)ˆ	+‡" [buffers total firstmatch out-buf buffer-read-only nil currbuf currfile kill-buf src-matches dir string match-part elt matches case-fold-search t regexp linenum tag lns start end hbut:source-prefix mapcar (lambda (dir) (expand-file-name hattr:filename dir)) hbmap:dir-list 0 widen erase-buffer get-file-buffer file-readable-p find-file-noselect file-name-directory buffer-file-name ((if kill-buf (kill-buffer currbuf))) hbdata:search expand-file-name insert "ERROR: (ebut:search): \"" "\" is not readable.

" ((if kill-buf (kill-buffer currbuf))) 1 ebut:match-regexp re-search-forward count-lines format "
%4d:" end-of-line match-beginning beginning-of-line buffer-substring "\"" "\"
" "

"] 32))

(defun ebut:delimit (start end instance-str) "\
Delimits button label spanning region START to END in current buffer.
If button is already delimited or delimit fails, returns nil, else t.
Inserts INSTANCE-STR after END, before ending delimiter." (byte-code "bˆÈÉ	!!… Ê	G!ˆË ƒ Â‚S ;?…\" Ì‰ˆ	cˆ	G\\‰bˆÍ\"ˆÎGG#‰ˆÏÐ!…I Ð#ˆÑ\"ˆbˆÇ‡" [start ebut:start nil instance-str end ebut:end ep:but t looking-at regexp-quote forward-char ebut:label-p "" insert + fboundp ep:but-add hbut:comment] 11))

(defun ebut:match-regexp (match-keys match-part) "\
Returns regexp to match to all explicit button keys from MATCH-KEYS." (byte-code "ƒ Ä	ÅÆOÇQ‚ È‰ˆÉÊ
!ËÌÍÎ#ÏÊ	!&‡" [match-part ebut:end ebut:start match-keys "[^" -1 nil "]*" "[ 	
]*" concat regexp-quote "\\(" mapconcat (lambda (key) (ebut:label-regexp key (quote no-delim))) "\\|" "\\)"] 11))

(defconst ebut:end ")>" "\
String matching the end of a hyper-button.")

(defconst ebut:instance-sep ":" "\
String of one character, separates an ebut label from its instance num.")

(defconst ebut:start "<(" "\
String matching the start of a hyper-button.")

(defvar gbut:file (expand-file-name hbmap:filename hbmap:dir-user) "\
File that stores Hyperbole buttons accessible by name, global buttons.")

(defun gbut:act (label) "\
Activates Hyperbole global button with LABEL." (interactive (byte-code "ÂÃÄÅÆ \"ÀÁÀÇ&C‡" [nil t hargs:read-match "Activate global button labeled: " mapcar list gbut:lbl-list ebut] 9)) (byte-code "Å	!ÆÃ#
ƒ Ç
!‚ ÈÉ	\"*‡" [lbl-key label but nil gbut:file hbut:label-to-key ebut:get hbut:act error "(gbut:act): No global button labeled: %s"] 6))

(defun gbut:help (label) "\
Displays help for Hyperbole global button with LABEL." (interactive (byte-code "ÂÃÄÅÆ \"ÀÁÀÇ&C‡" [nil t hargs:read-match "Report on global button labeled: " mapcar list gbut:lbl-list ebut] 9)) (byte-code "Å	!ÆÃ#
ƒ Ç
!‚ ÈÉ	\"*‡" [lbl-key label but nil gbut:file hbut:label-to-key ebut:get hbut:report error "(gbut:help): No global button labeled: %s"] 6))

(defun gbut:key-list nil "\
Returns list of global button label keys." (byte-code "ŠÄ!…& ÂŒÅ`ÆÇÂÃ#ƒ `‚ d\"ˆebˆÂÈÉ�ˆ	)))‡" [gbut:file gbuts nil t hbdata:to-entry-buf narrow-to-region search-forward "" (byte-code "Áp!@B‰… Âˆ‚  ‡" [gbuts read nil] 3) ((error nil))] 7))

(defun gbut:lbl-list nil "\
Returns list of global button labels." (mapcar (quote hbut:key-to-label) (gbut:key-list)))

(defun hattr:attributes (obj-symbol) "\
Returns a list of OBJ-SYMBOL's attributes as symbols." (byte-code "9… Ä!ÅÆÃÇÈ	\"\"*‡" [obj-symbol attr-val-list i nil symbol-plist -1 delq mapcar (lambda (elt) (setq i (1+ i)) (and (= (mod i 2) 0) elt))] 6))

(defun hattr:clear (hbut) "\
Removes all of HBUT's attributes except `variable-documentation'." (byte-code "Â	9† ÃÄ	\"ˆÅÆ	!>‰ƒ# ÇAÂ\"ˆÈ	\"‚' È	Â\")‡" [sublist hbut nil error "(hattr:clear): Argument not a Hyperbole button: %s" variable-documentation symbol-plist setcdr setplist] 7))

(defun hattr:copy (from-hbut to-hbut) "\
Copies attributes FROM-HBUT TO-HBUT, eliminating attributes TO-HBUT had.
Returns TO-HBUT." (byte-code "ÃÄ	D\"ˆÅŽÂ)ˆ	‡" [from-hbut to-hbut nil mapcar (lambda (hbut) (or (and hbut (symbolp hbut)) (error "(hattr:clear): Argument not a Hyperbole button: %s" hbut))) ((byte-code "Â!ˆÃÄÅÆ	!\"\"‡" [to-hbut from-hbut hattr:clear setplist mapcar identity symbol-plist] 7))] 4))

(defun hattr:get (obj-symbol attr-symbol) "\
Returns value of OBJ-SYMBOL's attribute ATTR-SYMBOL." (get obj-symbol attr-symbol))

(defun hattr:list (obj-symbol) "\
Returns a property list of OBJ-SYMBOL's attributes.
Each pair of elements is: <attrib-name> <attrib-value>." (byte-code "9ƒ Á!‚ ÂÃ\"‡" [obj-symbol symbol-plist error "(hattr:list): Argument not a symbol: %s"] 4))

(defun hattr:memq (attr-symbol obj-symbol) "\
Returns t if ATTR-SYMBOL is in OBJ-SYMBOL's attribute list, else nil." (byte-code "9…! 	9…! Ç!ÈÉÅÊË
\"\")	>…  Æ*‡" [obj-symbol attr-symbol attr-val-list attr-list i nil t symbol-plist -1 delq mapcar (lambda (elt) (setq i (1+ i)) (and (= (mod i 2) 0) elt))] 6))

(defun hattr:report (attrib-list) "\
Pretty prints to standard-output attribute-value pairs from ATTRIB-LIST.
Ignores nil valued attributes.  Returns t unless no attributes are printed." (byte-code "ÅÅÅÅ?† <?† ÉGÊ\"ËUƒ! Å‚¯ @‰…­ A‰@A‰ˆ
…© ÆÌ	!Í	GZË]‰ˆÎÏ!ˆÎ	!ˆÎÐ!ˆÎÑÒ\"!ˆÅÓÔÕ	\"ƒ} Ö

×HØY…w 
×HÙX…w Ú#‚¤ 
;ƒ† 
‚‰ Û
!‰…” ÔÜ\"ƒ£ ÝÞ×!ÅO!‚¤ 
!)ˆß ˆ‚! ˆ,‡" [has-attr attr val len attrib-list nil t str htz:local % 2 1 symbol-name 16 princ "   " ":" make-string 32 prin1 string-match "time" htz:date-unix 0 48 57 "GMT" prin1-to-string "\\`actypes::" intern match-end terpri] 18))

(defun hattr:save nil "\
Saves button attribute file for current directory, if modified.
Suitable for use as part of 'write-file-hooks'." (byte-code "Æ	
\"
;… Ç!… … p=?…7 ÅÈ!…6 ŠqˆÉ ˆÈ!†5 Ê!))*ˆÅ‡" [bd-file hattr:filename default-directory buf ebut:hattr-save nil expand-file-name get-file-buffer buffer-modified-p save-buffer kill-buffer] 7))

(defun hattr:set (obj-symbol attr-symbol attr-value) "\
Sets OBJ-SYMBOL's attribute ATTR-SYMBOL to ATTR-VALUE." (put obj-symbol attr-symbol attr-value))

(fset (quote hattr:summarize) (quote hattr:report))

(defvar hattr:filename ".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!")

(defun hbut:act (hbut) "\
Performs action for explicit or implicit Hyperbole button symbol HBUT." (byte-code "… ÁÂÃÄ\"ÃÅ\"#‡" [hbut apply actype:act hattr:get actype args] 7))

(defun hbut:action (hbut) "\
Returns appropriate action for Hyperbole button symbol HBUT." (byte-code "Ä	À\"ÅÅÆ=ƒ Ä	Ã\"Ä	Ç\"‰‚# ÄÇ\"‰ˆÈ
!GÉUƒ1 
‚8 †8 Ê
!+‡" [categ hbut atype action hattr:get nil explicit actype symbol-name 2 actype:action] 7))

(defun hbut:at-p nil "\
Returns symbol for explicit or implicit Hyperbole button at point or nil." (or (ebut:at-p) (ibut:at-p)))

(defun hbut:comment (start end) "\
Comment button label spanning region START to END in current buffer.
Use buffer commenting grammar, if any, otherwise don't comment." (byte-code "Š…p Æ	Ç\"† 	?ƒ2 È ˆÉ
Ã#ƒ  Ä‚/ 
bˆcˆÊhË\"…/ Ëc‚p ÌÍ!ÎÍ	!QÄÃ#…F ÏÍ!!ƒM Ä‚p 
bˆcˆÊhË\"…\\ Ëcˆ`
Z\\bˆÊgË\"…m Ëcˆ	c)‡" [comment-start comment-end start t nil end equal "" beginning-of-line search-forward /= 32 re-search-backward regexp-quote "\\|" looking-at] 13))

(defvar hbut:fill-prefix-regexps (quote ("
[ 	]*\\([:|<>]+ *\\)+" "
[ 	]*[^'`\"< 	]*> *" "
[ 	]*\\(;+[ 	]*\\)+" "
[ 	]*\\(#+[ 	]*\\)+" "
[ 	]*//[/ 	]+" "\\*+[/)][ 	]*
+[ 	]*[/(]\\*+" "}[ 	]*
+[ 	]*{" "
[ 	]*--[ 	]+" "
[Cc][ 	]+" "
[ 	]*\\(%+[ 	]*\\)+")) "List of regexps of fill prefixes to remove from the middle of buttons.")

(defun hbut:fill-prefix-remove (label) "\
Removes any recognized fill prefix from within LABEL.
'hbut:fill-prefix-regexps' is a list of fill prefixes to recognize." (byte-code "ÂÃ\"… ÄÅ	\"ˆ‡" [label hbut:fill-prefix-regexps string-match "
" mapcar (lambda (fill-prefix) (and (string-match "
" label) (setq label (hypb:replace-match-string fill-prefix label " " t))))] 4))

(defun hbut:is-p (object) "\
Returns non-nil if object denotes a Hyperbole button." (byte-code "9…	 ÁÂ\"‡" [object hattr:get categ] 3))

(byte-code "ÀÁMˆÂÃMˆÄÅMˆÆÇM‡" [hbut:key-src ebut:key-src hbut:key-to-label ebut:key-to-label hbut:label-p ebut:label-p hbut:label-to-key ebut:label-to-key] 2)

(defun hbut:report (&optional arg) "\
Pretty prints the attributes of a button or buttons.

Takes an optional ARG interpreted as follows:
  a button symbol - report on that button;
  nil             - report on button at point, if any;
  integer > 0     - report on all explicit buttons in buffer, alphabetize;
  integer < 1     - report on all explicit buttons in occurrence order;

Returns number of buttons reported on or nil if none." (byte-code "Ë!† 9ƒ ‚& <ƒ% Ë@‰!ƒ! ‚\" Ì‚& Ì‰ˆ…/ 9ƒ6 ‚8 Í 
…A Î
Ï\"
…J Î
Ð\"†O Ñ ?ƒ` …] Ò!C‚… 9ƒu Ó!…r ÒÎÏ\"!C‚… ÌWƒ€ Ô ‚… ÕÔ Ö\"Gp× Ø	…² �Ù
!ˆÚ!ˆÛ ˆÛ ˆÜÝ\"‘ˆG.‡" [arg t but curr-key key-src lbl-lst total key-buf buf-name attribs hbut:source-prefix integerp 1 hbut:at-p hattr:get lbl-key loc hbut:key-src ebut:key-to-label hbut:is-p ebut:list sort (lambda (s1 s2) (string< (downcase s1) (downcase s2))) hypb:help-buf-name nil princ prin1 terpri mapcar (lambda (lbl) (if (setq but (cond ((or (null arg) (symbolp arg)) but) (t (ebut:get (ebut:label-to-key lbl) key-buf))) attribs (hattr:list but)) (progn (princ (if (ibut:is-p but) lbl (concat ebut:start lbl ebut:end))) (terpri) (let ((doc (actype:doc but (= 1 (length lbl-lst))))) (if doc (progn (princ "  ") (princ doc) (terpri)))) (hattr:report (if (eq (car (cdr (memq (quote categ) attribs))) (quote explicit)) (memq (quote action) attribs) (memq (quote categ) attribs))) (terpri))))] 22))

(defun hbut:source (&optional full) "\
Returns Hyperbole source buffer or file given at point.
If a file, always returns a full path if optional FULL is non-nil." (byte-code "ÄÅ!bˆÆÇ!ƒ ÈÉÊË!ÄË!\"!‚? ÆÌ!…? ÉÊÅ!TÄÅ!S\"Í!
…3 	?ƒ= Î\"‚> *‡" [file absolute full default-directory match-end 0 looking-at "#<buffer \\([^ 
]+\\)>" get-buffer buffer-substring match-beginning 1 "\".+\"" file-name-absolute-p expand-file-name] 14))

(fset (quote hbut:summarize) (quote hbut:report))

(defvar hbut:current nil "\
Currently selected Hyperbole button.
Available to action routines.")

(defconst hbut:source-prefix moccur-source-prefix "\
String found at start of a buffer containing only a hyper-button menu.
   This expression should be followed immediately by a file-name indicating the
source file for the buttons in the menu, if any.")

(require (quote set))

(defmacro htype:create (type parent doc property-list) "Creates a new Hyperbole TYPE (an unquoted symbol)
TYPE is derived from PARENT (an unquoted symbol).
DOC is a string describing the type.
Attaches PROPERTY-LIST to the new type and returns the symbol for the type." (byte-code "ÅÆ	!ÇÆ
!Q!ÈÉÊËDËÌBBDEÍËDË	DÎFÏËD%)‡" [sym parent type doc property-list intern symbol-name "::" list progn setplist quote variable-documentation symset:add (quote types) (run-hooks (quote htype:create-hook))] 11))

(defun htype:doc (htype-sym) "\
Return documentation for HTYPE-SYM." (documentation-property htype-sym (quote variable-documentation)))

(defun htype:delete (type parent) "\
Deletes a Hyperbole TYPE (a symbol) derived from PARENT (a symbol).
Returns the Hyperbole symbol for the TYPE if it existed, else nil." (byte-code "ÅÆ	!ÇÆ
!Q!	ÈN>ÉÄ\"ˆÊ	È#ˆËÌ!ˆ…% *‡" [sym parent type exists nil intern symbol-name "::" types setplist symset:delete run-hooks htype:delete-hook] 8))

(defun htype:names (htype-sym &optional sym) "\
Returns list of current names for Hyperbole HTYPE-SYM in unsorted order.
HTYPE-SYM is either 'actypes or 'ibtypes.
When optional SYM is given, return the name for that symbol only, if any." (byte-code "ÇÄÄÈÄÉÊË\"\"\"ƒ1 9…. Ì\"‰…. Í	\"…. 	‚2 ,‡" [nm-func nm pos names nil htype-sym sym (lambda (sym) (setq nm (symbol-name sym) pos (if (string-match "::" nm) (match-end 0))) (if pos (substring nm pos) nm)) delq mapcar hattr:get types funcall set:member] 7))

(defun ibut:at-p (&optional key-only) "\
Returns symbol for implicit button at point, else nil.
With optional KEY-ONLY, returns only the label key for button." (byte-code "ÆÀNÇÈÈÈÉÊ!ˆ?… …7 @‰ˆËÌ
Í\"!‰ƒ/ 
‰‚3 A‰ˆ‚ ˆ…s ƒG ÌÊÎ\"‚s ÏÊÐŠÑÒ!)#ˆÏÊÓ#ˆÌÊÃ\"†q <?†q ÏÊÔ@#ˆÏÊÃA#ˆÊ-‡" [types hrule:action itype args is-type key-only ibtypes actype:identity nil hattr:clear hbut:current eval hattr:get at-p lbl-key hattr:set loc hbut:key-src full categ actype] 13))

(defun ibut:is-p (object) "\
Returns non-nil if object denotes an implicit Hyperbole button." (byte-code "9… ÂÁ\"	… ÃÄÅÆ	!\"=)‡" [object categ hattr:get 0 string-match "ibtypes::" symbol-name] 6))

(defun ibut:label-p nil "\
Returns key for Hyperbole implicit button label that point is on or nil." (ibut:at-p (quote key-only)))

(defun ibut:label-set (label &optional start end) "\
Sets current implicit button attributes from LABEL and START, END position.
START and END are OPTIONAL.
If LABEL is a list, it is assumed to contain all arguments." (byte-code ";ƒ# ÄÅÆÇ!#ˆ	… ÄÅÈ	#ˆ
…  ÄÅÉ
#‚S …) <ƒO ÄÅÆÇ@!#ˆ	…@ ÄÅÈÊ8#ˆ
…L ÄÅÉË8#‚S ÌÍ\"ˆÃ‡" [label start end t hattr:set hbut:current lbl-key hbut:label-to-key lbl-start lbl-end 1 2 error "(ibut:label-set): Invalid label arg: '%s'"] 12))

(byte-code "ÀÁMˆÂÁÃÄ#‡" [defib ibtype:create put lisp-indent-hook defun] 4)

(defmacro ibtype:create (type params doc at-p &optional to-p style) "Creates implicit button TYPE (unquoted sym) with PARAMS, described by DOC.
PARAMS are presently ignored.

  AT-P is a boolean form of no arguments which determines whether or not point
is within a button of this type.
  Optional TO-P is a boolean form which moves point immediately after the next
button of this type within the current buffer and returns a list of (button-
label start-pos end-pos), or nil when none is found.
  Optional STYLE is a display style specification to use when highlighting
buttons of this type; most useful when TO-P is also given.

Returns symbol created when successful, else nil.  Nil indicates that action
type for ibtype is presently undefined." (byte-code "… ÅÆÇ	ÅÂ
ÃÄ&%‡" [type doc at-p to-p style list htype:create ibtypes] 12))

(defun ibtype:delete (type) "\
Deletes an implicit button TYPE (a symbol).
Returns TYPE's symbol if it existed, else nil." (htype:delete type (quote ibtypes)))

(require (quote set))

(defun symset:add (elt symbol prop) "\
Adds ELT to SYMBOL's PROP set.
Returns nil iff ELT is already in SET.  Uses 'eq' for comparison." (byte-code "	
NÇÈ\"ƒ ‚ ƒ B‰‚ C…) É	
#+‡" [set symbol prop set:equal-op new-set elt t eq set:member put] 5))

(fset (quote symset:delete) (quote symset:remove))

(defun symset:remove (elt symbol prop) "\
Removes ELT from SYMBOL's PROP set and returns the new set.
Assumes PROP is a valid set.  Uses 'eq' for comparison." (byte-code "	
NÉÊ	
Ë\"…G GÌUƒ$ Ç‰‚G GÌUƒ: ÍÎGÏZ\"Ç\"‚G ÐA@\"ˆÍAA\"ˆ*#*‡" [set symbol prop set:equal-op rest elt rtn nil t eq put set:member 1 setcdr nthcdr 2 setcar] 10))

(provide (quote hbut))
