From: Stefan Bund Date: Thu, 20 Mar 2014 07:49:00 +0000 (+0100) Subject: new stuff X-Git-Url: http://g0dil.de/git?a=commitdiff_plain;h=337a12f5680ab26634cd3892a87abc804304342a;p=emacs-init.git new stuff --- diff --git a/.gitmodules b/.gitmodules index 16f74b3..bdd6371 100644 --- a/.gitmodules +++ b/.gitmodules @@ -9,3 +9,6 @@ url = git://github.com/magit/magit.git [submodule "emacsstuff"] path = emacsstuff url = git://g0dil.de/emacsstuff.git +[submodule "git-modes"] + path = git-modes + url = https://github.com/magit/git-modes.git diff --git a/auto-install/cl-lib.el b/auto-install/cl-lib.el new file mode 100644 index 0000000..52c4276 --- /dev/null +++ b/auto-install/cl-lib.el @@ -0,0 +1,392 @@ +;;; cl-lib.el --- Properly prefixed CL functions and macros -*- coding: utf-8 -*- + +;; Copyright (C) 2012, 2013, 2014 Free Software Foundation, Inc. + +;; Author: Stefan Monnier +;; vcomment: Emacs-24.3's version is 1.0 so this has to stay below. +;; Version: 0.4 + +;; 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 of the License, 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. If not, see . + +;;; Commentary: + +;; This is a forward compatibility package, which provides (a subset of) the +;; features of the cl-lib package introduced in Emacs-24.3, for use on +;; previous emacsen. + +;; Make sure this is installed *late* in your `load-path`, i.e. after Emacs's +;; built-in .../lisp/emacs-lisp directory, so that if/when you upgrade to +;; Emacs-24.3, the built-in version of the file will take precedence, otherwise +;; you could get into trouble (although we try to hack our way around the +;; problem in case it happens). + +;; This code is largely copied from Emacs-24.3's cl.el, with the alias bindings +;; simply reversed. + +;;; Code: + +(when (functionp 'macroexp--compiler-macro) + ;; `macroexp--compiler-macro' was introduced as part of the big CL + ;; reorganization which moved/reimplemented some of CL into core (mostly the + ;; setf and compiler-macro support), so its presence indicates we're running + ;; in an Emacs that comes with the new cl-lib.el, where this file should + ;; never be loaded! + (message "Real cl-lib shadowed by compatibility cl-lib? (%s)" load-file-name) + (when load-file-name + ;; (message "Let's try to patch things up") + (let ((loaddir (file-name-directory load-file-name)) + load-path-dir) + ;; Find the problematic directory from load-path. + (dolist (dir load-path) + (if (equal loaddir (expand-file-name (file-name-as-directory dir))) + (setq load-path-dir dir))) + (when load-path-dir + ;; (message "Let's move the offending dir to the end") + (setq load-path (append (remove load-path-dir load-path) + (list load-path-dir))) + ;; Here we could manually load cl-lib and then return immediately. + ;; But Emacs currently doesn't provide any way for a file to "return + ;; immediately", so instead we make sure the rest of the file does not + ;; throw away any pre-existing definition. + )))) + +(require 'cl) + +;; Some of Emacs-24.3's cl.el definition are not just aliases, because either +;; the feature was dropped from cl-lib.el or because the cl-lib version is +;; not fully compatible. +;; Let's just not include them here, since it is very important that if code +;; works with this cl-lib.el it should also work with Emacs-24.3's cl-lib.el, +;; whereas the reverse is much less important. + +(dolist (var '( + ;; loop-result-var + ;; loop-result + ;; loop-initially + ;; loop-finally + ;; loop-bindings + ;; loop-args + ;; bind-inits + ;; bind-block + ;; lambda-list-keywords + float-negative-epsilon + float-epsilon + least-negative-normalized-float + least-positive-normalized-float + least-negative-float + least-positive-float + most-negative-float + most-positive-float + ;; custom-print-functions + )) + (let ((new (intern (format "cl-%s" var)))) + (unless (boundp new) (defvaralias new var)))) + +;; The following cl-lib functions were already defined in the old cl.el, +;; with a different meaning: +;; - cl-position and cl-delete-duplicates +;; the two meanings are clearly different, but we can distinguish which was +;; meant by looking at the arguments. +;; - cl-member +;; the old meaning hasn't been used for a long time and is a subset of the +;; new, so we can simply override it. +;; - cl-adjoin +;; the old meaning is actually the same as the new except for optimizations. + +(dolist (fun '( + (get* . cl-get) + (random* . cl-random) + (rem* . cl-rem) + (mod* . cl-mod) + (round* . cl-round) + (truncate* . cl-truncate) + (ceiling* . cl-ceiling) + (floor* . cl-floor) + (rassoc* . cl-rassoc) + (assoc* . cl-assoc) + ;; (member* . cl-member) ;Handle specially below. + (delete* . cl-delete) + (remove* . cl-remove) + (defsubst* . cl-defsubst) + (sort* . cl-sort) + (function* . cl-function) + (defmacro* . cl-defmacro) + (defun* . cl-defun) + (mapcar* . cl-mapcar) + + remprop + getf + tailp + list-length + nreconc + revappend + concatenate + subseq + random-state-p + make-random-state + signum + isqrt + lcm + gcd + notevery + notany + every + some + mapcon + mapcan + mapl + maplist + map + equalp + coerce + tree-equal + nsublis + sublis + nsubst-if-not + nsubst-if + nsubst + subst-if-not + subst-if + subsetp + nset-exclusive-or + set-exclusive-or + nset-difference + set-difference + nintersection + intersection + nunion + union + rassoc-if-not + rassoc-if + assoc-if-not + assoc-if + member-if-not + member-if + merge + stable-sort + search + mismatch + count-if-not + count-if + count + position-if-not + position-if + ;; position ;Handle specially via defadvice below. + find-if-not + find-if + find + nsubstitute-if-not + nsubstitute-if + nsubstitute + substitute-if-not + substitute-if + substitute + ;; delete-duplicates ;Handle specially via defadvice below. + remove-duplicates + delete-if-not + delete-if + remove-if-not + remove-if + replace + fill + reduce + compiler-macroexpand + define-compiler-macro + assert + check-type + typep + deftype + defstruct + callf2 + callf + letf* + letf + rotatef + shiftf + remf + psetf + declare + the + locally + multiple-value-setq + multiple-value-bind + symbol-macrolet + macrolet + progv + psetq + do-all-symbols + do-symbols + dotimes + dolist + do* + do + loop + return-from + return + block + etypecase + typecase + ecase + case + load-time-value + eval-when + destructuring-bind + gentemp + gensym + pairlis + acons + subst + ;; adjoin ;It's already defined. + copy-list + ldiff + list* + cddddr + cdddar + cddadr + cddaar + cdaddr + cdadar + cdaadr + cdaaar + cadddr + caddar + cadadr + cadaar + caaddr + caadar + caaadr + caaaar + cdddr + cddar + cdadr + cdaar + caddr + cadar + caadr + caaar + tenth + ninth + eighth + seventh + sixth + fifth + fourth + third + endp + rest + second + first + svref + copy-seq + evenp + oddp + minusp + plusp + floatp-safe + declaim + proclaim + nth-value + multiple-value-call + multiple-value-apply + multiple-value-list + values-list + values + pushnew + decf + incf + + dolist + dotimes + )) + (let ((new (if (consp fun) (prog1 (cdr fun) (setq fun (car fun))) + (intern (format "cl-%s" fun))))) + (if (fboundp new) + (unless (or (eq (symbol-function new) fun) + (eq new (and (symbolp fun) (fboundp fun) + (symbol-function fun)))) + (message "%S already defined, not rebinding" new)) + (defalias new fun)))) + +(autoload 'cl-position "cl-seq") +(defadvice cl-position (around cl-lib (cl-item cl-seq &rest cl-keys) activate) + (let ((argk (ad-get-args 2))) + (if (or (null argk) (keywordp (car argk))) + ;; This is a call to cl-lib's `cl-position'. + (setq ad-return-value + (apply #'position (ad-get-arg 0) (ad-get-arg 1) argk)) + ;; Must be a call to cl's old `cl-position'. + ad-do-it))) + +(autoload 'cl-delete-duplicates "cl-seq") +(defadvice cl-delete-duplicates (around cl-lib (cl-seq &rest cl-keys) activate) + (let ((argk (ad-get-args 1))) + (if (or (null argk) (keywordp (car argk))) + ;; This is a call to cl-lib's `cl-delete-duplicates'. + (setq ad-return-value + (apply #'delete-duplicates (ad-get-arg 0) argk)) + ;; Must be a call to cl's old `cl-delete-duplicates'. + ad-do-it))) + +(when (or (not (fboundp 'cl-member)) + (eq (symbol-function 'cl-member) #'memq)) + (defalias 'cl-member #'member*)) + +;; `cl-labels' is not 100% compatible with `labels' when using dynamic scoping +;; (mostly because it does not turn lambdas that refer to those functions into +;; closures). OTOH it is compatible when using lexical scoping. + +(unless (fboundp 'cl-labels) + (defmacro cl-labels (&rest args) + (unless (and (boundp 'lexical-binding) lexical-binding) + ;; We used to signal an error rather than a message, but in many uses of + ;; cl-labels, the value of lexical-binding doesn't actually matter. + ;; More importantly, the value of `lexical-binding' here is unreliable + ;; (it does not necessarily reflect faithfully whether the output of this + ;; macro will be interpreted as lexically bound code or not). + (message "This `cl-labels' requires `lexical-binding' to be non-nil")) + `(labels ,@args))) + +;;;; ChangeLog: + +;; 2014-01-25 Stefan Monnier +;; +;; * cl-lib.el: Resolve conflicts with old internal definitions +;; (bug#16353). +;; (dolist fun): Don't skip definitions silently. +;; (define-setf-expander): Remove, not in cl-lib. +;; (cl-position, cl-delete-duplicates): Add advice to distinguish the use +;; case. +;; (cl-member): Override old definition. +;; +;; 2013-05-22 Stefan Monnier +;; +;; * cl-lib.el (cl-labels): Demote error to message and improve it. +;; +;; 2012-11-30 Stefan Monnier +;; +;; * cl-lib.el: Try and patch things up in case we're hiding the real +;; cl-lib. +;; +;; 2012-11-22 Stefan Monnier +;; +;; Add cl-letf and cl-labels. +;; +;; 2012-11-16 Stefan Monnier +;; +;; * packages/cl-lib: New package. +;; + + +(provide 'cl-lib) +;;; cl-lib.el ends here diff --git a/auto-install/framemove.el b/auto-install/framemove.el new file mode 100644 index 0000000..b1bf09b --- /dev/null +++ b/auto-install/framemove.el @@ -0,0 +1,232 @@ +;;; framemove.el --- directional frame selection routines +;; +;; Copyright (C) 2010 +;; +;; Author: Trey Jackson (bigfaceworm@gmail.com) +;; Created: February 14, 2010 +;; Keywords: frame, movement, convenience +;; +;; This file is not (yet) a part of GNU Emacs. +;; +;; Very much like the windmove package, only for frames. +;; Provide a simple set of keystrokes to move the input/focus +;; between windows. +;; +;; Version 0.9 +;; +;; This software is licensed under the GPL version 3. +;; +;; To install: +;; (require 'framemove) +;; (framemove-default-keybindings) +;; +;; If you want to integrate framemove and windmove +;; You can omit the call to 'framemove-default-keybindings +;; And instead do: +;; (require 'framemove) +;; (windmove-default-keybindings) +;; (setq framemove-hook-into-windmove t) +;; +;; Compatibility: GNU Emacs 22.x, 23.x +;; + +(defvar framemove-hook-into-windmove nil + "When non-nil, try moving frames if moving windows fails.") + +(defun fm-frame-bbox (frame) + ;; eval b/c when things are beyond borders, you get + ;; (+ -11) weirdness + (let ((yl (eval (frame-parameter frame 'top))) + (xl (eval (frame-parameter frame 'left)))) + (list xl + yl + (+ xl (frame-pixel-width frame)) + (+ yl (frame-pixel-height frame))))) + +(defun fm-opposite (dir) + (cdr (assq dir '((left . right) (right . left) (up . down) (down . up))))) + +(defun fm-frame-coord (frame-or-box dir) + (nth (cdr (assq dir '((left . 0) (up . 1) (right . 2) (down . 3)))) + (if (framep frame-or-box) + (fm-frame-bbox frame-or-box) + frame-or-box))) + +(defun fm-frame-is-completly-to-dir-of (refframe dir otherframe) + (cond + ((eq refframe otherframe) + nil) + ((memq dir '(left up)) + (< (fm-frame-coord refframe (fm-opposite dir)) (fm-frame-coord otherframe dir))) + ((memq dir '(right down)) + (> (fm-frame-coord refframe (fm-opposite dir)) (fm-frame-coord otherframe dir))) + (t (error "Invalid direction of movement: %s" dir)))) + +(defun fm-frame-is-to-dir-of (refframe dir otherframe) + (cond + ((not (eq (frame-parameter refframe 'display) (frame-parameter otherframe 'display))) + nil) + ((eq refframe otherframe) + nil) + ((memq dir '(left up)) + (< (fm-frame-coord refframe dir) (fm-frame-coord otherframe dir))) + ((memq dir '(right down)) + (> (fm-frame-coord refframe dir) (fm-frame-coord otherframe dir))) + (t (error "Invalid direction of movement: %s" dir)))) + +(defun fm-absolute-coords-of-position (position) + (let ((rel-x-y (fm-frame-relative-coordinates position)) + (frame-bbox (fm-frame-bbox (window-frame (posn-window position))))) + (cons (+ (car frame-bbox) (car rel-x-y)) + (+ (cadr frame-bbox) (cdr rel-x-y))))) + +(defun fm-frame-relative-coordinates (position) + "Return frame-relative coordinates from POSITION." + (let* ((x-y (posn-x-y position)) + (window (posn-window position)) + (edges (window-inside-pixel-edges window))) + (cons (+ (car x-y) (car edges)) + (+ (cdr x-y) (cadr edges))))) + +(defun fm-project (coord frame dir) + "project COORD in direction DIR to edge of FRAME" + (if (memq dir '(up down)) + (cons (car coord) + (fm-frame-coord frame dir)) + (cons (fm-frame-coord frame dir) + (cdr coord)))) + + +(defun fm-next-frame (dir) + "move focus to next frame in direction (from currently focused frame)" + (interactive (list + (intern (completing-read "Which direction: " '("up" "down" "left" "right") nil t)))) + (let* ((thisframe (selected-frame)) + (current-coords (fm-absolute-coords-of-position (posn-at-point))) + (coords-projected-in-dir (fm-project current-coords thisframe dir)) + (possible-frames + (sort + (remove-if-not + '(lambda (f) (fm-frame-is-to-dir-of f dir thisframe)) + (visible-frame-list)) + '(lambda (f1 f2) (fm-frame-is-to-dir-of f1 (fm-opposite dir) f2))))) + (if possible-frames + (let ((frames-in-line-of-cursor + ;; try to find frame in line with cursor + (remove-if-not + '(lambda (f) (fm-coord-in-range current-coords dir f)) + possible-frames)) + (frames-in-line-of-frame + ;; find frame that overlaps current frame + ;; need to sort by distance from cursor + (sort + (remove-if-not + '(lambda (f) (fm-range-overlap thisframe f dir)) + possible-frames) + '(lambda (f1 f2) + (< (fm-dist-from-coords coords-projected-in-dir f1) + (fm-dist-from-coords coords-projected-in-dir f2)))))) + (select-frame-set-input-focus + (or (car frames-in-line-of-cursor) + (car frames-in-line-of-frame) + (car possible-frames)))) + (error "No frame in that direction")))) + +(defun fm-dist-from-coords (coord frame) + "distance from coord to the bbox of the frame" + (let* ((x (car coord)) + (y (cdr coord)) + (x-in-range (fm-v-in-range x (fm-bbox-range 'left frame))) + (y-in-range (fm-v-in-range y (fm-bbox-range 'up frame))) + (x-dist (min (abs (- x (fm-frame-coord frame 'left))) + (abs (- x (fm-frame-coord frame 'right))))) + (y-dist (min (abs (- y (fm-frame-coord frame 'up))) + (abs (- y (fm-frame-coord frame 'down)))))) + (cond ((and x-in-range y-in-range) + 0) + (x-in-range + y-dist) + (y-in-range + x-dist) + ((sqrt (+ (expt x-dist 2) + (expt y-dist 2))))))) + +(defun fm-v-in-range (v range) + (and (> v (car range)) + (< v (cdr range)))) + +(defun fm-bbox-range (dir box) + (if (memq dir '(up down)) + (cons (fm-frame-coord box 'up) + (fm-frame-coord box 'down)) + (cons (fm-frame-coord box 'left) + (fm-frame-coord box 'right)))) + +(defun fm-range-overlap (f1 f2 dir) + "return true if the bbox'es of the two frames overlap using coords perpendicular to dir" + (let ((perp (if (memq dir '(up down)) 'left 'up)) + (f1box (fm-frame-bbox f1)) + (f2box (fm-frame-bbox f2))) + (or (fm-v-in-range (fm-frame-coord f1 perp) (fm-bbox-range perp f2)) + (fm-v-in-range (fm-frame-coord f1 (fm-opposite perp)) (fm-bbox-range perp f2)) + (fm-v-in-range (fm-frame-coord f2 perp) (fm-bbox-range perp f1)) + (fm-v-in-range (fm-frame-coord f2 (fm-opposite perp)) (fm-bbox-range perp f1))))) + +(defun fm-coord-in-range (coord dir frame) + "return true if the coord can be projected in orientation of dir +onto the bbox of the frame, or more simply, is the part of the coord +perpendicular to DIR between the edges of frame perpendicular to DIR" + (let ((n (if (memq dir '(up down)) (car coord) (cdr coord))) + (perp (if (memq dir '(up down)) 'left 'up))) + (and (< (fm-frame-coord frame perp) n) + (> (fm-frame-coord frame (fm-opposite perp)) n)))) + +(defun fm-sort-frames-by-edge (framelist dir) + (sort + framelist + (lambda (f1 f2) + (apply (symbol-function + (if (memq dir '(left up)) '> '<)) + (list (fm-frame-coord f1 dir) (fm-frame-coord f2 dir)))))) + +;;;###autoload +(defun fm-down-frame () + (interactive) + (fm-next-frame 'down)) +;;;###autoload +(defun fm-up-frame () + (interactive) + (fm-next-frame 'up)) +;;;###autoload +(defun fm-left-frame () + (interactive) + (fm-next-frame 'left)) +;;;###autoload +(defun fm-right-frame () + (interactive) + (fm-next-frame 'right)) + +;;;###autoload +(defun framemove-default-keybindings (&optional modifier) + "Set up keybindings for `framemove'. +Keybindings are of the form MODIFIER-{left,right,up,down}. +Default MODIFIER is 'meta." + (interactive) + (unless modifier (setq modifier 'meta)) + + (global-set-key (vector (list modifier 'down)) 'fm-down-frame) + (global-set-key (vector (list modifier 'up)) 'fm-up-frame) + (global-set-key (vector (list modifier 'left)) 'fm-left-frame) + (global-set-key (vector (list modifier 'right)) 'fm-right-frame)) + +(defadvice windmove-do-window-select (around framemove-do-window-select-wrapper activate) + "Let windmove do its own thing, if there is an error, try framemove in that direction." + (condition-case err + ad-do-it + (error + (if framemove-hook-into-windmove + (fm-next-frame (ad-get-arg 0)) + (error (error-message-string err)))))) + +(provide 'framemove) +;;; framemove.el ends here diff --git a/git-modes b/git-modes new file mode 160000 index 0000000..0cd113d --- /dev/null +++ b/git-modes @@ -0,0 +1 @@ +Subproject commit 0cd113d7c14090e660807fea4be0116003925d2b diff --git a/setup/ffap.el b/setup/ffap.el new file mode 100644 index 0000000..1cf09d5 --- /dev/null +++ b/setup/ffap.el @@ -0,0 +1,26 @@ +(defun my-find-file-at-point-with-line () + "Opens the file at point and goes to line-number." + (interactive) + (let ((fname (ffap-file-at-point))) + (if fname + (let ((line + (save-excursion + (goto-char (cadr ffap-string-at-point-region)) + (and (re-search-backward ":\\([0-9]+\\)" + (line-beginning-position) t) + (string-to-int (match-string 1)))))) + ;; (message "file:%s,line:%s" fname line) + (when (and (tramp-tramp-file-p default-directory) + (= ?/ (aref fname 0))) + ;; if fname is an absolute path in remote machine, it will not return a tramp path,fix it here. + (let ((pos (position ?: default-directory))) + (if (not pos) (error "failed find first tramp indentifier ':'")) + (setf pos (position ?: default-directory :start (1+ pos))) + (if (not pos) (error "failed find second tramp indentifier ':'")) + (setf fname (concat (substring default-directory 0 (1+ pos)) fname)))) + (message "fname:%s" fname) + (find-file-existing fname) + (when line (goto-line line))) + (error "File does not exist.")))) + +(global-set-key (kbd "C-c C-x C-f") 'my-find-file-at-point-with-line) \ No newline at end of file