diff options
Diffstat (limited to '.emacs.d')
30 files changed, 12043 insertions, 18 deletions
diff --git a/.emacs.d/ac-dict/c++-mode b/.emacs.d/ac-dict/c++-mode new file mode 100644 index 0000000..e3cd8ae --- /dev/null +++ b/.emacs.d/ac-dict/c++-mode @@ -0,0 +1,74 @@ +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 new file mode 100644 index 0000000..496f904 --- /dev/null +++ b/.emacs.d/ac-dict/c-mode @@ -0,0 +1,37 @@ +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 new file mode 100644 index 0000000..16348ed --- /dev/null +++ b/.emacs.d/ac-dict/clojure-mode @@ -0,0 +1,475 @@ +*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 new file mode 100644 index 0000000..4ec8f7d --- /dev/null +++ b/.emacs.d/ac-dict/css-mode @@ -0,0 +1,747 @@ +!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 new file mode 100644 index 0000000..8ed3d04 --- /dev/null +++ b/.emacs.d/ac-dict/java-mode @@ -0,0 +1,50 @@ +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 new file mode 100644 index 0000000..3d83f84 --- /dev/null +++ b/.emacs.d/ac-dict/javascript-mode @@ -0,0 +1,148 @@ +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 new file mode 100644 index 0000000..04352d8 --- /dev/null +++ b/.emacs.d/ac-dict/php-mode @@ -0,0 +1,62 @@ +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 new file mode 100644 index 0000000..33b4b32 --- /dev/null +++ b/.emacs.d/ac-dict/python-mode @@ -0,0 +1,104 @@ +__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 new file mode 100644 index 0000000..90b4fc9 --- /dev/null +++ b/.emacs.d/ac-dict/ruby-mode @@ -0,0 +1,181 @@ +$! +$" +$$ +$& +$' +$* +$+ +$, +$-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 new file mode 100644 index 0000000..e5cca61 --- /dev/null +++ b/.emacs.d/ac-dict/scheme-mode @@ -0,0 +1,216 @@ +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-ci>=? +char-ci>? +char-downcase +char-lower-case? +char-numeric? +char-ready? +char-upcase +char-upper-case? +char-whitespace? +char<=? +char<? +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-ci>=? +string-ci>? +string-copy +string-fill! +string-length +string-ref +string-set! +string<=? +string<? +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 new file mode 100644 index 0000000..07a1281 --- /dev/null +++ b/.emacs.d/ac-dict/tcl-mode @@ -0,0 +1,172 @@ +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 new file mode 100644 index 0000000..26ec044 --- /dev/null +++ b/.emacs.d/auto-complete-config.el @@ -0,0 +1,480 @@ +;;; auto-complete-config.el --- auto-complete additional configuations + +;; Copyright (C) 2009, 2010 Tomohiro Matsuyama + +;; Author: Tomohiro Matsuyama <m2ym.pub@gmail.com> +;; 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 <http://www.gnu.org/licenses/>. + +;;; 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 Binary files differnew file mode 100644 index 0000000..2761c49 --- /dev/null +++ b/.emacs.d/auto-complete-config.elc diff --git a/.emacs.d/auto-complete.el b/.emacs.d/auto-complete.el new file mode 100644 index 0000000..2472dc7 --- /dev/null +++ b/.emacs.d/auto-complete.el @@ -0,0 +1,1897 @@ +;;; auto-complete.el --- Auto Completion for GNU Emacs + +;; Copyright (C) 2008, 2009, 2010 Tomohiro Matsuyama + +;; Author: Tomohiro Matsuyama <m2ym.pub@gmail.com> +;; 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 <http://www.gnu.org/licenses/>. + +;;; 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 Binary files differnew file mode 100644 index 0000000..4b0e44d --- /dev/null +++ b/.emacs.d/auto-complete.elc diff --git a/.emacs.d/color-theme-vibrant-ink.el b/.emacs.d/color-theme-vibrant-ink.el deleted file mode 100644 index dee8c6a..0000000 --- a/.emacs.d/color-theme-vibrant-ink.el +++ /dev/null @@ -1,18 +0,0 @@ -(require 'color-theme) - -;; vibrant-ink 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) diff --git a/.emacs.d/fuzzy.el b/.emacs.d/fuzzy.el new file mode 100644 index 0000000..c69150a --- /dev/null +++ b/.emacs.d/fuzzy.el @@ -0,0 +1,255 @@ +;;; fuzzy.el --- Fuzzy matching utilities + +;; Copyright (C) 2010 Tomohiro Matsuyama + +;; Author: Tomohiro Matsuyama <m2ym.pub@gmail.com> +;; 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 <http://www.gnu.org/licenses/>. + +;;; 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 Binary files differnew file mode 100644 index 0000000..aef35d9 --- /dev/null +++ b/.emacs.d/fuzzy.elc diff --git a/.emacs.d/ide-skel.el b/.emacs.d/ide-skel.el new file mode 100644 index 0000000..eb70ec2 --- /dev/null +++ b/.emacs.d/ide-skel.el @@ -0,0 +1,4016 @@ +;; ide-skel.el --- IDE skeleton for Emacs Lisp hackers + +;; Copyright (C) 2008 Peter Karpiuk, Scott Tiger S.A. + +;; Author: Peter Karpiuk <piotr.karpiuk (at) gmail (dot) com> +;; Maintainer: Peter Karpiuk <piotr.karpiuk (at) gmail (dot) com> +;; 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\", +\",piy76<aaaa\", +\">u-===*#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\", +\"<tasdfgh>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 new file mode 100644 index 0000000..1a6e238 --- /dev/null +++ b/.emacs.d/include.el @@ -0,0 +1,20 @@ +(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/linux/.emacs b/.emacs.d/linux/.emacs new file mode 100644 index 0000000..991f9c9 --- /dev/null +++ b/.emacs.d/linux/.emacs @@ -0,0 +1 @@ +(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 new file mode 100644 index 0000000..0f14dfe --- /dev/null +++ b/.emacs.d/popup.el @@ -0,0 +1,1061 @@ +;;; popup.el --- Visual popup interface + +;; Copyright (C) 2009, 2010 Tomohiro Matsuyama + +;; Author: Tomohiro Matsuyama <tomo@cx4a.org> +;; 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 <http://www.gnu.org/licenses/>. + +;;; 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 Binary files differnew file mode 100644 index 0000000..e0acbfd --- /dev/null +++ b/.emacs.d/popup.elc diff --git a/.emacs.d/ports.el b/.emacs.d/ports.el new file mode 100644 index 0000000..eec3854 --- /dev/null +++ b/.emacs.d/ports.el @@ -0,0 +1,29 @@ +;; 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/slash_c.el b/.emacs.d/slash_c.el new file mode 100644 index 0000000..b8d35fe --- /dev/null +++ b/.emacs.d/slash_c.el @@ -0,0 +1,15 @@ +(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 new file mode 100644 index 0000000..fa27bb7 --- /dev/null +++ b/.emacs.d/slash_functions.el @@ -0,0 +1,5 @@ +(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 new file mode 100644 index 0000000..4cb2a72 --- /dev/null +++ b/.emacs.d/slash_python.el @@ -0,0 +1,17 @@ +;; 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/color-theme-weirdness.el b/.emacs.d/slash_theme.el index a97cefc..1847b6d 100644 --- a/.emacs.d/color-theme-weirdness.el +++ b/.emacs.d/slash_theme.el @@ -1,3 +1,4 @@ +(add-to-list 'load-path "~/.emacs.d") (require 'color-theme) ;; weirdness color-theme @@ -35,3 +36,31 @@ (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/tabbar.el b/.emacs.d/tabbar.el new file mode 100644 index 0000000..09db712 --- /dev/null +++ b/.emacs.d/tabbar.el @@ -0,0 +1,1932 @@ +;;; Tabbar.el --- Display a tab bar in the header line + +;; Copyright (C) 2003, 2004, 2005 David Ponce + +;; Author: David Ponce <david@dponce.com> +;; Maintainer: David Ponce <david@dponce.com> +;; 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 <C-f10>) +;; 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 <C-home>) +;; `tabbar-press-scroll-left' (C-c <C-prior>) +;; `tabbar-press-scroll-right' (C-c <C-next>) +;; 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 <C-left>) +;; `tabbar-forward' (C-c <C-right>) +;; 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 <C-up>) +;; `tabbar-forward-group' (C-c <C-down>) +;; 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 `<button>': +;; +;; `tabbar-<button>-function' +;; Function called when <button> is selected. The function is +;; passed the mouse event received. +;; +;; `tabbar-<button>-help-function' +;; Function called with no arguments to obtain a help string +;; displayed when the mouse is over <button>. +;; +;; To increase performance, each tab set automatically maintains its +;; visual representation in a cache. As far as possible, the cache is +;; used to display the tab set, and refreshed only when necessary. +;; +;; Several tab sets can be maintained at the same time. Only one is +;; displayed on the tab bar, it is obtained by calling the function +;; specified in the variable `tabbar-current-tabset-function'. +;; +;; A special tab set is maintained, that contains the list of the +;; currently selected tabs in the existing tab sets. This tab set is +;; useful to show the existing tab sets in a tab bar, and switch +;; between them easily. The function `tabbar-get-tabsets-tabset' +;; returns this special tab set. +;; +;; +;; Buffer tabs +;; ----------- +;; +;; The default tab bar implementation provided displays buffers in +;; dedicated tabs. Selecting a tab, switch (mouse-1), or pop +;; (mouse-2), to the buffer it contains. +;; +;; The list of buffers put in tabs is provided by the function +;; specified in the variable `tabbar-buffer-list-function'. The +;; default function: `tabbar-buffer-list', excludes buffers whose name +;; starts with a space, when they are not visiting a file. +;; +;; Buffers are organized in groups, each one represented by a tab set. +;; A buffer can have no group, or belong to more than one group. The +;; function specified by the variable `tabbar-buffer-groups-function' +;; is called for each buffer to obtain the groups it belongs to. The +;; default function provided: `tabbar-buffer-groups' organizes buffers +;; depending on their major mode (see that function for details). +;; +;; The "home" button toggles display of buffer groups on the tab bar, +;; allowing to easily show another buffer group by clicking on the +;; associated tab. +;; +;; Known problems: +;; +;; Bug item #858306 at <http://sf.net/tracker/?group_id=79309>: +;; tabbar-mode crashes GNU Emacs 21.3 on MS-Windows 98/95. +;; + +;;; History: +;; + +;;; Code: + +;;; Options +;; +(defgroup tabbar nil + "Display a tab bar in the header line." + :group 'convenience) + +(defcustom tabbar-cycle-scope nil + "*Specify the scope of cyclic navigation through tabs. +The following scopes are possible: + +- `tabs' + Navigate through visible tabs only. +- `groups' + Navigate through tab groups only. +- default + Navigate through visible tabs, then through tab groups." + :group 'tabbar + :type '(choice :tag "Cycle through..." + (const :tag "Visible Tabs Only" tabs) + (const :tag "Tab Groups Only" groups) + (const :tag "Visible Tabs then Tab Groups" nil))) + +(defcustom tabbar-auto-scroll-flag t + "*Non-nil means to automatically scroll the tab bar. +That is, when a tab is selected outside of the tab bar visible area, +the tab bar is scrolled horizontally so the selected tab becomes +visible." + :group 'tabbar + :type 'boolean) + +(defvar tabbar-inhibit-functions '(tabbar-default-inhibit-function) + "List of functions to be called before displaying the tab bar. +Those functions are called one by one, with no arguments, until one of +them returns a non-nil value, and thus, prevents to display the tab +bar.") + +(defvar tabbar-current-tabset-function nil + "Function called with no argument to obtain the current tab set. +This is the tab set displayed on the tab bar.") + +(defvar tabbar-tab-label-function nil + "Function that obtains a tab label displayed on the tab bar. +The function is passed a tab and should return a string.") + +(defvar tabbar-select-tab-function nil + "Function that select a tab. +The function is passed a mouse event and a tab, and should make it the +selected tab.") + +(defvar tabbar-help-on-tab-function nil + "Function to obtain a help string for a tab. +The help string is displayed when the mouse is onto the button. The +function is passed the tab and should return a help string or nil for +none.") + +(defvar tabbar-button-label-function nil + "Function that obtains a button label displayed on the tab bar. +The function is passed a button name should return a propertized +string to display.") + +(defvar tabbar-home-function nil + "Function called when clicking on the tab bar home button. +The function is passed the mouse event received.") + +(defvar tabbar-home-help-function nil + "Function to obtain a help string for the tab bar home button. +The help string is displayed when the mouse is onto the button. +The function is called with no arguments.") + +(defvar tabbar-scroll-left-function 'tabbar-scroll-left + "Function that scrolls tabs on left. +The function is passed the mouse event received when clicking on the +scroll left button. It should scroll the current tab set.") + +(defvar tabbar-scroll-left-help-function 'tabbar-scroll-left-help + "Function to obtain a help string for the scroll left button. +The help string is displayed when the mouse is onto the button. +The function is called with no arguments.") + +(defvar tabbar-scroll-right-function 'tabbar-scroll-right + "Function that scrolls tabs on right. +The function is passed the mouse event received when clicking on the +scroll right button. It should scroll the current tab set.") + +(defvar tabbar-scroll-right-help-function 'tabbar-scroll-right-help + "Function to obtain a help string for the scroll right button. +The help string is displayed when the mouse is onto the button. +The function is called with no arguments.") + +;;; Misc. +;; +(eval-and-compile + (defalias 'tabbar-display-update + (if (fboundp 'force-window-update) + #'(lambda () (force-window-update (selected-window))) + 'force-mode-line-update))) + +(defsubst tabbar-click-p (event) + "Return non-nil if EVENT is a mouse click event." + (memq 'click (event-modifiers event))) + +(defun tabbar-shorten (str width) + "Return a shortened string from STR that fits in the given display WIDTH. +WIDTH is specified in terms of character display width in the current +buffer; see also `char-width'. If STR display width is greater than +WIDTH, STR is truncated and an ellipsis string \"...\" is inserted at +end or in the middle of the returned string, depending on available +room." + (let* ((n (length str)) + (sw (string-width str)) + (el "...") + (ew (string-width el)) + (w 0) + (i 0)) + (cond + ;; STR fit in WIDTH, return it. + ((<= sw width) + str) + ;; There isn't enough room for the ellipsis, STR is just + ;; truncated to fit in WIDTH. + ((<= width ew) + (while (< w width) + (setq w (+ w (char-width (aref str i))) + i (1+ i))) + (substring str 0 i)) + ;; There isn't enough room to insert the ellipsis in the middle + ;; of the truncated string, so put the ellipsis at end. + ((zerop (setq sw (/ (- width ew) 2))) + (setq width (- width ew)) + (while (< w width) + (setq w (+ w (char-width (aref str i))) + i (1+ i))) + (concat (substring str 0 i) el)) + ;; Put the ellipsis in the middle of the truncated string. + (t + (while (< w sw) + (setq w (+ w (char-width (aref str i))) + i (1+ i))) + (setq w (+ w ew)) + (while (< w width) + (setq n (1- n) + w (+ w (char-width (aref str n))))) + (concat (substring str 0 i) el (substring str n))) + ))) + +;;; Tab and tab set +;; +(defsubst tabbar-make-tab (object tabset) + "Return a new tab with value OBJECT. +TABSET is the tab set the tab belongs to." + (cons object tabset)) + +(defsubst tabbar-tab-value (tab) + "Return the value of tab TAB." + (car tab)) + +(defsubst tabbar-tab-tabset (tab) + "Return the tab set TAB belongs to." + (cdr tab)) + +(defvar tabbar-tabsets nil + "The tab sets store.") + +(defvar tabbar-tabsets-tabset nil + "The special tab set of existing tab sets.") + +(defvar tabbar-current-tabset nil + "The tab set currently displayed on the tab bar.") +(make-variable-buffer-local 'tabbar-current-tabset) + +(defvar tabbar-init-hook nil + "Hook run after tab bar data has been initialized. +You should use this hook to initialize dependent data.") + +(defsubst tabbar-init-tabsets-store () + "Initialize the tab set store." + (setq tabbar-tabsets (make-vector 31 0) + tabbar-tabsets-tabset (make-symbol "tabbar-tabsets-tabset")) + (put tabbar-tabsets-tabset 'start 0) + (run-hooks 'tabbar-init-hook)) + +(defvar tabbar-quit-hook nil + "Hook run after tab bar data has been freed. +You should use this hook to reset dependent data.") + +(defsubst tabbar-free-tabsets-store () + "Free the tab set store." + (setq tabbar-tabsets nil + tabbar-tabsets-tabset nil) + (run-hooks 'tabbar-quit-hook)) + +;; Define an "hygienic" function free of side effect between its local +;; variables and those of the callee. +(eval-and-compile + (defalias 'tabbar-map-tabsets + (let ((function (make-symbol "function")) + (result (make-symbol "result")) + (tabset (make-symbol "tabset"))) + `(lambda (,function) + "Apply FUNCTION to each tab set, and make a list of the results. +The result is a list just as long as the number of existing tab sets." + (let (,result) + (mapatoms + #'(lambda (,tabset) + (push (funcall ,function ,tabset) ,result)) + tabbar-tabsets) + ,result))))) + +(defun tabbar-make-tabset (name &rest objects) + "Make a new tab set whose name is the string NAME. +It is initialized with tabs build from the list of OBJECTS." + (let* ((tabset (intern name tabbar-tabsets)) + (tabs (mapcar #'(lambda (object) + (tabbar-make-tab object tabset)) + objects))) + (set tabset tabs) + (put tabset 'select (car tabs)) + (put tabset 'start 0) + tabset)) + +(defsubst tabbar-get-tabset (name) + "Return the tab set whose name is the string NAME. +Return nil if not found." + (intern-soft name tabbar-tabsets)) + +(defsubst tabbar-delete-tabset (tabset) + "Delete the tab set TABSET. +That is, remove it from the tab sets store." + (unintern tabset tabbar-tabsets)) + +(defsubst tabbar-tabs (tabset) + "Return the list of tabs in TABSET." + (symbol-value tabset)) + +(defsubst tabbar-tab-values (tabset) + "Return the list of tab values in TABSET." + (mapcar 'tabbar-tab-value (tabbar-tabs tabset))) + +(defsubst tabbar-get-tab (object tabset) + "Search for a tab with value OBJECT in TABSET. +Return the tab found, or nil if not found." + (assoc object (tabbar-tabs tabset))) + +(defsubst tabbar-member (tab tabset) + "Return non-nil if TAB is in TABSET." + (or (eq (tabbar-tab-tabset tab) tabset) + (memq tab (tabbar-tabs tabset)))) + +(defsubst tabbar-template (tabset) + "Return the cached visual representation of TABSET. +That is, a `header-line-format' template, or nil if the cache is +empty." + (get tabset 'template)) + +(defsubst tabbar-set-template (tabset template) + "Set the cached visual representation of TABSET to TEMPLATE. +TEMPLATE must be a valid `header-line-format' template, or nil to +cleanup the cache." + (put tabset 'template template)) + +(defsubst tabbar-selected-tab (tabset) + "Return the tab selected in TABSET." + (get tabset 'select)) + +(defsubst tabbar-selected-value (tabset) + "Return the value of the tab selected in TABSET." + (tabbar-tab-value (tabbar-selected-tab tabset))) + +(defsubst tabbar-selected-p (tab tabset) + "Return non-nil if TAB is the selected tab in TABSET." + (eq tab (tabbar-selected-tab tabset))) + +(defvar tabbar--track-selected nil) + +(defsubst tabbar-select-tab (tab tabset) + "Make TAB the selected tab in TABSET. +Does nothing if TAB is not found in TABSET. +Return TAB if selected, nil if not." + (when (tabbar-member tab tabset) + (unless (tabbar-selected-p tab tabset) + (tabbar-set-template tabset nil) + (setq tabbar--track-selected tabbar-auto-scroll-flag)) + (put tabset 'select tab))) + +(defsubst tabbar-select-tab-value (object tabset) + "Make the tab with value OBJECT, the selected tab in TABSET. +Does nothing if a tab with value OBJECT is not found in TABSET. +Return the tab selected, or nil if nothing was selected." + (tabbar-select-tab (tabbar-get-tab object tabset) tabset)) + +(defsubst tabbar-start (tabset) + "Return the index of the first visible tab in TABSET." + (get tabset 'start)) + +(defsubst tabbar-view (tabset) + "Return the list of visible tabs in TABSET. +That is, the sub-list of tabs starting at the first visible one." + (nthcdr (tabbar-start tabset) (tabbar-tabs tabset))) + +(defun tabbar-add-tab (tabset object &optional append) + "Add to TABSET a tab with value OBJECT if there isn't one there yet. +If the tab is added, it is added at the beginning of the tab list, +unless the optional argument APPEND is non-nil, in which case it is +added at the end." + (let ((tabs (tabbar-tabs tabset))) + (if (tabbar-get-tab object tabset) + tabs + (let ((tab (tabbar-make-tab object tabset))) + (tabbar-set-template tabset nil) + (set tabset (if append + (append tabs (list tab)) + (cons tab tabs))))))) + +(defun tabbar-delete-tab (tab) + "Remove TAB from its tab set." + (let* ((tabset (tabbar-tab-tabset tab)) + (tabs (tabbar-tabs tabset)) + (sel (eq tab (tabbar-selected-tab tabset))) + (next (and sel (cdr (memq tab tabs))))) + (tabbar-set-template tabset nil) + (setq tabs (delq tab tabs)) + ;; When the selected tab is deleted, select the next one, if + ;; available, or the last one otherwise. + (and sel (tabbar-select-tab (car (or next (last tabs))) tabset)) + (set tabset tabs))) + +(defun tabbar-scroll (tabset count) + "Scroll the visible tabs in TABSET of COUNT units. +If COUNT is positive move the view on right. If COUNT is negative, +move the view on left." + (let ((start (min (max 0 (+ (tabbar-start tabset) count)) + (1- (length (tabbar-tabs tabset)))))) + (when (/= start (tabbar-start tabset)) + (tabbar-set-template tabset nil) + (put tabset 'start start)))) + +(defun tabbar-tab-next (tabset tab &optional before) + "Search in TABSET for the tab after TAB. +If optional argument BEFORE is non-nil, search for the tab before +TAB. Return the tab found, or nil otherwise." + (let* (last (tabs (tabbar-tabs tabset))) + (while (and tabs (not (eq tab (car tabs)))) + (setq last (car tabs) + tabs (cdr tabs))) + (and tabs (if before last (nth 1 tabs))))) + +(defun tabbar-current-tabset (&optional update) + "Return the tab set currently displayed on the tab bar. +If optional argument UPDATE is non-nil, call the user defined function +`tabbar-current-tabset-function' to obtain it. Otherwise return the +current cached copy." + (and update tabbar-current-tabset-function + (setq tabbar-current-tabset + (funcall tabbar-current-tabset-function))) + tabbar-current-tabset) + +(defun tabbar-get-tabsets-tabset () + "Return the tab set of selected tabs in existing tab sets." + (set tabbar-tabsets-tabset (tabbar-map-tabsets 'tabbar-selected-tab)) + (tabbar-scroll tabbar-tabsets-tabset 0) + (tabbar-set-template tabbar-tabsets-tabset nil) + tabbar-tabsets-tabset) + +;;; Faces +;; +(defface tabbar-default + '( + ;;(((class color grayscale) (background light)) + ;; :inherit variable-pitch + ;; :height 0.8 + ;; :foreground "gray50" + ;; :background "grey75" + ;; ) + (((class color grayscale) (background dark)) + :inherit variable-pitch + :height 0.8 + :foreground "grey75" + :background "gray50" + ) + (((class mono) (background light)) + :inherit variable-pitch + :height 0.8 + :foreground "black" + :background "white" + ) + (((class mono) (background dark)) + :inherit variable-pitch + :height 0.8 + :foreground "white" + :background "black" + ) + (t + :inherit variable-pitch + :height 0.8 + :foreground "gray50" + :background "gray75" + )) + "Default face used in the tab bar." + :group 'tabbar) + +(defface tabbar-unselected + '((t + :inherit tabbar-default + :box (:line-width 1 :color "white" :style released-button) + )) + "Face used for unselected tabs." + :group 'tabbar) + +(defface tabbar-selected + '((t + :inherit tabbar-default + :box (:line-width 1 :color "white" :style pressed-button) + :foreground "blue" + )) + "Face used for the selected tab." + :group 'tabbar) + +(defface tabbar-highlight + '((t + :underline t + )) + "Face used to highlight a tab during mouse-overs." + :group 'tabbar) + +(defface tabbar-separator + '((t + :inherit tabbar-default + :height 0.1 + )) + "Face used for separators between tabs." + :group 'tabbar) + +(defface tabbar-button + '((t + :inherit tabbar-default + :box (:line-width 1 :color "white" :style released-button) + :foreground "dark red" + )) + "Face used for tab bar buttons." + :group 'tabbar) + +(defface tabbar-button-highlight + '((t + :inherit tabbar-default + )) + "Face used to highlight a button during mouse-overs." + :group 'tabbar) + +(defcustom tabbar-background-color nil + "*Background color of the tab bar. +By default, use the background color specified for the +`tabbar-default' face (or inherited from another face), or the +background color of the `default' face otherwise." + :group 'tabbar + :type '(choice (const :tag "Default" nil) + (color))) + +(defsubst tabbar-background-color () + "Return the background color of the tab bar." + (or tabbar-background-color + (let* ((face 'tabbar-default) + (color (face-background face))) + (while (null color) + (or (facep (setq face (face-attribute face :inherit))) + (setq face 'default)) + (setq color (face-background face))) + color))) + +;;; Buttons and separator look and feel +;; +(defconst tabbar-button-widget + '(cons + (cons :tag "Enabled" + (string) + (repeat :tag "Image" + :extra-offset 2 + (restricted-sexp :tag "Spec" + :match-alternatives (listp)))) + (cons :tag "Disabled" + (string) + (repeat :tag "Image" + :extra-offset 2 + (restricted-sexp :tag "Spec" + :match-alternatives (listp)))) + ) + "Widget for editing a tab bar button. +A button is specified as a pair (ENABLED-BUTTON . DISABLED-BUTTON), +where ENABLED-BUTTON and DISABLED-BUTTON specify the value used when +the button is respectively enabled and disabled. Each button value is +a pair (STRING . IMAGE) where STRING is a string value, and IMAGE a +list of image specifications. +If IMAGE is non-nil, try to use that image, else use STRING. +If only the ENABLED-BUTTON image is provided, a DISABLED-BUTTON image +is derived from it.") + +;;; Home button +;; +(defvar tabbar-home-button-value nil + "Value of the home button.") + +(defconst tabbar-home-button-enabled-image + '((:type pbm :data "\ +P2 13 13 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 +255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 0 +6 0 255 255 255 255 255 255 255 255 255 255 9 130 9 255 255 255 255 +255 255 255 255 255 255 26 130 26 255 255 255 255 255 255 255 0 9 26 +41 130 41 26 9 0 255 255 255 255 5 145 140 135 130 125 120 115 5 255 +255 255 255 0 9 26 41 130 41 26 9 0 255 255 255 255 255 255 255 26 130 +26 255 255 255 255 255 255 255 255 255 255 9 130 9 255 255 255 255 255 +255 255 255 255 255 0 6 0 255 255 255 255 255 255 255 255 255 255 255 +255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 +255 255 255 +")) + "Default image for the enabled home button.") + +(defconst tabbar-home-button-disabled-image + '((:type pbm :data "\ +P2 13 13 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 +255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 +255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 +255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 +255 255 0 0 1 2 3 2 1 0 0 255 255 255 255 0 132 128 123 119 114 110 +106 0 255 255 255 255 0 0 1 2 3 2 1 0 0 255 255 255 255 255 255 255 +255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 +255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 +255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 +255 255 255 255 255 255 255 255 255 +")) + "Default image for the disabled home button.") + +(defcustom tabbar-home-button + (cons (cons "[o]" tabbar-home-button-enabled-image) + (cons "[x]" tabbar-home-button-disabled-image)) + "The home button. +The variable `tabbar-button-widget' gives details on this widget." + :group 'tabbar + :type tabbar-button-widget + :set '(lambda (variable value) + (custom-set-default variable value) + ;; Schedule refresh of button value. + (setq tabbar-home-button-value nil))) + +;;; Scroll left button +;; +(defvar tabbar-scroll-left-button-value nil + "Value of the scroll left button.") + +(defconst tabbar-scroll-left-button-enabled-image + '((:type pbm :data "\ +P2 13 13 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 +255 255 255 255 255 255 255 255 128 16 48 255 255 255 255 255 255 255 +255 144 28 86 128 0 255 255 255 255 255 255 160 44 92 159 135 113 0 +255 255 255 255 160 44 97 165 144 129 120 117 0 255 255 176 44 98 175 +174 146 127 126 127 128 0 255 255 0 160 184 156 143 136 134 135 137 +138 0 255 255 176 32 67 144 146 144 145 146 148 149 0 255 255 255 255 +160 42 75 140 154 158 159 160 0 255 255 255 255 255 255 160 40 74 154 +170 171 0 255 255 255 255 255 255 255 255 160 41 82 163 0 255 255 255 +255 255 255 255 255 255 255 160 32 48 255 255 255 255 255 255 255 255 +255 255 255 255 255 255 +")) + "Default image for the enabled scroll left button. +A disabled button image will be automatically build from it.") + +(defcustom tabbar-scroll-left-button + (cons (cons " <" tabbar-scroll-left-button-enabled-image) + (cons " =" nil)) + "The scroll left button. +The variable `tabbar-button-widget' gives details on this widget." + :group 'tabbar + :type tabbar-button-widget + :set '(lambda (variable value) + (custom-set-default variable value) + ;; Schedule refresh of button value. + (setq tabbar-scroll-left-button-value nil))) + +;;; Scroll right button +;; +(defvar tabbar-scroll-right-button-value nil + "Value of the scroll right button.") + +(defconst tabbar-scroll-right-button-enabled-image + '((:type pbm :data "\ +P2 13 13 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 +48 32 160 255 255 255 255 255 255 255 255 255 255 44 161 71 32 160 255 +255 255 255 255 255 255 255 36 157 163 145 62 32 160 255 255 255 255 +255 255 30 128 133 137 142 124 50 32 160 255 255 255 255 29 120 121 +124 126 126 124 105 42 32 176 255 255 31 126 127 128 128 128 128 126 +124 89 32 255 255 33 134 135 136 137 137 138 119 49 32 176 255 255 34 +143 144 145 146 128 54 32 160 255 255 255 255 36 152 153 134 57 32 160 +255 255 255 255 255 255 38 141 60 32 160 255 255 255 255 255 255 255 +255 48 32 160 255 255 255 255 255 255 255 255 255 255 255 255 255 255 +255 255 255 255 255 255 255 255 +")) + "Default image for the enabled scroll right button. +A disabled button image will be automatically build from it.") + +(defcustom tabbar-scroll-right-button + (cons (cons " >" tabbar-scroll-right-button-enabled-image) + (cons " =" nil)) + "The scroll right button. +The variable `tabbar-button-widget' gives details on this widget." + :group 'tabbar + :type tabbar-button-widget + :set '(lambda (variable value) + (custom-set-default variable value) + ;; Schedule refresh of button value. + (setq tabbar-scroll-right-button-value nil))) + +;;; Separator +;; +(defconst tabbar-separator-widget + '(cons (choice (string) + (number :tag "Space width" 0.2)) + (repeat :tag "Image" + :extra-offset 2 + (restricted-sexp :tag "Spec" + :match-alternatives (listp)))) + "Widget for editing a tab bar separator. +A separator is specified as a pair (STRING-OR-WIDTH . IMAGE) where +STRING-OR-WIDTH is a string value or a space width, and IMAGE a list +of image specifications. +If IMAGE is non-nil, try to use that image, else use STRING-OR-WIDTH. +The value (\"\"), or (0) hide separators.") + +(defvar tabbar-separator-value nil + "Value of the separator used between tabs.") + +(defcustom tabbar-separator (list 0.2) + "Separator used between tabs. +The variable `tabbar-separator-widget' gives details on this widget." + :group 'tabbar + :type tabbar-separator-widget + :set '(lambda (variable value) + (custom-set-default variable value) + ;; Schedule refresh of separator value. + (setq tabbar-separator-value nil))) + +;;; Images +;; +(defcustom tabbar-use-images t + "*Non-nil means to try to use images in tab bar. +That is for buttons and separators." + :group 'tabbar + :type 'boolean + :set '(lambda (variable value) + (custom-set-default variable value) + ;; Schedule refresh of all buttons and separator values. + (setq tabbar-separator-value nil + tabbar-home-button-value nil + tabbar-scroll-left-button-value nil + tabbar-scroll-right-button-value nil))) + +(defsubst tabbar-find-image (specs) + "Find an image, choosing one of a list of image specifications. +SPECS is a list of image specifications. See also `find-image'." + (when (and tabbar-use-images (display-images-p)) + (condition-case nil + (find-image specs) + (error nil)))) + +(defsubst tabbar-disable-image (image) + "From IMAGE, return a new image which looks disabled." + (setq image (copy-sequence image)) + (setcdr image (plist-put (cdr image) :conversion 'disabled)) + image) + +(defsubst tabbar-normalize-image (image &optional margin) + "Make IMAGE centered and transparent. +If optional MARGIN is non-nil, it must be a number of pixels to add as +an extra margin around the image." + (let ((plist (cdr image))) + (or (plist-get plist :ascent) + (setq plist (plist-put plist :ascent 'center))) + (or (plist-get plist :mask) + (setq plist (plist-put plist :mask '(heuristic t)))) + (or (not (natnump margin)) + (plist-get plist :margin) + (plist-put plist :margin margin)) + (setcdr image plist)) + image) + +;;; Button keymaps and callbacks +;; +(defun tabbar-make-mouse-keymap (callback) + "Return a keymap that call CALLBACK on mouse events. +CALLBACK is passed the received mouse event." + (let ((keymap (make-sparse-keymap))) + ;; Pass mouse-1, mouse-2 and mouse-3 events to CALLBACK. + (define-key keymap [header-line down-mouse-1] 'ignore) + (define-key keymap [header-line mouse-1] callback) + (define-key keymap [header-line down-mouse-2] 'ignore) + (define-key keymap [header-line mouse-2] callback) + (define-key keymap [header-line down-mouse-3] 'ignore) + (define-key keymap [header-line mouse-3] callback) + keymap)) + +(defsubst tabbar-make-mouse-event (&optional type) + "Return a mouse click event. +Optional argument TYPE is a mouse-click event or one of the +symbols `mouse-1', `mouse-2' or `mouse-3'. +The default is `mouse-1'." + (if (tabbar-click-p type) + type + (list (or (memq type '(mouse-2 mouse-3)) 'mouse-1) + (or (event-start nil) ;; Emacs 21.4 + (list (selected-window) (point) '(0 . 0) 0))))) + +;;; Buttons +;; +(defconst tabbar-default-button-keymap + (tabbar-make-mouse-keymap 'tabbar-select-button-callback) + "Default keymap of a button.") + +(defun tabbar-help-on-button (window object position) + "Return a help string or nil for none, for the button under the mouse. +WINDOW is the window in which the help was found (unused). +OBJECT is the button label under the mouse. +POSITION is the position in that label. +Call `tabbar-NAME-help-function' where NAME is the button name +associated to OBJECT." + (let* ((name (get-text-property position 'tabbar-button object)) + (funvar (and name + (intern-soft (format "tabbar-%s-help-function" + name))))) + (and (symbol-value funvar) + (funcall (symbol-value funvar))))) + +(defsubst tabbar-click-on-button (name &optional type) + "Handle a mouse click event on button NAME. +Call `tabbar-select-NAME-function' with the received, or simulated +mouse click event. +Optional argument TYPE is a mouse click event type (see the function +`tabbar-make-mouse-event' for details)." + (let ((funvar (intern-soft (format "tabbar-%s-function" name)))) + (when (symbol-value funvar) + (funcall (symbol-value funvar) (tabbar-make-mouse-event type)) + (tabbar-display-update)))) + +(defun tabbar-select-button-callback (event) + "Handle a mouse EVENT on a button. +Pass mouse click events on a button to `tabbar-click-on-button'." + (interactive "@e") + (when (tabbar-click-p event) + (let ((target (posn-string (event-start event)))) + (tabbar-click-on-button + (get-text-property (cdr target) 'tabbar-button (car target)) + event)))) + +(defun tabbar-make-button-keymap (name) + "Return a keymap to handle mouse click events on button NAME." + (if (fboundp 'posn-string) + tabbar-default-button-keymap + (let ((event (make-symbol "event"))) + (tabbar-make-mouse-keymap + `(lambda (,event) + (interactive "@e") + (and (tabbar-click-p ,event) + (tabbar-click-on-button ',name ,event))))))) + +;;; Button callbacks +;; +(defun tabbar-scroll-left (event) + "On mouse EVENT, scroll current tab set on left." + (when (eq (event-basic-type event) 'mouse-1) + (tabbar-scroll (tabbar-current-tabset) -1))) + +(defun tabbar-scroll-left-help () + "Help string shown when mouse is over the scroll left button." + "mouse-1: scroll tabs left.") + +(defun tabbar-scroll-right (event) + "On mouse EVENT, scroll current tab set on right." + (when (eq (event-basic-type event) 'mouse-1) + (tabbar-scroll (tabbar-current-tabset) 1))) + +(defun tabbar-scroll-right-help () + "Help string shown when mouse is over the scroll right button." + "mouse-1: scroll tabs right.") + +;;; Tabs +;; +(defconst tabbar-default-tab-keymap + (tabbar-make-mouse-keymap 'tabbar-select-tab-callback) + "Default keymap of a tab.") + +(defun tabbar-help-on-tab (window object position) + "Return a help string or nil for none, for the tab under the mouse. +WINDOW is the window in which the help was found (unused). +OBJECT is the tab label under the mouse. +POSITION is the position in that label. +Call `tabbar-help-on-tab-function' with the associated tab." + (when tabbar-help-on-tab-function + (let ((tab (get-text-property position 'tabbar-tab object))) + (funcall tabbar-help-on-tab-function tab)))) + +(defsubst tabbar-click-on-tab (tab &optional type) + "Handle a mouse click event on tab TAB. +Call `tabbar-select-tab-function' with the received, or simulated +mouse click event, and TAB. +Optional argument TYPE is a mouse click event type (see the function +`tabbar-make-mouse-event' for details)." + (when tabbar-select-tab-function + (funcall tabbar-select-tab-function + (tabbar-make-mouse-event type) tab) + (tabbar-display-update))) + +(defun tabbar-select-tab-callback (event) + "Handle a mouse EVENT on a tab. +Pass mouse click events on a tab to `tabbar-click-on-tab'." + (interactive "@e") + (when (tabbar-click-p event) + (let ((target (posn-string (event-start event)))) + (tabbar-click-on-tab + (get-text-property (cdr target) 'tabbar-tab (car target)) + event)))) + +(defun tabbar-make-tab-keymap (tab) + "Return a keymap to handle mouse click events on TAB." + (if (fboundp 'posn-string) + tabbar-default-tab-keymap + (let ((event (make-symbol "event"))) + (tabbar-make-mouse-keymap + `(lambda (,event) + (interactive "@e") + (and (tabbar-click-p ,event) + (tabbar-click-on-tab ',tab ,event))))))) + +;;; Tab bar construction +;; +(defun tabbar-button-label (name) + "Return a label for button NAME. +That is a pair (ENABLED . DISABLED), where ENABLED and DISABLED are +respectively the appearance of the button when enabled and disabled. +They are propertized strings which could display images, as specified +by the variable `tabbar-NAME-button'." + (let* ((btn (symbol-value + (intern-soft (format "tabbar-%s-button" name)))) + (on (tabbar-find-image (cdar btn))) + (off (and on (tabbar-find-image (cddr btn))))) + (when on + (tabbar-normalize-image on 1) + (if off + (tabbar-normalize-image off 1) + ;; If there is no disabled button image, derive one from the + ;; button enabled image. + (setq off (tabbar-disable-image on)))) + (cons + (propertize (or (caar btn) " ") 'display on) + (propertize (or (cadr btn) " ") 'display off)))) + +(defun tabbar-line-button (name) + "Return the display representation of button NAME. +That is, a propertized string used as an `header-line-format' template +element." + (let ((label (if tabbar-button-label-function + (funcall tabbar-button-label-function name) + (cons name name)))) + ;; Cache the display value of the enabled/disabled buttons in + ;; variables `tabbar-NAME-button-value'. + (set (intern (format "tabbar-%s-button-value" name)) + (cons + (propertize (car label) + 'tabbar-button name + 'face 'tabbar-button + 'mouse-face 'tabbar-button-highlight + 'pointer 'hand + 'local-map (tabbar-make-button-keymap name) + 'help-echo 'tabbar-help-on-button) + (propertize (cdr label) + 'face 'tabbar-button + 'pointer 'arrow))))) + +(defun tabbar-line-separator () + "Return the display representation of a tab bar separator. +That is, a propertized string used as an `header-line-format' template +element." + (let ((image (tabbar-find-image (cdr tabbar-separator)))) + ;; Cache the separator display value in variable + ;; `tabbar-separator-value'. + (setq tabbar-separator-value + (cond + (image + (propertize " " + 'face 'tabbar-separator + 'pointer 'arrow + 'display (tabbar-normalize-image image))) + ((numberp (car tabbar-separator)) + (propertize " " + 'face 'tabbar-separator + 'pointer 'arrow + 'display (list 'space + :width (car tabbar-separator)))) + ((propertize (or (car tabbar-separator) " ") + 'face 'tabbar-separator + 'pointer 'arrow)))) + )) + +(defsubst tabbar-line-buttons (tabset) + "Return a list of propertized strings for tab bar buttons. +TABSET is the tab set used to choose the appropriate buttons." + (list + (if tabbar-home-function + (car tabbar-home-button-value) + (cdr tabbar-home-button-value)) + (if (> (tabbar-start tabset) 0) + (car tabbar-scroll-left-button-value) + (cdr tabbar-scroll-left-button-value)) + (if (< (tabbar-start tabset) + (1- (length (tabbar-tabs tabset)))) + (car tabbar-scroll-right-button-value) + (cdr tabbar-scroll-right-button-value)) + tabbar-separator-value)) + +(defsubst tabbar-line-tab (tab) + "Return the display representation of tab TAB. +That is, a propertized string used as an `header-line-format' template +element. +Call `tabbar-tab-label-function' to obtain a label for TAB." + (concat (propertize + (if tabbar-tab-label-function + (funcall tabbar-tab-label-function tab) + tab) + 'tabbar-tab tab + 'local-map (tabbar-make-tab-keymap tab) + 'help-echo 'tabbar-help-on-tab + 'mouse-face 'tabbar-highlight + 'face (if (tabbar-selected-p tab (tabbar-current-tabset)) + 'tabbar-selected + 'tabbar-unselected) + 'pointer 'hand) + tabbar-separator-value)) + +(defun tabbar-line-format (tabset) + "Return the `header-line-format' value to display TABSET." + (let* ((sel (tabbar-selected-tab tabset)) + (tabs (tabbar-view tabset)) + (padcolor (tabbar-background-color)) + atsel elts) + ;; Initialize buttons and separator values. + (or tabbar-separator-value + (tabbar-line-separator)) + (or tabbar-home-button-value + (tabbar-line-button 'home)) + (or tabbar-scroll-left-button-value + (tabbar-line-button 'scroll-left)) + (or tabbar-scroll-right-button-value + (tabbar-line-button 'scroll-right)) + ;; Track the selected tab to ensure it is always visible. + (when tabbar--track-selected + (while (not (memq sel tabs)) + (tabbar-scroll tabset -1) + (setq tabs (tabbar-view tabset))) + (while (and tabs (not atsel)) + (setq elts (cons (tabbar-line-tab (car tabs)) elts) + atsel (eq (car tabs) sel) + tabs (cdr tabs))) + (setq elts (nreverse elts)) + ;; At this point the selected tab is the last elt in ELTS. + ;; Scroll TABSET and ELTS until the selected tab becomes + ;; visible. + (with-temp-buffer + (let ((truncate-partial-width-windows nil) + (inhibit-modification-hooks t) + deactivate-mark ;; Prevent deactivation of the mark! + start) + (setq truncate-lines nil + buffer-undo-list t) + (apply 'insert (tabbar-line-buttons tabset)) + (setq start (point)) + (while (and (cdr elts) ;; Always show the selected tab! + (progn + (delete-region start (point-max)) + (goto-char (point-max)) + (apply 'insert elts) + (goto-char (point-min)) + (> (vertical-motion 1) 0))) + (tabbar-scroll tabset 1) + (setq elts (cdr elts))))) + (setq elts (nreverse elts)) + (setq tabbar--track-selected nil)) + ;; Format remaining tabs. + (while tabs + (setq elts (cons (tabbar-line-tab (car tabs)) elts) + tabs (cdr tabs))) + ;; Cache and return the new tab bar. + (tabbar-set-template + tabset + (list (tabbar-line-buttons tabset) + (nreverse elts) + (propertize "%-" + 'face (list :background padcolor + :foreground padcolor) + 'pointer 'arrow))) + )) + +(defun tabbar-line () + "Return the header line templates that represent the tab bar. +Inhibit display of the tab bar in current window if any of the +`tabbar-inhibit-functions' return non-nil." + (cond + ((run-hook-with-args-until-success 'tabbar-inhibit-functions) + ;; Don't show the tab bar. + (setq header-line-format nil)) + ((tabbar-current-tabset t) + ;; When available, use a cached tab bar value, else recompute it. + (or (tabbar-template tabbar-current-tabset) + (tabbar-line-format tabbar-current-tabset))))) + +(defconst tabbar-header-line-format '(:eval (tabbar-line)) + "The tab bar header line format.") + +(defun tabbar-default-inhibit-function () + "Inhibit display of the tab bar in specified windows. +That is dedicated windows, and `checkdoc' status windows." + (or (window-dedicated-p (selected-window)) + (member (buffer-name) + (list " *Checkdoc Status*" + (if (boundp 'ispell-choices-buffer) + ispell-choices-buffer + "*Choices*"))))) + +;;; Cyclic navigation through tabs +;; +(defun tabbar-cycle (&optional backward type) + "Cycle to the next available tab. +The scope of the cyclic navigation through tabs is specified by the +option `tabbar-cycle-scope'. +If optional argument BACKWARD is non-nil, cycle to the previous tab +instead. +Optional argument TYPE is a mouse event type (see the function +`tabbar-make-mouse-event' for details)." + (let* ((tabset (tabbar-current-tabset t)) + (ttabset (tabbar-get-tabsets-tabset)) + ;; If navigation through groups is requested, and there is + ;; only one group, navigate through visible tabs. + (cycle (if (and (eq tabbar-cycle-scope 'groups) + (not (cdr (tabbar-tabs ttabset)))) + 'tabs + tabbar-cycle-scope)) + selected tab) + (when tabset + (setq selected (tabbar-selected-tab tabset)) + (cond + ;; Cycle through visible tabs only. + ((eq cycle 'tabs) + (setq tab (tabbar-tab-next tabset selected backward)) + ;; When there is no tab after/before the selected one, cycle + ;; to the first/last visible tab. + (unless tab + (setq tabset (tabbar-tabs tabset) + tab (car (if backward (last tabset) tabset)))) + ) + ;; Cycle through tab groups only. + ((eq cycle 'groups) + (setq tab (tabbar-tab-next ttabset selected backward)) + ;; When there is no group after/before the selected one, cycle + ;; to the first/last available group. + (unless tab + (setq tabset (tabbar-tabs ttabset) + tab (car (if backward (last tabset) tabset)))) + ) + (t + ;; Cycle through visible tabs then tab groups. + (setq tab (tabbar-tab-next tabset selected backward)) + ;; When there is no visible tab after/before the selected one, + ;; cycle to the next/previous available group. + (unless tab + (setq tab (tabbar-tab-next ttabset selected backward)) + ;; When there is no next/previous group, cycle to the + ;; first/last available group. + (unless tab + (setq tabset (tabbar-tabs ttabset) + tab (car (if backward (last tabset) tabset)))) + ;; Select the first/last visible tab of the new group. + (setq tabset (tabbar-tabs (tabbar-tab-tabset tab)) + tab (car (if backward (last tabset) tabset)))) + )) + (tabbar-click-on-tab tab type)))) + +;;;###autoload +(defun tabbar-backward () + "Select the previous available tab. +Depend on the setting of the option `tabbar-cycle-scope'." + (interactive) + (tabbar-cycle t)) + +;;;###autoload +(defun tabbar-forward () + "Select the next available tab. +Depend on the setting of the option `tabbar-cycle-scope'." + (interactive) + (tabbar-cycle)) + +;;;###autoload +(defun tabbar-backward-group () + "Go to selected tab in the previous available group." + (interactive) + (let ((tabbar-cycle-scope 'groups)) + (tabbar-cycle t))) + +;;;###autoload +(defun tabbar-forward-group () + "Go to selected tab in the next available group." + (interactive) + (let ((tabbar-cycle-scope 'groups)) + (tabbar-cycle))) + +;;;###autoload +(defun tabbar-backward-tab () + "Select the previous visible tab." + (interactive) + (let ((tabbar-cycle-scope 'tabs)) + (tabbar-cycle t))) + +;;;###autoload +(defun tabbar-forward-tab () + "Select the next visible tab." + (interactive) + (let ((tabbar-cycle-scope 'tabs)) + (tabbar-cycle))) + +;;; Button press commands +;; +(defsubst tabbar--mouse (number) + "Return a mouse button symbol from NUMBER. +That is mouse-2, or mouse-3 when NUMBER is respectively 2, or 3. +Return mouse-1 otherwise." + (cond ((eq number 2) 'mouse-2) + ((eq number 3) 'mouse-3) + ('mouse-1))) + +;;;###autoload +(defun tabbar-press-home (&optional arg) + "Press the tab bar home button. +That is, simulate a mouse click on that button. +A numeric prefix ARG value of 2, or 3, respectively simulates a +mouse-2, or mouse-3 click. The default is a mouse-1 click." + (interactive "p") + (tabbar-click-on-button 'home (tabbar--mouse arg))) + +;;;###autoload +(defun tabbar-press-scroll-left (&optional arg) + "Press the tab bar scroll-left button. +That is, simulate a mouse click on that button. +A numeric prefix ARG value of 2, or 3, respectively simulates a +mouse-2, or mouse-3 click. The default is a mouse-1 click." + (interactive "p") + (tabbar-click-on-button 'scroll-left (tabbar--mouse arg))) + +;;;###autoload +(defun tabbar-press-scroll-right (&optional arg) + "Press the tab bar scroll-right button. +That is, simulate a mouse click on that button. +A numeric prefix ARG value of 2, or 3, respectively simulates a +mouse-2, or mouse-3 click. The default is a mouse-1 click." + (interactive "p") + (tabbar-click-on-button 'scroll-right (tabbar--mouse arg))) + +;;; Mouse-wheel support +;; +(require 'mwheel) + +;;; Compatibility +;; +(defconst tabbar--mwheel-up-event + (symbol-value (if (boundp 'mouse-wheel-up-event) + 'mouse-wheel-up-event + 'mouse-wheel-up-button))) + +(defconst tabbar--mwheel-down-event + (symbol-value (if (boundp 'mouse-wheel-down-event) + 'mouse-wheel-down-event + 'mouse-wheel-down-button))) + +(defsubst tabbar--mwheel-key (event-type) + "Return a mouse wheel key symbol from EVENT-TYPE. +When EVENT-TYPE is a symbol return it. +When it is a button number, return symbol `mouse-<EVENT-TYPE>'." + (if (symbolp event-type) + event-type + (intern (format "mouse-%s" event-type)))) + +(defsubst tabbar--mwheel-up-p (event) + "Return non-nil if EVENT is a mouse-wheel up event." + (let ((x (event-basic-type event))) + (if (eq 'mouse-wheel x) + (< (car (cdr (cdr event))) 0) ;; Emacs 21.3 + ;; Emacs > 21.3 + (eq x tabbar--mwheel-up-event)))) + +;;; Basic commands +;; +;;;###autoload +(defun tabbar-mwheel-backward (event) + "Select the previous available tab. +EVENT is the mouse event that triggered this command. +Mouse-enabled equivalent of the command `tabbar-backward'." + (interactive "@e") + (tabbar-cycle t event)) + +;;;###autoload +(defun tabbar-mwheel-forward (event) + "Select the next available tab. +EVENT is the mouse event that triggered this command. +Mouse-enabled equivalent of the command `tabbar-forward'." + (interactive "@e") + (tabbar-cycle nil event)) + +;;;###autoload +(defun tabbar-mwheel-backward-group (event) + "Go to selected tab in the previous available group. +If there is only one group, select the previous visible tab. +EVENT is the mouse event that triggered this command. +Mouse-enabled equivalent of the command `tabbar-backward-group'." + (interactive "@e") + (let ((tabbar-cycle-scope 'groups)) + (tabbar-cycle t event))) + +;;;###autoload +(defun tabbar-mwheel-forward-group (event) + "Go to selected tab in the next available group. +If there is only one group, select the next visible tab. +EVENT is the mouse event that triggered this command. +Mouse-enabled equivalent of the command `tabbar-forward-group'." + (interactive "@e") + (let ((tabbar-cycle-scope 'groups)) + (tabbar-cycle nil event))) + +;;;###autoload +(defun tabbar-mwheel-backward-tab (event) + "Select the previous visible tab. +EVENT is the mouse event that triggered this command. +Mouse-enabled equivalent of the command `tabbar-backward-tab'." + (interactive "@e") + (let ((tabbar-cycle-scope 'tabs)) + (tabbar-cycle t event))) + +;;;###autoload +(defun tabbar-mwheel-forward-tab (event) + "Select the next visible tab. +EVENT is the mouse event that triggered this command. +Mouse-enabled equivalent of the command `tabbar-forward-tab'." + (interactive "@e") + (let ((tabbar-cycle-scope 'tabs)) + (tabbar-cycle nil event))) + +;;; Wrappers when there is only one generic mouse-wheel event +;; +;;;###autoload +(defun tabbar-mwheel-switch-tab (event) + "Select the next or previous tab according to EVENT." + (interactive "@e") + (if (tabbar--mwheel-up-p event) + (tabbar-mwheel-forward-tab event) + (tabbar-mwheel-backward-tab event))) + +;;;###autoload +(defun tabbar-mwheel-switch-group (event) + "Select the next or previous group of tabs according to EVENT." + (interactive "@e") + (if (tabbar--mwheel-up-p event) + (tabbar-mwheel-forward-group event) + (tabbar-mwheel-backward-group event))) + +;;; Minor modes +;; +(defsubst tabbar-mode-on-p () + "Return non-nil if Tabbar mode is on." + (eq (default-value 'header-line-format) + tabbar-header-line-format)) + +;;; Tabbar-Local mode +;; +(defvar tabbar--local-hlf nil) + +;;;###autoload +(define-minor-mode tabbar-local-mode + "Toggle local display of the tab bar. +With prefix argument ARG, turn on if positive, otherwise off. +Returns non-nil if the new state is enabled. +When turned on, if a local header line is shown, it is hidden to show +the tab bar. The tab bar is locally hidden otherwise. When turned +off, if a local header line is hidden or the tab bar is locally +hidden, it is shown again. Signal an error if Tabbar mode is off." + :group 'tabbar + :global nil + (unless (tabbar-mode-on-p) + (error "Tabbar mode must be enabled")) +;;; ON + (if tabbar-local-mode + (if (and (local-variable-p 'header-line-format) + header-line-format) + ;; A local header line exists, hide it to show the tab bar. + (progn + ;; Fail in case of an inconsistency because another local + ;; header line is already hidden. + (when (local-variable-p 'tabbar--local-hlf) + (error "Another local header line is already hidden")) + (set (make-local-variable 'tabbar--local-hlf) + header-line-format) + (kill-local-variable 'header-line-format)) + ;; Otherwise hide the tab bar in this buffer. + (setq header-line-format nil)) +;;; OFF + (if (local-variable-p 'tabbar--local-hlf) + ;; A local header line is hidden, show it again. + (progn + (setq header-line-format tabbar--local-hlf) + (kill-local-variable 'tabbar--local-hlf)) + ;; The tab bar is locally hidden, show it again. + (kill-local-variable 'header-line-format)))) + +;;; Tabbar mode +;; +(defvar tabbar-prefix-key [(control ?c)] + "The common prefix key used in Tabbar mode.") + +(defvar 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 up)] 'tabbar-backward-group) + (define-key km [(control down)] 'tabbar-forward-group) + (define-key km [(control prior)] 'tabbar-press-scroll-left) + (define-key km [(control next)] 'tabbar-press-scroll-right) + (define-key km [(control f10)] 'tabbar-local-mode) + km) + "The key bindings provided in Tabbar mode.") + +(defvar tabbar-mode-map + (let ((km (make-sparse-keymap))) + (define-key km tabbar-prefix-key tabbar-prefix-map) + km) + "Keymap to use in Tabbar mode.") + +(defvar tabbar--global-hlf nil) + +;;;###autoload +(define-minor-mode tabbar-mode + "Toggle display of a tab bar in the header line. +With prefix argument ARG, turn on if positive, otherwise off. +Returns non-nil if the new state is enabled. + +\\{tabbar-mode-map}" + :group 'tabbar + :require 'tabbar + :global t + :keymap tabbar-mode-map + (if tabbar-mode +;;; ON + (unless (tabbar-mode-on-p) + ;; Save current default value of `header-line-format'. + (setq tabbar--global-hlf (default-value 'header-line-format)) + (tabbar-init-tabsets-store) + (setq-default header-line-format tabbar-header-line-format)) +;;; OFF + (when (tabbar-mode-on-p) + ;; Turn off Tabbar-Local mode globally. + (mapc #'(lambda (b) + (condition-case nil + (with-current-buffer b + (and tabbar-local-mode + (tabbar-local-mode -1))) + (error nil))) + (buffer-list)) + ;; Restore previous `header-line-format'. + (setq-default header-line-format tabbar--global-hlf) + (tabbar-free-tabsets-store)) + )) + +;;; Tabbar-Mwheel mode +;; +(defvar 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] + 'tabbar-mwheel-switch-group) + ;; 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] + 'tabbar-mwheel-backward-group) + (define-key km `[header-line ,up] + 'tabbar-mwheel-forward-group) + (define-key km `[header-line (control ,down)] + 'tabbar-mwheel-backward-tab) + (define-key km `[header-line (control ,up)] + 'tabbar-mwheel-forward-tab) + (define-key km `[header-line (shift ,down)] + 'tabbar-mwheel-backward) + (define-key km `[header-line (shift ,up)] + 'tabbar-mwheel-forward) + )) + km) + "Keymap to use in Tabbar-Mwheel mode.") + +;;;###autoload +(define-minor-mode tabbar-mwheel-mode + "Toggle use of the mouse wheel to navigate through tabs or groups. +With prefix argument ARG, turn on if positive, otherwise off. +Returns non-nil if the new state is enabled. + +\\{tabbar-mwheel-mode-map}" + :group 'tabbar + :require 'tabbar + :global t + :keymap tabbar-mwheel-mode-map + (when tabbar-mwheel-mode + (unless (and mouse-wheel-mode tabbar-mode) + (tabbar-mwheel-mode -1)))) + +(defun tabbar-mwheel-follow () + "Toggle Tabbar-Mwheel following Tabbar and Mouse-Wheel modes." + (tabbar-mwheel-mode (if (and mouse-wheel-mode tabbar-mode) 1 -1))) + +(add-hook 'tabbar-mode-hook 'tabbar-mwheel-follow) +(add-hook 'mouse-wheel-mode-hook 'tabbar-mwheel-follow) + +;;; Buffer tabs +;; +(defgroup tabbar-buffer nil + "Display buffers in the tab bar." + :group 'tabbar) + +(defcustom tabbar-buffer-home-button + (cons (cons "[+]" tabbar-home-button-enabled-image) + (cons "[-]" tabbar-home-button-disabled-image)) + "The home button displayed when showing buffer tabs. +The enabled button value is displayed when showing tabs for groups of +buffers, and the disabled button value is displayed when showing +buffer tabs. +The variable `tabbar-button-widget' gives details on this widget." + :group 'tabbar-buffer + :type tabbar-button-widget + :set '(lambda (variable value) + (custom-set-default variable value) + ;; Schedule refresh of button value. + (setq tabbar-home-button-value nil))) + +(defvar tabbar-buffer-list-function 'tabbar-buffer-list + "Function that returns the list of buffers to show in tabs. +That function is called with no arguments and must return a list of +buffers.") + +(defvar tabbar-buffer-groups-function 'tabbar-buffer-groups + "Function that gives the group names the current buffer belongs to. +It must return a list of group names, or nil if the buffer has no +group. Notice that it is better that a buffer belongs to one group.") + +(defun tabbar-buffer-list () + "Return the list of buffers to show in tabs. +Exclude buffers whose name starts with a space, when they are not +visiting a file. The current buffer is always included." + (delq nil + (mapcar #'(lambda (b) + (cond + ;; Always include the current buffer. + ((eq (current-buffer) b) b) + ((buffer-file-name b) b) + ((char-equal ?\ (aref (buffer-name b) 0)) nil) + ((buffer-live-p b) b))) + (buffer-list)))) + +(defun tabbar-buffer-mode-derived-p (mode parents) + "Return non-nil if MODE derives from a mode in PARENTS." + (let (derived) + (while (and (not derived) mode) + (if (memq mode parents) + (setq derived t) + (setq mode (get mode 'derived-mode-parent)))) + derived)) + +(defun tabbar-buffer-groups () + "Return the list of group names the current buffer belongs to. +Return a list of one element based on major mode." + (list + (cond + ((or (get-buffer-process (current-buffer)) + ;; Check if the major mode derives from `comint-mode' or + ;; `compilation-mode'. + (tabbar-buffer-mode-derived-p + major-mode '(comint-mode compilation-mode))) + "Process" + ) + ((member (buffer-name) + '("*scratch*" "*Messages*")) + "Common" + ) + ((eq major-mode 'dired-mode) + "Dired" + ) + ((memq major-mode + '(help-mode apropos-mode Info-mode Man-mode)) + "Help" + ) + ((memq major-mode + '(rmail-mode + rmail-edit-mode vm-summary-mode vm-mode mail-mode + mh-letter-mode mh-show-mode mh-folder-mode + gnus-summary-mode message-mode gnus-group-mode + gnus-article-mode score-mode gnus-browse-killed-mode)) + "Mail" + ) + (t + ;; Return `mode-name' if not blank, `major-mode' otherwise. + (if (and (stringp mode-name) + ;; Take care of preserving the match-data because this + ;; function is called when updating the header line. + (save-match-data (string-match "[^ ]" mode-name))) + mode-name + (symbol-name major-mode)) + )))) + +;;; Group buffers in tab sets. +;; +(defvar tabbar--buffers nil) + +(defun tabbar-buffer-update-groups () + "Update tab sets from groups of existing buffers. +Return the the first group where the current buffer is." + (let ((bl (sort + (mapcar + #'(lambda (b) + (with-current-buffer b + (list (current-buffer) + (buffer-name) + (if tabbar-buffer-groups-function + (funcall tabbar-buffer-groups-function) + '("Common"))))) + (and tabbar-buffer-list-function + (funcall tabbar-buffer-list-function))) + #'(lambda (e1 e2) + (string-lessp (nth 1 e1) (nth 1 e2)))))) + ;; If the cache has changed, update the tab sets. + (unless (equal bl tabbar--buffers) + ;; Add new buffers, or update changed ones. + (dolist (e bl) + (dolist (g (nth 2 e)) + (let ((tabset (tabbar-get-tabset g))) + (if tabset + (unless (equal e (assq (car e) tabbar--buffers)) + ;; This is a new buffer, or a previously existing + ;; buffer that has been renamed, or moved to another + ;; group. Update the tab set, and the display. + (tabbar-add-tab tabset (car e) t) + (tabbar-set-template tabset nil)) + (tabbar-make-tabset g (car e)))))) + ;; Remove tabs for buffers not found in cache or moved to other + ;; groups, and remove empty tabsets. + (mapc 'tabbar-delete-tabset + (tabbar-map-tabsets + #'(lambda (tabset) + (dolist (tab (tabbar-tabs tabset)) + (let ((e (assq (tabbar-tab-value tab) bl))) + (or (and e (memq tabset + (mapcar 'tabbar-get-tabset + (nth 2 e)))) + (tabbar-delete-tab tab)))) + ;; Return empty tab sets + (unless (tabbar-tabs tabset) + tabset)))) + ;; The new cache becomes the current one. + (setq tabbar--buffers bl))) + ;; Return the first group the current buffer belongs to. + (car (nth 2 (assq (current-buffer) tabbar--buffers)))) + +;;; Tab bar callbacks +;; +(defvar tabbar--buffer-show-groups nil) + +(defsubst tabbar-buffer-show-groups (flag) + "Set display of tabs for groups of buffers to FLAG." + (setq tabbar--buffer-show-groups flag + ;; Redisplay the home button. + tabbar-home-button-value nil)) + +(defun tabbar-buffer-tabs () + "Return the buffers to display on the tab bar, in a tab set." + (let ((tabset (tabbar-get-tabset (tabbar-buffer-update-groups)))) + (tabbar-select-tab-value (current-buffer) tabset) + (when tabbar--buffer-show-groups + (setq tabset (tabbar-get-tabsets-tabset)) + (tabbar-select-tab-value (current-buffer) tabset)) + tabset)) + +(defun tabbar-buffer-button-label (name) + "Return a label for button NAME. +That is a pair (ENABLED . DISABLED), where ENABLED and DISABLED are +respectively the appearance of the button when enabled and disabled. +They are propertized strings which could display images, as specified +by the variable `tabbar-button-label'. +When NAME is 'home, return a different ENABLED button if showing tabs +or groups. Call the function `tabbar-button-label' otherwise." + (let ((lab (tabbar-button-label name))) + (when (eq name 'home) + (let* ((btn tabbar-buffer-home-button) + (on (tabbar-find-image (cdar btn))) + (off (tabbar-find-image (cddr btn)))) + ;; When `tabbar-buffer-home-button' does not provide a value, + ;; default to the enabled value of `tabbar-home-button'. + (if on + (tabbar-normalize-image on 1) + (setq on (get-text-property 0 'display (car lab)))) + (if off + (tabbar-normalize-image off 1) + (setq off (get-text-property 0 'display (car lab)))) + (setcar lab + (if tabbar--buffer-show-groups + (propertize (or (caar btn) (car lab)) 'display on) + (propertize (or (cadr btn) (car lab)) 'display off))) + )) + lab)) + +(defun tabbar-buffer-tab-label (tab) + "Return a label for TAB. +That is, a string used to represent it on the tab bar." + (let ((label (if tabbar--buffer-show-groups + (format "[%s]" (tabbar-tab-tabset tab)) + (format "%s" (tabbar-tab-value tab))))) + ;; Unless the tab bar auto scrolls to keep the selected tab + ;; visible, shorten the tab label to keep as many tabs as possible + ;; in the visible area of the tab bar. + (if tabbar-auto-scroll-flag + label + (tabbar-shorten + label (max 1 (/ (window-width) + (length (tabbar-view + (tabbar-current-tabset))))))))) + +(defun tabbar-buffer-help-on-tab (tab) + "Return the help string shown when mouse is onto TAB." + (if tabbar--buffer-show-groups + (let* ((tabset (tabbar-tab-tabset tab)) + (tab (tabbar-selected-tab tabset))) + (format "mouse-1: switch to buffer %S in group [%s]" + (buffer-name (tabbar-tab-value tab)) tabset)) + (format "mouse-1: switch to buffer %S\n\ +mouse-2: pop to buffer, mouse-3: delete other windows" + (buffer-name (tabbar-tab-value tab))) + )) + +(defun tabbar-buffer-select-tab (event tab) + "On mouse EVENT, select TAB." + (let ((mouse-button (event-basic-type event)) + (buffer (tabbar-tab-value tab))) + (cond + ((eq mouse-button 'mouse-2) + (pop-to-buffer buffer t)) + ((eq mouse-button 'mouse-3) + (delete-other-windows)) + (t + (switch-to-buffer buffer))) + ;; Don't show groups. + (tabbar-buffer-show-groups nil) + )) + +(defun tabbar-buffer-click-on-home (event) + "Handle a mouse click EVENT on the tab bar home button. +mouse-1, toggle the display of tabs for groups of buffers. +mouse-3, close the current buffer." + (let ((mouse-button (event-basic-type event))) + (cond + ((eq mouse-button 'mouse-1) + (tabbar-buffer-show-groups (not tabbar--buffer-show-groups))) + ((eq mouse-button 'mouse-3) + (kill-buffer nil)) + ))) + +(defun tabbar-buffer-help-on-home () + "Return the help string shown when mouse is onto the toggle button." + (concat + (if tabbar--buffer-show-groups + "mouse-1: show buffers in selected group" + "mouse-1: show groups of buffers") + ", mouse-3: close current buffer")) + +(defun tabbar-buffer-track-killed () + "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." + (and (eq header-line-format tabbar-header-line-format) + (eq tabbar-current-tabset-function 'tabbar-buffer-tabs) + (eq (current-buffer) (window-buffer (selected-window))) + (let ((bl (tabbar-tab-values (tabbar-current-tabset))) + (b (current-buffer)) + found sibling) + (while (and bl (not found)) + (if (eq b (car bl)) + (setq found t) + (setq sibling (car bl))) + (setq bl (cdr bl))) + (when (and (setq sibling (or (car bl) sibling)) + (buffer-live-p sibling)) + ;; Move sibling buffer in front of the buffer list. + (save-current-buffer + (switch-to-buffer sibling)))))) + +;;; Tab bar buffer setup +;; +(defun tabbar-buffer-init () + "Initialize tab bar buffer data. +Run as `tabbar-init-hook'." + (setq tabbar--buffers nil + tabbar--buffer-show-groups nil + tabbar-current-tabset-function 'tabbar-buffer-tabs + tabbar-tab-label-function 'tabbar-buffer-tab-label + tabbar-select-tab-function 'tabbar-buffer-select-tab + tabbar-help-on-tab-function 'tabbar-buffer-help-on-tab + tabbar-button-label-function 'tabbar-buffer-button-label + tabbar-home-function 'tabbar-buffer-click-on-home + tabbar-home-help-function 'tabbar-buffer-help-on-home + ) + (add-hook 'kill-buffer-hook 'tabbar-buffer-track-killed)) + +(defun tabbar-buffer-quit () + "Quit tab bar buffer. +Run as `tabbar-quit-hook'." + (setq tabbar--buffers nil + tabbar--buffer-show-groups nil + tabbar-current-tabset-function nil + tabbar-tab-label-function nil + tabbar-select-tab-function nil + tabbar-help-on-tab-function nil + tabbar-button-label-function nil + tabbar-home-function nil + tabbar-home-help-function nil + ) + (remove-hook 'kill-buffer-hook 'tabbar-buffer-track-killed)) + +(add-hook 'tabbar-init-hook 'tabbar-buffer-init) +(add-hook 'tabbar-quit-hook 'tabbar-buffer-quit) + +(provide 'tabbar) + +(run-hooks 'tabbar-load-hook) + +;;; tabbar.el ends here diff --git a/.emacs.d/tramp b/.emacs.d/tramp new file mode 100644 index 0000000..407d593 --- /dev/null +++ b/.emacs.d/tramp @@ -0,0 +1,20 @@ +;; -*- emacs-lisp -*- +;; Tramp connection history. Don't change this file. +;; You can delete it, forcing Tramp to reapply the checks. + +((["scp" "slash" "192.168.1.90" nil] + ("uname" "Linux 2.6.33.5-112.fc13.i686") + ("test" "test") + ("remote-path" + ("/bin" "/usr/bin" "/usr/sbin" "/usr/local/bin")) + ("remote-shell" "/bin/sh") + ("~" "/home/slash") + ("file-exists" "test -e") + ("stat" "\\stat") + ("id" "/usr/bin/id") + ("gid-integer" 500) + ("local-encoding" base64-encode-region) + ("local-decoding" base64-decode-region) + ("remote-encoding" "base64") + ("remote-decoding" "base64 -d") + ("perl" "\\perl"))) |