xemacs-beta: lisp/gutter-items.el comparison

comparison lisp/gutter-items.el @ 903:4a27df428c73

[xemacs-hg @ 2002-07-06 05:48:14 by andyp] sync with 21.4

author	andyp
date	Sat, 06 Jul 2002 05:48:22 +0000
parents	42375619fa45
children	3508e2f71814

comparison

equal deleted inserted replaced

-:2fd2239ea63a
+:4a27df428c73
 :group 'buffers-tab
 :type 'boolean)
 (defvar gutter-buffers-tab-orientation 'top
 "Where the buffers tab currently is. Do not set this.")
+(defcustom buffers-tab-max-size 6
+"*Maximum number of entries which may appear on the \"Buffers\" tab.
+If this is 10, then only the ten most-recently-selected buffers will be
+shown.  If this is nil, then all buffers will be shown.  Setting this to
+a large number or nil will slow down tab responsiveness."
+:type '(choice (const :tag "Show all" nil)
+		 (integer 6))
+:group 'buffers-tab)
+(defcustom buffers-tab-switch-to-buffer-function 'buffers-tab-switch-to-buffer
+"*The function to call to select a buffer from the buffers tab.
+`switch-to-buffer' is a good choice, as is `pop-to-buffer'."
+:type '(radio (function-item switch-to-buffer)
+		(function-item pop-to-buffer)
+		(function :tag "Other"))
+:group 'buffers-tab)
+(defcustom buffers-tab-omit-function 'buffers-menu-omit-invisible-buffers
+"*If non-nil, a function specifying the buffers to omit from the buffers tab.
+This is passed a buffer and should return non-nil if the buffer should be
+omitted.  The default value `buffers-menu-omit-invisible-buffers' omits
+buffers that are normally considered \"invisible\" (those whose name
+begins with a space)."
+:type '(choice (const :tag "None" nil)
+		 function)
+:group 'buffers-tab)
+(defvar buffers-tab-selection-function 'select-buffers-tab-buffers-by-mode
+"*If non-nil, a function specifying the buffers to select in the
+buffers tab.  This is passed two buffers and should return non-nil if
+the first buffer should be selected.  The default value
+`select-buffers-tab-buffers-by-mode' groups buffers by major mode and
+by `buffers-tab-grouping-regexp'.")
+(make-obsolete-variable buffers-tab-selection-function
+			"Set `buffers-tab-filter-functions' instead.")
+(defcustom buffers-tab-filter-functions (list 'select-buffers-tab-buffers-by-mode)
+"*If non-nil, a list of functions specifying the buffers to include
+in the buffers tab, depending on the context.
+Each function in the list is passed two buffers, the buffer to
+potentially select and the context buffer, and should return non-nil
+if the first buffer should be selected.  The default value groups
+buffers by major mode and by `buffers-tab-grouping-regexp'."
+:type '(repeat function)
+:group 'buffers-tab)
+(defcustom buffers-tab-sort-function nil
+"*If non-nil, a function specifying the buffers to select from the
+buffers tab.  This is passed the buffer list and returns the list in the
+order desired for the tab widget.  The default value `nil' leaves the
+list in `buffer-list' order (usual most-recently-selected-first)."
+:type '(choice (const :tag "None" nil)
+		 function)
+:group 'buffers-tab)
+(make-face 'buffers-tab "Face for displaying the buffers tab.")
+(set-face-parent 'buffers-tab 'modeline)
+(defcustom buffers-tab-face 'buffers-tab
+"*Face to use for displaying the buffers tab."
+:type 'face
+:group 'buffers-tab)
+(defcustom buffers-tab-grouping-regexp
+'("^\\(gnus-\\|message-mode\\|mime/viewer-mode\\)"
+"^\\(emacs-lisp-\\|lisp-\\)")
+"*If non-nil, a list of regular expressions for buffer grouping.
+Each regular expression is applied to the current major-mode symbol
+name and mode-name, if it matches then any other buffers that match
+the same regular expression be added to the current group."
+:type '(choice (const :tag "None" nil)
+		 sexp)
+:group 'buffers-tab)
+(defcustom buffers-tab-format-buffer-line-function 'format-buffers-tab-line
+"*The function to call to return a string to represent a buffer in the
+buffers tab.  The function is passed a buffer and should return a
+string.  The default value `format-buffers-tab-line' just returns the
+name of the buffer, optionally truncated to
+`buffers-tab-max-buffer-line-length'.  Also check out
+`slow-format-buffers-menu-line' which returns a whole bunch of info
+about a buffer."
+:type 'function
+:group 'buffers-tab)
+(defvar buffers-tab-default-buffer-line-length
+(make-specifier-and-init 'generic '((global ((default) . 25))) t)
+"*Maximum length of text which may appear in a \"Buffers\" tab.
+This is a specifier, use set-specifier to modify it.")
+(defcustom buffers-tab-max-buffer-line-length
+(specifier-instance buffers-tab-default-buffer-line-length)
+"*Maximum length of text which may appear in a \"Buffers\" tab.
+Buffer names over this length will be truncated with elipses.
+If this is 0, then the full buffer name will be shown."
+:type '(choice (const :tag "Show all" 0)
+		 (integer 25))
+:group 'buffers-tab
+:set #'(lambda (var val)
+	   (set-specifier buffers-tab-default-buffer-line-length val)
+	   (setq buffers-tab-max-buffer-line-length val)))
+(defun buffers-tab-switch-to-buffer (buffer)
+"For use as a value for `buffers-tab-switch-to-buffer-function'."
+(unless (eq (window-buffer) buffer)
+;; this used to add the norecord flag to both calls below.
+;; this is bogus because it is a pervasive assumption in XEmacs
+;; that the current buffer is at the front of the buffers list.
+;; for example, select an item and then do M-C-l
+;; (switch-to-other-buffer).  Things get way confused.
+(if (> (length (windows-of-buffer buffer)) 0)
+	(select-window (car (windows-of-buffer buffer)))
+(switch-to-buffer buffer))))
+(defun select-buffers-tab-buffers-by-mode (buffer-to-select buf1)
+"For use as a value of `buffers-tab-selection-function'.
+This selects buffers by major mode `buffers-tab-grouping-regexp'."
+(let ((mode1 (symbol-name (symbol-value-in-buffer 'major-mode buf1)))
+	(mode2 (symbol-name (symbol-value-in-buffer 'major-mode
+						    buffer-to-select)))
+	(modenm1 (symbol-value-in-buffer 'mode-name buf1))
+	(modenm2 (symbol-value-in-buffer 'mode-name buffer-to-select)))
+(cond ((or (eq mode1 mode2)
+	       (eq modenm1 modenm2)
+	       (and (string-match "^[^-]+-" mode1)
+		    (string-match
+		     (concat "^" (regexp-quote
+				  (substring mode1 0 (match-end 0))))
+		     mode2))
+	       (and buffers-tab-grouping-regexp
+		    (find-if #'(lambda (x)
+				 (or
+				  (and (string-match x mode1)
+				       (string-match x mode2))
+				  (and (string-match x modenm1)
+				       (string-match x modenm2))))
+			     buffers-tab-grouping-regexp)))
+	   t)
+	  (t nil))))
+(defun format-buffers-tab-line (buffer)
+"For use as a value of `buffers-tab-format-buffer-line-function'.
+This just returns the buffer's name, optionally truncated."
+(let ((len (specifier-instance buffers-tab-default-buffer-line-length)))
+(if (and (> len 0)
+	     (> (length (buffer-name buffer)) len))
+	(if (string-match ".*<.>$" (buffer-name buffer))
+	    (concat (substring (buffer-name buffer)
+			       0 (- len 6)) "..."
+			       (substring (buffer-name buffer) -3))
+	  (concat (substring (buffer-name buffer)
+			     0 (- len 3)) "..."))
+(buffer-name buffer))))
+(defsubst build-buffers-tab-internal (buffers)
+(let ((selected t))
+(mapcar
+#'(lambda (buffer)
+	 (prog1
+	     (vector
+	      (funcall buffers-tab-format-buffer-line-function
+		       buffer)
+	      (list buffers-tab-switch-to-buffer-function
+		    (buffer-name buffer))
+	      :selected selected)
+	   (when selected (setq selected nil))))
+buffers)))
+;;; #### SJT would like this function to have a sort function list. I
+;;; don't see how this could work given that sorting is not
+;;; cumulative --andyp.
+(defun buffers-tab-items (&optional in-deletion frame force-selection)
+"Return a list of tab instantiators based on the current buffers list.
+This function is used as the tab filter for the top-level buffers
+\"Buffers\" tab.  It dynamically creates a list of tab instantiators
+to use as the contents of the tab.  The contents and order of the list
+is controlled by `buffers-tab-filter-functions' which by default
+groups buffers according to major mode and removes invisible buffers.
+You can control how many buffers will be shown by setting
+`buffers-tab-max-size'.  You can control the text of the tab items by
+redefining the function `format-buffers-menu-line'."
+(save-match-data
+;; NB it is too late if we run the omit function as part of the
+;; filter functions because we need to know which buffer is the
+;; context buffer before they get run.
+(let* ((buffers (delete-if
+		     buffers-tab-omit-function (buffer-list frame)))
+	   (first-buf (car buffers)))
+;; maybe force the selected window
+(when (and force-selection
+		 (not in-deletion)
+		 (not (eq first-buf (window-buffer (selected-window frame)))))
+	(setq buffers (cons (window-buffer (selected-window frame))
+			    (delq first-buf buffers))))
+;; if we're in deletion ignore the current buffer
+(when in-deletion
+	(setq buffers (delq (current-buffer) buffers))
+	(setq first-buf (car buffers)))
+;; filter buffers
+(when buffers-tab-filter-functions
+	(setq buffers
+	      (delete-if
+	       #'null
+	       (mapcar #'(lambda (buf)
+			   (let ((tmp-buf buf))
+			     (mapc #'(lambda (fun)
+				       (unless (funcall fun buf first-buf)
+					 (setq tmp-buf nil)))
+				   buffers-tab-filter-functions)
+			     tmp-buf))
+		       buffers))))
+;; maybe shorten list of buffers
+(and (integerp buffers-tab-max-size)
+	   (> buffers-tab-max-size 1)
+	   (> (length buffers) buffers-tab-max-size)
+	   (setcdr (nthcdr (1- buffers-tab-max-size) buffers) nil))
+;; sort buffers in group (default is most-recently-selected)
+(when buffers-tab-sort-function
+	(setq buffers (funcall buffers-tab-sort-function buffers)))
+;; convert list of buffers to list of structures used by tab widget
+(setq buffers (build-buffers-tab-internal buffers))
+buffers)))
 (defun add-tab-to-gutter ()
 "Put a tab control in the gutter area to hold the most recent buffers."
 (setq gutter-buffers-tab-orientation (default-gutter-position))
 (let* ((gutter-string (copy-sequence "\n"))

Mercurial > hg > xemacs-beta

comparison lisp/gutter-items.el @ 903:4a27df428c73