[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[elpa] externals/hyperbole 269665e586 2/4: Fix gbut created in wrong buf
|
From: |
ELPA Syncer |
|
Subject: |
[elpa] externals/hyperbole 269665e586 2/4: Fix gbut created in wrong buffer bug; change gbut:file to a function |
|
Date: |
Sat, 5 Feb 2022 17:57:33 -0500 (EST) |
branch: externals/hyperbole
commit 269665e5863fe056d2ab17f039b099f802ab6684
Author: Bob Weiner <rsw@gnu.org>
Commit: Bob Weiner <rsw@gnu.org>
Fix gbut created in wrong buffer bug; change gbut:file to a function
And these changes:
* hpath.el (hpath:outline-section-pattern): Remove leading spaces
(hpath:to-markup-anchor): Search for leading spaces in above
regexp
only after not finding a match without leading spaces. This prevents
matching to Table of Contents entries with the same section name but
indented.
* hui.el (hui:error): Remove, has been obsolete for a long time. Use
hypb:error.
(hui:ebut-delimit): Remove, has been obsolete for a long time.
Use ebut:delimit instead.
* hbut.el (gbut:file): Change from a variable to a function so if user
resets
any of its components, the current value is always used. Fixes bug
where
global buttons were written to the wrong file.
* hsmail.el (mail-yank-original): Fix indentation of this overloaded
function.
(message--yank-original-internal): Add overloading of this
function.
---
ChangeLog | 26 ++++++
hactypes.el | 4 +-
hargs.el | 15 ++--
hbut.el | 29 +++----
hpath.el | 49 +++++++-----
hsmail.el | 233 +++++++++++++++++++++++++++++++-----------------------
hui-mini.el | 6 +-
hui.el | 80 +++++++++----------
test/hui-tests.el | 10 +--
9 files changed, 262 insertions(+), 190 deletions(-)
diff --git a/ChangeLog b/ChangeLog
index 54fb8f19b1..b7ef69df9c 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,27 @@
+2022-02-05 Bob Weiner <rsw@gnu.org>
+
+* hpath.el (hpath:outline-section-pattern): Remove leading spaces
+ (hpath:to-markup-anchor): Search for leading spaces in above regexp
+ only after not finding a match without leading spaces. This prevents
+ matching to Table of Contents entries with the same section name but
indented.
+
+* hui.el (hui:gbut-create, hui:buf-writable-err): Fix sporadic bug where err
+ function did not trigger an error but changed the (current-buffer), thereby
+ cause the 'hui:gbut-create' function to improperly place a global button
+ in the wrong buffer.
+ (hui:error): Remove, has been obsolete for a long time. Use
hypb:error.
+ (hui:ebut-delimit): Remove, has been obsolete for a long time.
+ Use ebut:delimit instead.
+ hargs.el (hargs:action-get): Add a save-excursion to fix above bug as this
+ was temporarily changing the current-buffer.
+
+* hbut.el (gbut:file): Change from a variable to a function so if user resets
+ any of its components, the current value is always used. Fixes bug where
+ global buttons were written to the wrong file.
+
+* hsmail.el (mail-yank-original): Fix indentation of this overloaded function.
+ (message--yank-original-internal): Add overloading of this
function.
+
2022-02-04 Mats Lidell <matsl@gnu.org>
* test/hargs-tests.el (hargs-get-verify-extension-characters)
@@ -8450,3 +8474,5 @@ V5.06 changes ^^^^:
Copyright 1991-2021 Free Software Foundation, Inc.
Copying and distribution of this file, with or without modification, are
permitted provided the copyright notice and this notice are preserved.
+
+
diff --git a/hactypes.el b/hactypes.el
index a274f9fc93..ca20d91bb5 100644
--- a/hactypes.el
+++ b/hactypes.el
@@ -3,7 +3,7 @@
;; Author: Bob Weiner
;;
;; Orig-Date: 23-Sep-91 at 20:34:36
-;; Last-Mod: 29-Jan-22 at 19:47:39 by Bob Weiner
+;; Last-Mod: 5-Feb-22 at 11:39:05 by Bob Weiner
;;
;; Copyright (C) 1991-2022 Free Software Foundation, Inc.
;; See the "HY-COPY" file for license information.
@@ -439,7 +439,7 @@ the window or as close as possible."
Optional second arg, KEY-FILE, is not used but is for calling
compatibility with the `hlink' function."
(interactive
- (let ((gbut-file (hpath:validate (hpath:substitute-value gbut:file)))
+ (let ((gbut-file (hpath:validate (hpath:substitute-value (gbut:file))))
but-lbl)
(if (not (file-readable-p gbut-file))
(hypb:error "(link-to-gbut): You cannot read `%s'" gbut-file)
diff --git a/hargs.el b/hargs.el
index 4d0ac3259d..595cb84a10 100644
--- a/hargs.el
+++ b/hargs.el
@@ -3,7 +3,7 @@
;; Author: Bob Weiner
;;
;; Orig-Date: 31-Oct-91 at 23:17:35
-;; Last-Mod: 30-Jan-22 at 22:15:38 by Bob Weiner
+;; Last-Mod: 5-Feb-22 at 13:06:32 by Bob Weiner
;;
;; Copyright (C) 1991-2022 Free Software Foundation, Inc.
;; See the "HY-COPY" file for license information.
@@ -86,11 +86,12 @@
Current button is being modified when MODIFYING is t.
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)))
- (when interactive-form
- (hpath:relative-arguments
- (hargs:iform-read interactive-form modifying))))))
+ (save-excursion
+ (and (or (hypb:emacs-byte-code-p action) (listp action))
+ (let ((interactive-form (action:commandp action)))
+ (when interactive-form
+ (hpath:relative-arguments
+ (hargs:iform-read interactive-form modifying)))))))
(defun hargs:buffer-substring (start end)
"Return the buffer substring sans any properties between START and END
positions.
@@ -356,7 +357,7 @@ Handles all of the interactive argument types that
`hargs:iform-read' does."
((eq hargs:reading-type 'ebut) (ebut:label-p 'as-label))
((eq hargs:reading-type 'ibut) (ibut:label-p 'as-label))
((eq hargs:reading-type 'gbut)
- (when (eq (current-buffer) (get-file-buffer gbut:file))
+ (when (eq (current-buffer) (get-file-buffer (gbut:file)))
(hbut:label-p 'as-label)))
((eq hargs:reading-type 'hbut) (hbut:label-p 'as-label))
((hbut:label-p) nil)
diff --git a/hbut.el b/hbut.el
index 054a867472..13671b820d 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: 30-Jan-22 at 03:17:19 by Bob Weiner
+;; Last-Mod: 5-Feb-22 at 11:42:05 by Bob Weiner
;;
;; Copyright (C) 1991-2021 Free Software Foundation, Inc.
;; See the "HY-COPY" file for license information.
@@ -600,9 +600,6 @@ Insert INSTANCE-FLAG after END, before ending delimiter."
;;; gbut class - Global Hyperbole buttons - activated by typing label name
;;; ========================================================================
-(defvar gbut:file (expand-file-name hbmap:filename hbmap:dir-user)
- "File that stores globally accessible Hyperbole buttons, accessed by name.")
-
(defun gbut:act (label)
"Activate Hyperbole global button with LABEL."
(interactive (list (hargs:read-match "Activate global button labeled: "
@@ -621,7 +618,7 @@ Insert INSTANCE-FLAG after END, before ending delimiter."
(defun gbut:delete (&optional lbl-key)
"Delete Hyperbole global button based on optional LBL-KEY or button at point.
Return entry deleted (a list of attribute values) or nil."
- (hbut:delete lbl-key nil gbut:file))
+ (hbut:delete lbl-key nil (gbut:file)))
(defun gbut:ebut-program (label actype &rest args)
"Programmatically create a global explicit Hyperbole button at point from
LABEL, ACTYPE (action type), and optional actype ARGS.
@@ -642,8 +639,12 @@ For interactive creation, use `hui:gbut-create' instead."
(insert "\n"))
(eval `(ebut:program ',label ',actype ,@args))))))
+(defun gbut:file ()
+ "Return the absolute filename that stores Hyperbole global buttons (those
accessed by name)."
+ (expand-file-name hbmap:filename hbmap:dir-user))
+
(defun gbut:get (&optional lbl-key)
- "Return global Hyperbole button symbol given by optional LBL-KEY if found in
gbut:file.
+ "Return global Hyperbole button symbol given by optional LBL-KEY if found in
(gbut:file).
Retrieve any button data, convert into a button object and return a symbol
which references the button.
@@ -652,7 +653,7 @@ All arguments are optional. When none are given, return a
symbol for
the button that point is within.
Return nil if no matching button is found."
- (hbut:get lbl-key nil gbut:file))
+ (hbut:get lbl-key nil (gbut:file)))
(defun gbut:help (label)
"Display help for Hyperbole global button with LABEL."
@@ -660,7 +661,7 @@ Return nil if no matching button is found."
(mapcar 'list (gbut:label-list))
nil t nil 'hbut)))
(let* ((lbl-key (hbut:label-to-key label))
- (but (hbut:get lbl-key nil gbut:file)))
+ (but (hbut:get lbl-key nil (gbut:file))))
(if but
(hbut:report but)
(error "(gbut:help): No global button labeled: %s" label))))
@@ -681,18 +682,18 @@ delimiters. With POS-FLAG non-nil, return the list of
label-or-key,
but-start-position, but-end-position. Positions include
delimiters. With TWO-LINES-FLAG non-nil, constrain label search
to two lines."
- (when (equal buffer-file-name gbut:file)
+ (when (equal buffer-file-name (gbut:file))
(hbut:label-p as-label start-delim end-delim pos-flag two-lines-flag)))
(defun gbut:to (lbl-key)
"Find the global button with LBL-KEY (a label or label key) within the
visible portion of the global button file.
Leave point inside the button label, if it has one.
Return the symbol for the button when found, else nil."
- (when (file-readable-p gbut:file)
+ (when (file-readable-p (gbut:file))
(let ((obuf (current-buffer))
(opoint (point))
found)
- (set-buffer (find-file-noselect gbut:file))
+ (set-buffer (find-file-noselect (gbut:file)))
(setq found (hbut:to lbl-key))
(if found
(hpath:display-buffer (current-buffer) 'this-window)
@@ -708,7 +709,7 @@ Return the symbol for the button when found, else nil."
(defun gbut:ebut-key-list ()
"Return a list of explicit button label keys from the global button file."
(save-excursion
- (when (hbdata:to-entry-buf gbut:file)
+ (when (hbdata:to-entry-buf (gbut:file))
(let (gbuts)
(save-restriction
(narrow-to-region (point) (if (search-forward "\f" nil t)
@@ -721,9 +722,9 @@ Return the symbol for the button when found, else nil."
(defun gbut:ibut-key-list ()
"Return a list of implicit button label keys from the global button file."
- (when (file-readable-p gbut:file)
+ (when (file-readable-p (gbut:file))
(save-excursion
- (with-current-buffer (find-file-noselect gbut:file)
+ (with-current-buffer (find-file-noselect (gbut:file))
(save-restriction
(widen)
(ibut:label-map #'(lambda (label start end) (ibut:label-to-key
label))))))))
diff --git a/hpath.el b/hpath.el
index 447fdbd584..8ccb55b8a7 100644
--- a/hpath.el
+++ b/hpath.el
@@ -621,8 +621,8 @@ use with `string-match'.")
(defconst hpath:markdown-suffix-regexp "\\.[mM][dD]"
"Regexp that matches to a Markdown file suffix.")
-(defconst hpath:outline-section-pattern "^[ \t]*\\*+[ \t]+%s[
\t]*\\([:punct:]+\\|$\\)"
- "Regexp matching an Emacs outline section header and containing a %s for
replacement of a specific section name.")
+(defconst hpath:outline-section-pattern "^\\*+[ \t]+%s[
\t]*\\([:punct:]+\\|$\\)"
+ "Bol-anchored, no leading spaces regexp matching an Emacs outline section
header and containing a %s for replacement of a specific section name.")
(defvar hpath:prefix-regexp "\\`[-!&][ ]*"
"Regexp matching command characters which may precede a pathname.
@@ -1396,26 +1396,33 @@ buffer but don't display it."
(anchor-name (if (or prog-mode
(string-match-p "-.* \\| .*-"
anchor))
anchor
- (subst-char-in-string ?- ?\ anchor))))
+ (subst-char-in-string ?- ?\ anchor)))
+ (referent-regexp (format
+ (cond ((or (derived-mode-p
'outline-mode) ;; Includes Org mode
+ ;; Treat all caps filenames
without suffix like outlines, e.g. README, INSTALL.
+ (and buffer-file-name
+ (string-match-p
"\\`[A-Z][A-Z0-9]+\\'" buffer-file-name)))
+ hpath:outline-section-pattern)
+ (prog-mode
+ "%s")
+ ((or (and buffer-file-name
+ (string-match-p
hpath:markdown-suffix-regexp buffer-file-name))
+ (memq major-mode
hpath:shell-modes))
+ hpath:markdown-section-pattern)
+ ((derived-mode-p 'texinfo-mode)
+ hpath:texinfo-section-pattern)
+ ((derived-mode-p 'text-mode)
+ "%s")
+ (t
hpath:outline-section-pattern))
+ (regexp-quote anchor-name)))
+ (referent-leading-spaces-regexp
+ (when (and (not (string-empty-p referent-regexp))
+ (= (aref referent-regexp 0) ?^))
+ (concat "^[ \t]+" (substring referent-regexp 1)))))
(goto-char (point-min))
- (if (re-search-forward (format
- (cond ((or (derived-mode-p
'outline-mode) ;; Includes Org mode
- ;; Treat all caps
filenames without suffix like outlines, e.g. README, INSTALL.
- (and buffer-file-name
- (string-match-p
"\\`[A-Z][A-Z0-9]+\\'" buffer-file-name)))
- hpath:outline-section-pattern)
- (prog-mode
- "%s")
- ((or (and buffer-file-name
- (string-match-p
hpath:markdown-suffix-regexp buffer-file-name))
- (memq major-mode
hpath:shell-modes))
- hpath:markdown-section-pattern)
- ((derived-mode-p 'texinfo-mode)
- hpath:texinfo-section-pattern)
- ((derived-mode-p 'text-mode)
- "%s")
- (t
hpath:outline-section-pattern))
- (regexp-quote anchor-name)) nil t)
+ (if (or (re-search-forward referent-regexp nil t)
+ (and referent-leading-spaces-regexp
+ (re-search-forward
referent-leading-spaces-regexp nil t)))
(progn (forward-line 0)
(when (eq (current-buffer) (window-buffer))
(recenter 0)))
diff --git a/hsmail.el b/hsmail.el
index 1f6881d5c4..cb67ab519f 100644
--- a/hsmail.el
+++ b/hsmail.el
@@ -3,7 +3,7 @@
;; Author: Bob Weiner
;;
;; Orig-Date: 9-May-91 at 04:50:20
-;; Last-Mod: 24-Jan-22 at 00:18:47 by Bob Weiner
+;; Last-Mod: 5-Feb-22 at 11:15:20 by Bob Weiner
;;
;; Copyright (C) 1991-2022 Free Software Foundation, Inc.
;; See the "HY-COPY" file for license information.
@@ -17,7 +17,7 @@
;;; Other required Elisp libraries
;;; ************************************************************************
-(require 'sendmail)
+(require 'message)
(require 'hypb) ;For `hypb:supercite-p'.
(defvar inhibit-hyperbole-messaging) ;; From "hsettings.el".
@@ -35,23 +35,13 @@ Default is nil for no comment. Set to:
for a comment.")
-;; Used by 'mail-send' in Emacs "sendmail.el".
-;; FIXME: Is this still needed?
-(add-function :before send-mail-function #'smail:widen)
+;; Used by 'message-send' in Emacs "message.el".
+(add-hook 'message-send-hook #'smail:widen)
;; For compatibility with Supercite and GNU Emacs.
-(defvar mail-yank-prefix "> "
- "*Prefix to insert on lines of yanked message being replied to.
-If this is nil, use indentation, as specified by `mail-indentation-spaces'.")
-
-(defvar mail-indentation-spaces 3
- "*Number of spaces to insert at the beginning of each cited line.
-Used by `mail-yank-original' via `mail-indent-citation'.")
-
-;;; ************************************************************************
-;;; Public declarations
-;;; ************************************************************************
-(defvar mail-reply-buffer)
+;; message-mode defines message-yank-prefix - mail-yank-prefix removed
+;; message-mode defines message-indentation-spaces - mail-indentation-spaces
removed
+;; message-mode defines message-reply-buffer - mail-reply-buffer removed
;;; ************************************************************************
;;; Overloaded functions
@@ -75,40 +65,88 @@ message. If not given, 'smail:comment' is evaluated by
default."
(defun smail:widen ()
"Widens outgoing mail buffer to include Hyperbole button data."
- (if (fboundp 'mail+narrow) (mail+narrow) (widen)))
-
-;; Redefine this function from Emacs "sendmail.el" to work with supercite.
-(defun mail-indent-citation ()
- "Modify text just inserted from a message to be cited.
-The inserted text should be the region.
-When this function returns, the region is again around the modified text.
-
-Normally, indent each nonblank line `mail-indentation-spaces' spaces.
-However, if `mail-yank-prefix' is non-nil, insert that prefix on each line."
- ;; Don't ever remove headers if user uses Supercite package,
- ;; since he can set an option in that package to do
- ;; the removal.
- (unless (hypb:supercite-p)
- (mail-yank-clear-headers (region-beginning) (region-end)))
- (if (null mail-yank-prefix)
- (indent-rigidly (region-beginning) (region-end)
- mail-indentation-spaces)
- (save-excursion
- (let ((end (set-marker (make-marker) (region-end))))
- (goto-char (region-beginning))
- (while (< (point) end)
- (insert mail-yank-prefix)
- (forward-line 1))))))
+ (if (fboundp #'mail+narrow) (mail+narrow) (widen)))
+
+;; Redefine this function from "message.el" to include Hyperbole button
+;; data when yanking in a message and to highlight buttons if possible.
+(defun message--yank-original-internal (arg)
+ "See `message-yank-original'.
+
+If supercite is in use, header fields are never deleted.
+Use (setq sc-nuke-mail-headers 'all) to have them removed."
+ (let ((modified (buffer-modified-p))
+ body-text
+ opoint)
+ (when (and message-reply-buffer
+ message-cite-function)
+ (when (equal message-cite-reply-position 'above)
+ (save-excursion
+ (setq body-text
+ (buffer-substring (message-goto-body)
+ (point-max)))
+ (delete-region (message-goto-body) (point-max))))
+ (when (bufferp message-reply-buffer)
+ (delete-windows-on message-reply-buffer t)
+ (with-current-buffer message-reply-buffer
+ ;; Hyperbole addition: Might be called from newsreader
+ ;; before any Hyperbole mail reader support has been autoloaded.
+ (cond ((fboundp 'rmail:msg-widen) (rmail:msg-widen))
+ ((eq major-mode 'news-reply-mode) (widen)))
+ (hmail:msg-narrow)
+ (when (fboundp 'hproperty:but-create)
+ (hproperty:but-create))))
+ (setq opoint (point))
+ (push-mark (save-excursion
+ (cond
+ ((bufferp message-reply-buffer)
+ (insert-buffer-substring message-reply-buffer))
+ ((and (consp message-reply-buffer)
+ (functionp (car message-reply-buffer)))
+ (apply (car message-reply-buffer)
+ (cdr message-reply-buffer))))
+ (unless (bolp)
+ (insert ?\n))
+ (point)))
+ (unless arg
+ (funcall message-cite-function)
+ (unless (eq (char-before (mark t)) ?\n)
+ (let ((pt (point)))
+ (goto-char (mark t))
+ (insert-before-markers ?\n)
+ (goto-char pt))))
+ (pcase message-cite-reply-position
+ ('above
+ (message-goto-body)
+ (insert body-text)
+ (insert (if (bolp) "\n" "\n\n"))
+ (message-goto-body))
+ ('below
+ (message-goto-signature)))
+ ;; Hyperbole addition
+ (when (bufferp message-reply-buffer)
+ (with-current-buffer message-reply-buffer
+ (hmail:msg-narrow)))
+ ;; Add a `message-setup-very-last-hook' here?
+ ;; Add `gnus-article-highlight-citation' here?
+ (unless modified
+ (setq message-checksum (message-checksum))))))
+
;; Redefine this function from "sendmail.el" to include Hyperbole button
;; data when yanking in a message and to highlight buttons if possible.
(defun mail-yank-original (arg)
"Insert the message being replied to, if any (in Rmail).
-Puts point before the text and mark after.
-Applies 'mail-citation-hook', 'mail-yank-hook' or 'mail-yank-hooks'
+Put point before the text and mark after.
+
+Normally indent each nonblank line ARG spaces (default 3).
+However, if ‘mail-yank-prefix’ is non-nil, insert that prefix
+on each line.
+
+Apply `mail-citation-hook', `mail-yank-hook' or `mail-yank-hooks'
to text (in decreasing order of precedence).
-Just \\[universal-argument] as argument means don't apply hooks
-and don't delete any header fields.
+
+Just \\[universal-argument] as argument means don't indent,
+insert no prefix, and don't delete any header fields.
If supercite is in use, header fields are never deleted.
Use (setq sc-nuke-mail-headers 'all) to have them removed."
@@ -132,8 +170,8 @@ Use (setq sc-nuke-mail-headers 'all) to have them removed."
;; frame, delete that window to save space.
(delete-windows-on original t)
(with-current-buffer original
- ;; Might be called from newsreader before any
- ;; Hyperbole mail reader support has been autoloaded.
+ ;; Hyperbole addition: Might be called from newsreader
+ ;; before any Hyperbole mail reader support has been
autoloaded.
(cond ((fboundp 'rmail:msg-widen) (rmail:msg-widen))
((eq major-mode 'news-reply-mode) (widen))))
(setq opoint (point))
@@ -153,56 +191,57 @@ Use (setq sc-nuke-mail-headers 'all) to have them
removed."
(with-current-buffer original
buffer-file-coding-system))))))
(set-text-properties (point) (mark t) nil))
- (hmail:msg-narrow)
- (when (fboundp 'hproperty:but-create)
- (hproperty:but-create))
- (unless (consp arg)
- ;; Don't ever remove headers if user uses Supercite package,
- ;; since he can set an option in that package to do
- ;; the removal.
- (or (hypb:supercite-p)
- (mail-yank-clear-headers
- start (marker-position (mark-marker))))
- (goto-char start)
- (let ((mail-indentation-spaces (if arg (prefix-numeric-value
arg)
- mail-indentation-spaces))
- ;; Avoid error in Transient Mark mode
- ;; on account of mark's being inactive.
- (mark-even-if-inactive t))
- (cond ((and (boundp 'mail-citation-hook) mail-citation-hook)
- ;; Bind mail-citation-header to the inserted
- ;; message's header.
- (let ((mail-citation-header
- (buffer-substring-no-properties
- start
- (save-excursion
- (save-restriction
- (narrow-to-region start (point-max))
- (goto-char start)
- (rfc822-goto-eoh)
- (point))))))
- (run-hooks 'mail-citation-hook)))
- ((and (boundp 'mail-yank-hook) mail-yank-hook)
- (run-hooks 'mail-yank-hook))
- ((and (boundp 'mail-yank-hooks) mail-yank-hooks)
- (run-hooks 'mail-yank-hooks))
- (t (mail-indent-citation))))
- (goto-char (min (point-max) (mark t)))
- (set-mark opoint)
- (delete-region (point) ; Remove trailing blank lines.
- (progn (re-search-backward "[^ \t\n\r\f]")
- (end-of-line)
- (point))))
- (unless (eq major-mode 'news-reply-mode)
- ;; This is like exchange-point-and-mark, but doesn't activate
the mark.
- ;; It is cleaner to avoid activation, even though the command
- ;; loop would deactivate the mark because we inserted text.
- (goto-char (prog1 (mark t)
- (set-marker (mark-marker)
- (point) (current-buffer))))
- (unless (eolp)
- (insert ?\n))))
- (with-current-buffer mail-reply-buffer
+ ;; Hyperbole addition
+ (hmail:msg-narrow)
+ (when (fboundp 'hproperty:but-create)
+ (hproperty:but-create))
+ (unless (consp arg)
+ ;; Don't ever remove headers if user uses Supercite package,
+ ;; since he can set an option in that package to do
+ ;; the removal.
+ (or (hypb:supercite-p)
+ (mail-yank-clear-headers
+ start (marker-position (mark-marker))))
+ (goto-char start)
+ (let ((message-indentation-spaces (if arg (prefix-numeric-value
arg)
+ message-indentation-spaces))
+ ;; Avoid error in Transient Mark mode
+ ;; on account of mark's being inactive.
+ (mark-even-if-inactive t))
+ (cond ((and (boundp 'mail-citation-hook) mail-citation-hook)
+ ;; Bind mail-citation-header to the inserted message's
header.
+ (let ((mail-citation-header
+ (buffer-substring-no-properties
+ start
+ (save-excursion
+ (save-restriction
+ (narrow-to-region start (point-max))
+ (goto-char start)
+ (rfc822-goto-eoh)
+ (point))))))
+ (run-hooks 'mail-citation-hook)))
+ ((and (boundp 'mail-yank-hook) mail-yank-hook)
+ (run-hooks 'mail-yank-hook))
+ ((and (boundp 'mail-yank-hooks) mail-yank-hooks)
+ (run-hooks 'mail-yank-hooks))
+ (t (funcall message-indent-citation-function))))
+ (goto-char (min (point-max) (mark t)))
+ (set-mark opoint)
+ (delete-region (point) ; Remove trailing blank lines.
+ (progn (re-search-backward "[^ \t\n\r\f]")
+ (end-of-line)
+ (point))))
+ (unless (eq major-mode 'news-reply-mode)
+ ;; This is like exchange-point-and-mark, but doesn't activate
the mark.
+ ;; It is cleaner to avoid activation, even though the command
+ ;; loop would deactivate the mark because we inserted text.
+ (goto-char (prog1 (mark t)
+ (set-marker (mark-marker)
+ (point) (current-buffer))))
+ (unless (eolp)
+ (insert ?\n))))
+ ;; Hyperbole addition
+ (with-current-buffer message-reply-buffer
(hmail:msg-narrow))))))
;;; ************************************************************************
diff --git a/hui-mini.el b/hui-mini.el
index ecd3ae3f97..f3d213a405 100644
--- a/hui-mini.el
+++ b/hui-mini.el
@@ -3,7 +3,7 @@
;; Author: Bob Weiner
;;
;; Orig-Date: 15-Oct-91 at 20:13:17
-;; Last-Mod: 24-Jan-22 at 00:18:47 by Bob Weiner
+;; Last-Mod: 5-Feb-22 at 11:39:04 by Bob Weiner
;;
;; Copyright (C) 1991-2022 Free Software Foundation, Inc.
;; See the "HY-COPY" file for license information.
@@ -675,8 +675,8 @@ constructs. If not given, the top level Hyperbole menu is
used."
'(gbut .
(("GButton>")
("Act" gbut:act "Activates global button by name.")
- ("Create" hui:gbut-create "Adds a global button to gbut:file.")
- ("Delete" hui:gbut-delete "Removes a global button from gbut:file.")
+ ("Create" hui:gbut-create "Adds a global button to (gbut:file).")
+ ("Delete" hui:gbut-delete "Removes a global button from (gbut:file).")
("Edit" hui:gbut-modify "Modifies global button attributes.")
("Help" gbut:help "Reports on a global button by name.")
("Info" (id-info "(hyperbole)Global Buttons")
diff --git a/hui.el b/hui.el
index 000f2a95f6..2074a46c19 100644
--- a/hui.el
+++ b/hui.el
@@ -3,7 +3,7 @@
;; Author: Bob Weiner
;;
;; Orig-Date: 19-Sep-91 at 21:42:03
-;; Last-Mod: 24-Jan-22 at 00:18:52 by Bob Weiner
+;; Last-Mod: 5-Feb-22 at 13:05:28 by Bob Weiner
;;
;; Copyright (C) 1991-2021 Free Software Foundation, Inc.
;; See the "HY-COPY" file for license information.
@@ -201,7 +201,7 @@ Signal an error when no such button is found in the current
buffer."
(ebut:alist) nil t
(ebut:label-p t) 'ebut)))))
(unless (stringp lbl-key)
- (if (called-interactively-p)
+ (if (called-interactively-p 'interactive)
(error "(hui:ebut-modify): No explicit button to modify")
(error "(hui:ebut-modify): 'lbl-key' argument must be a string, not
'%s'" lbl-key)))
@@ -332,9 +332,6 @@ a menu to find any of the occurrences."
(if (called-interactively-p 'interactive) (message "No matches.")
total))))
-(defun hui:error (&rest args)
- (hypb:error "(hui:error): Obsolete, use hypb:error instead"))
-
(defun hui:gbut-create (lbl ibut-flag)
"Create a Hyperbole global explicit button with LBL.
@@ -349,24 +346,27 @@ See `hui:gibut-create' for details."
but-buf
src-dir)
(save-excursion
- (setq src-dir default-directory
+ (setq src-dir default-directory
actype (hui:actype)
- but-buf (find-file-noselect gbut:file))
- (hui:buf-writable-err but-buf "gbut-create")
- ;; This prevents movement of point which might be useful to user.
+ but-buf (find-file-noselect (gbut:file)))
(set-buffer but-buf)
+ (hui:buf-writable-err (current-buffer) "gbut-create")
+ ;; This prevents movement of point which might be useful to user.
(save-excursion
(goto-char (point-max))
(unless (bolp)
(insert "\n"))
;; loc = Directory of the global button file
(hattr:set 'hbut:current 'loc (hui:key-src but-buf))
- ;; dir = default-directory of current buffer when button is created
+ ;; dir = default-directory of current buffer at the start of
+ ;; this `hui:gbut-create' function call (when button is created)
(hattr:set 'hbut:current 'dir src-dir)
(hattr:set 'hbut:current 'actype actype)
(hattr:set 'hbut:current 'args (hargs:actype-get actype))
- (hattr:set 'hbut:current 'action
- (and hui:ebut-prompt-for-action (hui:action actype)))
+ (hattr:set 'hbut:current 'action (when hui:ebut-prompt-for-action
+ (hui:action actype)))
+ ;; Ensure ebut:operate is given but-buf as the current buffer
+ (set-buffer but-buf)
(setq lbl (concat lbl (ebut:operate lbl nil)))
(goto-char (point-max))
(insert "\n")
@@ -381,12 +381,12 @@ and derive BUT-KEY from the button that point is within.
Signal an error if point is not within a button."
(interactive (list (save-excursion
(hui:buf-writable-err
- (find-file-noselect gbut:file) "gbut-delete")
+ (find-file-noselect (gbut:file)) "gbut-delete")
(hbut:label-to-key
(hargs:read-match "Global button to delete: "
(mapcar #'list (gbut:label-list))
nil t nil 'gbut)))))
- (hui:hbut-delete but-key gbut:file))
+ (hui:hbut-delete but-key (gbut:file)))
(defun hui:gbut-modify (lbl-key)
"Modify a global Hyperbole button given by LBL-KEY.
@@ -395,21 +395,21 @@ When called interactively, save the global button buffer
after the
modification Signal an error when no such button is found."
(interactive (list (save-excursion
(hui:buf-writable-err
- (find-file-noselect gbut:file) "gbut-modify")
+ (find-file-noselect (gbut:file)) "gbut-modify")
(hbut:label-to-key
(hargs:read-match "Global button to modify: "
(mapcar #'list (gbut:label-list))
nil t (gbut:label-p t) 'gbut)))))
(unless (stringp lbl-key)
- (if (called-interactively-p)
+ (if (called-interactively-p 'interactive)
(error "(hui:gbut-modify): No global button to modify")
(error "(hui:gbut-modify): 'lbl-key' argument must be a string, not
'%s'" lbl-key)))
(let ((lbl (hbut:key-to-label lbl-key))
(interactive-flag (called-interactively-p 'interactive))
- (but-buf (find-file-noselect gbut:file))
- (src-dir (file-name-directory gbut:file))
+ (but-buf (find-file-noselect (gbut:file)))
+ (src-dir (file-name-directory (gbut:file)))
actype but new-lbl)
(save-excursion
(unless interactive-flag
@@ -480,7 +480,7 @@ modification Signal an error when no such button is
found."
When in the global button buffer, the default is the button at point."
(interactive (list (save-excursion
(hui:buf-writable-err
- (find-file-noselect gbut:file) "gbut-rename")
+ (find-file-noselect (gbut:file)) "gbut-rename")
(hbut:label-to-key
(hargs:read-match "Global button to rename: "
(mapcar #'list (gbut:label-list))
@@ -496,7 +496,7 @@ Use `hui:gbut-create' to create a global explicit button."
delimited-label)
(save-excursion
(setq delimited-label (concat ibut:label-start lbl ibut:label-end)
- but-buf (find-file-noselect gbut:file))
+ but-buf (find-file-noselect (gbut:file)))
(hui:buf-writable-err but-buf "gibut-create")
;; This prevents movement of point which might be useful to user.
(set-buffer but-buf)
@@ -683,7 +683,7 @@ its buttons, the label is simply inserted at point."
(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)
+ lbl)
(cond (label-key-start-end
(error "(hui:ibut-label-create): ibutton at point already has a
label; try hui:ibut-rename"))
(ibut
@@ -716,21 +716,21 @@ Signal an error when no such button is found in the
current buffer."
(ibut:alist) nil t
(ibut:label-p t) 'ibut)))))
(unless (stringp lbl-key)
- (if (called-interactively-p)
+ (if (called-interactively-p 'interactive)
(error "(hui:ibut-modify): No named implicit button to modify")
(error "(hui:ibut-modify): 'lbl-key' argument must be a string, not
'%s'" lbl-key)))
(let ((lbl (ibut:key-to-label lbl-key))
(interactive-flag (called-interactively-p 'interactive))
(but-buf (current-buffer))
- actype args but new-lbl)
+ new-lbl)
(hattr:set 'hbut:current 'loc (hui:key-src but-buf))
(hattr:set 'hbut:current 'dir (hui:key-dir but-buf))
(save-excursion
(unless (called-interactively-p 'interactive)
(hui:buf-writable-err but-buf "ibut-modify"))
- (unless (setq but (ibut:get lbl-key but-buf))
+ (unless (ibut:get lbl-key but-buf)
(pop-to-buffer but-buf)
(hypb:error "(ibut-modify): Invalid button, no data for '%s'" lbl))
@@ -786,11 +786,11 @@ Signal an error when no such button is found in the
current buffer."
(ibut:alist) nil t nil 'ibut))))))
(let ((lbl (ibut:key-to-label lbl-key))
(but-buf (current-buffer))
- actype but new-lbl)
+ new-lbl)
(unless (called-interactively-p 'interactive)
(hui:buf-writable-err but-buf "ibut-rename"))
- (unless (setq but (ibut:get lbl-key but-buf))
+ (unless (ibut:get lbl-key but-buf)
(hypb:error "(ibut-rename): Invalid button: '%s'." lbl))
(setq new-lbl
@@ -820,7 +820,7 @@ See also documentation for `hui:link-possible-types'."
(interactive (hmouse-choose-windows #'hui:link))
(let ((but-window (or depress-window action-key-depress-window))
(referent-window (or release-window action-key-release-window
(selected-window)))
- but-name but-modify but-categ link-types num-types type-and-args
lbl-key but-loc but-dir)
+ but-name but-modify link-types num-types type-and-args lbl-key but-loc
but-dir)
(select-window but-window)
(hui:buf-writable-err (current-buffer) "link-directly")
(if (ebut:at-p)
@@ -951,22 +951,23 @@ DEFAULT-ACTYPE may be a valid symbol or symbol name."
(defun hui:buf-writable-err (but-buf func-name)
"If BUT-BUF is read-only, signal an error from FUNC-NAME."
- (let ((obuf (prog1 (current-buffer) (set-buffer but-buf)))
- ;; (unwritable (and buffer-file-name
- ;; (not (file-writable-p buffer-file-name))))
- (err))
+ (let (err)
+ ;; (unwritable (and buffer-file-name
+ ;; (not (file-writable-p buffer-file-name))))
;; (if unwritable
;; Commented error out since some people want to be able to create
;; buttons within files which they have purposely marked read-only.
;; (setq err
;; (format "(ebut-modify): Hyperbole lacks permission to write to
'%s'."
;; (file-name-nondirectory buffer-file-name))))
- (if buffer-read-only
+ (with-current-buffer but-buf
+ (when buffer-read-only
(setq err
(format "(%s) Read-only error in Hyperbole button buffer '%s'.
Use {%s} to enable edits."
- func-name (buffer-name but-buf)
(hmouse-read-only-toggle-key))))
- (set-buffer obuf)
- (if err (progn (pop-to-buffer but-buf) (hypb:error err)))))
+ func-name (buffer-name but-buf)
(hmouse-read-only-toggle-key)))))
+ (when err
+ (pop-to-buffer but-buf)
+ (hypb:error err))))
(defun hui:ebut-buf (&optional prompt)
"Prompt for and return a buffer in which to place a button."
@@ -1022,9 +1023,6 @@ within."
t)
(hypb:error "(ebut-delete): You may not delete buttons from this
buffer"))))
-(defun hui:ebut-delimit (start end instance-str)
- (hypb:error "(hui:ebut-delimit): Obsolete, use ebut:delimit instead"))
-
(defun hui:ebut-message (but-modify-flag)
(let ((actype (symbol-name (hattr:get 'hbut:current 'actype)))
(args (hattr:get 'hbut:current 'args)))
@@ -1141,8 +1139,8 @@ for with completion of all labeled buttons within the
current buffer."
(sit-for 0)
(setq inverse-video nil))))
-(defun hui:hbut-term-unhighlight (start end)
- "For terminals only: Remove any emphasis from hyper-button at START to END."
+(defun hui:hbut-term-unhighlight (start _end)
+ "For terminals only: Remove any emphasis from hyper-button at START to _END."
(save-excursion
(save-restriction
(goto-char start)
@@ -1331,7 +1329,7 @@ Buffer without File link-to-buffer-tmp"
;; Next line forces use of any ibut name in the
link.
(save-excursion (ibut:at-to-name-p hbut-sym)))
(setq lbl-key (hattr:get hbut-sym 'lbl-key))
- (eq (current-buffer) (get-file-buffer gbut:file)))
+ (eq (current-buffer) (get-file-buffer (gbut:file))))
(list 'link-to-gbut lbl-key))
((and hbut-sym (eq (hattr:get hbut-sym 'categ) 'explicit))
(list 'link-to-ebut lbl-key))
diff --git a/test/hui-tests.el b/test/hui-tests.el
index 15b2409125..b442b3a43f 100644
--- a/test/hui-tests.el
+++ b/test/hui-tests.el
@@ -3,7 +3,7 @@
;; Author: Mats Lidell <matsl@gnu.org>
;;
;; Orig-Date: 30-Jan-21 at 12:00:00
-;; Last-Mod: 24-Jan-22 at 00:40:28 by Bob Weiner
+;; Last-Mod: 5-Feb-22 at 11:39:04 by Bob Weiner
;;
;; Copyright (C) 2021 Free Software Foundation, Inc.
;; See the "HY-COPY" file for license information.
@@ -161,7 +161,7 @@ Modifying the button but keeping the label creates a dubbel
label."
(unwind-protect
(progn
(with-mock
- (mock (find-file-noselect gbut:file) => test-buffer)
+ (mock (find-file-noselect (gbut:file)) => test-buffer)
(hui:gibut-create "global" test-file))
(with-current-buffer test-buffer
(should (eq (hattr:get (hbut:at-p) 'actype)
'actypes::link-to-file))
@@ -176,7 +176,7 @@ Modifying the button but keeping the label creates a dubbel
label."
(unwind-protect
(progn
(with-mock
- (mock (find-file-noselect gbut:file) => test-buffer)
+ (mock (find-file-noselect (gbut:file)) => test-buffer)
(hui:gibut-create "global" (concat test-file ":10")))
(with-current-buffer test-buffer
(should (eq (hattr:get (hbut:at-p) 'actype)
'actypes::link-to-file-line))
@@ -191,7 +191,7 @@ Modifying the button but keeping the label creates a dubbel
label."
(unwind-protect
(progn
(with-mock
- (mock (find-file-noselect gbut:file) => test-buffer)
+ (mock (find-file-noselect (gbut:file)) => test-buffer)
(hui:gibut-create "global" (concat test-file ":10:20")))
(with-current-buffer test-buffer
(should (eq (hattr:get (hbut:at-p) 'actype)
'actypes::link-to-file-line-and-column))
@@ -207,7 +207,7 @@ Modifying the button but keeping the label creates a dubbel
label."
(unwind-protect
(progn
(with-mock
- (mock (find-file-noselect gbut:file) => test-buffer)
+ (mock (find-file-noselect (gbut:file)) => test-buffer)
(hui:gibut-create "global" (concat "\"" info-node "\"")))
(with-current-buffer test-buffer
(should (eq (hattr:get (hbut:at-p) 'actype)
'actypes::link-to-Info-node))