Re: Buffer listing in multiple frames/ttys

[lorentey@elte.hu (Lőrentey Károly)]

[-- Attachment #1.1.1: Type: text/plain, Size: 636 bytes --]

Juri Linkov <juri@jurta.org> 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.


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #1.1.2: Type: text/x-patch, Size: 15303 bytes --]

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)))
  \f
  ;;; 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)))
! 
  \f
  ;;; 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;

[-- Attachment #1.1.3: Type: text/plain, Size: 16 bytes --]


-- 
Károly

[-- Attachment #1.2: Type: application/pgp-signature, Size: 188 bytes --]

[-- Attachment #2: Type: text/plain, Size: 142 bytes --]

_______________________________________________
Emacs-devel mailing list
Emacs-devel@gnu.org
http://lists.gnu.org/mailman/listinfo/emacs-devel