🚀 go-pugleaf

Here are two sample applications of the XMENU interface, one for
selecting buffers, and one for inserting selections from the kill ring.

						    - Mark Kolb
						      kolb@crd.ge.com


;;;  -*- Mode: Emacs-Lisp -*-

;;;  File written by Mark A. Kolb, Tue, Jan 22 1991.
;;;  Elisp functions which use the XMENU interface.

(require 'x-utils)
(provide 'xmenu-utils)


;;;  Use of XMENU to select a buffer.

(defun xmenu-buffer-select (&rest ignore)
  "Selects a new current buffer from a pop-up xmenu."
  (interactive)
  (let ((buffer-name (xmenu "Select Buffer" (get-buffer-names))))
    (when buffer-name
      (switch-to-buffer buffer-name))))

(defun get-buffer-names ()
  "Returns a list of the names of all selectable buffers."
  (let ((buffer-names nil)
	(space-char ? ))
    (dolist (a-name (mapcar 'buffer-name (buffer-list)))
       (when (not (char-equal (elt a-name 0) space-char))
	  (setq buffer-names (cons a-name buffer-names))))
    (nreverse buffer-names)))

;(global-set-key "Pick a key" 'xmenu-buffer-select)




;;;  Sample code using XMENU to paste items from the kill ring.

(defun xmenu-kill-ring (&rest ignore)
  "Inserts choices from a pop-up xmenu of the kill ring."
  (interactive)
  (let* ((filtered-ring (remove-whitespace-strings kill-ring))
	 (filtered-choices (mapcar 'trim-leading-whitespace filtered-ring))
	 (selection (xmenu "Kill Ring" filtered-choices filtered-ring)))
    (when selection (insert selection))))

;(global-set-key "Pick a key" 'xmenu-kill-ring)



;;;  Functions for filtering strings with whitespace characters.
;;;  Used by XMENU-KILL-RING.

(defvar *whitespace-chars* '(?  ?	 ?
) "A list of all whitespace characters (SPACE, TAB, NEWLINE).")

(defun remove-whitespace-strings (string-list)
  "Filters out strings from STRING-LIST which contain only whitespace chars."
  (let ((keepers '())
	(keep-p nil))
    (dolist (a-string string-list)
      (setq keep-p nil)
      (let ((i 0)
	    (length (length a-string)))
	(while (and (null keep-p)
		    (< i length))
	  (if (memq (elt a-string i) *whitespace-chars*)
	      (setq i (+ i 1))
	    (setq keep-p t))))
      (when keep-p
	(setq keepers (cons a-string keepers))))
    (nreverse keepers)))

(defun trim-leading-whitespace (a-string)
  "Returns a substring of A-STRING with no leading whitespace characters."
  (let ((i 0)
	(length (length a-string))
	(start nil))
    (while (and (null start)
		(< i length))
      (if (memq (elt a-string i) *whitespace-chars*)
	  (setq i (+ i 1))
	(setq start i)))
    (if (zerop start)
	a-string
	(substring a-string start))))    


;;;  End of file.