unofficial mirror of bug-gnu-emacs@gnu.org 
 help / color / mirror / code / Atom feed
From: Stefan Monnier <monnier@IRO.UMontreal.CA>
To: Michael Albinus <michael.albinus@gmx.de>
Cc: 27371@debbugs.gnu.org
Subject: bug#27371: 26.0.50; Unexpected element (define-type . tramp-file-name) in load-history
Date: Tue, 18 Jul 2017 10:25:56 -0400	[thread overview]
Message-ID: <jwv60epua0j.fsf-monnier+emacsbugs@gnu.org> (raw)
In-Reply-To: <87y3rm2pbw.fsf@detlef> (Michael Albinus's message of "Tue, 18 Jul 2017 09:09:55 +0200")

>>> However, it just skips the entry. Wouldn't it be better to remove the
>>> defstruct itself, and all inherited symbols? And where could I find
>>> information how to destroy a defstruct?
>> Better would be to add some hook so cl-lib can add support for
>> define-type.
> Likely yes. But I'm not familiar with cl*; I have no idea how such a
> hook should look like. And how it shall be implemented.

The hook shouldn't be specific to cl.  Maybe something like the patch
below would make sense?
Then we can add support for define-type, ert-deftest, cl-defmethod, ...


        Stefan


diff --git a/lisp/loadhist.el b/lisp/loadhist.el
index 28d0b18c81..bf15399c11 100644
--- a/lisp/loadhist.el
+++ b/lisp/loadhist.el
@@ -162,6 +162,60 @@ unload--set-major-mode
           ;; mode, or proposed is not nil and not major-mode, and so we use it.
           (funcall (or proposed 'fundamental-mode)))))))
 
+(cl-defgeneric loadhist-unload-element (x)
+  "Unload an element from the `load-history'."
+  (message "Unexpected element %S in load-history" x))
+
+;; In `load-history', the definition of a previously autoloaded
+;; function is represented by 2 entries: (t . SYMBOL) comes before
+;; (defun . SYMBOL) and says we should restore SYMBOL's autoload when
+;; we undefine it.
+;; So we use this auxiliary variable to keep track of the last (t . SYMBOL)
+;; that occurred.
+(defvar loadhist--restore-autoload
+  "If non-nil, this is a symbol for which we should
+restore a previous autoload if possible.")
+
+(cl-defmethod loadhist-unload-element ((x (head t)))
+  (setq loadhist--restore-autoload (cdr x)))
+
+(defun loadhist--unload-function (x)
+  (let ((fun (cdr x)))
+    (when (fboundp fun)
+      (when (fboundp 'ad-unadvise)
+	(ad-unadvise fun))
+      (let ((aload (get fun 'autoload)))
+	(defalias fun
+          (if (and aload (eq fun loadhist--restore-autoload))
+	      (cons 'autoload aload)
+            nil))))))
+  (setq loadhist--restore-autoload nil))
+
+(cl-defmethod loadhist-unload-element ((x (head defun)))
+  (loadhist--unload-function x))
+(cl-defmethod loadhist-unload-element ((x (head autoload)))
+  (loadhist--unload-function x))
+
+(cl-defmethod loadhist-unload-element ((x (head require))) nil)
+(cl-defmethod loadhist-unload-element ((x (head defface))) nil)
+
+(cl-defmethod loadhist-unload-element ((x (head provide)))
+  ;; Remove any feature names that this file provided.
+  (setq features (delq (cdr x) features)))
+
+(cl-defmethod loadhist-unload-element ((x symbol))
+  ;; Kill local values as much as possible.
+  (dolist (buf (buffer-list))
+    (with-current-buffer buf
+      (if (and (boundp x) (timerp (symbol-value x)))
+	  (cancel-timer (symbol-value x)))
+      (kill-local-variable x)))
+  (if (and (boundp x) (timerp (symbol-value x)))
+      (cancel-timer (symbol-value x)))
+  ;; Get rid of the default binding if we can.
+  (unless (local-variable-if-set-p x)
+    (makunbound x)))
+
 ;;;###autoload
 (defun unload-feature (feature &optional force)
   "Unload the library that provided FEATURE.
@@ -200,9 +254,6 @@ unload-feature
 	       (prin1-to-string dependents) file))))
   (let* ((unload-function-defs-list (feature-symbols feature))
          (file (pop unload-function-defs-list))
-	 ;; If non-nil, this is a symbol for which we should
-	 ;; restore a previous autoload if possible.
-	 restore-autoload
 	 (name (symbol-name feature))
          (unload-hook (intern-soft (concat name "-unload-hook")))
 	 (unload-func (intern-soft (concat name "-unload-function"))))
@@ -250,38 +301,7 @@ unload-feature
 	  (when (symbolp elt)
 	    (elp-restore-function elt))))
 
-      (dolist (x unload-function-defs-list)
-	(if (consp x)
-	    (pcase (car x)
-	      ;; Remove any feature names that this file provided.
-	      (`provide
-	       (setq features (delq (cdr x) features)))
-	      ((or `defun `autoload)
-	       (let ((fun (cdr x)))
-		 (when (fboundp fun)
-		   (when (fboundp 'ad-unadvise)
-		     (ad-unadvise fun))
-		   (let ((aload (get fun 'autoload)))
-		     (if (and aload (eq fun restore-autoload))
-			 (fset fun (cons 'autoload aload))
-		       (fmakunbound fun))))))
-	      ;; (t . SYMBOL) comes before (defun . SYMBOL)
-	      ;; and says we should restore SYMBOL's autoload
-	      ;; when we undefine it.
-	      (`t (setq restore-autoload (cdr x)))
-	      ((or `require `defface) nil)
-	      (_ (message "Unexpected element %s in load-history" x)))
-	  ;; Kill local values as much as possible.
-	  (dolist (buf (buffer-list))
-	    (with-current-buffer buf
-	      (if (and (boundp x) (timerp (symbol-value x)))
-		  (cancel-timer (symbol-value x)))
-	      (kill-local-variable x)))
-	  (if (and (boundp x) (timerp (symbol-value x)))
-	      (cancel-timer (symbol-value x)))
-	  ;; Get rid of the default binding if we can.
-	  (unless (local-variable-if-set-p x)
-	    (makunbound x))))
+      (mapc #'loadhist-unload-element unload-function-defs-list)
       ;; Delete the load-history element for this file.
       (setq load-history (delq (assoc file load-history) load-history))))
   ;; Don't return load-history, it is not useful.





  reply	other threads:[~2017-07-18 14:25 UTC|newest]

Thread overview: 13+ messages / expand[flat|nested]  mbox.gz  Atom feed  top
2017-06-15  8:05 bug#27371: 26.0.50; Unexpected element (define-type . tramp-file-name) in load-history Michael Albinus
2017-07-17 12:36 ` Michael Albinus
2017-07-17 19:43   ` Stefan Monnier
2017-07-18  7:09     ` Michael Albinus
2017-07-18 14:25       ` Stefan Monnier [this message]
2017-07-18 15:19         ` Michael Albinus
2017-07-18 15:56           ` Stefan Monnier
2017-07-24 15:01             ` Michael Albinus
2017-07-24 15:33               ` Stefan Monnier
2017-07-24 16:13                 ` Michael Albinus
2017-07-24 16:31                   ` Stefan Monnier
2017-07-24 17:39                     ` Michael Albinus
2017-07-18 16:08           ` Michael Albinus

Reply instructions:

You may reply publicly to this message via plain-text email
using any one of the following methods:

* Save the following mbox file, import it into your mail client,
  and reply-to-all from there: mbox

  Avoid top-posting and favor interleaved quoting:
  https://en.wikipedia.org/wiki/Posting_style#Interleaved_style

  List information: https://www.gnu.org/software/emacs/

* Reply using the --to, --cc, and --in-reply-to
  switches of git-send-email(1):

  git send-email \
    --in-reply-to=jwv60epua0j.fsf-monnier+emacsbugs@gnu.org \
    --to=monnier@iro.umontreal.ca \
    --cc=27371@debbugs.gnu.org \
    --cc=michael.albinus@gmx.de \
    /path/to/YOUR_REPLY

  https://kernel.org/pub/software/scm/git/docs/git-send-email.html

* If your mail client supports setting the In-Reply-To header
  via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line before the message body.
Code repositories for project(s) associated with this public inbox

	https://git.savannah.gnu.org/cgit/emacs.git

This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).