Skip to content

Patch by Stefan #209

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Merged
matsl merged 3 commits into from
Jul 15, 2022
Merged

Patch by Stefan #209

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
3 commits
Select commit Hold shift + click to select a range
3613b57
Patch by Stefan
matsl Jul 14, 2022
93e95b6
Update ChangeLog entries
matsl Jul 15, 2022
e804cbc
Use Stefans ChangeLog
matsl Jul 15, 2022
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
18 changes: 18 additions & 0 deletions ChangeLog
View file
Open in desktop
Original file line number Diff line number Diff line change
@@ -1,3 +1,21 @@
2022-07-13 Stefan Monnier <monnier@iro.umontreal.ca>

* hrmail.el (rmail-cease-edit, rmail-forward, rmail-get-new-mail)
(rmail-new-summary): Use `advice-add` rather than straight redefinition
or `hypb:function-overload`.

* hmh.el (mh-display-msg, mh-regenerate-headers): Use `advice-add`
rather than `hypb:function-overload`.

* hgnus.el (gnus-inews-article): Remove hack on function that was
deleted back in Nov 1995.

* hypb.el (hypb:emacs-byte-code-p): `byte-code-function-p` is always
defined in Emacs≥27.
(hypb:function-copy, hypb:function-overload)
(hypb:function-symbol-replace, hypb:map-sublists)
(hypb:constant-vector-symbol-replace): Delete functions.

2022-07-12 Mats Lidell <matsl@gnu.org>

* test/hpath-tests.el (hpath:auto-variable-alist-load-path-test): Simplify
Expand Down
9 changes: 1 addition & 8 deletions hgnus.el
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -5,7 +5,7 @@
;; Orig-Date: 24-Dec-91 at 22:29:28
;; Last-Mod: 9-May-22 at 00:01:49 by Bob Weiner
;;
;; Copyright (C) 1991-2016 Free Software Foundation, Inc.
;; Copyright (C) 1991-2022 Free Software Foundation, Inc.
;; See the "HY-COPY" file for license information.
;;
;; This file is part of GNU Hyperbole.
Expand Down Expand Up @@ -71,13 +71,6 @@
(gnus-summary-display-article article))))


Copy link
Copy Markdown
Collaborator Author

@matsl matsl Jul 15, 2022

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

@rswgnu gnus-inews-article seems to have been removed since long. So this would be a bug for us to still depend on it. As we have spoken about before the gnus/message support should probably get a complete overlook and is probably broken. Not sure what is the best approach here. I guess using functionality that does not exists does not make sense and is misleading so for the short term it might be OK to just remove it!?

Copy link
Copy Markdown
Owner

@rswgnu rswgnu Jul 15, 2022

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Yes.

;;; Redefine 'gnus-inews-article' from "gnuspost.el" to make it include
;;; any signature before Hyperbole button data. Does this by having
;;; signature inserted within narrowed buffer and then applies a hook to
;;; have the buffer widened before sending.
(hypb:function-symbol-replace
'gnus-inews-article 'widen 'hmail:msg-narrow)

;;; Overload this function from "rnewspost.el" for supercite compatibility
;;; only when supercite is in use.
(if (hypb:supercite-p)
Expand Down
32 changes: 18 additions & 14 deletions hmh.el
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -5,7 +5,7 @@
;; Orig-Date: 21-May-91 at 17:06:36
;; Last-Mod: 9-May-22 at 22:36:31 by Bob Weiner
;;
;; Copyright (C) 1991-2016 Free Software Foundation, Inc.
;; Copyright (C) 1991-2022 Free Software Foundation, Inc.
;; See the "HY-COPY" file for license information.
;;
;; This file is part of GNU Hyperbole.
Expand Down Expand Up @@ -135,20 +135,24 @@ Returns t if successful, else nil."
;;; Private functions
;;; ************************************************************************
;;;
;;; Redefine version of this function from mh-e.el to run mh-show-hook at end.
;;; This hook may already be run, depending on the version of mh-e you are
;;; running, but running it twice shouldn't do any harm. Comment this out if
;;; you know that your mh-e.el already runs the hook.
(hypb:function-overload 'mh-display-msg nil
'(run-hooks 'mh-show-hook))
;; Redefine version of this function from mh-e.el to run mh-show-hook at end.
;; This hook may already be run, depending on the version of mh-e you are
;; running, but running it twice shouldn't do any harm. Comment this out if
;; you know that your mh-e.el already runs the hook.
;; FIXME: `mh-show.el' has not changed much since Emacs-27 (which we require),
;; so we should not need such an advice, yet AFAICT `mh-display-msg'
;; doesn't run this hook, on `mh-show-msg' does.
(advice-add 'mh-display-msg :after #'hmh--run-show-hook)
(defun hmh--run-show-hook (&rest _) (run-hooks 'mh-show-hook))

;;;
;;; Redefine version of 'mh-regenerate-headers' to highlight Hyperbole
;;; buttons when possible.
;;;
(hypb:function-overload 'mh-regenerate-headers nil
'(if (fboundp 'hproperty:but-create)
(hproperty:but-create)))
;;
;; Redefine version of 'mh-regenerate-headers' to highlight Hyperbole
;; buttons when possible.
;;
;; FIXME: Add a hook to MH-E so we don't need this advice.
(advice-add 'mh-regenerate-headers :after #'hmh--highlight-buttons)
(defun hmh--highlight-buttons (&rest _)
(if (fboundp 'hproperty:but-create) (hproperty:but-create)))

;;;
;;; Set 'mh-send-letter' hook to widen to include button data before sending.
Expand Down
72 changes: 37 additions & 35 deletions hrmail.el
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -5,7 +5,7 @@
;; Orig-Date: 9-May-91 at 04:22:02
;; Last-Mod: 5-Jun-22 at 17:59:19 by Bob Weiner
;;
;; Copyright (C) 1991-2016 Free Software Foundation, Inc.
;; Copyright (C) 1991-2022 Free Software Foundation, Inc.
;; See the "HY-COPY" file for license information.
;;
;; This file is part of GNU Hyperbole.
Expand Down Expand Up @@ -167,15 +167,18 @@ Return t if successful, else nil."
;;; Overloaded functions
;;; ************************************************************************

(if (featurep 'rmail-hyperbole)
(if (featurep 'rmail-hyperbole) ;FIXME: Nowhere to be found.
;; No overloads are necessary, the needed features are built-in.
nil

;;; else
;;;
;;; Redefine version of this function from "rmailedit.el" to include any
;;; hidden Hyperbole button data when computing message length.
(defun rmail-cease-edit ()
;; else
;;
;; Redefine version of this function from "rmailedit.el" to include any
;; hidden Hyperbole button data when computing message length.
;; FIXME: Copy&redefine like this is *evil*. Use an advice or a hook.
;; We can make changes to `rmail.el' if needed.
(advice-add 'rmail-cease-edit :override #'hrmail--rmail-cease-edit)
(defun hrmail--rmail-cease-edit ()
"Finish editing message; switch back to Rmail proper."
(interactive)
;; Make sure buffer ends with a newline.
Expand Down Expand Up @@ -251,9 +254,12 @@ Return t if successful, else nil."
(setq buffer-read-only t))


;;; Redefine version of this function from "rmail.el" to include any
;;; Hyperbole button data.
(defun rmail-forward (resend)
;; Redefine version of this function from "rmail.el" to include any
;; Hyperbole button data.
;; FIXME: Copy&redefine like this is *evil*. Use an advice or a hook.
;; We can make changes to `rmail.el' if needed.
(advice-add 'rmail-forward :override #'hrmail--rmail-forward)
(defun hrmail--rmail-forward (resend)
"Forward the current message to another user.
With prefix argument, \"resend\" the message instead of forwarding it;
see the documentation of `rmail-resend'."
Expand Down Expand Up @@ -320,31 +326,27 @@ see the documentation of `rmail-resend'."
(insert-buffer-substring forward-buffer)
(hmail:msg-narrow))))))))

;;; Redefine version of 'rmail-get-new-mail' from "rmail.el" to highlight
;;; Hyperbole buttons when possible.
;;;
(if (boundp 'rmail-get-new-mail-post-hook)
(add-hook 'rmail-get-new-mail-post-hook
(lambda ()
(if (fboundp 'hproperty:but-create)
(progn (widen) (hproperty:but-create)
(rmail-show-message)))))
(hypb:function-overload 'rmail-get-new-mail nil
'(if (fboundp 'hproperty:but-create)
(progn (widen) (hproperty:but-create)
(rmail-show-message)))))

;;; Redefine version of 'rmail-new-summary' from "rmailsum.el" to
;;; highlight Hyperbole buttons when possible.
;;;
(if (boundp 'rmail-summary-create-post-hook)
(add-hook 'rmail-summary-create-post-hook
(lambda ()
(if (fboundp 'hproperty:but-create)
(hproperty:but-create))))
(hypb:function-overload 'rmail-new-summary nil
'(if (fboundp 'hproperty:but-create)
(hproperty:but-create))))
;; Redefine version of 'rmail-get-new-mail' from "rmail.el" to highlight
;; Hyperbole buttons when possible.
;;

(defun hrmail--show-msg-and-buttons (&rest _)
(if (fboundp 'hproperty:but-create)
(progn (widen) (hproperty:but-create)
(rmail-show-message))))
(if (boundp 'rmail-get-new-mail-post-hook) ;FIXME: Doesn't exist. XEmacs?
Copy link
Copy Markdown
Owner

@rswgnu rswgnu Jul 14, 2022

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

This needs to work.

Copy link
Copy Markdown
Collaborator Author

@matsl matsl Jul 15, 2022

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Not sure I understand. Does it mean that we need to see to that this works or that it must be kept?

Related: I can't find rmail-get-new-mail-post-hook neither in Emacs nor XEmacs in current and historic data I have access to.

Copy link
Copy Markdown
Owner

@rswgnu rswgnu Jul 15, 2022 •
edited
Loading

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

It may be something I added when I redid rmail and rmailsum years ago but not sure if it was merged to mainline. I guess it doesn't matter at this point.

(add-hook 'rmail-get-new-mail-post-hook #'hrmail--show-msg-and-buttons)
;; FIXME: Why change `rmail-get-new-mail' rather than `rmail-show-message'?
(advice-add 'rmail-get-new-mail :after #'hrmail--show-msg-and-buttons))

;; Redefine version of 'rmail-new-summary' from "rmailsum.el" to
;; highlight Hyperbole buttons when possible.
;;
(defun hrmail--highlight-buttons (&rest _)
(if (fboundp 'hproperty:but-create) (hproperty:but-create)))
(if (boundp 'rmail-summary-create-post-hook) ;FIXME: Doesn't exist. XEmacs?
(add-hook 'rmail-summary-create-post-hook #'hrmail--highlight-buttons)
(advice-add 'rmail-new-summary :after #'hrmail--highlight-buttons))

;; end not InfoDock
)
Expand Down
113 changes: 2 additions & 111 deletions hypb.el
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -303,10 +303,8 @@ If no matching installation type is found, return a list of (\"unknown\" hyperb:
(concat "@" dname))))

;;;###autoload
(defun hypb:emacs-byte-code-p (obj)
"Return non-nil iff OBJ is an Emacs byte compiled object."
(or (and (fboundp 'byte-code-function-p) (byte-code-function-p obj))
(and (fboundp 'compiled-function-p) (compiled-function-p obj))))
(define-obsolete-function-alias 'hypb:emacs-byte-code-p
#'byte-code-function-p "2022")

(defun hypb:error (&rest args)
"Signal an error typically to be caught by `hyperbole'."
Expand Down Expand Up @@ -356,88 +354,6 @@ Return either the modified string or the original ARG when not modified."
nil t)
arg))

(defun hypb:function-copy (func-symbol)
"Copy FUNC-SYMBOL's body for overloading. Return a copy of the body or the original if a subr/primitive."
(if (fboundp func-symbol)
(let ((func (hypb:indirect-function func-symbol)))
(cond ((listp func) (copy-sequence func))
((subrp func) func)
((and (hypb:emacs-byte-code-p func) (fboundp 'make-byte-code))
(let ((new-code (append func nil))) ; turn it into a list
(apply 'make-byte-code new-code)))
(t (error "(hypb:function-copy): Can't copy function body: %s" func))))
(error "(hypb:function-copy): `%s' symbol is not bound to a function"
func-symbol)))

(defun hypb:function-overload (func-sym prepend &rest new-forms)
"Redefine function named FUNC-SYM by either PREPENDing (or appending if nil) rest of quoted NEW-FORMS."
(let ((old-func-sym (intern
(concat "hypb--old-"
(symbol-name func-sym)))))
(unless (fboundp old-func-sym)
(defalias old-func-sym (hypb:function-copy func-sym)))
(let* ((old-func (hypb:indirect-function old-func-sym))
(old-param-list (action:params old-func))
(param-list (action:param-list old-func))
(old-func-call
(list (if (memq '&rest old-param-list)
;; Have to account for extra list wrapper from &rest.
(cons 'apply
(cons (list 'quote old-func-sym) param-list))
(cons old-func-sym param-list)))))
(eval (append
(list 'defun func-sym old-param-list)
(delq nil
(list
(documentation old-func-sym)
(action:commandp old-func-sym)))
(if prepend
(append new-forms old-func-call)
(append old-func-call new-forms)))))))

(defun hypb:function-symbol-replace (func-sym sym-to-replace replace-with-sym)
"Replace in body of FUNC-SYM SYM-TO-REPLACE with REPLACE-WITH-SYM.
FUNC-SYM may be a function symbol or its body. All occurrences within lists
are replaced. Returns body of modified FUNC-SYM."
(let ((body (hypb:indirect-function func-sym))
(constant-vector) (constant))
(if (subrp body)
;; Non-Lisp code, can't do any replacement
body
(if (listp body)
;; assume V18 byte compiler
(setq constant-vector
(car (delq nil (mapcar
(lambda (elt)
(and (listp elt)
(vectorp (setq constant-vector (nth 2 elt)))
constant-vector))
body))))
;; assume EMACS byte compiler (eq (compiled-function-p body) t)
(setq constant (if (fboundp 'compiled-function-constants)
(compiled-function-constants body)
(aref body 2))
constant-vector (when (vectorp constant) constant)))
(if constant-vector
;; Code is byte-compiled.
(hypb:constant-vector-symbol-replace
constant-vector sym-to-replace replace-with-sym)
;;
;; Code is not byte-compiled.
;; Replaces occurrence of symbol within lists only.
(hypb:map-sublists
(lambda (atom list)
;; The ' in the next line *is* required for proper substitution.
(when (eq atom 'sym-to-replace)
(let ((again t))
(while (and again list)
(if (eq (car list) atom)
(progn (setcar list replace-with-sym)
(setq again nil))
(setq list (cdr list)))))))
body))
body)))

;; Extracted from part of `choose-completion' in "simple.el"
(defun hypb:get-completion (&optional event)
"Return the completion at point.
Expand Down Expand Up @@ -586,17 +502,6 @@ then `locate-post-command-hook'."
collect (funcall func k v) into result
finally return result))

(defun hypb:map-sublists (func list)
"Apply FUNC to every atom found at any level of LIST.
FUNC must take two arguments, an atom and a list in which the atom is found.
Returns values from applications of FUNC as a list with the same
structure as LIST. FUNC is therefore normally used just for its side-effects."
(mapcar (lambda (elt)
(if (atom elt)
(funcall func elt list)
(hypb:map-sublists func elt)))
list))

(defun hypb:map-vector (func object)
"Return list of results of application of FUNC to each element of OBJECT.
OBJECT should be a vector or `byte-code' object."
Expand Down Expand Up @@ -888,20 +793,6 @@ If FILE is not an absolute path, expand it relative to `hyperb:dir'."
;;; Private functions
;;; ************************************************************************

(defun hypb:constant-vector-symbol-replace
(constant-vector sym-to-replace replace-with-sym)
"Replace symbols within a byte-compiled constant vector."
(let ((i (length constant-vector))
constant)
(while (>= (setq i (1- i)) 0)
(setq constant (aref constant-vector i))
(cond ((eq constant sym-to-replace)
(aset constant-vector i replace-with-sym))
((and (fboundp 'compiled-function-p)
(compiled-function-p constant))
(hypb:function-symbol-replace
constant sym-to-replace replace-with-sym))))))

(defun hypb:insert-hyperbole-banner ()
Copy link
Copy Markdown
Owner

@rswgnu rswgnu Jul 14, 2022 •
edited
Loading

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Check that all the removed fun ctions above are no longer called anywhere.

Add Changelog entries for all major file-level changes.

Copy link
Copy Markdown
Collaborator Author

@matsl matsl Jul 15, 2022

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Verified that all deleted functions are by this PR not use somewhere else.

Noticed while looking at Stefans mail again that ChangeLog entries were provided already by Stefan so I reused those. (Wasted time by providing my own ChangeLog entries. Can be viewed in separate commit. 😄 )

Copy link
Copy Markdown
Owner

@rswgnu rswgnu Jul 15, 2022

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Ok, thanks.

"Display an optional text FILE with the Hyperbole banner prepended.
Without file, the banner is prepended to the current buffer."
Expand Down