[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[elpa] externals/hyperbole 004e608bb9 3/3: Fix a number of user-visible
|
From: |
ELPA Syncer |
|
Subject: |
[elpa] externals/hyperbole 004e608bb9 3/3: Fix a number of user-visible issues |
|
Date: |
Sun, 29 Jan 2023 03:57:59 -0500 (EST) |
branch: externals/hyperbole
commit 004e608bb9a82fd34b102d76e27774569ad1e3ea
Author: Bob Weiner <rsw@gnu.org>
Commit: Bob Weiner <rsw@gnu.org>
Fix a number of user-visible issues
Ebut creation in unsent email msg.
HyRolo implicit button activation rather than editing source of match.
Expand htype name in *Help* buffer so Action Key jumps to its def properly.
---
ChangeLog | 20 ++++-
hbdata.el | 21 +++--
hbut.el | 254 +++++++++++++++++++++++++++++-----------------------------
hmail.el | 46 ++++++-----
hmouse-tag.el | 11 ++-
hui-mouse.el | 17 +---
6 files changed, 197 insertions(+), 172 deletions(-)
diff --git a/ChangeLog b/ChangeLog
index 20005090ac..6b5712d0dc 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,22 @@
+2023-01-29 Bob Weiner <rsw@gnu.org>
+
+* hbdata.el (hbdata:to-entry-buf): Fix error when creating an ebut in an
+ unsent message-compose buffer. Had assumed buffer-file-name there
+ would be nil but now Emacs saves unsent drafts to a file, so have to
+ check if is a mail or news buffer instead.
+
+* hui-mouse.el (smart-man-entry-ref): Replace 'smart-symlink-expand' call
+ with 'hpath:symlink-referent'.
+ (smart-symlink-expand): Remove this function.
+
+* hbut.el (ibut:to-text): Fix so does not move point if lbl-key end up nil.
+
+2023-01-28 Bob Weiner <rsw@gnu.org>
+
+* hmouse-tag.el (smart-lisp-htype-tag): Fix so expands shortened htype tags
+ whose symbols have been interned when defined. This fixes jumping to
+ the definition of htypes in Help buffers.
+
2023-01-22 Mats Lidell <matsl@gnu.org>
* hypb.el: Add variable and function declarations for package
@@ -8163,7 +8182,6 @@ V6.0.0 changes ^^^^:
* man/hyperbole.texi (Smart Key - Identifier Menu Mode ): Renamed and updated
with imenu support.
hui-mouse.el (smart-imenu-display-item-where, smart-item-menu-p,
smart-imenu-item-at-p): Added
-
these functions and to use the Emacs imenu library to display programming
identifiers defined
within the same file in which they are referenced. This works without a
TAGS file and on files
that have not yet been evaluated within the current Emacs session.
diff --git a/hbdata.el b/hbdata.el
index 87ed9e4344..330aa50e7a 100644
--- a/hbdata.el
+++ b/hbdata.el
@@ -3,7 +3,7 @@
;; Author: Bob Weiner
;;
;; Orig-Date: 2-Apr-91
-;; Last-Mod: 20-Jan-23 at 23:17:59 by Mats Lidell
+;; Last-Mod: 29-Jan-23 at 02:34:21 by Bob Weiner
;;
;; Copyright (C) 1991-2021 Free Software Foundation, Inc.
;; See the "HY-COPY" file for license information.
@@ -407,13 +407,20 @@ Use hbdata file in KEY-SRC's directory, or optional
DIRECTORY or if nil, use
With optional CREATE, if no such line exists, insert a new file entry at the
beginning of the hbdata file (which is created if necessary).
Return non-nil if KEY-SRC is found or created, else nil."
- (let ((rtn) (ln-dir))
- (if (and (get-buffer key-src)
- (set-buffer key-src)
- (not buffer-file-name))
+ (let (rtn
+ ln-dir)
+ ;; Drafts of mail messages now have a buffer-file-name since they
+ ;; are temporarily saved to a file until sent. But but-data still
+ ;; should be stored in the mail buffer itself, so check explicitly
+ ;; whether is a mail composition buffer in such cases.
+ (if (or (hmail:mode-is-p)
+ (and (get-buffer key-src)
+ (set-buffer key-src)
+ (not buffer-file-name)))
;; Button buffer has no file attached
- (progn (setq buffer-read-only nil)
- (unless (hmail:hbdata-to-p)
+ (progn (if (hmail:hbdata-to-p) ;; Might change the buffer
+ (setq buffer-read-only nil)
+ (setq buffer-read-only nil)
(insert "\n" hmail:hbdata-sep "\n"))
(backward-char 1)
(setq rtn t))
diff --git a/hbut.el b/hbut.el
index 5c591a0e60..0fd04a774f 100644
--- a/hbut.el
+++ b/hbut.el
@@ -3,7 +3,7 @@
;; Author: Bob Weiner
;;
;; Orig-Date: 18-Sep-91 at 02:57:09
-;; Last-Mod: 26-Nov-22 at 17:21:53 by Bob Weiner
+;; Last-Mod: 29-Jan-23 at 02:39:52 by Bob Weiner
;;
;; Copyright (C) 1991-2022 Free Software Foundation, Inc.
;; See the "HY-COPY" file for license information.
@@ -1605,95 +1605,98 @@ Return nil if no implicit button at point."
(itype)
(is-type categ))
- (hattr:clear 'hbut:current)
- (unless is-type
- (while (and (not is-type) types)
- (setq itype (car types))
- (when (and itype (setq args (funcall itype)))
- (setq is-type itype)
- ;; Any implicit button type check should leave point
- ;; unchanged. Trigger an error if not.
- (unless (equal (point-marker) ibpoint)
- (hypb:error "(Hyperbole): `%s' at-p test improperly moved point
from %s to %s"
- is-type ibpoint (point-marker))))
- (setq types (cdr types))))
-
- (set-marker ibpoint nil)
-
- (when is-type
- (let ((current-name (hattr:get 'hbut:current 'name))
- ;; (current-lbl-key (hattr:get 'hbut:current 'lbl-key))
- (current-lbl-start (hattr:get 'hbut:current 'lbl-start))
- (current-lbl-end (hattr:get 'hbut:current 'lbl-end))
- ;; (current-categ (hattr:get 'hbut:current 'categ))
- (current-loc (hattr:get 'hbut:current 'loc))
- (current-dir (hattr:get 'hbut:current 'dir))
- (current-action (hattr:get 'hbut:current 'action))
- ;; (current-actype (hattr:get 'hbut:current 'actype))
- (current-args (hattr:get 'hbut:current 'args)))
-
- (if current-name
- (setq name current-name)
- (unless name
- (setq name (ibut:label-p t nil nil nil t)))
- (when name
- (hattr:set 'hbut:current 'name name)))
-
- ;; Need to ignore current-lbl-key and use name if any
- (setq lbl-key (or (ibut:label-to-key name)
- lbl-key
- (ibut:label-p nil "\"" "\"" nil t)))
- (when lbl-key
- (hattr:set 'hbut:current 'lbl-key lbl-key))
-
- (if current-lbl-start
- (setq lbl-start current-lbl-start)
- (when lbl-start
- (hattr:set 'hbut:current 'lbl-start lbl-start)))
-
- (if current-lbl-end
- (setq lbl-end current-lbl-end)
- (when lbl-end
- (hattr:set 'hbut:current 'lbl-end lbl-end)))
-
- (hattr:set 'hbut:current 'categ is-type)
-
- (if current-loc
- (setq loc current-loc)
- (unless loc
- (setq loc (save-excursion (hbut:to-key-src 'full))))
- (when loc
- (hattr:set 'hbut:current 'loc loc)))
-
- (if current-dir
- (setq dir current-dir)
- (unless dir
- (setq dir (hui:key-dir (current-buffer))))
- (when dir
- (hattr:set 'hbut:current 'dir dir)))
-
- (if current-action
- (setq action current-action)
- (when action
- (hattr:set 'hbut:current 'action action)))
- (when action
- (unless args (setq args action)))
-
- (or current-args
- (not (listp args))
- (progn
- (setq args (copy-sequence args))
- (when (eq (car args) #'hact)
- (setq args (cdr args)))
- (hattr:set 'hbut:current 'actype
- (or
- actype
- ;; Hyperbole action type
- (symtable:actype-p (car args))
- ;; Regular Emacs Lisp function symbol
- (car args)))
- (hattr:set 'hbut:current 'args (if actype args (cdr args))))))
- 'hbut:current))))
+ (unwind-protect
+ (progn
+ (hattr:clear 'hbut:current)
+ (unless is-type
+ (while (and (not is-type) types)
+ (setq itype (car types))
+ (when (and itype (setq args (funcall itype)))
+ (setq is-type itype)
+ ;; Any implicit button type check should leave point
+ ;; unchanged. Trigger an error if not.
+ (unless (equal (point-marker) ibpoint)
+ (hypb:error "(Hyperbole): `%s' at-p test improperly moved
point from %s to %s"
+ is-type ibpoint (point-marker))))
+ (setq types (cdr types))))
+
+ (set-marker ibpoint nil)
+
+ (when is-type
+ (let ((current-name (hattr:get 'hbut:current 'name))
+ ;; (current-lbl-key (hattr:get 'hbut:current 'lbl-key))
+ (current-lbl-start (hattr:get 'hbut:current 'lbl-start))
+ (current-lbl-end (hattr:get 'hbut:current 'lbl-end))
+ ;; (current-categ (hattr:get 'hbut:current 'categ))
+ (current-loc (hattr:get 'hbut:current 'loc))
+ (current-dir (hattr:get 'hbut:current 'dir))
+ (current-action (hattr:get 'hbut:current 'action))
+ ;; (current-actype (hattr:get 'hbut:current 'actype))
+ (current-args (hattr:get 'hbut:current 'args)))
+
+ (if current-name
+ (setq name current-name)
+ (unless name
+ (setq name (ibut:label-p t nil nil nil t)))
+ (when name
+ (hattr:set 'hbut:current 'name name)))
+
+ ;; Need to ignore current-lbl-key and use name if any
+ (setq lbl-key (or (ibut:label-to-key name)
+ lbl-key
+ (ibut:label-p nil "\"" "\"" nil t)))
+ (when lbl-key
+ (hattr:set 'hbut:current 'lbl-key lbl-key))
+
+ (if current-lbl-start
+ (setq lbl-start current-lbl-start)
+ (when lbl-start
+ (hattr:set 'hbut:current 'lbl-start lbl-start)))
+
+ (if current-lbl-end
+ (setq lbl-end current-lbl-end)
+ (when lbl-end
+ (hattr:set 'hbut:current 'lbl-end lbl-end)))
+
+ (hattr:set 'hbut:current 'categ is-type)
+
+ (if current-loc
+ (setq loc current-loc)
+ (unless loc
+ (setq loc (save-excursion (hbut:to-key-src 'full))))
+ (when loc
+ (hattr:set 'hbut:current 'loc loc)))
+
+ (if current-dir
+ (setq dir current-dir)
+ (unless dir
+ (setq dir (hui:key-dir (current-buffer))))
+ (when dir
+ (hattr:set 'hbut:current 'dir dir)))
+
+ (if current-action
+ (setq action current-action)
+ (when action
+ (hattr:set 'hbut:current 'action action)))
+ (when action
+ (unless args (setq args action)))
+
+ (or current-args
+ (not (listp args))
+ (progn
+ (setq args (copy-sequence args))
+ (when (eq (car args) #'hact)
+ (setq args (cdr args)))
+ (hattr:set 'hbut:current 'actype
+ (or
+ actype
+ ;; Hyperbole action type
+ (symtable:actype-p (car args))
+ ;; Regular Emacs Lisp function symbol
+ (car args)))
+ (hattr:set 'hbut:current 'args (if actype args (cdr
args))))))
+ 'hbut:current))
+ (set-marker ibpoint nil)))))
(defun ibut:delete (&optional but-sym)
"Delete Hyperbole implicit button based on optional BUT-SYM.
@@ -2023,41 +2026,42 @@ implicit buttons.
Return the symbol for the button if found, else nil."
(unless lbl-key
(setq lbl-key (ibut:label-p nil nil nil nil t)))
- (hbut:funcall
- (lambda (lbl-key _buffer _key-src)
- (let* ((name-start-end (ibut:label-p t nil nil t t))
- (name-end (nth 2 name-start-end))
- (at-name (car name-start-end))
- (at-lbl-key (ibut:label-p nil "\"" "\"" nil t))
- (opoint (point))
- move-flag
- start
- ibut)
- ;; Do not move point if it is already in the text of an
- ;; implicit button matching LBL-KEY. If on the name of
- ;; the same button, move into the text of the button.
- (cond ((and lbl-key (equal at-lbl-key lbl-key))
- (setq ibut 'hbut:current))
- ((and at-name (equal (ibut:label-to-key at-name) lbl-key))
- (setq ibut 'hbut:current
- move-flag t))
- ((and lbl-key (setq ibut (ibut:to lbl-key)))
- (setq move-flag t)))
- (when (and move-flag ibut (not (hbut:outside-comment-p)))
- ;; Skip past any optional name and separators
- (if (setq start (hattr:get ibut 'lbl-start))
- (goto-char start)
- (when name-end
- (goto-char name-end)
- (if (looking-at ibut:label-separator-regexp)
- ;; Move past up to 2 possible characters of ibut
- ;; delimiters to ensure are inside the ibut name; this
- ;; prevents recognizing labeled, delimited ibuts of a
- ;; single character since no one should need that.
- (goto-char (min (+ 2 (match-end 0)) (point-max)))
- (goto-char opoint)))))
- ibut))
- lbl-key))
+ (when lbl-key
+ (hbut:funcall
+ (lambda (lbl-key _buffer _key-src)
+ (let* ((name-start-end (ibut:label-p t nil nil t t))
+ (name-end (nth 2 name-start-end))
+ (at-name (car name-start-end))
+ (at-lbl-key (ibut:label-p nil "\"" "\"" nil t))
+ (opoint (point))
+ move-flag
+ start
+ ibut)
+ ;; Do not move point if it is already in the text of an
+ ;; implicit button matching LBL-KEY. If on the name of
+ ;; the same button, move into the text of the button.
+ (cond ((and lbl-key (equal at-lbl-key lbl-key))
+ (setq ibut 'hbut:current))
+ ((and at-name (equal (ibut:label-to-key at-name) lbl-key))
+ (setq ibut 'hbut:current
+ move-flag t))
+ ((and lbl-key (setq ibut (ibut:to lbl-key)))
+ (setq move-flag t)))
+ (when (and move-flag ibut (not (hbut:outside-comment-p)))
+ ;; Skip past any optional name and separators
+ (if (setq start (hattr:get ibut 'lbl-start))
+ (goto-char start)
+ (when name-end
+ (goto-char name-end)
+ (if (looking-at ibut:label-separator-regexp)
+ ;; Move past up to 2 possible characters of ibut
+ ;; delimiters to ensure are inside the ibut name; this
+ ;; prevents recognizing labeled, delimited ibuts of a
+ ;; single character since no one should need that.
+ (goto-char (min (+ 2 (match-end 0)) (point-max)))
+ (goto-char opoint)))))
+ ibut))
+ lbl-key)))
;;; ------------------------------------------------------------------------
(defconst ibut:label-start "<["
diff --git a/hmail.el b/hmail.el
index c03c275198..1e53a4626d 100644
--- a/hmail.el
+++ b/hmail.el
@@ -3,7 +3,7 @@
;; Author: Bob Weiner
;;
;; Orig-Date: 9-Oct-91 at 18:38:05
-;; Last-Mod: 25-Jul-22 at 17:59:37 by Mats Lidell
+;; Last-Mod: 29-Jan-23 at 02:03:03 by Bob Weiner
;;
;; Copyright (C) 1991-2022 Free Software Foundation, Inc.
;; See the HY-COPY (Hyperbole) or BR-COPY (OO-Browser) file for license
@@ -73,7 +73,8 @@ Has side-effect of widening buffer.
Message's displayable part begins at optional MSG-START and ends at or before
MSG-END."
(widen)
- (or msg-end (setq msg-end (point-max)))
+ (unless msg-end
+ (setq msg-end (point-max)))
(save-excursion
(goto-char msg-end)
(if (search-backward hmail:hbdata-sep msg-start t) (1- (point)) msg-end)))
@@ -81,17 +82,19 @@ MSG-END."
(defun hmail:hbdata-to-p ()
"Move point to the start of embedded Hyperbole button data.
Return t if button data is found, else nil."
- (and (cond ((memq major-mode (list hmail:reader hmail:modifier))
- (hmail:msg-narrow) t)
- ((or (hmail:lister-p) (hnews:lister-p)) t)
- ((memq major-mode (list hmail:composer hnews:reader
- hnews:composer))
- (widen) t)
- ((not buffer-file-name)))
- (progn
- (goto-char (point-max))
- (if (search-backward hmail:hbdata-sep nil t)
- (progn (forward-line 1) t)))))
+ (when (cond ((memq major-mode (list hmail:reader hmail:modifier))
+ (hmail:msg-narrow)
+ t)
+ ((or (hmail:lister-p) (hnews:lister-p)) t)
+ ((memq major-mode (list hmail:composer hnews:reader
+ hnews:composer))
+ (widen)
+ t)
+ ((not buffer-file-name)))
+ (goto-char (point-max))
+ (when (search-backward hmail:hbdata-sep nil t)
+ (forward-line 1)
+ t)))
(defun hmail:browser-p ()
"Return t iff current major mode helps browse received e-mail messages."
@@ -103,8 +106,10 @@ Invisible text is expanded and included in the mail only
if INVISIBLE-FLAG is
non-nil. BUF defaults to the current buffer and may be a buffer or buffer
name."
(interactive (list (current-buffer) (y-or-n-p "Include invisible text? ")))
- (or buf (setq buf (current-buffer)))
- (if (stringp buf) (setq buf (get-buffer buf)))
+ (unless buf
+ (setq buf (current-buffer)))
+ (when (stringp buf)
+ (setq buf (get-buffer buf)))
(set-buffer buf)
(hmail:region (point-min) (point-max) buf invisible-flag))
@@ -240,17 +245,16 @@ Signals error when current mail reader is not supported."
(let* ((reader (symbol-name hmail:reader))
;; (toggled)
)
- (or (fboundp 'rmail:msg-hdrs-full)
- (error "(rmail:msg-id-get): Invalid mail reader: %s" reader))
+ (unless (fboundp 'rmail:msg-hdrs-full)
+ (error "(rmail:msg-id-get): Invalid mail reader: %s" reader))
(save-excursion
(unwind-protect
(progn
;; (setq toggled (rmail:msg-hdrs-full nil))
(goto-char (point-min))
- (if (re-search-forward (concat rmail:msg-hdr-prefix
- "\\(.+\\)"))
- ;; Found matching msg
- (buffer-substring (match-beginning 2) (match-end 2))))
+ (when (re-search-forward (concat rmail:msg-hdr-prefix "\\(.+\\)"))
+ ;; Found matching msg
+ (buffer-substring (match-beginning 2) (match-end 2))))
;; (rmail:msg-hdrs-full toggled)
()))))
diff --git a/hmouse-tag.el b/hmouse-tag.el
index 7d31e429f7..6371bc03c3 100644
--- a/hmouse-tag.el
+++ b/hmouse-tag.el
@@ -3,7 +3,7 @@
;; Author: Bob Weiner
;;
;; Orig-Date: 24-Aug-91
-;; Last-Mod: 15-Jan-23 at 16:56:07 by Mats Lidell
+;; Last-Mod: 28-Jan-23 at 23:51:50 by Bob Weiner
;;
;; Copyright (C) 1991-2022 Free Software Foundation, Inc.
;; See the "HY-COPY" file for license information.
@@ -739,9 +739,12 @@ Return matching Elisp tag name that point is within, else
nil."
;; If tag is preceded by an 'hact' call, then treat as a
Hyperbole actype.
(or (symtable:actype-p tag) tag))
(tag
- (if (intern-soft tag)
- tag
- (or (symtable:ibtype-p tag) (symtable:actype-p tag)
tag)))))
+ (let ((tag-sym (intern-soft tag)))
+ ;; The partial names of htypes will be interned
+ ;; but not fboundp or boundp.
+ (if (and tag-sym (or (fboundp tag-sym) (boundp 'tag-sym)))
+ tag
+ (or (symtable:ibtype-p tag) (symtable:actype-p tag)
tag))))))
(cond ((or (null tag) (stringp tag))
tag)
((symbolp tag)
diff --git a/hui-mouse.el b/hui-mouse.el
index 1b6e48bf57..b5f3596c19 100644
--- a/hui-mouse.el
+++ b/hui-mouse.el
@@ -3,7 +3,7 @@
;; Author: Bob Weiner
;;
;; Orig-Date: 04-Feb-89
-;; Last-Mod: 15-Jan-23 at 20:35:52 by Mats Lidell
+;; Last-Mod: 29-Jan-23 at 01:03:45 by Bob Weiner
;;
;; Copyright (C) 1991-2022 Free Software Foundation, Inc.
;; See the "HY-COPY" file for license information.
@@ -544,17 +544,6 @@ smart keyboard keys.")
(if (where-is-internal 'minibuffer-completion-help (current-local-map))
(minibuffer-completion-help)))
-(defun smart-symlink-expand (path)
- "Return referent for possible symbolic link, PATH."
- (if (not (fboundp 'symlink-referent))
- path
- (let ((start 0) (len (length path)) (ref) (part))
- (while (and (< start len) (setq part (string-match "/[^/]*" path start)))
- (setq part (concat ref
- (substring path start (setq start (match-end 0))))
- ref (symlink-referent part))) ;; FIXME - Where is this function
defined
- ref)))
-
;;; ************************************************************************
;;; smart-buffer-menu functions
;;; ************************************************************************
@@ -1581,10 +1570,10 @@ local variable containing its pathname."
(if (not (or (if (string-match "Manual Entry\\|\\*man "
(buffer-name (current-buffer)))
(progn (and (boundp 'man-path) man-path
- (setq ref (smart-symlink-expand man-path)))
+ (setq ref (hpath:symlink-referent man-path)))
t))
(if buffer-file-name
- (string-match "/man/" (setq ref (smart-symlink-expand
+ (string-match "/man/" (setq ref (hpath:symlink-referent
buffer-file-name))))))
(setq ref nil)
(or (setq ref (or (smart-man-file-ref)