From mboxrd@z Thu Jan 1 00:00:00 1970 Path: news.gmane.org!.POSTED!not-for-mail From: Michael Albinus Newsgroups: gmane.emacs.bugs 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 Message-ID: <8760eh98v0.fsf@detlef> References: <87mv99n0ac.fsf@detlef> <87o9sjme8n.fsf@detlef> <87y3rm2pbw.fsf@detlef> <87bmohai2u.fsf@detlef> NNTP-Posting-Host: blaine.gmane.org Mime-Version: 1.0 Content-Type: multipart/mixed; boundary="=-=-=" X-Trace: blaine.gmane.org 1500908598 28459 195.159.176.226 (24 Jul 2017 15:03:18 GMT) X-Complaints-To: usenet@blaine.gmane.org NNTP-Posting-Date: Mon, 24 Jul 2017 15:03:18 +0000 (UTC) User-Agent: Gnus/5.13 (Gnus v5.13) Emacs/26.0.50 (gnu/linux) Cc: 27371@debbugs.gnu.org To: Stefan Monnier Original-X-From: bug-gnu-emacs-bounces+geb-bug-gnu-emacs=m.gmane.org@gnu.org Mon Jul 24 17:03:12 2017 Return-path: Envelope-to: geb-bug-gnu-emacs@m.gmane.org Original-Received: from lists.gnu.org ([208.118.235.17]) by blaine.gmane.org with esmtp (Exim 4.84_2) (envelope-from ) id 1dZet4-0006vh-GX for geb-bug-gnu-emacs@m.gmane.org; Mon, 24 Jul 2017 17:03:10 +0200 Original-Received: from localhost ([::1]:55319 helo=lists.gnu.org) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1dZet8-00014s-Ea for geb-bug-gnu-emacs@m.gmane.org; Mon, 24 Jul 2017 11:03:14 -0400 Original-Received: from eggs.gnu.org ([2001:4830:134:3::10]:51625) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1dZet0-00014i-MS for bug-gnu-emacs@gnu.org; Mon, 24 Jul 2017 11:03:08 -0400 Original-Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1dZesx-0002CG-A0 for bug-gnu-emacs@gnu.org; Mon, 24 Jul 2017 11:03:06 -0400 Original-Received: from debbugs.gnu.org ([208.118.235.43]:51745) by eggs.gnu.org with esmtps (TLS1.0:RSA_AES_128_CBC_SHA1:16) (Exim 4.71) (envelope-from ) id 1dZesx-0002CB-5z for bug-gnu-emacs@gnu.org; Mon, 24 Jul 2017 11:03:03 -0400 Original-Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1dZesv-0004As-Rs for bug-gnu-emacs@gnu.org; Mon, 24 Jul 2017 11:03:02 -0400 X-Loop: help-debbugs@gnu.org Resent-From: Michael Albinus Original-Sender: "Debbugs-submit" Resent-CC: bug-gnu-emacs@gnu.org Resent-Date: Mon, 24 Jul 2017 15:03:01 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 27371 X-GNU-PR-Package: emacs X-GNU-PR-Keywords: Original-Received: via spool by 27371-submit@debbugs.gnu.org id=B27371.150090853315990 (code B ref 27371); Mon, 24 Jul 2017 15:03:01 +0000 Original-Received: (at 27371) by debbugs.gnu.org; 24 Jul 2017 15:02:13 +0000 Original-Received: from localhost ([127.0.0.1]:54422 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1dZes8-00049q-PW for submit@debbugs.gnu.org; Mon, 24 Jul 2017 11:02:13 -0400 Original-Received: from mout.gmx.net ([212.227.15.19]:60165) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1dZes6-00049c-Dy for 27371@debbugs.gnu.org; Mon, 24 Jul 2017 11:02:11 -0400 Original-Received: from detlef.gmx.de ([212.86.46.16]) by mail.gmx.com (mrgmx003 [212.227.17.190]) with ESMTPSA (Nemesis) id 0MXIcX-1d49se1I97-00WIvr; Mon, 24 Jul 2017 17:01:57 +0200 In-Reply-To: (Stefan Monnier's message of "Tue, 18 Jul 2017 11:56:18 -0400") X-Provags-ID: V03:K0:tIVKnCh8Tb66ctvm23EIsXb0SVQL+GncbSlknhp/z9/4eB45aqg sN8H6cPjJzeLv8jLjHJTpfragS8ioesaCDMrqHQiU6vbL6unVGnGS8x5f1AY+dQPLcNqhDU u1HapO3mAmWNfNkBjOXE+myr1oWNcMBA5UDvykLyNAMQ0TWua0bJd2pE/aProdyofLgKT+v HStv5fHqWzlTJviTahvSw== X-UI-Out-Filterresults: notjunk:1;V01:K0:Gf4qxC0bMnI=:Y+L+7LHrDnSYCzlYAK5K8g 7eRAMhWSIVs607aWqUmvDas9cGnQ8rn1/vAtLstM5mjtxxDZIPEGpEjWKMRdQ0lDPE8fj8Uds qCKZtVKgFbrs4riDtGGPDUwb8kAuOxFEwUK9cu13DP3P8kPpegbpxQZGGIttvDsXsBbciDlIe kZ3Y3WM6xtz2qGf72G7cW0h9JS2VkpDl0Tiy2jMbsy/UPW+n+SJusAv5xX1DFUIj0BTlhPAZU GeN7ymTovmmmYGgQPfWe2c3BTCLmEJoyEgPULc/aBPlR1NyTYwCFSlyLTHVXr7wtJ0QcM7vdm qj4tzPjiV2DWGq05UePGQZYIBNqG3NPasQnD1zbQdQbbyghLM77rkNuVgzXqfB8u5y8Zyljqm 7/QC3Skn9JzSJC7IGYnxrJTwhEdweurZT6IKpGk0FFRz4mOQ8p7VKM3Qh5cGe94Kiup9D3vbA oKzK5vtTKsC1+/Hk5YrVMc0OhQBpz2PJfYCDx0sKdK7L0EY7K8nDTZrWRcjNeJZHSVMhzgaLD yn9RepQjYIVCIvmJCTbNUUsvj7Kqcdhxh7mAQXFvPfiwN6QBUdIX57diE9OJkREbapIMfv03j ckunaim3u1Rj0GT5rbN3eIMjl4YUOK1QxUVEcQW45kCmC67Z4WJo761hEiocFdHIDhX8A6Dah FGZ7qEyXNkErHSaOCRLs741RLbh+kevDJE/3fMGxInaFXy8Z9JEs9+XXR7POf1kxZH67dcQ9O 9/zrXwuocJ7NRNoi9ddtrbMubxVMuVbHhuaQc82xT7whDYFtH6zoZnAz3cAeWTSZbolWzP/9 X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list X-detected-operating-system: by eggs.gnu.org: GNU/Linux 2.2.x-3.x [generic] X-Received-From: 208.118.235.43 X-BeenThere: bug-gnu-emacs@gnu.org List-Id: "Bug reports for GNU Emacs, the Swiss army knife of text editors" List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: bug-gnu-emacs-bounces+geb-bug-gnu-emacs=m.gmane.org@gnu.org Original-Sender: "bug-gnu-emacs" Xref: news.gmane.org gmane.emacs.bugs:134911 Archived-At: --=-=-= Content-Type: text/plain Stefan Monnier 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. --=-=-= Content-Type: text/plain Content-Disposition: attachment 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. --=-=-=--