bug-gnu-emacs
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

bug#15189: 24.3.50; display-buffer does not work well with custom frames


From: Keith David Bershatsky
Subject: bug#15189: 24.3.50; display-buffer does not work well with custom frames.
Date: Sun, 25 Aug 2013 17:50:43 -0700
User-agent: / () / () APEL/10.8 Emacs/24.3.50 (x86_64-apple-darwin10.8.0) MULE/6.0 (HANACHIRUSATO)

The documentation for (display-buffer) uses an example with (get-buffer-create 
"*foo*"):

http://www.gnu.org/software/emacs/manual/html_node/elisp/Display-Action-Functions.html

This does not work well with find-file in conjunction with several frames 
because find-file is executed BEFORE custom frame functions are run.  The 
result is that the buffer that initially had focus ends up getting buried even 
though the file being opened is in a new frame.  The only reliable workaround 
appears to be calling the find-file command AFTER the custom frame functions 
are run, which (in my lay opinion) defeats the purpose of using display-buffer.

If the display-buffer function was never intended by the developers to be used 
with find-file and custom frames, then perhaps this email could be treated as a 
feature request "wish-list" instead of being treated as a bug report.

Below is a detailed example that demonstrates what I am experiencing -- just 
plug it in and run the function "example".

Here is a link to a working example that does not use display-buffer:

http://stackoverflow.com/questions/18346785/how-to-intercept-a-file-before-it-opens-and-decide-which-frame

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defun example ()
  (interactive)
  (custom-find-file "*bar*")
  (set-frame-position (selected-frame) 0 0)
  (mark-whole-buffer)
  (delete-region (region-beginning) (region-end))
  (insert "\*bar\* is about to be buried.")
  (message "\*bar\* is about to be buried.")
  (sit-for 3)
  (custom-find-file "foo.txt")
  (set-frame-position (selected-frame) 100 100)
  (mark-whole-buffer)
  (delete-region (region-beginning) (region-end))
  (insert "\"foo.txt\" is about to be buried.")
  (message "\"foo.txt\" is about to be buried.")
  (sit-for 3)
  (custom-find-file "doe.org")
  (set-frame-position (selected-frame) 200 200)
  (mark-whole-buffer)
  (delete-region (region-beginning) (region-end))
  (insert "\"doe.org\" is about to be buried.")
  (message "\"doe.org\" is about to be buried.")
  (sit-for 3)
  (custom-find-file "*undefined*")
  (set-frame-position (selected-frame) 300 300)
  (mark-whole-buffer)
  (delete-region (region-beginning) (region-end))
  (insert "\*undefined\* is now visible in two (2) frames.")
  (message "\*undefined\* is now visible in two (2) frames.") )

(defvar lawlist-system-buffer-regexp nil
  "Regexps matching `buffer-filename` for frame name `SYSTEM`.")
(setq lawlist-system-buffer-regexp '("*scratch*" "*bar*"))

(defvar lawlist-main-buffer-regexp nil
  "Regexps matching `buffer-filename` for frame name `MAIN`.")
(setq lawlist-main-buffer-regexp '("\\.txt" "\\.tex" "\\.el" "\\.yasnippet"))

(defvar lawlist-org-buffer-regexp nil
  "Regexps matching `buffer-filename` for frame name `ORG`.")
(setq lawlist-org-buffer-regexp '("[*]todo-list[*]" "\\.org_archive" "\\.org"))

(defun lawlist-regexps-match-p (regexps string)
  (catch 'matched
    (dolist (regexp regexps)
      (if (string-match regexp string)
        (throw 'matched t)))))

(defvar buffer-filename nil)

(defun custom-find-file (&optional buffer-filename)
  "Locate or create a specific frame, and then open the file."
  (interactive)
  (unless buffer-filename (setq buffer-filename (read-file-name "Select File: 
")))
  (if buffer-filename
    (display-buffer
      (find-file buffer-filename))))


(defun lawlist-display-buffer-function (&optional buffer flag)
  (if buffer-filename (progn
    (when (lawlist-regexps-match-p lawlist-org-buffer-regexp buffer-filename)
      (if (frame-exists "ORG")
          (switch-to-frame "ORG")
        ;; If unnamed frame exists, then take control of it.
        (catch 'break (dolist (frame (frame-list))
          (if (and
              (not (equal "MAIN" (frame-parameter frame 'name)))
              (not (equal "SYSTEM" (frame-parameter frame 'name)))
              (not (equal "ORG" (frame-parameter frame 'name)))
              (not (equal "WANDERLUST" (frame-parameter frame 'name)))
              (not (equal "MISCELLANEOUS" (frame-parameter frame 'name))) )
            (throw 'break (progn
              (switch-to-frame (frame-parameter frame 'name))
              (set-frame-name "ORG"))))))
        ;; If dolist found no unnamed frame, then create / name it.
        (if (not (frame-exists "ORG"))
          (progn
            (make-frame)
            (set-frame-name "ORG"))) ))
    (when (lawlist-regexps-match-p lawlist-main-buffer-regexp buffer-filename)
      (if (frame-exists "MAIN")
          (switch-to-frame "MAIN")
        ;; If unnamed frame exists, then take control of it.
        (catch 'break (dolist (frame (frame-list))
          (if (and
              (not (equal "MAIN" (frame-parameter frame 'name)))
              (not (equal "SYSTEM" (frame-parameter frame 'name)))
              (not (equal "ORG" (frame-parameter frame 'name)))
              (not (equal "WANDERLUST" (frame-parameter frame 'name)))
              (not (equal "MISCELLANEOUS" (frame-parameter frame 'name))) )
            (throw 'break (progn
              (switch-to-frame (frame-parameter frame 'name))
              (set-frame-name "MAIN"))))))
        ;; If dolist found no unnamed frame, then create / name it.
        (if (not (frame-exists "MAIN"))
          (progn
            (make-frame)
            (set-frame-name "MAIN"))) ))
    (when (lawlist-regexps-match-p lawlist-system-buffer-regexp buffer-filename)
      (if (frame-exists "SYSTEM")
          (switch-to-frame "SYSTEM")
        ;; If unnamed frame exists, then take control of it.
        (catch 'break (dolist (frame (frame-list))
          (if (and
              (not (equal "MAIN" (frame-parameter frame 'name)))
              (not (equal "SYSTEM" (frame-parameter frame 'name)))
              (not (equal "ORG" (frame-parameter frame 'name)))
              (not (equal "WANDERLUST" (frame-parameter frame 'name)))
              (not (equal "MISCELLANEOUS" (frame-parameter frame 'name))) )
            (throw 'break (progn
              (switch-to-frame (frame-parameter frame 'name))
              (set-frame-name "SYSTEM"))))))
        ;; If dolist found no unnamed frame, then create / name it.
        (if (not (frame-exists "SYSTEM"))
          (progn
            (make-frame)
            (set-frame-name "SYSTEM"))) ))
    (when (and (not (lawlist-regexps-match-p lawlist-org-buffer-regexp 
buffer-filename))
            (not (lawlist-regexps-match-p lawlist-main-buffer-regexp 
buffer-filename))
            (not (lawlist-regexps-match-p lawlist-system-buffer-regexp 
buffer-filename)) )
      (if (frame-exists "MISCELLAENOUS")
          (switch-to-frame "MISCELLAENOUS")
        ;; If unnamed frame exists, then take control of it.
        (catch 'break (dolist (frame (frame-list))
          (if (and
              (not (equal "MAIN" (frame-parameter frame 'name)))
              (not (equal "SYSTEM" (frame-parameter frame 'name)))
              (not (equal "ORG" (frame-parameter frame 'name)))
              (not (equal "WANDERLUST" (frame-parameter frame 'name)))
              (not (equal "MISCELLANEOUS" (frame-parameter frame 'name))) )
            (throw 'break (progn
              (switch-to-frame (frame-parameter frame 'name))
              (set-frame-name "MISCELLAENEOUS"))))))
        ;; If dolist found no unnamed frame, then create / name it.
        (if (not (frame-exists "MISCELLAENEOUS"))
          (progn
            (make-frame)
            (set-frame-name "MISCELLAENEOUS"))))))))

(setq display-buffer-function 'lawlist-display-buffer-function)


(defun frame-exists (frame-name)
  (not (eq nil (get-frame frame-name))))

(defun get-frame-name (&optional frame)
  "Return the string that names FRAME (a frame).  Default is selected frame."
  (unless frame (setq frame (selected-frame)))
  (if (framep frame)
      (cdr (assq 'name (frame-parameters frame)))
    (error "Function `get-frame-name': Argument not a frame: `%s'" frame)))

(defun get-frame (frame)
  "Return a frame, if any, named FRAME (a frame or a string).
  If none, return nil.
  If FRAME is a frame, it is returned."
  (cond ((framep frame) frame)
        ((stringp frame)
         (catch 'get-a-frame-found
           (dolist (fr (frame-list))
             (when (string= frame (get-frame-name fr))
               (throw 'get-a-frame-found fr)))
           nil))
        (t
         (error
          "Function `get-frame-name': Arg neither a string nor a frame: `%s'"
          frame))))

(defun switch-to-frame (frame-name)
  (let ((frames (frame-list)))
    (catch 'break
      (while frames
        (let ((frame (car frames)))
          (if (equal (frame-parameter frame 'name) frame-name)
              (throw 'break (select-frame-set-input-focus frame))
            (setq frames (cdr frames))))))))


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

In GNU Emacs 24.3.50.1 (x86_64-apple-darwin10.8.0, NS apple-appkit-1038.36)
 of 2013-08-22 on MP.local
Bzr revision: 113971 monnier@iro.umontreal.ca-20130822040645-0fc4fi87eir72jnb
Windowing system distributor `Apple', version 10.3.1038
Configured using:
 `configure --with-ns'

Important settings:
  locale-coding-system: nil
  default enable-multibyte-characters: t

Major mode: Text

Minor modes in effect:
  whitespace-mode: t
  yas-global-mode: t
  yas-minor-mode: t
  global-highlight-parentheses-mode: t
  global-linum-mode: t
  linum-mode: t
  delete-selection-mode: t
  flyspell-mode: t
  frame-bufs-mode: t
  tabbar-mode: t
  highlight-parentheses-mode: t
  osx-key-mode: t
  tooltip-mode: t
  mouse-wheel-mode: t
  menu-bar-mode: t
  file-name-shadow-mode: t
  global-font-lock-mode: t
  font-lock-mode: t
  auto-composition-mode: t
  auto-encryption-mode: t
  auto-compression-mode: t
  line-number-mode: t
  global-visual-line-mode: t
  visual-line-mode: t
  transient-mark-mode: t

Recent input:
<escape> x e x a m p l e <return> s-w s-w s-w s-w s-w 
s-w s-w y s-w s-w s-w y s-w s-w s-w s-w s-w s-w s-o 
<menu-bar> <help-menu> <send-emacs-bug-report>

Recent messages:
Word wrapping enabled
*beep*
Beginning of buffer
*beep*
Beginning of buffer

Load-path shadows:
~/.0.data/.0.emacs/elpa/flim/md4 hides 
/Users/HOME/.0.data/.0.emacs/Emacs.app/Contents/Resources/lisp/md4
~/.0.data/.0.emacs/elpa/flim/hex-util hides 
/Users/HOME/.0.data/.0.emacs/Emacs.app/Contents/Resources/lisp/hex-util
~/.0.data/.0.emacs/elpa/flim/sasl hides 
/Users/HOME/.0.data/.0.emacs/Emacs.app/Contents/Resources/lisp/net/sasl
~/.0.data/.0.emacs/elpa/flim/sasl-ntlm hides 
/Users/HOME/.0.data/.0.emacs/Emacs.app/Contents/Resources/lisp/net/sasl-ntlm
~/.0.data/.0.emacs/elpa/flim/sasl-digest hides 
/Users/HOME/.0.data/.0.emacs/Emacs.app/Contents/Resources/lisp/net/sasl-digest
~/.0.data/.0.emacs/elpa/flim/sasl-cram hides 
/Users/HOME/.0.data/.0.emacs/Emacs.app/Contents/Resources/lisp/net/sasl-cram
~/.0.data/.0.emacs/elpa/flim/ntlm hides 
/Users/HOME/.0.data/.0.emacs/Emacs.app/Contents/Resources/lisp/net/ntlm
~/.0.data/.0.emacs/elpa/flim/hmac-md5 hides 
/Users/HOME/.0.data/.0.emacs/Emacs.app/Contents/Resources/lisp/net/hmac-md5
~/.0.data/.0.emacs/elpa/flim/hmac-def hides 
/Users/HOME/.0.data/.0.emacs/Emacs.app/Contents/Resources/lisp/net/hmac-def
~/.0.data/.0.emacs/elpa/wanderlust/rfc2368 hides 
/Users/HOME/.0.data/.0.emacs/Emacs.app/Contents/Resources/lisp/mail/rfc2368
~/.0.data/.0.emacs/elpa/wanderlust/utf7 hides 
/Users/HOME/.0.data/.0.emacs/Emacs.app/Contents/Resources/lisp/gnus/utf7
~/.0.data/.0.emacs/elpa/semi/smime hides 
/Users/HOME/.0.data/.0.emacs/Emacs.app/Contents/Resources/lisp/gnus/smime
~/.0.data/.0.emacs/elpa/el-get/.dir-locals hides 
/Users/HOME/.0.data/.0.emacs/Emacs.app/Contents/Resources/lisp/gnus/.dir-locals
~/.0.data/.0.emacs/elpa/semi/pgg hides 
/Users/HOME/.0.data/.0.emacs/Emacs.app/Contents/Resources/lisp/obsolete/pgg
~/.0.data/.0.emacs/elpa/semi/pgg-pgp5 hides 
/Users/HOME/.0.data/.0.emacs/Emacs.app/Contents/Resources/lisp/obsolete/pgg-pgp5
~/.0.data/.0.emacs/elpa/semi/pgg-pgp hides 
/Users/HOME/.0.data/.0.emacs/Emacs.app/Contents/Resources/lisp/obsolete/pgg-pgp
~/.0.data/.0.emacs/elpa/semi/pgg-parse hides 
/Users/HOME/.0.data/.0.emacs/Emacs.app/Contents/Resources/lisp/obsolete/pgg-parse
~/.0.data/.0.emacs/elpa/semi/pgg-gpg hides 
/Users/HOME/.0.data/.0.emacs/Emacs.app/Contents/Resources/lisp/obsolete/pgg-gpg
~/.0.data/.0.emacs/elpa/semi/pgg-def hides 
/Users/HOME/.0.data/.0.emacs/Emacs.app/Contents/Resources/lisp/obsolete/pgg-def
~/.0.data/.0.emacs/elpa/utilities/longlines hides 
/Users/HOME/.0.data/.0.emacs/Emacs.app/Contents/Resources/lisp/obsolete/longlines

Features:
(shadow wl-mime mime-edit pgg-parse pccl pccl-20 signature mime-setup
mail-mime-setup semi-setup mime-pgp pgg-def mime-play filename
mime-image modb-standard elmo-imap4 time-stamp emacsbug message rfc822
mml mml-sec mm-decode mm-bodies mm-encode mailabbrev gmm-utils
mailheader org-wl org-w3m org-vm org-rmail org-mhe org-mew org-irc
org-jsinfo org-infojs org-html org-exp ob-exp org-exp-blocks
org-agenda org-info org-gnus org-docview org-bibtex bibtex org-bbdb
disp-table whitespace yasnippet wl-demo wl-draft eword-encode
wl-template sendmail mail-utils elmo-net elmo-cache elmo-map elmo-dop
wl-news wl-address wl-thread wl-folder wl wl-e21 bbdb-autoloads bbdb
el-get el-get-autoloads el-get-list-packages el-get-notify help-mode
el-get-dependencies el-get-build el-get-status el-get-recipes
el-get-byte-compile el-get-methods el-get-fossil el-get-svn
el-get-pacman el-get-github-zip el-get-github-tar el-get-http-zip
el-get-http-tar el-get-hg el-get-git-svn el-get-fink el-get-emacswiki
el-get-http el-get-emacsmirror el-get-github el-get-git el-get-elpa
el-get-darcs el-get-cvs el-get-bzr el-get-brew el-get-builtin
el-get-apt-get el-get-custom el-get-core autoload lisp-mnt savehist
itunes osx-osascript linum delsel server multiple-cursors
mc-separate-operations rectangular-region-mode mc-mark-more thingatpt
mc-cycle-cursors mc-edit-lines multiple-cursors-core rect flyspell
ispell saveplace auto-save-buffers-enhanced auctex-autoloads tex-site
info multiple-cursors-autoloads yasnippet-autoloads package desktop
frameset init-tabbar init-frames tabbar frame-cmds frame-fns avoid
calendar-lawlist lawlist-calendar init-org derived cl-macs gv edmacro
kmacro org-toodledo mailcap-toodledo http-post-simple cl url-http tls
url-auth mail-parse rfc2231 rfc2047 rfc2045 ietf-drums url-gw url
url-proxy url-privacy url-expand url-methods url-history url-cookie
url-domsuf url-util url-parse auth-source eieio eieio-core gnus-util
mm-util mail-prsvr password-cache url-vars mailcap json xml org
ob-tangle ob-ref ob-lob ob-table org-footnote org-src ob-comint
ob-keys org-pcomplete pcomplete comint ansi-color ring org-list
org-faces org-entities noutline outline org-version ob-emacs-lisp ob
org-compat org-macs ob-eval org-loaddefs format-spec find-func
cal-menu calendar cal-loaddefs init-yas init-wl lawlist-tls wl-spam
wl-action wl-summary byte-opt ps-print ps-def lpr wl-refile wl-util pp
elmo-flag elmo-localdir bytecomp byte-compile cconv wl-message
elmo-mime mmelmo-buffer mmelmo-imap mime-view mime-conf calist
semi-def mmimap mime-parse mmbuffer mmgeneric wl-highlight wl-vars
wl-version epg-config elmo-multi elmo-spam elsp-header elsp-generic
elmo elmo-signal elmo-msgdb modb modb-generic modb-entity mime
elmo-util emu invisible inv-23 poem poem-e20 poem-e20_3 utf7
eword-decode mel mime-def alist std11 mcharset mcs-20 mcs-e20 pces
pces-e20 pces-20 broken pcustom elmo-date elmo-vars elmo-version
path-util poe pym static apel-ver product luna mime-w3m w3m-load w3m
browse-url doc-view jka-compr dired image-mode timezone w3m-hist
w3m-fb bookmark-w3m w3m-ems wid-edit cl-loaddefs cl-lib w3m-ccl ccl
w3m-favicon w3m-image w3m-proc w3m-util hideshow easymenu
highlight-parentheses init-osxkeys easy-mmode redo advice help-fns
time-date tooltip ediff-hook vc-hooks lisp-float-type mwheel ns-win
tool-bar dnd fontset image regexp-opt fringe tabulated-list newcomment
lisp-mode prog-mode register page menu-bar rfn-eshadow timer select
scroll-bar mouse jit-lock font-lock syntax facemenu font-core frame
cham georgian utf-8-lang misc-lang vietnamese tibetan thai tai-viet
lao korean japanese hebrew greek romanian slovak czech european
ethiopic indian cyrillic chinese case-table epa-hook jka-cmpr-hook
help simple abbrev minibuffer nadvice loaddefs button faces cus-face
macroexp files text-properties overlay sha1 md5 base64 format env
code-pages mule custom widget hashtable-print-readable backquote
make-network-process ns multi-tty emacs)





reply via email to

[Prev in Thread] Current Thread [Next in Thread]