;; ska-utils.el --- Some more or less useful defuns ;; Copyright (C) 2000-2002 Stefan Kamphausen ;; Author: Stefan Kamphausen ;; Time-stamp: <11-May-2006 14:01:45 ska> ;; Keywords: ;; This file is not part of XEmacs. ;; This code 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 code 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 code; see the file COPYING. If not, write to the Free ;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA ;; 02111-1307, USA. ;;; not Synched up with: (X)Emacs ;;; Commentary: ;; Here you can find all the more or less useful defuns I wrote or ;; stole. Being not a lisp hacker I may contain ugly and stupid code, ;; please tell me, if you can approve anything ;; To use: ;; 1. (load "ska-utils" t nil) ;; 2. Most of these defuns are binded to keys in ska-*-keys.el, thus ;; you should use them together (maybe). ;; ;; Author: Stefan Kamphausen ;; http://www.skamphausen.de ;;; Code: (message "Loading ska-utils") (defun ska-line-to-kill-ring () "Puts the current line on top of the kill ring." (interactive) (save-excursion (beginning-of-line) (copy-region-as-kill (point) (save-excursion (forward-line 1) (point))))) ;; ;; suggested key-bindings: ;;(global-set-key '(control \.) 'point-to-register-1) ;;(global-set-key '(control \,) 'jump-to-register-1) (defun ska-point-to-register() "Store cursorposition _fast_ in a register. Use ska-jump-to-register to jump back to the stored position." (interactive) (setq zmacs-region-stays t) (point-to-register 8)) (defun ska-jump-to-register() "Switches between current cursorposition and position that was stored with ska-point-to-register." (interactive) (setq zmacs-region-stays t) (let ((tmp (point-marker))) (jump-to-register 8) (set-register 8 tmp))) ;;---------------------------------------------------------------------------- ;; f4 fuer kill-buffer ist ja nett, aber oft brauche ich auch ;; killbuffer und schliess window (auf shift f4...) (defun ska-kill-this-window () "Kill buffer in current window and delete window after that." (interactive) (kill-this-buffer) (delete-window)) ;; aehnliches fuer switch-to-buffer: ;; switch to buffer und kill this window ;; key-Vorschlag C-x B (defun ska-switch-to-buffer-whole-window (BUFNAME) "Switch to chosen buffer and make that the only window." (interactive "BSwitch to buffer in whole window: ") (switch-to-buffer BUFNAME) (delete-other-windows)) ;(defun ska-previous-buffer () ; "Hmm, to be frank, this is just the same as bury-buffer. ;Used to wander through the buffer stack with the keyboard." ; (interactive) ; (bury-buffer)) ;(defun ska-next-buffer-1 () ; "Cycle to the next buffer with keyboard. Skips all buffers ;whose name begins with a space or a star" ; (interactive) ; (switch-to-buffer ; (car (reverse ; (chb-grep (buffer-list) ; (lambda (bn) (not (string-match "^[ \\*]+" (buffer-name ; bn))))))))) ;(defun ska-next-buffer-2 () ; "Cycle to the next buffer with keyboard. Skips all buffers ;whose name begins with a space" ; (interactive) ; (switch-to-buffer ; (car (reverse ; (chb-grep (buffer-list) ; (lambda (bn) (not (string-match "^ ?" (buffer-name ; bn))))))))) ;; The old version ;(defun ska-next-buffer () ; "Cycle to the next buffer with keyboard." ; (interactive) ; (let* ((bufs (buffer-list)) ; (entry (1- (length bufs))) ; val) ; (while (not (setq val (nth entry bufs) ; val (and (/= (aref (buffer-name val) 0) ; ? ) ; val))) ; (setq entry (1- entry))) ; (switch-to-buffer val))) ;;---------------------------------------------------------------------------- (defun ska-fit-fill-column-to-frame () "Falls (window-width) < fill-column+3, fill-column verkleinern." (interactive) (if (< (frame-width) 79) ( setq fill-column (- (frame-width) 3)) ) ) (defun ska-insert-exec-text (command) "Insert the output of an executable programm at the current cursorpostion." (interactive "sEnter command-string: \n") (insert (exec-to-string command))) ;; how many times have I typed a whole path into a buffer w/o TAB?? ;; Update: now I know comint-dynamic-complete :-) ;(defun ska-insert-path (pathname) ; (interactive "FInsert Path: ") ; (insert pathname)) (defun ska-insert-primary-selection () "Insert the primary selection at point. The primary selection is what you selected with the mouse in any X-Window and that you ususally paste in any other window using the middle mouse button." (interactive) (insert-selection t)) (defun ska-insert-current-time-string () "Insert the current time as in `current-time-string'." (interactive) (insert (current-time-string))) (defun ska-mail-insert-answer-gap () "Insert a nicely formatted gap when answering an email." (interactive) (if (bolp) (insert-char ?\n 1) (insert-char ?\n 2)) (save-excursion (insert-char ?\n 2) (insert " >") (when (not (looking-at " ")) (insert " ")))) ;; The fantastic speedbar definetly needs a TOGGLE (defun ska-speedbar-toggle-expand () (interactive) (beginning-of-line) ;; if we're on a [+] line we can simply expand (if (re-search-forward ":\\s-*.\\+." (save-excursion (end-of-line) (point)) t) (speedbar-expand-line) ;; if starts with "\\s>", we're in a expanded list ;; else ;; go back to the last line with [-] at the beginning (progn (end-of-line) ;; correction by CHB (re-search-backward ":\\s-*.-." (point-min) t) (speedbar-contract-line)) )) ;; This is from the EMacro-Package (I dunno where Bruce got it from) ;; at http://emacro.sourceforge.net/ ;; I only added the redraw-frame ;; Update: this is now done by active-menu.el ;;(defun toggle-menubar () "Hide/display text menu (usually at top)." ;; (interactive) ;; (set-specifier ;; menubar-visible-p ;; (not (specifier-instance menubar-visible-p))) ;; (redraw-frame)) (defun ska-minibuffer-electric-tilde () "Replacement for default minibuffer-electric-tilde. This ones inserts a trailing '/' and doesn't care about looking at '//' because I never come across this." (interactive) (and minibuffer-electric-file-name-behavior (eq directory-sep-char (char-before (point))) ;; permit URL's with //, for e.g. http://hostname/~user ;; but check for //usr/share/whatever (which happens sometimes) (save-excursion (not (and (re-search-backward "//" nil t) (not (bolp))))) (delete-region (point-min) (point))) ;; I rarely type URLs so the trailing slash is OK for me (insert "~/")) (defun ska-electric-transpose-chars () "Replacement for the default transpose-chars command. This is usually bound to C-t and it behaves somewhat unintelligent because I always have to move back one char when I mistyped something. This function checks whether the user is typing and then goes back one char itself." (interactive) (if (eq last-command 'self-insert-command) (progn (transpose-chars -1) (forward-char)) (transpose-chars -1))) ;; From: http://www.emacswiki.org/cgi-bin/wiki.pl?AddBufferKeywords ;; Add keywords to font-lock, function only exists in GNU Emacs? (require 'cl) (defun font-lock-add-buffer-keywords (keywords &optional append) "Add highlighting KEYWORDS for the current buffer. KEYWORDS should be a list; see the variable `font-lock-keywords'. By default they are added at the beginning of the current highlighting list. If optional argument APPEND is `set', they are used to replace the current highlighting list. If APPEND is any other non-nil value, they are added at the end of the current highlighting list. For example: (font-lock-add-buffer-keywords '((\"\\\\\\=<\\\\(FIXME\\\\):\" 1 font-lock-warning-face prepend) (\"\\\\\\=<\\\\(and\\\\|or\\\\|not\\\\)\\\\\\=>\" . font-lock-keyword-face))) adds two fontification patterns: one to fontify `FIXME:' words, even in comments, and the other to fontify `and', `or' and `not' words as keywords. Note that some modes have specialised support for additional patterns, e.g., see the variables `c-font-lock-extra-types', `c++-font-lock-extra-types', `objc-font-lock-extra-types' and `java-font-lock-extra-types'." ;; This is needed to avoid this operation ending up as a no-op (because ;; `font-lock-set-defaults' might get called later, and it might decide to ;; set `font-lock-keywords' itself, from scratch). I understand that some ;; older FSF Emacs releases don't do this in `font-lock-add-keywords', so ;; we do it here -- which can't hurt. (font-lock-set-defaults) ;; Use a native implementation if one exists (if (fboundp 'font-lock-add-keywords) (font-lock-add-keywords nil keywords append) ;; Otherwise, use this one that was grabbed from FSF Emacs 21's ;; `font-lock-add-keywords' and `font-lock-remove-keywords' functions. (if (eq append 'set) (setq font-lock-keywords keywords) ;; Try to remove duplicates (setq font-lock-keywords (copy-sequence font-lock-keywords)) (dolist (kw keywords) (setq font-lock-keywords (delete kw ;; The keywords might be compiled (delete (font-lock-compile-keyword kw) font-lock-keywords)))) (let ((old font-lock-keywords)) (when (eq (car-safe font-lock-keywords) t) (pop old)) (when append (rotatef keywords old)) (setq font-lock-keywords (append keywords old)))))) ;; And now we use it: (defun ska-add-fixme-highlighting () "Turn on extra highlighting for 'FIXME' and the like." (font-lock-add-buffer-keywords '(("\\<\\(FIXME\\|TODO\\|XXX+\\):\?" 1 font-lock-warning-face prepend)))) (defun ska-edit-personal-el () "Just open and unfold my main configuration file." (interactive) (find-file (concat my-config-dir "/personal.el")) (folding-open-buffer)) ;; How f*cking many times have I typed C-x C-f MaTABaTAB?? (defun ska-edit-automake-file () "Just a shortcut for C-x C-f MaTABaTAB." (interactive) (find-file "Makefile.am")) (defun ska-home () "Go 'home' depending on where you are. That is: * Go back to indentation when you are somewhere in a line. * Go to the beginning of the line when you are at indentation. * Go to the top of the window when on beginning of line * Go to top of buffer when at top of window." (interactive) (cond ((= (point) (window-start)) (goto-char (point-min))) ((= (point) (point-at-bol)) (move-to-window-line 0) (beginning-of-line)) ((= (point) (save-excursion (back-to-indentation) (point))) (beginning-of-line)) (t (back-to-indentation)))) (defun ska-end () "Go to the 'end' depending on where you are. That is: * Go to the end of the line when you are somewhere in the line. * Go to the end of the window when at end of line * Go to the end of buffer when at end of window." (interactive) (if (not (eolp)) (end-of-line) (if (eq this-command last-command) (cond ((not (= (point) (save-excursion (move-to-window-line -1) (end-of-line) (point)))) (move-to-window-line -1) (end-of-line)) (t (goto-char (point-max))))))) ;; from http://www.emacswiki.org/cgi-bin/wiki/PopupRuler (defun my-column-ruler (width) "Display temp ruler at point." (interactive `(,(- (window-width) 1))) (momentary-string-display (if (< width 10) "1 5 10\n|...|....|\n" (let* ((iterations (/ width 10)) (short (- width (* 10 iterations))) (result1 "|...|....|") (result2 "1 5 10") (inc1 "....|....|") (inc2 " %d0") (i 1)) (while (< i iterations) (setq i (1+ i)) (setq result1 (concat result1 inc1)) (setq result2 (concat result2 (substring (format inc2 i) -10)))) (concat result2 "\n" result1 (substring inc1 0 short) "\n"))) (line-beginning-position) nil "[space] Clears ruler")) (defun edi-linebreaks () "Break an EDI message into segments." (interactive) (save-excursion (goto-char (point-min)) (let ((sep (if (looking-at "UNA.....\\(.\\)") (match-string 1) "'")) (escape (if (looking-at "UNA...\\(.\\)") (match-string 1) "?"))) (replace-regexp (concat "\\([^" escape "]\\)" sep) (concat "\\1" sep "\n"))))) (defmacro def-slime-start (name lisp) `(defun ,name () (interactive) (slime ,lisp))) ;; (def-slime-start cmucl "/usr/bin/lisp") (defun broom-start () (interactive) (when (not (file-exists-p "/opt/EDDY3/ext/lib/CL/")) (error "Current MEAI has no CL")) (cd "/home/ska/prj/lisp/broom") (cmucl) (while (not (slime-connected-p)) (sit-for 1) (message "waiting for slime")) (slime-load-system "broom")) (defun insert-iso-time () (interactive) (insert (format-time-string "%Y-%m-%d"))) (message "ska-utils OK") ;; This is not mine, it'f from ;; http://groups.google.com/group/comp.lang.lisp/msg/67465d6d6423712e (defun lispdoc () "searches lispdoc.com for SYMBOL, which is by default the symbol currently under the curser" (interactive) (let* ((word-at-point (word-at-point)) (symbol-at-point (symbol-at-point)) (default (symbol-name symbol-at-point)) (inp (read-from-minibuffer (if (or word-at-point symbol-at-point) (concat "Symbol (default " default "): ") "Symbol (no default): ")))) (if (and (string= inp "") (not word-at-point) (not symbol-at-point)) (message "you didn't enter a symbol!") (let ((search-type (read-from-minibuffer "full-text (f) or basic (b) search (default b)? "))) (browse-url (concat "http://lispdoc.com?q=" (if (string= inp "") default inp) "&search=" (if (string-equal search-type "f") "full+text+search" "basic+search"))))))) ;; from ;; http://www.cliki.net/Bits%20from%20Mark%20Triggs's%20.emacs (defun lisp-reindent-defun () "Indent the current defun." (interactive) (save-excursion (beginning-of-defun) (indent-sexp))) (defun ska-toggle-long-lines () (interactive) (setq truncate-lines (not truncate-lines))) (provide 'ska-utils) ;; Local variables: ;; mode: emacs-lisp ;; end: