bug#8856: 24.0.50; regression: special-display-frame is no longer dedicated

["Drew Adams" <drew.adams@oracle.com>]

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

Martin,

OK, I believe I've located the problem.  Sorry for all of the confusion.

However, this is not necessarily simple, and you will need to load more in order
to see it.  I spent a lot of time on this today, but I cannot easily simplify
things more.  I think you will need to look at it first, and then we'll see what
we can do together to focus in more on the problem.

But I suspect that just by looking at the problematic part of the code you will
be able to offer a suggestion that will fix things.  Hope so.  I call
`display-buffer' with the old calling sequence, and that, I imagine, is the
problem.  With a little luck you will be able to let me know what the correction
should be, and that will take care of things.

You might be able to do that without bothering to test at all - see the end of
this message.  But I suspect it might help you to see what happens, even so.

I have tested this with Emacs 23.3 and with your latest window.el (Emacs 24
build from 6/20).  Here is the startup.  File throw-10.el is attached.  It loads
Icicles.

runemacs.exe -Q --debug-init  -l "window-2011-06-23a-MARTIN.el" -l "throw-10.el"
-f "1on1-emacs"

(For Emacs 23, the startup is the same, but without the -l of your window.el
file.)

Once Emacs is started, you can test as before: `M-x f TAB o'.

But to see the problem you need to be in Icicle mode, so do this first: `M-x
icy-mode' (toggles the mode).  You can thus test with and without Icicle mode to
see the difference.  With Emacs 23, both in and out of Icicle mode work.  With
your code it works only when not in Icicle mode.

--

You will need to download all of the Icicles source files for the test.  The
attached file, throw-10.el, loads them all, but it also then simplifies the part
of the code that I think is leading to the problem.  So the code you actually
need to look at is, I think, quite focused.

These are the Icicles files, and the place to get them:
http://www.emacswiki.org/cgi-bin/wiki?action=index;match=%5C.(el%7Ctar)(%5C.gz)%
3F%24

icicles-mac.el
icicles-face.el
icicles-opt.el
icicles-var.el
icicles-fn.el
icicles-mcmd.el
icicles-cmd1.el
icicles-cmd2.el
icicles-mode.el
icicles.el

The code to focus on is, I believe, in test-10.el, function
`icicle-display-candidates-in-Completions'.  (This function is called a lot, in
many Icicles contexts.)

This is the part of the code that I think is problematic - marked with a
`@@@@@@@' comment:

(let ((comp-buf  (get-buffer-create "*Completions*")))
  (unless (get-buffer-window comp-buf 'visible)
    (save-selected-window
      (display-buffer comp-buf t 0) ; <== the problem, no doubt
      (deactivate-mark))))

This calls `display-buffer', but it uses the old calling sequence, which I'm
guessing is the problem.  The point of this code is just to visit display the
buffer and deactivate the mark there.

Again, sorry for the amount of work.  Hoping this will help.

Thx - Drew


[-- Attachment #2: throw-10.el --]
[-- Type: application/octet-stream, Size: 10580 bytes --]

(setq debug-on-error t)

(load-file "c:/drews-lisp-20/icicles-mac.el")
(load-file "c:/drews-lisp-20/icicles-face.el")
(load-file "c:/drews-lisp-20/icicles-opt.el")
(load-file "c:/drews-lisp-20/icicles-var.el")
(load-file "c:/drews-lisp-20/icicles-fn.el")
(load-file "c:/drews-lisp-20/icicles-mcmd.el")
(load-file "c:/drews-lisp-20/icicles-cmd1.el")
(load-file "c:/drews-lisp-20/icicles-cmd2.el")
(load-file "c:/drews-lisp-20/icicles-mode.el")
(load-file "c:/drews-lisp-20/icicles.el")

;; (when (fboundp 'icicle-mode) (icicle-mode 1))

;; Pared down.
(defun icicle-display-candidates-in-Completions (&optional reverse-p no-display-p)
  ""
  (setq icicle-incremental-completion-p  icicle-incremental-completion-flag)
  (when (and (eq t icicle-incremental-completion-p) (get-buffer-window "*Completions*" 0))
    (setq icicle-incremental-completion-p  'always))
  (let ((nb-cands             (length icicle-completion-candidates)))
    (cond ((eq no-display-p 'no-msg))   ; No-op.
          (no-display-p)                ; Simplified for test.
          ((null icicle-completion-candidates) ; Simplified for test.
           (save-selected-window (icicle-remove-Completions-window)))
          (t
           ;; @@@ THIS SEEMS TO BE WHERE THE PROBLEM IS @@@@@@@@@@@@@@@@@@@
           (when (consp icicle-completion-candidates)
             (let ((comp-buf  (get-buffer-create "*Completions*")))
               (unless (get-buffer-window comp-buf 'visible)
                 ;; Remove any leftover mouse selection.
                 (save-selected-window
                   (display-buffer comp-buf t 0) ; <== the problem, no doubt
                   (deactivate-mark)))))
           ;; @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@

           (with-output-to-temp-buffer "*Completions*"
             ;; The `condition-case' shouldn't be needed, but it prevents an
             ;; "End of buffer" message from `display-completion-list' on Emacs 22.
             (condition-case nil
                 (display-completion-list
                  (if reverse-p (reverse icicle-completion-candidates)
                    icicle-completion-candidates))
               (error nil)))
           (message nil)))))

;; Make these functions into no-ops, to simplify things a bit.
(defun icicle-activate-mark () "" nil)
(defun icicle-cancel-Help-redirection () "" nil)
(defun icicle-restore-region-face () "" nil)
(defun icicle-unhighlight-lighter () "" nil)
(defun icicle-fit-completions-window (&optional arg) "" nil)

;---------------------------------


;;; Minibuffer frame
(defvar 1on1-minibuffer-frame nil "")

(defcustom 1on1-minibuffer-frame-alist
  (list
   (assq 'foreground-color minibuffer-frame-alist)
   (or (assq 'background-color minibuffer-frame-alist)
       (cons 'background-color "LightBlue"))
   (assq 'font minibuffer-frame-alist)
   (assq 'mouse-color minibuffer-frame-alist)
   (assq 'cursor-color minibuffer-frame-alist)
   (or (assq 'menu-bar-lines minibuffer-frame-alist)
       (cons 'menu-bar-lines 0))
   (or (assq 'left minibuffer-frame-alist)
       (cons 'left 0))
   (or (assq 'height minibuffer-frame-alist)
       (cons 'height 2))
   (or (assq 'icon-type minibuffer-frame-alist)
       (cons 'icon-type (< emacs-major-version 21)))
   (or (assq 'minibuffer minibuffer-frame-alist)
       (cons 'minibuffer 'only))
   (or (assq 'user-position minibuffer-frame-alist)
       (cons 'user-position t))
   (or (assq 'vertical-scroll-bars minibuffer-frame-alist)
       (cons 'vertical-scroll-bars nil))
   (or (assq 'name minibuffer-frame-alist)
       (cons 'name "Emacs Minibuffer")))
  ""
  :type '(repeat (cons :format "%v"
                  (symbol :tag "Frame Parameter")
                  (sexp :tag "Value")))
  :group 'One-On-One)

;;; *Completions* frame
(defcustom 1on1-default-frame-alist
  (list
   (assq 'foreground-color default-frame-alist)
   (or (assq 'background-color default-frame-alist)
       (cons 'background-color "LightBlue"))
   (assq 'font default-frame-alist)
   (assq 'mouse-color default-frame-alist)
   (assq 'cursor-color default-frame-alist)
   (assq 'cursor-type default-frame-alist)
   (or (assq 'menu-bar-lines default-frame-alist)
       (cons 'menu-bar-lines 1))
   (or (assq 'top default-frame-alist)
       (cons 'top 0))
   (or (assq 'left default-frame-alist)
       (cons 'left 0))
   (or (assq 'width default-frame-alist)
       (cons 'width 80))
   (or (assq 'height default-frame-alist)
       (cons 'height 35))
   (or (assq 'minibuffer default-frame-alist)
       (cons 'minibuffer nil))
   (or (assq 'user-position default-frame-alist)
       (cons 'user-position t))
   (or (assq 'vertical-scroll-bars default-frame-alist)
       (cons 'vertical-scroll-bars 'right))
   (or (assq 'icon-type default-frame-alist)
       (cons 'icon-type (< emacs-major-version 21)))
   (or (assq 'tool-bar-lines default-frame-alist)
       (cons 'tool-bar-lines 1))
   (if (cdr (assq 'left-fringe default-frame-alist))
       (assq 'left-fringe default-frame-alist)
     (cons 'left-fringe 0))
   (if (cdr (assq 'right-fringe default-frame-alist))
       (assq 'right-fringe default-frame-alist)
     (cons 'right-fringe 0))
   (or (assq 'fringe default-frame-alist)
       (cons 'fringe 0)))
  ""
  :type '(repeat (cons :format "%v"
                  (symbol :tag "Frame Parameter")
                  (sexp :tag "Value")))
  :group 'frames)

;;; Special-display frames
(defcustom 1on1-special-display-frame-alist
  (list
   (assq 'font special-display-frame-alist)
   (or (assq 'width special-display-frame-alist)
       (cons 'width 80))
   (or (assq 'height special-display-frame-alist)
       (cons 'height 20))
   (assq 'mouse-color special-display-frame-alist)
   (assq 'cursor-color special-display-frame-alist)
   (or (assq 'menu-bar-lines special-display-frame-alist)
       (cons 'menu-bar-lines 1))
   (assq 'foreground-color special-display-frame-alist)
   (or (assq 'background-color special-display-frame-alist)
       (cons 'background-color "LightSteelBlue"))
   (or (assq 'top special-display-frame-alist)
       (cons 'top 0))
   (or (assq 'left special-display-frame-alist)
       (cons 'left 0))
   (or (assq 'unsplittable special-display-frame-alist)
       (cons 'unsplittable t))
   (or (assq 'user-position special-display-frame-alist)
       (cons 'user-position t))
   (or (assq 'vertical-scroll-bars special-display-frame-alist)
       (cons 'vertical-scroll-bars 'right)))
  ""
  :type '(repeat (cons :format "%v"
                  (symbol :tag "Frame Parameter")
                  (sexp :tag "Value")))
  :group 'frames)

;; Pared down.
(defun 1on1-emacs ()
  ""
  (interactive)
  (setq default-frame-alist (append 1on1-default-frame-alist default-frame-alist)
        special-display-frame-alist (append 1on1-special-display-frame-alist
                                            special-display-frame-alist))
  (add-to-list                          ; *Help* frame
   'special-display-buffer-names
   (list "*Help*" '1on1-display-*Help*-frame
         (list (cons 'background-color "Thistle")
               '(height . 40))))
  (add-to-list                          ; *Completions* frame
   'special-display-buffer-names
   `("*Completions*" 1on1-display-*Completions*-frame
     ((background-color . "LavenderBlush2")
      (menu-bar-lines . 0) (tool-bar-lines . 0)
      (width . 100))))
  (setq pop-up-frames  t)
  ;; Minibuffer frame
  (setq minibuffer-frame-alist (append 1on1-minibuffer-frame-alist
                                       minibuffer-frame-alist))
  (if 1on1-minibuffer-frame
      (modify-frame-parameters 1on1-minibuffer-frame 1on1-minibuffer-frame-alist)
    (setq 1on1-minibuffer-frame
          (make-frame 1on1-minibuffer-frame-alist)))
  (set-frame-width 1on1-minibuffer-frame 150)
  (modify-frame-parameters 1on1-minibuffer-frame `((top ,@ -50)))
  (setq minibuffer-auto-raise t)
;;; (if foobar
;;;       (add-hook 'post-command-hook '1on1-fit-minibuffer-frame)
;;;     (remove-hook 'post-command-hook '1on1-fit-minibuffer-frame))
  (setq w32-grab-focus-on-raise  nil))

;; Pared down.
(defun 1on1-display-*Help*-frame (buf &optional args)
  ""
  (let (return-window)
    (setq return-window (select-window (funcall special-display-function buf args)))
    (raise-frame)
    return-window))

;; Pared down.
(defun 1on1-display-*Completions*-frame (buf &optional args)
  ""
  (let (return-window)
    (setq return-window (select-window (funcall special-display-function buf args)))
    (raise-frame)
    (when (boundp '1on1-minibuffer-frame)
      (redirect-frame-focus (selected-frame) 1on1-minibuffer-frame))
    return-window))

;; Pared down.
(defun 1on1-set-minibuffer-frame-top/bottom ()
  ""
  (when (boundp '1on1-minibuffer-frame)
    (condition-case nil (redisplay t) (error nil))
    (modify-frame-parameters 1on1-minibuffer-frame '((top . -50)))))

;; Pared down.
(defun 1on1-fit-minibuffer-frame ()
  ""
  (interactive)
;;   (unless (require 'fit-frame nil t)
;;     (error "You need to load library `fit-frame.el' to use this command"))
  (when (and (active-minibuffer-window)
             (save-selected-window
               (select-window (minibuffer-window))
               (one-window-p nil 'selected-frame)))
    (let* ((frame         (save-selected-window
                            (select-window (minibuffer-window)) (selected-frame)))
           (frame-height  (frame-height frame)))
      (cond
        ((eq last-command '1on1-fit-minibuffer-frame)
         (set-frame-height frame (1+ (frame-height frame)))
         (1on1-set-minibuffer-frame-top/bottom)
         (condition-case nil (scroll-down (frame-height frame)) (error nil)))
        (t
         (let* ((beg                                     (minibuffer-prompt-end))
                (fit-frame-max-height                    nil)
                (fit-frame-max-height-percent            10)
                (fit-frame-min-height                    2)
                (window-min-height                       2)
                (fit-frame-empty-height                  2)
                (fit-frame-empty-special-display-height  2))
           (fit-frame frame (frame-width frame))
           (1on1-set-minibuffer-frame-top/bottom)
           (condition-case nil (scroll-down (frame-height frame)) (error nil))))))))