From 1ca854dbec0e879429c83b3da3d26dae1d852c00 Mon Sep 17 00:00:00 2001 From: ryuslash Date: Sun, 12 Sep 2010 10:33:26 +0200 Subject: Removed old emacs files --- .emacs | 73 - .emacs.d/ac-dict/c++-mode | 74 - .emacs.d/ac-dict/c-mode | 37 - .emacs.d/ac-dict/clojure-mode | 475 -- .emacs.d/ac-dict/css-mode | 747 -- .emacs.d/ac-dict/java-mode | 50 - .emacs.d/ac-dict/javascript-mode | 148 - .emacs.d/ac-dict/php-mode | 62 - .emacs.d/ac-dict/python-mode | 104 - .emacs.d/ac-dict/ruby-mode | 181 - .emacs.d/ac-dict/scheme-mode | 216 - .emacs.d/ac-dict/tcl-mode | 172 - .emacs.d/auto-complete-config.el | 480 -- .emacs.d/auto-complete-config.elc | Bin 15943 -> 0 bytes .emacs.d/auto-complete.el | 1897 ----- .emacs.d/auto-complete.elc | Bin 59995 -> 0 bytes .emacs.d/autopair.el | 1036 --- .emacs.d/batch-mode.el | 156 - .emacs.d/color-theme.el | 1668 ---- .emacs.d/csharp-mode.el | 1977 ----- .emacs.d/fuzzy.el | 255 - .emacs.d/fuzzy.elc | Bin 7438 -> 0 bytes .emacs.d/ide-skel.el | 4016 --------- .emacs.d/include.el | 20 - .emacs.d/javascript.el | 707 -- .emacs.d/linux/.emacs | 1 - .emacs.d/popup.el | 1061 --- .emacs.d/popup.elc | Bin 64893 -> 0 bytes .emacs.d/ports.el | 29 - .emacs.d/rainbow-mode.el | 207 - .emacs.d/slash_c.el | 15 - .emacs.d/slash_functions.el | 5 - .emacs.d/slash_python.el | 17 - .emacs.d/slash_theme.el | 66 - .emacs.d/sqlplus.el | 5151 ------------ .emacs.d/tabbar.el | 1932 ----- .emacs.d/themes/color-theme-example.el | 22 - .emacs.d/themes/color-theme-library.el | 13539 ------------------------------- .emacs.d/tramp | 20 - .emacs.d/vala-mode.el | 395 - 40 files changed, 37011 deletions(-) delete mode 100644 .emacs delete mode 100644 .emacs.d/ac-dict/c++-mode delete mode 100644 .emacs.d/ac-dict/c-mode delete mode 100644 .emacs.d/ac-dict/clojure-mode delete mode 100644 .emacs.d/ac-dict/css-mode delete mode 100644 .emacs.d/ac-dict/java-mode delete mode 100644 .emacs.d/ac-dict/javascript-mode delete mode 100644 .emacs.d/ac-dict/php-mode delete mode 100644 .emacs.d/ac-dict/python-mode delete mode 100644 .emacs.d/ac-dict/ruby-mode delete mode 100644 .emacs.d/ac-dict/scheme-mode delete mode 100644 .emacs.d/ac-dict/tcl-mode delete mode 100644 .emacs.d/auto-complete-config.el delete mode 100644 .emacs.d/auto-complete-config.elc delete mode 100644 .emacs.d/auto-complete.el delete mode 100644 .emacs.d/auto-complete.elc delete mode 100644 .emacs.d/autopair.el delete mode 100644 .emacs.d/batch-mode.el delete mode 100644 .emacs.d/color-theme.el delete mode 100644 .emacs.d/csharp-mode.el delete mode 100644 .emacs.d/fuzzy.el delete mode 100644 .emacs.d/fuzzy.elc delete mode 100644 .emacs.d/ide-skel.el delete mode 100644 .emacs.d/include.el delete mode 100644 .emacs.d/javascript.el delete mode 100644 .emacs.d/linux/.emacs delete mode 100644 .emacs.d/popup.el delete mode 100644 .emacs.d/popup.elc delete mode 100644 .emacs.d/ports.el delete mode 100644 .emacs.d/rainbow-mode.el delete mode 100644 .emacs.d/slash_c.el delete mode 100644 .emacs.d/slash_functions.el delete mode 100644 .emacs.d/slash_python.el delete mode 100644 .emacs.d/slash_theme.el delete mode 100644 .emacs.d/sqlplus.el delete mode 100644 .emacs.d/tabbar.el delete mode 100644 .emacs.d/themes/color-theme-example.el delete mode 100644 .emacs.d/themes/color-theme-library.el delete mode 100644 .emacs.d/tramp delete mode 100644 .emacs.d/vala-mode.el diff --git a/.emacs b/.emacs deleted file mode 100644 index 9b26bb2..0000000 --- a/.emacs +++ /dev/null @@ -1,73 +0,0 @@ -(require 'paren) -(require 'uniquify) - -(load-file "~/.emacs.d/include.el") - -(if (eq system-type 'gnu/linux) ; if we're running linux - (load-file "~/.emacs.d/linux/.emacs")) - -(setq inhibit-startup-message t) ; don't show welcome -(setq-default indent-tabs-mode nil) ; spaces, no tabs -(tool-bar-mode nil) ; no toolbar -(menu-bar-mode nil) ; no menu -(line-number-mode nil) ; don't show line numbers in splitter -(global-linum-mode t) ; show line numbers in gutter -(column-number-mode t) ; show column numbers in splitter -(color-theme-weirdness) ; my theme -(global-font-lock-mode t) ; always show syntax higlighting, this may - ; be old -(fset 'yes-or-no-p 'y-or-n-p) ; don't want to have to type yes or no -(setq require-final-newline t) ; I always get bothered by this with the likes of fstab -(show-paren-mode t) -(setq font-lock-maximum-decoration t) ; denotes our interest in maximum possible fontification -(setq uniquify-buffer-name-style 'reverse) - -;; Keybindings -(global-set-key "\C-m" 'newline-and-indent) - -;; Autopair Mode -(autopair-global-mode) - -;; Vala Mode -(add-to-list 'auto-mode-alist '("\\.vala$" . vala-mode)) -(add-to-list 'auto-mode-alist '("\\.vapi$" . vala-mode)) -(add-to-list 'file-coding-system-alist '("\\.vala$" . utf-8)) -(add-to-list 'file-coding-system-alist '("\\.vapi$" . utf-8)) - -;; C# Mode -(setq auto-mode-alist (cons `("\\.cs\\'" . csharp-mode) auto-mode-alist)) - -;; Batch Mode -(setq auto-mode-alist (cons `("\\.bat\\'" . batch-mode) auto-mode-alist)) - -;; Autosave location -(setq backup-directory-alist - `((".*" . ,temporary-file-directory))) -(setq auto-save-file-name-transforms - `((".*" ,temporary-file-directory t))) - -;; Autocomplete -(add-to-list 'ac-dictionary-directories "~/.emacs.d//ac-dict") -(ac-config-default) - -;; ide-skel -(global-set-key [f4] 'ide-skel-proj-find-files-by-regexp) -(global-set-key [f5] 'ide-skel-proj-grep-files-by-regexp) -(global-set-key [f10] 'ide-skel-toggle-left-view-window) -(global-set-key [f11] 'ide-skel-toggle-bottom-view-window) -(global-set-key [f12] 'ide-skel-toggle-right-view-window) -(global-set-key [C-next] 'tabbar-backward) -(global-set-key [C-prior] 'tabbar-forward) - -(custom-set-variables - ;; custom-set-variables was added by Custom. - ;; If you edit it by hand, you could mess it up, so be careful. - ;; Your init file should contain only one such instance. - ;; If there is more than one, they won't work right. - ) -(custom-set-faces - ;; custom-set-faces was added by Custom. - ;; If you edit it by hand, you could mess it up, so be careful. - ;; Your init file should contain only one such instance. - ;; If there is more than one, they won't work right. - ) diff --git a/.emacs.d/ac-dict/c++-mode b/.emacs.d/ac-dict/c++-mode deleted file mode 100644 index e3cd8ae..0000000 --- a/.emacs.d/ac-dict/c++-mode +++ /dev/null @@ -1,74 +0,0 @@ -and -and_eq -asm -auto -bitand -bitor -bool -break -case -catch -char -class -compl -const -const_cast -continue -default -delete -do -double -dynamic_cast -else -enum -explicit -export -extern -false -float -for -friend -goto -if -inline -int -long -mutable -namespace -new -not -not_eq -operator -or -or_eq -private -protected -public -register -reinterpret_cast -return -short -signed -sizeof -static -static_cast -struct -switch -template -this -throw -true -try -typedef -typeid -typename -union -unsigned -using -virtual -void -volatile -wchar_t -while -xor -xor_eq diff --git a/.emacs.d/ac-dict/c-mode b/.emacs.d/ac-dict/c-mode deleted file mode 100644 index 496f904..0000000 --- a/.emacs.d/ac-dict/c-mode +++ /dev/null @@ -1,37 +0,0 @@ -auto -_Bool -break -case -char -_Complex -const -continue -default -do -double -else -enum -extern -float -for -goto -if -_Imaginary -inline -int -long -register -restrict -return -short -signed -sizeof -static -struct -switch -typedef -union -unsigned -void -volatile -while diff --git a/.emacs.d/ac-dict/clojure-mode b/.emacs.d/ac-dict/clojure-mode deleted file mode 100644 index 16348ed..0000000 --- a/.emacs.d/ac-dict/clojure-mode +++ /dev/null @@ -1,475 +0,0 @@ -*agent* -*clojure-version* -*command-line-args* -*compile-files* -*compile-path* -*err* -*file* -*flush-on-newline* -*in* -*ns* -*out* -*print-dup* -*print-length* -*print-level* -*print-meta* -*print-readably* -*read-eval* -*warn-on-reflection* -accessor -aclone -add-classpath -add-watch -agent -agent-error -agent-errors -aget -alength -alias -all-ns -alter -alter-meta! -alter-var-root -amap -ancestors -and -apply -areduce -array-map -aset -aset-boolean -aset-byte -aset-char -aset-double -aset-float -aset-int -aset-long -aset-short -assert -assoc -assoc! -assoc-in -associative? -atom -await -await-for -bases -bean -bigdec -bigint -binding -bit-and -bit-and-not -bit-clear -bit-flip -bit-not -bit-or -bit-set -bit-shift-left -bit-shift-right -bit-test -bit-xor -boolean -boolean-array -booleans -bound-fn -bound-fn* -butlast -byte -byte-array -bytes -case -cast -char -char-array -char-escape-string -char-name-string -char? -chars -class -class? -clear-agent-errors -clojure-version -coll? -comment -commute -comp -comparator -compare -compare-and-set! -compile -complement -concat -cond -condp -conj -conj! -cons -constantly -construct-proxy -contains? -count -counted? -create-ns -create-struct -cycle -dec -decimal? -declare -definline -defmacro -defmethod -defmulti -defn -defn- -defonce -defprotocol -defstruct -deftype -delay -delay? -deliver -deref -derive -descendants -disj -disj! -dissoc -dissoc! -distinct -distinct? -doall -doc -dorun -doseq -dosync -dotimes -doto -double -double-array -doubles -drop -drop-last -drop-while -dtype -empty -empty? -ensure -enumeration-seq -error-handler -error-mode -eval -even? -every? -extend -extend-class -extend-protocol -extend-type -extenders -extends? -false? -ffirst -file-seq -filter -find -find-doc -find-ns -find-var -first -float -float-array -float? -floats -flush -fn -fn? -fnext -for -force -format -future -future-call -future-cancel -future-cancelled? -future-done? -future? -gen-class -gen-interface -gensym -get -get-in -get-method -get-proxy-class -get-thread-bindings -get-validator -hash -hash-map -hash-set -identical? -identity -if-let -if-not -ifn? -import -in-ns -inc -init-proxy -instance? -int -int-array -integer? -interleave -intern -interpose -into -into-array -ints -io! -isa? -iterate -iterator-seq -juxt -key -keys -keyword -keyword? -last -lazy-cat -lazy-seq -let -letfn -line-seq -list -list* -list? -load -load-file -load-reader -load-string -loaded-libs -locking -long -long-array -longs -loop -macroexpand -macroexpand-1 -make-array -make-hierarchy -map -map? -mapcat -max -max-key -memfn -memoize -merge -merge-with -meta -methods -min -min-key -mod -name -namespace -neg? -newline -next -nfirst -nil? -nnext -not -not-any? -not-empty -not-every? -not= -ns -ns-aliases -ns-imports -ns-interns -ns-map -ns-name -ns-publics -ns-refers -ns-resolve -ns-unalias -ns-unmap -nth -nthnext -num -number? -object-array -odd? -or -parents -partial -partition -pcalls -peek -persistent! -pmap -pop -pop! -pop-thread-bindings -pos? -pr -pr-str -prefer-method -prefers -print -print-namespace-doc -print-str -printf -println -println-str -prn -prn-str -promise -proxy -proxy-mappings -proxy-super -push-thread-bindings -pvalues -quot -rand -rand-int -range -ratio? -rationalize -re-find -re-groups -re-matcher -re-matches -re-pattern -re-seq -read -read-line -read-string -reduce -ref -ref-history-count -ref-max-history -ref-min-history -ref-set -refer -refer-clojure -reify -release-pending-sends -rem -remove -remove-method -remove-ns -remove-watch -repeat -repeatedly -replace -replicate -require -reset! -reset-meta! -resolve -rest -restart-agent -resultset-seq -reverse -reversible? -rseq -rsubseq -satisfies? -second -select-keys -send -send-off -seq -seq? -seque -sequence -sequential? -set -set-error-handler! -set-error-mode! -set-validator! -set? -short -short-array -shorts -shutdown-agents -slurp -some -sort -sort-by -sorted-map -sorted-map-by -sorted-set -sorted-set-by -sorted? -special-form-anchor -special-symbol? -split-at -split-with -str -stream? -string? -struct -struct-map -subs -subseq -subvec -supers -swap! -symbol -symbol? -sync -syntax-symbol-anchor -take -take-last -take-nth -take-while -test -the-ns -time -to-array -to-array-2d -trampoline -transient -tree-seq -true? -type -unchecked-add -unchecked-dec -unchecked-divide -unchecked-inc -unchecked-multiply -unchecked-negate -unchecked-remainder -unchecked-subtract -underive -update-in -update-proxy -use -val -vals -var-get -var-set -var? -vary-meta -vec -vector -vector-of -vector? -when -when-first -when-let -when-not -while -with-bindings -with-bindings* -with-in-str -with-local-vars -with-meta -with-open -with-out-str -with-precision -xml-seq -zero? -zipmap \ No newline at end of file diff --git a/.emacs.d/ac-dict/css-mode b/.emacs.d/ac-dict/css-mode deleted file mode 100644 index 4ec8f7d..0000000 --- a/.emacs.d/ac-dict/css-mode +++ /dev/null @@ -1,747 +0,0 @@ -!important -ActiveBorder -ActiveCaption -Alpha -AppWorkspace -Background -Barn -BasicImage -Blinds -Blur -ButtonFace -ButtonHighlight -ButtonShadow -ButtonText -CaptionText -CheckerBoard -Chroma -Compositor -CradientWipe -DXImageTransform -DropShadow -Emboss -Engrave -Fade -FlipH -FlipV -Glow -Gray -GrayText -Highlight -HighlightText -Hz -ICMFilter -InactiveBorder -InactiveCaption -InactiveCaptionText -InfoBackground -InfoText -Inset -Invert -Iris -Light -MaskFilter -Matrix -Menu -MenuText -Microsoft -MotionBlur -Pixelate -RadialWipe -RandomBars -RandomDissolve -RevealTrans -Scrollbar -Shadow -Slide -Spiral -Stretch -Strips -ThreeDDarkShadow -ThreeDFace -ThreeDHighlight -ThreeDLightShadow -ThreeDShadow -Wave -Wheel -Window -WindowFrame -WindowText -Xray -Zigzag -_azimuth -_background -_background-position-x -_background-position-y -_border -_bottom -_caption -_clear -_clip -_color -_content -_counter -_cue -_cursor -_direction -_display -_elevation -_empty -_filter -_filter:progid:DXImageTransform.Microsoft -_float -_font -_height -_ime -_ime-mode -_layout -_layout-flow -_layout-grid -_layout-grid-char -_layout-grid-line -_layout-grid-mode -_layout-grid-type -_left -_letter -_line -_line-break -_list -_margin -_orphans -_outline -_overflow -_overflow-x -_overflow-y -_padding -_page -_pause -_pitch -_play -_position -_quotes -_richness -_right -_ruby -_ruby-align -_ruby-overhang -_ruby-position -_scrollbar -_scrollbar-3dlight-color -_scrollbar-arrow-color -_scrollbar-base-color -_scrollbar-darkshadow-color -_scrollbar-face-color -_scrollbar-highlight-color -_scrollbar-track-color -_speak -_speech -_stress -_table -_text -_text-align-last -_text-autospace -_text-justify -_text-kashida-space -_text-overflow -_text-underline-position -_top -_unicode -_vertical -_visibility -_voice -_volume -_white -_widows -_width -_word -_word-break -_word-wrap -_writing -_writing-mode -_z -_zoom -above -active -adjust -after -aliceblue -align -always -antiquewhite -aqua -aquamarine -armenian -arrow -attachment -auto -autospace -avoid -azimuth -azure -background -background-attachment -background-color -background-image -background-position -background-repeat -bar -base -baseline -before -behind -beige -below -bidi -bidi-override -bisque -black -blanchedalmond -blink -block -blue -blueviolet -bold -bolder -border -border-bottom -border-bottom-color -border-bottom-style -border-bottom-width -border-collapse -border-color -border-left -border-left-color -border-left-style -border-left-width -border-right -border-right-color -border-right-style -border-right-width -border-spacing -border-style -border-top -border-top-color -border-top-style -border-top-width -border-width -both -bottom -box -break -brown -burlwood -cadetblue -capitalize -caps -caption -caption-side -cell -cells -center -center-left -center-right -char -chartreuse -chocolate -circle -cjk -cjk-ideographic -clear -clip -close -close-quote -cm -code -collapse -color -column -compact -condensed -content -continuous -coral -cornflowerblue -cornsilk -counter -counter-increment -counter-reset -crimson -crop -cross -crosshair -cue -cue-after -cue-before -cursive -cursor -cyan -darkblue -darkcyan -darkgoldenrod -darkgray -darkgreen -darkkhaki -darkmagenta -darkolivegreen -darkorange -darkorchid -darkred -darksalmon -darkseagreen -darkshadow -darkslateblue -darkslategray -darkturquoise -darkviolet -dashed -decimal -decimal-leading-zero -decoration -deeppink -deepskyblue -default -deg -digits -dimgray -direction -disc -display -dodgerblue -dotted -double -during -e -e-resize -elevation -em -embed -empty -empty-cells -ex -expanded -extra -extra-condensed -extra-expanded -face -family -fantasy -far -far-left -far-right -fast -faster -firebrick -first -first-child -first-letter -first-line -fixed -float -floralwhite -flow -focus -font -font-family -font-size -font-size-adjust -font-stretch -font-style -font-variant -font-weight -footer -forestgreen -fuchsia -gainsboro -georgian -ghostwhite -gold -goldenrod -gray -greek -green -greenyellow -grid -groove -group -header -hebrew -height -help -hidden -hide -high -higher -hiragana -hiragana-iroha -honeydew -hotpink -hover -icon -ideographic -image -in -increment -indent -index -indianred -indigo -inherit -inline -inline-block -inline-table -inset -inside -iroha -italic -item -ivory -justify -kHz -kashida -katakana -katakana-iroha -khaki -landscape -lang() -large -larger -last -latin -lavender -lavenderblush -lawngreen -layout -leading -left -left-side -leftwards -lenonchiffon -letter -letter-spacing -level -lightblue -lightcoral -lightcyan -lighter -lightgoldenrodyellow -lightgray -lightgreen -lightgrey -lightpink -lightsalmon -lightseagreen -lightskyblue -lightslategray -lightsteelblue -lightyellow -lime -limegreen -line -line-height -line-through -linen -link -list -list-item -list-style -list-style-image -list-style-position -list-style-type -loud -low -lower -lower-alpha -lower-greek -lower-latin -lower-roman -lowercase -ltr -magenta -margin -margin-bottom -margin-left -margin-right -margin-top -marker -marker-offset -marks -maroon -max -max-height -max-width -medium -mediumaquamarine -mediumblue -mediumorchid -mediumpurple -mediumseagreen -mediumslateblue -mediumspringgreen -mediumturquoise -mediumvioletred -menu -message -message-box -middle -midnightblue -min -min-height -min-width -mintcream -mistyrose -mix -mm -moccasin -mode -monospace -move -ms -n -n-resize -naby -narrower -navajowhite -ne -ne-resize -no -no-close-quote -no-open-quote -no-repeat -none -normal -nowrap -number -numeral -nw -nw-resize -oblique -offset -oldlace -olive -olivedrab -once -open -open-quote -orange -orangered -orchid -orphans -out -outline -outline-color -outline-style -outline-width -outset -outside -overflow -overhang -overline -override -padding -padding-bottom -padding-left -padding-right -padding-top -page -page-break-after -page-break-before -page-break-inside -palegoldenrod -palegreen -paleturquoise -palevioletred -papayawhip -pause -pause-after -pause-before -pc -peachpuff -peru -pink -pitch -pitch-range -play -play-during -plum -pointer -portarait -position -powderblue -pre -pre-line -pre-wrap -progid -progress -pt -punctuation -purple -px -quote -quotes -rad -range -rate -red -relative -repeat -repeat-x -repeat-y -reset -resize -richness -ridge -right -right-side -rightwards -roman -rosybrown -row -royalblue -rtl -run -run-in -s -s-resize -saddlebrown -salmon -sandybrown -sans-serif -scroll -se -se-resize -seagreen -seashell -semi -semi-condensed -semi-expanded -separate -serif -shadow -show -side -sienna -silent -silever -silver -size -skyblue -slateblue -slategray -slow -slower -small -small-caps -small-caption -smaller -snow -soft -solid -space -spacing -speak -speak-header -speak-numeral -speak-punctuation -specific -specific-voice -speech -speech-rate -spell -spell-out -springgreen -square -static -status -status-bar -steelblue -stress -stretch -style -sub -super -sw -sw-resize -table -table-caption -table-cell -table-column -table-column-group -table-footer-group -table-header-group -table-layout -table-row -table-row-group -tan -teal -text -text-align -text-bottom -text-decoration -text-indent -text-shadow -text-top -text-transform -thick -thin -thistle -through -tomato -top -track -transform -transparent -turquoise -type -ultra -ultra-condensed -ultra-expanded -underline -unicode -unicode-bidi -upper -upper-alpha -upper-latin -upper-roman -uppercase -variant -vertical -vertical-align -violet -visibility -visible -visited -voice -voice-family -volume -w -w-resize -wait -weight -wheat -white -white-space -whitesmoke -wider -widows -width -word -word-spacing -wrap -x -x-fast -x-high -x-large -x-loud -x-low -x-slow -x-small -x-soft -xx -xx-large -xx-small -y -yellow -yellowgreen -z -z-index -zero diff --git a/.emacs.d/ac-dict/java-mode b/.emacs.d/ac-dict/java-mode deleted file mode 100644 index 8ed3d04..0000000 --- a/.emacs.d/ac-dict/java-mode +++ /dev/null @@ -1,50 +0,0 @@ -abstract -assert -boolean -break -byte -case -catch -char -class -const -continue -default -do -double -else -enum -extends -final -finally -float -for -goto -if -implements -import -instanceof -int -interface -long -native -new -package -private -protected -public -return -short -static -strictfp -super -switch -synchronized -this -throw -throws -transient -try -void -volatile -while diff --git a/.emacs.d/ac-dict/javascript-mode b/.emacs.d/ac-dict/javascript-mode deleted file mode 100644 index 3d83f84..0000000 --- a/.emacs.d/ac-dict/javascript-mode +++ /dev/null @@ -1,148 +0,0 @@ -Anchor -Area -Array -Boolean -Button -Checkbox -Date -Document -Element -FileUpload -Form -Frame -Function -Hidden -History -Image -Infinity -JavaArray -JavaClass -JavaObject -JavaPackage -Link -Location -Math -MimeType -NaN -Navigator -Number -Object -Option -Packages -Password -Plugin -Radio -RegExp -Reset -Select -String -Submit -Text -Textarea -Window -alert -arguments -assign -blur -break -callee -caller -captureEvents -case -clearInterval -clearTimeout -close -closed -comment -confirm -constructor -continue -default -defaultStatus -delete -do -document -else -escape -eval -export -find -focus -for -frames -function -getClass -history -home -if -import -in -innerHeight -innerWidth -isFinite -isNan -java -label -length -location -locationbar -menubar -moveBy -moveTo -name -navigate -navigator -netscape -new -onBlur -onError -onFocus -onLoad -onUnload -open -opener -outerHeight -outerWidth -pageXoffset -pageYoffset -parent -parseFloat -parseInt -personalbar -print -prompt -prototype -ref -releaseEvents -resizeBy -resizeTo -return -routeEvent -scroll -scrollBy -scrollTo -scrollbars -self -setInterval -setTimeout -status -statusbar -stop -sun -switch -taint -this -toString -toolbar -top -typeof -unescape -untaint -unwatch -valueOf -var -void -watch -while -window -with diff --git a/.emacs.d/ac-dict/php-mode b/.emacs.d/ac-dict/php-mode deleted file mode 100644 index 04352d8..0000000 --- a/.emacs.d/ac-dict/php-mode +++ /dev/null @@ -1,62 +0,0 @@ -and -array -as -break -case -catch -cfunction -class -clone -const -continue -declare -default -die -do -echo -else -elseif -empty -enddeclare -endfor -endforeach -endif -endswitch -endwhile -eval -exit -extends -final -for -foreach -function -global -goto -if -implements -include -include_once -instanceof -interface -isset -list -namespace -new -old_function -or -print -private -protected -public -require -require_once -return -static -switch -throw -try -unset -use -var -while -xor diff --git a/.emacs.d/ac-dict/python-mode b/.emacs.d/ac-dict/python-mode deleted file mode 100644 index 33b4b32..0000000 --- a/.emacs.d/ac-dict/python-mode +++ /dev/null @@ -1,104 +0,0 @@ -__import__ -abs -and -any -apply -as -assert -basestring -bin -bool -break -buffer -class -cmp -coerce -complex -continue -def -del -delattr -dict -dir -divmod -elif -else -enumerate -eval -except -exec -execfile -file -filter -finally -float -for -format -from -frozenset -getattr -global -globals -hasattr -hash -help -hex -id -if -import -in -input -int -intern -is -isinstance -issubclass -iter -lambda -len -list -locals -long -map -max -min -next -not -object -oct -open -or -ord -pass -pow -print -print -property -raise -range -raw_input -reduce -reload -repr -return -reversed -round -set -setattr -slice -sorted -staticmethod -str -sum -super -try -tuple -type -unichr -unicode -vars -while -with -xrange -yield -zip diff --git a/.emacs.d/ac-dict/ruby-mode b/.emacs.d/ac-dict/ruby-mode deleted file mode 100644 index 90b4fc9..0000000 --- a/.emacs.d/ac-dict/ruby-mode +++ /dev/null @@ -1,181 +0,0 @@ -$! -$" -$$ -$& -$' -$* -$+ -$, -$-0 -$-F -$-I -$-K -$-a -$-d -$-i -$-l -$-p -$-v -$-w -$. -$/ -$0 -$1 -$10 -$11 -$2 -$3 -$4 -$5 -$6 -$7 -$8 -$9 -$: -$; -$< -$= -$> -$? -$@ -$DEBUG -$FILENAME -$KCODE -$LOADED_FEATURES -$LOAD_PATH -$PROGRAM_NAME -$SAFE -$VERBOSE -$\ -$_ -$` -$deferr -$defout -$stderr -$stdin -$stdout -$~ -ARGF -ARGV -Array -BEGIN -DATA -END -ENV -FALSE -Float -Integer -NIL -PLATFORM -RELEASE_DATE -RUBY_COPYRIGHT -RUBY_DESCRIPTION -RUBY_PATCHLEVEL -RUBY_PLATFORM -RUBY_RELEASE_DATE -RUBY_VERSION -SCRIPT_LINES__ -STDERR -STDIN -STDOUT -String -TOPLEVEL_BINDING -TRUE -VERSION -__method__ -` -abort -alias -and -at_exit -autoload -autoload? -begin -binding -block_given -break -callcc -caller -case -catch -chomp -chomp! -chop -chop -class -def -defined? -do -else -elsif -end -ensure -eval -exec -exit -exit! -fail -false -for -fork -format -getc -gets -global_variables -gsub -gsub! -if -in -iterator? -lambda -load -local_varaibles -loop -module -next -nil -not -open -or -p -printf -proc -putc -puts -raise -rand -readline -readlines -redo -require -require_relative -rescue -retry -return -scan -select -self -set_trace_func -sleep -split -sprintf -srand -sub -sub! -super -syscall -system -test -then -throw -trace_var -trap -true -undef -unless -until -untrace_var -warn -when -while -yield diff --git a/.emacs.d/ac-dict/scheme-mode b/.emacs.d/ac-dict/scheme-mode deleted file mode 100644 index e5cca61..0000000 --- a/.emacs.d/ac-dict/scheme-mode +++ /dev/null @@ -1,216 +0,0 @@ -case-lambda -call/cc -class -define-class -exit-handler -field -import -inherit -init-field -interface -let*-values -let-values -let/ec -mixin -opt-lambda -override -protect -provide -public -rename -require -require-for-syntax -syntax -syntax-case -syntax-error -unit/sig -unless -when -with-syntax -and -begin -call-with-current-continuation -call-with-input-file -call-with-output-file -case -cond -define -define-syntax -delay -do -dynamic-wind -else -for-each -if -lambda -let -let* -let-syntax -letrec -letrec-syntax -map -or -syntax-rules -abs -acos -angle -append -apply -asin -assoc -assq -assv -atan -boolean? -caar -cadr -call-with-input-file -call-with-output-file -call-with-values -car -cdddar -cddddr -cdr -ceiling -char->integer -char-alphabetic? -char-ci<=? -char-ci=? -char-ci>? -char-downcase -char-lower-case? -char-numeric? -char-ready? -char-upcase -char-upper-case? -char-whitespace? -char<=? -char=? -char>? -char? -close-input-port -close-output-port -complex? -cons -cos -current-input-port -current-output-port -denominator -display -eof-object? -eq? -equal? -eqv? -eval -even? -exact->inexact -exact? -exp -expt -#f -floor -force -gcd -imag-part -inexact->exact -inexact? -input-port? -integer->char -integer? -interaction-environment -lcm -length -list -list->string -list->vector -list-ref -list-tail -list? -load -log -magnitude -make-polar -make-rectangular -make-string -make-vector -max -member -memq -memv -min -modulo -negative? -newline -not -null-environment -null? -number->string -number? -numerator -odd? -open-input-file -open-output-file -output-port? -pair? -peek-char -port? -positive? -procedure? -quasiquote -quote -quotient -rational? -rationalize -read -read-char -real-part -real? -remainder -reverse -round -scheme-report-environment -set! -set-car! -set-cdr! -sin -sqrt -string -string->list -string->number -string->symbol -string-append -string-ci<=? -string-ci=? -string-ci>? -string-copy -string-fill! -string-length -string-ref -string-set! -string<=? -string=? -string>? -string? -substring -symbol->string -symbol? -#t -tan -transcript-off -transcript-on -truncate -values -vector -vector->list -vector-fill! -vector-length -vector-ref -vector-set! diff --git a/.emacs.d/ac-dict/tcl-mode b/.emacs.d/ac-dict/tcl-mode deleted file mode 100644 index 07a1281..0000000 --- a/.emacs.d/ac-dict/tcl-mode +++ /dev/null @@ -1,172 +0,0 @@ -after -append -apply -array -auto_execok -auto_import -auto_load -auto_load_index -auto_mkindex -auto_mkindex_old -auto_qualify -auto_reset -bell -binary -bind -bindtags -break -button -canvas -case -catch -cd -chan -checkbutton -clipboard -clock -close -concat -continue -destroy -dict -encoding -entry -eof -error -eval -event -exec -exit -expr -fblocked -fconfigure -fcopy -file -fileevent -flush -focus -font -for -foreach -format -frame -gets -glob -global -grab -grid -if -image -incr -info -interp -join -label -labelframe -lappend -lassign -lindex -linsert -list -listbox -llength -load -lower -lrange -lrepeat -lreplace -lreverse -lsearch -lset -lsort -menu -menubutton -message -namespace -open -option -pack -package -panedwindow -pid -pkg_mkIndex -place -proc -puts -pwd -radiobutton -raise -read -regexp -registry -regsub -rename -return -scale -scan -scrollbar -seek -selection -set -socket -source -spinbox -split -string -subst -switch -tclLog -tclPkgSetup -tclPkgUnknown -tcl_findLibrary -tell -text -time -tk -tk_chooseColor -tk_chooseDirectory -tk_getOpenFile -tk_getSaveFile -tk_menuSetFocus -tk_messageBox -tk_popup -tk_textCopy -tk_textCut -tk_textPaste -tkwait -toplevel -ttk::button -ttk::checkbutton -ttk::combobox -ttk::entry -ttk::focusFirst -ttk::frame -ttk::label -ttk::labelframe -ttk::menubutton -ttk::notebook -ttk::paned -ttk::panedwindow -ttk::progressbar -ttk::radiobutton -ttk::scale -ttk::scrollbar -ttk::separator -ttk::setTheme -ttk::sizegrip -ttk::style -ttk::takefocus -ttk::themes -ttk::treeview -trace -unknown -unload -unset -update -uplevel -upvar -variable -vwait -while -winfo -wm diff --git a/.emacs.d/auto-complete-config.el b/.emacs.d/auto-complete-config.el deleted file mode 100644 index 26ec044..0000000 --- a/.emacs.d/auto-complete-config.el +++ /dev/null @@ -1,480 +0,0 @@ -;;; auto-complete-config.el --- auto-complete additional configuations - -;; Copyright (C) 2009, 2010 Tomohiro Matsuyama - -;; Author: Tomohiro Matsuyama -;; Keywords: convenience -;; Version: 1.3 - -;; 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: - -;; - -;;; Code: - -(eval-when-compile - (require 'cl)) - -(require 'auto-complete) - - - -;;;; Additional sources - -;; imenu - -(defvar ac-imenu-index nil) - -(ac-clear-variable-every-10-minutes 'ac-imenu-index) - -(defun ac-imenu-candidates () - (loop with i = 0 - with stack = (progn - (unless (local-variable-p 'ac-imenu-index) - (make-local-variable 'ac-imenu-index)) - (or ac-imenu-index - (setq ac-imenu-index - (ignore-errors - (with-no-warnings - (imenu--make-index-alist)))))) - with result - while (and stack (or (not (integerp ac-limit)) - (< i ac-limit))) - for node = (pop stack) - if (consp node) - do - (let ((car (car node)) - (cdr (cdr node))) - (if (consp cdr) - (mapc (lambda (child) - (push child stack)) - cdr) - (when (and (stringp car) - (string-match (concat "^" (regexp-quote ac-prefix)) car)) - ;; Remove extra characters - (if (string-match "^.*\\(()\\|=\\|<>\\)$" car) - (setq car (substring car 0 (match-beginning 1)))) - (push car result) - (incf i)))) - finally return (nreverse result))) - -(ac-define-source imenu - '((depends imenu) - (candidates . ac-imenu-candidates) - (symbol . "s"))) - -;; gtags - -(defface ac-gtags-candidate-face - '((t (:background "lightgray" :foreground "navy"))) - "Face for gtags candidate" - :group 'auto-complete) - -(defface ac-gtags-selection-face - '((t (:background "navy" :foreground "white"))) - "Face for the gtags selected candidate." - :group 'auto-complete) - -(defun ac-gtags-candidate () - (ignore-errors - (split-string (shell-command-to-string (format "global -ci %s" ac-prefix)) "\n"))) - -(ac-define-source gtags - '((candidates . ac-gtags-candidate) - (candidate-face . ac-gtags-candidate-face) - (selection-face . ac-gtags-selection-face) - (requires . 3) - (symbol . "s"))) - -;; yasnippet - -(defface ac-yasnippet-candidate-face - '((t (:background "sandybrown" :foreground "black"))) - "Face for yasnippet candidate." - :group 'auto-complete) - -(defface ac-yasnippet-selection-face - '((t (:background "coral3" :foreground "white"))) - "Face for the yasnippet selected candidate." - :group 'auto-complete) - -(defun ac-yasnippet-table-hash (table) - (cond - ((fboundp 'yas/snippet-table-hash) - (yas/snippet-table-hash table)) - ((fboundp 'yas/table-hash) - (yas/table-hash table)))) - -(defun ac-yasnippet-table-parent (table) - (cond - ((fboundp 'yas/snippet-table-parent) - (yas/snippet-table-parent table)) - ((fboundp 'yas/table-parent) - (yas/table-parent table)))) - -(defun ac-yasnippet-candidate-1 (table) - (with-no-warnings - (let ((hashtab (ac-yasnippet-table-hash table)) - (parent (ac-yasnippet-table-parent table)) - candidates) - (maphash (lambda (key value) - (push key candidates)) - hashtab) - (setq candidates (all-completions ac-prefix (nreverse candidates))) - (if parent - (setq candidates - (append candidates (ac-yasnippet-candidate-1 parent)))) - candidates))) - -(defun ac-yasnippet-candidates () - (with-no-warnings - (if (fboundp 'yas/get-snippet-tables) - ;; >0.6.0 - (apply 'append (mapcar 'ac-yasnippet-candidate-1 (yas/get-snippet-tables major-mode))) - (let ((table - (if (fboundp 'yas/snippet-table) - ;; <0.6.0 - (yas/snippet-table major-mode) - ;; 0.6.0 - (yas/current-snippet-table)))) - (if table - (ac-yasnippet-candidate-1 table)))))) - -(ac-define-source yasnippet - '((depends yasnippet) - (candidates . ac-yasnippet-candidates) - (action . yas/expand) - (candidate-face . ac-yasnippet-candidate-face) - (selection-face . ac-yasnippet-selection-face) - (symbol . "a"))) - -;; semantic - -(defun ac-semantic-candidates (prefix) - (with-no-warnings - (delete "" ; semantic sometimes returns an empty string - (mapcar 'semantic-tag-name - (ignore-errors - (or (semantic-analyze-possible-completions - (semantic-analyze-current-context)) - (senator-find-tag-for-completion prefix))))))) - -(ac-define-source semantic - '((available . (or (require 'semantic-ia nil t) - (require 'semantic/ia nil t))) - (candidates . (ac-semantic-candidates ac-prefix)) - (prefix . c-dot-ref) - (requires . 0) - (symbol . "m"))) - -(ac-define-source semantic-raw - '((available . (or (require 'semantic-ia nil t) - (require 'semantic/ia nil t))) - (candidates . (ac-semantic-candidates ac-prefix)) - (symbol . "s"))) - -;; eclim - -(defun ac-eclim-candidates () - (with-no-warnings - (loop for c in (eclim/java-complete) - collect (nth 1 c)))) - -(ac-define-source eclim - '((candidates . ac-eclim-candidates) - (prefix . c-dot) - (requires . 0) - (symbol . "f"))) - -;; css - -;; Copied from company-css.el -(defconst ac-css-property-alist - ;; see http://www.w3.org/TR/CSS21/propidx.html - '(("azimuth" angle "left-side" "far-left" "left" "center-left" "center" - "center-right" "right" "far-right" "right-side" "behind" "leftwards" - "rightwards") - ("background" background-color background-image background-repeat - background-attachment background-position) - ("background-attachment" "scroll" "fixed") - ("background-color" color "transparent") - ("background-image" uri "none") - ("background-position" percentage length "left" "center" "right" percentage - length "top" "center" "bottom" "left" "center" "right" "top" "center" - "bottom") - ("background-repeat" "repeat" "repeat-x" "repeat-y" "no-repeat") - ("border" border-width border-style border-color) - ("border-bottom" border) - ("border-bottom-color" border-color) - ("border-bottom-style" border-style) - ("border-bottom-width" border-width) - ("border-collapse" "collapse" "separate") - ("border-color" color "transparent") - ("border-left" border) - ("border-left-color" border-color) - ("border-left-style" border-style) - ("border-left-width" border-width) - ("border-right" border) - ("border-right-color" border-color) - ("border-right-style" border-style) - ("border-right-width" border-width) - ("border-spacing" length length) - ("border-style" border-style) - ("border-top" border) - ("border-top-color" border-color) - ("border-top-style" border-style) - ("border-top-width" border-width) - ("border-width" border-width) - ("bottom" length percentage "auto") - ("caption-side" "top" "bottom") - ("clear" "none" "left" "right" "both") - ("clip" shape "auto") - ("color" color) - ("content" "normal" "none" string uri counter "attr()" "open-quote" - "close-quote" "no-open-quote" "no-close-quote") - ("counter-increment" identifier integer "none") - ("counter-reset" identifier integer "none") - ("cue" cue-before cue-after) - ("cue-after" uri "none") - ("cue-before" uri "none") - ("cursor" uri "*" "auto" "crosshair" "default" "pointer" "move" "e-resize" - "ne-resize" "nw-resize" "n-resize" "se-resize" "sw-resize" "s-resize" - "w-resize" "text" "wait" "help" "progress") - ("direction" "ltr" "rtl") - ("display" "inline" "block" "list-item" "run-in" "inline-block" "table" - "inline-table" "table-row-group" "table-header-group" "table-footer-group" - "table-row" "table-column-group" "table-column" "table-cell" - "table-caption" "none") - ("elevation" angle "below" "level" "above" "higher" "lower") - ("empty-cells" "show" "hide") - ("float" "left" "right" "none") - ("font" font-style font-variant font-weight font-size "/" line-height - font-family "caption" "icon" "menu" "message-box" "small-caption" - "status-bar") - ("font-family" family-name generic-family) - ("font-size" absolute-size relative-size length percentage) - ("font-style" "normal" "italic" "oblique") - ("font-variant" "normal" "small-caps") - ("font-weight" "normal" "bold" "bolder" "lighter" "100" "200" "300" "400" - "500" "600" "700" "800" "900") - ("height" length percentage "auto") - ("left" length percentage "auto") - ("letter-spacing" "normal" length) - ("line-height" "normal" number length percentage) - ("list-style" list-style-type list-style-position list-style-image) - ("list-style-image" uri "none") - ("list-style-position" "inside" "outside") - ("list-style-type" "disc" "circle" "square" "decimal" "decimal-leading-zero" - "lower-roman" "upper-roman" "lower-greek" "lower-latin" "upper-latin" - "armenian" "georgian" "lower-alpha" "upper-alpha" "none") - ("margin" margin-width) - ("margin-bottom" margin-width) - ("margin-left" margin-width) - ("margin-right" margin-width) - ("margin-top" margin-width) - ("max-height" length percentage "none") - ("max-width" length percentage "none") - ("min-height" length percentage) - ("min-width" length percentage) - ("orphans" integer) - ("outline" outline-color outline-style outline-width) - ("outline-color" color "invert") - ("outline-style" border-style) - ("outline-width" border-width) - ("overflow" "visible" "hidden" "scroll" "auto") - ("padding" padding-width) - ("padding-bottom" padding-width) - ("padding-left" padding-width) - ("padding-right" padding-width) - ("padding-top" padding-width) - ("page-break-after" "auto" "always" "avoid" "left" "right") - ("page-break-before" "auto" "always" "avoid" "left" "right") - ("page-break-inside" "avoid" "auto") - ("pause" time percentage) - ("pause-after" time percentage) - ("pause-before" time percentage) - ("pitch" frequency "x-low" "low" "medium" "high" "x-high") - ("pitch-range" number) - ("play-during" uri "mix" "repeat" "auto" "none") - ("position" "static" "relative" "absolute" "fixed") - ("quotes" string string "none") - ("richness" number) - ("right" length percentage "auto") - ("speak" "normal" "none" "spell-out") - ("speak-header" "once" "always") - ("speak-numeral" "digits" "continuous") - ("speak-punctuation" "code" "none") - ("speech-rate" number "x-slow" "slow" "medium" "fast" "x-fast" "faster" - "slower") - ("stress" number) - ("table-layout" "auto" "fixed") - ("text-align" "left" "right" "center" "justify") - ("text-decoration" "none" "underline" "overline" "line-through" "blink") - ("text-indent" length percentage) - ("text-transform" "capitalize" "uppercase" "lowercase" "none") - ("top" length percentage "auto") - ("unicode-bidi" "normal" "embed" "bidi-override") - ("vertical-align" "baseline" "sub" "super" "top" "text-top" "middle" - "bottom" "text-bottom" percentage length) - ("visibility" "visible" "hidden" "collapse") - ("voice-family" specific-voice generic-voice "*" specific-voice - generic-voice) - ("volume" number percentage "silent" "x-soft" "soft" "medium" "loud" - "x-loud") - ("white-space" "normal" "pre" "nowrap" "pre-wrap" "pre-line") - ("widows" integer) - ("width" length percentage "auto") - ("word-spacing" "normal" length) - ("z-index" "auto" integer)) - "A list of CSS properties and their possible values.") - -(defconst ac-css-value-classes - '((absolute-size "xx-small" "x-small" "small" "medium" "large" "x-large" - "xx-large") - (border-style "none" "hidden" "dotted" "dashed" "solid" "double" "groove" - "ridge" "inset" "outset") - (color "aqua" "black" "blue" "fuchsia" "gray" "green" "lime" "maroon" "navy" - "olive" "orange" "purple" "red" "silver" "teal" "white" "yellow" - "rgb") - (counter "counter") - (family-name "Courier" "Helvetica" "Times") - (generic-family "serif" "sans-serif" "cursive" "fantasy" "monospace") - (generic-voice "male" "female" "child") - (margin-width "auto") ;; length percentage - (relative-size "larger" "smaller") - (shape "rect") - (uri "url")) - "A list of CSS property value classes and their contents.") - -(defconst ac-css-pseudo-classes - '("active" "after" "before" "first" "first-child" "first-letter" "first-line" - "focus" "hover" "lang" "left" "link" "right" "visited") - "Identifiers for CSS pseudo-elements and pseudo-classes.") - -(defvar ac-css-property nil - "Current editing property.") - -(defun ac-css-prefix () - (when (save-excursion (re-search-backward "\\_<\\(.+?\\)\\_>\\s *:.*\\=" nil t)) - (setq ac-css-property (match-string 1)) - (or (ac-prefix-symbol) (point)))) - -(defun ac-css-property-candidates () - (or (loop with list = (assoc-default ac-css-property ac-css-property-alist) - with value - while (setq value (pop list)) - if (symbolp value) - do (setq list - (append list - (or (assoc-default value ac-css-value-classes) - (assoc-default (symbol-name value) ac-css-property-alist)))) - else collect value) - ac-css-pseudo-classes)) - -(defvar ac-source-css-property - '((candidates . ac-css-property-candidates) - (prefix . ac-css-prefix) - (requires . 0))) - - - -;;;; Not maintained sources - -;; ropemacs - -(defvar ac-ropemacs-loaded nil) -(defun ac-ropemacs-require () - (with-no-warnings - (unless ac-ropemacs-loaded - (pymacs-load "ropemacs" "rope-") - (if (boundp 'ropemacs-enable-autoimport) - (setq ropemacs-enable-autoimport t)) - (setq ac-ropemacs-loaded t)))) - -(defun ac-ropemacs-setup () - (ac-ropemacs-require) - ;(setq ac-sources (append (list 'ac-source-ropemacs) ac-sources)) - (setq ac-omni-completion-sources '(("\\." ac-source-ropemacs)))) - -(defun ac-ropemacs-initialize () - (autoload 'pymacs-apply "pymacs") - (autoload 'pymacs-call "pymacs") - (autoload 'pymacs-eval "pymacs" nil t) - (autoload 'pymacs-exec "pymacs" nil t) - (autoload 'pymacs-load "pymacs" nil t) - (add-hook 'python-mode-hook 'ac-ropemacs-setup) - t) - -(defvar ac-ropemacs-completions-cache nil) -(defvar ac-source-ropemacs - '((init - . (lambda () - (setq ac-ropemacs-completions-cache - (mapcar - (lambda (completion) - (concat ac-prefix completion)) - (ignore-errors - (rope-completions)))))) - (candidates . ac-ropemacs-completions-cache))) - -;; rcodetools - -(defvar ac-source-rcodetools - '((init . (lambda () - (require 'rcodetools) - (condition-case x - (save-excursion - (rct-exec-and-eval rct-complete-command-name "--completion-emacs-icicles")) - (error) (setq rct-method-completion-table nil)))) - (candidates . (lambda () - (all-completions - ac-prefix - (mapcar - (lambda (completion) - (replace-regexp-in-string "\t.*$" "" (car completion))) - rct-method-completion-table)))))) - - - -;;;; Default settings - -(defun ac-common-setup () - (add-to-list 'ac-sources 'ac-source-filename)) - -(defun ac-emacs-lisp-mode-setup () - (setq ac-sources (append '(ac-source-features ac-source-functions ac-source-yasnippet ac-source-variables ac-source-symbols) ac-sources))) - -(defun ac-cc-mode-setup () - (setq ac-sources (append '(ac-source-yasnippet ac-source-gtags) ac-sources))) - -(defun ac-ruby-mode-setup () - (make-local-variable 'ac-ignores) - (add-to-list 'ac-ignores "end")) - -(defun ac-css-mode-setup () - (setq ac-sources (append '(ac-source-css-property) ac-sources))) - -(defun ac-config-default () - (setq-default ac-sources '(ac-source-abbrev ac-source-dictionary ac-source-words-in-same-mode-buffers)) - (add-hook 'emacs-lisp-mode-hook 'ac-emacs-lisp-mode-setup) - (add-hook 'c-mode-common-hook 'ac-cc-mode-setup) - (add-hook 'ruby-mode-hook 'ac-ruby-mode-setup) - (add-hook 'css-mode-hook 'ac-css-mode-setup) - (add-hook 'auto-complete-mode-hook 'ac-common-setup) - (global-auto-complete-mode t)) - -(provide 'auto-complete-config) -;;; auto-complete-config.el ends here diff --git a/.emacs.d/auto-complete-config.elc b/.emacs.d/auto-complete-config.elc deleted file mode 100644 index 2761c49..0000000 Binary files a/.emacs.d/auto-complete-config.elc and /dev/null differ diff --git a/.emacs.d/auto-complete.el b/.emacs.d/auto-complete.el deleted file mode 100644 index 2472dc7..0000000 --- a/.emacs.d/auto-complete.el +++ /dev/null @@ -1,1897 +0,0 @@ -;;; auto-complete.el --- Auto Completion for GNU Emacs - -;; Copyright (C) 2008, 2009, 2010 Tomohiro Matsuyama - -;; Author: Tomohiro Matsuyama -;; URL: http://cx4a.org/software/auto-complete -;; Keywords: completion, convenience -;; Version: 1.3 - -;; 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 extension provides a way to complete with popup menu like: -;; -;; def-!- -;; +-----------------+ -;; |defun::::::::::::| -;; |defvar | -;; |defmacro | -;; | ... | -;; +-----------------+ -;; -;; You can complete by typing and selecting menu. -;; -;; Entire documents are located in doc/ directory. -;; Take a look for information. -;; -;; Enjoy! - -;;; Code: - - - -(eval-when-compile - (require 'cl)) - -(require 'popup) - -;;;; Global stuff - -(defun ac-error (&optional var) - "Report an error and disable `auto-complete-mode'." - (ignore-errors - (message "auto-complete error: %s" var) - (auto-complete-mode -1) - var)) - - - -;;;; Customization - -(defgroup auto-complete nil - "Auto completion." - :group 'completion - :prefix "ac-") - -(defcustom ac-delay 0.1 - "Delay to completions will be available." - :type 'float - :group 'auto-complete) - -(defcustom ac-auto-show-menu 0.8 - "Non-nil means completion menu will be automatically shown." - :type '(choice (const :tag "Yes" t) - (const :tag "Never" nil) - (float :tag "Timer")) - :group 'auto-complete) - -(defcustom ac-show-menu-immediately-on-auto-complete t - "Non-nil means menu will be showed immediately on `auto-complete'." - :type 'boolean - :group 'auto-complete) - -(defcustom ac-expand-on-auto-complete t - "Non-nil means expand whole common part on first time `auto-complete'." - :type 'boolean - :group 'auto-complete) - -(defcustom ac-disable-faces '(font-lock-comment-face font-lock-string-face font-lock-doc-face) - "Non-nil means disable automatic completion on specified faces." - :type '(repeat symbol) - :group 'auto-complete) - -(defcustom ac-stop-flymake-on-completing t - "Non-nil means disble flymake temporarily on completing." - :type 'boolean - :group 'auto-complete) - -(defcustom ac-use-fuzzy t - "Non-nil means use fuzzy matching." - :type 'boolean - :group 'auto-complete) - -(defcustom ac-fuzzy-cursor-color "red" - "Cursor color in fuzzy mode." - :type 'string - :group 'auto-complete) - -(defcustom ac-use-comphist t - "Non-nil means use intelligent completion history." - :type 'boolean - :group 'auto-complete) - -(defcustom ac-comphist-threshold 0.7 - "Percentage of ignoring low scored candidates." - :type 'float - :group 'auto-complete) - -(defcustom ac-comphist-file - (expand-file-name (concat (if (boundp 'user-emacs-directory) - user-emacs-directory - "~/.emacs.d/") - "/ac-comphist.dat")) - "Completion history file name." - :type 'string - :group 'auto-complete) - -(defcustom ac-use-quick-help t - "Non-nil means use quick help." - :type 'boolean - :group 'auto-complete) - -(defcustom ac-quick-help-delay 1.5 - "Delay to show quick help." - :type 'float - :group 'auto-complete) - -(defcustom ac-menu-height 10 - "Max height of candidate menu." - :type 'integer - :group 'auto-complete) -(defvaralias 'ac-candidate-menu-height 'ac-menu-height) - -(defcustom ac-quick-help-height 20 - "Max height of quick help." - :type 'integer - :group 'auto-complete) - -(defcustom ac-quick-help-prefer-x t - "Prefer X tooltip than overlay popup for displaying quick help." - :type 'boolean - :group 'auto-complete) - -(defcustom ac-candidate-limit nil - "Limit number of candidates. Non-integer means no limit." - :type 'integer - :group 'auto-complete) -(defvaralias 'ac-candidate-max 'ac-candidate-limit) - -(defcustom ac-modes - '(emacs-lisp-mode - lisp-interaction-mode - c-mode cc-mode c++-mode - java-mode clojure-mode scala-mode - scheme-mode - ocaml-mode tuareg-mode - perl-mode cperl-mode python-mode ruby-mode - ecmascript-mode javascript-mode js-mode js2-mode php-mode css-mode - makefile-mode sh-mode fortran-mode f90-mode ada-mode - xml-mode sgml-mode) - "Major modes `auto-complete-mode' can run on." - :type '(repeat symbol) - :group 'auto-complete) - -(defcustom ac-compatible-packages-regexp - "^ac-" - "Regexp to indicate what packages can work with auto-complete." - :type 'string - :group 'auto-complete) - -(defcustom ac-trigger-commands - '(self-insert-command) - "Trigger commands that specify whether `auto-complete' should start or not." - :type '(repeat symbol) - :group 'auto-complete) - -(defcustom ac-trigger-commands-on-completing - '(delete-backward-char - backward-delete-char - backward-delete-char-untabify) - "Trigger commands that specify whether `auto-complete' should continue or not." - :type '(repeat symbol) - :group 'auto-complete) - -(defcustom ac-trigger-key nil - "Non-nil means `auto-complete' will start by typing this key. -If you specify this TAB, for example, `auto-complete' will start by typing TAB, -and if there is no completions, an original command will be fallbacked." - :type 'string - :group 'auto-complete - :set (lambda (symbol value) - (set-default symbol value) - (when (and value - (fboundp 'ac-set-trigger-key)) - (ac-set-trigger-key value)))) - -(defcustom ac-auto-start 2 - "Non-nil means completion will be started automatically. -Positive integer means if a length of a word you entered is larger than the value, -completion will be started automatically. -If you specify `nil', never be started automatically." - :type '(choice (const :tag "Yes" t) - (const :tag "Never" nil) - (integer :tag "Require")) - :group 'auto-complete) - -(defcustom ac-ignores nil - "List of string to ignore completion." - :type '(repeat string) - :group 'auto-complete) - -(defcustom ac-ignore-case 'smart - "Non-nil means auto-complete ignores case. -If this value is `smart', auto-complete ignores case only when -a prefix doen't contain any upper case letters." - :type '(choice (const :tag "Yes" t) - (const :tag "Smart" smart) - (const :tag "No" nil)) - :group 'auto-complete) - -(defcustom ac-dwim t - "Non-nil means `auto-complete' works based on Do What I Mean." - :type 'boolean - :group 'auto-complete) - -(defcustom ac-use-menu-map nil - "Non-nil means a special keymap `ac-menu-map' on completing menu will be used." - :type 'boolean - :group 'auto-complete) - -(defcustom ac-use-overriding-local-map nil - "Non-nil means `overriding-local-map' will be used to hack for overriding key events on auto-copletion." - :type 'boolean - :group 'auto-complete) - -(defface ac-completion-face - '((t (:foreground "darkgray" :underline t))) - "Face for inline completion" - :group 'auto-complete) - -(defface ac-candidate-face - '((t (:background "lightgray" :foreground "black"))) - "Face for candidate." - :group 'auto-complete) - -(defface ac-selection-face - '((t (:background "steelblue" :foreground "white"))) - "Face for selected candidate." - :group 'auto-complete) - -(defvar auto-complete-mode-hook nil - "Hook for `auto-complete-mode'.") - - - -;;;; Internal variables - -(defvar auto-complete-mode nil - "Dummy variable to suppress compiler warnings.") - -(defvar ac-cursor-color nil - "Old cursor color.") - -(defvar ac-inline nil - "Inline completion instance.") - -(defvar ac-menu nil - "Menu instance.") - -(defvar ac-show-menu nil - "Flag to show menu on timer tick.") - -(defvar ac-last-completion nil - "Cons of prefix marker and selected item of last completion.") - -(defvar ac-quick-help nil - "Quick help instance") - -(defvar ac-completing nil - "Non-nil means `auto-complete-mode' is now working on completion.") - -(defvar ac-buffer nil - "Buffer where auto-complete is started.") - -(defvar ac-point nil - "Start point of prefix.") - -(defvar ac-last-point nil - "Last point of updating pattern.") - -(defvar ac-prefix nil - "Prefix string.") -(defvaralias 'ac-target 'ac-prefix) - -(defvar ac-selected-candidate nil - "Last selected candidate.") - -(defvar ac-common-part nil - "Common part string of meaningful candidates. -If there is no common part, this will be nil.") - -(defvar ac-whole-common-part nil - "Common part string of whole candidates. -If there is no common part, this will be nil.") - -(defvar ac-prefix-overlay nil - "Overlay for prefix string.") - -(defvar ac-timer nil - "Completion idle timer.") - -(defvar ac-show-menu-timer nil - "Show menu idle timer.") - -(defvar ac-quick-help-timer nil - "Quick help idle timer.") - -(defvar ac-triggered nil - "Flag to update.") - -(defvar ac-limit nil - "Limit number of candidates for each sources.") - -(defvar ac-candidates nil - "Current candidates.") - -(defvar ac-candidates-cache nil - "Candidates cache for individual sources.") - -(defvar ac-fuzzy-enable nil - "Non-nil means fuzzy matching is enabled.") - -(defvar ac-dwim-enable nil - "Non-nil means DWIM completion will be allowed.") - -(defvar ac-mode-map (make-sparse-keymap) - "Auto-complete mode map. It is also used for trigger key command. See also `ac-trigger-key'.") - -(defvar ac-completing-map - (let ((map (make-sparse-keymap))) - (define-key map "\t" 'ac-expand) - (define-key map "\r" 'ac-complete) - (define-key map (kbd "M-TAB") 'auto-complete) - (define-key map "\C-s" 'ac-isearch) - - (define-key map "\M-n" 'ac-next) - (define-key map "\M-p" 'ac-previous) - (define-key map [down] 'ac-next) - (define-key map [up] 'ac-previous) - - (define-key map [f1] 'ac-help) - (define-key map [M-f1] 'ac-persist-help) - (define-key map (kbd "C-?") 'ac-help) - (define-key map (kbd "C-M-?") 'ac-persist-help) - - (define-key map [C-down] 'ac-quick-help-scroll-down) - (define-key map [C-up] 'ac-quick-help-scroll-up) - (define-key map "\C-\M-n" 'ac-quick-help-scroll-down) - (define-key map "\C-\M-p" 'ac-quick-help-scroll-up) - - (dotimes (i 9) - (let ((symbol (intern (format "ac-complete-%d" (1+ i))))) - (fset symbol - `(lambda () - (interactive) - (when (and (ac-menu-live-p) (popup-select ac-menu ,i)) - (ac-complete)))) - (define-key map (read-kbd-macro (format "M-%s" (1+ i))) symbol))) - - map) - "Keymap for completion.") -(defvaralias 'ac-complete-mode-map 'ac-completing-map) - -(defvar ac-menu-map - (let ((map (make-sparse-keymap))) - (define-key map "\C-n" 'ac-next) - (define-key map "\C-p" 'ac-previous) - (set-keymap-parent map ac-completing-map) - map) - "Keymap for completion on completing menu.") - -(defvar ac-current-map - (let ((map (make-sparse-keymap))) - (set-keymap-parent map ac-completing-map) - map)) - -(defvar ac-match-function 'all-completions - "Default match function.") - -(defvar ac-prefix-definitions - '((symbol . ac-prefix-symbol) - (file . ac-prefix-file) - (valid-file . ac-prefix-valid-file) - (c-dot . ac-prefix-c-dot) - (c-dot-ref . ac-prefix-c-dot-ref)) - "Prefix definitions for common use.") - -(defvar ac-sources '(ac-source-words-in-same-mode-buffers) - "Sources for completion.") -(make-variable-buffer-local 'ac-sources) - -(defvar ac-compiled-sources nil - "Compiled source of `ac-sources'.") - -(defvar ac-current-sources nil - "Current working sources. This is sublist of `ac-compiled-sources'.") - -(defvar ac-omni-completion-sources nil - "Do not use this anymore.") - -(defvar ac-current-prefix-def nil) - -(defvar ac-ignoring-prefix-def nil) - - - -;;;; Intelligent completion history - -(defvar ac-comphist nil - "Database of completion history.") - -(defsubst ac-comphist-make-tab () - (make-hash-table :test 'equal)) - -(defsubst ac-comphist-tab (db) - (nth 0 db)) - -(defsubst ac-comphist-cache (db) - (nth 1 db)) - -(defun ac-comphist-make (&optional tab) - (list (or tab (ac-comphist-make-tab)) (make-hash-table :test 'equal :weakness t))) - -(defun ac-comphist-get (db string &optional create) - (let* ((tab (ac-comphist-tab db)) - (index (gethash string tab))) - (when (and create (null index)) - (setq index (make-vector (length string) 0)) - (puthash string index tab)) - index)) - -(defun ac-comphist-add (db string prefix) - (setq prefix (min prefix (1- (length string)))) - (when (<= 0 prefix) - (setq string (substring-no-properties string)) - (let ((stat (ac-comphist-get db string t))) - (incf (aref stat prefix)) - (remhash string (ac-comphist-cache db))))) - -(defun ac-comphist-score (db string prefix) - (setq prefix (min prefix (1- (length string)))) - (if (<= 0 prefix) - (let ((cache (gethash string (ac-comphist-cache db)))) - (or (and cache (aref cache prefix)) - (let ((stat (ac-comphist-get db string)) - (score 0.0)) - (when stat - (loop for p from 0 below (length string) - ;; sigmoid function - with a = 5 - with d = (/ 6.0 a) - for x = (- d (abs (- prefix p))) - for r = (/ 1.0 (1+ (exp (* (- a) x)))) - do - (incf score (* (aref stat p) r)))) - ;; Weight by distance - (incf score (max 0.0 (- 0.3 (/ (- (length string) prefix) 100.0)))) - (unless cache - (setq cache (make-vector (length string) nil)) - (puthash string cache (ac-comphist-cache db))) - (aset cache prefix score) - score))) - 0.0)) - -(defun ac-comphist-sort (db collection prefix &optional threshold) - (let (result - (n 0) - (total 0) - (cur 0)) - (setq result (mapcar (lambda (a) - (when (and cur threshold) - (if (>= cur (* total threshold)) - (setq cur nil) - (incf n) - (incf cur (cdr a)))) - (car a)) - (sort (mapcar (lambda (string) - (let ((score (ac-comphist-score db string prefix))) - (incf total score) - (cons string score))) - collection) - (lambda (a b) (< (cdr b) (cdr a)))))) - (if threshold - (cons n result) - result))) - -(defun ac-comphist-serialize (db) - (let (alist) - (maphash (lambda (k v) - (push (cons k v) alist)) - (ac-comphist-tab db)) - (list alist))) - -(defun ac-comphist-deserialize (sexp) - (condition-case nil - (ac-comphist-make (let ((tab (ac-comphist-make-tab))) - (mapc (lambda (cons) - (puthash (car cons) (cdr cons) tab)) - (nth 0 sexp)) - tab)) - (error (message "Invalid comphist db.") nil))) - -(defun ac-comphist-init () - (ac-comphist-load) - (add-hook 'kill-emacs-hook 'ac-comphist-save)) - -(defun ac-comphist-load () - (interactive) - (let ((db (if (file-exists-p ac-comphist-file) - (ignore-errors - (with-temp-buffer - (insert-file-contents ac-comphist-file) - (goto-char (point-min)) - (ac-comphist-deserialize (read (current-buffer)))))))) - (setq ac-comphist (or db (ac-comphist-make))))) - -(defun ac-comphist-save () - (interactive) - (require 'pp) - (ignore-errors - (with-temp-buffer - (pp (ac-comphist-serialize ac-comphist) (current-buffer)) - (write-region (point-min) (point-max) ac-comphist-file)))) - - - -;;;; Auto completion internals - -(defun ac-menu-at-wrapper-line-p () - "Return non-nil if current line is long and wrapped to next visual line." - (and (not truncate-lines) - (eq (line-beginning-position) - (save-excursion - (vertical-motion 1) - (line-beginning-position))))) - -(defun ac-prefix-symbol () - "Default prefix definition function." - (require 'thingatpt) - (car-safe (bounds-of-thing-at-point 'symbol))) -(defalias 'ac-prefix-default 'ac-prefix-symbol) - -(defun ac-prefix-file () - "File prefix." - (let ((point (re-search-backward "[\"<>' \t\r\n]" nil t))) - (if point (1+ point)))) - -(defun ac-prefix-valid-file () - "Existed (or to be existed) file prefix." - (let* ((line-beg (line-beginning-position)) - (end (point)) - (start (or (let ((point (re-search-backward "[\"<>'= \t\r\n]" line-beg t))) - (if point (1+ point))) - line-beg)) - (file (buffer-substring start end))) - (if (and file (or (string-match "^/" file) - (and (setq file (and (string-match "^[^/]*/" file) - (match-string 0 file))) - (file-directory-p file)))) - start))) - -(defun ac-prefix-c-dot () - "C-like languages dot(.) prefix." - (if (re-search-backward "\\.\\(\\(?:[a-zA-Z0-9][_a-zA-Z0-9]*\\)?\\)\\=" nil t) - (match-beginning 1))) - -(defun ac-prefix-c-dot-ref () - "C-like languages dot(.) and reference(->) prefix." - (if (re-search-backward "\\(?:\\.\\|->\\)\\(\\(?:[a-zA-Z0-9][_a-zA-Z0-9]*\\)?\\)\\=" nil t) - (match-beginning 1))) - -(defun ac-define-prefix (name prefix) - "Define new prefix definition. -You can not use it in source definition like (prefix . `NAME')." - (push (cons name prefix) ac-prefix-definitions)) - -(defun ac-match-substring (prefix candidates) - (loop with regexp = (regexp-quote prefix) - for candidate in candidates - if (string-match regexp candidate) - collect candidate)) - -(defsubst ac-source-entity (source) - (if (symbolp source) - (symbol-value source) - source)) - -(defun ac-source-available-p (source) - (if (and (symbolp source) - (get source 'available)) - (eq (get source 'available) t) - (let* ((src (ac-source-entity source)) - (avail-pair (assq 'available src)) - (avail-cond (cdr avail-pair)) - (available (and (if avail-pair - (cond - ((symbolp avail-cond) - (funcall avail-cond)) - ((listp avail-cond) - (eval avail-cond))) - t) - (loop for feature in (assoc-default 'depends src) - unless (require feature nil t) return nil - finally return t)))) - (if (symbolp source) - (put source 'available (if available t 'no))) - available))) - -(defun ac-compile-sources (sources) - "Compiled `SOURCES' into expanded sources style." - (loop for source in sources - if (ac-source-available-p source) - do - (setq source (ac-source-entity source)) - (flet ((add-attribute (name value &optional append) (add-to-list 'source (cons name value) append))) - ;; prefix - (let* ((prefix (assoc 'prefix source)) - (real (assoc-default (cdr prefix) ac-prefix-definitions))) - (cond - (real - (add-attribute 'prefix real)) - ((null prefix) - (add-attribute 'prefix 'ac-prefix-default)))) - ;; match - (let ((match (assq 'match source))) - (cond - ((eq (cdr match) 'substring) - (setcdr match 'ac-match-substring))))) - and collect source)) - -(defun ac-compiled-sources () - (or ac-compiled-sources - (setq ac-compiled-sources - (ac-compile-sources ac-sources)))) - -(defsubst ac-menu-live-p () - (popup-live-p ac-menu)) - -(defun ac-menu-create (point width height) - (setq ac-menu - (popup-create point width height - :around t - :face 'ac-candidate-face - :selection-face 'ac-selection-face - :symbol t - :scroll-bar t - :margin-left 1))) - -(defun ac-menu-delete () - (when ac-menu - (popup-delete ac-menu) - (setq ac-menu))) - -(defsubst ac-inline-marker () - (nth 0 ac-inline)) - -(defsubst ac-inline-overlay () - (nth 1 ac-inline)) - -(defsubst ac-inline-live-p () - (and ac-inline (ac-inline-overlay) t)) - -(defun ac-inline-show (point string) - (unless ac-inline - (setq ac-inline (list (make-marker) nil))) - (save-excursion - (let ((overlay (ac-inline-overlay)) - (width 0) - (string-width (string-width string)) - (length 0) - (original-string string)) - ;; Calculate string space to show completion - (goto-char point) - (let (c) - (while (and (not (eolp)) - (< width string-width) - (setq c (char-after)) - (not (eq c ?\t))) ; special case for tab - (incf width (char-width c)) - (incf length) - (forward-char))) - - ;; Show completion - (goto-char point) - (cond - ((= width 0) - (set-marker (ac-inline-marker) point) - (let ((buffer-undo-list t)) - (insert " ")) - (setq width 1 - length 1)) - ((<= width string-width) - ;; No space to show - ;; Do nothing - ) - ((> width string-width) - ;; Need to fill space - (setq string (concat string (make-string (- width string-width) ? ))))) - (setq string (propertize string 'face 'ac-completion-face)) - (if overlay - (progn - (move-overlay overlay point (+ point length)) - (overlay-put overlay 'invisible nil)) - (setq overlay (make-overlay point (+ point length))) - (setf (nth 1 ac-inline) overlay) - (overlay-put overlay 'priority 9999) - ;; Help prefix-overlay in some cases - (overlay-put overlay 'keymap ac-current-map)) - (overlay-put overlay 'display (substring string 0 1)) - ;; TODO no width but char - (overlay-put overlay 'after-string (substring string 1)) - (overlay-put overlay 'string original-string)))) - -(defun ac-inline-delete () - (when (ac-inline-live-p) - (ac-inline-hide) - (delete-overlay (ac-inline-overlay)) - (setq ac-inline nil))) - -(defun ac-inline-hide () - (when (ac-inline-live-p) - (let ((overlay (ac-inline-overlay)) - (marker (ac-inline-marker)) - (buffer-undo-list t)) - (when overlay - (when (marker-position marker) - (save-excursion - (goto-char marker) - (delete-char 1) - (set-marker marker nil))) - (move-overlay overlay (point-min) (point-min)) - (overlay-put overlay 'invisible t) - (overlay-put overlay 'display nil) - (overlay-put overlay 'after-string nil))))) - -(defun ac-inline-update () - (if (and ac-completing ac-prefix (stringp ac-common-part)) - (let ((common-part-length (length ac-common-part)) - (prefix-length (length ac-prefix))) - (if (> common-part-length prefix-length) - (progn - (ac-inline-hide) - (ac-inline-show (point) (substring ac-common-part prefix-length))) - (ac-inline-delete))) - (ac-inline-delete))) - -(defun ac-put-prefix-overlay () - (unless ac-prefix-overlay - (let (newline) - ;; Insert newline to make sure that cursor always on the overlay - (when (and (eq ac-point (point-max)) - (eq ac-point (point))) - (popup-save-buffer-state - (insert "\n")) - (setq newline t)) - (setq ac-prefix-overlay (make-overlay ac-point (1+ (point)) nil t t)) - (overlay-put ac-prefix-overlay 'priority 9999) - (overlay-put ac-prefix-overlay 'keymap (make-sparse-keymap)) - (overlay-put ac-prefix-overlay 'newline newline)))) - -(defun ac-remove-prefix-overlay () - (when ac-prefix-overlay - (when (overlay-get ac-prefix-overlay 'newline) - ;; Remove inserted newline - (popup-save-buffer-state - (goto-char (point-max)) - (if (eq (char-before) ?\n) - (delete-char -1)))) - (delete-overlay ac-prefix-overlay))) - -(defun ac-activate-completing-map () - (if (and ac-show-menu ac-use-menu-map) - (set-keymap-parent ac-current-map ac-menu-map)) - (when (and ac-use-overriding-local-map - (null overriding-terminal-local-map)) - (setq overriding-terminal-local-map ac-current-map)) - (when ac-prefix-overlay - (set-keymap-parent (overlay-get ac-prefix-overlay 'keymap) ac-current-map))) - -(defun ac-deactivate-completing-map () - (set-keymap-parent ac-current-map ac-completing-map) - (when (and ac-use-overriding-local-map - (eq overriding-terminal-local-map ac-current-map)) - (setq overriding-terminal-local-map nil)) - (when ac-prefix-overlay - (set-keymap-parent (overlay-get ac-prefix-overlay 'keymap) nil))) - -(defsubst ac-selected-candidate () - (if ac-menu - (popup-selected-item ac-menu))) - -(defun ac-prefix (requires ignore-list) - (loop with current = (point) - with point - with prefix-def - with sources - for source in (ac-compiled-sources) - for prefix = (assoc-default 'prefix source) - for req = (or (assoc-default 'requires source) requires 1) - - if (null prefix-def) - do - (unless (member prefix ignore-list) - (save-excursion - (setq point (cond - ((symbolp prefix) - (funcall prefix)) - ((stringp prefix) - (and (re-search-backward (concat prefix "\\=") nil t) - (or (match-beginning 1) (match-beginning 0)))) - ((stringp (car-safe prefix)) - (let ((regexp (nth 0 prefix)) - (end (nth 1 prefix)) - (group (nth 2 prefix))) - (and (re-search-backward (concat regexp "\\=") nil t) - (funcall (if end 'match-end 'match-beginning) - (or group 0))))) - (t - (eval prefix)))) - (if (and point - (integerp req) - (< (- current point) req)) - (setq point nil)) - (if point - (setq prefix-def prefix)))) - - if (equal prefix prefix-def) do (push source sources) - - finally return - (and point (list prefix-def point (nreverse sources))))) - -(defun ac-init () - "Initialize current sources to start completion." - (setq ac-candidates-cache nil) - (loop for source in ac-current-sources - for function = (assoc-default 'init source) - if function do - (save-excursion - (cond - ((functionp function) - (funcall function)) - (t - (eval function)))))) - -(defun ac-candidates-1 (source) - (let* ((do-cache (assq 'cache source)) - (function (assoc-default 'candidates source)) - (action (assoc-default 'action source)) - (document (assoc-default 'document source)) - (symbol (assoc-default 'symbol source)) - (ac-limit (or (assoc-default 'limit source) ac-limit)) - (face (or (assoc-default 'face source) (assoc-default 'candidate-face source))) - (selection-face (assoc-default 'selection-face source)) - (cache (and do-cache (assq source ac-candidates-cache))) - (candidates (cdr cache))) - (unless cache - (setq candidates (save-excursion - (cond - ((functionp function) - (funcall function)) - (t - (eval function))))) - ;; Convert (name value) format candidates into name with text properties. - (setq candidates (mapcar (lambda (candidate) - (if (consp candidate) - (propertize (car candidate) 'value (cdr candidate)) - candidate)) - candidates)) - (when do-cache - (push (cons source candidates) ac-candidates-cache))) - (setq candidates (funcall (or (assoc-default 'match source) - ac-match-function) - ac-prefix candidates)) - ;; Remove extra items regarding to ac-limit - (if (and (integerp ac-limit) (> ac-limit 1) (> (length candidates) ac-limit)) - (setcdr (nthcdr (1- ac-limit) candidates) nil)) - ;; Put candidate properties - (setq candidates (mapcar (lambda (candidate) - (popup-item-propertize candidate - 'action action - 'symbol symbol - 'document document - 'popup-face face - 'selection-face selection-face)) - candidates)) - candidates)) - -(defun ac-candidates () - "Produce candidates for current sources." - (loop with completion-ignore-case = (or (eq ac-ignore-case t) - (and (eq ac-ignore-case 'smart) - (let ((case-fold-search nil)) (not (string-match "[[:upper:]]" ac-prefix))))) - with case-fold-search = completion-ignore-case - with prefix-len = (length ac-prefix) - for source in ac-current-sources - append (ac-candidates-1 source) into candidates - finally return - (progn - (delete-dups candidates) - (if (and ac-use-comphist ac-comphist) - (if ac-show-menu - (let* ((pair (ac-comphist-sort ac-comphist candidates prefix-len ac-comphist-threshold)) - (n (car pair)) - (result (cdr pair)) - (cons (if (> n 0) (nthcdr (1- n) result))) - (cdr (cdr cons))) - (if cons (setcdr cons nil)) - (setq ac-common-part (try-completion ac-prefix result)) - (setq ac-whole-common-part (try-completion ac-prefix candidates)) - (if cons (setcdr cons cdr)) - result) - (setq candidates (ac-comphist-sort ac-comphist candidates prefix-len)) - (setq ac-common-part (if candidates (popup-x-to-string (car candidates)))) - (setq ac-whole-common-part (try-completion ac-prefix candidates)) - candidates) - (setq ac-common-part (try-completion ac-prefix candidates)) - (setq ac-whole-common-part ac-common-part) - candidates)))) - -(defun ac-update-candidates (cursor scroll-top) - "Update candidates of menu to `ac-candidates' and redraw it." - (setf (popup-cursor ac-menu) cursor - (popup-scroll-top ac-menu) scroll-top) - (setq ac-dwim-enable (= (length ac-candidates) 1)) - (if ac-candidates - (progn - (setq ac-completing t) - (ac-activate-completing-map)) - (setq ac-completing nil) - (ac-deactivate-completing-map)) - (ac-inline-update) - (popup-set-list ac-menu ac-candidates) - (if (and (not ac-fuzzy-enable) - (<= (length ac-candidates) 1)) - (popup-hide ac-menu) - (if ac-show-menu - (popup-draw ac-menu)))) - -(defun ac-reposition () - "Force to redraw candidate menu with current `ac-candidates'." - (let ((cursor (popup-cursor ac-menu)) - (scroll-top (popup-scroll-top ac-menu))) - (ac-menu-delete) - (ac-menu-create ac-point (popup-preferred-width ac-candidates) (popup-height ac-menu)) - (ac-update-candidates cursor scroll-top))) - -(defun ac-cleanup () - "Cleanup auto completion." - (if ac-cursor-color - (set-cursor-color ac-cursor-color)) - (when (and ac-use-comphist ac-comphist) - (when (and (null ac-selected-candidate) - (member ac-prefix ac-candidates)) - ;; Assume candidate is selected by just typing - (setq ac-selected-candidate ac-prefix) - (setq ac-last-point ac-point)) - (when ac-selected-candidate - (ac-comphist-add ac-comphist - ac-selected-candidate - (if ac-last-point - (- ac-last-point ac-point) - (length ac-prefix))))) - (ac-deactivate-completing-map) - (ac-remove-prefix-overlay) - (ac-remove-quick-help) - (ac-inline-delete) - (ac-menu-delete) - (ac-cancel-timer) - (ac-cancel-show-menu-timer) - (ac-cancel-quick-help-timer) - (setq ac-cursor-color nil - ac-inline nil - ac-show-menu nil - ac-menu nil - ac-completing nil - ac-point nil - ac-last-point nil - ac-prefix nil - ac-prefix-overlay nil - ac-selected-candidate nil - ac-common-part nil - ac-whole-common-part nil - ac-triggered nil - ac-limit nil - ac-candidates nil - ac-candidates-cache nil - ac-fuzzy-enable nil - ac-dwim-enable nil - ac-compiled-sources nil - ac-current-sources nil - ac-current-prefix-def nil - ac-ignoring-prefix-def nil)) - -(defsubst ac-abort () - "Abort completion." - (ac-cleanup)) - -(defun ac-expand-string (string &optional remove-undo-boundary) - "Expand `STRING' into the buffer and update `ac-prefix' to `STRING'. -This function records deletion and insertion sequences by `undo-boundary'. -If `remove-undo-boundary' is non-nil, this function also removes `undo-boundary' -that have been made before in this function." - (when (not (equal string (buffer-substring ac-point (point)))) - (undo-boundary) - ;; We can't use primitive-undo since it undoes by - ;; groups, divided by boundaries. - ;; We don't want boundary between deletion and insertion. - ;; So do it manually. - ;; Delete region silently for undo: - (if remove-undo-boundary - (progn - (let (buffer-undo-list) - (save-excursion - (delete-region ac-point (point)))) - (setq buffer-undo-list - (nthcdr 2 buffer-undo-list))) - (delete-region ac-point (point))) - (insert string) - ;; Sometimes, possible when omni-completion used, (insert) added - ;; to buffer-undo-list strange record about position changes. - ;; Delete it here: - (when (and remove-undo-boundary - (integerp (cadr buffer-undo-list))) - (setcdr buffer-undo-list (nthcdr 2 buffer-undo-list))) - (undo-boundary) - (setq ac-selected-candidate string) - (setq ac-prefix string))) - -(defun ac-set-trigger-key (key) - "Set `ac-trigger-key' to `KEY'. It is recommemded to use this function instead of calling `setq'." - ;; Remove old mapping - (when ac-trigger-key - (define-key ac-mode-map (read-kbd-macro ac-trigger-key) nil)) - - ;; Make new mapping - (setq ac-trigger-key key) - (when key - (define-key ac-mode-map (read-kbd-macro key) 'ac-trigger-key-command))) - -(defun ac-set-timer () - (unless ac-timer - (setq ac-timer (run-with-idle-timer ac-delay ac-delay 'ac-update-greedy)))) - -(defun ac-cancel-timer () - (when (timerp ac-timer) - (cancel-timer ac-timer) - (setq ac-timer nil))) - -(defun ac-update (&optional force) - (when (and auto-complete-mode - ac-prefix - (or ac-triggered - force) - (not isearch-mode)) - (ac-put-prefix-overlay) - (setq ac-candidates (ac-candidates)) - (let ((preferred-width (popup-preferred-width ac-candidates))) - ;; Reposition if needed - (when (or (null ac-menu) - (>= (popup-width ac-menu) preferred-width) - (<= (popup-width ac-menu) (- preferred-width 10)) - (and (> (popup-direction ac-menu) 0) - (ac-menu-at-wrapper-line-p))) - (ac-inline-hide) ; Hide overlay to calculate correct column - (ac-menu-delete) - (ac-menu-create ac-point preferred-width ac-menu-height))) - (ac-update-candidates 0 0) - t)) - -(defun ac-update-greedy (&optional force) - (let (result) - (while (when (and (setq result (ac-update force)) - (null ac-candidates)) - (add-to-list 'ac-ignoring-prefix-def ac-current-prefix-def) - (ac-start :force-init t) - ac-current-prefix-def)) - result)) - -(defun ac-set-show-menu-timer () - (when (and (or (integerp ac-auto-show-menu) (floatp ac-auto-show-menu)) - (null ac-show-menu-timer)) - (setq ac-show-menu-timer (run-with-idle-timer ac-auto-show-menu ac-auto-show-menu 'ac-show-menu)))) - -(defun ac-cancel-show-menu-timer () - (when (timerp ac-show-menu-timer) - (cancel-timer ac-show-menu-timer) - (setq ac-show-menu-timer nil))) - -(defun ac-show-menu () - (when (not (eq ac-show-menu t)) - (setq ac-show-menu t) - (ac-inline-hide) - (ac-remove-quick-help) - (ac-update t))) - -(defun ac-help (&optional persist) - (interactive "P") - (when ac-menu - (popup-menu-show-help ac-menu persist))) - -(defun ac-persist-help () - (interactive) - (ac-help t)) - -(defun ac-last-help (&optional persist) - (interactive "P") - (when ac-last-completion - (popup-item-show-help (cdr ac-last-completion) persist))) - -(defun ac-last-persist-help () - (interactive) - (ac-last-help t)) - -(defun ac-set-quick-help-timer () - (when (and ac-use-quick-help - (null ac-quick-help-timer)) - (setq ac-quick-help-timer (run-with-idle-timer ac-quick-help-delay ac-quick-help-delay 'ac-quick-help)))) - -(defun ac-cancel-quick-help-timer () - (when (timerp ac-quick-help-timer) - (cancel-timer ac-quick-help-timer) - (setq ac-quick-help-timer nil))) - -(defun ac-pos-tip-show-quick-help (menu &optional item &rest args) - (let* ((point (plist-get args :point)) - (around nil) - (parent-offset (popup-offset menu)) - (doc (popup-menu-documentation menu item))) - (when (stringp doc) - (if (popup-hidden-p menu) - (setq around t) - (setq point nil)) - (with-no-warnings - (pos-tip-show doc - 'popup-tip-face - (or point - (and menu - (popup-child-point menu parent-offset)) - (point)) - nil 0 - popup-tip-max-width - nil nil - (and (not around) 0)) - (unless (plist-get args :nowait) - (clear-this-command-keys) - (unwind-protect - (push (read-event (plist-get args :prompt)) unread-command-events) - (pos-tip-hide)) - t))))) - -(defun ac-quick-help (&optional force) - (interactive) - (when (and (or force (null this-command)) - (ac-menu-live-p) - (null ac-quick-help)) - (setq ac-quick-help - (funcall (if (and ac-quick-help-prefer-x - (eq window-system 'x) - (featurep 'pos-tip)) - 'ac-pos-tip-show-quick-help - 'popup-menu-show-quick-help) - ac-menu nil - :point ac-point - :height ac-quick-help-height - :nowait t)))) - -(defun ac-remove-quick-help () - (when ac-quick-help - (popup-delete ac-quick-help) - (setq ac-quick-help nil))) - -(defun ac-last-quick-help () - (interactive) - (when (and ac-last-completion - (eq (marker-buffer (car ac-last-completion)) - (current-buffer))) - (let ((doc (popup-item-documentation (cdr ac-last-completion))) - (point (marker-position (car ac-last-completion)))) - (when (stringp doc) - (if (and ac-quick-help-prefer-x - (eq window-system 'x) - (featurep 'pos-tip)) - (with-no-warnings (pos-tip-show doc nil point nil 0)) - (popup-tip doc - :point point - :around t - :scroll-bar t - :margin t)))))) - -(defmacro ac-define-quick-help-command (name arglist &rest body) - (declare (indent 2)) - `(progn - (defun ,name ,arglist ,@body) - (put ',name 'ac-quick-help-command t))) - -(ac-define-quick-help-command ac-quick-help-scroll-down () - (interactive) - (when ac-quick-help - (popup-scroll-down ac-quick-help))) - -(ac-define-quick-help-command ac-quick-help-scroll-up () - (interactive) - (when ac-quick-help - (popup-scroll-up ac-quick-help))) - - - -;;;; Auto completion isearch - -(defun ac-isearch-callback (list) - (setq ac-dwim-enable (eq (length list) 1))) - -(defun ac-isearch () - (interactive) - (when (ac-menu-live-p) - (ac-cancel-show-menu-timer) - (ac-cancel-quick-help-timer) - (ac-show-menu) - (popup-isearch ac-menu :callback 'ac-isearch-callback))) - - - -;;;; Auto completion commands - -(defun auto-complete (&optional sources) - "Start auto-completion at current point." - (interactive) - (let ((menu-live (ac-menu-live-p)) - (inline-live (ac-inline-live-p))) - (ac-abort) - (let ((ac-sources (or sources ac-sources))) - (if (or ac-show-menu-immediately-on-auto-complete - inline-live) - (setq ac-show-menu t)) - (ac-start)) - (when (ac-update-greedy t) - ;; TODO Not to cause inline completion to be disrupted. - (if (ac-inline-live-p) - (ac-inline-hide)) - ;; Not to expand when it is first time to complete - (when (and (or (and (not ac-expand-on-auto-complete) - (> (length ac-candidates) 1) - (not menu-live)) - (not (let ((ac-common-part ac-whole-common-part)) - (ac-expand-common)))) - ac-use-fuzzy - (null ac-candidates)) - (ac-fuzzy-complete))))) - -(defun ac-fuzzy-complete () - "Start fuzzy completion at current point." - (interactive) - (when (require 'fuzzy nil) - (unless (ac-menu-live-p) - (ac-start)) - (let ((ac-match-function 'fuzzy-all-completions)) - (unless ac-cursor-color - (setq ac-cursor-color (frame-parameter (selected-frame) 'cursor-color))) - (if ac-fuzzy-cursor-color - (set-cursor-color ac-fuzzy-cursor-color)) - (setq ac-show-menu t) - (setq ac-fuzzy-enable t) - (setq ac-triggered nil) - (ac-update t))) - t) - -(defun ac-next () - "Select next candidate." - (interactive) - (when (ac-menu-live-p) - (popup-next ac-menu) - (setq ac-show-menu t) - (if (eq this-command 'ac-next) - (setq ac-dwim-enable t)))) - -(defun ac-previous () - "Select previous candidate." - (interactive) - (when (ac-menu-live-p) - (popup-previous ac-menu) - (setq ac-show-menu t) - (if (eq this-command 'ac-previous) - (setq ac-dwim-enable t)))) - -(defun ac-expand () - "Try expand, and if expanded twice, select next candidate." - (interactive) - (unless (ac-expand-common) - (let ((string (ac-selected-candidate))) - (when string - (when (equal ac-prefix string) - (ac-next) - (setq string (ac-selected-candidate))) - (ac-expand-string string (eq last-command this-command)) - ;; Do reposition if menu at long line - (if (and (> (popup-direction ac-menu) 0) - (ac-menu-at-wrapper-line-p)) - (ac-reposition)) - (setq ac-show-menu t) - string)))) - -(defun ac-expand-common () - "Try to expand meaningful common part." - (interactive) - (if (and ac-dwim ac-dwim-enable) - (ac-complete) - (when (and (ac-inline-live-p) - ac-common-part) - (ac-inline-hide) - (ac-expand-string ac-common-part (eq last-command this-command)) - (setq ac-common-part nil) - t))) - -(defun ac-complete () - "Try complete." - (interactive) - (let* ((candidate (ac-selected-candidate)) - (action (popup-item-property candidate 'action)) - (fallback nil)) - (when candidate - (unless (ac-expand-string candidate) - (setq fallback t)) - ;; Remember to show help later - (when (and ac-point candidate) - (unless ac-last-completion - (setq ac-last-completion (cons (make-marker) nil))) - (set-marker (car ac-last-completion) ac-point ac-buffer) - (setcdr ac-last-completion candidate))) - (ac-abort) - (cond - (action - (funcall action)) - (fallback - (ac-fallback-command))) - candidate)) - -(defun* ac-start (&key - requires - force-init) - "Start completion." - (interactive) - (if (not auto-complete-mode) - (message "auto-complete-mode is not enabled") - (let* ((info (ac-prefix requires ac-ignoring-prefix-def)) - (prefix-def (nth 0 info)) - (point (nth 1 info)) - (sources (nth 2 info)) - prefix - (init (or force-init (not (eq ac-point point))))) - (if (or (null point) - (member (setq prefix (buffer-substring-no-properties point (point))) - ac-ignores)) - (prog1 nil - (ac-abort)) - (unless ac-cursor-color - (setq ac-cursor-color (frame-parameter (selected-frame) 'cursor-color))) - (setq ac-show-menu (or ac-show-menu (if (eq ac-auto-show-menu t) t)) - ac-current-sources sources - ac-buffer (current-buffer) - ac-point point - ac-prefix prefix - ac-limit ac-candidate-limit - ac-triggered t - ac-current-prefix-def prefix-def) - (when (or init (null ac-prefix-overlay)) - (ac-init)) - (ac-set-timer) - (ac-set-show-menu-timer) - (ac-set-quick-help-timer) - (ac-put-prefix-overlay))))) - -(defun ac-stop () - "Stop completiong." - (interactive) - (setq ac-selected-candidate nil) - (ac-abort)) - -(defun ac-trigger-key-command (&optional force) - (interactive "P") - (if (or force (ac-trigger-command-p last-command)) - (auto-complete) - (ac-fallback-command 'ac-trigger-key-command))) - - - -;;;; Basic cache facility - -(defvar ac-clear-variables-every-minute-timer nil) -(defvar ac-clear-variables-after-save nil) -(defvar ac-clear-variables-every-minute nil) -(defvar ac-minutes-counter 0) - -(defun ac-clear-variable-after-save (variable &optional pred) - (add-to-list 'ac-clear-variables-after-save (cons variable pred))) - -(defun ac-clear-variables-after-save () - (dolist (pair ac-clear-variables-after-save) - (if (or (null (cdr pair)) - (funcall (cdr pair))) - (set (car pair) nil)))) - -(defun ac-clear-variable-every-minutes (variable minutes) - (add-to-list 'ac-clear-variables-every-minute (cons variable minutes))) - -(defun ac-clear-variable-every-minute (variable) - (ac-clear-variable-every-minutes variable 1)) - -(defun ac-clear-variable-every-10-minutes (variable) - (ac-clear-variable-every-minutes variable 10)) - -(defun ac-clear-variables-every-minute () - (incf ac-minutes-counter) - (dolist (pair ac-clear-variables-every-minute) - (if (eq (% ac-minutes-counter (cdr pair)) 0) - (set (car pair) nil)))) - - - -;;;; Auto complete mode - -(defun ac-cursor-on-diable-face-p (&optional point) - (memq (get-text-property (or point (point)) 'face) ac-disable-faces)) - -(defun ac-trigger-command-p (command) - "Return non-nil if `COMMAND' is a trigger command." - (and (symbolp command) - (or (memq command ac-trigger-commands) - (string-match "self-insert-command" (symbol-name command)) - (string-match "electric" (symbol-name command))))) - -(defun ac-fallback-command (&optional except-command) - (let* ((auto-complete-mode nil) - (keys (this-command-keys-vector)) - (command (if keys (key-binding keys)))) - (when (and (commandp command) - (not (eq command except-command))) - (setq this-command command) - (call-interactively command)))) - -(defun ac-compatible-package-command-p (command) - "Return non-nil if `COMMAND' is compatible with auto-complete." - (and (symbolp command) - (string-match ac-compatible-packages-regexp (symbol-name command)))) - -(defun ac-handle-pre-command () - (condition-case var - (if (or (setq ac-triggered (and (not ac-fuzzy-enable) ; ignore key storkes in fuzzy mode - (or (eq this-command 'auto-complete) ; special case - (ac-trigger-command-p this-command) - (and ac-completing - (memq this-command ac-trigger-commands-on-completing))) - (not (ac-cursor-on-diable-face-p)))) - (ac-compatible-package-command-p this-command)) - (progn - (if (or (not (symbolp this-command)) - (not (get this-command 'ac-quick-help-command))) - (ac-remove-quick-help)) - ;; Not to cause inline completion to be disrupted. - (ac-inline-hide)) - (ac-abort)) - (error (ac-error var)))) - -(defun ac-handle-post-command () - (condition-case var - (when (and ac-triggered - (or ac-auto-start - ac-completing) - (not isearch-mode)) - (setq ac-last-point (point)) - (ac-start :requires (unless ac-completing ac-auto-start)) - (ac-inline-update)) - (error (ac-error var)))) - -(defun ac-setup () - (if ac-trigger-key - (ac-set-trigger-key ac-trigger-key)) - (if ac-use-comphist - (ac-comphist-init)) - (unless ac-clear-variables-every-minute-timer - (setq ac-clear-variables-every-minute-timer (run-with-timer 60 60 'ac-clear-variables-every-minute))) - (if ac-stop-flymake-on-completing - (defadvice flymake-on-timer-event (around ac-flymake-stop-advice activate) - (unless ac-completing - ad-do-it)) - (ad-disable-advice 'flymake-on-timer-event 'around 'ac-flymake-stop-advice))) - -(define-minor-mode auto-complete-mode - "AutoComplete mode" - :lighter " AC" - :keymap ac-mode-map - :group 'auto-complete - (if auto-complete-mode - (progn - (ac-setup) - (add-hook 'pre-command-hook 'ac-handle-pre-command nil t) - (add-hook 'post-command-hook 'ac-handle-post-command nil t) - (add-hook 'after-save-hook 'ac-clear-variables-after-save nil t) - (run-hooks 'auto-complete-mode-hook)) - (remove-hook 'pre-command-hook 'ac-handle-pre-command t) - (remove-hook 'post-command-hook 'ac-handle-post-command t) - (remove-hook 'after-save-hook 'ac-clear-variables-after-save t) - (ac-abort))) - -(defun auto-complete-mode-maybe () - "What buffer `auto-complete-mode' prefers." - (if (and (not (minibufferp (current-buffer))) - (memq major-mode ac-modes)) - (auto-complete-mode 1))) - -(define-global-minor-mode global-auto-complete-mode - auto-complete-mode auto-complete-mode-maybe - :group 'auto-complete) - - - -;;;; Compatibilities with other extensions - -(defun ac-flyspell-workaround () - "Flyspell uses `sit-for' for delaying its process. Unfortunatelly, -it stops auto completion which is trigger with `run-with-idle-timer'. -This workaround avoid flyspell processes when auto completion is being started." - (interactive) - (defadvice flyspell-post-command-hook (around ac-flyspell-workaround activate) - (unless ac-triggered - ad-do-it))) - - - -;;;; Standard sources - -(defmacro ac-define-source (name source) - "Source definition macro. It defines a complete command also." - (declare (indent 1)) - `(progn - (defvar ,(intern (format "ac-source-%s" name)) - ,source) - (defun ,(intern (format "ac-complete-%s" name)) () - (interactive) - (auto-complete '(,(intern (format "ac-source-%s" name))))))) - -;; Words in buffer source -(defvar ac-word-index nil) - -(defun ac-candidate-words-in-buffer (point prefix limit) - (let ((i 0) - candidate - candidates - (regexp (concat "\\_<" (regexp-quote prefix) "\\(\\sw\\|\\s_\\)+\\_>"))) - (save-excursion - ;; Search backward - (goto-char point) - (while (and (or (not (integerp limit)) (< i limit)) - (re-search-backward regexp nil t)) - (setq candidate (match-string-no-properties 0)) - (unless (member candidate candidates) - (push candidate candidates) - (incf i))) - ;; Search backward - (goto-char (+ point (length prefix))) - (while (and (or (not (integerp limit)) (< i limit)) - (re-search-forward regexp nil t)) - (setq candidate (match-string-no-properties 0)) - (unless (member candidate candidates) - (push candidate candidates) - (incf i))) - (nreverse candidates)))) - -(defun ac-incremental-update-word-index () - (unless (local-variable-p 'ac-word-index) - (make-local-variable 'ac-word-index)) - (if (null ac-word-index) - (setq ac-word-index (cons nil nil))) - ;; Mark incomplete - (if (car ac-word-index) - (setcar ac-word-index nil)) - (let ((index (cdr ac-word-index)) - (words (ac-candidate-words-in-buffer ac-point ac-prefix (or (and (integerp ac-limit) ac-limit) 10)))) - (dolist (word words) - (unless (member word index) - (push word index) - (setcdr ac-word-index index))))) - -(defun ac-update-word-index-1 () - (unless (local-variable-p 'ac-word-index) - (make-local-variable 'ac-word-index)) - (when (and (not (car ac-word-index)) - (< (buffer-size) 1048576)) - ;; Complete index - (setq ac-word-index - (cons t - (split-string (buffer-substring-no-properties (point-min) (point-max)) - "\\(?:^\\|\\_>\\).*?\\(?:\\_<\\|$\\)"))))) - -(defun ac-update-word-index () - (dolist (buffer (buffer-list)) - (when (or ac-fuzzy-enable - (not (eq buffer (current-buffer)))) - (with-current-buffer buffer - (ac-update-word-index-1))))) - -(defun ac-word-candidates (&optional buffer-pred) - (loop initially (unless ac-fuzzy-enable (ac-incremental-update-word-index)) - for buffer in (buffer-list) - if (and (or (not (integerp ac-limit)) (< (length candidates) ac-limit)) - (if buffer-pred (funcall buffer-pred buffer) t)) - append (funcall ac-match-function - ac-prefix - (and (local-variable-p 'ac-word-index buffer) - (cdr (buffer-local-value 'ac-word-index buffer)))) - into candidates - finally return candidates)) - -(ac-define-source words-in-buffer - '((candidates . ac-word-candidates))) - -(ac-define-source words-in-all-buffer - '((init . ac-update-word-index) - (candidates . ac-word-candidates))) - -(ac-define-source words-in-same-mode-buffers - '((init . ac-update-word-index) - (candidates . (ac-word-candidates - (lambda (buffer) - (derived-mode-p (buffer-local-value 'major-mode buffer))))))) - -;; Lisp symbols source -(defvar ac-symbols-cache nil) -(ac-clear-variable-every-10-minutes 'ac-symbols-cache) - -(defun ac-symbol-file (symbol type) - (if (fboundp 'find-lisp-object-file-name) - (find-lisp-object-file-name symbol type) - (let ((file-name (with-no-warnings - (describe-simplify-lib-file-name - (symbol-file symbol type))))) - (when (equal file-name "loaddefs.el") - ;; Find the real def site of the preloaded object. - (let ((location (condition-case nil - (if (eq type 'defun) - (find-function-search-for-symbol symbol nil - "loaddefs.el") - (find-variable-noselect symbol file-name)) - (error nil)))) - (when location - (with-current-buffer (car location) - (when (cdr location) - (goto-char (cdr location))) - (when (re-search-backward - "^;;; Generated autoloads from \\(.*\\)" nil t) - (setq file-name (match-string 1))))))) - (if (and (null file-name) - (or (eq type 'defun) - (integerp (get symbol 'variable-documentation)))) - ;; It's a object not defined in Elisp but in C. - (if (get-buffer " *DOC*") - (if (eq type 'defun) - (help-C-file-name (symbol-function symbol) 'subr) - (help-C-file-name symbol 'var)) - 'C-source) - file-name)))) - -(defun ac-symbol-documentation (symbol) - (if (stringp symbol) - (setq symbol (intern-soft symbol))) - (ignore-errors - (with-temp-buffer - (let ((standard-output (current-buffer))) - (prin1 symbol) - (princ " is ") - (cond - ((fboundp symbol) - (let ((help-xref-following t)) - (describe-function-1 symbol)) - (buffer-string)) - ((boundp symbol) - (let ((file-name (ac-symbol-file symbol 'defvar))) - (princ "a variable") - (when file-name - (princ " defined in `") - (princ (if (eq file-name 'C-source) - "C source code" - (file-name-nondirectory file-name)))) - (princ "'.\n\n") - (princ (or (documentation-property symbol 'variable-documentation t) - "Not documented.")) - (buffer-string))) - ((facep symbol) - (let ((file-name (ac-symbol-file symbol 'defface))) - (princ "a face") - (when file-name - (princ " defined in `") - (princ (if (eq file-name 'C-source) - "C source code" - (file-name-nondirectory file-name)))) - (princ "'.\n\n") - (princ (or (documentation-property symbol 'face-documentation t) - "Not documented.")) - (buffer-string))) - (t - (let ((doc (documentation-property symbol 'group-documentation t))) - (when doc - (princ "a group.\n\n") - (princ doc) - (buffer-string))))))))) - -(defun ac-symbol-candidates () - (or ac-symbols-cache - (setq ac-symbols-cache - (loop for x being the symbols - if (or (fboundp x) - (boundp x) - (symbol-plist x)) - collect (symbol-name x))))) - -(ac-define-source symbols - '((candidates . ac-symbol-candidates) - (document . ac-symbol-documentation) - (symbol . "s") - (cache))) - -;; Lisp functions source -(defvar ac-functions-cache nil) -(ac-clear-variable-every-10-minutes 'ac-functions-cache) - -(defun ac-function-candidates () - (or ac-functions-cache - (setq ac-functions-cache - (loop for x being the symbols - if (fboundp x) - collect (symbol-name x))))) - -(ac-define-source functions - '((candidates . ac-function-candidates) - (document . ac-symbol-documentation) - (symbol . "f") - (prefix . "(\\(\\(?:\\sw\\|\\s_\\)+\\)") - (cache))) - -;; Lisp variables source -(defvar ac-variables-cache nil) -(ac-clear-variable-every-10-minutes 'ac-variables-cache) - -(defun ac-variable-candidates () - (or ac-variables-cache - (setq ac-variables-cache - (loop for x being the symbols - if (boundp x) - collect (symbol-name x))))) - -(ac-define-source variables - '((candidates . ac-variable-candidates) - (document . ac-symbol-documentation) - (symbol . "v") - (cache))) - -;; Lisp features source -(defvar ac-emacs-lisp-features nil) -(ac-clear-variable-every-10-minutes 'ac-emacs-lisp-features) - -(defun ac-emacs-lisp-feature-candidates () - (or ac-emacs-lisp-features - (if (fboundp 'find-library-suffixes) - (let ((suffix (concat (regexp-opt (find-library-suffixes) t) "\\'"))) - (setq ac-emacs-lisp-features - (append (mapcar 'prin1-to-string features) - (loop for dir in load-path - if (file-directory-p dir) - append (loop for file in (directory-files dir) - if (string-match suffix file) - collect (substring file 0 (match-beginning 0)))))))))) - -(ac-define-source features - '((depends find-func) - (candidates . ac-emacs-lisp-feature-candidates) - (prefix . "require +'\\(\\(?:\\sw\\|\\s_\\)*\\)") - (requires . 0))) - -(defvaralias 'ac-source-emacs-lisp-features 'ac-source-features) - -;; Abbrev source -(ac-define-source abbrev - '((candidates . (mapcar 'popup-x-to-string (append (vconcat local-abbrev-table global-abbrev-table) nil))) - (action . expand-abbrev) - (symbol . "a") - (cache))) - -;; Files in current directory source -(ac-define-source files-in-current-dir - '((candidates . (directory-files default-directory)) - (cache))) - -;; Filename source -(defvar ac-filename-cache nil) - -(defun ac-filename-candidate () - (unless (file-regular-p ac-prefix) - (ignore-errors - (loop with dir = (file-name-directory ac-prefix) - with files = (or (assoc-default dir ac-filename-cache) - (let ((files (directory-files dir nil "^[^.]"))) - (push (cons dir files) ac-filename-cache) - files)) - for file in files - for path = (concat dir file) - collect (if (file-directory-p path) - (concat path "/") - path))))) - -(ac-define-source filename - '((init . (setq ac-filename-cache nil)) - (candidates . ac-filename-candidate) - (prefix . valid-file) - (requires . 0) - (action . ac-start) - (limit . nil))) - -;; Dictionary source -(defcustom ac-user-dictionary nil - "User dictionary" - :type '(repeat string) - :group 'auto-complete) - -(defcustom ac-user-dictionary-files '("~/.dict") - "User dictionary files." - :type '(repeat string) - :group 'auto-complete) - -(defcustom ac-dictionary-directories nil - "Dictionary directories." - :type '(repeat string) - :group 'auto-complete) - -(defvar ac-dictionary nil) -(defvar ac-dictionary-cache (make-hash-table :test 'equal)) - -(defun ac-clear-dictionary-cache () - (interactive) - (clrhash ac-dictionary-cache)) - -(defun ac-read-file-dictionary (filename) - (let ((cache (gethash filename ac-dictionary-cache 'none))) - (if (and cache (not (eq cache 'none))) - cache - (let (result) - (ignore-errors - (with-temp-buffer - (insert-file-contents filename) - (setq result (split-string (buffer-string) "\n")))) - (puthash filename result ac-dictionary-cache) - result)))) - -(defun ac-buffer-dictionary () - (apply 'append - (mapcar 'ac-read-file-dictionary - (mapcar (lambda (name) - (loop for dir in ac-dictionary-directories - for file = (concat dir "/" name) - if (file-exists-p file) - return file)) - (list (symbol-name major-mode) - (ignore-errors - (file-name-extension (buffer-file-name)))))))) - -(defun ac-dictionary-candidates () - (apply 'append `(,ac-user-dictionary - ,(ac-buffer-dictionary) - ,@(mapcar 'ac-read-file-dictionary - ac-user-dictionary-files)))) - -(ac-define-source dictionary - '((candidates . ac-dictionary-candidates) - (symbol . "d"))) - -(provide 'auto-complete) -;;; auto-complete.el ends here diff --git a/.emacs.d/auto-complete.elc b/.emacs.d/auto-complete.elc deleted file mode 100644 index 4b0e44d..0000000 Binary files a/.emacs.d/auto-complete.elc and /dev/null differ diff --git a/.emacs.d/autopair.el b/.emacs.d/autopair.el deleted file mode 100644 index 31626f2..0000000 --- a/.emacs.d/autopair.el +++ /dev/null @@ -1,1036 +0,0 @@ -;;; autopair.el --- Automagically pair braces and quotes like TextMate - -;; Copyright (C) 2009,2010 Joao Tavora - -;; Author: Joao Tavora -;; Keywords: convenience, emulations -;; X-URL: http://autopair.googlecode.com -;; URL: http://autopair.googlecode.com -;; EmacsWiki: AutoPairs -;; Version: 0.4 -;; Revision: $Rev$ ($LastChangedDate$) - -;; 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: -;; -;; Another stab at making braces and quotes pair like in -;; TextMate: -;; -;; * Opening braces/quotes are autopaired; -;; * Closing braces/quotes are autoskipped; -;; * Backspacing an opening brace/quote autodeletes its adjacent pair. -;; * Newline between newly-opened brace pairs open an extra indented line. -;; -;; Autopair deduces from the current syntax table which characters to -;; pair, skip or delete. -;; -;;; Installation: -;; -;; (require 'autopair) -;; (autopair-global-mode) ;; to enable in all buffers -;; -;; To enable autopair in just some types of buffers, comment out the -;; `autopair-global-mode' and put autopair-mode in some major-mode -;; hook, like: -;; -;; (add-hook 'c-mode-common-hook #'(lambda () (autopair-mode))) -;; -;; Alternatively, do use `autopair-global-mode' and create -;; *exceptions* using the `autopair-dont-activate' local variable, -;; like: -;; -;; (add-hook 'c-mode-common-hook #'(lambda () (setq autopair-dont-activate t))) -;; -;;; Use: -;; -;; The extension works by rebinding the braces and quotes keys, but -;; can still be minimally intrusive, since the original binding is -;; always called as if autopair did not exist. -;; -;; The decision of which keys to actually rebind is taken at -;; minor-mode activation time, based on the current major mode's -;; syntax tables. To achieve this kind of behaviour, an emacs -;; variable `emulation-mode-map-alists' was used. -;; -;; If you set `autopair-pair-criteria' and `autopair-skip-criteria' to -;; 'help-balance (which, by the way, is the default), braces are not -;; autopaired/autoskiped in all situations; the decision to autopair -;; or autoskip a brace is taken according to the following table: -;; -;; +---------+------------+-----------+-------------------+ -;; | 1234567 | autopair? | autoskip? | notes | -;; +---------+------------+-----------+-------------------+ -;; | (()) | yyyyyyy | ---yy-- | balanced | -;; +---------+------------+-----------+-------------------+ -;; | (())) | ------y | ---yyy- | too many closings | -;; +---------+------------+-----------+-------------------+ -;; | ((()) | yyyyyyy | ------- | too many openings | -;; +---------+------------+-----------+-------------------+ -;; -;; The table is read like this: in a buffer with 7 characters laid out -;; like the first column, an "y" marks points where an opening brace -;; is autopaired and in which places would a closing brace be -;; autoskipped. -;; -;; Quote pairing tries to support similar "intelligence", but is less -;; deterministic. Some inside-string or inside-comment situations may -;; not always behave how you intend them to. -;; -;; The variable `autopair-autowrap' tells autopair to automatically -;; wrap the selection region with the delimiters you're trying to -;; insert. This is done conditionally based of syntaxes of the two -;; ends of the selection region. It is compatible with `cua-mode's -;; typing-deletes-selection behaviour. This feature is probably still -;; a little unstable, hence `autopair-autowrap' defaults to nil. -;; -;; If you find the paren-blinking annoying, turn `autopair-blink' to -;; nil. -;; -;; For lisp-programming you might also like `autopair-skip-whitespace'. -;; -;; For further customization have a look at `autopair-dont-pair', -;; `autopair-handle-action-fns' and `autopair-extra-pair'. -;; -;; `autopair-dont-pair' lets you define special cases of characters -;; you don't want paired. Its default value skips pairing -;; single-quote characters when inside a comment literal, even if the -;; language syntax tables does pair these characters. -;; -;; (defvar autopair-dont-pair `(:string (?') :comment (?')) -;; -;; As a further example, to also prevent the '{' (opening brace) -;; character from being autopaired in C++ comments use this in your -;; .emacs. -;; -;; (add-hook 'c++-mode-hook -;; #'(lambda () -;; (push ?{ -;; (getf autopair-dont-pair :comment)))) -;; -;; `autopair-handle-action-fns' lets you override/extend the actions -;; taken by autopair after it decides something must be paired,skipped -;; or deleted. To work with triple quoting in python mode, you can use -;; this for example: -;; -;; (add-hook 'python-mode-hook -;; #'(lambda () -;; (setq autopair-handle-action-fns -;; (list #'autopair-default-handle-action -;; #'autopair-python-triple-quote-action)))) -;; -;; It's also useful to deal with latex's mode use of the "paired -;; delimiter" syntax class. -;; -;; (add-hook 'latex-mode-hook -;; #'(lambda () -;; (set (make-local-variable 'autopair-handle-action-fns) -;; (list #'autopair-default-handle-action -;; #'autopair-latex-mode-paired-delimiter-action)))) -;; -;; `autopair-extra-pairs' lets you define extra pairing and skipping -;; behaviour for pairs not programmed into the syntax table. Watch -;; out, this is work-in-progress, a little unstable and does not help -;; balancing at all. To have '<' and '>' pair in c++-mode buffers, but -;; only in code, use: -;; -;; (add-hook 'c++-mode-hook -;; #'(lambda () -;; (push '(?< . ?>) -;; (getf autopair-extra-pairs :code)))) -;; -;; if you program in emacs-lisp you might also like the following to -;; pair backtick and quote -;; -;; (add-hook 'emacs-lisp-mode-hook -;; #'(lambda () -;; (push '(?` . ?') -;; (getf autopair-extra-pairs :comment)) -;; (push '(?` . ?') -;; (getf autopair-extra-pairs :string)))) -;; -;;; Bugs: -;; -;; * Quote pairing/skipping inside comments is not perfect... -;; -;; * See the last section on monkey-patching for the `defadvice' -;; tricks used to make `autopair-autowrap' work with `cua-mode' and -;; `delete-selection-mode'. -;; -;;; Credit: -;; -;; Thanks Ed Singleton for early testing. -;; -;;; Code: - -;; requires -(require 'cl) - -;; variables -(defvar autopair-pair-criteria 'help-balance - "How to decide whether to pair opening brackets or quotes. - -Set this to 'always to always pair, or 'help-balance to be more -criterious when pairing.") - -(defvar autopair-skip-criteria 'help-balance - "How to decide whether to skip closing brackets or quotes. - -Set this to 'always to always skip, or 'help-balance to be more -criterious when skipping.") - -(defvar autopair-emulation-alist nil - "A dinamic keymap for autopair set mostly from the current - syntax table.") - -(defvar autopair-dont-activate nil - "If non-nil `autopair-global-mode' does not activate in buffer") -(make-variable-buffer-local 'autopair-dont-activate) - -(defvar autopair-extra-pairs nil - "Extra pairs for which to use pairing. - -It's a Common-lisp-style even-numbered property list, each pair -of elements being of the form (TYPE , PAIRS). PAIRS is a mixed -list whose elements are cons cells, which look like cells look -like (OPENING . CLOSING). Autopair pairs these like -parenthesis. - -TYPE can be one of: - -:string : whereby PAIRS will be considered only when inside a - string literal - -:comment : whereby PAIRS will be considered only when inside a comment - -:code : whereby PAIRS will be considered only when outisde a - string and a comment. - -:everywhere : whereby PAIRS will be considered in all situations - -In Emacs-lisp, this might be useful - -(add-hook 'emacs-lisp-mode-hook - #'(lambda () - (setq autopair-extra-pairs `(:comment ((?`. ?')))))) - - -Note that this does *not* work for single characters, -e.x. characters you want to behave as quotes. See the -docs/source comments for more details.") - -(make-variable-buffer-local 'autopair-extra-pairs) - -(defvar autopair-dont-pair `(:string (?') :comment (?')) - "Characters for which to skip any pairing behaviour. - -This variable overrides `autopair-pair-criteria' and -`autopair-extra-pairs'. It does not - (currently) affect the skipping behaviour. - -It's a Common-lisp-style even-numbered property list, each pair -of elements being of the form (TYPE , CHARS). CHARS is a list of -characters and TYPE can be one of: - -:string : whereby characters in CHARS will not be autopaired when - inside a string literal - -:comment : whereby characters in CHARS will not be autopaired when - inside a comment - -:never : whereby characters in CHARS won't even have their - bindings replaced by autopair's. This particular option - should be used for troubleshooting and requires - `autopair-mode' to be restarted to have any effect.") -(make-variable-buffer-local 'autopair-dont-pair) - -(defvar autopair-action nil - "Autopair action decided on by last interactive autopair command, or nil. - -When autopair decides on an action this is a list whose first -three elements are (ACTION PAIR POS-BEFORE). - -ACTION is one of `opening', `insert-quote', `skip-quote', -`backspace', `newline' or `paired-delimiter'. PAIR is the pair of -the `last-input-event' character, if applicable. POS-BEFORE is -value of point before action command took place .") - - -(defvar autopair-wrap-action nil - "Autowrap action decided on by autopair, if any. - -When autopair decides on an action this is a list whose first -three elements are (ACTION PAIR POS-BEFORE REGION-BEFORE). - -ACTION can only be `wrap' currently. PAIR and POS-BEFORE -delimiter are as in `autopair-action'. REGION-BEFORE is a cons -cell with the bounds of the region before the command takes -place") - -(defvar autopair-handle-action-fns '() - "Autopair handlers to run *instead* of the default handler. - -Each element is a function taking three arguments (ACTION, PAIR -and POS-BEFORE), which are the three elements of the -`autopair-action' variable, which see. - -If non-nil, these functions are called *instead* of the single -function `autopair-default-handle-action', so use this variable -to specify special behaviour. To also run the default behaviour, -be sure to include `autopair-default-handle-action' in the -list, or call it from your handlers.") -(make-variable-buffer-local 'autopair-handle-action-fns) - -(defvar autopair-handle-wrap-action-fns '() - "Autopair wrap handlers to run *instead* of the default handler. - -Each element is a function taking four arguments (ACTION, PAIR, -POS-BEFORE and REGION-BEFORE), which are the three elements of the -`autopair-wrap-action' variable, which see. - -If non-nil, these functions are called *instead* of the single -function `autopair-default-handle-wrap-action', so use this -variable to specify special behaviour. To also run the default -behaviour, be sure to include `autopair-default-handle-wrap-action' in -the list, or call it in your handlers.") -(make-variable-buffer-local 'autopair-handle-wrap-action-fns) - -;; minor mode and global mode -;; -(define-globalized-minor-mode autopair-global-mode autopair-mode autopair-on) - -(defun autopair-on () (unless (or buffer-read-only autopair-dont-activate) (autopair-mode 1))) - -(define-minor-mode autopair-mode - "Automagically pair braces and quotes like in TextMate." - nil " pair" nil - (cond (autopair-mode - ;; Setup the dynamic emulation keymap - ;; - (let ((map (make-sparse-keymap))) - (define-key map [remap delete-backward-char] 'autopair-backspace) - (define-key map [remap backward-delete-char-untabify] 'autopair-backspace) - (define-key map (kbd "") 'autopair-backspace) - (define-key map [backspace] 'autopair-backspace) - (define-key map (kbd "DEL") 'autopair-backspace) - (define-key map (kbd "RET") 'autopair-newline) - (dotimes (char 256) ;; only searches the first 256 chars, - ;; TODO: is this enough/toomuch/stupid? - (unless (member char - (getf autopair-dont-pair :never)) - (let* ((syntax-entry (aref (syntax-table) char)) - (class (and syntax-entry - (syntax-class syntax-entry))) - (pair (and syntax-entry - (cdr syntax-entry)))) - (cond ((eq class (car (string-to-syntax "("))) - ;; syntax classes "opening parens" and "close parens" - (define-key map (string char) 'autopair-insert-opening) - (define-key map (string pair) 'autopair-skip-close-maybe)) - ((eq class (car (string-to-syntax "\""))) - ;; syntax class "string quote - (define-key map (string char) 'autopair-insert-or-skip-quote)) - ((eq class (car (string-to-syntax "$"))) - ;; syntax class "paired-delimiter" - ;; - ;; Apropos this class, see Issues 18, 25 and - ;; elisp info node "35.2.1 Table of Syntax - ;; Classes". The fact that it supresses - ;; syntatic properties in the delimited region - ;; dictates that deciding to autopair/autoskip - ;; can't really be as clean as the string - ;; delimiter. - ;; - ;; Apparently, only `TeX-mode' uses this, so - ;; the best is to bind this to - ;; `autopair-insert-or-skip-paired-delimiter' - ;; which defers any decision making to - ;; mode-specific post-command handler - ;; functions. - ;; - (define-key map (string char) 'autopair-insert-or-skip-paired-delimiter)))))) - ;; read `autopair-extra-pairs' - (dolist (pairs-list (remove-if-not #'listp autopair-extra-pairs)) - (dolist (pair pairs-list) - (define-key map (string (car pair)) 'autopair-extra-insert-opening) - (define-key map (string (cdr pair)) 'autopair-extra-skip-close-maybe))) - - (set (make-local-variable 'autopair-emulation-alist) (list (cons t map)))) - - (setq autopair-action nil) - (setq autopair-wrap-action nil) - (add-hook 'emulation-mode-map-alists 'autopair-emulation-alist 'append) - (add-hook 'post-command-hook 'autopair-post-command-handler 'append 'local)) - (t - (setq autopair-emulation-alist nil) - (remove-hook 'emulation-mode-map-alists 'autopair-emulation-alist) - (remove-hook 'post-command-hook 'autopair-post-command-handler 'local)))) - -;; helper functions -;; -(defun autopair-syntax-ppss () - "Calculate syntax info relevant to autopair. - -A list of four elements is returned: - -- SYNTAX-INFO is either the result `syntax-ppss' or the result of - calling `parse-partial-sexp' with the appropriate - bounds (previously calculated with `syntax-ppss'. - -- WHERE-SYM can be one of the symbols :string, :comment or :code. - -- QUICK-SYNTAX-INFO is always the result returned by `syntax-ppss'. - -- BOUNDS are the boudaries of the current string or comment if - we're currently inside one." - (let* ((quick-syntax-info (syntax-ppss)) - (string-or-comment-start (nth 8 quick-syntax-info))) - (cond (;; inside a string, recalculate - (nth 3 quick-syntax-info) - (list (parse-partial-sexp (1+ string-or-comment-start) (point)) - :string - quick-syntax-info - (cons string-or-comment-start - (condition-case nil - (scan-sexps string-or-comment-start 1) - (error nil))))) - ((nth 4 quick-syntax-info) - (list (parse-partial-sexp (1+ (nth 8 quick-syntax-info)) (point)) - :comment - quick-syntax-info)) - (t - (list quick-syntax-info - :code - quick-syntax-info))))) - -(defun autopair-find-pair (delim) - (when (and delim - (integerp delim)) - (let ((syntax-entry (aref (syntax-table) delim))) - (cond ((eq (syntax-class syntax-entry) (car (string-to-syntax "("))) - (cdr syntax-entry)) - ((or (eq (syntax-class syntax-entry) (car (string-to-syntax "\""))) - (eq (syntax-class syntax-entry) (car (string-to-syntax "$")))) - delim) - ((eq (syntax-class syntax-entry) (car (string-to-syntax ")"))) - (cdr syntax-entry)) - (autopair-extra-pairs - (some #'(lambda (pair-list) - (some #'(lambda (pair) - (cond ((eq (cdr pair) delim) (car pair)) - ((eq (car pair) delim) (cdr pair)))) - pair-list)) - (remove-if-not #'listp autopair-extra-pairs))))))) - -(defun autopair-calculate-wrap-action () - (when (region-active-p) - (save-excursion - (let* ((region-before (cons (region-beginning) - (region-end))) - (point-before (point)) - (start-syntax (syntax-ppss (car region-before))) - (end-syntax (syntax-ppss (cdr region-before)))) - (when (and (eq (nth 0 start-syntax) (nth 0 end-syntax)) - (eq (nth 3 start-syntax) (nth 3 end-syntax))) - (list 'wrap (or (second autopair-action) - (autopair-find-pair last-input-event)) - point-before - region-before)))))) - -(defun autopair-fallback (&optional fallback-keys) - (let* ((autopair-emulation-alist nil) - (beyond-cua (let ((cua--keymap-alist nil)) - (or (key-binding (this-single-command-keys)) - (key-binding fallback-keys)))) - (beyond-autopair (or (key-binding (this-single-command-keys)) - (key-binding fallback-keys)))) - (when autopair-autowrap - (setq autopair-wrap-action (autopair-calculate-wrap-action))) - - (setq this-original-command beyond-cua) - ;; defer to "paredit-mode" if that is installed and running - (when (and (featurep 'paredit) - (string-match "paredit" (symbol-name beyond-cua))) - (setq autopair-action nil)) - (let ((cua-delete-selection (not autopair-autowrap)) - (blink-matching-paren (not autopair-action))) - (call-interactively beyond-autopair)))) - -(defvar autopair-autowrap nil - "If non-nil autopair attempts to wrap the selected region. - -This is also done in an optimistic \"try-to-balance\" fashion.") - -(defvar autopair-skip-whitespace nil - "If non-nil also skip over whitespace when skipping closing delimiters. - -This will be most useful in lisp-like languages where you want -lots of )))))....") - -(defvar autopair-blink (if (boundp 'blink-matching-paren) - blink-matching-paren - t) - "If non-nil autopair blinks matching delimiters.") - -(defvar autopair-blink-delay 0.1 - "Autopair's blink-the-delimiter delay.") - -(defun autopair-document-bindings (&optional fallback-keys) - (concat - "Works by scheduling possible autopair behaviour, then calls -original command as if autopair didn't exist" - (when (eq this-command 'describe-key) - (let* ((autopair-emulation-alist nil) - (command (or (key-binding (this-single-command-keys)) - (key-binding fallback-keys)))) - (when command - (format ", which in this case is `%s'" command)))) - ".")) - -(defun autopair-escaped-p (syntax-info) - (nth 5 syntax-info)) - -(defun autopair-exception-p (where-sym exception-where-sym blacklist &optional fn) - (and (or (eq exception-where-sym :everywhere) - (eq exception-where-sym where-sym)) - (member last-input-event - (if fn - (mapcar fn (getf blacklist exception-where-sym)) - (getf blacklist exception-where-sym))))) - -(defun autopair-up-list (syntax-info &optional closing) - "Try to uplist as much as possible, moving point. - -Return nil if something prevented uplisting. - -Otherwise return a cons of char positions of the starting -delimiter and end delimiters of the last list we just came out -of. If we aren't inside any lists return a cons of current point. - -If inside nested lists of mixed parethesis types, finding a -matching parenthesis of a mixed-type is considered OK (non-nil is -returned) and uplisting stops there." - (condition-case nil - (let ((howmany (car syntax-info)) - (retval (cons (point) - (point)))) - (while (and (> howmany 0) - (condition-case err - (progn - (scan-sexps (point) (- (point-max))) - (error err)) - (error (let ((opening (and closing - (autopair-find-pair closing)))) - (setq retval (cons (fourth err) - (point))) - (or (not opening) - (eq opening (char-after (fourth err)))))))) - (goto-char (scan-lists (point) 1 1)) - (decf howmany)) - retval) - (error nil))) - -;; interactive commands and their associated predicates -;; -(defun autopair-insert-or-skip-quote () - (interactive) - (let* ((syntax-triplet (autopair-syntax-ppss)) - (syntax-info (first syntax-triplet)) - (where-sym (second syntax-triplet)) - (orig-info (third syntax-triplet)) - ;; inside-string may the quote character itself or t if this - ;; is a "generically terminated string" - (inside-string (and (eq where-sym :string) - (fourth orig-info))) - (escaped-p (autopair-escaped-p syntax-info)) - - ) - (cond (;; decides whether to skip the quote... - ;; - (and (not escaped-p) - (eq last-input-event (char-after (point))) - (or - ;; ... if we're already inside a string and the - ;; string starts with the character just inserted, - ;; or it's a generically terminated string - (and inside-string - (or (eq inside-string t) - (eq last-input-event inside-string))) - ;; ... if we're in a comment and ending a string - ;; (the inside-string criteria does not work - ;; here...) - (and (eq where-sym :comment) - (condition-case nil - (eq last-input-event (char-after (scan-sexps (1+ (point)) -1))) - (error nil))))) - (setq autopair-action (list 'skip-quote last-input-event (point)))) - (;; decides whether to pair, i.e do *not* pair the quote if... - ;; - (not - (or - escaped-p - ;; ... inside a generic string - (eq inside-string t) - ;; ... inside an unterminated string started by this char - (autopair-in-unterminated-string-p syntax-triplet) - ;; ... uplisting forward causes an error which leaves us - ;; inside an unterminated string started by this char - (condition-case err - (progn (save-excursion (up-list)) nil) - (error - (autopair-in-unterminated-string-p (save-excursion - (goto-char (fourth err)) - (autopair-syntax-ppss))))) - (autopair-in-unterminated-string-p (save-excursion - (goto-char (point-max)) - (autopair-syntax-ppss))) - ;; ... comment-disable or string-disable are true here. - ;; The latter is only useful if we're in a string - ;; terminated by a character other than - ;; `last-input-event'. - (some #'(lambda (sym) - (autopair-exception-p where-sym sym autopair-dont-pair)) - '(:comment :string)))) - (setq autopair-action (list 'insert-quote last-input-event (point))))) - (autopair-fallback))) - - (put 'autopair-insert-or-skip-quote 'function-documentation - '(concat "Insert or possibly skip over a quoting character.\n\n" - (autopair-document-bindings))) - -(defun autopair-in-unterminated-string-p (autopair-triplet) - (and (eq last-input-event (fourth (third autopair-triplet))) - (condition-case nil (progn (scan-sexps (ninth (third autopair-triplet)) 1) nil) (error t)))) - - -(defun autopair-insert-opening () - (interactive) - (when (autopair-pair-p) - (setq autopair-action (list 'opening (autopair-find-pair last-input-event) (point)))) - (autopair-fallback)) -(put 'autopair-insert-opening 'function-documentation - '(concat "Insert opening delimiter and possibly automatically close it.\n\n" - (autopair-document-bindings))) - -(defun autopair-skip-close-maybe () - (interactive) - (when (autopair-skip-p) - (setq autopair-action (list 'closing (autopair-find-pair last-input-event) (point)))) - (autopair-fallback)) -(put 'autopair-skip-close-maybe 'function-documentation - '(concat "Insert or possibly skip over a closing delimiter.\n\n" - (autopair-document-bindings))) - -(defun autopair-backspace () - (interactive) - (when (char-before) - (setq autopair-action (list 'backspace (autopair-find-pair (char-before)) (point)))) - (autopair-fallback (kbd "DEL"))) -(put 'autopair-backspace 'function-documentation - '(concat "Possibly delete a pair of paired delimiters.\n\n" - (autopair-document-bindings (kbd "DEL")))) - -(defun autopair-newline () - (interactive) - (let ((pair (autopair-find-pair (char-before)))) - (when (eq (char-after) pair) - (setq autopair-action (list 'newline pair (point)))) - (autopair-fallback (kbd "RET")))) -(put 'autopair-newline 'function-documentation - '(concat "Possibly insert two newlines and place point after the first, indented.\n\n" - (autopair-document-bindings (kbd "RET")))) - -(defun autopair-skip-p () - (interactive) - (let* ((syntax-triplet (autopair-syntax-ppss)) - (syntax-info (first syntax-triplet)) - (orig-point (point))) - (cond ((eq autopair-skip-criteria 'help-balance) - (save-excursion - (let ((pos-pair (autopair-up-list syntax-info last-input-event))) - ;; if `autopair-up-list' returned something valid, we - ;; probably want to skip but only if on of the following is true. - ;; - ;; 1. it returned a cons of equal values (we're not inside any list - ;; - ;; 2. up-listing stopped at a list that contains our original point - ;; - ;; 3. up-listing stopped at a list that does not - ;; contain out original point but its starting - ;; delimiter matches the one we expect. - (and pos-pair - (or (eq (car pos-pair) (cdr pos-pair)) - (< orig-point (cdr pos-pair)) - (eq (char-after (car pos-pair)) - (autopair-find-pair last-input-event))))))) - ((eq autopair-skip-criteria 'need-opening) - (save-excursion - (condition-case err - (progn - (backward-list) - t) - (error nil)))) - (t - t)))) - -(defun autopair-pair-p () - (let* ((syntax-triplet (autopair-syntax-ppss)) - (syntax-info (first syntax-triplet)) - (where-sym (second syntax-triplet)) - (orig-point (point))) - (and (not (some #'(lambda (sym) - (autopair-exception-p where-sym sym autopair-dont-pair)) - '(:string :comment :code :everywhere))) - (cond ((eq autopair-pair-criteria 'help-balance) - (and (not (autopair-escaped-p syntax-info)) - (save-excursion - (let ((pos-pair (autopair-up-list syntax-info)) - (prev-point (point-max)) - (expected-closing (autopair-find-pair last-input-event))) - (condition-case err - (progn - (while (not (eq prev-point (point))) - (setq prev-point (point)) - (forward-sexp)) - t) - (error - ;; if `forward-sexp' (called byp - ;; `autopair-forward') returned an error. - ;; typically we don't want to autopair, - ;; unless one of the following occurs: - ;; - (cond (;; 1. The error is *not* of type "containing - ;; expression ends prematurely", which means - ;; we're in the "too-many-openings" situation - ;; and thus want to autopair. - (not (string-match "prematurely" (second err))) - t) - (;; 2. We stopped at a closing parenthesis. Do - ;; autopair if we're in a mixed parens situation, - ;; i.e. the last list jumped over was started by - ;; the paren we're trying to match - ;; (`last-input-event') and ended by a different - ;; parens, or the closing paren we stopped at is - ;; also different from the expected. The second - ;; `scan-lists' places point at the closing of the - ;; last list we forwarded over. - ;; - (condition-case err - (prog1 - (eq (char-after (scan-lists (point) -1 0)) - last-input-event) - (goto-char (scan-lists (point) -1 -1))) - (error t)) - - (or - ;; mixed () ] for input (, yes autopair - (not (eq expected-closing (char-after (third err)))) - ;; mixed (] ) for input (, yes autopair - (not (eq expected-closing (char-after (point)))) - ;; ()) for input (, not mixed - ;; hence no autopair - )) - (t - nil)) - ;; (eq (fourth err) (point-max)) - )))))) - ((eq autopair-pair-criteria 'always) - t) - (t - (not (autopair-escaped-p))))))) - -;; post-command-hook stuff -;; -(defun autopair-post-command-handler () - "Performs pairing and wrapping based on `autopair-action' and -`autopair-wrap-action'. " - (when (and autopair-wrap-action - (notany #'null autopair-wrap-action)) - - (if autopair-handle-wrap-action-fns - (condition-case err - (mapc #'(lambda (fn) - (apply fn autopair-wrap-action)) - autopair-handle-wrap-action-fns) - (error (progn - (message "[autopair] error running custom `autopair-handle-wrap-action-fns', switching autopair off") - (autopair-mode -1)))) - (apply #'autopair-default-handle-wrap-action autopair-wrap-action)) - (setq autopair-wrap-action nil)) - - (when (and autopair-action - (notany #'null autopair-action)) - (if autopair-handle-action-fns - (condition-case err - (mapc #'(lambda (fn) - (funcall fn (first autopair-action) (second autopair-action) (third autopair-action))) - autopair-handle-action-fns) - (error (progn - (message "[autopair] error running custom `autopair-handle-action-fns', switching autopair off") - (autopair-mode -1)))) - (apply #'autopair-default-handle-action autopair-action)) - (setq autopair-action nil))) - -(defun autopair-blink-matching-open () - (let ((blink-matching-paren autopair-blink) - (show-paren-mode nil) - (blink-matching-delay autopair-blink-delay)) - (blink-matching-open))) - -(defun autopair-blink (&optional pos) - (when autopair-blink - (if pos - (save-excursion - (goto-char pos) - (sit-for autopair-blink-delay)) - (sit-for autopair-blink-delay)))) - -(defun autopair-default-handle-action (action pair pos-before) - ;;(message "action is %s" action) - (cond (;; automatically insert closing delimiter - (and (eq 'opening action) - (not (eq pair (char-before)))) - (insert pair) - (autopair-blink) - (backward-char 1)) - (;; automatically insert closing quote delimiter - (eq 'insert-quote action) - (insert pair) - (autopair-blink) - (backward-char 1)) - (;; automatically skip oper closer quote delimiter - (and (eq 'skip-quote action) - (eq pair (char-after (point)))) - (delete-char 1) - (autopair-blink-matching-open)) - (;; skip over newly-inserted-but-existing closing delimiter - ;; (normal case) - (eq 'closing action) - (let ((skipped 0)) - (when autopair-skip-whitespace - (setq skipped (save-excursion (skip-chars-forward "\s\n\t")))) - (when (eq last-input-event (char-after (+ (point) skipped))) - (unless (zerop skipped) (autopair-blink (+ (point) skipped))) - (delete-char (1+ skipped)) - (autopair-blink-matching-open)))) - (;; autodelete closing delimiter - (and (eq 'backspace action) - (eq pair (char-after (point)))) - (delete-char 1)) - (;; opens an extra line after point, then indents - (and (eq 'newline action) - (eq pair (char-after (point)))) - (save-excursion - (newline-and-indent)) - (indent-according-to-mode) - (when (or (and (boundp 'global-hl-line-mode) - global-hl-line-mode) - (and (boundp 'hl-line-mode) - hl-line-mode)) - (hl-line-unhighlight) (hl-line-highlight))))) - -(defun autopair-default-handle-wrap-action (action pair pos-before region-before) - "Default handler for the wrapping action in `autopair-wrap'" - (when (eq 'wrap action) - (let ((reverse-selected (= (car region-before) pos-before))) - (cond - ((eq 'opening (first autopair-action)) - ;; (message "wrap-opening!") - (cond (reverse-selected - (goto-char (1+ (cdr region-before))) - (insert pair) - (autopair-blink) - (goto-char (1+ (car region-before)))) - (t - (delete-backward-char 1) - (insert pair) - (goto-char (car region-before)) - (insert last-input-event))) - (setq autopair-action nil) ) - (;; wraps - (eq 'closing (first autopair-action)) - ;; (message "wrap-closing!") - (cond (reverse-selected - (delete-backward-char 1) - (insert pair) - (goto-char (1+ (cdr region-before))) - (insert last-input-event)) - (t - (goto-char (car region-before)) - (insert pair) - (autopair-blink) - (goto-char (+ 2 (cdr region-before))))) - (setq autopair-action nil)) - ((eq 'insert-quote (first autopair-action)) - (cond (reverse-selected - (goto-char (1+ (cdr region-before))) - (insert pair) - (autopair-blink)) - (t - (goto-char (car region-before)) - (insert last-input-event) - (autopair-blink))) - (setq autopair-action nil)) - (reverse-selected - (delete-backward-char 1) - (goto-char (cdr region-before)) - (insert last-input-event)))))) - - -;; example python triple quote helper -;; -(defun autopair-python-triple-quote-action (action pair pos-before) - (cond ((and (eq 'insert-quote action) - (>= (point) 3) - (string= (buffer-substring (- (point) 3) - (point)) - (make-string 3 pair))) - (save-excursion (insert (make-string 2 pair)))) - ((and (eq 'backspace action) - (>= (point) 2) - (<= (point) (- (point-max) 2)) - (string= (buffer-substring (- (point) 2) - (+ (point) 2)) - (make-string 4 pair))) - (delete-region (- (point) 2) - (+ (point) 2))) - ((and (eq 'skip-quote action) - (<= (point) (- (point-max) 2)) - (string= (buffer-substring (point) - (+ (point) 2)) - (make-string 2 pair))) - (forward-char 2)) - (t - t))) - -;; example latex paired-delimiter helper -;; -(defun autopair-latex-mode-paired-delimiter-action (action pair pos-before) - "Pair or skip latex's \"paired delimiter\" syntax in math mode." - (when (eq action 'paired-delimiter) - (when (eq (char-before) pair) - (if (and (eq (get-text-property pos-before 'face) 'tex-math) - (eq (char-after) pair)) - (cond ((and (eq (char-after) pair) - (eq (char-after (1+ (point))) pair)) - ;; double skip - (delete-char 1) - (forward-char)) - ((eq (char-before pos-before) pair) - ;; doube insert - (insert pair) - (backward-char)) - (t - ;; simple skip - (delete-char 1))) - (insert pair) - (backward-char))))) - -;; Commands and predicates for the autopair-extra* feature -;; - -(defun autopair-extra-insert-opening () - (interactive) - (when (autopair-extra-pair-p) - (setq autopair-action (list 'opening (autopair-find-pair last-input-event) (point)))) - (autopair-fallback)) -(put 'autopair-extra-insert-opening 'function-documentation - '(concat "Insert (an extra) opening delimiter and possibly automatically close it.\n\n" - (autopair-document-bindings))) - -(defun autopair-extra-skip-close-maybe () - (interactive) - (when (autopair-extra-skip-p) - (setq autopair-action (list 'closing last-input-event (point)))) - (autopair-fallback)) -(put 'autopair-extra-skip-close-maybe 'function-documentation - '(concat "Insert or possibly skip over a (and extra) closing delimiter.\n\n" - (autopair-document-bindings))) - -(defun autopair-extra-pair-p () - (let* ((syntax-triplet (autopair-syntax-ppss)) - (syntax-info (first syntax-triplet)) - (where-sym (second syntax-triplet))) - (some #'(lambda (sym) - (autopair-exception-p where-sym sym autopair-extra-pairs #'car)) - '(:everywhere :comment :string :code)))) - -(defun autopair-extra-skip-p () - (let* ((syntax-triplet (autopair-syntax-ppss)) - (syntax-info (first syntax-triplet)) - (where-sym (second syntax-triplet)) - (orig-point (point))) - (and (eq (char-after (point)) last-input-event) - (some #'(lambda (sym) - (autopair-exception-p where-sym sym autopair-extra-pairs #'cdr)) - '(:comment :string :code :everywhere)) - (save-excursion - (condition-case err - (backward-sexp (point-max)) - (error - (goto-char (third err)))) - (search-forward (make-string 1 (autopair-find-pair last-input-event)) - orig-point - 'noerror))))) - -;; Commands and tex-mode specific handler functions for the "paired -;; delimiter" syntax class. -;; -(defun autopair-insert-or-skip-paired-delimiter () - " insert or skip a character paired delimiter" - (interactive) - (setq autopair-action (list 'paired-delimiter last-input-event (point))) - (autopair-fallback)) - -(put 'autopair-insert-or-skip-paired-delimiter 'function-documentation - '(concat "Insert or possibly skip over a character with a syntax-class of \"paired delimiter\"." - (autopair-document-bindings))) - - - -;; monkey-patching: Compatibility with delete-selection-mode and cua-mode -;; -;; Ideally one would be able to use functions as the value of the -;; 'delete-selection properties of the autopair commands. The function -;; would return non-nil when no wrapping should/could be performed. -;; -;; Until then use some `defadvice' i.e. monkey-patching -;; -(put 'autopair-insert-opening 'delete-selection t) -(put 'autopair-skip-close-maybe 'delete-selection t) -(put 'autopair-insert-or-skip-quote 'delete-selection t) -(put 'autopair-extra-insert-opening 'delete-selection t) -(put 'autopair-extra-skip-close-maybe 'delete-selection t) -(put 'autopair-backspace 'delete-selection 'supersede) -(put 'autopair-newline 'delete-selection t) - -(defun autopair-should-autowrap () - (let ((name (symbol-name this-command))) - (and autopair-mode - (not (eq this-command 'autopair-backspace)) - (string-match "^autopair" (symbol-name this-command)) - (autopair-calculate-wrap-action)))) - -(defadvice cua--pre-command-handler-1 (around autopair-override activate) - "Don't actually do anything if autopair is about to autowrap. " - (unless (autopair-should-autowrap) ad-do-it)) - -(defadvice delete-selection-pre-hook (around autopair-override activate) - "Don't actually do anything if autopair is about to autowrap. " - (unless (autopair-should-autowrap) ad-do-it)) - - -(provide 'autopair) -;;; autopair.el ends here -;; diff --git a/.emacs.d/batch-mode.el b/.emacs.d/batch-mode.el deleted file mode 100644 index dcc156a..0000000 --- a/.emacs.d/batch-mode.el +++ /dev/null @@ -1,156 +0,0 @@ -;;; batch-mode.el --- major mode for editing ESRI batch scrips -;;; Copyright (C) 2002, Agnar Renolen -;;; Modified (c) 2009, Matthew Fidler -;;; Fixed indents (and labels) - -;; batch-mode.el 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 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, write to the Free Software -;; Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA - -;; This is version 1.0 of 21 August 2002. - -;;; Comentary: - -;; The batch-mode provides syntax hilighting and auto-indentation for -;; DOS batch files (.bat). and auto-idendation. - -;; Agnar Renolen, - -;;; Code: - -(defgroup batch nil - "Major mode for editing batch code" - :prefix "batch-" - :group 'languages) - -; (defvar batch-mode-hook nil -; "Hooks called when batch mode fires up." -; :type 'hook -; :group 'batch) - -(defvar batch-mode-map nil - "Keymap used with batch code") - -(defcustom batch-indent-level 4 - "Amount by which batch subexpressions are indented." - :type 'integer - :group 'batch) - -(defvar batch-font-lock-keywords - (eval-when-compile - (list - ; since we can't specify batch comments through the syntax table, - ; we have to specify it here, and override whatever is highlighted - '( "^[ \t]*rem\\>.*" (0 font-lock-comment-face t)) - - ; since the argument to the echo command is a string, we format it - ; as a string - '( "\\[ \t]*\\(.*\\)" (1 font-lock-string-face t)) - - ; the argument of the goto statement is a label - '( "\\[ \t]*\\([a-zA-Z0-9_]+\\)" (1 - font-lock-constant-face)) - - ; the keywords of batch (which are not built-in commands) - (concat "\\<\\(cmdextversion\\|" - "d\\(efined\\|isableextensions\\|o\\)\\|" - "e\\(lse\\|n\\(ableextensions\\|dlocal\\)" - "\\|qu\\|rrorlevel\\|xist\\)\\|for\\|" - "goto\\|i[fn]\\|n\\(eq\\|ot\\)\\|setlocal\\)\\>") - - ; built-in DOS commands - (cons (concat "\\<\\(a\\(ssoc\\|t\\(\\|trib\\)\\)\\|break\\|" - "c\\(a\\(cls\\|ll\\)\\|d\\|h\\(cp\\|dir\\|k\\(" - "dsk\\|ntfs\\)\\)\\|ls\\|md\\|o\\(lor\\|mp\\(\\|act\\)" - "\\|nvert\\|py\\)\\)\\|d\\(ate\\|el\\|i\\(" - "r\\|skco\\(mp\\|py\\)\\)\\|oskey\\)\\|" - "e\\(cho\\|rase\\|xit\\)\\|" - "f\\(c\\|ind\\(\\|str\\)\\|for\\(\\|mot\\)\\|type\\)\\|" - "graftabl\\|help\\|label\\|" - "m\\(d\\|mkdir\\|o[dvr]e\\)\\|p\\(a\\(th\\|use\\)" - "\\|opd\\|r\\(int\\|opmt\\)\\|ushd\\)\\|" - "r\\(d\\|e\\(cover\\|n\\(\\|ame\\)\\|place\\)\\|mdir\\)\\|" - "s\\(et\\|hift\\|ort\\|tart\\|ubst\\)\\|" - "t\\(i\\(me\\|tle\\)\\|ree\\|ype\\)\\|" - "v\\(er\\(\\|ify\\)\\|ol\\)\\|xcopy\\)\\>") - 'font-lock-builtin-face) - - ; variables are embeded in percent chars - '( "%[a-zA-Z0-9_]+%?" . font-lock-variable-name-face) - ; labels are formatted as constants - '( ":[a-zA-Z0-9_]+" . font-lock-constant-face) - - ; command line switches are hilighted as type-face - '( "[-/][a-zA-Z0-9_]+" . font-lock-type-face) - - ; variables set should also be hilighted with variable-name-face - '( "\\[ \t]*\\([a-zA-Z0-9_]+\\)" (1 font-lock-variable-name-face)) - ))) - - -;;;###autoload -(defun batch-mode () - "Major mode for editing batch scripts." - (interactive) - (kill-all-local-variables) - (setq major-mode 'batch-mode) - (setq mode-name "Avenue") - (set (make-local-variable 'indent-line-function) 'batch-indent-line) - (set (make-local-variable 'comment-start) "rem") - (set (make-local-variable 'comment-start-skip) "rem[ \t]*") - (set (make-local-variable 'font-lock-defaults) - '(batch-font-lock-keywords nil t nil)) - (run-hooks 'batch-mode-hook)) - -(defun batch-indent-line () - "Indent current line as batch script" - (let ((indent (batch-calculate-indent)) - beg shift-amt - (old-pos (- (point-max) (point)))) - (beginning-of-line) - (setq beg (point)) - (skip-chars-forward " \t") - (if (looking-at ")") - (setq indent (max (- indent batch-indent-level)))) - (message "prev indent: %d" indent) - (setq shift-amt (- indent (current-column))) - (if (not (zerop shift-amt)) - (progn - (delete-region beg (point)) - ; ArcView replaces tabs with single spaces, so we only insert - ; spaces to make indentation correct in ArcView. - (insert-char ? indent) - (if (> (- (point-max) old-pos) (point)) - (goto-char (- (point-max) old-pos))))) - shift-amt)) - -(defun batch-calculate-indent () - "Return appropriate indentation for the current line as batch code." - (save-excursion - (beginning-of-line) - (current-indentation) - (if (bobp) - 0 - (if (re-search-backward "^[ \t]*[^ \t\n\r]" nil t) - (if (looking-at "[ \t]*\\()[ \t]*else\\|for\\|if\\)\\>[^(\n]*([^)\n]*") - (+ (current-indentation) batch-indent-level) - (if (looking-at "[ \t]*[^(]*)[ \t]*") - (- (current-indentation) batch-indent-level) - (current-indentation))) - 0)))) - -(add-to-list 'auto-mode-alist '("\\.bat\\'" . batch-mode)) - -(provide 'batch-mode) - -;;; batch-mode.el ends here diff --git a/.emacs.d/color-theme.el b/.emacs.d/color-theme.el deleted file mode 100644 index c92c1a5..0000000 --- a/.emacs.d/color-theme.el +++ /dev/null @@ -1,1668 +0,0 @@ -;;; color-theme.el --- install color themes - -;; Copyright (C) 1999, 2000 Jonadab the Unsightly One -;; Copyright (C) 2000, 2001, 2002, 2003 Alex Schroeder -;; Copyright (C) 2003, 2004, 2005, 2006 Xavier Maillard - -;; Version: 6.6.0 -;; Keywords: faces -;; Author: Jonadab the Unsightly One -;; Maintainer: Xavier Maillard -;; URL: http://www.emacswiki.org/cgi-bin/wiki.pl?ColorTheme - -;; This file is not (YET) part of GNU Emacs. - -;; This 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 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: - -;; Please read README and BUGS files for any relevant help. -;; Contributors (not themers) should also read HACKING file. - -;;; Thanks - -;; Deepak Goel -;; S. Pokrovsky for ideas and discussion. -;; Gordon Messmer for ideas and discussion. -;; Sriram Karra for the color-theme-submit stuff. -;; Olgierd `Kingsajz' Ziolko for the spec-filter idea. -;; Brian Palmer for color-theme-library ideas and code -;; All the users that contributed their color themes. - - - -;;; Code: -(eval-when-compile - (require 'easymenu) - (require 'reporter) - (require 'sendmail)) - -(require 'cl); set-difference is a function... - -;; for custom-face-attributes-get or face-custom-attributes-get -(require 'cus-face) -(require 'wid-edit); for widget-apply stuff in cus-face.el - -(defconst color-theme-maintainer-address "zedek@gnu.org" - "Address used by `submit-color-theme'.") - -;; Emacs / XEmacs compatibility and workaround layer - -(cond ((and (facep 'tool-bar) - (not (facep 'toolbar))) - (put 'toolbar 'face-alias 'tool-bar)) - ((and (facep 'toolbar) - (not (facep 'tool-bar))) - (put 'tool-bar 'face-alias 'toolbar))) - -(defvar color-theme-xemacs-p (and (featurep 'xemacs) - (string-match "XEmacs" emacs-version)) - "Non-nil if running XEmacs.") - -;; Add this since it appears to miss in emacs-2x -(or (fboundp 'replace-in-string) - (defun replace-in-string (target old new) - (replace-regexp-in-string old new target))) - -;; face-attr-construct has a problem in Emacs 20.7 and older when -;; dealing with inverse-video faces. Here is a short test to check -;; wether you are affected. - -;; (set-background-color "wheat") -;; (set-foreground-color "black") -;; (setq a (make-face 'a-face)) -;; (face-spec-set a '((t (:background "white" :foreground "black" :inverse-video t)))) -;; (face-attr-construct a) -;; => (:background "black" :inverse-video t) - -;; The expected response is the original specification: -;; => (:background "white" :foreground "black" :inverse-video t) - -;; That's why we depend on cus-face.el functionality. - -(cond ((fboundp 'custom-face-attributes-get) - (defun color-theme-face-attr-construct (face frame) - (if (atom face) - (custom-face-attributes-get face frame) - (if (and (consp face) (eq (car face) 'quote)) - (custom-face-attributes-get (cadr face) frame) - (custom-face-attributes-get (car face) frame))))) - ((fboundp 'face-custom-attributes-get) - (defalias 'color-theme-face-attr-construct - 'face-custom-attributes-get)) - (t - (defun color-theme-face-attr-construct (&rest ignore) - (error "Unable to construct face attributes")))) - -(defun color-theme-alist (plist) - "Transform PLIST into an alist if it is a plist and return it. -If the first element of PLIST is a cons cell, we just return PLIST, -assuming PLIST to be an alist. If the first element of plist is not a -symbol, this is an error: We cannot distinguish a plist from an ordinary -list, but a list that doesn't start with a symbol is certainly no plist -and no alist. - -This is used to make sure `default-frame-alist' really is an alist and not -a plist. In XEmacs, the alist is deprecated; a plist is used instead." - (cond ((consp (car plist)) - plist) - ((not (symbolp (car plist))) - (error "Wrong type argument: plist, %S" plist)) - ((featurep 'xemacs) - (plist-to-alist plist)))); XEmacs only - -;; Customization - -(defgroup color-theme nil - "Color Themes for Emacs. -A color theme consists of frame parameter settings, variable settings, -and face definitions." - :version "20.6" - :group 'faces) - -(defcustom color-theme-legal-frame-parameters "\\(color\\|mode\\)$" - "Regexp that matches frame parameter names. -Only frame parameter names that match this regexp can be changed as part -of a color theme." - :type '(choice (const :tag "Colors only" "\\(color\\|mode\\)$") - (const :tag "Colors, fonts, and size" - "\\(color\\|mode\\|font\\|height\\|width\\)$") - (regexp :tag "Custom regexp")) - :group 'color-theme - :link '(info-link "(elisp)Window Frame Parameters")) - -(defcustom color-theme-legal-variables "\\(color\\|face\\)$" - "Regexp that matches variable names. -Only variables that match this regexp can be changed as part of a color -theme. In addition to matching this name, the variables have to be user -variables (see function `user-variable-p')." - :type 'regexp - :group 'color-theme) - -(defcustom color-theme-illegal-faces "^w3-" - "Regexp that matches face names forbidden in themes. -The default setting \"^w3-\" excludes w3 faces since these -are created dynamically." - :type 'regexp - :group 'color-theme - :link '(info-link "(elisp)Faces for Font Lock") - :link '(info-link "(elisp)Standard Faces")) - -(defcustom color-theme-illegal-default-attributes '(:family :height :width) - "A list of face properties to be ignored when installing faces. -This prevents Emacs from doing terrible things to your display just because -a theme author likes weird fonts." - :type '(repeat symbol) - :group 'color-theme) - -(defcustom color-theme-is-global t - "*Determines wether a color theme is installed on all frames or not. -If non-nil, color themes will be installed for all frames. -If nil, color themes will be installed for the selected frame only. - -A possible use for this variable is dynamic binding. Here is a larger -example to put in your ~/.emacs; it will make the Blue Sea color theme -the default used for the first frame, and it will create two additional -frames with different color themes. - -setup: - \(require 'color-theme) - ;; set default color theme - \(color-theme-blue-sea) - ;; create some frames with different color themes - \(let ((color-theme-is-global nil)) - \(select-frame (make-frame)) - \(color-theme-gnome2) - \(select-frame (make-frame)) - \(color-theme-standard)) - -Please note that using XEmacs and and a nil value for -color-theme-is-global will ignore any variable settings for the color -theme, since XEmacs doesn't have frame-local variable bindings. - -Also note that using Emacs and a non-nil value for color-theme-is-global -will install a new color theme for all frames. Using XEmacs and a -non-nil value for color-theme-is-global will install a new color theme -only on those frames that are not using a local color theme." - :type 'boolean - :group 'color-theme) - -(defcustom color-theme-is-cumulative t - "*Determines wether new color themes are installed on top of each other. -If non-nil, installing a color theme will undo all settings made by -previous color themes." - :type 'boolean - :group 'color-theme) - -(defcustom color-theme-directory nil - "Directory where we can find additionnal themes (personnal). -Note that there is at least one directory shipped with the official -color-theme distribution where all contributed themes are located. -This official selection can't be changed with that variable. -However, you still can decide to turn it on or off and thus, -not be shown with all themes but yours." - :type '(repeat string) - :group 'color-theme) - -(defcustom color-theme-libraries (directory-files - (concat - (file-name-directory (locate-library "color-theme")) - "/themes") t "^color-theme") - "A list of files, which will be loaded in color-theme-initialize depending -on `color-theme-load-all-themes' value. -This allows a user to prune the default color-themes (which can take a while -to load)." - :type '(repeat string) - :group 'color-theme) - -(defcustom color-theme-load-all-themes t - "When t, load all color-theme theme files -as presented by `color-theme-libraries'. Else -do not load any of this themes." - :type 'boolean - :group 'color-theme) - -(defcustom color-theme-mode-hook nil - "Hook for color-theme-mode." - :type 'hook - :group 'color-theme) - -(defvar color-theme-mode-map - (let ((map (make-sparse-keymap))) - (define-key map (kbd "RET") 'color-theme-install-at-point) - (define-key map (kbd "c") 'list-colors-display) - (define-key map (kbd "d") 'color-theme-describe) - (define-key map (kbd "f") 'list-faces-display) - (define-key map (kbd "i") 'color-theme-install-at-point) - (define-key map (kbd "l") 'color-theme-install-at-point-for-current-frame) - (define-key map (kbd "p") 'color-theme-print) - (define-key map (kbd "q") 'bury-buffer) - (define-key map (kbd "?") 'color-theme-describe) - (if color-theme-xemacs-p - (define-key map (kbd "") 'color-theme-install-at-mouse) - (define-key map (kbd "") 'color-theme-install-at-mouse)) - map) - "Mode map used for the buffer created by `color-theme-select'.") - -(defvar color-theme-initialized nil - "Internal variable determining whether color-theme-initialize has been invoked yet") - -(defvar color-theme-buffer-name "*Color Theme Selection*" - "Name of the color theme selection buffer.") - -(defvar color-theme-original-frame-alist nil - "nil until one of the color themes has been installed.") - -(defvar color-theme-history nil - "List of color-themes called, in reverse order") - -(defcustom color-theme-history-max-length nil - "Max length of history to maintain. -Two other values are acceptable: t means no limit, and -nil means that no history is maintained." - :type '(choice (const :tag "No history" nil) - (const :tag "Unlimited length" t) - integer) - :group 'color-theme) - -(defvar color-theme-counter 0 - "Counter for every addition to `color-theme-history'. -This counts how many themes were installed, regardless -of `color-theme-history-max-length'.") - -(defvar color-theme-entry-path (cond - ;; Emacs 22.x and later - ((lookup-key global-map [menu-bar tools]) - '("tools")) - ;; XEmacs - ((featurep 'xemacs) - (setq tool-entry '("Tools"))) - ;; Emacs < 22 - (t - '("Tools"))) - "Menu tool entry path.") - -(defun color-theme-add-to-history (name) - "Add color-theme NAME to `color-theme-history'." - (setq color-theme-history - (cons (list name color-theme-is-cumulative) - color-theme-history) - color-theme-counter (+ 1 color-theme-counter)) - ;; Truncate the list if necessary. - (when (and (integerp color-theme-history-max-length) - (>= (length color-theme-history) - color-theme-history-max-length)) - (setcdr (nthcdr (1- color-theme-history-max-length) - color-theme-history) - nil))) - -;; (let ((l '(1 2 3 4 5))) -;; (setcdr (nthcdr 2 l) nil) -;; l) - - - -;; List of color themes used to create the *Color Theme Selection* -;; buffer. - -(defvar color-themes - '((color-theme-aalto-dark "Aalto Dark" "Jari Aalto ") - (color-theme-aalto-light "Aalto Light" "Jari Aalto ") - (color-theme-aliceblue "Alice Blue" "Girish Bharadwaj ") - (color-theme-andreas "Andreas" "Andreas Busch ") - (color-theme-arjen "Arjen" "Arjen Wiersma ") - (color-theme-beige-diff "Beige Diff" "Alex Schroeder " t) - (color-theme-bharadwaj "Bharadwaj" "Girish Bharadwaj ") - (color-theme-bharadwaj-slate "Bharadwaj Slate" "Girish Bharadwaj ") - (color-theme-billw "Billw" "Bill White ") - (color-theme-black-on-gray "BlackOnGray" "Sudhir Bhojwani ") - (color-theme-blippblopp "Blipp Blopp" "Thomas Sicheritz-Ponten") - (color-theme-simple-1 "Black" "Jonadab ") - (color-theme-blue-erc "Blue ERC" "Alex Schroeder " t) - (color-theme-blue-gnus "Blue Gnus" "Alex Schroeder " t) - (color-theme-blue-mood "Blue Mood" "Nelson Loyola ") - (color-theme-blue-sea "Blue Sea" "Alex Schroeder ") - (color-theme-calm-forest "Calm Forest" "Artur Hefczyc ") - (color-theme-charcoal-black "Charcoal Black" "Lars Chr. Hausmann ") - (color-theme-goldenrod "Cheap Goldenrod" "Alex Schroeder ") - (color-theme-clarity "Clarity and Beauty" "Richard Wellum ") - (color-theme-classic "Classic" "Frederic Giroud ") - (color-theme-comidia "Comidia" "Marcelo Dias de Toledo ") - (color-theme-jsc-dark "Cooper Dark" "John S Cooper ") - (color-theme-jsc-light "Cooper Light" "John S Cooper ") - (color-theme-jsc-light2 "Cooper Light 2" "John S Cooper ") - (color-theme-dark-blue "Dark Blue" "Chris McMahan ") - (color-theme-dark-blue2 "Dark Blue 2" "Chris McMahan ") - (color-theme-dark-green "Dark Green" "eddy_woody@hotmail.com") - (color-theme-dark-laptop "Dark Laptop" "Laurent Michel ") - (color-theme-deep-blue "Deep Blue" "Tomas Cerha ") - (color-theme-digital-ofs1 "Digital OFS1" "Gareth Owen ") - (color-theme-euphoria "Euphoria" "oGLOWo@oGLOWo.cjb.net") - (color-theme-feng-shui "Feng Shui" "Walter Higgins ") - (color-theme-fischmeister "Fischmeister" - "Sebastian Fischmeister ") - (color-theme-gnome "Gnome" "Jonadab ") - (color-theme-gnome2 "Gnome 2" "Alex Schroeder ") - (color-theme-gray1 "Gray1" "Paul Pulli ") - (color-theme-gray30 "Gray30" "Girish Bharadwaj ") - (color-theme-kingsajz "Green Kingsajz" "Olgierd `Kingsajz' Ziolko ") - (color-theme-greiner "Greiner" "Kevin Greiner ") - (color-theme-gtk-ide "GTK IDE" "Gordon Messmer ") - (color-theme-high-contrast "High Contrast" "Alex Schroeder ") - (color-theme-hober "Hober" "Edward O'Connor ") - (color-theme-infodoc "Infodoc" "Frederic Giroud ") - (color-theme-jb-simple "JB Simple" "jeff@dvns.com") - (color-theme-jedit-grey "Jedit Grey" "Gordon Messmer ") - (color-theme-jonadabian "Jonadab" "Jonadab ") - (color-theme-jonadabian-slate "Jonadabian Slate" "Jonadab ") - (color-theme-katester "Katester" "Higgins_Walter@emc.com") - (color-theme-late-night "Late Night" "Alex Schroeder ") - (color-theme-lawrence "Lawrence" "lawrence mitchell ") - (color-theme-lethe "Lethe" "Ivica Loncar ") - (color-theme-ld-dark "Linh Dang Dark" "Linh Dang ") - (color-theme-marine "Marine" "Girish Bharadwaj ") - (color-theme-matrix "Matrix" "Walter Higgins ") - (color-theme-marquardt "Marquardt" "Colin Marquardt ") - (color-theme-midnight "Midnight" "Gordon Messmer ") - (color-theme-mistyday "Misty Day" "Hari Kumar ") - (color-theme-montz "Montz" "Brady Montz ") - (color-theme-oswald "Oswald" "Tom Oswald ") - (color-theme-parus "Parus" "Jon K Hellan ") - (color-theme-pierson "Pierson" "Dan L. Pierson ") - (color-theme-ramangalahy "Ramangalahy" "Solofo Ramangalahy ") - (color-theme-raspopovic "Raspopovic" "Pedja Raspopovic ") - (color-theme-renegade "Renegade" "Dave Benjamin ") - (color-theme-resolve "Resolve" "Damien Elmes ") - (color-theme-retro-green "Retro Green" "Alex Schroeder ") - (color-theme-retro-orange "Retro Orange" "Alex Schroeder ") - (color-theme-robin-hood "Robin Hood" "Alex Schroeder ") - (color-theme-rotor "Rotor" "Jinwei Shen ") - (color-theme-ryerson "Ryerson" "Luis Fernandes ") - (color-theme-salmon-diff "Salmon Diff" "Alex Schroeder " t) - (color-theme-salmon-font-lock "Salmon Font-Lock" "Alex Schroeder " t) - (color-theme-scintilla "Scintilla" "Gordon Messmer ") - (color-theme-shaman "Shaman" "shaman@interdon.net") - (color-theme-sitaramv-nt "Sitaram NT" - "Sitaram Venkatraman ") - (color-theme-sitaramv-solaris "Sitaram Solaris" - "Sitaram Venkatraman ") - (color-theme-snow "Snow" "Nicolas Rist ") - (color-theme-snowish "Snowish" "Girish Bharadwaj ") - (color-theme-standard-ediff "Standard Ediff" "Emacs Team, added by Alex Schroeder " t) - (color-theme-standard "Standard Emacs 20" "Emacs Team, added by Alex Schroeder ") - (color-theme-emacs-21 "Standard Emacs 21" "Emacs Team, added by Alex Schroeder ") - (color-theme-emacs-nw "Standard Emacs 21 No Window" "Emacs Team, added by D. Goel ") - (color-theme-xemacs "Standard XEmacs" "XEmacs Team, added by Alex Schroeder ") - (color-theme-subtle-blue "Subtle Blue" "Chris McMahan ") - (color-theme-subtle-hacker "Subtle Hacker" "Colin Walters ") - (color-theme-taming-mr-arneson "Taming Mr Arneson" "Erik Arneson ") - (color-theme-taylor "Taylor" "Art Taylor ") - (color-theme-tty-dark "TTY Dark" "O Polite ") - (color-theme-vim-colors "Vim Colors" "Michael Soulier ") - (color-theme-whateveryouwant "Whateveryouwant" "Fabien Penso , color by Scott Jaderholm ") - (color-theme-wheat "Wheat" "Alex Schroeder ") - (color-theme-pok-wob "White On Black" "S. Pokrovsky ") - (color-theme-pok-wog "White On Grey" "S. Pokrovsky ") - (color-theme-word-perfect "WordPerfect" "Thomas Gehrlein ") - (color-theme-xp "XP" "Girish Bharadwaj ")) - "List of color themes. - -Each THEME is itself a three element list (FUNC NAME MAINTAINER &optional LIBRARY). - -FUNC is a color theme function which does the setup. The function -FUNC may call `color-theme-install'. The color theme function may be -interactive. - -NAME is the name of the theme and MAINTAINER is the name and/or email of -the maintainer of the theme. - -If LIBRARY is non-nil, the color theme will be considered a library and -may not be shown in the default menu. - -If you defined your own color theme and want to add it to this list, -use something like this: - - (add-to-list 'color-themes '(color-theme-gnome2 \"Gnome2\" \"Alex\"))") - -;;; Functions - -(defun color-theme-backup-original-values () - "Back up the original `default-frame-alist'. -The values are stored in `color-theme-original-frame-alist' on -startup." - (if (null color-theme-original-frame-alist) - (setq color-theme-original-frame-alist - (color-theme-filter (frame-parameters (selected-frame)) - color-theme-legal-frame-parameters)))) -(add-hook 'after-init-hook 'color-theme-backup-original-values) - -;;;###autoload -(defun color-theme-select (&optional arg) - "Displays a special buffer for selecting and installing a color theme. -With optional prefix ARG, this buffer will include color theme libraries -as well. A color theme library is in itself not complete, it must be -used as part of another color theme to be useful. Thus, color theme -libraries are mainly useful for color theme authors." - (interactive "P") - (unless color-theme-initialized (color-theme-initialize)) - (switch-to-buffer (get-buffer-create color-theme-buffer-name)) - (setq buffer-read-only nil) - (erase-buffer) - ;; recreate the snapshot if necessary - (when (or (not (assq 'color-theme-snapshot color-themes)) - (not (commandp 'color-theme-snapshot))) - (fset 'color-theme-snapshot (color-theme-make-snapshot)) - (setq color-themes (delq (assq 'color-theme-snapshot color-themes) - color-themes) - color-themes (delq (assq 'bury-buffer color-themes) - color-themes) - color-themes (append '((color-theme-snapshot - "[Reset]" "Undo changes, if possible.") - (bury-buffer - "[Quit]" "Bury this buffer.")) - color-themes))) - (dolist (theme color-themes) - (let ((func (nth 0 theme)) - (name (nth 1 theme)) - (author (nth 2 theme)) - (library (nth 3 theme)) - (desc)) - (when (or (not library) arg) - (setq desc (format "%-23s %s" - (if library (concat name " [lib]") name) - author)) - (put-text-property 0 (length desc) 'color-theme func desc) - (put-text-property 0 (length name) 'face 'bold desc) - (put-text-property 0 (length name) 'mouse-face 'highlight desc) - (insert desc) - (newline)))) - (goto-char (point-min)) - (setq buffer-read-only t) - (set-buffer-modified-p nil) - (color-theme-mode)) - -(when (require 'easymenu) - (easy-menu-add-item nil color-theme-entry-path "--") - (easy-menu-add-item nil color-theme-entry-path - ["Color Themes" color-theme-select t])) - -(defun color-theme-mode () - "Major mode to select and install color themes. - -Use \\[color-theme-install-at-point] to install a color theme on all frames. -Use \\[color-theme-install-at-point-for-current-frame] to install a color theme for the current frame only. - -The changes are applied on top of your current setup. This is a -feature. - -Some of the themes should be considered extensions to the standard color -theme: they modify only a limited number of faces and variables. To -verify the final look of a color theme, install the standard color -theme, then install the other color theme. This is a feature. It allows -you to mix several color themes. - -Use \\[color-theme-describe] to read more about the color theme function at point. -If you want to install the color theme permanently, put the call to the -color theme function into your ~/.emacs: - - \(require 'color-theme) - \(color-theme-gnome2) - -If you worry about the size of color-theme.el: You are right. Use -\\[color-theme-print] to print the current color theme and save the resulting buffer -as ~/.emacs-color-theme. Now you can install only this specific color -theme in your .emacs: - - \(load-file \"~/.emacs-color-theme\") - \(my-color-theme) - -The Emacs menu is not affected by color themes within Emacs. Depending -on the toolkit you used to compile Emacs, you might have to set specific -X ressources. See the info manual for more information. Here is an -example ~/.Xdefaults fragment: - - emacs*Background: DarkSlateGray - emacs*Foreground: wheat - -\\{color-theme-mode-map} - -The color themes are listed in `color-themes', which see." - (kill-all-local-variables) - (setq major-mode 'color-theme-mode) - (setq mode-name "Color Themes") - (use-local-map color-theme-mode-map) - (when (functionp 'goto-address); Emacs - (goto-address)) - (run-hooks 'color-theme-mode-hook)) - -;;; Commands in Color Theme Selection mode - -;;;###autoload -(defun color-theme-describe () - "Describe color theme listed at point. -This shows the documentation of the value of text-property color-theme -at point. The text-property color-theme should be a color theme -function. See `color-themes'." - (interactive) - (describe-function (get-text-property (point) 'color-theme))) - -;;;###autoload -(defun color-theme-install-at-mouse (event) - "Install color theme clicked upon using the mouse. -First argument EVENT is used to set point. Then -`color-theme-install-at-point' is called." - (interactive "e") - (save-excursion - (mouse-set-point event) - (color-theme-install-at-point))) - -;;;autoload -(defun color-theme-install-at-point () - "Install color theme at point. -This calls the value of the text-property `color-theme' at point. -The text-property `color-theme' should be a color theme function. -See `color-themes'." - (interactive) - (let ((func (get-text-property (point) 'color-theme))) - ;; install theme - (if func - (funcall func)) - ;; If goto-address is being used, remove all overlays in the current - ;; buffer and run it again. The face used for the mail addresses in - ;; the the color theme selection buffer is based on the variable - ;; goto-address-mail-face. Changes in that variable will not affect - ;; existing overlays, however, thereby confusing users. - (when (functionp 'goto-address); Emacs - (dolist (o (overlays-in (point-min) (point-max))) - (delete-overlay o)) - (goto-address)))) - -;;;###autoload -(defun color-theme-install-at-point-for-current-frame () - "Install color theme at point for current frame only. -Binds `color-theme-is-global' to nil and calls -`color-theme-install-at-point'." - (interactive) - (let ((color-theme-is-global nil)) - (color-theme-install-at-point))) - - - -;; Taking a snapshot of the current color theme and pretty printing it. - -(defun color-theme-filter (old-list regexp &optional exclude) - "Filter OLD-LIST. -The resulting list will be newly allocated and contains only elements -with names matching REGEXP. OLD-LIST may be a list or an alist. If you -want to filter a plist, use `color-theme-alist' to convert your plist to -an alist, first. - -If the optional argument EXCLUDE is non-nil, then the sense is -reversed: only non-matching elements will be retained." - (let (elem new-list) - (dolist (elem old-list) - (setq name (symbol-name (if (listp elem) (car elem) elem))) - (when (or (and (not exclude) - (string-match regexp name)) - (and exclude - (not (string-match regexp name)))) - ;; Now make sure that if elem is a cons cell, and the cdr of - ;; that cons cell is a string, then we need a *new* string in - ;; the new list. Having a new cons cell is of no use because - ;; modify-frame-parameters will modify this string, thus - ;; modifying our color theme functions! - (when (and (consp elem) - (stringp (cdr elem))) - (setq elem (cons (car elem) - (copy-sequence (cdr elem))))) - ;; Now store elem - (setq new-list (cons elem new-list)))) - new-list)) - -(defun color-theme-spec-filter (spec) - "Filter the attributes in SPEC. -This makes sure that SPEC has the form ((t (PLIST ...))). -Only properties not in `color-theme-illegal-default-attributes' -are included in the SPEC returned." - (let ((props (cadar spec)) - result prop val) - (while props - (setq prop (nth 0 props) - val (nth 1 props) - props (nthcdr 2 props)) - (unless (memq prop color-theme-illegal-default-attributes) - (setq result (cons val (cons prop result))))) - `((t ,(nreverse result))))) - -;; (color-theme-spec-filter '((t (:background "blue3")))) -;; (color-theme-spec-filter '((t (:stipple nil :background "Black" :foreground "SteelBlue" :inverse-video nil :box nil :strike-through nil :overline nil :underline nil :slant normal :weight normal :width semi-condensed :family "misc-fixed")))) - -(defun color-theme-plist-delete (plist prop) - "Delete property PROP from property list PLIST by side effect. -This modifies PLIST." - ;; deal with prop at the start - (while (eq (car plist) prop) - (setq plist (cddr plist))) - ;; deal with empty plist - (when plist - (let ((lastcell (cdr plist)) - (l (cddr plist))) - (while l - (if (eq (car l) prop) - (progn - (setq l (cddr l)) - (setcdr lastcell l)) - (setq lastcell (cdr l) - l (cddr l)))))) - plist) - -;; (color-theme-plist-delete '(a b c d e f g h) 'a) -;; (color-theme-plist-delete '(a b c d e f g h) 'b) -;; (color-theme-plist-delete '(a b c d e f g h) 'c) -;; (color-theme-plist-delete '(a b c d e f g h) 'g) -;; (color-theme-plist-delete '(a b c d c d e f g h) 'c) -;; (color-theme-plist-delete '(a b c d e f c d g h) 'c) - -(if (or (featurep 'xemacs) - (< emacs-major-version 21)) - (defalias 'color-theme-spec-compat 'identity) - (defun color-theme-spec-compat (spec) - "Filter the attributes in SPEC such that is is never invalid. -Example: Eventhough :bold works in Emacs, it is not recognized by -`customize-face' -- and then the face is uncustomizable. This -function replaces a :bold attribute with the corresponding :weight -attribute, if there is no :weight, or deletes it. This undoes the -doings of `color-theme-spec-canonical-font', more or less." - (let ((props (cadar spec))) - (when (plist-member props :bold) - (setq props (color-theme-plist-delete props :bold)) - (unless (plist-member props :weight) - (setq props (plist-put props :weight 'bold)))) - (when (plist-member props :italic) - (setq props (color-theme-plist-delete props :italic)) - (unless (plist-member props :slant) - (setq props (plist-put props :slant 'italic)))) - `((t ,props))))) - -;; (color-theme-spec-compat '((t (:foreground "blue" :bold t)))) -;; (color-theme-spec-compat '((t (:bold t :foreground "blue" :weight extra-bold)))) -;; (color-theme-spec-compat '((t (:italic t :foreground "blue")))) -;; (color-theme-spec-compat '((t (:slant oblique :italic t :foreground "blue")))) - -(defun color-theme-spec-canonical-font (atts) - "Add :bold and :italic attributes if necessary." - ;; add these to the front of atts -- this will keept the old value for - ;; customize-face in Emacs 21. - (when (and (memq (plist-get atts :weight) - '(ultra-bold extra-bold bold semi-bold)) - (not (plist-get atts :bold))) - (setq atts (cons :bold (cons t atts)))) - (when (and (not (memq (plist-get atts :slant) - '(normal nil))) - (not (plist-get atts :italic))) - (setq atts (cons :italic (cons t atts)))) - atts) -;; (color-theme-spec-canonical-font (color-theme-face-attr-construct 'bold (selected-frame))) -;; (defface foo '((t (:weight extra-bold))) "foo") -;; (color-theme-spec-canonical-font (color-theme-face-attr-construct 'foo (selected-frame))) -;; (face-spec-set 'foo '((t (:weight extra-bold))) nil) -;; (face-spec-set 'foo '((t (:bold t))) nil) -;; (face-spec-set 'foo '((t (:bold t :weight extra-bold))) nil) - -;; Handle :height according to NEWS file for Emacs 21 -(defun color-theme-spec-resolve-height (old new) - "Return the new height given OLD and NEW height. -OLD is the current setting, NEW is the setting inherited from." - (cond ((not old) - new) - ((integerp old) - old) - ((and (floatp old) - (integerp new)) - (round (* old new))) - ((and (floatp old) - (floatp new)) - (* old new)) - ((and (functionp old) - (integerp new)) - (round (funcall old new))) - ((and (functionp old) - (float new)) - `(lambda (f) (* (funcall ,old f) ,new))) - ((and (functionp old) - (functionp new)) - `(lambda (f) (* (funcall ,old (funcall ,new f))))) - (t - (error "Illegal :height attributes: %S or %S" old new)))) -;; (color-theme-spec-resolve-height 12 1.2) -;; (color-theme-spec-resolve-height 1.2 1.2) -;; (color-theme-spec-resolve-height 1.2 12) -;; (color-theme-spec-resolve-height 1.2 'foo) -;; (color-theme-spec-resolve-height (lambda (f) (* 2 f)) 5) -;; (color-theme-spec-resolve-height (lambda (f) (* 2 f)) 2.0) -;; the following lambda is the result from the above calculation -;; (color-theme-spec-resolve-height (lambda (f) (* (funcall (lambda (f) (* 2 f)) f) 2.0)) 5) - -(defun color-theme-spec-resolve-inheritance (atts) - "Resolve all occurences of the :inherit attribute." - (let ((face (plist-get atts :inherit))) - ;; From the Emacs 21 NEWS file: "Attributes from inherited faces are - ;; merged into the face like an underlying face would be." -- - ;; therefore properties of the inherited face only add missing - ;; attributes. - (when face - ;; remove :inherit face from atts -- this assumes only one - ;; :inherit attribute. - (setq atts (delq ':inherit (delq face atts))) - (let ((more-atts (color-theme-spec-resolve-inheritance - (color-theme-face-attr-construct - face (selected-frame)))) - att val) - (while more-atts - (setq att (car more-atts) - val (cadr more-atts) - more-atts (cddr more-atts)) - ;; Color-theme assumes that no value is ever 'unspecified. - (cond ((eq att ':height); cumulative effect! - (setq atts (plist-put atts - ':height - (color-theme-spec-resolve-height - (plist-get atts att) - val)))) - ;; Default: Only put if it has not been specified before. - ((not (plist-get atts att)) - (setq atts (cons att (cons val atts)))) - -)))) - atts)) -;; (color-theme-spec-resolve-inheritance '(:bold t)) -;; (color-theme-spec-resolve-inheritance '(:bold t :foreground "blue")) -;; (color-theme-face-attr-construct 'font-lock-comment-face (selected-frame)) -;; (color-theme-spec-resolve-inheritance '(:bold t :inherit font-lock-comment-face)) -;; (color-theme-spec-resolve-inheritance '(:bold t :foreground "red" :inherit font-lock-comment-face)) -;; (color-theme-face-attr-construct 'Info-title-2-face (selected-frame)) -;; (color-theme-face-attr-construct 'Info-title-3-face (selected-frame)) -;; (color-theme-face-attr-construct 'Info-title-4-face (selected-frame)) -;; (color-theme-spec-resolve-inheritance '(:inherit Info-title-2-face)) - -;; The :inverse-video attribute causes Emacs to swap foreground and -;; background colors, XEmacs does not. Therefore, if anybody chooses -;; the inverse-video attribute, we 1. swap the colors ourselves in Emacs -;; and 2. we remove the inverse-video attribute in Emacs and XEmacs. -;; Inverse-video is only useful on a monochrome tty. -(defun color-theme-spec-maybe-invert (atts) - "Remove the :inverse-video attribute from ATTS. -If ATTS contains :inverse-video t, remove it and swap foreground and -background color. Return ATTS." - (let ((inv (plist-get atts ':inverse-video))) - (if inv - (let (result att) - (while atts - (setq att (car atts) - atts (cdr atts)) - (cond ((and (eq att :foreground) (not color-theme-xemacs-p)) - (setq result (cons :background result))) - ((and (eq att :background) (not color-theme-xemacs-p)) - (setq result (cons :foreground result))) - ((eq att :inverse-video) - (setq atts (cdr atts))); this prevents using dolist - (t - (setq result (cons att result))))) - (nreverse result)) - ;; else - atts))) -;; (color-theme-spec-maybe-invert '(:bold t)) -;; (color-theme-spec-maybe-invert '(:foreground "blue")) -;; (color-theme-spec-maybe-invert '(:background "red")) -;; (color-theme-spec-maybe-invert '(:inverse-video t)) -;; (color-theme-spec-maybe-invert '(:inverse-video t :foreground "red")) -;; (color-theme-spec-maybe-invert '(:inverse-video t :background "red")) -;; (color-theme-spec-maybe-invert '(:inverse-video t :background "red" :foreground "blue" :bold t)) -;; (color-theme-spec-maybe-invert '(:inverse-video nil :background "red" :foreground "blue" :bold t)) - -(defun color-theme-spec (face) - "Return a list for FACE which has the form (FACE SPEC). -See `defface' for the format of SPEC. In this case we use only one -DISPLAY, t, and determine ATTS using `color-theme-face-attr-construct'. -If ATTS is nil, (nil) is used instead. - -If ATTS contains :inverse-video t, we remove it and swap foreground and -background color using `color-theme-spec-maybe-invert'. We do this -because :inverse-video is handled differently in Emacs and XEmacs. We -will loose on a tty without colors, because in that situation, -:inverse-video means something." - (let ((atts - (color-theme-spec-canonical-font - (color-theme-spec-maybe-invert - (color-theme-spec-resolve-inheritance - (color-theme-face-attr-construct face (selected-frame))))))) - (if atts - `(,face ((t ,atts))) - `(,face ((t (nil))))))) - -(defun color-theme-get-params () - "Return a list of frame parameter settings usable in a color theme. -Such an alist may be installed by `color-theme-install-frame-params'. The -frame parameters returned must match `color-theme-legal-frame-parameters'." - (let ((params (color-theme-filter (frame-parameters (selected-frame)) - color-theme-legal-frame-parameters))) - (sort params (lambda (a b) (string< (symbol-name (car a)) - (symbol-name (car b))))))) - -(defun color-theme-get-vars () - "Return a list of variable settings usable in a color theme. -Such an alist may be installed by `color-theme-install-variables'. -The variable names must match `color-theme-legal-variables', and the -variable must be a user variable according to `user-variable-p'." - (let ((vars) - (val)) - (mapatoms (lambda (v) - (and (boundp v) - (user-variable-p v) - (string-match color-theme-legal-variables - (symbol-name v)) - (setq val (eval v)) - (add-to-list 'vars (cons v val))))) - (sort vars (lambda (a b) (string< (car a) (car b)))))) - -(defun color-theme-print-alist (alist) - "Print ALIST." - (insert "\n " (if alist "(" "nil")) - (dolist (elem alist) - (when (= (preceding-char) ?\)) - (insert "\n ")) - (prin1 elem (current-buffer))) - (when (= (preceding-char) ?\)) (insert ")"))) - -(defun color-theme-get-faces () - "Return a list of faces usable in a color theme. -Such an alist may be installed by `color-theme-install-faces'. The -faces returned must not match `color-theme-illegal-faces'." - (let ((faces (color-theme-filter (face-list) color-theme-illegal-faces t))) - ;; default face must come first according to comments in - ;; custom-save-faces, the rest is to be sorted by name - (cons 'default (sort (delq 'default faces) 'string-lessp)))) - -(defun color-theme-get-face-definitions () - "Return face settings usable in a color-theme." - (let ((faces (color-theme-get-faces))) - (mapcar 'color-theme-spec faces))) - -(defun color-theme-print-faces (faces) - "Print face settings for all faces returned by `color-theme-get-faces'." - (when faces - (insert "\n ")) - (dolist (face faces) - (when (= (preceding-char) ?\)) - (insert "\n ")) - (prin1 face (current-buffer)))) - -(defun color-theme-reset-faces () - "Reset face settings for all faces returned by `color-theme-get-faces'." - (let ((faces (color-theme-get-faces)) - (face) (spec) (entry) - (frame (if color-theme-is-global nil (selected-frame)))) - (while faces - (setq entry (color-theme-spec (car faces))) - (setq face (nth 0 entry)) - (setq spec '((t (nil)))) - (setq faces (cdr faces)) - (if (functionp 'face-spec-reset-face) - (face-spec-reset-face face frame) - (face-spec-set face spec frame) - (if color-theme-is-global - (put face 'face-defface-spec spec)))))) - -(defun color-theme-print-theme (func doc params vars faces) - "Print a theme into the current buffer. -FUNC is the function name, DOC the doc string, PARAMS the -frame parameters, VARS the variable bindings, and FACES -the list of faces and their specs." - (insert "(defun " (symbol-name func) " ()\n" - " \"" doc "\"\n" - " (interactive)\n" - " (color-theme-install\n" - " '(" (symbol-name func)) - ;; alist of frame parameters - (color-theme-print-alist params) - ;; alist of variables - (color-theme-print-alist vars) - ;; remaining elements of snapshot: face specs - (color-theme-print-faces faces) - (insert ")))\n") - (insert "(add-to-list 'color-themes '(" (symbol-name func) " " - " \"THEME NAME\" \"YOUR NAME\"))") - (goto-char (point-min))) - -;;;###autoload -(defun color-theme-print (&optional buf) - "Print the current color theme function. - -You can contribute this function to or -paste it into your .emacs file and call it. That should recreate all -the settings necessary for your color theme. - -Example: - - \(require 'color-theme) - \(defun my-color-theme () - \"Color theme by Alex Schroeder, created 2000-05-17.\" - \(interactive) - \(color-theme-install - '(... - ... - ...))) - \(my-color-theme) - -If you want to use a specific color theme function, you can call the -color theme function in your .emacs directly. - -Example: - - \(require 'color-theme) - \(color-theme-gnome2)" - (interactive) - (message "Pretty printing current color theme function...") - (switch-to-buffer (if buf - buf - (get-buffer-create "*Color Theme*"))) - (unless buf - (setq buffer-read-only nil) - (erase-buffer)) - ;; insert defun - (insert "(eval-when-compile" - " (require 'color-theme))\n") - (color-theme-print-theme 'my-color-theme - (concat "Color theme by " - (if (string= "" user-full-name) - (user-login-name) - user-full-name) - ", created " (format-time-string "%Y-%m-%d") ".") - (color-theme-get-params) - (color-theme-get-vars) - (mapcar 'color-theme-spec (color-theme-get-faces))) - (unless buf - (emacs-lisp-mode)) - (goto-char (point-min)) - (message "Pretty printing current color theme function... done")) - -(defun color-theme-analyze-find-theme (code) - "Find the sexpr that calls `color-theme-install'." - (let (theme) - (while (and (not theme) code) - (when (eq (car code) 'color-theme-install) - (setq theme code)) - (when (listp (car code)) - (setq theme (color-theme-analyze-find-theme (car code)))) - (setq code (cdr code))) - theme)) - -;; (equal (color-theme-analyze-find-theme -;; '(defun color-theme-blue-eshell () -;; "Color theme for eshell faces only." -;; (color-theme-install -;; '(color-theme-blue-eshell -;; nil -;; (eshell-ls-archive-face ((t (:bold t :foreground "IndianRed")))) -;; (eshell-ls-backup-face ((t (:foreground "Grey")))))))) -;; '(color-theme-install -;; (quote -;; (color-theme-blue-eshell -;; nil -;; (eshell-ls-archive-face ((t (:bold t :foreground "IndianRed")))) -;; (eshell-ls-backup-face ((t (:foreground "Grey"))))))))) - -(defun color-theme-analyze-add-face (a b regexp faces) - "If only one of A or B are in FACES, the other is added, and FACES is returned. -If REGEXP is given, this is only done if faces contains a match for regexps." - (when (or (not regexp) - (catch 'found - (dolist (face faces) - (when (string-match regexp (symbol-name (car face))) - (throw 'found t))))) - (let ((face-a (assoc a faces)) - (face-b (assoc b faces))) - (if (and face-a (not face-b)) - (setq faces (cons (list b (nth 1 face-a)) - faces)) - (if (and (not face-a) face-b) - (setq faces (cons (list a (nth 1 face-b)) - faces)))))) - faces) - -;; (equal (color-theme-analyze-add-face -;; 'blue 'violet nil -;; '((blue ((t (:foreground "blue")))) -;; (bold ((t (:bold t)))))) -;; '((violet ((t (:foreground "blue")))) -;; (blue ((t (:foreground "blue")))) -;; (bold ((t (:bold t)))))) -;; (equal (color-theme-analyze-add-face -;; 'violet 'blue nil -;; '((blue ((t (:foreground "blue")))) -;; (bold ((t (:bold t)))))) -;; '((violet ((t (:foreground "blue")))) -;; (blue ((t (:foreground "blue")))) -;; (bold ((t (:bold t)))))) -;; (equal (color-theme-analyze-add-face -;; 'violet 'blue "foo" -;; '((blue ((t (:foreground "blue")))) -;; (bold ((t (:bold t)))))) -;; '((blue ((t (:foreground "blue")))) -;; (bold ((t (:bold t)))))) -;; (equal (color-theme-analyze-add-face -;; 'violet 'blue "blue" -;; '((blue ((t (:foreground "blue")))) -;; (bold ((t (:bold t)))))) -;; '((violet ((t (:foreground "blue")))) -;; (blue ((t (:foreground "blue")))) -;; (bold ((t (:bold t)))))) - -(defun color-theme-analyze-add-faces (faces) - "Add missing faces to FACES and return it." - ;; The most important thing is to add missing faces for the other - ;; editor. These are the most important faces to check. The - ;; following rules list two faces, A and B. If either of the two is - ;; part of the theme, the other must be, too. The optional third - ;; argument specifies a regexp. Only if an existing face name - ;; matches this regexp, is the rule applied. - (let ((rules '((font-lock-builtin-face font-lock-reference-face) - (font-lock-doc-face font-lock-doc-string-face) - (font-lock-constant-face font-lock-preprocessor-face) - ;; In Emacs 21 `modeline' is just an alias for - ;; `mode-line'. I recommend the use of - ;; `modeline' until further notice. - (modeline mode-line) - (modeline modeline-buffer-id) - (modeline modeline-mousable) - (modeline modeline-mousable-minor-mode) - (region primary-selection) - (region zmacs-region) - (font-lock-string-face dired-face-boring "^dired") - (font-lock-function-name-face dired-face-directory "^dired") - (default dired-face-executable "^dired") - (font-lock-warning-face dired-face-flagged "^dired") - (font-lock-warning-face dired-face-marked "^dired") - (default dired-face-permissions "^dired") - (default dired-face-setuid "^dired") - (default dired-face-socket "^dired") - (font-lock-keyword-face dired-face-symlink "^dired") - (tool-bar menu)))) - (dolist (rule rules) - (setq faces (color-theme-analyze-add-face - (nth 0 rule) (nth 1 rule) (nth 2 rule) faces)))) - ;; The `fringe' face defines what the left and right borders of the - ;; frame look like in Emacs 21. To give them default fore- and - ;; background colors, use (fringe ((t (nil)))) in your color theme. - ;; Usually it makes more sense to choose a color slightly lighter or - ;; darker from the default background. - (unless (assoc 'fringe faces) - (setq faces (cons '(fringe ((t (nil)))) faces))) - ;; The tool-bar should not be part of the frame-parameters, since it - ;; should not appear or disappear depending on the color theme. The - ;; apppearance of the toolbar, however, can be changed by the color - ;; theme. For Emacs 21, use the `tool-bar' face. The easiest way - ;; to do this is to give it the default fore- and background colors. - ;; This can be achieved using (tool-bar ((t (nil)))) in the theme. - ;; Usually it makes more sense, however, to provide the same colors - ;; as used in the `menu' face, and to specify a :box attribute. In - ;; order to alleviate potential Emacs/XEmacs incompatibilities, - ;; `toolbar' will be defined as an alias for `tool-bar' if it does - ;; not exist, and vice-versa. This is done eventhough the face - ;; `toolbar' seems to have no effect on XEmacs. If you look at - ;; XEmacs lisp/faces.el, however, you will find that it is in fact - ;; referenced for XPM stuff. - (unless (assoc 'tool-bar faces) - (setq faces (cons '(tool-bar ((t (nil)))) faces))) - ;; Move the default face back to the front, and sort the rest. - (unless (eq (caar faces) 'default) - (let ((face (assoc 'default faces))) - (setq faces (cons face - (sort (delete face faces) - (lambda (a b) - (string-lessp (car a) (car b)))))))) - faces) - -(defun color-theme-analyze-remove-heights (faces) - "Remove :height property where it is an integer and return FACES." - ;; I don't recommend making font sizes part of a color theme. Most - ;; users would be surprised to see their font sizes change when they - ;; install a color-theme. Therefore, remove all :height attributes - ;; if the value is an integer. If the value is a float, this is ok - ;; -- the value is relative to the default height. One notable - ;; exceptions is for a color-theme created for visually impaired - ;; people. These *must* use a larger font in order to be usable. - (let (result) - (dolist (face faces) - (let ((props (cadar (nth 1 face)))) - (if (and (plist-member props :height) - (integerp (plist-get props :height))) - (setq props (color-theme-plist-delete props :height) - result (cons (list (car face) `((t ,props))) - result)) - (setq result (cons face result))))) - (nreverse result))) - -;; (equal (color-theme-analyze-remove-heights -;; '((blue ((t (:foreground "blue" :height 2)))) -;; (bold ((t (:bold t :height 1.0)))))) -;; '((blue ((t (:foreground "blue")))) -;; (bold ((t (:bold t :height 1.0)))))) - -;;;###autoload -(defun color-theme-analyze-defun () - "Once you have a color-theme printed, check for missing faces. -This is used by maintainers who receive a color-theme submission -and want to make sure it follows the guidelines by the color-theme -author." - ;; The support for :foreground and :background attributes works for - ;; Emacs 20 and 21 as well as for XEmacs. :inverse-video is taken - ;; care of while printing color themes. - (interactive) - ;; Parse the stuff and find the call to color-theme-install - (save-excursion - (save-restriction - (narrow-to-defun) - ;; define the function - (eval-defun nil) - (goto-char (point-min)) - (let* ((code (read (current-buffer))) - (theme (color-theme-canonic - (eval - (cadr - (color-theme-analyze-find-theme - code))))) - (func (color-theme-function theme)) - (doc (documentation func t)) - (variables (color-theme-variables theme)) - (faces (color-theme-faces theme)) - (params (color-theme-frame-params theme))) - (setq faces (color-theme-analyze-remove-heights - (color-theme-analyze-add-faces faces))) - ;; Remove any variable bindings of faces that point to their - ;; symbol? Perhaps not, because another theme might want to - ;; change this, so it is important to be able to reset them. - ;; (let (result) - ;; (dolist (var variables) - ;; (unless (eq (car var) (cdr var)) - ;; (setq result (cons var result)))) - ;; (setq variables (nreverse result))) - ;; Now modify the theme directly. - (setq theme (color-theme-analyze-find-theme code)) - (setcdr (cadadr theme) (list params variables faces)) - (message "Pretty printing analysed color theme function...") - (with-current-buffer (get-buffer-create "*Color Theme*") - (setq buffer-read-only nil) - (erase-buffer) - ;; insert defun - (color-theme-print-theme func doc params variables faces) - (emacs-lisp-mode)) - (message "Pretty printing analysed color theme function... done") - (ediff-buffers (current-buffer) - (get-buffer "*Color Theme*")))))) - -;;; Creating a snapshot of the current color theme - -(defun color-theme-snapshot nil) - -;;;###autoload -(defun color-theme-make-snapshot () - "Return the definition of the current color-theme. -The function returned will recreate the color-theme in use at the moment." - (eval `(lambda () - "The color theme in use when the selection buffer was created. -\\[color-theme-select] creates the color theme selection buffer. At the -same time, this snapshot is created as a very simple undo mechanism. -The snapshot is created via `color-theme-snapshot'." - (interactive) - (color-theme-install - '(color-theme-snapshot - ;; alist of frame parameters - ,(color-theme-get-params) - ;; alist of variables - ,(color-theme-get-vars) - ;; remaining elements of snapshot: face specs - ,@(color-theme-get-face-definitions)))))) - - - -;;; Handling the various parts of a color theme install - -(defvar color-theme-frame-param-frobbing-rules - '((foreground-color default foreground) - (background-color default background)) - "List of rules to use when frobbing faces based on frame parameters. -This is only necessary for XEmacs, because in Emacs 21 changing the -frame paramters automatically affects the relevant faces.") - -;; fixme: silent the bytecompiler with set-face-property -(defun color-theme-frob-faces (params) - "Change certain faces according to PARAMS. -This uses `color-theme-frame-param-frobbing-rules'." - (dolist (rule color-theme-frame-param-frobbing-rules) - (let* ((param (nth 0 rule)) - (face (nth 1 rule)) - (prop (nth 2 rule)) - (val (cdr (assq param params))) - (frame (if color-theme-is-global nil (selected-frame)))) - (when val - (set-face-property face prop val frame))))) - -(defun color-theme-alist-reduce (old-list) - "Reduce OLD-LIST. -The resulting list will be newly allocated and will not contain any elements -with duplicate cars. This will speed the installation of new themes by -only installing unique attributes." - (let (new-list) - (dolist (elem old-list) - (when (not (assq (car elem) new-list)) - (setq new-list (cons elem new-list)))) - new-list)) - -(defun color-theme-install-frame-params (params) - "Change frame parameters using alist PARAMETERS. - -If `color-theme-is-global' is non-nil, all frames are modified using -`modify-frame-parameters' and the PARAMETERS are prepended to -`default-frame-alist'. The value of `initial-frame-alist' is not -modified. If `color-theme-is-global' is nil, only the selected frame is -modified. If `color-theme-is-cumulative' is nil, the frame parameters -are restored from `color-theme-original-frame-alist'. - -If the current frame parameters have a parameter `minibuffer' with -value `only', then the frame parameters are not installed, since this -indicates a dedicated minibuffer frame. - -Called from `color-theme-install'." - (setq params (color-theme-filter - params color-theme-legal-frame-parameters)) - ;; We have a new list in params now, therefore we may use - ;; destructive nconc. - (if color-theme-is-global - (let ((frames (frame-list))) - (if (or color-theme-is-cumulative - (null color-theme-original-frame-alist)) - (setq default-frame-alist - (append params (color-theme-alist default-frame-alist)) - minibuffer-frame-alist - (append params (color-theme-alist minibuffer-frame-alist))) - (setq default-frame-alist - (append params color-theme-original-frame-alist) - minibuffer-frame-alist - (append params (color-theme-alist minibuffer-frame-alist)))) - (setq default-frame-alist - (color-theme-alist-reduce default-frame-alist) - minibuffer-frame-alist - (color-theme-alist-reduce minibuffer-frame-alist)) - (dolist (frame frames) - (let ((params (if (eq 'only (cdr (assq 'minibuffer (frame-parameters frame)))) - minibuffer-frame-alist - default-frame-alist))) - (condition-case var - (modify-frame-parameters frame params) - (error (message "Error using params %S: %S" params var)))))) - (condition-case var - (modify-frame-parameters (selected-frame) params) - (error (message "Error using params %S: %S" params var)))) - (when color-theme-xemacs-p - (color-theme-frob-faces params))) - -;; (setq default-frame-alist (cons '(height . 30) default-frame-alist)) - -(defun color-theme-install-variables (vars) - "Change variables using alist VARS. -All variables matching `color-theme-legal-variables' are set. - -If `color-theme-is-global' and `color-theme-xemacs-p' are nil, variables -are made frame-local before setting them. Variables are set using `set' -in either case. This may lead to problems if changing the variable -requires the usage of the function specified with the :set tag in -defcustom declarations. - -Called from `color-theme-install'." - (let ((vars (color-theme-filter vars color-theme-legal-variables))) - (dolist (var vars) - (if (or color-theme-is-global color-theme-xemacs-p) - (set (car var) (cdr var)) - (make-variable-frame-local (car var)) - (modify-frame-parameters (selected-frame) (list var)))))) - -(defun color-theme-install-faces (faces) - "Change faces using FACES. - -Change faces for all frames and create any faces listed in FACES which -don't exist. The modified faces will be marked as \"unchanged from -its standard setting\". This is OK, since the changes made by -installing a color theme should never by saved in .emacs by -customization code. - -FACES should be a list where each entry has the form: - - (FACE SPEC) - -See `defface' for the format of SPEC. - -If `color-theme-is-global' is non-nil, faces are modified on all frames -using `face-spec-set'. If `color-theme-is-global' is nil, faces are -only modified on the selected frame. Non-existing faces are created -using `make-empty-face' in either case. If `color-theme-is-cumulative' -is nil, all faces are reset before installing the new faces. - -Called from `color-theme-install'." - ;; clear all previous faces - (when (not color-theme-is-cumulative) - (color-theme-reset-faces)) - ;; install new faces - (let ((faces (color-theme-filter faces color-theme-illegal-faces t)) - (frame (if color-theme-is-global nil (selected-frame)))) - (dolist (entry faces) - (let ((face (nth 0 entry)) - (spec (nth 1 entry))) - (or (facep face) - (make-empty-face face)) - ;; remove weird properties from the default face only - (when (eq face 'default) - (setq spec (color-theme-spec-filter spec))) - ;; Emacs/XEmacs customization issues: filter out :bold when - ;; the spec contains :weight, etc, such that the spec remains - ;; "valid" for custom. - (setq spec (color-theme-spec-compat spec)) - ;; using a spec of ((t (nil))) to reset a face doesn't work - ;; in Emacs 21, we use the new function face-spec-reset-face - ;; instead - (if (and (functionp 'face-spec-reset-face) - (equal spec '((t (nil))))) - (face-spec-reset-face face frame) - (condition-case var - (progn - (face-spec-set face spec frame) - (if color-theme-is-global - (put face 'face-defface-spec spec))) - (error (message "Error using spec %S: %S" spec var)))))))) - -;; `custom-set-faces' is unusable here because it doesn't allow to set -;; the faces for one frame only. - -;; Emacs `face-spec-set': If FRAME is nil, the face is created and -;; marked as a customized face. This is achieved by setting the -;; `face-defface-spec' property. If we don't, new frames will not be -;; created using the face we installed because `face-spec-set' is -;; broken: If given a FRAME of nil, it will not set the default faces; -;; instead it will walk through all the frames and set modify the faces. -;; If we do set a property (`saved-face' or `face-defface-spec'), -;; `make-frame' will correctly use the faces we defined with our color -;; theme. If we used the property `saved-face', -;; `customize-save-customized' will save all the faces installed as part -;; of a color-theme in .emacs. That's why we use the -;; `face-defface-spec' property. - - - -;;; Theme accessor functions, canonicalization, merging, comparing - -(defun color-theme-canonic (theme) - "Return the canonic form of THEME. -This deals with all the backwards compatibility stuff." - (let (function frame-params variables faces) - (when (functionp (car theme)) - (setq function (car theme) - theme (cdr theme))) - (setq frame-params (car theme) - theme (cdr theme)) - ;; optional variable defintions (for backwards compatibility) - (when (listp (caar theme)) - (setq variables (car theme) - theme (cdr theme))) - ;; face definitions - (setq faces theme) - (list function frame-params variables faces))) - -(defun color-theme-function (theme) - "Return function used to create THEME." - (nth 0 theme)) - -(defun color-theme-frame-params (theme) - "Return frame-parameters defined by THEME." - (nth 1 theme)) - -(defun color-theme-variables (theme) - "Return variables set by THEME." - (nth 2 theme)) - -(defun color-theme-faces (theme) - "Return faces defined by THEME." - (nth 3 theme)) - -(defun color-theme-merge-alists (&rest alists) - "Merges all the alist arguments into one alist. -Only the first instance of every key will be part of the resulting -alist. Membership will be tested using `assq'." - (let (result) - (dolist (l alists) - (dolist (entry l) - (unless (assq (car entry) result) - (setq result (cons entry result))))) - (nreverse result))) -;; (color-theme-merge-alists '((a . 1) (b . 2))) -;; (color-theme-merge-alists '((a . 1) (b . 2) (a . 3))) -;; (color-theme-merge-alists '((a . 1) (b . 2)) '((a . 3))) -;; (color-theme-merge-alists '((a . 1) (b . 2)) '((c . 3))) -;; (color-theme-merge-alists '((a . 1) (b . 2)) '((c . 3) (d . 4))) -;; (color-theme-merge-alists '((a . 1) (b . 2)) '((c . 3) (d . 4) (b . 5))) - -;;;###autoload -(defun color-theme-compare (theme-a theme-b) - "Compare two color themes. -This will print the differences between installing THEME-A and -installing THEME-B. Note that the order is important: If a face is -defined in THEME-A and not in THEME-B, then this will not show up as a -difference, because there is no reset before installing THEME-B. If a -face is defined in THEME-B and not in THEME-A, then this will show up as -a difference." - (interactive - (list - (intern - (completing-read "Theme A: " - (mapcar (lambda (i) (list (symbol-name (car i)))) - color-themes) - (lambda (i) (string-match "color-theme" (car i))))) - (intern - (completing-read "Theme B: " - (mapcar (lambda (i) (list (symbol-name (car i)))) - color-themes) - (lambda (i) (string-match "color-theme" (car i))))))) - ;; install the themes in a new frame and get the definitions - (let ((color-theme-is-global nil)) - (select-frame (make-frame)) - (funcall theme-a) - (setq theme-a (list theme-a - (color-theme-get-params) - (color-theme-get-vars) - (color-theme-get-face-definitions))) - (funcall theme-b) - (setq theme-b (list theme-b - (color-theme-get-params) - (color-theme-get-vars) - (color-theme-get-face-definitions))) - (delete-frame)) - (let ((params (set-difference - (color-theme-frame-params theme-b) - (color-theme-frame-params theme-a) - :test 'equal)) - (vars (set-difference - (color-theme-variables theme-b) - (color-theme-variables theme-a) - :test 'equal)) - (faces (set-difference - (color-theme-faces theme-b) - (color-theme-faces theme-a) - :test 'equal))) - (list 'diff - params - vars - faces))) - - - -;;; Installing a color theme -;;;###autoload -(defun color-theme-install (theme) - "Install a color theme defined by frame parameters, variables and faces. - -The theme is installed for all present and future frames; any missing -faces are created. See `color-theme-install-faces'. - -THEME is a color theme definition. See below for more information. - -If you want to install a color theme from your .emacs, use the output -generated by `color-theme-print'. This produces color theme function -which you can copy to your .emacs. - -A color theme definition is a list: -\([FUNCTION] FRAME-PARAMETERS VARIABLE-SETTINGS FACE-DEFINITIONS) - -FUNCTION is the color theme function which called `color-theme-install'. -This is no longer used. There was a time when this package supported -automatic factoring of color themes. This has been abandoned. - -FRAME-PARAMETERS is an alist of frame parameters. These are installed -with `color-theme-install-frame-params'. These are installed last such -that any changes to the default face can be changed by the frame -parameters. - -VARIABLE-DEFINITIONS is an alist of variable settings. These are -installed with `color-theme-install-variables'. - -FACE-DEFINITIONS is an alist of face definitions. These are installed -with `color-theme-install-faces'. - -If `color-theme-is-cumulative' is nil, a color theme will undo face and -frame-parameter settings of previous color themes." - (setq theme (color-theme-canonic theme)) - (color-theme-install-variables (color-theme-variables theme)) - (color-theme-install-faces (color-theme-faces theme)) - ;; frame parameters override faces - (color-theme-install-frame-params (color-theme-frame-params theme)) - (when color-theme-history-max-length - (color-theme-add-to-history - (car theme)))) - - - -;; Sharing your stuff -;;;###autoload -(defun color-theme-submit () - "Submit your color-theme to the maintainer." - (interactive) - (require 'reporter) - (let ((reporter-eval-buffer (current-buffer)) - final-resting-place - after-sep-pos - (reporter-status-message "Formatting buffer...") - (reporter-status-count 0) - (problem "Yet another color-theme") - (agent (reporter-compose-outgoing)) - (mailbuf (current-buffer)) - hookvar) - ;; do the work - (require 'sendmail) - ;; If mailbuf did not get made visible before, make it visible now. - (let (same-window-buffer-names same-window-regexps) - (pop-to-buffer mailbuf) - ;; Just in case the original buffer is not visible now, bring it - ;; back somewhere - (and pop-up-windows (display-buffer reporter-eval-buffer))) - (goto-char (point-min)) - (mail-position-on-field "to") - (insert color-theme-maintainer-address) - (mail-position-on-field "subject") - (insert problem) - ;; move point to the body of the message - (mail-text) - (setq after-sep-pos (point)) - (unwind-protect - (progn - (setq final-resting-place (point-marker)) - (goto-char final-resting-place)) - (color-theme-print (current-buffer)) - (goto-char final-resting-place) - (insert "\n\n") - (goto-char final-resting-place) - (insert "Hello there!\n\nHere's my color theme named: ") - (set-marker final-resting-place nil)) - ;; compose the minibuf message and display this. - (let* ((sendkey-whereis (where-is-internal - (get agent 'sendfunc) nil t)) - (abortkey-whereis (where-is-internal - (get agent 'abortfunc) nil t)) - (sendkey (if sendkey-whereis - (key-description sendkey-whereis) - "C-c C-c")); TBD: BOGUS hardcode - (abortkey (if abortkey-whereis - (key-description abortkey-whereis) - "M-x kill-buffer"))); TBD: BOGUS hardcode - (message "Enter a message and type %s to send or %s to abort." - sendkey abortkey)))) - - - -;; Use this to define themes -(defmacro define-color-theme (name author description &rest forms) - (let ((n name)) - `(progn - (add-to-list 'color-themes - (list ',n - (upcase-initials - (replace-in-string - (replace-in-string - (symbol-name ',n) "^color-theme-" "") "-" " ")) - ,author)) - (defun ,n () - ,description - (interactive) - ,@forms)))) - - -;;; FIXME: is this useful ?? -;;;###autoload -(defun color-theme-initialize () - "Initialize the color theme package by loading color-theme-libraries." - (interactive) - - (cond ((and (not color-theme-load-all-themes) - color-theme-directory) - (setq color-theme-libraries - (directory-files color-theme-directory t "^color-theme"))) - (color-theme-directory - (push (cdr (directory-files color-theme-directory t "^color-theme")) - color-theme-libraries))) - (dolist (library color-theme-libraries) - (load library))) - -(when nil - (setq color-theme-directory "themes/" - color-theme-load-all-themes nil) - (color-theme-initialize) -) -;; TODO: I don't like all those function names cluttering up my namespace. -;; Instead, a hashtable for the color-themes should be created. Now that -;; define-color-theme is around, it should be easy to change in just the -;; one place. - - -(provide 'color-theme) - -;;; color-theme.el ends here diff --git a/.emacs.d/csharp-mode.el b/.emacs.d/csharp-mode.el deleted file mode 100644 index 9cd7914..0000000 --- a/.emacs.d/csharp-mode.el +++ /dev/null @@ -1,1977 +0,0 @@ -;;; csharp-mode.el --- C# mode derived mode - -;; Author: Dylan R. E. Moonfire -;; Maintainer: Dylan R. E. Moonfire -;; Created: Feburary 2005 -;; Modified: February 2010 -;; Version: 0.7.4 - Dino Chiesa -;; Keywords: c# languages oop mode - -;; 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 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; see the file COPYING. If not, write to -;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. - -;;; Commentary: -;; -;; This is a separate mode to implement the C# constructs and -;; font-locking. It is based on the java-mode example from cc-mode. -;; -;; csharp-mode requires CC Mode 5.30 or later. It works with -;; cc-mode 5.31.3, which is current at this time. -;; -;; Features: -;; -;; - font-lock and indent of C# syntax including: -;; all c# keywords and major syntax -;; attributes that decorate methods, classes, fields, properties -;; enum types -;; #if/#endif #region/#endregion -;; instance initializers -;; anonymous functions and methods -;; verbatim literal strings (those that begin with @) -;; generics -;; -;; - automagic code-doc generation when you type three slashes. -;; -;; - intelligent inserttion of matched pairs of curly braces. -;; -;; - sets the compiler regex for next-error, for csc.exe output. -;; -;; - - -;;; To use: -;; -;; put this in your .emacs: -;; -;; (autoload 'csharp-mode "csharp-mode" "Major mode for editing C# code." t) -;; -;; or: -;; -;; (require 'csharp-mode) -;; -;; -;; AND: -;; -;; (setq auto-mode-alist -;; (append '(("\\.cs$" . csharp-mode)) auto-mode-alist)) -;; (defun my-csharp-mode-fn () -;; "function that runs when csharp-mode is initialized for a buffer." -;; ...insert your code here... -;; ...most commonly, your custom key bindings ... -;; ) -;; (add-hook 'csharp-mode-hook 'my-csharp-mode-fn t) -;; -;; - - -;;; Bugs: -;; -;; Namespaces in the using statements are not fontified. Should do in -;; c-basic-matchers-before or c-basic-matchers-after. -;; -;; Method names with a preceding attribute are not fontified. -;; -;; Field/Prop names inside object initializers are fontified only -;; if the null constructor is used, with no parens. -;; -;; This code doesn't seem to work when you compile it, then -;; load/require in the emacs file. You will get an error (error -;; "`c-lang-defconst' must be used in a file") which happens because -;; cc-mode doesn't think it is in a buffer while loading directly -;; from the init. However, if you call it based on a file extension, -;; it works properly. Interestingly enough, this doesn't happen if -;; you don't byte-compile cc-mode. -;; -;; -;; -;; Todo: -;; -;; Get csharp-mode.el accepted as part of the emacs standard distribution. -;; Must contact monnier at iro.umontreal.ca to make this happen. -;; -;; -;; -;; Acknowledgements: -;; -;; Thanks to Alan Mackenzie and Stefan Monnier for answering questions -;; and making suggestions. -;; -;; - -;;; Versions: -;; -;; 0.1.0 - Initial release. -;; 0.2.0 - Fixed the identification on the "enum" keyword. -;; - Fixed the font-lock on the "base" keyword -;; 0.3.0 - Added a regex to fontify attributes. It isn't the -;; the best method, but it handles single-like attributes -;; well. -;; - Got "super" not to fontify as a keyword. -;; - Got extending classes and interfaces to fontify as something. -;; 0.4.0 - Removed the attribute matching because it broke more than -;; it fixed. -;; - Corrected a bug with namespace not being properly identified -;; and treating the class level as an inner object, which screwed -;; up formatting. -;; - Added "partial" to the keywords. -;; 0.5.0 - Found bugs with compiled cc-mode and loading from init files. -;; - Updated the eval-when-compile to code to let the mode be -;; compiled. -;; 0.6.0 - Added the c-filter-ops patch for 5.31.1 which made that -;; function in cc-langs.el unavailable. -;; - Added a csharp-lineup-region for indention #region and -;; #endregion block differently. -;; 0.7.0 - Added autoload so update-directory-autoloads works -;; (Thank you, Nikolaj Schumacher) -;; - Fontified the entire #region and #endregion lines. -;; - Initial work to get get, set, add, remove font-locked. -;; 0.7.1 - Added option to indent #if/endif with code -;; - Fixed c-opt-cpp-prefix defn (it must not include the BOL -;; char (^). -;; - proper fontification and indent of classes that inherit -;; (previously the colon was confusing the parser) -;; - reclassified namespace as a block beginner -;; - removed $ as a legal symbol char - not legal in C#. -;; - added struct to c-class-decl-kwds so indent is correct -;; within a struct. -;; 0.7.2 - Added automatic codedoc insertion. -;; 0.7.3 - Instance initializers (new Type { ... } ) and -;; (new Type() { ...} ) are now indented properly. -;; - proper fontification and indent of enums as brace-list-*, -;; including special treatment for enums that explicitly -;; inherit from an int type. Previously the colon was -;; confusing the parser. -;; - proper fontification of verbatim literal strings, -;; including those that end in slash. This edge case was not -;; handled at all before; it is now handled correctly. -;; - code cleanup and organization; removed the linefeed. -;; - intelligent curly-brace insertion -;; 0.7.4 - added a C# style -;; - using is now a keyword and gets fontified -;; - fixed a bug that had crept into the codedoc insertion -;; - - -(require 'cc-mode) - -(message (concat "Loading " load-file-name)) - - -;; ================================================================== -;; c# upfront stuff -;; ================================================================== - -;; This is a copy of the function in cc-mode which is used to handle -;; the eval-when-compile which is needed during other times. -(defun c-filter-ops (ops opgroup-filter op-filter &optional xlate) - ;; See cc-langs.el, a direct copy. - (unless (listp (car-safe ops)) - (setq ops (list ops))) - (cond ((eq opgroup-filter t) - (setq opgroup-filter (lambda (opgroup) t))) - ((not (functionp opgroup-filter)) - (setq opgroup-filter `(lambda (opgroup) - (memq opgroup ',opgroup-filter))))) - (cond ((eq op-filter t) - (setq op-filter (lambda (op) t))) - ((stringp op-filter) - (setq op-filter `(lambda (op) - (string-match ,op-filter op))))) - (unless xlate - (setq xlate 'identity)) - (c-with-syntax-table (c-lang-const c-mode-syntax-table) - (delete-duplicates - (mapcan (lambda (opgroup) - (when (if (symbolp (car opgroup)) - (when (funcall opgroup-filter (car opgroup)) - (setq opgroup (cdr opgroup)) - t) - t) - (mapcan (lambda (op) - (when (funcall op-filter op) - (let ((res (funcall xlate op))) - (if (listp res) res (list res))))) - opgroup))) - ops) - :test 'equal))) - - - -;; These are only required at compile time to get the sources for the -;; language constants. (The cc-fonts require and the font-lock -;; related constants could additionally be put inside an -;; (eval-after-load "font-lock" ...) but then some trickery is -;; necessary to get them compiled.) -(eval-when-compile - (let ((load-path - (if (and (boundp 'byte-compile-dest-file) - (stringp byte-compile-dest-file)) - (cons (file-name-directory byte-compile-dest-file) load-path) - load-path))) - (load "cc-mode" nil t) - (load "cc-fonts" nil t) - (load "cc-langs" nil t))) - -(eval-and-compile - ;; Make our mode known to the language constant system. Use Java - ;; mode as the fallback for the constants we don't change here. - ;; This needs to be done also at compile time since the language - ;; constants are evaluated then. - (c-add-language 'csharp-mode 'java-mode)) - -;; ================================================================== -;; end of c# upfront stuff -;; ================================================================== - - - - - -;; ================================================================== -;; csharp-mode utility and feature defuns -;; ================================================================== - -;; Indention: csharp-mode follows normal indention rules except for -;; when indenting the #region and #endregion blocks. This function -;; defines a custom indention to indent the #region blocks properly -;; - -(defun csharp-lineup-region (langelem) - "Indent all #region and #endregion blocks inline with code while -retaining normal column-zero indention for #if and the other -processing blocks. - -To use this indenting just put the following in your emacs file: - (c-set-offset 'cpp-macro 'csharp-lineup-region) - -An alternative is to use `csharp-lineup-if-and-region'. -" - - (save-excursion - (back-to-indentation) - (if (re-search-forward "#\\(end\\)?region" (c-point 'eol) [0]) 0 [0]))) - - - -(defun csharp-lineup-if-and-region (langelem) - -"Indent all #region/endregion blocks and #if/endif blocks inline -with code while retaining normal column-zero indention for any -other processing blocks. - -To use this indenting just put the following in your emacs file: - (c-set-offset 'cpp-macro 'csharp-lineup-if-and-region) - -Another option is to use `csharp-lineup-region'. - -" - (save-excursion - (back-to-indentation) - (if (re-search-forward "#\\(\\(end\\)?\\(if\\|region\\)\\|else\\)" (c-point 'eol) [0]) 0 [0]))) - - - - - -(defun csharp-insert-open-brace () - "Intelligently insert a pair of curly braces. This fn is most -often bound to the open-curly brace, with - - (local-set-key (kbd \"{\") 'csharp-insert-open-brace) - -The default binding for an open curly brace in cc-modes is often -`c-electric-brace' or `skeleton-pair-insert-maybe'. The former -can be configured to insert newlines around braces in various -syntactic positions. The latter inserts a pair of braces and -then does not insert a newline, and does not indent. - -This fn provides another option, with some additional -intelligence for csharp-mode. When you type an open curly, the -appropriate pair of braces appears, with spacing and indent set -in a context-sensitive manner. - -Within a string literal, you just get a pair of braces, and point -is set between them. Following an equals sign, you get a pair of -braces, with a semincolon appended. Otherwise, you -get the open brace on a new line, with the closing brace on the -line following. - -There may be another way to get this to happen appropriately just within emacs, -but I could not figure out how to do it. So I wrote this alternative. -" - (interactive) - (let - (tpoint - (in-string (string= (csharp-in-literal) "string")) - (preceding3 - (save-excursion - (and - (skip-chars-backward " ") - (> (- (point) 2) (point-min)) - (buffer-substring-no-properties (point) (- (point) 3))))) - (one-word-back - (save-excursion - (backward-word 2) - (thing-at-point 'word)))) - - (cond - - ;; Case 1: inside a string literal? - ;; -------------------------------------------- - ;; If so, then just insert a pair of braces and put the point - ;; between them. The most common case is a format string for - ;; String.Format() or Console.WriteLine(). - (in-string - (self-insert-command 1) - (insert "}") - (backward-char)) - - ;; Case 2: the open brace starts an array initializer. - ;; -------------------------------------------- - ;; When the last non-space was an equals sign or square brackets, - ;; then it's an initializer. - ((save-excursion - (backward-sexp) - (looking-at "\\(\\w+\\b *=\\|[[]]+\\)")) - (self-insert-command 1) - (insert " };") - (backward-char 3)) - - ;; Case 3: the open brace starts an instance initializer - ;; -------------------------------------------- - ;; If one-word-back was "new", then it's an object initializer. - ((string= one-word-back "new") - (save-excursion - (message "object initializer") - (setq tpoint (point)) ;; prepare to indent-region later - (newline) - (self-insert-command 1) - (newline-and-indent) - (newline) - (insert "};") - (c-indent-region tpoint (point)) - (previous-line) - (indent-according-to-mode) - (end-of-line) - (setq tpoint (point))) - (goto-char tpoint)) - - ;; Case 4: a lambda initialier. - ;; -------------------------------------------- - ;; If the open curly follows =>, then it's a lambda initializer. - ((string= (substring preceding3 -2) "=>") - (message "lambda init") - (self-insert-command 1) - (insert " }") - (backward-char 2)) - - ;; else, it's a new scope. (if, while, class, etc) - (t - (save-excursion - (message "new scope") - (set-mark (point)) ;; prepare to indent-region later - ;; check if the prior sexp is on the same line - (if (save-excursion - (let ((curline (line-number-at-pos)) - (aftline (progn - (backward-sexp) - (line-number-at-pos)))) - (= curline aftline))) - (newline-and-indent)) - (self-insert-command 1) - (c-indent-line-or-region) - (end-of-line) - (newline) - (insert "}") - ;;(c-indent-command) ;; not sure of the difference here - (c-indent-line-or-region) - (previous-line) - (end-of-line) - (newline-and-indent) - ;; point ends up on an empty line, within the braces, properly indented - (setq tpoint (point))) - - (goto-char tpoint))))) - - - - -;; ================================================================== -;; end of csharp-mode utility and feature defuns -;; ================================================================== - - - - - - -;; ================================================================== -;; c# values for "language constants" defined in cc-langs.el -;; ================================================================== - - -;; Java uses a series of regexes to change the font-lock for class -;; references. The problem comes in because Java uses Pascal (leading -;; space in names, SomeClass) for class and package names, but -;; Camel-casing (initial lowercase, upper case in words, -;; i.e. someVariable) for variables. The notation suggested by EMCA for C# is -;; to use Pascal notation for everything, except inner variables. So, -;; the Java regex and formatting produces very wrong results in C#. -;;(error (byte-compile-dest-file)) -;;(error (c-get-current-file)) -(c-lang-defconst c-opt-after-id-concat-key - csharp (if (c-lang-const c-opt-identifier-concat-key) - (c-lang-const c-symbol-start))) - -(c-lang-defconst c-basic-matchers-before - csharp `( - ;;;; Font-lock the attributes by searching for the - ;;;; appropriate regex and marking it as TODO. - ;;,`(,(concat "\\(" csharp-attribute-regex "\\)") - ;; 0 font-lock-function-name-face) - - ;; Put a warning face on the opener of unclosed strings that - ;; can't span lines. Later font - ;; lock packages have a `font-lock-syntactic-face-function' for - ;; this, but it doesn't give the control we want since any - ;; fontification done inside the function will be - ;; unconditionally overridden. - ,(c-make-font-lock-search-function - ;; Match a char before the string starter to make - ;; `c-skip-comments-and-strings' work correctly. - (concat ".\\(" c-string-limit-regexp "\\)") - '((c-font-lock-invalid-string))) - - ;; Fontify keyword constants. - ,@(when (c-lang-const c-constant-kwds) - (let ((re (c-make-keywords-re nil - (c-lang-const c-constant-kwds)))) - `((eval . (list ,(concat "\\<\\(" re "\\)\\>") - 1 c-constant-face-name))))) - - ;; Fontify all keywords except the primitive types. - ,`(,(concat "\\<" (c-lang-const c-regular-keywords-regexp)) - 1 font-lock-keyword-face) - - ;; Fontify leading identifiers in fully qualified names like - ;; "Foo.Bar". - ,@(when (c-lang-const c-opt-identifier-concat-key) - `((,(byte-compile - `(lambda (limit) - (while (re-search-forward - ,(concat "\\(\\<" ; 1 - "\\(" (c-lang-const c-symbol-key) - "\\)" ; 2 - "[ \t\n\r\f\v]*" - (c-lang-const - c-opt-identifier-concat-key) - "[ \t\n\r\f\v]*" - "\\)" - "\\(" - (c-lang-const - c-opt-after-id-concat-key) - "\\)") - limit t) - (unless (progn - (goto-char (match-beginning 0)) - (c-skip-comments-and-strings limit)) - (or (get-text-property (match-beginning 2) 'face) - (c-put-font-lock-face (match-beginning 2) - (match-end 2) - c-reference-face-name)) - (goto-char (match-end 1))))))))) - )) - - - -;; C# does not allow a leading qualifier operator. It also doesn't -;; allow the ".*" construct of Java. So, we redo this regex without -;; the "\\|\\*" regex. -(c-lang-defconst c-identifier-key - csharp (concat "\\(" (c-lang-const c-symbol-key) "\\)" ; 1 - (concat "\\(" - "[ \t\n\r\f\v]*" - (c-lang-const c-opt-identifier-concat-key) - "[ \t\n\r\f\v]*" - (concat "\\(" - "\\(" (c-lang-const c-symbol-key) "\\)" - "\\)") - "\\)*"))) - -;; C# has a few rules that are slightly different than Java for -;; operators. This also removed the Java's "super" and replaces it -;; with the C#'s "base". -(c-lang-defconst c-operators - csharp `((prefix "base"))) - - -;; C# uses CPP-like prefixes to mark #define, #region/endregion, -;; #if/else/endif, and #pragma. This regexp matches the prefix, -;; not including the beginning-of-line (BOL), and not including -;; the term after the prefix (define, pragma, etc). This regexp says -;; whitespace, followed by the prefix, followed by maybe more whitespace. - -(c-lang-defconst c-opt-cpp-prefix - csharp "\\s *#\\s *") - - -;; there are no message directives in C# -(c-lang-defconst c-cpp-message-directives - csharp nil) - -(c-lang-defconst c-cpp-expr-directives - csharp '("if")) - -(c-lang-defconst c-opt-cpp-macro-define - csharp "define") - -;; $ is not a legal char in an identifier in C#. So we need to -;; create a csharp-specific definition of this constant. -(c-lang-defconst c-symbol-chars - csharp (concat c-alnum "_")) - - -(c-lang-defconst c-colon-type-list-kwds - csharp '("class")) - -(c-lang-defconst c-block-prefix-disallowed-chars - - ;; Allow ':' for inherit list starters. - csharp (set-difference (c-lang-const c-block-prefix-disallowed-chars) - '(?: ?,))) - - -(c-lang-defconst c-assignment-operators - csharp '("=" "*=" "/=" "%=" "+=" "-=" ">>=" "<<=" "&=" "^=" "|=")) - -(c-lang-defconst c-primitive-type-kwds - ;; ECMA-344, S8 - csharp '("object" "string" "sbyte" "short" "int" "long" "byte" - "ushort" "uint" "ulong" "float" "double" "bool" "char" - "decimal" "void")) - -;; The keywords that define that the following is a type, such as a -;; class definition. -(c-lang-defconst c-type-prefix-kwds - ;; ECMA-344, S? - csharp '("class" "interface" "struct")) ;; no enum here. - ;; we want enum to be a brace list. - - -;; Type modifier keywords. They appear anywhere in types, but modify -;; instead of create one. -(c-lang-defconst c-type-modifier-kwds - ;; EMCA-344, S? - csharp '("readonly" "const")) - - -;; Tue, 20 Apr 2010 16:02 -;; need to vverify that this works for lambdas... -(c-lang-defconst c-special-brace-lists - csharp '((?{ . ?}) )) - - - -;; dinoch -;; Thu, 22 Apr 2010 18:54 -;; -;; No idea why this isn't getting set properly in the first place. -;; In cc-langs.el, it is set to the union of a bunch of things, none -;; of which include "new", or "enum". -;; -;; But somehow both of those show up in the resulting derived regexp. -;; This breaks indentation of instance initializers, such as -;; -;; var x = new Foo { ... }; -;; -;; Based on my inspection, the existing c-lang-defconst should work! -;; I don't know how to fix this c-lang-defconst, so I am re-setting this -;; variable here, to provide the regex explicitly. -;; -(c-lang-defconst c-decl-block-key - - csharp '"\\(namespace\\)\\([^[:alnum:]_]\\|$\\)\\|\\(class\\|interface\\|struct\\)\\([^[:alnum:]_]\\|$\\)" - ) - - - -;; Thu, 22 Apr 2010 14:29 -;; I want this to handle var x = new Foo[] { ... }; -;; not sure if necessary. -(c-lang-defconst c-inexpr-brace-list-kwds - csharp '("new")) - - -;; ;;(c-lang-defconst c-inexpr-class-kwds -;; ;; csharp '("new")) - - - -(c-lang-defconst c-class-decl-kwds - ;; EMCA-344, S? - csharp '("class" "interface" "struct" )) ;; no "enum"!! - - -;; The various modifiers used for class and method descriptions. -(c-lang-defconst c-modifier-kwds - csharp '("public" "partial" "private" "const" "abstract" - "protected" "ref" "out" "static" "virtual" - "override" "params" "internal")) - - -;; Thu, 22 Apr 2010 23:02 -;; Based on inspection of the cc-mode code, the c-protection-kwds -;; c-lang-const is used only for objective-c. So the value is -;; irrelevant for csharp. -(c-lang-defconst c-protection-kwds - csharp nil - ;; csharp '("private" "protected" "public" "internal") -) - - -;; Define the keywords that can have something following after them. -(c-lang-defconst c-type-list-kwds - csharp '("struct" "class" "interface" "is" "as" - "delegate" "event" "set" "get" "add" "remove")) - - -;; This allows the classes after the : in the class declartion to be -;; fontified. -(c-lang-defconst c-typeless-decl-kwds - csharp '(":")) - -;; Sets up the enum to handle the list properly, and also the new -;; keyword to handle object initializers. This requires a modified -;; c-basic-matchers-after (see above) in order to correctly fontify C# -;; 3.0 object initializers. -(c-lang-defconst c-brace-list-decl-kwds - csharp '("enum" "new")) - - -;; Statement keywords followed directly by a substatement. -;; catch is not one of them. -(c-lang-defconst c-block-stmt-1-kwds - csharp '("do" "try" "finally")) - - -;; Statement keywords followed by a paren sexp and then by a substatement. -(c-lang-defconst c-block-stmt-2-kwds - csharp '("for" "if" "switch" "while" "catch" "foreach" "using" - "checked" "unchecked" "lock")) - - -;; Statements that break out of braces -(c-lang-defconst c-simple-stmt-kwds - csharp '("return" "continue" "break" "throw" "goto" )) - -;; Statements that allow a label -;; TODO? -(c-lang-defconst c-before-label-kwds - csharp nil) - -;; Constant keywords -(c-lang-defconst c-constant-kwds - csharp '("true" "false" "null")) - -;; Keywords that start "primary expressions." -(c-lang-defconst c-primary-expr-kwds - csharp '("this" "base")) - -;; Treat namespace as an outer block so class indenting -;; works properly. -(c-lang-defconst c-other-block-decl-kwds - csharp '("namespace")) - -(c-lang-defconst c-other-kwds - csharp '("in" "sizeof" "typeof" "is" "as" "yield" - "where" "select" "from")) - -(c-lang-defconst c-overloadable-operators - ;; EMCA-344, S14.2.1 - csharp '("+" "-" "*" "/" "%" "&" "|" "^" - "<<" ">>" "==" "!=" ">" "<" ">=" "<=")) - - -;; This c-cpp-matchers stuff is used for fontification. -;; see cc-font.el -;; - -;; There's no preprocessor in C#, but there are still compiler -;; directives to fontify: "#pragma", #region/endregion, #define, #undef, -;; #if/else/endif. (The definitions for the extra keywords above are -;; enough to incorporate them into the fontification regexps for types -;; and keywords, so no additional font-lock patterns are required for -;; keywords.) - -(c-lang-defconst c-cpp-matchers - csharp (cons - ;; Use the eval form for `font-lock-keywords' to be able to use - ;; the `c-preprocessor-face-name' variable that maps to a - ;; suitable face depending on the (X)Emacs version. - '(eval . (list "^\\s *\\(#pragma\\|undef\\|define\\)\\>\\(.*\\)" - (list 1 c-preprocessor-face-name) - '(2 font-lock-string-face))) - ;; There are some other things in `c-cpp-matchers' besides the - ;; preprocessor support, so include it. - (c-lang-const c-cpp-matchers))) - -(defcustom csharp-font-lock-extra-types nil - "*List of extra types (aside from the type keywords) to recognize in C# mode. -Each list item should be a regexp matching a single identifier." - :type 'list :group 'csharp) - -(defconst csharp-font-lock-keywords-1 (c-lang-const c-matchers-1 csharp) - "Minimal highlighting for C# mode.") - -(defconst csharp-font-lock-keywords-2 (c-lang-const c-matchers-2 csharp) - "Fast normal highlighting for C# mode.") - -(defconst csharp-font-lock-keywords-3 (c-lang-const c-matchers-3 csharp) - "Accurate normal highlighting for C# mode.") - -(defvar csharp-font-lock-keywords csharp-font-lock-keywords-3 - "Default expressions to highlight in C# mode.") - -(defvar csharp-mode-syntax-table nil - "Syntax table used in csharp-mode buffers.") -(or csharp-mode-syntax-table - (setq csharp-mode-syntax-table - (funcall (c-lang-const c-make-mode-syntax-table csharp)))) - -(defvar csharp-mode-abbrev-table nil - "Abbreviation table used in csharp-mode buffers.") -(c-define-abbrev-table 'csharp-mode-abbrev-table - ;; Keywords that if they occur first on a line might alter the - ;; syntactic context, and which therefore should trig reindentation - ;; when they are completed. - '(("else" "else" c-electric-continued-statement 0) - ("while" "while" c-electric-continued-statement 0) - ("catch" "catch" c-electric-continued-statement 0) - ("finally" "finally" c-electric-continued-statement 0))) - -(defvar csharp-mode-map (let ((map (c-make-inherited-keymap))) - ;; Add bindings which are only useful for C# - map) - "Keymap used in csharp-mode buffers.") - - -;; TODO -;; Defines our constant for finding attributes. -;;(defconst csharp-attribute-regex "\\[\\([XmlType]+\\)(") -;;(defconst csharp-attribute-regex "\\[\\(.\\)") -;; This doesn't work because the string regex happens before this point -;; and getting the font-locking to work before and after is fairly difficult -;;(defconst csharp-attribute-regex -;; (concat -;; "\\[[a-zA-Z][ \ta-zA-Z0-9.]+" -;; "\\((.*\\)?" -;;)) - - -;; ================================================================== -;; end of c# values for "language constants" defined in cc-langs.el -;; ================================================================== - - - - -;; ================================================================== -;; C# code-doc insertion magic -;; ================================================================== -;; -;; In Visual Studio, if you type three slashes, it immediately expands into -;; an inline code-documentation fragment. The following method does the -;; same thing. -;; -;; This is the kind of thing that could be handled by YASnippet or -;; another similarly flexible snippet framework. But I don't want to -;; introduce a dependency on yasnippet to csharp-mode. So the capability -;; must live within csharp-mode itself. - -(defun csharp-maybe-insert-codedoc (arg) - - "Insert an xml code documentation template as appropriate, when -typing slashes. This fn gets bound to / (the slash key), in -csharp-mode. If the slash being inserted is not the third -consecutive slash, the slash is inserted as normal. If it is the -third consecutive slash, then a xml code documentation template -may be inserted in some cases. For example, - - a template is inserted if the prior line is empty, - or contains only an open curly brace; - a template is inserted if the prior word - closes the element; - a template is inserted if the prior word - closes the element; - an template is inserted if the prior word closes - the element; - a template is inserted if the prior word closes - a element. - -In all other cases the slash is inserted as normal. - -If you want the default cc-mode behavior, which implies no automatic -insertion of xml code documentation templates, then use this in -your `csharp-mode-hook' function: - - (local-set-key (kbd \"/\") 'c-electric-slash) - - " - (interactive "*p") - ;;(message "csharp-maybe-insert-codedoc") - (let ( - (cur-point (point)) - (char last-command-char) - (cb0 (char-before (- (point) 0))) - (cb1 (char-before (- (point) 1))) - is-first-non-whitespace - did-auto-insert - ) - - ;; check if two prior chars were slash - (if (and - (= char ?/) - cb0 (= ?/ cb0) - cb1 (= ?/ cb1) - ) - - (progn - ;;(message "yes - this is the third consecutive slash") - (setq is-first-non-whitespace - (save-excursion - (back-to-indentation) - (= cur-point (+ (point) 2)))) - - (if is-first-non-whitespace - ;; This is a 3-slash sequence. It is the first non-whitespace text - ;; on the line. Now we need to examine the surrounding context - ;; in order to determine which xml cod doc template to insert. - (let (word-back char0 char1 - word-fore char-0 char-1 - text-to-insert ;; text to insert in lieu of slash - fn-to-call ;; func to call after inserting text - (preceding-line-is-empty (or - (= (line-number-at-pos) 1) - (save-excursion - (previous-line) - (beginning-of-line) - (looking-at "[ \t]*$\\|[ \t]*{[ \t]*$")))) - (flavor 0) ;; used only for diagnostic purposes - ) - - ;;(message "starting a 3-slash comment") - ;; get the prior word, and the 2 chars preceding it. - (backward-word) - - (setq word-back (thing-at-point 'word) - char0 (char-before (- (point) 0)) - char1 (char-before (- (point) 1))) - - ;; restore prior position - (goto-char cur-point) - - ;; get the following word, and the 2 chars preceding it. - (forward-word) - (backward-word) - (setq word-fore (thing-at-point 'word) - char-0 (char-before (- (point) 0)) - char-1 (char-before (- (point) 1))) - - ;; restore prior position again - (goto-char cur-point) - - (cond - ;; The preceding line is empty, or all whitespace, or - ;; contains only an open-curly. In this case, insert a - ;; summary element pair. - (preceding-line-is-empty - (setq text-to-insert "/ \n/// \n/// " - flavor 1) ) - - ;; The preceding word closed a summary element. In this case, - ;; if the forward word does not open a remarks element, then - ;; insert a remarks element. - ((and (string-equal word-back "summary") (eq char0 ?/) (eq char1 ?<)) - (if (not (and (string-equal word-fore "remarks") (eq char-0 ?<))) - (setq text-to-insert "/ \n/// \n/// \n/// \n/// " - flavor 2))) - - ;; The preceding word closed the remarks section. In this case, - ;; insert an example element. - ((and (string-equal word-back "remarks") (eq char0 ?/) (eq char1 ?<)) - (setq text-to-insert "/ \n/// \n/// " - flavor 3)) - - ;; The preceding word closed the example section. In this - ;; case, insert an returns element. This isn't always - ;; correct, because sometimes the xml code doc is attached to - ;; a class or a property, neither of which has a return - ;; value. A more intelligent implementation would inspect the - ;; syntax state and only inject a returns element if - ;; appropriate. - ((and (string-equal word-back "example") (eq char0 ?/) (eq char1 ?<)) - (setq text-to-insert "/ " - fn-to-call (lambda () - (backward-word) - (backward-char) - (backward-char) - (c-indent-line-or-region) - ) - flavor 4)) - - ;; The preceding word opened the remarks section, or it - ;; closed a para section. In this case, insert a para - ;; element, using appropriate indentation with respect to the - ;; prior tag. - ((or - (and (string-equal word-back "remarks") (eq char0 ?<) (or (eq char1 32) (eq char1 9))) - (and (string-equal word-back "para") (eq char0 ?/) (eq char1 ?<))) - - (let (prior-point spacer) - (save-excursion - (backward-word) - (backward-char) - (backward-char) - (setq prior-point (point)) - (skip-chars-backward "\t ") - (setq spacer (buffer-substring (point) prior-point)) - ;;(message (format "pt(%d) prior(%d) spacer(%s)" (point) prior-point spacer)) - ) - - (if (string-equal word-back "remarks") - (setq spacer (concat spacer " "))) - - (setq text-to-insert (format "/%s\n///%s \n///%s" - spacer spacer spacer) - flavor 6))) - - ;; The preceding word opened a para element. In this case, if - ;; the forward word does not close the para element, then - ;; close the para element. - ;; -- - ;; This is a nice idea but flawed. Suppose I have a para element with some - ;; text in it. If I position the cursor at the first line, then type 3 slashes, - ;; I get a close-element, and that would be inappropriate. Not sure I can - ;; easily solve that problem, so the best thing might be to simply punt, and - ;; require people to close their own elements. - ;; - ;; ( (and (string-equal word-back "para") (eq char0 60) (or (eq char1 32) (eq char1 9))) - ;; (if (not (and (string-equal word-fore "para") (eq char-0 47) (eq char-1 60) )) - ;; (setq text-to-insert "/ \n/// \n///" - ;; fn-to-call (lambda () - ;; (previous-line) - ;; (end-of-line) - ;; ) - ;; flavor 7) ) - ;; ) - - ;; the default case - do nothing - (t nil)) - - (if text-to-insert - (progn - ;;(message (format "inserting special text (f(%d))" flavor)) - - ;; set the flag, that we actually inserted text - (setq did-auto-insert t) - - ;; save point of beginning of insertion - (setq cur-point (point)) - - ;; actually insert the text - (insert text-to-insert) - - ;; indent the inserted string, and re-position point, either through - ;; the case-specific fn, or via the default progn. - (if fn-to-call - (funcall fn-to-call) - - (let ((newline-count 0) (pos 0) ix) - - ;; count the number of newlines in the inserted string - (while (string-match "\n" text-to-insert pos) - (setq pos (match-end 0) - newline-count (+ newline-count 1) ) - ) - - ;; indent what we just inserted - (c-indent-region cur-point (point) t) - - ;; move up n/2 lines. This assumes that the - ;; inserted text is ~symmetric about the halfway point. - ;; The assumption holds if the xml code doc uses a - ;; begin-elt and end-elt on a new line all by themselves, - ;; and a blank line in between them where the point should be. - ;; A more intelligent implementation would use a specific - ;; marker string, like @@DOT, to note the desired point. - (previous-line (/ newline-count 2)) - (end-of-line))))))))) - - (if (not did-auto-insert) - (self-insert-command (prefix-numeric-value arg))))) - -;; ================================================================== -;; end of c# code-doc insertion magic -;; ================================================================== - - - - -;; ================================================================== -;; c# fontification extensions -;; ================================================================== -;; Commentary: -;; -;; The purpose of the following code is to fix font-lock for C#, -;; specifically for the verbatim-literal strings. C# is a cc-mode -;; language and strings are handled mostly like other c-based -;; languages. The one exception is the verbatim-literal string, which -;; uses the syntax @"...". -;; -;; `parse-partial-sexp' treats those strings as just regular strings, -;; with the @ a non-string character. This is fine, except when the -;; verblit string ends in a slash, in which case, font-lock breaks from -;; that point onward in the buffer. -;; -;; This is an attempt to fix that. -;; -;; The idea is to scan the buffer in full for verblit strings, and apply the -;; appropriate syntax-table text properties for verblit strings. Also setting -;; `parse-sexp-lookup-properties' to t tells `parse-partial-sexp' -;; to use the syntax-table text properties set up by the scan as it does -;; its parse. -;; -;; Also need to re-scan after any changes in the buffer, but on a more -;; limited region. -;; - - -;; ;; I don't remember what this is supposed to do, -;; ;; or how I figured out the value. -;; ;; -;; (defconst csharp-font-lock-syntactic-keywords -;; '(("\\(@\\)\\(\"\\)[^\"]*\\(\"\\)\\(\"\\)[^\"]*\\(\"\\)[^\"]" -;; (1 '(6)) (2 '(7)) (3 '(1)) (4 '(1)) (5 '(7)) -;; )) -;; "Highlighting of verbatim literal strings. See also the variable -;; `font-lock-keywords'.") - - - -;; Allow this: -;; (csharp-log 3 "csharp: scan...'%s'" state) - -(defvar csharp-log-level 0 - "The current log level for CSharp-specific operations. -This is used in particular by the verbatim-literal -string scanning. - -Most other csharp functions are not instrumented. -0 = NONE, 1 = Info, 2 = VERBOSE, 3 = DEBUG, 4 = SHUTUP ALREADY. ") - -(defun csharp-log (level text &rest args) - "Log a message at level LEVEL. -If LEVEL is higher than `csharp-log-level', the message is -ignored. Otherwise, it is printed using `message'. -TEXT is a format control string, and the remaining arguments ARGS -are the string substitutions (see `format')." - (if (<= level csharp-log-level) - (let* ((msg (apply 'format text args))) - (message "%s" msg) - ))) - - - -(defun csharp-max-beginning-of-stmt () - "Return the greater of `c-beginning-of-statement-1' and -`c-beginning-of-statement' . I don't understand why both of -these methods are necessary or why they differ. But they do." - - (let (dash - nodash - (curpos (point))) - - ;; I think this may need a save-excursion... - ;; Calling c-beginning-of-statement-1 resets the point! - - (setq dash (progn (c-beginning-of-statement-1) (point))) - (csharp-log 3 "C#: max-bostmt dash(%d)" dash) - (goto-char curpos) - - (setq nodash (progn (c-beginning-of-statement 1) (point))) - (csharp-log 3 "C#: max-bostmt nodash(%d)" nodash) - (goto-char curpos) - - (max dash nodash))) - - -(defun csharp-in-literal (&optional lim detect-cpp) - "Return the type of literal point is in, if any. -Basically this works like `c-in-literal' except it doesn't -use or fill the cache (`c-in-literal-cache'). - -The return value is `c' if in a C-style comment, `c++' if in a C++ -style comment, `string' if in a string literal, `pound' if DETECT-CPP -is non-nil and in a preprocessor line, or nil if somewhere else. -Optional LIM is used as the backward limit of the search. If omitted, -or nil, `c-beginning-of-syntax' is used. - -Note that this function might do hidden buffer changes. See the -comment at the start of cc-engine.el for more info." - - (let ((rtn - (save-excursion - (let* ((pos (point)) - (lim (or lim (progn - (c-beginning-of-syntax) - (point)))) - (state (parse-partial-sexp lim pos))) - (csharp-log 4 "C#: parse lim(%d) state: %s" lim (prin1-to-string state)) - (cond - ((elt state 3) - (csharp-log 4 "C#: in literal string (%d)" pos) - 'string) - ((elt state 4) - (csharp-log 4 "C#: in literal comment (%d)" pos) - (if (elt state 7) 'c++ 'c)) - ((and detect-cpp (c-beginning-of-macro lim)) 'pound) - (t nil)))))) - rtn)) - - -(defun csharp-set-vliteral-syntax-table-properties (beg end) - "Scan the buffer text between BEG and END, a verbatim literal -string, setting and clearing syntax-table text properties where -necessary. - -We need to modify the default syntax-table text property in these cases: - (backslash) - is not an escape inside a verbatim literal string. - (double-quote) - can be a literal quote, when doubled. - -BEG is the @ delimiter. END is the 'old' position of the ending quote. - -see http://www.sunsite.ualberta.ca/Documentation/Gnu/emacs-lisp-ref-21-2.7/html_node/elisp_592.html -for the list of syntax table numeric codes. - -" - - (csharp-log 3 "C#: set-vlit-syntax-table: beg(%d) end(%d)" beg end) - - (if (and (> beg 0) (> end 0)) - - (let ((curpos beg) - (state 0)) - - (c-clear-char-properties beg end 'syntax-table) - - (while (<= curpos end) - - (cond - ((= state 0) - (if (= (char-after curpos) ?@) - (progn - (c-put-char-property curpos 'syntax-table '(3)) ; (6) = expression prefix, (3) = symbol - ;;(message (format "C#: set-s-t: prefix pos(%d) chr(%c)" beg (char-after beg))) - ) - ) - (setq state (+ 1 state))) - - ((= state 1) - (if (= (char-after curpos) ?\") - (progn - (c-put-char-property curpos 'syntax-table '(7)) ; (7) = string quote - ;;(message (format "C#: set-s-t: open quote pos(%d) chr(%c)" - ;; curpos (char-after curpos))) - )) - (setq state (+ 1 state))) - - ((= state 2) - (cond - ;; handle backslash - ((= (char-after curpos) ?\\) - (c-put-char-property curpos 'syntax-table '(2)) ; (1) = punctuation, (2) = word - ;;(message (format "C#: set-s-t: backslash word pos(%d) chr(%c)" curpos (char-after curpos))) - ) - - ;; doubled double-quote - ((and - (= (char-after curpos) ?\") - (= (char-after (+ 1 curpos)) ?\")) - (c-put-char-property curpos 'syntax-table '(2)) ; (1) = punctuation, (2) = word - (c-put-char-property (+ 1 curpos) 'syntax-table '(2)) ; (1) = punctuation - ;;(message (format "C#: set-s-t: double doublequote pos(%d) chr(%c)" curpos (char-after curpos))) - (setq curpos (+ curpos 1)) - ) - - ;; a single double-quote, which should be a string terminator - ((= (char-after curpos) ?\") - (c-put-char-property curpos 'syntax-table '(7)) ; (7) = string quote - ;;(message (format "C#: set-s-t: close quote pos(%d) chr(%c)" curpos (char-after curpos))) - ;;go no further - (setq state (+ 1 state))) - - ;; everything else - (t - ;;(message (format "C#: set-s-t: none pos(%d) chr(%c)" curpos (char-after curpos))) - nil)))) - ;; next char - (setq curpos (+ curpos 1)))))) - - - -(defun csharp-end-of-verbatim-literal-string (&optional lim) - "Moves to and returns the position of the end quote of the verbatim literal -string. When calling, point should be on the @ of the verblit string. -If it is not, then no movement is performed and `point' is returned. - -This function ignores text properties. In fact it is the -underlying scanner used to set the text properties in a C# buffer. -" - - (csharp-log 3 "C#: end-of-vlit-string: point(%d) c(%c)" (point) (char-after)) - - (let (curpos - (max (or lim (point-max)))) - - (if (not (looking-at "@\"")) - (point) - (forward-char 2) ;; pass up the @ sign and first quote - (setq curpos (point)) - - ;; Within a verbatim literal string, a doubled double-quote - ;; escapes the double-quote." - (while (and ;; process characters... - (or ;; while... - (not (eq (char-after curpos) ?\")) ;; it's not a quote - (eq (char-after (+ curpos 1)) ?\")) ;; or, its a double (double) quote - (< curpos max)) ;; and we're not done yet - - (cond - ((and (eq (char-after curpos) ?\") ;; it's a double-quote. - (eq (char-after (+ curpos 1)) ?\")) - (setq curpos (+ 2 curpos))) ;; Skip 2 - (t ;; anything else - (setq curpos (+ 1 curpos))))) ;; skip fwd 1 - curpos))) - - - - -(defun csharp-scan-for-verbatim-literals-and-set-props (&optional beg end) - -"Scans the buffer, between BEG and END, for verbatim literal -strings, and sets override text properties on each string to -allow proper syntax highlighting, indenting, and cursor movement. - -BEG and END define the limits of the scan. When nil, they -default to `point-min' and `point-max' respectively. - -Setting text properties generally causes the buffer to be marked -as modified, but this fn suppresses that via the -`c-buffer-save-state' macro, for any changes in text properties -that it makes. This fn also ignores the read-only setting on a -buffer, using the same macro. - -This fn is called when a csharp-mode buffer is loaded, with BEG -and END set to nil, to do a full scan. It is also called on -every buffer change, with the BEG and END set to the values for -the change. - -The return value is nil if the buffer was not a csharp-mode -buffer. Otherwise it is the last cursor position examined by the -scan. -" - - (if (not (c-major-mode-is 'csharp-mode)) ;; don't scan if not csharp mode - nil - (save-excursion - (c-save-buffer-state - ((curpos (or beg (point-min))) - (lastpos (or end (point-max))) - (state 0) (start 0) (cycle 0) - literal eos limits) - - (csharp-log 3 "C#: scan") - (goto-char curpos) - - (while (and (< curpos lastpos) (< cycle 10000)) - (cond - - ;; Case 1: current char is a @ sign - ;; -------------------------------------------- - ;; Check to see if it demarks the beginning of a verblit - ;; string. - ((= ?@ (char-after curpos)) - - ;; are we in a comment? a string? Maybe the @ is a prefix - ;; to allow the use of a reserved word as a symbol. Let's find out. - - ;; not sure why I need both of the following. - (syntax-ppss-flush-cache 1) - (parse-partial-sexp 1 curpos) - (goto-char curpos) - (setq literal (csharp-in-literal)) - (cond - - ;; Case 1.A: it's a @ within a string. - ;; -------------------------------------------- - ;; This should never happen, because this scanner hops over strings. - ;; But it might happen if the scan starts at an odd place. - ((eq literal 'string) nil) - - ;; Case 1.B: The @ is within a comment. Hop over it. - ((and (memq literal '(c c++)) - ;; This is a kludge for XEmacs where we use - ;; `buffer-syntactic-context', which doesn't correctly - ;; recognize "\*/" to end a block comment. - ;; `parse-partial-sexp' which is used by - ;; `c-literal-limits' will however do that in most - ;; versions, which results in that we get nil from - ;; `c-literal-limits' even when `c-in-literal' claims - ;; we're inside a comment. - ;;(setq limits (c-literal-limits start))) - (setq limits (c-literal-limits))) - - ;; advance to the end of the comment - (if limits - (progn - (csharp-log 4 "C#: scan: jump end comment A (%d)" (cdr limits)) - (setq curpos (cdr limits))))) - - - ;; Case 1.B: curpos is at least 2 chars before the last - ;; position to examine, and, the following char is a - ;; double-quote (ASCII 34). - ;; -------------------------------------------- - ;; This looks like the beginning of a verbatim string - ;; literal. - ((and (< (+ 2 curpos) lastpos) - (= ?\" (char-after (+ 1 curpos)))) - - (setq eos (csharp-end-of-verbatim-literal-string)) - ;; set override syntax properties on the verblit string - (csharp-set-vliteral-syntax-table-properties curpos eos) - - (csharp-log 4 "C#: scan: jump end verblit string (%d)" eos) - (setq curpos eos)))) - - - ;; Case 2: current char is a double-quote. - ;; -------------------------------------------- - ;; If this is a string, we hop over it, on the assumption that - ;; this scanner need not bother with regular literal strings, which - ;; get the proper syntax with the generic approach. - ;; If in a comment, hop over the comment. - ((= ?\" (char-after curpos)) - (goto-char curpos) - (setq literal (c-in-literal)) - (cond - - ;; Case 2.A: a quote within a string - ;; -------------------------------------------- - ;; This shouldn't happen, because we hop over strings. - ;; But it might. - ((eq literal 'string) nil) - - ;; Case 2.B: a quote within a comment - ;; -------------------------------------------- - ((and (memq literal '(c c++)) - ;; This is a kludge for XEmacs where we use - ;; `buffer-syntactic-context', which doesn't correctly - ;; recognize "\*/" to end a block comment. - ;; `parse-partial-sexp' which is used by - ;; `c-literal-limits' will however do that in most - ;; versions, which results in that we get nil from - ;; `c-literal-limits' even when `c-in-literal' claims - ;; we're inside a comment. - ;;(setq limits (c-literal-limits start))) - (setq limits (c-literal-limits))) - - ;; advance to the end of the comment - (if limits - (progn - (setq curpos (cdr limits)) - (csharp-log 3 "C#: scan: jump end comment B (%s)" curpos)))) - - - ;; Case 2.C: Not in a comment, and not in a string. - ;; -------------------------------------------- - ;; This is the beginning of a literal (but not verbatim) string. - (t - (forward-char 1) ;; pass up the quote - (if (consp (setq limits (c-literal-limits))) - (progn - (csharp-log 4 "C#: scan: jump end literal (%d)" (cdr limits)) - (setq curpos (cdr limits)))))))) - - (setq cycle (+ 1 cycle)) - (setq curpos (+ 1 curpos)) - (c-safe (goto-char curpos))))))) - - -(defun csharp-before-font-lock (beg end old-len) - "Adjust`syntax-table' properties on the region affected by the change -in a csharp-mode buffer. - -This function is the C# value for `c-before-font-lock-function'. -It intended to be called only by the cc-mode runtime. - -It prepares the buffer for font locking, hence must get called -before `font-lock-after-change-function'. - -It does hidden buffer changes. - -BEG, END and OLD-LEN have the same meaning here as for any -after-change function. - -Point is undefined both before and after this function call. -The return value is meaningless, and is ignored by cc-mode. -" - (let ((start-scan (progn - (c-beginning-of-statement 1) - (point)))) - (csharp-scan-for-verbatim-literals-and-set-props start-scan end))) - - - -(c-lang-defconst c-before-font-lock-function - csharp 'csharp-before-font-lock) - -;; ================================================================== -;; end of c# fontification extensions -;; ================================================================== - - - - - -;; ================================================================== -;; C#-specific optimizations of cc-mode funcs -;; ================================================================== - - -;; There's never a need to check for C-style macro definitions in -;; a C# buffer. -(defadvice c-beginning-of-macro (around - csharp-mode-advice-1 - compile activate) - (if (c-major-mode-is 'csharp-mode) - nil - ad-do-it) - ) - - -;; There's never a need to move over an Obj-C directive in csharp mode -(defadvice c-forward-objc-directive (around - csharp-mode-advice-2 - compile activate) - (if (c-major-mode-is 'csharp-mode) - nil - ad-do-it) - ) - -;; ================================================================== -;; end of C#-specific optimizations of cc-mode funcs -;; ================================================================== - - - - - - - - -;; ================================================================== -;; c# - monkey-patching of basic parsing logic -;; ================================================================== -;; -;; Here, the model redefines two defuns to add special cases for csharp -;; mode. These primarily deal with indentation of instance -;; initializers, which are somewhat unique to C#. I couldn't figure out -;; how to get cc-mode to do what C# needs, without modifying these -;; defuns. -;; - -(defun c-looking-at-inexpr-block (lim containing-sexp &optional check-at-end) - ;; Return non-nil if we're looking at the beginning of a block - ;; inside an expression. The value returned is actually a cons of - ;; either 'inlambda, 'inexpr-statement or 'inexpr-class and the - ;; position of the beginning of the construct. - ;; - ;; LIM limits the backward search. CONTAINING-SEXP is the start - ;; position of the closest containing list. If it's nil, the - ;; containing paren isn't used to decide whether we're inside an - ;; expression or not. If both LIM and CONTAINING-SEXP are used, LIM - ;; needs to be farther back. - ;; - ;; If CHECK-AT-END is non-nil then extra checks at the end of the - ;; brace block might be done. It should only be used when the - ;; construct can be assumed to be complete, i.e. when the original - ;; starting position was further down than that. - ;; - ;; This function might do hidden buffer changes. - - (save-excursion - (let ((res 'maybe) passed-paren - (closest-lim (or containing-sexp lim (point-min))) - ;; Look at the character after point only as a last resort - ;; when we can't disambiguate. - (block-follows (and (eq (char-after) ?{) (point)))) - - (while (and (eq res 'maybe) - (progn (c-backward-syntactic-ws) - (> (point) closest-lim)) - (not (bobp)) - (progn (backward-char) - (looking-at "[\]\).]\\|\\w\\|\\s_")) - (c-safe (forward-char) - (goto-char (scan-sexps (point) -1)))) - - (setq res - (if (looking-at c-keywords-regexp) - (let ((kw-sym (c-keyword-sym (match-string 1)))) - (cond - ((and block-follows - (c-keyword-member kw-sym 'c-inexpr-class-kwds)) - (and (not (eq passed-paren ?\[)) - - ;; dinoch Thu, 22 Apr 2010 18:20 - ;; ============================================ - ;; looking at new MyType() { ... } - ;; means this is a brace list, so, return nil, - ;; implying NOT looking-at-inexpr-block - (not - (and (c-major-mode-is 'csharp-mode) - (looking-at "new\s+\\([[:alnum:]_]+\\)\\b"))) - - (or (not (looking-at c-class-key)) - ;; If the class instantiation is at the start of - ;; a statement, we don't consider it an - ;; in-expression class. - (let ((prev (point))) - (while (and - (= (c-backward-token-2 1 nil closest-lim) 0) - (eq (char-syntax (char-after)) ?w)) - (setq prev (point))) - (goto-char prev) - (not (c-at-statement-start-p))) - ;; Also, in Pike we treat it as an - ;; in-expression class if it's used in an - ;; object clone expression. - (save-excursion - (and check-at-end - (c-major-mode-is 'pike-mode) - (progn (goto-char block-follows) - (zerop (c-forward-token-2 1 t))) - (eq (char-after) ?\()))) - (cons 'inexpr-class (point)))) - ((c-keyword-member kw-sym 'c-inexpr-block-kwds) - (when (not passed-paren) - (cons 'inexpr-statement (point)))) - ((c-keyword-member kw-sym 'c-lambda-kwds) - (when (or (not passed-paren) - (eq passed-paren ?\()) - (cons 'inlambda (point)))) - ((c-keyword-member kw-sym 'c-block-stmt-kwds) - nil) - (t - 'maybe))) - - (if (looking-at "\\s(") - (if passed-paren - (if (and (eq passed-paren ?\[) - (eq (char-after) ?\[)) - ;; Accept several square bracket sexps for - ;; Java array initializations. - 'maybe) - (setq passed-paren (char-after)) - 'maybe) - 'maybe)))) - - (if (eq res 'maybe) - (when (and c-recognize-paren-inexpr-blocks - block-follows - containing-sexp - (eq (char-after containing-sexp) ?\()) - (goto-char containing-sexp) - (if (or (save-excursion - (c-backward-syntactic-ws lim) - (and (> (point) (or lim (point-min))) - (c-on-identifier))) - (and c-special-brace-lists - (c-looking-at-special-brace-list))) - nil - (cons 'inexpr-statement (point)))) - - res)))) - - - - -(defconst csharp-enum-decl-re - (concat - "\\\s+\\([[:alnum:]_]+\\)\s*:\s*" - "\\(" - (c-make-keywords-re nil - (list "sbyte" "byte" "short" "ushort" "int" "uint" "long" "ulong")) - "\\)") - "Regex that captures an enum declaration in C#" - ) - - - -(defun c-inside-bracelist-p (containing-sexp paren-state) - ;; return the buffer position of the beginning of the brace list - ;; statement if we're inside a brace list, otherwise return nil. - ;; CONTAINING-SEXP is the buffer pos of the innermost containing - ;; paren. PAREN-STATE is the remainder of the state of enclosing - ;; braces - ;; - ;; N.B.: This algorithm can potentially get confused by cpp macros - ;; placed in inconvenient locations. It's a trade-off we make for - ;; speed. - ;; - ;; This function might do hidden buffer changes. - (or - ;; This will pick up brace list declarations. - (c-safe - (save-excursion - (goto-char containing-sexp) - (c-forward-sexp -1) - (let (bracepos) - (if (and (or (looking-at c-brace-list-key) - - (progn (c-forward-sexp -1) - (looking-at c-brace-list-key)) - - ;; dinoch Thu, 22 Apr 2010 18:20 - ;; ============================================ - ;; looking enum Foo : int - ;; means this is a brace list, so, return nil, - ;; implying NOT looking-at-inexpr-block - - (and (c-major-mode-is 'csharp-mode) - (progn - (c-forward-sexp -1) - (looking-at csharp-enum-decl-re)))) - - (setq bracepos (c-down-list-forward (point))) - (not (c-crosses-statement-barrier-p (point) - (- bracepos 2)))) - (point))))) - ;; this will pick up array/aggregate init lists, even if they are nested. - (save-excursion - (let ((class-key - ;; Pike can have class definitions anywhere, so we must - ;; check for the class key here. - (and (c-major-mode-is 'pike-mode) - c-decl-block-key)) - bufpos braceassignp lim next-containing) - (while (and (not bufpos) - containing-sexp) - (when paren-state - (if (consp (car paren-state)) - (setq lim (cdr (car paren-state)) - paren-state (cdr paren-state)) - (setq lim (car paren-state))) - (when paren-state - (setq next-containing (car paren-state) - paren-state (cdr paren-state)))) - (goto-char containing-sexp) - (if (c-looking-at-inexpr-block next-containing next-containing) - ;; We're in an in-expression block of some kind. Do not - ;; check nesting. We deliberately set the limit to the - ;; containing sexp, so that c-looking-at-inexpr-block - ;; doesn't check for an identifier before it. - (setq containing-sexp nil) - ;; see if the open brace is preceded by = or [...] in - ;; this statement, but watch out for operator= - (setq braceassignp 'dontknow) - (c-backward-token-2 1 t lim) - ;; Checks to do only on the first sexp before the brace. - (when (and c-opt-inexpr-brace-list-key - (eq (char-after) ?\[)) - ;; In Java, an initialization brace list may follow - ;; directly after "new Foo[]", so check for a "new" - ;; earlier. - (while (eq braceassignp 'dontknow) - (setq braceassignp - (cond ((/= (c-backward-token-2 1 t lim) 0) nil) - ((looking-at c-opt-inexpr-brace-list-key) t) - ((looking-at "\\sw\\|\\s_\\|[.[]") - ;; Carry on looking if this is an - ;; identifier (may contain "." in Java) - ;; or another "[]" sexp. - 'dontknow) - (t nil))))) - ;; Checks to do on all sexps before the brace, up to the - ;; beginning of the statement. - (while (eq braceassignp 'dontknow) - (cond ((eq (char-after) ?\;) - (setq braceassignp nil)) - ((and class-key - (looking-at class-key)) - (setq braceassignp nil)) - ((eq (char-after) ?=) - ;; We've seen a =, but must check earlier tokens so - ;; that it isn't something that should be ignored. - (setq braceassignp 'maybe) - (while (and (eq braceassignp 'maybe) - (zerop (c-backward-token-2 1 t lim))) - (setq braceassignp - (cond - ;; Check for operator = - ((and c-opt-op-identifier-prefix - (looking-at c-opt-op-identifier-prefix)) - nil) - ;; Check for `= in Pike. - ((and (c-major-mode-is 'pike-mode) - (or (eq (char-after) ?`) - ;; Special case for Pikes - ;; `[]=, since '[' is not in - ;; the punctuation class. - (and (eq (char-after) ?\[) - (eq (char-before) ?`)))) - nil) - ((looking-at "\\s.") 'maybe) - ;; make sure we're not in a C++ template - ;; argument assignment - ((and - (c-major-mode-is 'c++-mode) - (save-excursion - (let ((here (point)) - (pos< (progn - (skip-chars-backward "^<>") - (point)))) - (and (eq (char-before) ?<) - (not (c-crosses-statement-barrier-p - pos< here)) - (not (c-in-literal)) - )))) - nil) - (t t)))))) - (if (and (eq braceassignp 'dontknow) - (/= (c-backward-token-2 1 t lim) 0)) - (setq braceassignp nil))) - (if (not braceassignp) - (if (eq (char-after) ?\;) - ;; Brace lists can't contain a semicolon, so we're done. - (setq containing-sexp nil) - ;; Go up one level. - (setq containing-sexp next-containing - lim nil - next-containing nil)) - ;; we've hit the beginning of the aggregate list - (c-beginning-of-statement-1 - (c-most-enclosing-brace paren-state)) - (setq bufpos (point)))) - ) - bufpos)) - )) - -;; ================================================================== -;; end of monkey-patching of basic parsing logic -;; ================================================================== - - - - -;;(easy-menu-define csharp-menu csharp-mode-map "C# Mode Commands" -;; ;; Can use `csharp' as the language for `c-mode-menu' -;; ;; since its definition covers any language. In -;; ;; this case the language is used to adapt to the -;; ;; nonexistence of a cpp pass and thus removing some -;; ;; irrelevant menu alternatives. -;; (cons "C#" (c-lang-const c-mode-menu csharp))) - -;;; Autoload mode trigger -;;;###autoload -(add-to-list 'auto-mode-alist '("\\.cs$" . csharp-mode)) - - - -(c-add-style "C#" - '("Java" - (c-basic-offset . 4) - (c-comment-only-line-offset . (0 . 0)) - (c-offsets-alist . ( - (access-label . -) - (arglist-close . c-lineup-arglist) - (arglist-cont . 0) - (arglist-cont-nonempty . c-lineup-arglist) - (arglist-intro . c-lineup-arglist-intro-after-paren) - (block-close . 0) - (block-open . 0) - (brace-entry-open . 0) - (brace-list-close . 0) - (brace-list-entry . 0) - (brace-list-intro . +) - (brace-list-open . +) - (c . c-lineup-C-comments) - (case-label . +) - (catch-clause . 0) - (class-close . 0) - (class-open . 0) - (comment-intro . c-lineup-comment) - (cpp-macro . 0) - (cpp-macro-cont . c-lineup-dont-change) - (defun-block-intro . +) - (defun-close . 0) - (defun-open . 0) - (do-while-closure . 0) - (else-clause . 0) - (extern-lang-close . 0) - (extern-lang-open . 0) - (friend . 0) - (func-decl-cont . +) - (inclass . +) - (inexpr-class . +) - (inexpr-statement . 0) - (inextern-lang . +) - (inher-cont . c-lineup-multi-inher) - (inher-intro . +) - (inlambda . c-lineup-inexpr-block) - (inline-close . 0) - (inline-open . 0) - (innamespace . +) - (knr-argdecl . 0) - (knr-argdecl-intro . 5) - (label . 0) - (lambda-intro-cont . +) - (member-init-cont . c-lineup-multi-inher) - (member-init-intro . +) - (namespace-close . 0) - (namespace-open . 0) - (statement . 0) - (statement-block-intro . +) - (statement-case-intro . +) - (statement-case-open . +) - (statement-cont . +) - (stream-op . c-lineup-streamop) - (string . c-lineup-dont-change) - (substatement . +) - (substatement-open . 0) - (template-args-cont c-lineup-template-args +) - (topmost-intro . 0) - (topmost-intro-cont . 0) - )) - )) - - - - -;; Custom variables -;;;###autoload -(defcustom csharp-mode-hook nil - "*Hook called by `csharp-mode'." - :type 'hook - :group 'c) - - - -;;; The entry point into the mode -;;;###autoload -(defun csharp-mode () - "Major mode for editing C# code. This mode is derived from CC Mode to -support C#. - -The hook `c-mode-common-hook' is run with no args at mode -initialization, then `csharp-mode-hook'. - -This mode will automatically add a regexp for Csc.exe error and warning -messages to the `compilation-error-regexp-alist'. - -Key bindings: -\\{csharp-mode-map}" - (interactive) - (kill-all-local-variables) - (make-local-variable 'beginning-of-defun-function) - (make-local-variable 'end-of-defun-function) - (c-initialize-cc-mode t) - (set-syntax-table csharp-mode-syntax-table) - - ;; define underscore as part of a word in the Csharp syntax table - (modify-syntax-entry ?_ "w" csharp-mode-syntax-table) - - ;; define @ as an expression prefix in Csharp syntax table - (modify-syntax-entry ?@ "'" csharp-mode-syntax-table) - - (setq major-mode 'csharp-mode - mode-name "C#" - local-abbrev-table csharp-mode-abbrev-table - abbrev-mode t) - (use-local-map csharp-mode-map) - - ;; `c-init-language-vars' is a macro that is expanded at compile - ;; time to a large `setq' with all the language variables and their - ;; customized values for our language. - (c-init-language-vars csharp-mode) - - - ;; `c-common-init' initializes most of the components of a CC Mode - ;; buffer, including setup of the mode menu, font-lock, etc. - ;; There's also a lower level routine `c-basic-common-init' that - ;; only makes the necessary initialization to get the syntactic - ;; analysis and similar things working. - (c-common-init 'csharp-mode) - - - ;; csc.exe, the C# Compiler, produces errors like this: - ;; file.cs(6,18): error SC1006: Name of constructor must match name of class - - (add-hook 'compilation-mode-hook - (lambda () - (setq compilation-error-regexp-alist - (cons ' ("^[ \t]*\\([A-Za-z0-9][^(]+\\.cs\\)(\\([0-9]+\\)[,]\\([0-9]+\\)) ?: \\(error\\|warning\\) CS[0-9]+:" 1 2 3) - compilation-error-regexp-alist)))) - - ;; to allow next-error to work with csc.exe: - (setq compilation-scroll-output t) - - ;; allow fill-paragraph to work on xml code doc - (set (make-local-variable 'paragraph-separate) - "[ \t]*\\(//+\\|\\**\\)\\([ \t]+\\|[ \t]+<.+?>\\)$\\|^\f") - - - (c-run-mode-hooks 'c-mode-common-hook 'csharp-mode-hook) - - - ;; Need the following for parse-partial-sexp to work properly with - ;; verbatim literal strings Setting this var to non-nil tells - ;; `parse-partial-sexp' to pay attention to the syntax text - ;; properties on the text in the buffer. If csharp-mode attaches - ;; text syntax to @"..." then, `parse-partial-sexp' will treat those - ;; strings accordingly. - (set (make-local-variable 'parse-sexp-lookup-properties) - t) - - ;; scan the entire buffer for verblit strings - (csharp-scan-for-verbatim-literals-and-set-props nil nil) - - - (local-set-key (kbd "/") 'csharp-maybe-insert-codedoc) - (local-set-key (kbd "{") 'csharp-insert-open-brace) - - (c-update-modeline)) - - - -(message (concat "Done loading " load-file-name)) - - -(provide 'csharp-mode) - -;;; csharp-mode.el ends here -;;MD5: 4EDCB2ECE38841F407C7ED3DA8354E15 diff --git a/.emacs.d/fuzzy.el b/.emacs.d/fuzzy.el deleted file mode 100644 index c69150a..0000000 --- a/.emacs.d/fuzzy.el +++ /dev/null @@ -1,255 +0,0 @@ -;;; fuzzy.el --- Fuzzy matching utilities - -;; Copyright (C) 2010 Tomohiro Matsuyama - -;; Author: Tomohiro Matsuyama -;; Keywords: convenience - -;; 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: - -;; - -;;; Code: - -(eval-when-compile - (require 'cl)) -(require 'regexp-opt) - -(defgroup fuzzy nil - "Fuzzy matching utilities." - :group 'convenience - :prefix "fuzzy-") - -(defcustom fuzzy-accept-error-rate 0.10 - "Error threshold." - :group 'fuzzy) - -(defvar fuzzy-accept-length-difference 2) - -(defvar fuzzy-regexp-some-char (format "\\w\\{0,%s\\}" fuzzy-accept-length-difference)) - - - -;;; Functions - -(defun fuzzy-reverse-string (string) - (apply 'string (nreverse (append string nil)))) - -(defun fuzzy-regexp-compile (string) - (labels ((oddp (n) (eq (logand n 1) 1)) - (evenp (n) (eq (logand n 1) 0)) - (opt (n) (regexp-opt-charset (append (substring string - (max 0 (- n 1)) - (min (length string) (+ n 2))) nil)))) - (concat - "\\(" - (loop for i below (length string) - for c = (if (evenp i) (opt i) fuzzy-regexp-some-char) - concat c) - "\\|" - (loop for i below (length string) - for c = (if (oddp i) (opt i) fuzzy-regexp-some-char) - concat c) - "\\)"))) - -(defalias 'fuzzy-edit-distance 'fuzzy-jaro-winkler-distance) - -(defun fuzzy-jaro-winkler-distance (s1 s2) - "http://en.wikipedia.org/wiki/Jaro-Winkler_distance" - (let* ((l1 (length s1)) - (l2 (length s2)) - (r (max 1 (1- (/ (max l1 l2) 2)))) - (m 0) - (tr 0) - (p 0) - cs1 cs2) - (loop with seen = (make-vector l2 nil) - for i below l1 - for c1 = (aref s1 i) do - (loop for j from (max 0 (- i r)) below (min l2 (+ i r)) - for c2 = (aref s2 j) - if (and (char-equal c1 c2) - (null (aref seen j))) do - (push c1 cs1) - (aset seen j c2) - (incf m) - and return nil) - finally - (setq cs1 (nreverse cs1) - cs2 (loop for i below l2 - for c = (aref seen i) - if c collect c))) - (loop for c1 in cs1 - for c2 in cs2 - if (not (char-equal c1 c2)) do - (incf tr)) - (loop for i below (min m 5) - for c1 across s1 - for c2 across s2 - while (char-equal c1 c2) do - (incf p)) - (if (eq m 0) - 0.0 - (setq m (float m)) - (let* ((dj (/ (+ (/ m l1) (/ m l2) (/ (- m (/ tr 2)) m)) 3)) - (dw (+ dj (* p 0.1 (- 1 dj))))) - dw)))) - -;; this function should be compiled -(byte-compile 'fuzzy-jaro-winkler-distance) - -(defun fuzzy-match (s1 s2 &optional function) - (or function (setq function 'fuzzy-edit-distance)) - (and (<= (abs (- (length s1) (length s2))) - fuzzy-accept-length-difference) - (>= (funcall function s1 s2) - (- 1 fuzzy-accept-error-rate)))) - -(defun fuzzy-all-completions (string collection) - "all-completions family with fuzzy matching." - (loop with length = (length string) - for str in collection - for s = (substring str 0 (min (length str) - (+ length fuzzy-accept-length-difference))) - if (fuzzy-match string s) - collect str)) - - - -;;; Search and Incremental Search - -(defvar fuzzy-search-cache nil) -(defvar fuzzy-search-cache-string nil) - -(defun fuzzy-search-cache-activate () - (setq fuzzy-search-cache (make-hash-table)) - (setq fuzzy-search-cache-string nil)) - -(defun fuzzy-search-cache-deactive () - (setq fuzzy-search-cache nil) - (setq fuzzy-search-cache-string nil)) - -(defun fuzzy-search-edit-distance (s1 s2) - (or (and fuzzy-search-cache - (cond - ((null fuzzy-search-cache-string) - (setq fuzzy-search-cache-string s1) - nil) - ((not (equal fuzzy-search-cache-string s1)) - (setq fuzzy-search-cache-string s1) - (clrhash fuzzy-search-cache) - nil) - (t)) - (gethash s2 fuzzy-search-cache)) - (let ((d (fuzzy-edit-distance s1 s2))) - (if fuzzy-search-cache - (puthash s2 d fuzzy-search-cache)) - d))) - -(defun fuzzy-search-match (s1 s2) - (fuzzy-match s1 s2 'fuzzy-search-edit-distance)) - -(defun fuzzy-search-forward (string &optional bound noerror count) - (let* ((regexp (fuzzy-regexp-compile string)) - match-data) - (save-excursion - (while (and (null match-data) - (re-search-forward regexp bound t)) - (if (fuzzy-search-match string (match-string 1)) - (setq match-data (match-data)) - (goto-char (1+ (match-beginning 1)))))) - (when match-data - (store-match-data match-data) - (goto-char (match-end 1))))) - -(defun fuzzy-search-backward (string &optional bound noerror count) - (let* ((regexp (fuzzy-regexp-compile string)) - match-data begin end) - (save-excursion - (while (and (null match-data) - (re-search-backward regexp bound t)) - (setq begin (match-beginning 1) - end (match-end 1)) - (store-match-data nil) - (goto-char (max (point-min) (- begin (* (length string) 2)))) - (while (re-search-forward regexp end t) - (if (fuzzy-search-match string (match-string 1)) - (setq match-data (match-data)) - (goto-char (1+ (match-beginning 1))))) - (unless match-data - (goto-char begin))) - (if match-data - (progn - (store-match-data match-data) - (goto-char (match-beginning 1))) - (store-match-data nil))))) - -(defvar fuzzy-isearch nil) -(defvar fuzzy-isearch-failed-count 0) -(defvar fuzzy-isearch-enabled 'on-failed) -(defvar fuzzy-isearch-original-search-fun nil) -(defvar fuzzy-isearch-prefix "[FUZZY] ") - -(defun fuzzy-isearch-activate () - (setq fuzzy-isearch t) - (setq fuzzy-isearch-failed-count 0) - (fuzzy-search-cache-activate)) - -(defun fuzzy-isearch-deactivate () - (setq fuzzy-isearch nil) - (setq fuzzy-isearch-failed-count 0) - (fuzzy-search-cache-deactive)) - -(defun fuzzy-isearch () - (cond (isearch-word - (if isearch-forward 'word-search-forward 'word-search-backward)) - (isearch-regexp - (if isearch-forward 're-search-forward 're-search-backward)) - ((or fuzzy-isearch - (eq fuzzy-isearch-enabled 'always) - (and (eq fuzzy-isearch-enabled 'on-failed) - (null isearch-success) - isearch-wrapped - (> (setq fuzzy-isearch-failed-count (1+ fuzzy-isearch-failed-count)) - 1))) - (unless fuzzy-isearch - ;(goto-char isearch-opoint) - (fuzzy-isearch-activate)) - (if isearch-forward 'fuzzy-search-forward 'fuzzy-search-backward)) - (t - (if isearch-forward 'search-forward 'search-backward)))) - -(defun fuzzy-isearch-end-hook () - (fuzzy-isearch-deactivate)) - -(defun turn-on-fuzzy-isearch () - (interactive) - (setq fuzzy-isearch-original-search-fun isearch-search-fun-function) - (setq isearch-search-fun-function 'fuzzy-isearch) - (add-hook 'isearch-mode-end-hook 'fuzzy-isearch-end-hook)) - -(defun turn-off-fuzzy-isearch () - (interactive) - (setq isearch-search-fun-function fuzzy-isearch-original-search-fun) - (remove-hook 'isearch-mode-end-hook 'fuzzy-isearch-end-hook)) - -(defadvice isearch-message-prefix (after fuzzy-isearch-message-prefix activate) - (if fuzzy-isearch - (setq ad-return-value (concat fuzzy-isearch-prefix ad-return-value)) - ad-return-value)) - -(provide 'fuzzy) -;;; fuzzy.el ends here diff --git a/.emacs.d/fuzzy.elc b/.emacs.d/fuzzy.elc deleted file mode 100644 index aef35d9..0000000 Binary files a/.emacs.d/fuzzy.elc and /dev/null differ diff --git a/.emacs.d/ide-skel.el b/.emacs.d/ide-skel.el deleted file mode 100644 index eb70ec2..0000000 --- a/.emacs.d/ide-skel.el +++ /dev/null @@ -1,4016 +0,0 @@ -;; ide-skel.el --- IDE skeleton for Emacs Lisp hackers - -;; Copyright (C) 2008 Peter Karpiuk, Scott Tiger S.A. - -;; Author: Peter Karpiuk -;; Maintainer: Peter Karpiuk -;; Created: 24 Apr 2008 -;; Version 0.6.0 -;; Keywords: ide speedbar - -;; GNU Emacs 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. - -;; GNU Emacs 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, 675 Mass Ave, Cambridge, MA 02139, USA. - -;;; Commentary: - -;; Ide-skel is a skeleton (or framework) of IDE for Emacs users. -;; Like Eclipse, it can be used as is with some predefined plugins -;; on board, but is designed to extend by Emacs Lisp programmers to -;; suite their own needs. Emacs 22 only, tested under Linux only -;; (under Windows ide-skel.el will rather not work, sorry). -;; -;; ** Configuration in .emacs -;; -;; (require 'ide-skel) -;; -;; ;; optional, but useful - see Emacs Manual -;; (partial-completion-mode) -;; (icomplete-mode) -;; -;; ;; for convenience -;; (global-set-key [f4] 'ide-skel-proj-find-files-by-regexp) -;; (global-set-key [f5] 'ide-skel-proj-grep-files-by-regexp) -;; (global-set-key [f10] 'ide-skel-toggle-left-view-window) -;; (global-set-key [f11] 'ide-skel-toggle-bottom-view-window) -;; (global-set-key [f12] 'ide-skel-toggle-right-view-window) -;; (global-set-key [C-next] 'tabbar-backward) -;; (global-set-key [C-prior] 'tabbar-forward) -;; -;; ** Side view windows -;; -;; Left and right view windows are "speedbars" - they are embedded -;; inside main Emacs frame and can be open/closed independently. -;; Right view window summarizes information related to the current -;; editor buffer - it can present content of such buffer in another -;; way (eg. Imenu tree), or show an extra panel for buffer major -;; mode operations (see SQL*Plus mode plugin example). Left view -;; window contains buffers such like buffer list (yet another, -;; popular way for switching buffers), filesystem/project browser -;; for easy navigation, or Info documentation browser, -;; or... whatever you wish. -;; -;; Side view windows are special - they cannot take focus and we can -;; operate on it only with mouse (!). Some window operations like -;; delete-other-windows (C-x 1) are slighty modified to treat side -;; view windows specially. -;; -;; ** Bottom view window -;; -;; Let auxiliary buffers (*shell*, *Messages*, *Help*, *Compilation* -;; and another buffers with '*' in name) pop up/show in bottom -;; window only. BUT, if you want, you can open any buffer in any -;; window (except side windows) as usual - that's only nice -;; heuristic, not pressure. -;; -;; Bottom view window remembers last selected buffer within it, so -;; if you close this window and open later, it will show you buffer -;; which you expect. -;; -;; ** Tabbars -;; -;; Ide-skel uses (great) tabbar.el package with some modifications: -;; -;; - there is no division into major mode groups (like in -;; Eclipse), -;; -;; - side view windows, bottom view window and editor windows have -;; different tabsets, -;; -;; - you can scroll tabs with mouse wheel, -;; -;; - the Home button in window left corner acts as window menu -;; (you can add your items to it in your plugin), -;; -;; - mouse-3 click on tab kills its buffer -;; -;; * Project -;; -;; Here, "project" means a directory tree checked out from CVS or -;; SVN. One project can contain source files of many types. When -;; we edit any project file, Emacs can easily find the project root -;; directory simply by looking at filesystem. -;; -;; So, we can execute many commands (grep, find, replace) on all -;; project source files or on all project source files of the same -;; type as file edited now (see Project menu). Ide-skel package -;; also automatically configures partial-completion-mode for project -;; edited now. -;; -;; There is no configuration for concrete projects needed (and -;; that's great advantage in my opinion). - -;; If you find this package useful, send me a postcard to address: -;; -;; Peter Karpiuk -;; Scott Tiger S.A. -;; ul. Gawinskiego 8 -;; 01-645 Warsaw -;; Poland - - -;; * Notes for Emacs Lisp hackers -;; -;; Each side window buffer should have: -;; -;; - name that begins with space, -;; -;; - tab label (string) - buffer local IDE-SKEL-TABBAR-TAB-LABEL -;; variable, -;; -;; - keep condition function (IDE-SKEL-KEEP-CONDITION-FUNCTION), -;; -;; - menu (IDE-SKEL-TABBAR-MENU-FUNCTION) - optional. -;; -;; Side window buffer is enabled (can be choosed by mouse click on -;; his tab) if it has buffer local variable IDE-SKEL-TABBAR-ENABLED -;; set to non-nil. There may be many live side window buffers, but -;; unavailable in current context ("context" means buffer edited in -;; editor window) if they have IDE-SKEL-TABBAR-ENABLED set to nil. -;; -;; Hiding side window operation disables all window buffers. "Show -;; side window" event handler should enable (and maybe create) side -;; window buffers based on current context. When you switch to -;; other buffer in editor window (switching the context), all side -;; window buffers for which keep condition function returns nil are -;; disabled. Handlers for EDITOR-BUFFER-CHANGED event should enable -;; (and maybe create) additional buffers based on current context. -;; -;; ** Side window events -;; -;; Event handlers should be implemented as an abnormal hook: -;; -;; ide-skel-side-view-window-functions -;; -;; It should be function with parameters -;; -;; - side: symbol LEFT or RIGHT -;; -;; - event-type: symbol for event: -;; SHOW/EDITOR-BUFFER-CHANGED/TAB-CHANGE/HIDE -;; -;; - list (optional): event parameters specific for event type. -;; -;; Events are send only for opened (existing and visible) windows. -;; -;; Hook functions are called in order until one of them returns -;; non-nil. -;; -;; *** Show -;; -;; After side window open. Event handler should enable (and maybe -;; create) buffers appropriate for current context. After event -;; handle, if no side window buffer is selected, there will be -;; selected one of them. No parameters. -;; -;; *** Editor Buffer Changed -;; -;; After editor buffer changed (aka context switch). -;; -;; Before event, buffers for which keep condition function returns -;; nil, are disabled. Event handler should enable (and maybe -;; create) buffers appropriate for new context. -;; -;; Parameters: before-buffer current-buffer. -;; -;; *** Tab Change -;; -;; Before side window buffer change (as result of mouse click on tab -;; or ide-skel-side-window-switch-to-buffer function call). -;; Parameters: current-buffer new-buffer -;; -;; *** Hide -;; -;; Before side window hiding. After event handling, all side window -;; buffers are disabled. -;; -;; *** Functions & vars -;; -;; In plugins, you can use variables with self-descriptive names: -;; -;; ide-skel-selected-frame -;; ide-skel-current-editor-window -;; ide-skel-current-editor-buffer -;; ide-skel-current-left-view-window -;; ide-skel-current-right-view-window -;; -;; Moreover, when user selects another buffer to edit, the -;; -;; ide-skel-editor-buffer-changed-hook -;; -;; hook is run. It is similar to "editor buffer changed" event, but -;; has no parameters and is run even when all side windows are -;; closed. -;; -;; **** Functions -;; -;; ide-skel-side-window-switch-to-buffer (side-window buffer) -;; Switch buffer in side window (please use only this function for -;; this operation). -;; -;; ide-skel-get-side-view-buffer-create (name side-sym tab-label -;; help-string keep-condition-function) -;; Create new buffer for side view window. NAME should begin with -;; space, side sym should be LEFT or RIGHT. -;; -;; **** Local variables in side window buffers -;; -;; ide-skel-tabbar-tab-label -;; ide-skel-tabbar-tab-help-string -;; ide-skel-tabbar-menu-function -;; ide-skel-tabbar-enabled -;; ide-skel-keep-condition-function - -(require 'cl) -(require 'complete) -(require 'tree-widget) -(require 'tabbar) -(require 'recentf) - -(defgroup ide-skel nil - "Ide Skeleton" - :group 'tools - :version 21) - -(defcustom ide-skel-tabbar-hidden-buffer-names-regexp-list '("^TAGS" "^diary$") - "Buffer name that matches any of this regexps, will have no tab." - :group 'ide-skel - :tag "Hidden Buffer Names Regexp List" - :type '(repeat regexp) - :initialize 'custom-initialize-default - :set (lambda (symbol value) - (when tabbar-mode - (tabbar-init-tabsets-store)) - (set-default symbol value))) - -(defcustom ide-skel-bottom-view-buffer-names-regexps '("\\*.*\\*") - "Buffers with names matched by one of this regexps will be shown in bottom view." - :group 'ide-skel - :tag "Bottom View Buffer Names Regexps" - :type '(repeat regexp) - :initialize 'custom-initialize-default - :set (lambda (symbol value) - (when tabbar-mode - (tabbar-init-tabsets-store)) - (set-default symbol value)) - ) - -(defcustom ide-skel-bottom-view-buffer-names-disallowed-regexps '("\\*info\\*" "\\*Backtrace\\*") - "Buffers with names matched by one of this regexps will NOT be shown in bottom view." - :group 'ide-skel - :tag "Bottom View Buffer Names Disallowed Regexps" - :type '(repeat regexp) - :initialize 'custom-initialize-default - :set (lambda (symbol value) - (when tabbar-mode - (tabbar-init-tabsets-store)) - (set-default symbol value)) - ) - -(defconst ide-skel-left-view-window-tabset-name "LeftView") -(defconst ide-skel-right-view-window-tabset-name "RightView") -(defconst ide-skel-bottom-view-window-tabset-name "BottomView") -(defconst ide-skel-editor-window-tabset-name "Editor") - -(defun ide-skel-shine-color (color percent) - (when (equal color "unspecified-bg") - (setq color (if (< percent 0) "white" "black"))) - (apply 'format "#%02x%02x%02x" - (mapcar (lambda (value) - (min 65535 (max 0 (* (+ (/ value 650) percent) 650)))) - (color-values color)))) - -(defun ide-skel-color-percentage (color) - (truncate (* (/ (/ (reduce '+ (color-values color)) 3.0) 65535.0) 100.0))) - -(defun ide-skel-shine-face-background (face-sym percent) - (when (>= (ide-skel-color-percentage (face-background 'default)) 50) - (setq percent (- percent))) - (set-face-attribute face-sym nil - :background (ide-skel-shine-color (face-background 'default) percent))) - -(defun ide-skel-shine-face-foreground (face-sym percent) - (when (>= (ide-skel-color-percentage (face-foreground 'default)) 50) - (setq percent (- percent))) - (set-face-attribute face-sym nil - :foreground (ide-skel-shine-color (face-foreground 'default) percent))) - - -(defvar ide-skel-tabbar-tab-label-max-width 25 - "Max width for tab label. Nil means no limit. If label width is too big, it will be shortened with ... inside.") - -(defvar ide-skel-tabbar-tab-label nil - "Tab name. Local for buffer in side view window.") -(make-variable-buffer-local 'ide-skel-tabbar-tab-label) - -(defvar ide-skel-tabbar-tab-help-string nil - "Tooltip text for tab in side view window. Buffer local.") -(make-variable-buffer-local 'ide-skel-tabbar-tab-help-string) - -(defvar ide-skel-tabset-name nil) -(make-variable-buffer-local 'ide-skel-tabset-name) - -(defvar ide-skel-tabbar-menu-function nil) -(make-variable-buffer-local 'ide-skel-tabbar-menu-function) - -(defvar ide-skel-tabbar-enabled nil) -(make-variable-buffer-local 'ide-skel-tabbar-enabled) - -(defvar ide-skel-keep-condition-function nil) -(make-variable-buffer-local 'ide-skel-keep-condition-function) - -(defvar ide-skel-current-left-view-window nil) -(defvar ide-skel-current-right-view-window nil) -(defvar ide-skel-current-editor-window nil) -(defvar ide-skel-current-editor-buffer nil) -(defvar ide-skel-selected-frame nil) - -(defconst ide-skel-left-view-window-xpm "\ -/* XPM */ -static char * left_view_xpm[] = { -\"24 24 145 2\", -\" c None\", -\". c #000000\", -\"+ c #FBFED6\", -\"@ c #F3F6CE\", -\"# c #EBEEC7\", -\"$ c #E3E7BF\", -\"% c #DCE0B9\", -\"& c #D5D9B2\", -\"* c #FFFFFF\", -\"= c #FDFDFD\", -\"- c #F9F9F9\", -\"; c #F4F4F4\", -\"> c #DDDDDD\", -\", c #F2F5CD\", -\"' c #E4E8C0\", -\") c #DDE1BA\", -\"! c #D7DAB4\", -\"~ c #D1D4AE\", -\"{ c #FEFEFE\", -\"] c #FBFBFB\", -\"^ c #F8F8F8\", -\"/ c #F5F5F5\", -\"( c #F2F2F2\", -\"_ c #DBDBDB\", -\": c #E9EDC5\", -\"< c #D8DBB5\", -\"[ c #D2D5AF\", -\"} c #CDD0AA\", -\"| c #FCFCFC\", -\"1 c #F6F6F6\", -\"2 c #F3F3F3\", -\"3 c #F0F0F0\", -\"4 c #DADADA\", -\"5 c #E1E5BD\", -\"6 c #CDD0AB\", -\"7 c #C8CCA6\", -\"8 c #FAFAFA\", -\"9 c #F7F7F7\", -\"0 c #EFEFEF\", -\"a c #D9D9D9\", -\"b c #DADDB6\", -\"c c #C4C7A2\", -\"d c #EDEDED\", -\"e c #D7D7D7\", -\"f c #D3D6B0\", -\"g c #CFD3AD\", -\"h c #CBCFA9\", -\"i c #C8CBA6\", -\"j c #C0C39F\", -\"k c #F1F1F1\", -\"l c #EEEEEE\", -\"m c #ECECEC\", -\"n c #D6D6D6\", -\"o c #C9CDA7\", -\"p c #C6C9A4\", -\"q c #C3C6A1\", -\"r c #BFC39E\", -\"s c #BCBF9B\", -\"t c #EAEAEA\", -\"u c #D4D4D4\", -\"v c #C7CAA5\", -\"w c #C1C5A0\", -\"x c #BEC29D\", -\"y c #BBBF9B\", -\"z c #B9BC98\", -\"A c #EBEBEB\", -\"B c #E8E8E8\", -\"C c #D3D3D3\", -\"D c #C2C5A0\", -\"E c #BDC09C\", -\"F c #BABE99\", -\"G c #B8BB97\", -\"H c #B5B895\", -\"I c #E9E9E9\", -\"J c #E7E7E7\", -\"K c #D1D1D1\", -\"L c #BBBE9A\", -\"M c #B7BA96\", -\"N c #B4B794\", -\"O c #B2B592\", -\"P c #E5E5E5\", -\"Q c #D0D0D0\", -\"R c #B3B693\", -\"S c #B1B491\", -\"T c #AFB28F\", -\"U c #E3E3E3\", -\"V c #CECECE\", -\"W c #B4B793\", -\"X c #B0B390\", -\"Y c #AEB18F\", -\"Z c #ACAF8D\", -\"` c #E6E6E6\", -\" . c #E4E4E4\", -\".. c #E2E2E2\", -\"+. c #CDCDCD\", -\"@. c #ADB08E\", -\"#. c #ABAE8C\", -\"$. c #AAAD8B\", -\"%. c #E0E0E0\", -\"&. c #CBCBCB\", -\"*. c #A9AC8A\", -\"=. c #A7AA89\", -\"-. c #DEDEDE\", -\";. c #CACACA\", -\">. c #ABAE8B\", -\",. c #A8AB89\", -\"'. c #A6A988\", -\"). c #A5A887\", -\"!. c #C8C8C8\", -\"~. c #A7AA88\", -\"{. c #A6A987\", -\"]. c #A4A786\", -\"^. c #A3A685\", -\"/. c #DFDFDF\", -\"(. c #C7C7C7\", -\"_. c #A5A886\", -\":. c #A2A584\", -\"<. c #A1A483\", -\"[. c #C6C6C6\", -\"}. c #A4A785\", -\"|. c #A0A382\", -\"1. c #9FA282\", -\"2. c #D8D8D8\", -\"3. c #C4C4C4\", -\"4. c #A3A684\", -\"5. c #A2A484\", -\"6. c #A0A383\", -\"7. c #9EA181\", -\"8. c #9DA080\", -\"9. c #C3C3C3\", -\"0. c #8D8F72\", -\"a. c #8C8E72\", -\"b. c #8B8D71\", -\"c. c #8A8C70\", -\"d. c #898B6F\", -\"e. c #888A6F\", -\"f. c #C5C5C5\", -\"g. c #C2C2C2\", -\"h. c #C1C1C1\", -\"i. c #C0C0C0\", -\"j. c #BEBEBE\", -\"k. c #BDBDBD\", -\"l. c #BBBBBB\", -\"m. c #BABABA\", -\"n. c #ABABAB\", -\" \", -\" . . . . . . . . . . . . . . . . . . . . . . \", -\". + @ # $ % & . * * * * * * * * * * = - ; ; > . \", -\". , # ' ) ! ~ . * * * * * * * * * { ] ^ / ( _ . \", -\". : $ ) < [ } . * * * * * * * * * | - 1 2 3 4 . \", -\". 5 % ! [ 6 7 . * * * * * * * * = 8 9 ; 3 0 a . \", -\". b & ~ } 7 c . * * * * * * * { ] ^ / ( 0 d e . \", -\". f g h i c j . * * * * * * * | - 1 2 k l m n . \", -\". } o p q r s . * * * * * * = 8 9 ; 3 0 m t u . \", -\". v c w x y z . * * * * * = 8 9 / ( 0 d A B C . \", -\". D r E F G H . * * * * { ] ^ / 2 3 l A I J K . \", -\". E L z M N O . * * * { ] ^ 1 2 3 l m I J P Q . \", -\". z M H R S T . * * { ] ^ 1 2 k l m t B P U V . \", -\". H W O X Y Z . * = ] ^ 1 2 k 0 m t B ` ...+.. \", -\". O X T @.#.$.. = 8 ^ 1 2 k 0 m t B ` ...%.&.. \", -\". T @.Z $.*.=.. 8 9 / 2 k 0 m t B ` ...%.-.;.. \", -\". Z >.*.,.'.).. 9 / 2 3 l m t B ` ...%.-.> !.. \", -\". *.,.~.{.].^.. ; ( 3 l m t B ` ...%./.> _ (.. \", -\". ~.{._.^.:.<.. k 0 l m t B ` ...%./.> _ a [.. \", -\". _.}.:.<.|.1.. 0 d A I B ` ...%./.> _ a 2.3.. \", -\". 4.5.6.1.7.8.. m A I J P ...%.-.> _ a 2.n 9.. \", -\". 0.a.b.c.d.e.. +.&.;.!.(.f.3.g.h.i.j.k.l.m.n.. \", -\" . . . . . . . . . . . . . . . . . . . . . . \", -\" \"}; -" - "XPM format image used as left view window icon") - -(defconst ide-skel-left-view-window-image - (create-image ide-skel-left-view-window-xpm 'xpm t)) - -(defconst ide-skel-right-view-window-xpm "\ -/* XPM */ -static char * right_view_xpm[] = { -\"24 24 125 2\", -\" c None\", -\". c #000000\", -\"+ c #FFFFFF\", -\"@ c #A8AB89\", -\"# c #A6A987\", -\"$ c #A4A785\", -\"% c #A2A484\", -\"& c #A0A282\", -\"* c #919376\", -\"= c #A7AA88\", -\"- c #A5A886\", -\"; c #A2A584\", -\"> c #A0A383\", -\", c #9FA181\", -\"' c #909275\", -\") c #A3A685\", -\"! c #A1A483\", -\"~ c #9FA282\", -\"{ c #9DA080\", -\"] c #8F9174\", -\"^ c #A4A786\", -\"/ c #A0A382\", -\"( c #9EA181\", -\"_ c #9C9F7F\", -\": c #8E9073\", -\"< c #FEFEFE\", -\"[ c #9B9E7F\", -\"} c #8D8F73\", -\"| c #FCFCFC\", -\"1 c #A1A484\", -\"2 c #9EA180\", -\"3 c #9A9D7E\", -\"4 c #8C8E72\", -\"5 c #FDFDFD\", -\"6 c #FAFAFA\", -\"7 c #9B9E7E\", -\"8 c #999C7D\", -\"9 c #8B8D71\", -\"0 c #F7F7F7\", -\"a c #9FA281\", -\"b c #9A9C7D\", -\"c c #989B7C\", -\"d c #8A8C70\", -\"e c #FBFBFB\", -\"f c #F8F8F8\", -\"g c #F5F5F5\", -\"h c #9C9E7F\", -\"i c #9A9D7D\", -\"j c #979A7B\", -\"k c #898B70\", -\"l c #F6F6F6\", -\"m c #F3F3F3\", -\"n c #999C7C\", -\"o c #96997A\", -\"p c #888A6F\", -\"q c #F1F1F1\", -\"r c #9B9D7E\", -\"s c #989A7B\", -\"t c #959779\", -\"u c #87896E\", -\"v c #EFEFEF\", -\"w c #959879\", -\"x c #949678\", -\"y c #86886D\", -\"z c #ECECEC\", -\"A c #97997B\", -\"B c #949778\", -\"C c #939577\", -\"D c #85876C\", -\"E c #EAEAEA\", -\"F c #95987A\", -\"G c #919476\", -\"H c #84876C\", -\"I c #F9F9F9\", -\"J c #F0F0F0\", -\"K c #EEEEEE\", -\"L c #E8E8E8\", -\"M c #949779\", -\"N c #939578\", -\"O c #929476\", -\"P c #909375\", -\"Q c #83866B\", -\"R c #F4F4F4\", -\"S c #F2F2F2\", -\"T c #E6E6E6\", -\"U c #939678\", -\"V c #929477\", -\"W c #909376\", -\"X c #8F9275\", -\"Y c #82856A\", -\"Z c #E4E4E4\", -\"` c #8E9174\", -\" . c #818469\", -\".. c #EDEDED\", -\"+. c #EBEBEB\", -\"@. c #E9E9E9\", -\"#. c #E2E2E2\", -\"$. c #8D9073\", -\"%. c #808368\", -\"&. c #E7E7E7\", -\"*. c #E5E5E5\", -\"=. c #E0E0E0\", -\"-. c #8C8F72\", -\";. c #7F8268\", -\">. c #D6D6D6\", -\",. c #D5D5D5\", -\"'. c #D4D4D4\", -\"). c #D2D2D2\", -\"!. c #D1D1D1\", -\"~. c #D0D0D0\", -\"{. c #CECECE\", -\"]. c #CDCDCD\", -\"^. c #CBCBCB\", -\"/. c #CACACA\", -\"(. c #C8C8C8\", -\"_. c #C7C7C7\", -\":. c #C5C5C5\", -\"<. c #C4C4C4\", -\"[. c #C2C2C2\", -\"}. c #7D8066\", -\"|. c #7C7F65\", -\"1. c #7B7E64\", -\"2. c #7B7D64\", -\"3. c #7A7C63\", -\"4. c #70725B\", -\" \", -\" . . . . . . . . . . . . . . . . . . . . . . \", -\". + + + + + + + + + + + + + + + . @ # $ % & * . \", -\". + + + + + + + + + + + + + + + . = - ; > , ' . \", -\". + + + + + + + + + + + + + + + . # ) ! ~ { ] . \", -\". + + + + + + + + + + + + + + + . ^ ; / ( _ : . \", -\". + + + + + + + + + + + + + + < . ) ! ~ { [ } . \", -\". + + + + + + + + + + + + + + | . 1 & 2 _ 3 4 . \", -\". + + + + + + + + + + + + + 5 6 . > ( _ 7 8 9 . \", -\". + + + + + + + + + + + + 5 6 0 . a { 7 b c d . \", -\". + + + + + + + + + + + < e f g . { h i c j k . \", -\". + + + + + + + + + + < e f l m . _ 3 n j o p . \", -\". + + + + + + + + + < e f l m q . r 8 s o t u . \", -\". + + + + + + + + 5 e f l m q v . 8 c o w x y . \", -\". + + + + + + + 5 6 f l m q v z . c A w B C D . \", -\". + + + + + < | 6 0 g m q v z E . A F B C G H . \", -\". + + + + 5 e I 0 g m J K z E L . F M N O P Q . \", -\". + + < | 6 f l R S J K z E L T . M U V W X Y . \", -\". < 5 e I 0 g m q v K z E L T Z . U V * X ` .. \", -\". e I f l R S q v ..+.@.L T Z #.. V * X ` $.%.. \", -\". f l g m q J K z +.@.&.*.Z #.=.. W X ` $.-.;.. \", -\". >.,.'.).!.~.{.].^./.(._.:.<.[.. }.|.1.2.3.4.. \", -\" . . . . . . . . . . . . . . . . . . . . . . \", -\" \"}; -" - "XPM format image used as right view window icon") - -(defconst ide-skel-right-view-window-image - (create-image ide-skel-right-view-window-xpm 'xpm t)) - -(defconst ide-skel-bottom-view-window-xpm "\ -/* XPM */ -static char * bottom_view_xpm[] = { -\"24 24 130 2\", -\" c None\", -\". c #000000\", -\"+ c #FFFFFF\", -\"@ c #FDFDFD\", -\"# c #F9F9F9\", -\"$ c #F6F6F6\", -\"% c #F4F4F4\", -\"& c #DDDDDD\", -\"* c #FEFEFE\", -\"= c #FBFBFB\", -\"- c #F8F8F8\", -\"; c #F5F5F5\", -\"> c #F2F2F2\", -\", c #DBDBDB\", -\"' c #FCFCFC\", -\") c #F3F3F3\", -\"! c #F0F0F0\", -\"~ c #DADADA\", -\"{ c #FAFAFA\", -\"] c #F7F7F7\", -\"^ c #F1F1F1\", -\"/ c #EFEFEF\", -\"( c #D9D9D9\", -\"_ c #EDEDED\", -\": c #D7D7D7\", -\"< c #EEEEEE\", -\"[ c #ECECEC\", -\"} c #D6D6D6\", -\"| c #EAEAEA\", -\"1 c #D4D4D4\", -\"2 c #EBEBEB\", -\"3 c #E8E8E8\", -\"4 c #D3D3D3\", -\"5 c #E9E9E9\", -\"6 c #E7E7E7\", -\"7 c #D1D1D1\", -\"8 c #E5E5E5\", -\"9 c #D0D0D0\", -\"0 c #E3E3E3\", -\"a c #CECECE\", -\"b c #E6E6E6\", -\"c c #E4E4E4\", -\"d c #E2E2E2\", -\"e c #CDCDCD\", -\"f c #E0E0E0\", -\"g c #CBCBCB\", -\"h c #CCCFAB\", -\"i c #CACDAA\", -\"j c #C8CBA8\", -\"k c #C7CAA7\", -\"l c #C5C8A5\", -\"m c #C3C6A4\", -\"n c #C2C5A3\", -\"o c #C0C3A1\", -\"p c #BEC1A0\", -\"q c #BDBF9E\", -\"r c #BBBE9D\", -\"s c #B9BC9B\", -\"t c #B8BA9A\", -\"u c #B6B999\", -\"v c #B4B797\", -\"w c #B3B596\", -\"x c #B1B495\", -\"y c #B0B293\", -\"z c #AEB192\", -\"A c #ADAF91\", -\"B c #ABAE8F\", -\"C c #9C9E82\", -\"D c #C9CCA8\", -\"E c #C6C9A6\", -\"F c #C4C7A5\", -\"G c #C1C4A2\", -\"H c #BFC2A1\", -\"I c #BEC19F\", -\"J c #BCBF9E\", -\"K c #BABD9C\", -\"L c #B7BA9A\", -\"M c #B6B998\", -\"N c #ABAE90\", -\"O c #AAAD8E\", -\"P c #9A9D81\", -\"Q c #C2C4A2\", -\"R c #BFC1A0\", -\"S c #BDC09F\", -\"T c #BCBE9D\", -\"U c #B9BB9B\", -\"V c #B7BA99\", -\"W c #B6B898\", -\"X c #B1B494\", -\"Y c #A9AB8D\", -\"Z c #999C80\", -\"` c #C1C3A2\", -\" . c #BFC2A0\", -\".. c #B9BC9C\", -\"+. c #B8BB9A\", -\"@. c #B7B999\", -\"#. c #B5B898\", -\"$. c #B4B697\", -\"%. c #B2B596\", -\"&. c #AAAD8F\", -\"*. c #A7AA8C\", -\"=. c #989B80\", -\"-. c #BDC09E\", -\";. c #B3B696\", -\">. c #B2B595\", -\",. c #B1B394\", -\"'. c #AFB293\", -\"). c #A6A98B\", -\"!. c #97997F\", -\"~. c #A7A98C\", -\"{. c #A6A88B\", -\"]. c #A4A78A\", -\"^. c #A3A689\", -\"/. c #A2A588\", -\"(. c #A1A487\", -\"_. c #A0A286\", -\":. c #9FA185\", -\"<. c #9EA084\", -\"[. c #9D9F83\", -\"}. c #9B9E82\", -\"|. c #999B80\", -\"1. c #989A7F\", -\"2. c #97997E\", -\"3. c #96987D\", -\"4. c #95977D\", -\"5. c #94967C\", -\"6. c #92957B\", -\"7. c #91947A\", -\"8. c #909279\", -\"9. c #85876F\", -\" \", -\" . . . . . . . . . . . . . . . . . . . . . . \", -\". + + + + + + + + + + + + + + + + + @ # $ % & . \", -\". + + + + + + + + + + + + + + + + * = - ; > , . \", -\". + + + + + + + + + + + + + + + + ' # $ ) ! ~ . \", -\". + + + + + + + + + + + + + + + @ { ] % ^ / ( . \", -\". + + + + + + + + + + + + + + * = - ; > ! _ : . \", -\". + + + + + + + + + + + + + + ' # $ ) / < [ } . \", -\". + + + + + + + + + + + + + @ { ] % ^ < [ | 1 . \", -\". + + + + + + + + + + + + @ { ] ; > / _ 2 3 4 . \", -\". + + + + + + + + + + + * = - ; > ! < 2 5 6 7 . \", -\". + + + + + + + + + + * = - $ ) ! < [ 5 6 8 9 . \", -\". + + + + + + + + + * = - $ ) ^ < [ | 3 8 0 a . \", -\". + + + + + + + + @ = - $ ) ^ / [ | 3 b c d e . \", -\". + + + + + + + @ { - $ ) ^ / [ | 3 b c d f g . \", -\". . . . . . . . . . . . . . . . . . . . . . . . \", -\". h i j k l m n o p q r s t u v w x y z A B C . \", -\". D k E F n G H I J K s L M v w x y z A N O P . \", -\". E F m Q o R S T K U V W v w X y z A N O Y Z . \", -\". m n ` .I J r ..+.@.#.$.%.X y z A N &.Y *.=.. \", -\". G H p -.T K s t u #.;.>.,.'.z A N O Y *.).!.. \", -\". ~.{.].^./.(._.:.<.[.}.P |.1.2.3.4.5.6.7.8.9.. \", -\" . . . . . . . . . . . . . . . . . . . . . . \", -\" \"}; -" - "XPM format image used as bottom view window icon") - -(defconst ide-skel-bottom-view-window-image - (create-image ide-skel-bottom-view-window-xpm 'xpm t)) - -(defvar ide-skel-win--win2-switch t) - -(defvar ide-skel-win--minibuffer-selected-p nil) - -;; (copy-win-node w) -;; (win-node-corner-pos w) -;; (make-win-node :corner-pos 0 :buffer b :horiz-scroll 0 :point 0 :mark nil :divisions nil) -;; (win-node-p w) -(defstruct win-node - "Window configuration tree node." - (corner-pos nil) ; pair - original position of left top window corner - (buf-corner-pos 1) ; position within the buffer at the upper left of the window - buffer ; the buffer window displays - (horiz-scroll 0) ; amount of horizontal scrolling, in columns - (point 1) ; point - (mark nil) ; the mark - (edges nil) ; (window-edges) - (cursor-priority nil) - (fixed-size nil) - (divisions nil)) ; children (list of division) - -(defstruct division - "Podzial okienka" - win-node ; winnode for window after division - horizontal-p ; division horizontal or vertical - percent) ; 0.0-1.0: width/height of parent after division - -(defvar sel-window nil) -(defvar sel-priority nil) - -(defvar ide-skel-ommited-windows nil) - -(defvar ide-skel--fixed-size-windows nil) - -;; args: 'left/right 'show/editor-buffer-changed/hide/tab-change &rest buffer... -(defvar ide-skel-side-view-window-functions nil) - -(defvar ide-skel-editor-buffer-changed-hook nil) - -(defvar ide-skel-last-buffer-change-event nil) -(defvar ide-skel-last-selected-window-or-buffer nil) - -(defcustom ide-skel-bottom-view-window-size 0.35 - "Default bottom view window height in characters (int >= 5) or percent of Emacs frame height (0.0 - 1.0)" - :group 'ide-skel - :tag "Default Bottom View Window Height" - :type (list 'restricted-sexp - :match-alternatives (list (lambda (value) - (or (and (floatp value) - (> value 0.0) - (< value 1.0)) - (and (integerp value) - (>= value 5))))))) - -(defcustom ide-skel-bottom-view-on-left-view t - "Non-nil if bottom view lies partially on left view." - :group 'ide-skel - :tag "Bottom View on Left View" - :type '(boolean) - :initialize 'custom-initialize-default - :set (lambda (symbol value) - (let ((is-bottom-view-window (ide-skel-get-bottom-view-window))) - (when is-bottom-view-window - (ide-skel-hide-bottom-view-window)) - (unwind-protect - (set-default symbol value) - (when is-bottom-view-window - (ide-skel-show-bottom-view-window)))))) - -(defcustom ide-skel-bottom-view-on-right-view t - "Non-nil if bottom view lies partially on right view." - :group 'ide-skel - :tag "Bottom View on Right View" - :type '(boolean) - :initialize 'custom-initialize-default - :set (lambda (symbol value) - (let ((is-bottom-view-window (ide-skel-get-bottom-view-window))) - (when is-bottom-view-window - (ide-skel-hide-bottom-view-window)) - (unwind-protect - (set-default symbol value) - (when is-bottom-view-window - (ide-skel-show-bottom-view-window)))))) - -(defconst ide-skel-unexpected-bottom-view-window-buffer-names '("*Completions*" "*Compile-Log*")) - -(defvar ide-skel--last-bottom-view-buffer-name nil) - -(defvar ide-skel-was-scratch nil) - -(defvar ide-skel-bottom-view-window-oper-in-progress nil) - -(defvar ide-skel--current-side-windows (cons nil nil)) - -(defcustom ide-skel-left-view-window-width 25 - "Default width of left view window." - :group 'ide-skel - :tag "Default Left View Window Width" - :type '(integer) - :initialize 'custom-initialize-default - :set (lambda (symbol value) - (let ((is-left-view-window (ide-skel-get-left-view-window))) - (when is-left-view-window - (ide-skel-hide-left-view-window)) - (unwind-protect - (set-default symbol value) - (when is-left-view-window - (ide-skel-show-left-view-window)))))) - -(defcustom ide-skel-right-view-window-width 30 - "Default width of right view window." - :group 'ide-skel - :tag "Default Right View Window Width" - :type '(integer) - :initialize 'custom-initialize-default - :set (lambda (symbol value) - (let ((is-right-view-window (ide-skel-get-right-view-window))) - (when is-right-view-window - (ide-skel-hide-right-view-window)) - (unwind-protect - (set-default symbol value) - (when is-right-view-window - (ide-skel-show-right-view-window)))))) - -(defcustom ide-skel-side-view-display-cursor nil - "Non-nil if cursor should be displayed in side view windows" - :group 'ide-skel - :tag "Side View Display Cursor" - :type 'boolean) - -(defvar ide-skel-highlight-face 'ide-skel-highlight-face) -(defface ide-skel-highlight-face - (list - (list '((background light)) - (append (list :inherit 'variable-pitch :background (ide-skel-shine-color (face-background 'default) -70) :foreground (face-background 'default)) - (when (>= emacs-major-version 22) '(:box (:style released-button))))) - (list '((background dark)) - (append (list :inherit 'variable-pitch :background (ide-skel-shine-color (face-background 'default) +70) :foreground (face-background 'default)) - (when (>= emacs-major-version 22) '(:box (:style released-button))))) - '(t (:inherit default))) - "Face for selection in side views." - :group 'ide-skel) - -;;; buffer -> alist -;;; :imenu-buffer -;;; :default-left-tab-label, :default-right-tab-label -(defvar ide-skel-context-properties (make-hash-table :test 'eq)) - -(defvar ide-skel-last-left-view-window-tab-label nil) -(defvar ide-skel-last-right-view-window-tab-label nil) - -(defvar ide-skel-buffer-list-buffer nil) -(defvar ide-skel-buffer-list nil) - -(defvar ide-skel-buffer-list-tick nil) - -(defconst ide-skel-tree-widget-open-xpm "\ -/* XPM */ -static char *open[] = { -/* columns rows colors chars-per-pixel */ -\"11 15 49 1\", -\" c #4D084D080B7B\", -\". c #5A705A700DBB\", -\"X c #7B647B6404B5\", -\"o c #7818781810F1\", -\"O c #7E1E7E1E16D4\", -\"+ c #5EB75D2D6FCF\", -\"@ c #5FD85D2D6FCF\", -\"# c #60415D2D6FCF\", -\"$ c #88BD88BD068F\", -\"% c #8A5D8A5D0969\", -\"& c #82F782F71033\", -\"* c #841B841B1157\", -\"= c #87BC87BC1125\", -\"- c #878787871696\", -\"; c #87D587BE172E\", -\": c #87C187C11812\", -\"> c #895A895A1B9C\", -\", c #8A0A8A0A1C10\", -\"< c #8E5B8DF21DE7\", -\"1 c #95DF95DF1A5F\", -\"2 c #95CC95CC1B5B\", -\"3 c #98D498D41EE5\", -\"4 c #9BBB9BBB2414\", -\"5 c #9BBB9BBB2622\", -\"6 c #9CDF9CDF2696\", -\"7 c #984C984C281C\", -\"8 c #9EA19EA129C1\", -\"9 c #A060A0602B4B\", -\"0 c #A3BAA3BA3148\", -\"q c #A78AA78A36FD\", -\"w c #A7BBA7BB38D9\", -\"e c #A7B7A7B73B03\", -\"r c #AB1AAB1A3B03\", -\"t c #ABD7ABD73C6C\", -\"y c #AFC5AFC54435\", -\"u c #B5D2B5D24A67\", -\"i c #B659B6594AEE\", -\"p c #B959B9595378\", -\"a c #BBCEBBCE5267\", -\"s c #BE64BE645A53\", -\"d c #C2D2C2D26078\", -\"f c #C43BC43B60D8\", -\"g c #C42EC42E60EE\", -\"h c #C44FC44F60EC\", -\"j c #C73BC73B66E7\", -\"k c #C65DC65D697B\", -\"l c #CECECECE7676\", -\"z c #D02CD02C7B7B\", -\"x c None\", -/* pixels */ -\"xxxxxxxxxxx\", -\"xxxxxxxxxxx\", -\"xxxxxxxxxxx\", -\"xxxxxxxxxxx\", -\"x,> xxxxxxx\", -\"6zlpw07xxxx\", -\"5k32211=oxx\", -\"49ryuasfexx\", -\"$8yuasgdOxx\", -\"%qiashjtxxx\", -\"X&*<;-:.xxx\", -\"xxx@xxxxxxx\", -\"xxx#xxxxxxx\", -\"xxx+xxxxxxx\", -\"xxx+xxxxxxx\" -}; -") - -(defconst ide-skel-tree-widget-open-image - (create-image ide-skel-tree-widget-open-xpm 'xpm t)) - -(defconst ide-skel-tree-widget-no-handle-xpm "\ -/* XPM */ -static char *no_handle[] = { -/* columns rows colors chars-per-pixel */ -\"7 15 1 1\", -\" c None\", -/* pixels */ -\" \", -\" \", -\" \", -\" \", -\" \", -\" \", -\" \", -\" \", -\" \", -\" \", -\" \", -\" \", -\" \", -\" \", -\" \" -}; -") - -(defconst ide-skel-tree-widget-no-handle-image - (create-image ide-skel-tree-widget-no-handle-xpm 'xpm t)) - -(defconst ide-skel-tree-widget-no-guide-xpm "\ -/* XPM */ -static char *no_guide[] = { -/* columns rows colors chars-per-pixel */ -\"4 15 1 1\", -\" c None\", -/* pixels */ -\" \", -\" \", -\" \", -\" \", -\" \", -\" \", -\" \", -\" \", -\" \", -\" \", -\" \", -\" \", -\" \", -\" \", -\" \" -}; -") - -(defconst ide-skel-tree-widget-no-guide-image - (create-image ide-skel-tree-widget-no-guide-xpm 'xpm t)) - -(defconst ide-skel-tree-widget-leaf-xpm "\ -/* XPM */ -static char *leaf[] = { -/* columns rows colors chars-per-pixel */ -\"11 15 42 1\", -\" c #224222422242\", -\". c #254525452545\", -\"X c #272727272727\", -\"o c #31DA31DA31DA\", -\"O c #4CAC4CAC4CAC\", -\"+ c #4F064F064F06\", -\"@ c #506050605060\", -\"# c #511651165116\", -\"$ c #57D657D657D6\", -\"% c #59A559A559A5\", -\"& c #5AAC5AAC5AAC\", -\"* c #5D5A5D5A5D5A\", -\"= c #5F025F025F02\", -\"- c #60C660C660C6\", -\"; c #617D617D617D\", -\": c #63D363D363D3\", -\"> c #8B908B908B90\", -\", c #8E3C8E3C8E3C\", -\"< c #8F588F588F58\", -\"1 c #93FC93FC93FC\", -\"2 c #949194919491\", -\"3 c #96AD96AD96AD\", -\"4 c #991899189918\", -\"5 c #99EA99EA99EA\", -\"6 c #9B619B619B61\", -\"7 c #9CD69CD69CD6\", -\"8 c #9E769E769E76\", -\"9 c #9FA59FA59FA5\", -\"0 c #A0C3A0C3A0C3\", -\"q c #A293A293A293\", -\"w c #A32EA32EA32E\", -\"e c #A480A480A480\", -\"r c #A5A5A5A5A5A5\", -\"t c #A755A755A755\", -\"y c #AA39AA39AA39\", -\"u c #AC77AC77AC77\", -\"i c #B1B7B1B7B1B7\", -\"p c #B283B283B283\", -\"a c #B7B7B7B7B7B7\", -\"s c #BD02BD02BD02\", -\"d c gray74\", -\"f c None\", -/* pixels */ -\"fffffffffff\", -\"fffffffffff\", -\"fffffffffff\", -\"XXXXfffffff\", -\"%,25#offfff\", -\"*6qr$&.ffff\", -\"=1<3>wOffff\", -\";6648a@ffff\", -\";wweys#ffff\", -\":970ed#ffff\", -\"-tuipp+ffff\", -\"XXXXXX ffff\", -\"fffffffffff\", -\"fffffffffff\", -\"fffffffffff\" -}; -") - -(defconst ide-skel-tree-widget-leaf-image - (create-image ide-skel-tree-widget-leaf-xpm 'xpm t)) - -(defconst ide-skel-tree-widget-handle-xpm "\ -/* XPM */ -static char *handle[] = { -/* columns rows colors chars-per-pixel */ -\"7 15 2 1\", -\" c #56D752D36363\", -\". c None\", -/* pixels */ -\".......\", -\".......\", -\".......\", -\".......\", -\".......\", -\".......\", -\".......\", -\" \", -\".......\", -\".......\", -\".......\", -\".......\", -\".......\", -\".......\", -\".......\" -}; -") - -(defconst ide-skel-tree-widget-handle-image - (create-image ide-skel-tree-widget-handle-xpm 'xpm t)) - -(defconst ide-skel-tree-widget-guide-xpm "\ -/* XPM */ -static char *guide[] = { -/* columns rows colors chars-per-pixel */ -\"4 15 2 1\", -\" c #73C96E6E8484\", -\". c None\", -/* pixels */ -\"... \", -\"... \", -\"... \", -\"... \", -\"... \", -\"... \", -\"... \", -\"... \", -\"... \", -\"... \", -\"... \", -\"... \", -\"... \", -\"... \", -\"... \" -}; -") - -(defconst ide-skel-tree-widget-guide-image - (create-image ide-skel-tree-widget-guide-xpm 'xpm t)) - -(defconst ide-skel-tree-widget-end-guide-xpm "\ -/* XPM */ -static char *end_guide[] = { -/* columns rows colors chars-per-pixel */ -\"4 15 2 1\", -\" c #73C96E6E8484\", -\". c None\", -/* pixels */ -\"... \", -\"... \", -\"... \", -\"... \", -\"... \", -\"... \", -\"... \", -\"... \", -\"....\", -\"....\", -\"....\", -\"....\", -\"....\", -\"....\", -\"....\" -}; -") - -(defconst ide-skel-tree-widget-end-guide-image - (create-image ide-skel-tree-widget-end-guide-xpm 'xpm t)) - -(defconst ide-skel-tree-widget-empty-xpm "\ -/* XPM */ -static char *empty[] = { -/* columns rows colors chars-per-pixel */ -\"11 15 39 1\", -\" c #2BCF2BCF2BCF\", -\". c #31F831F831F8\", -\"X c #3F283F283F28\", -\"o c #41B141B141B1\", -\"O c #467946794679\", -\"+ c #476747674767\", -\"@ c #484648464846\", -\"# c #498749874987\", -\"$ c #4B684B684B68\", -\"% c #524F524F524F\", -\"& c #52D352D352D3\", -\"* c #554155415541\", -\"= c #561C561C561C\", -\"- c #598659865986\", -\"; c #5D775D775D77\", -\": c #5E7E5E7E5E7E\", -\"> c #60CE60CE60CE\", -\", c #615161516151\", -\"< c #61F361F361F3\", -\"1 c #642464246424\", -\"2 c #654865486548\", -\"3 c #678767876787\", -\"4 c #68D868D868D8\", -\"5 c #699569956995\", -\"6 c #6D556D556D55\", -\"7 c #6FB56FB56FB5\", -\"8 c #72CF72CF72CF\", -\"9 c #731073107310\", -\"0 c #757775777577\", -\"q c #7B747B747B74\", -\"w c #809080908090\", -\"e c #81F281F281F2\", -\"r c #820D820D820D\", -\"t c #84F984F984F9\", -\"y c #858285828582\", -\"u c #95E295E295E2\", -\"i c #9FFF9FFF9FFF\", -\"p c #A5A5A5A5A5A5\", -\"a c None\", -/* pixels */ -\"aaaaaaaaaaa\", -\"aaaaaaaaaaa\", -\"aaaaaaaaaaa\", -\"aaaaaaaaaaa\", -\"a&% aaaaaaa\", -\",piy76u-===*#oaa\", -\":14690qe3aa\", -\"+;680qewOaa\", -\"@290qrt5aaa\", -\"XO+@#$$.aaa\", -\"aaaaaaaaaaa\", -\"aaaaaaaaaaa\", -\"aaaaaaaaaaa\", -\"aaaaaaaaaaa\" -}; -") - -(defconst ide-skel-tree-widget-empty-image - (create-image ide-skel-tree-widget-empty-xpm 'xpm t)) - -(defconst ide-skel-tree-widget-close-xpm "\ -/* XPM */ -static char *close[] = { -/* columns rows colors chars-per-pixel */ -\"11 15 45 1\", -\" c #4EA14EA10DFA\", -\". c #5AA05AA00C52\", -\"X c #75297529068F\", -\"o c #7B647B6404B5\", -\"O c #8B888B880B91\", -\"+ c #8EDE8EDE0F5F\", -\"@ c #82F782F71033\", -\"# c #83A683A61157\", -\"$ c #84AD84AD13BC\", -\"% c #857985791489\", -\"& c #868086801590\", -\"* c #8A8A8A8A1697\", -\"= c #878787871812\", -\"- c #885388531936\", -\"; c #8BAB8BAB17B8\", -\": c #8CCC8CCC1A7D\", -\"> c #8DB68DB61BC4\", -\", c #90EC90EC11D0\", -\"< c #9161916114B5\", -\"1 c #92A292A2163F\", -\"2 c #8E8B8E8B2150\", -\"3 c #8F0F8F0F2274\", -\"4 c #9AF79AF72386\", -\"5 c #9D289D282655\", -\"6 c #9ED19ED1286E\", -\"7 c #9F599F592912\", -\"8 c #A31DA31D2D82\", -\"9 c #A3DDA3DD2DA2\", -\"0 c #A144A1442ED2\", -\"q c #A828A82833B4\", -\"w c #AB38AB383AEB\", -\"e c #AD21AD213DC2\", -\"r c #AD6DAD6D3E56\", -\"t c #AFFCAFFC4481\", -\"y c #B0AAB0AA429F\", -\"u c #B1B1B1B144E8\", -\"i c #B51DB51D4A5F\", -\"p c #B535B5354A8A\", -\"a c #B56FB56F4AEE\", -\"s c #B7B0B7B0525B\", -\"d c #BD14BD1459B1\", -\"f c #BFACBFAC5C55\", -\"g c #C5D9C5D965F7\", -\"h c #C85FC85F6D04\", -\"j c None\", -/* pixels */ -\"jjjjjjjjjjj\", -\"jjjjjjjjjjj\", -\"jjjjjjjjjjj\", -\"jjjjjjjjjjj\", -\"j32 jjjjjjj\", -\"1uy84570.jj\", -\"O69wtpsd*jj\", -\"+qrtpsdf;jj\", -\",etisdfg:jj\", -\"jj\", -\"o@#$%&=-Xjj\", -\"jjjjjjjjjjj\", -\"jjjjjjjjjjj\", -\"jjjjjjjjjjj\", -\"jjjjjjjjjjj\" -}; -") - -(defconst ide-skel-tree-widget-close-image - (create-image ide-skel-tree-widget-close-xpm 'xpm t)) - -(define-widget 'ide-skel-imenu-internal-node-widget 'tree-widget - "Internal node widget.") - -(define-widget 'ide-skel-imenu-leaf-widget 'push-button - "Leaf widget." - :format "%[%t%]\n" - :button-face 'variable-pitch - ) - -(defvar ide-skel-imenu-sorted nil) -(make-variable-buffer-local 'ide-skel-imenu-sorted) - -(defvar ide-skel-imenu-editor-buffer nil) -(make-variable-buffer-local 'ide-skel-imenu-editor-buffer) - -(defvar ide-skel-imenu-open-paths nil) -(make-variable-buffer-local 'ide-skel-imenu-open-paths) - -(defface imenu-side-view-face '((t :inherit variable-pitch :height 0.8)) - "Default face used in right view for imenu" - :group 'ide-skel) - -(define-widget 'ide-skel-info-tree-dir-widget 'tree-widget - "Directory Tree widget." - :expander 'ide-skel-info-tree-expand-dir - :notify 'ide-skel-info-open - :indent 0) - -(define-widget 'ide-skel-info-tree-file-widget 'push-button - "File widget." - :format "%[%t%]%d\n" - :button-face 'variable-pitch - :notify 'ide-skel-info-file-open) - -(defvar ide-skel-info-open-paths nil) -(make-variable-buffer-local 'ide-skel-info-open-paths) - -(defvar ide-skel-info-root-node nil) -(make-variable-buffer-local 'ide-skel-info-root-node) - -(defvar ide-skel-info-buffer nil) - -(define-widget 'ide-skel-dir-tree-dir-widget 'tree-widget - "Directory Tree widget." - :expander 'ide-skel-dir-tree-expand-dir - :notify 'ide-skel-dir-open - :indent 0) - -(define-widget 'ide-skel-dir-tree-file-widget 'push-button - "File widget." - :format "%[%t%]%d\n" - :button-face 'variable-pitch - :notify 'ide-skel-file-open) - -(defvar ide-skel-dir-open-paths nil) -(make-variable-buffer-local 'ide-skel-dir-open-paths) - -(defvar ide-skel-dir-root-dir "/") -(make-variable-buffer-local 'ide-skel-dir-root-dir) - -(defvar ide-skel-dir-buffer nil) - -(defconst ide-skel-cvs-dir-regexp "\\(\\.svn\\|CVS\\|\\.git\\)$") - -(defstruct ide-skel-project - root-path - include-file-path ; for PC-include-file-path variable -) - -(defvar ide-skel-projects nil) - -(defvar ide-skel-proj-find-results-buffer-name "*Proj find*") - -(defvar ide-skel-project-menu - '("Project" - :filter ide-skel-project-menu) - "Menu for CVS/SVN projects") - -(defvar ide-skel-proj-find-project-files-history nil) -(defvar ide-skel-proj-grep-project-files-history nil) - -(defvar ide-skel-proj-ignored-extensions '("semantic.cache")) - -(defvar ide-skel-all-text-files-flag nil) - -(defvar ide-skel-proj-grep-header nil) - -(defvar ide-skel-proj-old-compilation-exit-message-function nil) -(make-variable-buffer-local 'ide-skel-proj-old-compilation-exit-message-function) - -(defvar ide-skel-proj-grep-mode-map nil) - -(defvar ide-skel-proj-grep-replace-history nil) - -;;; - -(copy-face 'mode-line 'mode-line-inactive) - -(define-key tree-widget-button-keymap [drag-mouse-1] 'ignore) - -(defun ide-skel-tabbar-tab-label (tab) - "Return a label for TAB. -That is, a string used to represent it on the tab bar." - (let* ((object (tabbar-tab-value tab)) - (tabset (tabbar-tab-tabset tab)) - (label (format " %s " - (or (and (bufferp object) - (with-current-buffer object ide-skel-tabbar-tab-label)) ; local in buffer - object)))) - (when (and (not (memq tabset (list (tabbar-get-tabset ide-skel-left-view-window-tabset-name) - (tabbar-get-tabset ide-skel-right-view-window-tabset-name)))) - (numberp ide-skel-tabbar-tab-label-max-width) - (> ide-skel-tabbar-tab-label-max-width 0)) - (setq label (tabbar-shorten label ide-skel-tabbar-tab-label-max-width))) - label)) - -(defun ide-skel-tabbar-help-on-tab (tab) - "Return the help string shown when mouse is onto TAB." - (let ((tabset (tabbar-tab-tabset tab)) - (object (tabbar-tab-value tab))) - (or (when (bufferp object) - (with-current-buffer object - (or ide-skel-tabbar-tab-help-string ; local in buffer - (buffer-file-name)))) - "mouse-1: switch to buffer\nmouse-2: delete other windows\nmouse-3: kill buffer"))) - -(defun ide-skel-tabbar-buffer-groups () - "Return the list of group names the current buffer belongs to." - (if (and (ide-skel-side-view-buffer-p (current-buffer)) - (or (not ide-skel-tabbar-tab-label) - (not ide-skel-tabbar-enabled))) - nil - (let ((result (list (or ide-skel-tabset-name ; local in current buffer - (when (ide-skel-bottom-view-buffer-p (current-buffer)) ide-skel-bottom-view-window-tabset-name) - ide-skel-editor-window-tabset-name)))) - (dolist (window (copy-list (window-list nil 1))) - (when (eq (window-buffer window) (current-buffer)) - (let ((tabset-name (ide-skel-get-tabset-name-for-window window))) - (unless (member tabset-name result) - (push tabset-name result))))) - result))) - -(defun ide-skel-tabbar-buffer-tabs () - "Return the buffers to display on the tab bar, in a tab set." - ;; (message "ide-skel-tabbar-buffer-tabs %S" (current-buffer)) - (tabbar-buffer-update-groups) - (let* ((window (selected-window)) - (tabset (tabbar-get-tabset (ide-skel-get-tabset-name-for-window window)))) - (when (not (tabbar-get-tab (current-buffer) tabset)) - (tabbar-add-tab tabset (current-buffer) t)) - (tabbar-select-tab-value (current-buffer) tabset) - tabset)) - -(defun ide-skel-tabbar-buffer-list () - "Return the list of buffers to show in tabs. -The current buffer is always included." - (ide-skel-tabbar-faces-adapt) - (delq t - (mapcar #'(lambda (b) - (let ((buffer-name (buffer-name b))) - (cond - ((and (ide-skel-side-view-buffer-p b) - (with-current-buffer b - (or (not ide-skel-tabbar-tab-label) - (not ide-skel-tabbar-enabled)))) - t) - ;; Always include the current buffer. - ((eq (current-buffer) b) b) - ;; accept if buffer has tabset name - ((with-current-buffer b ide-skel-tabset-name) b) - ;; remove if matches any regexp from ide-skel-tabbar-hidden-buffer-names-regexp-list - ((not (null (some (lambda (regexp) - (string-match regexp buffer-name)) - ide-skel-tabbar-hidden-buffer-names-regexp-list))) - t) - ;; accept if buffer has filename - ((buffer-file-name b) b) - ;; remove if name starts with space - ((and (char-equal ?\ (aref (buffer-name b) 0)) - (not (ide-skel-side-view-buffer-p b))) - t) - ;; accept otherwise - (b)))) - (buffer-list (selected-frame))))) - -(defun ide-skel-get-tabset-name-for-window (window) - (cond ((eq (ide-skel-get-left-view-window) window) ide-skel-left-view-window-tabset-name) - ((eq (ide-skel-get-right-view-window) window) ide-skel-right-view-window-tabset-name) - ((eq (ide-skel-get-bottom-view-window) window) ide-skel-bottom-view-window-tabset-name) - (t ide-skel-editor-window-tabset-name))) - -(defun ide-skel-tabbar-select-tab (event tab) - "On mouse EVENT, select TAB." - (let* ((mouse-button (event-basic-type event)) - (buffer (tabbar-tab-value tab)) - (tabset-name (and (buffer-live-p buffer) - (with-current-buffer buffer ide-skel-tabset-name))) - (left-tabset (equal tabset-name ide-skel-left-view-window-tabset-name)) - (right-tabset (equal tabset-name ide-skel-right-view-window-tabset-name))) - (cond - ((eq mouse-button 'mouse-1) - (cond (left-tabset (ide-skel-side-window-switch-to-buffer ide-skel-current-left-view-window buffer)) - (right-tabset (ide-skel-side-window-switch-to-buffer ide-skel-current-right-view-window buffer)) - (t (switch-to-buffer buffer)))) - ((and (eq mouse-button 'mouse-2) - (not left-tabset) - (not right-tabset)) - (switch-to-buffer buffer) - (delete-other-windows)) - ((and (eq mouse-button 'mouse-3) - (not left-tabset) - (not right-tabset)) - (kill-buffer buffer))) - ;; Disable group mode. - (set 'tabbar-buffer-group-mode nil))) - -(defun ide-skel-tabbar-buffer-kill-buffer-hook () - "Hook run just before actually killing a buffer. -In Tabbar mode, try to switch to a buffer in the current tab bar, -after the current buffer has been killed. Try first the buffer in tab -after the current one, then the buffer in tab before. On success, put -the sibling buffer in front of the buffer list, so it will be selected -first." - (let ((buffer-to-kill (current-buffer))) - (save-selected-window - (save-current-buffer - ;; cannot kill buffer from any side view window - (when (and (eq header-line-format tabbar-header-line-format) - (not (ide-skel-side-view-buffer-p (current-buffer)))) - (dolist (window (copy-list (window-list nil 1))) - (when (eq buffer-to-kill (window-buffer window)) - (select-window window) - (let ((bl (tabbar-tab-values (funcall tabbar-current-tabset-function))) - found sibling) - (while (and bl (not found)) - (if (equal buffer-to-kill (car bl)) - (setq found t) - (setq sibling (car bl))) - (setq bl (cdr bl))) - (setq sibling (or sibling (car bl))) - (if (and sibling - (not (eq sibling buffer-to-kill)) - (buffer-live-p sibling)) - ;; Move sibling buffer in front of the buffer list. - (switch-to-buffer sibling) - (let ((next-buffer (ide-skel--find-buffer-for-bottom-view-window))) - (when (eq next-buffer buffer-to-kill) - (setq next-buffer (some (lambda (buf) - (if (or (eq buf buffer-to-kill) - (ide-skel-side-view-buffer-p buf) - (ide-skel-hidden-buffer-name-p (buffer-name buf))) - nil - buf)) - (buffer-list (selected-frame))))) - (when next-buffer - (switch-to-buffer next-buffer) - (tabbar-current-tabset t)))))))))))) - -(defun ide-skel-tabbar-inhibit-function () - "Inhibit display of the tab bar in specified windows, that is -in `checkdoc' status windows and in windows with its own header -line." - (let ((result (tabbar-default-inhibit-function)) - (sw (selected-window))) - (when (and result - (ide-skel-side-view-window-p sw)) - (setq result nil)) - (when (not (eq header-line-format tabbar-header-line-format)) - (setq result t)) - result)) - -(defun ide-skel-tabbar-home-function (event) - (let* ((window (posn-window (event-start event))) - (is-view-window (ide-skel-side-view-window-p window)) - (buffer (window-buffer window)) - extra-commands - (normal-window-counter 0)) - (dolist (win (copy-list (window-list nil 1))) - (unless (ide-skel-side-view-window-p win) - (incf normal-window-counter))) - (with-selected-window window - (when (and is-view-window - ide-skel-tabbar-menu-function) - (setq extra-commands (funcall ide-skel-tabbar-menu-function))) - (let ((close-p (when (or is-view-window - (> normal-window-counter 1)) - (list '(close "Close" t)))) - (maximize-p (when (and (not is-view-window) - (> normal-window-counter 1)) - (list '(maximize "Maximize" t))))) - (when (or close-p maximize-p) - (let ((user-selection - (car (x-popup-menu event (append (list 'keymap) close-p maximize-p extra-commands))))) - (cond ((eq user-selection 'close) - (call-interactively 'delete-window)) - ((eq user-selection 'maximize) - (delete-other-windows window)) - ((eq user-selection nil)) - (t - (funcall user-selection))))))))) - -(defun ide-skel-tabbar-mwheel-scroll-forward (event) - (interactive "@e") - (tabbar-press-scroll-left)) - -(defun ide-skel-tabbar-mwheel-scroll-backward (event) - (interactive "@e") - (tabbar-press-scroll-right)) - -(defun ide-skel-tabbar-mwheel-scroll (event) - "Select the next or previous group of tabs according to EVENT." - (interactive "@e") - (if (tabbar--mwheel-up-p event) - (ide-skel-tabbar-mwheel-scroll-forward event) - (ide-skel-tabbar-mwheel-scroll-backward event))) - -(defun ide-skel-tabbar-mwhell-mode-hook () - (setq tabbar-mwheel-mode-map - (let ((km (make-sparse-keymap))) - (if (get 'mouse-wheel 'event-symbol-elements) - ;; Use one generic mouse wheel event - (define-key km [A-mouse-wheel] - 'ide-skel-tabbar-mwheel-scroll) - ;; Use separate up/down mouse wheel events - (let ((up (tabbar--mwheel-key tabbar--mwheel-up-event)) - (down (tabbar--mwheel-key tabbar--mwheel-down-event))) - (define-key km `[header-line ,down] - 'ide-skel-tabbar-mwheel-scroll-backward) - (define-key km `[header-line ,up] - 'ide-skel-tabbar-mwheel-scroll-forward) - )) - km)) - (setcdr (assoc 'tabbar-mwheel-mode minor-mode-map-alist) tabbar-mwheel-mode-map)) - -(defun ide-skel-tabbar-mode-hook () - (setq tabbar-prefix-map - (let ((km (make-sparse-keymap))) - (define-key km [(control home)] 'tabbar-press-home) - (define-key km [(control left)] 'tabbar-backward) - (define-key km [(control right)] 'tabbar-forward) - (define-key km [(control prior)] 'tabbar-press-scroll-left) - (define-key km [(control next)] 'tabbar-press-scroll-right) - km)) - (setq tabbar-mode-map - (let ((km (make-sparse-keymap))) - (define-key km tabbar-prefix-key tabbar-prefix-map) - km)) - (setcdr (assoc 'tabbar-mode minor-mode-map-alist) tabbar-mode-map)) - -(defun ide-skel-tabbar-init-hook () - (setq tabbar-cycle-scope 'tabs - tabbar-auto-scroll-flag nil) - (setq - tabbar-tab-label-function 'ide-skel-tabbar-tab-label - tabbar-help-on-tab-function 'ide-skel-tabbar-help-on-tab - tabbar-buffer-groups-function 'ide-skel-tabbar-buffer-groups - tabbar-buffer-list-function 'ide-skel-tabbar-buffer-list - tabbar-current-tabset-function 'ide-skel-tabbar-buffer-tabs - tabbar-select-tab-function 'ide-skel-tabbar-select-tab - tabbar-inhibit-functions (append '(ide-skel-tabbar-inhibit-function) - (delq 'tabbar-default-inhibit-function tabbar-inhibit-functions)) - tabbar-home-function 'ide-skel-tabbar-home-function - tabbar-home-help-function (lambda () "Window menu")) - (add-hook 'kill-buffer-hook 'ide-skel-tabbar-buffer-kill-buffer-hook)) - -(defun ide-skel-tabbar-quit-hook () - (setq - tabbar-current-tabset-function nil - tabbar-tab-label-function nil - tabbar-select-tab-function nil - tabbar-help-on-tab-function nil - tabbar-home-function nil - tabbar-home-help-function nil - tabbar-buffer-groups-function nil - tabbar-buffer-list-function nil) - (remove-hook 'kill-buffer-hook 'ide-skel-tabbar-buffer-kill-buffer-hook)) - -(defun ide-skel-tabbar-load-hook () - (add-hook 'tabbar-mode-hook 'ide-skel-tabbar-mode-hook) - (add-hook 'tabbar-mwheel-mode-hook 'ide-skel-tabbar-mwhell-mode-hook) - (add-hook 'tabbar-init-hook 'ide-skel-tabbar-init-hook t) - (add-hook 'tabbar-quit-hook 'ide-skel-tabbar-quit-hook t) - (custom-set-faces - '(tabbar-default ((t (:inherit variable-pitch :background "gray82" :foreground "gray50" :height 0.8)))) - '(tabbar-selected ((t (:inherit tabbar-default :background "white" :foreground "blue" :box (:line-width 1 :color "black"))))) - '(tabbar-separator ((t (:inherit tabbar-default :height 0.2)))) - '(tabbar-highlight ((t ()))) - '(tabbar-button-highlight ((t (:inherit tabbar-button)))) - '(tabbar-unselected ((t (:inherit tabbar-default :background "gray72" :foreground "black" :box (:line-width 1 :color "black")))))) - (ide-skel-tabbar-faces-adapt)) - -(defun ide-skel-tabbar-faces-adapt () - (ide-skel-shine-face-background 'tabbar-default +18) - (set-face-attribute 'tabbar-selected nil :background (face-background 'default)) - (set-face-attribute 'tabbar-selected nil :foreground (face-foreground 'font-lock-function-name-face)) - (set-face-attribute 'tabbar-selected nil :box (list :line-width 1 :color (face-foreground 'default))) - (ide-skel-shine-face-background 'tabbar-unselected +30) - (set-face-attribute 'tabbar-unselected nil :foreground (face-foreground 'default)) - (set-face-attribute 'tabbar-unselected nil :box (list :line-width 1 :color (face-foreground 'default))) - (ide-skel-shine-face-background 'tabbar-button +18) - (ide-skel-shine-face-foreground 'tabbar-button +20)) - -(defun ide-skel-paradox-settings () - ;; hide scroll buttons - (setq tabbar-scroll-left-button (cons (cons "" nil) (cons "" nil)) - tabbar-scroll-right-button (cons (cons "" nil) (cons "" nil)))) - -(ide-skel-paradox-settings) - - -;;; Views - -(defun ide-skel-window-list () - (delq nil - (mapcar (lambda (win) - (unless (memq win ide-skel-ommited-windows) - win)) - (copy-list (window-list nil 1))))) - -(defun ide-skel-next-window (&optional window minibuf all-frames) - (let ((nw (next-window window minibuf all-frames))) - (if (memq nw ide-skel-ommited-windows) - (ide-skel-next-window nw minibuf all-frames) - nw))) - -(defun ide-skel-previous-window (window minibuf all-frames) - (let ((pw (previous-window window minibuf all-frames))) - (if (memq pw ide-skel-ommited-windows) - window - pw))) - -(defun ide-skel-win--absorb-win-node (dest-win-node src-win-node) - (dotimes (index (length src-win-node)) - (setf (elt dest-win-node index) - (elt src-win-node index)))) - -(defun ide-skel-win--create-win-node (object) - (cond ((win-node-p object) (copy-win-node object)) - ((windowp object) - (make-win-node :corner-pos (ide-skel-win-corner object) - :buf-corner-pos (window-start object) - :buffer (window-buffer object) - :horiz-scroll (window-hscroll object) - :point (window-point object) - :mark nil - :edges (window-edges object) - :fixed-size (cdr (assoc (ide-skel-win-corner object) ide-skel--fixed-size-windows)) - :divisions nil)) - (t (error "Argument is not win-not nor window: %S" object)))) - -(defun ide-skel-win--get-corner-pos (object) - (cond ((windowp object) (ide-skel-win-corner object)) - ((win-node-p object) (win-node-corner-pos object)) - ((consp object) object) - (t (error "Invalid arg: %S" object)))) - -(defun ide-skel-win--corner-pos-equal (win-node1 win-node2) - (let ((corner-pos1 (ide-skel-win--get-corner-pos win-node1)) - (corner-pos2 (ide-skel-win--get-corner-pos win-node2))) - (equal corner-pos1 corner-pos2))) - -(defun ide-skel-win--add-division (win-node division &optional at-end-p) - (setf (win-node-divisions win-node) - (if at-end-p - (reverse (cons division (reverse (win-node-divisions win-node)))) - (cons division (win-node-divisions win-node))))) - -(defun ide-skel-win--remove-division (win-node &optional from-end-p) - (let (result) - (if from-end-p - (let ((divs (reverse (win-node-divisions win-node)))) - (setq result (car divs)) - (setf (win-node-divisions win-node) - (reverse (cdr divs)))) - (setq result (car (win-node-divisions win-node))) - (setf (win-node-divisions win-node) (cdr (win-node-divisions win-node)))) - result)) - -(defun ide-skel-win--find-node (root predicate) - "Return node for which predicate returns non-nil." - (when root - (if (funcall predicate root) - root - (some (lambda (division) - (ide-skel-win--find-node (division-win-node division) predicate)) - (win-node-divisions root))))) - -(defun ide-skel-win--find-node-by-corner-pos (root corner-pos) - "Return struct for window with specified corner coordinates." - (setq corner-pos - (cond ((windowp corner-pos) (ide-skel-win-corner corner-pos)) - ((consp corner-pos) corner-pos) - (t (error "arg corner-pos %S is not a pair/window" corner-pos)))) - (ide-skel-win--find-node root - (lambda (win-node) - (equal corner-pos (win-node-corner-pos win-node))))) - -(defun ide-skel-win--get-window-list () - (let* ((start-win (selected-window)) - (cur-win (ide-skel-next-window start-win 1 1)) - (win-list (list start-win))) - (while (not (eq cur-win start-win)) - (setq win-list (cons cur-win win-list)) - (setq cur-win (ide-skel-next-window cur-win 1 1))) - (reverse win-list))) - -(defun ide-skel-win--analysis (&optional window-proc) - ;; (message "ide-skel-win--analysis BEGIN %S" (get-internal-run-time)) - (let ((window-size-fixed nil)) - (setq ide-skel--fixed-size-windows nil) - (dolist (window (copy-list (window-list nil 1))) - (with-selected-window window - (cond ((eq window-size-fixed 'width) - (push (cons (ide-skel-win-corner window) (cons (window-width window) nil)) ide-skel--fixed-size-windows)) - ((eq window-size-fixed 'height) - (push (cons (ide-skel-win-corner window) (cons nil (window-height window))) ide-skel--fixed-size-windows)) - ((not window-size-fixed) - nil) - (t - (push (cons (ide-skel-win-corner window) (cons (window-width window) (window-height window))) ide-skel--fixed-size-windows))))) - (dolist (window (ide-skel-window-list)) - (when (ide-skel-side-view-window-p window) (set-window-dedicated-p window nil))) - (setq ide-skel-win--minibuffer-selected-p (eq (selected-window) (minibuffer-window))) - (when ide-skel-win--minibuffer-selected-p - (select-window (ide-skel-get-editor-window))) - (when (memq (selected-window) ide-skel-ommited-windows) - (select-window (ide-skel-next-window (selected-window) 1 1))) - (let* (leaf-win - (counter 0) - (cursor-alist (mapcar (lambda (win) (prog1 (cons win counter) (incf counter))) (ide-skel-win--get-window-list))) - win-node-set) - (select-window (ide-skel-win-get-upper-left-window)) - (while (setq leaf-win (get-window-with-predicate - (lambda (win) - (if ide-skel-win--win2-switch (ide-skel-win--is-leaf2 win) (ide-skel-win--is-leaf win))) 1 1)) - (let* ((parent-win (ide-skel-previous-window leaf-win 1 1)) - (parent-node (car (member* (ide-skel-win-corner parent-win) win-node-set :test 'ide-skel-win--corner-pos-equal))) - (leaf-node (car (member* (ide-skel-win-corner leaf-win) win-node-set :test 'ide-skel-win--corner-pos-equal)))) - (unless leaf-node - (setq leaf-node (ide-skel-win--create-win-node leaf-win)) - (setf (win-node-cursor-priority leaf-node) (cdr (assq leaf-win cursor-alist))) - (setq win-node-set (adjoin leaf-node win-node-set :test 'ide-skel-win--corner-pos-equal))) - (unless parent-node - (setq parent-node (ide-skel-win--create-win-node parent-win)) - (setf (win-node-cursor-priority parent-node) (cdr (assq parent-win cursor-alist))) - (setq win-node-set (adjoin parent-node win-node-set :test 'ide-skel-win--corner-pos-equal))) - - (let* ((is-horizontal (ide-skel-win--is-adjacent parent-win 'right leaf-win)) - (size (if is-horizontal (window-width parent-win) (window-height parent-win))) - percent) - (setf (win-node-edges leaf-node) (window-edges leaf-win)) - (when window-proc (funcall window-proc parent-win)) - (when window-proc (funcall window-proc leaf-win)) - (delete-window leaf-win) - (when window-proc (funcall window-proc parent-win)) - (setq percent - (/ (float size) (if is-horizontal (window-width parent-win) (window-height parent-win)))) - (ide-skel-win--add-division parent-node - (make-division :win-node leaf-node - :horizontal-p is-horizontal - :percent percent))))) - ;; if there was only one window - (unless win-node-set - (when window-proc (funcall window-proc (selected-window))) - (let ((node (ide-skel-win--create-win-node (selected-window)))) - (setq win-node-set (adjoin node win-node-set - :test 'ide-skel-win--corner-pos-equal)))) - ;; return root node - (let ((root-node (car (member* (ide-skel-win-corner (selected-window)) - win-node-set - :test 'ide-skel-win--corner-pos-equal)))) - (setf (win-node-edges root-node) (window-edges (selected-window))) - ;; (message "ide-skel-win--analysis END %S" (get-internal-run-time)) - root-node)))) - -(defun ide-skel-win-get-upper-left-window () - "Return window in left upper corner" - (let (best-window) - (dolist (win (ide-skel-window-list)) - (if (null best-window) - (setq best-window win) - (let* ((best-window-coords (window-edges best-window)) - (best-window-weight (+ (car best-window-coords) (cadr best-window-coords))) - (win-coords (window-edges win)) - (win-weight (+ (car win-coords) (cadr win-coords)))) - (when (< win-weight best-window-weight) - (setq best-window win))))) - best-window)) - -(defun ide--is-right-window (window) - (let ((bounds (window-edges window)) - (result t)) - (dolist (win (ide-skel-window-list)) - (let ((left-edge-pos (car (window-edges win)))) - (when (>= left-edge-pos (nth 2 bounds)) - (setq result nil)))) - result)) - -(defun ide-skel-get-win-width-delta (window) - (if window-system - (let ((bounds (window-edges window))) - (+ (- (- (nth 2 bounds) (nth 0 bounds)) (window-width window)) - (if (and (not scroll-bar-mode) - (ide--is-right-window window)) - 1 - 0))) - 1)) - -(defun ide-skel-win--split (window horizontal-p percentage) - "Split window and return children." - (let* ((delta (ide-skel-get-win-width-delta window)) - (weight percentage) - (new-size (cond - ((integerp weight) (if (< weight 0) - (if horizontal-p - (+ (window-width window) weight) - (+ (window-height window) weight)) - (if horizontal-p (+ delta weight) weight))) - (t ; float - (when (< weight 0.0) - (setq weight (+ 1.0 weight))) - (if horizontal-p - (round (+ delta (* (window-width window) weight))) - (round (* (window-height window) weight))))))) - (split-window window new-size horizontal-p))) - -(defun ide-skel-win--process-win-node (win win-node &optional window-proc) - (let ((win2 win)) - (set-window-buffer win (win-node-buffer win-node)) - ; (set-window-start win (win-node-buf-corner-pos win-node)) - (set-window-hscroll win (win-node-horiz-scroll win-node)) - (set-window-point win (win-node-point win-node)) - (when window-proc (setq win (funcall window-proc win))) - (dolist (division (win-node-divisions win-node)) - (when (not (null (division-win-node division))) - (let ((child-window (ide-skel-win--split win (division-horizontal-p division) (division-percent division)))) - (when window-proc (setq win (funcall window-proc win))) - (ide-skel-win--process-win-node child-window (division-win-node division) window-proc)))) - (with-selected-window win2 - (let ((fixed-size (win-node-fixed-size win-node)) - (window-size-fixed nil)) - (when fixed-size - (when (car fixed-size) - (enlarge-window (- (car fixed-size) (window-width win2)) t)) - (when (cdr fixed-size) - (enlarge-window (- (cdr fixed-size) (window-height win2)) nil))))) - (when (win-node-cursor-priority win-node) - (unless sel-window - (setq sel-window win - sel-priority (win-node-cursor-priority win-node))) - (when (< (win-node-cursor-priority win-node) sel-priority) - (setq sel-window win - sel-priority (win-node-cursor-priority win-node)))))) - -(defun ide-skel-win--synthesis (window win-node &optional window-proc) - (let ((window-size-fixed nil) - sel-window - sel-priority) - (ide-skel-win--process-win-node window win-node window-proc) - (when sel-window - (select-window sel-window)) - (when ide-skel-win--minibuffer-selected-p - (select-window (minibuffer-window))) - (setq ide-skel-win--minibuffer-selected-p nil) - (dolist (window (ide-skel-window-list)) - (when (ide-skel-side-view-window-p window) (set-window-dedicated-p window t))))) - -(defun ide-skel-win--remove-child (win-node child-win-node) - (if (eq win-node child-win-node) - (let* ((division (ide-skel-win--remove-division win-node t)) - (divisions (win-node-divisions win-node))) - (when division - (ide-skel-win--absorb-win-node win-node (division-win-node division))) - (setf (win-node-divisions win-node) - (append divisions (win-node-divisions win-node)))) - (dolist (division (win-node-divisions win-node)) - (if (and (eq (division-win-node division) child-win-node) (null (win-node-divisions (division-win-node division)))) - (setf (division-win-node division) nil) - (ide-skel-win--remove-child (division-win-node division) child-win-node))))) - -(defun ide-skel-win-remove-window (window) - "Remove window with coordinates WINDOW." - (let* ((window-corner-pos (ide-skel-win-corner window)) - (root-win-node (ide-skel-win--analysis)) - (child-win-node (ide-skel-win--find-node-by-corner-pos root-win-node window-corner-pos))) - (ide-skel-win--remove-child root-win-node child-win-node) - (ide-skel-win--synthesis (selected-window) root-win-node))) - -(defun ide-skel-win-add-window (buffer parent-window-edges edge-symbol size) - "Split PARENT-WINDOW-EDGES window along specified edge. In new window with width/height SIZE -show buffer BUFFER. SIZE can be integer (character count) or float 0.0 - 1.0." - (when (windowp parent-window-edges) - (setq parent-window-edges (window-edges parent-window-edges))) - (let ((horizontal-p (or (eq edge-symbol 'left) (eq edge-symbol 'right))) - (replace-parent-p (or (eq edge-symbol 'top) (eq edge-symbol 'left))) - (percentage - (if (or (eq edge-symbol 'bottom) (eq edge-symbol 'right)) - (- size) - size))) - (ide-skel-win--add-window buffer parent-window-edges horizontal-p percentage replace-parent-p))) - -(defun ide-skel-win--add-window (buffer parent-window-edges horizontal-p percentage replace-parent-p) - (let* ((root-win-node (ide-skel-win--analysis)) - (new-win-node (make-win-node :buffer buffer))) - (ide-skel-win--synthesis (selected-window) root-win-node - (lambda (window) - (if (equal (window-edges window) parent-window-edges) - (let ((child-window (ide-skel-win--split window horizontal-p percentage))) - (set-window-buffer (if replace-parent-p window child-window) buffer) - (if replace-parent-p child-window window)) - window))))) - -(defun ide-skel-win--get-bounds (object) - (cond ((windowp object) (window-edges object)) - ((and (listp object) (= (length object) 4)) object) - (t (error "Invalid object param: %S" object)))) - -(defun ide-skel-win--win-area (window) - (let ((win-bounds (ide-skel-win--get-bounds window))) - (* (- (nth 2 win-bounds) (nth 0 win-bounds)) - (- (nth 3 win-bounds) (nth 1 win-bounds))))) - -(defun ide-skel-win--is-adjacent(window1 edge-symbol window2) - "Non-nil if WINDOW1 sticks to WINDOW2 along specified edge." - (let ((bounds1 (ide-skel-win--get-bounds window1)) - (bounds2 (ide-skel-win--get-bounds window2)) - result) - (if (or (equal edge-symbol 'top) (equal edge-symbol 'bottom)) - (setq result (and - (equal (nth 0 bounds1) (nth 0 bounds2)) ; bounds.LEFT = bounds2.LEFT - (equal (nth 2 bounds1) (nth 2 bounds2)))) ; bounds.RIGHT = bounds2.RIGHT - (setq result (and - (equal (nth 1 bounds1) (nth 1 bounds2)) ; bounds.TOP = bounds2.TOP - (equal (nth 3 bounds1) (nth 3 bounds2))))) ; bounds.BOTTOM = bounds2.BOTTOM - (when result - (setq result - (cond ((equal edge-symbol 'top) (equal (nth 1 bounds1) (nth 3 bounds2))) ; bounds.TOP = bounds2.BOTTOM - ((equal edge-symbol 'bottom) (equal (nth 3 bounds1) (nth 1 bounds2))) ; bounds.BOTTOM = bounds2.TOP - ((equal edge-symbol 'left) (equal (nth 0 bounds1) (nth 2 bounds2))) ; bounds.LEFT = bounds2.RIGHT - (t (equal (nth 2 bounds1) (nth 0 bounds2)))))) - result)) - -(defun ide-skel-win--is-leaf (&optional window) - "Non-nil if WINDOW is a leaf." - (unless window - (setq window (selected-window))) - ;; no window can stick from right or bottom - (when (and (not (get-window-with-predicate - (lambda (win) (ide-skel-win--is-adjacent window 'right win)) 1 1)) - (not (get-window-with-predicate - (lambda (win) (ide-skel-win--is-adjacent window 'bottom win)) 1 1))) - (let ((parent (ide-skel-previous-window window 1 1))) - ;; parent must exist and come from left or up - (when (and parent - (or (ide-skel-win--is-adjacent window 'top parent) - (ide-skel-win--is-adjacent window 'left parent))) - window)))) - -(defun ide-skel-win--is-leaf2 (&optional win2) - "Non-nil if WIN2 is leaf." - (unless win2 - (setq win2 (selected-window))) - ;; no window can stick from right or bottom - (when (and (not (get-window-with-predicate - (lambda (win) (ide-skel-win--is-adjacent win2 'right win)))) - (not (get-window-with-predicate - (lambda (win) (ide-skel-win--is-adjacent win2 'bottom win))))) - (let ((parent (ide-skel-previous-window win2 1 1))) - ;; parent must exist and come from left or up - (when (and parent - (or (ide-skel-win--is-adjacent win2 'top parent) - (ide-skel-win--is-adjacent win2 'left parent))) - win2)))) - -(defun ide-skel-win-corner (window) - (let ((coords (window-edges window))) - (cons (car coords) (cadr coords)))) - -(defun ide-skel-window-size-changed (frame) - (let* ((editor-window (ide-skel-get-editor-window)) - (left-view-window (car ide-skel--current-side-windows)) - (right-view-window (cdr ide-skel--current-side-windows)) - (bottom-view-window (ide-skel-get-bottom-view-window))) - (ide-skel-recalculate-view-cache) - (when bottom-view-window - (ide-skel-remember-bottom-view-window)) - (when left-view-window - (setq ide-skel-left-view-window-width (window-width left-view-window))) - (when right-view-window - (setq ide-skel-right-view-window-width (window-width right-view-window))))) - -(add-hook 'window-size-change-functions 'ide-skel-window-size-changed) - -(setq special-display-regexps ide-skel-bottom-view-buffer-names-regexps) - -(defun ide-skel-recalculate-view-cache () - (setq ide-skel-selected-frame (selected-frame) - ide-skel-current-editor-window (ide-skel-get-editor-window)) - (setq ide-skel-current-editor-buffer (window-buffer ide-skel-current-editor-window) - ide-skel-current-left-view-window (car ide-skel--current-side-windows) - ide-skel-current-right-view-window (cdr ide-skel--current-side-windows))) - -(defun ide-skel-get-last-selected-window () - (and ide-skel-last-selected-window-or-buffer - (or (and (window-live-p (car ide-skel-last-selected-window-or-buffer)) - (car ide-skel-last-selected-window-or-buffer)) - (and (buffer-live-p (cdr ide-skel-last-selected-window-or-buffer)) - (get-buffer-window (cdr ide-skel-last-selected-window-or-buffer)))))) - -(require 'mwheel) - -(defvar ide-skel-mouse-wheel-events (list mouse-wheel-up-event mouse-wheel-down-event)) - -(run-with-idle-timer 0 t (lambda () -;; (when ide-skel-current-left-view-window -;; (with-selected-window ide-skel-current-left-view-window -;; (beginning-of-line))) -;; (when ide-skel-current-right-view-window -;; (with-selected-window ide-skel-current-right-view-window -;; (beginning-of-line))) - (unless (or (active-minibuffer-window) - (memq 'down (event-modifiers last-input-event)) - (memq (event-basic-type last-input-event) ide-skel-mouse-wheel-events) - (mouse-movement-p last-input-event)) - ;; selected frame changed? - (unless (eq (selected-frame) ide-skel-selected-frame) - (ide-skel-recalculate-view-cache)) - ;; side view windows cannot have cursor - (while (memq (selected-window) (list ide-skel-current-left-view-window - ide-skel-current-right-view-window)) - (let ((win (ide-skel-get-last-selected-window))) - (if (and win (not (eq (selected-window) win))) - (select-window win) - (other-window 1)))) - (setq ide-skel-last-selected-window-or-buffer - (cons (selected-window) (window-buffer (selected-window)))) - ;; current buffer changed? - (let ((editor-buffer (window-buffer ide-skel-current-editor-window))) - (when (not (eq ide-skel-last-buffer-change-event editor-buffer)) - (ide-skel-send-event nil 'editor-buffer-changed ide-skel-last-buffer-change-event editor-buffer)))))) - -(setq special-display-function - (lambda (buffer &optional data) - (let ((bottom-view-window (ide-skel-get-bottom-view-window))) - (if (and bottom-view-window - (eq bottom-view-window (selected-window)) - (member (buffer-name buffer) ide-skel-unexpected-bottom-view-window-buffer-names)) - (progn - (show-buffer (ide-skel-get-editor-window) buffer) - (ide-skel-get-editor-window)) - (unless (ide-skel-get-bottom-view-window) - (ide-skel-show-bottom-view-window)) - (set-window-buffer (ide-skel-get-bottom-view-window) buffer) - ;; (select-window (ide-skel-get-bottom-view-window)) - (ide-skel-get-bottom-view-window))))) - -;;; Bottom view - -(defun ide-skel-hidden-buffer-name-p (buffer-name) - (equal (elt buffer-name 0) 32)) - -(defun ide-skel-bottom-view-buffer-p (buffer) - "Non-nil if buffer should be shown in bottom view." - (let ((name (buffer-name buffer))) - (or (with-current-buffer buffer - (and ide-skel-tabset-name - (string= ide-skel-tabset-name ide-skel-bottom-view-window-tabset-name))) - (and (not (ide-skel-hidden-buffer-name-p name)) - (some (lambda (regexp) (string-match regexp name)) ide-skel-bottom-view-buffer-names-regexps) - (not (some (lambda (regexp) (string-match regexp name)) ide-skel-bottom-view-buffer-names-disallowed-regexps)))))) - -(defun ide-skel-remember-bottom-view-window () - (let ((bottom-view-window (ide-skel-get-bottom-view-window))) - (when bottom-view-window - (setq ide-skel--last-bottom-view-buffer-name (buffer-name (window-buffer bottom-view-window)) - ide-skel-bottom-view-window-size (max 5 (window-height bottom-view-window)))))) - -(defun ide-skel--find-buffer-for-bottom-view-window () - "Returns first buffer to display in bottom view window (always returns a buffer)." - (let ((best-buffers (list (car (buffer-list (selected-frame)))))) - (some (lambda (buffer) - (when (ide-skel-bottom-view-buffer-p buffer) - (if (member (buffer-name buffer) ide-skel-unexpected-bottom-view-window-buffer-names) - (setq best-buffers (append best-buffers (list buffer))) - (setq best-buffers (cons buffer best-buffers))) - nil)) - (buffer-list (selected-frame))) - (if (and (not ide-skel-was-scratch) - (get-buffer "*scratch*")) - (progn - (setq ide-skel-was-scratch t) - (get-buffer "*scratch*")) - (car best-buffers)))) - -(defun ide-skel--is-full-width-window (window &rest except-windows) - (let ((bounds (window-edges window)) - (result t)) - (dolist (win (ide-skel-window-list)) - (unless (memq win except-windows) - (let ((left-edge-pos (car (window-edges win)))) - (when (or (< left-edge-pos (car bounds)) - (>= left-edge-pos (nth 2 bounds))) - (setq result nil))))) - result)) - -(defun ide-skel-get-bottom-view-window () - (let* ((editor-window (ide-skel-get-editor-window)) - best-window) - ;; get lowest window - (dolist (win (copy-list (window-list nil 1))) - (when (with-current-buffer (window-buffer win) - (and (or (not ide-skel-tabset-name) - (equal ide-skel-tabset-name ide-skel-bottom-view-window-tabset-name)) - (not (eq win editor-window)))) - (if (null best-window) - (setq best-window win) - (when (> (cadr (window-edges win)) (cadr (window-edges best-window))) - (setq best-window win))))) - (when (and best-window - (not (ide-skel--is-full-width-window best-window (ide-skel-get-left-view-window) (ide-skel-get-right-view-window)))) - (setq best-window nil)) - best-window)) - -(defun ide-skel-show-bottom-view-window (&optional buffer) - (interactive) - (unless ide-skel-bottom-view-window-oper-in-progress - (let ((saved-window (cons (selected-window) (window-buffer (selected-window))))) - (unwind-protect - (unless (ide-skel-get-bottom-view-window) ;; if not open yet - (setq ide-skel-bottom-view-window-oper-in-progress t) - (unless buffer - (setq buffer - (or (and ide-skel--last-bottom-view-buffer-name (get-buffer ide-skel--last-bottom-view-buffer-name)) - (ide-skel--find-buffer-for-bottom-view-window)))) - (let* ((left-view-window (ide-skel-get-left-view-window)) - (left-view-window-bounds (and left-view-window - (window-edges left-view-window))) - (right-view-window (ide-skel-get-right-view-window)) - (right-view-window-bounds (and right-view-window - (window-edges right-view-window))) - (root-win-node (ide-skel-win--analysis)) - (window-bounds (window-edges (selected-window)))) ; bounds of maximized window (after analysis) - (when (and left-view-window-bounds (not ide-skel-bottom-view-on-left-view)) - (setf (nth 0 window-bounds) (nth 2 left-view-window-bounds))) - (when (and right-view-window-bounds (not ide-skel-bottom-view-on-right-view)) - (setf (nth 2 window-bounds) (nth 0 right-view-window-bounds))) - (ide-skel-win--synthesis (selected-window) root-win-node) - (let ((ide-skel-win--win2-switch (and (not (null left-view-window)) - ide-skel-bottom-view-on-right-view)) - (old ide-skel-ommited-windows)) - (when (and (not ide-skel-bottom-view-on-left-view) - (not ide-skel-bottom-view-on-right-view) - (ide-skel-get-left-view-window)) - (push (ide-skel-get-left-view-window) ide-skel-ommited-windows)) - (ide-skel-win-add-window buffer window-bounds 'bottom ide-skel-bottom-view-window-size) - (setq ide-skel-ommited-windows old)))) - (if (window-live-p (car saved-window)) - (select-window (car saved-window)) - (when (get-buffer-window (cdr saved-window)) - (select-window (get-buffer-window (cdr saved-window))))) - (setq ide-skel-bottom-view-window-oper-in-progress nil))))) - -(defun ide-skel-hide-bottom-view-window () - (interactive) - (unless ide-skel-bottom-view-window-oper-in-progress - (setq ide-skel-bottom-view-window-oper-in-progress t) - (let ((bottom-view-window (ide-skel-get-bottom-view-window))) - (when bottom-view-window - (let ((ide-skel-win--win2-switch nil) - (select-editor (eq bottom-view-window (selected-window)))) - (ide-skel-remember-bottom-view-window) - (ide-skel-win-remove-window bottom-view-window) - (when select-editor (select-window (ide-skel-get-editor-window)))))) - (setq ide-skel-bottom-view-window-oper-in-progress nil))) - -(defun ide-skel-toggle-bottom-view-window () - "Toggle bottom view window." - (interactive) - (if (ide-skel-get-bottom-view-window) - (ide-skel-hide-bottom-view-window) - (ide-skel-show-bottom-view-window))) - -;;; Editor - -(defun ide-skel-get-editor-window () - (let (best-window) - (setq ide-skel--current-side-windows (cons nil nil)) - (dolist (win (copy-list (window-list nil 1))) - (when (with-current-buffer (window-buffer win) - (when (equal ide-skel-tabset-name ide-skel-left-view-window-tabset-name) - (setcar ide-skel--current-side-windows win)) - (when (equal ide-skel-tabset-name ide-skel-right-view-window-tabset-name) - (setcdr ide-skel--current-side-windows win)) - (or (not ide-skel-tabset-name) - (equal ide-skel-tabset-name ide-skel-editor-window-tabset-name))) - (if (null best-window) - (setq best-window win) - (let* ((best-window-coords (window-edges best-window)) - (win-coords (window-edges win))) - (when (or (< (cadr win-coords) (cadr best-window-coords)) - (and (= (cadr win-coords) (cadr best-window-coords)) - (< (car win-coords) (car best-window-coords)))) - (setq best-window win)))))) - best-window)) - -;;; Left view & Right view - -(defun ide-skel-toggle-side-view-window (name &optional run-hooks) - (if (funcall (intern (format "ide-skel-get-%s-view-window" name))) - (funcall (intern (format "ide-skel-hide-%s-view-window" name)) run-hooks) - (funcall (intern (format "ide-skel-show-%s-view-window" name)) run-hooks))) - -(defun ide-skel-toggle-left-view-window () - (interactive) - (ide-skel-toggle-side-view-window 'left (interactive-p))) - -(defun ide-skel-toggle-right-view-window () - (interactive) - (ide-skel-toggle-side-view-window 'right (interactive-p))) - - -(add-hook 'kill-buffer-hook (lambda () - (when (eq ide-skel-current-editor-buffer (current-buffer)) - (let* ((context (gethash ide-skel-current-editor-buffer ide-skel-context-properties)) - (imenu-buffer (cdr (assq :imenu-buffer context))) - (imenu-window (when imenu-buffer (get-buffer-window imenu-buffer)))) - (when imenu-window - (set-window-dedicated-p imenu-window nil) - (set-window-buffer imenu-window ide-skel-default-right-view-buffer) - (set-window-dedicated-p imenu-window t)) - (remhash (current-buffer) ide-skel-context-properties) - (when imenu-buffer - (kill-buffer imenu-buffer)))))) - -(defun ide-skel-send-event (side-symbol event-type &rest params) - (ide-skel-recalculate-view-cache) - (cond ((eq event-type 'hide) - (run-hook-with-args-until-success 'ide-skel-side-view-window-functions side-symbol 'hide) - (ide-skel-disable-nonactual-side-view-tabs side-symbol 'disable-all)) - ((eq event-type 'show) - (run-hook-with-args-until-success 'ide-skel-side-view-window-functions side-symbol 'show) - (ide-skel-side-window-switch-to-buffer (symbol-value (intern (format "ide-skel-current-%s-view-window" side-symbol))) nil)) - ((eq event-type 'editor-buffer-changed) - (run-hooks 'ide-skel-editor-buffer-changed-hook) - (when ide-skel-current-left-view-window - (ide-skel-disable-nonactual-side-view-tabs 'left) - (run-hook-with-args-until-success 'ide-skel-side-view-window-functions - 'left 'editor-buffer-changed - ide-skel-last-buffer-change-event ide-skel-current-editor-buffer) - (ide-skel-side-window-switch-to-buffer ide-skel-current-left-view-window nil)) - (when ide-skel-current-right-view-window - (ide-skel-disable-nonactual-side-view-tabs 'right) - (run-hook-with-args-until-success 'ide-skel-side-view-window-functions - 'right 'editor-buffer-changed - (car params) (cadr params)) - (ide-skel-side-window-switch-to-buffer ide-skel-current-right-view-window nil)) - (setq ide-skel-last-buffer-change-event ide-skel-current-editor-buffer)) - ((eq event-type 'tab-change) - (run-hook-with-args-until-success 'ide-skel-side-view-window-functions side-symbol 'tab-change (car params) (cadr params))))) - -(defun ide-skel-hide-side-view-window (name &optional run-hooks) - (let* ((view-window (funcall (intern (format "ide-skel-get-%s-view-window" name)))) - (select-editor (eq view-window (selected-window)))) - (when view-window - (when (active-minibuffer-window) - (error "Cannot remove side window while minibuffer is active")) - (let* ((bottom-view-window (ide-skel-get-bottom-view-window)) - (selected-bottom-view-window (and bottom-view-window (eq bottom-view-window (selected-window)))) - (buffer (window-buffer view-window)) - (second-side-window (funcall (intern (format "ide-skel-get-%s-view-window" (if (eq name 'left) 'right 'left)))))) - (set (intern (format "ide-skel-last-%s-view-buffer" name)) buffer) - (when run-hooks - (ide-skel-send-event name 'hide)) - (when bottom-view-window - (ide-skel-hide-bottom-view-window)) - (when second-side-window - (push second-side-window ide-skel-ommited-windows)) - (let ((ide-skel-win--win2-switch (eq name 'left))) - (set (intern (format "ide-skel-%s-view-window-width" name)) (window-width view-window)) - (ide-skel-win-remove-window view-window)) - (setq ide-skel-ommited-windows nil) - (when bottom-view-window - (ide-skel-show-bottom-view-window) - (when selected-bottom-view-window - (select-window (ide-skel-get-bottom-view-window)))) - (ide-skel-recalculate-view-cache) - (when select-editor (select-window (ide-skel-get-editor-window))))))) - -(defun ide-skel-hide-left-view-window (&optional run-hooks) - (interactive) - (let ((right-view-window (ide-skel-get-right-view-window))) - (when right-view-window - (ide-skel-hide-right-view-window)) - (ide-skel-hide-side-view-window 'left (or run-hooks (interactive-p))) - (when right-view-window - (ide-skel-show-right-view-window)))) - -(defun ide-skel-hide-right-view-window (&optional run-hooks) - (interactive) - (ide-skel-hide-side-view-window 'right (or (interactive-p) run-hooks))) - -(defun ide-skel-get-side-view-buffer-create (name side-sym tab-label help-string keep-condition-function) - (let* ((was-buffer (get-buffer name)) - (km (make-sparse-keymap)) - (buffer (get-buffer-create name))) - (unless was-buffer - (with-current-buffer buffer - (kill-all-local-variables) - (remove-overlays) - (define-key km [drag-mouse-1] 'ignore) - (use-local-map km) - (make-local-variable 'mouse-wheel-scroll-amount) - (make-local-variable 'auto-hscroll-mode) - (make-local-variable 'hscroll-step) - (make-local-variable 'hscroll-margin) - (setq ide-skel-tabset-name (if (eq side-sym 'left) ide-skel-left-view-window-tabset-name ide-skel-right-view-window-tabset-name) - ide-skel-tabbar-tab-label tab-label - ide-skel-tabbar-tab-help-string help-string - ide-skel-keep-condition-function keep-condition-function - auto-hscroll-mode nil - hscroll-step 0.0 - hscroll-margin 0 -;; left-fringe-width 0 -;; right-fringe-width 0 - buffer-read-only t - mode-line-format " " - mouse-wheel-scroll-amount '(1) - window-size-fixed 'width) - ;; (make-variable-buffer-local 'fringe-indicator-alist) - (setq fringe-indicator-alist (copy-alist default-fringe-indicator-alist)) -;; (when (>= emacs-major-version 22) -;; (set 'indicate-buffer-boundaries '((up . left) (down . left)))) - (setcdr (assq 'truncation fringe-indicator-alist) nil) - (set (make-local-variable 'scroll-conservatively) 1500) ; much greater than 0 - (when (and window-system - (not ide-skel-side-view-display-cursor)) - (setq cursor-type nil)))) - buffer)) - -(defvar ide-skel-default-left-view-buffer - (let ((buffer (ide-skel-get-side-view-buffer-create " Default Left View Buffer" 'left nil nil (lambda (buf) t)))) - (with-current-buffer buffer - (setq header-line-format " ")) - buffer)) -(defvar ide-skel-last-left-view-buffer ide-skel-default-left-view-buffer) -(defvar ide-skel-default-right-view-buffer - (let ((buffer (ide-skel-get-side-view-buffer-create " Default Right View Buffer" 'right nil nil (lambda (buf) t)))) - (with-current-buffer buffer - (setq header-line-format " ")) - buffer)) -(defvar ide-skel-last-right-view-buffer ide-skel-default-right-view-buffer) - -(defun ide-skel-show-side-view-window (name &optional run-hooks) - (unless (funcall (intern (format "ide-skel-get-%s-view-window" name))) - (let* ((current-buffer (window-buffer (selected-window))) - (bottom-view-window (ide-skel-get-bottom-view-window)) - root-win-node - (bottom-view-window-bounds (and (or (symbol-value (intern (format "ide-skel-bottom-view-on-%s-view" name))) - (and ide-skel-bottom-view-on-left-view - (not ide-skel-bottom-view-on-right-view))) - bottom-view-window - (window-edges bottom-view-window))) - best-window-bounds) - (when bottom-view-window-bounds - (ide-skel-hide-bottom-view-window)) - (let ((second-side-window (funcall (intern (format "ide-skel-get-%s-view-window" (if (eq name 'left) 'right 'left)))))) - (when second-side-window - (push second-side-window ide-skel-ommited-windows)) - (setq root-win-node (ide-skel-win--analysis)) - (setq best-window-bounds (window-edges (selected-window))) ; bounds of maximized window (after analysis) - (ide-skel-win--synthesis (selected-window) root-win-node) - (ide-skel-win-add-window - (symbol-value (intern (format (if run-hooks "ide-skel-default-%s-view-buffer" "ide-skel-last-%s-view-buffer") name))) - best-window-bounds name - (symbol-value (intern (format "ide-skel-%s-view-window-width" name)))) - (setq ide-skel-ommited-windows nil) - (when bottom-view-window-bounds - (ide-skel-show-bottom-view-window)) - (set-window-dedicated-p (funcall (intern (format "ide-skel-get-%s-view-window" name))) t) - (when run-hooks - (dolist (tab (tabbar-tabs (tabbar-get-tabset (symbol-value (intern (format "ide-skel-%s-view-window-tabset-name" name)))))) - (tabbar-delete-tab tab)) - (ide-skel-send-event name 'show)) - (some (lambda (win) (when (eq (window-buffer win) current-buffer) (select-window win) t)) (copy-list (window-list nil 1))))))) - -;; Disables from view all buffers for which keep condition function -;; returns nil. If a current buffer is there, select another enabled, -;; which implies tab-change event, then select any enabled buffer. -(defun ide-skel-disable-nonactual-side-view-tabs (name &optional disable-all) - (let* ((tabset (tabbar-get-tabset (symbol-value (intern (format "ide-skel-%s-view-window-tabset-name" name))))) - (tabs (tabbar-tabs tabset)) - (editor-buffer (window-buffer (ide-skel-get-editor-window))) - selected-deleted - (selected-tab (tabbar-selected-tab tabset))) - (when tabs - (dolist (tab tabs) - (let ((buffer (tabbar-tab-value tab))) - (with-current-buffer buffer - (when (or disable-all - (not ide-skel-keep-condition-function) - (not (funcall ide-skel-keep-condition-function editor-buffer))) - (setq ide-skel-tabbar-enabled nil) - (when (eq tab selected-tab) - (setq selected-deleted t)) - (tabbar-delete-tab tab))))) - (let ((selected-buffer (when (and (not selected-deleted) - (tabbar-tabs tabset) (tabbar-selected-value tabset))))) - (when (and (not disable-all) - (or selected-deleted - (not (eq (tabbar-selected-tab tabset) selected-tab)))) - (unless selected-buffer - (setq selected-buffer (symbol-value (intern (format "ide-skel-default-%s-view-buffer" name))))) - (ide-skel-side-window-switch-to-buffer - (symbol-value (intern (format "ide-skel-current-%s-view-window" name))) - selected-buffer)))))) - -(defun ide-skel-show-left-view-window (&optional run-hooks) - (interactive) - (let ((right-view-window (ide-skel-get-right-view-window))) - (when right-view-window - (ide-skel-hide-right-view-window)) - (ide-skel-show-side-view-window 'left (or run-hooks (interactive-p))) - (when right-view-window - (ide-skel-show-right-view-window)))) - -(defun ide-skel-show-right-view-window (&optional run-hooks) - (interactive) - (ide-skel-show-side-view-window 'right (or run-hooks (interactive-p)))) - -(defun ide-skel-get-side-view-window (name) - (let ((tabset-name (symbol-value (intern (format "ide-skel-%s-view-window-tabset-name" name))))) - (some (lambda (win) - (when (with-current-buffer (window-buffer win) - (equal ide-skel-tabset-name tabset-name)) - win)) - (copy-list (window-list nil 1))))) - -(defun ide-skel-get-left-view-window () - (ide-skel-get-side-view-window 'left)) - -(defun ide-skel-get-right-view-window () - (ide-skel-get-side-view-window 'right)) - -(defun ide-skel-get-side-view-windows () - (let (result - (left-view-win (ide-skel-get-left-view-window)) - (right-view-win (ide-skel-get-right-view-window))) - (when left-view-win (push left-view-win result)) - (when right-view-win (push right-view-win result)) - result)) - -(defun ide-skel-side-view-window-p (window) - (ide-skel-side-view-buffer-p (window-buffer window))) - -(defun ide-skel-side-view-buffer-p (buffer) - (with-current-buffer buffer - (or (equal ide-skel-tabset-name ide-skel-left-view-window-tabset-name) - (equal ide-skel-tabset-name ide-skel-right-view-window-tabset-name)))) - -(defadvice delete-window (around delete-window-around-advice (&optional window)) - (let* ((target-window (if window window (selected-window))) - (editor-window (and (interactive-p) (ide-skel-get-editor-window))) ; for ide-skel--current-side-windows (side-effects) - (hide-view-windows (and (interactive-p) - (not (eq (car ide-skel--current-side-windows) target-window)) - (not (eq (cdr ide-skel--current-side-windows) target-window)))) - (hide-left-view-window (and hide-view-windows (car ide-skel--current-side-windows))) - (hide-right-view-window (and hide-view-windows (cdr ide-skel--current-side-windows))) - result) - (when (interactive-p) - (if (eq (car ide-skel--current-side-windows) target-window) - (ide-skel-send-event 'left 'hide) - (when (eq (cdr ide-skel--current-side-windows) target-window) - (ide-skel-send-event 'right 'hide)))) - (let* ((edges (window-inside-edges window)) - (buf (window-buffer window)) - win - (center-position (cons (/ (+ (car edges) (caddr edges)) 2) - (/ (+ (cadr edges) (cadddr edges)) 2)))) - (when hide-left-view-window (ide-skel-hide-left-view-window)) - (when hide-right-view-window (ide-skel-hide-right-view-window)) - (setq win (window-at (car center-position) (cdr center-position))) - (when (eq (window-buffer win) buf) - (setq window (window-at (car center-position) (cdr center-position))))) - (unwind-protect - (setq result (progn ad-do-it)) - (when hide-left-view-window (ide-skel-show-left-view-window)) - (when hide-right-view-window (ide-skel-show-right-view-window))) - result)) -(ad-activate 'delete-window) - -(defadvice delete-other-windows (around delete-other-windows-around-advice (&optional window)) - (ide-skel-assert-not-in-side-view-window) - (let* ((editor-window (ide-skel-get-editor-window)) - (dont-revert-after (and (interactive-p) (listp current-prefix-arg) (car current-prefix-arg))) ; C-u - (hide-left-view-window (and (interactive-p) (car ide-skel--current-side-windows))) - (hide-right-view-window (and (interactive-p) (cdr ide-skel--current-side-windows))) - result) - (when hide-left-view-window (ide-skel-hide-left-view-window dont-revert-after)) - (when hide-right-view-window (ide-skel-hide-right-view-window dont-revert-after)) - (unwind-protect - (setq result (progn ad-do-it)) - (when (not dont-revert-after) - (when hide-left-view-window - (ide-skel-show-left-view-window)) - (when hide-right-view-window - (ide-skel-show-right-view-window)))) - result)) -(ad-activate 'delete-other-windows) - -(defun ide-skel-assert-not-in-side-view-window () - (when (and (interactive-p) (ide-skel-side-view-window-p (selected-window))) - (error "Cannot do it"))) - -(defadvice kill-buffer (before kill-buffer-before-advice (buffer)) - (ide-skel-assert-not-in-side-view-window)) -(ad-activate 'kill-buffer) - -(defadvice split-window-vertically (before split-window-vertically-before-advice (&optional size)) - (ide-skel-assert-not-in-side-view-window)) -(ad-activate 'split-window-vertically) - -(defadvice split-window-horizontally (before split-window-horizontally-before-advice (&optional size)) - (ide-skel-assert-not-in-side-view-window)) -(ad-activate 'split-window-horizontally) - -(defadvice mouse-drag-vertical-line (around mouse-drag-vertical-line-around-advice (start-event)) - (let* ((editor-window (ide-skel-get-editor-window)) - (left-view-window (car ide-skel--current-side-windows)) - (right-view-window (cdr ide-skel--current-side-windows))) - (when left-view-window (with-selected-window left-view-window (setq window-size-fixed nil))) - (when right-view-window (with-selected-window right-view-window (setq window-size-fixed nil))) - (unwind-protect - (progn ad-do-it) - (when left-view-window (with-selected-window left-view-window (setq window-size-fixed 'width))) - (when right-view-window (with-selected-window right-view-window (setq window-size-fixed 'width)))))) -(ad-activate 'mouse-drag-vertical-line) - -(defadvice other-window (after other-window-after-advice (arg &optional all-frames)) - (if (memq (selected-window) (list ide-skel-current-left-view-window ide-skel-current-right-view-window)) - (other-window arg all-frames) - ad-return-value)) -(ad-activate 'other-window) - -;; Buffer list buffer (left side view) - -(define-derived-mode fundmental-mode - fundamental-mode "Fundmental") - -(setq default-major-mode 'fundmental-mode) - -(defun ide-skel-recentf-closed-files-list () - "Lista ostatnio otwieranych, ale aktualnie zamknietych plikow" - (let* ((open-file-paths (delq nil (mapcar (lambda (buffer) (buffer-file-name buffer)) (buffer-list))))) - (if (featurep 'recentf) - (sort (reverse (set-difference recentf-list open-file-paths :test 'string=)) - (lambda (path1 path2) - (string< (file-name-nondirectory path1) (file-name-nondirectory path2)))) - nil))) - -(defun ide-skel-select-buffer (buffer-or-path &optional line-no) - (let* ((window (ide-skel-get-last-selected-window)) - (buffer (or (and (bufferp buffer-or-path) buffer-or-path) - (find-file-noselect buffer-or-path))) - (is-bottom-view-buffer (ide-skel-bottom-view-buffer-p buffer))) - (when (not (buffer-live-p buffer)) - (error "Buffer %s is dead" buffer)) - (unless (get-buffer-window buffer) - ;; (message "%S %S" window (ide-skel-get-bottom-view-window)) - (if (and window - (not (eq window (ide-skel-get-bottom-view-window))) - (not is-bottom-view-buffer)) - (set-window-buffer window buffer) - (let ((editor-window (ide-skel-get-editor-window))) - (select-window editor-window) - (if is-bottom-view-buffer - (switch-to-buffer-other-window buffer) - (set-window-buffer editor-window buffer))))) - (setq ide-skel-last-selected-window-or-buffer (cons (get-buffer-window buffer) buffer)) - (select-window (car ide-skel-last-selected-window-or-buffer)) - (when line-no - (with-current-buffer buffer - (goto-line line-no))))) - -(defun ide-skel-select-buffer-handler (event) - (interactive "@e") - ;; (message "EVENT: %S" event) - (with-selected-window (posn-window (event-start event)) - (let* ((object (get-text-property (posn-point (event-start event)) 'object-to-display))) - (beginning-of-line) - (ide-skel-select-buffer object)))) - -(defun ide-skel-buffers-view-insert-buffer-list (label buffer-list) - (setq label (propertize label 'face 'bold)) - (insert (format "%s\n" label)) - (dolist (object buffer-list) - (let* ((label (format " % -100s" (if (bufferp object) (buffer-name object) (file-name-nondirectory object)))) - (km (make-sparse-keymap))) - (define-key km [mouse-1] 'ide-skel-select-buffer-handler) - (setq label (propertize label - 'mouse-face 'ide-skel-highlight-face - 'local-map km - 'face 'variable-pitch - 'pointer 'hand - 'object-to-display object - 'help-echo (if (bufferp object) (buffer-file-name object) object))) - (insert label) - (insert "\n")))) - -(defun ide-skel-buffers-view-fill () - (when ide-skel-current-left-view-window - (with-current-buffer ide-skel-buffer-list-buffer - (let ((point (point)) - (window-start (when (eq (window-buffer ide-skel-current-left-view-window) ide-skel-buffer-list-buffer) - (save-excursion - (goto-char (window-start ide-skel-current-left-view-window)) - (cons (line-number-at-pos) (current-column)))))) - ;; (message "%S" window-start) - (let (asterisk-buffers - (inhibit-read-only t) - normal-buffers) - (erase-buffer) - (dolist (buffer (sort (buffer-list) (lambda (buf1 buf2) (string< (buffer-name buf1) (buffer-name buf2))))) - (let* ((name (buffer-name buffer)) - (first-char (aref (buffer-name buffer) 0))) - (unless (char-equal ?\ first-char) - (if (char-equal ?* first-char) - (push buffer asterisk-buffers) - (push buffer normal-buffers))))) - (ide-skel-buffers-view-insert-buffer-list "Normal Buffers:" normal-buffers) - (ide-skel-buffers-view-insert-buffer-list "Scratch Buffers:" asterisk-buffers) - (ide-skel-buffers-view-insert-buffer-list "Recent Files:" (ide-skel-recentf-closed-files-list))) - (if window-start - (let ((pos (save-excursion - (goto-line (car window-start)) - (beginning-of-line) - (forward-char (cdr window-start)) - (point)))) - (set-window-start ide-skel-current-left-view-window pos)) - (goto-char point) - (beginning-of-line)))))) - -(defun ide-skel-some-view-window-buffer (side-symbol predicate) - (some (lambda (buffer) - (and (buffer-live-p buffer) - (with-current-buffer buffer - (and (equal ide-skel-tabset-name (symbol-value (intern (format "ide-skel-%s-view-window-tabset-name" side-symbol)))) - ide-skel-tabbar-enabled - (funcall predicate buffer) - buffer)))) - (buffer-list))) - -(defun ide-skel-side-window-switch-to-buffer (side-window buffer) - "If BUFFER is nil, then select any non-default buffer. The -TAB-CHANGE event is send only if selected buffer changed." - (unwind-protect - (let* ((side-symbol (cond ((eq side-window ide-skel-current-left-view-window) 'left) - ((eq side-window ide-skel-current-right-view-window) 'right) - (t nil))) - (context (gethash ide-skel-current-editor-buffer ide-skel-context-properties)) - (context-default-tab-label-symbol (intern (format "default-%s-tab-label" side-symbol)))) - (when side-symbol - (unless buffer - (let* ((default-empty-buffer (symbol-value (intern (format "ide-skel-default-%s-view-buffer" side-symbol)))) - (context-default-tab-label (cdr (assq context-default-tab-label-symbol context))) - (last-view-window-tab-label (symbol-value (intern (format "ide-skel-last-%s-view-window-tab-label" side-symbol))))) - ;; first non-nil: - ;; - selected before in this context - ;; - selected in previous context - ;; - current if other than default-empty - ;; - first non default-empty - ;; - default-empty - (setq buffer - (or (and context-default-tab-label - (ide-skel-some-view-window-buffer side-symbol (lambda (buffer) - (equal ide-skel-tabbar-tab-label context-default-tab-label)))) - (and last-view-window-tab-label - (ide-skel-some-view-window-buffer side-symbol (lambda (buffer) - (equal ide-skel-tabbar-tab-label last-view-window-tab-label)))) - (and (not (eq (window-buffer side-window) default-empty-buffer)) - (window-buffer side-window)) - (ide-skel-some-view-window-buffer side-symbol (lambda (buffer) ide-skel-tabbar-tab-label)) - default-empty-buffer)))) - (unless (eq (window-buffer side-window) buffer) - (set (intern (format "ide-skel-last-%s-view-window-tab-label" side-symbol)) (with-current-buffer buffer ide-skel-tabbar-tab-label)) - (setq context (assq-delete-all context-default-tab-label-symbol context)) - (puthash ide-skel-current-editor-buffer - (cons (cons context-default-tab-label-symbol (with-current-buffer buffer ide-skel-tabbar-tab-label)) context) - ide-skel-context-properties) - (ide-skel-send-event side-symbol 'tab-change (window-buffer side-window) buffer))) - (set-window-dedicated-p side-window nil) - (set-window-buffer side-window buffer)) - (set-window-dedicated-p side-window t))) - -;; args: 'left/right 'show/editor-buffer-changed/hide/tab-change &rest buffer... -(defun ide-skel-default-side-view-window-function (side event &rest list) - ;; (message "SIDE: %S, event: %S, rest: %S %S" side event list ide-skel-current-left-view-window) - (when (and (eq side 'left) ide-skel-current-left-view-window) - (cond ((eq event 'show) - (unless ide-skel-buffer-list-buffer - (setq ide-skel-buffer-list-buffer (ide-skel-get-side-view-buffer-create - " Ide-Skel Buffer List Buffer" 'left "Bufs" "List of opened and recent files" - (lambda (buf) t))) - (with-current-buffer ide-skel-buffer-list-buffer - (setq ide-skel-tabbar-enabled t))) - (ide-skel-buffers-view-fill) - (ide-skel-side-window-switch-to-buffer ide-skel-current-left-view-window ide-skel-buffer-list-buffer)))) - nil) - - ;; (message "SIDE: %S, event: %S, rest: %S" side event list) - -(add-hook 'change-major-mode-hook (lambda () (setq ide-skel-buffer-list-tick t))) -(add-hook 'kill-buffer-hook (lambda () (setq ide-skel-buffer-list-tick t))) -(run-with-idle-timer 0.1 t (lambda () - (when ide-skel-buffer-list-tick - (setq ide-skel-buffer-list-tick nil) - (ide-skel-buffers-view-fill)))) - -(add-hook 'ide-skel-side-view-window-functions 'ide-skel-default-side-view-window-function) - -(define-key-after global-map [tool-bar ide-skel-toggle-left-view-window] - (list 'menu-item "Left View Window" 'ide-skel-toggle-left-view-window :image ide-skel-left-view-window-image)) -(define-key-after global-map [tool-bar ide-skel-toggle-bottom-view-window] - (list 'menu-item "Bottom View Window" 'ide-skel-toggle-bottom-view-window :image ide-skel-bottom-view-window-image)) -(define-key-after global-map [tool-bar ide-skel-toggle-right-view-window] - (list 'menu-item "Right View Window" 'ide-skel-toggle-right-view-window :image ide-skel-right-view-window-image)) - -(eval-after-load "tabbar" '(ide-skel-tabbar-load-hook)) - -;;; Tree Widget - -(defadvice tree-widget-lookup-image (around tree-widget-lookup-image-around-advice (name)) - (if (equal (tree-widget-theme-name) "small-folder") - (setq ad-return-value (apply 'create-image (symbol-value (intern (format "ide-skel-tree-widget-%s-xpm" name))) 'xpm t (tree-widget-image-properties name))) - ad-do-it)) -(ad-activate 'tree-widget-lookup-image) - - - -;;; Imenu - -(require 'imenu) - -(defun ide-skel-imenu-refresh () - (interactive) - (ide-skel-imenu-side-view-draw-tree (window-buffer ide-skel-current-right-view-window) t)) - -(defun ide-skel-imenu-sort-change () - (interactive) - (with-current-buffer (window-buffer ide-skel-current-right-view-window) - (setq ide-skel-imenu-sorted (not ide-skel-imenu-sorted))) - (ide-skel-imenu-side-view-draw-tree (window-buffer ide-skel-current-right-view-window) t)) - -(defun ide-skel-imenu-get-buffer-create (editor-buffer &optional dont-create) - (let* ((context (gethash editor-buffer ide-skel-context-properties)) - (buffer (cdr (assq :imenu-buffer context)))) - (when (and (not buffer) (not dont-create)) - (setq buffer (ide-skel-get-side-view-buffer-create (concat " " (buffer-name editor-buffer) " Ide Skel Imenu") - 'right "Imenu" nil - (lambda (editor-buffer) - (eq ide-skel-imenu-editor-buffer ide-skel-current-editor-buffer)))) - (with-current-buffer buffer - (setq ide-skel-tabbar-menu-function - (lambda () - (let ((is-outline-mode (with-current-buffer (window-buffer ide-skel-current-right-view-window) - (with-current-buffer ide-skel-imenu-editor-buffer - (or (eq major-mode 'outline-mode) - (and (boundp 'outline-minor-mode) - (symbol-value 'outline-minor-mode))))))) - (append - (list - (list 'ide-skel-imenu-refresh "Refresh" t) - (unless is-outline-mode - (list 'ide-skel-imenu-sort-change (if (with-current-buffer (window-buffer ide-skel-current-right-view-window) - ide-skel-imenu-sorted) - "Natural order" - "Sorted order") t)))))) - ide-skel-imenu-editor-buffer editor-buffer - ide-skel-imenu-open-paths (make-hash-table :test 'equal)) - (add-hook 'tree-widget-after-toggle-functions (lambda (widget) - (let ((path (widget-get widget :path))) - (when path - (if (widget-get widget :open) - (puthash path t ide-skel-imenu-open-paths) - (remhash path ide-skel-imenu-open-paths))))) - nil t)) - (puthash editor-buffer (cons (cons :imenu-buffer buffer) context) ide-skel-context-properties)) - buffer)) - -(defun ide-skel-tree-node-notify (widget &rest rest) - (let ((index-name (widget-get widget :index-name)) - (index-position (widget-get widget :index-position)) - (function (widget-get widget :function)) - (arguments (widget-get widget :arguments))) - (select-window (ide-skel-get-editor-window)) - (if function - (apply function index-name index-position arguments) - (goto-char index-position)))) - -;; building hash -(defun ide-skel-imenu-analyze (hash prefix element) - (when element - (if (and (consp (cdr element)) - (listp (cadr element))) - (dolist (elem (cdr element)) - (ide-skel-imenu-analyze hash (concat prefix "/" (car element)) elem)) - (puthash (concat prefix "/" (car element)) (list (cons :element element)) hash)))) - -;; logical linking, internal nodes creation -(defun ide-skel-imenu-analyze2 (hash prefix element) - (when element - (if (and (consp (cdr element)) - (listp (cadr element))) - (dolist (elem (cdr element)) - (ide-skel-imenu-analyze2 hash (concat prefix "/" (car element)) elem)) - (let* ((index-name (car element)) - (path (concat prefix "/" index-name)) - (node (gethash path hash)) - (reverse-separators (let ((index 0) - result) - (while (string-match "[*#:.]+" index-name index) - (push (cons (match-beginning 0) (match-end 0)) result) - (setq index (match-end 0))) - result)) - found) - (some (lambda (separator-pair) - (let* ((begin (car separator-pair)) - (end (cdr separator-pair)) - (before-name (substring index-name 0 begin)) - (after-name (substring index-name end)) - (parent-path (concat prefix "/" before-name)) - (parent-node (gethash parent-path hash))) - (when parent-node - (push (cons :parent parent-path) node) - (unless (assq :name node) - (push (cons :name after-name) node)) - (puthash path node hash) - (unless (assq :widget parent-node) - (let* ((parent-element (cdr (assq :element parent-node))) - (parent-index-name (car parent-element)) - (parent-index-position (if (consp (cdr parent-element)) (cadr parent-element) (cdr parent-element))) - (parent-function (when (consp (cdr parent-element)) (caddr parent-element))) - (open-status (gethash parent-path ide-skel-imenu-open-paths)) - (parent-arguments (when (consp (cdr parent-element)) (cdddr parent-element)))) - (push (cons :widget - ;; internal node - (list 'ide-skel-imenu-internal-node-widget - :open open-status - :indent 0 - :path parent-path - :notify 'ide-skel-tree-node-notify - :index-name parent-index-name - :index-position parent-index-position - :function parent-function - :arguments parent-arguments - :node (list 'push-button - :format "%[%t%]\n" - :button-face 'variable-pitch - :tag (or (cdr (assq :name parent-node)) - before-name) - ;; :tag (cadr (assq :element parent-node)) - ))) - parent-node) - (puthash parent-path parent-node hash))) - t))) - reverse-separators))))) - -;; widget linking, leafs creation -(defun ide-skel-imenu-analyze3 (hash prefix element) - (when element - (if (and (consp (cdr element)) - (listp (cadr element))) - (dolist (elem (cdr element)) - (ide-skel-imenu-analyze3 hash (concat prefix "/" (car element)) elem)) - (let* ((index-name (car element)) - (index-position (if (consp (cdr element)) (cadr element) (cdr element))) - (function (when (consp (cdr element)) (caddr element))) - (arguments (when (consp (cdr element)) (cdddr element))) - (path (concat prefix "/" index-name)) - (node (gethash path hash)) - (widget (cdr (assq :widget node))) - (parent-path (cdr (assq :parent node))) - (parent-node (when parent-path (gethash parent-path hash))) - (parent-widget (when parent-node (cdr (assq :widget parent-node))))) - ;; create leaf if not exists - (unless widget - ;; leaf node - (push (cons :widget (list 'ide-skel-imenu-leaf-widget - :notify 'ide-skel-tree-node-notify - :index-name index-name - :index-position index-position - :function function - :arguments arguments - :tag (or (cdr (assq :name node)) - index-name))) - node) - (puthash path node hash) - (setq widget (cdr (assq :widget node)))) - ;; add to parent - (when parent-widget - (setcdr (last parent-widget) (cons widget nil))))))) - -(defun ide-skel-imenu-create-tree (hash prefix element) - (when element - (if (and (consp (cdr element)) - (listp (cadr element))) - (let* ((menu-title (car element)) - (sub-alist (cdr element)) - (path (concat prefix "/" menu-title)) - (open-status (gethash path ide-skel-imenu-open-paths))) - (append - (list 'ide-skel-imenu-internal-node-widget - :open open-status - :indent 0 - :path path - :node (list 'push-button - :format "%[%t%]\n" - :button-face 'variable-pitch - :tag menu-title)) - (delq nil (mapcar (lambda (elem) - (ide-skel-imenu-create-tree hash path elem)) - sub-alist)))) - (let* ((index-name (car element)) - (index-position (if (consp (cdr element)) (cadr element) (cdr element))) - (function (when (consp (cdr element)) (caddr element))) - (arguments (when (consp (cdr element)) (cdddr element))) - (path (concat prefix "/" index-name)) - (node (gethash path hash)) - (parent-path (cdr (assq :parent node))) - (widget (cdr (assq :widget node)))) - (unless parent-path - widget))))) - -(defun ide-skel-imenu-compare (e1 e2) - (let ((ce1 (and (consp (cdr e1)) (listp (cadr e1)))) - (ce2 (and (consp (cdr e2)) (listp (cadr e2))))) - (when ce1 - (setcdr e1 (sort (cdr e1) 'ide-skel-imenu-compare))) - (when ce2 - (setcdr e2 (sort (cdr e2) 'ide-skel-imenu-compare))) - (if (or (and ce1 ce2) - (and (not ce1) (not ce2))) - (string< (car e1) (car e2)) - (and ce1 (not ce2))))) - -(defun ide-skel-outline-tree-create (index-alist) - (let (stack - node-list - (current-depth 0)) - (dolist (element index-alist) - (let ((index-name (car element)) - (index-position (if (consp (cdr element)) (cadr element) (cdr element))) - (function (when (consp (cdr element)) (caddr element))) - (arguments (when (consp (cdr element)) (cdddr element)))) - ;; (message "index-name: %S" index-name) - (string-match "^\\([*]+\\)[ ]*\\(.*\\)$" index-name) - (let* ((depth (length (match-string 1 index-name))) - (name (match-string 2 index-name)) - parent-node - node) - (while (and stack - (>= (caar stack) depth)) - (setq stack (cdr stack))) - (when stack - (setq parent-node (cdar stack)) - (when (eq (car parent-node) 'ide-skel-imenu-leaf-widget) - (let ((path (plist-get (cdr parent-node) :path))) - (setcar parent-node 'ide-skel-imenu-internal-node-widget) - (setcdr parent-node (list :open (gethash path ide-skel-imenu-open-paths) - :indent 0 - :notify 'ide-skel-tree-node-notify - :index-name (plist-get (cdr parent-node) :index-name) - :index-position (plist-get (cdr parent-node) :index-position) - :function (plist-get (cdr parent-node) :function) - :arguments (plist-get (cdr parent-node) :arguments) - :path path - :node (list 'push-button - :format "%[%t%]\n" - :button-face 'variable-pitch - :tag (plist-get (cdr parent-node) :tag))))))) - (setq node (list 'ide-skel-imenu-leaf-widget - :notify 'ide-skel-tree-node-notify - :index-name index-name - :index-position index-position - :function function - :path (concat (plist-get (cdr parent-node) :path) "/" index-name) - :arguments arguments - :tag name)) - (push (cons depth node) stack) - (if parent-node - (setcdr (last parent-node) (cons node nil)) - (push node node-list))))) - (append - (list 'ide-skel-imenu-internal-node-widget - :open t - :indent 0 - :path "" - :tag "") - (reverse node-list)))) - -(defun ide-skel-imenu-side-view-draw-tree (imenu-buffer &optional refresh) - (with-current-buffer imenu-buffer - (let ((index-alist (with-current-buffer ide-skel-imenu-editor-buffer - (when refresh - (imenu--cleanup) - (setq imenu--index-alist nil)) - (cons "" (progn - (unless imenu--index-alist - (font-lock-default-fontify-buffer) - (condition-case err - (imenu--make-index-alist t) - (error nil))) - imenu--index-alist)))) - (is-outline-mode (with-current-buffer ide-skel-imenu-editor-buffer - (or (eq major-mode 'outline-mode) - (and (boundp 'outline-minor-mode) - (symbol-value 'outline-minor-mode))))) - (inhibit-read-only t) - (hash (make-hash-table :test 'equal)) - (start-line (save-excursion - (goto-char (window-start ide-skel-current-right-view-window)) - (line-number-at-pos)))) - (unless is-outline-mode - (when ide-skel-imenu-sorted - (setq index-alist (cons "" (sort (copy-tree (cdr index-alist)) 'ide-skel-imenu-compare)))) - (ide-skel-imenu-analyze hash "/" index-alist) - (ide-skel-imenu-analyze2 hash "/" index-alist) - (ide-skel-imenu-analyze3 hash "/" index-alist)) - (let ((tree (if is-outline-mode - (ide-skel-outline-tree-create (cdr index-alist)) - (ide-skel-imenu-create-tree hash "/" index-alist)))) - (plist-put (cdr tree) :open t) - (plist-put (cdr tree) :indent 0) - (erase-buffer) - (tree-widget-set-theme "small-folder") - (widget-create tree) - (set-keymap-parent (current-local-map) tree-widget-button-keymap) - (widget-setup) - (goto-line start-line) - (beginning-of-line) - (set-window-start ide-skel-current-right-view-window (point)))))) - -(defun ide-skel-imenu-side-view-window-function (side event &rest list) - ;; (message "%S %S %S" side event list) - (when (and (eq side 'right) - ide-skel-current-right-view-window) - (let ((imenu-buffer (ide-skel-imenu-get-buffer-create ide-skel-current-editor-buffer t))) - (when (memq event '(show editor-buffer-changed)) - (when (ide-skel-has-imenu ide-skel-current-editor-buffer) - (unless imenu-buffer - (setq imenu-buffer (ide-skel-imenu-get-buffer-create ide-skel-current-editor-buffer))) - (with-current-buffer imenu-buffer - (setq ide-skel-tabbar-enabled t)))) - (when (and imenu-buffer - (eq event 'tab-change) - (eq (cadr list) imenu-buffer)) - (with-current-buffer imenu-buffer - (when (= (buffer-size) 0) - (ide-skel-imenu-side-view-draw-tree imenu-buffer)))))) - nil) - -(add-hook 'ide-skel-side-view-window-functions 'ide-skel-imenu-side-view-window-function) - -;;; Info - -(require 'info) - -(defun ide-skel-info-get-buffer-create () - (let ((buffer (ide-skel-get-side-view-buffer-create " Ide Skel Info" - 'left "Info" "Info browser" - (lambda (editor-buffer) t)))) - (with-current-buffer buffer - (setq ide-skel-tabbar-menu-function - (lambda () - (append - (list - (list 'ide-skel-info-refresh "Refresh" t)))) - ide-skel-info-open-paths (make-hash-table :test 'equal) - ide-skel-info-root-node (cons "Top" "(dir)top")) - (add-hook 'tree-widget-after-toggle-functions (lambda (widget) - (let ((path (widget-get widget :path))) - (when path - (if (widget-get widget :open) - (puthash path t ide-skel-info-open-paths) - (remhash path ide-skel-info-open-paths))))) - nil t)) - buffer)) - -(defun ide-skel-info-file-open (widget &rest rest) - (let ((path (widget-get widget :path))) - (if (not (string-match "^(\\([^)]+\\))\\([^.]+\\)$" path)) - (error "Invalid node %s" path) - (let ((filename (match-string 1 path)) - (nodename (match-string 2 path)) - (buffer (get-buffer "*info*")) - buffer-win) - (unless buffer - (with-selected-window (ide-skel-get-last-selected-window) - (info) - (setq buffer (window-buffer (selected-window))) - (setq buffer-win (selected-window)))) - (unless buffer-win - (setq buffer-win (get-buffer-window buffer)) - (unless buffer-win - (with-selected-window (ide-skel-get-last-selected-window) - (switch-to-buffer buffer) - (setq buffer-win (selected-window))))) - (select-window buffer-win) - (Info-find-node filename nodename))))) - -(defun ide-skel-info-tree-expand-dir (tree) - (let ((path (widget-get tree :path))) - (condition-case err - (mapcar 'ide-skel-info-tree-widget (Info-speedbar-fetch-file-nodes path)) - (error - (message "%s" (error-message-string err)) - nil)))) - -(defun ide-skel-info-tree-widget (e) - (let ((name (car e)) - (path (cdr e))) - (if (condition-case err - (Info-speedbar-fetch-file-nodes path) - (error nil)) - (list 'ide-skel-info-tree-dir-widget - :path path - :help-echo name - :open (gethash path ide-skel-info-open-paths) - :node (list 'push-button - :tag name - :format "%[%t%]\n" - :notify 'ide-skel-info-file-open - :path path - :button-face 'variable-pitch - :help-echo name - :keymap tree-widget-button-keymap - )) - (list 'ide-skel-info-tree-file-widget - :path path - :help-echo name - :keymap tree-widget-button-keymap - :tag name)))) - -(defun ide-skel-info-refresh (&optional show-top) - (interactive) - (with-current-buffer ide-skel-info-buffer - (let ((inhibit-read-only t) - (start-line (save-excursion - (goto-char (window-start ide-skel-current-left-view-window)) - (line-number-at-pos)))) - (erase-buffer) - (tree-widget-set-theme "small-folder") - (let ((tree (ide-skel-info-tree-widget ide-skel-info-root-node))) - (plist-put (cdr tree) :open t) - (widget-create tree)) - (set-keymap-parent (current-local-map) tree-widget-button-keymap) - (widget-setup) - (if show-top - (goto-char (point-min)) - (goto-line start-line)) - (beginning-of-line) - (set-window-start ide-skel-current-right-view-window (point))))) - -(defun ide-skel-info (root-node) - (with-current-buffer ide-skel-info-buffer - (clrhash ide-skel-info-open-paths) - (setq ide-skel-info-root-node root-node) - (ide-skel-info-refresh t))) - -(defun ide-skel-info-side-view-window-function (side event &rest list) - (when (and (eq side 'left) ide-skel-current-left-view-window) - (cond ((eq event 'show) - (unless ide-skel-info-buffer - (setq ide-skel-info-buffer (ide-skel-info-get-buffer-create))) - (with-current-buffer ide-skel-info-buffer - (setq ide-skel-tabbar-enabled t))) - ((and (eq event 'tab-change) - (eq (cadr list) ide-skel-info-buffer) - (= (buffer-size ide-skel-info-buffer) 0)) - (ide-skel-info-refresh)))) - nil) - -(add-hook 'ide-skel-side-view-window-functions 'ide-skel-info-side-view-window-function) - -;;; Dir tree - -(defun ide-skel-dir-node-notify (widget &rest rest) - (let ((path (widget-get widget :path))) - (ide-skel-dir path))) - -(defun ide-skel-file-open (widget &rest rest) - (let ((path (widget-get widget :path))) - (ide-skel-select-buffer path))) - -(defun ide-skel-dir-tree-widget (e) - "Return a widget to display file or directory E." - (if (file-directory-p e) - `(ide-skel-dir-tree-dir-widget - :path ,e - :help-echo ,e - :open ,(gethash e ide-skel-dir-open-paths) - :node (push-button - :tag ,(file-name-as-directory - (file-name-nondirectory e)) - :format "%[%t%]\n" - :notify ide-skel-dir-node-notify - :path ,e - :button-face (variable-pitch bold) - :help-echo ,e - :keymap ,tree-widget-button-keymap ; Emacs - )) - `(ide-skel-dir-tree-file-widget - :path ,e - :help-echo ,e - :tag ,(file-name-nondirectory e)))) - -(defun ide-skel-dir-get-buffer-create () - (let ((buffer (ide-skel-get-side-view-buffer-create " Ide Skel Dirs" - 'left "Dirs" "Filesystem browser" - (lambda (editor-buffer) t)))) - (with-current-buffer buffer - (setq ide-skel-tabbar-menu-function - (lambda () - (append - (list - (list 'ide-skel-dir-refresh "Refresh" t) - (when (and (buffer-file-name ide-skel-current-editor-buffer) - (fboundp 'ide-skel-proj-get-project-create) - (funcall 'ide-skel-project-p (car (funcall 'ide-skel-proj-get-project-create (buffer-file-name ide-skel-current-editor-buffer))))) - (list 'ide-skel-dir-project "Show project tree" t)) - (list 'ide-skel-dir-home "Home" t) - (list 'ide-skel-dir-filesystem-root "/" t) - ))) - ide-skel-dir-open-paths (make-hash-table :test 'equal) - ide-skel-dir-root-dir (file-truename (substitute-in-file-name "~"))) - (add-hook 'tree-widget-after-toggle-functions (lambda (widget) - (let ((path (widget-get widget :path))) - (when path - (if (widget-get widget :open) - (puthash path t ide-skel-dir-open-paths) - (remhash path ide-skel-dir-open-paths))))) - nil t)) - buffer)) - -(defun ide-skel-dir-tree-list (dir) - "Return the content of the directory DIR. -Return the list of components found, with sub-directories at the -beginning of the list." - (let (files dirs) - (dolist (entry (directory-files dir 'full)) - (unless (string-equal (substring entry -1) ".") - (if (file-directory-p entry) - (push entry dirs) - (push entry files)))) - (nreverse (nconc files dirs)))) - -(defun ide-skel-dir-tree-expand-dir (tree) - "Expand the tree widget TREE. -Return a list of child widgets." - (let ((dir (directory-file-name (widget-get tree :path)))) - (if (file-accessible-directory-p dir) - (progn - (message "Reading directory %s..." dir) - (condition-case err - (prog1 - (mapcar 'ide-skel-dir-tree-widget (ide-skel-dir-tree-list dir)) - (message "Reading directory %s...done" dir)) - (error - (message "%s" (error-message-string err)) - nil))) - (error "This directory is inaccessible")))) - -(defun ide-skel-select-dir-handler (event) - (interactive "@e") - (with-selected-window (posn-window (event-start event)) - (let* ((path (get-text-property (posn-point (event-start event)) 'path))) - (ide-skel-dir path)))) - -(defun ide-skel-dir-refresh (&optional show-top) - (interactive) - (with-current-buffer ide-skel-dir-buffer - (let ((inhibit-read-only t) - (start-line (save-excursion - (goto-char (window-start ide-skel-current-left-view-window)) - (line-number-at-pos)))) - (erase-buffer) - (let ((path-dirs (split-string (directory-file-name ide-skel-dir-root-dir) "[/\\]")) - (km (make-sparse-keymap)) - path) - (setq path-dirs (reverse (cdr (reverse path-dirs)))) - (define-key km [mouse-1] 'ide-skel-select-dir-handler) - (while path-dirs - (let ((dir (car path-dirs))) - (when (and (> (current-column) 0) - (>= (+ (current-column) (length dir) 1) (window-width ide-skel-current-left-view-window))) - (insert "\n")) - (setq path (directory-file-name (concat path (format "/%s" dir)))) - (unless (equal (char-before) ?/) - (insert "/")) - (insert (propertize dir - 'face 'bold - 'local-map km - 'mouse-face 'highlight - 'path path))) - (setq path-dirs (cdr path-dirs)))) - (insert "\n\n") - (tree-widget-set-theme "small-folder") - (let ((default-directory ide-skel-dir-root-dir) - (tree (ide-skel-dir-tree-widget (directory-file-name ide-skel-dir-root-dir)))) - (plist-put (cdr tree) :open t) - (widget-create tree)) - (set-keymap-parent (current-local-map) tree-widget-button-keymap) - (widget-setup) - (if show-top - (goto-char (point-min)) - (goto-line start-line)) - (beginning-of-line) - (set-window-start ide-skel-current-right-view-window (point)) - ))) - -(defun ide-skel-dir (root-dir) - (with-current-buffer ide-skel-dir-buffer - (clrhash ide-skel-dir-open-paths) - (setq ide-skel-dir-root-dir (file-truename (substitute-in-file-name root-dir))) - (ide-skel-dir-refresh t))) - -(defun ide-skel-dir-project () - (interactive) - (let ((root-dir (funcall 'ide-skel-project-root-path - (car (funcall 'ide-skel-proj-get-project-create (buffer-file-name ide-skel-current-editor-buffer)))))) - (message "Root dir: %S" root-dir) - (ide-skel-dir root-dir))) - -(defun ide-skel-dir-home () - (interactive) - (ide-skel-dir "~")) - -(defun ide-skel-dir-filesystem-root () - (interactive) - (ide-skel-dir "/")) - -(defun ide-skel-dirs-side-view-window-function (side event &rest list) - (when (and (eq side 'left) ide-skel-current-left-view-window) - (cond ((eq event 'show) - (unless ide-skel-dir-buffer - (setq ide-skel-dir-buffer (ide-skel-dir-get-buffer-create))) - (with-current-buffer ide-skel-dir-buffer - (setq ide-skel-tabbar-enabled t))) - ((and (eq event 'tab-change) - (eq (cadr list) ide-skel-dir-buffer) - (= (buffer-size ide-skel-dir-buffer) 0)) - (ide-skel-dir-refresh)))) - nil) - -(add-hook 'ide-skel-side-view-window-functions 'ide-skel-dirs-side-view-window-function) - -(easy-menu-add-item nil nil ide-skel-project-menu t) - -(defun ide-skel-proj-insert-with-face (string face) - (let ((point (point))) - (insert string) - (let ((overlay (make-overlay point (point)))) - (overlay-put overlay 'face face)))) - -(defun ide-skel-mode-name-stringify (mode-name) - (let ((name (format "%s" mode-name))) - (replace-regexp-in-string "-" " " - (capitalize - (if (string-match "^\\(.*\\)-mode" name) - (match-string 1 name) - name))))) - -(defun ide-skel-proj-get-all-dirs (root-dir) - (condition-case err - (split-string (shell-command-to-string (format "find %s -type d | grep -v '/CVS\\|/\\.svn\\|/\\.git'" root-dir)) - "\n" t) - (error nil))) - -(defun ide-skel-shell () - (interactive) - (when (fboundp 'ide-skel-show-bottom-view-window) - (funcall 'ide-skel-show-bottom-view-window) - (select-window (or (funcall 'ide-skel-get-bottom-view-window) - (selected-window))) - (ansi-term (or (getenv "ESHELL") (getenv "SHELL"))))) - -(defun ide-skel-project-menu (menu) - (let* ((curbuf-file (buffer-file-name (current-buffer))) - (curbuf-mode-name (when (and (buffer-file-name (current-buffer)) - (ide-skel-mode-file-regexp-list (list major-mode))) - (ide-skel-mode-name-stringify major-mode)))) - (condition-case err - (append - (when curbuf-mode-name - (list (vector (format "Search for %s file..." curbuf-mode-name) 'ide-skel-proj-find-files-by-regexp curbuf-mode-name))) - (list (vector "Search for file..." 'ide-skel-proj-find-text-files-by-regexp curbuf-mode-name)) - (when curbuf-mode-name - (list (vector (format "Grep %s files..." curbuf-mode-name) 'ide-skel-proj-grep-files-by-regexp curbuf-mode-name))) - (list (vector "Grep files..." 'ide-skel-proj-grep-text-files-by-regexp curbuf-file)) - (list (vector "Shell" 'ide-skel-shell t))) - (error (message (error-message-string err)))))) - -;; (ide-skel-project . relative-path) jesli path nalezy do projektu, -;; (qdir . filename) wpp - -(defun ide-skel-proj-get-project-create (path) - (let ((path (file-truename (substitute-in-file-name path))) - dir) - (if (file-directory-p path) - (progn - (setq path (file-name-as-directory path)) - (setq dir path)) - (setq dir (file-name-as-directory (file-name-directory path)))) - ;; path - true, qualified file name (no environment variables, ~, links) - (let ((project (some (lambda (project) - (let ((root-dir (ide-skel-project-root-path project))) - (when (string-match (concat "^" (regexp-quote root-dir)) path) - project))) - ide-skel-projects))) - (when project - (setq dir (ide-skel-project-root-path project))) - ;; there is no such project - (unless project - (let ((last-project-dir dir) - (dir-list (split-string dir "/")) - is-project) - ;; there is no root dir - (while (directory-files dir t (concat "^" ide-skel-cvs-dir-regexp) t) - (setq is-project t - last-project-dir (file-name-as-directory dir) - dir (file-name-as-directory (file-name-directory (directory-file-name dir))))) - (when is-project - (let ((list (nthcdr (1- (length (split-string last-project-dir "/"))) dir-list))) - (cond ((equal (car list) "trunk") - (setq last-project-dir (concat last-project-dir "trunk/"))) - ((member (car list) '("branches" "tags")) - (setq last-project-dir (concat last-project-dir (car list) "/" (when (cdr list) (concat (cadr list) "/"))))) - (t))) - (setq project (make-ide-skel-project :root-path last-project-dir - :include-file-path (ide-skel-proj-get-all-dirs last-project-dir)) - dir last-project-dir) - (push project ide-skel-projects)))) - (list (or project dir) (file-relative-name path dir) path)))) - -(defun ide-skel-proj-get-root (proj-or-dir) - (when proj-or-dir - (directory-file-name (file-truename (substitute-in-file-name - (if (ide-skel-project-p proj-or-dir) - (ide-skel-project-root-path proj-or-dir) - proj-or-dir)))))) - -(defun ide-skel-proj-find-files (dir file-predicate &optional dir-predicate) - "Return list of all qualified file paths in tree dir with root -DIR, for which FILE-PREDICATE returns non-nil. We will go into -directory only if DIR-PREDICATE returns non-nil or DIR-PREDICATE *is* nil." - (setq dir (file-name-as-directory (file-truename (substitute-in-file-name dir)))) - (let (result-list) - (mapcar (lambda (path) - (if (file-directory-p path) - (when (and (file-accessible-directory-p path) - (or (null dir-predicate) - (funcall dir-predicate path))) - (setq result-list (append result-list (ide-skel-proj-find-files path file-predicate dir-predicate)))) - (when (or (null file-predicate) - (funcall file-predicate path)) - (push path result-list)))) - (delete (concat (file-name-as-directory dir) ".") - (delete (concat (file-name-as-directory dir) "..") - (directory-files dir t nil t)))) - result-list)) - -(defun ide-skel-root-dir-for-path (path) - (let (root-dir) - (setq root-dir (car (ide-skel-proj-get-project-create path))) - (unless (stringp root-dir) - (setq root-dir (ide-skel-project-root-path root-dir))) - root-dir)) - -(defun ide-skel-has-imenu (&optional buffer) - (with-current-buffer (or buffer (current-buffer)) - (or (and imenu-prev-index-position-function - imenu-extract-index-name-function) - imenu-generic-expression - (not (eq imenu-create-index-function - 'imenu-default-create-index-function))))) - -(defun ide-skel-mode-file-regexp-list (mode-symbol-list) - (delq nil (mapcar (lambda (element) - (let ((fun-name (if (listp (cdr element)) (cadr element) (cdr element)))) - (when (memq fun-name mode-symbol-list) (cons (car element) fun-name)))) - auto-mode-alist))) - -(defun ide-skel-find-project-files (root-dir mode-symbol-list predicate) - (let ((obj-file-regexp-list (delq nil (mapcar (lambda (element) - (let ((len (length element))) - (unless (and (> len 0) - (equal (elt element (1- len)) ?/)) - (concat (regexp-quote element) "$")))) - (append ide-skel-proj-ignored-extensions completion-ignored-extensions)))) - (mode-file-regexp-list (ide-skel-mode-file-regexp-list mode-symbol-list))) ; (file-path-regexp . major-mode-function-symbol) - (when (and mode-symbol-list - (not mode-file-regexp-list)) - (error (format "No rules for %s major modes in auto-mode-alist." (mapconcat 'identity mode-symbol-list ", ")))) - (ide-skel-proj-find-files root-dir - (lambda (file-name) - (and (not (string-match "#" file-name)) - (not (string-match "semantic.cache" file-name)) - (or (and (not mode-symbol-list) - (not (some (lambda (regexp) - (string-match regexp file-name)) - obj-file-regexp-list))) - (and mode-symbol-list - (some (lambda (element) - (let ((freg (if (string-match "[$]" (car element)) - (car element) - (concat (car element) "$")))) - (when (string-match freg file-name) - (cdr element)))) - mode-file-regexp-list))) - (or (not predicate) - (funcall predicate file-name)))) - (lambda (dir-path) - (not (string-match (concat "/" ide-skel-cvs-dir-regexp) dir-path)))))) - -(defun ide-skel-proj-find-text-files-by-regexp () - (interactive) - (unwind-protect - (progn - (setq ide-skel-all-text-files-flag t) - (call-interactively 'ide-skel-proj-find-files-by-regexp)) - (setq ide-skel-all-text-files-flag nil))) - -(defun ide-skel-proj-grep-text-files-by-regexp () - (interactive) - (unwind-protect - (progn - (setq ide-skel-all-text-files-flag t) - (call-interactively 'ide-skel-proj-grep-files-by-regexp)) - (setq ide-skel-all-text-files-flag nil))) - -(defun ide-skel-proj-grep-files-by-regexp (root-dir mode-symbol-list regexp) - (interactive (let* ((path (buffer-file-name (current-buffer))) - (all-text-files (or ide-skel-all-text-files-flag - (consp current-prefix-arg))) - (whatever (progn - (when (and (not all-text-files) - (not (ide-skel-mode-file-regexp-list (list major-mode)))) - (error (format "No rules for %s major mode in auto-mode-alist" (symbol-name major-mode)))) - (unless path - (error "Current buffer (%s) is not visiting any project file" (buffer-name (current-buffer)))))) - (root-dir (when path (ide-skel-root-dir-for-path path))) - (thing (let ((res (thing-at-point 'symbol))) - (set-text-properties 0 (length res) nil res) - res)) - (chunk (let ((result (read-string (concat (if root-dir (format "Root dir is %s. " root-dir) "") - (format "Search in %s files. Regexp%s: " - (if all-text-files - "all text" - (ide-skel-mode-name-stringify major-mode)) - (if thing (format " (default %s)" thing) ""))) - nil ide-skel-proj-grep-project-files-history thing))) - (if (and result (> (length result) 0)) - result - (error "Regexp cannot be null"))))) - (list root-dir (unless all-text-files (list major-mode)) chunk))) - (let* ((paths (ide-skel-find-project-files root-dir mode-symbol-list (lambda (path) t))) - (temp-file-path (concat (file-name-as-directory temporary-file-directory) (make-temp-name "ide-")))) - (unless paths - (error "No files to grep")) - ;; create temporary file with file paths to search - (with-temp-file temp-file-path - (dolist (path paths) - ;; save buffer if is open - (let ((buffer (get-file-buffer path))) - (when (and buffer - (buffer-live-p buffer)) - (with-current-buffer buffer - (save-buffer)))) - (setq path (concat "./" (file-relative-name path (file-name-as-directory root-dir)))) - (insert (concat "'" path "'\n")))) - (let* ((default-directory root-dir) - (grep-command (format "cat %s | xargs grep -n %s" temp-file-path regexp))) - (setq ide-skel-proj-grep-header (list root-dir - (if mode-symbol-list - (mapconcat (lambda (sym) (ide-skel-mode-name-stringify sym)) mode-symbol-list ", ") - "all text") - regexp)) - (grep grep-command)) - ;; delete file after some time, because grep is executed as external process - (run-with-idle-timer 5 nil (lambda (file-path) - (condition-case nil - nil ; (delete-file file-path) - (error nil))) - temp-file-path))) - -(defun ide-skel-proj-find-files-by-regexp (root-dir mode-symbol-list name-regexp &optional case-sensitive) - "Search directory tree with root in ROOT-DIR and returns -qualified paths to files which after open in Emacs would have one -of modes in MODE-SYMBOL-LIST (if list is empty, we will take all -text files) and their name (without dir) matches NAME-REGEXP." - (interactive (let* ((path (buffer-file-name (current-buffer))) - (all-text-files (or ide-skel-all-text-files-flag - (consp current-prefix-arg))) - (whatever (progn - (when (and (not all-text-files) - (not (ide-skel-mode-file-regexp-list (list major-mode)))) - (error (format "No rules for %s major mode in auto-mode-alist" (symbol-name major-mode)))) - (unless path - (error "Current buffer (%s) is not visiting any project file" (buffer-name (current-buffer)))))) - (root-dir (when path (ide-skel-root-dir-for-path path))) - (chunk (read-string (concat (if root-dir (format "Root dir is %s. " root-dir) "") - (if all-text-files - "F" - (concat (ide-skel-mode-name-stringify major-mode) " f")) - (format "ile name regexp: " )) - nil ide-skel-proj-find-project-files-history nil))) - (list root-dir (unless all-text-files (list major-mode)) chunk))) - (let* ((paths (ide-skel-find-project-files root-dir mode-symbol-list - (lambda (path) - (let ((case-fold-search (not case-sensitive))) - (or (not name-regexp) - (string-match name-regexp (file-name-nondirectory path))))))) - (buffer (get-buffer-create ide-skel-proj-find-results-buffer-name)) - (saved-window (cons (selected-window) (window-buffer (selected-window))))) - (if (= (length paths) 1) - (find-file (car paths)) - (save-selected-window - (save-excursion - (set-buffer buffer) - (setq buffer-read-only nil - default-directory root-dir) - (erase-buffer) - - (insert "Root dir: ") - (ide-skel-proj-insert-with-face root-dir 'font-lock-keyword-face) - (insert "; Range: ") - (ide-skel-proj-insert-with-face - (if mode-symbol-list - (mapconcat (lambda (sym) (ide-skel-mode-name-stringify sym)) mode-symbol-list ", ") - "all text") - 'font-lock-keyword-face) - (insert " files; Regexp: ") - (ide-skel-proj-insert-with-face name-regexp 'font-lock-keyword-face) - (insert "; Case sensitive: ") - (ide-skel-proj-insert-with-face (if case-sensitive "Yes" "No") 'font-lock-keyword-face) - (insert "\n\n") - (compilation-minor-mode 1) - (let ((invisible-suffix ":1:1 s")) - (put-text-property 0 (length invisible-suffix) 'invisible t invisible-suffix) - (dolist (path paths) - (let ((relative-path (file-relative-name path root-dir))) - (put-text-property 0 (length relative-path) 'mouse-face 'highlight relative-path) - (insert relative-path) - (insert invisible-suffix) - (insert "\n")))) - (insert (format "\n%d files found." (length paths))) - (goto-char (point-min)) - (setq buffer-read-only t) - (when (and paths (fboundp 'compile-reinitialize-errors) (funcall (symbol-function 'compile-reinitialize-errors) t))) - (switch-to-buffer-other-window buffer) - (goto-line 1) - (goto-line 3))) - (if (window-live-p (car saved-window)) - (select-window (car saved-window)) - (when (get-buffer-window (cdr saved-window)) - (select-window (get-buffer-window (cdr saved-window)))))))) - -(unless ide-skel-proj-grep-mode-map - (setq ide-skel-proj-grep-mode-map (make-sparse-keymap)) - (define-key ide-skel-proj-grep-mode-map "r" 'ide-skel-proj-grep-replace)) - -(defun ide-skel-proj-grep-replace () - (interactive) - (let ((replace-to (read-string "Replace to: " nil 'ide-skel-proj-grep-replace-history)) - (current-pos 1) - begin end - buffers-to-revert - replace-info) - (save-excursion - (while current-pos - (setq current-pos (next-single-property-change current-pos 'font-lock-face (current-buffer))) - (when (and current-pos - (eq (get-text-property current-pos 'font-lock-face) 'match)) - (setq begin current-pos) - (setq current-pos (next-single-property-change current-pos 'font-lock-face (current-buffer))) - (setq end current-pos) - (save-excursion - (goto-char begin) - (beginning-of-line) - (let ((begline (point))) - (re-search-forward "^\\(.*\\):\\([0-9]+\\):" nil t) - (let ((len (length (match-string 0))) - (file-path (expand-file-name (substring-no-properties (match-string 1)) default-directory))) - (when (get-file-buffer file-path) - (push (get-file-buffer file-path) buffers-to-revert)) - (push (list file-path - (string-to-number (match-string 2)) - (- begin begline len) - (- end begline len)) - replace-info))))))) - (dolist (replacement replace-info) - (let ((file-path (nth 0 replacement)) - (line-no (nth 1 replacement)) - (from-column-no (nth 2 replacement)) - (to-column-no (nth 3 replacement))) - (condition-case err - (with-temp-file file-path - (insert-file-contents file-path) - (goto-line line-no) - (forward-char from-column-no) - (delete-region (point) (+ (point) (- to-column-no from-column-no))) - (insert replace-to)) - (error (message "%s" (error-message-string err)))))) - (dolist (buffer buffers-to-revert) - (when (buffer-live-p buffer) - (with-current-buffer buffer - (revert-buffer t t t)))) ; ignore-auto, nonconfirm, preserve-modes - (message "Done."))) - -(define-minor-mode ide-skel-proj-grep-mode - "" - nil ; init value - nil ; mode indicator - ide-skel-proj-grep-mode-map ; keymap - ;; body - (unless (assq 'ide-skel-proj-grep-mode minor-mode-map-alist) - (push (cons 'ide-skel-proj-grep-mode ide-skel-proj-grep-mode-map) minor-mode-map-alist))) - -(add-hook 'grep-setup-hook (lambda () - (when ide-skel-proj-grep-header - (ide-skel-proj-grep-mode 1) - (unwind-protect - (progn - (setq buffer-read-only nil) - (erase-buffer) - (remove-overlays) - (insert "Root dir: ") - (ide-skel-proj-insert-with-face (car ide-skel-proj-grep-header) 'font-lock-keyword-face) - (insert "; Range: ") - (ide-skel-proj-insert-with-face (cadr ide-skel-proj-grep-header) 'font-lock-keyword-face) - (insert " files; Regexp: ") - (ide-skel-proj-insert-with-face (caddr ide-skel-proj-grep-header) 'font-lock-keyword-face) - (insert "\n") - (insert "mouse-1 toggle match; r replace matches") - (insert "\n\n")) - (setq buffer-read-only t - ide-skel-proj-grep-header nil) - (setq ide-skel-proj-old-compilation-exit-message-function (symbol-value 'compilation-exit-message-function)) - (set 'compilation-exit-message-function - (lambda (status code msg) - (let ((result (if ide-skel-proj-old-compilation-exit-message-function - (funcall ide-skel-proj-old-compilation-exit-message-function - status code msg) - (cons msg code)))) - (save-excursion - (goto-char (point-min)) - (let (begin - end - (km (make-sparse-keymap)) - (inhibit-read-only t)) - (define-key km [down-mouse-1] 'ignore) - (define-key km [mouse-1] 'ide-skel-proj-grep-click) - (while (setq begin (next-single-property-change (point) 'font-lock-face (current-buffer) nil)) - (setq end (next-single-property-change begin 'font-lock-face (current-buffer) nil)) - (put-text-property begin end 'pointer 'hand) - (put-text-property begin end 'local-map km) - (goto-char end)))) - result))))))) - -(defun ide-skel-proj-grep-click (event) - (interactive "@e") - (with-selected-window (posn-window (event-start event)) - (let* ((posn-point (posn-point (event-start event))) - (begin (or (and (not (get-text-property (1- posn-point) 'font-lock-face)) - posn-point) - (previous-single-property-change posn-point 'font-lock-face (current-buffer) nil))) - (end (next-single-property-change posn-point 'font-lock-face (current-buffer) nil)) - (font-lock-face (get-text-property posn-point 'font-lock-face)) - (inhibit-read-only t)) - (put-text-property begin end 'font-lock-face (if (eq font-lock-face 'match) 'widget-field 'match))))) - -(defun ide-skel-proj-change-buffer-hook-function () - (let ((path (buffer-file-name))) - (when path - (condition-case err - (let ((project-list (ide-skel-proj-get-project-create path))) - (when (ide-skel-project-p (car project-list)) - (setq PC-include-file-path (ide-skel-project-include-file-path (car project-list))))) - (error nil))))) - -(add-hook 'ide-skel-editor-buffer-changed-hook 'ide-skel-proj-change-buffer-hook-function) - -(tabbar-mode 1) - -(provide 'ide-skel) - diff --git a/.emacs.d/include.el b/.emacs.d/include.el deleted file mode 100644 index 1a6e238..0000000 --- a/.emacs.d/include.el +++ /dev/null @@ -1,20 +0,0 @@ -(load-file "~/.emacs.d/slash_theme.el") -(load-file "~/.emacs.d/slash_python.el") -(load-file "~/.emacs.d/slash_functions.el") -(autoload 'vala-mode - "~/.emacs.d/vala-mode.el" "A Major mode for editing Vala files" t) -(autoload 'csharp-mode - "~/.emacs.d/csharp-mode.el" "A Major mode for editing C# files" t) -(autoload 'javascript-mode - "~/.emacs.d/javascript.el" "A Major mode for editing JavaScript" t) -(autoload 'sqlplus - "~/.emacs.d/sqlplus.el" "A Major mode for communicating with Oracle" t) -(autoload 'batch-mode - "~/.emacs.d/batch-mode.el" "A Major mode for editing Batch files" t) -(autoload 'rainbow-mode - "~/.emacs.d/rainbow-mode.el" "A Minor mode for showing colors inline" t) -(load-file "~/.emacs.d/autopair.el") -(load-file "~/.emacs.d/auto-complete-config.el") -(require 'auto-complete-config) -(require 'tabbar) -(require 'ide-skel) \ No newline at end of file diff --git a/.emacs.d/javascript.el b/.emacs.d/javascript.el deleted file mode 100644 index 33d852f..0000000 --- a/.emacs.d/javascript.el +++ /dev/null @@ -1,707 +0,0 @@ -;;; javascript.el --- Major mode for editing JavaScript source text - -;; Copyright (C) 2006 Karl Landström - -;; Author: Karl Landström -;; Maintainer: Karl Landström -;; Version: 2.0 Beta 8 -;; Date: 2006-12-26 -;; Keywords: languages, oop - -;; 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: -;; -;; The main features of this JavaScript mode are syntactic -;; highlighting (enabled with `font-lock-mode' or -;; `global-font-lock-mode'), automatic indentation and filling of -;; comments. -;; -;; This package has (only) been tested with GNU Emacs 21.4 (the latest -;; stable release). -;; -;; Installation: -;; -;; Put this file in a directory where Emacs can find it (`C-h v -;; load-path' for more info). Then add the following lines to your -;; Emacs initialization file: -;; -;; (add-to-list 'auto-mode-alist '("\\.js\\'" . javascript-mode)) -;; (autoload 'javascript-mode "javascript" nil t) -;; -;; General Remarks: -;; -;; This mode assumes that block comments are not nested inside block -;; comments and that strings do not contain line breaks. -;; -;; Exported names start with "javascript-" whereas private names start -;; with "js-". -;; -;; Changes: -;; -;; See javascript.el.changelog. - -;;; Code: - -(require 'cc-mode) -(require 'font-lock) -(require 'newcomment) - -(defgroup javascript nil - "Customization variables for `javascript-mode'." - :tag "JavaScript" - :group 'languages) - -(defcustom javascript-indent-level 4 - "Number of spaces for each indentation step." - :type 'integer - :group 'javascript) - -(defcustom javascript-auto-indent-flag t - "Automatic indentation with punctuation characters. If non-nil, the -current line is indented when certain punctuations are inserted." - :type 'boolean - :group 'javascript) - - -;; --- Keymap --- - -(defvar javascript-mode-map nil - "Keymap used in JavaScript mode.") - -(unless javascript-mode-map - (setq javascript-mode-map (make-sparse-keymap))) - -(when javascript-auto-indent-flag - (mapc (lambda (key) - (define-key javascript-mode-map key 'javascript-insert-and-indent)) - '("{" "}" "(" ")" ":" ";" ","))) - -(defun javascript-insert-and-indent (key) - "Run command bound to key and indent current line. Runs the command -bound to KEY in the global keymap and indents the current line." - (interactive (list (this-command-keys))) - (call-interactively (lookup-key (current-global-map) key)) - (indent-according-to-mode)) - - -;; --- Syntax Table And Parsing --- - -(defvar javascript-mode-syntax-table - (let ((table (make-syntax-table))) - (c-populate-syntax-table table) - - ;; The syntax class of underscore should really be `symbol' ("_") - ;; but that makes matching of tokens much more complex as e.g. - ;; "\\" matches part of e.g. "_xyz" and "xyz_abc". Defines - ;; it as word constituent for now. - (modify-syntax-entry ?_ "w" table) - - table) - "Syntax table used in JavaScript mode.") - - -(defun js-re-search-forward-inner (regexp &optional bound count) - "Auxiliary function for `js-re-search-forward'." - (let ((parse) - (saved-point (point-min))) - (while (> count 0) - (re-search-forward regexp bound) - (setq parse (parse-partial-sexp saved-point (point))) - (cond ((nth 3 parse) - (re-search-forward - (concat "\\([^\\]\\|^\\)" (string (nth 3 parse))) - (save-excursion (end-of-line) (point)) t)) - ((nth 7 parse) - (forward-line)) - ((or (nth 4 parse) - (and (eq (char-before) ?\/) (eq (char-after) ?\*))) - (re-search-forward "\\*/")) - (t - (setq count (1- count)))) - (setq saved-point (point)))) - (point)) - - -(defun js-re-search-forward (regexp &optional bound noerror count) - "Search forward but ignore strings and comments. Invokes -`re-search-forward' but treats the buffer as if strings and -comments have been removed." - (let ((saved-point (point)) - (search-expr - (cond ((null count) - '(js-re-search-forward-inner regexp bound 1)) - ((< count 0) - '(js-re-search-backward-inner regexp bound (- count))) - ((> count 0) - '(js-re-search-forward-inner regexp bound count))))) - (condition-case err - (eval search-expr) - (search-failed - (goto-char saved-point) - (unless noerror - (error (error-message-string err))))))) - - -(defun js-re-search-backward-inner (regexp &optional bound count) - "Auxiliary function for `js-re-search-backward'." - (let ((parse) - (saved-point (point-min))) - (while (> count 0) - (re-search-backward regexp bound) - (when (and (> (point) (point-min)) - (save-excursion (backward-char) (looking-at "/[/*]"))) - (forward-char)) - (setq parse (parse-partial-sexp saved-point (point))) - (cond ((nth 3 parse) - (re-search-backward - (concat "\\([^\\]\\|^\\)" (string (nth 3 parse))) - (save-excursion (beginning-of-line) (point)) t)) - ((nth 7 parse) - (goto-char (nth 8 parse))) - ((or (nth 4 parse) - (and (eq (char-before) ?/) (eq (char-after) ?*))) - (re-search-backward "/\\*")) - (t - (setq count (1- count)))))) - (point)) - - -(defun js-re-search-backward (regexp &optional bound noerror count) - "Search backward but ignore strings and comments. Invokes -`re-search-backward' but treats the buffer as if strings and -comments have been removed." - (let ((saved-point (point)) - (search-expr - (cond ((null count) - '(js-re-search-backward-inner regexp bound 1)) - ((< count 0) - '(js-re-search-forward-inner regexp bound (- count))) - ((> count 0) - '(js-re-search-backward-inner regexp bound count))))) - (condition-case err - (eval search-expr) - (search-failed - (goto-char saved-point) - (unless noerror - (error (error-message-string err))))))) - - -(defun js-continued-var-decl-list-p () - "Return non-nil if point is inside a continued variable declaration -list." - (interactive) - (let ((start (save-excursion (js-re-search-backward "\\" nil t)))) - (and start - (save-excursion (re-search-backward "\n" start t)) - (not (save-excursion - (js-re-search-backward - ";\\|[^, \t][ \t]*\\(/[/*]\\|$\\)" start t)))))) - - -;; --- Font Lock --- - -(defun js-inside-param-list-p () - "Return non-nil if point is inside a function parameter list." - (condition-case err - (save-excursion - (up-list -1) - (and (looking-at "(") - (progn (backward-word 1) - (or (looking-at "function") - (progn (backward-word 1) (looking-at "function")))))) - (error nil))) - - -(defconst js-function-heading-1-re - "^[ \t]*function[ \t]+\\(\\w+\\)" - "Regular expression matching the start of a function header.") - -(defconst js-function-heading-2-re - "^[ \t]*\\(\\w+\\)[ \t]*:[ \t]*function\\>" - "Regular expression matching the start of a function entry in - an associative array.") - -(defconst js-keyword-re - (regexp-opt '("abstract" "break" "case" "catch" "class" "const" - "continue" "debugger" "default" "delete" "do" "else" - "enum" "export" "extends" "final" "finally" "for" - "function" "goto" "if" "implements" "import" "in" - "instanceof" "interface" "native" "new" "package" - "private" "protected" "public" "return" "static" - "super" "switch" "synchronized" "this" "throw" - "throws" "transient" "try" "typeof" "var" "void" - "volatile" "while" "with" - "let") 'words) - "Regular expression matching any JavaScript keyword.") - -(defconst js-basic-type-re - (regexp-opt '("boolean" "byte" "char" "double" "float" "int" "long" - "short" "void") 'words) - "Regular expression matching any predefined type in JavaScript.") - -(defconst js-constant-re - (regexp-opt '("false" "null" "true") 'words) - "Regular expression matching any future reserved words in JavaScript.") - - -(defconst js-font-lock-keywords-1 - (list - "\\" - (list js-function-heading-1-re 1 font-lock-function-name-face) - (list js-function-heading-2-re 1 font-lock-function-name-face) - (list "[=(][ \t]*\\(/.*?[^\\]/\\w*\\)" 1 font-lock-string-face)) - "Level one font lock.") - -(defconst js-font-lock-keywords-2 - (append js-font-lock-keywords-1 - (list (list js-keyword-re 1 font-lock-keyword-face) - (cons js-basic-type-re font-lock-type-face) - (cons js-constant-re font-lock-constant-face))) - "Level two font lock.") - - -;; Limitations with variable declarations: There seems to be no -;; sensible way to highlight variables occuring after an initialized -;; variable in a variable list. For instance, in -;; -;; var x, y = f(a, b), z -;; -;; z will not be highlighted. - -(defconst js-font-lock-keywords-3 - (append - js-font-lock-keywords-2 - (list - - ;; variable declarations - (list - (concat "\\<\\(const\\|var\\)\\>\\|" js-basic-type-re) - (list "\\(\\w+\\)[ \t]*\\([=;].*\\|,\\|/[/*]\\|$\\)" - nil - nil - '(1 font-lock-variable-name-face))) - - ;; continued variable declaration list - (list - (concat "^[ \t]*\\w+[ \t]*\\([,;=]\\|/[/*]\\|$\\)") - (list "\\(\\w+\\)[ \t]*\\([=;].*\\|,\\|/[/*]\\|$\\)" - '(if (save-excursion (backward-char) (js-continued-var-decl-list-p)) - (backward-word 1) - (end-of-line)) - '(end-of-line) - '(1 font-lock-variable-name-face))) - - ;; formal parameters - (list - (concat "\\\\([ \t]+\\w+\\)?[ \t]*([ \t]*\\w") - (list "\\(\\w+\\)\\([ \t]*).*\\)?" - '(backward-char) - '(end-of-line) - '(1 font-lock-variable-name-face))) - - ;; continued formal parameter list - (list - (concat "^[ \t]*\\w+[ \t]*[,)]") - (list "\\w+" - '(if (save-excursion (backward-char) (js-inside-param-list-p)) - (backward-word 1) - (end-of-line)) - '(end-of-line) - '(0 font-lock-variable-name-face))))) - "Level three font lock.") - -(defconst js-font-lock-keywords - '(js-font-lock-keywords-3 js-font-lock-keywords-1 js-font-lock-keywords-2 - js-font-lock-keywords-3) - "See `font-lock-keywords'.") - - -;; --- Indentation --- - -(defconst js-possibly-braceless-keyword-re - (regexp-opt - '("catch" "do" "else" "finally" "for" "if" "try" "while" "with" "let") - 'words) - "Regular expression matching keywords that are optionally - followed by an opening brace.") - -(defconst js-indent-operator-re - (concat "[-+*/%<>=&^|?:.]\\([^-+*/]\\|$\\)\\|" - (regexp-opt '("in" "instanceof") 'words)) - "Regular expression matching operators that affect indentation - of continued expressions.") - - -(defun js-looking-at-operator-p () - "Return non-nil if text after point is an operator (that is not -a comma)." - (save-match-data - (and (looking-at js-indent-operator-re) - (or (not (looking-at ":")) - (save-excursion - (and (js-re-search-backward "[?:{]\\|\\" nil t) - (looking-at "?"))))))) - - -(defun js-continued-expression-p () - "Returns non-nil if the current line continues an expression." - (save-excursion - (back-to-indentation) - (or (js-looking-at-operator-p) - (and (js-re-search-backward "\n" nil t) - (progn - (skip-chars-backward " \t") - (backward-char) - (and (> (point) (point-min)) - (save-excursion (backward-char) (not (looking-at "[/*]/"))) - (js-looking-at-operator-p) - (and (progn (backward-char) - (not (looking-at "++\\|--\\|/[/*]")))))))))) - - -(defun js-end-of-do-while-loop-p () - "Returns non-nil if word after point is `while' of a do-while -statement, else returns nil. A braceless do-while statement -spanning several lines requires that the start of the loop is -indented to the same column as the current line." - (interactive) - (save-excursion - (save-match-data - (when (looking-at "\\s-*\\") - (if (save-excursion - (skip-chars-backward "[ \t\n]*}") - (looking-at "[ \t\n]*}")) - (save-excursion - (backward-list) (backward-word 1) (looking-at "\\")) - (js-re-search-backward "\\" (point-at-bol) t) - (or (looking-at "\\") - (let ((saved-indent (current-indentation))) - (while (and (js-re-search-backward "^[ \t]*\\<" nil t) - (/= (current-indentation) saved-indent))) - (and (looking-at "[ \t]*\\") - (not (js-re-search-forward - "\\" (point-at-eol) t)) - (= (current-indentation) saved-indent))))))))) - - -(defun js-ctrl-statement-indentation () - "Returns the proper indentation of the current line if it -starts the body of a control statement without braces, else -returns nil." - (save-excursion - (back-to-indentation) - (when (save-excursion - (and (not (looking-at "[{]")) - (progn - (js-re-search-backward "[[:graph:]]" nil t) - (forward-char) - (when (= (char-before) ?\)) (backward-list)) - (skip-syntax-backward " ") - (skip-syntax-backward "w") - (looking-at js-possibly-braceless-keyword-re)) - (not (js-end-of-do-while-loop-p)))) - (save-excursion - (goto-char (match-beginning 0)) - (+ (current-indentation) javascript-indent-level))))) - - -(defun js-proper-indentation (parse-status) - "Return the proper indentation for the current line." - (save-excursion - (back-to-indentation) - (let ((ctrl-stmt-indent (js-ctrl-statement-indentation)) - (same-indent-p (looking-at "[]})]\\|\\\\|\\")) - (continued-expr-p (js-continued-expression-p))) - (cond (ctrl-stmt-indent) - ((js-continued-var-decl-list-p) - (js-re-search-backward "\\" nil t) - (+ (current-indentation) javascript-indent-level)) - ((nth 1 parse-status) - (goto-char (nth 1 parse-status)) - (if (looking-at "[({[][ \t]*\\(/[/*]\\|$\\)") - (progn - (skip-syntax-backward " ") - (when (= (char-before) ?\)) (backward-list)) - (back-to-indentation) - (cond (same-indent-p - (current-column)) - (continued-expr-p - (+ (current-column) (* 2 javascript-indent-level))) - (t - (+ (current-column) javascript-indent-level)))) - (unless same-indent-p - (forward-char) - (skip-chars-forward " \t")) - (current-column))) - (continued-expr-p javascript-indent-level) - (t 0))))) - - -(defun javascript-indent-line () - "Indent the current line as JavaScript source text." - (interactive) - (let ((parse-status - (save-excursion (parse-partial-sexp (point-min) (point-at-bol)))) - (offset (- (current-column) (current-indentation)))) - (when (not (nth 8 parse-status)) - (indent-line-to (js-proper-indentation parse-status)) - (when (> offset 0) (forward-char offset))))) - - -;; --- Filling --- - -;; FIXME: It should be possible to use the more sofisticated function -;; `c-fill-paragraph' in `cc-cmds.el' instead. However, just setting -;; `fill-paragraph-function' to `c-fill-paragraph' does not work; -;; inside `c-fill-paragraph', `fill-paragraph-function' evaluates to -;; nil!? - -(defun js-backward-paragraph () - "Move backward to start of paragraph. Postcondition: Point is at -beginning of buffer or the previous line contains only whitespace." - (forward-line -1) - (while (not (or (bobp) (looking-at "^[ \t]*$"))) - (forward-line -1)) - (when (not (bobp)) (forward-line 1))) - - -(defun js-forward-paragraph () - "Move forward to end of paragraph. Postcondition: Point is at -end of buffer or the next line contains only whitespace." - (forward-line 1) - (while (not (or (eobp) (looking-at "^[ \t]*$"))) - (forward-line 1)) - (when (not (eobp)) (backward-char 1))) - - -(defun js-fill-block-comment-paragraph (parse-status justify) - "Fill current paragraph as a block comment. PARSE-STATUS is the -result of `parse-partial-regexp' from beginning of buffer to -point. JUSTIFY has the same meaning as in `fill-paragraph'." - (let ((offset (save-excursion - (goto-char (nth 8 parse-status)) (current-indentation)))) - (save-excursion - (save-restriction - (narrow-to-region (save-excursion - (goto-char (nth 8 parse-status)) (point-at-bol)) - (save-excursion - (goto-char (nth 8 parse-status)) - (re-search-forward "*/"))) - (narrow-to-region (save-excursion - (js-backward-paragraph) - (when (looking-at "^[ \t]*$") (forward-line 1)) - (point)) - (save-excursion - (js-forward-paragraph) - (when (looking-at "^[ \t]*$") (backward-char)) - (point))) - (goto-char (point-min)) - (while (not (eobp)) - (delete-horizontal-space) - (forward-line 1)) - (let ((fill-column (- fill-column offset)) - (fill-paragraph-function nil)) - (fill-paragraph justify)) - - ;; In Emacs 21.4 as opposed to CVS Emacs 22, - ;; `fill-paragraph' seems toadd a newline at the end of the - ;; paragraph. Remove it! - (goto-char (point-max)) - (when (looking-at "^$") (backward-delete-char 1)) - - (goto-char (point-min)) - (while (not (eobp)) - (indent-to offset) - (forward-line 1)))))) - - -(defun js-sline-comment-par-start () - "Return point at the beginning of the line where the current -single-line comment paragraph starts." - (save-excursion - (beginning-of-line) - (while (and (not (bobp)) - (looking-at "^[ \t]*//[ \t]*[[:graph:]]")) - (forward-line -1)) - (unless (bobp) (forward-line 1)) - (point))) - - -(defun js-sline-comment-par-end () - "Return point at end of current single-line comment paragraph." - (save-excursion - (beginning-of-line) - (while (and (not (eobp)) - (looking-at "^[ \t]*//[ \t]*[[:graph:]]")) - (forward-line 1)) - (unless (bobp) (backward-char)) - (point))) - - -(defun js-sline-comment-offset (line) - "Return the column at the start of the current single-line -comment paragraph." - (save-excursion - (goto-line line) - (re-search-forward "//" (point-at-eol)) - (goto-char (match-beginning 0)) - (current-column))) - - -(defun js-sline-comment-text-offset (line) - "Return the column at the start of the text of the current -single-line comment paragraph." - (save-excursion - (goto-line line) - (re-search-forward "//[ \t]*" (point-at-eol)) - (current-column))) - - -(defun js-at-empty-sline-comment-p () - "Return non-nil if inside an empty single-line comment." - (and (save-excursion - (beginning-of-line) - (not (looking-at "^.*//.*[[:graph:]]"))) - (save-excursion - (re-search-backward "//" (point-at-bol) t)))) - - -(defun js-fill-sline-comments (parse-status justify) - "Fill current paragraph as a sequence of single-line comments. -PARSE-STATUS is the result of `parse-partial-regexp' from -beginning of buffer to point. JUSTIFY has the same meaning as in -`fill-paragraph'." - (when (not (js-at-empty-sline-comment-p)) - (let* ((start (js-sline-comment-par-start)) - (start-line (1+ (count-lines (point-min) start))) - (end (js-sline-comment-par-end)) - (offset (js-sline-comment-offset start-line)) - (text-offset (js-sline-comment-text-offset start-line))) - (save-excursion - (save-restriction - (narrow-to-region start end) - (goto-char (point-min)) - (while (re-search-forward "^[ \t]*//[ \t]*" nil t) - (replace-match "") - (forward-line 1)) - (let ((fill-paragraph-function nil) - (fill-column (- fill-column text-offset))) - (fill-paragraph justify)) - - ;; In Emacs 21.4 as opposed to CVS Emacs 22, - ;; `fill-paragraph' seems toadd a newline at the end of the - ;; paragraph. Remove it! - (goto-char (point-max)) - (when (looking-at "^$") (backward-delete-char 1)) - - (goto-char (point-min)) - (while (not (eobp)) - (indent-to offset) - (insert "//") - (indent-to text-offset) - (forward-line 1))))))) - - -(defun js-trailing-comment-p (parse-status) - "Return non-nil if inside a trailing comment. PARSE-STATUS is -the result of `parse-partial-regexp' from beginning of buffer to -point." - (save-excursion - (when (nth 4 parse-status) - (goto-char (nth 8 parse-status)) - (skip-chars-backward " \t") - (not (bolp))))) - - -(defun js-block-comment-p (parse-status) - "Return non-nil if inside a block comment. PARSE-STATUS is the -result of `parse-partial-regexp' from beginning of buffer to -point." - (save-excursion - (save-match-data - (when (nth 4 parse-status) - (goto-char (nth 8 parse-status)) - (looking-at "/\\*"))))) - - -(defun javascript-fill-paragraph (&optional justify) - "If inside a comment, fill the current comment paragraph. -Trailing comments are ignored." - (interactive) - (let ((parse-status (parse-partial-sexp (point-min) (point)))) - (when (and (nth 4 parse-status) - (not (js-trailing-comment-p parse-status))) - (if (js-block-comment-p parse-status) - (js-fill-block-comment-paragraph parse-status justify) - (js-fill-sline-comments parse-status justify)))) - t) - - -;; --- Imenu --- - -(defconst js-imenu-generic-expression - (list - (list - nil - "function\\s-+\\(\\w+\\)\\s-*(" - 1)) - "Regular expression matching top level procedures. Used by imenu.") - - -;; --- Main Function --- - -;;;###autoload -(defun javascript-mode () - "Major mode for editing JavaScript source text. - -Key bindings: - -\\{javascript-mode-map}" - (interactive) - (kill-all-local-variables) - - (use-local-map javascript-mode-map) - (set-syntax-table javascript-mode-syntax-table) - (set (make-local-variable 'indent-line-function) 'javascript-indent-line) - (set (make-local-variable 'font-lock-defaults) (list js-font-lock-keywords)) - - (set (make-local-variable 'parse-sexp-ignore-comments) t) - - ;; Comments - (setq comment-start "// ") - (setq comment-end "") - (set (make-local-variable 'fill-paragraph-function) - 'javascript-fill-paragraph) - - ;; Make c-mark-function work - (setq c-nonsymbol-token-regexp "!=\\|%=\\|&[&=]\\|\\*[/=]\\|\\+[+=]\\|-[=-]\\|/[*/=]\\|<\\(?:<=\\|[<=]\\)\\|==\\|>\\(?:>\\(?:>=\\|[=>]\\)\\|[=>]\\)\\|\\^=\\||[=|]\\|[]!%&(-,./:-?[{-~^-]" - c-stmt-delim-chars "^;{}?:" - c-syntactic-ws-end "[ \n \f/]" - c-syntactic-eol "\\(\\s \\|/\\*\\([^*\n ]\\|\\*[^/\n ]\\)*\\*/\\)*\\(\\(/\\*\\([^*\n ]\\|\\*[^/\n ]\\)*\\|\\\\\\)?$\\|//\\)") - - ;; Imenu - (setq imenu-case-fold-search nil) - (set (make-local-variable 'imenu-generic-expression) - js-imenu-generic-expression) - - (setq major-mode 'javascript-mode) - (setq mode-name "JavaScript") - (run-hooks 'javascript-mode-hook)) - - -(provide 'javascript-mode) -;;; javascript.el ends here diff --git a/.emacs.d/linux/.emacs b/.emacs.d/linux/.emacs deleted file mode 100644 index 991f9c9..0000000 --- a/.emacs.d/linux/.emacs +++ /dev/null @@ -1 +0,0 @@ -(set-default-font "-xos4-terminus-medium-*-*-*-14-*-*-*-*-*-*-*") \ No newline at end of file diff --git a/.emacs.d/popup.el b/.emacs.d/popup.el deleted file mode 100644 index 0f14dfe..0000000 --- a/.emacs.d/popup.el +++ /dev/null @@ -1,1061 +0,0 @@ -;;; popup.el --- Visual popup interface - -;; Copyright (C) 2009, 2010 Tomohiro Matsuyama - -;; Author: Tomohiro Matsuyama -;; Keywords: lisp -;; 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: - -;; - -;;; Code: - -(eval-when-compile - (require 'cl)) - - - -;; Utilities - -(defvar popup-use-optimized-column-computation t - "Use optimized column computation routine. -If there is a problem, please set it to nil.") - -;; Borrowed from anything.el -(defmacro popup-aif (test-form then-form &rest else-forms) - "Anaphoric if. Temporary variable `it' is the result of test-form." - (declare (indent 2)) - `(let ((it ,test-form)) - (if it ,then-form ,@else-forms))) - -(defun popup-x-to-string (x) - "Convert any object to string effeciently. -This is faster than prin1-to-string in many cases." - (typecase x - (string x) - (symbol (symbol-name x)) - (integer (number-to-string x)) - (float (number-to-string x)) - (t (format "%s" x)))) - -(defun popup-substring-by-width (string width) - "Return cons of substring and remaining string by `WIDTH'." - ;; Expand tabs with 4 spaces - (setq string (replace-regexp-in-string "\t" " " string)) - (loop with len = (length string) - with w = 0 - for l from 0 - for c in (append string nil) - while (<= (incf w (char-width c)) width) - finally return - (if (< l len) - (cons (substring string 0 l) (substring string l)) - (list string)))) - -(defun popup-fill-string (string &optional width max-width justify squeeze) - "Split STRING into fixed width strings and return a cons cell like -\(WIDTH . ROWS). Here, the car WIDTH indicates the actual maxim width of ROWS. - -The argument WIDTH specifies the width of filling each paragraph. WIDTH nil -means don't perform any justification and word wrap. Note that this function -doesn't add any padding characters at the end of each row. - -MAX-WIDTH, if WIDTH is nil, specifies the maximum number of columns. - -The optional fourth argument JUSTIFY specifies which kind of justification -to do: `full', `left', `right', `center', or `none' (equivalent to nil). -A value of t means handle each paragraph as specified by its text properties. - -SQUEEZE nil means leave whitespaces other than line breaks untouched." - (if (eq width 0) - (error "Can't fill string with 0 width")) - (if width - (setq max-width width)) - (with-temp-buffer - (let ((tab-width 4) - (fill-column width) - (left-margin 0) - (kinsoku-limit 1) - indent-tabs-mode - row rows) - (insert string) - (untabify (point-min) (point-max)) - (if width - (fill-region (point-min) (point-max) justify (not squeeze))) - (goto-char (point-min)) - (setq width 0) - (while (prog2 - (let ((line (buffer-substring - (point) (progn (end-of-line) (point))))) - (if max-width - (while (progn - (setq row (truncate-string-to-width line max-width) - width (max width (string-width row))) - (push row rows) - (if (not (= (length row) (length line))) - (setq line (substring line (length row)))))) - (setq width (max width (string-width line))) - (push line rows))) - (< (point) (point-max)) - (beginning-of-line 2))) - (cons width (nreverse rows))))) - -(defmacro popup-save-buffer-state (&rest body) - (declare (indent 0)) - `(save-excursion - (let ((buffer-undo-list t) - (buffer-read-only nil) - (modified (buffer-modified-p))) - (unwind-protect - (progn ,@body) - (set-buffer-modified-p modified))))) - -(defun popup-preferred-width (list) - "Return preferred width of popup to show `LIST' beautifully." - (loop with tab-width = 4 - for item in list - for summary = (popup-item-summary item) - maximize (string-width (popup-x-to-string item)) into width - if (stringp summary) - maximize (+ (string-width summary) 2) into summary-width - finally return (* (ceiling (/ (+ (or width 0) (or summary-width 0)) 10.0)) 10))) - -;; window-full-width-p is not defined in Emacs 22.1 -(defun popup-window-full-width-p (&optional window) - (if (fboundp 'window-full-width-p) - (window-full-width-p window) - (= (window-width window) (frame-width (window-frame (or window (selected-window))))))) - -;; truncated-partial-width-window-p is not defined in Emacs 22 -(defun popup-truncated-partial-width-window-p (&optional window) - (unless window - (setq window (selected-window))) - (unless (popup-window-full-width-p window) - (let ((t-p-w-w (buffer-local-value 'truncate-partial-width-windows - (window-buffer window)))) - (if (integerp t-p-w-w) - (< (window-width window) t-p-w-w) - t-p-w-w)))) - -(defun popup-current-physical-column () - (or (when (and popup-use-optimized-column-computation - (eq (window-hscroll) 0)) - (let ((current-column (current-column))) - (if (or (popup-truncated-partial-width-window-p) - truncate-lines - (< current-column (window-width))) - current-column))) - (car (posn-col-row (posn-at-point))))) - -(defun popup-last-line-of-buffer-p () - (save-excursion (end-of-line) (/= (forward-line) 0))) - -(defun popup-lookup-key-by-event (function event) - (or (funcall function (vector event)) - (if (symbolp event) - (popup-aif (get event 'event-symbol-element-mask) - (funcall function (vector (logior (or (get (car it) 'ascii-character) 0) - (cadr it)))))))) - - - -;; Popup common - -(defgroup popup nil - "Visual popup interface" - :group 'lisp - :prefix "popup-") - -(defface popup-face - '((t (:background "lightgray" :foreground "black"))) - "Face for popup." - :group 'popup) - -(defface popup-scroll-bar-foreground-face - '((t (:background "black"))) - "Foreground face for scroll-bar." - :group 'popup) - -(defface popup-scroll-bar-background-face - '((t (:background "gray"))) - "Background face for scroll-bar." - :group 'popup) - -(defvar popup-instances nil - "Popup instances.") - -(defvar popup-scroll-bar-foreground-char - (propertize " " 'face 'popup-scroll-bar-foreground-face) - "Foreground character for scroll-bar.") - -(defvar popup-scroll-bar-background-char - (propertize " " 'face 'popup-scroll-bar-background-face) - "Background character for scroll-bar.") - -(defstruct popup - point row column width height min-height direction overlays - parent depth - face selection-face - margin-left margin-right margin-left-cancel scroll-bar symbol - cursor offset scroll-top current-height list newlines - pattern original-list) - -(defun popup-item-propertize (item &rest properties) - "Same to `propertize` but this avoids overriding existed value with `nil` property." - (let (props) - (while properties - (when (cadr properties) - (push (car properties) props) - (push (cadr properties) props)) - (setq properties (cddr properties))) - (apply 'propertize - (popup-x-to-string item) - (nreverse props)))) - -(defun popup-item-property (item property) - (if (stringp item) - (get-text-property 0 property item))) - -(defun* popup-make-item (name - &key - value - popup-face - selection-face - sublist - document - symbol - summary) - "Utility function to make popup item. -See also `popup-item-propertize'." - (popup-item-propertize name - 'value value - 'popup-face popup-face - 'selection-face selection-face - 'document document - 'symbol symbol - 'summary summary - 'sublist sublist)) - -(defsubst popup-item-value (item) (popup-item-property item 'value)) -(defsubst popup-item-value-or-self (item) (or (popup-item-value item) item)) -(defsubst popup-item-popup-face (item) (popup-item-property item 'popup-face)) -(defsubst popup-item-selection-face (item) (popup-item-property item 'selection-face)) -(defsubst popup-item-document (item) (popup-item-property item 'document)) -(defsubst popup-item-summary (item) (popup-item-property item 'summary)) -(defsubst popup-item-symbol (item) (popup-item-property item 'symbol)) -(defsubst popup-item-sublist (item) (popup-item-property item 'sublist)) - -(defun popup-item-documentation (item) - (let ((doc (popup-item-document item))) - (if (functionp doc) - (setq doc (funcall doc (popup-item-value-or-self item)))) - doc)) - -(defun popup-item-show-help-1 (item) - (let ((doc (popup-item-documentation item))) - (when doc - (with-current-buffer (get-buffer-create " *Popup Help*") - (erase-buffer) - (insert doc) - (goto-char (point-min)) - (display-buffer (current-buffer))) - t))) - -(defun popup-item-show-help (item &optional persist) - (when item - (if (not persist) - (save-window-excursion - (when (popup-item-show-help-1 item) - (block nil - (while t - (clear-this-command-keys) - (let ((key (read-key-sequence-vector nil))) - (case (key-binding key) - ('scroll-other-window - (scroll-other-window)) - ('scroll-other-window-down - (scroll-other-window-down nil)) - (t - (setq unread-command-events (append key unread-command-events)) - (return)))))))) - (popup-item-show-help-1 item)))) - -(defun popup-set-list (popup list) - (popup-set-filtered-list popup list) - (setf (popup-pattern popup) nil) - (setf (popup-original-list popup) list)) - -(defun popup-set-filtered-list (popup list) - (setf (popup-list popup) list - (popup-offset popup) (if (> (popup-direction popup) 0) - 0 - (max (- (popup-height popup) (length list)) 0)))) - -(defun popup-selected-item (popup) - (nth (popup-cursor popup) (popup-list popup))) - -(defun popup-selected-line (popup) - (- (popup-cursor popup) (popup-scroll-top popup))) - -(defun popup-line-overlay (popup line) - (aref (popup-overlays popup) line)) - -(defun popup-selected-line-overlay (popup) - (popup-line-overlay popup (popup-selected-line popup))) - -(defun popup-hide-line (popup line) - (let ((overlay (popup-line-overlay popup line))) - (overlay-put overlay 'display nil) - (overlay-put overlay 'after-string nil))) - -(defun popup-line-hidden-p (popup line) - (let ((overlay (popup-line-overlay popup line))) - (and (eq (overlay-get overlay 'display) nil) - (eq (overlay-get overlay 'after-string) nil)))) - -(defun popup-set-line-item (popup line item face margin-left margin-right scroll-bar-char symbol summary) - (let* ((overlay (popup-line-overlay popup line)) - (content (popup-create-line-string popup (popup-x-to-string item) margin-left margin-right symbol summary)) - (start 0) - (prefix (overlay-get overlay 'prefix)) - (postfix (overlay-get overlay 'postfix)) - end) - ;; Overlap face properties - (if (get-text-property start 'face content) - (setq start (next-single-property-change start 'face content))) - (while (and start (setq end (next-single-property-change start 'face content))) - (put-text-property start end 'face face content) - (setq start (next-single-property-change end 'face content))) - (if start - (put-text-property start (length content) 'face face content)) - (unless (overlay-get overlay 'dangle) - (overlay-put overlay 'display (concat prefix (substring content 0 1))) - (setq prefix nil - content (concat (substring content 1)))) - (overlay-put overlay - 'after-string - (concat prefix - content - scroll-bar-char - postfix)))) - -(defun popup-create-line-string (popup string margin-left margin-right symbol summary) - (let* ((popup-width (popup-width popup)) - (summary-width (string-width summary)) - (string (car (popup-substring-by-width string - (- popup-width - (if (> summary-width 0) - (+ summary-width 2) - 0))))) - (string-width (string-width string))) - (concat margin-left - string - (make-string (max (- popup-width string-width summary-width) 0) ? ) - summary - symbol - margin-right))) - -(defun popup-live-p (popup) - (and popup (popup-overlays popup) t)) - -(defun popup-child-point (popup &optional offset) - (overlay-end (popup-line-overlay popup - (or offset - (popup-selected-line popup))))) - -(defun* popup-create (point - width - height - &key - min-height - around - (face 'popup-face) - (selection-face face) - scroll-bar - margin-left - margin-right - symbol - parent - parent-offset) - (or margin-left (setq margin-left 0)) - (or margin-right (setq margin-right 0)) - (unless point - (setq point - (if parent (popup-child-point parent parent-offset) (point)))) - - (save-excursion - (goto-char point) - (let* ((row (line-number-at-pos)) - (column (popup-current-physical-column)) - (overlays (make-vector height nil)) - (popup-width (+ width - (if scroll-bar 1 0) - margin-left - margin-right - (if symbol 2 0))) - margin-left-cancel - (window (selected-window)) - (window-start (window-start)) - (window-hscroll (window-hscroll)) - (window-width (window-width)) - (right (+ column popup-width)) - (overflow (and (> right window-width) - (>= right popup-width))) - (foldable (and (null parent) - (>= column popup-width))) - (direction (or - ;; Currently the direction of cascade popup won't be changed - (and parent (popup-direction parent)) - - ;; Calculate direction - (if (and (> row height) - (> height (- (max 1 (- (window-height) - (if mode-line-format 1 0) - (if header-line-format 1 0))) - (count-lines window-start (point))))) - -1 - 1))) - (depth (if parent (1+ (popup-depth parent)) 0)) - (newlines (max 0 (+ (- height (count-lines point (point-max))) (if around 1 0)))) - current-column) - (when (> newlines 0) - (popup-save-buffer-state - (goto-char (point-max)) - (insert (make-string newlines ?\n)))) - - (if overflow - (if foldable - (progn - (decf column (- popup-width margin-left margin-right)) - (unless around (move-to-column column))) - (when (not truncate-lines) - ;; Cut out overflow - (let ((d (1+ (- popup-width (- window-width column))))) - (decf popup-width d) - (decf width d))) - (decf column margin-left)) - (decf column margin-left)) - (when (and (null parent) - (< column 0)) - ;; Cancel margin left - (setq column 0) - (decf popup-width margin-left) - (setq margin-left-cancel t)) - - (dotimes (i height) - (let (overlay begin w (dangle t) (prefix "") (postfix "")) - (when around - (if (>= emacs-major-version 23) - (vertical-motion (cons column direction)) - (vertical-motion direction) - (move-to-column (+ (current-column) column)))) - (setq around t - current-column (popup-current-physical-column)) - - (when (> current-column column) - (backward-char) - (setq current-column (popup-current-physical-column))) - (when (< current-column column) - ;; Extend short buffer lines by popup prefix (line of spaces) - (setq prefix (make-string (+ (if (= current-column 0) - (- window-hscroll (current-column)) - 0) - (- column current-column)) - ? ))) - - (setq begin (point)) - (setq w (+ popup-width (length prefix))) - (while (and (not (eolp)) (> w 0)) - (setq dangle nil) - (decf w (char-width (char-after))) - (forward-char)) - (if (< w 0) - (setq postfix (make-string (- w) ? ))) - - (setq overlay (make-overlay begin (point))) - (overlay-put overlay 'window window) - (overlay-put overlay 'dangle dangle) - (overlay-put overlay 'prefix prefix) - (overlay-put overlay 'postfix postfix) - (overlay-put overlay 'width width) - (aset overlays - (if (> direction 0) i (- height i 1)) - overlay))) - (loop for p from (- 10000 (* depth 1000)) - for overlay in (nreverse (append overlays nil)) - do (overlay-put overlay 'priority p)) - (let ((it (make-popup :point point - :row row - :column column - :width width - :height height - :min-height min-height - :direction direction - :parent parent - :depth depth - :face face - :selection-face selection-face - :margin-left margin-left - :margin-right margin-right - :margin-left-cancel margin-left-cancel - :scroll-bar scroll-bar - :symbol symbol - :cursor 0 - :scroll-top 0 - :current-height 0 - :list nil - :newlines newlines - :overlays overlays))) - (push it popup-instances) - it)))) - -(defun popup-delete (popup) - (when (popup-live-p popup) - (popup-hide popup) - (mapc 'delete-overlay (popup-overlays popup)) - (setf (popup-overlays popup) nil) - (setq popup-instances (delq popup popup-instances)) - (let ((newlines (popup-newlines popup))) - (when (> newlines 0) - (popup-save-buffer-state - (goto-char (point-max)) - (dotimes (i newlines) - (if (= (char-before) ?\n) - (delete-char -1))))))) - nil) - -(defun popup-draw (popup) - (loop with height = (popup-height popup) - with min-height = (popup-min-height popup) - with popup-face = (popup-face popup) - with selection-face = (popup-selection-face popup) - with list = (popup-list popup) - with length = (length list) - with thum-size = (max (/ (* height height) (max length 1)) 1) - with page-size = (/ (+ 0.0 (max length 1)) height) - with scroll-bar = (popup-scroll-bar popup) - with margin-left = (make-string (if (popup-margin-left-cancel popup) 0 (popup-margin-left popup)) ? ) - with margin-right = (make-string (popup-margin-right popup) ? ) - with symbol = (popup-symbol popup) - with cursor = (popup-cursor popup) - with scroll-top = (popup-scroll-top popup) - with offset = (popup-offset popup) - for o from offset - for i from scroll-top - while (< o height) - for item in (nthcdr scroll-top list) - for page-index = (* thum-size (/ o thum-size)) - for face = (if (= i cursor) - (or (popup-item-selection-face item) selection-face) - (or (popup-item-popup-face item) popup-face)) - for empty-char = (propertize " " 'face face) - for scroll-bar-char = (if scroll-bar - (cond - ((<= page-size 1) - empty-char) - ((and (> page-size 1) - (>= cursor (* page-index page-size)) - (< cursor (* (+ page-index thum-size) page-size))) - popup-scroll-bar-foreground-char) - (t - popup-scroll-bar-background-char)) - "") - for sym = (if symbol - (concat " " (or (popup-item-symbol item) " ")) - "") - for summary = (or (popup-item-summary item) "") - - do - ;; Show line and set item to the line - (popup-set-line-item popup o item face margin-left margin-right scroll-bar-char sym summary) - - finally - ;; Remember current height - (setf (popup-current-height popup) (- o offset)) - - ;; Hide remaining lines - (let ((scroll-bar-char (if scroll-bar (propertize " " 'face popup-face) "")) - (symbol (if symbol " " ""))) - (if (> (popup-direction popup) 0) - (progn - (when min-height - (while (< o min-height) - (popup-set-line-item popup o "" popup-face margin-left margin-right scroll-bar-char symbol "") - (incf o))) - (while (< o height) - (popup-hide-line popup o) - (incf o))) - (loop with h = (if min-height (- height min-height) offset) - for o from 0 below offset - if (< o h) - do (popup-hide-line popup o) - if (>= o h) - do (popup-set-line-item popup o "" popup-face margin-left margin-right scroll-bar-char symbol "")))))) - -(defun popup-hide (popup) - (dotimes (i (popup-height popup)) - (popup-hide-line popup i))) - -(defun popup-hidden-p (popup) - (let ((hidden t)) - (when (popup-live-p popup) - (dotimes (i (popup-height popup)) - (unless (popup-line-hidden-p popup i) - (setq hidden nil)))) - hidden)) - -(defun popup-select (popup i) - (setq i (+ i (popup-offset popup))) - (when (and (<= 0 i) (< i (popup-height popup))) - (setf (popup-cursor popup) i) - (popup-draw popup) - t)) - -(defun popup-next (popup) - (let ((height (popup-height popup)) - (cursor (1+ (popup-cursor popup))) - (scroll-top (popup-scroll-top popup)) - (length (length (popup-list popup)))) - (cond - ((>= cursor length) - ;; Back to first page - (setq cursor 0 - scroll-top 0)) - ((= cursor (+ scroll-top height)) - ;; Go to next page - (setq scroll-top (min (1+ scroll-top) (max (- length height) 0))))) - (setf (popup-cursor popup) cursor - (popup-scroll-top popup) scroll-top) - (popup-draw popup))) - -(defun popup-previous (popup) - (let ((height (popup-height popup)) - (cursor (1- (popup-cursor popup))) - (scroll-top (popup-scroll-top popup)) - (length (length (popup-list popup)))) - (cond - ((< cursor 0) - ;; Go to last page - (setq cursor (1- length) - scroll-top (max (- length height) 0))) - ((= cursor (1- scroll-top)) - ;; Go to previous page - (decf scroll-top))) - (setf (popup-cursor popup) cursor - (popup-scroll-top popup) scroll-top) - (popup-draw popup))) - -(defun popup-scroll-down (popup &optional n) - (let ((scroll-top (min (+ (popup-scroll-top popup) (or n 1)) - (- (length (popup-list popup)) (popup-height popup))))) - (setf (popup-cursor popup) scroll-top - (popup-scroll-top popup) scroll-top) - (popup-draw popup))) - -(defun popup-scroll-up (popup &optional n) - (let ((scroll-top (max (- (popup-scroll-top popup) (or n 1)) - 0))) - (setf (popup-cursor popup) scroll-top - (popup-scroll-top popup) scroll-top) - (popup-draw popup))) - - - -;; Popup isearch - -(defface popup-isearch-match - '((t (:background "sky blue"))) - "Popup isearch match face." - :group 'popup) - -(defvar popup-isearch-cursor-color "blue") - -(defvar popup-isearch-keymap - (let ((map (make-sparse-keymap))) - ;(define-key map "\r" 'popup-isearch-done) - (define-key map "\C-g" 'popup-isearch-cancel) - (define-key map "\C-h" 'popup-isearch-delete) - (define-key map (kbd "DEL") 'popup-isearch-delete) - map)) - -(defsubst popup-isearch-char-p (char) - (and (integerp char) - (<= 32 char) - (<= char 126))) - -(defun popup-isearch-filter-list (pattern list) - (loop with regexp = (regexp-quote pattern) - for item in list - do - (unless (stringp item) - (setq item (popup-item-propertize (popup-x-to-string item) - 'value item))) - if (string-match regexp item) - collect (let ((beg (match-beginning 0)) - (end (match-end 0))) - (alter-text-property 0 (length item) 'face - (lambda (prop) - (unless (eq prop 'popup-isearch-match) - prop)) - item) - (put-text-property beg end - 'face 'popup-isearch-match - item) - item))) - -(defun popup-isearch-prompt (popup pattern) - (format "Pattern: %s" (if (= (length (popup-list popup)) 0) - (propertize pattern 'face 'isearch-fail) - pattern))) - -(defun popup-isearch-update (popup pattern &optional callback) - (setf (popup-cursor popup) 0 - (popup-scroll-top popup) 0 - (popup-pattern popup) pattern) - (let ((list (popup-isearch-filter-list pattern (popup-original-list popup)))) - (popup-set-filtered-list popup list) - (if callback - (funcall callback list))) - (popup-draw popup)) - -(defun* popup-isearch (popup - &key - (cursor-color popup-isearch-cursor-color) - (keymap popup-isearch-keymap) - callback - help-delay) - (let ((list (popup-original-list popup)) - (pattern (or (popup-pattern popup) "")) - (old-cursor-color (frame-parameter (selected-frame) 'cursor-color)) - prompt key binding done) - (unwind-protect - (unless (block nil - (if cursor-color - (set-cursor-color cursor-color)) - (while t - (setq prompt (popup-isearch-prompt popup pattern)) - (setq key (popup-menu-read-key-sequence keymap prompt help-delay)) - (if (null key) - (unless (funcall popup-menu-show-quick-help-function popup nil :prompt prompt) - (clear-this-command-keys) - (push (read-event prompt) unread-command-events)) - (setq binding (lookup-key keymap key)) - (cond - ((and (stringp key) - (popup-isearch-char-p (aref key 0))) - (setq pattern (concat pattern key))) - ((eq binding 'popup-isearch-done) - (return t)) - ((eq binding 'popup-isearch-cancel) - (return nil)) - ((eq binding 'popup-isearch-delete) - (if (> (length pattern) 0) - (setq pattern (substring pattern 0 (1- (length pattern)))))) - (t - (setq unread-command-events - (append (listify-key-sequence key) unread-command-events)) - (return t))) - (popup-isearch-update popup pattern callback)))) - (popup-isearch-update popup "" callback) - t) ; Return non-nil if isearch is cancelled - (if old-cursor-color - (set-cursor-color old-cursor-color))))) - - - -;; Popup tip - -(defface popup-tip-face - '((t (:background "khaki1" :foreground "black"))) - "Face for popup tip." - :group 'popup) - -(defvar popup-tip-max-width 80) - -(defun* popup-tip (string - &key - point - (around t) - width - (height 15) - min-height - truncate - margin - margin-left - margin-right - scroll-bar - parent - parent-offset - nowait - prompt - &aux tip lines) - (if (bufferp string) - (setq string (with-current-buffer string (buffer-string)))) - ;; TODO strip text (mainly face) properties - (setq string (substring-no-properties string)) - - (and (eq margin t) (setq margin 1)) - (or margin-left (setq margin-left margin)) - (or margin-right (setq margin-right margin)) - - (let ((it (popup-fill-string string width popup-tip-max-width))) - (setq width (car it) - lines (cdr it))) - - (setq tip (popup-create point width height - :min-height min-height - :around around - :margin-left margin-left - :margin-right margin-right - :scroll-bar scroll-bar - :face 'popup-tip-face - :parent parent - :parent-offset parent-offset)) - - (unwind-protect - (when (> (popup-width tip) 0) ; not to be corrupted - (when (and (not (eq width (popup-width tip))) ; truncated - (not truncate)) - ;; Refill once again to lines be fitted to popup width - (setq width (popup-width tip)) - (setq lines (cdr (popup-fill-string string width width)))) - - (popup-set-list tip lines) - (popup-draw tip) - (if nowait - tip - (clear-this-command-keys) - (push (read-event prompt) unread-command-events) - t)) - (unless nowait - (popup-delete tip)))) - - - -;; Popup menu - -(defface popup-menu-face - '((t (:background "lightgray" :foreground "black"))) - "Face for popup menu." - :group 'popup) - -(defface popup-menu-selection-face - '((t (:background "steelblue" :foreground "white"))) - "Face for popup menu selection." - :group 'popup) - -(defvar popup-menu-show-tip-function 'popup-tip - "Function used for showing tooltip by `popup-menu-show-quick-help'.") - -(defvar popup-menu-show-quick-help-function 'popup-menu-show-quick-help - "Function used for showing quick help by `popup-menu*'.") - -(defun popup-menu-show-help (menu &optional persist item) - (popup-item-show-help (or item (popup-selected-item menu)) persist)) - -(defun popup-menu-documentation (menu &optional item) - (popup-item-documentation (or item (popup-selected-item menu)))) - -(defun popup-menu-show-quick-help (menu &optional item &rest args) - (let* ((point (plist-get args :point)) - (height (or (plist-get args :height) (popup-height menu))) - (min-height (min height (popup-current-height menu))) - (around nil) - (parent-offset (popup-offset menu)) - (doc (popup-menu-documentation menu item))) - (when (stringp doc) - (if (popup-hidden-p menu) - (setq around t - menu nil - parent-offset nil) - (setq point nil)) - (let ((popup-use-optimized-column-computation nil)) ; To avoid wrong positioning - (apply popup-menu-show-tip-function - doc - :point point - :height height - :min-height min-height - :around around - :parent menu - :parent-offset parent-offset - args))))) - -(defun popup-menu-read-key-sequence (keymap &optional prompt timeout) - (catch 'timeout - (let ((timer (and timeout - (run-with-timer timeout nil - (lambda () - (if (zerop (length (this-command-keys))) - (throw 'timeout nil)))))) - (old-global-map (current-global-map)) - (temp-global-map (make-sparse-keymap)) - (overriding-terminal-local-map (make-sparse-keymap))) - (substitute-key-definition 'keyboard-quit 'keyboard-quit - temp-global-map old-global-map) - (define-key temp-global-map [menu-bar] (lookup-key old-global-map [menu-bar])) - (define-key temp-global-map [tool-bar] (lookup-key old-global-map [tool-bar])) - (set-keymap-parent overriding-terminal-local-map keymap) - (if (current-local-map) - (define-key overriding-terminal-local-map [menu-bar] - (lookup-key (current-local-map) [menu-bar]))) - (unwind-protect - (progn - (use-global-map temp-global-map) - (clear-this-command-keys) - (with-temp-message prompt - (read-key-sequence nil))) - (use-global-map old-global-map) - (if timer (cancel-timer timer)))))) - -(defun popup-menu-fallback (event default)) - -(defun* popup-menu-event-loop (menu keymap fallback &optional prompt help-delay isearch isearch-cursor-color isearch-keymap isearch-callback &aux key binding) - (block nil - (while (popup-live-p menu) - (and isearch - (popup-isearch menu - :cursor-color isearch-cursor-color - :keymap isearch-keymap - :callback isearch-callback - :help-delay help-delay) - (keyboard-quit)) - (setq key (popup-menu-read-key-sequence keymap prompt help-delay)) - (if (null key) - (unless (funcall popup-menu-show-quick-help-function menu nil :prompt prompt) - (clear-this-command-keys) - (push (read-event prompt) unread-command-events)) - (if (eq (lookup-key (current-global-map) key) 'keyboard-quit) - (keyboard-quit)) - (setq binding (lookup-key keymap key)) - (cond - ((eq binding 'popup-close) - (if (popup-parent menu) - (return))) - ((memq binding '(popup-select popup-open)) - (let* ((item (popup-selected-item menu)) - (sublist (popup-item-sublist item))) - (if sublist - (popup-aif (popup-cascade-menu sublist - :around nil - :parent menu - :margin-left (popup-margin-left menu) - :margin-right (popup-margin-right menu) - :scroll-bar (popup-scroll-bar menu)) - (and it (return it))) - (if (eq binding 'popup-select) - (return (popup-item-value-or-self item)))))) - ((eq binding 'popup-next) - (popup-next menu)) - ((eq binding 'popup-previous) - (popup-previous menu)) - ((eq binding 'popup-help) - (popup-menu-show-help menu)) - ((eq binding 'popup-isearch) - (popup-isearch menu - :cursor-color isearch-cursor-color - :keymap isearch-keymap - :callback isearch-callback - :help-delay help-delay)) - ((commandp binding) - (call-interactively binding)) - (t - (funcall fallback key (key-binding key)))))))) - -;; popup-menu is used by mouse.el unfairly... -(defun* popup-menu* (list - &key - point - (around t) - (width (popup-preferred-width list)) - (height 15) - margin - margin-left - margin-right - scroll-bar - symbol - parent - parent-offset - (keymap popup-menu-keymap) - (fallback 'popup-menu-fallback) - help-delay - prompt - isearch - (isearch-cursor-color popup-isearch-cursor-color) - (isearch-keymap popup-isearch-keymap) - isearch-callback - &aux menu event) - (and (eq margin t) (setq margin 1)) - (or margin-left (setq margin-left margin)) - (or margin-right (setq margin-right margin)) - (if (and scroll-bar - (integerp margin-right) - (> margin-right 0)) - ;; Make scroll-bar space as margin-right - (decf margin-right)) - (setq menu (popup-create point width height - :around around - :face 'popup-menu-face - :selection-face 'popup-menu-selection-face - :margin-left margin-left - :margin-right margin-right - :scroll-bar scroll-bar - :symbol symbol - :parent parent)) - (unwind-protect - (progn - (popup-set-list menu list) - (popup-draw menu) - (popup-menu-event-loop menu keymap fallback prompt help-delay isearch - isearch-cursor-color isearch-keymap isearch-callback)) - (popup-delete menu))) - -(defun popup-cascade-menu (list &rest args) - "Same to `popup-menu', but an element of `LIST' can be -list of submenu." - (apply 'popup-menu* - (mapcar (lambda (item) - (if (consp item) - (popup-make-item (car item) - :sublist (cdr item) - :symbol ">") - item)) - list) - :symbol t - args)) - -(defvar popup-menu-keymap - (let ((map (make-sparse-keymap))) - (define-key map "\r" 'popup-select) - (define-key map "\C-f" 'popup-open) - (define-key map [right] 'popup-open) - (define-key map "\C-b" 'popup-close) - (define-key map [left] 'popup-close) - - (define-key map "\C-n" 'popup-next) - (define-key map [down] 'popup-next) - (define-key map "\C-p" 'popup-previous) - (define-key map [up] 'popup-previous) - - (define-key map [f1] 'popup-help) - (define-key map (kbd "\C-?") 'popup-help) - - (define-key map "\C-s" 'popup-isearch) - map)) - -(provide 'popup) -;;; popup.el ends here diff --git a/.emacs.d/popup.elc b/.emacs.d/popup.elc deleted file mode 100644 index e0acbfd..0000000 Binary files a/.emacs.d/popup.elc and /dev/null differ diff --git a/.emacs.d/ports.el b/.emacs.d/ports.el deleted file mode 100644 index eec3854..0000000 --- a/.emacs.d/ports.el +++ /dev/null @@ -1,29 +0,0 @@ -;; function copied from dim-ports.al by Dimitri Fontaine -;; http://git.naquadah.org/?p=~dim/emacs.d.git;a=summary -(defun lsb-release (&optional property) - "Parse lsb-release output and return an alist, or the value for the given property" - (when (file-executable-p "/usr/bin/lsb_release") - (let* ((lsbr (shell-command-to-string "/usr/bin/lsb_release -a 2>/dev/null")) - (props (split-string lsbr "[:\n]" t)) - (kv)) - (while (>= (length props) 2) - ;; Don't keep extra spaces. This way seems like the easy one in elisp. - (let ((key (mapconcat 'identity (split-string (car props)) " ")) - (val (mapconcat 'identity (split-string (cadr props)) " "))) - (setq kv (add-to-list 'kv (cons key val))) - (setq props (cddr props)))) - (if property - (cdr (assoc property (lsb-release))) - kv)))) - -;; function copied from dim-ports.al by Dimitri Fontaine -;; http://git.naquadah.org/?p=~dim/emacs.d.git;a=summary -(defmacro when-running-ubuntu (&rest body) - "eval body only when running under Ubuntu" - (when (equal (lsb-release "Distributor ID") "Ubuntu") ,@body)) - -;; function adapted from dim-ports.al by Dimitri Fontaine -;; http://git.naquadah.org/?p=~dim/emacs.d.git;a=summary -(defmacro when-running-fedora (&rest body) - "eval body only when running under Fedora" - (when (equal (lsb-release "Distributor ID") "Fedora") ,@body)) \ No newline at end of file diff --git a/.emacs.d/rainbow-mode.el b/.emacs.d/rainbow-mode.el deleted file mode 100644 index 8207abc..0000000 --- a/.emacs.d/rainbow-mode.el +++ /dev/null @@ -1,207 +0,0 @@ -;;; rainbow-mode.el --- prints color strings with colored background - -;; Copyright (C) 2010 Julien Danjou - -;; Author: Julien Danjou -;; Keywords: strings, faces - -;; This file is NOT part of GNU Emacs. - -;; GNU Emacs 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. - -;; GNU Emacs 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. If not, see . - -;;; Commentary: -;; This minor mode will add background to strings that matches color names. -;; i.e. -;; #0000ff -;; Will be printed in white with a blue background. -;; - -;;; Code: - -(eval-when-compile - (require 'cl)) - -(require 'regexp-opt) -(require 'faces) - -(defgroup rainbow nil - "Show color strings with a background color." - :tag "Rainbow" - :group 'help) - -;; Hexadecimal colors -(defvar rainbow-hexadecimal-colors-font-lock-keywords - '("#[0-9a-fA-F]\\{3\\}[0-9a-fA-F]\\{3\\}?" - (0 (rainbow-colorize-itself))) - "Font-lock keywords to add for hexadecimal colors.") - -;; rgb() colors -(defvar rainbow-html-rgb-colors-font-lock-keywords - '(("rgb(\s*\\([0-9]\\{1,3\\}\\(?:\s*%\\)?\\)\s*,\s*\\([0-9]\\{1,3\\}\\(?:\s*%\\)?\\)\s*,\s*\\([0-9]\\{1,3\\}\\(?:\s*%\\)?\\)\s*)" - (0 (rainbow-colorize-rgb))) - ("rgba(\s*\\([0-9]\\{1,3\\}\\(?:\s*%\\)?\\)\s*,\s*\\([0-9]\\{1,3\\}\\(?:\s*%\\)?\\)\s*,\s*\\([0-9]\\{1,3\\}\\(?:\s*%\\)?\\)\s*,\s*[0-9]\\{1,3\\}\s*%?\s*)" - (0 (rainbow-colorize-rgb)))) - "Font-lock keywords to add for RGB colors.") - -;; HTML colors name -(defvar rainbow-html-colors-font-lock-keywords nil - "Font-lock keywords to add for HTML colors.") -(make-variable-buffer-local 'rainbow-html-colors-font-lock-keywords) - -(defcustom rainbow-html-colors-alist - '(("black" . "#000000") - ("silver" . "#C0C0C0") - ("gray" . "#808080") - ("white" . "#FFFFFF") - ("maroon" . "#800000") - ("red" . "#FF0000") - ("purple" . "#800080") - ("fuchsia" . "#FF00FF") - ("green" . "#008000") - ("lime" . "#00FF00") - ("olive" . "#808000") - ("yellow" . "#FFFF00") - ("navy" . "#000080") - ("blue" . "#0000FF") - ("teal" . "#008080") - ("aqua" . "#00FFFF")) - "Alist of HTML colors. -Each entry should have the form (COLOR-NAME . HEXADECIMAL-COLOR)." - :group 'rainbow) - -(defcustom rainbow-html-colors-major-mode-list - '(html-mode css-mode php-mode nxml-mode xml-mode) - "List of major mode where HTML colors are enabled when -`rainbow-html-colors' is set to auto." - :group 'rainbow) - -(defcustom rainbow-html-colors 'auto - "When to enable HTML colors. -If set to t, the HTML colors will be enabled. If set to nil, the -HTML colors will not be enabled. If set to auto, the HTML colors -will be enabled if a major mode has been detected from the -`rainbow-html-colors-major-mode-list'." - :group 'rainbow) - -;; X colors -(defvar rainbow-x-colors-font-lock-keywords - `(,(regexp-opt (x-defined-colors) 'words) - (0 (rainbow-colorize-itself))) - "Font-lock keywords to add for X colors.") - -(defcustom rainbow-x-colors-major-mode-list - '(emacs-lisp-mode lisp-interaction-mode c-mode c++-mode java-mode) - "List of major mode where X colors are enabled when -`rainbow-x-colors' is set to auto." - :group 'rainbow) - -(defcustom rainbow-x-colors 'auto - "When to enable X colors. -If set to t, the X colors will be enabled. If set to nil, the -X colors will not be enabled. If set to auto, the X colors -will be enabled if a major mode has been detected from the -`rainbow-x-colors-major-mode-list'." - :group 'rainbow) - -;; Functions -(defun rainbow-colorize-match (color) - "Return a matched string propertized with a face whose -background is COLOR. The foreground is computed using -`rainbow-color-luminance', and is either white or black." - (put-text-property - (match-beginning 0) (match-end 0) - 'face `((:foreground ,(if (> 128.0 (rainbow-x-color-luminance color)) - "white" "black")) - (:background ,color)))) - -(defun rainbow-colorize-itself () - "Colorize a match with itself." - (rainbow-colorize-match (match-string-no-properties 0))) - -(defun rainbow-colorize-by-assoc (assoc-list) - "Colorize a match with its association from ASSOC-LIST." - (rainbow-colorize-match (cdr (assoc (match-string-no-properties 0) assoc-list)))) - -(defun rainbow-rgb-relative-to-absolute (number) - "Convert a relative NUMBER to absolute. If NUMBER is absolute, return NUMBER. -This will convert \"80 %\" to 204, \"100 %\" to 255 but \"123\" to \"123\"" - (let ((string-length (- (length number) 1))) - ;; Is this a number with %? - (if (eq (elt number string-length) ?%) - (/ (* (string-to-number (substring number 0 string-length)) 255) 100) - (string-to-number number)))) - -(defun rainbow-colorize-rgb () - "Colorize a match with itself." - (let ((r (rainbow-rgb-relative-to-absolute (match-string-no-properties 1))) - (g (rainbow-rgb-relative-to-absolute (match-string-no-properties 2))) - (b (rainbow-rgb-relative-to-absolute (match-string-no-properties 3)))) - (rainbow-colorize-match (format "#%02X%02X%02X" r g b)))) - -(defun rainbow-color-luminance (red green blue) - "Calculate the luminance of color composed of RED, BLUE and GREEN." - (floor (+ (* .2126 red) (* .7152 green) (* .0722 blue)) 256)) - -(defun rainbow-x-color-luminance (color) - "Calculate the luminance of a color string (e.g. \"#ffaa00\", \"blue\")." - (let* ((values (x-color-values color)) - (r (car values)) - (g (cadr values)) - (b (caddr values))) - (rainbow-color-luminance r g b))) - -(defun rainbow-turn-on () - "Turn on raibow-mode." - (font-lock-add-keywords nil - (list rainbow-hexadecimal-colors-font-lock-keywords)) - ;; Activate X colors? - (when (or (eq rainbow-x-colors t) - (and (eq rainbow-x-colors 'auto) - (memq major-mode rainbow-x-colors-major-mode-list))) - (font-lock-add-keywords nil - (list rainbow-x-colors-font-lock-keywords))) - ;; Activate HTML colors? - (when (or (eq rainbow-html-colors t) - (and (eq rainbow-html-colors 'auto) - (memq major-mode rainbow-html-colors-major-mode-list))) - (setq rainbow-html-colors-font-lock-keywords - `(,(regexp-opt (mapcar 'car rainbow-html-colors-alist) 'words) - (0 (rainbow-colorize-by-assoc rainbow-html-colors-alist)))) - (font-lock-add-keywords nil - `(,rainbow-html-colors-font-lock-keywords - ,@rainbow-html-rgb-colors-font-lock-keywords)))) - -(defun rainbow-turn-off () - "Turn off rainbow-mode." - (font-lock-remove-keywords - nil - (list - rainbow-hexadecimal-colors-font-lock-keywords - rainbow-html-colors-font-lock-keywords - rainbow-x-colors-font-lock-keywords - rainbow-html-rgb-colors-font-lock-keywords))) - -;;;###autoload -(define-minor-mode rainbow-mode - "Colorize strings that represent colors. -This will fontify with colors the string like \"#aabbcc\" or \"blue\"" - :lighter " Rbow" - (progn - (if rainbow-mode - (rainbow-turn-on) - (rainbow-turn-off)) - ;; Turn on font lock - (font-lock-mode 1))) - -(provide 'rainbow-mode) diff --git a/.emacs.d/slash_c.el b/.emacs.d/slash_c.el deleted file mode 100644 index b8d35fe..0000000 --- a/.emacs.d/slash_c.el +++ /dev/null @@ -1,15 +0,0 @@ -(if (not (intern-soft "cc-mode")) - (require 'cc-mode)) - -(global-set-key [(f9)] 'compile) ; make F9 call the compilation command -(setq compilation-window-height 8) ; make the compilation window smaller - -;; Make compilation window disappear on succesful build -(setq compilation-finish-function - (lambda (buf str) - (if (string-match "exited abnormally" str) - ;; there were errors - (message "compilation errors, press C-x ` to visit") - ;; no errors, make the compilation window go away in 0.5 seconds - (run-at-time 0.5 nil 'delete-windows-on buf) - (message "NO COMPILATION ERRORS!")))) \ No newline at end of file diff --git a/.emacs.d/slash_functions.el b/.emacs.d/slash_functions.el deleted file mode 100644 index fa27bb7..0000000 --- a/.emacs.d/slash_functions.el +++ /dev/null @@ -1,5 +0,0 @@ -(defun what-face (pos) - (interactive "d") - (let ((face (or (get-char-property (point) 'read-face-name) - (get-char-property (point) 'face)))) - (if face (message "Face: %s" face) (message "No face at %d" pos)))) \ No newline at end of file diff --git a/.emacs.d/slash_python.el b/.emacs.d/slash_python.el deleted file mode 100644 index 4cb2a72..0000000 --- a/.emacs.d/slash_python.el +++ /dev/null @@ -1,17 +0,0 @@ -;; Pyflakes -(when (load "flymake" t) - (defun flymake-pyflakes-init () - (let* ((temp-file (flymake-init-create-temp-buffer-copy - 'flymake-create-temp-inplace)) - (local-file (file-relative-name - temp-file - (file-name-directory buffer-file-name)))) - (list "pyflakes" (list local-file)))) - - (add-to-list 'flymake-allowed-file-name-masks - '("\\.py\\'" flymake-pyflakes-init))) -(add-hook 'find-file-hook 'flymake-find-file-hook) - -;; Bind RET to py-newline-and-indent -(add-hook 'python-mode-hook '(lambda () - (define-key python-mode-map "\C-m" 'newline-and-indent))) \ No newline at end of file diff --git a/.emacs.d/slash_theme.el b/.emacs.d/slash_theme.el deleted file mode 100644 index 1847b6d..0000000 --- a/.emacs.d/slash_theme.el +++ /dev/null @@ -1,66 +0,0 @@ -(add-to-list 'load-path "~/.emacs.d") -(require 'color-theme) - -;; weirdness color-theme -(defun color-theme-weirdness () - (interactive) - (color-theme-install - '(color-theme-weirdness - ((background-color . "#000000") - (background-mode . dark) - (border-color . "#000000") - (cursor-color . "#FFFFFF") - (foreground-color . "#FFFFFF") - (mouse-color . "#000000")) - (org-level-1 ((t (:foreground "#5BFD5B" :weight normal)))) - (org-level-2 ((t (:foreground "#379A37" :weight normal)))) - (org-level-3 ((t (:foreground "#757575" :weight normal)))) - (org-level-4 ((t (:foreground "#778899" :weight normal)))) - (org-level-5 ((t (:foreground "#9898FF" :weight normal)))) - (org-level-6 ((t (:foreground "#0000B0" :weight normal)))) - (org-level-7 ((t (:foreground "#740091" :weight normal)))) - (org-level-8 ((t (:foreground "#B275C1" :weight normal)))) - (fringe ((t (:background "#000000")))) - (mode-line ((t (:foreground "#B3B3B3" :background "#43527A" :background "#000000" :box nil)))) - (region ((t (:background "#3D3D3D")))) - (minibuffer-prompt ((t (:foreground "#72F3FF" :bold t)))) - (flymake-warnline ((t (:background "#000060")))) - (flymake-errline ((t (:background "#600000")))) - (font-lock-builtin-face ((t (:foreground "#C436C4")))) - (font-lock-comment-face ((t (:foreground "#00AC00" :background "#004000" :bold t :box (:line-width 1 :color "#006000" :style nil))))) - (font-lock-comment-delimiter-face ((t (:inherit 'font-lock-comment-face)))) - (font-lock-function-name-face ((t (:foreground "#0FFF28")))) - (font-lock-keyword-face ((t (:foreground "#4E61BB" :bold t)))) - (font-lock-string-face ((t (:foreground "#E00900")))) - (font-lock-type-face ((t (:foreground "#8522DD")))) - (font-lock-variable-name-face ((t (:foreground "#18EFF2")))) - (font-lock-warning-face ((t (:foreground "#FF0000" :bold t))))))) -(provide 'color-theme-weirdness) - -;; ryrobes color theme -(defun color-theme-vibrant-ink () - (interactive) - (color-theme-install - '(color-theme-ryrobes - ((background-color . "#000000") - (background-mode . dark) - (border-color . "#000000") - (cursor-color . "#FFFFFF") - (foreground-color . "#FFFFFF") - (mouse-color . "#FFFFFF")) - (font-lock-comment-face ((t (:foreground "#9933CC" :italic t)))) - (font-lock-keyword-face ((t (:foreground "#FF6600")))) - (font-lock-type-face ((t (:foreground "#FFCC00")))) - (font-lock-string-face ((t (:foreground "#66FF00"))))))) -(provide 'color-theme-vibrant-ink) -(provide 'color-theme-ryrobes) - - - - - - - - - - diff --git a/.emacs.d/sqlplus.el b/.emacs.d/sqlplus.el deleted file mode 100644 index 4d5e7d7..0000000 --- a/.emacs.d/sqlplus.el +++ /dev/null @@ -1,5151 +0,0 @@ -;;; sqlplus.el --- User friendly interface to SQL*Plus and support for PL/SQL compilation - -;; Copyright (C) 2007, 2008 Peter Karpiuk, Scott Tiger S.A. - -;; Author: Peter Karpiuk -;; Maintainer: Peter Karpiuk -;; Created: 25 Nov 2007 -;; Version 0.9.0 -;; Keywords: sql sqlplus oracle plsql - -;; GNU Emacs 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. - -;; GNU Emacs 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, 675 Mass Ave, Cambridge, MA 02139, USA. - -;;; Commentary: - -;; Facilitates interaction with Oracle via SQL*Plus (GNU Emacs only). -;; Moreover, this package complements plsql.el (Kahlil Hodgson) -;; upon convenient compilation of PL/SQL source files. -;; -;; This package was inspired by sqlplus-mode.el (Rob Riepel, Peter -;; D. Pezaris, Martin Schwenke), but offers more features: -;; - tables are parsed, formatted and rendered with colors, like in -;; many GUI programs; you can see raw SQL*Plus output also, -;; if you wish -;; - table will be cutted if you try to fetch too many rows -;; (SELECT * FROM MY_MILLION_ROWS_TABLE); current SQL*Plus command -;; will be automatically interrupted under the hood in such cases -;; - you can use many SQL*Plus processes simultaneously, -;; - font locking (especially if you use Emacs>=22), with database -;; object names highlighting, -;; - history (log) of executed commands - see` sqlplus-history-dir` -;; variable, -;; - commands for fetching any database object definition -;; (package, table/index/sequence script) -;; - query result can be shown in HTML, -;; - input buffer for each connection can be saved into file on -;; disconnect and automatically restored on next connect (see -;; 'sqlplus-session-cache-dir' variable); if you place some -;; SQL*Plus commands between '/* init */' and '/* end */' -;; comments in saved input buffer, they will be automatically -;; executed on every connect -;; - if you use plsql.el for editing PL/SQL files, you can compile -;; such sources everytime with C-cC-c; error messages will be -;; parsed and displayed for easy source navigation -;; - M-. or C-mouse-1 on database object name will go to definition -;; in filesystem (use arrow button on toolbar to go back) -;; -;; The following commands should be added to a global initialization -;; file or to any user's .emacs file to conveniently use -;; sqlplus-mode: -;; -;; (require 'sqlplus) -;; (add-to-list 'auto-mode-alist '("\\.sqp\\'" . sqlplus-mode)) -;; -;; If you want PL/SQL support also, try something like this: -;; -;; (require 'plsql) -;; (setq auto-mode-alist -;; (append '(("\\.pls\\'" . plsql-mode) ("\\.pkg\\'" . plsql-mode) -;; ("\\.pks\\'" . plsql-mode) ("\\.pkb\\'" . plsql-mode) -;; ("\\.sql\\'" . plsql-mode) ("\\.PLS\\'" . plsql-mode) -;; ("\\.PKG\\'" . plsql-mode) ("\\.PKS\\'" . plsql-mode) -;; ("\\.PKB\\'" . plsql-mode) ("\\.SQL\\'" . plsql-mode) -;; ("\\.prc\\'" . plsql-mode) ("\\.fnc\\'" . plsql-mode) -;; ("\\.trg\\'" . plsql-mode) ("\\.vw\\'" . plsql-mode) -;; ("\\.PRC\\'" . plsql-mode) ("\\.FNC\\'" . plsql-mode) -;; ("\\.TRG\\'" . plsql-mode) ("\\.VW\\'" . plsql-mode)) -;; auto-mode-alist )) -;; -;; M-x sqlplus will start new SQL*Plus session. -;; -;; C-RET execute command under point -;; S-C-RET execute command under point and show result table in HTML -;; buffer -;; M-RET explain execution plan for command under point -;; M-. or C-mouse-1: find database object definition (table, view -;; index, synonym, trigger, procedure, function, package) -;; in filesystem -;; C-cC-s show database object definition (retrieved from database) -;; -;; Use describe-mode while in sqlplus-mode for further instructions. -;; -;; Many useful commands are defined in orcl-mode minor mode, which is -;; common for input and otput SQL*Plus buffers, as well as PL/SQL -;; buffers. -;; -;; For twiddling, see 'sqlplus' customization group. -;; -;; If you find this package useful, send me a postcard to address: -;; -;; Peter Karpiuk -;; Scott Tiger S.A. -;; ul. Gawinskiego 8 -;; 01-645 Warsaw -;; Poland - -;;; Known bugs: - -;; 1. Result of SQL select command can be messed up if some columns -;; has newline characters. To avoid this, execute SQL*Plus command -;; column truncated -;; before such select - -;;; Code: - -(require 'recentf) -(require 'font-lock) -(require 'cl) -(require 'sql) -(require 'tabify) -(require 'skeleton) - -(defconst sqlplus-revision "$Revision: 1.7 $") - -;;; Variables - - -(defgroup sqlplus nil - "SQL*Plus" - :group 'tools - :version 21) - -(defcustom plsql-auto-parse-errors-flag t - "Non nil means parse PL/SQL compilation results and show them in the compilation buffer." - :group 'sqlplus - :type '(boolean)) - -(defcustom sqlplus-init-sequence-start-regexp "/\\* init \\*/" - "SQL*Plus start of session init command sequence." - :group 'sqlplus - :type '(regexp)) - -(defcustom sqlplus-init-sequence-end-regexp "/\\* end \\*/" - "SQL*Plus end of session init command sequence." - :group 'sqlplus - :type '(regexp)) - -(defcustom sqlplus-explain-plan-warning-regexps '("TABLE ACCESS FULL" "INDEX FULL SCAN") - "SQL*Plus explain plan warning regexps" - :group 'sqlplus - :type '(repeat regexp)) - -(defcustom sqlplus-syntax-faces - '((schema font-lock-type-face nil) - (table font-lock-type-face ("dual")) - (synonym font-lock-type-face nil) - (view font-lock-type-face nil) - (column font-lock-constant-face nil) - (sequence font-lock-type-face nil) - (package font-lock-type-face nil) - (trigger font-lock-type-face nil) - (index font-lock-type-face) nil) - "Font lock configuration for database object names in current schema. -This is alist, and each element looks like (SYMBOL FACE LIST) -where SYMBOL is one of: schema, table, synonym, view, column, -sequence, package, trigger, index. Database objects means only -objects from current schema, so if you want syntax highlighting -for other objects (eg. 'dual' table name), you can explicitly -enumerate them in LIST as strings." - :group 'sqlplus - :tag "Oracle SQL Syntax Faces" - :type '(repeat (list symbol face (repeat string)))) - -(defcustom sqlplus-output-buffer-max-size (* 50 1000 1000) - "Maximum size of SQL*Plus output buffer. -After exceeding oldest results are deleted." - :group 'sqlplus - :tag "SQL*Plus Output Buffer Max Size" - :type '(integer)) - -(defcustom sqlplus-select-result-max-col-width nil - "Maximum width of column in displayed database table, or nil if there is no limit. -If any cell value is longer, it will be cutted and terminated with ellipsis ('...')." - :group 'sqlplus - :tag "SQL*Plus Select Result Max Column Width" - :type '(choice integer (const nil))) - -(defcustom sqlplus-format-output-tables-flag t - "Non-nil means format result if it looks like database table." - :group 'sqlplus - :tag "SQL*Plus Format Output Table" - :type '(boolean)) - -(defcustom sqlplus-kill-processes-without-query-on-exit-flag t - "Non-nil means silently kill all SQL*Plus processes on Emacs exit." - :group 'sqlplus - :tag "SQL*Plus Kill Processes Without Query On Exit" - :type '(boolean)) - -(defcustom sqlplus-multi-output-tables-default-flag t - "Non-nil means render database table as set of adjacent tables so that they occupy all width of output window. -For screen space saving and user comfort." - :group 'sqlplus - :tag "SQL*Plus Multiple Tables In Output by Default" - :type '(boolean)) - -(defcustom sqlplus-source-buffer-readonly-by-default-flag t - "Non-nil means show database sources in read-only buffer." - :group 'sqlplus - :tag "SQL*Plus Source Buffer Read Only By Default" - :type '(boolean)) - -(defcustom sqlplus-command "sqlplus" - "SQL*Plus interpreter program." - :group 'sqlplus - :tag "SQL*Plus Command" - :type '(string)) - -(defcustom sqlplus-history-dir nil - "Directory of SQL*Plus command history (log) files, or nil (dont generate log files). -History file name has format '-history.txt'." - :group 'sqlplus - :tag "SQL*Plus History Dir" - :type '(choice directory (const nil))) - -(defvar sqlplus-session-file-extension "sqp") - -(defcustom sqlplus-session-cache-dir nil - "Directory of SQL*Plus input buffer files, or nil (dont save user session). -Session file name has format '.sqp'" - :group 'sqlplus - :tag "SQL*Plus History Dir" - :type '(choice directory (const nil))) - -(defcustom sqlplus-save-passwords nil - "Non-nil means save passwords between Emacs sessions. (Not implemented yet)." - :group 'sqlplus - :tag "SQL*Plus Save Passwords" - :type '(boolean)) - -(defcustom sqlplus-pagesize 200 - "Approximate number of records in query results. -If result has more rows, it will be cutted and terminated with '. . .' line." - :group 'sqlplus - :tag "SQL*Plus Max Rows Count" - :type '(integer)) - -(defvar sqlplus-default-wrap "on") - -(defcustom sqlplus-initial-strings - (list "set sqlnumber off" - "set tab off" - "set linesize 4000" - "set echo off" - "set newpage 1" - "set space 1" - "set feedback 6" - "set heading on" - "set trimspool off" - (format "set wrap %s" sqlplus-default-wrap) - "set timing on" - "set feedback on") - "Initial commands to send to interpreter. -Customizing this variable is dangerous." - :group 'sqlplus - :tag "SQL*Plus Initial Strings" - :type '(repeat string)) - -(defcustom sqlplus-table-col-separator " | " - "Database table column separator (text-only terminals)." - :group 'sqlplus - :tag "SQL*Plus Table Col Separator" - :type '(string)) - -(defcustom sqlplus-table-col-head-separator "-+-" - "Database table header-column separator (text-only terminals)." - :group 'sqlplus - :tag "SQL*Plus Table Col Separator" - :type '(string)) - -(defcustom sqlplus-html-output-file-name "$HOME/sqlplus_report.html" - "Output file for HTML result." - :group 'sqlplus - :tag "SQL*Plus HTML Output File Name" - :type '(file)) - -(defcustom sqlplus-html-output-encoding "iso-8859-1" - "Encoding for SQL*Plus HTML output." - :group 'sqlplus - :tag "SQL*Plus HTML Output Encoding" - :type '(string)) - -(defcustom sqlplus-html-output-sql t - "Non-nil means put SQL*Plus command in head of HTML result." - :group 'sqlplus - :tag "SQL*Plus HTML Output Encoding" - :type '(choice (const :tag "Elegant" 'elegant) - (const :tag "Simple" t) - (const :tag "No" nil))) - -(defcustom sqlplus-html-output-header (concat (current-time-string) "

") - "HTML header sexp (result must be string)." - :group 'sqlplus - :tag "SQL*Plus HTML Output Header" - :type '(sexp)) - -(defcustom sqlplus-command-highlighting-percentage 7 - "SQL*Plus command highlighting percentage (0-100), only if sqlplus-command-highlighting-style is set." - :group 'sqlplus - :tag "SQL*Plus command highlighting percentage" - :type '(integer)) - -(defcustom sqlplus-command-highlighting-style nil - "How to highlight current command in sqlplus buffer." - :group 'sqlplus - :tag "SQL*Plud command highlighting style" - :type '(choice (const :tag "Fringe" fringe) - (const :tag "Background" background) - (const :tag "Fringe and background" fringe-and-background) - (const :tag "None" nil))) - -(defvar sqlplus-elegant-style window-system) - -(defvar sqlplus-cs nil) - -(defun sqlplus-shine-color (color percent) - (when (equal color "unspecified-bg") - (setq color (if (< percent 0) "white" "black"))) - (apply 'format "#%02x%02x%02x" - (mapcar (lambda (value) - (min 65535 (max 0 (* (+ (/ value 650) percent) 650)))) - (color-values color)))) - -(defvar sqlplus-table-head-face 'sqlplus-table-head-face) -(defface sqlplus-table-head-face - (list - (list '((class mono)) - '(:inherit default :weight bold :inverse-video t)) - (list '((background light)) - (append (list :inherit 'default :background (sqlplus-shine-color (face-background 'default) -70) :foreground (face-background 'default)) - (when (and sqlplus-elegant-style (>= emacs-major-version 22)) '(:box (:style released-button))))) - (list '((background dark)) - (append (list :inherit 'default :background (sqlplus-shine-color (face-background 'default) +70) :foreground (face-background 'default)) - (when (and sqlplus-elegant-style (>= emacs-major-version 22)) '(:box (:style released-button))))) - '(t (:inherit default))) - "Face for table header" - :group 'sqlplus) - -(defvar sqlplus-table-even-rows-face 'sqlplus-table-even-rows-face) -(defface sqlplus-table-even-rows-face - (list - (list '((class mono)) '()) - (list '((type tty)) '()) - (list '((background light)) - (append (list :inherit 'default :background (sqlplus-shine-color (face-background 'default) -20) :overline (face-background 'default)))) - (list '((background dark)) - (append (list :inherit 'default :background (sqlplus-shine-color (face-background 'default) +20) :overline (face-background 'default)))) - '(t ())) - "Face for table even rows" - :group 'sqlplus) - -(defvar sqlplus-table-odd-rows-face 'sqlplus-table-odd-rows-face) -(defface sqlplus-table-odd-rows-face - (list - (list '((class mono)) '(:inherit default)) - (list '((background light)) - (append (list :inherit 'default :background (sqlplus-shine-color (face-background 'default) -30) :overline (face-background 'default)))) - (list '((background dark)) - (append (list :inherit 'default :background (sqlplus-shine-color (face-background 'default) +30) :overline (face-background 'default)))) - '(t (:inherit default))) - "Face for table even rows" - :group 'sqlplus) - -(defvar sqlplus-command-highlight-face 'sqlplus-command-highlight-face) -(defface sqlplus-command-highlight-face - (list - '(((class mono)) ()) - '(((type tty)) ()) - (list '((background light)) - (append (list :background (sqlplus-shine-color (face-background 'default) (- sqlplus-command-highlighting-percentage))))) - (list '((background dark)) - (append (list :background (sqlplus-shine-color (face-background 'default) sqlplus-command-highlighting-percentage)))) - '(t ())) - "Face for highlighting command under point" - :group 'sqlplus) - -(defvar sqlplus-plsql-compilation-results-buffer-name "*PL/SQL Compilation*") - -(defvar sqlplus-fan "|" - "Local in input buffers") -(make-variable-buffer-local 'sqlplus-fan) - -(defvar orcl-mode-map nil - "Keymap used in Orcl mode.") - -(define-minor-mode orcl-mode - "Mode for executing SQL*Plus commands and scrolling results. - -Mode Specific Bindings: - -\\{orcl-mode-map}" - nil ; init value - (" " (:eval sqlplus-fan) " " (:eval (connect-string-to-string))) ; mode indicator - orcl-mode-map ; keymap - ;; body - (setq sqlplus-fan "|") - (unless (assq 'orcl-mode minor-mode-map-alist) - (push (cons 'orcl-mode orcl-mode-map) minor-mode-map-alist))) - -(defvar sqlplus-user-variables (makehash 'equal)) - -(defvar sqlplus-user-variables-history nil) - -(defvar sqlplus-get-source-history nil) - -(defvar sqlplus-process-p nil - "Non-nil (connect string) if current buffer is SQL*Plus process buffer. -Local in process buffer.") -(make-variable-buffer-local 'sqlplus-process-p) - -(defvar sqlplus-command-seq 0 - "Sequence for command id within SQL*Plus connection. -Local in process buffer.") -(make-variable-buffer-local 'sqlplus-command-seq) - -;;; :id - unique command identifier (from sequence, for session) -;;; :sql - content of command -;;; :dont-parse-result - process data online as it comes from sqlplus, with sqlplus-result-online or with :result-function function -;;; :result-function - function for processing sqlplus data; must have signature (context connect-string begin end interrupted); -;;; if nil then it is sqlplus-result-online for :dont-parse-result set to non-nil and sqlplus-process-command-output for :dont-parse-result set to nil -;;; :current-command-input-buffer-name - buffer name from which command was initialized -(defvar sqlplus-command-contexts nil - "Command options list, for current and enqueued commands, in chronological order. -Local in process buffer.") -(make-variable-buffer-local 'sqlplus-command-contexts) - -(defvar sqlplus-connect-string nil - "Local variable with connect-string for current buffer (input buffers, output buffer).") -(make-variable-buffer-local 'sqlplus-connect-string) - -(defvar sqlplus-connect-strings-alist nil - "Connect strings in format (CS . PASSWD), where PASSWD can be nil.") - -(defvar sqlplus-connect-string-history nil) - -(defvar sqlplus-prompt-prefix "SQL[") -(defvar sqlplus-prompt-suffix "]# ") - -(defvar sqlplus-page-separator "@!%#!") - -(defvar sqlplus-repfooter "##%@!") - -(defvar sqlplus-mode-map nil - "Keymap used in SQL*Plus mode.") - -(defvar sqlplus-output-separator "@--" - "String printed between sets of SQL*Plus command output.") - -;;; Markers - - -(defvar sqlplus-buffer-mark (make-marker) - "Marks the current SQL command in the SQL*Plus output buffer. -Local in output buffer.") -(make-variable-buffer-local 'sqlplus-buffer-mark) - -(defvar sqlplus-region-beginning-pos nil - "Marks the beginning of the region to sent to the SQL*Plus process. -Local in input buffer with sqlplus-mode.") -(make-variable-buffer-local 'sqlplus-region-beginning-pos) - -(defvar sqlplus-region-end-pos nil - "Marks the end of the region to sent to the SQL*Plus process. -Local in input buffer with sqlplus-mode.") -(make-variable-buffer-local 'sqlplus-region-end-pos) - -(defvar sqlplus-connections-menu - '("SQL*Plus" - :filter sqlplus-connections-menu) - "Menu for database connections") - -(defconst sqlplus-kill-xpm "\ -/* XPM */ -static char * reload_page_xpm[] = { -\"24 24 100 2\", -\" c None\", -\". c #000000\", -\"+ c #2A5695\", -\"@ c #30609E\", -\"# c #3363A2\", -\"$ c #3969A6\", -\"% c #3D6BA6\", -\"& c #3C68A3\", -\"* c #35619C\", -\"= c #244F8D\", -\"- c #3364A3\", -\"; c #3162A1\", -\"> c #3867A4\", -\", c #3F6DA8\", -\"' c #4672AC\", -\") c #4B76AE\", -\"! c #4E78AF\", -\"~ c #537CB1\", -\"{ c #547DB0\", -\"] c #446BA1\", -\"^ c #2E5D9C\", -\"/ c #234F8C\", -\"( c #214C89\", -\"_ c #244E8C\", -\": c #3A649D\", -\"< c #517BB0\", -\"[ c #517BB1\", -\"} c #4874AD\", -\"| c #6086B7\", -\"1 c #5F84B4\", -\"2 c #4B71A6\", -\"3 c #7B9BC4\", -\"4 c #224C89\", -\"5 c #3865A2\", -\"6 c #406FAB\", -\"7 c #436BA3\", -\"8 c #648ABA\", -\"9 c #4D78AF\", -\"0 c #4B77AE\", -\"a c #6E91BE\", -\"b c #809EC6\", -\"c c #204A87\", -\"d c #4974AF\", -\"e c #2B5590\", -\"f c #6487B5\", -\"g c #678CBB\", -\"h c #3465A4\", -\"i c #84A1C8\", -\"j c #6D8FBA\", -\"k c #4F7AB0\", -\"l c #8BA7CB\", -\"m c #7E9DC5\", -\"n c #83A1C7\", -\"o c #91ACCE\", -\"p c #89A4C9\", -\"q c #8FA9CB\", -\"r c #85A2C7\", -\"s c #90ABCC\", -\"t c #3E6CA8\", -\"u c #87A3C8\", -\"v c #4B6DA1\", -\"w c #91ABCD\", -\"x c #3768A5\", -\"y c #8AA5C9\", -\"z c #2D5690\", -\"A c #204A86\", -\"B c #93ADCE\", -\"C c #7294BF\", -\"D c #6288B9\", -\"E c #86A3C8\", -\"F c #466EA3\", -\"G c #3864A1\", -\"H c #285390\", -\"I c #234E8C\", -\"J c #95AECF\", -\"K c #7493BC\", -\"L c #86A2C7\", -\"M c #7999C3\", -\"N c #5B82B5\", -\"O c #6C8EBB\", -\"P c #4B71A5\", -\"Q c #26508B\", -\"R c #2B5792\", -\"S c #305E9B\", -\"T c #31619F\", -\"U c #7895BD\", -\"V c #819DC3\", -\"W c #688DBB\", -\"X c #6288B8\", -\"Y c #5880B4\", -\"Z c #577FB3\", -\"` c #547DB2\", -\" . c #416FAA\", -\".. c #3564A2\", -\"+. c #577AAB\", -\"@. c #6286B6\", -\"#. c #668BBA\", -\"$. c #507AB0\", -\"%. c #426EA8\", -\"&. c #2F5B97\", -\" \", -\" \", -\" \", -\" . . . . . . . . \", -\" . . + @ # $ % & * . . . . \", -\" . = - ; @ > , ' ) ! ~ { . . . ] . \", -\" . ^ / ( _ . . . : < [ } | 1 2 3 . \", -\" . _ 4 5 6 . . . 7 8 9 0 a b . \", -\" . c d . . . e f g h i . \", -\" . . . . . j k h l . \", -\" . . f m n l o . \", -\" . . . . . . . . \", -\" . . . . . . . . \", -\" . p q q q r . . \", -\" . s , t u v . . . . \", -\" . w x | y z . . . . A . \", -\" . B C 9 D E F . . . G H I . \", -\" . J K L M N C O P . . . Q R S T . \", -\" . U . . . V W X | Y Z ` ) .... \", -\" . . . . +.@.#.N $.%.&.. . \", -\" . . . . . . . . \", -\" \", -\" \", -\" \"}; -" - "XPM format image used as Kill icon") - -(defconst sqlplus-cancel-xpm "\ -/* XPM */ -static char * process_stop_xpm[] = { -\"24 24 197 2\", -\" c None\", -\". c #000000\", -\"+ c #C92B1E\", -\"@ c #DA432F\", -\"# c #E95941\", -\"$ c #F26B50\", -\"% c #ED6047\", -\"& c #DF4A35\", -\"* c #CE3324\", -\"= c #BF1D13\", -\"- c #EA5942\", -\"; c #EF563A\", -\"> c #F14D2C\", -\", c #F1431F\", -\"' c #F23A12\", -\") c #F2421C\", -\"! c #F24D2A\", -\"~ c #F15737\", -\"{ c #F0644A\", -\"] c #CF3121\", -\"^ c #D83828\", -\"/ c #ED5840\", -\"( c #EC3B1C\", -\"_ c #EE310B\", -\": c #F1350C\", -\"< c #F4380D\", -\"[ c #F53A0D\", -\"} c #F53B0D\", -\"| c #F4390D\", -\"1 c #F2360C\", -\"2 c #EF3A15\", -\"3 c #F05A3D\", -\"4 c #E44D37\", -\"5 c #CD2B1E\", -\"6 c #EA4D35\", -\"7 c #E92D0C\", -\"8 c #ED2F0B\", -\"9 c #F0330C\", -\"0 c #F3380D\", -\"a c #F63C0E\", -\"b c #F93F0F\", -\"c c #F9400F\", -\"d c #F73D0E\", -\"e c #F1340C\", -\"f c #EE300B\", -\"g c #EC482C\", -\"h c #E04532\", -\"i c #E84E3A\", -\"j c #E62A0E\", -\"k c #EA2B0A\", -\"l c #F83F0E\", -\"m c #FC4310\", -\"n c #FC4410\", -\"o c #F63B0E\", -\"p c #EB2C0A\", -\"q c #EB5139\", -\"r c #C8251A\", -\"s c #DD3D2E\", -\"t c #E5341D\", -\"u c #E62508\", -\"v c #F9BEB2\", -\"w c #FBCFC5\", -\"x c #F54C23\", -\"y c #F95125\", -\"z c #FDD4CB\", -\"A c #FABFB2\", -\"B c #E83013\", -\"C c #E84F3B\", -\"D c #E54737\", -\"E c #E22007\", -\"F c #E92A09\", -\"G c #FBD2CA\", -\"H c #FFFFFF\", -\"I c #FDDFD9\", -\"J c #F64E24\", -\"K c #FDE0D9\", -\"L c #E72609\", -\"M c #E7452F\", -\"N c #E33D2D\", -\"O c #E11E07\", -\"P c #E52308\", -\"Q c #E82809\", -\"R c #EC3F21\", -\"S c #FCDED8\", -\"T c #F55C37\", -\"U c #FCDFD8\", -\"V c #F04521\", -\"W c #EC2E0A\", -\"X c #E92909\", -\"Y c #E62408\", -\"Z c #E53823\", -\"` c #CE2B1F\", -\" . c #C62018\", -\".. c #E03120\", -\"+. c #E01C06\", -\"@. c #E32107\", -\"#. c #ED4121\", -\"$. c #FEF9F8\", -\"%. c #E72709\", -\"&. c #E42208\", -\"*. c #E32D17\", -\"=. c #D83729\", -\"-. c #CB231B\", -\";. c #DE2A1B\", -\">. c #DE1A06\", -\",. c #EE5135\", -\"'. c #EF5335\", -\"). c #EC2D0A\", -\"!. c #E82709\", -\"~. c #E21F07\", -\"{. c #E02511\", -\"]. c #DC392C\", -\"^. c #BE1612\", -\"/. c #DD2E21\", -\"(. c #DC1705\", -\"_. c #DF1B06\", -\":. c #E42308\", -\"<. c #E93A20\", -\"[. c #FBDDD8\", -\"}. c #EB3D20\", -\"|. c #DF2A18\", -\"1. c #D02A1F\", -\"2. c #DC3328\", -\"3. c #DA1404\", -\"4. c #DD1805\", -\"5. c #E3331E\", -\"6. c #FADCD8\", -\"7. c #FBDCD8\", -\"8. c #EB4C34\", -\"9. c #E6361F\", -\"0. c #DD1905\", -\"a. c #DF2F21\", -\"b. c #C21A14\", -\"c. c #DA3128\", -\"d. c #D81408\", -\"e. c #F7C9C4\", -\"f. c #FADBD8\", -\"g. c #E5341E\", -\"h. c #E5351E\", -\"i. c #F8CEC9\", -\"j. c #DB1505\", -\"k. c #DD3429\", -\"l. c #C31613\", -\"m. c #D9281F\", -\"n. c #D71003\", -\"o. c #D91304\", -\"p. c #F3B5B0\", -\"q. c #F7CDC9\", -\"r. c #E12F1D\", -\"s. c #DF1C06\", -\"t. c #E2301D\", -\"u. c #F4B6B0\", -\"v. c #DC1605\", -\"w. c #DB2317\", -\"x. c #D2271F\", -\"y. c #D1231D\", -\"z. c #D61A10\", -\"A. c #D60F03\", -\"B. c #D81104\", -\"C. c #DB1605\", -\"D. c #D81204\", -\"E. c #D81509\", -\"F. c #DA2F26\", -\"G. c #D52620\", -\"H. c #D51A12\", -\"I. c #D50D03\", -\"J. c #D60E03\", -\"K. c #D6170D\", -\"L. c #D92B23\", -\"M. c #BD100D\", -\"N. c #AB0404\", -\"O. c #CE1D19\", -\"P. c #D6231C\", -\"Q. c #D41008\", -\"R. c #D40B02\", -\"S. c #D40C02\", -\"T. c #D50C03\", -\"U. c #D40E05\", -\"V. c #D62018\", -\"W. c #D4251F\", -\"X. c #B30A09\", -\"Y. c #A20000\", -\"Z. c #BC0F0E\", -\"`. c #D2211E\", -\" + c #D52520\", -\".+ c #D5201A\", -\"++ c #D41A14\", -\"@+ c #D51F19\", -\"#+ c #D62620\", -\"$+ c #D52420\", -\"%+ c #C51614\", -\"&+ c #A30101\", -\"*+ c #A30303\", -\"=+ c #AE0909\", -\"-+ c #BD0E0E\", -\";+ c #B30B0B\", -\">+ c #A30404\", -\" \", -\" . . . . . . . \", -\" . . + @ # $ % & * . . \", -\" . = - ; > , ' ) ! ~ { ] . \", -\" . ^ / ( _ : < [ } | 1 2 3 4 . \", -\" . 5 6 7 8 9 0 a b c d | e f g h . \", -\" . i j k f : [ l m n c o 1 _ p q r . \", -\" . s t u k v w x l m n y z A _ p B C . \", -\" . D E u F G H I J b y K H w f k L M . \", -\" . N O P Q R S H I T K H U V W X Y Z ` . \", -\" . ...+.@.u F #.S H $.H U V 8 k %.&.*.=.. \", -\" . -.;.>.O &.L F ,.$.H $.'.).k !.P ~.{.].. \", -\" . ^./.(._.~.:.<.[.H $.H [.}.L P E +.|.1.. \", -\" . 2.3.4._.5.6.H 7.8.7.H 6.9.~.+.0.a.b.. \", -\" . c.d.3.(.e.H f.g.@.h.6.H i._.4.j.k.. \", -\" . l.m.n.o.p.q.r._.s.s.t.e.u.v.3.w.x.. \", -\" . y.z.A.B.o.j.C.(.(.v.j.3.D.E.F.. \", -\" . G.H.I.J.n.B.B.B.B.n.A.K.L.M.. \", -\" . N.O.P.Q.R.S.T.T.S.U.V.W.X.. \", -\" . Y.Z.`. +.+++@+#+$+%+&+. \", -\" . . . *+=+-+;+>+Y.. . \", -\" . . . . . . \", -\" \", -\" \"}; -" - "XPM format image used as Cancel icon") - -(defconst sqlplus-rollback-xpm "\ -/* XPM */ -static char * rollback_xpm[] = { -\"24 24 228 2\", -\" c None\", -\". c #000000\", -\"+ c #F8F080\", -\"@ c #FEF57B\", -\"# c #FFF571\", -\"$ c #FFF164\", -\"% c #FFED58\", -\"& c #FFE748\", -\"* c #FEDE39\", -\"= c #F8F897\", -\"- c #FFFE96\", -\"; c #FFFA8A\", -\"> c #FFF67C\", -\", c #FFF16E\", -\"' c #FFEC62\", -\") c #FFE956\", -\"! c #FFE448\", -\"~ c #FFE03C\", -\"{ c #FFDD30\", -\"] c #FED821\", -\"^ c #F1CB15\", -\"/ c #FFFC92\", -\"( c #FFFC91\", -\"_ c #FFFC90\", -\": c #FFFB8D\", -\"< c #FFF67D\", -\"[ c #FFEB5E\", -\"} c #FFEA5B\", -\"| c #FFE958\", -\"1 c #FFE855\", -\"2 c #FFE752\", -\"3 c #FDD41C\", -\"4 c #FDD319\", -\"5 c #FDD416\", -\"6 c #FFFF9D\", -\"7 c #FFFF99\", -\"8 c #FFFD94\", -\"9 c #FFFA89\", -\"0 c #FFDC2F\", -\"a c #FED315\", -\"b c #FFD808\", -\"c c #FFFC9F\", -\"d c #FFFE99\", -\"e c #FFDF3B\", -\"f c #F7C909\", -\"g c #F8EA86\", -\"h c #FEFCB7\", -\"i c #FFFDA6\", -\"j c #FFFA91\", -\"k c #FFF681\", -\"l c #FFF171\", -\"m c #FFED64\", -\"n c #FFE44A\", -\"o c #FFE03D\", -\"p c #FEDB2F\", -\"q c #F9D21E\", -\"r c #E9BC0F\", -\"s c #CE9C02\", -\"t c #F3E36A\", -\"u c #FCF899\", -\"v c #FFFCA3\", -\"w c #FEF694\", -\"x c #FFF284\", -\"y c #FFEE71\", -\"z c #FFEA62\", -\"A c #FDDC40\", -\"B c #F8D22F\", -\"C c #F1C61B\", -\"D c #DDAD0A\", -\"E c #CC9A02\", -\"F c #C89500\", -\"G c #F4EA77\", -\"H c #F7EF7F\", -\"I c #FFF16A\", -\"J c #FFEF68\", -\"K c #FFEE66\", -\"L c #FED622\", -\"M c #FED51E\", -\"N c #FED419\", -\"O c #E9B90E\", -\"P c #E7B509\", -\"Q c #D4A202\", -\"R c #CA9700\", -\"S c #F6E67C\", -\"T c #F3E67F\", -\"U c #FCEE7A\", -\"V c #FDEB66\", -\"W c #FEE44E\", -\"X c #FED313\", -\"Y c #FDCA03\", -\"Z c #F2BE01\", -\"` c #D4A60D\", -\" . c #D4A206\", -\".. c #D19C00\", -\"+. c #CF9800\", -\"@. c #E3AF02\", -\"#. c #F9EB81\", -\"$. c #FBF096\", -\"%. c #F9E67C\", -\"&. c #F8DC5F\", -\"*. c #F8D548\", -\"=. c #F9D02D\", -\"-. c #F9C915\", -\";. c #F7C104\", -\">. c #EEB606\", -\",. c #E9B704\", -\"'. c #DEAE08\", -\"). c #414D7B\", -\"!. c #3C5CA2\", -\"~. c #3A65B3\", -\"{. c #3668BB\", -\"]. c #325EAF\", -\"^. c #F3E46E\", -\"/. c #FCFA9B\", -\"(. c #FFF89C\", -\"_. c #FDEC81\", -\":. c #FCE668\", -\"<. c #FDDF4E\", -\"[. c #FCDA3C\", -\"}. c #FCD52E\", -\"|. c #FAD026\", -\"1. c #4662A2\", -\"2. c #465A8D\", -\"3. c #3F6CBA\", -\"4. c #3A68B7\", -\"5. c #2E529E\", -\"6. c #2655AC\", -\"7. c #F0DC69\", -\"8. c #FBF78C\", -\"9. c #FFF880\", -\"0. c #FFF06B\", -\"a. c #FFE03E\", -\"b. c #FFD828\", -\"c. c #FED015\", -\"d. c #F5C40A\", -\"e. c #4B70B4\", -\"f. c #4870B7\", -\"g. c #3C5CA1\", -\"h. c #4070BF\", -\"i. c #3759A0\", -\"j. c #1D469C\", -\"k. c #214493\", -\"l. c #F2DD6C\", -\"m. c #F8EB7E\", -\"n. c #FBEE7A\", -\"o. c #FBE461\", -\"p. c #FADB48\", -\"q. c #FBD631\", -\"r. c #FED10F\", -\"s. c #FECD07\", -\"t. c #F1BD00\", -\"u. c #456AAE\", -\"v. c #4C7ECA\", -\"w. c #487AC8\", -\"x. c #35528F\", -\"y. c #1B4294\", -\"z. c #1B4193\", -\"A. c #F9EA83\", -\"B. c #FCF08E\", -\"C. c #F6E16E\", -\"D. c #F4D559\", -\"E. c #F5CF45\", -\"F. c #F6CB2E\", -\"G. c #F8C611\", -\"H. c #F6C005\", -\"I. c #E8B300\", -\"J. c #4268AE\", -\"K. c #4375C4\", -\"L. c #3F71C1\", -\"M. c #33569B\", -\"N. c #173F94\", -\"O. c #183A8B\", -\"P. c #F3E36E\", -\"Q. c #FCF7A1\", -\"R. c #FEF9A1\", -\"S. c #FEEE7D\", -\"T. c #FCE360\", -\"U. c #FAD946\", -\"V. c #F9D132\", -\"W. c #F8CD26\", -\"X. c #F7CA20\", -\"Y. c #3B589A\", -\"Z. c #395FA9\", -\"`. c #3359A5\", -\" + c #3056A3\", -\".+ c #2B468D\", -\"++ c #0A3897\", -\"@+ c #E6D465\", -\"#+ c #FDFA90\", -\"$+ c #FFF885\", -\"%+ c #FFF074\", -\"&+ c #FFEA60\", -\"*+ c #FFE246\", -\"=+ c #FFDC31\", -\"-+ c #FED51F\", -\";+ c #F7CB14\", -\">+ c #173788\", -\",+ c #063494\", -\"'+ c #E8DE7B\", -\")+ c #FFFA86\", -\"!+ c #FFF26A\", -\"~+ c #FFE84F\", -\"{+ c #FFD415\", -\"]+ c #FDCC04\", -\"^+ c #F3C001\", -\"/+ c #EBB600\", -\"(+ c #E3AF01\", -\"_+ c #D7A100\", -\":+ c #2D3E7F\", -\"<+ c #033396\", -\"[+ c #CFB954\", -\"}+ c #DBC347\", -\"|+ c #DEBF2C\", -\"1+ c #DFB718\", -\"2+ c #DFB206\", -\"3+ c #D6A505\", -\"4+ c #C6970A\", -\"5+ c #B48413\", -\"6+ c #374682\", -\"7+ c #023398\", -\"8+ c #0E3287\", -\"9+ c #253775\", -\"0+ c #05318F\", -\"a+ c #10358B\", -\"b+ c #183888\", -\"c+ c #053495\", -\"d+ c #0E348D\", -\"e+ c #183585\", -\" . . . . . . . \", -\" . . + @ # $ % & * . . . \", -\" . = - ; > , ' ) ! ~ { ] ^ . \", -\". / ( _ : ; < [ } | 1 2 3 4 5 . \", -\". 6 7 8 9 > , ' ) ! ~ 0 ] a b . \", -\". c d 8 9 > , ' ) ! e 0 ] a f . \", -\". g h i j k l m | n o p q r s . \", -\". t u v w x y z 2 A B C D E F . \", -\". G H I J K L M N O P Q R F F . \", -\". S T U V W p X Y Z ` ...+.@.. . . . . \", -\". #.$.%.&.*.=.-.;.>.. . ,.'.. ).!.~.{.].. \", -\". ^./.(._.:.<.[.}.|.. 1.. . 2.3.4.. . 5.6.. \", -\". 7.8.9.0.) a.b.c.d.. e.f.g.h.i.. . j.k.. \", -\". l.m.n.o.p.q.r.s.t.. u.v.w.x.. . y.z.. \", -\". A.B.C.D.E.F.G.H.I.. J.K.L.M.. . N.O.. \", -\". P.Q.R.S.T.U.V.W.X.. Y.Z.`. +.+. . ++. \", -\". @+#+$+%+&+*+=+-+;+. . . . . . . . >+,+. \", -\" . '+)+!+~+{ {+]+^+/+(+_+. . :+<+. \", -\" . . [+}+|+1+2+3+4+5+. . 6+7+8+. \", -\" . . . . . . . . . 9+0+a+. \", -\" . b+c+d+. \", -\" . e+. . \", -\" . \", -\" \"}; -" - "XPM format image used as Rollback icon") - -(defconst sqlplus-commit-xpm "\ -/* XPM */ -static char * commit_xpm[] = { -\"24 24 276 2\", -\" c None\", -\". c #000000\", -\"+ c #FDF57D\", -\"@ c #FFF676\", -\"# c #FFF36C\", -\"$ c #FFF05D\", -\"% c #FFEB51\", -\"& c #FFE445\", -\"* c #FDDC35\", -\"= c #EFEA85\", -\"- c #FBF68D\", -\"; c #FCF482\", -\"> c #FCF178\", -\", c #FCEE6E\", -\"' c #FCEB66\", -\") c #FCE85B\", -\"! c #FCE551\", -\"~ c #FDE147\", -\"{ c #FDDF3D\", -\"] c #FEDD2D\", -\"^ c #FCD621\", -\"/ c #E5BF16\", -\"( c #D8D479\", -\"_ c #FCF587\", -\": c #FAEF78\", -\"< c #FAEA6B\", -\"[ c #FAEA6A\", -\"} c #FAE968\", -\"| c #FAE967\", -\"1 c #FAE865\", -\"2 c #FAE864\", -\"3 c #FDDD3C\", -\"4 c #FED621\", -\"5 c #FFD51D\", -\"6 c #FFD51B\", -\"7 c #FFD519\", -\"8 c #D8B82B\", -\"9 c #FCF790\", -\"0 c #FBF587\", -\"a c #F8EF7D\", -\"b c #F8EC75\", -\"c c #F7E86B\", -\"d c #F8E868\", -\"e c #F9E663\", -\"f c #F9E45A\", -\"g c #F9E253\", -\"h c #F9E04C\", -\"i c #FBDD40\", -\"j c #FBDB38\", -\"k c #FAD933\", -\"l c #FAD529\", -\"m c #FDD810\", -\"n c #FFFD9E\", -\"o c #FFFF9A\", -\"p c #FFFE96\", -\"q c #FFFB8C\", -\"r c #FFF781\", -\"s c #FFF375\", -\"t c #FFEF69\", -\"u c #FFEA5B\", -\"v c #FFE750\", -\"w c #FFE345\", -\"x c #FFDF38\", -\"y c #FFDB2B\", -\"z c #FFD81F\", -\"A c #FFD313\", -\"B c #FBD007\", -\"C c #FBF090\", -\"D c #FFFDAE\", -\"E c #FFFEA2\", -\"F c #FFFA8C\", -\"G c #FFF780\", -\"H c #F6CA11\", -\"I c #E1AF03\", -\"J c #F4E36D\", -\"K c #FCF7A4\", -\"L c #FFFEBB\", -\"M c #FEFAA6\", -\"N c #FFF990\", -\"O c #FFF57E\", -\"P c #FFEE6F\", -\"Q c #FFEB61\", -\"R c #FFE856\", -\"S c #FFE34A\", -\"T c #FBDD44\", -\"U c #F7D535\", -\"V c #EBBF13\", -\"W c #D5A406\", -\"X c #C99500\", -\"Y c #F0DC5F\", -\"Z c #F3E772\", -\"` c #F7EC76\", -\" . c #F6E56D\", -\".. c #F6E369\", -\"+. c #F6E264\", -\"@. c #F5DF5C\", -\"#. c #F3DB53\", -\"$. c #F3D849\", -\"%. c #EFD245\", -\"&. c #ECCE3F\", -\"*. c #E3B91F\", -\"=. c #D3A40B\", -\"-. c #C99600\", -\";. c #C69200\", -\">. c #EED95E\", -\",. c #EDDA60\", -\"'. c #F1DF64\", -\"). c #F2DF5E\", -\"!. c #F2DD57\", -\"~. c #F2D94E\", -\"{. c #F2D644\", -\"]. c #EFD038\", -\"^. c #ECCB34\", -\"/. c #E6C430\", -\"(. c #DFB71F\", -\"_. c #D9AD17\", -\":. c #CC9907\", -\"<. c #C69000\", -\"[. c #D39E00\", -\"}. c #BB1503\", -\"|. c #F9EA7D\", -\"1. c #F6E57A\", -\"2. c #F5E370\", -\"3. c #F5DE62\", -\"4. c #F9DF52\", -\"5. c #FBDB3E\", -\"6. c #FCD526\", -\"7. c #FCCE0F\", -\"8. c #F7C50A\", -\"9. c #EEBA08\", -\"0. c #E2AB03\", -\"a. c #D7A000\", -\"b. c #D59D00\", -\"c. c #DFA901\", -\"d. c #E7B402\", -\"e. c #C91800\", -\"f. c #F6E676\", -\"g. c #FCF4A1\", -\"h. c #FDF096\", -\"i. c #FAE167\", -\"j. c #F7D64F\", -\"k. c #F7CF38\", -\"l. c #F7CB26\", -\"m. c #F6BF0C\", -\"n. c #F1B905\", -\"o. c #ECB309\", -\"p. c #EBB60A\", -\"q. c #F0BF0B\", -\"r. c #F3C206\", -\"s. c #E5B201\", -\"t. c #CF9C01\", -\"u. c #C21602\", -\"v. c #C21703\", -\"w. c #F2E067\", -\"x. c #FBF78F\", -\"y. c #FEF28A\", -\"z. c #FEED74\", -\"A. c #FFE85F\", -\"B. c #FFE24D\", -\"C. c #FFDE3A\", -\"D. c #FED92F\", -\"E. c #FCD325\", -\"F. c #F8CD1A\", -\"G. c #EDBD0A\", -\"H. c #D9A701\", -\"I. c #C79200\", -\"J. c #D11D00\", -\"K. c #EFDA64\", -\"L. c #F7EF7F\", -\"M. c #FCF47F\", -\"N. c #FDEE6C\", -\"O. c #FDE85B\", -\"P. c #FDE249\", -\"Q. c #FDDC36\", -\"R. c #FCD423\", -\"S. c #F9CC14\", -\"T. c #F0C10E\", -\"U. c #E6B507\", -\"V. c #DCA900\", -\"W. c #D29F00\", -\"X. c #C69400\", -\"Y. c #C99200\", -\"Z. c #CC1B02\", -\"`. c #C61A04\", -\" + c #E1CF5F\", -\".+ c #EAD862\", -\"++ c #ECDB63\", -\"@+ c #EFDC5E\", -\"#+ c #EFD955\", -\"$+ c #EFD74D\", -\"%+ c #EFD444\", -\"&+ c #F0D23E\", -\"*+ c #EECE37\", -\"=+ c #E8C731\", -\"-+ c #E0B922\", -\";+ c #D09E03\", -\">+ c #CB9700\", -\",+ c #C39100\", -\"'+ c #C99400\", -\")+ c #E12400\", -\"!+ c #F2E47C\", -\"~+ c #F8ED8C\", -\"{+ c #F4E171\", -\"]+ c #F0D65B\", -\"^+ c #F0D24F\", -\"/+ c #F1CF43\", -\"(+ c #F2CD34\", -\"_+ c #F2C824\", -\":+ c #EEC527\", -\"<+ c #E7BD23\", -\"[+ c #DFAC12\", -\"}+ c #DAA203\", -\"|+ c #E5B202\", -\"1+ c #EDBA01\", -\"2+ c #D69F00\", -\"3+ c #D21E01\", -\"4+ c #D01C00\", -\"5+ c #F2E16A\", -\"6+ c #FBF59D\", -\"7+ c #FEFBAA\", -\"8+ c #FEF084\", -\"9+ c #FCE567\", -\"0+ c #FBDD50\", -\"a+ c #F8D23B\", -\"b+ c #F8CD28\", -\"c+ c #EEB51C\", -\"d+ c #DA8A13\", -\"e+ c #E29A16\", -\"f+ c #EDB111\", -\"g+ c #E5AE08\", -\"h+ c #D19C01\", -\"i+ c #C79400\", -\"j+ c #BF1603\", -\"k+ c #DD2300\", -\"l+ c #E6D261\", -\"m+ c #FCF88C\", -\"n+ c #FFF27A\", -\"o+ c #FFEC6A\", -\"p+ c #FFE655\", -\"q+ c #FFE041\", -\"r+ c #FFDA2B\", -\"s+ c #E49D14\", -\"t+ c #BA4F02\", -\"u+ c #BB6A00\", -\"v+ c #B37102\", -\"w+ c #DD2200\", -\"x+ c #CA1B02\", -\"y+ c #E6DB78\", -\"z+ c #FEFB8B\", -\"A+ c #FFF470\", -\"B+ c #FFEA56\", -\"C+ c #FFE13E\", -\"D+ c #FFDA24\", -\"E+ c #FECF0A\", -\"F+ c #F5BE01\", -\"G+ c #D37800\", -\"H+ c #D72000\", -\"I+ c #C61802\", -\"J+ c #EBD55C\", -\"K+ c #FCE353\", -\"L+ c #FFE33E\", -\"M+ c #FFDB26\", -\"N+ c #FFD20B\", -\"O+ c #FCCB01\", -\"P+ c #F0B900\", -\"Q+ c #D47D00\", -\"R+ c #E42500\", -\"S+ c #EB2900\", -\"T+ c #DF2301\", -\"U+ c #E82700\", -\"V+ c #D31F04\", -\"W+ c #C71F01\", -\"X+ c #EA2800\", -\"Y+ c #E92800\", -\"Z+ c #DD2301\", -\"`+ c #E22501\", -\" . . . . . . . \", -\" . . . + @ # $ % & * . . . \", -\" . = - ; > , ' ) ! ~ { ] ^ / . \", -\". ( _ : < [ } | 1 2 3 4 5 6 7 8 . \", -\". 9 0 a b c d e f g h i j k l m . \", -\". n o p q r s t u v w x y z A B . \", -\". C D E F G s t u v w x y z H I . \", -\". J K L M N O P Q R S T U V W X . \", -\". Y Z ` ...+.@.#.$.%.&.*.=.-.;.. . . \", -\". >.,.'.).!.~.{.].^./.(._.:.<.[.. . }.. \", -\". |.1.2.3.4.5.6.7.8.9.0.a.b.c.d.. . e.. \", -\". f.g.h.i.j.k.l.m.n.o.p.q.r.s.t.. . u.v.. \", -\". w.x.n y.z.A.B.C.D.E.F.G.H.-.I.. . J.. \", -\". K.L.M.N.O.P.Q.R.S.T.U.V.W.X.Y.. . Z.`.. \", -\". +.+++@+#+$+%+&+*+=+-+;+>+,+'+. . )+. \", -\". !+~+{+]+^+/+(+_+:+<+[+}+|+1+2+. . 3+4+. \", -\". 5+6+7+8+9+0+a+b+c+d+e+f+g+h+i+. j+k+. \", -\". l+m+q n+o+p+q+r+s+. . . t+u+v+. w+x+. \", -\" . y+z+A+B+C+D+E+F+G+. H+. . . I+)+. \", -\" . . J+K+L+M+N+O+P+Q+. R+S+T+U+V+. \", -\" . . . . . . . . . . W+X+Y+. \", -\" . Z+`+. \", -\" . . \", -\" . \"}; -" - "XPM format image used as Commit icon") - -(defconst plsql-prev-mark-xpm "\ -/* XPM */ -static char * go_previous_xpm[] = { -\"24 24 59 1\", -\" c None\", -\". c #000000\", -\"+ c #355D96\", -\"@ c #3C639B\", -\"# c #6E92BF\", -\"$ c #41679D\", -\"% c #6990BE\", -\"& c #6D94C2\", -\"* c #456DA2\", -\"= c #628BBC\", -\"- c #4D7BB4\", -\"; c #6991C0\", -\"> c #4971A6\", -\", c #5D87BA\", -\"' c #4B7BB3\", -\") c #4979B3\", -\"! c #5884B9\", -\"~ c #638CBC\", -\"{ c #638BBC\", -\"] c #6089BA\", -\"^ c #4B73A9\", -\"/ c #5883B8\", -\"( c #4A7AB3\", -\"_ c #618ABB\", -\": c #4C74AB\", -\"< c #547FB5\", -\"[ c #4972A9\", -\"} c #4D79B1\", -\"| c #4171AD\", -\"1 c #4071AD\", -\"2 c #4070AD\", -\"3 c #4171AC\", -\"4 c #4071AC\", -\"5 c #4070AC\", -\"6 c #3F70AC\", -\"7 c #3F70AB\", -\"8 c #406FAC\", -\"9 c #5781B5\", -\"0 c #4A74AC\", -\"a c #3E6CA8\", -\"b c #3465A4\", -\"c c #4E78AF\", -\"d c #446FA8\", -\"e c #4A75AD\", -\"f c #3F6CA6\", -\"g c #3C6BA7\", -\"h c #3B6BA7\", -\"i c #4471AB\", -\"j c #4572AB\", -\"k c #4672AC\", -\"l c #4571AB\", -\"m c #3A68A3\", -\"n c #3B6AA7\", -\"o c #406EA9\", -\"p c #3564A0\", -\"q c #3868A6\", -\"r c #305E9D\", -\"s c #3767A5\", -\"t c #2E5D9B\", -\" \", -\" \", -\" \", -\" .. \", -\" .+. \", -\" .@#. \", -\" .$%&. \", -\" .*=-;......... \", -\" .>,')!~{{{{{~]. \", -\" .^/()))(((((('_. \", -\" .:<)))))))))))),. \", -\" .[}|1123455567589. \", -\" .0abbbbbbbbbbbbc. \", -\" .dabbbbbbbbbbbe. \", -\" .fgbbhijjjjjkl. \", -\" .mnbo......... \", -\" .pqh. \", -\" .rs. \", -\" .t. \", -\" .. \", -\" . \", -\" \", -\" \", -\" \"}; -" - "XPM format image used as Previous Mark icon") - -(defconst plsql-next-mark-xpm "\ -/* XPM */ -static char * go_next_xpm[] = { -\"24 24 63 1\", -\" c None\", -\". c #000000\", -\"+ c #365F97\", -\"@ c #6B8FBE\", -\"# c #41689E\", -\"$ c #6990BF\", -\"% c #466EA4\", -\"& c #678EBD\", -\"* c #4E7DB5\", -\"= c #638CBC\", -\"- c #4B72A7\", -\"; c #5B83B5\", -\"> c #628BBB\", -\", c #5A86BA\", -\"' c #4979B3\", -\") c #4B7AB3\", -\"! c #5E87B9\", -\"~ c #4E76AA\", -\"{ c #5B84B8\", -\"] c #4E7CB5\", -\"^ c #4A7AB3\", -\"/ c #5883B7\", -\"( c #5178AD\", -\"_ c #5982B6\", -\": c #4C7BB4\", -\"< c #537FB5\", -\"[ c #5079AE\", -\"} c #507BB0\", -\"| c #4272AD\", -\"1 c #4070AC\", -\"2 c #3F70AB\", -\"3 c #3F70AC\", -\"4 c #4071AC\", -\"5 c #4171AC\", -\"6 c #4070AD\", -\"7 c #4071AD\", -\"8 c #4171AD\", -\"9 c #4D79B1\", -\"0 c #4E76AD\", -\"a c #4872AA\", -\"b c #3767A5\", -\"c c #3465A4\", -\"d c #3D6CA8\", -\"e c #4C76AD\", -\"f c #2B548E\", -\"g c #446FA8\", -\"h c #3C6BA7\", -\"i c #4772AA\", -\"j c #29528E\", -\"k c #3F6CA6\", -\"l c #4471AB\", -\"m c #4371AB\", -\"n c #3B6BA7\", -\"o c #416EA8\", -\"p c #3F6CA7\", -\"q c #3A69A6\", -\"r c #3C6AA5\", -\"s c #3B6AA5\", -\"t c #3868A6\", -\"u c #3765A2\", -\"v c #3666A3\", -\"w c #32619F\", -\"x c #2F5D9B\", -\" \", -\" \", -\" \", -\" .. \", -\" .+. \", -\" .@#. \", -\" .$$%. \", -\" .........&*=-. \", -\" .;>>>>>>=,')!~. \", -\" .{]^^^^^^''''/(. \", -\" ._:'''''''''''<[. \", -\" .}|12311145677890. \", -\" .abcccccccccccde. \", -\" .gbcccccccccchi. \", -\" .klmlllllhccno. \", -\" .........pcqr. \", -\" .stu. \", -\" .vw. \", -\" .x. \", -\" .. \", -\" . \", -\" \", -\" \", -\" \"}; -" - "XPM format image used as Next Mark icon") - -(defconst sqlplus-kill-image - (create-image sqlplus-kill-xpm 'xpm t)) - -(defconst sqlplus-cancel-image - (create-image sqlplus-cancel-xpm 'xpm t)) - -(defconst sqlplus-commit-image - (create-image sqlplus-commit-xpm 'xpm t)) - -(defconst sqlplus-rollback-image - (create-image sqlplus-rollback-xpm 'xpm t)) - -(defconst plsql-prev-mark-image - (create-image plsql-prev-mark-xpm 'xpm t)) - -(defconst plsql-next-mark-image - (create-image plsql-next-mark-xpm 'xpm t)) - -(defvar sqlplus-mode-syntax-table nil - "Syntax table used while in sqlplus-mode.") - -(defvar sqlplus-suppress-show-output-buffer nil) - -;; Local in input buffers -(defvar sqlplus-font-lock-keywords-1 nil) -(make-variable-buffer-local 'sqlplus-font-lock-keywords-1) -(defvar sqlplus-font-lock-keywords-2 nil) -(make-variable-buffer-local 'sqlplus-font-lock-keywords-2) -(defvar sqlplus-font-lock-keywords-3 nil) -(make-variable-buffer-local 'sqlplus-font-lock-keywords-3) - -(defvar sqlplus-font-lock-defaults '((sqlplus-font-lock-keywords-1 sqlplus-font-lock-keywords-2 sqlplus-font-lock-keywords-3) nil t nil nil)) - -(defvar sqlplus-oracle-extra-builtin-functions-re - (concat "\\b" - (regexp-opt '("acos" "asciistr" "asin" "atan" "atan2" "bfilename" "bin_to_num" "bitand" "cardinality" "cast" "coalesce" "collect" - "compose" "corr" "corr_s" "corr_k" "covar_pop" "covar_samp" "cume_dist" "current_date" "current_timestamp" "cv" - "dbtimezone" "decompose" "dense_rank" "depth" "deref" "empty_blob, empty_clob" "existsnode" "extract" - "extractvalue" "first" "first_value" "from_tz" "group_id" "grouping" "grouping_id" "iteration_number" - "lag" "last" "last_value" "lead" "lnnvl" "localtimestamp" "make_ref" "median" "nanvl" "nchr" "nls_charset_decl_len" - "nls_charset_id" "nls_charset_name" "ntile" "nullif" "numtodsinterval" "numtoyminterval" "nvl2" "ora_hash" "path" - "percent_rank" "percentile_cont" "percentile_disc" "powermultiset" "powermultiset_by_cardinality" "presentnnv" - "presentv" "previous" "rank" "ratio_to_report" "rawtonhex" "ref" "reftohex" "regexp_instr" "regexp_replace" - "regexp_substr" "regr_slope" "regr_intercept" "regr_count" "regr_r2" "regr_avgx" "regr_avgy" "regr_sxx" "regr_syy" - "regr_sxy" "remainder" "row_number" "rowidtonchar" "scn_to_timestamp" "sessiontimezone" "stats_binomial_test" - "stats_crosstab" "stats_f_test" "stats_ks_test" "stats_mode" "stats_mw_test" "stats_one_way_anova" "stats_t_test_one" - "stats_t_test_paired" "stats_t_test_indep" "stats_t_test_indepu" "stats_wsr_test" "stddev_pop" "stddev_samp" - "sys_connect_by_path" "sys_context" "sys_dburigen" "sys_extract_utc" "sys_guid" "sys_typeid" "sys_xmlagg" "sys_xmlgen" - "systimestamp" "timestamp_to_scn" "to_binary_double" "to_binary_float" "to_clob" "to_dsinterval" "to_lob" "to_nchar" - "to_nclob" "to_timestamp" "to_timestamp_tz" "to_yminterval" "treat" "tz_offset" "unistr" "updatexml" "value" "var_pop" - "var_samp" "width_bucket" "xmlagg" "xmlcolattval" "xmlconcat" "xmlelement" "xmlforest" "xmlsequence" "xmltransform") t) - "\\b")) -(defvar sqlplus-oracle-extra-warning-words-re - (concat "\\b" - (regexp-opt '("access_into_null" "case_not_found" "collection_is_null" "rowtype_mismatch" - "self_is_null" "subscript_beyond_count" "subscript_outside_limit" "sys_invalid_rowid") t) - "\\b")) -(defvar sqlplus-oracle-extra-keywords-re - (concat "\\b\\(" - "\\(at\\s-+local\\|at\\s-+time\\s-+zone\\|to\\s-+second\\|to\\s-+month\\|is\\s-+present\\|a\\s-+set\\)\\|" - (regexp-opt '("case" "nan" "infinite" "equals_path" "empty" "likec" "like2" "like4" "member" - "regexp_like" "submultiset" "under_path" "mlslabel") t) - "\\)\\b")) -(defvar sqlplus-oracle-extra-pseudocolumns-re - (concat "\\b" - (regexp-opt '("connect_by_iscycle" "connect_by_isleaf" "versions_starttime" "versions_startscn" - "versions_endtime" "versions_endscn" "versions_xid" "versions_operation" "object_id" "object_value" "ora_rowscn" - "xmldata") t) - "\\b")) -(defvar sqlplus-oracle-plsql-extra-reserved-words-re - (concat "\\b" - (regexp-opt '("array" "at" "authid" "bulk" "char_base" "day" "do" "extends" "forall" "heap" "hour" - "interface" "isolation" "java" "limited" "minute" "mlslabel" "month" "natural" "naturaln" "nocopy" "number_base" - "ocirowid" "opaque" "operator" "organization" "pls_integer" "positive" "positiven" "range" "record" "release" "reverse" - "rowtype" "second" "separate" "space" "sql" "timezone_region" "timezone_abbr" "timezone_minute" "timezone_hour" "year" - "zone") t) - "\\b")) -(defvar sqlplus-oracle-extra-types-re - (concat "\\b" - (regexp-opt '("nvarchar2" "binary_float" "binary_double" "timestamp" "interval" "interval_day" "urowid" "nchar" "clob" "nclob" "bfile") t) - "\\b")) - -(defvar sqlplus-commands-regexp-1 nil) -(defvar sqlplus-commands-regexp-23 nil) -(defvar sqlplus-system-variables-regexp-1 nil) -(defvar sqlplus-system-variables-regexp-23 nil) -(defvar sqlplus-v22-commands-font-lock-keywords-1 nil) -(defvar sqlplus-v22-commands-font-lock-keywords-23 nil) -(defvar font-lock-sqlplus-face nil) - -(defvar sqlplus-output-buffer-keymap nil - "Local in output buffer.") -(make-variable-buffer-local 'sqlplus-output-buffer-keymap) - -(defvar sqlplus-kill-function-inhibitor nil) - -(defvar sqlplus-slip-separator-width 2 - "Only for classic table style.") - -(defvar sqlplus-user-string-history nil) - -(defvar sqlplus-object-types '( "CONSUMER GROUP" "SEQUENCE" "SCHEDULE" "PROCEDURE" "OPERATOR" "WINDOW" - "PACKAGE" "LIBRARY" "PROGRAM" "PACKAGE BODY" "JAVA RESOURCE" "XML SCHEMA" - "JOB CLASS" "TRIGGER" "TABLE" "SYNONYM" "VIEW" "FUNCTION" "WINDOW GROUP" - "JAVA CLASS" "INDEXTYPE" "INDEX" "TYPE" "EVALUATION CONTEXT" )) - -(defvar sqlplus-end-of-source-sentinel "%%@@end-of-source-sentinel@@%%") - -(defconst sqlplus-system-variables - '("appi[nfo]" "array[size]" "auto[commit]" "autop[rint]" "autorecovery" "autot[race]" "blo[ckterminator]" "cmds[ep]" - "colsep" "com[patibility]" "con[cat]" "copyc[ommit]" "copytypecheck" "def[ine]" "describe" "echo" "editf[ile]" - "emb[edded]" "esc[ape]" "feed[back]" "flagger" "flu[sh]" "hea[ding]" "heads[ep]" "instance" "lin[esize]" - "lobof[fset]" "logsource" "long" "longc[hunksize]" "mark[up]" "newp[age]" "null" "numf[ormat]" "num[width]" - "pages[ize]" "pau[se]" "recsep" "recsepchar" "serverout[put]" "shift[inout]" "show[mode]" "sqlbl[anklines]" - "sqlc[ase]" "sqlco[ntinue]" "sqln[umber]" "sqlpluscompat[ibility]" "sqlpre[fix]" "sqlp[rompt]" "sqlt[erminator]" - "suf[fix]" "tab" "term[out]" "ti[me]" "timi[ng]" "trim[out]" "trims[pool]" "und[erline]" "ver[ify]" "wra[p]")) - -(defconst sqlplus-commands - '(("@[@]") - (("/" "r[un]")) - ("acc[ept]" - (font-lock-type-face "num[ber]" "char" "date" "binary_float" "binary_double") - (font-lock-keyword-face "for[mat]" "def[ault]" "[no]prompt" "hide")) - ("a[ppend]") - ("archive log" - (font-lock-keyword-face "list" "stop" "start" "next" "all" "to")) - ("attribute" - (font-lock-keyword-face "ali[as]" "cle[ar]" "for[mat]" "like" "on" "off")) - ("bre[ak]" - (font-lock-keyword-face "on" "row" "report" "ski[p]" "page" "nodup[licates]" "dup[licates]")) - ("bti[tle]" - (font-lock-keyword-face "on" "off") - (font-lock-builtin-face "bold" "ce[nter]" "col" "format" "le[ft]" "r[ight]" "s[kip]" "tab")) - ("c[hange]") - ("cl[ear]" - (font-lock-keyword-face "bre[aks]" "buff[er]" "col[umns]" "comp[utes]" "scr[een]" "sql" "timi[ng]")) - ("col[umn]" - (font-lock-keyword-face "ali[as]" "cle[ar]" "entmap" "on" "off" "fold_a[fter]" "fold_b[efore]" "for[mat]" "hea[ding]" - "jus[tify]" "l[eft]" "c[enter]" "r[ight]" "like" "newl[ine]" "new_v[alue]" "nopri[nt]" "pri[nt]" - "nul[l]" "old_v[alue]" "wra[pped]" "wor[d_wrapped]" "tru[ncated]")) - ("comp[ute]" - (font-lock-keyword-face "lab[el]" "of" "on" "report" "row") - (font-lock-builtin-face "avg" "cou[nt]" "min[imum]" "max[imum]" "num[ber]" "sum" "std" "var[iance]")) - ("conn[ect]" - (font-lock-keyword-face "as" "sysoper" "sysdba")) - ("copy") - ("def[ine]") - ("del" - (font-lock-keyword-face "last")) - ("desc[ribe]") - ("disc[onnect]") - ("ed[it]") - ("exec[ute]") - (("exit" "quit") - (font-lock-keyword-face "success" "failure" "warning" "commit" "rollback")) - ("get" - (font-lock-keyword-face "file" "lis[t]" "nol[ist]")) - ("help") - (("ho[st]" "!" "$")) - ("i[nput]") - ("l[ist]" - (font-lock-keyword-face "last")) - ("passw[ord]") - ("pau[se]") - ("pri[nt]") - ("pro[mpt]") - ("recover" - (font-lock-keyword-face "begin" "end" "backup" "automatic" "from" "logfile" "test" "allow" "corruption" "continue" "default" "cancel" - "standby" "database" "until" "time" "change" "using" "controlfile" "tablespace" "datafile" - "consistent" "with" "[no]parallel" "managed" "disconnect" "session" "[no]timeout" "[no]delay" "next" "no" "expire" - "current" "through" "thread" "sequence" "all" "archivelog" "last" "switchover" "immediate" "[no]wait" - "finish" "skip")) - ("rem[ark]") - ("repf[ooter]" - (font-lock-keyword-face "page" "on" "off") - (font-lock-builtin-face "bold" "ce[nter]" "col" "format" "le[ft]" "r[ight]" "s[kip]" "tab")) - ("reph[eader]" - (font-lock-keyword-face "page" "on" "off") - (font-lock-builtin-face "bold" "ce[nter]" "col" "format" "le[ft]" "r[ight]" "s[kip]" "tab")) - ("sav[e]" - (font-lock-keyword-face "file" "cre[ate]" "rep[lace]" "app[end]")) - ("set" - (font-lock-builtin-face sqlplus-system-variables) - (font-lock-keyword-face "on" "off" "immediate" "trace[only]" "explain" "statistics" "native" "v7" "v8" "all" "linenum" "indent" - "entry" "intermediate" "full" "local" "head" "html" "body" "table" "entmap" "spool" "[pre]format" - "none" "[word_]wrapped" "each" "truncated" "[in]visible" "mixed" "lower" "upper")) - ("sho[w]" - (font-lock-keyword-face "all" "bti[tle]" "err[ors]" "function" "procedure" "package[ body]" "trigger" "view" "type[ body]" - "dimension" "java class" "lno" "parameters" "pno" "recyc[lebin]" "rel[ease]" "repf[ooter]" "reph[eader]" - "sga" "spoo[l]" "sqlcode" "tti[tle]" "user") - (font-lock-builtin-face sqlplus-system-variables)) - ("shutdown" - (font-lock-keyword-face "abort" "immediate" "normal" "transactional" "local")) - ("spo[ol]" - ("cre" "create" "rep" "replace" "app" "append" "off" "out")) - ("sta[rt]") - ("startup" - (font-lock-keyword-face "force" "restrict" "pfile" "quiet" "mount" "open" "nomount" "read" "only" "write" "recover")) - ("store" - (font-lock-keyword-face "set" "cre[ate]" "rep[lace]" "app[end]")) - ("timi[ng]" - (font-lock-keyword-face "start" "show" "stop")) - ("tti[tle]" - (font-lock-keyword-face "tti[tle]" "on" "off") - (font-lock-builtin-face "bold" "ce[nter]" "col" "format" "le[ft]" "r[ight]" "s[kip]" "tab")) - ("undef[ine]") - ("var[iable]" - (font-lock-type-face "number" "[n]char" "byte" "[n]varchar2" "[n]clob" "refcursor" "binary_float" "binary_double")) - ("whenever oserror" - (font-lock-keyword-face "exit" "success" "failure" "commit" "rollback" "continue" "commit" "rollback" "none")) - ("whenever sqlerror" - (font-lock-keyword-face "exit" "success" "failure" "warning" "commit" "rollback" "continue" "none")))) - -(defvar plsql-mode-map nil) - -(defstruct sqlplus-global-struct - font-lock-regexps - objects-alist - side-view-buffer - root-dir -) - -(defvar sqlplus-global-structures (make-hash-table :test 'equal) - "Connect string -> sqlplus-global-struct") - -(defun sqlplus-get-objects-alist (&optional connect-string) - (let ((struct (gethash (car (refine-connect-string (or connect-string sqlplus-connect-string sqlplus-process-p))) - sqlplus-global-structures))) - (when struct - (sqlplus-global-struct-objects-alist struct)))) - -(defun sqlplus-set-objects-alist (objects-alist &optional connect-string) - (let ((struct (gethash (car (refine-connect-string (or connect-string sqlplus-connect-string sqlplus-process-p))) - sqlplus-global-structures))) - (when struct - (setf (sqlplus-global-struct-objects-alist struct) objects-alist)))) - -(defun sqlplus-get-font-lock-regexps (&optional connect-string) - (let ((struct (gethash (car (refine-connect-string (or connect-string sqlplus-connect-string sqlplus-process-p))) - sqlplus-global-structures))) - (when struct - (sqlplus-global-struct-font-lock-regexps struct)))) - -(defun sqlplus-set-font-lock-regexps (font-lock-regexps &optional connect-string) - (let ((struct (gethash (car (refine-connect-string (or connect-string sqlplus-connect-string sqlplus-process-p))) - sqlplus-global-structures))) - (when struct - (setf (sqlplus-global-struct-font-lock-regexps struct) font-lock-regexps)))) - -(defun sqlplus-get-side-view-buffer (&optional connect-string) - (let ((struct (gethash (car (refine-connect-string (or connect-string sqlplus-connect-string sqlplus-process-p))) - sqlplus-global-structures))) - (when struct - (sqlplus-global-struct-side-view-buffer struct)))) - -(defun sqlplus-get-root-dir (&optional connect-string) - (let ((struct (gethash (car (refine-connect-string (or connect-string sqlplus-connect-string sqlplus-process-p))) - sqlplus-global-structures))) - (when struct - (sqlplus-global-struct-root-dir struct)))) - -(defun sqlplus-set-root-dir (root-dir &optional connect-string) - (let ((struct (gethash (car (refine-connect-string (or connect-string sqlplus-connect-string sqlplus-process-p))) - sqlplus-global-structures))) - (when struct - (setf (sqlplus-global-struct-root-dir struct) root-dir)))) - -;;; --- - -(defun sqlplus-initial-strings () - (append sqlplus-initial-strings - (list - (concat "btitle left '" sqlplus-page-separator "'") - (concat "repfooter left '" sqlplus-repfooter "'") - (concat "set pagesize " (number-to-string sqlplus-pagesize))))) - -(defun sqlplus-connect-string-lessp (cs1 cs2) - "Compare two connect strings" - (let ((cs1-pair (split-string cs1 "@")) - (cs2-pair (split-string cs2 "@"))) - (or (string< (cadr cs1-pair) (cadr cs2-pair)) - (and (string= (cadr cs1-pair) (cadr cs2-pair)) - (string< (car cs1-pair) (car cs2-pair)))))) - -(defun sqlplus-divide-connect-strings () - "Returns (active-connect-string-list . inactive-connect-string-list)" - (let* ((active-connect-strings - (sort (delq nil (mapcar (lambda (buffer) - (with-current-buffer buffer - (when (and (eq major-mode 'sqlplus-mode) - sqlplus-connect-string) - (let ((cs (car (refine-connect-string sqlplus-connect-string)))) - (when (and (get-buffer (sqlplus-get-process-buffer-name cs)) - (get-process (sqlplus-get-process-name cs))) - (downcase cs)))))) - (buffer-list))) - 'sqlplus-connect-string-lessp)) - (inactive-connect-strings - (sort (delq nil (mapcar (lambda (pair) - (unless (member (downcase (car pair)) active-connect-strings) (downcase (car pair))) ) - sqlplus-connect-strings-alist)) - 'sqlplus-connect-string-lessp))) - (setq active-connect-strings (remove-duplicates active-connect-strings :test 'equal)) - (setq inactive-connect-strings (remove-duplicates inactive-connect-strings :test 'equal)) - (cons active-connect-strings inactive-connect-strings))) - -(defun sqlplus-connections-menu (menu) - (condition-case err - (let* ((connect-strings-pair (sqlplus-divide-connect-strings)) - (active-connect-strings (car connect-strings-pair)) - (inactive-connect-strings (cdr connect-strings-pair))) - (append - (list ["New connection..." sqlplus t]) - (list ["Tnsnames.ora" sqlplus-find-tnsnames t]) - (list ["Command Line" sqlplus-command-line t]) - (when (eq major-mode 'sqlplus-mode) - (list - "----" - ["Evaluate Statement" sqlplus-send-current sqlplus-connect-string] - ["Explain Statement" sqlplus-explain sqlplus-connect-string] - ["Evaluate Statement (HTML)" sqlplus-send-current-html sqlplus-connect-string] - ["Evaluate Region" sqlplus-send-region (and (mark) sqlplus-connect-string)])) - (when orcl-mode - (list - "----" - ["Send Commit" sqlplus-send-commit sqlplus-connect-string] - ["Send Rollback" sqlplus-send-rollback sqlplus-connect-string] - ["Restart Connection" sqlplus-restart-connection sqlplus-connect-string] - ["Show History" sqlplus-show-history sqlplus-connect-string] - ["Get Source from DB" sqlplus-get-source sqlplus-connect-string] - ["Interrupt Evaluation" sqlplus-send-interrupt sqlplus-connect-string] - ["Compare schema to filesystem" sqlplus-compare-schema-to-filesystem sqlplus-connect-string] - "----" - (list "Output" - ["Show window" sqlplus-buffer-display-window t] - "----" - ["Redisplay" sqlplus-buffer-redisplay-current t] - ["Previous" sqlplus-buffer-prev-command t] - ["Next" sqlplus-buffer-next-command t] - "----" - ["Scroll Right" sqlplus-buffer-scroll-right t] - ["Scroll Left" sqlplus-buffer-scroll-left t] - ["Scroll Down" sqlplus-buffer-scroll-down t] - ["Scroll Up" sqlplus-buffer-scroll-up t] - "----" - ["Bottom" sqlplus-buffer-bottom t] - ["Top" sqlplus-buffer-top t] - "----" - ["Erase" sqlplus-buffer-erase t]) - )) - (when inactive-connect-strings - (append - (list "----") - (list (append (list "Recent Connections") - (mapcar (lambda (connect-string) - (vector connect-string (list 'apply ''sqlplus - (list 'sqlplus-read-connect-string connect-string)) t)) inactive-connect-strings))))) - (when active-connect-strings - (append - (list "----") - (mapcar (lambda (connect-string) - (vector connect-string (list 'apply ''sqlplus - (list 'sqlplus-read-connect-string connect-string)) t)) active-connect-strings))) - )) - (error (message (error-message-string err))))) - -(defun sqlplus-send-commit () - "Send 'commit' command to SQL*Process." - (interactive) - (sqlplus-check-connection) - (sqlplus-execute sqlplus-connect-string "commit;" nil nil)) - -(defun sqlplus-send-rollback () - "Send 'rollback' command to SQL*Process." - (interactive) - (sqlplus-check-connection) - (sqlplus-execute sqlplus-connect-string "rollback;" nil nil)) - -(defun sqlplus-show-history () - "Show command history for current connection." - (interactive) - (sqlplus-check-connection) - (sqlplus-verify-buffer sqlplus-connect-string) - (switch-to-buffer (sqlplus-get-history-buffer sqlplus-connect-string))) - -(defun sqlplus-restart-connection () - "Kill SQL*Plus process and start again." - (interactive) - (sqlplus-check-connection) - (sqlplus-verify-buffer sqlplus-connect-string) - (let ((connect-stringos sqlplus-connect-string)) - (unwind-protect - (progn - (setq sqlplus-kill-function-inhibitor t) - (sqlplus-shutdown connect-stringos t)) - (setq sqlplus-kill-function-inhibitor nil)) - (sqlplus connect-stringos (sqlplus-get-input-buffer-name connect-stringos)))) - -(define-skeleton plsql-begin - "begin..end skeleton" - "" ; interactor - "begin" ?\n - > _ ?\n - "end;" >) - -(define-skeleton plsql-loop - "loop..end loop skeleton" - "" ; interactor - "loop" ?\n - > _ ?\n - "end loop;" >) - -(define-skeleton plsql-if - "if..end if skeleton" - "" ; interactor - "if " _ " then" ?\n - > ?\n - "end if;" >) - -;;; SQLPLUS-mode Keymap - - -(unless orcl-mode-map - (setq orcl-mode-map (make-sparse-keymap)) - (define-key orcl-mode-map "\C-c\C-o" 'sqlplus-buffer-display-window) - (define-key orcl-mode-map "\C-c\C-l" 'sqlplus-buffer-redisplay-current) - (define-key orcl-mode-map "\C-c\C-p" 'sqlplus-buffer-prev-command) - (define-key orcl-mode-map [C-S-up] 'sqlplus-buffer-prev-command) - (define-key orcl-mode-map "\C-c\C-n" 'sqlplus-buffer-next-command) - (define-key orcl-mode-map [C-S-down] 'sqlplus-buffer-next-command) - (define-key orcl-mode-map "\C-c\C-b" 'sqlplus-buffer-scroll-right) - (define-key orcl-mode-map [C-S-left] 'sqlplus-buffer-scroll-right) - (define-key orcl-mode-map "\C-c\C-f" 'sqlplus-buffer-scroll-left) - (define-key orcl-mode-map [C-S-right] 'sqlplus-buffer-scroll-left) - (define-key orcl-mode-map "\C-c\M-v" 'sqlplus-buffer-scroll-down) - (define-key orcl-mode-map "\C-c\C-v" 'sqlplus-buffer-scroll-up) - (define-key orcl-mode-map "\C-c>" 'sqlplus-buffer-bottom) - (define-key orcl-mode-map "\C-c<" 'sqlplus-buffer-top) - (define-key orcl-mode-map "\C-c\C-w" 'sqlplus-buffer-erase) - (define-key orcl-mode-map "\C-c\C-m" 'sqlplus-send-commit) - (define-key orcl-mode-map "\C-c\C-a" 'sqlplus-send-rollback) - (define-key orcl-mode-map "\C-c\C-k" 'sqlplus-restart-connection) - (define-key orcl-mode-map "\C-c\C-t" 'sqlplus-show-history) - (define-key orcl-mode-map "\C-c\C-s" 'sqlplus-get-source) - (define-key orcl-mode-map "\C-c\C-i" 'sqlplus-send-interrupt) - (define-key orcl-mode-map [S-return] 'sqlplus-send-user-string) - (define-key orcl-mode-map [tool-bar sqlplus-restart-connection] - (list 'menu-item "Restart connection" 'sqlplus-restart-connection :image sqlplus-kill-image)) - (define-key orcl-mode-map [tool-bar sqlplus-cancel] - (list 'menu-item "Cancel" 'sqlplus-send-interrupt :image sqlplus-cancel-image)) - (define-key orcl-mode-map [tool-bar sqlplus-rollback] - (list 'menu-item "Rollback" 'sqlplus-send-rollback :image sqlplus-rollback-image)) - (define-key orcl-mode-map [tool-bar sqlplus-commit] - (list 'menu-item "Commit" 'sqlplus-send-commit :image sqlplus-commit-image))) - -(unless sqlplus-mode-map - (setq sqlplus-mode-map (make-sparse-keymap)) - (define-key sqlplus-mode-map "\C-c\C-g" 'plsql-begin) - (define-key sqlplus-mode-map "\C-c\C-q" 'plsql-loop) - (define-key sqlplus-mode-map "\C-c\C-z" 'plsql-if) - (define-key sqlplus-mode-map "\C-c\C-r" 'sqlplus-send-region) - (define-key sqlplus-mode-map [C-return] 'sqlplus-send-current) - (define-key sqlplus-mode-map [M-return] 'sqlplus-explain) - (define-key sqlplus-mode-map "\C-c\C-e" 'sqlplus-send-current) - (define-key sqlplus-mode-map "\C-c\C-j" 'sqlplus-send-current-html) - (define-key sqlplus-mode-map [C-S-return] 'sqlplus-send-current-html) - (define-key sqlplus-mode-map "\M-." 'sqlplus-file-get-source) - (define-key sqlplus-mode-map [C-down-mouse-1] 'sqlplus-mouse-select-identifier) - (define-key sqlplus-mode-map [C-mouse-1] 'sqlplus-file-get-source-mouse) - ) - -(easy-menu-add-item nil nil sqlplus-connections-menu t) - -(unless sqlplus-mode-syntax-table - (setq sqlplus-mode-syntax-table (make-syntax-table)) - (modify-syntax-entry ?/ ". 14" sqlplus-mode-syntax-table) ; comment start - (modify-syntax-entry ?* ". 23" sqlplus-mode-syntax-table) - (modify-syntax-entry ?+ "." sqlplus-mode-syntax-table) - (modify-syntax-entry ?. "." sqlplus-mode-syntax-table) - (modify-syntax-entry ?\" "." sqlplus-mode-syntax-table) - (modify-syntax-entry ?\\ "." sqlplus-mode-syntax-table) - (modify-syntax-entry ?- ". 12b" sqlplus-mode-syntax-table) - (modify-syntax-entry ?\n "> b" sqlplus-mode-syntax-table) - (modify-syntax-entry ?= "." sqlplus-mode-syntax-table) - (modify-syntax-entry ?% "w" sqlplus-mode-syntax-table) - (modify-syntax-entry ?< "." sqlplus-mode-syntax-table) - (modify-syntax-entry ?> "." sqlplus-mode-syntax-table) - (modify-syntax-entry ?& "w" sqlplus-mode-syntax-table) - (modify-syntax-entry ?| "." sqlplus-mode-syntax-table) - (modify-syntax-entry ?_ "w" sqlplus-mode-syntax-table) ; _ is word char - (modify-syntax-entry ?\' "\"" sqlplus-mode-syntax-table)) - -;;; SQL*Plus mode - -(defun connect-string-to-string () - (let ((txt (or (car (refine-connect-string sqlplus-connect-string)) "disconnected")) - (result)) - (if (string-match "^\\(.*?\\)\\(\\w*prod\\w*\\)$" txt) - (if (>= emacs-major-version 22) - (setq result (list (list :propertize (substring txt 0 (match-beginning 2)) 'face '((:foreground "blue"))) - (list :propertize (substring txt (match-beginning 2)) 'face '((:foreground "red")(:weight bold))))) - (setq result (setq txt (propertize txt 'face '((:foreground "blue"))))) - (put-text-property (match-beginning 2) (match-end 2) 'face '((:foreground "red")(:weight bold)) txt)) - (setq result - (if (>= emacs-major-version 22) - (list :propertize txt 'face '((:foreground "blue"))) - (setq txt (propertize txt 'face '((:foreground "blue"))))))) - result)) - -(defun sqlplus-font-lock (type-symbol limit) - (let ((sqlplus-font-lock-regexps (sqlplus-get-font-lock-regexps))) - (when sqlplus-font-lock-regexps - (let ((regexp (gethash type-symbol sqlplus-font-lock-regexps))) - (when regexp - (re-search-forward regexp limit t)))))) - -;; Local in input buffer (sqlplus-mode) -(defvar sqlplus-command-overlay nil) -(make-variable-buffer-local 'sqlplus-command-overlay) -(defvar sqlplus-begin-command-overlay-arrow-position nil) -(make-variable-buffer-local 'sqlplus-begin-command-overlay-arrow-position) -(defvar sqlplus-end-command-overlay-arrow-position nil) -(make-variable-buffer-local 'sqlplus-end-command-overlay-arrow-position) - -(defun sqlplus-highlight-current-sqlplus-command() - (when (and window-system sqlplus-command-highlighting-style) - (let* ((pair (sqlplus-mark-current)) - (begin (and (car pair) (save-excursion (goto-char (car pair)) (skip-chars-forward " \t\n") (point)))) - (end (and (cdr pair) (save-excursion (goto-char (cdr pair)) (skip-chars-backward " \t\n") (beginning-of-line) (point)))) - (point-line-beg (save-excursion (beginning-of-line) (point))) - (overlay-begin begin) - (overlay-end end)) - (when (and begin end) - (when (< end point-line-beg) - (save-excursion (goto-char point-line-beg) (when (eobp) (insert "\n"))) - (setq end point-line-beg) - (setq overlay-end end)) - (when (or (>= begin end) (< (point) begin)) - (when (or (< (point) begin) (> begin end)) - (setq overlay-begin nil - overlay-end nil)) - (setq begin nil - end nil))) - (if (and overlay-begin overlay-end (memq sqlplus-command-highlighting-style '(background fringe-and-background))) - (progn - (setq overlay-end (save-excursion - (goto-char overlay-end) - (beginning-of-line 2) - (point))) - (move-overlay sqlplus-command-overlay overlay-begin overlay-end)) - (move-overlay sqlplus-command-overlay 1 1)) - (if (memq sqlplus-command-highlighting-style '(fringe fringe-and-background)) - (progn - (put 'sqlplus-begin-command-overlay-arrow-position 'overlay-arrow-bitmap 'top-left-angle) - (put 'sqlplus-end-command-overlay-arrow-position 'overlay-arrow-bitmap 'bottom-left-angle) - (set-marker sqlplus-begin-command-overlay-arrow-position begin) - (set-marker sqlplus-end-command-overlay-arrow-position end)) - (set-marker sqlplus-begin-command-overlay-arrow-position nil) - (set-marker sqlplus-end-command-overlay-arrow-position nil))))) - -(defun sqlplus-find-begin-of-sqlplus-command () - (save-excursion - (beginning-of-line) - (while (and (not (bobp)) (save-excursion (end-of-line 0) (skip-chars-backward " \t") (equal (char-before) ?-))) - (beginning-of-line 0)) - (point))) - -(defun sqlplus-find-end-of-sqlplus-command () - (save-excursion - (end-of-line) - (while (progn (skip-chars-backward " \t") (and (not (eobp)) (equal (char-before) ?-))) - (end-of-line 2)) - (point))) - -(defun sqlplus-set-font-lock-emacs-structures-for-level (level mode-symbol) - (let ((result (append sql-mode-oracle-font-lock-keywords - (default-value (cond ((equal level 3) 'sqlplus-font-lock-keywords-3) - ((equal level 2) 'sqlplus-font-lock-keywords-2) - ((equal level 1) 'sqlplus-font-lock-keywords-1) - (t nil)))))) - (when (featurep 'plsql) - (setq result (append (symbol-value 'plsql-oracle-font-lock-fix-re) result))) - (setq result - (append - ;; Names for schemas, tables, synonyms, views, columns, sequences, packages, triggers and indexes - (when (> level 2) - (mapcar (lambda (pair) - (let ((type-symbol (car pair)) - (face (cadr pair))) - (cons (eval `(lambda (limit) (sqlplus-font-lock ',type-symbol limit))) face))) - sqlplus-syntax-faces)) - ;; SQL*Plus - (when (eq mode-symbol 'sqlplus-mode) - (unless sqlplus-commands-regexp-1 - (flet ((first-form-fun (cmds) (mapcar (lambda (name) (car (sqlplus-full-forms name))) cmds)) - (all-forms-fun (cmds) (mapcan 'sqlplus-full-forms cmds)) - (sqlplus-commands-regexp-fun (form-fun cmds) (concat "^" (regexp-opt (funcall form-fun cmds) t) "\\b")) - (sqlplus-system-variables-fun (form-fun vars) (concat "\\b" (regexp-opt (funcall form-fun vars) t) "\\b"))) - (flet ((sqlplus-v22-commands-font-lock-keywords-fun - (form-fun) - (delq nil - (mapcar - (lambda (command-info) - (let* ((names (car command-info)) - (names-list (if (listp names) names (list names))) - (sublists (cdr command-info))) - (when sublists - (append (list (sqlplus-commands-regexp-fun form-fun names-list)) - (mapcar (lambda (sublist) - (let ((face (car sublist)) - (regexp (concat "\\b" - (regexp-opt (mapcan (lambda (name) (sqlplus-full-forms name)) - (mapcan (lambda (elem) - (if (symbolp elem) - (copy-list (symbol-value elem)) - (list elem))) - (cdr sublist))) - t) - "\\b"))) - (list regexp '(sqlplus-find-end-of-sqlplus-command) nil (list 1 face)))) - sublists) - (list '("\\(\\w+\\)" (sqlplus-find-end-of-sqlplus-command) nil (1 font-lock-sqlplus-face))))))) - sqlplus-commands)))) - (let ((commands (mapcan - (lambda (command-info) (let ((names (car command-info))) (if (listp names) (copy-list names) (list names)))) - sqlplus-commands))) - (setq sqlplus-commands-regexp-1 (sqlplus-commands-regexp-fun 'first-form-fun commands)) - (setq sqlplus-commands-regexp-23 (sqlplus-commands-regexp-fun 'all-forms-fun commands)) - (if (<= emacs-major-version 21) - (setq sqlplus-system-variables-regexp-1 (sqlplus-system-variables-fun 'first-form-fun sqlplus-system-variables) - sqlplus-system-variables-regexp-23 (sqlplus-system-variables-fun 'all-forms-fun sqlplus-system-variables)) - (setq sqlplus-v22-commands-font-lock-keywords-1 (sqlplus-v22-commands-font-lock-keywords-fun 'first-form-fun) - sqlplus-v22-commands-font-lock-keywords-23 (sqlplus-v22-commands-font-lock-keywords-fun 'all-forms-fun))))))) - (append (list - ;; Comments (REM command) - (cons "^\\(rem\\)\\b\\(.*?\\)$" '((1 font-lock-keyword-face nil nil) (2 font-lock-comment-face t nil))) - ;; Predefined SQL*Plus variables - (cons (concat "\\b" - (regexp-opt '("_CONNECT_IDENTIFIER" "_DATE" "_EDITOR" "_O_VERSION" "_O_RELEASE" "_PRIVILEGE" - "_SQLPLUS_RELEASE" "_USER") t) - "\\b") - 'font-lock-builtin-face) - ;; SQL*Plus commands (+ shortcuts if level >= 2) - (cons - (concat (if (>= level 2) sqlplus-commands-regexp-23 sqlplus-commands-regexp-1) "\\|^\\(@@\\|@\\|!\\|/\\|\\$\\)" ) - 'font-lock-keyword-face)) - (if (<= emacs-major-version 21) - ;; SQL*Plus system variables (+ shortcuts if level >= 2) - (list (cons (if (>= level 2) sqlplus-system-variables-regexp-23 sqlplus-system-variables-regexp-1) 'font-lock-builtin-face)) - ;; ver. >= 22 - (if (>= level 2) sqlplus-v22-commands-font-lock-keywords-23 sqlplus-v22-commands-font-lock-keywords-1)))) - ; (cons "\\b\\([a-zA-Z$_#0-9]+\\)\\b\\.\\(\\b[a-zA-Z$_#0-9]+\\b\\)" '((1 font-lock-type-face nil nil)(2 font-lock-variable-name-face nil nil))) - (list - ;; Extra Oracle syntax highlighting, not recognized by sql-mode or plsql-mode - (cons sqlplus-oracle-extra-types-re 'font-lock-type-face) - (cons sqlplus-oracle-extra-warning-words-re 'font-lock-warning-face) - (cons sqlplus-oracle-extra-types-re 'font-lock-type-face) - (cons sqlplus-oracle-extra-keywords-re 'font-lock-keyword-face) - (cons sqlplus-oracle-plsql-extra-reserved-words-re 'font-lock-keyword-face) - (if (string-match "XEmacs\\|Lucid" emacs-version) - (cons sqlplus-oracle-extra-pseudocolumns-re 'font-lock-preprocessor-face) - (cons sqlplus-oracle-extra-pseudocolumns-re 'font-lock-builtin-face)) - (if (string-match "XEmacs\\|Lucid" emacs-version) - (cons sqlplus-oracle-extra-builtin-functions-re 'font-lock-preprocessor-face) - (cons sqlplus-oracle-extra-builtin-functions-re 'font-lock-builtin-face)) - ;; SQL*Plus variable names, like '&name' or '&&name' - (cons "\\(\\b&[&a-zA-Z$_#0-9]+\\b\\)" 'font-lock-variable-name-face)) - result - ;; Function calls - (when (>= level 2) - (list (cons "\\b\\(\\([a-zA-Z$_#0-9]+\\b\\)\\.\\)?\\(\\b[a-zA-Z$_#0-9]+\\b\\)\\s-*(" - '((2 font-lock-type-face nil t) - (3 font-lock-function-name-face nil nil))))))) - result)) - -(defun sqlplus-mode nil - "Mode for editing and executing SQL*Plus commands. Entry into this mode runs the hook -'sqlplus-mode-hook'. - -Use \\[sqlplus] to start the SQL*Plus interpreter. - -Just position the cursor on or near the SQL*Plus statement you -wish to send and press '\\[sqlplus-send-current]' to run it and -display the results. - -Mode Specific Bindings: - -\\{sqlplus-mode-map}" - (interactive) - (run-hooks 'change-major-mode-hook) - (setq major-mode 'sqlplus-mode - mode-name "SQL*Plus") - (use-local-map sqlplus-mode-map) - (set-syntax-table sqlplus-mode-syntax-table) - (make-local-variable 'comment-start) - (make-local-variable 'comment-end) - (setq comment-start "/* " - comment-end " */") - (orcl-mode 1) - (setq sqlplus-font-lock-keywords-1 (sqlplus-set-font-lock-emacs-structures-for-level 1 major-mode) - sqlplus-font-lock-keywords-2 (sqlplus-set-font-lock-emacs-structures-for-level 2 major-mode) - sqlplus-font-lock-keywords-3 (sqlplus-set-font-lock-emacs-structures-for-level 3 major-mode)) - (when (featurep 'plsql) - (set (make-local-variable 'indent-line-function) - (lambda () (interactive) (condition-case err (funcall (symbol-function 'plsql-indent)) (error (message "Error: %S" err))))) - (set (make-local-variable 'indent-region-function) 'plsql-indent-region) - (set (make-local-variable 'align-mode-rules-list) 'plsql-align-rules-list)) - (setq font-lock-defaults sqlplus-font-lock-defaults) - (unless sqlplus-connect-string - (let ((potential-connect-string (sqlplus-get-potential-connect-string (buffer-file-name)))) - (when (and potential-connect-string - (get-process (sqlplus-get-process-name potential-connect-string))) - (setq sqlplus-connect-string potential-connect-string)))) - (set (make-local-variable 'font-lock-extend-after-change-region-function) - (lambda (beg end old-len) - (cons (save-excursion (goto-char beg) (sqlplus-find-begin-of-sqlplus-command)) - (save-excursion (goto-char end) (sqlplus-find-end-of-sqlplus-command))))) - (unless font-lock-sqlplus-face - (copy-face 'default 'font-lock-sqlplus-face) - (setq font-lock-sqlplus-face 'font-lock-sqlplus-face)) - (turn-on-font-lock) - (unless frame-background-mode - (setq frame-background-mode (if (< (sqlplus-color-percentage (face-background 'default)) 50) 'dark 'light))) - (setq imenu-generic-expression '((nil "^--[ ]*\\([^;.\n]*\\)" 1))) - ;; if input buffer has sqlplus-mode then prepare it for command under cursor selection - (when (and (eq major-mode 'sqlplus-mode) (null sqlplus-begin-command-overlay-arrow-position)) - (setq sqlplus-begin-command-overlay-arrow-position (make-marker) - sqlplus-end-command-overlay-arrow-position (make-marker) - sqlplus-command-overlay (make-overlay 1 1)) - (overlay-put sqlplus-command-overlay 'face 'sqlplus-command-highlight-face) - (when (and (>= emacs-major-version 22) (not (memq 'sqlplus-begin-command-overlay-arrow-position overlay-arrow-variable-list))) - (push 'sqlplus-begin-command-overlay-arrow-position overlay-arrow-variable-list)) - (when (and (>= emacs-major-version 22) (not (memq 'sqlplus-end-command-overlay-arrow-position overlay-arrow-variable-list))) - (push 'sqlplus-end-command-overlay-arrow-position overlay-arrow-variable-list)) - (add-hook 'pre-command-hook (lambda () - (set-marker sqlplus-begin-command-overlay-arrow-position nil) - (set-marker sqlplus-end-command-overlay-arrow-position nil)) - nil t) - (add-hook 'post-command-hook (lambda () - (sqlplus-clear-mouse-selection) - (set-marker sqlplus-begin-command-overlay-arrow-position nil) - (set-marker sqlplus-end-command-overlay-arrow-position nil)) - nil t)) - (run-hooks 'sqlplus-mode-hook)) - -(defun sqlplus-color-percentage (color) - (truncate (* (/ (/ (reduce '+ (color-values color)) 3.0) 65535.0) 100.0))) - -(defun sqlplus-get-potential-connect-string (file-path) - (when file-path - (let* ((file-name (file-name-nondirectory file-path)) - (extension (file-name-extension file-name)) - (case-fold-search t)) - (when (and extension - (string-match (concat "^" sqlplus-session-file-extension "$") extension) - (string-match "@" file-name)) - (car (refine-connect-string (file-name-sans-extension file-name))))))) - -(defun sqlplus-check-connection () - (if orcl-mode - (unless sqlplus-connect-string - (let* ((potential-connect-string (sqlplus-get-potential-connect-string (buffer-file-name))) - (connect-string (car (sqlplus-read-connect-string nil (or potential-connect-string - (caar (sqlplus-divide-connect-strings))))))) - (sqlplus connect-string (buffer-name)))) - (error "Current buffer is not determined to communicate with Oracle"))) - -;;; Utilitities - -(defun sqlplus-echo-in-buffer (buffer-name string &optional force-display hide-after-head) - "Displays string in the named buffer, creating the buffer if needed. If force-display is true, the buffer will appear -if not already shown." - (let ((buffer (get-buffer buffer-name))) - (when buffer - (if force-display (display-buffer buffer)) - (with-current-buffer buffer - (while (and (> (buffer-size) sqlplus-output-buffer-max-size) - (progn (goto-char (point-min)) - (unless (eobp) (forward-char)) - (re-search-forward (concat "^" (regexp-quote sqlplus-output-separator)) nil t))) - (delete-region 1 (- (point) (length sqlplus-output-separator)))) - - (goto-char (point-max)) - (let ((start-point (point))) - (insert string) - (when hide-after-head - (let ((from-pos (string-match "\n" string)) - (keymap (make-sparse-keymap)) - overlay) - (when from-pos - (setq overlay (make-overlay (+ start-point from-pos) (- (+ start-point (length string)) 2))) - (when (or (not (consp buffer-invisibility-spec)) - (not (assq 'hide-symbol buffer-invisibility-spec))) - (add-to-invisibility-spec '(hide-symbol . t))) - (overlay-put overlay 'invisible 'hide-symbol) - (put-text-property start-point (- (+ start-point (length string)) 2) 'help-echo string) - (put-text-property start-point (- (+ start-point (length string)) 2) 'mouse-face 'highlight) - (put-text-property start-point (- (+ start-point (length string)) 2) 'keymap sqlplus-output-buffer-keymap))))) - (if force-display - (set-window-point (get-buffer-window buffer-name) (point-max))))))) - -(defun sqlplus-verify-buffer (connect-string) - (let ((output-buffer-name (sqlplus-get-output-buffer-name connect-string)) - (process-buffer-name (sqlplus-get-process-buffer-name connect-string))) - (when (not (get-buffer process-buffer-name)) - (sqlplus-shutdown connect-string) - (error "No SQL*Plus session! Use 'M-x sqlplus' to start the SQL*Plus interpreter")) - (unless (get-buffer-process process-buffer-name) - (sqlplus-shutdown connect-string) - (error "Buffer '%s' is not talking to anybody!" output-buffer-name))) - t) - -(defun sqlplus-get-context (connect-string &optional id) - (let ((process-buffer (sqlplus-get-process-buffer-name connect-string))) - (when process-buffer - (with-current-buffer process-buffer - (when id - (while (and sqlplus-command-contexts - (not (equal (sqlplus-get-context-value (car sqlplus-command-contexts) :id) id))) - (setq sqlplus-command-contexts (cdr sqlplus-command-contexts)))) - (car sqlplus-command-contexts))))) - -(defun sqlplus-get-context-value (context var-symbol) - (cdr (assq var-symbol context))) - -(defun sqlplus-set-context-value (context var-symbol value) - (let ((association (assq var-symbol context))) - (if association - (setcdr association value) - (setcdr context (cons (cons var-symbol value) (cdr context)))) - context)) - -(defun sqlplus-mark-current () - "Marks the current SQL for sending to the SQL*Plus process. Marks are placed around a region defined by empty lines." - (let (begin end empty-line-p empty-line-p next-line-included tail-p) - (save-excursion - (beginning-of-line) - (setq empty-line-p (when (looking-at "^[ \t]*\\(\n\\|\\'\\)") (point))) - (setq next-line-included (and empty-line-p (save-excursion (skip-chars-forward " \t\n") (> (current-column) 0)))) - (setq tail-p (and empty-line-p - (or (bobp) (save-excursion (beginning-of-line 0) (looking-at "^[ \t]*\n")))))) - (unless tail-p - (save-excursion - (end-of-line) - (re-search-backward "\\`\\|\n[\r\t ]*\n[^ \t]" nil t) - (skip-syntax-forward "-") - (setq begin (point))) - (save-excursion - (beginning-of-line) - (re-search-forward "\n[\r\t ]*\n[^ \t]\\|\\'" nil t) - (unless (zerop (length (match-string 0))) - (backward-char 1)) - (skip-syntax-backward "-") - (setq end (or (and (not next-line-included) empty-line-p) (point))))) - (cons begin end))) - -;;; Transmission Commands - -(defun sqlplus-send-current (arg &optional html) - "Send the current SQL command(s) to the SQL*Plus process. With argument, show results in raw form." - (interactive "P") - (sqlplus-check-connection) - (when (buffer-file-name) - (condition-case err - (save-buffer) - (error (message (error-message-string err))))) - (let ((region (sqlplus-mark-current))) - (setq sqlplus-region-beginning-pos (car region) - sqlplus-region-end-pos (cdr region))) - (if (and sqlplus-region-beginning-pos sqlplus-region-end-pos) - (sqlplus-send-region arg sqlplus-region-beginning-pos sqlplus-region-end-pos nil html) - (error "Point doesn't indicate any command to execute"))) - -(defun sqlplus-send-current-html (arg) - (interactive "P") - (sqlplus-send-current arg t)) - - -;;; SQLPLUS-Output Buffer Operations - - -(defun sqlplus--show-buffer (connect-string fcn args) - (let* ((output-buffer-name (sqlplus-get-output-buffer-name connect-string))) - (sqlplus-verify-buffer connect-string) - (if sqlplus-suppress-show-output-buffer - (with-current-buffer (get-buffer output-buffer-name) - (if fcn (condition-case err (apply fcn args) (error (message (error-message-string err)))))) - (if (not (eq (window-buffer (selected-window)) (get-buffer output-buffer-name))) - (switch-to-buffer-other-window output-buffer-name)) - (if fcn (condition-case err (apply fcn args) (error (message (error-message-string err)))))))) - -(defun sqlplus-show-buffer (&optional connect-string fcn &rest args) - "Makes the SQL*Plus output buffer visible in the other window." - (interactive) - (setq connect-string (or connect-string sqlplus-connect-string)) - (unless connect-string - (error "Current buffer is disconnected!")) - (let ((output-buffer-name (sqlplus-get-output-buffer-name connect-string))) - (if (and output-buffer-name - (eq (current-buffer) (get-buffer output-buffer-name))) - (sqlplus--show-buffer connect-string fcn args) - (save-excursion - (save-selected-window - (sqlplus--show-buffer connect-string fcn args)))))) - -(fset 'sqlplus-buffer-display-window 'sqlplus-show-buffer) - -(defun sqlplus-buffer-scroll-up (&optional connect-string) - "Scroll-up in the SQL*Plus output buffer window." - (interactive) - (sqlplus-show-buffer (or connect-string sqlplus-connect-string) 'scroll-up)) - -(defun sqlplus-buffer-scroll-down (&optional connect-string) - "Scroll-down in the SQL*Plus output buffer window." - (interactive) - (sqlplus-show-buffer (or connect-string sqlplus-connect-string) 'scroll-down)) - -(defun sqlplus-scroll-left (num) - (call-interactively 'scroll-left)) - -(defun sqlplus-scroll-right (num) - (call-interactively 'scroll-right)) - -(defun sqlplus-buffer-scroll-left (num &optional connect-string) - "Scroll-left in the SQL*Plus output buffer window." - (interactive "p") - (sqlplus-show-buffer (or connect-string sqlplus-connect-string) 'sqlplus-scroll-left (* num (/ (window-width) 2)))) - -(defun sqlplus-buffer-scroll-right (num &optional connect-string) - "Scroll-right in the SQL*Plus output buffer window." - (interactive "p") - (sqlplus-show-buffer (or connect-string sqlplus-connect-string) 'sqlplus-scroll-right (* num (/ (window-width) 2)))) - -(defun sqlplus-buffer-mark-current (&optional connect-string) - "Mark the current position in the SQL*Plus output window." - (sqlplus-show-buffer (or connect-string sqlplus-connect-string) 'sqlplus-buffer-make-mark)) - -(defun sqlplus-buffer-make-mark (&optional connect-string) - "Set the sqlplus-buffer-marker." - (setq sqlplus-buffer-mark (copy-marker (point)))) - -(defun sqlplus-buffer-redisplay-current (&optional connect-string) - "Go to the current sqlplus-buffer-mark." - (interactive) - (sqlplus-show-buffer (or connect-string sqlplus-connect-string) 'sqlplus-goto-mark)) - -(defun sqlplus-goto-mark () - (goto-char sqlplus-buffer-mark) - (recenter 0)) - -(defun sqlplus-buffer-top (&optional connect-string) - "Goto the top of the SQL*Plus output buffer." - (interactive) - (sqlplus-show-buffer (or connect-string sqlplus-connect-string) 'sqlplus-beginning-of-buffer)) - -(defun sqlplus-beginning-of-buffer nil (goto-char (point-min))) - -(defun sqlplus-buffer-bottom (&optional connect-string) - "Goto the bottom of the SQL*Plus output buffer." - (interactive) - (sqlplus-show-buffer (or connect-string sqlplus-connect-string) 'sqlplus-end-of-buffer)) - -(defun sqlplus-end-of-buffer nil (goto-char (point-max)) (unless sqlplus-suppress-show-output-buffer (recenter -1))) - -(defun sqlplus-buffer-erase (&optional connect-string) - "Clear the SQL output buffer." - (interactive) - (sqlplus-show-buffer (or connect-string sqlplus-connect-string) 'erase-buffer)) - -(defun sqlplus-buffer-next-command (&optional connect-string) - "Search for the next command in the SQL*Plus output buffer." - (interactive) - (sqlplus-show-buffer (or connect-string sqlplus-connect-string) 'sqlplus-next-command)) - -(defun sqlplus-next-command nil - "Search for the next command in the SQL*Plus output buffer." - (cond ((re-search-forward (concat "^" (regexp-quote sqlplus-output-separator)) nil t) - (forward-line 2) - (recenter 0)) - (t (beep) (message "No more commands.")))) - -(defun sqlplus-buffer-prev-command (&optional connect-string) - "Search for the previous command in the SQL*Plus output buffer." - (interactive) - (sqlplus-show-buffer (or connect-string sqlplus-connect-string) 'sqlplus-previous-command)) - -(defun sqlplus-previous-command nil - "Search for the previous command in the SQL*Plus output buffer." - (let ((start (point))) - (re-search-backward (concat "^" (regexp-quote sqlplus-output-separator)) nil t) - (cond ((re-search-backward (concat "^" (regexp-quote sqlplus-output-separator)) nil t) - (forward-line 2) - (recenter 0)) - (t - (message "No more commands.") (beep) - (goto-char start))))) - -(defun sqlplus-send-interrupt nil - "Send an interrupt the the SQL*Plus interpreter process." - (interactive) - (sqlplus-check-connection) - (let ((connect-string sqlplus-connect-string)) - (sqlplus-verify-buffer connect-string) - (interrupt-process (get-process (sqlplus-get-process-name connect-string))))) - - -;;; SQL Interpreter - -(defun refine-connect-string (connect-string &optional no-slash) - "Z connect stringa do SQL*Plusa wycina haslo, tj. np. 'ponaglenia/x@SID' -> ('ponaglenia@SID' . 'x')." - (let (result passwd) - (when connect-string - (setq result - (if (string-match "\\(\\`[^@/]*?\\)/\\([^/@:]*\\)\\(.*?\\'\\)" connect-string) - (progn - (setq passwd (match-string 2 connect-string)) - (concat (match-string 1 connect-string) (match-string 3 connect-string))) - connect-string)) - (when no-slash - (while (string-match "/" result) - (setq result (replace-match "!" nil t result))))) - (cons result passwd))) - -(defun sqlplus-get-output-buffer-name (connect-string) - (concat "*" (car (refine-connect-string connect-string)) "*")) - -(defun sqlplus-get-input-buffer-name (connect-string) - (concat (car (refine-connect-string connect-string)) (concat "." sqlplus-session-file-extension))) - -(defun sqlplus-get-history-buffer-name (connect-string) - (concat " " (car (refine-connect-string connect-string)) "-hist")) - -(defun sqlplus-get-process-buffer-name (connect-string) - (concat " " (car (refine-connect-string connect-string)))) - -(defun sqlplus-get-process-name (connect-string) - (car (refine-connect-string connect-string))) - -(defun sqlplus-read-connect-string (&optional connect-string default-connect-string) - "Ask user for connect string with password, with DEFAULT-CONNECT-STRING proposed. -DEFAULT-CONNECT-STRING nil means first inactive connect-string on sqlplus-connect-strings-alist. -CONNECT-STRING non nil means ask for password only if CONNECT-STRING has no password itself. -Returns (qualified-connect-string refined-connect-string)." - (unless default-connect-string - (let ((inactive-connect-strings (cdr (sqlplus-divide-connect-strings)))) - (setq default-connect-string - (some (lambda (pair) - (when (member (car pair) inactive-connect-strings) (car pair))) - sqlplus-connect-strings-alist)))) - (let* ((cs (downcase (or connect-string - (read-string (format "Connect string%s: " (if default-connect-string (format " [default %s]" default-connect-string) "")) - nil 'sqlplus-connect-string-history default-connect-string)))) - (pair (refine-connect-string cs)) - (refined-cs (car pair)) - (password (cdr pair)) - (was-password password) - (association (assoc refined-cs sqlplus-connect-strings-alist))) - (unless (or password current-prefix-arg) - (setq password (cdr association))) - (unless password - (setq password (read-passwd (format "Password for %s: " cs)))) - (unless was-password - (if (string-match "@" cs) - (setq cs (replace-match (concat "/" password "@") t t cs)) - (setq cs (concat cs "/" password)))) - (list cs refined-cs))) - -(defun sqlplus (connect-string &optional input-buffer-name output-buffer-flag) - "Create SQL*Plus process connected to Oracle according to -CONNECT-STRING, open (or create) input buffer with specified -name (do not create if INPUT-BUFFER-NAME is nil). -OUTPUT-BUFFER-FLAG has meanings: nil or SHOW-OUTPUT-BUFFER - -create output buffer and show it, DONT-SHOW-OUTPUT-BUFFER - -create output buffer but dont show it, DONT-CREATE-OUTPUT-BUFFER -- dont create output buffer" - (interactive (let ((pair (sqlplus-read-connect-string))) - (list (car pair) (concat (cadr pair) (concat "." sqlplus-session-file-extension))))) - (set (make-local-variable 'comment-start-skip) "/\\*+ *\\|--+ *") - (set (make-local-variable 'comment-multi-line) t) - ;; create sqlplus-session-cache-dir if not exists - (when sqlplus-session-cache-dir - (condition-case err - (unless (file-directory-p sqlplus-session-cache-dir) - (make-directory sqlplus-session-cache-dir t)) - (error (message (error-message-string err))))) - (let* ((was-input-buffer (and input-buffer-name (get-buffer input-buffer-name))) - (input-buffer (or was-input-buffer - (when input-buffer-name - (if sqlplus-session-cache-dir - (let ((buf (find-file-noselect - (concat - (file-name-as-directory sqlplus-session-cache-dir) - (car (refine-connect-string connect-string t)) - (concat "." sqlplus-session-file-extension))))) - (condition-case nil - (with-current-buffer buf - (rename-buffer input-buffer-name)) - (error nil)) - buf) - (get-buffer-create input-buffer-name))))) - (output-buffer (or (and (not (eq output-buffer-flag 'dont-create-output-buffer)) - (get-buffer-create (sqlplus-get-output-buffer-name connect-string))) - (get-buffer (sqlplus-get-output-buffer-name connect-string)))) - (process-name (sqlplus-get-process-name connect-string)) - (process-buffer-name (sqlplus-get-process-buffer-name connect-string)) - (was-process (get-process process-name)) - process-created - (process (or was-process - (let (proc) - (puthash (car (refine-connect-string connect-string)) - (make-sqlplus-global-struct :font-lock-regexps (make-hash-table :test 'equal) - :side-view-buffer (when (featurep 'ide-skel) (sqlplus-create-side-view-buffer connect-string))) - sqlplus-global-structures) - ;; push current connect string to the beginning of sqlplus-connect-strings-alist - (let* ((refined-cs (refine-connect-string connect-string))) - (setq sqlplus-connect-strings-alist (delete* (car refined-cs) sqlplus-connect-strings-alist :test 'string= :key 'car)) - (push refined-cs sqlplus-connect-strings-alist)) - (sqlplus-get-history-buffer connect-string) - (when output-buffer - (with-current-buffer output-buffer - (erase-buffer))) - (setq process-created t - proc (start-process process-name process-buffer-name sqlplus-command connect-string)) - (set-process-sentinel proc (lambda (process event) - (let ((proc-buffer (buffer-name (process-buffer process))) - (output-buffer (get-buffer (sqlplus-get-output-buffer-name (process-name process)))) - err-msg - (exited-abnormally (string-match "\\`exited abnormally with code" event))) - (when output-buffer - (with-current-buffer output-buffer - (goto-char (point-max)) - (insert (format "\n%s" event)) - (when exited-abnormally - (setq sqlplus-connect-strings-alist - (delete* (car (refine-connect-string sqlplus-connect-string)) - sqlplus-connect-strings-alist :test 'string= :key 'car)) - (when proc-buffer - (with-current-buffer proc-buffer - (save-excursion - (goto-char (point-min)) - (when (re-search-forward "^ORA-[0-9]+.*$" nil t) - (setq err-msg (match-string 0)))) - (erase-buffer))) - (when err-msg - (insert (concat "\n" err-msg))))))))) - (process-kill-without-query proc (not sqlplus-kill-processes-without-query-on-exit-flag)) - (set-process-filter proc 'sqlplus-process-filter) - (with-current-buffer (get-buffer process-buffer-name) - (setq sqlplus-process-p connect-string)) - proc)))) - (when output-buffer - (with-current-buffer output-buffer - (orcl-mode 1) - (set (make-local-variable 'line-move-ignore-invisible) t) - (setq sqlplus-output-buffer-keymap (make-sparse-keymap) - sqlplus-connect-string connect-string - truncate-lines t) - (define-key sqlplus-output-buffer-keymap "\C-m" (lambda () (interactive) (sqlplus-output-buffer-hide-show))) - (define-key sqlplus-output-buffer-keymap [S-mouse-2] (lambda (event) (interactive "@e") (sqlplus-output-buffer-hide-show))) - (local-set-key [S-return] 'sqlplus-send-user-string))) - (when input-buffer - (with-current-buffer input-buffer - (setq sqlplus-connect-string connect-string))) - ;; if input buffer was created then switch it to sqlplus-mode - (when (and input-buffer (not was-input-buffer)) - (with-current-buffer input-buffer - (unless (eq major-mode 'sqlplus-mode) - (sqlplus-mode))) - (when font-lock-mode (font-lock-mode 1)) - (set-window-buffer (sqlplus-get-workbench-window) input-buffer)) - ;; if process was created then get information for font lock - (when process-created - (sqlplus-execute connect-string nil nil (sqlplus-initial-strings) 'no-echo) - (let ((plsql-font-lock-level (sqlplus-font-lock-value-in-major-mode font-lock-maximum-decoration 'plsql-mode)) - (sqlplus-font-lock-level (sqlplus-font-lock-value-in-major-mode font-lock-maximum-decoration 'sqlplus-mode))) - (when (or (equal plsql-font-lock-level t) (equal sqlplus-font-lock-level t) - (and (numberp plsql-font-lock-level) (>= plsql-font-lock-level 2)) - (and (numberp sqlplus-font-lock-level) (>= sqlplus-font-lock-level 2))) - (sqlplus-hidden-select connect-string - (concat "select distinct column_name, 'COLUMN', ' ' from user_tab_columns where column_name not like 'BIN$%'\n" - "union\n" - "select username, 'SCHEMA', ' ' from all_users where username not like 'BIN$%'\n" - "union\n" - "select object_name, object_type, decode( status, 'INVALID', 'I', ' ' ) from user_objects\n" - "where object_name not like 'BIN$%'\n" - "and object_type in ('VIEW', 'SEQUENCE', 'PACKAGE', 'TRIGGER', 'TABLE', 'SYNONYM', 'INDEX', 'FUNCTION', 'PROCEDURE');") - 'sqlplus-my-handler)))) - (when input-buffer - (save-selected-window - (when (equal (selected-window) (sqlplus-get-side-window)) - (select-window (sqlplus-get-workbench-window))) - (switch-to-buffer input-buffer))) - (let ((saved-window (cons (selected-window) (window-buffer (selected-window)))) - (input-buffer (get-buffer (sqlplus-get-input-buffer-name connect-string)))) - (when (or (eq output-buffer-flag 'show-output-buffer) (null output-buffer-flag)) - (sqlplus-show-buffer connect-string)) - (if (window-live-p (car saved-window)) - (select-window (car saved-window)) - (if (get-buffer-window (cdr saved-window)) - (select-window (get-buffer-window (cdr saved-window))) - (when (and input-buffer - (get-buffer-window input-buffer)) - (select-window (get-buffer-window input-buffer)))))) - ;; executing initial sequence (between /* init */ and /* end */) - (when (and (not was-process) input-buffer) - (with-current-buffer input-buffer - (save-excursion - (goto-char (point-min)) - (when (re-search-forward (concat "^" sqlplus-init-sequence-start-regexp "\\s-*\n\\(\\(.\\|\n\\)*?\\)\n" sqlplus-init-sequence-end-regexp) nil t) - (when (match-string 1) - (sqlplus-send-region nil (match-beginning 1) (match-end 1) t)))))))) - -;; Command under cursor selection mechanism -(when window-system - (run-with-idle-timer 0 t (lambda () (when (eq major-mode 'sqlplus-mode) (sqlplus-highlight-current-sqlplus-command)))) - (run-with-idle-timer 1 t (lambda () - (when (eq major-mode 'sqlplus-mode) - (if (>= (sqlplus-color-percentage (face-background 'default)) 50) - (set-face-attribute 'sqlplus-command-highlight-face nil - :background (sqlplus-shine-color (face-background 'default) (- sqlplus-command-highlighting-percentage))) - (set-face-attribute 'sqlplus-command-highlight-face nil - :background (sqlplus-shine-color (face-background 'default) sqlplus-command-highlighting-percentage))))))) - -(defun sqlplus-output-buffer-hide-show () - (if (and (consp buffer-invisibility-spec) - (assq 'hide-symbol buffer-invisibility-spec)) - (remove-from-invisibility-spec '(hide-symbol . t)) - (add-to-invisibility-spec '(hide-symbol . t))) - (let ((overlay (car (overlays-at (point))))) - (when overlay - (goto-char (overlay-start overlay)) - (beginning-of-line))) - (recenter 0)) - -(defun sqlplus-font-lock-value-in-major-mode (alist mode-symbol) - (if (consp alist) - (cdr (or (assq mode-symbol alist) (assq t alist))) - alist)) - -(defun sqlplus-get-history-buffer (connect-string) - (let* ((history-buffer-name (sqlplus-get-history-buffer-name connect-string)) - (history-buffer (get-buffer history-buffer-name))) - (unless history-buffer - (setq history-buffer (get-buffer-create history-buffer-name)) - (with-current-buffer history-buffer - (setq sqlplus-cs connect-string) - (add-hook 'kill-buffer-hook 'sqlplus-history-buffer-kill-function nil t))) - history-buffer)) - -(defun sqlplus-history-buffer-kill-function () - (when sqlplus-history-dir - (condition-case err - (progn - (unless (file-directory-p sqlplus-history-dir) - (make-directory sqlplus-history-dir t)) - (append-to-file 1 (buffer-size) (concat (file-name-as-directory sqlplus-history-dir) (car (refine-connect-string sqlplus-cs t)) "-hist.txt"))) - (error (message (error-message-string err)))))) - -(defun sqlplus-soft-shutdown (connect-string) - (unless (some (lambda (buffer) - (with-current-buffer buffer - (and sqlplus-connect-string - (equal (car (refine-connect-string sqlplus-connect-string)) - (car (refine-connect-string connect-string)))))) - (buffer-list)) - (sqlplus-shutdown connect-string))) - -(defun sqlplus-shutdown (connect-string &optional dont-kill-input-buffer) - "Kill input, output and process buffer for specified CONNECT-STRING." - (let ((input-buffers (delq nil (mapcar (lambda (buffer) (with-current-buffer buffer - (when (and (eq major-mode 'sqlplus-mode) - (equal (car (refine-connect-string sqlplus-connect-string)) - (car (refine-connect-string connect-string)))) - buffer))) (buffer-list)))) - (output-buffer (get-buffer (sqlplus-get-output-buffer-name connect-string))) - (history-buffer (get-buffer (sqlplus-get-history-buffer-name connect-string))) - (process-buffer (get-buffer (sqlplus-get-process-buffer-name connect-string)))) - (when history-buffer - (kill-buffer history-buffer)) - (when (and process-buffer - (with-current-buffer process-buffer sqlplus-process-p)) - (when (get-process (sqlplus-get-process-name connect-string)) - (delete-process (sqlplus-get-process-name connect-string))) - (kill-buffer process-buffer)) - (when (and output-buffer - (with-current-buffer output-buffer sqlplus-connect-string)) - (when (buffer-file-name output-buffer) - (with-current-buffer output-buffer - (save-buffer))) - (kill-buffer output-buffer)) - (dolist (input-buffer input-buffers) - (when (buffer-file-name input-buffer) - (with-current-buffer input-buffer - (save-buffer))) - (unless dont-kill-input-buffer - (kill-buffer input-buffer))))) - -(defun sqlplus-magic () - (let (bottom-message pos) - (delete-region (point) (progn (beginning-of-line 3) (point))) - (setq bottom-message (buffer-substring (point) (save-excursion (end-of-line) (point)))) - (setq pos (point)) - (when (re-search-forward "^-------" nil t) - (delete-region pos (progn (beginning-of-line 2) (point))) - (while (re-search-forward "|" (save-excursion (end-of-line) (point)) t) - (save-excursion - (backward-char) - (if (or (bolp) (save-excursion (forward-char) (eolp))) - (while (member (char-after) '(?- ?|)) - (delete-char 1) - (sqlplus-next-line)) - (while (member (char-after) '(?- ?|)) - (delete-char 1) - (insert " ") - (backward-char) - (sqlplus-next-line))))) - (beginning-of-line 3) - (re-search-forward "^---" nil t) - (goto-char (match-beginning 0)) - (delete-region (point) (point-max)) - (insert (format "%s\n\n%s\n" sqlplus-repfooter bottom-message)) - ))) - - -(defun sqlplus-process-command-output (context connect-string begin end interrupted) - (let* ((output-buffer-name (sqlplus-get-output-buffer-name connect-string)) - (output-buffer (get-buffer output-buffer-name)) - (process-buffer (sqlplus-get-process-buffer-name connect-string)) - str - error-list show-errors-p - slips-count - (user-function (sqlplus-get-context-value context :user-function)) - (result-function (sqlplus-get-context-value context :result-table-function)) - (last-compiled-file-path (sqlplus-get-context-value context :last-compiled-file-path)) - (compilation-expected (sqlplus-get-context-value context :compilation-expected)) - (columns-count (sqlplus-get-context-value context :columns-count)) - (sql (sqlplus-get-context-value context :sql)) - (original-buffer (current-buffer)) - explain-plan - table-data) - (setq slips-count columns-count) - (with-temp-buffer - (insert-buffer-substring original-buffer begin end) - (goto-char (point-min)) - (while (re-search-forward (concat "\n+" (regexp-quote sqlplus-page-separator) "\n") nil t) - (replace-match "\n")) - (goto-char (point-min)) - (setq str (buffer-string)) - (while (string-match (concat "^" (regexp-quote sqlplus-repfooter) "\n") str) - (setq str (replace-match "" nil t str))) - - ;; compilation errors? - (goto-char (point-min)) - (skip-chars-forward "\n\t ") - (when (and ;;(not (equal (point) (point-max))) - plsql-auto-parse-errors-flag - output-buffer - last-compiled-file-path - (re-search-forward "^\\(LINE/COL\\|\\(SP2\\|CPY\\|ORA\\)-[0-9]\\{4,5\\}:\\|No errors\\|Nie ma b..d.w\\|Keine Fehler\\|No hay errores\\|Identificateur erron\\|Nessun errore\\|N..o h.. erros\\)" nil t)) - (goto-char (point-min)) - (setq error-list (plsql-parse-errors last-compiled-file-path) - show-errors-p compilation-expected)) - - ;; explain? - (let ((case-fold-search t)) - (goto-char (point-min)) - (skip-chars-forward "\n\t ") - (when (and sql - (string-match "^[\n\t ]*explain\\>" sql) - (looking-at "Explained[.]")) - (delete-region (point-min) (point-max)) - (setq str "") - (sqlplus--send connect-string - "select plan_table_output from table(dbms_xplan.display(null, null, 'TYPICAL'));" - nil - 'no-echo - nil))) - - ;; plan table output? - (goto-char (point-min)) - (skip-chars-forward "\n\t ") - (when (and (looking-at "^PLAN_TABLE_OUTPUT\n") - sqlplus-format-output-tables-flag - (not compilation-expected) - (not show-errors-p)) - (sqlplus-magic) ;; TODO - (goto-char (point-min)) - (re-search-forward "^[^\n]+" nil t) - (delete-region (point-min) (progn (beginning-of-line) (point))) - ;; (setq slips-count 1) - (setq explain-plan t) - (setq table-data (save-excursion (sqlplus-parse-output-table interrupted)))) - - ;; query result? - (goto-char (point-min)) - (when (and sqlplus-format-output-tables-flag - (not compilation-expected) - (not table-data) - (not show-errors-p) - (not (re-search-forward "^LINE/COL\\>" nil t))) - (setq table-data (save-excursion (sqlplus-parse-output-table interrupted)))) - (if user-function - (funcall user-function connect-string context (or table-data str)) - (when output-buffer - (with-current-buffer output-buffer - (save-excursion - (goto-char (point-max)) - (cond (show-errors-p - (insert str) - (plsql-display-errors (file-name-directory last-compiled-file-path) error-list) - (let* ((plsql-buf (get-file-buffer last-compiled-file-path)) - (win (when plsql-buf (car (get-buffer-window-list plsql-buf))))) - (when win - (select-window win)))) - ((and table-data - (car table-data)) - (if result-function - (funcall result-function connect-string table-data) - (let ((b (point)) - (warning-regexp (regexp-opt sqlplus-explain-plan-warning-regexps)) - e) - (sqlplus-draw-table table-data slips-count) - (when interrupted (insert ". . .\n")) - (setq e (point)) - (when explain-plan - (save-excursion - (goto-char b) - (while (re-search-forward warning-regexp nil t) - (add-text-properties (match-beginning 0) (match-end 0) - (list 'face (list (cons 'foreground-color "red") (list :weight 'bold) - (get-text-property (match-beginning 0) 'face)))))))))) - (t - (insert str)))))))))) - -(defun sqlplus-result-online (connect-string context string last-chunk) - (let ((output-buffer (sqlplus-get-output-buffer-name connect-string))) - (when output-buffer - (with-current-buffer output-buffer - (save-excursion - (goto-char (point-max)) - (insert string)))))) - -(defvar sqlplus-prompt-regexp (concat "^" (regexp-quote sqlplus-prompt-prefix) "\\([0-9]+\\)" (regexp-quote sqlplus-prompt-suffix))) - -(defvar sqlplus-page-separator-regexp (concat "^" (regexp-quote sqlplus-page-separator))) - -(defun sqlplus-process-filter (process string) - (with-current-buffer (process-buffer process) - (let* ((prompt-safe-len (+ (max (+ (length sqlplus-prompt-prefix) (length sqlplus-prompt-suffix)) (length sqlplus-page-separator)) 10)) - current-context-id filter-input-processed - (connect-string sqlplus-process-p) - (chunk-begin-pos (make-marker)) - (chunk-end-pos (make-marker)) - (prompt-found (make-marker)) - (context (sqlplus-get-context connect-string current-context-id)) - (current-command-input-buffer-name (sqlplus-get-context-value context :current-command-input-buffer-name)) - (current-command-input-buffer-names (when current-command-input-buffer-name (list current-command-input-buffer-name)))) - (set-marker chunk-begin-pos (max 1 (- (point) prompt-safe-len))) - (goto-char (point-max)) - (insert string) - (unless current-command-input-buffer-names - (setq current-command-input-buffer-names - (delq nil (mapcar (lambda (buffer) (with-current-buffer buffer - (when (and (memq major-mode '(sqlplus-mode plsql-mode)) - sqlplus-connect-string - (equal (car (refine-connect-string sqlplus-connect-string)) - (car (refine-connect-string connect-string)))) - buffer))) (buffer-list))))) - ;; fan animation - (dolist (current-command-input-buffer-name current-command-input-buffer-names) - (let ((input-buffer (get-buffer current-command-input-buffer-name))) - (when input-buffer - (with-current-buffer input-buffer - (setq sqlplus-fan - (cond ((equal sqlplus-fan "|") "/") - ((equal sqlplus-fan "/") "-") - ((equal sqlplus-fan "-") "\\") - ((equal sqlplus-fan "\\") "|"))) - (put-text-property 0 (length sqlplus-fan) 'face '((foreground-color . "red")) sqlplus-fan) - (put-text-property 0 (length sqlplus-fan) 'help-echo (sqlplus-get-context-value context :sql) sqlplus-fan) - (force-mode-line-update))))) - (unwind-protect - (while (not filter-input-processed) - (let* ((context (sqlplus-get-context connect-string current-context-id)) - (dont-parse-result (sqlplus-get-context-value context :dont-parse-result)) - (current-command-input-buffer-name (sqlplus-get-context-value context :current-command-input-buffer-name)) - (result-function (sqlplus-get-context-value context :result-function)) - (skip-to-the-end-of-command (sqlplus-get-context-value context :skip-to-the-end-of-command))) - (set-marker prompt-found nil) - (goto-char chunk-begin-pos) - (set-marker chunk-end-pos - (if (or (re-search-forward sqlplus-prompt-regexp nil t) - (re-search-forward "^SQL> " nil t)) - (progn - (set-marker prompt-found (match-end 0)) - (when (match-string 1) - (setq current-context-id (string-to-number (match-string 1)))) - (match-beginning 0)) - (point-max))) - (cond ((and (equal chunk-begin-pos chunk-end-pos) ; at the end of command - (marker-position prompt-found)) - ;; deactivate fan - (dolist (current-command-input-buffer-name current-command-input-buffer-names) - (let ((input-buffer (get-buffer current-command-input-buffer-name))) - (when input-buffer - (with-current-buffer input-buffer - (remove-text-properties 0 (length sqlplus-fan) '(face nil) sqlplus-fan) - (force-mode-line-update))))) - (delete-region 1 prompt-found) - (when dont-parse-result - (funcall (or result-function 'sqlplus-result-online) connect-string context "" t)) - (sqlplus-set-context-value context :skip-to-the-end-of-command nil) - (set-marker chunk-begin-pos 1)) - ((equal chunk-begin-pos chunk-end-pos) - (when dont-parse-result - (delete-region 1 (point-max))) - (setq filter-input-processed t)) - (dont-parse-result - (funcall (or result-function 'sqlplus-result-online) - connect-string - context - (buffer-substring chunk-begin-pos chunk-end-pos) - (marker-position prompt-found)) - (set-marker chunk-begin-pos chunk-end-pos)) - (t - (when (not skip-to-the-end-of-command) - (goto-char (max 1 (- chunk-begin-pos 4010))) - (let ((page-separator-found - (save-excursion (let ((pos (re-search-forward (concat sqlplus-page-separator-regexp "[^-]*\\(^-\\|^ e b) - (buffer-substring b e) - ""))) - (col-preferred-width (string-width col-name))) - ;; (put-text-property 0 (length col-name) 'face '(bold) col-name) - (push (make-col-desc :id col-counter :name col-name :start-pos col-begin - :end-pos col-end :max-width col-max-width :preferred-width col-preferred-width :min-prefix-len col-max-width) - column-infos) - (incf col-counter) - (goto-char ed) - (if (equal (char-after) ?\n) - (progn - (beginning-of-line 3) - (incf record-lines)) - (forward-char))) - (setq finish t))) - (decf record-lines) - (setq column-infos (nreverse column-infos)) - (forward-line -1) - - ;; at the first char of first data cell. - ;; table parsing... - (while (< (point) end) - (let (record last-start-pos) - (dolist (column-info column-infos) - (let ((start-pos (col-desc-start-pos column-info)) - (end-pos (col-desc-end-pos column-info)) - width len value b e l) - (when (and last-start-pos - (<= start-pos last-start-pos)) - (forward-line)) - (setq last-start-pos start-pos) - (move-to-column start-pos) - (setq b (point)) - (move-to-column end-pos) - (setq e (point)) - (move-to-column start-pos) - (setq l (skip-chars-forward " " e)) - (when (and (col-desc-min-prefix-len column-info) - (< l (- e b)) - (< l (col-desc-min-prefix-len column-info))) - (setf (col-desc-min-prefix-len column-info) - (if (looking-at "[0-9]") l nil))) - (move-to-column end-pos) - (skip-chars-backward " " b) - (setq value (if (> (point) b) (buffer-substring b (point)) "")) - (setq len (length value) - width (string-width value)) - (when (and sqlplus-select-result-max-col-width - (> len sqlplus-select-result-max-col-width)) - (setq value (concat (substring value 0 sqlplus-select-result-max-col-width) "...") - len (length value) - width (string-width value))) - (when (> width (col-desc-preferred-width column-info)) - (setf (col-desc-preferred-width column-info) width)) - (when (and (< l (- e b)) - (memq (col-desc-numeric column-info) '(nil y))) - (setf (col-desc-numeric column-info) - (if (string-match "\\` *[-+0-9Ee.,$]+\\'" value) 'y 'n))) - (push value record))) - (forward-line) - (when (> record-lines 1) - (forward-line)) - (setq last-start-pos nil - record (nreverse record)) - (push record rows))) - (setq rows (nreverse rows)) - (list column-infos rows last-msg))))) - -(defun sqlplus-draw-table (lst &optional slips-count) - "SLIPS-COUNT (nil means compute automatically)." - ;; current buffer: SQL*Plus output buffer - (when window-system - (if (>= (sqlplus-color-percentage (face-background 'default)) 50) - (progn - (set-face-attribute 'sqlplus-table-head-face nil - :background (sqlplus-shine-color (face-background 'default) -70) :foreground (face-background 'default)) - (set-face-attribute 'sqlplus-table-even-rows-face nil - :background (sqlplus-shine-color (face-background 'default) -20) :overline (face-background 'default)) - (set-face-attribute 'sqlplus-table-odd-rows-face nil - :background (sqlplus-shine-color (face-background 'default) -30) :overline (face-background 'default))) - (set-face-attribute 'sqlplus-table-head-face nil - :background (sqlplus-shine-color (face-background 'default) +70) :foreground (face-background 'default)) - (set-face-attribute 'sqlplus-table-even-rows-face nil - :background (sqlplus-shine-color (face-background 'default) +20) :overline (face-background 'default)) - (set-face-attribute 'sqlplus-table-odd-rows-face nil - :background (sqlplus-shine-color (face-background 'default) +30) :overline (face-background 'default)))) - (let* ((column-infos (car lst)) - (rows (cadr lst)) - (slip-width 0) - (table-header-height 1) - (table-area-width (1- (let ((side-window (sqlplus-get-side-window))) (if side-window (window-width side-window) (frame-width))))) - ;; may be nil, which means no limit - (table-area-height (let ((side-window (sqlplus-get-side-window))) - (when side-window - (- (window-height side-window) 2 (if mode-line-format 1 0) (if header-line-format 1 0))))) - (column-separator-width (if sqlplus-elegant-style 1.2 (max (length sqlplus-table-col-separator) (length sqlplus-table-col-head-separator)))) - rows-per-slip ;; data rows per slip - (slip-separator-width (if sqlplus-elegant-style 1.5 sqlplus-slip-separator-width)) - (slip-separator (make-string (max 0 (if sqlplus-elegant-style 1 sqlplus-slip-separator-width)) ?\ )) - (last-msg (caddr lst))) - (when sqlplus-elegant-style - (put-text-property 0 1 'display (cons 'space (list :width slip-separator-width)) slip-separator)) - (when (<= table-area-height table-header-height) - (setq table-area-height nil)) - (when (and window-system sqlplus-elegant-style table-area-height (> table-area-height 3)) - ;; overline makes glyph higher... - (setq table-area-height (- table-area-height (round (/ (* 20.0 (- table-area-height 3)) (face-attribute 'default :height)))))) - (when column-infos - (goto-char (point-max)) - (beginning-of-line) - ;; slip width (without separator between slips) - (dolist (col-info column-infos) - (when (col-desc-min-prefix-len col-info) - (setf (col-desc-preferred-width col-info) (max (string-width (col-desc-name col-info)) - (- (col-desc-preferred-width col-info) (col-desc-min-prefix-len col-info))))) - (incf slip-width (+ (col-desc-preferred-width col-info) column-separator-width))) - (when (> slip-width 0) - (setq slip-width (+ (- slip-width column-separator-width) (if sqlplus-elegant-style 1.0 0)))) - ;; computing slip count if not known yet - (unless slips-count - (setq slips-count - (if table-area-height (min (ceiling (/ (float (length rows)) (max 1 (- table-area-height table-header-height 2)))) - (max 1 (floor (/ (float table-area-width) (+ slip-width slip-separator-width))))) - 1))) - (setq slips-count (max 1 (min slips-count (length rows)))) ; slip count <= data rows - (setq rows-per-slip (ceiling (/ (float (length rows)) slips-count))) - (when (> rows-per-slip 0) - (setq slips-count (max 1 (min (ceiling (/ (float (length rows)) rows-per-slip)) slips-count)))) - - (let ((table-begin-point (point))) - (dotimes (slip-no slips-count) - (let ((row-no 0) - (slip-begin-point (point)) - (rows-processed 0)) - ;; column names - (dolist (col-info column-infos) - (let* ((col-name (col-desc-name col-info)) - (spaces (max 0 (- (col-desc-preferred-width col-info) (string-width col-name)))) - (last-col-p (>= (1+ (col-desc-id col-info)) (length column-infos))) - (val (format (if sqlplus-elegant-style " %s%s %s" "%s%s%s") - col-name - (make-string spaces ?\ ) - (if last-col-p "" (if sqlplus-elegant-style " " sqlplus-table-col-separator))))) - (put-text-property 0 (if (or (not sqlplus-elegant-style) last-col-p) (length val) (1- (length val))) - 'face 'sqlplus-table-head-face val) - (when sqlplus-elegant-style - (put-text-property 0 1 'display '(space . (:width 0.5)) val) - (put-text-property (- (length val) (if last-col-p 1 2)) (- (length val) (if last-col-p 0 1)) 'display '(space . (:width 0.5)) val) - (unless last-col-p - (put-text-property (- (length val) 1) (length val) 'display '(space . (:width 0.2)) val))) - (insert val))) - (insert slip-separator) - (insert "\n") - ;; data rows - (while (and (< rows-processed rows-per-slip) - rows) - (let ((row (car rows))) - (setq rows (cdr rows)) - (incf rows-processed) - (let ((col-infos column-infos)) - (dolist (value row) - (let* ((col-info (car col-infos)) - (numeric-p (eq (col-desc-numeric col-info) 'y)) - (min-prefix (col-desc-min-prefix-len col-info))) - (when (and min-prefix - value - (>= (length value) min-prefix)) - (setq value (substring value min-prefix))) - (let* ((spaces (max 0 (- (col-desc-preferred-width col-info) (string-width value)))) - (val (if numeric-p - (format (if sqlplus-elegant-style " %s%s %s" "%s%s%s") - (make-string spaces ?\ ) - value - (if (cdr col-infos) (if sqlplus-elegant-style " " sqlplus-table-col-separator) "")) - (format (if sqlplus-elegant-style " %s%s %s" "%s%s%s") - value - (make-string spaces ?\ ) - (if (cdr col-infos) (if sqlplus-elegant-style " " sqlplus-table-col-separator) ""))))) - (put-text-property 0 (if (and sqlplus-elegant-style (cdr col-infos)) (- (length val) 1) (length val)) - 'face (if (evenp row-no) - 'sqlplus-table-even-rows-face - 'sqlplus-table-odd-rows-face) val) - (when sqlplus-elegant-style - (put-text-property 0 1 'display '(space . (:width 0.5)) val) - (put-text-property (- (length val) (if (cdr col-infos) 2 1)) - (- (length val) (if (cdr col-infos) 1 0)) - 'display '(space . (:width 0.5)) val) - (when (cdr col-infos) - (put-text-property (- (length val) 1) (length val) 'display '(space . (:width 0.2)) val))) - (setq col-infos (cdr col-infos)) - (insert val)))) - (incf row-no) - (insert slip-separator) - (insert "\n")))) - (when (> slip-no 0) - (delete-backward-char 1) - (let ((slip-end-point (point))) - (kill-rectangle slip-begin-point slip-end-point) - (delete-region slip-begin-point (point-max)) - (goto-char table-begin-point) - (end-of-line) - (yank-rectangle) - (goto-char (point-max)) - )))) - (goto-char (point-max)) - (when (and last-msg (> (length last-msg) 0)) - (unless sqlplus-elegant-style (insert "\n")) - (let ((s (format "%s\n\n" (replace-regexp-in-string "\n+" " " last-msg)))) - (when sqlplus-elegant-style - (put-text-property (- (length s) 2) (1- (length s)) 'display '(space . (:height 1.5)) s)) - (insert s))))))) - -(defun sqlplus-send-user-string (str) - (interactive (progn (sqlplus-check-connection) - (if sqlplus-connect-string - (list (read-string "Send to process: " nil 'sqlplus-user-string-history "")) - (error "Works only in SQL*Plus buffer")))) - (let ((connect-string sqlplus-connect-string)) - (sqlplus-verify-buffer connect-string) - (let* ((process (get-process (sqlplus-get-process-name connect-string))) - (output-buffer-name (sqlplus-get-output-buffer-name connect-string))) - (sqlplus-echo-in-buffer output-buffer-name (concat str "\n")) - (send-string process (concat str "\n"))))) - -(defun sqlplus-prepare-update-alist (table-data) - (let ((column-infos (car table-data)) - (rows (cadr table-data)) - (msg (caddr table-data)) - alist) - (dolist (row rows) - (let* ((object-name (car row)) - (object-type (intern (downcase (cadr row)))) - (status (caddr row)) - (regexp-list (cdr (assq object-type alist))) - (pair (cons object-name (equal status "I")))) - (if regexp-list - (setcdr regexp-list (cons pair (cdr regexp-list))) - (setq regexp-list (list pair)) - (setq alist (cons (cons object-type regexp-list) alist))))) - alist)) - -(defun sqlplus-my-update-handler (connect-string table-data) - (let ((alist (sqlplus-prepare-update-alist table-data))) - (when (featurep 'ide-skel) - (funcall 'sqlplus-side-view-update-data connect-string alist)))) - -(defun sqlplus-my-handler (connect-string table-data) - (let ((alist (sqlplus-prepare-update-alist table-data)) - (sqlplus-font-lock-regexps (sqlplus-get-font-lock-regexps connect-string))) - (sqlplus-set-objects-alist alist connect-string) - (when (featurep 'ide-skel) - (funcall 'sqlplus-side-view-update-data connect-string alist)) - (clrhash sqlplus-font-lock-regexps) - (dolist (lst sqlplus-syntax-faces) - (let* ((object-type (car lst)) - (regexp-list (append (caddr lst) (mapcar 'car (cdr (assq object-type alist)))))) - (when regexp-list - (puthash object-type (concat "\\b" (regexp-opt regexp-list t) "\\b") sqlplus-font-lock-regexps)))) - (let ((map sqlplus-font-lock-regexps)) - (mapc (lambda (buffer) - (with-current-buffer buffer - (when (and (memq major-mode '(sqlplus-mode plsql-mode)) - (equal sqlplus-connect-string connect-string)) - (when font-lock-mode (font-lock-mode 1))))) - (buffer-list))))) - -(defun sqlplus-get-source-function (connect-string context string last-chunk) - (let* ((source-text (sqlplus-get-context-value context :source-text)) - (source-type (sqlplus-get-context-value context :source-type)) - (source-name (sqlplus-get-context-value context :source-name)) - (source-extension (sqlplus-get-context-value context :source-extension)) - (name (concat (upcase source-name) "." source-extension)) - finish) - (unless (sqlplus-get-context-value context :finished) - (setq source-text (concat source-text string)) - (sqlplus-set-context-value context :source-text source-text) - (when last-chunk - (if (string-match (regexp-quote sqlplus-end-of-source-sentinel) source-text) - (when (< (length source-text) (+ (length sqlplus-end-of-source-sentinel) 5)) - (setq last-chunk nil - finish "There is no such database object")) - (setq last-chunk nil))) - (when last-chunk - (setq finish t)) - (when finish - (sqlplus-set-context-value context :finished t) - (if (stringp finish) - (message finish) - (with-temp-buffer - (insert source-text) - (goto-char (point-min)) - (re-search-forward (regexp-quote sqlplus-end-of-source-sentinel) nil t) - (replace-match "") - (goto-char (point-max)) - (forward-comment (- (buffer-size))) - (when (equal source-type "TABLE") - (goto-char (point-min)) - (insert (format "table %s\n(\n" source-name)) - (goto-char (point-max)) - (delete-region (re-search-backward "," nil t) (point-max)) - (insert "\n);")) - (insert "\n/\n") - (unless (member source-type '("SEQUENCE" "TABLE" "SYNONYM" "INDEX")) - (insert "show err\n")) - (goto-char (point-min)) - (insert "create " (if (member source-type '("INDEX" "SEQUENCE" "TABLE")) "" "or replace ")) - (setq source-text (buffer-string))) - (with-current-buffer (get-buffer-create name) - (setq buffer-read-only nil) - (erase-buffer) - (insert source-text) - (goto-char (point-min)) - (set-visited-file-name (concat (file-name-as-directory temporary-file-directory) - (concat (make-temp-name (sqlplus-canonize-file-name (concat (upcase source-name) "_") "[$]")) "." source-extension))) - (rename-buffer name) - (condition-case err - (funcall (symbol-function 'plsql-mode)) - (error nil)) - (setq sqlplus-connect-string connect-string - buffer-read-only sqlplus-source-buffer-readonly-by-default-flag) - (save-buffer) - (save-selected-window - (let ((win (selected-window))) - (when (or (equal win (sqlplus-get-side-window)) - (and (fboundp 'ide-skel-side-view-window-p) - (funcall 'ide-skel-side-view-window-p win))) - (setq win (sqlplus-get-workbench-window))) - (set-window-buffer win (current-buffer)))))))))) - -(defun sqlplus-get-source (connect-string name type &optional schema-name) - "Fetch source for database object NAME in current or specified SCHEMA-NAME, and show the source in new buffer. -Possible TYPE values are in 'sqlplus-object-types'." - (interactive (let* ((thing (thing-at-point 'symbol)) - (obj-raw-name (read-string (concat "Object name" (if thing (concat " [default " thing "]") "") ": ") - nil - 'sqlplus-get-source-history (when thing thing))) - (completion-ignore-case t) - (type (completing-read "Object type: " (mapcar (lambda (type) (cons type nil)) sqlplus-object-types) nil t))) - (string-match "^\\(\\([^.]+\\)[.]\\)?\\(.*\\)$" obj-raw-name) - (list sqlplus-connect-string (match-string 3 obj-raw-name) type (match-string 2 obj-raw-name)))) - (setq type (upcase type)) - (let* ((sql - (cond ((equal type "SEQUENCE") - (format (concat "select 'sequence %s' || sequence_name || " - "decode( increment_by, 1, '', ' increment by ' || increment_by ) || " - "case when increment_by > 0 and max_value >= (1.0000E+27)-1 or increment_by < 0 and max_value = -1 then '' " - "else decode( max_value, null, ' nomaxvalue', ' maxvalue ' || max_value) end || " - "case when increment_by > 0 and min_value = 1 or increment_by < 0 and min_value <= (-1.0000E+26)+1 then '' " - "else decode( min_value, null, ' nominvalue', ' minvalue ' || min_value) end || " - "decode( cycle_flag, 'Y', ' cycle', '' ) || " - "decode( cache_size, 20, '', 0, ' nocache', ' cache ' || cache_size ) || " - "decode( order_flag, 'Y', ' order', '' ) " - "from %s where sequence_name = '%s'%s;") - (if schema-name (concat (upcase schema-name) ".") "") - (if schema-name "all_sequences" "user_sequences") - (upcase name) - (if schema-name (format " and sequence_owner = '%s'" (upcase schema-name)) ""))) - ((equal type "TABLE") - (format (concat "select ' ' || column_name || ' ' || data_type || " - "decode( data_type," - " 'VARCHAR2', '(' || to_char( data_length, 'fm9999' ) || ')'," - " 'NUMBER', decode( data_precision," - " null, ''," - " '(' || to_char( data_precision, 'fm9999' ) || decode( data_scale," - " null, ''," - " 0, ''," - " ',' || data_scale ) || ')' )," - " '') || " - "decode( nullable, 'Y', ' not null', '') || ','" - "from all_tab_columns " - "where owner = %s and table_name = '%s' " - "order by column_id;") - (if schema-name (concat "'" (upcase schema-name) "'") "user") - (upcase name))) - ((equal type "SYNONYM") - (format (concat "select " - "decode( owner, 'PUBLIC', 'public ', '' ) || 'synonym ' || " - "decode( owner, 'PUBLIC', '', user, '', owner || '.' ) || synonym_name || ' for ' || " - "decode( table_owner, user, '', table_owner || '.' ) || table_name || " - "decode( db_link, null, '', '@' || db_link ) " - "from all_synonyms where (owner = 'PUBLIC' or owner = %s) and synonym_name = '%s';") - (if schema-name (concat "'" (upcase schema-name) "'") "user") - (upcase name))) - ((equal type "VIEW") - (if schema-name (format "select 'view %s.' || view_name || ' as ', text from all_views where owner = '%s' and view_name = '%s';" - (upcase schema-name) (upcase schema-name) (upcase name)) - (format "select 'view ' || view_name || ' as ', text from user_views where view_name = '%s';" (upcase name)))) - ((or (equal type "PROCEDURE") - (equal type "FUNCTION")) - (if schema-name (format "select text from all_source where owner = '%s' and name = '%s' and type in ('PROCEDURE', 'FUNCTION') order by line;" - (upcase schema-name) (upcase name)) - (format "select text from user_source where name = '%s' and type in ('PROCEDURE', 'FUNCTION') order by line;" - (upcase name)))) - (t - (if schema-name (format "select text from all_source where owner = '%s' and name = '%s' and type = '%s' order by line;" - (upcase schema-name) (upcase name) (upcase type)) - (format "select text from user_source where name = '%s' and type = '%s' order by line;" - (upcase name) (upcase type)))))) - (prolog-commands (list "set echo off" - "set newpage 0" - "set space 0" - "set pagesize 0" - "set feedback off" - "set long 4000" - "set longchunksize 4000" - "set wrap on" - "set heading off" - "set trimspool on" - "set linesize 4000" - "set timing off")) - (extension (if (equal (downcase type) "package") "pks" "sql")) - (source-buffer-name (concat " " (upcase name) "." extension)) - (context-options (list (cons :dont-parse-result 'dont-parse) - (cons :source-text nil) - (cons :source-type type) - (cons :source-name name) - (cons :source-extension extension) - (cons :result-function 'sqlplus-get-source-function)))) - (sqlplus-execute connect-string sql context-options prolog-commands t t) - (sqlplus-execute connect-string (format "select '%s' from dual;" sqlplus-end-of-source-sentinel) context-options prolog-commands t t))) - -(defun sqlplus-canonize-file-name (file-name regexp) - (while (string-match regexp file-name) - (setq file-name (replace-match "!" nil t file-name))) - file-name) - -(defun sqlplus-define-user-variables (string) - (when string - (let (variables-list - define-commands - (index 0)) - (while (setq index (string-match "&+\\(\\(\\sw\\|\\s_\\)+\\)" string index)) - (let ((var-name (match-string 1 string))) - (setq index (+ 2 index)) - (unless (member var-name variables-list) - (push var-name variables-list)))) - (dolist (var-name (reverse variables-list)) - (let* ((default-value (gethash var-name sqlplus-user-variables nil)) - (value (read-string (format (concat "Variable value for %s" (if default-value (format " [default: %s]" default-value) "") ": ") var-name) - nil 'sqlplus-user-variables-history default-value))) - (unless value - (error "There is no value for %s defined" var-name)) - (setq define-commands (cons (format "define %s=%s" var-name value) define-commands)) - (puthash var-name value sqlplus-user-variables))) - define-commands))) - -(defun sqlplus-parse-region (start end) - (let ((sql (buffer-substring start end))) - (save-excursion - ;; Strip whitespace from beginning and end, just to be neat. - (if (string-match "\\`[ \t\n]+" sql) - (setq sql (substring sql (match-end 0)))) - (if (string-match "[ \t\n]+\\'" sql) - (setq sql (substring sql 0 (match-beginning 0)))) - (setq sql (replace-regexp-in-string "^[ \t]*--.*[\n]?" "" sql)) - (when (zerop (length sql)) - (error "Nothing to send")) - ;; Now the string should end with an sqlplus-terminator. - (if (not (string-match "\\(;\\|/\\|[.]\\)\\'" sql)) - (setq sql (concat sql ";")))) - sql)) - -(defun sqlplus-show-html-fun (context connect-string begin end interrupted) - (let ((output-file (expand-file-name (substitute-in-file-name sqlplus-html-output-file-name))) - (sql (sqlplus-get-context-value context :htmlized-html-command)) - (html (buffer-substring begin end)) - (header-html (eval sqlplus-html-output-header))) - (let ((case-fold-search t)) - (while (and (string-match "\\`[ \t\n]*\\(
\\|

\\)?" html) (match-string 0 html) (> (length (match-string 0 html)) 0)) - (setq html (replace-match "" nil t html))) - (when (> (length html) 0) - (sqlplus-execute connect-string "" nil '("set markup html off") 'no-echo 'dont-show-output-buffer) - (find-file output-file) - (erase-buffer) - (insert (concat "\n" - "\n" - " \n" - (sqlplus-get-context-value context :head) "\n" - "\n" - "\n" - (if header-html header-html "") - (if sqlplus-html-output-sql sql "") - "

" - html "\n" - "\n" - "")) - (goto-char (point-min)) - (save-buffer))))) - -(defun sqlplus-refine-html (html remove-entities) - (string-match "\\`\"?\\(\\(.\\|\n\\)*?\\)\"?[ \t\n]*\\'" html) - (setq html (match-string 1 html)) - (if remove-entities - (progn - (while (string-match """ html) (setq html (replace-match "\"" nil t html))) - (while (string-match "<" html) (setq html (replace-match "<" nil t html))) - (while (string-match ">" html) (setq html (replace-match ">" nil t html))) - (while (string-match "&" html) (setq html (replace-match "&" nil t html)))) - (while (string-match "&" html) (setq html (replace-match "&" nil t html))) - (while (string-match ">" html) (setq html (replace-match ">" nil t html))) - (while (string-match "<" html) (setq html (replace-match "<" nil t html))) - (while (string-match "\"" html) (setq html (replace-match """ nil t html)))) - (string-match "\\`\"?\\(\\(.\\|\n\\)*?\\)\"?[ \t\n]*\\'" html) - (setq html (match-string 1 html)) - html) - -(defun sqlplus-show-markup-fun (context connect-string begin end interrupted) - (goto-char begin) - (let ((head "") - (body "") - preformat) - (when (re-search-forward (concat "\\bHEAD\\b[ \t\n]*\\(\\(.\\|\n\\)*\\)[ \t\n]*" - "\\bBODY\\b[ \t\n]*\\(\\(.\\|\n\\)*\\)[ \t\n]*" - "\\bTABLE\\b\\(.\\|\n\\)*PREFORMAT[ \t\n]+\\(ON\\|OFF\\)\\b") nil t) - (setq head (match-string 1) - body (match-string 3) - preformat (string= (downcase (match-string 6)) "on")) - (setq head (sqlplus-refine-html head t) - body (sqlplus-refine-html body t)) - (let ((context-options (list (cons :result-function 'sqlplus-show-html-fun) - (cons :current-command-input-buffer-name (sqlplus-get-context-value context :current-command-input-buffer-name)) - (cons :html-command (sqlplus-get-context-value context :html-command)) - (cons :htmlized-html-command (sqlplus-get-context-value context :htmlized-html-command)) - (cons :head head) - (cons :body body))) - (prolog-commands (list "set wrap on" - (format "set linesize %S" (if preformat (1- (frame-width)) 4000)) - "set pagesize 50000" - "btitle off" - "repfooter off" - "set markup html on"))) - (sqlplus-execute connect-string (sqlplus-get-context-value context :html-command) context-options prolog-commands 'no-echo 'dont-show-output-buffer))))) - -(defun sqlplus-htmlize (begin end) - (let (result) - (when (featurep 'htmlize) - (let* ((htmlize-output-type 'font) - (buffer (funcall (symbol-function 'htmlize-region) begin end))) - (with-current-buffer buffer - (goto-char 1) - (re-search-forward "

[ \t\n]*\\(\\(.\\|\n\\)*?\\)[ \t\n]*
" nil t) - (setq result (concat "
" (match-string 1) "
"))) - (kill-buffer buffer))) - (unless result - (setq result (sqlplus-refine-html (buffer-substring begin end) nil))) - result)) - -(defun sqlplus--send (connect-string sql &optional arg no-echo html start end) - (if html - (let* ((context-options (list (cons :result-function 'sqlplus-show-markup-fun) - (cons :current-command-input-buffer-name (buffer-name)) - (cons :html-command sql) - (cons :htmlized-html-command (if (and (eq sqlplus-html-output-sql 'elegant) (featurep 'htmlize)) - (sqlplus-htmlize start end) - (sqlplus-refine-html sql nil)))))) - (sqlplus-execute connect-string "show markup\n" context-options nil 'no-echo 'dont-show-output-buffer)) - (let* ((no-parse (consp arg)) - (context-options (list (cons :dont-parse-result (consp arg)) - (cons :columns-count (if (integerp arg) - (if (zerop arg) nil arg) - (if sqlplus-multi-output-tables-default-flag nil 1))) - (cons :current-command-input-buffer-name (buffer-name)))) - (prolog-commands (list (format "set wrap %s" (if no-parse "on" sqlplus-default-wrap)) - (format "set linesize %s" (if (consp arg) (1- (frame-width)) 4000)) - (format "set pagesize %S" (if no-parse 50000 sqlplus-pagesize)) - (format "btitle %s" - (if no-parse "off" (concat "left '" sqlplus-page-separator "'"))) - (format "repfooter %s" - (if no-parse "off" (concat "left '" sqlplus-repfooter "'")))))) - (sqlplus-execute connect-string sql context-options prolog-commands no-echo)))) - -(defun sqlplus-explain () - (interactive) - (sqlplus-check-connection) - (when (buffer-file-name) - (condition-case err - (save-buffer) - (error (message (error-message-string err))))) - (let* ((region (sqlplus-mark-current))) - (setq sqlplus-region-beginning-pos (car region) - sqlplus-region-end-pos (cdr region)) - (if (and sqlplus-region-beginning-pos sqlplus-region-end-pos) - (let ((sql (sqlplus-parse-region (car region) (cdr region))) - (case-fold-search t)) - (if (string-match "^[\n\t ]*explain[\n\t ]+plan[\t\t ]+for\\>" sql) - (sqlplus--send sqlplus-connect-string sql nil nil nil) - (setq sql (concat (sqlplus-fontify-string sqlplus-connect-string "explain plan for ") sql)) - (sqlplus--send sqlplus-connect-string sql nil nil nil))) - (error "Point doesn't indicate any command to execute")))) - -(defun sqlplus-send-region (arg start end &optional no-echo html) - "Send a region to the SQL*Plus process." - (interactive "P\nr") - (sqlplus-check-connection) - (sqlplus--send sqlplus-connect-string (sqlplus-parse-region start end) arg no-echo html start end)) - -(defun sqlplus-user-command (connect-string sql result-proc) - (let* ((context-options (list (cons :user-function result-proc) - (cons :columns-count 1))) - (prolog-commands (list (format "set wrap %s" sqlplus-default-wrap) - "set linesize 4000" - "set timing off" - "set pagesize 50000" - "btitle off" - (format "repfooter %s" (concat "left '" sqlplus-repfooter "'"))))) - (sqlplus-execute connect-string sql context-options prolog-commands 'no-echo 'dont-show-output-buffer))) - - -(defun sqlplus-hidden-select (connect-string sql result-proc) - (let* ((context-options (list (cons :result-table-function result-proc) - (cons :columns-count 1))) - (prolog-commands (list (format "set wrap %s" sqlplus-default-wrap) - "set linesize 4000" - "set pagesize 50000" - "btitle off" - (format "repfooter %s" (concat "left '" sqlplus-repfooter "'"))))) - (sqlplus-execute connect-string sql context-options prolog-commands 'no-echo 'dont-show-output-buffer))) - -;; "appi[nfo]" -> '("appinfo" "appi") -(defun sqlplus-full-forms (name) - (if (string-match "\\`\\([^[]*\\)?\\[\\([^]]+\\)\\]\\([^]]*\\)?\\'" name) - (list (replace-match "\\1\\2\\3" t nil name) - (replace-match "\\1\\3" t nil name)) - (list name))) - -(defun sqlplus-get-canonical-command-name (name) - (let ((association (assoc (downcase name) sqlplus-system-variables))) - (if association (cdr association) name))) - - -(defun sqlplus-execute (connect-string sql context-options prolog-commands &optional no-echo dont-show-output-buffer) - (sqlplus-verify-buffer connect-string) - (let* ((process-buffer-name (sqlplus-get-process-buffer-name connect-string)) - (process-buffer (get-buffer process-buffer-name)) - (output-buffer-name (sqlplus-get-output-buffer-name connect-string)) - (echo-prolog (concat "\n" sqlplus-output-separator " " (current-time-string) "\n\n")) - (process (get-buffer-process process-buffer-name)) - set-prolog-commands commands command-no - (history-buffer (sqlplus-get-history-buffer connect-string)) - (defines (sqlplus-define-user-variables sql))) - (setq prolog-commands (append (sqlplus-initial-strings) prolog-commands)) - (when process-buffer - (with-current-buffer process-buffer - (setq command-no sqlplus-command-seq) - (incf sqlplus-command-seq) - (setq context-options (append (list (cons :id command-no) (cons :sql sql)) (copy-list context-options))) - (setq sqlplus-command-contexts (reverse (cons context-options (reverse sqlplus-command-contexts)))))) - ;; move all "set" commands from prolog-commands to set-prolog-commands - (setq prolog-commands (delq nil (mapcar (lambda (command) (if (string-match "^\\s-*[sS][eE][tT]\\s-+" command) - (progn - (setq set-prolog-commands - (append set-prolog-commands - (list (substring command (length (match-string 0 command)))))) - nil) - command)) - prolog-commands))) - ;; remove duplicates commands from prolog-commands (last entries win) - (let (spc-alist) - (dolist (command prolog-commands) - (let* ((name (progn (string-match "^\\S-+" command) (downcase (match-string 0 command)))) - (association (assoc name spc-alist))) - (if (and association (not (equal name "define"))) - (setcdr association command) - (setq spc-alist (cons (cons name command) spc-alist))))) - (setq prolog-commands (mapcar (lambda (pair) (cdr pair)) (reverse spc-alist)))) - - (setq prolog-commands (append prolog-commands defines)) - (setq set-prolog-commands (append (list (format "sqlprompt '%s%S%s'" sqlplus-prompt-prefix command-no sqlplus-prompt-suffix)) set-prolog-commands)) - - ;; remove duplicates from set-prolog-commands (last entries win) - (let (spc-alist) - (dolist (set-command set-prolog-commands) - (let* ((name (progn (string-match "^\\S-+" set-command) (downcase (sqlplus-get-canonical-command-name (match-string 0 set-command))))) - (association (assoc name spc-alist))) - (if association - (setcdr association set-command) - (setq spc-alist (cons (cons name set-command) spc-alist))))) - (setq set-prolog-commands (mapcar (lambda (pair) (cdr pair)) (reverse spc-alist)))) - - (setq commands (concat (mapconcat 'identity (append - (list (concat "set " (mapconcat 'identity set-prolog-commands " "))) - prolog-commands - (list sql)) "\n") - "\n")) - (when history-buffer - (with-current-buffer history-buffer - (goto-char (point-max)) - (insert echo-prolog) - (insert (concat commands "\n")))) - (let ((saved-window (cons (selected-window) (window-buffer (selected-window)))) - (input-buffer (get-buffer (sqlplus-get-input-buffer-name connect-string)))) - (unless no-echo - (sqlplus-echo-in-buffer output-buffer-name echo-prolog) - (let ((old-suppress-show-output-buffer sqlplus-suppress-show-output-buffer)) - (unwind-protect - (save-selected-window - (setq sqlplus-suppress-show-output-buffer dont-show-output-buffer) - (when (and output-buffer-name - (get-buffer output-buffer-name)) - (with-current-buffer (get-buffer output-buffer-name) - (sqlplus-buffer-bottom connect-string) - (sqlplus-buffer-mark-current connect-string)))) - (setq sqlplus-suppress-show-output-buffer old-suppress-show-output-buffer))) - (sqlplus-echo-in-buffer output-buffer-name (concat sql "\n\n") nil t) - (save-selected-window - (unless dont-show-output-buffer - (when (and output-buffer-name - (get-buffer output-buffer-name)) - (with-current-buffer (get-buffer output-buffer-name) - (sqlplus-buffer-redisplay-current connect-string)))))) - (if (window-live-p (car saved-window)) - (select-window (car saved-window)) - (if (get-buffer-window (cdr saved-window)) - (select-window (get-buffer-window (cdr saved-window))) - (when (and input-buffer - (get-buffer-window input-buffer)) - (select-window (get-buffer-window input-buffer)))))) - (send-string process commands))) - -(defun sqlplus-fontify-string (connect-string string) - (let* ((input-buffer-name (sqlplus-get-input-buffer-name connect-string)) - (input-buffer (when input-buffer-name (get-buffer input-buffer-name))) - (result string)) - (when (and input-buffer (buffer-live-p input-buffer)) - (with-current-buffer input-buffer - (save-excursion - (goto-char (point-max)) - (let ((pos (point))) - (insert "\n\n") - (insert string) - (font-lock-fontify-block (+ (count "\n" string) 2)) - (setq result (buffer-substring (+ pos 2) (point-max))) - (delete-region pos (point-max)))))) - result)) - -(defvar plsql-mark-backward-list nil) - -(unless plsql-mode-map - (setq plsql-mode-map (copy-keymap sql-mode-map)) - (define-key plsql-mode-map "\M-." 'sqlplus-file-get-source) - (define-key plsql-mode-map [C-down-mouse-1] 'sqlplus-mouse-select-identifier) - (define-key plsql-mode-map [C-mouse-1] 'sqlplus-file-get-source-mouse) - (define-key plsql-mode-map "\C-c\C-g" 'plsql-begin) - (define-key plsql-mode-map "\C-c\C-q" 'plsql-loop) - (define-key plsql-mode-map "\C-c\C-z" 'plsql-if) - (define-key plsql-mode-map "\C-c\C-c" 'plsql-compile) - (define-key plsql-mode-map [tool-bar plsql-prev-mark] - (list 'menu-item "Previous mark" 'plsql-prev-mark - :image plsql-prev-mark-image - :enable 'plsql-mark-backward-list))) - -(defvar plsql-continue-anyway nil - "Local in input buffer (plsql-mode).") -(make-variable-buffer-local 'plsql-continue-anyway) - -(defun sqlplus-switch-to-buffer (buffer-or-path &optional line-no) - (if (fboundp 'ide-skel-select-buffer) - (funcall 'ide-skel-select-buffer buffer-or-path line-no) - (let ((buffer (or (and (bufferp buffer-or-path) buffer-or-path) - (find-file-noselect buffer-or-path)))) - (switch-to-buffer buffer) - (goto-line line-no)))) - -(defun plsql-prev-mark () - (interactive) - (let (finish) - (while (and plsql-mark-backward-list - (not finish)) - (let* ((marker (pop plsql-mark-backward-list)) - (buffer (marker-buffer marker)) - (point (marker-position marker))) - (set-marker marker nil) - (when (and buffer - (or (not (eq (current-buffer) buffer)) - (not (eql (point) point)))) - (sqlplus-switch-to-buffer buffer) - (goto-char point) - (setq finish t)))) - ;; (message "BACK: %S -- FORWARD: %S" plsql-mark-backward-list plsql-mark-forward-list) - (force-mode-line-update) - (sit-for 0))) - -(defun sqlplus-mouse-select-identifier (event) - (interactive "@e") - (with-selected-window (posn-window (event-start event)) - (save-excursion - (let* ((point (posn-point (event-start event))) - (identifier (progn (goto-char point) (thing-at-point 'symbol))) - (ident-regexp (when identifier (regexp-quote identifier)))) - (push (point-marker) plsql-mark-backward-list) - (when ident-regexp - (save-excursion - (while (not (looking-at ident-regexp)) - (backward-char)) - (sqlplus-mouse-set-selection (current-buffer) (point) (+ (point) (length identifier)) 'highlight))))))) - -(defun sqlplus-file-get-source-mouse (event) - (interactive "@e") - (let (ident) - (with-selected-window (posn-window (event-start event)) - (save-excursion - (goto-char (posn-point (event-start event))) - (setq ident (thing-at-point 'symbol)))) - (sqlplus-file-get-source sqlplus-connect-string ident nil) - (sit-for 0))) - -(defun plsql-compile (&optional arg) - "Save buffer and send its content to SQL*Plus. -You must enter connect-string if buffer is disconnected; with -argument you can change connect-string even for connected -buffer." - (interactive "P") - (let (aborted - exists-show-error-command - (case-fold-search t)) - (save-window-excursion - (save-excursion - ;; ask for "/" and "show err" if absent - (let ((old-point (point)) - show-err-needed - exists-run-command best-point finish) - (goto-char (point-min)) - (setq show-err-needed (let ((case-fold-search t)) - (re-search-forward "create\\([ \t\n]+or[ \t\n]+replace\\)?[ \t\n]+\\(package\\|procedure\\|function\\|trigger\\|view\\|type\\)" nil t))) - (goto-char (point-max)) - (forward-comment (- (buffer-size))) - (re-search-backward "^\\s-*show\\s-+err" nil t) - (forward-comment (- (buffer-size))) - (condition-case nil (forward-char) (error nil)) - (setq best-point (point)) - (goto-char (point-min)) - (setq exists-run-command (re-search-forward "^\\s-*/[^*]" nil t)) - (goto-char (point-min)) - (setq exists-show-error-command (or (not show-err-needed) (re-search-forward "^\\s-*show\\s-+err" nil t))) - (while (and (not plsql-continue-anyway) (or (not exists-run-command) (not exists-show-error-command)) (not finish)) - (goto-char best-point) - (let ((c (read-char - (format "Cannot find %s. (I)nsert it at point, (A)bort, (C)ontinue anyway" - (concat (unless exists-run-command "\"/\"") - (unless (or exists-run-command exists-show-error-command) " and ") - (unless exists-show-error-command "\"show err\"")))))) - (cond ((memq c '(?i ?I)) - (unless exists-run-command (insert "/\n")) - (unless exists-show-error-command (insert "show err\n")) - (setq finish t)) - ((memq c '(?a ?A)) - (setq aborted t - finish t)) - ((memq c '(?c ?C)) - (setq plsql-continue-anyway t) - (setq finish t)))))))) - (unless aborted - (save-buffer) - (let* ((buffer (current-buffer)) - (input-buffer-name (buffer-name)) - (file-path (sqlplus-file-truename (buffer-file-name))) - (compilation-buffer (get-buffer sqlplus-plsql-compilation-results-buffer-name)) - (context-options (list (cons :last-compiled-file-path file-path) - (cons :current-command-input-buffer-name input-buffer-name) - (cons :compilation-expected exists-show-error-command))) - (prolog-commands (list (format "set wrap %s" sqlplus-default-wrap) - "set linesize 4000" - (format "set pagesize %S" sqlplus-pagesize) - (format "btitle %s" (concat "left '" sqlplus-page-separator "'")) - (format "repfooter %s" (concat "left '" sqlplus-repfooter "'"))))) - (when (or (not sqlplus-connect-string) - arg) - (setq sqlplus-connect-string (car (sqlplus-read-connect-string nil (caar (sqlplus-divide-connect-strings)))))) - (sqlplus sqlplus-connect-string nil (when plsql-auto-parse-errors-flag 'dont-show-output-buffer)) - (set-buffer buffer) - (force-mode-line-update) - (when font-lock-mode (font-lock-mode 1)) - (when compilation-buffer - (with-current-buffer compilation-buffer - (let ((inhibit-read-only t)) - (erase-buffer)))) - (setq prolog-commands (append prolog-commands (sqlplus-define-user-variables (buffer-string)))) - (sqlplus-execute sqlplus-connect-string (concat "@" file-path) context-options prolog-commands nil exists-show-error-command))))) - -(defun plsql-parse-errors (last-compiled-file-path) - (let ((file-name (file-name-nondirectory last-compiled-file-path)) - error-list) - (put-text-property 0 (length file-name) 'face 'font-lock-warning-face file-name) - (save-excursion - (when (re-search-forward "^LINE/COL\\>" nil t) - (beginning-of-line 3) - (while (re-search-forward "^\\([0-9]+\\)/\\([0-9]+\\)\\s-*\\(\\(.\\|\n\\)*?\\)[\r\t ]*\n\\([\r\t ]*\\(\n\\|\\'\\)\\|[0-9]+\\)" nil t) - (let ((line-no (match-string 1)) - (column-no (match-string 2)) - (errmsg (match-string 3)) - label) - (goto-char (match-beginning 5)) - (while (string-match "\\s-\\s-+" errmsg) - (setq errmsg (replace-match " " nil t errmsg))) - (put-text-property 0 (length line-no) 'face 'font-lock-variable-name-face line-no) - (put-text-property 0 (length column-no) 'face 'font-lock-variable-name-face column-no) - (setq label (concat file-name ":" line-no ":" column-no ": " errmsg)) - (put-text-property 0 (length label) 'mouse-face 'highlight label) - (push label error-list))))) - (save-excursion - (while (re-search-forward "\\s-\\([0-9]+\\):\n\\(ORA-[0-9]+[^\n]*\\)\n" nil t) - (let ((line-no (match-string 1)) - (errmsg (match-string 2)) - label) - (put-text-property 0 (length line-no) 'face 'font-lock-variable-name-face line-no) - (setq label (concat file-name ":" line-no ": " errmsg)) - (put-text-property 0 (length label) 'mouse-face 'highlight label) - (push label error-list)))) - (save-excursion - (while (re-search-forward "\\(\\(SP2\\|CPY\\)-[0-9]+:[^\n]*\\)\n" nil t) - (let ((errmsg (match-string 1)) - label) - (setq label (concat file-name ":" errmsg)) - (put-text-property 0 (length label) 'mouse-face 'highlight label) - (push label error-list)))) - error-list)) - -(defun plsql-display-errors (dir error-list) - (let ((buffer (get-buffer-create sqlplus-plsql-compilation-results-buffer-name))) - (save-selected-window - (save-excursion - (set-buffer buffer) - (let ((inhibit-read-only t)) - (erase-buffer) - (setq default-directory dir) - (insert (format "cd %s\n" default-directory)) - (insert (format "Compilation results\n")) - (compilation-minor-mode 1) - (dolist (msg (reverse error-list)) - (insert msg) - (insert "\n")) - (insert (format "\n(%s errors)\n" (length error-list)))) - (when (and error-list (fboundp 'compile-reinitialize-errors) (funcall (symbol-function 'compile-reinitialize-errors) t))) - (switch-to-buffer-other-window buffer) - (goto-line 1) - (goto-line 3))))) - - -(defun sqlplus-file-truename (file-name) - (if file-name - (file-truename file-name) - file-name)) - -(defun sqlplus--hidden-buffer-name-p (buffer-name) - (equal (elt buffer-name 0) 32)) - -(defun sqlplus-get-workbench-window () - "Return upper left window" - (if (fboundp 'ide-get-workbench-window) - (funcall (symbol-function 'ide-get-workbench-window)) - (let (best-window) - (dolist (win (copy-list (window-list nil 1))) - (when (not (sqlplus--hidden-buffer-name-p (buffer-name (window-buffer win)))) - (if (null best-window) - (setq best-window win) - (let* ((best-window-coords (window-edges best-window)) - (win-coords (window-edges win))) - (when (or (< (cadr win-coords) (cadr best-window-coords)) - (and (= (cadr win-coords) (cadr best-window-coords)) - (< (car win-coords) (car best-window-coords)))) - (setq best-window win)))))) - ;; (message "BEST-WINDOW: %S" best-window) - best-window))) - -(defun sqlplus-get-side-window () - "Return bottom helper window, or nil if not found" - (if (fboundp 'ide-get-side-window) - (funcall (symbol-function 'ide-get-side-window)) - (let* ((workbench-window (sqlplus-get-workbench-window)) - best-window) - (dolist (win (copy-list (window-list nil 1))) - (when (and (not (sqlplus--hidden-buffer-name-p (buffer-name (window-buffer win)))) - (not (eq win workbench-window))) - (if (null best-window) - (setq best-window win) - (when (> (cadr (window-edges win)) (cadr (window-edges best-window))) - (setq best-window win))))) - best-window))) - -(defvar sqlplus--idle-tasks nil) - -(defun sqlplus--enqueue-task (fun &rest params) - (setq sqlplus--idle-tasks (reverse (cons (cons fun params) (reverse sqlplus--idle-tasks))))) - -(defun sqlplus--execute-tasks () - (dolist (task sqlplus--idle-tasks) - (let ((fun (car task)) - (params (cdr task))) - (condition-case var - (apply fun params) - (error (message (error-message-string var)))))) - (setq sqlplus--idle-tasks nil)) - -(add-hook 'post-command-hook 'sqlplus--execute-tasks) - -(defvar sqlplus-mouse-selection nil) - -(defun sqlplus-mouse-set-selection (buffer begin end mouse-face) - (interactive "@e") - (let ((old-buffer-modified-p (buffer-modified-p))) - (when (buffer-live-p buffer) - (with-current-buffer buffer - (unwind-protect - (put-text-property begin end 'mouse-face mouse-face) - (set-buffer-modified-p old-buffer-modified-p) - (setq sqlplus-mouse-selection (when mouse-face (list buffer begin end)))))))) - -(defun sqlplus-clear-mouse-selection () - (when (and sqlplus-mouse-selection - (eq (event-basic-type last-input-event) 'mouse-1) - (not (memq 'down (event-modifiers last-input-event)))) - (sqlplus-mouse-set-selection (car sqlplus-mouse-selection) (cadr sqlplus-mouse-selection) (caddr sqlplus-mouse-selection) nil))) - -(add-hook 'plsql-mode-hook - (lambda () - (modify-syntax-entry ?. "." sql-mode-syntax-table) - (setq sqlplus-font-lock-keywords-1 (sqlplus-set-font-lock-emacs-structures-for-level 1 major-mode)) - (setq sqlplus-font-lock-keywords-2 (sqlplus-set-font-lock-emacs-structures-for-level 2 major-mode)) - (setq sqlplus-font-lock-keywords-3 (sqlplus-set-font-lock-emacs-structures-for-level 3 major-mode)) - (setq font-lock-defaults '((sqlplus-font-lock-keywords-1 sqlplus-font-lock-keywords-2 sqlplus-font-lock-keywords-3) - nil t ((?_ . "w") (?$ . "w") (?# . "w") (?& . "w")))) - (orcl-mode 1) - (use-local-map plsql-mode-map) ; std - (add-hook 'post-command-hook 'sqlplus-clear-mouse-selection nil t))) - -(setq recentf-exclude (cons (concat "^" (regexp-quote (file-name-as-directory temporary-file-directory))) - (when (boundp 'recentf-exclude) - recentf-exclude))) - -(when (fboundp 'ide-register-persistent-var) - (funcall (symbol-function 'ide-register-persistent-var) 'sqlplus-connect-strings-alist - ;; save proc - (lambda (alist) - (mapcar (lambda (pair) - (if sqlplus-save-passwords - pair - (cons (car pair) nil))) - alist)) - ;; load proc - (lambda (alist) - (setq sqlplus-connect-string-history (mapcar (lambda (pair) (car pair)) alist)) - alist))) - -(defun get-all-dirs (root-dir) - (let ((list-to-see (list root-dir)) - result-list) - (while list-to-see - (let* ((dir (pop list-to-see)) - (children (directory-files dir t))) - (push dir result-list) - (dolist (child children) - (when (and (not (string-match "^[.]+"(file-name-nondirectory child))) - (file-directory-p child)) - (push child list-to-see))))) - result-list)) - -(defun sqlplus-command-line () - (interactive) - (if (comint-check-proc "*SQL*") - (pop-to-buffer "*SQL*") - (let* ((pair (sqlplus-read-connect-string nil (when sqlplus-connect-string (car (refine-connect-string sqlplus-connect-string))))) - (qualified-cs (car pair)) - (refined-cs (cadr pair)) - (password (cdr (refine-connect-string qualified-cs)))) - (if (string-match "^\\([^@]*\\)@\\(.*\\)$" refined-cs) - (let ((old-sql-get-login-fun (symbol-function 'sql-get-login))) - (setq sql-user (match-string 1 refined-cs) - sql-password password - sql-database (match-string 2 refined-cs)) - (unwind-protect - (progn - (fset 'sql-get-login (lambda (&rest whatever) nil)) - (sql-oracle)) - (fset 'sql-get-login old-sql-get-login-fun))) - (error "Connect string must be in form login@sid"))))) - -(defun sqlplus-find-tnsnames () - (interactive) - (let* ((ora-home-dir (or (getenv "ORACLE_HOME") (error "Environment variable ORACLE_HOME not set"))) - found - (list-to-see (list ora-home-dir))) - (while (and (not found) list-to-see) - (let* ((dir (pop list-to-see)) - (children (condition-case nil (directory-files dir t) (error nil)))) - (dolist (child children) - (unless found - (if (string-match "admin.tnsnames\.ora$" child) - (progn - (setq found t) - (find-file child)) - (if (and (not (string-match "^[.]+" (file-name-nondirectory child))) - (file-directory-p child)) - (push child list-to-see))))))) - (unless found - (message "File tnsnames.ora not found")))) - -(defun sqlplus-remove-help-echo (list) - "Remove all HELP-ECHO properties from mode-line format value" - (when (listp list) - (if (eq (car list) :propertize) - (while list - (when (eq (cadr list) 'help-echo) - (setcdr list (cdddr list))) - (setq list (cdr list))) - (dolist (elem list) (sqlplus-remove-help-echo elem))))) - -(when (>= emacs-major-version 22) - (sqlplus-remove-help-echo mode-line-modes)) - -(defun sqlplus-get-project-root-dir (path) - (let ((path (file-truename (substitute-in-file-name path))) - dir) - (if (file-directory-p path) - (progn - (setq path (file-name-as-directory path)) - (setq dir path)) - (setq dir (file-name-as-directory (file-name-directory path)))) - (let ((last-project-dir dir) - (dir-list (split-string dir "/")) - is-project) - (while (directory-files dir t (concat "^" "\\(\\.svn\\|CVS\\)$") t) - (setq is-project t - last-project-dir (file-name-as-directory dir) - dir (file-name-as-directory (file-name-directory (directory-file-name dir))))) - (when is-project - (let ((list (nthcdr (1- (length (split-string last-project-dir "/"))) dir-list))) - (cond ((equal (car list) "trunk") - (setq last-project-dir (concat last-project-dir "trunk/"))) - ((member (car list) '("branches" "tags")) - (setq last-project-dir (concat last-project-dir (car list) "/" (when (cdr list) (concat (cadr list) "/"))))) - (t))) - (setq dir last-project-dir))) - dir)) - -(defvar sqlplus-search-buffer-name "*search*") - -(defvar sqlplus-object-types-regexps - '( - ("TABLE" . "\\bcreate\\s+table\\s+[^(]*?\\b#\\b") - ("VIEW" . "\\bview\\s+.*?\\b#\\b") - ("INDEX" . "\\b(constraint|index)\\s+.*?\\b#\\b") - ("TRIGGER" . "\\btrigger\\s+.*?\\b#\\b") - ("SEQUENCE" . "\\bsequence\\s+.*?\\b#\\b") - ("SYNONYM" . "\\bsynonym\\s+.*?\\b#\\b") - ("SCHEMA" . "\\bcreate\\b.*?\\buser\\b.*?\\b#\\b") - ("PROCEDURE" . "\\b(procedure|function)\\b[^(]*?\\b#\\b") - ("PACKAGE" . "\\bpackage\\s+.*?\\b#\\b"))) - -(defvar sqlplus-root-dir-history nil) - -(defvar sqlplus-compare-report-buffer-name "*Comparation Report*") - -(defun sqlplus-compare-schema-to-filesystem (&optional arg) - (interactive "P") - (let* ((connect-string sqlplus-connect-string) - (objects-alist (sqlplus-get-objects-alist sqlplus-connect-string)) - (report-buffer (get-buffer-create sqlplus-compare-report-buffer-name)) - (types-length (- (length objects-alist) 2)) - (root-dir (or (sqlplus-get-root-dir connect-string) - (sqlplus-set-project-for-connect-string connect-string) - (error "Root dir not set"))) - (counter 0)) - (unless objects-alist - (error "Not ready yet - try again later")) - (save-excursion - (switch-to-buffer-other-window report-buffer)) - (with-current-buffer report-buffer - (let ((inhibit-read-only t)) - (erase-buffer) - (insert (format "%s %s vs. %s\n\n" (current-time-string) (car (refine-connect-string connect-string)) root-dir)) - (sit-for 0))) - (dolist (pair objects-alist) - (let ((type (upcase (format "%s" (car pair)))) - (names (cdr pair))) - (unless (member type '("SCHEMA" "COLUMN")) - (incf counter) - (message (format "%s (%d/%d)..." type counter types-length)) - (dolist (name-pair names) - (let* ((name (car name-pair)) - (grep-result (sqlplus-file-get-source sqlplus-connect-string name type 'batch-mode))) - (with-current-buffer report-buffer - (let ((inhibit-read-only t)) - (goto-char (point-max)) - (cond ((eql (length grep-result) 0) - (insert (format "%s %s: not found\n" type name)) - (sit-for 0)) - ((and arg - (> (length grep-result) 1)) - (insert (format "%s %s:\n" type name)) - (dolist (list grep-result) - (insert (format " %s:%d %s\n" (car list) (cadr list) (caddr list)))) - (sit-for 0)) - (t))))))))) - (message "Done.") - (with-current-buffer report-buffer - (goto-char (point-min))))) - -(defun sqlplus-proj-find-files (dir file-predicate &optional dir-predicate) - (setq dir (file-name-as-directory (file-truename (substitute-in-file-name dir)))) - (let (result-list) - (mapcar (lambda (path) - (if (file-directory-p path) - (when (and (file-accessible-directory-p path) - (or (null dir-predicate) - (funcall dir-predicate path))) - (setq result-list (append result-list (sqlplus-proj-find-files path file-predicate dir-predicate)))) - (when (or (null file-predicate) - (funcall file-predicate path)) - (push path result-list)))) - (delete (concat (file-name-as-directory dir) ".") - (delete (concat (file-name-as-directory dir) "..") - (directory-files dir t nil t)))) - result-list)) - -(defvar sqlplus-proj-ignored-extensions '("semantic.cache")) - -(defun sqlplus-mode-file-regexp-list (mode-symbol-list) - (delq nil (mapcar (lambda (element) - (let ((fun-name (if (listp (cdr element)) (cadr element) (cdr element)))) - (when (memq fun-name mode-symbol-list) (cons (car element) fun-name)))) - auto-mode-alist))) - -(defun sqlplus-find-project-files (root-dir mode-symbol-list predicate) - (let ((obj-file-regexp-list (delq nil (mapcar (lambda (element) - (let ((len (length element))) - (unless (and (> len 0) - (equal (elt element (1- len)) ?/)) - (concat (regexp-quote element) "$")))) - (append sqlplus-proj-ignored-extensions completion-ignored-extensions)))) - (mode-file-regexp-list (sqlplus-mode-file-regexp-list mode-symbol-list))) ; (file-path-regexp . major-mode-function-symbol) - (when (and mode-symbol-list - (not mode-file-regexp-list)) - (error (format "No rules for %s major modes in auto-mode-alist." (mapconcat 'identity mode-symbol-list ", ")))) - (sqlplus-proj-find-files root-dir - (lambda (file-name) - (and (not (string-match "#" file-name)) - (not (string-match "semantic.cache" file-name)) - (or (and (not mode-symbol-list) - (not (some (lambda (regexp) - (string-match regexp file-name)) - obj-file-regexp-list))) - (and mode-symbol-list - (some (lambda (element) - (let ((freg (if (string-match "[$]" (car element)) - (car element) - (concat (car element) "$")))) - (when (string-match freg file-name) - (cdr element)))) - mode-file-regexp-list))) - (or (not predicate) - (funcall predicate file-name)))) - (lambda (dir-path) - (not (string-match "/\\(\\.svn\\|CVS\\)$" dir-path)))))) - - -(defun sqlplus-file-get-source (connect-string object-name object-type &optional batch-mode) - (interactive - (progn - (push (point-marker) plsql-mark-backward-list) - (list sqlplus-connect-string (thing-at-point 'symbol) nil))) - (unless object-name - (error "Nothing to search")) - (let* ((root-dir (or (and (not object-type) - (eq major-mode 'plsql-mode) - (buffer-file-name) - (sqlplus-get-project-root-dir (buffer-file-name))) - (sqlplus-get-root-dir connect-string) - (sqlplus-set-project-for-connect-string connect-string) - (error "Root dir not set"))) - (mode-symbol-list '(plsql-mode sql-mode)) - (files-to-grep (sqlplus-find-project-files root-dir mode-symbol-list nil)) - (temp-file-path (concat (file-name-as-directory temporary-file-directory) (make-temp-name "ide-"))) - (search-buffer (get-buffer sqlplus-search-buffer-name)) - (regexp (let ((index 0) - (len (length object-name)) - result) - (setq result - (if object-type - (let ((type (cond ((equal object-type "FUNCTION") "PROCEDURE") - ((equal object-type "PACKAGE BODY") "PACKAGE") - (t object-type)))) - (cdr (assoc type sqlplus-object-types-regexps))) - (mapconcat 'cdr sqlplus-object-types-regexps "|"))) - (unless result - (error "Not implemented")) - (while (and (< index (length result)) - (string-match "#" result index)) - (setq index (+ (match-beginning 0) len)) - (setq result (replace-match object-name t t result))) - (setq index 0) - (while (and (< index (length result)) - (string-match "[$]\\(\\\\b\\)?" result index)) - (setq index (+ (match-end 0) 1)) - (setq result (replace-match "\\$" t t result))) - result)) - grep-command - grep-result) - (when search-buffer - (with-current-buffer search-buffer - (let ((inhibit-read-only t)) - (erase-buffer)))) - ;; (message "Object type: %S, object name: %S, regexp: %S" object-type object-name regexp) - (with-temp-file temp-file-path - (dolist (path files-to-grep) - (insert (concat "'" path "'\n")))) - (let* ((grep-command (format "cat %s | xargs grep -nHiE -e '%s'" temp-file-path regexp)) - (raw-grep-result (split-string (shell-command-to-string grep-command) "\n" t)) - (grep-result (delq nil (mapcar (lambda (line) - (string-match "^\\(.*?\\):\\([0-9]+\\):\\(.*\\)$" line) - (let* ((path (match-string 1 line)) - (line-no (string-to-number (match-string 2 line))) - (text (match-string 3 line)) - (text2 text) - (syn-table (copy-syntax-table)) - (case-fold-search t)) - (modify-syntax-entry ?$ "w" syn-table) - (modify-syntax-entry ?# "w" syn-table) - (modify-syntax-entry ?_ "w" syn-table) - (with-syntax-table syn-table - (when (and (or (and (not object-type) - (> (length raw-grep-result) 1)) - (equal object-type "SYNONYM")) - (string-match "\\<\\(for\\|from\\|on\\|as\\)\\>" text2)) - (setq text2 (substring text2 0 (match-beginning 0)))) - ;; (message "GREP-RESULT: %s" text2) - (unless (or (not (string-match (concat "\\<" (regexp-quote object-name) "\\>") text2)) - (string-match (concat "\\(--\\|\\\\|\\\\|\\\\|\\\\).*\\<" - (regexp-quote object-name) "\\>") text2) - (and (or (and (not object-type) - (> (length raw-grep-result) 1)) - (equal object-type "TRIGGER")) - (string-match "\\<\\(alter\\|disable\\|enable\\)\\>" text2)) - (and (or (and (not object-type) - (string-match "\\" text2) - current-prefix-arg) - (equal object-type "PACKAGE")) - (string-match "\\" text2)) - (and (or (and (not object-type) - (string-match "\\" text2) - (not current-prefix-arg)) - (equal object-type "PACKAGE BODY")) - (not (string-match "\\" text2))) - (and (not object-type) - (not current-prefix-arg) - (string-match "[.]pks$" path))) - (list path line-no text))))) - raw-grep-result)))) - (if batch-mode - grep-result - (cond ((not grep-result) - (error "Not found")) - ((eql (length grep-result) 1) - (sqlplus-switch-to-buffer (caar grep-result) (cadar grep-result)) - (when connect-string - (setq sqlplus-connect-string connect-string))) - (t - (let ((search-buffer (get-buffer-create sqlplus-search-buffer-name))) - (with-current-buffer search-buffer - (setq buffer-read-only t) - (let ((inhibit-read-only t)) - (setq default-directory root-dir) - (erase-buffer) - (insert "Root dir: ") - (sqlplus-proj-insert-with-face root-dir 'font-lock-keyword-face) - (insert "; Range: ") - (sqlplus-proj-insert-with-face (mapconcat (lambda (sym) (sqlplus-mode-name-stringify sym)) mode-symbol-list ", ") - 'font-lock-keyword-face) - (insert "; Object type: ") - (sqlplus-proj-insert-with-face (or object-type "unspecified") 'font-lock-keyword-face) - (insert "; Object name: ") - (sqlplus-proj-insert-with-face object-name 'font-lock-keyword-face) - (insert "\n\n") - (compilation-minor-mode 1) - (dolist (result grep-result) - (let ((relative-path (concat "./" (file-relative-name (car result) root-dir))) - (line-no (cadr result)) - (text (caddr result))) - (put-text-property 0 (length relative-path) 'mouse-face 'highlight relative-path) - (insert relative-path) - (insert (format ":%S:1 %s\n" line-no text)))) - (insert (format "\n%d matches found." (length grep-result))) - (goto-char (point-min)) - (when (and grep-result (fboundp 'compile-reinitialize-errors) (funcall (symbol-function 'compile-reinitialize-errors) t))) - (switch-to-buffer-other-window search-buffer) - (goto-line 1) - (goto-line 3)))))))))) - -(defun sqlplus-mode-name-stringify (mode-name) - (let ((name (format "%s" mode-name))) - (replace-regexp-in-string "-" " " - (capitalize - (if (string-match "^\\(.*\\)-mode" name) - (match-string 1 name) - name))))) - -(defun sqlplus-proj-insert-with-face (string face) - (let ((point (point))) - (insert string) - (let ((overlay (make-overlay point (point)))) - (overlay-put overlay 'face face)))) - -(defun sqlplus-set-project-for-connect-string (connect-string) - (if (featurep 'ide-skel) - ;; Prepare sqlplus-root-dir-history (file-name-history) for user convenience - ;; 0. previous project root - ;; 1. current editor file project root - ;; 2. previous choices - ;; 3. new project roots - (let* ((prev-proj-root-dir (sqlplus-get-root-dir connect-string)) - (last-sel-window (funcall 'ide-skel-get-last-selected-window)) - (editor-file-proj-root-dir (when last-sel-window - (let* ((buffer (window-buffer last-sel-window)) - (path (and buffer (buffer-file-name buffer))) - (project (and path (car (funcall 'ide-skel-proj-get-project-create path))))) - (when (funcall 'ide-skel-project-p project) - (funcall 'ide-skel-project-root-path project)))))) - (setq sqlplus-root-dir-history - (delete-dups - (delq nil - (mapcar (lambda (dir) - (when dir - (directory-file-name (file-truename (substitute-in-file-name dir))))) - (append - (list editor-file-proj-root-dir prev-proj-root-dir) - sqlplus-root-dir-history - (mapcar (lambda (project) (funcall 'ide-skel-project-root-path project)) - (symbol-value 'ide-skel-projects))))))) - (let* ((file-name-history (cdr sqlplus-root-dir-history)) - (use-file-dialog nil) - (dir (directory-file-name (file-truename (substitute-in-file-name - (read-directory-name (format "Root dir for %s: " (car (refine-connect-string connect-string))) - (car sqlplus-root-dir-history) - (car sqlplus-root-dir-history) - t - nil)))))) - (funcall 'ide-skel-proj-get-project-create dir) - (sqlplus-set-root-dir dir connect-string) - (message (format "Root dir for %s set to %s" (car (refine-connect-string connect-string)) dir)) - dir)) - (let* ((use-file-dialog nil) - (dir (directory-file-name (file-truename (substitute-in-file-name - (read-directory-name (format "Root dir for %s: " (car (refine-connect-string connect-string))) - nil nil t nil)))))) - (sqlplus-set-root-dir dir connect-string) - (message (format "Root dir for %s set to %s" (car (refine-connect-string connect-string)) dir)) - dir))) - -;;; Plugin for ide-skel.el - -(defstruct sqlplus-tab - id - name ; tab name - symbol ; view/sequence/schema/trigger/index/table/package/synonym/procedure - help-string - (display-start 1) ; display-start in side view window - (data nil) ; '(("name" . status)...), where status t means 'invalid' - draw-function ; parameters: sqlplus-tab - click-function ; parameters: event "@e" - (errors-count 0) - (refresh-in-progress t) - update-select) - -(defvar sqlplus-side-view-connect-string nil) -(make-variable-buffer-local 'sqlplus-side-view-connect-string) - -(defvar sqlplus-side-view-active-tab nil) -(make-variable-buffer-local 'sqlplus-side-view-active-tab) - -(defvar sqlplus-side-view-tabset nil) -(make-variable-buffer-local 'sqlplus-side-view-tabset) - -(defface sqlplus-side-view-face '((t :inherit variable-pitch :height 0.8)) - "Default face used in right view" - :group 'sqlplus) - -(defvar sqlplus-side-view-keymap nil) -(unless sqlplus-side-view-keymap - (setq sqlplus-side-view-keymap (make-sparse-keymap)) - (define-key sqlplus-side-view-keymap [mode-line down-mouse-1] 'ignore) - (define-key sqlplus-side-view-keymap [mode-line mouse-1] 'sqlplus-side-view-tab-click)) - -(defun sqlplus-side-view-tab-click (event) - (interactive "@e") - (with-selected-window (posn-window (event-start event)) - (let* ((previous-sel-tab-info (nth sqlplus-side-view-active-tab sqlplus-side-view-tabset)) - (target (posn-string (event-start event))) - (tab-info (get-text-property (cdr target) 'tab-info (car target)))) - (setf (sqlplus-tab-display-start previous-sel-tab-info) (line-number-at-pos (window-start))) - (setq sqlplus-side-view-active-tab (sqlplus-tab-id tab-info)) - (sqlplus-side-view-redraw (current-buffer) t) - (sqlplus-side-view-buffer-mode-line)))) - -(defun sqlplus-side-view-buffer-mode-line () - (let* ((separator (propertize " " - 'face 'header-line - 'display '(space :width 0.2) - 'pointer 'arrow))) - (setq mode-line-format - (concat separator - (mapconcat (lambda (tab) - (let ((face (if (eq (sqlplus-tab-id tab) sqlplus-side-view-active-tab) - 'tabbar-selected - 'tabbar-unselected)) - (help-echo (concat (sqlplus-tab-help-string tab) - (if (> (sqlplus-tab-errors-count tab) 0) - (format "\n(%s error%s)" (sqlplus-tab-errors-count tab) - (if (> (sqlplus-tab-errors-count tab) 1) "s" "")) - "")))) - (propertize (format " %s " (sqlplus-tab-name tab)) - 'local-map sqlplus-side-view-keymap - 'tab-info tab - 'help-echo help-echo - 'mouse-face 'tabbar-highlight - 'face (if (> (sqlplus-tab-errors-count tab) 0) - (list '(foreground-color . "red") face) - face) - 'pointer 'hand))) - sqlplus-side-view-tabset - separator) - separator)))) - -(defun sqlplus-side-view-click-on-default-handler (event) - (interactive "@e") - (with-selected-window (posn-window (event-start event)) - (let* ((posn-point (posn-point (event-start event))) - (object-name (get-text-property posn-point 'object-name)) - (object-type (get-text-property posn-point 'object-type)) - (type (car event))) - (when (eq type 'mouse-3) - (setq type (car (x-popup-menu t (append (list 'keymap object-name) - (list '(sqlplus-refresh-side-view-buffer "Refresh" t)) - (list '(mouse-1 "Get source from Oracle" t)) - (list '(M-mouse-1 "Search source in filesystem" t)) - (list (list 'C-M-mouse-1 (concat "Set root dir for " (car (refine-connect-string sqlplus-side-view-connect-string))) t)) - ))))) - (cond ((eq type 'mouse-1) - (sqlplus-get-source sqlplus-side-view-connect-string object-name object-type)) - ((eq type 'M-mouse-1) - (sqlplus-file-get-source sqlplus-side-view-connect-string object-name object-type)) - ((eq type 'C-M-mouse-1) - (sqlplus-set-project-for-connect-string sqlplus-side-view-connect-string)) - ((eq type nil)) - (t - (condition-case err - (funcall type) - (error nil))))))) - -(defun sqlplus-side-view-click-on-index-handler (event) - (interactive "@e") - (with-selected-window (posn-window (event-start event)) - (let* ((posn-point (posn-point (event-start event))) - (object-name (get-text-property posn-point 'object-name)) - (object-type (get-text-property posn-point 'object-type)) - (type (car event))) - (when (eq type 'mouse-3) - (setq type (car (x-popup-menu t (append (list 'keymap object-name) - (list '(sqlplus-refresh-side-view-buffer "Refresh" t)) - (list '(mouse-1 "Get source from Oracle" t)) - (list '(M-mouse-1 "Search source in filesystem" t)) - (list (list 'C-M-mouse-1 (concat "Set root dir for " (car (refine-connect-string sqlplus-side-view-connect-string))) t)) - ))))) - (cond ((eq type 'mouse-1) - (sqlplus-get-source sqlplus-side-view-connect-string object-name object-type)) - ((eq type 'M-mouse-1) - (sqlplus-file-get-source sqlplus-side-view-connect-string object-name object-type)) - ((eq type 'C-M-mouse-1) - (sqlplus-set-project-for-connect-string sqlplus-side-view-connect-string)) - ((eq type nil)) - (t - (condition-case err - (funcall type) - (error nil))))))) - -(defun sqlplus-side-view-click-on-schema-handler (event) - (interactive "@e") - (with-selected-window (posn-window (event-start event)) - (let* ((posn-point (posn-point (event-start event))) - (object-name (get-text-property posn-point 'object-name)) - (object-type (get-text-property posn-point 'object-type)) - (last-selected-win (funcall 'ide-skel-get-last-selected-window)) - (type (car event))) - (when (eq type 'mouse-3) - (setq type (car (x-popup-menu t (append (list 'keymap object-name) - (list '(sqlplus-refresh-side-view-buffer "Refresh" t)) - (list '(mouse-1 "Connect to schema" t)) - (list '(M-mouse-1 "Search source in filesystem" t)) - (list (list 'C-M-mouse-1 (concat "Set root dir for " (car (refine-connect-string sqlplus-side-view-connect-string))) t)) - ))))) - (cond ((eq type 'mouse-1) - (when (string-match "@.*$" sqlplus-side-view-connect-string) - (let* ((cs (downcase (concat object-name (match-string 0 sqlplus-side-view-connect-string)))) - (pair (sqlplus-read-connect-string cs cs))) - (select-window (or last-selected-win (funcall 'ide-skel-get-editor-window))) - (sqlplus (car pair) (concat (cadr pair) (concat "." sqlplus-session-file-extension)))))) - ((eq type 'M-mouse-1) - (sqlplus-file-get-source sqlplus-side-view-connect-string object-name object-type)) - ((eq type 'C-M-mouse-1) - (sqlplus-set-project-for-connect-string sqlplus-side-view-connect-string)) - ((eq type nil)) - (t - (condition-case err - (funcall type) - (error nil)))) - (select-window (funcall 'ide-skel-get-last-selected-window))))) - -(defun sqlplus-side-view-click-on-table-handler (event) - (interactive "@e") - (with-selected-window (posn-window (event-start event)) - (let* ((posn-point (posn-point (event-start event))) - (object-name (get-text-property posn-point 'object-name)) - (object-type (get-text-property posn-point 'object-type)) - (type (car event))) - (when (eq type 'mouse-3) - (setq type (car (x-popup-menu t (append (list 'keymap object-name) - (list '(sqlplus-refresh-side-view-buffer "Refresh" t)) - (list '(mouse-1 "Show description" t)) - (list '(C-mouse-1 "Select *" t)) - (list '(S-mouse-1 "Get source from Oracle" t)) - (list '(M-mouse-1 "Search source in filesystem" t)) - (list (list 'C-M-mouse-1 (concat "Set root dir for " (car (refine-connect-string sqlplus-side-view-connect-string))) t)) - ))))) - (cond ((eq type 'mouse-1) - (sqlplus-execute sqlplus-side-view-connect-string - (sqlplus-fontify-string sqlplus-side-view-connect-string (format "desc %s;" object-name)) - nil nil)) - ((eq type 'C-mouse-1) - (sqlplus-execute sqlplus-side-view-connect-string - (sqlplus-fontify-string sqlplus-side-view-connect-string (format "select * from %s;" object-name)) - nil nil)) - ((eq type 'S-mouse-1) - (sqlplus-get-source sqlplus-side-view-connect-string object-name object-type)) - ((eq type 'M-mouse-1) - (sqlplus-file-get-source sqlplus-side-view-connect-string object-name object-type)) - ((eq type 'C-M-mouse-1) - (sqlplus-set-project-for-connect-string sqlplus-side-view-connect-string)) - ((eq type nil)) - (t - (condition-case err - (funcall type) - (error nil)))) - (select-window (funcall 'ide-skel-get-last-selected-window))))) - -(defun sqlplus-side-view-click-on-package-handler (event) - (interactive "@e") - (with-selected-window (posn-window (event-start event)) - (let* ((posn-point (posn-point (event-start event))) - (object-name (get-text-property posn-point 'object-name)) - (object-type (get-text-property posn-point 'object-type)) - (type (car event))) - (when (eq type 'mouse-3) - (setq type (car (x-popup-menu t (append (list 'keymap object-name) - (list '(sqlplus-refresh-side-view-buffer "Refresh" t)) - (list '(S-mouse-1 "Get package header from Oracle" t)) - (list '(mouse-1 "Get package body from Oracle" t)) - (list '(S-M-mouse-1 "Search header source in filesystem" t)) - (list '(M-mouse-1 "Search body source in filesystem" t)) - (list (list 'C-M-mouse-1 (concat "Set root dir for " (car (refine-connect-string sqlplus-side-view-connect-string))) t)) - ))))) - (cond ((eq type 'S-mouse-1) - (sqlplus-get-source sqlplus-side-view-connect-string object-name object-type)) - ((eq type 'mouse-1) - (sqlplus-get-source sqlplus-side-view-connect-string object-name "PACKAGE BODY")) - ((eq type 'M-mouse-1) - (sqlplus-file-get-source sqlplus-side-view-connect-string object-name "PACKAGE BODY")) - ((eq type 'S-M-mouse-1) - (sqlplus-file-get-source sqlplus-side-view-connect-string object-name "PACKAGE")) - ((eq type 'C-M-mouse-1) - (sqlplus-set-project-for-connect-string sqlplus-side-view-connect-string)) - ((eq type nil)) - (t - (condition-case err - (funcall type) - (error nil))))))) - -(defun sqlplus-side-view-default-draw-panel (tab-info click-function) - (let ((pairs (sort (sqlplus-tab-data tab-info) - (lambda (pair1 pair2) (string< (car pair1) (car pair2))))) - (type-name (upcase (symbol-name (sqlplus-tab-symbol tab-info))))) - (dolist (pair pairs) - (let* ((label (format " % -100s" (car pair))) - (km (make-sparse-keymap))) - (define-key km [down-mouse-1] 'ignore) - (define-key km [mouse-1] click-function) - (define-key km [C-down-mouse-1] 'ignore) - (define-key km [C-mouse-1] click-function) - (define-key km [S-down-mouse-1] 'ignore) - (define-key km [S-mouse-1] click-function) - (define-key km [down-mouse-3] 'ignore) - (define-key km [mouse-3] click-function) - (setq label (propertize label - 'mouse-face 'ide-skel-highlight-face - 'face (if (cdr pair) - '(sqlplus-side-view-face (foreground-color . "red")) - 'sqlplus-side-view-face) - 'local-map km - 'pointer 'hand - 'object-name (car pair) - 'object-type type-name)) - (insert label) - (insert "\n"))))) - -(defun sqlplus-refresh-side-view-buffer () - (let* ((tab-info (nth sqlplus-side-view-active-tab sqlplus-side-view-tabset)) - (update-select (sqlplus-tab-update-select tab-info))) - (unless (sqlplus-tab-refresh-in-progress tab-info) - (sqlplus-hidden-select sqlplus-side-view-connect-string update-select 'sqlplus-my-update-handler)))) - -(defun sqlplus-get-default-update-select (symbol) - (concat "select object_name, object_type, decode( status, 'INVALID', 'I', ' ' ) from user_objects\n" - "where object_name not like 'BIN$%'\n" - (format "and object_type = '%s';" (upcase (symbol-name symbol))))) - -(defun sqlplus-create-side-view-buffer (connect-string) - (let* ((original-connect-string connect-string) - (connect-string (car (refine-connect-string connect-string))) - (buffer (funcall 'ide-skel-get-side-view-buffer-create - (concat " Ide Skel Right View SQL " connect-string) - 'right "SQL" (concat "SQL Panel for " connect-string) - (lambda (editor-buffer) - (let ((connect-string sqlplus-side-view-connect-string)) - (with-current-buffer editor-buffer - (and connect-string - (equal (car (refine-connect-string sqlplus-connect-string)) - (car (refine-connect-string connect-string))) - ))))))) - (with-current-buffer buffer - (set 'ide-skel-tabbar-menu-function - (lambda () - (let ((tab-info (nth sqlplus-side-view-active-tab sqlplus-side-view-tabset))) - (list - (unless (sqlplus-tab-refresh-in-progress tab-info) - '(sqlplus-refresh-side-view-buffer "Refresh" t)))))) - (setq sqlplus-side-view-connect-string original-connect-string - sqlplus-side-view-active-tab 0 - sqlplus-side-view-tabset - (list - (make-sqlplus-tab :id 0 :name "Tab" :symbol 'table :help-string "Tables" :draw-function 'sqlplus-side-view-default-draw-panel - :update-select (sqlplus-get-default-update-select 'table) - :click-function 'sqlplus-side-view-click-on-table-handler) - (make-sqlplus-tab :id 1 :name "Vie" :symbol 'view :help-string "Views" :draw-function 'sqlplus-side-view-default-draw-panel - :update-select (sqlplus-get-default-update-select 'view) - :click-function 'sqlplus-side-view-click-on-table-handler) - (make-sqlplus-tab :id 2 :name "Idx" :symbol 'index :help-string "Indexes" :draw-function 'sqlplus-side-view-default-draw-panel - :update-select (sqlplus-get-default-update-select 'index) - :click-function 'sqlplus-side-view-click-on-index-handler) - (make-sqlplus-tab :id 3 :name "Tri" :symbol 'trigger :help-string "Triggers" :draw-function 'sqlplus-side-view-default-draw-panel - :update-select (sqlplus-get-default-update-select 'trigger) - :click-function 'sqlplus-side-view-click-on-default-handler) - (make-sqlplus-tab :id 4 :name "Seq" :symbol 'sequence :help-string "Sequences" :draw-function 'sqlplus-side-view-default-draw-panel - :update-select (sqlplus-get-default-update-select 'sequence) - :click-function 'sqlplus-side-view-click-on-default-handler) - (make-sqlplus-tab :id 5 :name "Syn" :symbol 'synonym :help-string "Synonyms" :draw-function 'sqlplus-side-view-default-draw-panel - :update-select (sqlplus-get-default-update-select 'synonym) - :click-function 'sqlplus-side-view-click-on-default-handler) - (make-sqlplus-tab :id 6 :name "Pkg" :symbol 'package :help-string "PL/SQL Packages" :draw-function 'sqlplus-side-view-default-draw-panel - :update-select (sqlplus-get-default-update-select 'package) - :click-function 'sqlplus-side-view-click-on-package-handler) - (make-sqlplus-tab :id 7 :name "Prc" :symbol 'procedure :help-string "PL/SQL Functions & Procedures" :draw-function 'sqlplus-side-view-default-draw-panel - :update-select (concat "select object_name, object_type, decode( status, 'INVALID', 'I', ' ' ) from user_objects\n" - "where object_name not like 'BIN$%'\n" - "and object_type in ('FUNCTION', 'PROCEDURE');") - :click-function 'sqlplus-side-view-click-on-default-handler) - (make-sqlplus-tab :id 8 :name "Sch" :symbol 'schema :help-string "Schemas" :draw-function 'sqlplus-side-view-default-draw-panel - :update-select "select username, 'SCHEMA', ' ' from all_users where username not like 'BIN$%';" - :click-function 'sqlplus-side-view-click-on-schema-handler) - )) - (sqlplus-side-view-buffer-mode-line)) - buffer)) - -(defun sqlplus-side-view-redraw (sql-view-buffer &optional window-start-from-tab-info) - (with-current-buffer sql-view-buffer - (let* ((point (point)) - (tab-info (nth sqlplus-side-view-active-tab sqlplus-side-view-tabset)) - (window-start (when (and (symbol-value 'ide-skel-current-right-view-window) - (eq (window-buffer (symbol-value 'ide-skel-current-right-view-window)) (current-buffer))) - (if window-start-from-tab-info - (sqlplus-tab-display-start tab-info) - (line-number-at-pos (window-start (symbol-value 'ide-skel-current-right-view-window))))))) - (let ((inhibit-read-only t)) - (setq buffer-read-only nil) - (erase-buffer) - (when (sqlplus-tab-draw-function tab-info) - (funcall (sqlplus-tab-draw-function tab-info) tab-info (sqlplus-tab-click-function tab-info)))) - (if window-start - (let ((pos (save-excursion - (goto-line window-start) - (beginning-of-line) - (point)))) - (set-window-start (symbol-value 'ide-skel-current-right-view-window) pos) - (setf (sqlplus-tab-display-start tab-info) window-start)) - (goto-char point) - (beginning-of-line))))) - -(defun sqlplus-side-view-update-data (connect-string alist) - (let* ((connect-string (car (refine-connect-string connect-string))) - (sql-view-buffer (sqlplus-get-side-view-buffer connect-string)) - was-proc) - (when sql-view-buffer - (with-current-buffer sql-view-buffer - (dolist (pair alist) - (let* ((symbol (if (eq (car pair) 'function) 'procedure (car pair))) - (data-list (cdr pair)) - (tab-info (some (lambda (tab) - (when (eq (sqlplus-tab-symbol tab) symbol) - tab)) - sqlplus-side-view-tabset))) - (when tab-info - (setf (sqlplus-tab-refresh-in-progress tab-info) nil) - (setf (sqlplus-tab-data tab-info) - (if (and (eq symbol 'procedure) - was-proc) - (append (sqlplus-tab-data tab-info) (copy-list data-list)) - data-list)) - (when (eq symbol 'procedure) - (setq was-proc t)) - (setf (sqlplus-tab-errors-count tab-info) - (count t (mapcar 'cdr data-list))) - (when (eql sqlplus-side-view-active-tab (sqlplus-tab-id tab-info)) - (sqlplus-side-view-redraw (current-buffer)))))) - (sqlplus-side-view-buffer-mode-line) - (force-mode-line-update))))) - -(defun sqlplus-side-view-window-function (side event &rest list) - (when (and (eq side 'right) - (symbol-value 'ide-skel-current-right-view-window) - (with-current-buffer (symbol-value 'ide-skel-current-editor-buffer) - sqlplus-connect-string)) - (cond ((memq event '(show editor-buffer-changed)) - (let ((sql-view-buffer (sqlplus-get-side-view-buffer (with-current-buffer (symbol-value 'ide-skel-current-editor-buffer) - sqlplus-connect-string)))) - (when sql-view-buffer - (with-current-buffer sql-view-buffer - (set 'ide-skel-tabbar-enabled t) - (funcall 'ide-skel-side-window-switch-to-buffer (symbol-value 'ide-skel-current-right-view-window) sql-view-buffer))))))) - nil) - -(add-hook 'ide-skel-side-view-window-functions 'sqlplus-side-view-window-function) - - -(provide 'sqlplus) - -;;; sqlplus.el ends here diff --git a/.emacs.d/tabbar.el b/.emacs.d/tabbar.el deleted file mode 100644 index 09db712..0000000 --- a/.emacs.d/tabbar.el +++ /dev/null @@ -1,1932 +0,0 @@ -;;; Tabbar.el --- Display a tab bar in the header line - -;; Copyright (C) 2003, 2004, 2005 David Ponce - -;; Author: David Ponce -;; Maintainer: David Ponce -;; Created: 25 February 2003 -;; Keywords: convenience -;; Revision: $Id: tabbar.el,v 1.69 2006/06/08 08:27:39 ponced Exp $ - -(defconst tabbar-version "2.0") - -;; This file is not 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., 51 Franklin Street, Fifth -;; Floor, Boston, MA 02110-1301, USA. - -;;; Commentary: -;; -;; This library provides the Tabbar global minor mode to display a tab -;; bar in the header line of Emacs 21 and later versions. You can use -;; the mouse to click on a tab and select it. Also, three buttons are -;; displayed on the left side of the tab bar in this order: the -;; "home", "scroll left", and "scroll right" buttons. The "home" -;; button is a general purpose button used to change something on the -;; tab bar. The scroll left and scroll right buttons are used to -;; scroll tabs horizontally. Tabs can be divided up into groups to -;; maintain several sets of tabs at the same time (see also the -;; chapter "Core" below for more details on tab grouping). Only one -;; group is displayed on the tab bar, and the "home" button, for -;; example, can be used to navigate through the different groups, to -;; show different tab bars. -;; -;; In a graphic environment, using the mouse is probably the preferred -;; way to work with the tab bar. However, you can also use the tab -;; bar when Emacs is running on a terminal, so it is possible to use -;; commands to press special buttons, or to navigate cyclically -;; through tabs. -;; -;; These commands, and default keyboard shortcuts, are provided: -;; -;; `tabbar-mode' -;; Toggle the Tabbar global minor mode. When enabled a tab bar is -;; displayed in the header line. -;; -;; `tabbar-local-mode' (C-c ) -;; Toggle the Tabbar-Local minor mode. Provided the global minor -;; mode is turned on, the tab bar becomes local in the current -;; buffer when the local minor mode is enabled. This permits to -;; see the tab bar in a buffer where the header line is already -;; used by another mode (like `Info-mode' for example). -;; -;; `tabbar-mwheel-mode' -;; Toggle the Tabbar-Mwheel global minor mode. When enabled you -;; can use the mouse wheel to navigate through tabs of groups. -;; -;; `tabbar-press-home' (C-c ) -;; `tabbar-press-scroll-left' (C-c ) -;; `tabbar-press-scroll-right' (C-c ) -;; Simulate a mouse-1 click on respectively the "home", "scroll -;; left", and "scroll right" buttons. A numeric prefix argument -;; value of 2, or 3, respectively simulates a mouse-2, or mouse-3 -;; click. -;; -;; `tabbar-backward' (C-c ) -;; `tabbar-forward' (C-c ) -;; Are the basic commands to navigate cyclically through tabs or -;; groups of tabs. The cycle is controlled by the -;; `tabbar-cycle-scope' option. The default is to navigate -;; through all tabs across all existing groups of tabs. You can -;; change the default behavior to navigate only through the tabs -;; visible on the tab bar, or through groups of tabs only. Or use -;; the more specialized commands below. -;; -;; `tabbar-backward-tab' -;; `tabbar-forward-tab' -;; Navigate through the tabs visible on the tab bar. -;; -;; `tabbar-backward-group' (C-c ) -;; `tabbar-forward-group' (C-c ) -;; Navigate through existing groups of tabs. -;; -;; -;; Core -;; ---- -;; -;; The content of the tab bar is represented by an internal data -;; structure: a tab set. A tab set is a collection (group) of tabs, -;; identified by an unique name. In a tab set, at any time, one and -;; only one tab is designated as selected within the tab set. -;; -;; A tab is a simple data structure giving the value of the tab, and a -;; reference to its tab set container. A tab value can be any Lisp -;; object. Each tab object is guaranteed to be unique. -;; -;; A tab set is displayed on the tab bar through a "view" defined by -;; the index of the leftmost tab shown. Thus, it is possible to -;; scroll the tab bar horizontally by changing the start index of the -;; tab set view. -;; -;; The visual representation of a tab bar is a list of valid -;; `header-line-format' template elements, one for each special -;; button, and for each tab found into a tab set "view". When the -;; visual representation of a tab is required, the function specified -;; in the variable `tabbar-tab-label-function' is called to obtain it. -;; The visual representation of a special button is obtained by -;; calling the function specified in `tabbar-button-label-function', -;; which is passed a button name among `home', `scroll-left', or -;; `scroll-right'. There are also options and faces to customize the -;; appearance of buttons and tabs (see the code for more details). -;; -;; When the mouse is over a tab, the function specified in -;; `tabbar-help-on-tab-function' is called, which is passed the tab -;; and should return a help string to display. When a tab is -;; selected, the function specified in `tabbar-select-tab-function' is -;; called, which is passed the tab and the event received. -;; -;; Similarly, to control the behavior of the special buttons, the -;; following variables are available, for respectively the `home', -;; `scroll-left' and `scroll-right' value of `