Merge remote-tracking branch 'hyperbole/master' into externals/hyperbolescratch/hyperbole-lexbind

1 files changed, 185 insertions, 69 deletions

diff --git a/hui.el b/hui.el
index d32ea3d..12f2680 100644
--- a/hui.el
+++ b/hui.el
@@ -1,4 +1,4 @@
-;;; hui.el ---  GNU Hyperbole button and hyperlink user interface
+;;; hui.el --- GNU Hyperbole button and hyperlink user interface
 ;;
 ;; Author:       Bob Weiner
 ;;
@@ -65,8 +65,27 @@
 	       (message "{%s} now runs `%s'; prior {%s} binding removed" new-key-text cmd old-key-text))
       (message "{%s} now runs `%s'" new-key-text cmd))))
 
+(defun hui:ebut-act (&optional but)
+  "Executes action for optional explicit button symbol BUT in current buffer.
+Default is the current button."
+  (interactive
+   (let ((but (ebut:at-p)) (lst))
+     (list
+      (cond (but)
+	    ((setq lst (ebut:alist))
+	     (ebut:get (ebut:label-to-key
+			(hargs:read-match "Button to execute: " lst nil t
+					  (ebut:label-p 'as-label) 'ebut))))
+	    (t (hypb:error "(ebut-act): No explicit buttons in buffer."))))))
+  (cond ((and (called-interactively-p 'interactive) (null but))
+	 (hypb:error "(ebut-act): No current explicit button to activate."))
+	((not (hbut:is-p but))
+	 (hypb:error "(ebut-act): Explicit button is invalid; it has no attributes."))
+	(t (or but (setq but 'hbut:current))
+	   (hui:but-flash) (hbut:act but))))
+
 (defun hui:ebut-create (&optional start end)
-  "Creates an explicit but starting from label between optional START and END.
+  "Creates an explicit Hyperbole button starting from label between optional START and END.
 Indicates by delimiting and adding any necessary instance number of the button
 label."
   (interactive (list (and (marker-position (hypb:mark-marker t))
@@ -79,10 +98,10 @@ label."
 	    (hui:hbut-label-default start end (not (called-interactively-p 'interactive)))
 	    lbl (hui:hbut-label default-lbl "ebut-create"))
       (if (not (equal lbl default-lbl)) (setq default-lbl nil))
-      
+
       (setq but-buf (if default-lbl (current-buffer) (hui:ebut-buf)))
       (hui:buf-writable-err but-buf "ebut-create")
-      
+
       (hattr:set 'hbut:current 'loc (hui:key-src but-buf))
       (hattr:set 'hbut:current 'dir (hui:key-dir but-buf))
       (setq actype (hui:actype))
@@ -118,7 +137,7 @@ Signals an error if point is not within a button."
 	    (hui:ebut-delete-op interactive but-key key-src)
 	  (message ""))
       (hui:ebut-delete-op interactive but-key key-src))))
-      
+
 (defun hui:ebut-edit ()
   "Creates or modifies an explicit Hyperbole button when conditions are met.
 A region must have been delimited with the action-key and point must now be
@@ -153,13 +172,13 @@ Signals an error when no such button is found in the current buffer."
 	(but-buf (current-buffer))
 	actype but new-lbl)
     (save-excursion
-      (or (called-interactively-p 'interactive)
-	  (hui:buf-writable-err but-buf "ebut-modify"))
-      
-      (or (setq but (ebut:get lbl-key but-buf))
-	  (progn (pop-to-buffer but-buf)
-		 (hypb:error "(ebut-modify): Invalid button, no data for '%s'." lbl)))
-      
+      (unless (called-interactively-p 'interactive)
+	(hui:buf-writable-err but-buf "ebut-modify"))
+
+      (unless (setq but (ebut:get lbl-key but-buf))
+	(pop-to-buffer but-buf)
+	(hypb:error "(ebut-modify): Invalid button, no data for '%s'." lbl))
+
       (setq new-lbl
 	    (hargs:read
 	     "Change button label to: "
@@ -169,7 +188,7 @@ Signals an error when no such button is found in the current buffer."
 	     (format "(ebut-modify): Enter a string of at most %s chars."
 		     ebut:max-len)
 	     'string))
-      
+
       (hattr:set 'hbut:current 'loc (hui:key-src but-buf))
       (hattr:set 'hbut:current 'dir (hui:key-dir but-buf))
       (setq actype (hui:actype (hattr:get but 'actype)))
@@ -220,19 +239,17 @@ Signals an error if any problem occurs."
        (list curr-label new-label))))
 
   (save-excursion
-    (if (called-interactively-p 'interactive)
-	nil
+    (unless (called-interactively-p 'interactive)
       (hui:buf-writable-err (current-buffer) "ebut-rename")
       (if (or (not (stringp curr-label)) (string= curr-label ""))
 	  (hypb:error "(ebut-rename): 'curr-label' must be a non-empty string: %s"
-		 curr-label))
+		      curr-label))
       (and (stringp new-label) (string= new-label "")
 	   (hypb:error "(ebut-rename): 'new-label' must be a non-empty string: %s"
-		  new-label)))
+		       new-label)))
     (or (ebut:get (ebut:label-to-key curr-label))
 	(hypb:error "(ebut-rename): Can't rename %s since no button data."
-	       curr-label))
-    )
+	       curr-label)))
   (cond (new-label
 	 (ebut:operate curr-label new-label)
 	 (setq hui:ebut-label-prev nil)
@@ -280,8 +297,12 @@ a menu to find any of the occurrences."
   (hypb:error "(hui:error): Obsolete, use hypb:error instead."))
 
 (defun hui:gbut-create (lbl)
-  "Creates Hyperbole global button with LBL."
-  (interactive "sCreate global button labeled: ")
+  "Creates Hyperbole explicit global button with LBL.
+
+To create an implicit global button, add the text for an implicit
+button to `gbut:file` and then with point on the implicit button,
+invoke: {C-h h i l}, to label/name it."
+  (interactive "sCreate explicit global button labeled: ")
   (let (but-buf actype)
     (save-excursion
       (setq actype (hui:actype))
@@ -306,6 +327,7 @@ a menu to find any of the occurrences."
 
 (defun hui:gbut-modify (lbl-key)
   "Modifies a global Hyperbole button given by LBL-KEY.
+The button may be explicit or a labeled implicit button.
 Signals an error when no such button is found."
   (interactive (list (save-excursion
 		       (hui:buf-writable-err
@@ -318,14 +340,13 @@ Signals an error when no such button is found."
 	(but-buf (find-file-noselect gbut:file))
 	actype but new-lbl)
     (save-excursion
-      (or (called-interactively-p 'interactive)
-	  (hui:buf-writable-err but-buf "gbut-modify"))
-      
-      (or (setq but (ebut:get lbl-key but-buf))
-	  (progn (pop-to-buffer but-buf)
-		 (hypb:error
-		  "(gbut-modify): Invalid button, no data for '%s'." lbl)))
-      
+      (unless (called-interactively-p 'interactive)
+	(hui:buf-writable-err but-buf "gbut-modify"))
+
+      (unless (setq but (gbut:get lbl-key))
+	(pop-to-buffer but-buf)
+	(hypb:error "(gbut-modify): Invalid button, no data for '%s'." lbl))
+
       (setq new-lbl
 	    (hargs:read
 	     "Change global button label to: "
@@ -335,16 +356,26 @@ Signals an error when no such button is found."
 	     (format "(gbut-modify): Enter a string of at most %s chars."
 		     ebut:max-len)
 	     'string))
-      
-      (hattr:set 'hbut:current 'loc (hui:key-src but-buf))
-      (hattr:set 'hbut:current 'dir (hui:key-dir but-buf))
-      (setq actype (hui:actype (hattr:get but 'actype)))
-      (hattr:set 'hbut:current 'actype actype)
-      (hattr:set 'hbut:current 'args (hargs:actype-get actype 'modifying))
-      (hattr:set 'hbut:current 'action
-		 (and hui:ebut-prompt-for-action (hui:action actype)))
-      (set-buffer but-buf)
-      (ebut:operate lbl new-lbl))))
+
+      (if (eq (hattr:get but 'categ) 'explicit)
+	  (progn
+	    ;; Explicit buttons
+	    (hattr:set 'hbut:current 'loc (hui:key-src but-buf))
+	    (hattr:set 'hbut:current 'dir (hui:key-dir but-buf))
+	    (setq actype (hui:actype (hattr:get but 'actype)))
+	    (hattr:set 'hbut:current 'actype actype)
+	    (hattr:set 'hbut:current 'args (hargs:actype-get actype 'modifying))
+	    (hattr:set 'hbut:current 'action
+		       (and hui:ebut-prompt-for-action (hui:action actype)))
+	    (set-buffer but-buf)
+	    (ebut:operate lbl new-lbl))
+	;; Ixplicit buttons
+	(save-excursion
+	  (set-buffer but-buf)
+	  (ibut:rename lbl new-lbl)
+	  (when (and (called-interactively-p 'interactive)
+		     (ibut:at-p))
+	    (hui:ibut-message t)))))))
 
 (defun hui:hbut-act (&optional but)
   "Executes action for optional Hyperbole button symbol BUT in current buffer.
@@ -353,11 +384,11 @@ Default is the current button."
    (let ((but (hbut:at-p)) (lst))
      (list
       (cond (but)
-	    ((setq lst (ebut:alist))
-	     (ebut:get (ebut:label-to-key
+	    ((setq lst (nconc (ebut:alist) (ibut:alist)))
+	     (hbut:get (hbut:label-to-key
 			(hargs:read-match "Button to execute: " lst nil t
-					  (ebut:label-p 'as-label) 'ebut))))
-	    (t (hypb:error "(hbut-act): No explicit buttons in buffer."))))))
+					  (hbut:label-p 'as-label) 'hbut))))
+	    (t (hypb:error "(hbut-act): No labeled buttons in buffer."))))))
   (cond ((and (called-interactively-p 'interactive) (null but))
 	 (hypb:error "(hbut-act): No current button to activate."))
 	((not (hbut:is-p but))
@@ -383,28 +414,28 @@ BUT defaults to the button whose label point is within."
 		(ebut:get (ebut:label-to-key
 			   (hargs:read-match "Help for button: "
 					     (ebut:alist) nil t nil 'ebut)))))
-  (or but
-      (hypb:error "(hbut-help):  Move point to a valid Hyperbole button."))
-  (if (not (hbut:is-p but))
-      (cond (but (hypb:error "(hbut-help): Invalid button."))
-	    (t   (hypb:error
-		  "(hbut-help): Not on an implicit button and no buffer explicit buttons."))))
+  (unless but
+    (hypb:error "(hbut-help):  Move point to a valid Hyperbole button."))
+  (unless (hbut:is-p but)
+    (cond (but (hypb:error "(hbut-help): Invalid button."))
+	  (t   (hypb:error
+		"(hbut-help): Not on an implicit button and no buffer explicit buttons."))))
   (let ((type-help-func (intern-soft
 			 (concat 
 			  (htype:names 'ibtypes (hattr:get but 'categ))
 			  ":help"))))
-    (or (equal (hypb:indirect-function 'hui:but-flash)
-	       (lambda nil))
-	;; Only flash button if point is on it.
-	(let ((lbl-key (hattr:get but 'lbl-key)))
-	  (and lbl-key
-	       (or (equal lbl-key (ebut:label-p))
-		   (equal lbl-key (ibut:label-p)))
-	       (hui:but-flash))))
+    (unless (equal (hypb:indirect-function 'hui:but-flash)
+		   (lambda nil))
+      ;; Only flash button if point is on it.
+      (let ((lbl-key (hattr:get but 'lbl-key)))
+	(and lbl-key
+	     (or (equal lbl-key (ebut:label-p))
+		 (equal lbl-key (ibut:label-p)))
+	     (hui:but-flash))))
     (if (functionp type-help-func)
 	(funcall type-help-func but)
       (let ((total (hbut:report but)))
-	(if total (hui:help-ebut-highlight))))))
+	(when total (hui:help-ebut-highlight))))))
 
 (defun hui:hbut-label (default-label func-name)
   "Reads button label from user using DEFAULT-LABEL and caller's FUNC-NAME."
@@ -438,12 +469,79 @@ See 'hbut:report'."
   (if (and arg (symbolp arg))
       (hui:hbut-help arg)
     (let ((total (hbut:report arg)))
-      (if total
-	  (progn (hui:help-ebut-highlight)
-		 (message "%d button%s." total (if (/= total 1) "s" "")))))))
+      (when total
+	(hui:help-ebut-highlight)
+	(message "%d button%s." total (if (/= total 1) "s" ""))))))
 
 (defalias 'hui:hbut-summarize 'hui:hbut-report)
 
+(defun hui:ibut-label-create ()
+  "Creates an implicit button label preceding an existing implicit button at point, if any.
+Adds the label and delimiters around it plus any necessary label instance number.
+Signals an error if point is not on an implicit button or if the button already has a label.
+
+If the implicit button type does not specify the starting locations of
+its buttons, the the label is simply inserted at point."
+  (interactive)
+  (hui:buf-writable-err (current-buffer) "ibut-label-create")
+  (let* ((ibut (ibut:at-p))
+	 (ibut-start (when ibut (hattr:get 'hbut:current 'lbl-start)))
+	 ;; non-nil when point is within an existing ibut label
+	 (label-key-start-end (when ibut (ibut:label-p nil nil nil t t)))
+	 lbl actype)
+    (cond (label-key-start-end
+	   (error "(hui:ibut-label-create): ibutton at point already has a label; try hui:ibut-rename"))
+	  (ibut
+	   (save-excursion
+	     (when ibut-start
+	       (goto-char ibut-start))
+	     (save-excursion
+	       ;; Check if ibut has an existing preceding label
+	       (skip-chars-backward "][:=<>a-zA-Z0-9#@!$%^&* -")
+	       (skip-chars-forward " ")
+	       (when (looking-at (concat (regexp-quote ibut:label-start) "\\s-*[:=a-zA-Z0-9#@!$%^&* -]+" (regexp-quote ibut:label-end)))
+		 (error "(hui:ibut-label-create): ibutton at point already has a label; try hui:ibut-rename")))
+	     (setq lbl (hui:hbut-label nil "ibut-label-create")) ; prompts for label
+	     ;; !! Handle adding instance to label
+	     (insert ibut:label-start lbl ibut:label-end ibut:label-separator))
+	   (when (called-interactively-p 'interactive)
+	     (hui:ibut-message nil)))
+	  (t (error "(hui:ibut-label-create): To add a label, point must be within the text of an implicit button")))))
+
+(defun hui:ibut-rename (lbl-key)
+  "Renames a label preceding a Hyperbole implicit button in the current buffer given by LBL-KEY.
+Signals an error when no such button is found in the current buffer."
+  (interactive (list (save-excursion
+		       (hui:buf-writable-err (current-buffer) "ibut-rename")
+		       (or (ibut:label-p)
+			   (ibut:label-to-key
+			    (hargs:read-match "Labeled implicit button to rename: "
+					      (ibut:alist) nil t nil 'ibut))))))
+  (let ((lbl (ibut:key-to-label lbl-key))
+	(but-buf (current-buffer))
+	actype but new-lbl)
+    (unless (called-interactively-p 'interactive)
+      (hui:buf-writable-err but-buf "ibut-rename"))
+
+    (unless (setq but (ibut:get lbl-key but-buf))
+      (hypb:error "(ibut-rename): Invalid button: '%s'." lbl))
+
+    (setq new-lbl
+	  (hargs:read
+	   "Change implicit button label to: "
+	   (lambda (lbl)
+	     (and (not (string= lbl "")) (<= (length lbl) ebut:max-len)))
+	   lbl
+	   (format "(ibut-rename): Enter a string of at most %s chars."
+		   ebut:max-len)
+	   'string))
+
+    (save-excursion
+      (ibut:rename lbl new-lbl)
+      (when (and (called-interactively-p 'interactive)
+		 (ibut:at-p))
+	(hui:ibut-message t)))))
+
 (defun hui:link-directly ()
   "Creates a Hyperbole link button at depress point, linked to release point.
 See also documentation for `hui:link-possible-types'."
@@ -724,8 +822,8 @@ All args are optional, the current button and buffer file are the defaults."
 
 (defun hui:hbut-term-highlight (start end)
   "For terminals only: Emphasize a button spanning from START to END."
-  (save-restriction
-    (save-excursion
+  (save-excursion
+    (save-restriction
       (goto-char start)
       (narrow-to-region (point-min) start)
       (sit-for 0)
@@ -739,8 +837,8 @@ All args are optional, the current button and buffer file are the defaults."
 
 (defun hui:hbut-term-unhighlight (start end)
   "For terminals only: Remove any emphasis from hyper-button at START to END."
-  (save-restriction
-    (save-excursion
+  (save-excursion
+    (save-restriction
       (goto-char start)
       (narrow-to-region (point-min) start)
       (sit-for 0)
@@ -817,13 +915,25 @@ Optional NO-SORT means display in decreasing priority order (natural order)."
 	 '(("\\`*Help" . ((lambda (buf _alist) (switch-to-buffer buf)))))))
     (hui:htype-help htype-sym no-sort)))
 
+(defun hui:ibut-message (but-modify-flag)
+  (let ((actype (symbol-name (hattr:get 'hbut:current 'actype)))
+	(args (hattr:get 'hbut:current 'args)))
+    (if (string-match "\\`actypes::" actype)
+	(setq actype (intern (substring actype (match-end 0)))))
+    (message "%s%s%s %s %S"
+	     ibut:label-start
+	     (hbut:key-to-label (hattr:get 'hbut:current 'lbl-key))
+	     ibut:label-end
+	     (if but-modify-flag "now executes" "executes")
+	     (cons actype args))))
+
 (defun hui:key-dir (but-buf)
   "Returns button key src directory based on BUT-BUF, a buffer."
   (if (bufferp but-buf)
       (let ((file (buffer-file-name but-buf)))
 	(if file
 	    (file-name-directory (hpath:symlink-referent file))
-	  (cdr (assq 'default-directory (buffer-local-variables but-buf)))))
+	  (buffer-local-value 'default-directory but-buf)))
     (hypb:error "(hui:key-dir): '%s' is not a valid buffer.")))
 
 (defun hui:key-src (but-buf)
@@ -836,7 +946,7 @@ button's source file name when the button data is stored externally."
 	  (t but-buf))))
 
 (defun hui:link-create (modify but-window lbl-key but-loc but-dir type-and-args)
-  "Creates or modifies a new Hyperbole link button.
+  "Creates or modifies a new Hyperbole explicit link button.
 If MODIFY is non-nil, modifies button at point in BUT-WINDOW,
 otherwise, prompts for button label and creates a button.
 LBL-KEY is internal form of button label.  BUT-LOC is file or buffer
@@ -864,7 +974,9 @@ possible types.
 
 Referent Context         Possible Link Type Returned
 ----------------------------------------------------
+Global Button            link-to-gbut
 Explicit Button          link-to-ebut
+Implicit Button          link-to-ibut
 Info Index Item          link-to-Info-index-item
 Info Node                link-to-Info-node
 Mail Reader Message      link-to-mail
@@ -879,8 +991,12 @@ Buffer without File      link-to-buffer-tmp"
 
   (let (val)
     (delq nil
-	  (list (if (ebut:at-p)
-		    (list 'link-to-ebut buffer-file-name (ebut:label-p)))
+	  (list (cond ((eq (current-buffer) (get-file-buffer gbut:file))
+		       (list 'link-to-gbut buffer-file-name (hbut:label-p)))
+		      ((ebut:at-p)
+		       (list 'link-to-ebut buffer-file-name (ebut:label-p)))
+		      ((setq val (ibut:at-p t))
+		       (list 'link-to-ibut buffer-file-name val)))
 		(cond ((eq major-mode 'Info-mode)
 		       (if (and Info-current-node
 				(member Info-current-node