Re: Buffer listing in multiple frames/ttys

[Lőrentey Károly]

Juri Linkov <address@hidden> writes:
> Thanks for your patch.  Generally it works correctly, with few exceptions:
>
> 1. The function `buffer-list' returns a list of buried buffers in reverse
> order.  In the frame parameter `buried_buffer_list' the most recently
> buried buffer is first, so `buffer-list' misses a Fnreverse on `prevlist'.

Fixed.

> 2. Since `last-buffer' is a general function, I suggest to move it to
> simple.el.

Done.

> 3. Could you create a separate function from lambda which is now let-bound
> in `last-buffer'?  It could be named, for example, as `get-next-valid-buffer'.

Done.  New patch attached below.

Index: lisp/bindings.el
===================================================================
RCS file: /cvsroot/emacs/emacs/lisp/bindings.el,v
retrieving revision 1.154
diff -u -3 -p -r1.154 bindings.el
*** lisp/bindings.el    28 Oct 2005 16:19:16 -0000      1.154
--- lisp/bindings.el    8 Dec 2005 14:22:42 -0000
***************
*** 338,366 ****
  (defvar mode-line-buffer-identification-keymap nil "\
  Keymap for what is displayed by `mode-line-buffer-identification'.")
  
- (defun last-buffer () "\
- Return the last non-hidden buffer in the buffer list."
-   ;; This logic is more or less copied from bury-buffer,
-   ;; except that we reverse the buffer list.
-   (let ((list (nreverse (buffer-list (selected-frame))))
-       (pred (frame-parameter nil 'buffer-predicate))
-       found notsogood)
-     (while (and list (not found))
-       (unless (or (eq (aref (buffer-name (car list)) 0) ? )
-                 ;; If the selected frame has a buffer_predicate,
-                 ;; disregard buffers that don't fit the predicate.
-                 (and pred (not (funcall pred (car list)))))
-       (if (get-buffer-window (car list) 'visible)
-           (or notsogood (eq (car list) (current-buffer)))
-         (setq found (car list))))
-       (pop list))
-     (or found notsogood
-       (get-buffer "*scratch*")
-       (progn
-         (set-buffer-major-mode
-          (get-buffer-create "*scratch*"))
-         (get-buffer "*scratch*")))))
- 
  (defun unbury-buffer () "\
  Switch to the last buffer in the buffer list."
    (interactive)
--- 338,343 ----
***************
*** 673,680 ****
  
  (define-key global-map [?\C-x right] 'next-buffer)
  (define-key global-map [?\C-x C-right] 'next-buffer)
! (define-key global-map [?\C-x left] 'prev-buffer)
! (define-key global-map [?\C-x C-left] 'prev-buffer)
  
  (let ((map minibuffer-local-map))
    (define-key map "\en"   'next-history-element)
--- 650,657 ----
  
  (define-key global-map [?\C-x right] 'next-buffer)
  (define-key global-map [?\C-x C-right] 'next-buffer)
! (define-key global-map [?\C-x left] 'previous-buffer)
! (define-key global-map [?\C-x C-left] 'previous-buffer)
  
  (let ((map minibuffer-local-map))
    (define-key map "\en"   'next-history-element)
Index: lisp/menu-bar.el
===================================================================
RCS file: /cvsroot/emacs/emacs/lisp/menu-bar.el,v
retrieving revision 1.282
diff -u -3 -p -r1.282 menu-bar.el
*** lisp/menu-bar.el    19 Nov 2005 11:23:04 -0000      1.282
--- lisp/menu-bar.el    8 Dec 2005 14:22:43 -0000
***************
*** 1662,1671 ****
                             "Next Buffer"
                             'next-buffer
                             :help "Switch to the \"next\" buffer in a cyclic 
order")
!                      (list 'prev-buffer
                             'menu-item
                             "Previous Buffer"
!                            'prev-buffer
                             :help "Switch to the \"previous\" buffer in a 
cyclic order")
                       (list 'select-named-buffer
                             'menu-item
--- 1662,1671 ----
                             "Next Buffer"
                             'next-buffer
                             :help "Switch to the \"next\" buffer in a cyclic 
order")
!                      (list 'previous-buffer
                             'menu-item
                             "Previous Buffer"
!                            'previous-buffer
                             :help "Switch to the \"previous\" buffer in a 
cyclic order")
                       (list 'select-named-buffer
                             'menu-item
Index: lisp/simple.el
===================================================================
RCS file: /cvsroot/emacs/emacs/lisp/simple.el,v
retrieving revision 1.777
diff -u -3 -p -r1.777 simple.el
*** lisp/simple.el      4 Dec 2005 02:42:29 -0000       1.777
--- lisp/simple.el      8 Dec 2005 14:22:43 -0000
***************
*** 52,76 ****
    "Highlight (un)matching of parens and expressions."
    :group 'matching)
  
  (defun next-buffer ()
    "Switch to the next buffer in cyclic order."
    (interactive)
    (let ((buffer (current-buffer)))
!     (switch-to-buffer (other-buffer buffer))
      (bury-buffer buffer)))
  
! (defun prev-buffer ()
    "Switch to the previous buffer in cyclic order."
    (interactive)
!   (let ((list (nreverse (buffer-list)))
!       found)
!     (while (and (not found) list)
!       (let ((buffer (car list)))
!       (if (and (not (get-buffer-window buffer))
!                (not (string-match "\\` " (buffer-name buffer))))
!           (setq found buffer)))
!       (setq list (cdr list)))
!     (switch-to-buffer found)))
  
  ;;; next-error support framework
  
--- 52,108 ----
    "Highlight (un)matching of parens and expressions."
    :group 'matching)
  
+ (defun get-next-valid-buffer (list &optional buffer visible-ok frame) "\
+ Search LIST for a valid buffer to display in FRAME.
+ Return nil when all buffers in LIST are undesirable for display,
+ otherwise return the first suitable buffer in LIST.
+ 
+ Buffers not visible in windows are preferred to visible buffers,
+ unless VISIBLE-OK is non-nil.
+ If the optional argument FRAME is nil, it defaults to the selected frame.
+ If BUFFER is non-nil, ignore occurances of that buffer in LIST."
+   ;; This logic is more or less copied from other-buffer.
+   (setq frame (or frame (selected-frame)))
+   (let ((pred (frame-parameter frame 'buffer-predicate))
+       found buf)
+     (while (and (not found) list)
+       (setq buf (car list))
+       (if (and (not (eq buffer buf))
+              (buffer-live-p buf)
+              (or (null pred) (funcall pred buf))
+              (not (eq (aref (buffer-name buf) 0) ?\s))
+              (or visible-ok (null (get-buffer-window buf 'visible))))
+         (setq found buf)
+       (setq list (cdr list))))
+     (car list)))
+ 
+ (defun last-buffer (&optional buffer visible-ok frame) "\
+ Return the last non-hidden displayable buffer in the buffer list.
+ If BUFFER is non-nil, last-buffer will ignore that buffer.
+ Buffers not visible in windows are preferred to visible buffers,
+ unless optional argument VISIBLE-OK is non-nil.
+ If the optional third argument FRAME is non-nil, use that frame's
+ buffer list instead of the selected frame's buffer list.
+ If no other buffer exists, the buffer `*scratch*' is returned."
+   (setq frame (or frame (selected-frame)))
+   (or (get-next-valid-buffer (nreverse (buffer-list frame))
+                            buffer-visible-ok frame)
+       (progn
+       (set-buffer-major-mode (get-buffer-create "*scratch*"))
+       (get-buffer "*scratch*"))))
+ 
  (defun next-buffer ()
    "Switch to the next buffer in cyclic order."
    (interactive)
    (let ((buffer (current-buffer)))
!     (switch-to-buffer (other-buffer buffer t))
      (bury-buffer buffer)))
  
! (defun previous-buffer ()
    "Switch to the previous buffer in cyclic order."
    (interactive)
!   (switch-to-buffer (last-buffer (current-buffer) t)))
! 
  
  ;;; next-error support framework
  
Index: src/alloc.c
===================================================================
RCS file: /cvsroot/emacs/emacs/src/alloc.c,v
retrieving revision 1.384
diff -u -3 -p -r1.384 alloc.c
*** src/alloc.c 30 Nov 2005 00:04:51 -0000      1.384
--- src/alloc.c 8 Dec 2005 14:22:43 -0000
***************
*** 5370,5375 ****
--- 5370,5376 ----
          mark_object (ptr->menu_bar_vector);
          mark_object (ptr->buffer_predicate);
          mark_object (ptr->buffer_list);
+         mark_object (ptr->buried_buffer_list);
          mark_object (ptr->menu_bar_window);
          mark_object (ptr->tool_bar_window);
          mark_face_cache (ptr->face_cache);
Index: src/buffer.c
===================================================================
RCS file: /cvsroot/emacs/emacs/src/buffer.c,v
retrieving revision 1.496
diff -u -3 -p -r1.496 buffer.c
*** src/buffer.c        6 Dec 2005 07:37:47 -0000       1.496
--- src/buffer.c        8 Dec 2005 14:22:43 -0000
***************
*** 212,236 ****
       (frame)
       Lisp_Object frame;
  {
!   Lisp_Object framelist, general;
    general = Fmapcar (Qcdr, Vbuffer_alist);
  
    if (FRAMEP (frame))
      {
!       Lisp_Object tail;
  
        CHECK_FRAME (frame);
  
        framelist = Fcopy_sequence (XFRAME (frame)->buffer_list);
  
!       /* Remove from GENERAL any buffer that duplicates one in FRAMELIST.  */
        tail = framelist;
!       while (! NILP (tail))
        {
          general = Fdelq (XCAR (tail), general);
          tail = XCDR (tail);
        }
!       return nconc2 (framelist, general);
      }
  
    return general;
--- 212,249 ----
       (frame)
       Lisp_Object frame;
  {
!   Lisp_Object general;
    general = Fmapcar (Qcdr, Vbuffer_alist);
  
    if (FRAMEP (frame))
      {
!       Lisp_Object framelist, prevlist, tail;
!       Lisp_Object args[3];
  
        CHECK_FRAME (frame);
  
        framelist = Fcopy_sequence (XFRAME (frame)->buffer_list);
+       prevlist = Fnreverse (Fcopy_sequence (XFRAME 
(frame)->buried_buffer_list));
  
!       /* Remove from GENERAL any buffer that duplicates one in
!          FRAMELIST or PREVLIST.  */
        tail = framelist;
!       while (CONSP (tail))
        {
          general = Fdelq (XCAR (tail), general);
          tail = XCDR (tail);
        }
!       tail = prevlist;
!       while (CONSP (tail))
!       {
!         general = Fdelq (XCAR (tail), general);
!         tail = XCDR (tail);
!       }
! 
!       args[0] = framelist;
!       args[1] = general;
!       args[2] = prevlist;
!       return Fnconc (3, args);
      }
  
    return general;
***************
*** 1545,1550 ****
--- 1558,1580 ----
    XSETCDR (link, Vbuffer_alist);
    Vbuffer_alist = link;
  
+   /* Effectively do a delq on buried_buffer_list.  */
+   
+   prev = Qnil;
+   for (link = XFRAME (frame)->buried_buffer_list; CONSP (link);
+        link = XCDR (link))
+     {
+       if (EQ (XCAR (link), buf))
+         {
+           if (NILP (prev))
+             XFRAME (frame)->buried_buffer_list = XCDR (link);
+           else
+             XSETCDR (prev, XCDR (XCDR (prev)));
+           break;
+         }
+       prev = link;
+     }
+ 
    /* Now move this buffer to the front of frame_buffer_list also.  */
  
    prev = Qnil;
***************
*** 2016,2025 ****
        XSETCDR (link, Qnil);
        Vbuffer_alist = nconc2 (Vbuffer_alist, link);
  
!       /* Removing BUFFER from frame-specific lists
!        has the effect of putting BUFFER at the end
!        of the combined list in each frame.  */
!       frames_discard_buffer (buffer);
      }
  
    return Qnil;
--- 2046,2055 ----
        XSETCDR (link, Qnil);
        Vbuffer_alist = nconc2 (Vbuffer_alist, link);
  
!       XFRAME (selected_frame)->buffer_list
!         = Fdelq (buffer, XFRAME (selected_frame)->buffer_list);
!       XFRAME (selected_frame)->buried_buffer_list
!         = Fcons (buffer, XFRAME (selected_frame)->buried_buffer_list);
      }
  
    return Qnil;
Index: src/frame.c
===================================================================
RCS file: /cvsroot/emacs/emacs/src/frame.c,v
retrieving revision 1.322
diff -u -3 -p -r1.322 frame.c
*** src/frame.c 10 Oct 2005 14:52:50 -0000      1.322
--- src/frame.c 8 Dec 2005 14:22:43 -0000
***************
*** 104,110 ****
  Lisp_Object Qunsplittable;
  Lisp_Object Qmenu_bar_lines, Qtool_bar_lines;
  Lisp_Object Qleft_fringe, Qright_fringe;
! Lisp_Object Qbuffer_predicate, Qbuffer_list;
  Lisp_Object Qtty_color_mode;
  
  Lisp_Object Qfullscreen, Qfullwidth, Qfullheight, Qfullboth;
--- 104,110 ----
  Lisp_Object Qunsplittable;
  Lisp_Object Qmenu_bar_lines, Qtool_bar_lines;
  Lisp_Object Qleft_fringe, Qright_fringe;
! Lisp_Object Qbuffer_predicate, Qbuffer_list, Qburied_buffer_list;
  Lisp_Object Qtty_color_mode;
  
  Lisp_Object Qfullscreen, Qfullwidth, Qfullheight, Qfullboth;
***************
*** 276,281 ****
--- 276,282 ----
    f->menu_bar_items_used = 0;
    f->buffer_predicate = Qnil;
    f->buffer_list = Qnil;
+   f->buried_buffer_list = Qnil;
  #ifdef MULTI_KBOARD
    f->kboard = initial_kboard;
  #endif
***************
*** 1900,1906 ****
    XFRAME (frame)->buffer_list = list;
  }
  
! /* Discard BUFFER from the buffer-list of each frame.  */
  
  void
  frames_discard_buffer (buffer)
--- 1901,1907 ----
    XFRAME (frame)->buffer_list = list;
  }
  
! /* Discard BUFFER from the buffer-list and buried-buffer-list of each frame.  
*/
  
  void
  frames_discard_buffer (buffer)
***************
*** 1912,1917 ****
--- 1913,1920 ----
      {
        XFRAME (frame)->buffer_list
        = Fdelq (buffer, XFRAME (frame)->buffer_list);
+       XFRAME (frame)->buried_buffer_list
+         = Fdelq (buffer, XFRAME (frame)->buried_buffer_list);
      }
  }
  
***************
*** 1999,2011 ****
  {
    register Lisp_Object old_alist_elt;
  
!   /* The buffer-alist parameter is stored in a special place and is
!      not in the alist.  */
    if (EQ (prop, Qbuffer_list))
      {
        f->buffer_list = val;
        return;
      }
  
    /* If PROP is a symbol which is supposed to have frame-local values,
       and it is set up based on this frame, switch to the global
--- 2002,2019 ----
  {
    register Lisp_Object old_alist_elt;
  
!   /* The buffer-list parameters are stored in a special place and not
!      in the alist.  */
    if (EQ (prop, Qbuffer_list))
      {
        f->buffer_list = val;
        return;
      }
+   if (EQ (prop, Qburied_buffer_list))
+     {
+       f->buried_buffer_list = val;
+       return;
+     }
  
    /* If PROP is a symbol which is supposed to have frame-local values,
       and it is set up based on this frame, switch to the global
***************
*** 2145,2150 ****
--- 2153,2159 ----
                   : FRAME_MINIBUF_WINDOW (f)));
    store_in_alist (&alist, Qunsplittable, (FRAME_NO_SPLIT_P (f) ? Qt : Qnil));
    store_in_alist (&alist, Qbuffer_list, frame_buffer_list (frame));
+   store_in_alist (&alist, Qburied_buffer_list, XFRAME 
(frame)->buried_buffer_list);
  
    /* I think this should be done with a hook.  */
  #ifdef HAVE_WINDOW_SYSTEM
***************
*** 3965,3970 ****
--- 3974,3981 ----
    staticpro (&Qbuffer_predicate);
    Qbuffer_list = intern ("buffer-list");
    staticpro (&Qbuffer_list);
+   Qburied_buffer_list = intern ("buried-buffer-list");
+   staticpro (&Qburied_buffer_list);
    Qdisplay_type = intern ("display-type");
    staticpro (&Qdisplay_type);
    Qbackground_mode = intern ("background-mode");
Index: src/frame.h
===================================================================
RCS file: /cvsroot/emacs/emacs/src/frame.h,v
retrieving revision 1.112
diff -u -3 -p -r1.112 frame.h
*** src/frame.h 8 Sep 2005 22:30:08 -0000       1.112
--- src/frame.h 8 Dec 2005 14:22:43 -0000
***************
*** 182,187 ****
--- 182,191 ----
    /* List of buffers viewed in this frame, for other-buffer.  */
    Lisp_Object buffer_list;
  
+   /* List of buffers that were viewed, then buried in this frame.  The
+      most recently buried buffer is first.  For last-buffer.  */
+   Lisp_Object buried_buffer_list;
+   
    /* A dummy window used to display menu bars under X when no X
       toolkit support is available.  */
    Lisp_Object menu_bar_window;
***************
*** 994,1000 ****
  
  extern Lisp_Object Qauto_raise, Qauto_lower;
  extern Lisp_Object Qborder_color, Qborder_width;
! extern Lisp_Object Qbuffer_predicate, Qbuffer_list;
  extern Lisp_Object Qcursor_color, Qcursor_type;
  extern Lisp_Object Qfont;
  extern Lisp_Object Qbackground_color, Qforeground_color;
--- 998,1004 ----
  
  extern Lisp_Object Qauto_raise, Qauto_lower;
  extern Lisp_Object Qborder_color, Qborder_width;
! extern Lisp_Object Qbuffer_predicate, Qbuffer_list, Qburied_buffer_list;
  extern Lisp_Object Qcursor_color, Qcursor_type;
  extern Lisp_Object Qfont;
  extern Lisp_Object Qbackground_color, Qforeground_color;

-- 
Károly

pgpINy_4zsFtk.pgp
Description: PGP signature