[elpa] externals/hyperbole d087a82 11/51: Fixes for 7.0.8 test release

[Stefan Monnier]

branch: externals/hyperbole
commit d087a82455dabe008934ca879662c9f3746e8a7f
Author: Bob Weiner <rsw@gnu.org>
Commit: Bob Weiner <rsw@gnu.org>

    Fixes for 7.0.8 test release
---
 Changes       |  15 ++++
 hargs.el      | 266 +++++++++++++++++++++++++++++-----------------------------
 hbut.el       |   3 +-
 hib-social.el |  11 +--
 hibtypes.el   |   8 +-
 hpath.el      |  16 +++-
 6 files changed, 173 insertions(+), 146 deletions(-)

diff --git a/Changes b/Changes
index 8f14393..c1e4fe2 100644
--- a/Changes
+++ b/Changes
@@ -2,6 +2,21 @@
 
 * Published 7.0.8 test release.
 
+* hib-social.el (social-reference): Fixed handling of social refs without any 
service name,
+    e.g. #gnu.
+
+* hibtypes.el (action): 'actype::' should be 'actypes::; action variable args 
were quoted
+    twice so did not work.
+
+* hpath.el: Fixed to handle in-file HTML-like link references.
+     (hpath:is-p): Allowed for URL "file://" prefix.
+     (hpath:markup-link-anchor-regexp): Allowed for anchor only paths, no 
pathname.
+     (hpath:find): Use buffer-file-name if pathname is empty.
+     (hpath:to-markup-anchor): Prevent string-match error if buffer-file-name 
is null.
+  hbut.el (hbut:outside-comment-p): Ignore comment status for html-like markup
+    modes that register as programming modes.  This fixes ibuttons not being
+    recognized, notably in-file anchor links.
+
 * Makefile (ftp): Added missing gzipped tar file dependency
   hui-select.el: Removed kotl-mode require as it caused an infinite loading 
cycle
 
diff --git a/hargs.el b/hargs.el
index 26bb614..cf4917a 100644
--- a/hargs.el
+++ b/hargs.el
@@ -56,24 +56,22 @@
                (sit-for 1)
                nil)))
        (save-excursion
-         (if (not (memq (char-syntax (preceding-char)) '(?w ?_)))
-             (while (not (looking-at "\\sw\\|\\s_\\|\\'"))
-               (forward-char 1)))
+         (unless (memq (char-syntax (preceding-char)) '(?w ?_))
+           (while (not (looking-at "\\sw\\|\\s_\\|\\'"))
+             (forward-char 1)))
          (while (looking-at "\\sw\\|\\s_")
            (forward-char 1))
-         (if (re-search-backward "\\sw\\|\\s_" nil t)
-             (regexp-quote
-              (progn (forward-char 1)
-                     (buffer-substring (point)
-                                       (progn (forward-sexp -1)
-                                              (while (looking-at "\\s'")
-                                                (forward-char 1))
-                                              (point)))))
-           nil)))))
+         (when (re-search-backward "\\sw\\|\\s_" nil t)
+           (forward-char 1)
+           (regexp-quote (buffer-substring (point)
+                                           (progn (forward-sexp -1)
+                                                  (while (looking-at "\\s'")
+                                                    (forward-char 1))
+                                                  (point)))))))))
 
 (unless (fboundp 'find-tag--default)
   (defun find-tag--default ()
-    (funcall (or (if (fboundp find-tag-default-function) 
find-tag-default-function)
+    (funcall (or (when (fboundp find-tag-default-function) 
find-tag-default-function)
                 (get major-mode 'find-tag-default-function)
                 'find-tag-default))))
 (defalias 'hargs:find-tag-default 'find-tag--default)
@@ -86,9 +84,9 @@ Return nil if ACTION is not a list or `byte-code' object, has 
no
 interactive form or takes no arguments."
   (and (or (hypb:emacs-byte-code-p action) (listp action))
        (let ((interactive-form (action:commandp action)))
-        (if interactive-form
-            (action:path-args-rel
-             (hargs:iform-read interactive-form modifying))))))
+        (when interactive-form
+          (action:path-args-rel
+           (hargs:iform-read interactive-form modifying))))))
 
 (defun hargs:buffer-substring (start end)
   (let ((string (buffer-substring-no-properties start end)))
@@ -185,8 +183,8 @@ element of the list is always the symbol 'args."
          ((eq (aref interactive-entry 0) ?+)
           (setq cmd (aref interactive-entry 1)
                 prompt (format (substring interactive-entry 2) prior-arg)
-                func (if (< cmd (length hargs:iform-extensions-vector))
-                         (aref hargs:iform-extensions-vector cmd)))
+                func (when (< cmd (length hargs:iform-extensions-vector))
+                       (aref hargs:iform-extensions-vector cmd)))
           (if func
               (funcall func prompt default)
             (error
@@ -196,8 +194,8 @@ element of the list is always the symbol 'args."
          (t (setq cmd (aref interactive-entry 0)
                   prompt
                   (format (substring interactive-entry 1) prior-arg)
-                  func (if (< cmd (length hargs:iform-vector))
-                           (aref hargs:iform-vector cmd)))
+                  func (when (< cmd (length hargs:iform-vector))
+                         (aref hargs:iform-vector cmd)))
             (if func
                 (funcall func prompt default)
               (error
@@ -242,8 +240,8 @@ Optional DEFAULT-PROMPT is used to describe default value."
   (save-window-excursion
     (set-buffer (window-buffer (minibuffer-window)))
     (setq hargs:string-to-complete (minibuffer-contents-no-properties))
-    (if (equal hargs:string-to-complete "")
-       (setq hargs:string-to-complete nil))))
+    (when (equal hargs:string-to-complete "")
+      (setq hargs:string-to-complete nil))))
 
 (defun hargs:unset-string-to-complete ()
   "Remove any value from `hargs:string-to-complete'."
@@ -304,7 +302,7 @@ Handles all of the interactive argument types that 
`hargs:iform-read' does."
             (list (hargs:at-p)))))
        ((eq hargs:reading-p 'kvspec)
         (read-string "Koutline view spec: "
-                     (if (boundp 'kvspec:current) kvspec:current)))
+                     (when (boundp 'kvspec:current) kvspec:current)))
        ((eolp) nil)
        ((and (eq hargs:reading-p 'hmenu)
              (eq (selected-window) (minibuffer-window)))
@@ -339,7 +337,7 @@ Handles all of the interactive argument types that 
`hargs:iform-read' does."
               ;; Unquoted remote file name.
               ((hpath:is-p (hpath:remote-at-p) 'file))
               ;; Possibly non-existent file name
-              ((if no-default (hpath:at-p 'file 'non-exist)))
+              ((when no-default (hpath:at-p 'file 'non-exist)))
               (no-default nil)
               ((buffer-file-name))
               ))
@@ -357,7 +355,7 @@ Handles all of the interactive argument types that 
`hargs:iform-read' does."
               ;; Unquoted remote directory name.
               ((hpath:is-p (hpath:remote-at-p) 'directory))
               ;; Possibly non-existent directory name
-              ((if no-default (hpath:at-p 'directory 'non-exist)))
+              ((when no-default (hpath:at-p 'directory 'non-exist)))
               (no-default nil)
               (default-directory)
               ))
@@ -375,26 +373,26 @@ Handles all of the interactive argument types that 
`hargs:iform-read' does."
           (car (set:member name (htype:names 'ibtypes)))))
        ((eq hargs:reading-p 'sexpression) (hargs:sexpression-p))
        ((memq hargs:reading-p '(Info-index-item Info-node))
-        (if (eq major-mode 'Info-mode)
-            (let ((file (Info-current-filename-sans-extension))
-                  (node (cond ((Info-note-at-p))
-                              ((Info-menu-item-at-p)
-                               (save-excursion
-                                 (beginning-of-line)
-                                 (forward-char 2)
-                                 (Info-extract-menu-node-name nil 
(Info-index-node))))
-                              (t Info-current-node))))
-              (cond ((and (stringp node) (string-match "\\`\(" node))
-                     node)
-                    (file
-                     (concat "(" file ")" node))
-                    (t node)))))
+        (when (eq major-mode 'Info-mode)
+          (let ((file (Info-current-filename-sans-extension))
+                (node (cond ((Info-note-at-p))
+                            ((Info-menu-item-at-p)
+                             (save-excursion
+                               (beginning-of-line)
+                               (forward-char 2)
+                               (Info-extract-menu-node-name nil 
(Info-index-node))))
+                            (t Info-current-node))))
+            (cond ((and (stringp node) (string-match "\\`\(" node))
+                   node)
+                  (file
+                   (concat "(" file ")" node))
+                  (t node)))))
        ((eq hargs:reading-p 'mail)
         (and (hmail:reader-p) buffer-file-name
              (prin1-to-string (list (rmail:msg-id-get) buffer-file-name))))
        ((eq hargs:reading-p 'symbol)
         (let ((sym (hargs:find-tag-default)))
-          (if (or (fboundp sym) (boundp sym)) sym)))
+          (when (or (fboundp sym) (boundp sym)) sym)))
        ((eq hargs:reading-p 'buffer)
         (hargs:find-tag-default))
        ((eq hargs:reading-p 'character)
@@ -405,76 +403,77 @@ Handles all of the interactive argument types that 
`hargs:iform-read' does."
           (when key-seq (kbd-key:normalize key-seq))))
        ((eq hargs:reading-p 'integer)
         (save-excursion (skip-chars-backward "-0-9")
-                        (if (looking-at "-?[0-9]+")
-                            (read (current-buffer)))))))
+                        (when (looking-at "-?[0-9]+")
+                          (read (current-buffer)))))))
 
 (defun hargs:completion (&optional no-insert)
   "If in the completions buffer, return completion at point.
 Also insert unless optional NO-INSERT is non-nil.
 Insert in minibuffer if active or in other window if minibuffer is inactive."
   (interactive '(nil))
-  (if (or (string-match "[* ]Completions\\*\\'" (buffer-name))
-         (eq major-mode 'completion-mode))
-      (let ((opoint (point))
-           (owind (selected-window)))
-       (if (re-search-backward "^\\|\t\\| [ \t]" nil t)
-           (let ((insert-window
-                  (cond ((> (minibuffer-depth) 0)
-                         (minibuffer-window))
-                        ((not (eq (selected-window) (next-window nil)))
-                         (next-window nil))))
-                 (bury-completions)
-                 (entry))
-             (skip-chars-forward " \t")
-             (if (and insert-window
-                      ;; Allow single spaces in the middle of completions
-                      ;; since completions always end with either a tab,
-                      ;; newline or two whitespace characters.
-                      (looking-at
-                       "[^ \t\n]+\\( [^ \t\n]+\\)*\\( [ 
\t\n]\\|[\t\n]\\|\\'\\)"))
-                 (progn (setq entry (buffer-substring (match-beginning 0)
-                                                      (match-beginning 2)))
-                        (select-window insert-window)
-                        (let ((str (or hargs:string-to-complete
-                                       (buffer-substring
-                                        (point)
-                                        (save-excursion (beginning-of-line)
-                                                        (point))))))
-                          (cond
-                           ((and (eq (selected-window) (minibuffer-window)))
-                            (cond ((string-match (concat
-                                                  (regexp-quote entry)
-                                                  "\\'")
-                                                 str)
-                                   ;; If entry matches tail of minibuffer
-                                   ;; prefix already, then return minibuffer
-                                   ;; contents as the entry.
-                                   (setq entry str))
-                                  ;;
-                                  ((string-match "[~/][^/]*\\'" str)
-                                   ;; file or directory entry
-                                   (setq entry
-                                         (concat
-                                          (substring
-                                           str 0
-                                           (1+ (match-beginning 0)))
-                                          entry))))
-                            (or no-insert
-                                (if entry (progn (erase-buffer)
-                                                 (insert entry)))))
-                           ;; In buffer, non-minibuffer completion.
-                           ;; Only insert entry if last buffer line does
-                           ;; not end in entry.
-                           (no-insert)
-                           ((or (string-match
-                                 (concat (regexp-quote entry) "\\'") str)
-                                (null entry))
-                            (setq bury-completions t))
-                           (t (insert entry))))))
-             (select-window owind) (goto-char opoint)
-             (if bury-completions
-                 (progn (bury-buffer nil) (delete-window)))
-             entry)))))
+  (when (or (string-match "[* ]Completions\\*\\'" (buffer-name))
+           (eq major-mode 'completion-mode))
+    (let ((opoint (point))
+         (owind (selected-window)))
+      (when (re-search-backward "^\\|\t\\| [ \t]" nil t)
+       (let ((insert-window
+              (cond ((> (minibuffer-depth) 0)
+                     (minibuffer-window))
+                    ((not (eq (selected-window) (next-window nil)))
+                     (next-window nil))))
+             (bury-completions)
+             (entry))
+         (skip-chars-forward " \t")
+         (when (and insert-window
+                    ;; Allow single spaces in the middle of completions
+                    ;; since completions always end with either a tab,
+                    ;; newline or two whitespace characters.
+                    (looking-at
+                     "[^ \t\n]+\\( [^ \t\n]+\\)*\\( [ 
\t\n]\\|[\t\n]\\|\\'\\)"))
+           (setq entry (buffer-substring (match-beginning 0)
+                                         (match-beginning 2)))
+           (select-window insert-window)
+           (let ((str (or hargs:string-to-complete
+                          (buffer-substring
+                           (point)
+                           (save-excursion (beginning-of-line)
+                                           (point))))))
+             (cond
+              ((and (eq (selected-window) (minibuffer-window)))
+               (cond ((string-match (concat
+                                     (regexp-quote entry)
+                                     "\\'")
+                                    str)
+                      ;; If entry matches tail of minibuffer
+                      ;; prefix already, then return minibuffer
+                      ;; contents as the entry.
+                      (setq entry str))
+                     ;;
+                     ((string-match "[~/][^/]*\\'" str)
+                      ;; file or directory entry
+                      (setq entry
+                            (concat
+                             (substring
+                              str 0
+                              (1+ (match-beginning 0)))
+                             entry))))
+               (or no-insert
+                   (if entry (progn (erase-buffer)
+                                    (insert entry)))))
+              ;; In buffer, non-minibuffer completion.
+              ;; Only insert entry if last buffer line does
+              ;; not end in entry.
+              (no-insert)
+              ((or (string-match
+                    (concat (regexp-quote entry) "\\'") str)
+                   (null entry))
+               (setq bury-completions t))
+              (t (insert entry)))))
+         (select-window owind) (goto-char opoint)
+         (when bury-completions
+           (bury-buffer nil)
+           (delete-window))
+         entry)))))
 
 (defun hargs:iform-read (iform &optional modifying)
   "Read action arguments according to IFORM, a list with car = 'interactive.
@@ -594,12 +593,13 @@ string read or nil."
                          (and predicate (not (funcall predicate val)))))
            (if bad-val (setq bad-val nil) (setq default val))
            (beep)
-           (if err (progn (message err) (sit-for 3))))
+           (when err
+             (message err)
+             (sit-for 3)))
          val)
       (setq hargs:reading-p prev-reading-p)
       (select-window owind)
-      (switch-to-buffer obuf)
-      )))
+      (switch-to-buffer obuf))))
 
 (defun hargs:read-match (prompt collection
                         &optional predicate must-match initial-input val-type)
@@ -635,32 +635,32 @@ the current minibuffer argument, otherwise, the 
minibuffer is erased
 and value is inserted there.
 Optional ASSIST-FLAG non-nil triggers display of Hyperbole menu item
 help when appropriate."
-    (if (and (> (minibuffer-depth) 0) (or value (setq value (hargs:at-p))))
-       (let ((owind (selected-window)) (back-to)
-             (str-value (and value (format "%s" value)))
-             ;; This command requires recursive minibuffers.
-             (enable-recursive-minibuffers t))
-         (unwind-protect
-             (progn
-               (select-window (minibuffer-window))
-               (set-buffer (window-buffer (minibuffer-window)))
-               (cond
-                ;;
-                ;; Selecting a menu item
-                ((eq hargs:reading-p 'hmenu)
-                 (if assist-flag (setq hargs:reading-p 'hmenu-help))
-                 (hui:menu-enter str-value))
-                ;;
-                ;; Enter existing value into the minibuffer as the desired 
parameter.
-                ((string-equal str-value (minibuffer-contents))
-                 (exit-minibuffer))
-                ;;
-                ;; Clear minibuffer and insert value.
-                (t (delete-minibuffer-contents)
-                   (insert str-value)
-                   (setq back-to t)))
-               value)
-           (if back-to (select-window owind))))))
+    (when (and (> (minibuffer-depth) 0) (or value (setq value (hargs:at-p))))
+      (let ((owind (selected-window)) (back-to)
+           (str-value (and value (format "%s" value)))
+           ;; This command requires recursive minibuffers.
+           (enable-recursive-minibuffers t))
+       (unwind-protect
+           (progn
+             (select-window (minibuffer-window))
+             (set-buffer (window-buffer (minibuffer-window)))
+             (cond
+              ;;
+              ;; Selecting a menu item
+              ((eq hargs:reading-p 'hmenu)
+               (if assist-flag (setq hargs:reading-p 'hmenu-help))
+               (hui:menu-enter str-value))
+              ;;
+              ;; Enter existing value into the minibuffer as the desired 
parameter.
+              ((string-equal str-value (minibuffer-contents))
+               (exit-minibuffer))
+              ;;
+              ;; Clear minibuffer and insert value.
+              (t (delete-minibuffer-contents)
+                 (insert str-value)
+                 (setq back-to t)))
+             value)
+         (when back-to (select-window owind))))))
 
 ;;; ************************************************************************
 ;;; Private variables
diff --git a/hbut.el b/hbut.el
index a1b2c16..53c13eb 100644
--- a/hbut.el
+++ b/hbut.el
@@ -1058,7 +1058,8 @@ include delimiters when INCLUDE-DELIMS is non-nil)."
 (defun    hbut:outside-comment-p ()
   "Return t if within a programming language buffer and prior regexp match is 
outside a comment, else nil."
   (when (and (derived-mode-p 'prog-mode)
-            (not (eq major-mode 'lisp-interaction-mode)))
+            (not (eq major-mode 'lisp-interaction-mode))
+            (not (memq major-mode hui-select-markup-modes)))
     ;; Match is outside of a programming language comment
     (not (nth 4 (syntax-ppss)))))
 
diff --git a/hib-social.el b/hib-social.el
index dd54c8a..92e1b5f 100644
--- a/hib-social.el
+++ b/hib-social.el
@@ -281,14 +281,15 @@ listed in `hibtypes-social-inhibit-modes'."
                      (and (eq major-mode 'markdown-mode)
                           (hargs:delimited "(" ")"))))
             (save-excursion
-              (if (looking-at "[-#@=/.:_[:alnum:]]")
-                  (skip-chars-backward "-#@=/.:_[:alnum:]"))
+              (when (looking-at "[-#@=/.:_[:alnum:]]")
+                (skip-chars-backward "-#@=/.:_[:alnum:]"))
               (and (looking-at hibtypes-social-regexp)
-                   ;; Ensure prefix matches to a social web service
+                   ;; Ensure prefix if any matches to a social web service
                    (save-match-data
                      (let ((ref (match-string-no-properties 1)))
-                       (delq nil (mapcar (lambda (regexp) (string-match regexp 
ref))
-                                         (mapcar #'car 
hibtypes-social-hashtag-alist)))))
+                       (or (string-empty-p ref)
+                           (delq nil (mapcar (lambda (regexp) (string-match 
regexp ref))
+                                             (mapcar #'car 
hibtypes-social-hashtag-alist))))))
                    ;; Heuristic to ensure this is not an email address
                    (save-match-data
                      (not (and (looking-at mail-address-regexp)
diff --git a/hibtypes.el b/hibtypes.el
index 1ffd1d5..bb9790a 100644
--- a/hibtypes.el
+++ b/hibtypes.el
@@ -151,7 +151,9 @@ display options."
     (let ((path (hpath:at-p))
              full-path)
       (if path
-             (progn (apply #'ibut:label-set path (hpath:start-end path))
+             (progn (when (string-match "\\`file://" path)
+                                  (setq path (substring path (match-end 0))))
+                                (apply #'ibut:label-set path (hpath:start-end 
path))
                         (hact 'link-to-file path))
            ;;
            ;; Match to Emacs Lisp and Info files without any directory 
component.
@@ -1237,7 +1239,7 @@ arg1 ... argN '>'.  For example, <mail nil 
\"user@somewhere.org\">."
            (setq var-flag t
                  lbl (substring lbl 1)))
       (setq actype (if (string-match-p " "  lbl) (car (split-string lbl)) lbl)
-               actype (or (intern-soft (concat "actype::" actype))
+               actype (or (intern-soft (concat "actypes::" actype))
                               (intern-soft actype)))
       ;; Ignore unbound symbols
       (unless (and actype (or (fboundp actype) (boundp actype)))
@@ -1254,7 +1256,7 @@ arg1 ... argN '>'.  For example, <mail nil 
\"user@somewhere.org\">."
                  ((and (null args) (symbolp actype) (boundp actype)
                            (or var-flag (not (fboundp actype))))
                   ;; Is a variable, display its value as the action
-                  (setq args `(',actype)
+                  (setq args `(,actype)
                             action `(display-variable ',actype)
                             actype 'display-variable)))
            ;; Necessary so can return a null value, which actype:act cannot.
diff --git a/hpath.el b/hpath.el
index 29ebd61..0009663 100644
--- a/hpath.el
+++ b/hpath.el
@@ -503,7 +503,7 @@ use with `string-match'.")
   "Regexp that matches to a Markdown file suffix.")
 
 (defconst hpath:markup-link-anchor-regexp
-  "\\`\\(#?[^#]+\\)\\(#\\)\\([^\]\[#^{}<>\"`'\\\n\t\f\r]*\\)"
+  "\\`\\(#?[^#]+\\)?\\(#\\)\\([^\]\[#^{}<>\"`'\\\n\t\f\r]*\\)"
   "Regexp that matches a markup filename followed by a hash (#) and an 
optional in-file anchor name.
 Group 3 is the anchor name.")
 
@@ -866,7 +866,9 @@ buffer but don't display it."
     (when (string-match hpath:markup-link-anchor-regexp path)
       (setq hash t
            anchor (match-string 3 path)
-           path (substring path 0 (match-end 1))))
+           path (if (match-end 1)
+                    (substring path 0 (match-end 1))
+                  buffer-file-name)))
     (setq path (hpath:substitute-value path)
          filename (hpath:absolute-to path default-directory))
     (if noselect
@@ -957,7 +959,8 @@ buffer but don't display it."
                                     (subst-char-in-string ?- ?\  anchor))))
                  (goto-char (point-min))
                  (if (re-search-forward (format
-                                         (cond ((or (string-match 
hpath:markdown-suffix-regexp buffer-file-name)
+                                         (cond ((or (and buffer-file-name
+                                                         (string-match 
hpath:markdown-suffix-regexp buffer-file-name))
                                                     (memq major-mode 
hpath:shell-modes))
                                                 hpath:markdown-section-pattern)
                                                ((eq major-mode 'texinfo-mode)
@@ -1049,7 +1052,7 @@ See also `hpath:internal-display-alist' for internal, 
`window-system' independen
                             (cons "next" 
hpath:external-display-alist-macos)))))))
 
 (defun hpath:is-p (path &optional type non-exist)
-  "Return normalized PATH if PATH is a Posix or MSWindows path, else nil.
+  "Return normalized PATH as a URL if PATH is a Posix or MSWindows path, else 
nil.
 If optional TYPE is the symbol 'file or 'directory, then only that path type
 is accepted as a match.  The existence of the path is checked only for
 locally reachable paths (Info paths are not checked).  With optional NON-EXIST,
@@ -1068,6 +1071,11 @@ path form is what is returned for PATH."
       (when (string-match hpath:prefix-regexp path)
        (setq modifier (substring path 0 1)
              path (substring path (match-end 0))))
+      (when (string-match "\\`file://" path)
+       (setq path (substring path (match-end 0))))
+      (when (string-match hpath:prefix-regexp path)
+       (setq modifier (substring path 0 1)
+             path (substring path (match-end 0))))
       (setq path (hpath:mswindows-to-posix path))
       (and (not (or (string-equal path "")
                    (string-match "\\`\\s-\\|\\s-\\'" path)))