all messages for Emacs-related lists mirrored at yhetil.org
 help / color / mirror / code / Atom feed
From: Michael Albinus <michael.albinus@gmx.de>
To: Stefan Monnier <monnier@IRO.UMontreal.CA>
Cc: 27371@debbugs.gnu.org
Subject: bug#27371: 26.0.50; Unexpected element (define-type . tramp-file-name) in load-history
Date: Mon, 24 Jul 2017 17:01:55 +0200	[thread overview]
Message-ID: <8760eh98v0.fsf@detlef> (raw)
In-Reply-To: <jwvy3rlrcn3.fsf-monnier+emacsbugs@gnu.org> (Stefan Monnier's message of "Tue, 18 Jul 2017 11:56:18 -0400")

[-- Attachment #1: Type: text/plain, Size: 579 bytes --]

Stefan Monnier <monnier@IRO.UMontreal.CA> writes:

Hi Stefan,

>>> Then we can add support for define-type, ert-deftest, cl-defmethod, ...
>> That's my original question: what does it take to unload a `define-type'
>> entry?
>
> Presumably it should undo what cl-struct-define does.
> The main part would be (setf (cl--find-class name) nil), I guess.

I've ended up with the appended patch. Would this be OK? More precise,
would the implementation of

(cl-defmethod loadhist-unload-element ((x (head define-type)))

be the right thing?

>         Stefan

Best regards, Michael.


[-- Attachment #2: Type: text/plain, Size: 5462 bytes --]

diff --git a/lisp/loadhist.el b/lisp/loadhist.el
index 28d0b18c81..59b1688857 100644
--- a/lisp/loadhist.el
+++ b/lisp/loadhist.el
@@ -162,6 +162,83 @@ 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)
+;; The following two might require more actions.
+(cl-defmethod loadhist-unload-element ((x (head ert-deftest))) nil)
+(cl-defmethod loadhist-unload-element ((x (head cl-defmethod))) 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)))
+
+(cl-defmethod loadhist-unload-element ((x (head define-type)))
+  (let* ((name (cdr x))
+         (slots (mapcar 'car (cdr (cl-struct-slot-info name)))))
+    ;; Remove the struct.
+    (setf (cl--find-class name) nil)
+    ;; Remove internal functions.
+    (dolist (fun
+	     (append
+	      ;; constructor, copier, predicate, tag-symbol.
+	      `(,(format "make-%s" name)
+	        ,(format "copy-%s" name)
+	        ,(format "%s-p" name)
+	        ,(format "cl-struct-%s-tags" name))
+	      ;; accessors.
+	      (mapcar #'(lambda (y) (format "%s-%s" name y)) slots)))
+      (dolist
+          (symbol
+           `(,fun ,(format "%s--cmacro" fun) ,(format "--cl-block-%s--" fun)))
+        (unintern symbol obarray)))))
+
 ;;;###autoload
 (defun unload-feature (feature &optional force)
   "Unload the library that provided FEATURE.
@@ -200,9 +277,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 +324,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-24 15:01 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
2017-07-18 15:19         ` Michael Albinus
2017-07-18 15:56           ` Stefan Monnier
2017-07-24 15:01             ` Michael Albinus [this message]
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

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

  git send-email \
    --in-reply-to=8760eh98v0.fsf@detlef \
    --to=michael.albinus@gmx.de \
    --cc=27371@debbugs.gnu.org \
    --cc=monnier@IRO.UMontreal.CA \
    /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 external index

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

This is an external index of several public inboxes,
see mirroring instructions on how to clone and mirror
all data and code used by this external index.