bug#31551: 27.0.50; emacs hangs in hexl-mode on modula2 files

[Stefan Monnier]

>> BTW, this "save previous major mode and then restore it" is something
>> done in other places (at least doc-view-mode comes to mind, but
>> I believe there are others as well) and we should try and avoid
>> duplicating that code (i.e. develop a "standard" way to do it).
>
> In the long run, certainly.

Lightly tested patch below,


        Stefan


    * subr.el (major-mode--suspended): New var.
    (major-mode-suspend, major-mode-restore): New funs, extracted from doc-view.
    * doc-view.el (doc-view--previous-major-mode): Remove.
    (doc-view-mode): Use major-mode-suspend.
    (doc-view-fallback-mode): Use major-mode-restore.
    * hexl-mode.el (hexl-mode--minor-mode-p, hexl-mode--setq-local): Remove.
    (hexl-mode): Use major-mode-suspend and hexl-follow-ascii-mode.
    (hexl-mode-exit): Use major-mode-restore.
    (hexl-activate-ruler, hexl-follow-line): Don't bother trying to preserve
    earlier state, now that entering/leaving hexl-mode kills local vars.
    (hexl-follow-ascii-mode): New proper local minor mode.
    (hexl-follow-ascii): Rewrite, using it.


diff --git a/lisp/subr.el b/lisp/subr.el
index 914112ccef..3bcf3f6cd2 100644
--- a/lisp/subr.el
+++ b/lisp/subr.el
@@ -1908,6 +1908,31 @@ derived-mode-p
   "Non-nil if the current major mode is derived from one of MODES.
 Uses the `derived-mode-parent' property of the symbol to trace backwards."
   (apply #'provided-mode-derived-p major-mode modes))
+
+(defvar-local major-mode--suspended nil)
+(put 'major-mode--suspended 'permanent-local t)
+
+(defun major-mode-suspend ()
+  "Exit current major, remembering it."
+  (let* ((prev-major-mode (or major-mode--suspended
+                             (unless (eq major-mode 'fundamental-mode)
+                               major-mode))))
+    (kill-all-local-variables)
+    (setq-local major-mode--suspended prev-major-mode)))
+
+(defun major-mode-restore (&optional avoided-modes)
+  "Restore major mode earlier suspended with `major-mode-suspend'.
+If there was no earlier suspended major mode, then fallback to `normal-mode',
+tho trying to avoid AVOIDED-MODES."
+  (if major-mode--suspended
+      (funcall (prog1 major-mode--suspended
+                 (kill-local-variable 'major-mode--suspended)))
+    (let ((auto-mode-alist
+           (let ((alist (copy-alist auto-mode-alist)))
+             (dolist (mode avoided-modes)
+               (setq alist (rassq-delete-all mode alist)))
+             alist)))
+      (normal-mode))))
 
 ;;;; Minor modes.
 
@@ -3030,6 +3055,8 @@ insert-for-yank-1
         (inhibit-read-only inhibit-read-only)
         end)
 
+    ;; FIXME: This throws away any yank-undo-function set by previous calls
+    ;; to insert-for-yank-1 within the loop of insert-for-yank!
     (setq yank-undo-function t)
     (if (nth 0 handler) ; FUNCTION
        (funcall (car handler) param)
diff --git a/lisp/doc-view.el b/lisp/doc-view.el
index dfc4d887ae..970e12402d 100644
--- a/lisp/doc-view.el
+++ b/lisp/doc-view.el
@@ -354,9 +354,6 @@ doc-view--current-search-matches
 (defvar doc-view--pending-cache-flush nil
   "Only used internally.")
 
-(defvar doc-view--previous-major-mode nil
-  "Only used internally.")
-
 (defvar doc-view--buffer-file-name nil
   "Only used internally.
 The file name used for conversion.  Normally it's the same as
@@ -1752,12 +1749,7 @@ doc-view-mode
       ;; returns nil for tar members.
       (doc-view-fallback-mode)
 
-    (let* ((prev-major-mode (if (derived-mode-p 'doc-view-mode)
-                               doc-view--previous-major-mode
-                             (unless (eq major-mode 'fundamental-mode)
-                               major-mode))))
-      (kill-all-local-variables)
-      (setq-local doc-view--previous-major-mode prev-major-mode))
+    (major-mode-suspend)
 
     (dolist (var doc-view-saved-settings)
       (set (make-local-variable (car var)) (cdr var)))
@@ -1848,14 +1840,7 @@ doc-view-fallback-mode
                           '(doc-view-resolution
                             image-mode-winprops-alist)))))
     (remove-overlays (point-min) (point-max) 'doc-view t)
-    (if doc-view--previous-major-mode
-        (funcall doc-view--previous-major-mode)
-      (let ((auto-mode-alist
-             (rassq-delete-all
-              'doc-view-mode-maybe
-              (rassq-delete-all 'doc-view-mode
-                                (copy-alist auto-mode-alist)))))
-        (normal-mode)))
+    (major-mode-restore '(doc-view-mode-maybe doc-view-mode))
     (when vars
       (setq-local doc-view-saved-settings vars))))
 
diff --git a/lisp/hexl.el b/lisp/hexl.el
index 2c1a7de48a..9d48ef5b85 100644
--- a/lisp/hexl.el
+++ b/lisp/hexl.el
@@ -58,53 +58,45 @@ hexl-bits
                  (const 16)
                  (const 32)
                  (const 64))
-  :group 'hexl
   :version "24.3")
 
 (defcustom hexl-program "hexl"
   "The program that will hexlify and dehexlify its stdin.
 `hexl-program' will always be concatenated with `hexl-options'
 and \"-de\" when dehexlifying a buffer."
-  :type 'string
-  :group 'hexl)
+  :type 'string)
 
 (defcustom hexl-iso ""
   "If your Emacs can handle ISO characters, this should be set to
 \"-iso\" otherwise it should be \"\"."
-  :type 'string
-  :group 'hexl)
+  :type 'string)
 
 (defcustom hexl-options (format "-hex %s" hexl-iso)
   "Space separated options to `hexl-program' that suit your needs.
 Quoting cannot be used, so the arguments cannot themselves contain spaces.
 If you wish to set the `-group-by-X-bits' options, set `hexl-bits' instead,
 as that will override any bit grouping options set here."
-  :type 'string
-  :group 'hexl)
+  :type 'string)
 
 (defcustom hexl-follow-ascii t
   "If non-nil then highlight the ASCII character corresponding to point."
   :type 'boolean
-  :group 'hexl
   :version "20.3")
 
 (defcustom hexl-mode-hook '(hexl-follow-line hexl-activate-ruler)
   "Normal hook run when entering Hexl mode."
   :type 'hook
-  :options '(hexl-follow-line hexl-activate-ruler eldoc-mode)
-  :group 'hexl)
+  :options '(hexl-follow-line hexl-activate-ruler eldoc-mode))
 
 (defface hexl-address-region
   '((t (:inherit header-line)))
-  "Face used in address area of Hexl mode buffer."
-  :group 'hexl)
+  "Face used in address area of Hexl mode buffer.")
 
 (defface hexl-ascii-region
   '((t (:inherit header-line)))
-  "Face used in ASCII area of Hexl mode buffer."
-  :group 'hexl)
+  "Face used in ASCII area of Hexl mode buffer.")
 
-(defvar hexl-max-address 0
+(defvar-local hexl-max-address 0
   "Maximum offset into hexl buffer.")
 
 (defvar hexl-mode-map
@@ -252,24 +244,6 @@ hexl-line-displen
   "The length of a hexl display line (varies with `hexl-bits')."
   (+ 60 (/ 128 (or hexl-bits 16))))
 
-(defun hexl-mode--minor-mode-p (var)
-  (memq var '(ruler-mode hl-line-mode)))
-
-(defun hexl-mode--setq-local (var val)
-  ;; `var' can be either a symbol or a pair, in which case the `car'
-  ;; is the getter function and the `cdr' is the corresponding setter.
-  (unless (or (member var hexl-mode--old-var-vals)
-              (assoc var hexl-mode--old-var-vals))
-    (push (if (or (consp var) (boundp var))
-              (cons var
-                    (if (consp var) (funcall (car var)) (symbol-value var)))
-            var)
-          hexl-mode--old-var-vals))
-  (cond
-   ((consp var) (funcall (cdr var) val))
-   ((hexl-mode--minor-mode-p var) (funcall var (if val 1 -1)))
-   (t (set (make-local-variable var) val))))
-
 ;;;###autoload
 (defun hexl-mode (&optional arg)
   "\\<hexl-mode-map>A mode for editing binary files in hex dump format.
@@ -364,35 +338,33 @@ hexl-mode
          (or (bolp) (setq original-point (1- original-point))))
         (hexlify-buffer)
         (restore-buffer-modified-p modified))
-      (set (make-local-variable 'hexl-max-address)
-           (+ (* (/ (1- (buffer-size)) (hexl-line-displen)) 16) 15))
+      (setq hexl-max-address
+            (+ (* (/ (1- (buffer-size)) (hexl-line-displen)) 16) 15))
       (condition-case nil
          (hexl-goto-address original-point)
        (error nil)))
 
-    ;; We do not turn off the old major mode; instead we just
-    ;; override most of it.  That way, we can restore it perfectly.
+    (let ((max-address hexl-max-address))
+      (major-mode-suspend)
+      (setq hexl-max-address max-address))
 
-    (hexl-mode--setq-local '(current-local-map . use-local-map) hexl-mode-map)
+    (use-local-map hexl-mode-map)
 
-    (hexl-mode--setq-local 'mode-name "Hexl")
-    (hexl-mode--setq-local 'isearch-search-fun-function
-                           'hexl-isearch-search-function)
-    (hexl-mode--setq-local 'major-mode 'hexl-mode)
+    (setq-local mode-name "Hexl")
+    (setq-local isearch-search-fun-function #'hexl-isearch-search-function)
+    (setq-local major-mode 'hexl-mode)
 
-    (hexl-mode--setq-local '(syntax-table . set-syntax-table)
-                           (standard-syntax-table))
+    ;; (set-syntax-table (standard-syntax-table))
 
-    (add-hook 'write-contents-functions 'hexl-save-buffer nil t)
+    (add-hook 'write-contents-functions #'hexl-save-buffer nil t)
 
-    (hexl-mode--setq-local 'require-final-newline nil)
+    (setq-local require-final-newline nil)
 
 
-    (hexl-mode--setq-local 'font-lock-defaults '(hexl-font-lock-keywords t))
+    (setq-local font-lock-defaults '(hexl-font-lock-keywords t))
 
-    (hexl-mode--setq-local 'revert-buffer-function
-                           #'hexl-revert-buffer-function)
-    (add-hook 'change-major-mode-hook 'hexl-maybe-dehexlify-buffer nil t)
+    (setq-local revert-buffer-function #'hexl-revert-buffer-function)
+    (add-hook 'change-major-mode-hook #'hexl-maybe-dehexlify-buffer nil t)
 
     ;; Set a callback function for eldoc.
     (add-function :before-until (local 'eldoc-documentation-function)
@@ -401,7 +373,7 @@ hexl-mode
     (eldoc-remove-command "hexl-save-buffer"
                          "hexl-current-address")
 
-    (if hexl-follow-ascii (hexl-follow-ascii 1)))
+    (if hexl-follow-ascii (hexl-follow-ascii-mode 1)))
   (run-mode-hooks 'hexl-mode-hook))
 
 
@@ -469,6 +441,7 @@ hexl-find-file
       (hexl-mode)))
 
 (defun hexl-revert-buffer-function (_ignore-auto _noconfirm)
+  ;; FIXME: We don't obey revert-buffer-preserve-modes!
   (let ((coding-system-for-read 'no-conversion)
        revert-buffer-function)
     ;; Call the original `revert-buffer' without code conversion; also
@@ -481,7 +454,7 @@ hexl-revert-buffer-function
     ;; already hexl-mode.
     ;; 2. reset change-major-mode-hook in case that `hexl-mode'
     ;; previously added hexl-maybe-dehexlify-buffer to it.
-    (remove-hook 'change-major-mode-hook 'hexl-maybe-dehexlify-buffer t)
+    (remove-hook 'change-major-mode-hook #'hexl-maybe-dehexlify-buffer t)
     (setq major-mode 'fundamental-mode)
     (hexl-mode)))
 
@@ -494,7 +467,7 @@ hexl-mode-exit
            (inhibit-read-only t)
            (original-point (1+ (hexl-current-address))))
        (dehexlify-buffer)
-       (remove-hook 'write-contents-functions 'hexl-save-buffer t)
+       (remove-hook 'write-contents-functions #'hexl-save-buffer t)
        (restore-buffer-modified-p modified)
        (goto-char original-point)
        ;; Maybe adjust point for the removed CR characters.
@@ -504,27 +477,8 @@ hexl-mode-exit
          (or (bobp) (setq original-point (1+ original-point))))
        (goto-char original-point)))
 
-  (remove-hook 'change-major-mode-hook 'hexl-maybe-dehexlify-buffer t)
-  (remove-hook 'post-command-hook 'hexl-follow-ascii-find t)
-  (setq hexl-ascii-overlay nil)
-
-  (let ((mms ()))
-    (dolist (varval hexl-mode--old-var-vals)
-      (let* ((bound (consp varval))
-             (var (if bound (car varval) varval))
-             (val (cdr-safe varval)))
-        (cond
-         ((consp var) (funcall (cdr var) val))
-         ((hexl-mode--minor-mode-p var) (push (cons var val) mms))
-         (bound (set (make-local-variable var) val))
-         (t (kill-local-variable var)))))
-    (kill-local-variable 'hexl-mode--old-var-vals)
-    ;; Enable/disable minor modes.  Do it after having reset the other vars,
-    ;; since some of them may affect the minor modes.
-    (dolist (mm mms)
-      (funcall (car mm) (if (cdr mm) 1 -1))))
-
-  (force-mode-line-update))
+  (remove-hook 'change-major-mode-hook #'hexl-maybe-dehexlify-buffer t)
+  (major-mode-restore))
 
 (defun hexl-maybe-dehexlify-buffer ()
   "Convert a hexl format buffer to binary.
@@ -534,7 +488,7 @@ hexl-maybe-dehexlify-buffer
            (inhibit-read-only t)
            (original-point (1+ (hexl-current-address))))
        (dehexlify-buffer)
-       (remove-hook 'write-contents-functions 'hexl-save-buffer t)
+       (remove-hook 'write-contents-functions #'hexl-save-buffer t)
        (restore-buffer-modified-p modified)
        (goto-char original-point))))
 
@@ -1041,48 +995,50 @@ hexl-insert-octal-char
        (error "Decimal number out of range")
       (hexl-insert-multibyte-char num arg))))
 
-(defun hexl-follow-ascii (&optional arg)
+(define-minor-mode hexl-follow-ascii
   "Toggle following ASCII in Hexl buffers.
-With prefix ARG, turn on following if and only if ARG is positive.
-When following is enabled, the ASCII character corresponding to the
-element under the point is highlighted.
-Customize the variable `hexl-follow-ascii' to disable this feature."
-  (interactive "P")
+Like `hexl-follow-ascii-mode' but remembers the choice globally."
+  (interactive)
   (let ((on-p (if arg
                  (> (prefix-numeric-value arg) 0)
               (not hexl-ascii-overlay))))
-
-    (if on-p
+    (hexl-follow-ascii-mode (if on-p 1 -1))
+    ;; Remember this choice globally for later use.
+    ;; FIXME: This causes Custom to complain that this var has been set
+    ;; externally, so maybe we should use `customize-mark-as-set' if
+    ;; we were called interactively?
+    (setq hexl-follow-ascii hexl-follow-ascii-mode)))
+
+(define-minor-mode hexl-follow-ascii-mode
+  "Minor mode to follow ASCII in current Hexl buffer.
+When following is enabled, the ASCII character corresponding to the
+element under the point is highlighted.
+The default activation is controlled by `hexl-follow-ascii'."
+  (if hexl-follow-ascii-mode
       ;; turn it on
-      (if (not hexl-ascii-overlay)
-         (progn
-           (setq hexl-ascii-overlay (make-overlay 1 1)
-                 hexl-follow-ascii t)
-           (overlay-put hexl-ascii-overlay 'face 'highlight)
-           (add-hook 'post-command-hook 'hexl-follow-ascii-find nil t)))
+      (progn
+        (unless hexl-ascii-overlay
+         (setq hexl-ascii-overlay (make-overlay (point) (point)))
+         (overlay-put hexl-ascii-overlay 'face 'highlight))
+        (add-hook 'post-command-hook #'hexl-follow-ascii-find nil t))
       ;; turn it off
-      (if hexl-ascii-overlay
-         (progn
-           (delete-overlay hexl-ascii-overlay)
-           (setq hexl-ascii-overlay nil
-                 hexl-follow-ascii nil)
-           (remove-hook 'post-command-hook 'hexl-follow-ascii-find t)
-           )))))
+      (when hexl-ascii-overlay
+        (delete-overlay hexl-ascii-overlay)
+        (setq hexl-ascii-overlay nil))
+      (remove-hook 'post-command-hook #'hexl-follow-ascii-find t)))
 
 (defun hexl-activate-ruler ()
   "Activate `ruler-mode'."
   (require 'ruler-mode)
-  (hexl-mode--setq-local 'ruler-mode-ruler-function
-                         #'hexl-mode-ruler)
-  (hexl-mode--setq-local 'ruler-mode t))
+  (setq-local ruler-mode-ruler-function #'hexl-mode-ruler)
+  (ruler-mode 1))
 
 (defun hexl-follow-line ()
   "Activate `hl-line-mode'."
   (require 'hl-line)
-  (hexl-mode--setq-local 'hl-line-range-function
-                         #'hexl-highlight-line-range)
-  (hexl-mode--setq-local 'hl-line-face 'highlight)
-  (hexl-mode--setq-local 'hl-line-mode t))
+  (setq-local hl-line-range-function #'hexl-highlight-line-range)
+  (setq-local hl-line-face 'highlight)  ;FIXME: Why?
+  (hl-line-mode 1))
 
 (defun hexl-highlight-line-range ()
   "Return the range of address region for the point.