2008-12-05 22:34:25 -05:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
								
									
								 | 
							
							
								;;; fuel-base.el --- Basic FUEL support code
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
								
									
								 | 
							
							
								
							 | 
						
					
						
							
								
									
										
										
										
											2009-01-11 20:34:39 -05:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
								
									
								 | 
							
							
								;; Copyright (C) 2008 Jose Antonio Ortega Ruiz
							 | 
						
					
						
							
								
									
										
										
										
											2008-12-05 22:34:25 -05:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
								
									
								 | 
							
							
								;; See http://factorcode.org/license.txt for BSD license.
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
								
									
								 | 
							
							
								
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
								
									
								 | 
							
							
								;; Author: Jose Antonio Ortega Ruiz <jao@gnu.org>
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
								
									
								 | 
							
							
								;; Keywords: languages
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
								
									
								 | 
							
							
								
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
								
									
								 | 
							
							
								;;; Commentary:
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
								
									
								 | 
							
							
								
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
								
									
								 | 
							
							
								;; Basic definitions likely to be used by all FUEL modules.
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
								
									
								 | 
							
							
								
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
								
									
								 | 
							
							
								;;; Code:
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
								
									
								 | 
							
							
								
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
								
									
								 | 
							
							
								(defconst fuel-version "1.0")
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
								
									
								 | 
							
							
								
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
								
									
								 | 
							
							
								;;;###autoload
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
								
									
								 | 
							
							
								(defsubst fuel-version ()
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
								
									
								 | 
							
							
								  "Echoes FUEL's version."
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
								
									
								 | 
							
							
								  (interactive)
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
								
									
								 | 
							
							
								  (message "FUEL %s" fuel-version))
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
								
									
								 | 
							
							
								
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
								
									
										
									
								 | 
							
							
								
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
								
									
								 | 
							
							
								;;; Customization:
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
								
									
								 | 
							
							
								
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
								
									
								 | 
							
							
								;;;###autoload
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
								
									
								 | 
							
							
								(defgroup fuel nil
							 | 
						
					
						
							
								
									
										
										
										
											2008-12-21 19:51:41 -05:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
								
									
								 | 
							
							
								  "Factor's Ultimate Emacs Library."
							 | 
						
					
						
							
								
									
										
										
										
											2008-12-21 21:07:45 -05:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
								
									
								 | 
							
							
								  :group 'languages)
							 | 
						
					
						
							
								
									
										
										
										
											2008-12-05 22:34:25 -05:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
								
									
								 | 
							
							
								
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
								
									
										
									
								 | 
							
							
								
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
								
									
								 | 
							
							
								;;; Emacs compatibility:
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
								
									
								 | 
							
							
								
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
								
									
								 | 
							
							
								(eval-after-load "ring"
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
								
									
								 | 
							
							
								  '(when (not (fboundp 'ring-member))
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
								
									
								 | 
							
							
								     (defun ring-member (ring item)
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
								
									
								 | 
							
							
								       (catch 'found
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
								
									
								 | 
							
							
								         (dotimes (ind (ring-length ring) nil)
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
								
									
								 | 
							
							
								           (when (equal item (ring-ref ring ind))
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
								
									
								 | 
							
							
								             (throw 'found ind)))))))
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
								
									
								 | 
							
							
								
							 | 
						
					
						
							
								
									
										
										
										
											2008-12-17 17:50:48 -05:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
								
									
								 | 
							
							
								(when (not (fboundp 'completion-table-dynamic))
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
								
									
								 | 
							
							
								  (defun completion-table-dynamic (fun)
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
								
									
								 | 
							
							
								    (lexical-let ((fun fun))
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
								
									
								 | 
							
							
								      (lambda (string pred action)
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
								
									
								 | 
							
							
								        (with-current-buffer (let ((win (minibuffer-selected-window)))
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
								
									
								 | 
							
							
								                               (if (window-live-p win) (window-buffer win)
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
								
									
								 | 
							
							
								                                 (current-buffer)))
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
								
									
								 | 
							
							
								          (complete-with-action action (funcall fun string) string pred))))))
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
								
									
								 | 
							
							
								
							 | 
						
					
						
							
								
									
										
										
										
											2008-12-20 10:51:05 -05:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
								
									
								 | 
							
							
								(when (not (fboundp 'looking-at-p))
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
								
									
								 | 
							
							
								  (defsubst looking-at-p (regexp)
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
								
									
								 | 
							
							
								    (let ((inhibit-changing-match-data t))
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
								
									
								 | 
							
							
								      (looking-at regexp))))
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
								
									
								 | 
							
							
								
							 | 
						
					
						
							
								
									
										
										
										
											2008-12-05 22:34:25 -05:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
								
									
										
									
								 | 
							
							
								
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
								
									
								 | 
							
							
								;;; Utilities
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
								
									
								 | 
							
							
								
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
								
									
								 | 
							
							
								(defun fuel--shorten-str (str len)
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
								
									
								 | 
							
							
								  (let ((sl (length str)))
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
								
									
								 | 
							
							
								    (if (<= sl len) str
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
								
									
								 | 
							
							
								      (let* ((sep " ... ")
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
								
									
								 | 
							
							
								             (sepl (length sep))
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
								
									
								 | 
							
							
								             (segl (/ (- len sepl) 2)))
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
								
									
								 | 
							
							
								        (format "%s%s%s"
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
								
									
								 | 
							
							
								                (substring str 0 segl)
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
								
									
								 | 
							
							
								                sep
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
								
									
								 | 
							
							
								                (substring str (- sl segl)))))))
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
								
									
								 | 
							
							
								
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
								
									
								 | 
							
							
								(defun fuel--shorten-region (begin end len)
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
								
									
								 | 
							
							
								  (fuel--shorten-str (mapconcat 'identity
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
								
									
								 | 
							
							
								                                (split-string (buffer-substring begin end) nil t)
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
								
									
								 | 
							
							
								                                " ")
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
								
									
								 | 
							
							
								                     len))
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
								
									
								 | 
							
							
								
							 | 
						
					
						
							
								
									
										
										
										
											2008-12-20 10:51:05 -05:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
								
									
								 | 
							
							
								(defsubst fuel--region-to-string (begin &optional end)
							 | 
						
					
						
							
								
									
										
										
										
											2008-12-21 18:07:41 -05:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
								
									
								 | 
							
							
								  (let ((end (or end (point))))
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
								
									
								 | 
							
							
								    (if (< begin end)
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
								
									
								 | 
							
							
								        (mapconcat 'identity
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
								
									
								 | 
							
							
								                   (split-string (buffer-substring-no-properties begin end)
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
								
									
								 | 
							
							
								                                 nil
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
								
									
								 | 
							
							
								                                 t)
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
								
									
								 | 
							
							
								                   " ")
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
								
									
								 | 
							
							
								      "")))
							 | 
						
					
						
							
								
									
										
										
										
											2008-12-20 10:51:05 -05:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
								
									
								 | 
							
							
								
							 | 
						
					
						
							
								
									
										
										
										
											2008-12-12 19:54:18 -05:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
								
									
								 | 
							
							
								(defsubst empty-string-p (str) (equal str ""))
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
								
									
								 | 
							
							
								
							 | 
						
					
						
							
								
									
										
										
										
											2008-12-17 15:44:41 -05:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
								
									
								 | 
							
							
								(defun fuel--string-prefix-p (prefix str)
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
								
									
								 | 
							
							
								  (and (>= (length str) (length prefix))
							 | 
						
					
						
							
								
									
										
										
										
											2008-12-22 18:34:43 -05:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
								
									
								 | 
							
							
								       (string= (substring-no-properties str 0 (length prefix))
							 | 
						
					
						
							
								
									
										
										
										
											2008-12-17 15:44:41 -05:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
								
									
								 | 
							
							
								                (substring-no-properties prefix))))
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
								
									
								 | 
							
							
								
							 | 
						
					
						
							
								
									
										
										
										
											2008-12-15 17:44:13 -05:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
								
									
								 | 
							
							
								(defun fuel--respecting-message (format &rest format-args)
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
								
									
								 | 
							
							
								  "Display TEXT as a message, without hiding any minibuffer contents."
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
								
									
								 | 
							
							
								  (let ((text (format " [%s]" (apply #'format format format-args))))
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
								
									
								 | 
							
							
								    (if (minibuffer-window-active-p (minibuffer-window))
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
								
									
								 | 
							
							
								        (minibuffer-message text)
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
								
									
								 | 
							
							
								      (message "%s" text))))
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
								
									
								 | 
							
							
								
							 | 
						
					
						
							
								
									
										
										
										
											2008-12-05 22:34:25 -05:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
								
									
								 | 
							
							
								(provide 'fuel-base)
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
								
									
								 | 
							
							
								;;; fuel-base.el ends here
							 |