From d087a82455dabe008934ca879662c9f3746e8a7f Mon Sep 17 00:00:00 2001 From: Bob Weiner Date: Mon, 20 Jan 2020 23:01:01 -0500 Subject: [PATCH] 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 8f143933..c1e4fe2a 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 26bb6141..cf4917ad 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 a1b2c169..53c13eb2 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 dd54c8a3..92e1b5fe 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 1ffd1d59..bb9790a8 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, ." (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, ." ((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 29ebd618..00096632 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)))