猫熊は燃えつきた？！日記

○ elscreen

というわけで、無事 Elscreen 1.4.0 が公開された。某所であった、右？左？ の話はとりあえずペンディング。

○ Yet anthor elscreen-select-and-goto

  (define-key elscreen-map "z" 'elscreen-select-and-goto2)
  (define-key elscreen-map "\C-z" 'elscreen-select-and-goto2)
  
  (defface elscreen-selected-face
    `((((class color) (type tty)) (:foreground "blue"))
      (((class color) (background light)) (:foreground "white" :background "dark blue" :bold t))
      (((class color) (background dark)) (:foreground "LimeGreen" :background "white" :bold t))
      (t (:bold t :underline t)))
    "Face of selected screen."
    :group 'elscreen)
  
  (defface elscreen-select-face
    `((((class color) (type tty)) (:foreground "black"))
      (((class color) (background light)) (:foreground "black"))
      (((class color) (background dark)) (:foreground "white"))
      (t nil))
    "Face screens."
    :group 'elscreen)
  
  (defun elscreen-select-and-goto2 ()
    (interactive)
    (let* ((showbuf (get-buffer-create " *Elscreen select*"))
	   (wheight (max (+ (elscreen-get-number-of-screens) 4)
			 window-min-height))
	   (msgs "")
	   (minimsg "Select SCREEN number or (c)reate, (k)ill, (f)ind-file, e(x)ecute")
	   (names (elscreen-get-screen-to-name-alist (- (frame-width) 10)))
	   (cscrn (elscreen-get-current-screen))
	   (command-list '((?c . elscreen-create)
			   (?k . (continue . (elscreen-kill . num)))
			   (?f . elscreen-find-file)
			   (?x . elscreen-execute-extended-command)))
	   window last-window
	   num c num-or-func continue tmp)
      (setq tmp minimsg)
      (setq minimsg "")
      (while (string-match "(\\(.\\))" tmp)
	(setq minimsg (concat minimsg (substring tmp 0 (match-beginning 1))))
	(setq c (match-string 1 tmp))
	(setq tmp (substring tmp (match-end 0)))
	(put-text-property 0 1 'face 'bold c)
	(setq minimsg (concat minimsg c ")")))
      (setq minimsg (concat minimsg tmp))
      (setq c nil)
      (setq names (sort names (lambda (x y) (< (car x) (car y)))))
      (if (not names)
	  (message "No screen")
	(mapcar (lambda (x)
		  (setq num (car x))
		  (setq x (format " %d: %s %s"
				  (car x)
				  (elscreen-status-label (car x))
				  (cdr x)))
		  (add-text-properties 0 (length x) `(elscreen-select-number
						      ,num
						      face
						      elscreen-select-face)
				       x)
		  (setq msgs (concat msgs "\n" x)))
		names)
	(unwind-protect
	    (save-window-excursion
	      (setq last-window (previous-window (static-if elscreen-on-xemacs
							   (frame-highest-window)
							 (frame-first-window))))
	      (while (minibuffer-window-active-p last-window)
		(setq last-window (previous-window last-window)))
	      (while (and
		      (not (one-window-p))
		      (or (< (window-width last-window)
			     (frame-width))
			  (< (window-height last-window)
			     (+ wheight window-min-height))))
		(setq window last-window)
		(setq last-window (previous-window window))
		(delete-window window))
	      (select-window (split-window last-window))
	      (shrink-window (- (window-height) wheight))
	      (switch-to-buffer showbuf)
	      (setq buffer-read-only nil)
	      (erase-buffer)
	      (shrink-window (- (window-height) wheight))
	      (insert "Select SCREEN:\n" msgs "\n")
	      (goto-char (point-min))
	      (when (re-search-forward (format "^ +%d:" cscrn) nil t)
		(beginning-of-line))
	      (add-text-properties (1+ (point)) (line-end-position)
				   '(face elscreen-selected-face))
	      (while (null c)
		(set-buffer-modified-p nil)
		(setq c (static-if (fboundp 'read-event)
			    (read-event minimsg)
			  (message minimsg)
			  (read-char-exclusive)))
		(cond
		 ((memq c '(?q ? ))
		  (setq num-or-func 'exit))
		 ((and (numberp c) (assq (- c ?0) names))
		  (add-text-properties (point) (line-end-position)
				       '(face elscreen-select-face))
		  (goto-char (point-min))
		  (let ((case-fold-search nil))
		    (when (re-search-forward (format "^ %c:" c) nil t)
		      (beginning-of-line)
		      (add-text-properties (1+ (point)) (line-end-position)
					   '(face elscreen-selected-face))
		      (sit-for 0.5)))
		  (setq num-or-func (get-text-property (point) 'elscreen-select-number)))
		 ((memq c '(?\C-m return))
		  (setq num-or-func (get-text-property (point) 'elscreen-select-number)))
		 ((assq c command-list)
		  (setq num (get-text-property (point) 'elscreen-select-number))
		  (setq num-or-func (cdr (assq c command-list))))
		 ((memq c '(?\C-n ?n down))
		  (setq c nil)
		  (add-text-properties (point) (line-end-position)
				       '(face elscreen-select-face))
		  (forward-line)
		  (unless (get-text-property (point) 'elscreen-select-number)
		    (goto-char (next-single-property-change
				(point-min)
				'elscreen-select-number)))
		  (add-text-properties (1+ (point)) (line-end-position)
				       '(face elscreen-selected-face)))
		 ((memq c '(?\C-p ?p up))
		  (setq c nil)
		  (add-text-properties (point) (line-end-position)
				       '(face elscreen-select-face))
		  (forward-line -1)
		  (beginning-of-line)
		  (unless (get-text-property (point) 'elscreen-select-number)
		    (goto-char (point-max))
		    (forward-line -1)
		    (beginning-of-line))
		  (add-text-properties (1+ (point)) (line-end-position)
				       '(face elscreen-selected-face)))
		 (t
		  (setq c nil)
		  (unless (string-match "retry$" minimsg)
		    (setq minimsg (concat minimsg ", retry")))))))
	  (kill-buffer showbuf))
	(when (and (consp num-or-func)
		   (eq (car num-or-func) 'continue))
	  (setq continue t)
	  (setq num-or-func (cdr num-or-func)))
	(cond
	 ((numberp num-or-func)
	  (message "Goto screen %d" num-or-func)
	  (funcall 'elscreen-goto num-or-func))
	 ((functionp num-or-func)
	  (message "Execute %s" (symbol-name num-or-func))
	  (call-interactively num-or-func))
	 ((and (consp num-or-func)
	       (functionp (car num-or-func))
	       (eq 'num (cdr num-or-func)))
	  (message "Execute %s with %d" (symbol-name (car num-or-func)) num)
	  (funcall (car num-or-func) num)))
	(when continue
	  (elscreen-select-and-goto2)))))