[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[elpa] externals/hyperbole f271ade 2/4: Fix hpath:expand when no match f
|
From: |
ELPA Syncer |
|
Subject: |
[elpa] externals/hyperbole f271ade 2/4: Fix hpath:expand when no match for variable in path |
|
Date: |
Sat, 29 May 2021 12:57:10 -0400 (EDT) |
branch: externals/hyperbole
commit f271adec7faa70a2927c692acf0323b15953fdd1
Author: Bob Weiner <rsw@gnu.org>
Commit: Bob Weiner <rsw@gnu.org>
Fix hpath:expand when no match for variable in path
Fix some cases of symtable:actype-p and symtable:ibtype-p
Improve koutline indent handling in kview.el
---
ChangeLog | 22 ++++++++
hact.el | 22 ++++----
hbut.el | 4 +-
hpath.el | 157 ++++++++++++++++++++++++++++-------------------------
hypb.el | 28 ++++++----
hyrolo.el | 5 +-
kotl/kexport.el | 2 +-
kotl/kotl-mode.el | 11 ++--
kotl/kview.el | 33 ++++++-----
test/hbut-tests.el | 2 +-
10 files changed, 164 insertions(+), 122 deletions(-)
diff --git a/ChangeLog b/ChangeLog
index ceeff3b..312613d 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,25 @@
+2021-05-27 Bob Weiner <rsw@gnu.org>
+
+* hpath.el (hpath:expand-with-variable): Fix to not add variable
+ to path if already in the path.
+ (hpath:substitute-match-value): Return STR unchanged
+ if no value substituted for any variable name.
+
+* hbut.el (ebut:program, hbut:action):
+ hact.el (actype:action, actype:doc): Handle lambdas properly.
+
+* hact.el (symtable:actype-p, symtable:ibtype-p): Return nil if
+ arg is not a symbol or string, e.g. a lambda.
+
+2021-05-25 Bob Weiner <rsw@gnu.org>
+
+* kotl/kotl-mode.el (kotl-mode:to-valid-position): Removed one
+ unused setting of 'indent'.
+
+* kotl/kview.el (kcell-view:level): Use 'floor' to ignore any
+ small remainder when cells at level 1 have labels longer
+ than the allowed indent.
+
2021-05-23 Bob Weiner <rsw@gnu.org>
* kotl/kotl-mode.el (kotl-mode:beginning-of-buffer,
diff --git a/hact.el b/hact.el
index 3f957f1..5eb1d3b 100644
--- a/hact.el
+++ b/hact.el
@@ -111,11 +111,13 @@ keys is the Elisp symbol for the type, which includes the
prefix.")
(defsubst symtable:actype-p (symbol-or-name)
"Return the Elisp symbol given by SYMBOL-OR-NAME if it is a Hyperbole action
type name, else nil."
- (symtable:get symbol-or-name symtable:actypes))
+ (when (or (symbolp symbol-or-name) (stringp symbol-or-name))
+ (symtable:get symbol-or-name symtable:actypes)))
(defsubst symtable:ibtype-p (symbol-or-name)
"Return the Elisp symbol given by SYMBOL-OR-NAME if it is a Hyperbole
implicit button type name, else nil."
- (symtable:get symbol-or-name symtable:ibtypes))
+ (when (or (symbolp symbol-or-name) (stringp symbol-or-name))
+ (symtable:get symbol-or-name symtable:ibtypes)))
(defun symtable:add (symbol-or-name symtable)
"Add Hyperbole SYMBOL-OR-NAME to existing SYMTABLE.
@@ -455,13 +457,14 @@ performing ACTION."
ACTYPE may be a Hyperbole actype or Emacs Lisp function."
(let (actname
action)
- (if (stringp actype)
- (setq actname actype
- actype (intern actype))
- (setq actname (symbol-name actype)))
+ (cond ((stringp actype)
+ (setq actname actype
+ actype (intern actype)))
+ ((and actype (symbolp actype))
+ (setq actname (symbol-name actype))))
(setq actype (or (symtable:actype-p actname) actype)
action (htype:body actype))
- (if (fboundp actype)
+ (if (functionp actype)
actype
action)))
@@ -515,14 +518,13 @@ Return nil when no documentation."
(but-type (hattr:get hbut 'categ))
(sym-p (and act (symbolp act)))
(end-line) (doc))
- (cond ((and but-type (fboundp but-type)
+ (cond ((and (functionp but-type)
(setq doc (htype:doc but-type)))
;; Is an implicit button, so use its doc string if any.
)
(sym-p
(setq doc (htype:doc act))))
- (if (null doc)
- nil
+ (when doc
(setq doc (substitute-command-keys doc))
(or full (setq end-line (string-match "[\n]" doc)
doc (substring doc 0 end-line))))
diff --git a/hbut.el b/hbut.el
index 2e4bc75..7f48fb7 100644
--- a/hbut.el
+++ b/hbut.el
@@ -429,7 +429,7 @@ For interactive creation, use `hui:ebut-create' instead."
(hattr:set 'hbut:current 'loc (hui:key-src but-buf))
(hattr:set 'hbut:current 'dir (hui:key-dir but-buf))
(if (or (and actype-sym (fboundp actype-sym))
- (fboundp ,actype))
+ (functionp ,actype))
(hattr:set 'hbut:current 'actype ,actype)
(error "(,actype)"))
(hattr:set 'hbut:current 'args ',args)
@@ -879,7 +879,7 @@ Default is 'hbut:current."
atype
(or action (actype:action atype))))
;; Must be an implicit button.
- (when (fboundp atype) atype))))
+ (when (functionp atype) atype))))
(defun hbut:at-p ()
"Return symbol for explicit or implicit Hyperbole button at point or nil.
diff --git a/hpath.el b/hpath.el
index 0cbf125..708f375 100644
--- a/hpath.el
+++ b/hpath.el
@@ -1009,10 +1009,15 @@ window in which the buffer is displayed."
(defun hpath:expand (path)
"Expand relative PATH using the load variable from the first file matching
regexp in `hpath:auto-variable-alist'."
(unless (file-name-absolute-p path)
- (setq path (hpath:substitute-value
- (if (string-match "\\`[\\/~.]" path)
- (expand-file-name path)
- (hpath:expand-with-variable path)))))
+ (let ((substituted-path (hpath:substitute-value
+ (if (string-match "\\`[\\/~.]" path)
+ (expand-file-name path)
+ (hpath:expand-with-variable path)))))
+ (unless (string-match "\\$@?\{\\([^\}]+\\)@?\}" substituted-path)
+ ;; When no valid variable substitution was found after
+ ;; potentially adding a variable to the path, use
+ ;; unchanged path.
+ (setq path substituted-path))))
;; For compressed Elisp libraries, add any found compressed suffix to the
path.
(or (locate-library path t) path))
@@ -1031,9 +1036,12 @@ window in which the buffer is displayed."
(setq regexp (caar auto-variable-alist)
variable (cdar auto-variable-alist)
auto-variable-alist (cdr auto-variable-alist))
- (when (string-match regexp path)
- (when (or (and (stringp variable) (getenv variable))
- (and (symbolp variable) (boundp variable)))
+ (when (and variable (symbolp variable))
+ (setq variable (symbol-name variable)))
+ (when (and path variable (string-match regexp path))
+ (when (and (not (string-match (regexp-quote variable) path))
+ (or (and (stringp variable) (getenv variable))
+ (and (symbolp variable) (boundp variable))))
(setq path (format "${%s}/%s" variable path)))
(setq auto-variable-alist nil)))
(concat path compression-suffix)))
@@ -1505,35 +1513,36 @@ in-buffer path will not match."
"Substitute matching value for Emacs Lisp variables and environment
variables in PATH and return PATH."
;; Uses free variables `match' and `start' from `hypb:replace-match-string'.
(substitute-in-file-name
- (hpath:substitute-match-value
- "\\$@?\{\\([^\}]+\\)@?\}"
- path
- (lambda (matched-str)
- (let* ((var-group (substring path match start))
- (rest-of-path (substring path start))
- (var-ext (substring path (match-beginning 1) (match-end 1)))
- (var-name (if (= ?@ (aref var-ext (1- (length var-ext))))
- (substring var-ext 0 -1)
- var-ext))
- (trailing-dir-sep-flag (and (not (string-empty-p rest-of-path))
- (memq (aref rest-of-path 0) '(?/
?\\))))
- (sym (intern-soft var-name)))
- (when (file-name-absolute-p rest-of-path)
- (setq rest-of-path (substring rest-of-path 1)))
- (if (or (and sym (boundp sym)) (getenv var-name))
- (funcall (if trailing-dir-sep-flag #'directory-file-name
#'identity)
- ;; hpath:substitute-dir may trigger an error but this may
- ;; be called when testing for implicit button matches
- ;; where no error should occur, so catch the error
- ;; and ignore variable expansion in such a case.
- ;; -- RSW, 08-26-2019
- ;; Removed errors on non-existent paths.
- ;; -- RSW, 04-19-2021
- (condition-case nil
- (hpath:substitute-dir var-name rest-of-path)
- (error var-name)))
- var-group)))
- t t)))
+ (hpath:substitute-match-value
+ "\\$@?\{\\([^\}]+\\)@?\}"
+ path
+ (lambda (matched-str)
+ (let* ((var-group (substring path match start))
+ (rest-of-path (substring path start))
+ (var-ext (substring path (match-beginning 1) (match-end 1)))
+ (var-name (if (= ?@ (aref var-ext (1- (length var-ext))))
+ (substring var-ext 0 -1)
+ var-ext))
+ (trailing-dir-sep-flag (and (not (string-empty-p rest-of-path))
+ (memq (aref rest-of-path 0) '(?/
?\\))))
+ (sym (intern-soft var-name)))
+ (when (file-name-absolute-p rest-of-path)
+ (setq rest-of-path (substring rest-of-path 1)))
+ (if (or (and sym (boundp sym)) (getenv var-name))
+ ;; directory-file-name or hpath:substitute-dir may trigger
+ ;; an error but this may be called when testing for
+ ;; implicit button matches where no error should occur, so
+ ;; catch the error and ignore variable expansion in such a
+ ;; case.
+ ;; -- RSW, 08-26-2019
+ ;; Removed errors on non-existent paths.
+ ;; -- RSW, 04-19-2021
+ (condition-case nil
+ (funcall (if trailing-dir-sep-flag #'directory-file-name
#'identity)
+ (hpath:substitute-dir var-name rest-of-path))
+ (error ""))
+ var-group)))
+ t t)))
(defun hpath:substitute-var (path)
"Replace up to one match in PATH with the first variable from
`hpath:variables' whose value contain a string match to PATH.
@@ -1983,11 +1992,11 @@ local pathname."
(concat "$\{" var-name "\}/" rest-of-path)))))
(t (error "(hpath:substitute-dir): Value of VAR-NAME, \"%s\", must be
a string or list" var-name)))))
-(defun hpath:substitute-match-value (regexp str newtext &optional literal
fixedcase)
- "Replace all matches for REGEXP in STR with NEWTEXT string and return the
result.
+(defun hpath:substitute-match-value (regexp str new &optional literal
fixedcase)
+ "Replace all matches for REGEXP in STR with NEW string and return the result.
Optional LITERAL non-nil means do a literal replacement.
-Otherwise treat \\ in NEWTEXT string as special:
+Otherwise treat \\ in NEW string as special:
\\& means substitute original matched text,
\\N means substitute match for \(...\) number N,
\\\\ means insert one \\.
@@ -1996,16 +2005,16 @@ If optional fifth arg FIXEDCASE is non-nil, do not
alter the case of
the replacement text. Otherwise, maybe capitalize the whole text, or
maybe just word initials, based on the replaced text. If the replaced
text has only capital letters and has at least one multiletter word,
-convert NEWTEXT to all caps. Otherwise if all words are capitalized
-in the replaced text, capitalize each word in NEWTEXT.
+convert NEW to all caps. Otherwise if all words are capitalized
+in the replaced text, capitalize each word in NEW.
-NEWTEXT may instead be a function of one argument (the string to replace in)
+NEW may instead be a function of one argument (the string to replace in)
that returns a replacement string."
(unless (stringp str)
- (error "(hypb:replace-match-string): 2nd arg must be a string: %s" str))
- (unless (or (stringp newtext) (functionp newtext))
- (error "(hypb:replace-match-string): 3rd arg must be a string or function:
%s"
- newtext))
+ (error "(hpath:substitute-match-value): 2nd arg must be a string: %s" str))
+ (unless (or (stringp new) (functionp new))
+ (error "(hpath:substitute-match-value): 3rd arg must be a string or
function: %s"
+ new))
(let ((rtn-str "")
(start 0)
(special)
@@ -2015,33 +2024,35 @@ that returns a replacement string."
start (match-end 0)
rtn-str
(concat
- rtn-str
- (substring str prev-start match)
- (cond ((functionp newtext)
- (hypb:replace-match-string
- regexp (substring str match start)
- (funcall newtext str) literal fixedcase))
- (literal newtext)
- (t (mapconcat
- (lambda (c)
- (cond (special
- (setq special nil)
- (cond ((eq c ?\\) "\\")
- ((eq c ?&)
- (match-string 0 str))
- ((and (>= c ?0) (<= c ?9))
- (if (> c (+ ?0 (length (match-data))))
- ;; Invalid match num
- (error
"(hypb:replace-match-string) Invalid match num: %c" c)
- (setq c (- c ?0))
- (match-string c str)))
- (t (char-to-string c))))
- ((eq c ?\\)
- (setq special t)
- nil)
- (t (char-to-string c))))
- newtext ""))))))
- (concat rtn-str (substring str start))))
+ rtn-str
+ (substring str prev-start match)
+ (cond ((functionp new)
+ (hypb:replace-match-string
+ regexp (substring str match start)
+ (funcall new str) literal fixedcase))
+ (literal new)
+ (t (mapconcat
+ (lambda (c)
+ (cond (special
+ (setq special nil)
+ (cond ((eq c ?\\) "\\")
+ ((eq c ?&)
+ (match-string 0 str))
+ ((and (>= c ?0) (<= c ?9))
+ (if (> c (+ ?0 (length (match-data))))
+ ;; Invalid match num
+ (error
"(hpath:substitute-match-value): Invalid match num: %c" c)
+ (setq c (- c ?0))
+ (match-string c str)))
+ (t (char-to-string c))))
+ ((eq c ?\\)
+ (setq special t)
+ nil)
+ (t (char-to-string c))))
+ new ""))))))
+ (if (or (null rtn-str) (string-empty-p rtn-str))
+ str
+ (concat rtn-str (substring str start)))))
(defun hpath:substitute-var-name (var-symbol var-dir-val path)
"Replace with VAR-SYMBOL any occurrences of VAR-DIR-VAL in PATH.
diff --git a/hypb.el b/hypb.el
index c4bad25..ee18ee8 100644
--- a/hypb.el
+++ b/hypb.el
@@ -580,10 +580,12 @@ WINDOW pixelwise."
((symbolp object)
(get object 'hyperbole))))
-(defun hypb:replace-match-string (regexp str newtext &optional literal
fixedcase)
- "Replace all matches for REGEXP in STR with NEWTEXT string and return the
result.
+(defun hypb:replace-match-string (regexp str new &optional literal fixedcase)
+ "Replace all matches for REGEXP in STR with NEW string and return the result.
+If NEW is nil, return STR unchanged.
+
Optional LITERAL non-nil means do a literal replacement.
-Otherwise treat \\ in NEWTEXT string as special:
+Otherwise treat \\ in NEW string as special:
\\& means substitute original matched text,
\\N means substitute match for \(...\) number N,
\\\\ means insert one \\.
@@ -592,17 +594,19 @@ If optional fifth arg FIXEDCASE is non-nil, do not alter
the case of
the replacement text. Otherwise, maybe capitalize the whole text, or
maybe just word initials, based on the replaced text. If the replaced
text has only capital letters and has at least one multiletter word,
-convert NEWTEXT to all caps. Otherwise if all words are capitalized
-in the replaced text, capitalize each word in NEWTEXT.
+convert NEW to all caps. Otherwise if all words are capitalized
+in the replaced text, capitalize each word in NEW.
-NEWTEXT may instead be a function of one argument (the string to replace in)
+NEW may instead be a function of one argument (the string to replace in)
that returns a replacement string."
- (unless (stringp str)
- (error "(hypb:replace-match-string): 2nd arg must be a string: %s" str))
- (unless (or (stringp newtext) (functionp newtext))
- (error "(hypb:replace-match-string): 3rd arg must be a string or function:
%s"
- newtext))
- (replace-regexp-in-string regexp newtext str fixedcase literal))
+ (if (null new)
+ str
+ (unless (stringp str)
+ (error "(hypb:replace-match-string): 2nd arg must be a string: %s" str))
+ (unless (or (stringp new) (functionp new))
+ (error "(hypb:replace-match-string): 3rd arg must be a string or
function: %s"
+ new))
+ (replace-regexp-in-string regexp new str fixedcase literal)))
(defun hypb:return-process-output (program &optional infile &rest args)
"Return as a string the output from external PROGRAM with INFILE for input.
diff --git a/hyrolo.el b/hyrolo.el
index 5f490cb..84a15b1 100644
--- a/hyrolo.el
+++ b/hyrolo.el
@@ -95,6 +95,7 @@ executable must be found as well (for Oauth security)."
"Return non-nil if `hyrolo-google-contacts-flag' is non-nil and
google-contacts package and gpg executables are available for use."
(and hyrolo-google-contacts-flag
(featurep 'google-contacts)
+ (boundp 'google-contacts-buffer-name)
;; If no gpg encryption executable, Oauth login to Google will fail.
(or (executable-find "gpg2") (executable-find "gpg"))))
@@ -104,7 +105,7 @@ executable must be found as well (for Oauth security)."
(defun hyrolo-initialize-file-list ()
"Initialize the list of files used for HyRolo search."
(interactive)
- (let* ((gcontacts (if (hyrolo-google-contacts-p)
google-contacts-buffer-name))
+ (let* ((gcontacts (when (hyrolo-google-contacts-p)
google-contacts-buffer-name))
(ms "c:/_rolo.otl")
(posix "~/.rolo.otl")
(list (delq nil (if (and (boundp 'bbdb-file) (stringp bbdb-file))
@@ -357,7 +358,7 @@ Returns entry name if found, else nil."
(cond ((and (boundp 'bbdb-file) (stringp bbdb-file) (equal src
(expand-file-name bbdb-file)))
;; For now, can't edit an entry from the bbdb database,
signal an error.
(error "(hyrolo-edit-entry): BBDB entries are not
editable"))
- ((and (featurep 'google-contacts) (equal src (get-buffer
google-contacts-buffer-name)))
+ ((and (hyrolo-google-contacts-p) (equal src (get-buffer
google-contacts-buffer-name)))
;; For now, can't edit an entry from Google Contacts,
signal an error.
(error "(hyrolo-edit-entry): Google Contacts entries are
not editable"))
(t (hyrolo-edit name src)
diff --git a/kotl/kexport.el b/kotl/kexport.el
index d5dcbf1..87e4cfa 100644
--- a/kotl/kexport.el
+++ b/kotl/kexport.el
@@ -15,7 +15,7 @@
;; Within JavaScript-enabled web browsers, koutline parent cells exported to
;; HTML may be expanded and collapsed interactively. This feature utilizes
;; a small 20-line JavaScript snippet that is included in each exported
-;; koutline.
+;; koutline.
;;; Code:
;;; ************************************************************************
diff --git a/kotl/kotl-mode.el b/kotl/kotl-mode.el
index ce5bd16..09db305 100644
--- a/kotl/kotl-mode.el
+++ b/kotl/kotl-mode.el
@@ -3071,12 +3071,11 @@ With optional BACKWARD-P, move backward if possible to
get to valid position."
(goto-char (kcell-view:start nil label-sep-len)))
((kotl-mode:eobp)
(skip-chars-backward "\n\r"))
- (t (let ((indent (kcell-view:indent nil label-sep-len)))
- (when (bolp)
- (if backward-p
- (skip-chars-backward "\n\r")
- (skip-chars-forward "\n\r")))
- (setq indent (kcell-view:indent nil label-sep-len))
+ (t (when (bolp)
+ (if backward-p
+ (skip-chars-backward "\n\r")
+ (skip-chars-forward "\n\r")))
+ (let ((indent (kcell-view:indent nil label-sep-len)))
(when (< (current-column) indent)
(move-to-column indent))))))))
diff --git a/kotl/kview.el b/kotl/kview.el
index a3ff628..5e67211 100644
--- a/kotl/kview.el
+++ b/kotl/kview.el
@@ -358,8 +358,8 @@ the start of its body. Optional INDENT is the indentation
in
characters of the cell whose level is desired."
(unless label-sep-len
(setq label-sep-len (kview:label-separator-length kview)))
- (/ (- (or indent (kcell-view:indent pos label-sep-len)) label-sep-len)
- (kview:level-indent kview)))
+ (floor (/ (- (or indent (kcell-view:indent pos label-sep-len)) label-sep-len)
+ (kview:level-indent kview))))
(defun kcell-view:line (&optional pos)
"Return contents of cell line at point or optional POS as a string."
@@ -919,9 +919,10 @@ in the view.
FUNC should take one argument, the kview local variable of the current
buffer or some other kview, and should operate upon the cell at point.
-`Cell-indent' contains the indentation value of the first cell mapped when
-FUNC is called so that it may test against this value. `Label-sep-len'
-contains the label separator length.
+The variable `cell-indent' contains the indentation value of the
+first cell mapped when FUNC is called so that it may be tested
+against this value. The variable `label-sep-len' contains the label
+separator length.
See also `kview:map-branch' and `kview:map-tree'."
(with-current-buffer (kview:buffer kview)
@@ -931,10 +932,10 @@ See also `kview:map-branch' and `kview:map-tree'."
cell-indent)
;; Next line ensures point is in the root of the current tree if
;; the tree is at all hidden.
- (if visible-p (kotl-mode:to-start-of-line))
- (if first-p
- ;; Move back to first predecessor at same level.
- (while (kcell-view:backward t label-sep-len)))
+ (when visible-p (kotl-mode:to-start-of-line))
+ (when first-p
+ ;; Move back to first predecessor at same level.
+ (while (kcell-view:backward t label-sep-len)))
(setq cell-indent (kcell-view:indent nil label-sep-len))
;; Terminate when no further cells at same level.
(while (progn (setq results (cons (funcall func kview) results))
@@ -953,9 +954,10 @@ With optional TOP-P non-nil, maps over all of kview's
cells.
FUNC should take one argument, the kview with the tree to map, and should
operate upon the cell at point.
-`Cell-indent' contains the indentation value of the first cell mapped when
-FUNC is called so that it may test against this value. `Label-sep-len'
-contains the label separator length.
+The variable `cell-indent' contains the indentation value of the
+first cell mapped when FUNC is called so that it may be tested
+against this value. The variable `label-sep-len' contains the label
+separator length.
See also `kview:map-region', `kview:map-branch' and `kview:map-siblings'."
(with-current-buffer (kview:buffer kview)
@@ -1006,9 +1008,10 @@ view.
FUNC should take one argument, the kview with the tree to map, and
should operate upon the cell at point.
-`Cell-indent' contains the indentation value of the first cell mapped when
-FUNC is called so that it may test against this value. `Label-sep-len'
-contains the label separator length.
+The variable `cell-indent' contains the indentation value of the
+first cell mapped when FUNC is called so that it may be tested
+against this value. The variable `label-sep-len' contains the label
+separator length.
See also `kview:map-region', `kview:map-branch' and `kview:map-siblings'."
(with-current-buffer (kview:buffer kview)
diff --git a/test/hbut-tests.el b/test/hbut-tests.el
index 6363c20..bfc6319 100644
--- a/test/hbut-tests.el
+++ b/test/hbut-tests.el
@@ -497,7 +497,7 @@
(should was-called)))))
(ert-deftest hbut-load-modifier-with-plain-file-loads-file-from-load-path ()
- "Path prefix - with filename without diretory will load from`load-path'."
+ "Path prefix - filename without directory will load from`load-path'."
(with-temp-buffer
(insert "\"-tutorial.el\"")
(goto-char 2)