From eeb3c102a753caaebfed86b448fae8c7b4e750ad Mon Sep 17 00:00:00 2001 From: Alexander Sulfrian Date: Tue, 27 Apr 2010 23:49:29 +0200 Subject: updated emacs config added browse module for the kill ring added sml-modline to hide scrollbar added dir-locals menu for directory local settings (from .dir-locals.el) --- emacs.d/lisp/browse-kill-ring.el | 1050 ++++++++++++++++++++++++++++++++++++++ emacs.d/lisp/dir-locals.el | 183 +++++++ emacs.d/lisp/sml-modeline.el | 192 +++++++ 3 files changed, 1425 insertions(+) create mode 100644 emacs.d/lisp/browse-kill-ring.el create mode 100644 emacs.d/lisp/dir-locals.el create mode 100644 emacs.d/lisp/sml-modeline.el (limited to 'emacs.d') diff --git a/emacs.d/lisp/browse-kill-ring.el b/emacs.d/lisp/browse-kill-ring.el new file mode 100644 index 0000000..94f18a3 --- /dev/null +++ b/emacs.d/lisp/browse-kill-ring.el @@ -0,0 +1,1050 @@ +;;; browse-kill-ring.el --- interactively insert items from kill-ring -*- coding: utf-8 -*- + +;; Copyright (C) 2001, 2002 Colin Walters + +;; Author: Colin Walters +;; Maintainer: Nick Hurley +;; Created: 7 Apr 2001 +;; Version: 1.3a (CVS) +;; X-RCS: $Id: browse-kill-ring.el,v 1.2 2008/10/29 00:23:00 hurley Exp $ +;; URL: http://freedom.cis.ohio-state.edu/~hurley/ +;; URL-ja: http://www.fan.gr.jp/~ring/doc/browse-kill-ring.html +;; Keywords: convenience + +;; This file is not currently part of GNU Emacs. + +;; This program is free software; you can redistribute it and/or +;; modify it under the terms of the GNU General Public License as +;; published by the Free Software Foundation; either version 2, or (at +;; your option) any later version. + +;; This program is distributed in the hope that it will be useful, but +;; WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +;; General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program ; see the file COPYING. If not, write to +;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330, +;; Boston, MA 02111-1307, USA. + +;;; Commentary: + +;; Ever feel that 'C-y M-y M-y M-y ...' is not a great way of trying +;; to find that piece of text you know you killed a while back? Then +;; browse-kill-ring.el is for you. + +;; This package is simple to install; add (require 'browse-kill-ring) +;; to your ~/.emacs file, after placing this file somewhere in your +;; `load-path'. If you want to use 'M-y' to invoke +;; `browse-kill-ring', also add (browse-kill-ring-default-keybindings) +;; to your ~/.emacs file. Alternatively, you can bind it to another +;; key such as "C-c k", with: +;; (global-set-key (kbd "C-c k") 'browse-kill-ring) + +;; Note that the command keeps track of the last window displayed to +;; handle insertion of chosen text; this might have unexpected +;; consequences if you do 'M-x browse-kill-ring', then switch your +;; window configuration, and try to use the same *Kill Ring* buffer +;; again. + +;;; Change Log: + +;; Changes from 1.3 to 1.3a: + +;; * Sneak update by Benjamin Andresen +;; * Added the read-only bugfix (http://bugs.debian.org/225082) from +;; the emacs-goodies-el package + +;; Changes from 1.2 to 1.3: + +;; * New maintainer, Nick Hurley +;; * New functions `browse-kill-ring-prepend-insert', and +;; `browse-kill-ring-append-insert', bound to 'b' and 'a' by +;; default. There are also the unbound functions +;; `browse-kill-ring-prepend-insert-and-quit', +;; `browse-kill-ring-prepend-insert-and-move', +;; `browse-kill-ring-prepend-insert-move-and-quit', +;; `browse-kill-ring-append-insert-and-quit', +;; `browse-kill-ring-append-insert-and-move', +;; `browse-kill-ring-append-insert-move-and-quit'. + +;; Changes from 1.1 to 1.2: + +;; * New variable `browse-kill-ring-resize-window', which controls +;; whether or not the browse-kill-ring window will try to resize +;; itself to fit the buffer. Implementation from Juanma Barranquero +;; . +;; * New variable `browse-kill-ring-highlight-inserted-item'. +;; Implementation from Yasutaka SHINDOH . +;; * `browse-kill-ring-mouse-insert' (normally bound to mouse-2) now +;; calls `browse-kill-ring-quit'. +;; * Some non-user-visible code cleanup. +;; * New variable `browse-kill-ring-recenter', implementation from +;; René Kyllingstad . +;; * Patch from Michal Maršuka which handles +;; read-only text better. +;; * New ability to move unkilled entries back to the beginning of the +;; ring; patch from Yasutaka SHINDOH . +;; * Do nothing if the user invokes `browse-kill-ring' when we're +;; already in a *Kill Ring* buffer (initial patch from Juanma +;; Barranquero ). + +;; Changes from 1.0 to 1.1: + +;; * Important keybinding change! The default bindings of RET and 'i' +;; have switched; this means typing RET now by default inserts the +;; text and calls `browse-kill-ring-quit'; 'i' just inserts. +;; * The variable `browse-kill-ring-use-fontification' is gone; +;; browse-kill-ring.el has been rewritten to use font-lock. XEmacs +;; users who want fontification will have to do: +;; (add-hook 'browse-kill-ring-hook 'font-lock-mode) +;; * Integrated code from Michael Slass into +;; `browse-kill-ring-default-keybindings'. +;; * New Japanese homepage for browse-kill-ring.el, thanks to +;; Yasutaka SHINDOH . +;; * Correctly restore window configuration after editing an entry. +;; * New command `browse-kill-ring-insert-and-delete'. +;; * Bug reports and patches from Michael Slass and +;; Juanma Barranquero . + +;; Changes from 0.9b to 1.0: + +;; * Add autoload cookie to `browse-kill-ring'; suggestion from +;; D. Goel and Dave Pearson . +;; * Add keybinding tip from Michael Slass . + +;; Changes from 0.9a to 0.9b: + +;; * Remove extra parenthesis. Duh. + +;; Changes from 0.9 to 0.9a: + +;; * Fix bug making `browse-kill-ring-quit-action' uncustomizable. +;; Patch from Henrik Enberg . +;; * Add `url-link' and `group' attributes to main Customization +;; group. + +;; Changes from 0.8 to 0.9: + +;; * Add new function `browse-kill-ring-insert-and-quit', bound to 'i' +;; by default (idea from Yasutaka Shindoh). +;; * Make default `browse-kill-ring-quit-action' be +;; `bury-and-delete-window', which handles the case of a single window +;; more nicely. +;; * Note change of home page and author address. + +;; Changes from 0.7 to 0.8: + +;; * Fix silly bug in `browse-kill-ring-edit' which made it impossible +;; to edit entries. +;; * New variable `browse-kill-ring-quit-action'. +;; * `browse-kill-ring-restore' renamed to `browse-kill-ring-quit'. +;; * Describe the keymaps in mode documentation. Patch from +;; Marko Slyz . +;; * Fix advice documentation for `browse-kill-ring-no-duplicates'. + +;; Changes from 0.6 to 0.7: + +;; * New functions `browse-kill-ring-search-forward' and +;; `browse-kill-ring-search-backward', bound to "s" and "r" by +;; default, respectively. +;; * New function `browse-kill-ring-edit' bound to "e" by default, and +;; a associated new major mode. +;; * New function `browse-kill-ring-occur', bound to "l" by default. + +;; Changes from 0.5 to 0.6: + +;; * Fix bug in `browse-kill-ring-forward' which sometimes would cause +;; a message "Wrong type argument: overlayp, nil" to appear. +;; * New function `browse-kill-ring-update'. +;; * New variable `browse-kill-ring-highlight-current-entry'. +;; * New variable `browse-kill-ring-display-duplicates'. +;; * New optional advice `browse-kill-ring-no-kill-new-duplicates', +;; and associated variable `browse-kill-ring-no-duplicates'. Code +;; from Klaus Berndl . +;; * Bind "?" to `describe-mode'. Patch from Dave Pearson +;; . +;; * Fix typo in `browse-kill-ring-display-style' defcustom form. +;; Thanks "Kahlil (Kal) HODGSON" . + +;; Changes from 0.4 to 0.5: + +;; * New function `browse-kill-ring-delete', bound to "d" by default. +;; * New function `browse-kill-ring-undo', bound to "U" by default. +;; * New variable `browse-kill-ring-maximum-display-length'. +;; * New variable `browse-kill-ring-use-fontification'. +;; * New variable `browse-kill-ring-hook', called after the +;; "*Kill Ring*" buffer is created. + +;; Changes from 0.3 to 0.4: + +;; * New functions `browse-kill-ring-forward' and +;; `browse-kill-ring-previous', bound to "n" and "p" by default, +;; respectively. +;; * Change the default `browse-kill-ring-display-style' to +;; `separated'. +;; * Removed `browse-kill-ring-original-window-config'; Now +;; `browse-kill-ring-restore' just buries the "*Kill Ring*" buffer +;; and deletes its window, which is simpler and more intuitive. +;; * New variable `browse-kill-ring-separator-face'. + +;;; Bugs: + +;; * Sometimes, in Emacs 21, the cursor will jump to the end of an +;; entry when moving backwards using `browse-kill-ring-previous'. +;; This doesn't seem to occur in Emacs 20 or XEmacs. + +;;; Code: + +(eval-when-compile + (require 'cl) + (require 'derived)) + +(when (featurep 'xemacs) + (require 'overlay)) + +(defun browse-kill-ring-depropertize-string (str) + "Return a copy of STR with text properties removed." + (let ((str (copy-sequence str))) + (set-text-properties 0 (length str) nil str) + str)) + +(cond ((fboundp 'propertize) + (defalias 'browse-kill-ring-propertize 'propertize)) + ;; Maybe save some memory :) + ((fboundp 'ibuffer-propertize) + (defalias 'browse-kill-ring-propertize 'ibuffer-propertize)) + (t + (defun browse-kill-ring-propertize (string &rest properties) + "Return a copy of STRING with text properties added. + + [Note: this docstring has been copied from the Emacs 21 version] + +First argument is the string to copy. +Remaining arguments form a sequence of PROPERTY VALUE pairs for text +properties to add to the result." + (let ((str (copy-sequence string))) + (add-text-properties 0 (length str) + properties + str) + str)))) + +(defgroup browse-kill-ring nil + "A package for browsing and inserting the items in `kill-ring'." + :link '(url-link "http://freedom.cis.ohio-state.edu/~hurley/") + :group 'convenience) + +(defvar browse-kill-ring-display-styles + '((separated . browse-kill-ring-insert-as-separated) + (one-line . browse-kill-ring-insert-as-one-line))) + +(defcustom browse-kill-ring-display-style 'separated + "How to display the kill ring items. + +If `one-line', then replace newlines with \"\\n\" for display. + +If `separated', then display `browse-kill-ring-separator' between +entries." + :type '(choice (const :tag "One line" one-line) + (const :tag "Separated" separated)) + :group 'browse-kill-ring) + +(defcustom browse-kill-ring-quit-action 'bury-and-delete-window + "What action to take when `browse-kill-ring-quit' is called. + +If `bury-buffer', then simply bury the *Kill Ring* buffer, but keep +the window. + +If `bury-and-delete-window', then bury the buffer, and (if there is +more than one window) delete the window. This is the default. + +If `save-and-restore', then save the window configuration when +`browse-kill-ring' is called, and restore it at quit. + +If `kill-and-delete-window', then kill the *Kill Ring* buffer, and +delete the window on close. + +Otherwise, it should be a function to call." + :type '(choice (const :tag "Bury buffer" :value bury-buffer) + (const :tag "Delete window" :value delete-window) + (const :tag "Save and restore" :value save-and-restore) + (const :tag "Bury buffer and delete window" :value bury-and-delete-window) + (const :tag "Kill buffer and delete window" :value kill-and-delete-window) + function) + :group 'browse-kill-ring) + +(defcustom browse-kill-ring-resize-window nil + "Whether to resize the `browse-kill-ring' window to fit its contents. +Value is either t, meaning yes, or a cons pair of integers, + (MAXIMUM . MINIMUM) for the size of the window. MAXIMUM defaults to +the window size chosen by `pop-to-buffer'; MINIMUM defaults to +`window-min-height'." + :type '(choice (const :tag "No" nil) + (const :tag "Yes" t) + (cons (integer :tag "Maximum") (integer :tag "Minimum"))) + :group 'browse-kill-ring) + +(defcustom browse-kill-ring-separator "-------" + "The string separating entries in the `separated' style. +See `browse-kill-ring-display-style'." + :type 'string + :group 'browse-kill-ring) + +(defcustom browse-kill-ring-recenter nil + "If non-nil, then always keep the current entry at the top of the window." + :type 'boolean + :group 'browse-kill-ring) + +(defcustom browse-kill-ring-highlight-current-entry nil + "If non-nil, highlight the currently selected `kill-ring' entry." + :type 'boolean + :group 'browse-kill-ring) + +(defcustom browse-kill-ring-highlight-inserted-item browse-kill-ring-highlight-current-entry + "If non-nil, temporarily highlight the inserted `kill-ring' entry." + :type 'boolean + :group 'browse-kill-ring) + +(defcustom browse-kill-ring-separator-face 'bold + "The face in which to highlight the `browse-kill-ring-separator'." + :type 'face + :group 'browse-kill-ring) + +(defcustom browse-kill-ring-maximum-display-length nil + "Whether or not to limit the length of displayed items. + +If this variable is an integer, the display of `kill-ring' will be +limited to that many characters. +Setting this variable to nil means no limit." + :type '(choice (const :tag "None" nil) + integer) + :group 'browse-kill-ring) + +(defcustom browse-kill-ring-display-duplicates t + "If non-nil, then display duplicate items in `kill-ring'." + :type 'boolean + :group 'browse-kill-ring) + +(defadvice kill-new (around browse-kill-ring-no-kill-new-duplicates) + "An advice for not adding duplicate elements to `kill-ring'. +Even after being \"activated\", this advice will only modify the +behavior of `kill-new' when `browse-kill-ring-no-duplicates' +is non-nil." + (if browse-kill-ring-no-duplicates + (setq kill-ring (delete (ad-get-arg 0) kill-ring))) + ad-do-it) + +(defcustom browse-kill-ring-no-duplicates nil + "If non-nil, then the `b-k-r-no-kill-new-duplicates' advice will operate. +This means that duplicate entries won't be added to the `kill-ring' +when you call `kill-new'. + +If you set this variable via customize, the advice will be activated +or deactivated automatically. Otherwise, to enable the advice, add + + (ad-enable-advice 'kill-new 'around 'browse-kill-ring-no-kill-new-duplicates) + (ad-activate 'kill-new) + +to your init file." + :type 'boolean + :set (lambda (symbol value) + (set symbol value) + (if value + (ad-enable-advice 'kill-new 'around + 'browse-kill-ring-no-kill-new-duplicates) + (ad-disable-advice 'kill-new 'around + 'browse-kill-ring-no-kill-new-duplicates)) + (ad-activate 'kill-new)) + :group 'browse-kill-ring) + +(defcustom browse-kill-ring-depropertize nil + "If non-nil, remove text properties from `kill-ring' items. +This only changes the items for display and insertion from +`browse-kill-ring'; if you call `yank' directly, the items will be +inserted with properties." + :type 'boolean + :group 'browse-kill-ring) + +(defcustom browse-kill-ring-hook nil + "A list of functions to call after `browse-kill-ring'." + :type 'hook + :group 'browse-kill-ring) + +(defvar browse-kill-ring-original-window-config nil + "The window configuration to restore for `browse-kill-ring-quit'.") +(make-variable-buffer-local 'browse-kill-ring-original-window-config) + +(defvar browse-kill-ring-original-window nil + "The window in which chosen kill ring data will be inserted. +It is probably not a good idea to set this variable directly; simply +call `browse-kill-ring' again.") + +(defun browse-kill-ring-mouse-insert (e) + "Insert the chosen text, and close the *Kill Ring* buffer afterwards." + (interactive "e") + (let* ((data (save-excursion + (mouse-set-point e) + (cons (current-buffer) (point)))) + (buf (car data)) + (pt (cdr data))) + (browse-kill-ring-do-insert buf pt)) + (browse-kill-ring-quit)) + +(if (fboundp 'fit-window-to-buffer) + (defalias 'browse-kill-ring-fit-window 'fit-window-to-buffer) + (defun browse-kill-ring-fit-window (window max-height min-height) + (setq min-height (or min-height window-min-height)) + (setq max-height (or max-height (- (frame-height) (window-height) 1))) + (let* ((window-min-height min-height) + (windows (count-windows)) + (config (current-window-configuration))) + (enlarge-window (- max-height (window-height))) + (when (> windows (count-windows)) + (set-window-configuration config)) + (if (/= (point-min) (point-max)) + (shrink-window-if-larger-than-buffer window) + (shrink-window (- (window-height) window-min-height)))))) + +(defun browse-kill-ring-resize-window () + (when browse-kill-ring-resize-window + (apply #'browse-kill-ring-fit-window (selected-window) + (if (consp browse-kill-ring-resize-window) + (list (car browse-kill-ring-resize-window) + (or (cdr browse-kill-ring-resize-window) + window-min-height)) + (list nil window-min-height))))) + +(defun browse-kill-ring-undo-other-window () + "Undo the most recent change in the other window's buffer. +You most likely want to use this command for undoing an insertion of +yanked text from the *Kill Ring* buffer." + (interactive) + (with-current-buffer (window-buffer browse-kill-ring-original-window) + (undo))) + +(defun browse-kill-ring-insert (&optional quit) + "Insert the kill ring item at point into the last selected buffer. +If optional argument QUIT is non-nil, close the *Kill Ring* buffer as +well." + (interactive "P") + (browse-kill-ring-do-insert (current-buffer) + (point)) + (when quit + (browse-kill-ring-quit))) + +(defun browse-kill-ring-insert-and-delete (&optional quit) + "Insert the kill ring item at point, and remove it from the kill ring. +If optional argument QUIT is non-nil, close the *Kill Ring* buffer as +well." + (interactive "P") + (browse-kill-ring-do-insert (current-buffer) + (point)) + (browse-kill-ring-delete) + (when quit + (browse-kill-ring-quit))) + +(defun browse-kill-ring-insert-and-quit () + "Like `browse-kill-ring-insert', but close the *Kill Ring* buffer afterwards." + (interactive) + (browse-kill-ring-insert t)) + +(defun browse-kill-ring-insert-and-move (&optional quit) + "Like `browse-kill-ring-insert', but move the entry to the front." + (interactive "P") + (let ((buf (current-buffer)) + (pt (point))) + (browse-kill-ring-do-insert buf pt) + (let ((str (browse-kill-ring-current-string buf pt))) + (browse-kill-ring-delete) + (kill-new str))) + (if quit + (browse-kill-ring-quit) + (browse-kill-ring-update))) + +(defun browse-kill-ring-insert-move-and-quit () + "Like `browse-kill-ring-insert-and-move', but close the *Kill Ring* buffer." + (interactive) + (browse-kill-ring-insert-and-move t)) + +(defun browse-kill-ring-prepend-insert (&optional quit) + "Like `browse-kill-ring-insert', but it places the entry at the beginning +of the buffer as opposed to point." + (interactive "P") + (browse-kill-ring-do-prepend-insert (current-buffer) + (point)) + (when quit + (browse-kill-ring-quit))) + +(defun browse-kill-ring-prepend-insert-and-quit () + "Like `browse-kill-ring-prepend-insert', but close the *Kill Ring* buffer." + (interactive) + (browse-kill-ring-prepend-insert t)) + +(defun browse-kill-ring-prepend-insert-and-move (&optional quit) + "Like `browse-kill-ring-prepend-insert', but move the entry to the front +of the *Kill Ring*." + (interactive "P") + (let ((buf (current-buffer)) + (pt (point))) + (browse-kill-ring-do-prepend-insert buf pt) + (let ((str (browse-kill-ring-current-string buf pt))) + (browse-kill-ring-delete) + (kill-new str))) + (if quit + (browse-kill-ring-quit) + (browse-kill-ring-update))) + +(defun browse-kill-ring-prepend-insert-move-and-quit () + "Like `browse-kill-ring-prepend-insert-and-move', but close the +*Kill Ring* buffer." + (interactive) + (browse-kill-ring-prepend-insert-and-move t)) + +(defun browse-kill-ring-do-prepend-insert (buf pt) + (let ((str (browse-kill-ring-current-string buf pt))) + (let ((orig (current-buffer))) + (unwind-protect + (progn + (unless (window-live-p browse-kill-ring-original-window) + (error "Window %s has been deleted; Try calling `browse-kill-ring' again" + browse-kill-ring-original-window)) + (set-buffer (window-buffer browse-kill-ring-original-window)) + (save-excursion + (let ((pt (point))) + (goto-char (point-min)) + (insert (if browse-kill-ring-depropertize + (browse-kill-ring-depropertize-string str) + str)) + (when browse-kill-ring-highlight-inserted-item + (let ((o (make-overlay (point-min) (point)))) + (overlay-put o 'face 'highlight) + (sit-for 0.5) + (delete-overlay o))) + (goto-char pt)))) + (set-buffer orig))))) + +(defun browse-kill-ring-append-insert (&optional quit) + "Like `browse-kill-ring-insert', but places the entry at the end of the +buffer as opposed to point." + (interactive "P") + (browse-kill-ring-do-append-insert (current-buffer) + (point)) + (when quit + (browse-kill-ring-quit))) + +(defun browse-kill-ring-append-insert-and-quit () + "Like `browse-kill-ring-append-insert', but close the *Kill Ring* buffer." + (interactive) + (browse-kill-ring-append-insert t)) + +(defun browse-kill-ring-append-insert-and-move (&optional quit) + "Like `browse-kill-ring-append-insert', but move the entry to the front +of the *Kill Ring*." + (interactive "P") + (let ((buf (current-buffer)) + (pt (point))) + (browse-kill-ring-do-append-insert buf pt) + (let ((str (browse-kill-ring-current-string buf pt))) + (browse-kill-ring-delete) + (kill-new str))) + (if quit + (browse-kill-ring-quit) + (browse-kill-ring-update))) + +(defun browse-kill-ring-append-insert-move-and-quit () + "Like `browse-kill-ring-append-insert-and-move', but close the +*Kill Ring* buffer." + (interactive) + (browse-kill-ring-append-insert-and-move t)) + +(defun browse-kill-ring-do-append-insert (buf pt) + (let ((str (browse-kill-ring-current-string buf pt))) + (let ((orig (current-buffer))) + (unwind-protect + (progn + (unless (window-live-p browse-kill-ring-original-window) + (error "Window %s has been deleted; Try calling `browse-kill-ring' again" + browse-kill-ring-original-window)) + (set-buffer (window-buffer browse-kill-ring-original-window)) + (save-excursion + (let ((pt (point)) + (begin-pt (point-max))) + (goto-char begin-pt) + (insert (if browse-kill-ring-depropertize + (browse-kill-ring-depropertize-string str) + str)) + (when browse-kill-ring-highlight-inserted-item + (let ((o (make-overlay begin-pt (point-max)))) + (overlay-put o 'face 'highlight) + (sit-for 0.5) + (delete-overlay o))) + (goto-char pt)))) + (set-buffer orig))))) + +(defun browse-kill-ring-delete () + "Remove the item at point from the `kill-ring'." + (interactive) + (let ((over (car (overlays-at (point))))) + (unless (overlayp over) + (error "No kill ring item here")) + (unwind-protect + (progn + (setq buffer-read-only nil) + (let ((target (overlay-get over 'browse-kill-ring-target))) + (delete-region (overlay-start over) + (1+ (overlay-end over))) + (setq kill-ring (delete target kill-ring))) + (when (get-text-property (point) 'browse-kill-ring-extra) + (let ((prev (previous-single-property-change (point) + 'browse-kill-ring-extra)) + (next (next-single-property-change (point) + 'browse-kill-ring-extra))) + ;; This is some voodoo. + (when prev + (incf prev)) + (when next + (incf next)) + (delete-region (or prev (point-min)) + (or next (point-max)))))) + (setq buffer-read-only t))) + (browse-kill-ring-resize-window) + (browse-kill-ring-forward 0)) + +(defun browse-kill-ring-current-string (buf pt) + (with-current-buffer buf + (let ((overs (overlays-at pt))) + (or (and overs + (overlay-get (car overs) 'browse-kill-ring-target)) + (error "No kill ring item here"))))) + +(defun browse-kill-ring-do-insert (buf pt) + (let ((str (browse-kill-ring-current-string buf pt))) + (let ((orig (current-buffer))) + (unwind-protect + (progn + (unless (window-live-p browse-kill-ring-original-window) + (error "Window %s has been deleted; Try calling `browse-kill-ring' again" + browse-kill-ring-original-window)) + (set-buffer (window-buffer browse-kill-ring-original-window)) + (save-excursion + (let ((pt (point))) + (insert (if browse-kill-ring-depropertize + (browse-kill-ring-depropertize-string str) + str)) + (when browse-kill-ring-highlight-inserted-item + (let ((o (make-overlay pt (point)))) + (overlay-put o 'face 'highlight) + (sit-for 0.5) + (delete-overlay o)))))) + (set-buffer orig))))) + +(defun browse-kill-ring-forward (&optional arg) + "Move forward by ARG `kill-ring' entries." + (interactive "p") + (beginning-of-line) + (while (not (zerop arg)) + (if (< arg 0) + (progn + (incf arg) + (if (overlays-at (point)) + (progn + (goto-char (overlay-start (car (overlays-at (point))))) + (goto-char (previous-overlay-change (point))) + (goto-char (previous-overlay-change (point)))) + (progn + (goto-char (1- (previous-overlay-change (point)))) + (unless (bobp) + (goto-char (overlay-start (car (overlays-at (point))))))))) + (progn + (decf arg) + (if (overlays-at (point)) + (progn + (goto-char (overlay-end (car (overlays-at (point))))) + (goto-char (next-overlay-change (point)))) + (goto-char (next-overlay-change (point))) + (unless (eobp) + (goto-char (overlay-start (car (overlays-at (point)))))))))) + ;; This could probably be implemented in a more intelligent manner. + ;; Perhaps keep track over the overlay we started from? That would + ;; break when the user moved manually, though. + (when (and browse-kill-ring-highlight-current-entry + (overlays-at (point))) + (let ((overs (overlay-lists)) + (current-overlay (car (overlays-at (point))))) + (mapcar #'(lambda (o) + (overlay-put o 'face nil)) + (nconc (car overs) (cdr overs))) + (overlay-put current-overlay 'face 'highlight))) + (when browse-kill-ring-recenter + (recenter 1))) + +(defun browse-kill-ring-previous (&optional arg) + "Move backward by ARG `kill-ring' entries." + (interactive "p") + (browse-kill-ring-forward (- arg))) + +(defun browse-kill-ring-read-regexp (msg) + (let* ((default (car regexp-history)) + (input + (read-from-minibuffer + (if default + (format "%s for regexp (default `%s'): " + msg + default) + (format "%s (regexp): " msg)) + nil + nil + nil + 'regexp-history))) + (if (equal input "") + default + input))) + +(defun browse-kill-ring-search-forward (regexp &optional backwards) + "Move to the next `kill-ring' entry matching REGEXP from point. +If optional arg BACKWARDS is non-nil, move to the previous matching +entry." + (interactive + (list (browse-kill-ring-read-regexp "Search forward") + current-prefix-arg)) + (let ((orig (point))) + (browse-kill-ring-forward (if backwards -1 1)) + (let ((overs (overlays-at (point)))) + (while (and overs + (not (if backwards (bobp) (eobp))) + (not (string-match regexp + (overlay-get (car overs) + 'browse-kill-ring-target)))) + (browse-kill-ring-forward (if backwards -1 1)) + (setq overs (overlays-at (point)))) + (unless (and overs + (string-match regexp + (overlay-get (car overs) + 'browse-kill-ring-target))) + (progn + (goto-char orig) + (message "No more `kill-ring' entries matching %s" regexp)))))) + +(defun browse-kill-ring-search-backward (regexp) + "Move to the previous `kill-ring' entry matching REGEXP from point." + (interactive + (list (browse-kill-ring-read-regexp "Search backward"))) + (browse-kill-ring-search-forward regexp t)) + +(defun browse-kill-ring-quit () + "Take the action specified by `browse-kill-ring-quit-action'." + (interactive) + (case browse-kill-ring-quit-action + (save-and-restore + (let (buf (current-buffer)) + (set-window-configuration browse-kill-ring-original-window-config) + (kill-buffer buf))) + (kill-and-delete-window + (kill-buffer (current-buffer)) + (unless (= (count-windows) 1) + (delete-window))) + (bury-and-delete-window + (bury-buffer) + (unless (= (count-windows) 1) + (delete-window))) + (t + (funcall browse-kill-ring-quit-action)))) + +(put 'browse-kill-ring-mode 'mode-class 'special) +(define-derived-mode browse-kill-ring-mode fundamental-mode + "Kill Ring" + "A major mode for browsing the `kill-ring'. +You most likely do not want to call `browse-kill-ring-mode' directly; use +`browse-kill-ring' instead. + +\\{browse-kill-ring-mode-map}" + (set (make-local-variable 'font-lock-defaults) + '(nil t nil nil nil + (font-lock-fontify-region-function . browse-kill-ring-fontify-region))) + (define-key browse-kill-ring-mode-map (kbd "q") 'browse-kill-ring-quit) + (define-key browse-kill-ring-mode-map (kbd "U") 'browse-kill-ring-undo-other-window) + (define-key browse-kill-ring-mode-map (kbd "d") 'browse-kill-ring-delete) + (define-key browse-kill-ring-mode-map (kbd "s") 'browse-kill-ring-search-forward) + (define-key browse-kill-ring-mode-map (kbd "r") 'browse-kill-ring-search-backward) + (define-key browse-kill-ring-mode-map (kbd "g") 'browse-kill-ring-update) + (define-key browse-kill-ring-mode-map (kbd "l") 'browse-kill-ring-occur) + (define-key browse-kill-ring-mode-map (kbd "e") 'browse-kill-ring-edit) + (define-key browse-kill-ring-mode-map (kbd "n") 'browse-kill-ring-forward) + (define-key browse-kill-ring-mode-map (kbd "p") 'browse-kill-ring-previous) + (define-key browse-kill-ring-mode-map [(mouse-2)] 'browse-kill-ring-mouse-insert) + (define-key browse-kill-ring-mode-map (kbd "?") 'describe-mode) + (define-key browse-kill-ring-mode-map (kbd "h") 'describe-mode) + (define-key browse-kill-ring-mode-map (kbd "y") 'browse-kill-ring-insert) + (define-key browse-kill-ring-mode-map (kbd "u") 'browse-kill-ring-insert-move-and-quit) + (define-key browse-kill-ring-mode-map (kbd "i") 'browse-kill-ring-insert) + (define-key browse-kill-ring-mode-map (kbd "o") 'browse-kill-ring-insert-and-move) + (define-key browse-kill-ring-mode-map (kbd "x") 'browse-kill-ring-insert-and-delete) + (define-key browse-kill-ring-mode-map (kbd "RET") 'browse-kill-ring-insert-and-quit) + (define-key browse-kill-ring-mode-map (kbd "b") 'browse-kill-ring-prepend-insert) + (define-key browse-kill-ring-mode-map (kbd "a") 'browse-kill-ring-append-insert)) + +;;;###autoload +(defun browse-kill-ring-default-keybindings () + "Set up M-y (`yank-pop') so that it can invoke `browse-kill-ring'. +Normally, if M-y was not preceeded by C-y, then it has no useful +behavior. This function sets things up so that M-y will invoke +`browse-kill-ring'." + (interactive) + (defadvice yank-pop (around kill-ring-browse-maybe (arg)) + "If last action was not a yank, run `browse-kill-ring' instead." + ;; yank-pop has an (interactive "*p") form which does not allow + ;; it to run in a read-only buffer. We want browse-kill-ring to + ;; be allowed to run in a read only buffer, so we change the + ;; interactive form here. In that case, we need to + ;; barf-if-buffer-read-only if we're going to call yank-pop with + ;; ad-do-it + (interactive "p") + (if (not (eq last-command 'yank)) + (browse-kill-ring) + (barf-if-buffer-read-only) + ad-do-it)) + (ad-activate 'yank-pop)) + +(define-derived-mode browse-kill-ring-edit-mode fundamental-mode + "Kill Ring Edit" + "A major mode for editing a `kill-ring' entry. +You most likely do not want to call `browse-kill-ring-edit-mode' +directly; use `browse-kill-ring' instead. + +\\{browse-kill-ring-edit-mode-map}" + (define-key browse-kill-ring-edit-mode-map (kbd "C-c C-c") + 'browse-kill-ring-edit-finish)) + +(defvar browse-kill-ring-edit-target nil) +(make-variable-buffer-local 'browse-kill-ring-edit-target) + +(defun browse-kill-ring-edit () + "Edit the `kill-ring' entry at point." + (interactive) + (let ((overs (overlays-at (point)))) + (unless overs + (error "No kill ring entry here")) + (let* ((target (overlay-get (car overs) + 'browse-kill-ring-target)) + (target-cell (member target kill-ring))) + (unless target-cell + (error "Item deleted from the kill-ring")) + (switch-to-buffer (get-buffer-create "*Kill Ring Edit*")) + (setq buffer-read-only nil) + (erase-buffer) + (insert target) + (goto-char (point-min)) + (browse-kill-ring-resize-window) + (browse-kill-ring-edit-mode) + (message "%s" + (substitute-command-keys + "Use \\[browse-kill-ring-edit-finish] to finish editing.")) + (setq browse-kill-ring-edit-target target-cell)))) + +(defun browse-kill-ring-edit-finish () + "Commit the changes to the `kill-ring'." + (interactive) + (if browse-kill-ring-edit-target + (setcar browse-kill-ring-edit-target (buffer-string)) + (when (y-or-n-p "The item has been deleted; add to front? ") + (push (buffer-string) kill-ring))) + (bury-buffer) + ;; The user might have rearranged the windows + (when (eq major-mode 'browse-kill-ring-mode) + (browse-kill-ring-setup (current-buffer) + browse-kill-ring-original-window + nil + browse-kill-ring-original-window-config) + (browse-kill-ring-resize-window))) + +(defmacro browse-kill-ring-add-overlays-for (item &rest body) + (let ((beg (gensym "browse-kill-ring-add-overlays-")) + (end (gensym "browse-kill-ring-add-overlays-"))) + `(let ((,beg (point)) + (,end + (progn + ,@body + (point)))) + (let ((o (make-overlay ,beg ,end))) + (overlay-put o 'browse-kill-ring-target ,item) + (overlay-put o 'mouse-face 'highlight))))) +;; (put 'browse-kill-ring-add-overlays-for 'lisp-indent-function 1) + +(defun browse-kill-ring-elide (str) + (if (and browse-kill-ring-maximum-display-length + (> (length str) + browse-kill-ring-maximum-display-length)) + (concat (substring str 0 (- browse-kill-ring-maximum-display-length 3)) + (browse-kill-ring-propertize "..." 'browse-kill-ring-extra t)) + str)) + +(defun browse-kill-ring-insert-as-one-line (items) + (dolist (item items) + (browse-kill-ring-add-overlays-for item + (let* ((item (browse-kill-ring-elide item)) + (len (length item)) + (start 0) + (newl (browse-kill-ring-propertize "\\n" 'browse-kill-ring-extra t))) + (while (and (< start len) + (string-match "\n" item start)) + (insert (substring item start (match-beginning 0)) + newl) + (setq start (match-end 0))) + (insert (substring item start len)))) + (insert "\n"))) + +(defun browse-kill-ring-insert-as-separated (items) + (while (cdr items) + (browse-kill-ring-insert-as-separated-1 (car items) t) + (setq items (cdr items))) + (when items + (browse-kill-ring-insert-as-separated-1 (car items) nil))) + +(defun browse-kill-ring-insert-as-separated-1 (origitem separatep) + (let* ((item (browse-kill-ring-elide origitem)) + (len (length item))) + (browse-kill-ring-add-overlays-for origitem + (insert item)) + ;; When the kill-ring has items with read-only text property at + ;; **the end of** string, browse-kill-ring-setup fails with error + ;; `Text is read-only'. So inhibit-read-only here. + ;; See http://bugs.debian.org/225082 + ;; - INOUE Hiroyuki + (let ((inhibit-read-only t)) + (insert "\n") + (when separatep + (insert (browse-kill-ring-propertize browse-kill-ring-separator + 'browse-kill-ring-extra t + 'browse-kill-ring-separator t)) + (insert "\n"))))) + +(defun browse-kill-ring-occur (regexp) + "Display all `kill-ring' entries matching REGEXP." + (interactive + (list + (browse-kill-ring-read-regexp "Display kill ring entries matching"))) + (assert (eq major-mode 'browse-kill-ring-mode)) + (browse-kill-ring-setup (current-buffer) + browse-kill-ring-original-window + regexp) + (browse-kill-ring-resize-window)) + +(defun browse-kill-ring-fontify-on-property (prop face beg end) + (save-excursion + (goto-char beg) + (let ((prop-end nil)) + (while + (setq prop-end + (let ((prop-beg (or (and (get-text-property (point) prop) (point)) + (next-single-property-change (point) prop nil end)))) + (when (and prop-beg (not (= prop-beg end))) + (let ((prop-end (next-single-property-change prop-beg prop nil end))) + (when (and prop-end (not (= prop-end end))) + (put-text-property prop-beg prop-end 'face face) + prop-end))))) + (goto-char prop-end))))) + +(defun browse-kill-ring-fontify-region (beg end &optional verbose) + (when verbose (message "Fontifying...")) + (let ((buffer-read-only nil)) + (browse-kill-ring-fontify-on-property 'browse-kill-ring-extra 'bold beg end) + (browse-kill-ring-fontify-on-property 'browse-kill-ring-separator + browse-kill-ring-separator-face beg end)) + (when verbose (message "Fontifying...done"))) + +(defun browse-kill-ring-update () + "Update the buffer to reflect outside changes to `kill-ring'." + (interactive) + (assert (eq major-mode 'browse-kill-ring-mode)) + (browse-kill-ring-setup (current-buffer) + browse-kill-ring-original-window) + (browse-kill-ring-resize-window)) + +(defun browse-kill-ring-setup (buf window &optional regexp window-config) + (with-current-buffer buf + (unwind-protect + (progn + (browse-kill-ring-mode) + (setq buffer-read-only nil) + (when (eq browse-kill-ring-display-style + 'one-line) + (setq truncate-lines t)) + (let ((inhibit-read-only t)) + (erase-buffer)) + (setq browse-kill-ring-original-window window + browse-kill-ring-original-window-config + (or window-config + (current-window-configuration))) + (let ((browse-kill-ring-maximum-display-length + (if (and browse-kill-ring-maximum-display-length + (<= browse-kill-ring-maximum-display-length 3)) + 4 + browse-kill-ring-maximum-display-length)) + (items (mapcar + (if browse-kill-ring-depropertize + #'browse-kill-ring-depropertize-string + #'copy-sequence) + kill-ring))) + (when (not browse-kill-ring-display-duplicates) + ;; I'm not going to rewrite `delete-duplicates'. If + ;; someone really wants to rewrite it here, send me a + ;; patch. + (require 'cl) + (setq items (delete-duplicates items :test #'equal))) + (when (stringp regexp) + (setq items (delq nil + (mapcar + #'(lambda (item) + (when (string-match regexp item) + item)) + items)))) + (funcall (or (cdr (assq browse-kill-ring-display-style + browse-kill-ring-display-styles)) + (error "Invalid `browse-kill-ring-display-style': %s" + browse-kill-ring-display-style)) + items) +;; Code from Michael Slass + (message + (let ((entry (if (= 1 (length kill-ring)) "entry" "entries"))) + (concat + (if (and (not regexp) + browse-kill-ring-display-duplicates) + (format "%s %s in the kill ring." + (length kill-ring) entry) + (format "%s (of %s) %s in the kill ring shown." + (length items) (length kill-ring) entry)) + (substitute-command-keys + (concat " Type \\[browse-kill-ring-quit] to quit. " + "\\[describe-mode] for help."))))) +;; End code from Michael Slass + (set-buffer-modified-p nil) + (goto-char (point-min)) + (browse-kill-ring-forward 0) + (when regexp + (setq mode-name (concat "Kill Ring [" regexp "]"))) + (run-hooks 'browse-kill-ring-hook) + ;; I will be very glad when I can get rid of this gross + ;; hack, which solely exists for XEmacs users. + (when (and (featurep 'xemacs) + font-lock-mode) + (browse-kill-ring-fontify-region (point-min) (point-max))))) + (progn + (setq buffer-read-only t))))) + +;;;###autoload +(defun browse-kill-ring () + "Display items in the `kill-ring' in another buffer." + (interactive) + (if (eq major-mode 'browse-kill-ring-mode) + (message "Already viewing the kill ring") + (let ((orig-buf (current-buffer)) + (buf (get-buffer-create "*Kill Ring*"))) + (browse-kill-ring-setup buf (selected-window)) + (pop-to-buffer buf) + (browse-kill-ring-resize-window) + nil))) + +(provide 'browse-kill-ring) + +;;; browse-kill-ring.el ends here diff --git a/emacs.d/lisp/dir-locals.el b/emacs.d/lisp/dir-locals.el new file mode 100644 index 0000000..f88457b --- /dev/null +++ b/emacs.d/lisp/dir-locals.el @@ -0,0 +1,183 @@ +;;; dir-locals.el --- Local variables for a directory tree + +;; Copyright (C) 2005, 2006 Free Software Foundation, Inc. + +;; Author: Dave Love +;; Keywords: files +;; $Revision: 1.7 $ +;; URL: http://www.loveshack.ukfsn.org/emacs + +;; This file is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 2, or (at your option) +;; any later version. + +;; This file is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs; see the file COPYING. If not, write to +;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330, +;; Boston, MA 02111-1307, USA. + +;;; Commentary: + +;; It can be useful to specify local variables directory-wide, e.g. to +;; define CC mode styles consistently. This library implements such a +;; scheme, controlled by the global minor mode `dir-locals-mode'. + +;; Place a file named `.emacs-locals' (or the value of +;; `dir-locals-file-name') in the directory root. This should specify +;; local variables in the usual way. The values it sets are inherited +;; when a file in the directory tree is found. Local variables +;; specified in the found file override the directory-wide ones. + +;; However, `eval' pseudo-variables specified in the file are +;; evaluated (assuming `enable-local-eval' is true) _before_ any +;; directory-wide processing, and they are evaluated in a scratch +;; buffer, so that they are only useful for side effects on local +;; variables. `mode' pseudo-variables which specify minor modes +;; toggle those modes for files within the directory. If +;; .emacs-locals specifies a major mode, it doesn't propagate, but any +;; local variables and minor modes its hook sets will; thus it should +;; normally not specify a major mode. The `coding' pseudo-variable +;; will not propagate from .emacs-locals. + +;; For example, with dir-locals mode on, placing this in .emacs-locals +;; at the top-level of the Linux source tree would set the C +;; indentation style appropriately for files within the tree: +;; +;; Local variables: +;; c-file-style: "linux" +;; End: +;; +;; (and ignore the stupid remarks in Documentation/CodingStyle). + +;; Another possible use is, say, setting change-log parameters in +;; different trees for which the Emacs 22 development source broke use +;; of change-log-mode-hook. + +;; NB: This doesn't work with some versions of the Emacs 22 codebase +;; which changed the way hack-local-variables-hook is run, but the +;; change has been reverted. + +;; Another, less clean, implementation of this sort of thing was +;; posted to gnu-emacs-sources as dirvals.el by Benjamin Rutt +;; , June 2006, based on work by Matt Armstrong +;; . It uses a different format for the equivalent +;; of .emacs-locals. + +;;; Code: + +(defgroup dir-locals () + "Directory-wide file-local variables" + :link '(emacs-commentary-link "dir-locals") + :group 'files) + +(defcustom dir-locals-file-name ".emacs-locals" + "File name used by Dir-Locals mode to specify local variables. +This should specify local variables in the normal way. When Dir-Locals +minor mode is active, these will be inherited by files found in a +directory tree containing such a file at its root. + +This may also be a function of no arguments which returns the name to +use, allowing arbitrary per-directory customization of the +per-directory customization file on the basis of `default-directory'." + :group 'dir-locals + :type '(choice file function)) + +;; Adapted from dirvals.el. +(defcustom dir-locals-chase-remote nil + "Non-nil means search upwards for `dir-locals-file-name' in remote filesystem." + :group 'dir-locals + :type 'boolean) + +(define-minor-mode dir-locals-mode + "Toggle use of directory-wide file-local variables. +See `dir-locals-file-name'." + :global t + (if dir-locals-mode + (add-hook 'hack-local-variables-hook 'dir-locals-hack-local-variables) + (remove-hook 'hack-local-variables-hook + 'dir-locals-hack-local-variables))) + +;; Following find-change-log. Fixme: Should be abstracted from there. +(defun dir-locals-tree-find (file) + "Find FILE in the current directory or one of its parents. +If one is found, return its fully-qualified name, otherwise return +nil. + +FILE may be a string or a nullary function returning one on the basis +of `default-directory'." + (unless (and (not dir-locals-chase-remote) + (fboundp 'file-remote-p) ; not in Emacs 21 + (file-remote-p default-directory)) + (let* ((dir-name + ;; Chase links in the source file and start searching in + ;; the dir where it resides. + (or (if buffer-file-name + (file-name-directory (file-chase-links buffer-file-name))) + default-directory)) + (file (if (functionp file) + (funcall file) + file)) + (file1 (if (file-directory-p dir-name) + (expand-file-name file dir-name)))) + ;; Chase links before visiting the file. This makes it easier + ;; to use a file for several related directories. + (setq file1 (expand-file-name (file-chase-links file1))) + ;; Move up in the dir hierarchy till we find a suitable file. + (while (and (not (file-exists-p file1)) + (setq dir-name (file-name-directory + (directory-file-name + (file-name-directory file1)))) + ;; Give up if we are already at the root dir. + (not (string= (file-name-directory file1) dir-name))) + ;; Move up to the parent dir and try again. + (setq file1 (expand-file-name (file-name-nondirectory file) dir-name))) + (if (file-exists-p file1) + file1)))) + +(defun dir-locals-hack-local-variables () + "Set local variables from directory-wide values. +Inherit the local variables set in `dir-locals-file-name' if that is +found by `dir-locals-tree-find'. Ignore everything ignored by +`hack-local-variables'." + (let* ((file (dir-locals-tree-find dir-locals-file-name)) + (hack-local-variables-hook nil) + (buffer-file + (if buffer-file-name + (expand-file-name (file-chase-links buffer-file-name)))) + ;; Fixme: Probably condition-case this and ensure any error + ;; messages indicate the directory file. + (vars (when (and file + ;; Don't do it twice, so as to avoid + ;; repeating possible interactive queries. + (not (equal file buffer-file))) + (with-temp-buffer + ;; Make queries from `hack-local-variables' clearer. + (rename-buffer (file-name-nondirectory file) t) + (insert-file-contents file) + (let* ((locals (buffer-local-variables)) + (_ (hack-local-variables)) + (new-locals (buffer-local-variables))) + ;; Derive the list of new pairs. + (dolist (l locals) + (setq new-locals (delete l new-locals))) + ;; And some internals which get updated. + (dolist (l '(buffer-display-time buffer-display-count)) + (setq new-locals (assq-delete-all l new-locals))) + new-locals))))) + (dolist (v vars) + (let ((sym (car v))) + (unless (local-variable-p sym) ; file-locals take precedence + (if (and (string-match "-mode\\'" (symbol-name sym)) + (fboundp sym)) + (funcall sym) + (set (make-local-variable sym) (cdr v)))))))) + +(provide 'dir-locals) + +;;; dir-locals.el ends here diff --git a/emacs.d/lisp/sml-modeline.el b/emacs.d/lisp/sml-modeline.el new file mode 100644 index 0000000..882d184 --- /dev/null +++ b/emacs.d/lisp/sml-modeline.el @@ -0,0 +1,192 @@ +;;; sml-modeline.el --- Show position in a scrollbar like way in mode-line +;; +;; Author: Lennart Borgman (lennart O borgman A gmail O com) +;; Created: 2010-03-16 Tue +;; Version: 0.5 +;; Last-Updated: 2010-03-18 Thu +;; URL: http://bazaar.launchpad.net/~nxhtml/nxhtml/main/annotate/head%3A/util/sml-modeline.el +;; Keywords: +;; Compatibility: +;; +;; Features that might be required by this library: +;; +;; None +;; +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; +;;; Commentary: +;; +;; Show scrollbar like position indicator in mode line. +;; See the global minor mode `sml-modeline-mode' for more information. +;; +;; Idea and part of this code is adapted from David Engster's and Drew +;; Adam's code in these mail messages: +;; +;; http://lists.gnu.org/archive/html/emacs-devel/2010-03/msg00523.html +;; http://permalink.gmane.org/gmane.emacs.devel/122038 +;; +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; +;;; Change log: +;; +;; +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; +;; This program is free software; you can redistribute it and/or +;; modify it under the terms of the GNU General Public License as +;; published by the Free Software Foundation; either version 3, or +;; (at your option) any later version. +;; +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +;; General Public License for more details. +;; +;; You should have received a copy of the GNU General Public License +;; along with this program; see the file COPYING. If not, write to +;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth +;; Floor, Boston, MA 02110-1301, USA. +;; +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; +;;; Code: + +;;;###autoload +(defgroup sml-modeline nil + "Customization group for `sml-modeline-mode'." + :group 'frames) + +(defun sml-modeline-refresh () + "Refresh after option changes if loaded." + (when (featurep 'sml-modeline) + (when (and (boundp 'sml-modeline-mode) + sml-modeline-mode) + (sml-modeline-mode -1) + (sml-modeline-mode 1)))) + +(defcustom sml-modeline-len 12 + "Mode line indicator total length." + :type 'integer + :set (lambda (sym val) + (set-default sym val) + (sml-modeline-refresh)) + :group 'sml-modeline) + +(defcustom sml-modeline-borders nil + "Indicator borders. +This is a pair of indicators, like [] or nil." + :type '(choice (const :tag "None" nil) + (cons (string :tag "Left border") + (string :tag "Right border"))) + :set (lambda (sym val) + (set-default sym val) + (sml-modeline-refresh)) + :group 'sml-modeline) + +(defcustom sml-modeline-numbers 'percentage + "Position number style. +This can be 'percentage or 'line-number." + :type '(choice (const :tag "Line numbers" line-numbers) + (const :tag "Percentage" percentage)) + :set (lambda (sym val) + (set-default sym val) + (sml-modeline-refresh)) + :group 'sml-modeline) + +(defface sml-modeline-end-face + '((t (:inherit match))) + "Face for invisible buffer parts." + :group 'sml-modeline) +;; 'face `(:background ,(face-foreground 'mode-line-inactive) +;; :foreground ,(face-background 'mode-line)) + +(defface sml-modeline-vis-face + '((t (:inherit region))) + "Face for invisible buffer parts." + :group 'sml-modeline) +;; 'face `(:background ,(face-foreground 'mode-line) +;; :foreground ,(face-background 'mode-line)) + +;;(sml-modeline-create) +(defun sml-modeline-create () + (let* ((wstart (window-start)) + (wend (window-end)) + number-max number-beg number-end + (sml-begin (or (car sml-modeline-borders) "")) + (sml-end (or (cdr sml-modeline-borders) "")) + (inner-len (- sml-modeline-len (length sml-begin) (length sml-end))) + bpad-len epad-len + pos-% + start end + string) + (if (not (or (< wend (save-restriction (widen) (point-max))) + (> wstart 1))) + "" + (cond + ((eq sml-modeline-numbers 'percentage) + (setq number-max (save-restriction (widen) (point-max))) + (setq number-beg (/ (float wstart) (float number-max))) + (setq number-end (/ (float wend) (float number-max))) + (setq start (floor (* number-beg inner-len))) + (setq end (floor (* number-end inner-len))) + (setq string + (concat (format "%02d" (round (* number-beg 100))) + "-" + (format "%02d" (round (* number-end 100))) "%%"))) + ((eq sml-modeline-numbers 'line-numbers) + (save-restriction + (widen) + (setq number-max (line-number-at-pos (point-max))) + (setq number-beg (line-number-at-pos wstart)) + (setq number-end (line-number-at-pos wend))) + (setq start (floor (* (/ number-beg (float number-max)) inner-len))) + (setq end (floor (* (/ number-end (float number-max)) inner-len))) + (setq string + (concat "L" + (format "%02d" number-beg) + "-" + (format "%02d" number-end)))) + (t (error "Unknown sml-modeline-numbers=%S" sml-modeline-numbers))) + (setq inner-len (max inner-len (length string))) + (setq bpad-len (floor (/ (- inner-len (length string)) 2.0))) + (setq epad-len (- inner-len (length string) bpad-len)) + (setq pos-% (+ bpad-len (length string) -1)) + (setq string (concat sml-begin + (make-string bpad-len 32) + string + (make-string epad-len 32) + sml-end)) + ;;(assert (= (length string) sml-modeline-len) t) + (when (= start sml-modeline-len) (setq start (1- start))) + (setq start (+ start (length sml-begin))) + (when (= start end) (setq end (1+ end))) + (when (= end pos-%) (setq end (1+ end))) ;; If on % add 1 + (put-text-property start end 'face 'sml-modeline-vis-face string) + (when (and (= 0 (length sml-begin)) + (= 0 (length sml-end))) + (put-text-property 0 start 'face 'sml-modeline-end-face string) + (put-text-property end sml-modeline-len 'face 'sml-modeline-end-face string)) + string))) + +(defvar sml-modeline-old-car-mode-line-position nil) + +;;;###autoload +(define-minor-mode sml-modeline-mode + "Show buffer size and position like scrollbar in mode line. +You can customize this minor mode, see option `sml-modeline-mode'. + +Note: If you turn this mode on then you probably want to turn off +option `scroll-bar-mode'." + :global t + :group 'sml-modeline + (if sml-modeline-mode + (progn + (unless sml-modeline-old-car-mode-line-position + (setq sml-modeline-old-car-mode-line-position (car mode-line-position))) + (setcar mode-line-position '(:eval (list (sml-modeline-create))))) + (setcar mode-line-position sml-modeline-old-car-mode-line-position))) + + +(provide 'sml-modeline) +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; sml-modeline.el ends here -- cgit v1.2.3