GNU bug report logs - #15189
24.3.50; display-buffer does not work well with custom frames.

Previous Next

Full log

Message #29 received at 15189 <at> debbugs.gnu.org (full text, mbox):

From: Keith David Bershatsky <esq <at> lawlist.com>
To: martin rudalics <rudalics <at> gmx.at>
Cc: 15189 <at> debbugs.gnu.org
Subject: Re: bug#15189: 24.3.50;
 display-buffer does not work well with custom frames.
Date: Wed, 28 Aug 2013 09:35:12 -0700

I have consolidated all of the magic into the display-buffer-alist, so that it can be used for both types of situations -- i.e., file-visiting, and non-file-visiting buffers.  This revision longer relies upon the display-buffer-function, which is slated to be discontinued.

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; EXAMPLE ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defun example ()
  (interactive)
  (lawlist-find-file "*bar*")
  (set-frame-height (selected-frame) 15)
  (set-frame-width (selected-frame) 80)
  (set-frame-position (selected-frame) 0 0)
  (message "\*bar\* appears in frame name SYSTEM.")
  (sit-for 3)
  (lawlist-find-file "foo.txt")
  (set-frame-height (selected-frame) 15)
  (set-frame-width (selected-frame) 80)
  (set-frame-position (selected-frame) 100 100)
  (message "\"foo.txt\" appears in frame name MAIN.")
  (sit-for 3)
  (lawlist-find-file "doe.org")
  (set-frame-height (selected-frame) 15)
  (set-frame-width (selected-frame) 80)
  (set-frame-position (selected-frame) 200 200)
  (message "\"doe.org\" appears in frame name ORG.")
  (sit-for 3)
  (lawlist-find-file "*buffer-filename-non-regexp*")
  (set-frame-height (selected-frame) 15)
  (set-frame-width (selected-frame) 80)
  (set-frame-position (selected-frame) 300 300)
  (message "\*IS\* buffer-filename.  \*NOT\* defined by any special regexp.")
  (sit-for 8)
  (display-buffer (get-buffer-create "*get-buffer-create-example*"))
  (set-frame-height (selected-frame) 15)
  (set-frame-width (selected-frame) 80)
  (set-frame-position (selected-frame) 400 400)
  (message "\*NOT\* buffer-filename.  \*\*IS\*\* defined by main-buffer-regexp.")
  (sit-for 8)
  (display-buffer (get-buffer-create "*get-buffer-create-UNDEFINED*"))
  (message "\*NOT\* buffer-filename.  \*NOT\* defined by any special regexp.")
  (sit-for 8)
  (kill-buffer "*bar*")
  (kill-buffer "foo.txt")
  (kill-buffer "doe.org")
  (kill-buffer "*buffer-filename-non-regexp*")
  (kill-buffer "*get-buffer-create-example*")
  (kill-buffer "*get-buffer-create-UNDEFINED*")
  (make-frame)
  (delete-frame (get-frame "SYSTEM"))
  (delete-frame (get-frame "MAIN"))
  (delete-frame (get-frame "ORG"))
  (delete-frame (get-frame "MISCELLANEOUS"))
  (message "THE END."))

;;;;;;;;;;;;;;;;; DISPLAY-BUFFER-ALIST and DISPLAY-BUFFER ;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defvar regexp-frame-names "^\\(?:MAIN\\|SYSTEM\\|ORG\\|MISCELLANEOUS\\)$"
    "Regexp matching frames with specific names.")

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

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

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

(defvar buffer-filename nil)

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

(defun lawlist-find-file (&optional buffer-filename)
  "With assistance from the display-buffer-alist, locate or create a specific frame,
  and then open the file."
  (interactive)
  (unless buffer-filename (setq buffer-filename (read-file-name "Select File: ")))
  ;; If using a version of Emacs built `--with-ns`, then user may substitute:
  ;;     (unless buffer-filename (setq buffer-filename
  ;;       (ns-read-file-name "Select File:" "~/" t nil)))
    (if buffer-filename
      (display-buffer (find-file-noselect buffer-filename))))

(setq display-buffer-alist '((".*" . (lawlist-display-buffer-pop-up-frame))))

(defun lawlist-display-buffer-pop-up-frame (buffer alist)
  (cond
    ((regexp-match-p org-buffer-regexp (buffer-name buffer))
      (if (frame-exists "ORG")
          (switch-to-frame "ORG")
        ;; If unnamed frame exists, then take control of it.
        (catch 'break (dolist (frame (frame-list))
          (if (not (string-match regexp-frame-names (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"))) )
      (set-window-buffer (frame-selected-window) (buffer-name buffer)))
    ((regexp-match-p main-buffer-regexp (buffer-name buffer))
      (if (frame-exists "MAIN")
          (switch-to-frame "MAIN")
        ;; If unnamed frame exists, then take control of it.
        (catch 'break (dolist (frame (frame-list))
          (if (not (string-match regexp-frame-names (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"))) )
      (set-window-buffer (frame-selected-window) (buffer-name buffer)))
    ((regexp-match-p system-buffer-regexp (buffer-name buffer))
      (if (frame-exists "SYSTEM")
          (switch-to-frame "SYSTEM")
        ;; If unnamed frame exists, then take control of it.
        (catch 'break (dolist (frame (frame-list))
          (if (not (string-match regexp-frame-names (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"))) )
      (set-window-buffer (frame-selected-window) (buffer-name buffer)))
    ((and (not (regexp-match-p org-buffer-regexp (buffer-name buffer)))
          (not (regexp-match-p main-buffer-regexp (buffer-name buffer)))
          (not (regexp-match-p system-buffer-regexp (buffer-name buffer)))
          buffer-filename )
      (if (frame-exists "MISCELLANEOUS")
          (switch-to-frame "MISCELLANEOUS")
        ;; If unnamed frame exists, then take control of it.
        (catch 'break (dolist (frame (frame-list))
          (if (not (string-match regexp-frame-names (frame-parameter frame 'name)))
            (throw 'break (progn
              (switch-to-frame (frame-parameter frame 'name))
              (set-frame-name "MISCELLANEOUS"))))))
        ;; If dolist found no unnamed frame, then create / name it.
        (if (not (frame-exists "MISCELLANEOUS"))
          (progn
            (make-frame)
            (set-frame-name "MISCELLANEOUS"))))
      (set-window-buffer (frame-selected-window) (buffer-name buffer)))
    (t
      (set-window-buffer (split-window-horizontally) (buffer-name buffer)))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; GENERIC REGEXP FUNCTION ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

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

;;;;;;;;;;;;;;;;;;;;;;;;;;; GENERIC BUFFER / FRAME UTILITIES ;;;;;;;;;;;;;;;;;;;;;;;;

(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))))))))

;;;;;;;;;;;;;;;;;;;;;;;; IF BUILT --with-ns, THEN ALSO USE ;;;;;;;;;;;;;;;;;;;;;;;;;;

(defalias 'ns-find-file 'lawlist-ns-find-file)

(defun lawlist-ns-find-file ()
  "Do a `find-file' with the `ns-input-file' as argument."
  (interactive)
  (let* ((f (file-truename
    (expand-file-name (pop ns-input-file)
      command-line-default-directory)))
    (file (find-file-noselect f))
    (bufwin1 (get-buffer-window file 'visible))
    (bufwin2 (get-buffer-window "*scratch*" 'visible)))
  (cond
    (bufwin1
      (select-frame (window-frame bufwin1))
      (raise-frame (window-frame bufwin1))
      (select-window bufwin1))
    ((and (eq ns-pop-up-frames 'fresh) bufwin2)
      (ns-hide-emacs 'activate)
      (select-frame (window-frame bufwin2))
      (raise-frame (window-frame bufwin2))
      (select-window bufwin2)
      (lawlist-find-file f))
    (t
      (ns-hide-emacs 'activate)
      (lawlist-find-file f)))))

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

Previous Next

GNU bug tracking system
Copyright (C) 1999 Darren O. Benham, 1997,2003 nCipher Corporation Ltd, 1994-97 Ian Jackson.