diff --git a/emacs.d/TUTORIAL b/emacs.d/TUTORIAL new file mode 100644 index 0000000..bf9a783 --- /dev/null +++ b/emacs.d/TUTORIAL @@ -0,0 +1,1168 @@ +Emacs tutorial. See end for copying conditions. + +Emacs commands generally involve the CONTROL key (sometimes labeled +CTRL or CTL) or the META key (sometimes labeled EDIT or ALT). Rather than +write that in full each time, we'll use the following abbreviations: + + C- means hold the CONTROL key while typing the character + Thus, C-f would be: hold the CONTROL key and type f. + M- means hold the META or EDIT or ALT key down while typing . + If there is no META, EDIT or ALT key, instead press and release the + ESC key and then type . We write for the ESC key. + +Important note: to end the Emacs session, type C-x C-c. (Two characters.) +The characters ">>" at the left margin indicate directions for you to +try using a command. For instance: + + + + + + + + + + + + + + + + + + +[Middle of page left blank for didactic purposes. Text continues below] + + + + + + + + + + + + + + + + + + +>> Now type C-v (View next screen) to move to the next screen. + (go ahead, do it by holding down the CONTROL key while typing v). + From now on, you should do this again whenever you finish + reading the screen. + +Note that there is an overlap of two lines when you move from screen +to screen; this provides some continuity so you can continue reading +the text. + +The first thing that you need to know is how to move around from place +to place in the text. You already know how to move forward one screen, +with C-v. To move backwards one screen, type M-v (hold down the META key +and type v, or type v if you do not have a META, EDIT, or ALT key). + +>> Try typing M-v and then C-v, a few times. + + +* SUMMARY +--------- + +The following commands are useful for viewing screenfuls: + + C-v Move forward one screenful + M-v Move backward one screenful + C-l Clear screen and redisplay all the text, + moving the text around the cursor + to the center of the screen. + (That's CONTROL-L, not CONTROL-1.) + +>> Find the cursor, and note what text is near it. + Then type C-l. + Find the cursor again and notice that the same text + is near the cursor now. + +You can also use the PageUp and PageDn keys to move by screenfuls, if +your terminal has them, but you can edit more efficiently if you use +C-v and M-v. + + +* BASIC CURSOR CONTROL +---------------------- + +Moving from screenful to screenful is useful, but how do you +move to a specific place within the text on the screen? + +There are several ways you can do this. You can use the arrow keys, +but it's more efficient to keep your hands in the standard position +and use the commands C-p, C-b, C-f, and C-n. These characters +are equivalent to the four arrow keys, like this: + + Previous line, C-p + : + : + Backward, C-b .... Current cursor position .... Forward, C-f + : + : + Next line, C-n + +>> Move the cursor to the line in the middle of that diagram + using C-n or C-p. Then type C-l to see the whole diagram + centered in the screen. + +You'll find it easy to remember these letters by words they stand for: +P for previous, N for next, B for backward and F for forward. You +will be using these basic cursor positioning commands all the time. + +>> Do a few C-n's to bring the cursor down to this line. + +>> Move into the line with C-f's and then up with C-p's. + See what C-p does when the cursor is in the middle of the line. + +Each line of text ends with a Newline character, which serves to +separate it from the following line. The last line in your file ought +to have a Newline at the end (but Emacs does not require it to have +one). + +>> Try to C-b at the beginning of a line. It should move to + the end of the previous line. This is because it moves back + across the Newline character. + +C-f can move across a Newline just like C-b. + +>> Do a few more C-b's, so you get a feel for where the cursor is. + Then do C-f's to return to the end of the line. + Then do one more C-f to move to the following line. + +When you move past the top or bottom of the screen, the text beyond +the edge shifts onto the screen. This is called "scrolling". It +enables Emacs to move the cursor to the specified place in the text +without moving it off the screen. + +>> Try to move the cursor off the bottom of the screen with C-n, and + see what happens. + +If moving by characters is too slow, you can move by words. M-f +(META-f) moves forward a word and M-b moves back a word. + +>> Type a few M-f's and M-b's. + +When you are in the middle of a word, M-f moves to the end of the word. +When you are in whitespace between words, M-f moves to the end of the +following word. M-b works likewise in the opposite direction. + +>> Type M-f and M-b a few times, interspersed with C-f's and C-b's + so that you can observe the action of M-f and M-b from various + places inside and between words. + +Notice the parallel between C-f and C-b on the one hand, and M-f and +M-b on the other hand. Very often Meta characters are used for +operations related to the units defined by language (words, sentences, +paragraphs), while Control characters operate on basic units that are +independent of what you are editing (characters, lines, etc). + +This parallel applies between lines and sentences: C-a and C-e move to +the beginning or end of a line, and M-a and M-e move to the beginning +or end of a sentence. + +>> Try a couple of C-a's, and then a couple of C-e's. + Try a couple of M-a's, and then a couple of M-e's. + +See how repeated C-a's do nothing, but repeated M-a's keep moving one +more sentence. Although these are not quite analogous, each one seems +natural. + +The location of the cursor in the text is also called "point". To +paraphrase, the cursor shows on the screen where point is located in +the text. + +Here is a summary of simple cursor-moving operations, including the +word and sentence moving commands: + + C-f Move forward a character + C-b Move backward a character + + M-f Move forward a word + M-b Move backward a word + + C-n Move to next line + C-p Move to previous line + + C-a Move to beginning of line + C-e Move to end of line + + M-a Move back to beginning of sentence + M-e Move forward to end of sentence + +>> Try all of these commands now a few times for practice. + These are the most often used commands. + +Two other important cursor motion commands are M-< (META Less-than), +which moves to the beginning of the whole text, and M-> (META +Greater-than), which moves to the end of the whole text. + +On most terminals, the "<" is above the comma, so you must use the +shift key to type it. On these terminals you must use the shift key +to type M-< also; without the shift key, you would be typing M-comma. + +>> Try M-< now, to move to the beginning of the tutorial. + Then use C-v repeatedly to move back here. + +>> Try M-> now, to move to the end of the tutorial. + Then use M-v repeatedly to move back here. + +You can also move the cursor with the arrow keys, if your terminal has +arrow keys. We recommend learning C-b, C-f, C-n and C-p for three +reasons. First, they work on all kinds of terminals. Second, once +you gain practice at using Emacs, you will find that typing these Control +characters is faster than typing the arrow keys (because you do not +have to move your hands away from touch-typing position). Third, once +you form the habit of using these Control character commands, you can +easily learn to use other advanced cursor motion commands as well. + +Most Emacs commands accept a numeric argument; for most commands, this +serves as a repeat-count. The way you give a command a repeat count +is by typing C-u and then the digits before you type the command. If +you have a META (or EDIT or ALT) key, there is another, alternative way +to enter a numeric argument: type the digits while holding down the +META key. We recommend learning the C-u method because it works on +any terminal. The numeric argument is also called a "prefix argument", +because you type the argument before the command it applies to. + +For instance, C-u 8 C-f moves forward eight characters. + +>> Try using C-n or C-p with a numeric argument, to move the cursor + to a line near this one with just one command. + +Most commands use the numeric argument as a repeat count, but some +commands use it in some other way. Several commands (but none of +those you have learned so far) use it as a flag--the presence of a +prefix argument, regardless of its value, makes the command do +something different. + +C-v and M-v are another kind of exception. When given an argument, +they scroll the screen up or down by that many lines, rather than by a +screenful. For example, C-u 8 C-v scrolls the screen by 8 lines. + +>> Try typing C-u 8 C-v now. + +This should have scrolled the screen up by 8 lines. If you would like +to scroll it down again, you can give an argument to M-v. + +If you are using a windowed display, such as X11 or MS-Windows, there +should be a tall rectangular area called a scroll bar at the +side of the Emacs window. You can scroll the text by clicking the +mouse in the scroll bar. + +>> Try pressing the middle button at the top of the highlighted area + within the scroll bar. This should scroll the text to a position + determined by how high or low you click. + +>> Try moving the mouse up and down, while holding the middle button + pressed down. You'll see that the text scrolls up and down as + you move the mouse. + + +* WHEN EMACS IS HUNG +-------------------- + +If Emacs stops responding to your commands, you can stop it safely by +typing C-g. You can use C-g to stop a command which is taking too +long to execute. + +You can also use C-g to discard a numeric argument or the beginning of +a command that you do not want to finish. + +>> Type C-u 100 to make a numeric arg of 100, then type C-g. + Now type C-f. It should move just one character, + because you canceled the argument with C-g. + +If you have typed an by mistake, you can get rid of it +with a C-g. + + +* DISABLED COMMANDS +------------------- + +Some Emacs commands are "disabled" so that beginning users cannot use +them by accident. + +If you type one of the disabled commands, Emacs displays a message +saying what the command was, and asking you whether you want to go +ahead and execute the command. + +If you really want to try the command, type (the Space bar) in +answer to the question. Normally, if you do not want to execute the +disabled command, answer the question with "n". + +>> Type C-x C-l (which is a disabled command), + then type n to answer the question. + + +* WINDOWS +--------- + +Emacs can have several windows, each displaying its own text. We will +explain later on how to use multiple windows. Right now we want to +explain how to get rid of extra windows and go back to basic +one-window editing. It is simple: + + C-x 1 One window (i.e., kill all other windows). + +That is CONTROL-x followed by the digit 1. C-x 1 expands the window +which contains the cursor, to occupy the full screen. It deletes all +other windows. + +>> Move the cursor to this line and type C-u 0 C-l. +>> Type CONTROL-h k CONTROL-f. + See how this window shrinks, while a new one appears + to display documentation on the CONTROL-f command. + +>> Type C-x 1 and see the documentation listing window disappear. + +This command is unlike the other commands you have learned in that it +consists of two characters. It starts with the character CONTROL-x. +There is a whole series of commands that start with CONTROL-x; many of +them have to do with windows, files, buffers, and related things. +These commands are two, three or four characters long. + + +* INSERTING AND DELETING +------------------------ + +If you want to insert text, just type the text. Characters which you +can see, such as A, 7, *, etc. are taken by Emacs as text and inserted +immediately. Type (the carriage-return key) to insert a +Newline character. + +You can delete the last character you typed by typing . + is a key on the keyboard--the same one you normally use, +outside Emacs, for deleting the last character you typed. It is +normally a large key a couple of lines up from the key, and +it is usually labeled "Delete", "Del" or "Backspace". + +If the large key there is labeled "Backspace", then that's the one you +use for . There may also be another key labeled "Delete" +somewhere else, but that's not . + +More generally, deletes the character immediately before the +current cursor position. + +>> Do this now--type a few characters, then delete them + by typing a few times. Don't worry about this file + being changed; you will not alter the master tutorial. This is + your personal copy of it. + +When a line of text gets too big for one line on the screen, the line +of text is "continued" onto a second screen line. A backslash ("\") +(or, if you're using a windowed display, a little curved arrow) at the +right margin indicates a line which has been continued. + +>> Insert text until you reach the right margin, and keep on inserting. + You'll see a continuation line appear. + +>> Use s to delete the text until the line fits on one screen + line again. The continuation line goes away. + +You can delete a Newline character just like any other character. +Deleting the Newline character between two lines merges them into +one line. If the resulting combined line is too long to fit in the +screen width, it will be displayed with a continuation line. + +>> Move the cursor to the beginning of a line and type . This + merges that line with the previous line. + +>> Type to reinsert the Newline you deleted. + +Remember that most Emacs commands can be given a repeat count; +this includes text characters. Repeating a text character inserts +it several times. + +>> Try that now -- type C-u 8 * to insert ********. + +You've now learned the most basic way of typing something in +Emacs and correcting errors. You can delete by words or lines +as well. Here is a summary of the delete operations: + + Delete the character just before the cursor + C-d Delete the next character after the cursor + + M- Kill the word immediately before the cursor + M-d Kill the next word after the cursor + + C-k Kill from the cursor position to end of line + M-k Kill to the end of the current sentence + +Notice that and C-d vs M- and M-d extend the parallel +started by C-f and M-f (well, is not really a control +character, but let's not worry about that). C-k and M-k are like C-e +and M-e, sort of, in that lines are opposite sentences. + +You can also kill any part of the text with one uniform method. Move +to one end of that part, and type C-@ or C- (either one). ( +is the Space bar.) Move to the other end of that part, and type C-w. +That kills all the text between the two positions. + +>> Move the cursor to the Y at the start of the previous paragraph. +>> Type C-. Emacs should display a message "Mark set" + at the bottom of the screen. +>> Move the cursor to the n in "end", on the second line of the + paragraph. +>> Type C-w. This will kill the text starting from the Y, + and ending just before the n. + +The difference between "killing" and "deleting" is that "killed" text +can be reinserted, whereas "deleted" things cannot be reinserted. +Reinsertion of killed text is called "yanking". Generally, the +commands that can remove a lot of text kill the text (they set up so +that you can yank the text), while the commands that remove just one +character, or only remove blank lines and spaces, do deletion (so you +cannot yank that text). and C-d do deletion in the simplest +case, with no argument. When given an argument, they kill instead. + +>> Move the cursor to the beginning of a line which is not empty. + Then type C-k to kill the text on that line. +>> Type C-k a second time. You'll see that it kills the Newline + which follows that line. + +Note that a single C-k kills the contents of the line, and a second +C-k kills the line itself, and makes all the other lines move up. C-k +treats a numeric argument specially: it kills that many lines AND +their contents. This is not mere repetition. C-u 2 C-k kills two +lines and their newlines; typing C-k twice would not do that. + +Bringing back killed text is called "yanking". (Think of it as +yanking back, or pulling back, some text that was taken away.) You +can yank the killed text either at the same place where it was killed, +or at some other place in the text you are editing, or even in a +different file. You can yank the same text several times; that makes +multiple copies of it. + +The command for yanking is C-y. It reinserts the last killed text, +at the current cursor position. + +>> Try it; type C-y to yank the text back. + +If you do several C-k's in a row, all of the killed text is saved +together, so that one C-y will yank all of the lines at once. + +>> Do this now, type C-k several times. + +Now to retrieve that killed text: + +>> Type C-y. Then move the cursor down a few lines and type C-y + again. You now see how to copy some text. + +What do you do if you have some text you want to yank back, and then +you kill something else? C-y would yank the more recent kill. But +the previous text is not lost. You can get back to it using the M-y +command. After you have done C-y to get the most recent kill, typing +M-y replaces that yanked text with the previous kill. Typing M-y +again and again brings in earlier and earlier kills. When you have +reached the text you are looking for, you do not have to do anything to +keep it. Just go on with your editing, leaving the yanked text where +it is. + +If you M-y enough times, you come back to the starting point (the most +recent kill). + +>> Kill a line, move around, kill another line. + Then do C-y to get back the second killed line. + Then do M-y and it will be replaced by the first killed line. + Do more M-y's and see what you get. Keep doing them until + the second kill line comes back, and then a few more. + If you like, you can try giving M-y positive and negative + arguments. + + +* UNDO +------ + +If you make a change to the text, and then decide that it was a +mistake, you can undo the change with the undo command, C-x u. + +Normally, C-x u undoes the changes made by one command; if you repeat +the C-x u several times in a row, each repetition undoes one +additional command. + +But there are two exceptions: commands that do not change the text do +not count (this includes cursor motion commands and scrolling +command), and self-inserting characters are usually handled in groups +of up to 20. (This is to reduce the number of C-x u's you have to +type to undo insertion of text.) + +>> Kill this line with C-k, then type C-x u and it should reappear. + +C-_ is an alternative undo command; it works just the same as C-x u, +but it is easier to type several times in a row. The disadvantage of +C-_ is that on some keyboards it is not obvious how to type it. That +is why we provide C-x u as well. On some terminals, you can type C-_ +by typing / while holding down CONTROL. + +A numeric argument to C-_ or C-x u acts as a repeat count. + +You can undo deletion of text just as you can undo killing of text. +The distinction between killing something and deleting it affects +whether you can yank it with C-y; it makes no difference for undo. + + +* FILES +------- + +In order to make the text you edit permanent, you must put it in a +file. Otherwise, it will go away when your invocation of Emacs goes +away. In order to put your text in a file, you must "find" the file +before you enter the text. (This is also called "visiting" the file.) + +Finding a file means that you see the contents of the file within +Emacs. In many ways, it is as if you were editing the file itself. +However, the changes you make using Emacs do not become permanent +until you "save" the file. This is so you can avoid leaving a +half-changed file on the system when you do not want to. Even when +you save, Emacs leaves the original file under a changed name in case +you later decide that your changes were a mistake. + +If you look near the bottom of the screen you will see a line that +begins and ends with dashes, and starts with "--:-- TUTORIAL" or +something like that. This part of the screen normally shows the name +of the file that you are visiting. Right now, you are visiting a file +called "TUTORIAL" which is your personal scratch copy of the Emacs +tutorial. When you find a file with Emacs, that file's name will +appear in that precise spot. + +One special thing about the command for finding a file is that you +have to say what file name you want. We say the command "reads an +argument from the terminal" (in this case, the argument is the name of +the file). After you type the command + + C-x C-f Find a file + +Emacs asks you to type the file name. The file name you type appears +on the bottom line of the screen. The bottom line is called the +minibuffer when it is used for this sort of input. You can use +ordinary Emacs editing commands to edit the file name. + +While you are entering the file name (or any minibuffer input), +you can cancel the command with C-g. + +>> Type C-x C-f, then type C-g. This cancels the minibuffer, + and also cancels the C-x C-f command that was using the + minibuffer. So you do not find any file. + +When you have finished entering the file name, type to +terminate it. Then C-x C-f command goes to work, and finds the file +you chose. The minibuffer disappears when the C-x C-f command is +finished. + +In a little while the file contents appear on the screen, and you can +edit the contents. When you wish to make your changes permanent, +type the command + + C-x C-s Save the file + +This copies the text within Emacs into the file. The first time you +do this, Emacs renames the original file to a new name so that it is +not lost. The new name is made by adding "~" to the end of the +original file's name. + +When saving is finished, Emacs displays the name of the file written. +You should save fairly often, so that you will not lose very much +work if the system should crash. + +>> Type C-x C-s, saving your copy of the tutorial. + This should show "Wrote ...TUTORIAL" at the bottom of the screen. + +NOTE: On some systems, typing C-x C-s will freeze the screen and you +will see no further output from Emacs. This indicates that an +operating system "feature" called "flow control" is intercepting the +C-s and not letting it get through to Emacs. To unfreeze the screen, +type C-q. Then see the section "Spontaneous Entry to Incremental +Search" in the Emacs manual for advice on dealing with this "feature". + +You can find an existing file, to view it or edit it. You can also +find a file which does not already exist. This is the way to create a +file with Emacs: find the file, which will start out empty, and then +begin inserting the text for the file. When you ask to "save" the +file, Emacs will really create the file with the text that you have +inserted. From then on, you can consider yourself to be editing an +already existing file. + + +* BUFFERS +--------- + +If you find a second file with C-x C-f, the first file remains +inside Emacs. You can switch back to it by finding it again with +C-x C-f. This way you can get quite a number of files inside Emacs. + +>> Create a file named "foo" by typing C-x C-f foo . + Then insert some text, edit it, and save "foo" by typing C-x C-s. + Finally, type C-x C-f TUTORIAL + to come back to the tutorial. + +Emacs stores each file's text inside an object called a "buffer". +Finding a file makes a new buffer inside Emacs. To see a list of the +buffers that currently exist in your Emacs job, type + + C-x C-b List buffers + +>> Try C-x C-b now. + +See how each buffer has a name, and it may also have a file name for +the file whose contents it holds. ANY text you see in an Emacs window +is always part of some buffer. + +>> Type C-x 1 to get rid of the buffer list. + +When you have several buffers, only one of them is "current" at any +time. That buffer is the one you edit. If you want to edit another +buffer, you need to "switch" to it. If you want to switch to a buffer +that corresponds to a file, you can do it by visiting the file again +with C-x C-f. But there is an easier way: use the C-x b command. +In that command, you have to type the buffer's name. + +>> Type C-x b foo to go back to the buffer "foo" which holds + the text of the file "foo". Then type C-x b TUTORIAL + to come back to this tutorial. + +Most of the time, the buffer's name is the same as the file name +(without the file directory part). However, this is not always true. +The buffer list you make with C-x C-b always shows you the name of +every buffer. + +ANY text you see in an Emacs window is always part of some buffer. +Some buffers do not correspond to files. For example, the buffer +named "*Buffer List*" does not have any file. It is the buffer which +contains the buffer list that you made with C-x C-b. The buffer named +"*Messages*" also does not correspond to any file; it contains the +messages that have appeared on the bottom line during your Emacs +session. + +my text foo + +>> Type C-x b *Messages* to look at the buffer of messages. + Then type C-x b TUTORIAL to come back to this tutorial. + +If you make changes to the text of one file, then find another file, +this does not save the first file. Its changes remain inside Emacs, +in that file's buffer. The creation or editing of the second file's +buffer has no effect on the first file's buffer. This is very useful, +but it also means that you need a convenient way to save the first +file's buffer. It would be a nuisance to have to switch back to +it with C-x C-f in order to save it with C-x C-s. So we have + + C-x s Save some buffers + +C-x s asks you about each buffer which contains changes that you have +not saved. It asks you, for each such buffer, whether to save the +buffer. + +>> Insert a line of text, then type C-x s. + It should ask you whether to save the buffer named TUTORIAL. + Answer yes to the question by typing "y". + + +* EXTENDING THE COMMAND SET +--------------------------- + +There are many, many more Emacs commands than could possibly be put +on all the control and meta characters. Emacs gets around this with +the X (eXtend) command. This comes in two flavors: + + C-x Character eXtend. Followed by one character. + M-x Named command eXtend. Followed by a long name. + +These are commands that are generally useful but used less than the +commands you have already learned about. You have already seen a few +of them: the file commands C-x C-f to Find and C-x C-s to Save, for +example. Another example is the command to end the Emacs +session--this is the command C-x C-c. (Do not worry about losing +changes you have made; C-x C-c offers to save each changed file before +it kills the Emacs.) + +If you are using a graphical display that supports multiple +applications in parallel, you don't need any special command to move +from Emacs to another application. You can do this with the mouse or +with window manager commands. However, if you're using a text +terminal which can only show one application at a time, you need to +"suspend" Emacs to move to any other program. + +C-z is the command to exit Emacs *temporarily*--so that you can go +back to the same Emacs session afterward. When Emacs is running on a +text terminal, C-z "suspends" Emacs; that is, it returns to the shell +but does not destroy the Emacs. In the most common shells, you can +resume Emacs with the `fg' command or with `%emacs'. + +The time to use C-x C-c is when you are about to log out. It's also +the right thing to use to exit an Emacs invoked under mail handling +programs and other miscellaneous utilities, since they may not know +how to cope with suspension of Emacs. In ordinary circumstances, +though, if you are not about to log out, it is better to suspend Emacs +with C-z instead of exiting Emacs. + +There are many C-x commands. Here is a list of the ones you have learned: + + C-x C-f Find file + C-x C-s Save file + C-x s Save some buffers + C-x C-b List buffers + C-x b Switch buffer + C-x C-c Quit Emacs + C-x 1 Delete all but one window + C-x u Undo + +Named eXtended commands are commands which are used even less +frequently, or commands which are used only in certain modes. An +example is the command replace-string, which globally replaces one +string with another. When you type M-x, Emacs prompts you at the +bottom of the screen with M-x and you should type the name of the +command; in this case, "replace-string". Just type "repl s" and +Emacs will complete the name. ( is the Tab key, usually found +above the CapsLock or Shift key near the left edge of the keyboard.) +End the command name with . + +The replace-string command requires two arguments--the string to be +replaced, and the string to replace it with. You must end each +argument with . + +>> Move the cursor to the blank line two lines below this one. + Then type M-x repl schangedaltered. + + Notice how this line has altered: you've replaced + the word c-h-a-n-g-e-d with "altered" wherever it occurred, + after the initial position of the cursor. + + +* AUTO SAVE +----------- + +When you have made changes in a file, but you have not saved them yet, +they could be lost if your computer crashes. To protect you from +this, Emacs periodically writes an "auto save" file for each file that +you are editing. The auto save file name has a # at the beginning and +the end; for example, if your file is named "hello.c", its auto save +file's name is "#hello.c#". When you save the file in the normal way, +Emacs deletes its auto save file. + +If the computer crashes, you can recover your auto-saved editing by +finding the file normally (the file you were editing, not the auto +save file) and then typing M-x recover file. When it asks for +confirmation, type yes to go ahead and recover the auto-save +data. + + +* ECHO AREA +----------- + +If Emacs sees that you are typing multicharacter commands slowly, it +shows them to you at the bottom of the screen in an area called the +"echo area". The echo area contains the bottom line of the screen. + + +* MODE LINE +----------- + +The line immediately above the echo area is called the "mode line". +The mode line says something like this: + +--:** TUTORIAL 63% L749 (Fundamental)----------------------- + +This line gives useful information about the status of Emacs and +the text you are editing. + +You already know what the filename means--it is the file you have +found. NN% indicates your current position in the text; it means that +NN percent of the text is above the top of the screen. If the top of +the file is on the screen, it will say "Top" instead of " 0%". If the +bottom of the text is on the screen, it will say "Bot". If you are +looking at text so small that all of it fits on the screen, the mode +line says "All". + +The L and digits indicate position in another way: they give the +current line number of point. + +The stars near the front mean that you have made changes to the text. +Right after you visit or save a file, that part of the mode line shows +no stars, just dashes. + +The part of the mode line inside the parentheses is to tell you what +editing modes you are in. The default mode is Fundamental which is +what you are using now. It is an example of a "major mode". + +Emacs has many different major modes. Some of them are meant for +editing different languages and/or kinds of text, such as Lisp mode, +Text mode, etc. At any time one and only one major mode is active, +and its name can always be found in the mode line just where +"Fundamental" is now. + +Each major mode makes a few commands behave differently. For example, +there are commands for creating comments in a program, and since each +programming language has a different idea of what a comment should +look like, each major mode has to insert comments differently. Each +major mode is the name of an extended command, which is how you can +switch to that mode. For example, M-x fundamental-mode is a command to +switch to Fundamental mode. + +If you are going to be editing human-language text, such as this file, you +should probably use Text Mode. + +>> Type M-x text mode. + +Don't worry, none of the Emacs commands you have learned changes in +any great way. But you can observe that M-f and M-b now treat +apostrophes as part of words. Previously, in Fundamental mode, +M-f and M-b treated apostrophes as word-separators. + +Major modes usually make subtle changes like that one: most commands +do "the same job" in each major mode, but they work a little bit +differently. + +To view documentation on your current major mode, type C-h m. + +>> Use C-u C-v once or more to bring this line near the top of screen. +>> Type C-h m, to see how Text mode differs from Fundamental mode. +>> Type C-x 1 to remove the documentation from the screen. + +Major modes are called major because there are also minor modes. +Minor modes are not alternatives to the major modes, just minor +modifications of them. Each minor mode can be turned on or off by +itself, independent of all other minor modes, and independent of your +major mode. So you can use no minor modes, or one minor mode, or any +combination of several minor modes. + +One minor mode which is very useful, especially for editing +human-language text, is Auto Fill mode. When this mode is on, Emacs +breaks the line in between words automatically whenever you insert +text and make a line that is too wide. + +You can turn Auto Fill mode on by doing M-x auto fill mode. +When the mode is on, you can turn it off again by doing M-x +auto fill mode. If the mode is off, this command turns it on, +and if the mode is on, this command turns it off. We say that the +command "toggles the mode". + +>> Type M-x auto fill mode now. Then insert a line of "asdf " + over again until you see it divide into two lines. You must put in + spaces between them because Auto Fill breaks lines only at spaces. + +The margin is usually set at 70 characters, but you can change it +with the C-x f command. You should give the margin setting you want +as a numeric argument. + +>> Type C-x f with an argument of 20. (C-u 2 0 C-x f). + Then type in some text and see Emacs fill lines of 20 + characters with it. Then set the margin back to 70 using + C-x f again. + +If you make changes in the middle of a paragraph, Auto Fill mode +does not re-fill it for you. +To re-fill the paragraph, type M-q (META-q) with the cursor inside +that paragraph. + +>> Move the cursor into the previous paragraph and type M-q. + + +* SEARCHING +----------- + +Emacs can do searches for strings (these are groups of contiguous +characters or words) either forward through the text or backward +through it. Searching for a string is a cursor motion command; +it moves the cursor to the next place where that string appears. + +The Emacs search command is different from the search commands +of most editors, in that it is "incremental". This means that the +search happens while you type in the string to search for. + +The command to initiate a search is C-s for forward search, and C-r +for reverse search. BUT WAIT! Don't try them now. + +When you type C-s you'll notice that the string "I-search" appears as +a prompt in the echo area. This tells you that Emacs is in what is +called an incremental search waiting for you to type the thing that +you want to search for. terminates a search. + +>> Now type C-s to start a search. SLOWLY, one letter at a time, + type the word 'cursor', pausing after you type each + character to notice what happens to the cursor. + Now you have searched for "cursor", once. +>> Type C-s again, to search for the next occurrence of "cursor". +>> Now type four times and see how the cursor moves. +>> Type to terminate the search. + +Did you see what happened? Emacs, in an incremental search, tries to +go to the occurrence of the string that you've typed out so far. To +go to the next occurrence of 'cursor' just type C-s again. If no such +occurrence exists, Emacs beeps and tells you the search is currently +"failing". C-g would also terminate the search. + +NOTE: On some systems, typing C-s will freeze the screen and you will +see no further output from Emacs. This indicates that an operating +system "feature" called "flow control" is intercepting the C-s and not +letting it get through to Emacs. To unfreeze the screen, type C-q. +Then see the section "Spontaneous Entry to Incremental Search" in the +Emacs manual for advice on dealing with this "feature". + +If you are in the middle of an incremental search and type , +you'll notice that the last character in the search string is erased +and the search backs up to the last place of the search. For +instance, suppose you have typed "c", to search for the first +occurrence of "c". Now if you type "u", the cursor will move +to the first occurrence of "cu". Now type . This erases +the "u" from the search string, and the cursor moves back to +the first occurrence of "c". + +If you are in the middle of a search and type a control or meta +character (with a few exceptions--characters that are special in +a search, such as C-s and C-r), the search is terminated. + +The C-s starts a search that looks for any occurrence of the search +string AFTER the current cursor position. If you want to search for +something earlier in the text, type C-r instead. Everything that we +have said about C-s also applies to C-r, except that the direction of +the search is reversed. + + +* MULTIPLE WINDOWS +------------------ + +One of the nice features of Emacs is that you can display more than one +window on the screen at the same time. + +>> Move the cursor to this line and type C-u 0 C-l (that's CONTROL-L, not + CONTROL-1). + +>> Now type C-x 2 which splits the screen into two windows. + Both windows display this tutorial. The cursor stays in the top window. + +>> Type C-M-v to scroll the bottom window. + (If you do not have a real META key, type C-v.) + +>> Type C-x o ("o" for "other") to move the cursor to the bottom window. +>> Use C-v and M-v in the bottom window to scroll it. + Keep reading these directions in the top window. + +>> Type C-x o again to move the cursor back to the top window. + The cursor in the top window is just where it was before. + +You can keep using C-x o to switch between the windows. Each +window has its own cursor position, but only one window actually +shows the cursor. All the ordinary editing commands apply to the +window that the cursor is in. We call this the "selected window". + +The command C-M-v is very useful when you are editing text in one +window and using the other window just for reference. You can keep +the cursor always in the window where you are editing, and advance +through the other window sequentially with C-M-v. + +C-M-v is an example of a CONTROL-META character. If you have a real +META key, you can type C-M-v by holding down both CONTROL and META while +typing v. It does not matter whether CONTROL or META "comes first," +because both of these keys act by modifying the characters you type. + +If you do not have a real META key, and you use instead, the +order does matter: you must type followed by CONTROL-v, because +CONTROL- v will not work. This is because is a character +in its own right, not a modifier key. + +>> Type C-x 1 (in the top window) to get rid of the bottom window. + +(If you had typed C-x 1 in the bottom window, that would get rid +of the top one. Think of this command as "Keep just one +window--the window I am already in.") + +You do not have to display the same buffer in both windows. If you +use C-x C-f to find a file in one window, the other window does not +change. You can find a file in each window independently. + +Here is another way to use two windows to display two different +things: + +>> Type C-x 4 C-f followed by the name of one of your files. + End with . See the specified file appear in the bottom + window. The cursor goes there, too. + +>> Type C-x o to go back to the top window, and C-x 1 to delete + the bottom window. + + +* RECURSIVE EDITING LEVELS +-------------------------- + +Sometimes you will get into what is called a "recursive editing +level". This is indicated by square brackets in the mode line, +surrounding the parentheses around the major mode name. For +example, you might see [(Fundamental)] instead of (Fundamental). + +To get out of the recursive editing level, type . +That is an all-purpose "get out" command. You can also use it for +eliminating extra windows, and getting out of the minibuffer. + +>> Type M-x to get into a minibuffer; then type to + get out. + +You cannot use C-g to get out of a recursive editing level. This is +because C-g is used for canceling commands and arguments WITHIN the +recursive editing level. + + +* GETTING MORE HELP +------------------- + +In this tutorial we have tried to supply just enough information to +get you started using Emacs. There is so much available in Emacs that +it would be impossible to explain it all here. However, you may want +to learn more about Emacs since it has many other useful features. +Emacs provides commands for reading documentation about Emacs +commands. These "help" commands all start with the character +CONTROL-h, which is called "the Help character". + +To use the Help features, type the C-h character, and then a +character saying what kind of help you want. If you are REALLY lost, +type C-h ? and Emacs will tell you what kinds of help it can give. +If you have typed C-h and decide you do not want any help, just +type C-g to cancel it. + +(Some sites change the meaning of the character C-h. They really +should not do this as a blanket measure for all users, so you have +grounds to complain to the system administrator. Meanwhile, if C-h +does not display a message about help at the bottom of the screen, try +typing the F1 key or M-x help instead.) + +The most basic HELP feature is C-h c. Type C-h, the character c, and +a command character or sequence; then Emacs displays a very brief +description of the command. + +>> Type C-h c C-p. + +The message should be something like this: + + C-p runs the command previous-line + +This tells you the "name of the function". Function names are used +mainly for customizing and extending Emacs. But since function names +are chosen to indicate what the command does, they can serve also as +very brief documentation--sufficient to remind you of commands you +have already learned. + +Multi-character commands such as C-x C-s and (if you have no META or +EDIT or ALT key) v are also allowed after C-h c. + +To get more information about a command, use C-h k instead of C-h c. + +>> Type C-h k C-p. + +This displays the documentation of the function, as well as its +name, in an Emacs window. When you are finished reading the +output, type C-x 1 to get rid of the help text. You do not have +to do this right away. You can do some editing while referring +to the help text, and then type C-x 1. + +Here are some other useful C-h options: + + C-h f Describe a function. You type in the name of the + function. + +>> Try typing C-h f previous-line. + This displays all the information Emacs has about the + function which implements the C-p command. + +A similar command C-h v displays the documentation of variables whose +values you can set to customize Emacs behavior. You need to type in +the name of the variable when Emacs prompts for it. + + C-h a Command Apropos. Type in a keyword and Emacs will list + all the commands whose names contain that keyword. + These commands can all be invoked with META-x. + For some commands, Command Apropos will also list a one + or two character sequence which runs the same command. + +>> Type C-h a file. + +This displays in another window a list of all M-x commands with "file" +in their names. You will see character-commands like C-x C-f listed +beside the corresponding command names such as find-file. + +>> Type C-M-v to scroll the help window. Do this a few times. + +>> Type C-x 1 to delete the help window. + + C-h i Read On-line Manuals (a.k.a. Info). This command puts + you into a special buffer called `*info*' where you + can read on-line manuals for the packages installed on + your system. Type m emacs to read the Emacs + manual. If you have never before used Info, type ? + and Emacs will take you on a guided tour of Info mode + facilities. Once you are through with this tutorial, + you should consult the Emacs Info manual as your + primary documentation. + + +* MORE FEATURES +--------------- + +You can learn more about Emacs by reading its manual, either as a book +or on-line in Info (use the Help menu or type F10 h r). Two features +that you may like especially are completion, which saves typing, and +dired, which simplifies file handling. + +Completion is a way to avoid unnecessary typing. For instance, if you +want to switch to the *Messages* buffer, you can type C-x b *M +and Emacs will fill in the rest of the buffer name as far as it can +determine from what you have already typed. Completion is described +in Info in the Emacs manual in the node called "Completion". + +Dired enables you to list files in a directory (and optionally its +subdirectories), move around that list, visit, rename, delete and +otherwise operate on the files. Dired is described in Info in the +Emacs manual in the node called "Dired". + +The manual also describes many other Emacs features. + + +* CONCLUSION +------------ + +Remember, to exit Emacs permanently use C-x C-c. To exit to a shell +temporarily, so that you can come back to Emacs afterward, use C-z. + +This tutorial is meant to be understandable to all new users, so if +you found something unclear, don't sit and blame yourself - complain! + + +* COPYING +--------- + +This tutorial descends from a long line of Emacs tutorials +starting with the one written by Stuart Cracraft for the original Emacs. + +This version of the tutorial is a part of GNU Emacs. It is copyrighted +and comes with permission to distribute copies on certain conditions: + + Copyright (C) 1985, 1996, 1998, 2001, 2002, 2003, 2004, + 2005, 2006, 2007 Free Software Foundation, Inc. + + This file is part of GNU Emacs. + + GNU Emacs is free software; you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation; either version 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, Inc., 51 Franklin Street, Fifth Floor, + Boston, MA 02110-1301, USA. + +Please read the file COPYING and then do give copies of GNU Emacs to +your friends. Help stamp out software obstructionism ("ownership") by +using, writing, and sharing free software! + +;;; arch-tag: a0f84628-777f-4238-8865-451a73167f55 diff --git a/emacs.d/ansi-color.el b/emacs.d/ansi-color.el new file mode 100644 index 0000000..c3d06b2 --- /dev/null +++ b/emacs.d/ansi-color.el @@ -0,0 +1,639 @@ +;;; ansi-color.el --- translate ANSI escape sequences into faces + +;; Copyright (C) 1999, 2000, 2001, 2002 Free Software Foundation, Inc. + +;; Author: Alex Schroeder +;; Maintainer: Alex Schroeder +;; Version: 3.4.5 +;; Keywords: comm processes terminals services +;; URL: http://www.emacswiki.org/cgi-bin/wiki.pl?AnsiColor + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software; you can redistribute it and/or modify it +;; under the terms of the GNU General Public License as published by the +;; Free Software Foundation; either version 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, Inc., 59 Temple Place - Suite 330, +;; Boston, MA 02111-1307, USA. + +;;; Commentary: + +;; This file provides a function that takes a string or a region +;; containing Select Graphic Rendition (SGR) control sequences (formerly +;; known as ANSI escape sequences) and tries to translate these into +;; faces. +;; +;; This allows you to run ls --color=yes in shell-mode. In order to +;; test this, proceed as follows: +;; +;; 1. start a shell: M-x shell +;; 2. load this file: M-x load-library RET ansi-color RET +;; 3. activate ansi-color: M-x ansi-color-for-comint-mode-on +;; 4. test ls --color=yes in the *shell* buffer +;; +;; Note that starting your shell from within Emacs might set the TERM +;; environment variable. The new setting might disable the output of +;; SGR control sequences. Using ls --color=yes forces ls to produce +;; these. +;; +;; If you decide you like this, add the following to your .emacs file: +;; +;; (autoload 'ansi-color-for-comint-mode-on "ansi-color" nil t) +;; (add-hook 'shell-mode-hook 'ansi-color-for-comint-mode-on) +;; +;; SGR control sequences are defined in section 3.8.117 of the ECMA-48 +;; standard (identical to ISO/IEC 6429), which is freely available as a +;; PDF file . The +;; "Graphic Rendition Combination Mode (GRCM)" implemented is +;; "cumulative mode" as defined in section 7.2.8. Cumulative mode means +;; that whenever possible, SGR control sequences are combined (ie. blue +;; and bold). + +;; The basic functions are: +;; +;; `ansi-color-apply' to colorize a string containing SGR control +;; sequences. +;; +;; `ansi-color-filter-apply' to filter SGR control sequences from a +;; string. +;; +;; `ansi-color-apply-on-region' to colorize a region containing SGR +;; control sequences. +;; +;; `ansi-color-filter-region' to filter SGR control sequences from a +;; region. + +;;; Bugs + +;; Doesn't seem to work with older Emacs versions such as 20.2. + +;;; Thanks + +;; Georges Brun-Cottan for improving ansi-color.el +;; substantially by adding the code needed to cope with arbitrary chunks +;; of output and the filter functions. +;; +;; Markus Kuhn for pointing me to ECMA-48. +;; +;; Stefan Monnier explaing obscure font-lock stuff and +;; code suggestions. + + + +;;; Code: + +;; Customization + +(defgroup ansi-colors nil + "Translating SGR control sequences to faces. +This translation effectively colorizes strings and regions based upon +SGR control sequences embedded in the text. SGR (Select Graphic +Rendition) control sequences are defined in section 3.8.117 of the +ECMA-48 standard \(identical to ISO/IEC 6429), which is freely available +as a PDF file ." + :version "21.1" + :group 'processes) + +(defcustom ansi-color-faces-vector + [default bold default italic underline bold bold-italic modeline] + "Faces used for SGR control sequences determining a face. +This vector holds the faces used for SGR control sequence parameters 0 +to 7. + +Parameter Description Face used by default + 0 default default + 1 bold bold + 2 faint default + 3 italic italic + 4 underlined underline + 5 slowly blinking bold + 6 rapidly blinking bold-italic + 7 negative image modeline + +Note that the symbol `default' is special: It will not be combined +with the current face. + +This vector is used by `ansi-color-make-color-map' to create a color +map. This color map is stored in the variable `ansi-color-map'." + :type '(vector face face face face face face face face) + :set 'ansi-color-map-update + :initialize 'custom-initialize-default + :group 'ansi-colors) + +(defcustom ansi-color-names-vector + ["black" "red" "green" "yellow" "blue" "magenta" "cyan" "white"] + "Colors used for SGR control sequences determining a color. +This vector holds the colors used for SGR control sequences parameters +30 to 37 \(foreground colors) and 40 to 47 (background colors). + +Parameter Color + 30 40 black + 31 41 red + 32 42 green + 33 43 yellow + 34 44 blue + 35 45 magenta + 36 46 cyan + 37 47 white + +This vector is used by `ansi-color-make-color-map' to create a color +map. This color map is stored in the variable `ansi-color-map'." + :type '(vector string string string string string string string string) + :set 'ansi-color-map-update + :initialize 'custom-initialize-default + :group 'ansi-colors) + +(defconst ansi-color-regexp "\033\\[\\([0-9;]*\\)m" + "Regexp that matches SGR control sequences.") + +(defconst ansi-color-parameter-regexp "\\([0-9]*\\)[m;]" + "Regexp that matches SGR control sequence parameters.") + + +;; Convenience functions for comint modes (eg. shell-mode) + + +(defcustom ansi-color-for-comint-mode nil + "Determines what to do with comint output. +If nil, do nothing. +If the symbol `filter', then filter all SGR control sequences. +If anything else (such as t), then translate SGR control sequences +into text-properties. + +In order for this to have any effect, `ansi-color-process-output' must +be in `comint-output-filter-functions'. + +This can be used to enable colorized ls --color=yes output +in shell buffers. You set this variable by calling one of: +\\[ansi-color-for-comint-mode-on] +\\[ansi-color-for-comint-mode-off] +\\[ansi-color-for-comint-mode-filter]" + :type '(choice (const :tag "Do nothing" nil) + (const :tag "Filter" filter) + (const :tag "Translate" t)) + :group 'ansi-colors) + +;;;###autoload +(defun ansi-color-for-comint-mode-on () + "Set `ansi-color-for-comint-mode' to t." + (interactive) + (setq ansi-color-for-comint-mode t)) + +(defun ansi-color-for-comint-mode-off () + "Set `ansi-color-for-comint-mode' to nil." + (interactive) + (setq ansi-color-for-comint-mode nil)) + +(defun ansi-color-for-comint-mode-filter () + "Set `ansi-color-for-comint-mode' to symbol `filter'." + (interactive) + (setq ansi-color-for-comint-mode 'filter)) + +;;;###autoload +(defun ansi-color-process-output (string) + "Maybe translate SGR control sequences of comint output into text-properties. + +Depending on variable `ansi-color-for-comint-mode' the comint output is +either not processed, SGR control sequences are filtered using +`ansi-color-filter-region', or SGR control sequences are translated into +text-properties using `ansi-color-apply-on-region'. + +The comint output is assumed to lie between the marker +`comint-last-output-start' and the process-mark. + +This is a good function to put in `comint-output-filter-functions'." + (let ((start-marker (or comint-last-output-start + (point-min-marker))) + (end-marker (process-mark (get-buffer-process (current-buffer))))) + (cond ((eq ansi-color-for-comint-mode nil)) + ((eq ansi-color-for-comint-mode 'filter) + (ansi-color-filter-region start-marker end-marker)) + (t + (ansi-color-apply-on-region start-marker end-marker))))) + +(add-hook 'comint-output-filter-functions + 'ansi-color-process-output) + + +;; Alternative font-lock-unfontify-region-function for Emacs only + + +(eval-when-compile + ;; We use this to preserve or protect things when modifying text + ;; properties. Stolen from lazy-lock and font-lock. Ugly!!! + ;; Probably most of this is not needed? + (defmacro save-buffer-state (varlist &rest body) + "Bind variables according to VARLIST and eval BODY restoring buffer state." + (` (let* ((,@ (append varlist + '((modified (buffer-modified-p)) (buffer-undo-list t) + (inhibit-read-only t) (inhibit-point-motion-hooks t) + before-change-functions after-change-functions + deactivate-mark buffer-file-name buffer-file-truename)))) + (,@ body) + (when (and (not modified) (buffer-modified-p)) + (set-buffer-modified-p nil))))) + (put 'save-buffer-state 'lisp-indent-function 1)) + +(defun ansi-color-unfontify-region (beg end &rest xemacs-stuff) + "Replacement function for `font-lock-default-unfontify-region'. + +As text-properties are implemented using extents in XEmacs, this +function is probably not needed. In Emacs, however, things are a bit +different: When font-lock is active in a buffer, you cannot simply add +face text-properties to the buffer. Font-lock will remove the face +text-property using `font-lock-unfontify-region-function'. If you want +to insert the strings returned by `ansi-color-apply' into such buffers, +you must set `font-lock-unfontify-region-function' to +`ansi-color-unfontify-region'. This function will not remove all face +text-properties unconditionally. It will keep the face text-properties +if the property `ansi-color' is set. + +The region from BEG to END is unfontified. XEMACS-STUFF is ignored. + +A possible way to install this would be: + +\(add-hook 'font-lock-mode-hook + \(function (lambda () + \(setq font-lock-unfontify-region-function + 'ansi-color-unfontify-region))))" + ;; save-buffer-state is a macro in font-lock.el! + (save-buffer-state nil + (when (boundp 'font-lock-syntactic-keywords) + (remove-text-properties beg end '(syntax-table nil))) + ;; instead of just using (remove-text-properties beg end '(face + ;; nil)), we find regions with a non-nil face test-property, skip + ;; positions with the ansi-color property set, and remove the + ;; remaining face test-properties. + (while (setq beg (text-property-not-all beg end 'face nil)) + (setq beg (or (text-property-not-all beg end 'ansi-color t) end)) + (when (get-text-property beg 'face) + (let ((end-face (or (text-property-any beg end 'face nil) + end))) + (remove-text-properties beg end-face '(face nil)) + (setq beg end-face)))))) + +;; Working with strings + +(defvar ansi-color-context nil + "Context saved between two calls to `ansi-color-apply'. +This is a list of the form (FACES FRAGMENT) or nil. FACES is a list of +faces the last call to `ansi-color-apply' ended with, and FRAGMENT is a +string starting with an escape sequence, possibly the start of a new +escape sequence.") +(make-variable-buffer-local 'ansi-color-context) + +(defun ansi-color-filter-apply (string) + "Filter out all SGR control sequences from STRING. + +Every call to this function will set and use the buffer-local variable +`ansi-color-context' to save partial escape sequences. This information +will be used for the next call to `ansi-color-apply'. Set +`ansi-color-context' to nil if you don't want this. + +This function can be added to `comint-preoutput-filter-functions'." + (let ((start 0) end result) + ;; if context was saved and is a string, prepend it + (if (cadr ansi-color-context) + (setq string (concat (cadr ansi-color-context) string) + ansi-color-context nil)) + ;; find the next escape sequence + (while (setq end (string-match ansi-color-regexp string start)) + (setq result (concat result (substring string start end)) + start (match-end 0))) + ;; save context, add the remainder of the string to the result + (let (fragment) + (if (string-match "\033" string start) + (let ((pos (match-beginning 0))) + (setq fragment (substring string pos) + result (concat result (substring string start pos)))) + (setq result (concat result (substring string start)))) + (if fragment + (setq ansi-color-context (list nil fragment)) + (setq ansi-color-context nil))) + result)) + +(defun ansi-color-apply (string) + "Translates SGR control sequences into text-properties. + +Applies SGR control sequences setting foreground and background colors +to STRING using text-properties and returns the result. The colors used +are given in `ansi-color-faces-vector' and `ansi-color-names-vector'. +See function `ansi-color-apply-sequence' for details. + +Every call to this function will set and use the buffer-local variable +`ansi-color-context' to save partial escape sequences and current face. +This information will be used for the next call to `ansi-color-apply'. +Set `ansi-color-context' to nil if you don't want this. + +This function can be added to `comint-preoutput-filter-functions'. + +You cannot insert the strings returned into buffers using font-lock. +See `ansi-color-unfontify-region' for a way around this." + (let ((face (car ansi-color-context)) + (start 0) end escape-sequence result) + ;; if context was saved and is a string, prepend it + (if (cadr ansi-color-context) + (setq string (concat (cadr ansi-color-context) string) + ansi-color-context nil)) + ;; find the next escape sequence + (while (setq end (string-match ansi-color-regexp string start)) + ;; store escape sequence + (setq escape-sequence (match-string 1 string)) + ;; colorize the old block from start to end using old face + (when face + (put-text-property start end 'ansi-color t string) + (put-text-property start end 'face face string)) + (setq result (concat result (substring string start end)) + start (match-end 0)) + ;; create new face by applying all the parameters in the escape + ;; sequence + (setq face (ansi-color-apply-sequence escape-sequence face ansi-color-context))) + ;; if the rest of the string should have a face, put it there + (when face + (put-text-property start (length string) 'ansi-color t string) + (put-text-property start (length string) 'face face string)) + ;; save context, add the remainder of the string to the result + (let (fragment) + (if (string-match "\033" string start) + (let ((pos (match-beginning 0))) + (setq fragment (substring string pos) + result (concat result (substring string start pos)))) + (setq result (concat result (substring string start)))) + (if (or face fragment) + (setq ansi-color-context (list face fragment)) + (setq ansi-color-context nil))) + result)) + +;; Working with regions + +(defvar ansi-color-context-region nil + "Context saved between two calls to `ansi-color-apply-on-region'. +This is a list of the form (FACES MARKER) or nil. FACES is a list of +faces the last call to `ansi-color-apply-on-region' ended with, and +MARKER is a buffer position within an escape sequence or the last +position processed.") +(make-variable-buffer-local 'ansi-color-context-region) + +(defun ansi-color-filter-region (begin end) + "Filter out all SGR control sequences from region BEGIN to END. + +Every call to this function will set and use the buffer-local variable +`ansi-color-context-region' to save position. This information will be +used for the next call to `ansi-color-apply-on-region'. Specifically, +it will override BEGIN, the start of the region. Set +`ansi-color-context-region' to nil if you don't want this." + (let ((end-marker (copy-marker end)) + (start (or (cadr ansi-color-context-region) begin))) + (save-excursion + (goto-char start) + ;; find the next escape sequence + (while (re-search-forward ansi-color-regexp end-marker t) + ;; delete the escape sequence + (replace-match "")) + ;; save context, add the remainder of the string to the result + (if (re-search-forward "\033" end-marker t) + (setq ansi-color-context-region (list nil (match-beginning 0))) + (setq ansi-color-context-region nil))))) + +(defun ansi-color-apply-on-region (begin end) + "Translates SGR control sequences into overlays or extents. + +Applies SGR control sequences setting foreground and background colors +to text in region between BEGIN and END using extents or overlays. +Emacs will use overlays, XEmacs will use extents. The colors used are +given in `ansi-color-faces-vector' and `ansi-color-names-vector'. See +function `ansi-color-apply-sequence' for details. + +Every call to this function will set and use the buffer-local variable +`ansi-color-context-region' to save position and current face. This +information will be used for the next call to +`ansi-color-apply-on-region'. Specifically, it will override BEGIN, the +start of the region and set the face with which to start. Set +`ansi-color-context-region' to nil if you don't want this." + (let ((face (car ansi-color-context-region)) + (start-marker (or (cadr ansi-color-context-region) + (copy-marker begin))) + (end-marker (copy-marker end)) + escape-sequence) + (save-excursion + (goto-char start-marker) + ;; find the next escape sequence + (while (re-search-forward ansi-color-regexp end-marker t) + ;; colorize the old block from start to end using old face + (when face + (ansi-color-set-extent-face + (ansi-color-make-extent start-marker (match-beginning 0)) + face)) + ;; store escape sequence and new start position + (setq escape-sequence (match-string 1) + start-marker (copy-marker (match-end 0))) + ;; delete the escape sequence + (replace-match "") + ;; create new face by applying all the parameters in the escape + ;; sequence + (setq face (ansi-color-apply-sequence escape-sequence face ansi-color-context-region))) + ;; search for the possible start of a new escape sequence + (if (re-search-forward "\033" end-marker t) + (progn + ;; if the rest of the region should have a face, put it there + (when face + (ansi-color-set-extent-face + (ansi-color-make-extent start-marker (point)) + face)) + ;; save face and point + (setq ansi-color-context-region + (list face (copy-marker (match-beginning 0))))) + ;; if the rest of the region should have a face, put it there + (if face + (progn + (ansi-color-set-extent-face + (ansi-color-make-extent start-marker end-marker) + face) + (setq ansi-color-context-region (list face))) + ;; reset context + (setq ansi-color-context-region nil)))))) + +;; This function helps you look for overlapping overlays. This is +;; usefull in comint-buffers. Overlapping overlays should not happen! +;; A possible cause for bugs are the markers. If you create an overlay +;; up to the end of the region, then that end might coincide with the +;; process-mark. As text is added BEFORE the process-mark, the overlay +;; will keep growing. Therefore, as more overlays are created later on, +;; there will be TWO OR MORE overlays covering the buffer at that point. +;; This function helps you check your buffer for these situations. +; (defun ansi-color-debug-overlays () +; (interactive) +; (let ((pos (point-min))) +; (while (< pos (point-max)) +; (if (<= 2 (length (overlays-at pos))) +; (progn +; (goto-char pos) +; (error "%d overlays at %d" (length (overlays-at pos)) pos)) +; (let (message-log-max) +; (message "Reached %d." pos))) +; (setq pos (next-overlay-change pos))))) + +;; Emacs/XEmacs compatibility layer + +(defun ansi-color-make-face (property color) + "Return a face with PROPERTY set to COLOR. +PROPERTY can be either symbol `foreground' or symbol `background'. + +For Emacs, we just return the cons cell \(PROPERTY . COLOR). +For XEmacs, we create a temporary face and return it." + (if (featurep 'xemacs) + (let ((face (make-face (intern (concat color "-" (symbol-name property))) + "Temporary face created by ansi-color." + t))) + (set-face-property face property color) + face) + (cond ((eq property 'foreground) + (cons 'foreground-color color)) + ((eq property 'background) + (cons 'background-color color)) + (t + (cons property color))))) + +(defun ansi-color-make-extent (from to &optional object) + "Make an extent for the range [FROM, TO) in OBJECT. + +OBJECT defaults to the current buffer. XEmacs uses `make-extent', Emacs +uses `make-overlay'. XEmacs can use a buffer or a string for OBJECT, +Emacs requires OBJECT to be a buffer." + (if (functionp 'make-extent) + (make-extent from to object) + ;; In Emacs, the overlay might end at the process-mark in comint + ;; buffers. In that case, new text will be inserted before the + ;; process-mark, ie. inside the overlay (using insert-before-marks). + ;; In order to avoid this, we use the `insert-behind-hooks' overlay + ;; property to make sure it works. + (let ((overlay (make-overlay from to object))) + (overlay-put overlay 'modification-hooks '(ansi-color-freeze-overlay)) + overlay))) + +(defun ansi-color-freeze-overlay (overlay is-after begin end &optional len) + "Prevent OVERLAY from being extended. +This function can be used for the `modification-hooks' overlay +property." + ;; if stuff was inserted at the end of the overlay + (when (and is-after + (= 0 len) + (= end (overlay-end overlay))) + ;; reset the end of the overlay + (move-overlay overlay (overlay-start overlay) begin))) + +(defun ansi-color-set-extent-face (extent face) + "Set the `face' property of EXTENT to FACE. +XEmacs uses `set-extent-face', Emacs uses `overlay-put'." + (if (functionp 'set-extent-face) + (set-extent-face extent face) + (overlay-put extent 'face face))) + +;; Helper functions + +(defun ansi-color-apply-sequence (escape-sequence faces &optional context) + "Apply ESCAPE-SEQUENCE to FACES and return the new list of faces. + +ESCAPE-SEQUENCE is an escape sequence and specifies a list of new +faces. If any of the new faces is the default face, then the list of +faces is reset. + +The optional argument CONTEXT is a cons-cell with the current +context. This is either the value of `ansi-color-context' or +`ansi-color-context-region'. Both have the current face in +the CAR. When the escape sequence specifies that the face must +be reset to default, then the face in the context must be reset +as well." + (let ((ansi-color-r "[0-9][0-9]?") + (i 0) + face) + (while (string-match ansi-color-r escape-sequence i) + (setq i (match-end 0) + face (ansi-color-get-face-1 + (string-to-int (match-string 0 escape-sequence) 10))) + (cond ((not face)) + ((eq face 'default) + (setq faces nil) + (when context + (setcar context nil))) + (t + ;; Prepend the new face to the list of faces. Prepending + ;; is important when faces conflict, ie. both specify a + ;; foreground color. + (setq faces (cons face faces)))))) + faces) + +(defun ansi-color-make-color-map () + "Creates a vector of face definitions and returns it. + +The index into the vector is an ANSI code. See the documentation of +`ansi-color-map' for an example. + +The face definitions are based upon the variables +`ansi-color-faces-vector' and `ansi-color-names-vector'." + (let ((ansi-color-map (make-vector 50 nil)) + (index 0)) + ;; miscellaneous attributes + (mapcar + (function (lambda (e) + (aset ansi-color-map index e) + (setq index (1+ index)) )) + ansi-color-faces-vector) + ;; foreground attributes + (setq index 30) + (mapcar + (function (lambda (e) + (aset ansi-color-map index + (ansi-color-make-face 'foreground e)) + (setq index (1+ index)) )) + ansi-color-names-vector) + ;; background attributes + (setq index 40) + (mapcar + (function (lambda (e) + (aset ansi-color-map index + (ansi-color-make-face 'background e)) + (setq index (1+ index)) )) + ansi-color-names-vector) + ansi-color-map)) + +(defvar ansi-color-map (ansi-color-make-color-map) + "A brand new color map suitable for `ansi-color-get-face'. + +The value of this variable is usually constructed by +`ansi-color-make-color-map'. The values in the array are such that the +numbers included in an SGR control sequences point to the correct +foreground or background colors. + +Example: The sequence \033[34m specifies a blue foreground. Therefore: + (aref ansi-color-map 34) + => \(foreground-color . \"blue\")") + +(defun ansi-color-map-update (symbol value) + "Update `ansi-color-map'. + +Whenever the vectors used to construct `ansi-color-map' are changed, +this function is called. Therefore this function is listed as the :set +property of `ansi-color-faces-vector' and `ansi-color-names-vector'." + (set-default symbol value) + (setq ansi-color-map (ansi-color-make-color-map))) + +(defun ansi-color-get-face-1 (ansi-code) + "Get face definition from `ansi-color-map'. +ANSI-CODE is used as an index into the vector." + (condition-case nil + (aref ansi-color-map ansi-code) + ('args-out-of-range nil))) + +(provide 'ansi-color) + +;;; ansi-color.el ends here diff --git a/emacs.d/auto-save-list/.saves-197-MacBook.local~ b/emacs.d/auto-save-list/.saves-197-MacBook.local~ new file mode 100644 index 0000000..dc37a81 --- /dev/null +++ b/emacs.d/auto-save-list/.saves-197-MacBook.local~ @@ -0,0 +1,38 @@ +/Users/sjs/Projects/stack/integer.c +/Users/sjs/Projects/stack/#integer.c# +/Users/sjs/Projects/stack/float.c +/Users/sjs/Projects/stack/#float.c# +/Users/sjs/Projects/stack/common.c +/Users/sjs/Projects/stack/#common.c# +/Users/sjs/Projects/stack/number.c +/Users/sjs/Projects/stack/#number.c# +/Users/sjs/Projects/stack/number.h +/Users/sjs/Projects/stack/#number.h# +/Users/sjs/Projects/stack/float.h +/Users/sjs/Projects/stack/#float.h# +/Users/sjs/Projects/stack/common.h +/Users/sjs/Projects/stack/#common.h# +/Users/sjs/Projects/stack/TODO +/Users/sjs/Projects/stack/#TODO# +/Users/sjs/Projects/stack/integer.h +/Users/sjs/Projects/stack/#integer.h# +/Users/sjs/Projects/stack/types.h +/Users/sjs/Projects/stack/#types.h# +/Users/sjs/Projects/stack/vm/vm.c +/Users/sjs/Projects/stack/vm/#vm.c# +/Users/sjs/Projects/stack/vm/test_vm.c +/Users/sjs/Projects/stack/vm/#test_vm.c# +/Users/sjs/Projects/stack/Makefile +/Users/sjs/Projects/stack/#Makefile# +/Users/sjs/Projects/stack/types.c +/Users/sjs/Projects/stack/#types.c# +/Users/sjs/Projects/stack/class.h +/Users/sjs/Projects/stack/#class.h# +/Users/sjs/Projects/stack/class.c +/Users/sjs/Projects/stack/#class.c# +/Users/sjs/Projects/stack/string.c +/Users/sjs/Projects/stack/#string.c# +/Users/sjs/Projects/stack/string.h +/Users/sjs/Projects/stack/#string.h# +/Users/sjs/Projects/stack/config.h +/Users/sjs/Projects/stack/#config.h# diff --git a/emacs.d/auto-save-list/.saves-226-MacBook.local~ b/emacs.d/auto-save-list/.saves-226-MacBook.local~ new file mode 100644 index 0000000..e504653 --- /dev/null +++ b/emacs.d/auto-save-list/.saves-226-MacBook.local~ @@ -0,0 +1,70 @@ +/Users/sjs/Projects/stack/sequence.c +/Users/sjs/Projects/stack/#sequence.c# +/Users/sjs/Projects/stack/float.c +/Users/sjs/Projects/stack/#float.c# +/Users/sjs/Projects/stack/number.c +/Users/sjs/Projects/stack/#number.c# +/Users/sjs/Projects/stack/common.h +/Users/sjs/Projects/stack/#common.h# +/Users/sjs/Projects/stack/integer.c +/Users/sjs/Projects/stack/#integer.c# +/Users/sjs/Projects/stack/types.h +/Users/sjs/Projects/stack/#types.h# +/Users/sjs/Projects/stack/sequence.h +/Users/sjs/Projects/stack/#sequence.h# +/Users/sjs/Projects/stack/class.c +/Users/sjs/Projects/stack/#class.c# +/Users/sjs/Projects/stack/class.h +/Users/sjs/Projects/stack/#class.h# +/Users/sjs/Projects/stack/Makefile +/Users/sjs/Projects/stack/#Makefile# +/Users/sjs/Projects/stack/test.c +/Users/sjs/Projects/stack/#test.c# +/Users/sjs/Projects/stack/object.c +/Users/sjs/Projects/stack/#object.c# +/Users/sjs/Projects/stack/nil.c +/Users/sjs/Projects/stack/#nil.c# +/Users/sjs/Projects/stack/string.c +/Users/sjs/Projects/stack/#string.c# +/Users/sjs/Projects/stack/boolean.c +/Users/sjs/Projects/stack/#boolean.c# +/Users/sjs/Projects/stack/array.c +/Users/sjs/Projects/stack/#array.c# +/Users/sjs/Projects/stack/number.h +/Users/sjs/Projects/stack/#number.h# +/Users/sjs/Projects/stack/common.c +/Users/sjs/Projects/stack/#common.c# +/Users/sjs/Projects/stack/nil.h +/Users/sjs/Projects/stack/#nil.h# +/Users/sjs/Projects/stack/types.c +/Users/sjs/Projects/stack/#types.c# +/Users/sjs/Projects/stack/float.h +/Users/sjs/Projects/stack/#float.h# +/Users/sjs/Projects/stack/integer.h +/Users/sjs/Projects/stack/#integer.h# +/Users/sjs/Projects/stack/string.h +/Users/sjs/Projects/stack/#string.h# +/Users/sjs/Projects/stack/object.h +/Users/sjs/Projects/stack/#object.h# +/Users/sjs/Projects/stack/array.h +/Users/sjs/Projects/stack/#array.h# +/Users/sjs/Projects/stack/boolean.h +/Users/sjs/Projects/stack/#boolean.h# +/Users/sjs/Projects/stack/test.h +/Users/sjs/Projects/stack/#test.h# +/Users/sjs/Projects/stack/vm/vm.c +/Users/sjs/Projects/stack/vm/#vm.c# +/Users/sjs/Projects/stack/vm/stack.h +/Users/sjs/Projects/stack/vm/#stack.h# +/Users/sjs/Projects/stack/vm/vm.h +/Users/sjs/Projects/stack/vm/#vm.h# +/Users/sjs/Projects/stack/st.c +/Users/sjs/Projects/stack/#st.c# +/Users/sjs/Projects/stack/st.h +/Users/sjs/Projects/stack/#st.h# +/Users/sjs/Projects/stack/error.h +/Users/sjs/Projects/stack/#error.h# +/Users/sjs/Projects/stack/TODO +/Users/sjs/Projects/stack/#TODO# +/Users/sjs/.emacs +/Users/sjs/#.emacs# diff --git a/emacs.d/auto-save-list/.saves-242-MacBook.local~ b/emacs.d/auto-save-list/.saves-242-MacBook.local~ new file mode 100644 index 0000000..cea30f7 --- /dev/null +++ b/emacs.d/auto-save-list/.saves-242-MacBook.local~ @@ -0,0 +1,20 @@ +/Users/sjs/Projects/stack/common.h +/Users/sjs/Projects/stack/#common.h# +/Users/sjs/Projects/stack/types.h +/Users/sjs/Projects/stack/#types.h# +/Users/sjs/Projects/stack/types.c +/Users/sjs/Projects/stack/#types.c# +/Users/sjs/Projects/stack/fixnum.h +/Users/sjs/Projects/stack/#fixnum.h# +/Users/sjs/Projects/stack/test.c +/Users/sjs/Projects/stack/#test.c# +/Users/sjs/Projects/stack/vm/vm.c +/Users/sjs/Projects/stack/vm/#vm.c# +/Users/sjs/Projects/stack/vm/vm.h +/Users/sjs/Projects/stack/vm/#vm.h# +/Users/sjs/Projects/stack/vm/stack.h +/Users/sjs/Projects/stack/vm/#stack.h# +/Users/sjs/Projects/stack/vm/stack.c +/Users/sjs/Projects/stack/vm/#stack.c# +/Users/sjs/Projects/stack/TODO +/Users/sjs/Projects/stack/#TODO# diff --git a/emacs.d/auto-save-list/.saves-249-MacBook.local~ b/emacs.d/auto-save-list/.saves-249-MacBook.local~ new file mode 100644 index 0000000..e609fa9 --- /dev/null +++ b/emacs.d/auto-save-list/.saves-249-MacBook.local~ @@ -0,0 +1,14 @@ +/Users/sjs/Projects/stack/kiss/test.c +/Users/sjs/Projects/stack/kiss/#test.c# +/Users/sjs/Projects/stack/kiss/lexer.c +/Users/sjs/Projects/stack/kiss/#lexer.c# +/Users/sjs/Projects/stack/kiss/lexer.h +/Users/sjs/Projects/stack/kiss/#lexer.h# +/Users/sjs/Projects/stack/kiss/Makefile +/Users/sjs/Projects/stack/kiss/#Makefile# +/Users/sjs/.emacs +/Users/sjs/#.emacs# +/Users/sjs/Projects/stack/kiss/parser.c +/Users/sjs/Projects/stack/kiss/#parser.c# +/Users/sjs/Projects/stack/kiss/parser.h +/Users/sjs/Projects/stack/kiss/#parser.h# diff --git a/emacs.d/auto-save-list/.saves-28954-tuono.exile.net~ b/emacs.d/auto-save-list/.saves-28954-tuono.exile.net~ new file mode 100644 index 0000000..b3729d8 --- /dev/null +++ b/emacs.d/auto-save-list/.saves-28954-tuono.exile.net~ @@ -0,0 +1,34 @@ +/home/sjs/.emacs +/home/sjs/#.emacs# +/home/sjs/projects/balltrek/doc/TODO +/home/sjs/projects/balltrek/doc/#TODO# +/home/sjs/projects/balltrek/test/unit/customer_test.rb +/home/sjs/projects/balltrek/test/unit/#customer_test.rb# +/home/sjs/projects/balltrek/test/unit/purchase_test.rb +/home/sjs/projects/balltrek/test/unit/#purchase_test.rb# +/home/sjs/projects/balltrek/test/unit/cart_test.rb +/home/sjs/projects/balltrek/test/unit/#cart_test.rb# +/home/sjs/projects/balltrek/app/models/cart.rb +/home/sjs/projects/balltrek/app/models/#cart.rb# +/home/sjs/projects/balltrek/app/models/reservation.rb +/home/sjs/projects/balltrek/app/models/#reservation.rb# +/home/sjs/projects/balltrek/test/unit/reservation_test.rb +/home/sjs/projects/balltrek/test/unit/#reservation_test.rb# +/home/sjs/projects/balltrek/test/unit/item_test.rb +/home/sjs/projects/balltrek/test/unit/#item_test.rb# +/home/sjs/projects/balltrek/app/models/item.rb +/home/sjs/projects/balltrek/app/models/#item.rb# +/home/sjs/projects/balltrek/test/test_helper.rb +/home/sjs/projects/balltrek/test/#test_helper.rb# +/home/sjs/projects/balltrek/app/models/customer.rb +/home/sjs/projects/balltrek/app/models/#customer.rb# +/home/sjs/projects/balltrek/test/functional/admin/users_controller_test.rb +/home/sjs/projects/balltrek/test/functional/admin/#users_controller_test.rb# +/home/sjs/projects/balltrek/app/models/account_type.rb +/home/sjs/projects/balltrek/app/models/#account_type.rb# +/home/sjs/projects/balltrek/app/controllers/customers_controller.rb +/home/sjs/projects/balltrek/app/controllers/#customers_controller.rb# +/home/sjs/projects/balltrek/app/controllers/creditcard_controller.rb +/home/sjs/projects/balltrek/app/controllers/#creditcard_controller.rb# +/home/sjs/projects/balltrek/test/functional/customers_controller_test.rb +/home/sjs/projects/balltrek/test/functional/#customers_controller_test.rb# diff --git a/emacs.d/auto-save-list/.saves-328-MacBook.local~ b/emacs.d/auto-save-list/.saves-328-MacBook.local~ new file mode 100644 index 0000000..55ffdea --- /dev/null +++ b/emacs.d/auto-save-list/.saves-328-MacBook.local~ @@ -0,0 +1,8 @@ +/Users/sjs/count.rb +/Users/sjs/#count.rb# +/Users/sjs/count.sh +/Users/sjs/#count.sh# +/Users/sjs/Projects/c/itoa.c +/Users/sjs/Projects/c/#itoa.c# +/Users/sjs/Projects/c/expand.c +/Users/sjs/Projects/c/#expand.c# diff --git a/emacs.d/auto-save-list/.saves-4862-tuono.exile.net~ b/emacs.d/auto-save-list/.saves-4862-tuono.exile.net~ new file mode 100644 index 0000000..268cf0f --- /dev/null +++ b/emacs.d/auto-save-list/.saves-4862-tuono.exile.net~ @@ -0,0 +1,4 @@ +/home/sjs/projects/crescendo/IDEAS +/home/sjs/projects/crescendo/#IDEAS# +/home/sjs/.emacs +/home/sjs/#.emacs# diff --git a/emacs.d/auto-save-list/.saves-63325-MacBook.local~ b/emacs.d/auto-save-list/.saves-63325-MacBook.local~ new file mode 100644 index 0000000..4fca2ef --- /dev/null +++ b/emacs.d/auto-save-list/.saves-63325-MacBook.local~ @@ -0,0 +1,2 @@ +/Users/sjs/Projects/bjs/js.lex +/Users/sjs/Projects/bjs/#js.lex# diff --git a/emacs.d/auto-save-list/.saves-779-tuono.exile.net~ b/emacs.d/auto-save-list/.saves-779-tuono.exile.net~ new file mode 100644 index 0000000..5d80440 --- /dev/null +++ b/emacs.d/auto-save-list/.saves-779-tuono.exile.net~ @@ -0,0 +1,178 @@ +/home/sjs/projects/balltrek/app/views/customers/show.rhtml +/home/sjs/projects/balltrek/app/views/customers/#show.rhtml# +/home/sjs/projects/balltrek/app/models/fund_source.rb +/home/sjs/projects/balltrek/app/models/#fund_source.rb# +/home/sjs/projects/balltrek/doc/TODO +/home/sjs/projects/balltrek/doc/#TODO# +/home/sjs/projects/balltrek/app/controllers/customers_controller.rb +/home/sjs/projects/balltrek/app/controllers/#customers_controller.rb# +/home/sjs/projects/balltrek/app/helpers/customers_helper.rb +/home/sjs/projects/balltrek/app/helpers/#customers_helper.rb# +/home/sjs/projects/balltrek/app/models/paypal.rb +/home/sjs/projects/balltrek/app/models/#paypal.rb# +/home/sjs/projects/balltrek/app/models/credit_card.rb +/home/sjs/projects/balltrek/app/models/#credit_card.rb# +/home/sjs/projects/balltrek/app/models/customer.rb +/home/sjs/projects/balltrek/app/models/#customer.rb# +/home/sjs/projects/balltrek/lib/balltrek.rb +/home/sjs/projects/balltrek/lib/#balltrek.rb# +/home/sjs/projects/balltrek/app/helpers/application_helper.rb +/home/sjs/projects/balltrek/app/helpers/#application_helper.rb# +/home/sjs/projects/balltrek/config/environment.rb +/home/sjs/projects/balltrek/config/#environment.rb# +/home/sjs/projects/balltrek/config/environments/development.rb +/home/sjs/projects/balltrek/config/environments/#development.rb# +/home/sjs/code/ruby/lisp.rb +/home/sjs/code/ruby/#lisp.rb# +/home/sjs/projects/balltrek/config/environments/production.rb +/home/sjs/projects/balltrek/config/environments/#production.rb# +/home/sjs/projects/balltrek/config/environments/test.rb +/home/sjs/projects/balltrek/config/environments/#test.rb# +/home/sjs/code/factorial.txt +/home/sjs/code/#factorial.txt# +/home/sjs/projects/elschemo/sandbox.scm +/home/sjs/projects/elschemo/#sandbox.scm# +/home/sjs/projects/elschemo/stdlib.scm +/home/sjs/projects/elschemo/#stdlib.scm# +/home/sjs/.gtkrc-2.0 +/home/sjs/#.gtkrc-2.0# +/home/sjs/code/haskell/factorial.hs +/home/sjs/code/haskell/#factorial.hs# +/home/sjs/.emacs +/home/sjs/#.emacs# +/home/sjs/config/fluxbox/keys +/home/sjs/config/fluxbox/#keys# +/home/sjs/projects/balltrek/app/models/prize.rb +/home/sjs/projects/balltrek/app/models/#prize.rb# +/home/sjs/projects/balltrek/app/models/draw.rb +/home/sjs/projects/balltrek/app/models/#draw.rb# +/home/sjs/projects/balltrek/test/unit/prize_test.rb +/home/sjs/projects/balltrek/test/unit/#prize_test.rb# +/home/sjs/projects/balltrek/app/models/likely_result.rb +/home/sjs/projects/balltrek/app/models/#likely_result.rb# +/home/sjs/projects/balltrek/test/unit/likely_result_test.rb +/home/sjs/projects/balltrek/test/unit/#likely_result_test.rb# +/home/sjs/projects/balltrek/db/migrate/015_create_fund_sources.rb +/home/sjs/projects/balltrek/db/migrate/#015_create_fund_sources.rb# +/home/sjs/projects/balltrek/app/views/customers/winners.rhtml +/home/sjs/projects/balltrek/app/views/customers/#winners.rhtml# +/home/sjs/projects/balltrek/app/controllers/purchase_controller.rb +/home/sjs/projects/balltrek/app/controllers/#purchase_controller.rb# +/home/sjs/projects/balltrek/app/models/cart.rb +/home/sjs/projects/balltrek/app/models/#cart.rb# +/home/sjs/projects/balltrek/app/views/customers/_form.rhtml +/home/sjs/projects/balltrek/app/views/customers/#_form.rhtml# +/home/sjs/projects/balltrek/app/views/customers/edit.rhtml +/home/sjs/projects/balltrek/app/views/customers/#edit.rhtml# +/home/sjs/projects/balltrek/app/controllers/payments_controller.rb +/home/sjs/projects/balltrek/app/controllers/#payments_controller.rb# +/home/sjs/projects/balltrek/app/views/admin/cardtypes/index.rhtml +/home/sjs/projects/balltrek/app/views/admin/cardtypes/#index.rhtml# +/home/sjs/projects/balltrek/app/views/admin/cardtypes/create.rjs +/home/sjs/projects/balltrek/app/views/admin/cardtypes/#create.rjs# +/home/sjs/projects/balltrek/app/controllers/admin/paymentmethods_controller.rb +/home/sjs/projects/balltrek/app/controllers/admin/#paymentmethods_controller.rb# +/home/sjs/projects/balltrek/app/models/payment_method.rb +/home/sjs/projects/balltrek/app/models/#payment_method.rb# +/home/sjs/projects/balltrek/app/views/admin/paymentmethods/index.rhtml +/home/sjs/projects/balltrek/app/views/admin/paymentmethods/#index.rhtml# +/home/sjs/projects/balltrek/app/views/admin/paymentmethods/create.rjs +/home/sjs/projects/balltrek/app/views/admin/paymentmethods/#create.rjs# +/home/sjs/projects/balltrek/app/views/admin/paymentmethods/_payment_methods.rhtml +/home/sjs/projects/balltrek/app/views/admin/paymentmethods/#_payment_methods.rhtml# +/home/sjs/projects/balltrek/app/views/admin/paymentmethods/_payment_method.rhtml +/home/sjs/projects/balltrek/app/views/admin/paymentmethods/#_payment_method.rhtml# +/home/sjs/projects/balltrek/db/migrate/001_create_tables.rb +/home/sjs/projects/balltrek/db/migrate/#001_create_tables.rb# +/home/sjs/projects/balltrek/app/views/admin/lotteries/_prize.rhtml +/home/sjs/projects/balltrek/app/views/admin/lotteries/#_prize.rhtml# +/home/sjs/projects/balltrek/app/views/admin/lotteries/show.rhtml +/home/sjs/projects/balltrek/app/views/admin/lotteries/#show.rhtml# +/home/sjs/projects/balltrek/app/views/admin/prizes/_form.rhtml +/home/sjs/projects/balltrek/app/views/admin/prizes/#_form.rhtml# +/home/sjs/projects/balltrek/app/views/admin/prizes/new.rhtml +/home/sjs/projects/balltrek/app/views/admin/prizes/#new.rhtml# +/home/sjs/projects/balltrek/app/controllers/admin/prizes_controller.rb +/home/sjs/projects/balltrek/app/controllers/admin/#prizes_controller.rb# +/home/sjs/projects/balltrek/app/helpers/admin/lotteries_helper.rb +/home/sjs/projects/balltrek/app/helpers/admin/#lotteries_helper.rb# +/home/sjs/projects/balltrek/app/helpers/lottery_helper.rb +/home/sjs/projects/balltrek/app/helpers/#lottery_helper.rb# +/home/sjs/projects/balltrek/app/views/admin/lotteries/_form.rhtml +/home/sjs/projects/balltrek/app/views/admin/lotteries/#_form.rhtml# +/home/sjs/projects/balltrek/app/controllers/admin/lotteries_controller.rb +/home/sjs/projects/balltrek/app/controllers/admin/#lotteries_controller.rb# +/home/sjs/projects/balltrek/app/controllers/lottery_controller.rb +/home/sjs/projects/balltrek/app/controllers/#lottery_controller.rb# +/home/sjs/projects/balltrek/db/migrate/011_remove_p7_from_number_sets.rb +/home/sjs/projects/balltrek/db/migrate/#011_remove_p7_from_number_sets.rb# +/home/sjs/projects/balltrek/test/functional/customers_controller_test.rb +/home/sjs/projects/balltrek/test/functional/#customers_controller_test.rb# +/home/sjs/projects/balltrek/test/unit/payment_method_test.rb +/home/sjs/projects/balltrek/test/unit/#payment_method_test.rb# +/home/sjs/projects/balltrek/test/fixtures/payment_methods.yml +/home/sjs/projects/balltrek/test/fixtures/#payment_methods.yml# +/home/sjs/projects/balltrek/app/views/customers/_fund_sources.rhtml +/home/sjs/projects/balltrek/app/views/customers/#_fund_sources.rhtml# +/home/sjs/projects/balltrek/app/views/customers/_creditcard.rhtml +/home/sjs/projects/balltrek/app/views/customers/#_creditcard.rhtml# +/home/sjs/projects/balltrek/app/views/layouts/standard.rhtml +/home/sjs/projects/balltrek/app/views/layouts/#standard.rhtml# +/home/sjs/projects/balltrek/app/views/creditcard/set_default.rjs +/home/sjs/projects/balltrek/app/views/creditcard/#set_default.rjs# +/home/sjs/projects/balltrek/app/views/fund_sources/_paypal.rhtml +/home/sjs/projects/balltrek/app/views/fund_sources/#_paypal.rhtml# +/home/sjs/projects/balltrek/app/views/fund_sources/_credit_card.rhtml +/home/sjs/projects/balltrek/app/views/fund_sources/#_credit_card.rhtml# +/home/sjs/projects/balltrek/app/views/creditcard/app/views/creditcard/remove.rjs +/home/sjs/projects/balltrek/app/views/creditcard/app/views/creditcard/#remove.rjs# +/home/sjs/projects/balltrek/app/views/creditcard/_credit_card_form.rhtml +/home/sjs/projects/balltrek/app/views/creditcard/#_credit_card_form.rhtml# +/home/sjs/projects/balltrek/public/stylesheets/smooth.css +/home/sjs/projects/balltrek/public/stylesheets/#smooth.css# +/home/sjs/projects/balltrek/test/unit/customer_test.rb +/home/sjs/projects/balltrek/test/unit/#customer_test.rb# +/home/sjs/projects/balltrek/app/controllers/application.rb +/home/sjs/projects/balltrek/app/controllers/#application.rb# +/home/sjs/projects/balltrek/lib/authentication.rb +/home/sjs/projects/balltrek/lib/#authentication.rb# +/home/sjs/projects/balltrek/test/fixtures/customers.yml +/home/sjs/projects/balltrek/test/fixtures/#customers.yml# +/home/sjs/projects/balltrek/app/controllers/admin/customers_controller.rb +/home/sjs/projects/balltrek/app/controllers/admin/#customers_controller.rb# +/home/sjs/projects/balltrek/app/views/admin/_menu.rhtml +/home/sjs/projects/balltrek/app/views/admin/#_menu.rhtml# +/home/sjs/projects/balltrek/app/models/user.rb +/home/sjs/projects/balltrek/app/models/#user.rb# +/home/sjs/projects/balltrek/app/models/reservation.rb +/home/sjs/projects/balltrek/app/models/#reservation.rb# +/home/sjs/projects/balltrek/app/models/purchase.rb +/home/sjs/projects/balltrek/app/models/#purchase.rb# +/home/sjs/projects/balltrek/app/models/payment.rb +/home/sjs/projects/balltrek/app/models/#payment.rb# +/home/sjs/projects/balltrek/app/models/lottery.rb +/home/sjs/projects/balltrek/app/models/#lottery.rb# +/home/sjs/projects/balltrek/app/models/item.rb +/home/sjs/projects/balltrek/app/models/#item.rb# +/home/sjs/projects/balltrek/db/schema.rb +/home/sjs/projects/balltrek/db/#schema.rb# +/home/sjs/projects/balltrek/test/unit/payment_test.rb +/home/sjs/projects/balltrek/test/unit/#payment_test.rb# +/home/sjs/projects/balltrek/test/unit/credit_card_test.rb +/home/sjs/projects/balltrek/test/unit/#credit_card_test.rb# +/home/sjs/projects/balltrek/test/unit/paypal_test.rb +/home/sjs/projects/balltrek/test/unit/#paypal_test.rb# +/home/sjs/projects/balltrek/test/unit/fund_source_test.rb +/home/sjs/projects/balltrek/test/unit/#fund_source_test.rb# +/home/sjs/projects/balltrek/test/fixtures/paypals.yml +/home/sjs/projects/balltrek/test/fixtures/#paypals.yml# +/home/sjs/projects/balltrek/test/fixtures/credit_cards.yml +/home/sjs/projects/balltrek/test/fixtures/#credit_cards.yml# +/home/sjs/projects/balltrek/test/fixtures/fund_sources.yml +/home/sjs/projects/balltrek/test/fixtures/#fund_sources.yml# +/home/sjs/projects/balltrek/app/views/customers/signup.rhtml +/home/sjs/projects/balltrek/app/views/customers/#signup.rhtml# +/home/sjs/projects/balltrek/test/fixtures/account_types.yml +/home/sjs/projects/balltrek/test/fixtures/#account_types.yml# +/home/sjs/projects/balltrek/TAGS +/home/sjs/projects/balltrek/#TAGS# diff --git a/emacs.d/color-theme/color-theme.el b/emacs.d/color-theme/color-theme.el new file mode 100644 index 0000000..87e8cab --- /dev/null +++ b/emacs.d/color-theme/color-theme.el @@ -0,0 +1,15170 @@ +;;; color-theme.el --- install color themes + +;; Copyright (C) 1999, 2000 Jonadab the Unsightly One +;; Copyright (C) 2000, 2001, 2002, 2003 Alex Schroeder +;; Copyright (C) 2003 Xavier Maillard + +;; Version: 6.5.4 +;; Keywords: faces +;; Author: Jonadab the Unsightly One +;; Maintainer: Xavier Maillard +;; URL: http://www.emacswiki.org/cgi-bin/wiki.pl?ColorTheme + +;; This file is not part of GNU Emacs. + +;; This is free software; you can redistribute it and/or modify it under +;; the terms of the GNU General Public License as published by the Free +;; Software Foundation; either version 2, or (at your option) any later +;; version. +;; +;; This is distributed in the hope that it will be useful, but WITHOUT +;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +;; FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +;; for more details. +;; +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs; see the file COPYING. If not, write to the +;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, +;; MA 02111-1307, USA. + +;;; Commentary: + +;; Sharing your current color setup: +;; +;; Use `color-theme-submit'. If you have already invested time in +;; customizing Emacs faces, please consider sharing your current setup. +;; Make sure that color-theme.el is in your `load-path'. Type M-x +;; load-library RET color-theme RET to load all the functions. Type M-x +;; color-theme-submit RET and mail the result to the maintainer of this +;; package (see above for mail addres). +;; +;; If you want to make sure that all your customization was exported, +;; type M-x list-faces-display RET to get a list of all faces currently +;; defined. This is the list of faces that `color-theme-print' uses. + +;; Installing a color theme: +;; +;; Make sure that color-theme.el is in your `load-path'. Type M-x +;; load-library RET color-theme RET to load all the functions. +;; +;; The main function to call is color-theme-select. Type M-x +;; color-theme-select RET. That creates a Color Theme Selection +;; buffer. Press RET or `i' on a color theme to install it for the +;; rest of your session. +;; +;; If you want to install the color theme as soon as Emacs is started +;; up, read the description of the theme you like and remember the +;; name of the color theme function. Press `d' on a color theme in +;; the Color Theme Selection buffer to read the description. Assuming +;; you like the Gnome2 theme, you'll find that the function to use is +;; called `color-theme-gnome2'. Add the following to the end of your +;; .emacs (removing the leading `;;'). +;; +;; (require 'color-theme) +;; (color-theme-gnome2) + +;; Changing menu colors: +;; +;; In Emacs 21 on X, you can set the menu colors and font using the +;; menu face. Example for your .emacs file: +;; +;; (set-face-font 'menu "7x14") +;; (set-face-foreground 'menu "white"). +;; +;; If are using X, you can set the menu foreground and background using +;; a resource file, usually .Xdefaults or .Xresources. Usually +;; .Xdefaults is used when you start your session using a display +;; manager such as xdm or gdm. .Xresources is usually used when you +;; start X directly via a shell script such as startx. If you set +;; Emacs*Background and Emacs*Foreground in such a resource file, the +;; foreground and background of Emacs including the menu will be set. +;; If your .emacs then loads a color theme, the foreground and +;; background are changed -- with the exception of the menu. There is +;; no way to manipulate the menu foreground and background color from +;; elisp. You can also set more specific menu resources for Emacs in +;; the resource file. Here is a sample entry for your resource file: +;; +;; Emacs*Background: DarkSlateGray +;; Emacs*Foreground: wheat + +;; Creating your own color theme: +;; +;; Use M-x customize-face and customize the faces. Make sure to "Set +;; for Current Session" -- you don't want to save these using custom! +;; When you are done, call M-x color-theme-print to produce the elisp +;; code required to recreate your theme. Better yet, use M-x +;; color-theme-submit to mail it to the maintainer. That way it will be +;; added to future versions of color-theme.el. +;; +;; For more information on the elisp format of a color theme, start with +;; the documentation of `color-theme-install' using C-h f +;; color-theme-install. +;; +;; When your color theme is just a variation of an existing color theme, +;; take a look at `color-theme-robin-hood' in order to see an example of +;; how to do it. Essentially you want to call all the parent color +;; themes before installing your changes. For all but the first parent +;; color theme, you need to make sure that `color-theme-is-cumulative' +;; is bound to t. If you don't do that, users that set +;; `color-theme-is-cumulative' to nil will only install your changes +;; without the parent color themes. + +;; Making a color theme work for both Emacs and XEmacs: +;; +;; Once you have printed the color-theme, you can make sure it looks +;; similar in both Emacs and XEmacs by running +;; `color-theme-analyze-defun' on the printed theme. This function +;; will check for missing faces for the other editor... + +;;; Thanks + +;; Deepak Goel +;; S. Pokrovsky for ideas and discussion. +;; Gordon Messmer for ideas and discussion. +;; Sriram Karra for the color-theme-submit stuff. +;; Olgierd `Kingsajz' Ziolko for the spec-filter idea. +;; All the users that contributed their color themes. + +;;; Bugs: + +;; Emacs 20.7: Some faces are created using copy-face; these faces are +;; not printed correctly using M-x color-theme-print. They will have +;; (nil) in their spec. M-x customize-face has the same problem. +;; Example: +;; (copy-face 'bold 'new-bold) +;; (color-theme-spec 'bold) +;; => (bold ((t (:bold t)))) +;; (color-theme-spec 'new-bold) +;; => (new-bold ((t (nil)))) +;; +;; XEmacs 21.1: Some faces are defined using a certain font instead of +;; of the correct attribute. They will have (nil) in their spec. +;; M-x customize-face has the same problem. +;; Example: +;; (color-theme-spec 'bold) +;; => (bold ((t (nil)))) +;; +;; XEmacs 21.2 and up, Emacs 21: Not compatible with the custom-theme +;; mode. It should be easy to transform the color-theme source into +;; custom-theme source, however. +;; +;; If you are running XEmacs, then only foreground and background color +;; of the default face and only the background color of the text-cursor +;; face will used. This is due to the fact that these three pieces of +;; information are stored as frame parameters in Emacs. +;; +;; If you are running XEmacs, variables cannot have a frame-local +;; binding. Therefore, if color-theme-is-global is set to nil, the +;; variable settings in a color theme are ignored. +;; +;; Using Emacs and a non-nil value for color-theme-is-global will +;; install a new color theme for all frames. Using XEmacs and a non-nil +;; value for color-theme-is-global will install a new color theme only +;; on those frames that are not using a local color theme. +;; +;; If your system does not define the color names used, you will get the +;; error "undefined color". See the output of `list-colors-display' for +;; a list of colors defined on your display. +;; +;; The :box, :height, and other new attributes will be honored in Emacs +;; 21, but when you print such a color-theme on Emacs 20 or XEmacs 21, +;; the information will get lost. So don't do that. Furthermore, +;; customizing these faces may end up showing you a lisp expression +;; instead of the real widgets on Emacs 20 or XEmacs 21 because these +;; attributes are not understood. +;; +;; :inverse-video handling differs in Emacs and XEmacs. We therefore do +;; away with it. When printing a color-theme, the inverse-video +;; attribute should be handled correctly without ever appearing in color +;; themes. For maintenance, the following might be usefull for +;; query-replace-regexp. +;; :background "\([^"]*\)"\(.*\):foreground "\([^"]*\)"\(.*\) :inverse-video t +;; :background "\3"\2:foreground "\1"\4 +;; +;; In XEmacs 21.1, some of the face tests don't work. Example: +;; (custom-face-bold 'bold) returns nil on my system. A bug report was +;; submitted. +;; +;; Emacs 20 users will loose with new color themes, because these will +;; set the colors of the default face only, leaving frame background +;; untouched. In Emacs 20, the colors of the default face and of the +;; frame could be changed independently. In Emacs 21, this is no longer +;; true. New color themes will not be made backwards compatible. +;; +;; This release was superficially tested with Emacs 21.2 and XEmacs 21.4. + + + +;;; Code: + +(require 'cl); set-difference is a function... + +;; for custom-face-attributes-get or face-custom-attributes-get +(require 'cus-face) +(require 'wid-edit); for widget-apply stuff in cus-face.el + +(defconst color-theme-maintainer-address "zedek@gnu-rox.org" + "Address used by `submit-color-theme'.") + +;; Emacs / XEmacs compatibility and workaround layer + +(cond ((and (facep 'tool-bar) + (not (facep 'toolbar))) + (put 'toolbar 'face-alias 'tool-bar)) + ((and (facep 'toolbar) + (not (facep 'tool-bar))) + (put 'tool-bar 'face-alias 'toolbar))) + +(defvar color-theme-xemacs-p (string-match "XEmacs" emacs-version) + "Non-nil if running XEmacs.") + +;; face-attr-construct has a problem in Emacs 20.7 and older when +;; dealing with inverse-video faces. Here is a short test to check +;; wether you are affected. + +;; (set-background-color "wheat") +;; (set-foreground-color "black") +;; (setq a (make-face 'a-face)) +;; (face-spec-set a '((t (:background "white" :foreground "black" :inverse-video t)))) +;; (face-attr-construct a) +;; => (:background "black" :inverse-video t) + +;; The expected response is the original specification: +;; => (:background "white" :foreground "black" :inverse-video t) + +;; That's why we depend on cus-face.el functionality. + +(cond ((fboundp 'custom-face-attributes-get) + (defalias 'color-theme-face-attr-construct + 'custom-face-attributes-get)) + ((fboundp 'face-custom-attributes-get) + (defalias 'color-theme-face-attr-construct + 'face-custom-attributes-get)) + (t + (defun color-theme-face-attr-construct (&rest ignore) + (error "Unable to construct face attributes")))) + +(defun color-theme-alist (plist) + "Transform PLIST into an alist if it is a plist and return it. +If the first element of PLIST is a cons cell, we just return PLIST, +assuming PLIST to be an alist. If the first element of plist is not a +symbol, this is an error: We cannot distinguish a plist from an ordinary +list, but a list that doesn't start with a symbol is certainly no plist +and no alist. + +This is used to make sure `default-frame-alist' really is an alist and not +a plist. In XEmacs, the alist is deprecated; a plist is used instead." + (cond ((consp (car plist)) + plist) + ((not (symbolp (car plist))) + (error "Wrong type argument: plist, %S" plist)) + (t + (plist-to-alist plist)))); XEmacs only + +;; Customization + +(defgroup color-theme nil + "Color Themes for Emacs. +A color theme consists of frame parameter settings, variable settings, +and face definitions." + :version "20.6" + :group 'faces) + +(defcustom color-theme-legal-frame-parameters "\\(color\\|mode\\)$" + "Regexp that matches frame parameter names. +Only frame parameter names that match this regexp can be changed as part +of a color theme." + :type '(choice (const :tag "Colors only" "\\(color\\|mode\\)$") + (const :tag "Colors, fonts, and size" + "\\(color\\|mode\\|font\\|height\\|width\\)$") + (regexp :tag "Custom regexp")) + :group 'color-theme + :link '(info-link "(elisp)Window Frame Parameters")) + +(defcustom color-theme-legal-variables "\\(color\\|face\\)$" + "Regexp that matches variable names. +Only variables that match this regexp can be changed as part of a color +theme. In addition to matching this name, the variables have to be user +variables (see function `user-variable-p')." + :type 'regexp + :group 'color-theme) + +(defcustom color-theme-illegal-faces "^w3-" + "Regexp that matches face names forbidden in themes. +The default setting \"^w3-\" excludes w3 faces since these +are created dynamically." + :type 'regexp + :group 'color-theme + :link '(info-link "(elisp)Faces for Font Lock") + :link '(info-link "(elisp)Standard Faces")) + +(defcustom color-theme-illegal-default-attributes '(:family :height :width) + "A list of face properties to be ignored when installing faces. +This prevents Emacs from doing terrible things to your display just because +a theme author likes weird fonts." + :type '(repeat symbol) + :group 'color-theme) + +(defcustom color-theme-is-global t + "*Determines wether a color theme is installed on all frames or not. +If non-nil, color themes will be installed for all frames. +If nil, color themes will be installed for the selected frame only. + +A possible use for this variable is dynamic binding. Here is a larger +example to put in your ~/.emacs; it will make the Blue Sea color theme +the default used for the first frame, and it will create two additional +frames with different color themes. + +setup: + \(require 'color-theme) + ;; set default color theme + \(color-theme-blue-sea) + ;; create some frames with different color themes + \(let ((color-theme-is-global nil)) + \(select-frame (make-frame)) + \(color-theme-gnome2) + \(select-frame (make-frame)) + \(color-theme-standard)) + +Please note that using XEmacs and and a nil value for +color-theme-is-global will ignore any variable settings for the color +theme, since XEmacs doesn't have frame-local variable bindings. + +Also note that using Emacs and a non-nil value for color-theme-is-global +will install a new color theme for all frames. Using XEmacs and a +non-nil value for color-theme-is-global will install a new color theme +only on those frames that are not using a local color theme." + :type 'boolean + :group 'color-theme) + +(defcustom color-theme-is-cumulative t + "*Determines wether new color themes are installed on top of each other. +If non-nil, installing a color theme will undo all settings made by +previous color themes." + :type 'boolean + :group 'color-theme) + +(defcustom color-theme-mode-hook nil + "Hook for color-theme-mode." + :type 'hook + :group 'color-theme) + +(defvar color-theme-mode-map + (let ((map (make-sparse-keymap))) + (define-key map (kbd "RET") 'color-theme-install-at-point) + (define-key map (kbd "c") 'list-colors-display) + (define-key map (kbd "d") 'color-theme-describe) + (define-key map (kbd "f") 'list-faces-display) + (define-key map (kbd "i") 'color-theme-install-at-point) + (define-key map (kbd "l") 'color-theme-install-at-point-for-current-frame) + (define-key map (kbd "p") 'color-theme-print) + (define-key map (kbd "q") 'bury-buffer) + (define-key map (kbd "?") 'color-theme-describe) + (if color-theme-xemacs-p + (define-key map (kbd "") 'color-theme-install-at-mouse) + (define-key map (kbd "") 'color-theme-install-at-mouse)) + map) + "Mode map used for the buffer created by `color-theme-select'.") + +(defvar color-theme-buffer-name "*Color Theme Selection*" + "Name of the color theme selection buffer.") + +(defvar color-theme-original-frame-alist nil + "nil until one of the color themes has been installed.") + +(defvar color-theme-history nil + "List of color-themes called, in reverse order") + +(defcustom color-theme-history-max-length nil + "Max length of history to maintain. +Two other values are acceptable: t means no limit, and +nil means that no history is maintained." + :type '(choice (const :tag "No history" nil) + (const :tag "Unlimited length" t) + integer) + :group 'color-theme) + +(defvar color-theme-counter 0 + "Counter for every addition to `color-theme-history'. +This counts how many themes were installed, regardless +of `color-theme-history-max-length'.") + +(defun color-theme-add-to-history (name) + "Add color-theme NAME to `color-theme-history'." + (setq color-theme-history + (cons (list name color-theme-is-cumulative) + color-theme-history) + color-theme-counter (+ 1 color-theme-counter)) + ;; Truncate the list if necessary. + (when (and (integerp color-theme-history-max-length) + (>= (length color-theme-history) + color-theme-history-max-length)) + (setcdr (nthcdr (1- color-theme-history-max-length) + color-theme-history) + nil))) + +;; (let ((l '(1 2 3 4 5))) +;; (setcdr (nthcdr 2 l) nil) +;; l) + + + +;; List of color themes used to create the *Color Theme Selection* +;; buffer. + +(defvar color-themes + '((color-theme-aalto-dark "Aalto Dark" "Jari Aalto ") + (color-theme-aalto-light "Aalto Light" "Jari Aalto ") + (color-theme-aliceblue "Alice Blue" "Girish Bharadwaj ") + (color-theme-andreas "Andreas" "Andreas Busch ") + (color-theme-arjen "Arjen" "Arjen Wiersma ") + (color-theme-beige-diff "Beige Diff" "Alex Schroeder " t) + (color-theme-bharadwaj "Bharadwaj" "Girish Bharadwaj ") + (color-theme-bharadwaj-slate "Bharadwaj Slate" "Girish Bharadwaj ") + (color-theme-billw "Billw" "Bill White ") + (color-theme-black-on-gray "BlackOnGray" "Sudhir Bhojwani ") + (color-theme-blippblopp "Blipp Blopp" "Thomas Sicheritz-Ponten") + (color-theme-simple-1 "Black" "Jonadab ") + (color-theme-blue-erc "Blue ERC" "Alex Schroeder " t) + (color-theme-blue-gnus "Blue Gnus" "Alex Schroeder " t) + (color-theme-blue-mood "Blue Mood" "Nelson Loyola ") + (color-theme-blue-sea "Blue Sea" "Alex Schroeder ") + (color-theme-calm-forest "Calm Forest" "Artur Hefczyc ") + (color-theme-charcoal-black "Charcoal Black" "Lars Chr. Hausmann ") + (color-theme-goldenrod "Cheap Goldenrod" "Alex Schroeder ") + (color-theme-clarity "Clarity and Beauty" "Richard Wellum ") + (color-theme-classic "Classic" "Frederic Giroud ") + (color-theme-comidia "Comidia" "Marcelo Dias de Toledo ") + (color-theme-jsc-dark "Cooper Dark" "John S Cooper ") + (color-theme-jsc-light "Cooper Light" "John S Cooper ") + (color-theme-jsc-light2 "Cooper Light 2" "John S Cooper ") + (color-theme-dark-blue "Dark Blue" "Chris McMahan ") + (color-theme-dark-blue2 "Dark Blue 2" "Chris McMahan ") + (color-theme-dark-green "Dark Green" "eddy_woody@hotmail.com") + (color-theme-dark-laptop "Dark Laptop" "Laurent Michel ") + (color-theme-deep-blue "Deep Blue" "Tomas Cerha ") + (color-theme-digital-ofs1 "Digital OFS1" "Gareth Owen ") + (color-theme-euphoria "Euphoria" "oGLOWo@oGLOWo.cjb.net") + (color-theme-feng-shui "Feng Shui" "Walter Higgins ") + (color-theme-fischmeister "Fischmeister" + "Sebastian Fischmeister ") + (color-theme-gnome "Gnome" "Jonadab ") + (color-theme-gnome2 "Gnome 2" "Alex Schroeder ") + (color-theme-gray1 "Gray1" "Paul Pulli ") + (color-theme-gray30 "Gray30" "Girish Bharadwaj ") + (color-theme-kingsajz "Green Kingsajz" "Olgierd `Kingsajz' Ziolko ") + (color-theme-greiner "Greiner" "Kevin Greiner ") + (color-theme-gtk-ide "GTK IDE" "Gordon Messmer ") + (color-theme-high-contrast "High Contrast" "Alex Schroeder ") + (color-theme-hober "Hober" "Edward O'Connor ") + (color-theme-infodoc "Infodoc" "Frederic Giroud ") + (color-theme-jb-simple "JB Simple" "jeff@dvns.com") + (color-theme-jedit-grey "Jedit Grey" "Gordon Messmer ") + (color-theme-jonadabian "Jonadab" "Jonadab ") + (color-theme-jonadabian-slate "Jonadabian Slate" "Jonadab ") + (color-theme-katester "Katester" "Higgins_Walter@emc.com") + (color-theme-late-night "Late Night" "Alex Schroeder ") + (color-theme-lawrence "Lawrence" "lawrence mitchell ") + (color-theme-lethe "Lethe" "Ivica Loncar ") + (color-theme-ld-dark "Linh Dang Dark" "Linh Dang ") + (color-theme-marine "Marine" "Girish Bharadwaj ") + (color-theme-matrix "Matrix" "Walter Higgins ") + (color-theme-marquardt "Marquardt" "Colin Marquardt ") + (color-theme-midnight "Midnight" "Gordon Messmer ") + (color-theme-mistyday "Misty Day" "Hari Kumar ") + (color-theme-montz "Montz" "Brady Montz ") + (color-theme-oswald "Oswald" "Tom Oswald ") + (color-theme-parus "Parus" "Jon K Hellan ") + (color-theme-pierson "Pierson" "Dan L. Pierson ") + (color-theme-ramangalahy "Ramangalahy" "Solofo Ramangalahy ") + (color-theme-raspopovic "Raspopovic" "Pedja Raspopovic ") + (color-theme-resolve "Resolve" "Damien Elmes ") + (color-theme-retro-green "Retro Green" "Alex Schroeder ") + (color-theme-retro-orange "Retro Orange" "Alex Schroeder ") + (color-theme-robin-hood "Robin Hood" "Alex Schroeder ") + (color-theme-rotor "Rotor" "Jinwei Shen ") + (color-theme-ryerson "Ryerson" "Luis Fernandes ") + (color-theme-salmon-diff "Salmon Diff" "Alex Schroeder " t) + (color-theme-salmon-font-lock "Salmon Font-Lock" "Alex Schroeder " t) + (color-theme-scintilla "Scintilla" "Gordon Messmer ") + (color-theme-shaman "Shaman" "shaman@interdon.net") + (color-theme-sitaramv-nt "Sitaram NT" + "Sitaram Venkatraman ") + (color-theme-sitaramv-solaris "Sitaram Solaris" + "Sitaram Venkatraman ") + (color-theme-snow "Snow" "Nicolas Rist ") + (color-theme-snowish "Snowish" "Girish Bharadwaj ") + (color-theme-standard-ediff "Standard Ediff" "Emacs Team, added by Alex Schroeder " t) + (color-theme-standard "Standard Emacs 20" "Emacs Team, added by Alex Schroeder ") + (color-theme-emacs-21 "Standard Emacs 21" "Emacs Team, added by Alex Schroeder ") + (color-theme-emacs-nw "Standard Emacs 21 No Window" "Emacs Team, added by D. Goel ") + (color-theme-xemacs "Standard XEmacs" "XEmacs Team, added by Alex Schroeder ") + (color-theme-subtle-blue "Subtle Blue" "Chris McMahan ") + (color-theme-subtle-hacker "Subtle Hacker" "Colin Walters ") + (color-theme-taming-mr-arneson "Taming Mr Arneson" "Erik Arneson ") + (color-theme-taylor "Taylor" "Art Taylor ") + (color-theme-tty-dark "TTY Dark" "O Polite ") + (color-theme-vim-colors "Vim Colors" "Michael Soulier ") + (color-theme-whateveryouwant "Whateveryouwant" "Fabien Penso , color by Scott Jaderholm ") + (color-theme-wheat "Wheat" "Alex Schroeder ") + (color-theme-pok-wob "White On Black" "S. Pokrovsky ") + (color-theme-pok-wog "White On Grey" "S. Pokrovsky ") + (color-theme-word-perfect "WordPerfect" "Thomas Gehrlein ") + (color-theme-xp "XP" "Girish Bharadwaj ")) + "List of color themes. + +Each THEME is itself a three element list (FUNC NAME MAINTAINER &optional LIBRARY). + +FUNC is a color theme function which does the setup. The function +FUNC may call `color-theme-install'. The color theme function may be +interactive. + +NAME is the name of the theme and MAINTAINER is the name and/or email of +the maintainer of the theme. + +If LIBRARY is non-nil, the color theme will be considered a library and +may not be shown in the default menu. + +If you defined your own color theme and want to add it to this list, +use something like this: + + (add-to-list 'color-themes '(color-theme-gnome2 \"Gnome2\" \"Alex\"))") + +;;; Functions + +(defun color-theme-backup-original-values () + "Back up the original `default-frame-alist'. +The values are stored in `color-theme-original-frame-alist' on +startup." + (if (null color-theme-original-frame-alist) + (setq color-theme-original-frame-alist + (color-theme-filter (frame-parameters (selected-frame)) + color-theme-legal-frame-parameters)))) +(add-hook 'after-init-hook 'color-theme-backup-original-values) + +(defun color-theme-select (&optional arg) + "Displays a special buffer for selecting and installing a color theme. +With optional prefix ARG, this buffer will include color theme libraries +as well. A color theme library is in itself not complete, it must be +used as part of another color theme to be useful. Thus, color theme +libraries are mainly useful for color theme authors." + (interactive "P") + (switch-to-buffer (get-buffer-create color-theme-buffer-name)) + (setq buffer-read-only nil) + (erase-buffer) + ;; recreate the snapshot if necessary + (when (or (not (assq 'color-theme-snapshot color-themes)) + (not (commandp 'color-theme-snapshot))) + (fset 'color-theme-snapshot (color-theme-make-snapshot)) + (setq color-themes (delq (assq 'color-theme-snapshot color-themes) + color-themes) + color-themes (delq (assq 'bury-buffer color-themes) + color-themes) + color-themes (append '((color-theme-snapshot + "[Reset]" "Undo changes, if possible.") + (bury-buffer + "[Quit]" "Bury this buffer.")) + color-themes))) + (dolist (theme color-themes) + (let ((func (nth 0 theme)) + (name (nth 1 theme)) + (author (nth 2 theme)) + (library (nth 3 theme)) + (desc)) + (when (or (not library) arg) + (setq desc (format "%-23s %s" + (if library (concat name " [lib]") name) + author)) + (put-text-property 0 (length desc) 'color-theme func desc) + (put-text-property 0 (length name) 'face 'bold desc) + (put-text-property 0 (length name) 'mouse-face 'highlight desc) + (insert desc) + (newline)))) + (beginning-of-buffer) + (setq buffer-read-only t) + (set-buffer-modified-p nil) + (color-theme-mode)) + +(require 'easymenu) +(easy-menu-add-item nil '("Tools") "--") +(easy-menu-add-item nil '("Tools") + ["Color Themes" color-theme-select t]) + +(defun color-theme-mode () + "Major mode to select and install color themes. + +Use \\[color-theme-install-at-point] to install a color theme on all frames. +Use \\[color-theme-install-at-point-for-current-frame] to install a color theme for the current frame only. + +The changes are applied on top of your current setup. This is a +feature. + +Some of the themes should be considered extensions to the standard color +theme: they modify only a limited number of faces and variables. To +verify the final look of a color theme, install the standard color +theme, then install the other color theme. This is a feature. It allows +you to mix several color themes. + +Use \\[color-theme-describe] to read more about the color theme function at point. +If you want to install the color theme permanently, put the call to the +color theme function into your ~/.emacs: + + \(require 'color-theme) + \(color-theme-gnome2) + +If you worry about the size of color-theme.el: You are right. Use +\\[color-theme-print] to print the current color theme and save the resulting buffer +as ~/.emacs-color-theme. Now you can install only this specific color +theme in your .emacs: + + \(load-file \"~/.emacs-color-theme\") + \(my-color-theme) + +The Emacs menu is not affected by color themes within Emacs. Depending +on the toolkit you used to compile Emacs, you might have to set specific +X ressources. See the info manual for more information. Here is an +example ~/.Xdefaults fragment: + + emacs*Background: DarkSlateGray + emacs*Foreground: wheat + +\\{color-theme-mode-map} + +The color themes are listed in `color-themes', which see." + (kill-all-local-variables) + (setq major-mode 'color-theme-mode) + (setq mode-name "Color Themes") + (use-local-map color-theme-mode-map) + (when (functionp 'goto-address); Emacs + (goto-address)) + (run-hooks 'color-theme-mode-hook)) + +;;; Commands in Color Theme Selection mode + +(defun color-theme-describe () + "Describe color theme listed at point. +This shows the documentation of the value of text-property color-theme +at point. The text-property color-theme should be a color theme +function. See `color-themes'." + (interactive) + (describe-function (get-text-property (point) 'color-theme))) + +(defun color-theme-install-at-mouse (event) + "Install color theme clicked upon using the mouse. +First argument EVENT is used to set point. Then +`color-theme-install-at-point' is called." + (interactive "e") + (save-excursion + (mouse-set-point event) + (color-theme-install-at-point))) + +(defun color-theme-install-at-point () + "Install color theme at point. +This calls the value of the text-property `color-theme' at point. +The text-property `color-theme' should be a color theme function. +See `color-themes'." + (interactive) + (let ((func (get-text-property (point) 'color-theme))) + ;; install theme + (if func + (funcall func)) + ;; If goto-address is being used, remove all overlays in the current + ;; buffer and run it again. The face used for the mail addresses in + ;; the the color theme selection buffer is based on the variable + ;; goto-address-mail-face. Changes in that variable will not affect + ;; existing overlays, however, thereby confusing users. + (when (functionp 'goto-address); Emacs + (dolist (o (overlays-in (point-min) (point-max))) + (delete-overlay o)) + (goto-address)))) + +(defun color-theme-install-at-point-for-current-frame () + "Install color theme at point for current frame only. +Binds `color-theme-is-global' to nil and calls +`color-theme-install-at-point'." + (interactive) + (let ((color-theme-is-global nil)) + (color-theme-install-at-point))) + + + +;; Taking a snapshot of the current color theme and pretty printing it. + +(defun color-theme-filter (old-list regexp &optional exclude) + "Filter OLD-LIST. +The resulting list will be newly allocated and contains only elements +with names matching REGEXP. OLD-LIST may be a list or an alist. If you +want to filter a plist, use `color-theme-alist' to convert your plist to +an alist, first. + +If the optional argument EXCLUDE is non-nil, then the sense is +reversed: only non-matching elements will be retained." + (let (elem new-list) + (dolist (elem old-list) + (setq name (symbol-name (if (listp elem) (car elem) elem))) + (when (or (and (not exclude) + (string-match regexp name)) + (and exclude + (not (string-match regexp name)))) + ;; Now make sure that if elem is a cons cell, and the cdr of + ;; that cons cell is a string, then we need a *new* string in + ;; the new list. Having a new cons cell is of no use because + ;; modify-frame-parameters will modify this string, thus + ;; modifying our color theme functions! + (when (and (consp elem) + (stringp (cdr elem))) + (setq elem (cons (car elem) + (copy-sequence (cdr elem))))) + ;; Now store elem + (setq new-list (cons elem new-list)))) + new-list)) + +(defun color-theme-spec-filter (spec) + "Filter the attributes in SPEC. +This makes sure that SPEC has the form ((t (PLIST ...))). +Only properties not in `color-theme-illegal-default-attributes' +are included in the SPEC returned." + (let ((props (cadar spec)) + result prop val) + (while props + (setq prop (nth 0 props) + val (nth 1 props) + props (nthcdr 2 props)) + (unless (memq prop color-theme-illegal-default-attributes) + (setq result (cons val (cons prop result))))) + `((t ,(nreverse result))))) + +;; (color-theme-spec-filter '((t (:background "blue3")))) +;; (color-theme-spec-filter '((t (:stipple nil :background "Black" :foreground "SteelBlue" :inverse-video nil :box nil :strike-through nil :overline nil :underline nil :slant normal :weight normal :width semi-condensed :family "misc-fixed")))) + +(defun color-theme-plist-delete (plist prop) + "Delete property PROP from property list PLIST by side effect. +This modifies PLIST." + ;; deal with prop at the start + (while (eq (car plist) prop) + (setq plist (cddr plist))) + ;; deal with empty plist + (when plist + (let ((lastcell (cdr plist)) + (l (cddr plist))) + (while l + (if (eq (car l) prop) + (progn + (setq l (cddr l)) + (setcdr lastcell l)) + (setq lastcell (cdr l) + l (cddr l)))))) + plist) + +;; (color-theme-plist-delete '(a b c d e f g h) 'a) +;; (color-theme-plist-delete '(a b c d e f g h) 'b) +;; (color-theme-plist-delete '(a b c d e f g h) 'c) +;; (color-theme-plist-delete '(a b c d e f g h) 'g) +;; (color-theme-plist-delete '(a b c d c d e f g h) 'c) +;; (color-theme-plist-delete '(a b c d e f c d g h) 'c) + +(if (or (featurep 'xemacs) + (< emacs-major-version 21)) + (defalias 'color-theme-spec-compat 'identity) + (defun color-theme-spec-compat (spec) + "Filter the attributes in SPEC such that is is never invalid. +Example: Eventhough :bold works in Emacs, it is not recognized by +`customize-face' -- and then the face is uncustomizable. This +function replaces a :bold attribute with the corresponding :weight +attribute, if there is no :weight, or deletes it. This undoes the +doings of `color-theme-spec-canonical-font', more or less." + (let ((props (cadar spec))) + (when (plist-member props :bold) + (setq props (color-theme-plist-delete props :bold)) + (unless (plist-member props :weight) + (setq props (plist-put props :weight 'bold)))) + (when (plist-member props :italic) + (setq props (color-theme-plist-delete props :italic)) + (unless (plist-member props :slant) + (setq props (plist-put props :slant 'italic)))) + `((t ,props))))) + +;; (color-theme-spec-compat '((t (:foreground "blue" :bold t)))) +;; (color-theme-spec-compat '((t (:bold t :foreground "blue" :weight extra-bold)))) +;; (color-theme-spec-compat '((t (:italic t :foreground "blue")))) +;; (color-theme-spec-compat '((t (:slant oblique :italic t :foreground "blue")))) + +(defun color-theme-spec-canonical-font (atts) + "Add :bold and :italic attributes if necessary." + ;; add these to the front of atts -- this will keept the old value for + ;; customize-face in Emacs 21. + (when (and (memq (plist-get atts :weight) + '(ultra-bold extra-bold bold semi-bold)) + (not (plist-get atts :bold))) + (setq atts (cons :bold (cons t atts)))) + (when (and (not (memq (plist-get atts :slant) + '(normal nil))) + (not (plist-get atts :italic))) + (setq atts (cons :italic (cons t atts)))) + atts) +;; (color-theme-spec-canonical-font (color-theme-face-attr-construct 'bold (selected-frame))) +;; (defface foo '((t (:weight extra-bold))) "foo") +;; (color-theme-spec-canonical-font (color-theme-face-attr-construct 'foo (selected-frame))) +;; (face-spec-set 'foo '((t (:weight extra-bold))) nil) +;; (face-spec-set 'foo '((t (:bold t))) nil) +;; (face-spec-set 'foo '((t (:bold t :weight extra-bold))) nil) + +;; Handle :height according to NEWS file for Emacs 21 +(defun color-theme-spec-resolve-height (old new) + "Return the new height given OLD and NEW height. +OLD is the current setting, NEW is the setting inherited from." + (cond ((not old) + new) + ((integerp old) + old) + ((and (floatp old) + (integerp new)) + (round (* old new))) + ((and (floatp old) + (floatp new)) + (* old new)) + ((and (functionp old) + (integerp new)) + (round (funcall old new))) + ((and (functionp old) + (float new)) + `(lambda (f) (* (funcall ,old f) ,new))) + ((and (functionp old) + (functionp new)) + `(lambda (f) (* (funcall ,old (funcall ,new f))))) + (t + (error "Illegal :height attributes: %S or %S" old new)))) +;; (color-theme-spec-resolve-height 12 1.2) +;; (color-theme-spec-resolve-height 1.2 1.2) +;; (color-theme-spec-resolve-height 1.2 12) +;; (color-theme-spec-resolve-height 1.2 'foo) +;; (color-theme-spec-resolve-height (lambda (f) (* 2 f)) 5) +;; (color-theme-spec-resolve-height (lambda (f) (* 2 f)) 2.0) +;; the following lambda is the result from the above calculation +;; (color-theme-spec-resolve-height (lambda (f) (* (funcall (lambda (f) (* 2 f)) f) 2.0)) 5) + +(defun color-theme-spec-resolve-inheritance (atts) + "Resolve all occurences of the :inherit attribute." + (let ((face (plist-get atts :inherit))) + ;; From the Emacs 21 NEWS file: "Attributes from inherited faces are + ;; merged into the face like an underlying face would be." -- + ;; therefore properties of the inherited face only add missing + ;; attributes. + (when face + ;; remove :inherit face from atts -- this assumes only one + ;; :inherit attribute. + (setq atts (delq ':inherit (delq face atts))) + (let ((more-atts (color-theme-spec-resolve-inheritance + (color-theme-face-attr-construct + face (selected-frame)))) + att val) + (while more-atts + (setq att (car more-atts) + val (cadr more-atts) + more-atts (cddr more-atts)) + ;; Color-theme assumes that no value is ever 'unspecified. + (cond ((eq att ':height); cumulative effect! + (setq atts (plist-put atts + ':height + (color-theme-spec-resolve-height + (plist-get atts att) + val)))) + ;; Default: Only put if it has not been specified before. + ((not (plist-get atts att)) + (setq atts (cons att (cons val atts)))) + +)))) + atts)) +;; (color-theme-spec-resolve-inheritance '(:bold t)) +;; (color-theme-spec-resolve-inheritance '(:bold t :foreground "blue")) +;; (color-theme-face-attr-construct 'font-lock-comment-face (selected-frame)) +;; (color-theme-spec-resolve-inheritance '(:bold t :inherit font-lock-comment-face)) +;; (color-theme-spec-resolve-inheritance '(:bold t :foreground "red" :inherit font-lock-comment-face)) +;; (color-theme-face-attr-construct 'Info-title-2-face (selected-frame)) +;; (color-theme-face-attr-construct 'Info-title-3-face (selected-frame)) +;; (color-theme-face-attr-construct 'Info-title-4-face (selected-frame)) +;; (color-theme-spec-resolve-inheritance '(:inherit Info-title-2-face)) + +;; The :inverse-video attribute causes Emacs to swap foreground and +;; background colors, XEmacs does not. Therefore, if anybody chooses +;; the inverse-video attribute, we 1. swap the colors ourselves in Emacs +;; and 2. we remove the inverse-video attribute in Emacs and XEmacs. +;; Inverse-video is only useful on a monochrome tty. +(defun color-theme-spec-maybe-invert (atts) + "Remove the :inverse-video attribute from ATTS. +If ATTS contains :inverse-video t, remove it and swap foreground and +background color. Return ATTS." + (let ((inv (plist-get atts ':inverse-video))) + (if inv + (let (result att) + (while atts + (setq att (car atts) + atts (cdr atts)) + (cond ((and (eq att :foreground) (not color-theme-xemacs-p)) + (setq result (cons :background result))) + ((and (eq att :background) (not color-theme-xemacs-p)) + (setq result (cons :foreground result))) + ((eq att :inverse-video) + (setq atts (cdr atts))); this prevents using dolist + (t + (setq result (cons att result))))) + (nreverse result)) + ;; else + atts))) +;; (color-theme-spec-maybe-invert '(:bold t)) +;; (color-theme-spec-maybe-invert '(:foreground "blue")) +;; (color-theme-spec-maybe-invert '(:background "red")) +;; (color-theme-spec-maybe-invert '(:inverse-video t)) +;; (color-theme-spec-maybe-invert '(:inverse-video t :foreground "red")) +;; (color-theme-spec-maybe-invert '(:inverse-video t :background "red")) +;; (color-theme-spec-maybe-invert '(:inverse-video t :background "red" :foreground "blue" :bold t)) +;; (color-theme-spec-maybe-invert '(:inverse-video nil :background "red" :foreground "blue" :bold t)) + +(defun color-theme-spec (face) + "Return a list for FACE which has the form (FACE SPEC). +See `defface' for the format of SPEC. In this case we use only one +DISPLAY, t, and determine ATTS using `color-theme-face-attr-construct'. +If ATTS is nil, (nil) is used instead. + +If ATTS contains :inverse-video t, we remove it and swap foreground and +background color using `color-theme-spec-maybe-invert'. We do this +because :inverse-video is handled differently in Emacs and XEmacs. We +will loose on a tty without colors, because in that situation, +:inverse-video means something." + (let ((atts + (color-theme-spec-canonical-font + (color-theme-spec-maybe-invert + (color-theme-spec-resolve-inheritance + (color-theme-face-attr-construct face (selected-frame))))))) + (if atts + `(,face ((t ,atts))) + `(,face ((t (nil))))))) + +(defun color-theme-get-params () + "Return a list of frame parameter settings usable in a color theme. +Such an alist may be installed by `color-theme-install-frame-params'. The +frame parameters returned must match `color-theme-legal-frame-parameters'." + (let ((params (color-theme-filter (frame-parameters (selected-frame)) + color-theme-legal-frame-parameters))) + (sort params (lambda (a b) (string< (symbol-name (car a)) + (symbol-name (car b))))))) + +(defun color-theme-get-vars () + "Return a list of variable settings usable in a color theme. +Such an alist may be installed by `color-theme-install-variables'. +The variable names must match `color-theme-legal-variables', and the +variable must be a user variable according to `user-variable-p'." + (let ((vars) + (val)) + (mapatoms (lambda (v) + (and (boundp v) + (user-variable-p v) + (string-match color-theme-legal-variables + (symbol-name v)) + (setq val (eval v)) + (add-to-list 'vars (cons v val))))) + (sort vars (lambda (a b) (string< (car a) (car b)))))) + +(defun color-theme-print-alist (alist) + "Print ALIST." + (insert "\n " (if alist "(" "nil")) + (dolist (elem alist) + (when (= (preceding-char) ?\)) + (insert "\n ")) + (prin1 elem (current-buffer))) + (when (= (preceding-char) ?\)) (insert ")"))) + +(defun color-theme-get-faces () + "Return a list of faces usable in a color theme. +Such an alist may be installed by `color-theme-install-faces'. The +faces returned must not match `color-theme-illegal-faces'." + (let ((faces (color-theme-filter (face-list) color-theme-illegal-faces t))) + ;; default face must come first according to comments in + ;; custom-save-faces, the rest is to be sorted by name + (cons 'default (sort (delq 'default faces) 'string-lessp)))) + +(defun color-theme-get-face-definitions () + "Return face settings usable in a color-theme." + (let ((faces (color-theme-get-faces))) + (mapcar 'color-theme-spec faces))) + +(defun color-theme-print-faces (faces) + "Print face settings for all faces returned by `color-theme-get-faces'." + (when faces + (insert "\n ")) + (dolist (face faces) + (when (= (preceding-char) ?\)) + (insert "\n ")) + (prin1 face (current-buffer)))) + +(defun color-theme-reset-faces () + "Reset face settings for all faces returned by `color-theme-get-faces'." + (let ((faces (color-theme-get-faces)) + (face) (spec) (entry) + (frame (if color-theme-is-global nil (selected-frame)))) + (while faces + (setq entry (color-theme-spec (car faces))) + (setq face (nth 0 entry)) + (setq spec '((t (nil)))) + (setq faces (cdr faces)) + (if (functionp 'face-spec-reset-face) + (face-spec-reset-face face frame) + (face-spec-set face spec frame) + (if color-theme-is-global + (put face 'face-defface-spec spec)))))) + +(defun color-theme-print-theme (func doc params vars faces) + "Print a theme into the current buffer. +FUNC is the function name, DOC the doc string, PARAMS the +frame parameters, VARS the variable bindings, and FACES +the list of faces and their specs." + (insert "(defun " (symbol-name func) " ()\n" + " \"" doc "\"\n" + " (interactive)\n" + " (color-theme-install\n" + " '(" (symbol-name func)) + ;; alist of frame parameters + (color-theme-print-alist params) + ;; alist of variables + (color-theme-print-alist vars) + ;; remaining elements of snapshot: face specs + (color-theme-print-faces faces) + (insert ")))") + (goto-char (point-min))) + +(defun color-theme-print (&optional buf) + "Print the current color theme function. + +You can contribute this function to or +paste it into your .emacs file and call it. That should recreate all +the settings necessary for your color theme. + +Example: + + \(require 'color-theme) + \(defun my-color-theme () + \"Color theme by Alex Schroeder, created 2000-05-17.\" + \(interactive) + \(color-theme-install + '(... + ... + ...))) + \(my-color-theme) + +If you want to use a specific color theme function, you can call the +color theme function in your .emacs directly. + +Example: + + \(require 'color-theme) + \(color-theme-gnome2)" + (interactive) + (message "Pretty printing current color theme function...") + (switch-to-buffer (if buf + buf + (get-buffer-create "*Color Theme*"))) + (unless buf + (setq buffer-read-only nil) + (erase-buffer)) + ;; insert defun + (color-theme-print-theme 'my-color-theme + (concat "Color theme by " + (if (string= "" user-full-name) + (user-login-name) + user-full-name) + ", created " (format-time-string "%Y-%m-%d") ".") + (color-theme-get-params) + (color-theme-get-vars) + (mapcar 'color-theme-spec (color-theme-get-faces))) + (unless buf + (emacs-lisp-mode)) + (goto-char (point-min)) + (message "Pretty printing current color theme function... done")) + +(defun color-theme-analyze-find-theme (code) + "Find the sexpr that calls `color-theme-install'." + (let (theme) + (while (and (not theme) code) + (when (eq (car code) 'color-theme-install) + (setq theme code)) + (when (listp (car code)) + (setq theme (color-theme-analyze-find-theme (car code)))) + (setq code (cdr code))) + theme)) + +;; (equal (color-theme-analyze-find-theme +;; '(defun color-theme-blue-eshell () +;; "Color theme for eshell faces only." +;; (color-theme-install +;; '(color-theme-blue-eshell +;; nil +;; (eshell-ls-archive-face ((t (:bold t :foreground "IndianRed")))) +;; (eshell-ls-backup-face ((t (:foreground "Grey")))))))) +;; '(color-theme-install +;; (quote +;; (color-theme-blue-eshell +;; nil +;; (eshell-ls-archive-face ((t (:bold t :foreground "IndianRed")))) +;; (eshell-ls-backup-face ((t (:foreground "Grey"))))))))) + +(defun color-theme-analyze-add-face (a b regexp faces) + "If only one of A or B are in FACES, the other is added, and FACES is returned. +If REGEXP is given, this is only done if faces contains a match for regexps." + (when (or (not regexp) + (catch 'found + (dolist (face faces) + (when (string-match regexp (symbol-name (car face))) + (throw 'found t))))) + (let ((face-a (assoc a faces)) + (face-b (assoc b faces))) + (if (and face-a (not face-b)) + (setq faces (cons (list b (nth 1 face-a)) + faces)) + (if (and (not face-a) face-b) + (setq faces (cons (list a (nth 1 face-b)) + faces)))))) + faces) + +;; (equal (color-theme-analyze-add-face +;; 'blue 'violet nil +;; '((blue ((t (:foreground "blue")))) +;; (bold ((t (:bold t)))))) +;; '((violet ((t (:foreground "blue")))) +;; (blue ((t (:foreground "blue")))) +;; (bold ((t (:bold t)))))) +;; (equal (color-theme-analyze-add-face +;; 'violet 'blue nil +;; '((blue ((t (:foreground "blue")))) +;; (bold ((t (:bold t)))))) +;; '((violet ((t (:foreground "blue")))) +;; (blue ((t (:foreground "blue")))) +;; (bold ((t (:bold t)))))) +;; (equal (color-theme-analyze-add-face +;; 'violet 'blue "foo" +;; '((blue ((t (:foreground "blue")))) +;; (bold ((t (:bold t)))))) +;; '((blue ((t (:foreground "blue")))) +;; (bold ((t (:bold t)))))) +;; (equal (color-theme-analyze-add-face +;; 'violet 'blue "blue" +;; '((blue ((t (:foreground "blue")))) +;; (bold ((t (:bold t)))))) +;; '((violet ((t (:foreground "blue")))) +;; (blue ((t (:foreground "blue")))) +;; (bold ((t (:bold t)))))) + +(defun color-theme-analyze-add-faces (faces) + "Add missing faces to FACES and return it." + ;; The most important thing is to add missing faces for the other + ;; editor. These are the most important faces to check. The + ;; following rules list two faces, A and B. If either of the two is + ;; part of the theme, the other must be, too. The optional third + ;; argument specifies a regexp. Only if an existing face name + ;; matches this regexp, is the rule applied. + (let ((rules '((font-lock-builtin-face font-lock-reference-face) + (font-lock-doc-face font-lock-doc-string-face) + (font-lock-constant-face font-lock-preprocessor-face) + ;; In Emacs 21 `modeline' is just an alias for + ;; `mode-line'. I recommend the use of + ;; `modeline' until further notice. + (modeline mode-line) + (modeline modeline-buffer-id) + (modeline modeline-mousable) + (modeline modeline-mousable-minor-mode) + (region primary-selection) + (region zmacs-region) + (font-lock-string-face dired-face-boring "^dired") + (font-lock-function-name-face dired-face-directory "^dired") + (default dired-face-executable "^dired") + (font-lock-warning-face dired-face-flagged "^dired") + (font-lock-warning-face dired-face-marked "^dired") + (default dired-face-permissions "^dired") + (default dired-face-setuid "^dired") + (default dired-face-socket "^dired") + (font-lock-keyword-face dired-face-symlink "^dired") + (tool-bar menu)))) + (dolist (rule rules) + (setq faces (color-theme-analyze-add-face + (nth 0 rule) (nth 1 rule) (nth 2 rule) faces)))) + ;; The `fringe' face defines what the left and right borders of the + ;; frame look like in Emacs 21. To give them default fore- and + ;; background colors, use (fringe ((t (nil)))) in your color theme. + ;; Usually it makes more sense to choose a color slightly lighter or + ;; darker from the default background. + (unless (assoc 'fringe faces) + (setq faces (cons '(fringe ((t (nil)))) faces))) + ;; The tool-bar should not be part of the frame-parameters, since it + ;; should not appear or disappear depending on the color theme. The + ;; apppearance of the toolbar, however, can be changed by the color + ;; theme. For Emacs 21, use the `tool-bar' face. The easiest way + ;; to do this is to give it the default fore- and background colors. + ;; This can be achieved using (tool-bar ((t (nil)))) in the theme. + ;; Usually it makes more sense, however, to provide the same colors + ;; as used in the `menu' face, and to specify a :box attribute. In + ;; order to alleviate potential Emacs/XEmacs incompatibilities, + ;; `toolbar' will be defined as an alias for `tool-bar' if it does + ;; not exist, and vice-versa. This is done eventhough the face + ;; `toolbar' seems to have no effect on XEmacs. If you look at + ;; XEmacs lisp/faces.el, however, you will find that it is in fact + ;; referenced for XPM stuff. + (unless (assoc 'tool-bar faces) + (setq faces (cons '(tool-bar ((t (nil)))) faces))) + ;; Move the default face back to the front, and sort the rest. + (unless (eq (caar faces) 'default) + (let ((face (assoc 'default faces))) + (setq faces (cons face + (sort (delete face faces) + (lambda (a b) + (string-lessp (car a) (car b)))))))) + faces) + +(defun color-theme-analyze-remove-heights (faces) + "Remove :height property where it is an integer and return FACES." + ;; I don't recommend making font sizes part of a color theme. Most + ;; users would be surprised to see their font sizes change when they + ;; install a color-theme. Therefore, remove all :height attributes + ;; if the value is an integer. If the value is a float, this is ok + ;; -- the value is relative to the default height. One notable + ;; exceptions is for a color-theme created for visually impaired + ;; people. These *must* use a larger font in order to be usable. + (let (result) + (dolist (face faces) + (let ((props (cadar (nth 1 face)))) + (if (and (plist-member props :height) + (integerp (plist-get props :height))) + (setq props (color-theme-plist-delete props :height) + result (cons (list (car face) `((t ,props))) + result)) + (setq result (cons face result))))) + (nreverse result))) + +;; (equal (color-theme-analyze-remove-heights +;; '((blue ((t (:foreground "blue" :height 2)))) +;; (bold ((t (:bold t :height 1.0)))))) +;; '((blue ((t (:foreground "blue")))) +;; (bold ((t (:bold t :height 1.0)))))) + +(defun color-theme-analyze-defun () + "Once you have a color-theme printed, check for missing faces. +This is used by maintainers who receive a color-theme submission +and want to make sure it follows the guidelines by the color-theme +author." + ;; The support for :foreground and :background attributes works for + ;; Emacs 20 and 21 as well as for XEmacs. :inverse-video is taken + ;; care of while printing color themes. + (interactive) + ;; Parse the stuff and find the call to color-theme-install + (save-excursion + (save-restriction + (narrow-to-defun) + ;; define the function + (eval-defun nil) + (goto-char (point-min)) + (let* ((code (read (current-buffer))) + (theme (color-theme-canonic + (eval + (cadr + (color-theme-analyze-find-theme + code))))) + (func (color-theme-function theme)) + (doc (documentation func t)) + (variables (color-theme-variables theme)) + (faces (color-theme-faces theme)) + (params (color-theme-frame-params theme))) + (setq faces (color-theme-analyze-remove-heights + (color-theme-analyze-add-faces faces))) + ;; Remove any variable bindings of faces that point to their + ;; symbol? Perhaps not, because another theme might want to + ;; change this, so it is important to be able to reset them. + ;; (let (result) + ;; (dolist (var variables) + ;; (unless (eq (car var) (cdr var)) + ;; (setq result (cons var result)))) + ;; (setq variables (nreverse result))) + ;; Now modify the theme directly. + (setq theme (color-theme-analyze-find-theme code)) + (setcdr (cadadr theme) (list params variables faces)) + (message "Pretty printing analysed color theme function...") + (with-current-buffer (get-buffer-create "*Color Theme*") + (setq buffer-read-only nil) + (erase-buffer) + ;; insert defun + (color-theme-print-theme func doc params variables faces) + (emacs-lisp-mode)) + (message "Pretty printing analysed color theme function... done") + (ediff-buffers (current-buffer) + (get-buffer "*Color Theme*")))))) + +;;; Creating a snapshot of the current color theme + +(defun color-theme-snapshot nil) + +(defun color-theme-make-snapshot () + "Return the definition of the current color-theme. +The function returned will recreate the color-theme in use at the moment." + (eval `(lambda () + "The color theme in use when the selection buffer was created. +\\[color-theme-select] creates the color theme selection buffer. At the +same time, this snapshot is created as a very simple undo mechanism. +The snapshot is created via `color-theme-snapshot'." + (interactive) + (color-theme-install + '(color-theme-snapshot + ;; alist of frame parameters + ,(color-theme-get-params) + ;; alist of variables + ,(color-theme-get-vars) + ;; remaining elements of snapshot: face specs + ,@(color-theme-get-face-definitions)))))) + + + +;;; Handling the various parts of a color theme install + +(defvar color-theme-frame-param-frobbing-rules + '((foreground-color default foreground) + (background-color default background)) + "List of rules to use when frobbing faces based on frame parameters. +This is only necessary for XEmacs, because in Emacs 21 changing the +frame paramters automatically affects the relevant faces.") + +(defun color-theme-frob-faces (params) + "Change certain faces according to PARAMS. +This uses `color-theme-frame-param-frobbing-rules'." + (dolist (rule color-theme-frame-param-frobbing-rules) + (let* ((param (nth 0 rule)) + (face (nth 1 rule)) + (prop (nth 2 rule)) + (val (cdr (assq param params))) + (frame (if color-theme-is-global nil (selected-frame)))) + (when val + (set-face-property face prop val frame))))) + +(defun color-theme-alist-reduce (old-list) + "Reduce OLD-LIST. +The resulting list will be newly allocated and will not contain any elements +with duplicate cars. This will speed the installation of new themes by +only installing unique attributes." + (let (new-list) + (dolist (elem old-list) + (when (not (assq (car elem) new-list)) + (setq new-list (cons elem new-list)))) + new-list)) + +(defun color-theme-install-frame-params (params) + "Change frame parameters using alist PARAMETERS. + +If `color-theme-is-global' is non-nil, all frames are modified using +`modify-frame-parameters' and the PARAMETERS are prepended to +`default-frame-alist'. The value of `initial-frame-alist' is not +modified. If `color-theme-is-global' is nil, only the selected frame is +modified. If `color-theme-is-cumulative' is nil, the frame parameters +are restored from `color-theme-original-frame-alist'. + +If the current frame parameters have a parameter `minibuffer' with +value `only', then the frame parameters are not installed, since this +indicates a dedicated minibuffer frame. + +Called from `color-theme-install'." + (setq params (color-theme-filter + params color-theme-legal-frame-parameters)) + ;; We have a new list in params now, therefore we may use + ;; destructive nconc. + (if color-theme-is-global + (let ((frames (frame-list))) + (if (or color-theme-is-cumulative + (null color-theme-original-frame-alist)) + (setq default-frame-alist + (append params (color-theme-alist default-frame-alist)) + minibuffer-frame-alist + (append params (color-theme-alist minibuffer-frame-alist))) + (setq default-frame-alist + (append params color-theme-original-frame-alist) + minibuffer-frame-alist + (append params (color-theme-alist minibuffer-frame-alist)))) + (setq default-frame-alist + (color-theme-alist-reduce default-frame-alist) + minibuffer-frame-alist + (color-theme-alist-reduce minibuffer-frame-alist)) + (dolist (frame frames) + (let ((params (if (eq 'only (cdr (assq 'minibuffer (frame-parameters frame)))) + minibuffer-frame-alist + default-frame-alist))) + (condition-case var + (modify-frame-parameters frame params) + (error (message "Error using params %S: %S" params var)))))) + (condition-case var + (modify-frame-parameters (selected-frame) params) + (error (message "Error using params %S: %S" params var)))) + (when color-theme-xemacs-p + (color-theme-frob-faces params))) + +;; (setq default-frame-alist (cons '(height . 30) default-frame-alist)) + +(defun color-theme-install-variables (vars) + "Change variables using alist VARS. +All variables matching `color-theme-legal-variables' are set. + +If `color-theme-is-global' and `color-theme-xemacs-p' are nil, variables +are made frame-local before setting them. Variables are set using `set' +in either case. This may lead to problems if changing the variable +requires the usage of the function specified with the :set tag in +defcustom declarations. + +Called from `color-theme-install'." + (let ((vars (color-theme-filter vars color-theme-legal-variables))) + (dolist (var vars) + (if (or color-theme-is-global color-theme-xemacs-p) + (set (car var) (cdr var)) + (make-variable-frame-local (car var)) + (modify-frame-parameters (selected-frame) (list var)))))) + +(defun color-theme-install-faces (faces) + "Change faces using FACES. + +Change faces for all frames and create any faces listed in FACES which +don't exist. The modified faces will be marked as \"unchanged from +its standard setting\". This is OK, since the changes made by +installing a color theme should never by saved in .emacs by +customization code. + +FACES should be a list where each entry has the form: + + (FACE SPEC) + +See `defface' for the format of SPEC. + +If `color-theme-is-global' is non-nil, faces are modified on all frames +using `face-spec-set'. If `color-theme-is-global' is nil, faces are +only modified on the selected frame. Non-existing faces are created +using `make-empty-face' in either case. If `color-theme-is-cumulative' +is nil, all faces are reset before installing the new faces. + +Called from `color-theme-install'." + ;; clear all previous faces + (when (not color-theme-is-cumulative) + (color-theme-reset-faces)) + ;; install new faces + (let ((faces (color-theme-filter faces color-theme-illegal-faces t)) + (frame (if color-theme-is-global nil (selected-frame)))) + (dolist (entry faces) + (let ((face (nth 0 entry)) + (spec (nth 1 entry))) + (or (facep face) + (make-empty-face face)) + ;; remove weird properties from the default face only + (when (eq face 'default) + (setq spec (color-theme-spec-filter spec))) + ;; Emacs/XEmacs customization issues: filter out :bold when + ;; the spec contains :weight, etc, such that the spec remains + ;; "valid" for custom. + (setq spec (color-theme-spec-compat spec)) + ;; using a spec of ((t (nil))) to reset a face doesn't work + ;; in Emacs 21, we use the new function face-spec-reset-face + ;; instead + (if (and (functionp 'face-spec-reset-face) + (equal spec '((t (nil))))) + (face-spec-reset-face face frame) + (condition-case var + (progn + (face-spec-set face spec frame) + (if color-theme-is-global + (put face 'face-defface-spec spec))) + (error (message "Error using spec %S: %S" spec var)))))))) + +;; `custom-set-faces' is unusable here because it doesn't allow to set +;; the faces for one frame only. + +;; Emacs `face-spec-set': If FRAME is nil, the face is created and +;; marked as a customized face. This is achieved by setting the +;; `face-defface-spec' property. If we don't, new frames will not be +;; created using the face we installed because `face-spec-set' is +;; broken: If given a FRAME of nil, it will not set the default faces; +;; instead it will walk through all the frames and set modify the faces. +;; If we do set a property (`saved-face' or `face-defface-spec'), +;; `make-frame' will correctly use the faces we defined with our color +;; theme. If we used the property `saved-face', +;; `customize-save-customized' will save all the faces installed as part +;; of a color-theme in .emacs. That's why we use the +;; `face-defface-spec' property. + + + +;;; Theme accessor functions, canonicalization, merging, comparing + +(defun color-theme-canonic (theme) + "Return the canonic form of THEME. +This deals with all the backwards compatibility stuff." + (let (function frame-params variables faces) + (when (functionp (car theme)) + (setq function (car theme) + theme (cdr theme))) + (setq frame-params (car theme) + theme (cdr theme)) + ;; optional variable defintions (for backwards compatibility) + (when (listp (caar theme)) + (setq variables (car theme) + theme (cdr theme))) + ;; face definitions + (setq faces theme) + (list function frame-params variables faces))) + +(defun color-theme-function (theme) + "Return function used to create THEME." + (nth 0 theme)) + +(defun color-theme-frame-params (theme) + "Return frame-parameters defined by THEME." + (nth 1 theme)) + +(defun color-theme-variables (theme) + "Return variables set by THEME." + (nth 2 theme)) + +(defun color-theme-faces (theme) + "Return faces defined by THEME." + (nth 3 theme)) + +(defun color-theme-merge-alists (&rest alists) + "Merges all the alist arguments into one alist. +Only the first instance of every key will be part of the resulting +alist. Membership will be tested using `assq'." + (let (result) + (dolist (l alists) + (dolist (entry l) + (unless (assq (car entry) result) + (setq result (cons entry result))))) + (nreverse result))) +;; (color-theme-merge-alists '((a . 1) (b . 2))) +;; (color-theme-merge-alists '((a . 1) (b . 2) (a . 3))) +;; (color-theme-merge-alists '((a . 1) (b . 2)) '((a . 3))) +;; (color-theme-merge-alists '((a . 1) (b . 2)) '((c . 3))) +;; (color-theme-merge-alists '((a . 1) (b . 2)) '((c . 3) (d . 4))) +;; (color-theme-merge-alists '((a . 1) (b . 2)) '((c . 3) (d . 4) (b . 5))) + +(defun color-theme-compare (theme-a theme-b) + "Compare two color themes. +This will print the differences between installing THEME-A and +installing THEME-B. Note that the order is important: If a face is +defined in THEME-A and not in THEME-B, then this will not show up as a +difference, because there is no reset before installing THEME-B. If a +face is defined in THEME-B and not in THEME-A, then this will show up as +a difference." + (interactive + (list + (intern + (completing-read "Theme A: " + (mapcar (lambda (i) (list (symbol-name (car i)))) + color-themes) + (lambda (i) (string-match "color-theme" (car i))))) + (intern + (completing-read "Theme B: " + (mapcar (lambda (i) (list (symbol-name (car i)))) + color-themes) + (lambda (i) (string-match "color-theme" (car i))))))) + ;; install the themes in a new frame and get the definitions + (let ((color-theme-is-global nil)) + (select-frame (make-frame)) + (funcall theme-a) + (setq theme-a (list theme-a + (color-theme-get-params) + (color-theme-get-vars) + (color-theme-get-face-definitions))) + (funcall theme-b) + (setq theme-b (list theme-b + (color-theme-get-params) + (color-theme-get-vars) + (color-theme-get-face-definitions))) + (delete-frame)) + (let ((params (set-difference + (color-theme-frame-params theme-b) + (color-theme-frame-params theme-a) + :test 'equal)) + (vars (set-difference + (color-theme-variables theme-b) + (color-theme-variables theme-a) + :test 'equal)) + (faces (set-difference + (color-theme-faces theme-b) + (color-theme-faces theme-a) + :test 'equal))) + (list 'diff + params + vars + faces))) + + + +;;; Installing a color theme + +(defun color-theme-install (theme) + "Install a color theme defined by frame parameters, variables and faces. + +The theme is installed for all present and future frames; any missing +faces are created. See `color-theme-install-faces'. + +THEME is a color theme definition. See below for more information. + +If you want to install a color theme from your .emacs, use the output +generated by `color-theme-print'. This produces color theme function +which you can copy to your .emacs. + +A color theme definition is a list: +\([FUNCTION] FRAME-PARAMETERS VARIABLE-SETTINGS FACE-DEFINITIONS) + +FUNCTION is the color theme function which called `color-theme-install'. +This is no longer used. There was a time when this package supported +automatic factoring of color themes. This has been abandoned. + +FRAME-PARAMETERS is an alist of frame parameters. These are installed +with `color-theme-install-frame-params'. These are installed last such +that any changes to the default face can be changed by the frame +parameters. + +VARIABLE-DEFINITIONS is an alist of variable settings. These are +installed with `color-theme-install-variables'. + +FACE-DEFINITIONS is an alist of face definitions. These are installed +with `color-theme-install-faces'. + +If `color-theme-is-cumulative' is nil, a color theme will undo face and +frame-parameter settings of previous color themes." + (setq theme (color-theme-canonic theme)) + (color-theme-install-variables (color-theme-variables theme)) + (color-theme-install-faces (color-theme-faces theme)) + ;; frame parameters override faces + (color-theme-install-frame-params (color-theme-frame-params theme)) + (when color-theme-history-max-length + (color-theme-add-to-history + (car theme)))) + + + +;; Sharing your stuff + +(defun color-theme-submit () + "Submit your color-theme to the maintainer." + (interactive) + (require 'reporter) + (let ((reporter-eval-buffer (current-buffer)) + final-resting-place + after-sep-pos + (reporter-status-message "Formatting buffer...") + (reporter-status-count 0) + (problem "Yet another color-theme") + (agent (reporter-compose-outgoing)) + (mailbuf (current-buffer)) + hookvar) + ;; do the work + (require 'sendmail) + ;; If mailbuf did not get made visible before, make it visible now. + (let (same-window-buffer-names same-window-regexps) + (pop-to-buffer mailbuf) + ;; Just in case the original buffer is not visible now, bring it + ;; back somewhere + (and pop-up-windows (display-buffer reporter-eval-buffer))) + (goto-char (point-min)) + (mail-position-on-field "to") + (insert color-theme-maintainer-address) + (mail-position-on-field "subject") + (insert problem) + ;; move point to the body of the message + (mail-text) + (setq after-sep-pos (point)) + (unwind-protect + (progn + (setq final-resting-place (point-marker)) + (goto-char final-resting-place)) + (color-theme-print (current-buffer)) + (goto-char final-resting-place) + (insert "\n\n") + (goto-char final-resting-place) + (insert "Hello there!\n\nHere's my color theme named: ") + (set-marker final-resting-place nil)) + ;; compose the minibuf message and display this. + (let* ((sendkey-whereis (where-is-internal + (get agent 'sendfunc) nil t)) + (abortkey-whereis (where-is-internal + (get agent 'abortfunc) nil t)) + (sendkey (if sendkey-whereis + (key-description sendkey-whereis) + "C-c C-c")); TBD: BOGUS hardcode + (abortkey (if abortkey-whereis + (key-description abortkey-whereis) + "M-x kill-buffer"))); TBD: BOGUS hardcode + (message "Enter a message and type %s to send or %s to abort." + sendkey abortkey)))) + + + +;;; The color theme functions + +(defun color-theme-gnome () + "Wheat on darkslategrey scheme. +From one version of Emacs in RH6 and Gnome, modified by Jonadab." + (interactive) + (color-theme-install + '(color-theme-gnome + ((foreground-color . "wheat") + (background-color . "darkslategrey") + (background-mode . dark)) + (default ((t (nil)))) + (region ((t (:foreground "cyan" :background "dark cyan")))) + (underline ((t (:foreground "yellow" :underline t)))) + (modeline ((t (:foreground "dark cyan" :background "wheat")))) + (modeline-buffer-id ((t (:foreground "dark cyan" :background "wheat")))) + (modeline-mousable ((t (:foreground "dark cyan" :background "wheat")))) + (modeline-mousable-minor-mode ((t (:foreground "dark cyan" :background "wheat")))) + (italic ((t (:foreground "dark red" :italic t)))) + (bold-italic ((t (:foreground "dark red" :bold t :italic t)))) + (font-lock-comment-face ((t (:foreground "Firebrick")))) + (bold ((t (:bold))))))) + +(defun color-theme-blue-gnus () + "Color theme for gnus and message faces only. +This is intended for other color themes to use (eg. `color-theme-gnome2' +and `color-theme-blue-sea')." + (interactive) + (color-theme-install + '(color-theme-blue-gnus + nil + (gnus-cite-attribution-face ((t (:lforeground "lemon chiffon" :bold t)))) + (gnus-cite-face-1 ((t (:foreground "LightSalmon")))) + (gnus-cite-face-2 ((t (:foreground "Khaki")))) + (gnus-cite-face-3 ((t (:foreground "Coral")))) + (gnus-cite-face-4 ((t (:foreground "yellow green")))) + (gnus-cite-face-5 ((t (:foreground "dark khaki")))) + (gnus-cite-face-6 ((t (:foreground "bisque")))) + (gnus-cite-face-7 ((t (:foreground "peru")))) + (gnus-cite-face-8 ((t (:foreground "light coral")))) + (gnus-cite-face-9 ((t (:foreground "plum")))) + (gnus-emphasis-bold ((t (:bold t)))) + (gnus-emphasis-bold-italic ((t (:italic t :bold t)))) + (gnus-emphasis-highlight-words ((t (:background "black" :foreground "yellow")))) + (gnus-emphasis-italic ((t (:italic t)))) + (gnus-emphasis-underline ((t (:underline t)))) + (gnus-emphasis-underline-bold ((t (:bold t :underline t)))) + (gnus-emphasis-underline-bold-italic ((t (:italic t :bold t :underline t)))) + (gnus-emphasis-underline-italic ((t (:italic t :underline t)))) + (gnus-group-mail-1-empty-face ((t (:foreground "White")))) + (gnus-group-mail-1-face ((t (:bold t :foreground "White")))) + (gnus-group-mail-2-empty-face ((t (:foreground "light cyan")))) + (gnus-group-mail-2-face ((t (:bold t :foreground "light cyan")))) + (gnus-group-mail-3-empty-face ((t (:foreground "LightBlue")))) + (gnus-group-mail-3-face ((t (:bold t :foreground "LightBlue")))) + (gnus-group-mail-low-empty-face ((t (:foreground "Aquamarine")))) + (gnus-group-mail-low-face ((t (:bold t :foreground "Aquamarine")))) + (gnus-group-news-1-empty-face ((t (:foreground "White")))) + (gnus-group-news-1-face ((t (:bold t :foreground "White")))) + (gnus-group-news-2-empty-face ((t (:foreground "light cyan")))) + (gnus-group-news-2-face ((t (:bold t :foreground "light cyan")))) + (gnus-group-news-3-empty-face ((t (:foreground "LightBlue")))) + (gnus-group-news-3-face ((t (:bold t :foreground "LightBlue")))) + (gnus-group-news-4-empty-face ((t (:foreground "Aquamarine")))) + (gnus-group-news-4-face ((t (:bold t :foreground "Aquamarine")))) + (gnus-group-news-5-empty-face ((t (:foreground "MediumAquamarine")))) + (gnus-group-news-5-face ((t (:bold t :foreground "MediumAquamarine")))) + (gnus-group-news-6-empty-face ((t (:foreground "MediumAquamarine")))) + (gnus-group-news-6-face ((t (:bold t :foreground "MediumAquamarine")))) + (gnus-group-news-low-empty-face ((t (:foreground "MediumAquamarine")))) + (gnus-group-news-low-face ((t (:bold t :foreground "MediumAquamarine")))) + (gnus-header-content-face ((t (:foreground "LightSkyBlue3")))) + (gnus-header-from-face ((t (:bold t :foreground "light cyan")))) + (gnus-header-name-face ((t (:bold t :foreground "LightBlue")))) + (gnus-header-newsgroups-face ((t (:bold t :foreground "MediumAquamarine")))) + (gnus-header-subject-face ((t (:bold t :foreground "light cyan")))) + (gnus-signature-face ((t (:foreground "Grey")))) + (gnus-splash-face ((t (:foreground "ForestGreen")))) + (gnus-summary-cancelled-face ((t (:background "Black" :foreground "Yellow")))) + (gnus-summary-high-ancient-face ((t (:bold t :foreground "MediumAquamarine")))) + (gnus-summary-high-read-face ((t (:bold t :foreground "Aquamarine")))) + (gnus-summary-high-ticked-face ((t (:bold t :foreground "LightSalmon")))) + (gnus-summary-high-unread-face ((t (:bold t :foreground "beige")))) + (gnus-summary-low-ancient-face ((t (:foreground "DimGray")))) + (gnus-summary-low-read-face ((t (:foreground "slate gray")))) + (gnus-summary-low-ticked-face ((t (:foreground "Pink")))) + (gnus-summary-low-unread-face ((t (:foreground "LightGray")))) + (gnus-summary-normal-ancient-face ((t (:foreground "MediumAquamarine")))) + (gnus-summary-normal-read-face ((t (:foreground "Aquamarine")))) + (gnus-summary-normal-ticked-face ((t (:foreground "LightSalmon")))) + (gnus-summary-normal-unread-face ((t (nil)))) + (gnus-summary-selected-face ((t (:background "DarkSlateBlue")))) + (message-cited-text-face ((t (:foreground "LightSalmon")))) + (message-header-cc-face ((t (:foreground "light cyan")))) + (message-header-name-face ((t (:foreground "LightBlue")))) + (message-header-newsgroups-face ((t (:bold t :foreground "MediumAquamarine")))) + (message-header-other-face ((t (:foreground "MediumAquamarine")))) + (message-header-subject-face ((t (:bold t :foreground "light cyan")))) + (message-header-to-face ((t (:bold t :foreground "light cyan")))) + (message-header-xheader-face ((t (:foreground "MediumAquamarine")))) + (message-separator-face ((t (:foreground "chocolate"))))))) + +(defun color-theme-dark-gnus () + "Color theme for gnus and message faces only. +This is intended for other color themes to use +\(eg. `color-theme-late-night')." + (interactive) + (color-theme-install + '(color-theme-blue-gnus + nil + (gnus-cite-attribution-face ((t (:foreground "#bbb")))) + (gnus-cite-face-1 ((t (:foreground "#aaa")))) + (gnus-cite-face-2 ((t (:foreground "#aaa")))) + (gnus-cite-face-3 ((t (:foreground "#aaa")))) + (gnus-cite-face-4 ((t (:foreground "#aaa")))) + (gnus-cite-face-5 ((t (:foreground "#aaa")))) + (gnus-cite-face-6 ((t (:foreground "#aaa")))) + (gnus-cite-face-7 ((t (:foreground "#aaa")))) + (gnus-cite-face-8 ((t (:foreground "#aaa")))) + (gnus-cite-face-9 ((t (:foreground "#aaa")))) + (gnus-emphasis-bold ((t (:bold t)))) + (gnus-emphasis-bold-italic ((t (:italic t :bold t)))) + (gnus-emphasis-highlight-words ((t (:foreground "#ccc")))) + (gnus-emphasis-italic ((t (:italic t)))) + (gnus-emphasis-underline ((t (:underline t)))) + (gnus-emphasis-underline-bold ((t (:bold t :underline t)))) + (gnus-emphasis-underline-bold-italic ((t (:italic t :bold t :underline t)))) + (gnus-emphasis-underline-italic ((t (:italic t :underline t)))) + (gnus-group-mail-1-empty-face ((t (:foreground "#999")))) + (gnus-group-mail-1-face ((t (:bold t :foreground "#999")))) + (gnus-group-mail-2-empty-face ((t (:foreground "#999")))) + (gnus-group-mail-2-face ((t (:bold t :foreground "#999")))) + (gnus-group-mail-3-empty-face ((t (:foreground "#888")))) + (gnus-group-mail-3-face ((t (:bold t :foreground "#888")))) + (gnus-group-mail-low-empty-face ((t (:foreground "#777")))) + (gnus-group-mail-low-face ((t (:bold t :foreground "#777")))) + (gnus-group-news-1-empty-face ((t (:foreground "#999")))) + (gnus-group-news-1-face ((t (:bold t :foreground "#999")))) + (gnus-group-news-2-empty-face ((t (:foreground "#888")))) + (gnus-group-news-2-face ((t (:bold t :foreground "#888")))) + (gnus-group-news-3-empty-face ((t (:foreground "#777")))) + (gnus-group-news-3-face ((t (:bold t :foreground "#777")))) + (gnus-group-news-4-empty-face ((t (:foreground "#666")))) + (gnus-group-news-4-face ((t (:bold t :foreground "#666")))) + (gnus-group-news-5-empty-face ((t (:foreground "#666")))) + (gnus-group-news-5-face ((t (:bold t :foreground "#666")))) + (gnus-group-news-6-empty-face ((t (:foreground "#666")))) + (gnus-group-news-6-face ((t (:bold t :foreground "#666")))) + (gnus-group-news-low-empty-face ((t (:foreground "#666")))) + (gnus-group-news-low-face ((t (:bold t :foreground "#666")))) + (gnus-header-content-face ((t (:foreground "#888")))) + (gnus-header-from-face ((t (:bold t :foreground "#888")))) + (gnus-header-name-face ((t (:bold t :foreground "#777")))) + (gnus-header-newsgroups-face ((t (:bold t :foreground "#777")))) + (gnus-header-subject-face ((t (:bold t :foreground "#999")))) + (gnus-signature-face ((t (:foreground "#444")))) + (gnus-splash-face ((t (:foreground "#ccc")))) + (gnus-summary-cancelled-face ((t (:background "#555" :foreground "#000")))) + (gnus-summary-high-ancient-face ((t (:bold t :foreground "#555")))) + (gnus-summary-high-read-face ((t (:bold t :foreground "#666")))) + (gnus-summary-high-ticked-face ((t (:bold t :foreground "#777")))) + (gnus-summary-high-unread-face ((t (:bold t :foreground "#888")))) + (gnus-summary-low-ancient-face ((t (:foreground "#444")))) + (gnus-summary-low-read-face ((t (:foreground "#555")))) + (gnus-summary-low-ticked-face ((t (:foreground "#666")))) + (gnus-summary-low-unread-face ((t (:foreground "#777")))) + (gnus-summary-normal-ancient-face ((t (:foreground "#555")))) + (gnus-summary-normal-read-face ((t (:foreground "#666")))) + (gnus-summary-normal-ticked-face ((t (:foreground "#777")))) + (gnus-summary-normal-unread-face ((t (:foreground "#888")))) + (gnus-summary-selected-face ((t (:background "#333")))) + (message-cited-text-face ((t (:foreground "#aaa")))) + (message-header-cc-face ((t (:foreground "#888")))) + (message-header-name-face ((t (:bold t :foreground "#777")))) + (message-header-newsgroups-face ((t (:bold t :foreground "#777")))) + (message-header-other-face ((t (:foreground "#666")))) + (message-header-subject-face ((t (:bold t :foreground "#999")))) + (message-header-to-face ((t (:bold t :foreground "#777")))) + (message-header-xheader-face ((t (:foreground "#666")))) + (message-separator-face ((t (:foreground "#999"))))))) + +(defun color-theme-blue-eshell () + "Color theme for eshell faces only. +This is intended for other color themes to use (eg. `color-theme-gnome2')." + (interactive) + (color-theme-install + '(color-theme-blue-eshell + nil + (eshell-ls-archive-face ((t (:bold t :foreground "IndianRed")))) + (eshell-ls-backup-face ((t (:foreground "Grey")))) + (eshell-ls-clutter-face ((t (:foreground "DimGray")))) + (eshell-ls-directory-face ((t (:bold t :foreground "MediumSlateBlue")))) + (eshell-ls-executable-face ((t (:foreground "Coral")))) + (eshell-ls-missing-face ((t (:foreground "black")))) + (eshell-ls-picture-face ((t (:foreground "Violet")))) ; non-standard face + (eshell-ls-product-face ((t (:foreground "LightSalmon")))) + (eshell-ls-readonly-face ((t (:foreground "Aquamarine")))) + (eshell-ls-special-face ((t (:foreground "Gold")))) + (eshell-ls-symlink-face ((t (:foreground "White")))) + (eshell-ls-text-face ((t (:foreground "medium aquamarine")))) ; non-standard face + (eshell-ls-todo-face ((t (:bold t :foreground "aquamarine")))) ; non-standard face + (eshell-ls-unreadable-face ((t (:foreground "DimGray")))) + (eshell-prompt-face ((t (:foreground "powder blue"))))))) + +(defun color-theme-salmon-font-lock () + "Color theme for font-lock faces only. +This is intended for other color themes to use (eg. `color-theme-gnome2')." + (interactive) + (color-theme-install + '(color-theme-salmon-font-lock + nil + (font-lock-builtin-face ((t (:bold t :foreground "PaleGreen")))) + (font-lock-comment-face ((t (:foreground "LightBlue")))) + (font-lock-constant-face ((t (:foreground "Aquamarine")))) + (font-lock-doc-string-face ((t (:foreground "LightSalmon")))) + (font-lock-function-name-face ((t (:bold t :foreground "Aquamarine")))) + (font-lock-keyword-face ((t (:foreground "Salmon")))) + (font-lock-preprocessor-face ((t (:foreground "Salmon")))) + (font-lock-reference-face ((t (:foreground "pale green")))) + (font-lock-string-face ((t (:foreground "LightSalmon")))) + (font-lock-type-face ((t (:bold t :foreground "YellowGreen")))) + (font-lock-variable-name-face ((t (:bold t :foreground "Aquamarine")))) + (font-lock-warning-face ((t (:bold t :foreground "red"))))))) + +(defun color-theme-dark-font-lock () + "Color theme for font-lock faces only. +This is intended for other color themes to use (eg. `color-theme-late-night')." + (interactive) + (color-theme-install + '(color-theme-dark-font-lock + nil + (font-lock-builtin-face ((t (:bold t :foreground "#777")))) + (font-lock-comment-face ((t (:foreground "#555")))) + (font-lock-constant-face ((t (:foreground "#777")))) + (font-lock-doc-string-face ((t (:foreground "#777")))) + (font-lock-doc-face ((t (:foreground "#777")))) + (font-lock-function-name-face ((t (:bold t :foreground "#777")))) + (font-lock-keyword-face ((t (:foreground "#777")))) + (font-lock-preprocessor-face ((t (:foreground "#777")))) + (font-lock-reference-face ((t (:foreground "#777")))) + (font-lock-string-face ((t (:foreground "#777")))) + (font-lock-type-face ((t (:bold t)))) + (font-lock-variable-name-face ((t (:bold t :foreground "#888")))) + (font-lock-warning-face ((t (:bold t :foreground "#999"))))))) + +(defun color-theme-dark-info () + "Color theme for info, help and apropos faces. +This is intended for other color themes to use (eg. `color-theme-late-night')." + (interactive) + (color-theme-install + '(color-theme-dark-info + nil + (info-header-node ((t (:foreground "#666")))) + (info-header-xref ((t (:foreground "#666")))) + (info-menu-5 ((t (:underline t)))) + (info-menu-header ((t (:bold t :foreground "#666")))) + (info-node ((t (:bold t :foreground "#888")))) + (info-xref ((t (:bold t :foreground "#777"))))))) + +(defun color-theme-gnome2 () + "Wheat on darkslategrey scheme. +`color-theme-gnome' started it all. + +This theme supports standard faces, font-lock, eshell, info, message, +gnus, custom, widget, woman, diary, cperl, bbdb, and erc. This theme +includes faces for Emacs and XEmacs. + +The theme does not support w3 faces because w3 faces can be controlled +by your default style sheet. + +This is what you should put in your .Xdefaults file, if you want to +change the colors of the menus in Emacs 20 as well: + +emacs*Background: DarkSlateGray +emacs*Foreground: Wheat" + (interactive) + (color-theme-blue-gnus) + (let ((color-theme-is-cumulative t)) + (color-theme-blue-erc) + (color-theme-blue-eshell) + (color-theme-salmon-font-lock) + (color-theme-salmon-diff) + (color-theme-install + '(color-theme-gnome2 + ((foreground-color . "wheat") + (background-color . "darkslategrey") + (mouse-color . "Grey") + (cursor-color . "LightGray") + (border-color . "black") + (background-mode . dark)) + ((apropos-keybinding-face . underline) + (apropos-label-face . italic) + (apropos-match-face . secondary-selection) + (apropos-property-face . bold-italic) + (apropos-symbol-face . info-xref) + (goto-address-mail-face . message-header-to-face) + (goto-address-mail-mouse-face . secondary-selection) + (goto-address-url-face . info-xref) + (goto-address-url-mouse-face . highlight) + (list-matching-lines-face . bold) + (view-highlight-face . highlight)) + (default ((t (nil)))) + (bbdb-company ((t (:foreground "pale green")))) + (bbdb-name ((t (:bold t :foreground "pale green")))) + (bbdb-field-name ((t (:foreground "medium sea green")))) + (bbdb-field-value ((t (:foreground "dark sea green")))) + (bold ((t (:bold t)))) + (bold-italic ((t (:italic t :bold t :foreground "beige")))) + (calendar-today-face ((t (:underline t)))) + (comint-highlight-prompt ((t (:foreground "medium aquamarine")))) + (cperl-array-face ((t (:foreground "Yellow")))) + (cperl-hash-face ((t (:foreground "White")))) + (cperl-nonoverridable-face ((t (:foreground "SkyBlue")))) + (custom-button-face ((t (:underline t :foreground "MediumSlateBlue")))) + (custom-documentation-face ((t (:foreground "Grey")))) + (custom-group-tag-face ((t (:foreground "MediumAquamarine")))) + (custom-state-face ((t (:foreground "LightSalmon")))) + (custom-variable-tag-face ((t (:foreground "Aquamarine")))) + (diary-face ((t (:foreground "IndianRed")))) + (dired-face-directory ((t (:bold t :foreground "sky blue")))) + (dired-face-permissions ((t (:foreground "aquamarine")))) + (dired-face-flagged ((t (:foreground "tomato")))) + (dired-face-marked ((t (:foreground "light salmon")))) + (dired-face-executable ((t (:foreground "green yellow")))) + (fringe ((t (:background "darkslategrey")))) + (highlight ((t (:background "PaleGreen" :foreground "DarkGreen")))) + (highline-face ((t (:background "SeaGreen")))) + (holiday-face ((t (:background "DimGray")))) + (hyper-apropos-hyperlink ((t (:bold t :foreground "DodgerBlue1")))) + (hyper-apropos-documentation ((t (:foreground "LightSalmon")))) + (info-header-xref ((t (:foreground "DodgerBlue1" :bold t)))) + (info-menu-5 ((t (:underline t)))) + (info-node ((t (:underline t :bold t :foreground "DodgerBlue1")))) + (info-xref ((t (:bold t :foreground "DodgerBlue1")))) + (isearch ((t (:background "sea green")))) + (italic ((t (:italic t)))) + (menu ((t (:foreground "wheat" :background "darkslategrey")))) + (modeline ((t (:background "dark olive green" :foreground "wheat")))) + (modeline-buffer-id ((t (:background "dark olive green" :foreground "beige")))) + (modeline-mousable ((t (:background "dark olive green" :foreground "yellow green")))) + (modeline-mousable-minor-mode ((t (:background "dark olive green" :foreground "wheat")))) + (region ((t (:background "dark cyan" :foreground "cyan")))) + (secondary-selection ((t (:background "Aquamarine" :foreground "SlateBlue")))) + (show-paren-match-face ((t (:bold t :background "Aquamarine" :foreground "steel blue")))) + (show-paren-mismatch-face ((t (:background "Red" :foreground "White")))) + (underline ((t (:underline t)))) + (widget-field-face ((t (:foreground "LightBlue")))) + (widget-inactive-face ((t (:foreground "DimGray")))) + (widget-single-line-field-face ((t (:foreground "LightBlue")))) + (w3m-anchor-face ((t (:bold t :foreground "DodgerBlue1")))) + (w3m-arrived-anchor-face ((t (:bold t :foreground "DodgerBlue3")))) + (w3m-header-line-location-title-face ((t (:foreground "beige" :background "dark olive green")))) + (w3m-header-line-location-content-face ((t (:foreground "wheat" :background "dark olive green")))) + (woman-bold-face ((t (:bold t)))) + (woman-italic-face ((t (:foreground "beige")))) + (woman-unknown-face ((t (:foreground "LightSalmon")))) + (zmacs-region ((t (:background "dark cyan" :foreground "cyan")))))))) + +(defun color-theme-simple-1 () + "Black background. +Doesn't mess with most faces, but does turn on dark background mode." + (interactive) + (color-theme-install + '(color-theme-simple-1 + ((foreground-color . "white") + (background-color . "black") + (cursor-color . "indian red") + (background-mode . dark)) + (default ((t (nil)))) + (modeline ((t (:foreground "black" :background "white")))) + (modeline-buffer-id ((t (:foreground "black" :background "white")))) + (modeline-mousable ((t (:foreground "black" :background "white")))) + (modeline-mousable-minor-mode ((t (:foreground "black" :background "white")))) + (underline ((t (:underline t)))) + (region ((t (:background "grey"))))))) + +(defun color-theme-jonadabian () + "Dark blue background. +Supports standard faces, font-lock, highlight-changes, widget and +custom." + (interactive) + (color-theme-install + '(color-theme-jonadabian + ((foreground-color . "#CCBB77") + (cursor-color . "medium turquoise") + (background-color . "#000055") + (background-mode . dark)) + (default ((t (nil)))) + (modeline ((t (:foreground "cyan" :background "#007080")))) + (modeline-buffer-id ((t (:foreground "cyan" :background "#007080")))) + (modeline-mousable ((t (:foreground "cyan" :background "#007080")))) + (modeline-mousable-minor-mode ((t (:foreground "cyan" :background "#007080")))) + (underline ((t (:underline t)))) + (region ((t (:background "#004080")))) + (font-lock-keyword-face ((t (:foreground "#00BBBB")))) + (font-lock-comment-face ((t (:foreground "grey50" :bold t :italic t)))) + (font-lock-string-face ((t (:foreground "#10D010")))) + (font-lock-constant-face ((t (:foreground "indian red")))) + (highlight-changes-face ((t (:background "navy")))) + (highlight-changes-delete-face ((t (:foreground "red" :background "navy")))) + (widget-field-face ((t (:foreground "black" :background "grey35")))) + (widget-inactive-face ((t (:foreground "gray")))) + (custom-button-face ((t (:foreground "yellow" :background "dark blue")))) + (custom-state-face ((t (:foreground "mediumaquamarine")))) + (custom-face-tag-face ((t (:foreground "goldenrod" :underline t)))) + (custom-documentation-face ((t (:foreground "#10D010")))) + (custom-set-face ((t (:foreground "#2020D0"))))))) + +(defun color-theme-ryerson () + "White on midnightblue scheme. +Used at Ryerson Polytechnic University in the Electronic Engineering department." + (interactive) + (color-theme-install + '(color-theme-ryerson + ((foreground-color . "white") + (background-color . "midnightblue") + (cursor-color . "red") + (background-mode . dark)) + (default ((t (nil)))) + (modeline ((t (:foreground "black" :background "slategray3")))) + (modeline-buffer-id ((t (:foreground "black" :background "slategray3")))) + (modeline-mousable ((t (:foreground "black" :background "slategray3")))) + (modeline-mousable-minor-mode ((t (:foreground "black" :background "slategray3")))) + (underline ((t (:underline t)))) + (region ((t (:foreground "black" :background "slategray3"))))))) + +(defun color-theme-wheat () + "Default colors on a wheat background. +Calls the standard color theme function `color-theme-standard' in order +to reset all faces." + (interactive) + (color-theme-standard) + (let ((color-theme-is-cumulative t)) + (color-theme-install + '(color-theme-wheat + ((background-color . "Wheat")))))) + +(defun color-theme-standard () + "Emacs default colors. +If you are missing standard faces in this theme, please notify the maintainer." + (interactive) + ;; Note that some of the things that make up a color theme are + ;; actually variable settings! + (color-theme-install + '(color-theme-standard + ((foreground-color . "black") + (background-color . "white") + (mouse-color . "black") + (cursor-color . "black") + (border-color . "black") + (background-mode . light)) + ((Man-overstrike-face . bold) + (Man-underline-face . underline) + (apropos-keybinding-face . underline) + (apropos-label-face . italic) + (apropos-match-face . secondary-selection) + (apropos-property-face . bold-italic) + (apropos-symbol-face . bold) + (goto-address-mail-face . italic) + (goto-address-mail-mouse-face . secondary-selection) + (goto-address-url-face . bold) + (goto-address-url-mouse-face . highlight) + (help-highlight-face . underline) + (list-matching-lines-face . bold) + (view-highlight-face . highlight)) + (default ((t (nil)))) + (bold ((t (:bold t)))) + (bold-italic ((t (:bold t :italic t)))) + (calendar-today-face ((t (:underline t)))) + (cperl-array-face ((t (:foreground "Blue" :background "lightyellow2" :bold t)))) + (cperl-hash-face ((t (:foreground "Red" :background "lightyellow2" :bold t :italic t)))) + (cperl-nonoverridable-face ((t (:foreground "chartreuse3")))) + (custom-button-face ((t (nil)))) + (custom-changed-face ((t (:foreground "white" :background "blue")))) + (custom-documentation-face ((t (nil)))) + (custom-face-tag-face ((t (:underline t)))) + (custom-group-tag-face ((t (:foreground "blue" :underline t)))) + (custom-group-tag-face-1 ((t (:foreground "red" :underline t)))) + (custom-invalid-face ((t (:foreground "yellow" :background "red")))) + (custom-modified-face ((t (:foreground "white" :background "blue")))) + (custom-rogue-face ((t (:foreground "pink" :background "black")))) + (custom-saved-face ((t (:underline t)))) + (custom-set-face ((t (:foreground "blue" :background "white")))) + (custom-state-face ((t (:foreground "dark green")))) + (custom-variable-button-face ((t (:bold t :underline t)))) + (custom-variable-tag-face ((t (:foreground "blue" :underline t)))) + (diary-face ((t (:foreground "red")))) + (ediff-current-diff-face-A ((t (:foreground "firebrick" :background "pale green")))) + (ediff-current-diff-face-Ancestor ((t (:foreground "Black" :background "VioletRed")))) + (ediff-current-diff-face-B ((t (:foreground "DarkOrchid" :background "Yellow")))) + (ediff-current-diff-face-C ((t (:foreground "Navy" :background "Pink")))) + (ediff-even-diff-face-A ((t (:foreground "Black" :background "light grey")))) + (ediff-even-diff-face-Ancestor ((t (:foreground "White" :background "Grey")))) + (ediff-even-diff-face-B ((t (:foreground "White" :background "Grey")))) + (ediff-even-diff-face-C ((t (:foreground "Black" :background "light grey")))) + (ediff-fine-diff-face-A ((t (:foreground "Navy" :background "sky blue")))) + (ediff-fine-diff-face-Ancestor ((t (:foreground "Black" :background "Green")))) + (ediff-fine-diff-face-B ((t (:foreground "Black" :background "cyan")))) + (ediff-fine-diff-face-C ((t (:foreground "Black" :background "Turquoise")))) + (ediff-odd-diff-face-A ((t (:foreground "White" :background "Grey")))) + (ediff-odd-diff-face-Ancestor ((t (:foreground "Black" :background "light grey")))) + (ediff-odd-diff-face-B ((t (:foreground "Black" :background "light grey")))) + (ediff-odd-diff-face-C ((t (:foreground "White" :background "Grey")))) + (eshell-ls-archive-face ((t (:foreground "Orchid" :bold t)))) + (eshell-ls-backup-face ((t (:foreground "OrangeRed")))) + (eshell-ls-clutter-face ((t (:foreground "OrangeRed" :bold t)))) + (eshell-ls-directory-face ((t (:foreground "Blue" :bold t)))) + (eshell-ls-executable-face ((t (:foreground "ForestGreen" :bold t)))) + (eshell-ls-missing-face ((t (:foreground "Red" :bold t)))) + (eshell-ls-product-face ((t (:foreground "OrangeRed")))) + (eshell-ls-readonly-face ((t (:foreground "Brown")))) + (eshell-ls-special-face ((t (:foreground "Magenta" :bold t)))) + (eshell-ls-symlink-face ((t (:foreground "DarkCyan" :bold t)))) + (eshell-ls-unreadable-face ((t (:foreground "Grey30")))) + (eshell-prompt-face ((t (:foreground "Red" :bold t)))) + (eshell-test-failed-face ((t (:foreground "OrangeRed" :bold t)))) + (eshell-test-ok-face ((t (:foreground "Green" :bold t)))) + (excerpt ((t (:italic t)))) + (fixed ((t (:bold t)))) + (flyspell-duplicate-face ((t (:foreground "Gold3" :bold t :underline t)))) + (flyspell-incorrect-face ((t (:foreground "OrangeRed" :bold t :underline t)))) + (font-lock-builtin-face ((t (:foreground "Orchid")))) + (font-lock-comment-face ((t (:foreground "Firebrick")))) + (font-lock-constant-face ((t (:foreground "CadetBlue")))) + (font-lock-function-name-face ((t (:foreground "Blue")))) + (font-lock-keyword-face ((t (:foreground "Purple")))) + (font-lock-string-face ((t (:foreground "RosyBrown")))) + (font-lock-type-face ((t (:foreground "ForestGreen")))) + (font-lock-variable-name-face ((t (:foreground "DarkGoldenrod")))) + (font-lock-warning-face ((t (:foreground "Red" :bold t)))) + (fringe ((t (:background "grey95")))) + (gnus-cite-attribution-face ((t (:italic t)))) + (gnus-cite-face-1 ((t (:foreground "MidnightBlue")))) + (gnus-cite-face-10 ((t (:foreground "medium purple")))) + (gnus-cite-face-11 ((t (:foreground "turquoise")))) + (gnus-cite-face-2 ((t (:foreground "firebrick")))) + (gnus-cite-face-3 ((t (:foreground "dark green")))) + (gnus-cite-face-4 ((t (:foreground "OrangeRed")))) + (gnus-cite-face-5 ((t (:foreground "dark khaki")))) + (gnus-cite-face-6 ((t (:foreground "dark violet")))) + (gnus-cite-face-7 ((t (:foreground "SteelBlue4")))) + (gnus-cite-face-8 ((t (:foreground "magenta")))) + (gnus-cite-face-9 ((t (:foreground "violet")))) + (gnus-emphasis-bold ((t (:bold t)))) + (gnus-emphasis-bold-italic ((t (:bold t :italic t)))) + (gnus-emphasis-italic ((t (:italic t)))) + (gnus-emphasis-underline ((t (:underline t)))) + (gnus-emphasis-underline-bold ((t (:bold t :underline t)))) + (gnus-emphasis-underline-bold-italic ((t (:bold t :italic t :underline t)))) + (gnus-emphasis-underline-italic ((t (:italic t :underline t)))) + (gnus-group-mail-1-empty-face ((t (:foreground "DeepPink3")))) + (gnus-group-mail-1-face ((t (:foreground "DeepPink3" :bold t)))) + (gnus-group-mail-2-empty-face ((t (:foreground "HotPink3")))) + (gnus-group-mail-2-face ((t (:foreground "HotPink3" :bold t)))) + (gnus-group-mail-3-empty-face ((t (:foreground "magenta4")))) + (gnus-group-mail-3-face ((t (:foreground "magenta4" :bold t)))) + (gnus-group-mail-low-empty-face ((t (:foreground "DeepPink4")))) + (gnus-group-mail-low-face ((t (:foreground "DeepPink4" :bold t)))) + (gnus-group-news-1-empty-face ((t (:foreground "ForestGreen")))) + (gnus-group-news-1-face ((t (:foreground "ForestGreen" :bold t)))) + (gnus-group-news-2-empty-face ((t (:foreground "CadetBlue4")))) + (gnus-group-news-2-face ((t (:foreground "CadetBlue4" :bold t)))) + (gnus-group-news-3-empty-face ((t (nil)))) + (gnus-group-news-3-face ((t (:bold t)))) + (gnus-group-news-low-empty-face ((t (:foreground "DarkGreen")))) + (gnus-group-news-low-face ((t (:foreground "DarkGreen" :bold t)))) + (gnus-header-content-face ((t (:foreground "indianred4" :italic t)))) + (gnus-header-from-face ((t (:foreground "red3")))) + (gnus-header-name-face ((t (:foreground "maroon")))) + (gnus-header-newsgroups-face ((t (:foreground "MidnightBlue" :italic t)))) + (gnus-header-subject-face ((t (:foreground "red4")))) + (gnus-signature-face ((t (:italic t)))) + (gnus-splash-face ((t (:foreground "ForestGreen")))) + (gnus-summary-cancelled-face ((t (:foreground "yellow" :background "black")))) + (gnus-summary-high-ancient-face ((t (:foreground "RoyalBlue" :bold t)))) + (gnus-summary-high-read-face ((t (:foreground "DarkGreen" :bold t)))) + (gnus-summary-high-ticked-face ((t (:foreground "firebrick" :bold t)))) + (gnus-summary-high-unread-face ((t (:bold t)))) + (gnus-summary-low-ancient-face ((t (:foreground "RoyalBlue" :italic t)))) + (gnus-summary-low-read-face ((t (:foreground "DarkGreen" :italic t)))) + (gnus-summary-low-ticked-face ((t (:foreground "firebrick" :italic t)))) + (gnus-summary-low-unread-face ((t (:italic t)))) + (gnus-summary-normal-ancient-face ((t (:foreground "RoyalBlue")))) + (gnus-summary-normal-read-face ((t (:foreground "DarkGreen")))) + (gnus-summary-normal-ticked-face ((t (:foreground "firebrick")))) + (gnus-summary-normal-unread-face ((t (nil)))) + (gnus-summary-selected-face ((t (:underline t)))) + (highlight ((t (:background "darkseagreen2")))) + (highlight-changes-delete-face ((t (:foreground "red" :underline t)))) + (highlight-changes-face ((t (:foreground "red")))) + (highline-face ((t (:background "paleturquoise")))) + (holiday-face ((t (:background "pink")))) + (info-menu-5 ((t (:underline t)))) + (info-node ((t (:bold t :italic t)))) + (info-xref ((t (:bold t)))) + (italic ((t (:italic t)))) + (makefile-space-face ((t (:background "hotpink")))) + (message-cited-text-face ((t (:foreground "red")))) + (message-header-cc-face ((t (:foreground "MidnightBlue")))) + (message-header-name-face ((t (:foreground "cornflower blue")))) + (message-header-newsgroups-face ((t (:foreground "blue4" :bold t :italic t)))) + (message-header-other-face ((t (:foreground "steel blue")))) + (message-header-subject-face ((t (:foreground "navy blue" :bold t)))) + (message-header-to-face ((t (:foreground "MidnightBlue" :bold t)))) + (message-header-xheader-face ((t (:foreground "blue")))) + (message-separator-face ((t (:foreground "brown")))) + (modeline ((t (:foreground "white" :background "black")))) + (modeline-buffer-id ((t (:foreground "white" :background "black")))) + (modeline-mousable ((t (:foreground "white" :background "black")))) + (modeline-mousable-minor-mode ((t (:foreground "white" :background "black")))) + (region ((t (:background "gray")))) + (secondary-selection ((t (:background "paleturquoise")))) + (show-paren-match-face ((t (:background "turquoise")))) + (show-paren-mismatch-face ((t (:foreground "white" :background "purple")))) + (speedbar-button-face ((t (:foreground "green4")))) + (speedbar-directory-face ((t (:foreground "blue4")))) + (speedbar-file-face ((t (:foreground "cyan4")))) + (speedbar-highlight-face ((t (:background "green")))) + (speedbar-selected-face ((t (:foreground "red" :underline t)))) + (speedbar-tag-face ((t (:foreground "brown")))) + (term-black ((t (:foreground "black")))) + (term-blackbg ((t (:background "black")))) + (term-blue ((t (:foreground "blue")))) + (term-bluebg ((t (:background "blue")))) + (term-bold ((t (:bold t)))) + (term-cyan ((t (:foreground "cyan")))) + (term-cyanbg ((t (:background "cyan")))) + (term-default-bg ((t (nil)))) + (term-default-bg-inv ((t (nil)))) + (term-default-fg ((t (nil)))) + (term-default-fg-inv ((t (nil)))) + (term-green ((t (:foreground "green")))) + (term-greenbg ((t (:background "green")))) + (term-invisible ((t (nil)))) + (term-invisible-inv ((t (nil)))) + (term-magenta ((t (:foreground "magenta")))) + (term-magentabg ((t (:background "magenta")))) + (term-red ((t (:foreground "red")))) + (term-redbg ((t (:background "red")))) + (term-underline ((t (:underline t)))) + (term-white ((t (:foreground "white")))) + (term-whitebg ((t (:background "white")))) + (term-yellow ((t (:foreground "yellow")))) + (term-yellowbg ((t (:background "yellow")))) + (underline ((t (:underline t)))) + (vcursor ((t (:foreground "blue" :background "cyan" :underline t)))) + (vhdl-font-lock-attribute-face ((t (:foreground "Orchid")))) + (vhdl-font-lock-directive-face ((t (:foreground "CadetBlue")))) + (vhdl-font-lock-enumvalue-face ((t (:foreground "Gold4")))) + (vhdl-font-lock-function-face ((t (:foreground "Orchid4")))) + (vhdl-font-lock-prompt-face ((t (:foreground "Red" :bold t)))) + (vhdl-font-lock-reserved-words-face ((t (:foreground "Orange" :bold t)))) + (vhdl-font-lock-translate-off-face ((t (:background "LightGray")))) + (vhdl-speedbar-architecture-face ((t (:foreground "Blue")))) + (vhdl-speedbar-architecture-selected-face ((t (:foreground "Blue" :underline t)))) + (vhdl-speedbar-configuration-face ((t (:foreground "DarkGoldenrod")))) + (vhdl-speedbar-configuration-selected-face ((t (:foreground "DarkGoldenrod" :underline t)))) + (vhdl-speedbar-entity-face ((t (:foreground "ForestGreen")))) + (vhdl-speedbar-entity-selected-face ((t (:foreground "ForestGreen" :underline t)))) + (vhdl-speedbar-instantiation-face ((t (:foreground "Brown")))) + (vhdl-speedbar-instantiation-selected-face ((t (:foreground "Brown" :underline t)))) + (vhdl-speedbar-package-face ((t (:foreground "Grey50")))) + (vhdl-speedbar-package-selected-face ((t (:foreground "Grey50" :underline t)))) + (viper-minibuffer-emacs-face ((t (:foreground "Black" :background "darkseagreen2")))) + (viper-minibuffer-insert-face ((t (:foreground "Black" :background "pink")))) + (viper-minibuffer-vi-face ((t (:foreground "DarkGreen" :background "grey")))) + (viper-replace-overlay-face ((t (:foreground "Black" :background "darkseagreen2")))) + (viper-search-face ((t (:foreground "Black" :background "khaki")))) + (widget-button-face ((t (:bold t)))) + (widget-button-pressed-face ((t (:foreground "red")))) + (widget-documentation-face ((t (:foreground "dark green")))) + (widget-field-face ((t (:background "gray85")))) + (widget-inactive-face ((t (:foreground "dim gray")))) + (widget-single-line-field-face ((t (:background "gray85"))))))) + +(defun color-theme-fischmeister () + "The light colors on a grey blackground. +Sebastian Fischmeister " + (interactive) + (color-theme-install + '(color-theme-fischmeister + ((foreground-color . "black") + (background-color . "gray80") + (mouse-color . "red") + (cursor-color . "yellow") + (border-color . "black") + (background-mode . light)) + (default ((t (nil)))) + (modeline ((t (:foreground "gray80" :background "black")))) + (modeline-buffer-id ((t (:foreground "gray80" :background "black")))) + (modeline-mousable ((t (:foreground "gray80" :background "black")))) + (modeline-mousable-minor-mode ((t (:foreground "gray80" :background "black")))) + (highlight ((t (:background "darkseagreen2")))) + (bold ((t (:bold t)))) + (italic ((t (:italic t)))) + (bold-italic ((t (:bold t :italic t)))) + (region ((t (:background "gray")))) + (secondary-selection ((t (:background "paleturquoise")))) + (underline ((t (:underline t)))) + (show-paren-match-face ((t (:foreground "yellow" :background "darkgreen")))) + (show-paren-mismatch-face ((t (:foreground "white" :background "red")))) + (font-lock-comment-face ((t (:foreground "FireBrick" :bold t :italic t)))) + (font-lock-string-face ((t (:foreground "DarkSlateBlue" :italic t)))) + (font-lock-keyword-face ((t (:foreground "navy")))) + (font-lock-builtin-face ((t (:foreground "white")))) + (font-lock-function-name-face ((t (:foreground "Blue")))) + (font-lock-variable-name-face ((t (:foreground "Darkblue")))) + (font-lock-type-face ((t (:foreground "darkgreen")))) + (font-lock-constant-face ((t (:foreground "CadetBlue")))) + (font-lock-warning-face ((t (:foreground "Orchid" :bold t)))) + (font-lock-reference-face ((t (:foreground "SteelBlue"))))))) + +(defun color-theme-sitaramv-solaris () + "White on a midnight blue background. Lots of yellow and orange. +Includes faces for font-lock, widget, custom, speedbar, message, gnus, +eshell." + (interactive) + (color-theme-install + '(color-theme-sitaramv-solaris + ((foreground-color . "white") + (background-color . "MidnightBlue") + (mouse-color . "yellow") + (cursor-color . "magenta2") + (border-color . "black") + (background-mode . dark)) + (default ((t (nil)))) + (modeline ((t (:foreground "black" :background "gold2")))) + (modeline-buffer-id ((t (:foreground "black" :background "gold2")))) + (modeline-mousable ((t (:foreground "black" :background "gold2")))) + (modeline-mousable-minor-mode ((t (:foreground "black" :background "gold2")))) + (highlight ((t (:foreground "black" :background "Aquamarine")))) + (bold ((t (:bold t)))) + (italic ((t (:italic t)))) + (bold-italic ((t (:bold t :italic t)))) + (region ((t (:foreground "black" :background "snow3")))) + (secondary-selection ((t (:foreground "black" :background "aquamarine")))) + (underline ((t (:underline t)))) + (lazy-highlight-face ((t (:foreground "yellow")))) + (font-lock-comment-face ((t (:foreground "orange" :italic t)))) + (font-lock-string-face ((t (:foreground "orange")))) + (font-lock-keyword-face ((t (:foreground "green")))) + (font-lock-builtin-face ((t (:foreground "LightSteelBlue")))) + (font-lock-function-name-face ((t (:foreground "cyan" :bold t)))) + (font-lock-variable-name-face ((t (:foreground "white")))) + (font-lock-type-face ((t (:foreground "cyan")))) + (font-lock-constant-face ((t (:foreground "Aquamarine")))) + (font-lock-warning-face ((t (:foreground "Pink" :bold t)))) + (widget-documentation-face ((t (:foreground "lime green")))) + (widget-button-face ((t (:bold t)))) + (widget-field-face ((t (:background "dim gray")))) + (widget-single-line-field-face ((t (:background "dim gray")))) + (widget-inactive-face ((t (:foreground "light gray")))) + (widget-button-pressed-face ((t (:foreground "red")))) + (custom-invalid-face ((t (:foreground "yellow" :background "red")))) + (custom-rogue-face ((t (:foreground "pink" :background "black")))) + (custom-modified-face ((t (:foreground "white" :background "blue")))) + (custom-set-face ((t (:foreground "blue" :background "white")))) + (custom-changed-face ((t (:foreground "white" :background "blue")))) + (custom-saved-face ((t (:underline t)))) + (custom-button-face ((t (nil)))) + (custom-documentation-face ((t (nil)))) + (custom-state-face ((t (:foreground "lime green")))) + (custom-variable-tag-face ((t (:foreground "light blue" :underline t)))) + (custom-variable-button-face ((t (:bold t :underline t)))) + (custom-face-tag-face ((t (:underline t)))) + (custom-group-tag-face-1 ((t (:foreground "pink" :underline t)))) + (custom-group-tag-face ((t (:foreground "light blue" :underline t)))) + (speedbar-button-face ((t (:foreground "green3")))) + (speedbar-file-face ((t (:foreground "cyan")))) + (speedbar-directory-face ((t (:foreground "light blue")))) + (speedbar-tag-face ((t (:foreground "yellow")))) + (speedbar-selected-face ((t (:foreground "red" :underline t)))) + (speedbar-highlight-face ((t (:background "sea green")))) + (font-lock-doc-string-face ((t (:foreground "Plum1" :bold t)))) + (font-lock-exit-face ((t (:foreground "green")))) + (ff-paths-non-existant-file-face ((t (:foreground "NavyBlue" :bold t)))) + (show-paren-match-face ((t (:background "red")))) + (show-paren-mismatch-face ((t (:foreground "white" :background "purple")))) + (message-header-to-face ((t (:foreground "green2" :bold t)))) + (message-header-cc-face ((t (:foreground "LightGoldenrod" :bold t)))) + (message-header-subject-face ((t (:foreground "green3")))) + (message-header-newsgroups-face ((t (:foreground "yellow" :bold t :italic t)))) + (message-header-other-face ((t (:foreground "Salmon")))) + (message-header-name-face ((t (:foreground "green3")))) + (message-header-xheader-face ((t (:foreground "GreenYellow")))) + (message-separator-face ((t (:foreground "Tan")))) + (message-cited-text-face ((t (:foreground "Gold")))) + (message-mml-face ((t (:foreground "ForestGreen")))) + (gnus-group-news-1-face ((t (:foreground "PaleTurquoise" :bold t)))) + (gnus-group-news-1-empty-face ((t (:foreground "PaleTurquoise")))) + (gnus-group-news-2-face ((t (:foreground "turquoise" :bold t)))) + (gnus-group-news-2-empty-face ((t (:foreground "turquoise")))) + (gnus-group-news-3-face ((t (:bold t)))) + (gnus-group-news-3-empty-face ((t (nil)))) + (gnus-group-news-4-face ((t (:bold t)))) + (gnus-group-news-4-empty-face ((t (nil)))) + (gnus-group-news-5-face ((t (:bold t)))) + (gnus-group-news-5-empty-face ((t (nil)))) + (gnus-group-news-6-face ((t (:bold t)))) + (gnus-group-news-6-empty-face ((t (nil)))) + (gnus-group-news-low-face ((t (:foreground "DarkTurquoise" :bold t)))) + (gnus-group-news-low-empty-face ((t (:foreground "DarkTurquoise")))) + (gnus-group-mail-1-face ((t (:foreground "aquamarine1" :bold t)))) + (gnus-group-mail-1-empty-face ((t (:foreground "aquamarine1")))) + (gnus-group-mail-2-face ((t (:foreground "aquamarine2" :bold t)))) + (gnus-group-mail-2-empty-face ((t (:foreground "aquamarine2")))) + (gnus-group-mail-3-face ((t (:foreground "aquamarine3" :bold t)))) + (gnus-group-mail-3-empty-face ((t (:foreground "aquamarine3")))) + (gnus-group-mail-low-face ((t (:foreground "aquamarine4" :bold t)))) + (gnus-group-mail-low-empty-face ((t (:foreground "aquamarine4")))) + (gnus-summary-selected-face ((t (:underline t)))) + (gnus-summary-cancelled-face ((t (:foreground "yellow" :background "black")))) + (gnus-summary-high-ticked-face ((t (:foreground "pink" :bold t)))) + (gnus-summary-low-ticked-face ((t (:foreground "pink" :italic t)))) + (gnus-summary-normal-ticked-face ((t (:foreground "pink")))) + (gnus-summary-high-ancient-face ((t (:foreground "SkyBlue" :bold t)))) + (gnus-summary-low-ancient-face ((t (:foreground "SkyBlue" :italic t)))) + (gnus-summary-normal-ancient-face ((t (:foreground "SkyBlue")))) + (gnus-summary-high-unread-face ((t (:bold t)))) + (gnus-summary-low-unread-face ((t (:italic t)))) + (gnus-summary-normal-unread-face ((t (nil)))) + (gnus-summary-high-read-face ((t (:foreground "PaleGreen" :bold t)))) + (gnus-summary-low-read-face ((t (:foreground "PaleGreen" :italic t)))) + (gnus-summary-normal-read-face ((t (:foreground "PaleGreen")))) + (gnus-splash-face ((t (:foreground "Brown")))) + (eshell-ls-directory-face ((t (:foreground "SkyBlue" :bold t)))) + (eshell-ls-symlink-face ((t (:foreground "Cyan" :bold t)))) + (eshell-ls-executable-face ((t (:foreground "Green" :bold t)))) + (eshell-ls-readonly-face ((t (:foreground "Pink")))) + (eshell-ls-unreadable-face ((t (:foreground "DarkGrey")))) + (eshell-ls-special-face ((t (:foreground "Magenta" :bold t)))) + (eshell-ls-missing-face ((t (:foreground "Red" :bold t)))) + (eshell-ls-archive-face ((t (:foreground "Orchid" :bold t)))) + (eshell-ls-backup-face ((t (:foreground "LightSalmon")))) + (eshell-ls-product-face ((t (:foreground "LightSalmon")))) + (eshell-ls-clutter-face ((t (:foreground "OrangeRed" :bold t)))) + (eshell-prompt-face ((t (:foreground "Pink" :bold t)))) + (term-default-fg ((t (nil)))) + (term-default-bg ((t (nil)))) + (term-default-fg-inv ((t (nil)))) + (term-default-bg-inv ((t (nil)))) + (term-bold ((t (:bold t)))) + (term-underline ((t (:underline t)))) + (term-invisible ((t (nil)))) + (term-invisible-inv ((t (nil)))) + (term-black ((t (:foreground "black")))) + (term-red ((t (:foreground "red")))) + (term-green ((t (:foreground "green")))) + (term-yellow ((t (:foreground "yellow")))) + (term-blue ((t (:foreground "blue")))) + (term-magenta ((t (:foreground "magenta")))) + (term-cyan ((t (:foreground "cyan")))) + (term-white ((t (:foreground "white")))) + (term-blackbg ((t (:background "black")))) + (term-redbg ((t (:background "red")))) + (term-greenbg ((t (:background "green")))) + (term-yellowbg ((t (:background "yellow")))) + (term-bluebg ((t (:background "blue")))) + (term-magentabg ((t (:background "magenta")))) + (term-cyanbg ((t (:background "cyan")))) + (term-whitebg ((t (:background "white")))) + (gnus-emphasis-bold ((t (:bold t)))) + (gnus-emphasis-italic ((t (:italic t)))) + (gnus-emphasis-underline ((t (:underline t)))) + (gnus-emphasis-underline-bold ((t (:bold t :underline t)))) + (gnus-emphasis-underline-italic ((t (:italic t :underline t)))) + (gnus-emphasis-bold-italic ((t (:bold t :italic t)))) + (gnus-emphasis-underline-bold-italic ((t (:bold t :italic t :underline t)))) + (gnus-emphasis-highlight-words ((t (:foreground "yellow" :background "black")))) + (gnus-signature-face ((t (:italic t)))) + (gnus-header-from-face ((t (:foreground "spring green")))) + (gnus-header-subject-face ((t (:foreground "yellow" :bold t)))) + (gnus-header-newsgroups-face ((t (:foreground "SeaGreen3" :bold t :italic t)))) + (gnus-header-name-face ((t (:foreground "pink")))) + (gnus-header-content-face ((t (:foreground "lime green" :italic t)))) + (gnus-cite-attribution-face ((t (:italic t)))) + (gnus-cite-face-1 ((t (:foreground "light blue")))) + (gnus-cite-face-2 ((t (:foreground "light cyan")))) + (gnus-cite-face-3 ((t (:foreground "light yellow")))) + (gnus-cite-face-4 ((t (:foreground "light pink")))) + (gnus-cite-face-5 ((t (:foreground "pale green")))) + (gnus-cite-face-6 ((t (:foreground "beige")))) + (gnus-cite-face-7 ((t (:foreground "orange")))) + (gnus-cite-face-8 ((t (:foreground "magenta")))) + (gnus-cite-face-9 ((t (:foreground "violet")))) + (gnus-cite-face-10 ((t (:foreground "medium purple")))) + (gnus-cite-face-11 ((t (:foreground "turquoise"))))))) + +(defun color-theme-sitaramv-nt () + "Black foreground on white background. +Includes faces for font-lock, widget, custom, speedbar." + (interactive) + (color-theme-install + '(color-theme-sitaramv-nt + ((foreground-color . "black") + (background-color . "white") + (mouse-color . "sienna3") + (cursor-color . "HotPink") + (border-color . "Blue") + (background-mode . light)) + (default ((t (nil)))) + (modeline ((t (:foreground "black" :background "gold2")))) + (modeline-buffer-id ((t (:foreground "black" :background "gold2")))) + (modeline-mousable ((t (:foreground "black" :background "gold2")))) + (modeline-mousable-minor-mode ((t (:foreground "black" :background "gold2")))) + (highlight ((t (:foreground "black" :background "darkseagreen2")))) + (bold ((t (:bold t)))) + (italic ((t (:italic t)))) + (bold-italic ((t (:bold t :italic t)))) + (region ((t (:foreground "black" :background "snow3")))) + (secondary-selection ((t (:background "paleturquoise")))) + (underline ((t (:underline t)))) + (lazy-highlight-face ((t (:foreground "dark magenta" :bold t)))) + (font-lock-comment-face ((t (:foreground "ForestGreen" :italic t)))) + (font-lock-string-face ((t (:foreground "red")))) + (font-lock-keyword-face ((t (:foreground "blue" :bold t)))) + (font-lock-builtin-face ((t (:foreground "black")))) + (font-lock-function-name-face ((t (:foreground "dark magenta" :bold t)))) + (font-lock-variable-name-face ((t (:foreground "black")))) + (font-lock-type-face ((t (:foreground "blue")))) + (font-lock-constant-face ((t (:foreground "CadetBlue")))) + (font-lock-warning-face ((t (:foreground "Red" :bold t)))) + (widget-documentation-face ((t (:foreground "dark green")))) + (widget-button-face ((t (:bold t)))) + (widget-field-face ((t (:background "gray85")))) + (widget-single-line-field-face ((t (:background "gray85")))) + (widget-inactive-face ((t (:foreground "dim gray")))) + (widget-button-pressed-face ((t (:foreground "red")))) + (custom-invalid-face ((t (:foreground "yellow" :background "red")))) + (custom-rogue-face ((t (:foreground "pink" :background "black")))) + (custom-modified-face ((t (:foreground "white" :background "blue")))) + (custom-set-face ((t (:foreground "blue" :background "white")))) + (custom-changed-face ((t (:foreground "white" :background "blue")))) + (custom-saved-face ((t (:underline t)))) + (custom-button-face ((t (nil)))) + (custom-documentation-face ((t (nil)))) + (custom-state-face ((t (:foreground "dark green")))) + (custom-variable-tag-face ((t (:foreground "blue" :underline t)))) + (custom-variable-button-face ((t (:bold t :underline t)))) + (custom-face-tag-face ((t (:underline t)))) + (custom-group-tag-face-1 ((t (:foreground "red" :underline t)))) + (custom-group-tag-face ((t (:foreground "blue" :underline t)))) + (speedbar-button-face ((t (:foreground "green4")))) + (speedbar-file-face ((t (:foreground "cyan4")))) + (speedbar-directory-face ((t (:foreground "blue4")))) + (speedbar-tag-face ((t (:foreground "brown")))) + (speedbar-selected-face ((t (:foreground "red" :underline t)))) + (speedbar-highlight-face ((t (:background "green")))) + (ff-paths-non-existant-file-face ((t (:foreground "NavyBlue" :bold t)))) + (show-paren-match-face ((t (:background "light blue")))) + (show-paren-mismatch-face ((t (:foreground "white" :background "purple"))))))) + +(defun color-theme-billw () + "Cornsilk on black. +Includes info, diary, font-lock, eshell, sgml, message, gnus, +widget, custom, latex, ediff." + (interactive) + (color-theme-install + '(color-theme-billw + ((foreground-color . "cornsilk") + (background-color . "black") + (mouse-color . "black") + (cursor-color . "white") + (border-color . "black") + (background-mode . dark)) + (default ((t (nil)))) + (modeline ((t (:foreground "black" :background "wheat")))) + (modeline-buffer-id ((t (:foreground "black" :background "wheat")))) + (modeline-mousable ((t (:foreground "black" :background "wheat")))) + (modeline-mousable-minor-mode ((t (:foreground "black" :background "wheat")))) + (highlight ((t (:foreground "wheat" :background "darkslategray")))) + (bold ((t (:bold t)))) + (italic ((t (:italic t)))) + (bold-italic ((t (:bold t :italic t)))) + (region ((t (:background "dimgray")))) + (secondary-selection ((t (:background "deepskyblue4")))) + (underline ((t (:underline t)))) + (info-node ((t (:foreground "yellow" :bold t :italic t)))) + (info-menu-5 ((t (:underline t)))) + (info-xref ((t (:foreground "yellow" :bold t)))) + (diary-face ((t (:foreground "orange")))) + (calendar-today-face ((t (:underline t)))) + (holiday-face ((t (:background "red")))) + (show-paren-match-face ((t (:background "deepskyblue4")))) + (show-paren-mismatch-face ((t (:foreground "white" :background "red")))) + (font-lock-comment-face ((t (:foreground "gold")))) + (font-lock-string-face ((t (:foreground "orange")))) + (font-lock-keyword-face ((t (:foreground "cyan1")))) + (font-lock-builtin-face ((t (:foreground "LightSteelBlue")))) + (font-lock-function-name-face ((t (:foreground "mediumspringgreen")))) + (font-lock-variable-name-face ((t (:foreground "light salmon")))) + (font-lock-type-face ((t (:foreground "yellow1")))) + (font-lock-constant-face ((t (:foreground "salmon")))) + (font-lock-warning-face ((t (:foreground "gold" :bold t)))) + (blank-space-face ((t (:background "LightGray")))) + (blank-tab-face ((t (:foreground "black" :background "cornsilk")))) + (highline-face ((t (:background "gray35")))) + (eshell-ls-directory-face ((t (:foreground "green" :bold t)))) + (eshell-ls-symlink-face ((t (:foreground "Cyan" :bold t)))) + (eshell-ls-executable-face ((t (:foreground "orange" :bold t)))) + (eshell-ls-readonly-face ((t (:foreground "gray")))) + (eshell-ls-unreadable-face ((t (:foreground "DarkGrey")))) + (eshell-ls-special-face ((t (:foreground "Magenta" :bold t)))) + (eshell-ls-missing-face ((t (:foreground "Red" :bold t)))) + (eshell-ls-archive-face ((t (:foreground "Orchid" :bold t)))) + (eshell-ls-backup-face ((t (:foreground "LightSalmon")))) + (eshell-ls-product-face ((t (:foreground "LightSalmon")))) + (eshell-ls-clutter-face ((t (:foreground "blue" :bold t)))) + (sgml-start-tag-face ((t (:foreground "mediumspringgreen")))) + (custom-button-face ((t (:foreground "white")))) + (sgml-ignored-face ((t (:foreground "gray20" :background "gray60")))) + (sgml-doctype-face ((t (:foreground "orange")))) + (sgml-sgml-face ((t (:foreground "yellow")))) + (vc-annotate-face-0046FF ((t (:foreground "wheat" :background "black")))) + (custom-documentation-face ((t (:foreground "white")))) + (sgml-end-tag-face ((t (:foreground "greenyellow")))) + (linemenu-face ((t (:background "gray30")))) + (sgml-entity-face ((t (:foreground "gold")))) + (message-header-to-face ((t (:foreground "floral white" :bold t)))) + (message-header-cc-face ((t (:foreground "ivory")))) + (message-header-subject-face ((t (:foreground "papaya whip" :bold t)))) + (message-header-newsgroups-face ((t (:foreground "lavender blush" :bold t :italic t)))) + (message-header-other-face ((t (:foreground "pale turquoise")))) + (message-header-name-face ((t (:foreground "light sky blue")))) + (message-header-xheader-face ((t (:foreground "blue")))) + (message-separator-face ((t (:foreground "sandy brown")))) + (message-cited-text-face ((t (:foreground "plum1")))) + (message-mml-face ((t (:foreground "ForestGreen")))) + (gnus-group-news-1-face ((t (:foreground "white" :bold t)))) + (gnus-group-news-1-empty-face ((t (:foreground "white")))) + (gnus-group-news-2-face ((t (:foreground "lightcyan" :bold t)))) + (gnus-group-news-2-empty-face ((t (:foreground "lightcyan")))) + (gnus-group-news-3-face ((t (:foreground "tan" :bold t)))) + (gnus-group-news-3-empty-face ((t (:foreground "tan")))) + (gnus-group-news-4-face ((t (:foreground "white" :bold t)))) + (gnus-group-news-4-empty-face ((t (:foreground "white")))) + (gnus-group-news-5-face ((t (:foreground "wheat" :bold t)))) + (gnus-group-news-5-empty-face ((t (:foreground "wheat")))) + (gnus-group-news-6-face ((t (:foreground "tan" :bold t)))) + (gnus-group-news-6-empty-face ((t (:foreground "tan")))) + (gnus-group-news-low-face ((t (:foreground "DarkTurquoise" :bold t)))) + (gnus-group-news-low-empty-face ((t (:foreground "DarkTurquoise")))) + (gnus-group-mail-1-face ((t (:foreground "white" :bold t)))) + (gnus-group-mail-1-empty-face ((t (:foreground "gray80")))) + (gnus-group-mail-2-face ((t (:foreground "lightcyan" :bold t)))) + (gnus-group-mail-2-empty-face ((t (:foreground "lightcyan")))) + (gnus-group-mail-3-face ((t (:foreground "tan" :bold t)))) + (gnus-group-mail-3-empty-face ((t (:foreground "tan")))) + (gnus-group-mail-low-face ((t (:foreground "aquamarine4" :bold t)))) + (gnus-group-mail-low-empty-face ((t (:foreground "aquamarine4")))) + (gnus-summary-selected-face ((t (:background "deepskyblue4" :underline t)))) + (gnus-summary-cancelled-face ((t (:foreground "black" :background "gray")))) + (gnus-summary-high-ticked-face ((t (:foreground "gray70" :bold t)))) + (gnus-summary-low-ticked-face ((t (:foreground "gray70" :bold t)))) + (gnus-summary-normal-ticked-face ((t (:foreground "gray70" :bold t)))) + (gnus-summary-high-ancient-face ((t (:foreground "SkyBlue" :bold t)))) + (gnus-summary-low-ancient-face ((t (:foreground "SkyBlue" :italic t)))) + (gnus-summary-normal-ancient-face ((t (:foreground "SkyBlue")))) + (gnus-summary-high-unread-face ((t (:bold t)))) + (gnus-summary-low-unread-face ((t (:italic t)))) + (gnus-summary-normal-unread-face ((t (nil)))) + (gnus-summary-high-read-face ((t (:foreground "PaleGreen" :bold t)))) + (gnus-summary-low-read-face ((t (:foreground "PaleGreen" :italic t)))) + (gnus-summary-normal-read-face ((t (:foreground "PaleGreen")))) + (gnus-splash-face ((t (:foreground "gold")))) + (font-latex-bold-face ((t (nil)))) + (font-latex-italic-face ((t (nil)))) + (font-latex-math-face ((t (nil)))) + (font-latex-sedate-face ((t (:foreground "Gray85")))) + (font-latex-string-face ((t (:foreground "orange")))) + (font-latex-warning-face ((t (:foreground "gold")))) + (widget-documentation-face ((t (:foreground "lime green")))) + (widget-button-face ((t (:bold t)))) + (widget-field-face ((t (:background "gray20")))) + (widget-single-line-field-face ((t (:background "gray20")))) + (widget-inactive-face ((t (:foreground "wheat")))) + (widget-button-pressed-face ((t (:foreground "red")))) + (custom-invalid-face ((t (:foreground "yellow" :background "red")))) + (custom-rogue-face ((t (:foreground "pink" :background "black")))) + (custom-modified-face ((t (:foreground "white" :background "blue")))) + (custom-set-face ((t (:foreground "blue")))) + (custom-changed-face ((t (:foreground "wheat" :background "skyblue")))) + (custom-saved-face ((t (:underline t)))) + (custom-state-face ((t (:foreground "light green")))) + (custom-variable-tag-face ((t (:foreground "skyblue" :underline t)))) + (custom-variable-button-face ((t (:bold t :underline t)))) + (custom-face-tag-face ((t (:foreground "white" :underline t)))) + (custom-group-tag-face-1 ((t (:foreground "pink" :underline t)))) + (custom-group-tag-face ((t (:foreground "skyblue" :underline t)))) + (swbuff-current-buffer-face ((t (:foreground "red" :bold t)))) + (ediff-current-diff-face-A ((t (:foreground "firebrick" :background "pale green")))) + (ediff-current-diff-face-B ((t (:foreground "DarkOrchid" :background "Yellow")))) + (ediff-current-diff-face-C ((t (:foreground "white" :background "indianred")))) + (ediff-current-diff-face-Ancestor ((t (:foreground "Black" :background "VioletRed")))) + (ediff-fine-diff-face-A ((t (:foreground "Navy" :background "sky blue")))) + (ediff-fine-diff-face-B ((t (:foreground "Black" :background "cyan")))) + (ediff-fine-diff-face-C ((t (:foreground "Black" :background "Turquoise")))) + (ediff-fine-diff-face-Ancestor ((t (:foreground "Black" :background "Green")))) + (ediff-even-diff-face-A ((t (:foreground "Black" :background "light grey")))) + (ediff-even-diff-face-B ((t (:foreground "White" :background "Grey")))) + (ediff-even-diff-face-C ((t (:foreground "Black" :background "light grey")))) + (ediff-even-diff-face-Ancestor ((t (:foreground "White" :background "Grey")))) + (ediff-odd-diff-face-A ((t (:foreground "White" :background "Grey")))) + (ediff-odd-diff-face-B ((t (:foreground "Black" :background "light grey")))) + (ediff-odd-diff-face-C ((t (:foreground "White" :background "Grey")))) + (ediff-odd-diff-face-Ancestor ((t (:foreground "Black" :background "light grey")))) + (gnus-emphasis-bold ((t (:bold t)))) + (gnus-emphasis-italic ((t (:italic t)))) + (gnus-emphasis-underline ((t (:foreground "white" :background "goldenrod4")))) + (gnus-emphasis-underline-bold ((t (:foreground "black" :background "yellow" :bold t :underline t)))) + (gnus-emphasis-underline-italic ((t (:foreground "black" :background "yellow" :italic t :underline t)))) + (gnus-emphasis-bold-italic ((t (:bold t :italic t)))) + (gnus-emphasis-underline-bold-italic ((t (:foreground "black" :background "yellow" :bold t :italic t :underline t)))) + (gnus-emphasis-highlight-words ((t (:foreground "yellow" :background "black")))) + (gnus-signature-face ((t (:italic t)))) + (gnus-header-from-face ((t (:foreground "wheat")))) + (gnus-header-subject-face ((t (:foreground "wheat" :bold t)))) + (gnus-header-newsgroups-face ((t (:foreground "wheat" :italic t)))) + (gnus-header-name-face ((t (:foreground "white")))) + (gnus-header-content-face ((t (:foreground "tan" :italic t)))) + (gnus-filterhist-face-1 ((t (nil)))) + (gnus-splash ((t (:foreground "Brown")))) + (gnus-cite-attribution-face ((t (:italic t)))) + (gnus-cite-face-1 ((t (:foreground "light blue")))) + (gnus-cite-face-2 ((t (:foreground "light cyan")))) + (gnus-cite-face-3 ((t (:foreground "light yellow")))) + (gnus-cite-face-4 ((t (:foreground "light pink")))) + (gnus-cite-face-5 ((t (:foreground "pale green")))) + (gnus-cite-face-6 ((t (:foreground "beige")))) + (gnus-cite-face-7 ((t (:foreground "orange")))) + (gnus-cite-face-8 ((t (:foreground "magenta")))) + (gnus-cite-face-9 ((t (:foreground "violet")))) + (gnus-cite-face-10 ((t (:foreground "medium purple")))) + (gnus-cite-face-11 ((t (:foreground "turquoise"))))))) + +(defun color-theme-retro-green (&optional color func) + "Plain green on black faces for those longing for the good old days." + (interactive) + ;; Build a list of faces without parameters + (let ((old-faces (face-list)) + (faces) + (face) + (foreground (or color "green"))) + (dolist (face old-faces) + (cond ((memq face '(bold bold-italic)) + (add-to-list 'faces `(,face (( t (:bold t)))))) + ((memq face '(italic underline show-paren-mismatch-face)) + (add-to-list 'faces `(,face (( t (:underline t)))))) + ((memq face '(modeline modeline-buffer-id modeline-mousable + modeline-mousable-minor-mode highlight region + secondary-selection show-paren-match-face)) + (add-to-list 'faces `(,face (( t (:foreground "black" + :background ,foreground + :inverse t)))))) + (t + (add-to-list 'faces `(,face (( t (nil)))))))) + (color-theme-install + (append + (list (or func 'color-theme-retro-green) + (list (cons 'foreground-color foreground) + (cons 'background-color "black") + (cons 'mouse-color foreground) + (cons 'cursor-color foreground) + (cons 'border-color foreground) + (cons 'background-mode 'dark))) + faces)))) + +(defun color-theme-retro-orange () + "Plain orange on black faces for those longing for the good old days." + (interactive) + (color-theme-retro-green "orange" 'color-theme-retro-orange)) + +(defun color-theme-subtle-hacker () + "Subtle Hacker Color Theme. +Based on gnome2, but uses white for important things like comments, +and less of the unreadable tomato. By Colin Walters " + (interactive) + (color-theme-gnome2) + (let ((color-theme-is-cumulative t)) + (color-theme-install + '(color-theme-subtle-hacker + nil + nil + (custom-state-face ((t (:foreground "Coral")))) + (diary-face ((t (:bold t :foreground "IndianRed")))) + (eshell-ls-clutter-face ((t (:bold t :foreground "DimGray")))) + (eshell-ls-executable-face ((t (:bold t :foreground "Coral")))) + (eshell-ls-missing-face ((t (:bold t :foreground "black")))) + (eshell-ls-special-face ((t (:bold t :foreground "Gold")))) + (eshell-ls-symlink-face ((t (:bold t :foreground "White")))) + (font-lock-comment-face ((t (:foreground "White")))) + (font-lock-constant-face ((t (:bold t :foreground "Aquamarine")))) + (font-lock-function-name-face ((t (:bold t :foreground "MediumSlateBlue")))) + (font-lock-string-face ((t (:italic t :foreground "LightSalmon")))) + (font-lock-variable-name-face ((t (:italic t :bold t :foreground "Aquamarine")))) + (gnus-cite-face-1 ((t (:foreground "dark khaki")))) + (gnus-cite-face-2 ((t (:foreground "chocolate")))) + (gnus-cite-face-3 ((t (:foreground "tomato")))) + (gnus-group-mail-1-empty-face ((t (:foreground "light cyan")))) + (gnus-group-mail-1-face ((t (:bold t :foreground "light cyan")))) + (gnus-group-mail-2-empty-face ((t (:foreground "turquoise")))) + (gnus-group-mail-2-face ((t (:bold t :foreground "turquoise")))) + (gnus-group-mail-3-empty-face ((t (:foreground "tomato")))) + (gnus-group-mail-3-face ((t (:bold t :foreground "tomato")))) + (gnus-group-mail-low-empty-face ((t (:foreground "dodger blue")))) + (gnus-group-mail-low-face ((t (:bold t :foreground "dodger blue")))) + (gnus-group-news-1-empty-face ((t (:foreground "green yellow")))) + (gnus-group-news-1-face ((t (:bold t :foreground "green yellow")))) + (gnus-group-news-2-empty-face ((t (:foreground "dark orange")))) + (gnus-group-news-2-face ((t (:bold t :foreground "dark orange")))) + (gnus-group-news-3-empty-face ((t (:foreground "tomato")))) + (gnus-group-news-3-face ((t (:bold t :foreground "tomato")))) + (gnus-group-news-low-empty-face ((t (:foreground "yellow green")))) + (gnus-group-news-low-face ((t (:bold t :foreground "yellow green")))) + (gnus-header-name-face ((t (:bold t :foreground "DodgerBlue1")))) + (gnus-header-newsgroups-face ((t (:italic t :bold t :foreground "LightSkyBlue3")))) + (gnus-signature-face ((t (:foreground "salmon")))) + (gnus-summary-cancelled-face ((t (:background "black" :foreground "yellow")))) + (gnus-summary-high-ancient-face ((t (:bold t :foreground "RoyalBlue")))) + (gnus-summary-high-read-face ((t (:bold t :foreground "forest green")))) + (gnus-summary-high-ticked-face ((t (:bold t :foreground "burlywood")))) + (gnus-summary-high-unread-face ((t (:italic t :bold t :foreground "cyan")))) + (gnus-summary-low-ancient-face ((t (:italic t :foreground "chocolate")))) + (gnus-summary-low-read-face ((t (:foreground "light sea green")))) + (gnus-summary-low-ticked-face ((t (:italic t :foreground "chocolate")))) + (gnus-summary-low-unread-face ((t (:italic t :foreground "light sea green")))) + (gnus-summary-normal-ancient-face ((t (:foreground "RoyalBlue")))) + (gnus-summary-normal-read-face ((t (:foreground "khaki")))) + (gnus-summary-normal-ticked-face ((t (:foreground "sandy brown")))) + (gnus-summary-normal-unread-face ((t (:foreground "aquamarine")))) + (message-cited-text-face ((t (:foreground "White")))) + (message-header-name-face ((t (:foreground "DodgerBlue1")))) + (message-header-newsgroups-face ((t (:italic t :bold t :foreground "LightSkyBlue3")))) + (message-header-other-face ((t (:foreground "LightSkyBlue3")))) + (message-header-xheader-face ((t (:foreground "DodgerBlue3")))))))) + +(defun color-theme-pok-wog () + "Low-contrast White-on-Gray by S.Pokrovsky. + +The following might be a good addition to your .Xdefaults file: + +Emacs.pane.menubar.background: darkGrey +Emacs.pane.menubar.foreground: black" + (interactive) + (color-theme-install + '(color-theme-pok-wog + ((foreground-color . "White") + (background-color . "DarkSlateGray") + (mouse-color . "gold") + (cursor-color . "Cyan") + (border-color . "black") + (background-mode . dark)) + (default ((t (nil)))) + (bold ((t (:bold t :foreground "Wheat")))) + (bold-italic ((t (:italic t :bold t :foreground "wheat")))) + (calendar-today-face ((t (:underline t :foreground "white")))) + (diary-face ((t (:foreground "red")))) + (font-lock-builtin-face ((t (:bold t :foreground "cyan")))) + (font-lock-comment-face ((t (:foreground "Gold")))) + (font-lock-constant-face ((t (:bold t :foreground "LightSteelBlue")))) + (font-lock-function-name-face ((t (:bold t :foreground "Yellow")))) + (font-lock-keyword-face ((t (:bold t :foreground "Cyan")))) + (font-lock-string-face ((t (:foreground "Khaki")))) + (font-lock-type-face ((t (:bold t :foreground "Cyan")))) + (font-lock-variable-name-face ((t (:foreground "LightGoldenrod")))) + (font-lock-warning-face ((t (:bold t :foreground "Pink")))) + (gnus-cite-attribution-face ((t (:bold t :foreground "Wheat")))) + (gnus-cite-face-1 ((t (:foreground "wheat")))) + (gnus-cite-face-10 ((t (:foreground "wheat")))) + (gnus-cite-face-11 ((t (:foreground "turquoise")))) + (gnus-cite-face-2 ((t (:foreground "cyan")))) + (gnus-cite-face-3 ((t (:foreground "light yellow")))) + (gnus-cite-face-4 ((t (:foreground "light pink")))) + (gnus-cite-face-5 ((t (:foreground "pale green")))) + (gnus-cite-face-6 ((t (:foreground "beige")))) + (gnus-cite-face-7 ((t (:foreground "orange")))) + (gnus-cite-face-8 ((t (:foreground "magenta")))) + (gnus-cite-face-9 ((t (:foreground "violet")))) + (gnus-emphasis-bold ((t (:bold t :foreground "wheat")))) + (gnus-emphasis-bold-italic ((t (:italic t :bold t)))) + (gnus-emphasis-highlight-words ((t (:background "black" :foreground "yellow")))) + (gnus-emphasis-italic ((t (:italic t :foreground "white")))) + (gnus-emphasis-underline ((t (:underline t :foreground "white")))) + (gnus-emphasis-underline-bold ((t (:underline t :bold t :foreground "wheat")))) + (gnus-emphasis-underline-bold-italic ((t (:underline t :italic t :bold t)))) + (gnus-emphasis-underline-italic ((t (:underline t :italic t :foreground "white")))) + (gnus-group-mail-1-empty-face ((t (:foreground "aquamarine1")))) + (gnus-group-mail-1-face ((t (:bold t :foreground "aquamarine1")))) + (gnus-group-mail-2-empty-face ((t (:foreground "aquamarine2")))) + (gnus-group-mail-2-face ((t (:bold t :foreground "aquamarine2")))) + (gnus-group-mail-3-empty-face ((t (:foreground "Salmon")))) + (gnus-group-mail-3-face ((t (:bold t :foreground "gold")))) + (gnus-group-mail-low-empty-face ((t (:foreground "Wheat")))) + (gnus-group-mail-low-face ((t (:bold t :foreground "aquamarine4")))) + (gnus-group-news-1-empty-face ((t (:foreground "PaleTurquoise")))) + (gnus-group-news-1-face ((t (:bold t :foreground "PaleTurquoise")))) + (gnus-group-news-2-empty-face ((t (:foreground "turquoise")))) + (gnus-group-news-2-face ((t (:bold t :foreground "turquoise")))) + (gnus-group-news-3-empty-face ((t (nil)))) + (gnus-group-news-3-face ((t (:bold t :foreground "Wheat")))) + (gnus-group-news-4-empty-face ((t (nil)))) + (gnus-group-news-4-face ((t (:bold t)))) + (gnus-group-news-5-empty-face ((t (nil)))) + (gnus-group-news-5-face ((t (:bold t)))) + (gnus-group-news-6-empty-face ((t (nil)))) + (gnus-group-news-6-face ((t (:bold t)))) + (gnus-group-news-low-empty-face ((t (:foreground "DarkTurquoise")))) + (gnus-group-news-low-face ((t (:bold t :foreground "DarkTurquoise")))) + (gnus-header-content-face ((t (:italic t :foreground "Wheat")))) + (gnus-header-from-face ((t (:foreground "light yellow")))) + (gnus-header-name-face ((t (:foreground "cyan")))) + (gnus-header-newsgroups-face ((t (:italic t :foreground "yellow")))) + (gnus-header-subject-face ((t (:bold t :foreground "Gold")))) + (gnus-signature-face ((t (:italic t :foreground "wheat")))) + (gnus-splash-face ((t (:foreground "orange")))) + (gnus-summary-cancelled-face ((t (:background "black" :foreground "yellow")))) + (gnus-summary-high-ancient-face ((t (:bold t :foreground "SkyBlue")))) + (gnus-summary-high-read-face ((t (:bold t :foreground "PaleGreen")))) + (gnus-summary-high-ticked-face ((t (:bold t :foreground "pink")))) + (gnus-summary-high-unread-face ((t (:bold t :foreground "gold")))) + (gnus-summary-low-ancient-face ((t (:italic t :foreground "SkyBlue")))) + (gnus-summary-low-read-face ((t (:italic t :foreground "PaleGreen")))) + (gnus-summary-low-ticked-face ((t (:italic t :foreground "pink")))) + (gnus-summary-low-unread-face ((t (:italic t)))) + (gnus-summary-normal-ancient-face ((t (:foreground "SkyBlue")))) + (gnus-summary-normal-read-face ((t (:foreground "PaleGreen")))) + (gnus-summary-normal-ticked-face ((t (:foreground "pink")))) + (gnus-summary-normal-unread-face ((t (:foreground "wheat")))) + (gnus-summary-selected-face ((t (:underline t :foreground "white")))) + (highlight ((t (:background "Blue" :foreground "white")))) + (highline-face ((t (:background "black" :foreground "white")))) + (holiday-face ((t (:background "pink" :foreground "white")))) + (info-menu-5 ((t (:underline t)))) + (info-node ((t (:italic t :bold t :foreground "white")))) + (info-xref ((t (:bold t :foreground "wheat")))) + (italic ((t (:italic t :foreground "white")))) + (makefile-space-face ((t (:background "hotpink")))) + (message-cited-text-face ((t (:foreground "green")))) + (message-header-cc-face ((t (:bold t :foreground "Aquamarine")))) + (message-header-name-face ((t (:foreground "Gold")))) + (message-header-newsgroups-face ((t (:italic t :bold t :foreground "yellow")))) + (message-header-other-face ((t (:foreground "lightGray")))) + (message-header-subject-face ((t (:foreground "Yellow")))) + (message-header-to-face ((t (:bold t :foreground "green2")))) + (message-header-xheader-face ((t (:foreground "blue")))) + (message-mml-face ((t (:bold t :foreground "khaki")))) + (message-separator-face ((t (:background "aquamarine" :foreground "black")))) + (modeline ((t (:background "DarkGray" :foreground "Black")))) + (modeline-buffer-id ((t (:background "DarkGray" :foreground "Black")))) + (modeline-mousable ((t (:background "DarkGray" :foreground "Black")))) + (modeline-mousable-minor-mode ((t (:background "DarkGray" :foreground "Black")))) + (paren-mismatch-face ((t (:background "DeepPink" :foreground "white")))) + (paren-no-match-face ((t (:background "yellow" :foreground "white")))) + (region ((t (:background "MediumSlateBlue" :foreground "white")))) + (secondary-selection ((t (:background "Sienna" :foreground "white")))) + (show-paren-match-face ((t (:background "turquoise" :foreground "white")))) + (show-paren-mismatch-face ((t (:background "purple" :foreground "white")))) + (speedbar-button-face ((t (:bold t :foreground "magenta")))) + (speedbar-directory-face ((t (:bold t :foreground "orchid")))) + (speedbar-file-face ((t (:foreground "pink")))) + (speedbar-highlight-face ((t (:background "black")))) + (speedbar-selected-face ((t (:underline t :foreground "cyan")))) + (speedbar-tag-face ((t (:foreground "yellow")))) + (swbuff-current-buffer-face ((t (:bold t :foreground "red")))) + (underline ((t (:underline t :foreground "white")))) + (widget-button-face ((t (:bold t :foreground "wheat")))) + (widget-button-pressed-face ((t (:foreground "red")))) + (widget-documentation-face ((t (:foreground "lime green")))) + (widget-field-face ((t (:background "dim gray" :foreground "white")))) + (widget-inactive-face ((t (:foreground "light gray")))) + (widget-single-line-field-face ((t (:background "dim gray" :foreground "white"))))))) + +(defun color-theme-pok-wob () + "White-on-Black by S. Pokrovsky. + +The following might be a good addition to your .Xdefaults file: + +Emacs.pane.menubar.background: darkGrey +Emacs.pane.menubar.foreground: black" + (interactive) +; (setq term-default-fg-color "white" +; term-default-bg "black") + (color-theme-install + '(color-theme-pok-wob + ((foreground-color . "white") + (background-color . "black") + (mouse-color . "gold") + (cursor-color . "yellow") + (border-color . "black") + (background-mode . dark)) + (default ((t (nil)))) + (bold ((t (:bold t :foreground "light gray")))) + (bold-italic ((t (:italic t :bold t :foreground "cyan")))) + (calendar-today-face ((t (:underline t :foreground "white")))) + (custom-button-face ((t (nil)))) + (custom-changed-face ((t (:background "blue" :foreground "white")))) + (custom-documentation-face ((t (nil)))) + (custom-face-tag-face ((t (:underline t)))) + (custom-group-tag-face ((t (:underline t)))) + (custom-group-tag-face-1 ((t (:underline t)))) + (custom-invalid-face ((t (:background "red" :foreground "white")))) + (custom-modified-face ((t (:background "blue" :foreground "white")))) + (custom-rogue-face ((t (:background "black" :foreground "pink")))) + (custom-saved-face ((t (:underline t)))) + (custom-set-face ((t (:background "white" :foreground "blue")))) + (custom-state-face ((t (nil)))) + (custom-variable-button-face ((t (:underline t :bold t)))) + (custom-variable-tag-face ((t (:underline t)))) + (diary-face ((t (:foreground "gold")))) + (font-lock-builtin-face ((t (:bold t :foreground "cyan")))) + (font-lock-comment-face ((t (:foreground "Gold")))) + (font-lock-constant-face ((t (:bold t :foreground "LightSteelBlue")))) + (font-lock-function-name-face ((t (:bold t :foreground "gold")))) + (font-lock-keyword-face ((t (:bold t :foreground "Cyan")))) + (font-lock-string-face ((t (:foreground "Khaki")))) + (font-lock-type-face ((t (:bold t :foreground "Cyan")))) + (font-lock-variable-name-face ((t (:italic t :foreground "gold")))) + (font-lock-warning-face ((t (:bold t :foreground "Pink")))) + (gnus-cite-attribution-face ((t (:underline t :foreground "beige")))) + (gnus-cite-face-1 ((t (:foreground "gold")))) + (gnus-cite-face-10 ((t (:foreground "coral")))) + (gnus-cite-face-11 ((t (:foreground "turquoise")))) + (gnus-cite-face-2 ((t (:foreground "wheat")))) + (gnus-cite-face-3 ((t (:foreground "light pink")))) + (gnus-cite-face-4 ((t (:foreground "khaki")))) + (gnus-cite-face-5 ((t (:foreground "pale green")))) + (gnus-cite-face-6 ((t (:foreground "beige")))) + (gnus-cite-face-7 ((t (:foreground "orange")))) + (gnus-cite-face-8 ((t (:foreground "magenta")))) + (gnus-cite-face-9 ((t (:foreground "violet")))) + (gnus-emphasis-bold ((t (:bold t :foreground "light gray")))) + (gnus-emphasis-bold-italic ((t (:italic t :bold t :foreground "cyan")))) + (gnus-emphasis-highlight-words ((t (:background "black" :foreground "gold")))) + (gnus-emphasis-italic ((t (:italic t :foreground "cyan")))) + (gnus-emphasis-underline ((t (:underline t :foreground "white")))) + (gnus-emphasis-underline-bold ((t (:underline t :bold t :foreground "white")))) + (gnus-emphasis-underline-bold-italic ((t (:underline t :italic t :bold t :foreground "white")))) + (gnus-emphasis-underline-italic ((t (:underline t :italic t :foreground "white")))) + (gnus-group-mail-1-empty-face ((t (:foreground "Magenta")))) + (gnus-group-mail-1-face ((t (:bold t :foreground "Magenta")))) + (gnus-group-mail-2-empty-face ((t (:foreground "aquamarine2")))) + (gnus-group-mail-2-face ((t (:bold t :foreground "aquamarine2")))) + (gnus-group-mail-3-empty-face ((t (:foreground "Cyan")))) + (gnus-group-mail-3-face ((t (:bold t :foreground "Cyan")))) + (gnus-group-mail-low-empty-face ((t (:foreground "Wheat")))) + (gnus-group-mail-low-face ((t (:foreground "aquamarine4")))) + (gnus-group-news-1-empty-face ((t (:foreground "PaleTurquoise")))) + (gnus-group-news-1-face ((t (:bold t :foreground "PaleTurquoise")))) + (gnus-group-news-2-empty-face ((t (:foreground "turquoise")))) + (gnus-group-news-2-face ((t (:bold t :foreground "turquoise")))) + (gnus-group-news-3-empty-face ((t (:foreground "wheat")))) + (gnus-group-news-3-face ((t (:bold t :foreground "Wheat")))) + (gnus-group-news-4-empty-face ((t (nil)))) + (gnus-group-news-4-face ((t (:bold t)))) + (gnus-group-news-5-empty-face ((t (nil)))) + (gnus-group-news-5-face ((t (:bold t)))) + (gnus-group-news-6-empty-face ((t (nil)))) + (gnus-group-news-6-face ((t (:bold t)))) + (gnus-group-news-low-empty-face ((t (:foreground "MediumAquamarine")))) + (gnus-group-news-low-face ((t (:bold t :foreground "MediumAquamarine")))) + (gnus-header-content-face ((t (:italic t :foreground "Wheat")))) + (gnus-header-from-face ((t (:foreground "light yellow")))) + (gnus-header-name-face ((t (:foreground "Wheat")))) + (gnus-header-newsgroups-face ((t (:italic t :foreground "gold")))) + (gnus-header-subject-face ((t (:bold t :foreground "Gold")))) + (gnus-signature-face ((t (:italic t :foreground "white")))) + (gnus-splash-face ((t (:foreground "orange")))) + (gnus-summary-cancelled-face ((t (:background "black" :foreground "orange")))) + (gnus-summary-high-ancient-face ((t (:bold t :foreground "SkyBlue")))) + (gnus-summary-high-read-face ((t (:bold t :foreground "red")))) + (gnus-summary-high-ticked-face ((t (:bold t :foreground "coral")))) + (gnus-summary-high-unread-face ((t (:bold t :foreground "gold")))) + (gnus-summary-low-ancient-face ((t (:italic t :foreground "SkyBlue")))) + (gnus-summary-low-read-face ((t (:italic t :foreground "red")))) + (gnus-summary-low-ticked-face ((t (:italic t :foreground "coral")))) + (gnus-summary-low-unread-face ((t (:italic t :foreground "white")))) + (gnus-summary-normal-ancient-face ((t (:foreground "SkyBlue")))) + (gnus-summary-normal-read-face ((t (:foreground "PaleGreen")))) + (gnus-summary-normal-ticked-face ((t (:foreground "pink")))) + (gnus-summary-normal-unread-face ((t (:foreground "white")))) + (gnus-summary-selected-face ((t (:underline t :foreground "white")))) + (highlight ((t (:background "Blue" :foreground "white")))) + (highline-face ((t (:background "dark slate gray" :foreground "white")))) + (holiday-face ((t (:background "red" :foreground "white")))) + (info-menu-5 ((t (:underline t)))) + (info-node ((t (:italic t :bold t :foreground "white")))) + (info-xref ((t (:bold t :foreground "light gray")))) + (italic ((t (:italic t :foreground "cyan")))) + (makefile-space-face ((t (:background "hotpink" :foreground "white")))) + (message-cited-text-face ((t (:foreground "green")))) + (message-header-cc-face ((t (:bold t :foreground "Aquamarine")))) + (message-header-name-face ((t (:foreground "Gold")))) + (message-header-newsgroups-face ((t (:italic t :bold t :foreground "gold")))) + (message-header-other-face ((t (:foreground "lightGray")))) + (message-header-subject-face ((t (:foreground "Yellow")))) + (message-header-to-face ((t (:bold t :foreground "green2")))) + (message-header-xheader-face ((t (:foreground "sky blue")))) + (message-mml-face ((t (:bold t :foreground "khaki")))) + (message-separator-face ((t (:background "aquamarine" :foreground "black")))) + (modeline ((t (:background "dark gray" :foreground "black")))) + (modeline-buffer-id ((t (:background "dark gray" :foreground "black")))) + (modeline-mousable ((t (:background "dark gray" :foreground "black")))) + (modeline-mousable-minor-mode ((t (:background "dark gray" :foreground "black")))) + (paren-mismatch-face ((t (:bold t :background "white" :foreground "red")))) + (paren-no-match-face ((t (:bold t :background "white" :foreground "red")))) + (region ((t (:background "MediumSlateBlue" :foreground "white")))) + (secondary-selection ((t (:background "Sienna" :foreground "white")))) + (show-paren-match-face ((t (:background "purple" :foreground "white")))) + (show-paren-mismatch-face ((t (:bold t :background "white" :foreground "red")))) + (speedbar-button-face ((t (nil)))) + (speedbar-directory-face ((t (nil)))) + (speedbar-file-face ((t (:bold t)))) + (speedbar-highlight-face ((t (nil)))) + (speedbar-selected-face ((t (:underline t)))) + (speedbar-tag-face ((t (nil)))) + (swbuff-current-buffer-face ((t (:bold t :foreground "red")))) + (underline ((t (:underline t :foreground "white")))) + (widget-button-face ((t (:bold t :foreground "coral")))) + (widget-button-pressed-face ((t (:foreground "red")))) + (widget-documentation-face ((t (:foreground "lime green")))) + (widget-field-face ((t (:background "dim gray" :foreground "white")))) + (widget-inactive-face ((t (:foreground "light gray")))) + (widget-single-line-field-face ((t (:background "dim gray" :foreground "white"))))))) + +(defun color-theme-blue-sea () + "The grey on midnight blue theme. + +Includes faces for apropos, font-lock (Emacs and XEmacs), speedbar, +custom, widget, info, flyspell, gnus, message, man, woman, dired. + +This is what you should put in your .Xdefaults file, if you want to +change the colors of the menus: + +emacs*Background: DarkSlateGray +emacs*Foreground: Wheat" + (interactive) + (color-theme-blue-gnus) + (let ((color-theme-is-cumulative t)) + (color-theme-blue-erc) + (color-theme-install + '(color-theme-blue-sea + ((background-color . "MidnightBlue") + (background-mode . dark) + (border-color . "Grey") + (cursor-color . "Grey") + (foreground-color . "Grey") + (mouse-color . "Grey")) + ((Man-overstrike-face . woman-bold-face) + (Man-underline-face . woman-italic-face)) + (default ((t (nil)))) + (bold ((t (:bold t)))) + (bold-italic ((t (:bold t :foreground "beige")))) + (calendar-today-face ((t (:underline t)))) + (cperl-array-face ((t (:foreground "light salmon" :bold t)))) + (cperl-hash-face ((t (:foreground "beige" :bold t :italic t)))) + (cperl-nonoverridable-face ((t (:foreground "aquamarine")))) + (custom-button-face ((t (:foreground "gainsboro")))) + (custom-changed-face ((t (:foreground "white" :background "blue")))) + (custom-documentation-face ((t (:foreground "light blue")))) + (custom-face-tag-face ((t (:underline t)))) + (custom-group-tag-face ((t (:foreground "pale turquoise" :bold t)))) + (custom-group-tag-face-1 ((t (:foreground "pale turquoise" :underline t)))) + (custom-invalid-face ((t (:foreground "yellow" :background "red")))) + (custom-modified-face ((t (:foreground "white" :background "blue")))) + (custom-rogue-face ((t (:foreground "pink" :background "black")))) + (custom-saved-face ((t (:underline t)))) + (custom-set-face ((t (:foreground "blue" :background "white")))) + (custom-state-face ((t (:foreground "light salmon")))) + (custom-variable-button-face ((t (:bold t :underline t)))) + (custom-variable-tag-face ((t (:foreground "turquoise" :bold t)))) + (diary-face ((t (:foreground "red")))) + (dired-face-directory ((t (:bold t :foreground "sky blue")))) + (dired-face-permissions ((t (:foreground "aquamarine")))) + (dired-face-flagged ((t (:foreground "tomato")))) + (dired-face-marked ((t (:foreground "light salmon")))) + (dired-face-executable ((t (:foreground "green yellow")))) + (eshell-ls-archive-face ((t (:bold t :foreground "medium purple")))) + (eshell-ls-backup-face ((t (:foreground "dim gray")))) + (eshell-ls-clutter-face ((t (:foreground "dim gray")))) + (eshell-ls-directory-face ((t (:bold t :foreground "medium slate blue")))) + (eshell-ls-executable-face ((t (:bold t :foreground "aquamarine")))) + (eshell-ls-missing-face ((t (:foreground "black")))) + (eshell-ls-picture-face ((t (:foreground "violet")))) + (eshell-ls-product-face ((t (:foreground "light steel blue")))) + (eshell-ls-readonly-face ((t (:foreground "aquamarine")))) + (eshell-ls-special-face ((t (:foreground "gold")))) + (eshell-ls-symlink-face ((t (:foreground "white")))) + (eshell-ls-unreadable-face ((t (:foreground "dim gray")))) + (eshell-prompt-face ((t (:foreground "light sky blue" :bold t)))) + (excerpt ((t (:italic t)))) + (fixed ((t (:bold t)))) + (flyspell-duplicate-face ((t (:foreground "Gold3" :bold t :underline t)))) + (flyspell-incorrect-face ((t (:foreground "OrangeRed" :bold t :underline t)))) + (font-lock-builtin-face ((t (:foreground "aquamarine")))) + (font-lock-comment-face ((t (:foreground "light blue")))) + (font-lock-constant-face ((t (:foreground "pale green")))) + (font-lock-doc-string-face ((t (:foreground "sky blue")))) + (font-lock-function-name-face ((t (:bold t :foreground "aquamarine")))) + (font-lock-keyword-face ((t (:foreground "pale turquoise" :bold t)))) + (font-lock-reference-face ((t (:foreground "pale green")))) + (font-lock-string-face ((t (:foreground "light sky blue")))) + (font-lock-type-face ((t (:foreground "sky blue" :bold t)))) + (font-lock-variable-name-face ((t (:foreground "turquoise" :bold t)))) + (font-lock-warning-face ((t (:foreground "Red" :bold t)))) + (fringe ((t (:background "MidnightBlue")))) + (header-line ((t (:background "#002" :foreground "cornflower blue")))) + (highlight ((t (:background "dark slate blue" :foreground "light blue")))) + (highline-face ((t (:background "DeepSkyBlue4")))) + (holiday-face ((t (:background "pink")))) + (info-menu-5 ((t (:underline t)))) + (info-node ((t (:bold t)))) + (info-xref ((t (:bold t :foreground "sky blue")))) + (isearch ((t (:background "slate blue")))) + (italic ((t (:foreground "sky blue")))) + (makefile-space-face ((t (:background "hotpink")))) + (menu ((t (:background "MidnightBlue" :foreground "Grey")))) + (modeline ((t (:foreground "wheat" :background "slate blue")))) + (mode-line-inactive ((t (:background "dark slate blue" :foreground "wheat")))) + (modeline-buffer-id ((t (:foreground "beige" :background "slate blue")))) + (modeline-mousable ((t (:foreground "light cyan" :background "slate blue")))) + (modeline-mousable-minor-mode ((t (:foreground "wheat" :background "slate blue")))) + (region ((t (:background "DarkSlateBlue")))) + (secondary-selection ((t (:background "steel blue")))) + (show-paren-match-face ((t (:foreground "white" :background "light slate blue")))) + (show-paren-mismatch-face ((t (:foreground "white" :background "red")))) + (speedbar-button-face ((t (:foreground "seashell2")))) + (speedbar-directory-face ((t (:foreground "seashell3")))) + (speedbar-file-face ((t (:foreground "seashell4")))) + (speedbar-highlight-face ((t (:background "dark slate blue" :foreground "wheat")))) + (speedbar-selected-face ((t (:foreground "seashell1" :underline t)))) + (speedbar-tag-face ((t (:foreground "antique white")))) + (tool-bar ((t (:background "MidnightBlue" :foreground "Grey" :box (:line-width 1 :style released-button))))) + (underline ((t (:underline t)))) + (widget-button-face ((t (:bold t)))) + (widget-button-pressed-face ((t (:foreground "red")))) + (widget-documentation-face ((t (:foreground "light blue")))) + (widget-field-face ((t (:background "RoyalBlue4" :foreground "wheat")))) + (widget-inactive-face ((t (:foreground "dim gray")))) + (widget-single-line-field-face ((t (:background "slate blue" :foreground "wheat")))) + (woman-bold-face ((t (:foreground "sky blue" :bold t)))) + (woman-italic-face ((t (:foreground "deep sky blue")))) + (woman-unknown-face ((t (:foreground "LightSalmon")))) + (zmacs-region ((t (:background "DarkSlateBlue")))))))) + +(defun color-theme-rotor () + "Black on Beige color theme by Jinwei Shen, created 2000-06-08. +Supports default faces, font-lock, custom, widget, message, man, +show-paren, viper." + (interactive) + (color-theme-install + '(color-theme-rotor + ((background-color . "Beige") + (background-mode . light) + (border-color . "black") + (cursor-color . "Maroon") + (foreground-color . "Black") + (mouse-color . "Black")) + ((Man-overstrike-face . font-lock-function-name-face) + (Man-underline-face . font-lock-type-face) + (list-matching-lines-face . bold) + (rmail-highlight-face . font-lock-function-name-face) + (watson-attribution-face . italic) + (watson-url-face . bold) + (watson-url-mouse-face . highlight)) + (default ((t (nil)))) + (bold ((t (:bold t :background "grey40" :foreground "yellow")))) + (bold-italic ((t (:italic t :bold t :foreground "yellow green")))) + (custom-button-face ((t (nil)))) + (custom-changed-face ((t (:background "blue" :foreground "white")))) + (custom-documentation-face ((t (nil)))) + (custom-face-tag-face ((t (:underline t)))) + (custom-group-tag-face ((t (:underline t :foreground "blue")))) + (custom-group-tag-face-1 ((t (:underline t :foreground "red")))) + (custom-invalid-face ((t (:background "red" :foreground "yellow")))) + (custom-modified-face ((t (:background "blue" :foreground "white")))) + (custom-rogue-face ((t (:background "black" :foreground "pink")))) + (custom-saved-face ((t (:underline t)))) + (custom-set-face ((t (:background "white" :foreground "blue")))) + (custom-state-face ((t (:foreground "dark green")))) + (custom-variable-button-face ((t (:underline t :bold t)))) + (custom-variable-tag-face ((t (:underline t :foreground "blue")))) + (font-lock-builtin-face ((t (:foreground "Orchid")))) + (font-lock-comment-face ((t (:foreground "MediumBlue")))) + (font-lock-constant-face ((t (:foreground "CadetBlue")))) + (font-lock-function-name-face ((t (:foreground "MediumSlateBlue")))) + (font-lock-keyword-face ((t (:foreground "#80a0ff")))) + (font-lock-string-face ((t (:foreground "red")))) + (font-lock-type-face ((t (:foreground "ForestGreen")))) + (font-lock-variable-name-face ((t (:foreground "DarkGoldenrod")))) + (font-lock-warning-face ((t (:bold t :foreground "Red")))) + (highlight ((t (:background "PaleGreen" :foreground "black")))) + (italic ((t (:italic t :foreground "yellow3")))) + (message-cited-text-face ((t (:foreground "red")))) + (message-header-cc-face ((t (:foreground "MidnightBlue")))) + (message-header-name-face ((t (:foreground "cornflower blue")))) + (message-header-newsgroups-face ((t (:italic t :bold t :foreground "blue4")))) + (message-header-other-face ((t (:foreground "steel blue")))) + (message-header-subject-face ((t (:bold t :foreground "navy blue")))) + (message-header-to-face ((t (:bold t :foreground "MidnightBlue")))) + (message-header-xheader-face ((t (:foreground "blue")))) + (message-separator-face ((t (:foreground "brown")))) + (modeline ((t (:background "wheat" :foreground "DarkOliveGreen")))) + (modeline-buffer-id ((t (:background "wheat" :foreground "DarkOliveGreen")))) + (modeline-mousable ((t (:background "wheat" :foreground "DarkOliveGreen")))) + (modeline-mousable-minor-mode ((t (:background "wheat" :foreground "DarkOliveGreen")))) + (nil ((t (nil)))) + (region ((t (:background "dark cyan" :foreground "cyan")))) + (secondary-selection ((t (:background "Turquoise" :foreground "black")))) + (show-paren-match-face ((t (:background "turquoise")))) + (show-paren-mismatch-face ((t (:background "purple" :foreground "white")))) + (underline ((t (:underline t)))) + (viper-minibuffer-emacs-face ((t (:background "darkseagreen2" :foreground "Black")))) + (viper-minibuffer-insert-face ((t (:background "pink" :foreground "Black")))) + (viper-minibuffer-vi-face ((t (:background "grey" :foreground "DarkGreen")))) + (viper-replace-overlay-face ((t (:background "darkseagreen2" :foreground "Black")))) + (viper-search-face ((t (:background "khaki" :foreground "Black")))) + (widget-button-face ((t (:bold t)))) + (widget-button-pressed-face ((t (:foreground "red")))) + (widget-documentation-face ((t (:foreground "dark green")))) + (widget-field-face ((t (:background "gray85")))) + (widget-inactive-face ((t (:foreground "dim gray")))) + (widget-single-line-field-face ((t (:background "gray85"))))))) + +(defun color-theme-pierson () + "Black on White color theme by Dan L. Pierson, created 2000-06-08. +Supports default faces, font-lock, show-paren." + (interactive) + (color-theme-install + '(color-theme-pierson + ((background-color . "AntiqueWhite") + (background-mode . light) + (border-color . "black") + (cursor-color . "Orchid") + (foreground-color . "black") + (mouse-color . "Orchid")) + ((list-matching-lines-face . bold)) + (default ((t (nil)))) + (bold ((t (:bold t)))) + (bold-italic ((t (:italic t :bold t)))) + (font-lock-builtin-face ((t (:foreground "Orchid")))) + (font-lock-comment-face ((t (:foreground "ForestGreen")))) + (font-lock-constant-face ((t (:foreground "CadetBlue")))) + (font-lock-function-name-face ((t (:foreground "blue3")))) + (font-lock-keyword-face ((t (:foreground "Blue")))) + (font-lock-string-face ((t (:foreground "Firebrick")))) + (font-lock-type-face ((t (:foreground "Purple")))) + (font-lock-variable-name-face ((t (:foreground "blue3")))) + (font-lock-warning-face ((t (:bold t :foreground "Red")))) + (highlight ((t (:background "darkseagreen2")))) + (italic ((t (:italic t)))) + (modeline ((t (:foreground "antiquewhite" :background "black")))) + (modeline-mousable-minor-mode ((t (:foreground "antiquewhite" :background "black")))) + (modeline-mousable ((t (:foreground "antiquewhite" :background "black")))) + (modeline-buffer-id ((t (:foreground "antiquewhite" :background "black")))) + (region ((t (:background "gray")))) + (secondary-selection ((t (:background "paleturquoise")))) + (show-paren-match-face ((t (:background "turquoise")))) + (show-paren-mismatch-face ((t (:background "purple" :foreground "white")))) + (underline ((t (:underline t))))))) + +(defun color-theme-xemacs () + "XEmacs standard colors. +If you are missing standard faces in this theme, please notify the maintainer. +Currently, this theme includes the standard faces and font-lock faces, including +some faces used in Emacs only but which are needed to recreate the look of the +XEmacs color theme." + (interactive) + (color-theme-install + '(color-theme-xemacs + ((background-color . "gray80") + (background-mode . light) + (background-toolbar-color . "#cf3ccf3ccf3c") + (border-color . "#000000000000") + (bottom-toolbar-shadow-color . "#79e77df779e7") + (cursor-color . "Red3") + (foreground-color . "black") + (top-toolbar-shadow-color . "#fffffbeeffff")) + (default ((t (nil)))) + (blue ((t (:foreground "blue")))) + (bold ((t (:bold t)))) + (bold-italic ((t (:italic t :bold t)))) + (border-glyph ((t (nil)))) + (custom-button-face ((t (:bold t)))) + (custom-changed-face ((t (:background "blue" :foreground "white")))) + (custom-documentation-face ((t (nil)))) + (custom-face-tag-face ((t (:underline t)))) + (custom-group-tag-face ((t (:underline t :foreground "blue")))) + (custom-group-tag-face-1 ((t (:underline t :foreground "red")))) + (custom-invalid-face ((t (:background "red" :foreground "yellow")))) + (custom-modified-face ((t (:background "blue" :foreground "white")))) + (custom-rogue-face ((t (:background "black" :foreground "pink")))) + (custom-saved-face ((t (:underline t)))) + (custom-set-face ((t (:background "white" :foreground "blue")))) + (custom-state-face ((t (:foreground "dark green")))) + (custom-variable-button-face ((t (:underline t :bold t)))) + (custom-variable-tag-face ((t (:underline t :foreground "blue")))) + (dired-face-boring ((t (:foreground "Gray65")))) + (dired-face-directory ((t (:bold t)))) + (dired-face-executable ((t (:foreground "SeaGreen")))) + (dired-face-flagged ((t (:background "LightSlateGray")))) + (dired-face-marked ((t (:background "PaleVioletRed")))) + (dired-face-permissions ((t (:background "grey75" :foreground "black")))) + (dired-face-setuid ((t (:foreground "Red")))) + (dired-face-socket ((t (:foreground "magenta")))) + (dired-face-symlink ((t (:foreground "cyan")))) + (font-lock-builtin-face ((t (:foreground "red3")))) + (font-lock-comment-face ((t (:foreground "blue4")))) + (font-lock-constant-face ((t (:foreground "red3")))) + (font-lock-doc-string-face ((t (:foreground "green4")))) + (font-lock-function-name-face ((t (:foreground "brown4")))) + (font-lock-keyword-face ((t (:foreground "red4")))) + (font-lock-preprocessor-face ((t (:foreground "blue3")))) + (font-lock-reference-face ((t (:foreground "red3")))) + (font-lock-string-face ((t (:foreground "green4")))) + (font-lock-type-face ((t (:foreground "steelblue")))) + (font-lock-variable-name-face ((t (:foreground "magenta4")))) + (font-lock-warning-face ((t (:bold t :foreground "Red")))) + (green ((t (:foreground "green")))) + (gui-button-face ((t (:background "grey75" :foreground "black")))) + (gui-element ((t (:background "Gray80")))) + (highlight ((t (:background "darkseagreen2")))) + (info-node ((t (:italic t :bold t)))) + (info-xref ((t (:bold t)))) + (isearch ((t (:background "paleturquoise")))) + (italic ((t (:italic t)))) + (left-margin ((t (nil)))) + (list-mode-item-selected ((t (:background "gray68")))) + (modeline ((t (:background "Gray80")))) + (modeline-buffer-id ((t (:background "Gray80" :foreground "blue4")))) + (modeline-mousable ((t (:background "Gray80" :foreground "firebrick")))) + (modeline-mousable-minor-mode ((t (:background "Gray80" :foreground "green4")))) + (paren-blink-off ((t (:foreground "gray80")))) + (paren-match ((t (:background "darkseagreen2")))) + (paren-mismatch ((t (:background "DeepPink" :foreground "black")))) + (pointer ((t (nil)))) + (primary-selection ((t (:background "gray65")))) + (red ((t (:foreground "red")))) + (region ((t (:background "gray65")))) + (right-margin ((t (nil)))) + (secondary-selection ((t (:background "paleturquoise")))) + (text-cursor ((t (:background "Red3" :foreground "gray80")))) + (toolbar ((t (:background "Gray80")))) + (underline ((t (:underline t)))) + (vertical-divider ((t (:background "Gray80")))) + (widget-button-face ((t (:bold t)))) + (widget-button-pressed-face ((t (:foreground "red")))) + (widget-documentation-face ((t (:foreground "dark green")))) + (widget-field-face ((t (:background "gray85")))) + (widget-inactive-face ((t (:foreground "dim gray")))) + (yellow ((t (:foreground "yellow")))) + (zmacs-region ((t (:background "gray65"))))))) + +(defun color-theme-jsc-light () + "Color theme by John S Cooper, created 2000-06-08." + (interactive) + (color-theme-install + '(color-theme-jsc-light + ((background-color . "white") + (background-mode . light) + (border-color . "black") + (cursor-color . "Red") + (foreground-color . "black") + (mouse-color . "black")) + ((gnus-mouse-face . highlight) + (list-matching-lines-face . bold) + (view-highlight-face . highlight)) + (default ((t (nil)))) + (bold ((t (:bold t :foreground "red3")))) + (bold-italic ((t (:italic t :bold t :foreground "red")))) + (custom-button-face ((t (nil)))) + (custom-changed-face ((t (:background "blue" :foreground "white")))) + (custom-documentation-face ((t (nil)))) + (custom-face-tag-face ((t (:underline t)))) + (custom-group-tag-face ((t (:underline t :foreground "blue")))) + (custom-group-tag-face-1 ((t (:underline t :foreground "red")))) + (custom-invalid-face ((t (:background "red" :foreground "yellow")))) + (custom-modified-face ((t (:background "blue" :foreground "white")))) + (custom-rogue-face ((t (:background "black" :foreground "pink")))) + (custom-saved-face ((t (:underline t)))) + (custom-set-face ((t (:background "white" :foreground "blue")))) + (custom-state-face ((t (:foreground "dark green")))) + (custom-variable-button-face ((t (:underline t :bold t)))) + (custom-variable-tag-face ((t (:underline t :foreground "blue")))) + (font-lock-builtin-face ((t (:foreground "Orchid")))) + (font-lock-comment-face ((t (:italic t :bold t :foreground "Red3")))) + (font-lock-constant-face ((t (:foreground "navy")))) + (font-lock-function-name-face ((t (:bold t :foreground "Blue")))) + (font-lock-keyword-face ((t (:bold t :foreground "Purple")))) + (font-lock-string-face ((t (:foreground "Green4")))) + (font-lock-type-face ((t (:foreground "Navy")))) + (font-lock-variable-name-face ((t (:foreground "Tan4")))) + (font-lock-warning-face ((t (:bold t :foreground "Red")))) + (gnus-cite-attribution-face ((t (:italic t)))) + (gnus-cite-face-1 ((t (:foreground "MidnightBlue")))) + (gnus-cite-face-10 ((t (:foreground "medium purple")))) + (gnus-cite-face-11 ((t (:foreground "turquoise")))) + (gnus-cite-face-2 ((t (:foreground "firebrick")))) + (gnus-cite-face-3 ((t (:foreground "dark green")))) + (gnus-cite-face-4 ((t (:foreground "OrangeRed")))) + (gnus-cite-face-5 ((t (:foreground "dark khaki")))) + (gnus-cite-face-6 ((t (:foreground "dark violet")))) + (gnus-cite-face-7 ((t (:foreground "SteelBlue4")))) + (gnus-cite-face-8 ((t (:foreground "magenta")))) + (gnus-cite-face-9 ((t (:foreground "violet")))) + (gnus-emphasis-bold ((t (:bold t)))) + (gnus-emphasis-bold-italic ((t (:italic t :bold t)))) + (gnus-emphasis-highlight-words ((t (:background "black" :foreground "yellow")))) + (gnus-emphasis-italic ((t (:italic t)))) + (gnus-emphasis-underline ((t (:underline t)))) + (gnus-emphasis-underline-bold ((t (:underline t :bold t)))) + (gnus-emphasis-underline-bold-italic ((t (:underline t :italic t :bold t)))) + (gnus-emphasis-underline-italic ((t (:underline t :italic t)))) + (gnus-group-mail-1-empty-face ((t (:foreground "DeepPink3")))) + (gnus-group-mail-1-face ((t (:bold t :foreground "DeepPink3")))) + (gnus-group-mail-2-empty-face ((t (:foreground "HotPink3")))) + (gnus-group-mail-2-face ((t (:bold t :foreground "HotPink3")))) + (gnus-group-mail-3-empty-face ((t (:foreground "magenta4")))) + (gnus-group-mail-3-face ((t (:bold t :foreground "magenta4")))) + (gnus-group-mail-low-empty-face ((t (:foreground "DeepPink4")))) + (gnus-group-mail-low-face ((t (:bold t :foreground "DeepPink4")))) + (gnus-group-news-1-empty-face ((t (:foreground "blue2")))) + (gnus-group-news-1-face ((t (:bold t :foreground "blue2")))) + (gnus-group-news-2-empty-face ((t (:foreground "CadetBlue4")))) + (gnus-group-news-2-face ((t (:bold t :foreground "CadetBlue4")))) + (gnus-group-news-3-empty-face ((t (nil)))) + (gnus-group-news-3-face ((t (:bold t)))) + (gnus-group-news-4-empty-face ((t (nil)))) + (gnus-group-news-4-face ((t (:bold t)))) + (gnus-group-news-5-empty-face ((t (nil)))) + (gnus-group-news-5-face ((t (:bold t)))) + (gnus-group-news-6-empty-face ((t (nil)))) + (gnus-group-news-6-face ((t (:bold t)))) + (gnus-group-news-low-empty-face ((t (:foreground "DarkGreen")))) + (gnus-group-news-low-face ((t (:bold t :foreground "DarkGreen")))) + (gnus-header-content-face ((t (:italic t :foreground "blue")))) + (gnus-header-from-face ((t (:foreground "red3")))) + (gnus-header-name-face ((t (:foreground "red3")))) + (gnus-header-newsgroups-face ((t (:italic t :foreground "MidnightBlue")))) + (gnus-header-subject-face ((t (:bold t :foreground "red")))) + (gnus-signature-face ((t (:foreground "pink")))) + (gnus-splash-face ((t (:foreground "Brown")))) + (gnus-summary-cancelled-face ((t (:background "black" :foreground "yellow")))) + (gnus-summary-high-ancient-face ((t (:bold t :foreground "RoyalBlue")))) + (gnus-summary-high-read-face ((t (:bold t :foreground "navy")))) + (gnus-summary-high-ticked-face ((t (:bold t :foreground "firebrick")))) + (gnus-summary-high-unread-face ((t (:bold t :foreground "blue")))) + (gnus-summary-low-ancient-face ((t (:italic t :foreground "RoyalBlue")))) + (gnus-summary-low-read-face ((t (:italic t :foreground "DarkGreen")))) + (gnus-summary-low-ticked-face ((t (:italic t :foreground "firebrick")))) + (gnus-summary-low-unread-face ((t (:italic t)))) + (gnus-summary-normal-ancient-face ((t (:foreground "RoyalBlue")))) + (gnus-summary-normal-read-face ((t (:foreground "red3")))) + (gnus-summary-normal-ticked-face ((t (:foreground "black")))) + (gnus-summary-normal-unread-face ((t (:bold t :foreground "red3")))) + (gnus-summary-selected-face ((t (:underline t)))) + (highlight ((t (:background "antiquewhite" :foreground "blue")))) + (italic ((t (:italic t)))) + (makefile-space-face ((t (:background "hotpink")))) + (message-cited-text-face ((t (:foreground "red")))) + (message-header-cc-face ((t (:foreground "MidnightBlue")))) + (message-header-name-face ((t (:foreground "cornflower blue")))) + (message-header-newsgroups-face ((t (:italic t :bold t :foreground "blue4")))) + (message-header-other-face ((t (:foreground "steel blue")))) + (message-header-subject-face ((t (:bold t :foreground "navy blue")))) + (message-header-to-face ((t (:bold t :foreground "MidnightBlue")))) + (message-header-xheader-face ((t (:foreground "blue")))) + (message-mml-face ((t (:foreground "ForestGreen")))) + (message-separator-face ((t (:foreground "brown")))) + (modeline ((t (:background "plum" :foreground "black")))) + (modeline-buffer-id ((t (:background "plum" :foreground "black")))) + (modeline-mousable ((t (:background "plum" :foreground "black")))) + (modeline-mousable-minor-mode ((t (:background "plum" :foreground "black")))) + (region ((t (:background "plum")))) + (secondary-selection ((t (:background "palegreen")))) + (show-paren-match-face ((t (:background "plum")))) + (show-paren-mismatch-face ((t (:background "navy" :foreground "white")))) + (speedbar-button-face ((t (:foreground "green4")))) + (speedbar-directory-face ((t (:foreground "blue4")))) + (speedbar-file-face ((t (:foreground "cyan4")))) + (speedbar-highlight-face ((t (:background "green")))) + (speedbar-selected-face ((t (:underline t :foreground "red")))) + (speedbar-tag-face ((t (:foreground "brown")))) + (underline ((t (:underline t)))) + (widget-button-face ((t (:bold t)))) + (widget-button-pressed-face ((t (:foreground "red")))) + (widget-documentation-face ((t (:foreground "dark green")))) + (widget-field-face ((t (:background "gray85")))) + (widget-inactive-face ((t (:foreground "dim gray")))) + (widget-single-line-field-face ((t (:background "gray85"))))))) + +(defun color-theme-jsc-dark () + "Color theme by John S Cooper, created 2000-06-11." + (interactive) + (color-theme-install + '(color-theme-jsc-dark + ((background-color . "black") + (background-mode . dark) + (border-color . "black") + (cursor-color . "white") + (foreground-color . "cornsilk") + (mouse-color . "black")) + ((gnus-mouse-face . highlight) + (goto-address-mail-face . italic) + (goto-address-mail-mouse-face . secondary-selection) + (goto-address-url-face . bold) + (goto-address-url-mouse-face . highlight) + (list-matching-lines-face . bold) + (view-highlight-face . highlight)) + (blank-space-face ((t (:background "LightGray")))) + (blank-tab-face ((t (:background "cornsilk" :foreground "black")))) + (default ((t (nil)))) + (bold ((t (:bold t :foreground "white")))) + (bold-italic ((t (:italic t :bold t)))) + (calendar-today-face ((t (:underline t)))) + (cperl-array-face ((t (:bold t :background "lightyellow2" :foreground "Blue")))) + (cperl-hash-face ((t (:italic t :bold t :background "lightyellow2" :foreground "Red")))) + (cperl-nonoverridable-face ((t (:foreground "chartreuse3")))) + (custom-button-face ((t (:foreground "white")))) + (custom-changed-face ((t (:background "skyblue" :foreground "wheat")))) + (custom-documentation-face ((t (:foreground "white")))) + (custom-face-tag-face ((t (:underline t :foreground "white")))) + (custom-group-tag-face ((t (:underline t :foreground "skyblue")))) + (custom-group-tag-face-1 ((t (:underline t :foreground "pink")))) + (custom-invalid-face ((t (:background "red" :foreground "yellow")))) + (custom-modified-face ((t (:background "blue" :foreground "white")))) + (custom-rogue-face ((t (:background "black" :foreground "pink")))) + (custom-saved-face ((t (:underline t)))) + (custom-set-face ((t (:foreground "blue")))) + (custom-state-face ((t (:foreground "light green")))) + (custom-variable-button-face ((t (:underline t :bold t)))) + (custom-variable-tag-face ((t (:underline t :foreground "skyblue")))) + (diary-face ((t (:bold t :foreground "orange")))) + (font-lock-builtin-face ((t (:bold t :foreground "LightSteelBlue")))) + (font-lock-comment-face ((t (:italic t :foreground "red")))) + (font-lock-constant-face ((t (:bold t :foreground "salmon")))) + (font-lock-function-name-face ((t (:bold t :foreground "orange")))) + (font-lock-keyword-face ((t (:bold t :foreground "gold")))) + (font-lock-string-face ((t (:italic t :foreground "orange")))) + (font-lock-type-face ((t (:bold t :foreground "gold")))) + (font-lock-variable-name-face ((t (:italic t :bold t :foreground "light salmon")))) + (font-lock-warning-face ((t (:bold t :foreground "gold")))) + (gnus-cite-attribution-face ((t (:italic t)))) + (gnus-cite-face-1 ((t (:foreground "light cyan")))) + (gnus-cite-face-10 ((t (:foreground "medium purple")))) + (gnus-cite-face-11 ((t (:foreground "turquoise")))) + (gnus-cite-face-2 ((t (:foreground "light blue")))) + (gnus-cite-face-3 ((t (:foreground "light yellow")))) + (gnus-cite-face-4 ((t (:foreground "light pink")))) + (gnus-cite-face-5 ((t (:foreground "pale green")))) + (gnus-cite-face-6 ((t (:foreground "beige")))) + (gnus-cite-face-7 ((t (:foreground "orange")))) + (gnus-cite-face-8 ((t (:foreground "magenta")))) + (gnus-cite-face-9 ((t (:foreground "violet")))) + (gnus-emphasis-bold ((t (:bold t)))) + (gnus-emphasis-bold-italic ((t (:italic t :bold t)))) + (gnus-emphasis-highlight-words ((t (:background "black" :foreground "yellow")))) + (gnus-emphasis-italic ((t (:italic t)))) + (gnus-emphasis-underline ((t (:background "goldenrod4" :foreground "white")))) + (gnus-emphasis-underline-bold ((t (:underline t :bold t :background "yellow" :foreground "black")))) + (gnus-emphasis-underline-bold-italic ((t (:underline t :italic t :bold t :background "yellow" :foreground "black")))) + (gnus-emphasis-underline-italic ((t (:underline t :italic t :background "yellow" :foreground "black")))) + (gnus-filterhist-face-1 ((t (nil)))) + (gnus-group-mail-1-empty-face ((t (:foreground "gray80")))) + (gnus-group-mail-1-face ((t (:bold t :foreground "white")))) + (gnus-group-mail-2-empty-face ((t (:foreground "lightcyan")))) + (gnus-group-mail-2-face ((t (:bold t :foreground "lightcyan")))) + (gnus-group-mail-3-empty-face ((t (:foreground "tan")))) + (gnus-group-mail-3-face ((t (:bold t :foreground "tan")))) + (gnus-group-mail-low-empty-face ((t (:foreground "aquamarine4")))) + (gnus-group-mail-low-face ((t (:bold t :foreground "aquamarine4")))) + (gnus-group-news-1-empty-face ((t (:foreground "white")))) + (gnus-group-news-1-face ((t (:bold t :foreground "white")))) + (gnus-group-news-2-empty-face ((t (:foreground "lightcyan")))) + (gnus-group-news-2-face ((t (:bold t :foreground "lightcyan")))) + (gnus-group-news-3-empty-face ((t (:foreground "tan")))) + (gnus-group-news-3-face ((t (:bold t :foreground "tan")))) + (gnus-group-news-4-empty-face ((t (:foreground "white")))) + (gnus-group-news-4-face ((t (:bold t :foreground "white")))) + (gnus-group-news-5-empty-face ((t (:foreground "wheat")))) + (gnus-group-news-5-face ((t (:bold t :foreground "wheat")))) + (gnus-group-news-6-empty-face ((t (:foreground "tan")))) + (gnus-group-news-6-face ((t (:bold t :foreground "tan")))) + (gnus-group-news-low-empty-face ((t (:foreground "DarkTurquoise")))) + (gnus-group-news-low-face ((t (:bold t :foreground "DarkTurquoise")))) + (gnus-header-content-face ((t (:italic t :foreground "plum1")))) + (gnus-header-from-face ((t (:bold t :foreground "wheat")))) + (gnus-header-name-face ((t (:bold t :foreground "gold")))) + (gnus-header-newsgroups-face ((t (:italic t :bold t :foreground "wheat")))) + (gnus-header-subject-face ((t (:bold t :foreground "red")))) + (gnus-signature-face ((t (:italic t :foreground "maroon")))) + (gnus-splash ((t (:foreground "Brown")))) + (gnus-splash-face ((t (:foreground "gold")))) + (gnus-summary-cancelled-face ((t (:background "gray" :foreground "black")))) + (gnus-summary-high-ancient-face ((t (:bold t :foreground "SkyBlue")))) + (gnus-summary-high-read-face ((t (:bold t :foreground "PaleGreen")))) + (gnus-summary-high-ticked-face ((t (:bold t :foreground "gray70")))) + (gnus-summary-high-unread-face ((t (:italic t :bold t)))) + (gnus-summary-low-ancient-face ((t (:italic t :foreground "SkyBlue")))) + (gnus-summary-low-read-face ((t (:italic t :foreground "PaleGreen")))) + (gnus-summary-low-ticked-face ((t (:italic t :bold t :foreground "gray70")))) + (gnus-summary-low-unread-face ((t (:italic t)))) + (gnus-summary-normal-ancient-face ((t (:foreground "SkyBlue")))) + (gnus-summary-normal-read-face ((t (:foreground "PaleGreen")))) + (gnus-summary-normal-ticked-face ((t (:bold t :foreground "gray70")))) + (gnus-summary-normal-unread-face ((t (:bold t)))) + (gnus-summary-selected-face ((t (:underline t :background "deepskyblue4")))) + (highlight ((t (:background "darkslategray" :foreground "wheat")))) + (highlight-changes-delete-face ((t (:underline t :foreground "red")))) + (highlight-changes-face ((t (:foreground "red")))) + (highline-face ((t (:background "gray35")))) + (holiday-face ((t (:background "red")))) + (info-menu-5 ((t (:underline t)))) + (info-node ((t (:italic t :bold t :foreground "yellow")))) + (info-xref ((t (:bold t :foreground "plum")))) + (italic ((t (:italic t)))) + (lazy-highlight-face ((t (:bold t :foreground "dark magenta")))) + (linemenu-face ((t (:background "gray30")))) + (makefile-space-face ((t (:background "hotpink")))) + (message-cited-text-face ((t (:foreground "plum1")))) + (message-header-cc-face ((t (:bold t :foreground "ivory")))) + (message-header-name-face ((t (:foreground "light sky blue")))) + (message-header-newsgroups-face ((t (:italic t :bold t :foreground "lavender blush")))) + (message-header-other-face ((t (:foreground "pale turquoise")))) + (message-header-subject-face ((t (:bold t :foreground "papaya whip")))) + (message-header-to-face ((t (:bold t :foreground "floral white")))) + (message-header-xheader-face ((t (:foreground "blue")))) + (message-mml-face ((t (:bold t :foreground "ForestGreen")))) + (message-separator-face ((t (:foreground "sandy brown")))) + (modeline ((t (:background "tan" :foreground "black")))) + (modeline-buffer-id ((t (:background "tan" :foreground "black")))) + (modeline-mousable ((t (:background "tan" :foreground "black")))) + (modeline-mousable-minor-mode ((t (:background "tan" :foreground "black")))) + (paren-mismatch-face ((t (:bold t :background "white" :foreground "red")))) + (paren-no-match-face ((t (:bold t :background "white" :foreground "red")))) + (region ((t (:background "slategrey")))) + (secondary-selection ((t (:background "deepskyblue4")))) + (sgml-doctype-face ((t (:foreground "orange")))) + (sgml-end-tag-face ((t (:foreground "greenyellow")))) + (sgml-entity-face ((t (:foreground "gold")))) + (sgml-ignored-face ((t (:background "gray60" :foreground "gray20")))) + (sgml-sgml-face ((t (:foreground "yellow")))) + (sgml-start-tag-face ((t (:foreground "mediumspringgreen")))) + (show-paren-match-face ((t (:background "deepskyblue4")))) + (show-paren-mismatch-face ((t (:bold t :background "red" :foreground "white")))) + (speedbar-button-face ((t (:foreground "green4")))) + (speedbar-directory-face ((t (:foreground "blue4")))) + (speedbar-file-face ((t (:bold t :foreground "cyan4")))) + (speedbar-highlight-face ((t (:background "green")))) + (speedbar-selected-face ((t (:underline t :foreground "red")))) + (speedbar-tag-face ((t (:foreground "brown")))) + (underline ((t (:underline t)))) + (widget-button-face ((t (:bold t)))) + (widget-button-pressed-face ((t (:foreground "red")))) + (widget-documentation-face ((t (:foreground "lime green")))) + (widget-field-face ((t (:background "gray20")))) + (widget-inactive-face ((t (:foreground "wheat")))) + (widget-single-line-field-face ((t (:background "gray20")))) + (woman-bold-face ((t (:bold t)))) + (woman-italic-face ((t (:foreground "beige")))) + (woman-unknown-face ((t (:foreground "LightSalmon"))))))) + +(defun color-theme-greiner () + "Color theme by Kevin Greiner, created 2000-06-13. +Black on Beige, supports default, font-lock, speedbar, custom, widget +faces. Designed to be easy on the eyes, particularly on Win32 +computers which commonly have white window backgrounds." + (interactive) + (color-theme-install + '(color-theme-greiner + ((background-color . "beige") + (background-mode . light) + (border-color . "black") + (cursor-color . "black") + (foreground-color . "black") + (mouse-color . "black")) + ((list-matching-lines-face . bold)) + (default ((t (nil)))) + (bold ((t (:bold t)))) + (bold-italic ((t (:italic t :bold t)))) + (custom-button-face ((t (nil)))) + (custom-changed-face ((t (:background "blue" :foreground "white")))) + (custom-documentation-face ((t (nil)))) + (custom-face-tag-face ((t (:underline t)))) + (custom-group-tag-face ((t (:underline t :foreground "blue")))) + (custom-group-tag-face-1 ((t (:underline t :foreground "red")))) + (custom-invalid-face ((t (:background "red" :foreground "yellow")))) + (custom-modified-face ((t (:background "blue" :foreground "white")))) + (custom-rogue-face ((t (:background "black" :foreground "pink")))) + (custom-saved-face ((t (:underline t)))) + (custom-set-face ((t (:background "white" :foreground "blue")))) + (custom-state-face ((t (:foreground "dark green")))) + (custom-variable-button-face ((t (:underline t :bold t)))) + (custom-variable-tag-face ((t (:underline t :foreground "blue")))) + (font-lock-builtin-face ((t (:foreground "blue4")))) + (font-lock-comment-face ((t (:foreground "Firebrick")))) + (font-lock-constant-face ((t (:foreground "CadetBlue")))) + (font-lock-function-name-face ((t (:foreground "Blue")))) + (font-lock-keyword-face ((t (:foreground "royal blue")))) + (font-lock-string-face ((t (:foreground "RosyBrown")))) + (font-lock-type-face ((t (:foreground "ForestGreen")))) + (font-lock-variable-name-face ((t (:foreground "DarkGoldenrod")))) + (font-lock-warning-face ((t (:bold t :foreground "Red")))) + (highlight ((t (:background "darkseagreen2")))) + (info-menu-5 ((t (:underline t)))) + (info-node ((t (:italic t :bold t)))) + (info-xref ((t (:bold t)))) + (italic ((t (:italic t)))) + (modeline ((t (:background "black" :foreground "white")))) + (modeline-mousable-minor-mode ((t (:background "black" :foreground "white")))) + (modeline-mousable ((t (:background "black" :foreground "white")))) + (modeline-buffer-id ((t (:background "black" :foreground "white")))) + (region ((t (:background "gray")))) + (secondary-selection ((t (:background "paleturquoise")))) + (show-paren-match-face ((t (:background "turquoise")))) + (show-paren-mismatch-face ((t (:background "purple" :foreground "white")))) + (speedbar-button-face ((t (:foreground "green4")))) + (speedbar-directory-face ((t (:foreground "blue4")))) + (speedbar-file-face ((t (:foreground "cyan4")))) + (speedbar-highlight-face ((t (:background "green")))) + (speedbar-selected-face ((t (:underline t :foreground "red")))) + (speedbar-tag-face ((t (:foreground "brown")))) + (underline ((t (:underline t)))) + (widget-button-face ((t (:bold t)))) + (widget-button-pressed-face ((t (:foreground "red")))) + (widget-documentation-face ((t (:foreground "dark green")))) + (widget-field-face ((t (:background "gray85")))) + (widget-inactive-face ((t (:foreground "dim gray")))) + (widget-single-line-field-face ((t (:background "gray85"))))))) + +(defun color-theme-jb-simple () + "Color theme by jeff, created 2000-06-14. +Uses white background and bold for many things" + (interactive) + (color-theme-install + '(color-theme-jb-simple + ((background-color . "white") + (background-mode . light) + (background-toolbar-color . "#cf3ccf3ccf3c") + (border-color . "black") + (bottom-toolbar-shadow-color . "#79e77df779e7") + (cursor-color . "black") + (foreground-color . "black") + (mouse-color . "black") + (top-toolbar-shadow-color . "#fffffbeeffff")) + ((gnus-mouse-face . highlight) + (list-matching-lines-face . bold) + (rmail-highlight-face . font-lock-function-name-face) + (view-highlight-face . highlight)) + (default ((t (nil)))) + (blank-space-face ((t (nil)))) + (blank-tab-face ((t (nil)))) + (blue ((t (nil)))) + (bold ((t (:bold t)))) + (bold-italic ((t (:italic t :bold t)))) + (border-glyph ((t (nil)))) + (calendar-today-face ((t (:underline t)))) + (cperl-array-face ((t (:bold t :background "lightyellow2" :foreground "Blue")))) + (cperl-hash-face ((t (:italic t :bold t :background "lightyellow2" :foreground "Red")))) + (cperl-nonoverridable-face ((t (:foreground "chartreuse3")))) + (custom-button-face ((t (:bold t)))) + (custom-changed-face ((t (:background "blue" :foreground "white")))) + (custom-documentation-face ((t (nil)))) + (custom-face-tag-face ((t (:underline t)))) + (custom-group-tag-face ((t (:underline t :bold t :foreground "blue")))) + (custom-group-tag-face-1 ((t (:underline t :foreground "red")))) + (custom-invalid-face ((t (:background "red" :foreground "yellow")))) + (custom-modified-face ((t (:background "blue" :foreground "white")))) + (custom-rogue-face ((t (:background "black" :foreground "pink")))) + (custom-saved-face ((t (:underline t)))) + (custom-set-face ((t (:background "white" :foreground "blue")))) + (custom-state-face ((t (:foreground "dark green")))) + (custom-variable-button-face ((t (:underline t :bold t)))) + (custom-variable-tag-face ((t (:underline t :bold t :foreground "blue")))) + (diary-face ((t (:bold t :foreground "red")))) + (ediff-current-diff-face-A ((t (:background "pale green" :foreground "firebrick")))) + (ediff-current-diff-face-Ancestor ((t (:background "VioletRed" :foreground "Black")))) + (ediff-current-diff-face-B ((t (:background "Yellow" :foreground "DarkOrchid")))) + (ediff-current-diff-face-C ((t (:background "Pink" :foreground "Navy")))) + (ediff-even-diff-face-A ((t (:background "light grey" :foreground "Black")))) + (ediff-even-diff-face-Ancestor ((t (:background "Grey" :foreground "White")))) + (ediff-even-diff-face-B ((t (:background "Grey" :foreground "White")))) + (ediff-even-diff-face-C ((t (:background "light grey" :foreground "Black")))) + (ediff-fine-diff-face-A ((t (:background "sky blue" :foreground "Navy")))) + (ediff-fine-diff-face-Ancestor ((t (:background "Green" :foreground "Black")))) + (ediff-fine-diff-face-B ((t (:background "cyan" :foreground "Black")))) + (ediff-fine-diff-face-C ((t (:background "Turquoise" :foreground "Black")))) + (ediff-odd-diff-face-A ((t (:background "Grey" :foreground "White")))) + (ediff-odd-diff-face-Ancestor ((t (:background "light grey" :foreground "Black")))) + (ediff-odd-diff-face-B ((t (:background "light grey" :foreground "Black")))) + (ediff-odd-diff-face-C ((t (:background "Grey" :foreground "White")))) + (erc-action-face ((t (:bold t)))) + (erc-bold-face ((t (:bold t)))) + (erc-default-face ((t (nil)))) + (erc-direct-msg-face ((t (nil)))) + (erc-error-face ((t (:bold t)))) + (erc-input-face ((t (nil)))) + (erc-inverse-face ((t (nil)))) + (erc-notice-face ((t (nil)))) + (erc-pal-face ((t (nil)))) + (erc-prompt-face ((t (nil)))) + (erc-underline-face ((t (nil)))) + (eshell-ls-archive-face ((t (:bold t :foreground "Orchid")))) + (eshell-ls-backup-face ((t (:foreground "OrangeRed")))) + (eshell-ls-clutter-face ((t (:bold t :foreground "OrangeRed")))) + (eshell-ls-directory-face ((t (:bold t :foreground "Blue")))) + (eshell-ls-executable-face ((t (:bold t :foreground "ForestGreen")))) + (eshell-ls-missing-face ((t (:bold t :foreground "Red")))) + (eshell-ls-picture-face ((t (nil)))) + (eshell-ls-product-face ((t (:foreground "OrangeRed")))) + (eshell-ls-readonly-face ((t (:foreground "Brown")))) + (eshell-ls-special-face ((t (:bold t :foreground "Magenta")))) + (eshell-ls-symlink-face ((t (:bold t :foreground "DarkCyan")))) + (eshell-ls-unreadable-face ((t (:foreground "Grey30")))) + (eshell-prompt-face ((t (:bold t :foreground "Red")))) + (eshell-test-failed-face ((t (:bold t :foreground "OrangeRed")))) + (eshell-test-ok-face ((t (:bold t :foreground "Green")))) + (excerpt ((t (:italic t)))) + (ff-paths-non-existant-file-face ((t (:bold t :foreground "NavyBlue")))) + (fixed ((t (:bold t)))) + (flyspell-duplicate-face ((t (:underline t :bold t :foreground "Gold3")))) + (flyspell-incorrect-face ((t (:underline t :bold t :foreground "OrangeRed")))) + (font-latex-bold-face ((t (nil)))) + (font-latex-italic-face ((t (nil)))) + (font-latex-math-face ((t (nil)))) + (font-latex-sedate-face ((t (nil)))) + (font-latex-string-face ((t (nil)))) + (font-latex-warning-face ((t (nil)))) + (font-lock-builtin-face ((t (:bold t :foreground "Orchid")))) + (font-lock-comment-face ((t (:italic t :bold t :foreground "blue4")))) + (font-lock-constant-face ((t (:bold t :foreground "CadetBlue")))) + (font-lock-doc-string-face ((t (:italic t :bold t :foreground "blue4")))) + (font-lock-exit-face ((t (nil)))) + (font-lock-function-name-face ((t (:bold t :foreground "brown4")))) + (font-lock-keyword-face ((t (:bold t :foreground "black")))) + (font-lock-preprocessor-face ((t (:foreground "blue3")))) + (font-lock-reference-face ((t (:foreground "red3")))) + (font-lock-string-face ((t (:italic t :bold t :foreground "green4")))) + (font-lock-type-face ((t (:bold t :foreground "steelblue")))) + (font-lock-variable-name-face ((t (:italic t :bold t :foreground "magenta4")))) + (font-lock-warning-face ((t (:bold t :foreground "Red")))) + (gnus-cite-attribution-face ((t (:italic t :bold t)))) + (gnus-cite-face-1 ((t (:foreground "MidnightBlue")))) + (gnus-cite-face-10 ((t (:foreground "medium purple")))) + (gnus-cite-face-11 ((t (:foreground "turquoise")))) + (gnus-cite-face-2 ((t (:foreground "firebrick")))) + (gnus-cite-face-3 ((t (:foreground "dark green")))) + (gnus-cite-face-4 ((t (:foreground "OrangeRed")))) + (gnus-cite-face-5 ((t (:foreground "dark khaki")))) + (gnus-cite-face-6 ((t (:foreground "dark violet")))) + (gnus-cite-face-7 ((t (:foreground "SteelBlue4")))) + (gnus-cite-face-8 ((t (:foreground "magenta")))) + (gnus-cite-face-9 ((t (:foreground "violet")))) + (gnus-emphasis-bold ((t (:bold t)))) + (gnus-emphasis-bold-italic ((t (:italic t :bold t)))) + (gnus-emphasis-highlight-words ((t (nil)))) + (gnus-emphasis-italic ((t (:italic t)))) + (gnus-emphasis-underline ((t (:underline t)))) + (gnus-emphasis-underline-bold ((t (:underline t :bold t)))) + (gnus-emphasis-underline-bold-italic ((t (:underline t :italic t :bold t)))) + (gnus-emphasis-underline-italic ((t (:underline t :italic t)))) + (gnus-filterhist-face-1 ((t (nil)))) + (gnus-group-mail-1-empty-face ((t (:foreground "DeepPink3")))) + (gnus-group-mail-1-face ((t (:bold t :foreground "DeepPink3")))) + (gnus-group-mail-2-empty-face ((t (:foreground "HotPink3")))) + (gnus-group-mail-2-face ((t (:bold t :foreground "HotPink3")))) + (gnus-group-mail-3-empty-face ((t (:foreground "magenta4")))) + (gnus-group-mail-3-face ((t (:bold t :foreground "magenta4")))) + (gnus-group-mail-low-empty-face ((t (:foreground "DeepPink4")))) + (gnus-group-mail-low-face ((t (:bold t :foreground "DeepPink4")))) + (gnus-group-news-1-empty-face ((t (:foreground "ForestGreen")))) + (gnus-group-news-1-face ((t (:bold t :foreground "ForestGreen")))) + (gnus-group-news-2-empty-face ((t (:foreground "CadetBlue4")))) + (gnus-group-news-2-face ((t (:bold t :foreground "CadetBlue4")))) + (gnus-group-news-3-empty-face ((t (nil)))) + (gnus-group-news-3-face ((t (:bold t)))) + (gnus-group-news-4-empty-face ((t (nil)))) + (gnus-group-news-4-face ((t (:bold t)))) + (gnus-group-news-5-empty-face ((t (nil)))) + (gnus-group-news-5-face ((t (:bold t)))) + (gnus-group-news-6-empty-face ((t (nil)))) + (gnus-group-news-6-face ((t (:bold t)))) + (gnus-group-news-low-empty-face ((t (:foreground "DarkGreen")))) + (gnus-group-news-low-face ((t (:bold t :foreground "DarkGreen")))) + (gnus-header-content-face ((t (:italic t :foreground "indianred4")))) + (gnus-header-from-face ((t (:bold t :foreground "red3")))) + (gnus-header-name-face ((t (:bold t :foreground "maroon")))) + (gnus-header-newsgroups-face ((t (:italic t :bold t :foreground "MidnightBlue")))) + (gnus-header-subject-face ((t (:bold t :foreground "red4")))) + (gnus-signature-face ((t (:italic t)))) + (gnus-splash ((t (nil)))) + (gnus-splash-face ((t (:foreground "ForestGreen")))) + (gnus-summary-cancelled-face ((t (:background "black" :foreground "yellow")))) + (gnus-summary-high-ancient-face ((t (:bold t :foreground "RoyalBlue")))) + (gnus-summary-high-read-face ((t (:bold t :foreground "DarkGreen")))) + (gnus-summary-high-ticked-face ((t (:bold t :foreground "firebrick")))) + (gnus-summary-high-unread-face ((t (:italic t :bold t)))) + (gnus-summary-low-ancient-face ((t (:italic t :foreground "RoyalBlue")))) + (gnus-summary-low-read-face ((t (:italic t :foreground "DarkGreen")))) + (gnus-summary-low-ticked-face ((t (:italic t :bold t :foreground "firebrick")))) + (gnus-summary-low-unread-face ((t (:italic t)))) + (gnus-summary-normal-ancient-face ((t (:foreground "RoyalBlue")))) + (gnus-summary-normal-read-face ((t (:foreground "DarkGreen")))) + (gnus-summary-normal-ticked-face ((t (:bold t :foreground "firebrick")))) + (gnus-summary-normal-unread-face ((t (:bold t)))) + (gnus-summary-selected-face ((t (:underline t)))) + (green ((t (nil)))) + (gui-button-face ((t (:background "grey75")))) + (gui-element ((t (:background "Gray80")))) + (highlight ((t (:background "darkseagreen2")))) + (highlight-changes-delete-face ((t (:underline t :foreground "red")))) + (highlight-changes-face ((t (:foreground "red")))) + (highline-face ((t (:background "paleturquoise")))) + (holiday-face ((t (:background "pink")))) + (html-helper-italic-face ((t (:italic t)))) + (info-menu-5 ((t (:underline t)))) + (info-node ((t (:italic t :bold t)))) + (info-xref ((t (:bold t)))) + (isearch ((t (nil)))) + (italic ((t (:italic t)))) + (lazy-highlight-face ((t (:bold t :foreground "dark magenta")))) + (left-margin ((t (nil)))) + (linemenu-face ((t (nil)))) + (list-mode-item-selected ((t (nil)))) + (makefile-space-face ((t (:background "hotpink")))) + (message-cited-text-face ((t (:foreground "red")))) + (message-header-cc-face ((t (:bold t :foreground "MidnightBlue")))) + (message-header-name-face ((t (:foreground "cornflower blue")))) + (message-header-newsgroups-face ((t (:italic t :bold t :foreground "blue4")))) + (message-header-other-face ((t (:foreground "steel blue")))) + (message-header-subject-face ((t (:bold t :foreground "navy blue")))) + (message-header-to-face ((t (:bold t :foreground "MidnightBlue")))) + (message-header-xheader-face ((t (:foreground "blue")))) + (message-mml-face ((t (:bold t)))) + (message-separator-face ((t (:foreground "brown")))) + (modeline ((t (:background "darkblue" :foreground "yellow")))) + (modeline-buffer-id ((t (:background "black" :foreground "white")))) + (modeline-mousable ((t (:background "black" :foreground "white")))) + (modeline-mousable-minor-mode ((t (:background "black" :foreground "white")))) + (nil ((t (nil)))) + (paren-mismatch-face ((t (:bold t)))) + (paren-no-match-face ((t (:bold t)))) + (pointer ((t (nil)))) + (primary-selection ((t (nil)))) + (red ((t (nil)))) + (region ((t (:background "gray")))) + (right-margin ((t (nil)))) + (secondary-selection ((t (:background "paleturquoise")))) + (sgml-doctype-face ((t (nil)))) + (sgml-end-tag-face ((t (nil)))) + (sgml-entity-face ((t (nil)))) + (sgml-ignored-face ((t (nil)))) + (sgml-sgml-face ((t (nil)))) + (sgml-start-tag-face ((t (nil)))) + (show-paren-match-face ((t (:background "turquoise")))) + (show-paren-mismatch-face ((t (:bold t :background "purple" :foreground "white")))) + (speedbar-button-face ((t (:bold t :foreground "green4")))) + (speedbar-directory-face ((t (:bold t :foreground "blue4")))) + (speedbar-file-face ((t (:bold t :foreground "cyan4")))) + (speedbar-highlight-face ((t (:background "green")))) + (speedbar-selected-face ((t (:underline t :foreground "red")))) + (speedbar-tag-face ((t (:foreground "brown")))) + (swbuff-current-buffer-face ((t (:bold t)))) + (term-black ((t (:foreground "black")))) + (term-blackbg ((t (:background "black")))) + (term-blue ((t (:foreground "blue")))) + (term-bluebg ((t (:background "blue")))) + (term-bold ((t (:bold t)))) + (term-cyan ((t (:foreground "cyan")))) + (term-cyanbg ((t (:background "cyan")))) + (term-default-bg ((t (nil)))) + (term-default-bg-inv ((t (nil)))) + (term-default-fg ((t (nil)))) + (term-default-fg-inv ((t (nil)))) + (term-green ((t (:foreground "green")))) + (term-greenbg ((t (:background "green")))) + (term-invisible ((t (nil)))) + (term-invisible-inv ((t (nil)))) + (term-magenta ((t (:foreground "magenta")))) + (term-magentabg ((t (:background "magenta")))) + (term-red ((t (:foreground "red")))) + (term-redbg ((t (:background "red")))) + (term-underline ((t (:underline t)))) + (term-white ((t (:foreground "white")))) + (term-whitebg ((t (:background "white")))) + (term-yellow ((t (:foreground "yellow")))) + (term-yellowbg ((t (:background "yellow")))) + (text-cursor ((t (nil)))) + (toolbar ((t (nil)))) + (underline ((t (:underline t)))) + (vc-annotate-face-0046FF ((t (nil)))) + (vcursor ((t (:underline t :background "cyan" :foreground "blue")))) + (vertical-divider ((t (nil)))) + (vhdl-font-lock-attribute-face ((t (:foreground "Orchid")))) + (vhdl-font-lock-directive-face ((t (:foreground "CadetBlue")))) + (vhdl-font-lock-enumvalue-face ((t (:foreground "Gold4")))) + (vhdl-font-lock-function-face ((t (:foreground "Orchid4")))) + (vhdl-font-lock-prompt-face ((t (:bold t :foreground "Red")))) + (vhdl-font-lock-reserved-words-face ((t (:bold t :foreground "Orange")))) + (vhdl-font-lock-translate-off-face ((t (:background "LightGray")))) + (vhdl-speedbar-architecture-face ((t (:foreground "Blue")))) + (vhdl-speedbar-architecture-selected-face ((t (:underline t :foreground "Blue")))) + (vhdl-speedbar-configuration-face ((t (:foreground "DarkGoldenrod")))) + (vhdl-speedbar-configuration-selected-face ((t (:underline t :foreground "DarkGoldenrod")))) + (vhdl-speedbar-entity-face ((t (:foreground "ForestGreen")))) + (vhdl-speedbar-entity-selected-face ((t (:underline t :foreground "ForestGreen")))) + (vhdl-speedbar-instantiation-face ((t (:foreground "Brown")))) + (vhdl-speedbar-instantiation-selected-face ((t (:underline t :foreground "Brown")))) + (vhdl-speedbar-package-face ((t (:foreground "Grey50")))) + (vhdl-speedbar-package-selected-face ((t (:underline t :foreground "Grey50")))) + (viper-minibuffer-emacs-face ((t (:background "darkseagreen2" :foreground "Black")))) + (viper-minibuffer-insert-face ((t (:background "pink" :foreground "Black")))) + (viper-minibuffer-vi-face ((t (:background "grey" :foreground "DarkGreen")))) + (viper-replace-overlay-face ((t (:background "darkseagreen2" :foreground "Black")))) + (viper-search-face ((t (:background "khaki" :foreground "Black")))) + (widget-button-face ((t (:bold t)))) + (widget-button-pressed-face ((t (:foreground "red")))) + (widget-documentation-face ((t (:foreground "dark green")))) + (widget-field-face ((t (:background "gray85")))) + (widget-inactive-face ((t (:foreground "dim gray")))) + (widget-single-line-field-face ((t (:background "gray85")))) + (woman-bold-face ((t (:bold t)))) + (woman-italic-face ((t (nil)))) + (woman-unknown-face ((t (nil)))) + (yellow ((t (nil)))) + (zmacs-region ((t (nil))))))) + +(defun color-theme-beige-diff () + "Brownish faces for diff and change-log modes. +This is intended for other color themes to use (eg. `color-theme-gnome2' +and `color-theme-blue-sea')." + (color-theme-install + '(color-theme-beige-diff + nil + (change-log-acknowledgement-face ((t (:foreground "firebrick")))) + (change-log-conditionals-face ((t (:foreground "khaki" :background "sienna")))) + (change-log-date-face ((t (:foreground "gold")))) + (change-log-email-face ((t (:foreground "khaki" :underline t)))) + (change-log-file-face ((t (:bold t :foreground "lemon chiffon")))) + (change-log-function-face ((t (:foreground "khaki" :background "sienna")))) + (change-log-list-face ((t (:foreground "wheat")))) + (change-log-name-face ((t (:bold t :foreground "light goldenrod")))) + (diff-added-face ((t (nil)))) + (diff-changed-face ((t (nil)))) + (diff-context-face ((t (:foreground "grey50")))) + (diff-file-header-face ((t (:bold t :foreground "lemon chiffon")))) + (diff-function-face ((t (:foreground "grey50")))) + (diff-header-face ((t (:foreground "lemon chiffon")))) + (diff-hunk-header-face ((t (:foreground "light goldenrod")))) + (diff-index-face ((t (:bold t :underline t)))) + (diff-nonexistent-face ((t (:bold t :background "grey70" :weight bold)))) + (diff-removed-face ((t (nil)))) + (log-view-message-face ((t (:foreground "lemon chiffon"))))))) + +(defun color-theme-standard-ediff () + "Standard colors for ediff faces. +This is intended for other color themes to use +\(eg. `color-theme-goldenrod')." + (color-theme-install + '(color-theme-beige-diff + nil + (ediff-current-diff-face-A ((t (:background "pale green" :foreground "firebrick")))) + (ediff-current-diff-face-Ancestor ((t (:background "VioletRed" :foreground "Black")))) + (ediff-current-diff-face-B ((t (:background "Yellow" :foreground "DarkOrchid")))) + (ediff-current-diff-face-C ((t (:background "Pink" :foreground "Navy")))) + (ediff-even-diff-face-A ((t (:background "light grey" :foreground "Black")))) + (ediff-even-diff-face-Ancestor ((t (:background "Grey" :foreground "White")))) + (ediff-even-diff-face-B ((t (:background "Grey" :foreground "White")))) + (ediff-even-diff-face-C ((t (:background "light grey" :foreground "Black")))) + (ediff-fine-diff-face-A ((t (:background "sky blue" :foreground "Navy")))) + (ediff-fine-diff-face-Ancestor ((t (:background "Green" :foreground "Black")))) + (ediff-fine-diff-face-B ((t (:background "cyan" :foreground "Black")))) + (ediff-fine-diff-face-C ((t (:background "Turquoise" :foreground "Black")))) + (ediff-odd-diff-face-A ((t (:background "Grey" :foreground "White")))) + (ediff-odd-diff-face-Ancestor ((t (:background "light grey" :foreground "Black")))) + (ediff-odd-diff-face-B ((t (:background "light grey" :foreground "Black")))) + (ediff-odd-diff-face-C ((t (:background "Grey" :foreground "White"))))))) + +(defun color-theme-beige-eshell () + "Brownish colors for eshell faces only. +This is intended for other color themes to use (eg. `color-theme-goldenrod')." + (color-theme-install + '(color-theme-beige-eshell + nil + (eshell-ls-archive-face ((t (:bold t :foreground "IndianRed")))) + (eshell-ls-backup-face ((t (:foreground "Grey")))) + (eshell-ls-clutter-face ((t (:foreground "DimGray")))) + (eshell-ls-directory-face ((t (:bold t :foreground "dark khaki")))) + (eshell-ls-executable-face ((t (:foreground "Coral")))) + (eshell-ls-missing-face ((t (:foreground "black")))) + (eshell-ls-picture-face ((t (:foreground "gold")))) ; non-standard face + (eshell-ls-product-face ((t (:foreground "dark sea green")))) + (eshell-ls-readonly-face ((t (:foreground "light steel blue")))) + (eshell-ls-special-face ((t (:foreground "gold")))) + (eshell-ls-symlink-face ((t (:foreground "peach puff")))) + (eshell-ls-text-face ((t (:foreground "moccasin")))) ; non-standard face + (eshell-ls-todo-face ((t (:bold t :foreground "yellow green")))) ; non-standard face + (eshell-ls-unreadable-face ((t (:foreground "DimGray")))) + (eshell-prompt-face ((t (:foreground "lemon chiffon"))))))) + +(defun color-theme-goldenrod () + "Brown color theme. Very different from the others. +Supports standard, font-lock and info faces, and it uses +`color-theme-blue-gnus', `color-theme-blue-erc' , and +`color-theme-beige-diff'." + (interactive) + (color-theme-blue-gnus) + (let ((color-theme-is-cumulative t)) + (color-theme-blue-erc) + (color-theme-beige-diff) + (color-theme-beige-eshell) + (color-theme-install + '(color-theme-goldenrod + ((background-color . "black") + (background-mode . dark) + (border-color . "black") + (cursor-color . "light goldenrod") + (foreground-color . "goldenrod") + (mouse-color . "goldenrod")) + ((goto-address-mail-face . info-xref) + (list-matching-lines-face . bold) + (view-highlight-face . highlight)) + (default ((t (nil)))) + (bold ((t (:bold t)))) + (bold-italic ((t (:italic t :bold t :foreground "lavender")))) + (font-lock-builtin-face ((t (:foreground "pale goldenrod")))) + (font-lock-comment-face ((t (:foreground "indian red")))) + (font-lock-constant-face ((t (:foreground "pale green")))) + (font-lock-function-name-face ((t (:bold t :foreground "lemon chiffon")))) + (font-lock-keyword-face ((t (:foreground "wheat")))) + (font-lock-string-face ((t (:foreground "gold")))) + (font-lock-type-face ((t (:foreground "dark khaki" :bold t)))) + (font-lock-variable-name-face ((t (:bold t :foreground "khaki")))) + (font-lock-warning-face ((t (:bold t :foreground "orange red")))) + (fringe ((t (:background "gray25")))) + (header-line ((t (:background "gray20" :foreground "gray70")))) + (highlight ((t (:background "dark slate blue")))) + (info-menu-5 ((t (:underline t)))) + (info-node ((t (:bold t)))) + (info-xref ((t (:bold t :foreground "pale goldenrod")))) + (isearch ((t (:background "SeaGreen4")))) + (isearch-lazy-highlight-face ((t (:background "DarkOliveGreen4")))) + (italic ((t (:italic t :foreground "lavender")))) + (menu ((t (:background "gray25" :foreground "lemon chiffon")))) + (modeline ((t (:background "gray40" :foreground "lemon chiffon" :box (:line-width 1 :style released-button))))) + (modeline-buffer-id ((t (:background "AntiqueWhite4" :foreground "lemon chiffon")))) + (modeline-mousable ((t (:background "AntiqueWhite4" :foreground "lemon chiffon")))) + (modeline-mousable-minor-mode ((t (:background "wheat" :foreground "lemon chiffon")))) + (mode-line-inactive ((t (:background "gray20" :foreground "lemon chiffon" :box (:line-width 1 :style released-button))))) + (region ((t (:background "dark olive green")))) + (secondary-selection ((t (:background "dark green")))) + (tool-bar ((t (:background "gray25" :foreground "lemon chiffon" :box (:line-width 1 :style released-button))))) + (underline ((t (:underline t)))))))) + +(defun color-theme-ramangalahy () + "Color theme by Solofo Ramangalahy, created 2000-10-18. +Black on light grey, includes faces for vm, ispell, gnus, +dired, display-time, cperl, font-lock, widget, x-symbol." + (interactive) + (color-theme-install + '(color-theme-ramangalahy + ((background-color . "lightgrey") + (background-mode . light) + (background-toolbar-color . "#bfbfbfbfbfbf") + (border-color . "#000000000000") + (bottom-toolbar-shadow-color . "#737373737373") + (cursor-color . "blue") + (foreground-color . "black") + (top-toolbar-shadow-color . "#e6e6e6e6e6e6")) + ((gnus-mouse-face . highlight) + (goto-address-mail-face . info-xref) + (ispell-highlight-face . highlight) + (notes-bold-face . notes-bold-face) + (setnu-line-number-face . bold) + (tinyreplace-:face . highlight) + (vm-highlight-url-face . bold-italic) + (vm-highlighted-header-face . bold) + (vm-mime-button-face . gui-button-face) + (vm-summary-highlight-face . bold)) + (default ((t (nil)))) + (bbdb-company ((t (nil)))) + (blue ((t (:foreground "blue")))) + (bold ((t (:bold t)))) + (bold-italic ((t (:italic t :bold t)))) + (border-glyph ((t (nil)))) + (cperl-here-face ((t (:foreground "green4")))) + (cperl-pod-face ((t (:foreground "brown4")))) + (cperl-pod-head-face ((t (:foreground "steelblue")))) + (custom-button-face ((t (:bold t)))) + (custom-changed-face ((t (:background "blue" :foreground "white")))) + (custom-documentation-face ((t (nil)))) + (custom-face-tag-face ((t (:underline t)))) + (custom-group-tag-face ((t (:underline t :foreground "blue")))) + (custom-group-tag-face-1 ((t (:underline t :foreground "red")))) + (custom-invalid-face ((t (:background "red" :foreground "yellow")))) + (custom-modified-face ((t (:background "blue" :foreground "white")))) + (custom-rogue-face ((t (:background "black" :foreground "pink")))) + (custom-saved-face ((t (:underline t)))) + (custom-set-face ((t (:background "white" :foreground "blue")))) + (custom-state-face ((t (:foreground "dark green")))) + (custom-variable-button-face ((t (:underline t :bold t)))) + (custom-variable-tag-face ((t (:underline t :foreground "blue")))) + (dired-face-boring ((t (:foreground "Gray65")))) + (dired-face-directory ((t (:bold t)))) + (dired-face-executable ((t (:foreground "SeaGreen")))) + (dired-face-flagged ((t (:background "LightSlateGray")))) + (dired-face-marked ((t (:background "PaleVioletRed")))) + (dired-face-permissions ((t (:background "grey75" :foreground "black")))) + (dired-face-setuid ((t (:foreground "Red")))) + (dired-face-socket ((t (:foreground "magenta")))) + (dired-face-symlink ((t (:foreground "blue")))) + (display-time-mail-balloon-enhance-face ((t (:background "orange")))) + (display-time-mail-balloon-gnus-group-face ((t (:foreground "blue")))) + (display-time-time-balloon-face ((t (:foreground "red")))) + (ff-paths-non-existant-file-face ((t (:bold t :foreground "NavyBlue")))) + (font-lock-comment-face ((t (:bold t :foreground "purple")))) + (font-lock-doc-string-face ((t (:bold t :foreground "slateblue")))) + (font-lock-emphasized-face ((t (:bold t :background "lightyellow2")))) + (font-lock-function-name-face ((t (:bold t :foreground "blue")))) + (font-lock-keyword-face ((t (:bold t :foreground "violetred")))) + (font-lock-other-emphasized-face ((t (:italic t :bold t :background "lightyellow2")))) + (font-lock-other-type-face ((t (:bold t :foreground "orange3")))) + (font-lock-preprocessor-face ((t (:bold t :foreground "mediumblue")))) + (font-lock-reference-face ((t (:foreground "red3")))) + (font-lock-string-face ((t (:foreground "green4")))) + (font-lock-type-face ((t (:bold t :foreground "steelblue")))) + (font-lock-variable-name-face ((t (:foreground "magenta4")))) + (font-lock-warning-face ((t (:bold t :background "yellow" :foreground "Red")))) + (gnus-emphasis-bold ((t (:bold t)))) + (gnus-emphasis-bold-italic ((t (nil)))) + (gnus-emphasis-italic ((t (nil)))) + (gnus-emphasis-underline ((t (:underline t)))) + (gnus-emphasis-underline-bold ((t (:underline t :bold t)))) + (gnus-emphasis-underline-bold-italic ((t (:underline t)))) + (gnus-emphasis-underline-italic ((t (:underline t)))) + (gnus-group-mail-1-empty-face ((t (:foreground "DeepPink3")))) + (gnus-group-mail-1-face ((t (:bold t :foreground "DeepPink3")))) + (gnus-group-mail-2-empty-face ((t (:foreground "HotPink3")))) + (gnus-group-mail-2-face ((t (:bold t :foreground "HotPink3")))) + (gnus-group-mail-3-empty-face ((t (:foreground "magenta4")))) + (gnus-group-mail-3-face ((t (:bold t :foreground "magenta4")))) + (gnus-group-mail-low-empty-face ((t (:foreground "DeepPink4")))) + (gnus-group-mail-low-face ((t (:bold t :foreground "DeepPink4")))) + (gnus-group-news-1-empty-face ((t (:foreground "ForestGreen")))) + (gnus-group-news-1-face ((t (:bold t :foreground "ForestGreen")))) + (gnus-group-news-2-empty-face ((t (:foreground "CadetBlue4")))) + (gnus-group-news-2-face ((t (:bold t :foreground "CadetBlue4")))) + (gnus-group-news-3-empty-face ((t (:foreground "DeepPink4")))) + (gnus-group-news-3-face ((t (:bold t :foreground "DeepPink4")))) + (gnus-group-news-low-empty-face ((t (:foreground "DarkGreen")))) + (gnus-group-news-low-face ((t (:bold t :foreground "DarkGreen")))) + (gnus-header-content-face ((t (:foreground "indianred4")))) + (gnus-header-from-face ((t (:foreground "red3")))) + (gnus-header-name-face ((t (:foreground "maroon")))) + (gnus-header-newsgroups-face ((t (:foreground "MidnightBlue")))) + (gnus-header-subject-face ((t (:foreground "red4")))) + (gnus-signature-face ((t (:bold t)))) + (gnus-splash-face ((t (:foreground "ForestGreen")))) + (gnus-summary-cancelled-face ((t (:background "black" :foreground "yellow")))) + (gnus-summary-high-ancient-face ((t (:bold t :foreground "RoyalBlue")))) + (gnus-summary-high-read-face ((t (:bold t :foreground "DarkGreen")))) + (gnus-summary-high-ticked-face ((t (:bold t :foreground "firebrick")))) + (gnus-summary-high-unread-face ((t (:bold t)))) + (gnus-summary-low-ancient-face ((t (:foreground "RoyalBlue")))) + (gnus-summary-low-read-face ((t (:foreground "DarkGreen")))) + (gnus-summary-low-ticked-face ((t (:foreground "firebrick")))) + (gnus-summary-low-unread-face ((t (nil)))) + (gnus-summary-normal-ancient-face ((t (:foreground "RoyalBlue")))) + (gnus-summary-normal-read-face ((t (:foreground "DarkGreen")))) + (gnus-summary-normal-ticked-face ((t (:foreground "firebrick")))) + (gnus-summary-normal-unread-face ((t (nil)))) + (gnus-summary-selected-face ((t (:underline t)))) + (gnus-x-face ((t (:background "lightgrey" :foreground "black")))) + (green ((t (:foreground "green")))) + (gui-button-face ((t (:background "grey75" :foreground "black")))) + (gui-element ((t (:background "lightgrey")))) + (highlight ((t (:background "darkseagreen2")))) + (info-node ((t (:underline t :bold t :foreground "mediumpurple")))) + (info-xref ((t (:underline t :bold t :foreground "#0000ee")))) + (isearch ((t (:background "paleturquoise")))) + (italic ((t (:italic t)))) + (left-margin ((t (nil)))) + (list-mode-item-selected ((t (:background "gray68" :foreground "black")))) + (message-cited-text ((t (:foreground "slategrey")))) + (message-cited-text-face ((t (:foreground "red")))) + (message-header-cc-face ((t (:foreground "MidnightBlue")))) + (message-header-contents ((t (:italic t)))) + (message-header-name-face ((t (:foreground "cornflower blue")))) + (message-header-newsgroups-face ((t (:bold t :foreground "blue4")))) + (message-header-other-face ((t (:foreground "steel blue")))) + (message-header-subject-face ((t (:bold t :foreground "navy blue")))) + (message-header-to-face ((t (:bold t :foreground "MidnightBlue")))) + (message-header-xheader-face ((t (:foreground "blue")))) + (message-headers ((t (:bold t)))) + (message-highlighted-header-contents ((t (:bold t)))) + (message-separator-face ((t (:foreground "brown")))) + (message-url ((t (:bold t)))) + (modeline ((t (:bold t :background "Gray75" :foreground "Black")))) + (modeline-buffer-id ((t (:bold t :background "Gray75" :foreground "blue4")))) + (modeline-mousable ((t (:bold t :background "Gray75" :foreground "firebrick")))) + (modeline-mousable-minor-mode ((t (:bold t :background "Gray75" :foreground "green4")))) + (paren-blink-off ((t (:foreground "lightgrey")))) + (paren-match ((t (:background "darkseagreen2")))) + (paren-mismatch ((t (:background "DeepPink" :foreground "black")))) + (pointer ((t (:foreground "blue")))) + (primary-selection ((t (:background "gray65")))) + (red ((t (:foreground "red")))) + (region ((t (:background "black" :foreground "white")))) + (right-margin ((t (nil)))) + (searchm-buffer ((t (:bold t :background "white" :foreground "red")))) + (searchm-button ((t (:bold t :background "CadetBlue" :foreground "white")))) + (searchm-field ((t (:background "grey89")))) + (searchm-field-label ((t (:bold t)))) + (searchm-highlight ((t (:bold t :background "darkseagreen2" :foreground "black")))) + (secondary-selection ((t (:background "paleturquoise")))) + (template-message-face ((t (:bold t)))) + (text-cursor ((t (:background "blue" :foreground "lightgrey")))) + (toolbar ((t (nil)))) + (underline ((t (:underline t)))) + (vertical-divider ((t (nil)))) + (widget-button-face ((t (:bold t)))) + (widget-button-pressed-face ((t (:foreground "red")))) + (widget-documentation-face ((t (:foreground "dark green")))) + (widget-field-face ((t (:background "gray85")))) + (widget-inactive-face ((t (:foreground "dim gray")))) + (x-face ((t (:background "white" :foreground "black")))) + (x-symbol-adobe-fontspecific-face ((t (nil)))) + (x-symbol-face ((t (nil)))) + (x-symbol-heading-face ((t (:underline t :bold t :foreground "green4")))) + (x-symbol-info-face ((t (:foreground "green4")))) + (x-symbol-invisible-face ((t (nil)))) + (x-symbol-revealed-face ((t (:background "pink")))) + (yellow ((t (:foreground "yellow")))) + (zmacs-region ((t (:background "yellow"))))))) + +(defun color-theme-raspopovic () + "Color theme by Pedja Raspopovic, created 2000-10-19. +Includes faces for dired, font-lock, info, paren." + (interactive) + (color-theme-install + '(color-theme-raspopovic + ((background-color . "darkblue") + (background-mode . light) + (background-toolbar-color . "#bfbfbfbfbfbf") + (border-color . "#000000000000") + (bottom-toolbar-shadow-color . "#737373737373") + (cursor-color . "Red3") + (foreground-color . "yellow") + (top-toolbar-shadow-color . "#e6e6e6e6e6e6")) + ((setnu-line-number-face . bold) + (goto-address-mail-face . info-xref)) + (default ((t (nil)))) + (blue ((t (:background "darkblue" :foreground "blue")))) + (bold ((t (:bold t :background "darkblue" :foreground "yellow")))) + (bold-italic ((t (:bold t :background "darkblue" :foreground "red3")))) + (comint-input-face ((t (:foreground "deepskyblue")))) + (dired-face-boring ((t (:foreground "Gray65")))) + (dired-face-directory ((t (:foreground "lightgreen")))) + (dired-face-executable ((t (:foreground "indianred")))) + (dired-face-flagged ((t (:background "LightSlateGray")))) + (dired-face-marked ((t (:background "darkblue" :foreground "deepskyblue")))) + (dired-face-permissions ((t (:background "darkblue" :foreground "white")))) + (dired-face-setuid ((t (:foreground "Red")))) + (dired-face-socket ((t (:foreground "magenta")))) + (dired-face-symlink ((t (:foreground "grey95")))) + (font-lock-comment-face ((t (:background "darkblue" :foreground "lightgreen")))) + (font-lock-doc-string-face ((t (:background "darkblue" :foreground "darkseagreen")))) + (font-lock-function-name-face ((t (:bold t :background "darkblue" :foreground "indianred")))) + (font-lock-keyword-face ((t (:background "darkblue" :foreground "skyblue")))) + (font-lock-preprocessor-face ((t (:background "darkblue" :foreground "orange")))) + (font-lock-reference-face ((t (:background "darkblue" :foreground "deepskyblue")))) + (font-lock-string-face ((t (:background "darkblue" :foreground "lightgrey")))) + (font-lock-type-face ((t (:background "darkblue" :foreground "orange")))) + (font-lock-variable-name-face ((t (:background "darkblue" :foreground "white")))) + (green ((t (:background "darkblue" :foreground "green")))) + (gui-button-face ((t (:background "grey75" :foreground "black")))) + (highlight ((t (:background "yellow" :foreground "darkblue")))) + (info-node ((t (:bold t :background "darkblue" :foreground "red3")))) + (info-xref ((t (:bold t :background "darkblue" :foreground "yellow")))) + (isearch ((t (:background "yellow" :foreground "darkblue")))) + (isearch-secondary ((t (:foreground "red3")))) + (italic ((t (:background "darkblue" :foreground "red3")))) + (left-margin ((t (:background "darkblue" :foreground "yellow")))) + (list-mode-item-selected ((t (:background "gray68" :foreground "yellow")))) + (makefile-space-face ((t (:background "hotpink")))) + (modeline ((t (:background "Gray75" :foreground "Black")))) + (modeline-buffer-id ((t (:background "Gray75" :foreground "blue")))) + (modeline-mousable ((t (:background "Gray75" :foreground "red")))) + (modeline-mousable-minor-mode ((t (:background "Gray75" :foreground "green4")))) + (paren-blink-off ((t (:foreground "darkblue")))) + (paren-match ((t (:background "yellow" :foreground "darkblue")))) + (paren-mismatch ((t (:background "DeepPink" :foreground "yellow")))) + (pointer ((t (:background "darkblue" :foreground "red3")))) + (primary-selection ((t (:background "yellow" :foreground "darkblue")))) + (red ((t (:background "darkblue" :foreground "red")))) + (right-margin ((t (:background "darkblue" :foreground "yellow")))) + (secondary-selection ((t (:background "darkblue" :foreground "yellow")))) + (shell-option-face ((t (:background "darkblue" :foreground "cyan2")))) + (shell-output-2-face ((t (:background "darkblue" :foreground "darkseagreen")))) + (shell-output-3-face ((t (:background "darkblue" :foreground "lightgrey")))) + (shell-output-face ((t (:background "darkblue" :foreground "white")))) + (shell-prompt-face ((t (:background "darkblue" :foreground "red")))) + (text-cursor ((t (:background "Red3" :foreground "white")))) + (underline ((t (:underline t :background "darkblue" :foreground "yellow")))) + (vvb-face ((t (:background "pink" :foreground "black")))) + (yellow ((t (:background "darkblue" :foreground "yellow")))) + (zmacs-region ((t (:background "gray" :foreground "black"))))))) + +(defun color-theme-taylor () + "Color theme by Art Taylor, created 2000-10-20. +Wheat on black. Includes faces for font-lock, gnus, paren." + (interactive) + (color-theme-install + '(color-theme-taylor + ((background-color . "black") + (background-mode . dark) + (border-color . "black") + (cursor-color . "red") + (foreground-color . "wheat") + (mouse-color . "black")) + ((gnus-mouse-face . highlight) + (list-matching-lines-face . bold) + (view-highlight-face . highlight)) + (default ((t (nil)))) + (bold ((t (:bold t :background "grey40" :foreground "yellow")))) + (bold-italic ((t (:italic t :bold t :foreground "yellow green")))) + (fl-comment-face ((t (:foreground "medium purple")))) + (fl-function-name-face ((t (:foreground "green")))) + (fl-keyword-face ((t (:foreground "LightGreen")))) + (fl-string-face ((t (:foreground "light coral")))) + (fl-type-face ((t (:foreground "cyan")))) + (font-lock-builtin-face ((t (:foreground "LightSteelBlue")))) + (font-lock-comment-face ((t (:foreground "OrangeRed")))) + (font-lock-constant-face ((t (:foreground "Aquamarine")))) + (font-lock-function-name-face ((t (:foreground "LightSkyBlue")))) + (font-lock-keyword-face ((t (:foreground "Cyan")))) + (font-lock-string-face ((t (:foreground "LightSalmon")))) + (font-lock-type-face ((t (:foreground "PaleGreen")))) + (font-lock-variable-name-face ((t (:foreground "LightGoldenrod")))) + (font-lock-warning-face ((t (:bold t :foreground "Pink")))) + (gnus-group-mail-1-empty-face ((t (:foreground "aquamarine1")))) + (gnus-group-mail-1-face ((t (:bold t :foreground "aquamarine1")))) + (gnus-group-mail-2-empty-face ((t (:foreground "aquamarine2")))) + (gnus-group-mail-2-face ((t (:bold t :foreground "aquamarine2")))) + (gnus-group-mail-3-empty-face ((t (:foreground "aquamarine3")))) + (gnus-group-mail-3-face ((t (:bold t :foreground "aquamarine3")))) + (gnus-group-mail-low-empty-face ((t (:foreground "aquamarine4")))) + (gnus-group-mail-low-face ((t (:bold t :foreground "aquamarine4")))) + (gnus-group-news-1-empty-face ((t (:foreground "PaleTurquoise")))) + (gnus-group-news-1-face ((t (:bold t :foreground "PaleTurquoise")))) + (gnus-group-news-2-empty-face ((t (:foreground "turquoise")))) + (gnus-group-news-2-face ((t (:bold t :foreground "turquoise")))) + (gnus-group-news-3-empty-face ((t (nil)))) + (gnus-group-news-3-face ((t (:bold t)))) + (gnus-group-news-4-empty-face ((t (nil)))) + (gnus-group-news-4-face ((t (:bold t)))) + (gnus-group-news-5-empty-face ((t (nil)))) + (gnus-group-news-5-face ((t (:bold t)))) + (gnus-group-news-6-empty-face ((t (nil)))) + (gnus-group-news-6-face ((t (:bold t)))) + (gnus-group-news-low-empty-face ((t (:foreground "DarkTurquoise")))) + (gnus-group-news-low-face ((t (:bold t :foreground "DarkTurquoise")))) + (gnus-splash-face ((t (:foreground "Brown")))) + (gnus-summary-cancelled-face ((t (:background "black" :foreground "yellow")))) + (gnus-summary-high-ancient-face ((t (:bold t :foreground "SkyBlue")))) + (gnus-summary-high-read-face ((t (:bold t :foreground "PaleGreen")))) + (gnus-summary-high-ticked-face ((t (:bold t :foreground "pink")))) + (gnus-summary-high-unread-face ((t (:bold t)))) + (gnus-summary-low-ancient-face ((t (:italic t :foreground "SkyBlue")))) + (gnus-summary-low-read-face ((t (:italic t :foreground "PaleGreen")))) + (gnus-summary-low-ticked-face ((t (:italic t :foreground "pink")))) + (gnus-summary-low-unread-face ((t (:italic t)))) + (gnus-summary-normal-ancient-face ((t (:foreground "SkyBlue")))) + (gnus-summary-normal-read-face ((t (:foreground "PaleGreen")))) + (gnus-summary-normal-ticked-face ((t (:foreground "pink")))) + (gnus-summary-normal-unread-face ((t (nil)))) + (gnus-summary-selected-face ((t (:underline t)))) + (highlight ((t (:background "black" :foreground "black")))) + (italic ((t (:italic t :foreground "yellow3")))) + (message-cited-text-face ((t (:foreground "red")))) + (message-header-cc-face ((t (:bold t :foreground "green4")))) + (message-header-name-face ((t (:foreground "DarkGreen")))) + (message-header-newsgroups-face ((t (:italic t :bold t :foreground "yellow")))) + (message-header-other-face ((t (:foreground "#b00000")))) + (message-header-subject-face ((t (:foreground "green3")))) + (message-header-to-face ((t (:bold t :foreground "green2")))) + (message-header-xheader-face ((t (:foreground "blue")))) + (message-mml-face ((t (:foreground "ForestGreen")))) + (message-separator-face ((t (:foreground "blue3")))) + (modeline ((t (:background "wheat" :foreground "black")))) + (modeline-buffer-id ((t (:background "wheat" :foreground "black")))) + (modeline-mousable ((t (:background "wheat" :foreground "black")))) + (modeline-mousable-minor-mode ((t (:background "wheat" :foreground "black")))) + (region ((t (:background "blue")))) + (secondary-selection ((t (:background "darkslateblue" :foreground "black")))) + (show-paren-match-face ((t (:background "turquoise")))) + (show-paren-mismatch-face ((t (:background "purple" :foreground "white")))) + (underline ((t (:underline t)))) + (xref-keyword-face ((t (:foreground "blue")))) + (xref-list-default-face ((t (nil)))) + (xref-list-pilot-face ((t (:foreground "navy")))) + (xref-list-symbol-face ((t (:foreground "navy"))))))) + +(defun color-theme-marquardt () + "Color theme by Colin Marquardt, created 2000-10-25. +Black on bisque, a light color. Based on some settings from Robin S. Socha. +Features some color changes to programming languages, especially vhdl-mode. +You might also want to put something like + Emacs*Foreground: Black + Emacs*Background: bisque2 +in your ~/.Xdefaults." + (interactive) + (color-theme-install + '(color-theme-marquardt + ((background-color . "bisque") + (background-mode . light) + (background-toolbar-color . "bisque") + (border-color . "#000000000000") + (bottom-toolbar-shadow-color . "#909099999999") + (cursor-color . "Red3") + (foreground-color . "black") + (top-toolbar-shadow-color . "#ffffffffffff")) + (default ((t (nil)))) + (blue ((t (:foreground "blue")))) + (bold ((t (:bold t)))) + (bold-italic ((t (:bold t)))) + (border-glyph ((t (nil)))) + (calendar-today-face ((t (:underline t)))) + (diary-face ((t (:foreground "red")))) + (display-time-mail-balloon-enhance-face ((t (:background "orange")))) + (display-time-mail-balloon-gnus-group-face ((t (:foreground "blue")))) + (display-time-time-balloon-face ((t (:foreground "red")))) + (ff-paths-non-existant-file-face ((t (:bold t :foreground "NavyBlue")))) + (font-lock-comment-face ((t (:foreground "gray50")))) + (font-lock-doc-string-face ((t (:foreground "green4")))) + (font-lock-function-name-face ((t (:foreground "darkorange")))) + (font-lock-keyword-face ((t (:foreground "blue3")))) + (font-lock-preprocessor-face ((t (:foreground "blue3")))) + (font-lock-reference-face ((t (:foreground "red3")))) + (font-lock-special-comment-face ((t (:foreground "blue4")))) + (font-lock-special-keyword-face ((t (:foreground "red4")))) + (font-lock-string-face ((t (:foreground "green4")))) + (font-lock-type-face ((t (:foreground "steelblue")))) + (font-lock-variable-name-face ((t (:foreground "black")))) + (font-lock-warning-face ((t (:bold t :foreground "Red")))) + (green ((t (:foreground "green")))) + (gui-button-face ((t (:background "grey75" :foreground "black")))) + (gui-element ((t (:background "azure1" :foreground "Black")))) + (highlight ((t (:background "darkseagreen2" :foreground "blue")))) + (holiday-face ((t (:background "pink" :foreground "black")))) + (info-node ((t (:bold t)))) + (info-xref ((t (:bold t)))) + (isearch ((t (:background "yellow" :foreground "red")))) + (italic ((t (:bold t)))) + (left-margin ((t (nil)))) + (list-mode-item-selected ((t (:background "gray68" :foreground "black")))) + (message-cited-text-face ((t (:foreground "red")))) + (message-header-cc-face ((t (:foreground "MidnightBlue")))) + (message-header-name-face ((t (:foreground "cornflower blue")))) + (message-header-newsgroups-face ((t (:bold t :foreground "blue4")))) + (message-header-other-face ((t (:foreground "steel blue")))) + (message-header-subject-face ((t (:bold t :foreground "navy blue")))) + (message-header-to-face ((t (:bold t :foreground "MidnightBlue")))) + (message-header-xheader-face ((t (:foreground "blue")))) + (message-mml-face ((t (:foreground "ForestGreen")))) + (message-separator-face ((t (:foreground "brown")))) + (modeline ((t (:background "bisque2" :foreground "steelblue4")))) + (modeline-buffer-id ((t (:background "bisque2" :foreground "blue4")))) + (modeline-mousable ((t (:background "bisque2" :foreground "firebrick")))) + (modeline-mousable-minor-mode ((t (:background "bisque2" :foreground "green4")))) + (paren-blink-off ((t (:foreground "azure1")))) + (paren-face ((t (:background "lightgoldenrod")))) + (paren-match ((t (:background "bisque2")))) + (paren-mismatch ((t (:background "DeepPink" :foreground "black")))) + (paren-mismatch-face ((t (:background "DeepPink")))) + (paren-no-match-face ((t (:background "yellow")))) + (pointer ((t (:background "white" :foreground "blue")))) + (primary-selection ((t (:background "gray65")))) + (red ((t (:foreground "red")))) + (right-margin ((t (nil)))) + (secondary-selection ((t (:background "paleturquoise")))) + (shell-option-face ((t (:foreground "gray50")))) + (shell-output-2-face ((t (:foreground "green4")))) + (shell-output-3-face ((t (:foreground "green4")))) + (shell-output-face ((t (:bold t)))) + (shell-prompt-face ((t (:foreground "blue3")))) + (speedbar-button-face ((t (:foreground "green4")))) + (speedbar-directory-face ((t (:foreground "blue4")))) + (speedbar-file-face ((t (:foreground "cyan4")))) + (speedbar-highlight-face ((t (:background "green")))) + (speedbar-selected-face ((t (:underline t :foreground "red")))) + (speedbar-tag-face ((t (:foreground "brown")))) + (text-cursor ((t (:background "Red3" :foreground "bisque")))) + (toolbar ((t (:background "Gray80")))) + (underline ((t (:underline t)))) + (vertical-divider ((t (nil)))) + (vhdl-font-lock-attribute-face ((t (:foreground "Orchid")))) + (vhdl-font-lock-directive-face ((t (:foreground "CadetBlue")))) + (vhdl-font-lock-enumvalue-face ((t (:foreground "SaddleBrown")))) + (vhdl-font-lock-function-face ((t (:foreground "DarkCyan")))) + (vhdl-font-lock-generic-/constant-face ((t (:foreground "Gold3")))) + (vhdl-font-lock-prompt-face ((t (:bold t :foreground "Red")))) + (vhdl-font-lock-reserved-words-face ((t (:bold t :foreground "Orange")))) + (vhdl-font-lock-translate-off-face ((t (:background "LightGray")))) + (vhdl-font-lock-type-face ((t (:foreground "ForestGreen")))) + (vhdl-font-lock-variable-face ((t (:foreground "Grey50")))) + (vhdl-speedbar-architecture-face ((t (:foreground "Blue")))) + (vhdl-speedbar-architecture-selected-face ((t (:underline t :foreground "Blue")))) + (vhdl-speedbar-configuration-face ((t (:foreground "DarkGoldenrod")))) + (vhdl-speedbar-configuration-selected-face ((t (:underline t :foreground "DarkGoldenrod")))) + (vhdl-speedbar-entity-face ((t (:foreground "ForestGreen")))) + (vhdl-speedbar-entity-selected-face ((t (:underline t :foreground "ForestGreen")))) + (vhdl-speedbar-instantiation-face ((t (:foreground "Brown")))) + (vhdl-speedbar-instantiation-selected-face ((t (:underline t :foreground "Brown")))) + (vhdl-speedbar-package-face ((t (:foreground "Grey50")))) + (vhdl-speedbar-package-selected-face ((t (:underline t :foreground "Grey50")))) + (vhdl-speedbar-subprogram-face ((t (:foreground "Orchid4")))) + (widget-button-face ((t (:bold t)))) + (widget-button-pressed-face ((t (:foreground "red")))) + (widget-documentation-face ((t (:foreground "dark green")))) + (widget-field-face ((t (:background "gray85")))) + (widget-inactive-face ((t (:foreground "dim gray")))) + (yellow ((t (:foreground "yellow")))) + (zmacs-region ((t (:background "steelblue" :foreground "yellow"))))))) + +(defun color-theme-parus () + "Color theme by Jon K Hellan, created 2000-11-01. +White on dark blue color theme. + +There is some redundancy in the X resources, but I do not have time to +find out which should go or which should stay: + +Emacs*dialog*Background: midnightblue +Emacs*dialog*Foreground: white +Emacs*popup*Background: midnightblue +Emacs*popup*Foreground: white +emacs*background: #00005a +emacs*cursorColor: gray90 +emacs*foreground: White +emacs.dialog*.background: midnightblue +emacs.menu*.background: midnightblue +emacs.pane.menubar.background: midnightblue" + (interactive) + (color-theme-install + '(color-theme-parus + ((background-color . "#00005a") + (background-mode . dark) + (border-color . "black") + (cursor-color . "yellow") + (foreground-color . "White") + (mouse-color . "yellow")) + ((gnus-mouse-face . highlight) + (list-matching-lines-face . bold) + (paren-face . bold) + (paren-mismatch-face . paren-mismatch-face) + (paren-no-match-face . paren-no-match-face) + (view-highlight-face . highlight)) + (default ((t (nil)))) + (bold ((t (:bold t)))) + (bold-italic ((t (:italic t :bold t)))) + (font-latex-bold-face ((t (:bold t :foreground "OliveDrab")))) + (font-latex-italic-face ((t (:italic t :foreground "OliveDrab")))) + (font-latex-math-face ((t (:foreground "burlywood")))) + (font-latex-sedate-face ((t (:foreground "LightGray")))) + (font-latex-string-face ((t (:foreground "LightSalmon")))) + (font-latex-warning-face ((t (:foreground "Pink")))) + (font-lock-builtin-face ((t (:foreground "#e0e0ff")))) + (font-lock-reference-face ((t (:foreground "#e0e0ff")))) + (font-lock-comment-face ((t (:foreground "#FFd1d1")))) + (font-lock-constant-face ((t (:foreground "Aquamarine")))) + (font-lock-preprocessor-face ((t (:foreground "Aquamarine")))) + (font-lock-function-name-face ((t (:foreground "#b2e4ff")))) + (font-lock-keyword-face ((t (:foreground "#a0ffff")))) + (font-lock-string-face ((t (:foreground "#efca10")))) + (font-lock-doc-string-face ((t (:foreground "#efca10")))) + (font-lock-type-face ((t (:foreground "PaleGreen")))) + (font-lock-variable-name-face ((t (:foreground "LightGoldenrod")))) + (font-lock-warning-face ((t (:bold t :foreground "Pink")))) + (gnus-cite-attribution-face ((t (:italic t)))) + (gnus-cite-face-1 ((t (:foreground "#dfdfff")))) + (gnus-cite-face-10 ((t (:foreground "medium purple")))) + (gnus-cite-face-11 ((t (:foreground "turquoise")))) + (gnus-cite-face-2 ((t (:foreground "light cyan")))) + (gnus-cite-face-3 ((t (:foreground "light yellow")))) + (gnus-cite-face-4 ((t (:foreground "light pink")))) + (gnus-cite-face-5 ((t (:foreground "pale green")))) + (gnus-cite-face-6 ((t (:foreground "beige")))) + (gnus-cite-face-7 ((t (:foreground "orange")))) + (gnus-cite-face-8 ((t (:foreground "magenta")))) + (gnus-cite-face-9 ((t (:foreground "violet")))) + (gnus-emphasis-bold ((t (:bold t)))) + (gnus-emphasis-bold-italic ((t (:italic t :bold t)))) + (gnus-emphasis-highlight-words ((t (:background "black" :foreground "yellow")))) + (gnus-emphasis-italic ((t (:italic t)))) + (gnus-emphasis-underline ((t (:underline t)))) + (gnus-emphasis-underline-bold ((t (:underline t :bold t)))) + (gnus-emphasis-underline-bold-italic ((t (:underline t :italic t :bold t)))) + (gnus-emphasis-underline-italic ((t (:underline t :italic t)))) + (gnus-group-mail-1-empty-face ((t (:foreground "aquamarine1")))) + (gnus-group-mail-1-face ((t (:bold t :foreground "aquamarine1")))) + (gnus-group-mail-2-empty-face ((t (:foreground "aquamarine2")))) + (gnus-group-mail-2-face ((t (:bold t :foreground "aquamarine2")))) + (gnus-group-mail-3-empty-face ((t (:foreground "aquamarine3")))) + (gnus-group-mail-3-face ((t (:bold t :foreground "aquamarine3")))) + (gnus-group-mail-low-empty-face ((t (:foreground "aquamarine4")))) + (gnus-group-mail-low-face ((t (:bold t :foreground "aquamarine4")))) + (gnus-group-news-1-empty-face ((t (:foreground "PaleTurquoise")))) + (gnus-group-news-1-face ((t (:bold t :foreground "PaleTurquoise")))) + (gnus-group-news-2-empty-face ((t (:foreground "turquoise")))) + (gnus-group-news-2-face ((t (:bold t :foreground "turquoise")))) + (gnus-group-news-3-empty-face ((t (nil)))) + (gnus-group-news-3-face ((t (:bold t)))) + (gnus-group-news-4-empty-face ((t (nil)))) + (gnus-group-news-4-face ((t (:bold t)))) + (gnus-group-news-5-empty-face ((t (nil)))) + (gnus-group-news-5-face ((t (:bold t)))) + (gnus-group-news-6-empty-face ((t (nil)))) + (gnus-group-news-6-face ((t (:bold t)))) + (gnus-group-news-low-empty-face ((t (:foreground "DarkTurquoise")))) + (gnus-group-news-low-face ((t (:bold t :foreground "DarkTurquoise")))) + (gnus-header-content-face ((t (:italic t :foreground "#90f490")))) + (gnus-header-from-face ((t (:foreground "#aaffaa")))) + (gnus-header-name-face ((t (:foreground "#c7e3c7")))) + (gnus-header-newsgroups-face ((t (:italic t :foreground "yellow")))) + (gnus-header-subject-face ((t (:foreground "#a0f0a0")))) + (gnus-signature-face ((t (:italic t)))) + (gnus-splash-face ((t (:foreground "Brown")))) + (gnus-summary-cancelled-face ((t (:background "black" :foreground "yellow")))) + (gnus-summary-high-ancient-face ((t (:bold t :foreground "SkyBlue")))) + (gnus-summary-high-read-face ((t (:bold t :foreground "PaleGreen")))) + (gnus-summary-high-ticked-face ((t (:bold t :foreground "pink")))) + (gnus-summary-high-unread-face ((t (:bold t)))) + (gnus-summary-low-ancient-face ((t (:italic t :foreground "SkyBlue")))) + (gnus-summary-low-read-face ((t (:italic t :foreground "PaleGreen")))) + (gnus-summary-low-ticked-face ((t (:italic t :foreground "pink")))) + (gnus-summary-low-unread-face ((t (:italic t)))) + (gnus-summary-normal-ancient-face ((t (:foreground "SkyBlue")))) + (gnus-summary-normal-read-face ((t (:foreground "PaleGreen")))) + (gnus-summary-normal-ticked-face ((t (:foreground "pink")))) + (gnus-summary-normal-unread-face ((t (nil)))) + (gnus-summary-selected-face ((t (:underline t)))) + (highlight ((t (:background "darkolivegreen")))) + (italic ((t (:italic t)))) + (message-cited-text-face ((t (:foreground "#dfdfff")))) + (message-header-cc-face ((t (:bold t :foreground "#a0f0a0")))) + (message-header-name-face ((t (:foreground "#c7e3c7")))) + (message-header-newsgroups-face ((t (:italic t :bold t :foreground "yellow")))) + (message-header-other-face ((t (:foreground "#db9b9b")))) + (message-header-subject-face ((t (:foreground "#a0f0a0")))) + (message-header-to-face ((t (:bold t :foreground "#aaffaa")))) + (message-header-xheader-face ((t (:foreground "#e2e2ff")))) + (message-mml-face ((t (:foreground "#abdbab")))) + (message-separator-face ((t (:foreground "#dfdfff")))) + (modeline ((t (:background "White" :foreground "#00005a")))) + (modeline-buffer-id ((t (:background "White" :foreground "#00005a")))) + (modeline-mousable ((t (:background "White" :foreground "#00005a")))) + (modeline-mousable-minor-mode ((t (:background "White" :foreground "#00005a")))) + (paren-mismatch-face ((t (:background "DeepPink")))) + (paren-no-match-face ((t (:background "yellow")))) + (region ((t (:background "blue")))) + (primary-selection ((t (:background "blue")))) + (isearch ((t (:background "blue")))) + (secondary-selection ((t (:background "darkslateblue")))) + (underline ((t (:underline t)))) + (widget-button-face ((t (:bold t)))) + (widget-button-pressed-face ((t (:foreground "red")))) + (widget-documentation-face ((t (:foreground "lime green")))) + (widget-field-face ((t (:background "dim gray")))) + (widget-inactive-face ((t (:foreground "light gray")))) + (widget-single-line-field-face ((t (:background "dim gray"))))))) + +(defun color-theme-high-contrast () + "High contrast color theme, maybe for the visually impaired. +Watch out! This will set a very large font-size! + +If you want to modify the font as well, you should customize variable +`color-theme-legal-frame-parameters' to \"\\(color\\|mode\\|font\\|height\\|width\\)$\". +The default setting will prevent color themes from installing specific +fonts." + (interactive) + (color-theme-standard) + (let ((color-theme-is-cumulative t)) + (color-theme-install + '(color-theme-high-contrast + ((cursor-color . "red") + (width . 60) + (height . 25) + (background . dark)) + (default ((t (:stipple nil :background "white" :foreground "black" :inverse-video nil :box nil :strike-through nil :overline nil :underline nil :slant normal :weight bold :height 240 :width normal :family "adobe-courier")))) + + (bold ((t (:bold t :underline t)))) + (bold-italic ((t (:bold t :underline t)))) + (font-lock-builtin-face ((t (:bold t :foreground "Red")))) + (font-lock-comment-face ((t (:bold t :foreground "Firebrick")))) + (font-lock-constant-face ((t (:bold t :underline t :foreground "Blue")))) + (font-lock-function-name-face ((t (:bold t :foreground "Blue")))) + (font-lock-keyword-face ((t (:bold t :foreground "Purple")))) + (font-lock-string-face ((t (:bold t :foreground "DarkGreen")))) + (font-lock-type-face ((t (:bold t :foreground "ForestGreen")))) + (font-lock-variable-name-face ((t (:bold t :foreground "DarkGoldenrod")))) + (font-lock-warning-face ((t (:bold t :foreground "Red")))) + (highlight ((t (:background "black" :foreground "white" :bold 1)))) + (info-menu-5 ((t (:underline t :bold t)))) + (info-node ((t (:bold t)))) + (info-xref ((t (:bold t )))) + (italic ((t (:bold t :underline t)))) + (modeline ((t (:background "black" :foreground "white" :bold 1)))) + (modeline-buffer-id ((t (:background "black" :foreground "white" :bold 1)))) + (modeline-mousable ((t (:background "black" :foreground "white" :bold 1)))) + (modeline-mousable-minor-mode ((t (:background "black" :foreground "white" :bold 1)))) + (region ((t (:background "black" :foreground "white" :bold 1)))) + (secondary-selection ((t (:background "black" :foreground "white" :bold 1)))) + (underline ((t (:bold t :underline t)))))))) + +(defun color-theme-infodoc () + "Color theme by Frederic Giroud, created 2001-01-18. +Black on wheat scheme. Based on infodoc (xemacs variant distribution), +with my favorit fontlock color." + (interactive) + (color-theme-install + '(color-theme-infodoc + ((background-color . "wheat") + (background-mode . light) + (background-toolbar-color . "#000000000000") + (border-color . "#000000000000") + (bottom-toolbar-shadow-color . "#000000000000") + (cursor-color . "red") + (foreground-color . "black") + (top-toolbar-shadow-color . "#ffffffffffff")) + nil + (default ((t (:bold t)))) + (blue ((t (:bold t :foreground "blue")))) + (bold ((t (:background "wheat" :foreground "black")))) + (bold-italic ((t (:bold t :background "wheat" :foreground "black")))) + (border-glyph ((t (:bold t)))) + (calendar-today-face ((t (:underline t :bold t)))) + (custom-button-face ((t (nil)))) + (custom-changed-face ((t (:bold t :background "blue" :foreground "white")))) + (custom-documentation-face ((t (:bold t :background "wheat" :foreground "purple4")))) + (custom-face-tag-face ((t (:underline t :bold t)))) + (custom-group-tag-face ((t (:underline t :bold t :background "wheat" :foreground "blue")))) + (custom-group-tag-face-1 ((t (:underline t :bold t :background "wheat" :foreground "red")))) + (custom-invalid-face ((t (:bold t :background "red" :foreground "yellow")))) + (custom-modified-face ((t (:bold t :background "blue" :foreground "white")))) + (custom-rogue-face ((t (:bold t :background "black" :foreground "pink")))) + (custom-saved-face ((t (:underline t :bold t)))) + (custom-set-face ((t (:bold t :background "white" :foreground "blue")))) + (custom-state-face ((t (:bold t :background "wheat" :foreground "dark green")))) + (custom-variable-button-face ((t (:underline t)))) + (custom-variable-tag-face ((t (:underline t :bold t :background "wheat" :foreground "blue")))) + (diary-face ((t (:bold t :foreground "red")))) + (display-time-mail-balloon-enhance-face ((t (:bold t :background "wheat" :foreground "black")))) + (display-time-mail-balloon-gnus-group-face ((t (:bold t :background "wheat" :foreground "blue")))) + (display-time-time-balloon-face ((t (:bold t :background "light salmon" :foreground "dark green")))) + (font-lock-comment-face ((t (:bold t :background "wheat" :foreground "turquoise4")))) + (font-lock-doc-string-face ((t (:bold t :background "wheat" :foreground "purple4")))) + (font-lock-function-name-face ((t (:bold t :background "wheat" :foreground "blue4")))) + (font-lock-keyword-face ((t (:bold t :background "wheat" :foreground "dark orchid")))) + (font-lock-preprocessor-face ((t (:bold t :background "wheat" :foreground "orchid4")))) + (font-lock-reference-face ((t (:bold t :background "wheat" :foreground "red3")))) + (font-lock-string-face ((t (:bold t :background "wheat" :foreground "dark goldenrod")))) + (font-lock-type-face ((t (:bold t :background "wheat" :foreground "brown")))) + (font-lock-variable-name-face ((t (:bold t :background "wheat" :foreground "chocolate")))) + (font-lock-warning-face ((t (:bold t :background "wheat" :foreground "black")))) + (gdb-arrow-face ((t (:bold t :background "LightGreen" :foreground "black")))) + (green ((t (:bold t :foreground "green")))) + (gui-button-face ((t (:bold t :background "wheat" :foreground "red")))) + (gui-element ((t (:bold t :background "wheat" :foreground "black")))) + (highlight ((t (:bold t :background "darkseagreen2" :foreground "dark green")))) + (holiday-face ((t (:bold t :background "pink" :foreground "black")))) + (hproperty:but-face ((t (:bold t :background "wheat" :foreground "medium violet red")))) + (hproperty:flash-face ((t (:bold t :background "wheat" :foreground "gray80")))) + (hproperty:highlight-face ((t (:bold t :background "wheat" :foreground "red")))) + (hproperty:item-face ((t (:bold t)))) + (isearch ((t (:bold t :background "pale turquoise" :foreground "blue")))) + (italic ((t (:bold t :background "wheat" :foreground "black")))) + (left-margin ((t (:bold t :background "wheat" :foreground "black")))) + (list-mode-item-selected ((t (:bold t :background "gray68" :foreground "black")))) + (message-cited-text ((t (:bold t :background "wheat" :foreground "brown")))) + (message-header-contents ((t (:bold t :background "wheat" :foreground "black")))) + (message-headers ((t (:bold t :background "wheat" :foreground "black")))) + (message-highlighted-header-contents ((t (:bold t :background "wheat" :foreground "blue")))) + (message-url ((t (nil)))) + (modeline ((t (:bold t :background "light salmon" :foreground "dark green")))) + (modeline-buffer-id ((t (:bold t :background "light salmon" :foreground "blue4")))) + (modeline-mousable ((t (:bold t :background "light salmon" :foreground "firebrick")))) + (modeline-mousable-minor-mode ((t (:bold t :background "light salmon" :foreground "green4")))) + (pointer ((t (:bold t :background "wheat" :foreground "red")))) + (primary-selection ((t (:bold t :background "medium sea green")))) + (red ((t (:bold t :foreground "red")))) + (right-margin ((t (:bold t :background "wheat" :foreground "black")))) + (secondary-selection ((t (:bold t :background "paleturquoise" :foreground "black")))) + (shell-input-face ((t (:bold t :background "wheat" :foreground "blue")))) + (shell-option-face ((t (:bold t :background "wheat" :foreground "turquoise4")))) + (shell-output-2-face ((t (:bold t :background "wheat" :foreground "dark goldenrod")))) + (shell-output-3-face ((t (:bold t :background "wheat" :foreground "dark goldenrod")))) + (shell-output-face ((t (:bold t :background "wheat" :foreground "black")))) + (shell-prompt-face ((t (:bold t :background "wheat" :foreground "dark orchid")))) + (text-cursor ((t (:bold t :background "red" :foreground "wheat")))) + (toolbar ((t (:bold t :background "wheat" :foreground "black")))) + (underline ((t (:underline t :bold t :background "wheat" :foreground "black")))) + (vertical-divider ((t (:bold t)))) + (widget-button-face ((t (nil)))) + (widget-button-pressed-face ((t (:bold t :background "wheat" :foreground "red")))) + (widget-documentation-face ((t (:bold t :background "wheat" :foreground "dark green")))) + (widget-field-face ((t (:bold t :background "gray85")))) + (widget-inactive-face ((t (:bold t :background "wheat" :foreground "dim gray")))) + (x-face ((t (:bold t :background "wheat" :foreground "black")))) + (yellow ((t (:bold t :foreground "yellow")))) + (zmacs-region ((t (:bold t :background "lightyellow" :foreground "darkgreen"))))))) + +(defun color-theme-classic () + "Color theme by Frederic Giroud, created 2001-01-18. +AntiqueWhite on darkslategrey scheme. Based on Gnome 2, with my favorit +color foreground-color and fontlock color." + (interactive) + (color-theme-blue-gnus) + (let ((color-theme-is-cumulative t)) + (color-theme-install + '(color-theme-classic + ((foreground-color . "AntiqueWhite") + (background-color . "darkslategrey") + (mouse-color . "Grey") + (cursor-color . "Red") + (border-color . "black") + (background-mode . dark)) + ((apropos-keybinding-face . underline) + (apropos-label-face . italic) + (apropos-match-face . secondary-selection) + (apropos-property-face . bold-italic) + (apropos-symbol-face . info-xref) + (goto-address-mail-face . message-header-to-face) + (goto-address-mail-mouse-face . secondary-selection) + (goto-address-url-face . info-xref) + (goto-address-url-mouse-face . highlight) + (list-matching-lines-face . bold) + (view-highlight-face . highlight)) + (default ((t (nil)))) + (bold ((t (:bold t)))) + (bold-italic ((t (:italic t :bold t :foreground "beige")))) + (calendar-today-face ((t (:underline t)))) + (cperl-array-face ((t (:foreground "Yellow")))) + (cperl-hash-face ((t (:foreground "White")))) + (cperl-nonoverridable-face ((t (:foreground "SkyBlue")))) + (custom-button-face ((t (:underline t :foreground "MediumSlateBlue")))) + (custom-documentation-face ((t (:foreground "Grey")))) + (custom-group-tag-face ((t (:foreground "MediumAquamarine")))) + (custom-state-face ((t (:foreground "LightSalmon")))) + (custom-variable-tag-face ((t (:foreground "Aquamarine")))) + (diary-face ((t (:foreground "IndianRed")))) + (erc-action-face ((t (:bold t)))) + (erc-bold-face ((t (:bold t)))) + (erc-default-face ((t (nil)))) + (erc-direct-msg-face ((t (:foreground "LightSalmon")))) + (erc-error-face ((t (:bold t :foreground "IndianRed")))) + (erc-input-face ((t (:foreground "Beige")))) + (erc-inverse-face ((t (:background "wheat" :foreground "darkslategrey")))) + (erc-notice-face ((t (:foreground "MediumAquamarine")))) + (erc-pal-face ((t (:foreground "pale green")))) + (erc-prompt-face ((t (:foreground "MediumAquamarine")))) + (erc-underline-face ((t (:underline t)))) + (eshell-ls-archive-face ((t (:bold t :foreground "IndianRed")))) + (eshell-ls-backup-face ((t (:foreground "Grey")))) + (eshell-ls-clutter-face ((t (:foreground "DimGray")))) + (eshell-ls-directory-face ((t (:bold t :foreground "MediumSlateBlue")))) + (eshell-ls-executable-face ((t (:foreground "Coral")))) + (eshell-ls-missing-face ((t (:foreground "black")))) + (eshell-ls-picture-face ((t (:foreground "Violet")))) + (eshell-ls-product-face ((t (:foreground "LightSalmon")))) + (eshell-ls-readonly-face ((t (:foreground "Aquamarine")))) + (eshell-ls-special-face ((t (:foreground "Gold")))) + (eshell-ls-symlink-face ((t (:foreground "White")))) + (eshell-ls-unreadable-face ((t (:foreground "DimGray")))) + (eshell-prompt-face ((t (:foreground "MediumAquamarine")))) + (font-lock-builtin-face ((t (:bold t :foreground "PaleGreen")))) + (font-lock-comment-face ((t (:foreground "tomato3")))) + (font-lock-constant-face ((t (:foreground "Aquamarine")))) + (font-lock-doc-string-face ((t (:foreground "LightSalmon3")))) + (font-lock-function-name-face ((t (:foreground "SteelBlue1")))) + (font-lock-keyword-face ((t (:foreground "cyan1")))) + (font-lock-reference-face ((t (:foreground "LightSalmon2")))) + (font-lock-string-face ((t (:foreground "LightSalmon3")))) + (font-lock-type-face ((t (:foreground "PaleGreen3")))) + (font-lock-variable-name-face ((t (:foreground "khaki1")))) + (font-lock-warning-face ((t (:bold t :foreground "IndianRed")))) + (font-lock-preprocessor-face ((t (:foreground "SkyBlue3")))) + (widget-field-face ((t (:background "DarkCyan")))) + (custom-group-tag-face ((t(:foreground "brown" :underline t)))) + (custom-state-face ((t (:foreground "khaki")))) + (highlight ((t (:background "PaleGreen" :foreground "DarkGreen")))) + (highline-face ((t (:background "SeaGreen")))) + (holiday-face ((t (:background "DimGray")))) + (info-menu-5 ((t (:underline t)))) + (info-node ((t (:underline t :bold t :foreground "DodgerBlue1")))) + (info-xref ((t (:underline t :foreground "DodgerBlue1")))) + (isearch ((t (:foreground "red" :background "CornflowerBlue")))) + (italic ((t (:italic t)))) + (modeline ((t (:background "LightSlateGray" :foreground "AntiqueWhite")))) + (modeline-buffer-id ((t (:background "LightSlateGray" :foreground "DarkBlue")))) + (modeline-mousable ((t (:background "LightSlateGray" :foreground "firebrick")))) + (modeline-mousable-minor-mode ((t (:background "LightSlateGray" :foreground "wheat")))) + (region ((t (:background "dark cyan" :foreground "cyan")))) + (secondary-selection ((t (:background "Aquamarine" :foreground "SlateBlue")))) + (show-paren-match-face ((t (:background "Aquamarine" :foreground "SlateBlue")))) + (show-paren-mismatch-face ((t (:background "Red" :foreground "White")))) + (underline ((t (:underline t)))) + (widget-field-face ((t (:foreground "LightBlue")))) + (widget-inactive-face ((t (:foreground "DimGray")))) + (widget-single-line-field-face ((t (:foreground "LightBlue")))) + (woman-bold-face ((t (:bold t)))) + (woman-italic-face ((t (:foreground "beige")))) + (woman-unknown-face ((t (:foreground "LightSalmon")))))))) + +(defun color-theme-scintilla () + "Color theme by Gordon Messmer, created 2001-02-07. +Based on the Scintilla editor. + +If you want to modify the font as well, you should customize variable +`color-theme-legal-frame-parameters' to \"\\(color\\|mode\\|font\\|height\\|width\\)$\". +The default setting will prevent color themes from installing specific +fonts." + (interactive) + (color-theme-install + ;; The light editor style doesn't seem to look right with + ;; the same font that works in the dark editor style. + ;; Dark letters on light background just isn't as visible. + '(color-theme-scintilla + ((font . "-monotype-courier new-bold-r-normal-*-*-140-*-*-m-*-iso8859-1") + (width . 95) + (height . 40) + (background-color . "white") + (foreground-color . "black") + (background-mode . light) + (mouse-color . "grey15") + (cursor-color . "grey15")) + (default ((t nil))) + (font-lock-comment-face ((t (:italic t :foreground "ForestGreen")))) + (font-lock-string-face ((t (:foreground "DarkMagenta")))) + (font-lock-keyword-face ((t (:foreground "NavyBlue")))) + (font-lock-warning-face ((t (:bold t :foreground "VioletRed")))) + (font-lock-constant-face ((t (:foreground "Blue")))) + (font-lock-type-face ((t (:foreground "NavyBlue")))) + (font-lock-variable-name-face ((t (:foreground "DarkCyan")))) + (font-lock-function-name-face ((t (:foreground "DarkCyan")))) + (font-lock-builtin-face ((t (:foreground "NavyBlue")))) + (highline-face ((t (:background "Grey95")))) + (show-paren-match-face ((t (:background "Grey80")))) + (region ((t (:background "Grey80")))) + (highlight ((t (:foreground "ForestGreen")))) + (secondary-selection ((t (:background "NavyBlue" :foreground "white")))) + (widget-field-face ((t (:background "NavyBlue")))) + (widget-single-line-field-face ((t (:background "RoyalBlue")))))) ) + +(defun color-theme-gtk-ide () + "Color theme by Gordon Messmer, created 2001-02-07. +Inspired by a GTK IDE whose name I've forgotten. + +If you want to modify the font as well, you should customize variable +`color-theme-legal-frame-parameters' to \"\\(color\\|mode\\|font\\|height\\|width\\)$\". +The default setting will prevent color themes from installing specific +fonts." + ;; The light editor style doesn't seem to look right with + ;; the same font that works in the dark editor style. + ;; Dark letters on light background just isn't as visible. + (interactive) + (color-theme-install + '(color-theme-gtk-ide + ((font . "-monotype-courier new-medium-r-normal-*-*-120-*-*-m-*-iso8859-15") + (width . 95) + (height . 45) + (background-color . "white") + (foreground-color . "black") + (background-mode . light) + (mouse-color . "grey15") + (cursor-color . "grey15")) + (default ((t nil))) + (font-lock-comment-face ((t (:italic t :foreground "grey55")))) + (font-lock-string-face ((t (:foreground "DarkRed")))) + (font-lock-keyword-face ((t (:foreground "DarkBlue")))) + (font-lock-warning-face ((t (:bold t :foreground "VioletRed")))) + (font-lock-constant-face ((t (:foreground "OliveDrab")))) + (font-lock-type-face ((t (:foreground "SteelBlue4")))) + (font-lock-variable-name-face ((t (:foreground "DarkGoldenrod")))) + (font-lock-function-name-face ((t (:foreground "SlateBlue")))) + (font-lock-builtin-face ((t (:foreground "ForestGreen")))) + (highline-face ((t (:background "grey95")))) + (show-paren-match-face ((t (:background "grey80")))) + (region ((t (:background "grey80")))) + (highlight ((t (:background "LightSkyBlue")))) + (secondary-selection ((t (:background "grey55")))) + (widget-field-face ((t (:background "navy")))) + (widget-single-line-field-face ((t (:background "royalblue")))))) ) + +(defun color-theme-midnight () + "Color theme by Gordon Messmer, created 2001-02-07. +A color theme inspired by a certain IDE for Windows. It's all from memory, +since I only used that software in college. + +If you want to modify the font as well, you should customize variable +`color-theme-legal-frame-parameters' to \"\\(color\\|mode\\|font\\|height\\|width\\)$\". +The default setting will prevent color themes from installing specific +fonts." + (interactive) + (color-theme-install + '(color-theme-midnight + ((font . "fixed") + (width . 130) + (height . 50) + (background-color . "black") + (foreground-color . "grey85") + (background-mode . dark) + (mouse-color . "grey85") + (cursor-color . "grey85")) + (default ((t (nil)))) + (font-lock-comment-face ((t (:italic t :foreground "grey60")))) + (font-lock-string-face ((t (:foreground "Magenta")))) + (font-lock-keyword-face ((t (:foreground "Cyan")))) + (font-lock-warning-face ((t (:bold t :foreground "Pink")))) + (font-lock-constant-face ((t (:foreground "OliveDrab")))) + (font-lock-type-face ((t (:foreground "DarkCyan")))) + (font-lock-variable-name-face ((t (:foreground "DarkGoldenrod")))) + (font-lock-function-name-face ((t (:foreground "SlateBlue")))) + (font-lock-builtin-face ((t (:foreground "SkyBlue")))) + (highline-face ((t (:background "grey12")))) + (setnu-line-number-face ((t (:background "Grey15" :foreground "White" :bold t)))) + (show-paren-match-face ((t (:background "grey30")))) + (region ((t (:background "grey15")))) + (highlight ((t (:background "blue")))) + (secondary-selection ((t (:background "navy")))) + (widget-field-face ((t (:background "navy")))) + (widget-single-line-field-face ((t (:background "royalblue")))))) ) + +(defun color-theme-jedit-grey () + "Color theme by Gordon Messmer, created 2001-02-07. +Based on a screenshot of jedit. + +If you want to modify the font as well, you should customize variable +`color-theme-legal-frame-parameters' to \"\\(color\\|mode\\|font\\|height\\|width\\)$\". +The default setting will prevent color themes from installing specific +fonts." + (interactive) + (color-theme-install + '(color-theme-jedit-grey + ((font . "fixed") + (width . 130) + (height . 50) + (background-color . "grey77") + (foreground-color . "black") + (background-mode . light) + (mouse-color . "black") + (cursor-color . "black")) + (default ((t (nil)))) + (font-lock-comment-face ((t (:italic t :foreground "RoyalBlue4")))) + (font-lock-string-face ((t (:foreground "Gold4")))) + (font-lock-keyword-face ((t (:bold t :foreground "DarkRed")))) + (font-lock-warning-face ((t (:bold t :foreground "Pink")))) + (font-lock-constant-face ((t (:foreground "DarkCyan")))) + (font-lock-type-face ((t (:foreground "DarkRed")))) + (font-lock-function-name-face ((t (:foreground "Green4")))) + (font-lock-builtin-face ((t (:bold t :foreground "DarkRed")))) + (highline-face ((t (:background "grey84")))) + (setnu-line-number-face ((t (:background "White" :foreground "MediumPurple3" :italic t)))) + (show-paren-match-face ((t (:background "grey60")))) + (region ((t (:background "grey70")))) + (highlight ((t (:background "grey90")))) + (secondary-selection ((t (:background "white")))) + (widget-field-face ((t (:background "royalblue")))) + (widget-single-line-field-face ((t (:background "royalblue")))))) ) + +(defun color-theme-snow () + "Color theme by Nicolas Rist, created 2001-03-08. +Black on gainsboro. In Emacs, the text background is a shade darker +than the frame background: Gainsboro instead of snow. This makes the +structure of the text clearer without being too agressive on the eyes. +On XEmacs, this doesn't really work as the frame and the default face +allways use the same foreground and background colors. +The color theme includes gnus, message, font-lock, sgml, and speedbar." + (interactive) + (color-theme-install + '(color-theme-snow + ((background-color . "snow2") + (background-mode . light) + (border-color . "black") + (cursor-color . "RoyalBlue2") + (foreground-color . "black") + (mouse-color . "black")) + ((gnus-mouse-face . highlight) + (list-matching-lines-face . bold) + (view-highlight-face . highlight)) + (default ((t (:background "gainsboro" :foreground "dark slate gray")))) + (bold ((t (:bold t)))) + (bold-italic ((t (:italic t :bold t)))) + (calendar-today-face ((t (:underline t)))) + (custom-button-face ((t (:background "gainsboro" :foreground "dark cyan")))) + (custom-documentation-face ((t (:background "gainsboro")))) + (diary-face ((t (:foreground "red")))) + (fg:black ((t (:foreground "black")))) + (font-lock-builtin-face ((t (:background "gainsboro" :foreground "medium orchid")))) + (font-lock-comment-face ((t (:background "gainsboro" :foreground "SteelBlue3")))) + (font-lock-constant-face ((t (:background "gainsboro" :foreground "orange3")))) + (font-lock-function-name-face ((t (:background "gainsboro" :foreground "blue3")))) + (font-lock-keyword-face ((t (:background "gainsboro" :foreground "red3")))) + (font-lock-string-face ((t (:background "gainsboro" :foreground "SpringGreen3")))) + (font-lock-type-face ((t (:background "gainsboro" :foreground "dark cyan")))) + (font-lock-variable-name-face ((t (:background "gainsboro" :foreground "purple2")))) + (font-lock-warning-face ((t (:bold t :background "gainsboro" :foreground "red")))) + (gnus-group-mail-1-empty-face ((t (:foreground "DeepPink3")))) + (gnus-group-mail-1-face ((t (:bold t :foreground "DeepPink3")))) + (gnus-group-mail-2-empty-face ((t (:foreground "HotPink3")))) + (gnus-group-mail-2-face ((t (:bold t :foreground "HotPink3")))) + (gnus-group-mail-3-empty-face ((t (:foreground "magenta4")))) + (gnus-group-mail-3-face ((t (:bold t :foreground "magenta4")))) + (gnus-group-mail-low-empty-face ((t (:foreground "DeepPink4")))) + (gnus-group-mail-low-face ((t (:bold t :foreground "DeepPink4")))) + (gnus-group-news-1-empty-face ((t (:foreground "ForestGreen")))) + (gnus-group-news-1-face ((t (:bold t :foreground "ForestGreen")))) + (gnus-group-news-2-empty-face ((t (:foreground "CadetBlue4")))) + (gnus-group-news-2-face ((t (:bold t :foreground "CadetBlue4")))) + (gnus-group-news-3-empty-face ((t (nil)))) + (gnus-group-news-3-face ((t (:bold t)))) + (gnus-group-news-low-empty-face ((t (:foreground "DarkGreen")))) + (gnus-group-news-low-face ((t (:bold t :foreground "DarkGreen")))) + (gnus-splash-face ((t (:foreground "ForestGreen")))) + (gnus-summary-cancelled-face ((t (:background "black" :foreground "yellow")))) + (gnus-summary-high-ancient-face ((t (:bold t :foreground "RoyalBlue")))) + (gnus-summary-high-read-face ((t (:bold t :foreground "DarkGreen")))) + (gnus-summary-high-ticked-face ((t (:bold t :foreground "firebrick")))) + (gnus-summary-high-unread-face ((t (:bold t)))) + (gnus-summary-low-ancient-face ((t (:italic t :foreground "RoyalBlue")))) + (gnus-summary-low-read-face ((t (:italic t :foreground "DarkGreen")))) + (gnus-summary-low-ticked-face ((t (:italic t :foreground "firebrick")))) + (gnus-summary-low-unread-face ((t (:italic t)))) + (gnus-summary-normal-ancient-face ((t (:foreground "RoyalBlue")))) + (gnus-summary-normal-read-face ((t (:foreground "DarkGreen")))) + (gnus-summary-normal-ticked-face ((t (:foreground "firebrick")))) + (gnus-summary-normal-unread-face ((t (nil)))) + (gnus-summary-selected-face ((t (:underline t)))) + (gui-button-face ((t (:foreground "light grey")))) + (highlight ((t (:background "LightSteelBlue1")))) + (holiday-face ((t (:background "pink")))) + (ibuffer-marked-face ((t (:foreground "red")))) + (italic ((t (:italic t)))) + (message-cited-text-face ((t (:foreground "red")))) + (message-header-cc-face ((t (:foreground "MidnightBlue")))) + (message-header-name-face ((t (:foreground "cornflower blue")))) + (message-header-newsgroups-face ((t (:italic t :bold t :foreground "blue4")))) + (message-header-other-face ((t (:foreground "steel blue")))) + (message-header-subject-face ((t (:bold t :foreground "navy blue")))) + (message-header-to-face ((t (:bold t :foreground "MidnightBlue")))) + (message-header-xheader-face ((t (:foreground "blue")))) + (message-separator-face ((t (:foreground "brown")))) + (modeline ((t (:background "dark slate gray" :foreground "gainsboro")))) + (modeline-buffer-id ((t (:background "dark slate gray" :foreground "gainsboro")))) + (modeline-mousable ((t (:background "dark slate gray" :foreground "gainsboro")))) + (modeline-mousable-minor-mode ((t (:background "dark slate gray" :foreground "gainsboro")))) + (region ((t (:background "lavender")))) + (secondary-selection ((t (:background "paleturquoise")))) + (sgml-comment-face ((t (:foreground "dark green")))) + (sgml-doctype-face ((t (:foreground "maroon")))) + (sgml-end-tag-face ((t (:foreground "blue2")))) + (sgml-entity-face ((t (:foreground "red2")))) + (sgml-ignored-face ((t (:background "gray90" :foreground "maroon")))) + (sgml-ms-end-face ((t (:foreground "maroon")))) + (sgml-ms-start-face ((t (:foreground "maroon")))) + (sgml-pi-face ((t (:foreground "maroon")))) + (sgml-sgml-face ((t (:foreground "maroon")))) + (sgml-short-ref-face ((t (:foreground "goldenrod")))) + (sgml-start-tag-face ((t (:foreground "blue2")))) + (show-paren-match-face ((t (:background "SlateGray1")))) + (show-paren-mismatch-face ((t (:background "purple" :foreground "white")))) + (speedbar-button-face ((t (:foreground "green4")))) + (speedbar-directory-face ((t (:foreground "blue4")))) + (speedbar-file-face ((t (:foreground "cyan4")))) + (speedbar-highlight-face ((t (:background "dark turquoise" :foreground "white")))) + (speedbar-selected-face ((t (:underline t :foreground "red")))) + (speedbar-tag-face ((t (:foreground "brown")))) + (underline ((t (:underline t))))))) + +(defun color-theme-montz () + "Color theme by Brady Montz, created 2001-03-08. +Black on Gray. +Includes dired, bbdb, font-lock, gnus, message, viper, and widget." + (interactive) + (color-theme-install + '(color-theme-montz + ((background-color . "gray80") + (background-mode . light) + (background-toolbar-color . "#cccccccccccc") + (border-color . "#000000000000") + (bottom-toolbar-shadow-color . "#7a7a7a7a7a7a") + (cursor-color . "Red3") + (foreground-color . "black") + (top-toolbar-shadow-color . "#f5f5f5f5f5f5") + (viper-saved-cursor-color-in-replace-mode . "Red3")) + ((gnus-mouse-face . highlight) + (paren-match-face . paren-face-match) + (paren-mismatch-face . paren-face-mismatch) + (paren-no-match-face . paren-face-no-match) + (smiley-mouse-face . highlight)) + (default ((t (nil)))) + (bbdb-company ((t (:italic t)))) + (bbdb-field-name ((t (:bold t)))) + (bbdb-field-value ((t (nil)))) + (bbdb-name ((t (:underline t)))) + (blue ((t (:foreground "blue")))) + (bold ((t (:bold t)))) + (bold-italic ((t (:italic t :bold t)))) + (border-glyph ((t (nil)))) + (dired-face-boring ((t (:foreground "Gray65")))) + (dired-face-directory ((t (:bold t)))) + (dired-face-executable ((t (:foreground "SeaGreen")))) + (dired-face-flagged ((t (:background "LightSlateGray")))) + (dired-face-marked ((t (:background "PaleVioletRed")))) + (dired-face-permissions ((t (:background "grey75" :foreground "black")))) + (dired-face-setuid ((t (:foreground "Red")))) + (dired-face-socket ((t (:foreground "magenta")))) + (dired-face-symlink ((t (:foreground "cyan")))) + (display-time-mail-balloon-enhance-face ((t (:background "orange")))) + (display-time-mail-balloon-gnus-group-face ((t (:foreground "blue")))) + (display-time-time-balloon-face ((t (:foreground "red")))) + (font-lock-builtin-face ((t (:foreground "red3")))) + (font-lock-comment-face ((t (:foreground "blue")))) + (font-lock-constant-face ((t (:foreground "red3")))) + (font-lock-doc-string-face ((t (:foreground "mediumvioletred")))) + (font-lock-function-name-face ((t (:foreground "firebrick")))) + (font-lock-keyword-face ((t (:bold t :foreground "black")))) + (font-lock-preprocessor-face ((t (:foreground "blue3")))) + (font-lock-reference-face ((t (:foreground "red3")))) + (font-lock-string-face ((t (:foreground "mediumvioletred")))) + (font-lock-type-face ((t (:foreground "darkgreen")))) + (font-lock-variable-name-face ((t (:foreground "black")))) + (font-lock-warning-face ((t (:bold t :foreground "Red")))) + (gnus-cite-attribution-face ((t (:italic t)))) + (gnus-cite-face-1 ((t (:foreground "MidnightBlue")))) + (gnus-cite-face-10 ((t (:foreground "medium purple")))) + (gnus-cite-face-11 ((t (:foreground "turquoise")))) + (gnus-cite-face-2 ((t (:foreground "firebrick")))) + (gnus-cite-face-3 ((t (:foreground "dark green")))) + (gnus-cite-face-4 ((t (:foreground "OrangeRed")))) + (gnus-cite-face-5 ((t (:foreground "dark khaki")))) + (gnus-cite-face-6 ((t (:foreground "dark violet")))) + (gnus-cite-face-7 ((t (:foreground "SteelBlue4")))) + (gnus-cite-face-8 ((t (:foreground "magenta")))) + (gnus-cite-face-9 ((t (:foreground "violet")))) + (gnus-emphasis-bold ((t (:bold t)))) + (gnus-emphasis-bold-italic ((t (:bold t)))) + (gnus-emphasis-highlight-words ((t (:background "black" :foreground "yellow")))) + (gnus-emphasis-italic ((t (:italic t)))) + (gnus-emphasis-underline ((t (:underline t)))) + (gnus-emphasis-underline-bold ((t (:underline t :bold t)))) + (gnus-emphasis-underline-bold-italic ((t (:underline t :bold t)))) + (gnus-emphasis-underline-italic ((t (:underline t :italic t)))) + (gnus-group-mail-1-empty-face ((t (:foreground "DeepPink3")))) + (gnus-group-mail-1-face ((t (:bold t :foreground "DeepPink3")))) + (gnus-group-mail-2-empty-face ((t (:foreground "HotPink3")))) + (gnus-group-mail-2-face ((t (:bold t :foreground "HotPink3")))) + (gnus-group-mail-3-empty-face ((t (:foreground "magenta4")))) + (gnus-group-mail-3-face ((t (:bold t :foreground "magenta4")))) + (gnus-group-mail-low-empty-face ((t (:foreground "DeepPink4")))) + (gnus-group-mail-low-face ((t (:bold t :foreground "DeepPink4")))) + (gnus-group-news-1-empty-face ((t (:foreground "ForestGreen")))) + (gnus-group-news-1-face ((t (:bold t :foreground "ForestGreen")))) + (gnus-group-news-2-empty-face ((t (:foreground "CadetBlue4")))) + (gnus-group-news-2-face ((t (:bold t :foreground "CadetBlue4")))) + (gnus-group-news-3-empty-face ((t (nil)))) + (gnus-group-news-3-face ((t (:bold t)))) + (gnus-group-news-4-empty-face ((t (nil)))) + (gnus-group-news-4-face ((t (:bold t)))) + (gnus-group-news-5-empty-face ((t (nil)))) + (gnus-group-news-5-face ((t (:bold t)))) + (gnus-group-news-6-empty-face ((t (nil)))) + (gnus-group-news-6-face ((t (:bold t)))) + (gnus-group-news-low-empty-face ((t (:foreground "DarkGreen")))) + (gnus-group-news-low-face ((t (:bold t :foreground "DarkGreen")))) + (gnus-header-content-face ((t (:italic t :foreground "indianred4")))) + (gnus-header-from-face ((t (:foreground "red3")))) + (gnus-header-name-face ((t (:foreground "maroon")))) + (gnus-header-newsgroups-face ((t (:italic t :foreground "MidnightBlue")))) + (gnus-header-subject-face ((t (:foreground "red4")))) + (gnus-picons-face ((t (:background "white" :foreground "black")))) + (gnus-picons-xbm-face ((t (:background "white" :foreground "black")))) + (gnus-signature-face ((t (:italic t)))) + (gnus-splash-face ((t (:foreground "Brown")))) + (gnus-summary-cancelled-face ((t (:background "black" :foreground "yellow")))) + (gnus-summary-high-ancient-face ((t (:bold t :foreground "RoyalBlue")))) + (gnus-summary-high-read-face ((t (:bold t :foreground "DarkGreen")))) + (gnus-summary-high-ticked-face ((t (:bold t :foreground "firebrick")))) + (gnus-summary-high-unread-face ((t (:bold t)))) + (gnus-summary-low-ancient-face ((t (:italic t :foreground "RoyalBlue")))) + (gnus-summary-low-read-face ((t (:italic t :foreground "DarkGreen")))) + (gnus-summary-low-ticked-face ((t (:italic t :foreground "firebrick")))) + (gnus-summary-low-unread-face ((t (:italic t)))) + (gnus-summary-normal-ancient-face ((t (:foreground "RoyalBlue")))) + (gnus-summary-normal-read-face ((t (:foreground "DarkGreen")))) + (gnus-summary-normal-ticked-face ((t (:foreground "firebrick")))) + (gnus-summary-normal-unread-face ((t (nil)))) + (gnus-summary-selected-face ((t (:underline t)))) + (gnus-x-face ((t (:background "white" :foreground "black")))) + (green ((t (:foreground "green")))) + (gui-button-face ((t (:background "grey75" :foreground "black")))) + (gui-element ((t (nil)))) + (highlight ((t (:background "darkseagreen2")))) + (info-node ((t (:bold t)))) + (info-xref ((t (:bold t)))) + (isearch ((t (:background "paleturquoise")))) + (italic ((t (:italic t)))) + (left-margin ((t (nil)))) + (list-mode-item-selected ((t (:background "gray68" :foreground "black")))) + (message-cited-text-face ((t (:foreground "red")))) + (message-header-cc-face ((t (:foreground "MidnightBlue")))) + (message-header-name-face ((t (:foreground "cornflower blue")))) + (message-header-newsgroups-face ((t (:bold t :foreground "blue4")))) + (message-header-other-face ((t (:foreground "steel blue")))) + (message-header-subject-face ((t (:bold t :foreground "navy blue")))) + (message-header-to-face ((t (:bold t :foreground "MidnightBlue")))) + (message-header-xheader-face ((t (:foreground "blue")))) + (message-mml-face ((t (:foreground "ForestGreen")))) + (message-separator-face ((t (:foreground "brown")))) + (modeline ((t (nil)))) + (modeline-buffer-id ((t (:background "Gray80" :foreground "blue4")))) + (modeline-mousable ((t (:background "Gray80" :foreground "firebrick")))) + (modeline-mousable-minor-mode ((t (:background "Gray80" :foreground "green4")))) + (paren-face-match ((t (:background "turquoise")))) + (paren-face-mismatch ((t (:background "purple" :foreground "white")))) + (paren-face-no-match ((t (:background "yellow" :foreground "black")))) + (pointer ((t (nil)))) + (primary-selection ((t (:background "gray65")))) + (red ((t (:foreground "red")))) + (right-margin ((t (nil)))) + (secondary-selection ((t (:background "paleturquoise")))) + (text-cursor ((t (:background "Red3" :foreground "gray80")))) + (toolbar ((t (nil)))) + (underline ((t (:underline t)))) + (vertical-divider ((t (nil)))) + (viper-minibuffer-emacs-face ((t (:background "gray80" :foreground "black")))) + (viper-minibuffer-insert-face ((t (:background "gray80" :foreground "black")))) + (viper-minibuffer-vi-face ((t (:background "gray80" :foreground "black")))) + (viper-replace-overlay-face ((t (:background "black" :foreground "white")))) + (viper-search-face ((t (:background "black" :foreground "white")))) + (widget-button-face ((t (:bold t)))) + (widget-button-pressed-face ((t (:foreground "red")))) + (widget-documentation-face ((t (:foreground "dark green")))) + (widget-field-face ((t (:background "gray85")))) + (widget-inactive-face ((t (:foreground "dim gray")))) + (yellow ((t (:foreground "yellow")))) + (zmacs-region ((t (:background "black" :foreground "white"))))))) + +(defun color-theme-aalto-light () + "Color theme by Jari Aalto, created 2001-03-08. +Black on light yellow. +Used for Win32 on a Nokia446Xpro monitor. +Includes cvs, font-lock, gnus, message, sgml, widget" + (interactive) + (color-theme-install + '(color-theme-aalto-light + ((background-color . "#FFFFE0") + (background-mode . light) + (border-color . "black") + (cursor-color . "black") + (foreground-color . "black") + (mouse-color . "LawnGreen")) + ((gnus-mouse-face . highlight) + (list-matching-lines-face . bold) + (tinyreplace-:face . highlight) + (view-highlight-face . highlight)) + (default ((t (nil)))) + (bold ((t (:bold t)))) + (bold-italic ((t (:italic t :bold t)))) + (calendar-today-face ((t (:underline t)))) + (cvs-filename-face ((t (:foreground "blue4")))) + (cvs-handled-face ((t (:foreground "pink")))) + (cvs-header-face ((t (:bold t :foreground "blue4")))) + (cvs-marked-face ((t (:bold t :foreground "green3")))) + (cvs-msg-face ((t (:italic t)))) + (cvs-need-action-face ((t (:foreground "orange")))) + (cvs-unknown-face ((t (:foreground "red")))) + (diary-face ((t (:foreground "red")))) + (eshell-test-failed-face ((t (:bold t :foreground "OrangeRed")))) + (eshell-test-ok-face ((t (:bold t :foreground "Green")))) + (font-lock-builtin-face ((t (:foreground "Orchid")))) + (font-lock-comment-face ((t (:foreground "Firebrick")))) + (font-lock-constant-face ((t (:foreground "CadetBlue")))) + (font-lock-function-name-face ((t (:foreground "Blue")))) + (font-lock-keyword-face ((t (:foreground "Purple")))) + (font-lock-string-face ((t (:foreground "RosyBrown")))) + (font-lock-type-face ((t (:foreground "ForestGreen")))) + (font-lock-variable-name-face ((t (:foreground "DarkGoldenrod")))) + (font-lock-warning-face ((t (:bold t :foreground "Red")))) + (gnus-emphasis-bold ((t (:bold t)))) + (gnus-emphasis-bold-italic ((t (:italic t :bold t)))) + (gnus-emphasis-highlight-words ((t (:background "black" :foreground "yellow")))) + (gnus-emphasis-italic ((t (:italic t)))) + (gnus-emphasis-underline ((t (:underline t)))) + (gnus-emphasis-underline-bold ((t (:underline t :bold t)))) + (gnus-emphasis-underline-bold-italic ((t (:underline t :italic t :bold t)))) + (gnus-emphasis-underline-italic ((t (:underline t :italic t)))) + (gnus-group-mail-1-empty-face ((t (:foreground "DeepPink3")))) + (gnus-group-mail-1-face ((t (:bold t :foreground "DeepPink3")))) + (gnus-group-mail-2-empty-face ((t (:foreground "HotPink3")))) + (gnus-group-mail-2-face ((t (:bold t :foreground "HotPink3")))) + (gnus-group-mail-3-empty-face ((t (:foreground "magenta4")))) + (gnus-group-mail-3-face ((t (:bold t :foreground "magenta4")))) + (gnus-group-mail-low-empty-face ((t (:foreground "DeepPink4")))) + (gnus-group-mail-low-face ((t (:bold t :foreground "DeepPink4")))) + (gnus-group-news-1-empty-face ((t (:foreground "ForestGreen")))) + (gnus-group-news-1-face ((t (:bold t :foreground "ForestGreen")))) + (gnus-group-news-2-empty-face ((t (:foreground "CadetBlue4")))) + (gnus-group-news-2-face ((t (:bold t :foreground "CadetBlue4")))) + (gnus-group-news-3-empty-face ((t (nil)))) + (gnus-group-news-3-face ((t (:bold t)))) + (gnus-group-news-4-empty-face ((t (nil)))) + (gnus-group-news-4-face ((t (:bold t)))) + (gnus-group-news-5-empty-face ((t (nil)))) + (gnus-group-news-5-face ((t (:bold t)))) + (gnus-group-news-6-empty-face ((t (nil)))) + (gnus-group-news-6-face ((t (:bold t)))) + (gnus-group-news-low-empty-face ((t (:foreground "DarkGreen")))) + (gnus-group-news-low-face ((t (:bold t :foreground "DarkGreen")))) + (gnus-header-content-face ((t (:italic t :foreground "indianred4")))) + (gnus-header-from-face ((t (:foreground "red3")))) + (gnus-header-name-face ((t (:foreground "maroon")))) + (gnus-header-newsgroups-face ((t (:italic t :foreground "MidnightBlue")))) + (gnus-header-subject-face ((t (:foreground "red4")))) + (gnus-signature-face ((t (:italic t)))) + (gnus-splash-face ((t (:foreground "Brown")))) + (gnus-summary-cancelled-face ((t (:background "black" :foreground "yellow")))) + (gnus-summary-high-ancient-face ((t (:bold t :foreground "RoyalBlue")))) + (gnus-summary-high-read-face ((t (:bold t :foreground "DarkGreen")))) + (gnus-summary-high-ticked-face ((t (:bold t :foreground "firebrick")))) + (gnus-summary-high-unread-face ((t (:bold t)))) + (gnus-summary-low-ancient-face ((t (:italic t :foreground "RoyalBlue")))) + (gnus-summary-low-read-face ((t (:italic t :foreground "DarkGreen")))) + (gnus-summary-low-ticked-face ((t (:italic t :foreground "firebrick")))) + (gnus-summary-low-unread-face ((t (:italic t)))) + (gnus-summary-normal-ancient-face ((t (:foreground "RoyalBlue")))) + (gnus-summary-normal-read-face ((t (:foreground "DarkGreen")))) + (gnus-summary-normal-ticked-face ((t (:foreground "firebrick")))) + (gnus-summary-normal-unread-face ((t (nil)))) + (gnus-summary-selected-face ((t (:underline t)))) + (highlight ((t (:background "darkseagreen2")))) + (holiday-face ((t (:background "pink")))) + (info-menu-5 ((t (:underline t)))) + (info-node ((t (:italic t :bold t)))) + (info-xref ((t (:bold t)))) + (italic ((t (:italic t)))) + (message-cited-text-face ((t (:foreground "red")))) + (message-header-cc-face ((t (:foreground "MidnightBlue")))) + (message-header-name-face ((t (:foreground "cornflower blue")))) + (message-header-newsgroups-face ((t (:italic t :bold t :foreground "blue4")))) + (message-header-other-face ((t (:foreground "steel blue")))) + (message-header-subject-face ((t (:bold t :foreground "navy blue")))) + (message-header-to-face ((t (:bold t :foreground "MidnightBlue")))) + (message-header-xheader-face ((t (:foreground "blue")))) + (message-mml-face ((t (:foreground "ForestGreen")))) + (message-separator-face ((t (:foreground "brown")))) + (modeline ((t (:background "black" :foreground "white")))) + (modeline-buffer-id ((t (:background "black" :foreground "white")))) + (modeline-mousable ((t (:background "black" :foreground "white")))) + (modeline-mousable-minor-mode ((t (:background "black" :foreground "white")))) + (region ((t (:background "gray")))) + (secondary-selection ((t (:background "paleturquoise")))) + (sgml-comment-face ((t (:foreground "dark turquoise")))) + (sgml-doctype-face ((t (:foreground "red")))) + (sgml-end-tag-face ((t (:foreground "blue")))) + (sgml-entity-face ((t (:foreground "magenta")))) + (sgml-ignored-face ((t (:background "gray60" :foreground "gray40")))) + (sgml-ms-end-face ((t (:foreground "green")))) + (sgml-ms-start-face ((t (:foreground "green")))) + (sgml-pi-face ((t (:foreground "lime green")))) + (sgml-sgml-face ((t (:foreground "brown")))) + (sgml-short-ref-face ((t (:foreground "deep sky blue")))) + (sgml-start-tag-face ((t (:foreground "blue")))) + (show-paren-match-face ((t (:background "turquoise")))) + (show-paren-mismatch-face ((t (:background "purple" :foreground "white")))) + (underline ((t (:underline t)))) + (widget-button-face ((t (:bold t)))) + (widget-button-pressed-face ((t (:foreground "red")))) + (widget-documentation-face ((t (:foreground "dark green")))) + (widget-field-face ((t (:background "gray85")))) + (widget-inactive-face ((t (:foreground "dim gray")))) + (widget-single-line-field-face ((t (:background "gray85"))))))) + +(defun color-theme-aalto-dark () + "Color theme by Jari Aalto, created 2001-03-08. +White on Deep Sky Blue 3. +Used for Unix Exceed on a Nokia446Xpro monitor. +Includes font-lock, info, and message." + (interactive) + (color-theme-install + '(color-theme-aalto-dark + ((background-color . "DeepSkyBlue3") + (background-mode . dark) + (border-color . "black") + (cursor-color . "yellow") + (foreground-color . "white") + (mouse-color . "black")) + ((ispell-highlight-face . highlight) + (list-matching-lines-face . bold) + (tinyreplace-:face . highlight) + (view-highlight-face . highlight)) + (default ((t (nil)))) + (bold ((t (:bold t :background "blue3" :foreground "white")))) + (bold-italic ((t (:italic t :bold t :foreground "blue3")))) + (calendar-today-face ((t (:underline t)))) + (diary-face ((t (:foreground "red")))) + (font-lock-builtin-face ((t (:foreground "LightSteelBlue")))) + (font-lock-comment-face ((t (:foreground "OrangeRed")))) + (font-lock-constant-face ((t (:foreground "Aquamarine")))) + (font-lock-function-name-face ((t (:foreground "LightSkyBlue")))) + (font-lock-keyword-face ((t (:foreground "Cyan")))) + (font-lock-string-face ((t (:foreground "LightSalmon")))) + (font-lock-type-face ((t (:foreground "PaleGreen")))) + (font-lock-variable-name-face ((t (:foreground "LightGoldenrod")))) + (font-lock-warning-face ((t (:bold t :foreground "Pink")))) + (highlight ((t (:background "blue3" :foreground "white")))) + (holiday-face ((t (:background "pink")))) + (info-menu-5 ((t (:underline t)))) + (info-node ((t (:italic t :bold t)))) + (info-xref ((t (:bold t)))) + (italic ((t (:italic t :background "gray")))) + (message-cited-text-face ((t (:foreground "red")))) + (message-header-cc-face ((t (:bold t :foreground "green4")))) + (message-header-name-face ((t (:foreground "DarkGreen")))) + (message-header-newsgroups-face ((t (:italic t :bold t :foreground "yellow")))) + (message-header-other-face ((t (:foreground "#b00000")))) + (message-header-subject-face ((t (:foreground "green3")))) + (message-header-to-face ((t (:bold t :foreground "green2")))) + (message-header-xheader-face ((t (:foreground "blue")))) + (message-mml-face ((t (:foreground "ForestGreen")))) + (message-separator-face ((t (:foreground "blue3")))) + (modeline ((t (:background "white" :foreground "DeepSkyBlue3")))) + (modeline-buffer-id ((t (:background "white" :foreground "DeepSkyBlue3")))) + (modeline-mousable ((t (:background "white" :foreground "DeepSkyBlue3")))) + (modeline-mousable-minor-mode ((t (:background "white" :foreground "DeepSkyBlue3")))) + (region ((t (:background "gray")))) + (secondary-selection ((t (:background "darkslateblue")))) + (show-paren-match-face ((t (:background "turquoise")))) + (show-paren-mismatch-face ((t (:background "purple" :foreground "white")))) + (underline ((t (:underline t))))))) + +(defun color-theme-blippblopp () + "Color theme by Thomas Sicheritz-Ponten, created 2001-03-12. +Used by researchers at Uppsala University and the Center for Biological +Sequence Analysis at the Technical University of Denmark. (As some of my +swedish friends couldn't pronounce Sicheritz - they choose to transform +it to something more \"swedish\": Blippblopp :-) +Includes font-lock and message." + (interactive) + (color-theme-install + '(color-theme-blippblopp + ((background-color . "white") + (background-mode . light) + (background-toolbar-color . "#cf3ccf3ccf3c") + (border-color . "#000000000000") + (bottom-toolbar-shadow-color . "#79e77df779e7") + (cursor-color . "Red3") + (foreground-color . "black") + (mouse-color . "black") + (top-toolbar-shadow-color . "#fffffbeeffff") + (viper-saved-cursor-color-in-replace-mode . "Red3")) + ((ispell-highlight-face . highlight)) + (default ((t (nil)))) + (blue ((t (:foreground "blue")))) + (bold ((t (:bold t)))) + (bold-italic ((t (:italic t :bold t)))) + (excerpt ((t (:italic t)))) + (ff-paths-non-existant-file-face ((t (:bold t :foreground "NavyBlue")))) + (fg:black ((t (:foreground "black")))) + (fixed ((t (:bold t)))) + (font-lock-builtin-face ((t (:foreground "red3")))) + (font-lock-comment-face ((t (:foreground "orange")))) + (font-lock-constant-face ((t (:foreground "red3")))) + (font-lock-doc-string-face ((t (:foreground "darkgreen")))) + (font-lock-exit-face ((t (:foreground "green")))) + (font-lock-function-name-face ((t (:bold t :foreground "red")))) + (font-lock-keyword-face ((t (:bold t :foreground "steelblue")))) + (font-lock-preprocessor-face ((t (:foreground "blue3")))) + (font-lock-reference-face ((t (:foreground "red3")))) + (font-lock-string-face ((t (:foreground "green4")))) + (font-lock-type-face ((t (:bold t :foreground "blue")))) + (font-lock-variable-name-face ((t (:foreground "black")))) + (font-lock-warning-face ((t (:bold t :foreground "Red")))) + (green ((t (:foreground "green")))) + (message-cited-text-face ((t (:foreground "red")))) + (message-header-cc-face ((t (:foreground "MidnightBlue")))) + (message-header-name-face ((t (:foreground "cornflower blue")))) + (message-header-newsgroups-face ((t (:italic t :bold t :foreground "blue4")))) + (message-header-other-face ((t (:foreground "steel blue")))) + (message-header-subject-face ((t (:bold t :foreground "navy blue")))) + (message-header-to-face ((t (:bold t :foreground "MidnightBlue")))) + (message-header-xheader-face ((t (:foreground "blue")))) + (message-mml-face ((t (:foreground "ForestGreen")))) + (message-separator-face ((t (:foreground "brown")))) + (modeline ((t (:background "dimgray" :foreground "lemonchiffon")))) + (modeline-buffer-id ((t (:background "dimgray" :foreground "green3")))) + (modeline-mousable ((t (:background "dimgray" :foreground "orange")))) + (modeline-mousable-minor-mode ((t (:background "dimgray" :foreground "blue4")))) + (primary-selection ((t (:background "gray65")))) + (red ((t (:foreground "red")))) + (region ((t (:background "gray65")))) + (secondary-selection ((t (:background "paleturquoise")))) + (show-paren-match-face ((t (:background "turquoise")))) + (show-paren-mismatch-face ((t (:background "purple" :foreground "white")))) + (text-cursor ((t (:background "Red3" :foreground "white")))) + (toolbar ((t (:background "Gray80")))) + (underline ((t (:underline t)))) + (vcursor ((t (:underline t :background "cyan" :foreground "blue")))) + (vertical-divider ((t (:background "Gray80")))) + (xref-keyword-face ((t (:foreground "blue")))) + (xref-list-pilot-face ((t (:foreground "navy")))) + (xref-list-symbol-face ((t (:foreground "navy")))) + (yellow ((t (:foreground "yellow")))) + (zmacs-region ((t (:background "gray65"))))))) + +(defun color-theme-hober (&optional preview) + "Does all sorts of crazy stuff. +Originally based on color-theme-standard, so I probably still have some +setting that I haven't changed. I also liberally copied settings from +the other themes in this package. The end result isn't much like the +other ones; I hope you like it." + (interactive) + (color-theme-install + '(color-theme-hober + ((foreground-color . "#c0c0c0") + (background-color . "black") + (mouse-color . "black") + (cursor-color . "medium turquoise") + (border-color . "black") + (background-mode . dark)) + (default ((t (nil)))) + (modeline ((t (:foreground "white" :background "darkslateblue")))) + (modeline-buffer-id ((t (:foreground "white" :background "darkslateblue")))) + (modeline-mousable ((t (:foreground "white" :background "darkslateblue")))) + (modeline-mousable-minor-mode ((t (:foreground "white" :background "darkslateblue")))) + (highlight ((t (:foreground "black" :background "#c0c0c0")))) + (bold ((t (:bold t)))) + (italic ((t (:italic t)))) + (bold-italic ((t (:bold t :italic t)))) + (region ((t (:foreground "white" :background "darkslateblue")))) + (zmacs-region ((t (:foreground "white" :background "darkslateblue")))) + (secondary-selection ((t (:background "paleturquoise")))) + (underline ((t (:underline t)))) + (diary-face ((t (:foreground "red")))) + (calendar-today-face ((t (:underline t)))) + (holiday-face ((t (:background "pink")))) + (widget-documentation-face ((t (:foreground "dark green" :background "white")))) + (widget-button-face ((t (:bold t)))) + (widget-button-pressed-face ((t (:foreground "red" :background "black")))) + (widget-field-face ((t (:background "gray85" :foreground "black")))) + (widget-single-line-field-face ((t (:background "gray85" :foreground "black")))) + (widget-inactive-face ((t (:foreground "dim gray" :background "red")))) + (fixed ((t (:bold t)))) + (excerpt ((t (:italic t)))) + (term-default-fg ((t (nil)))) + (term-default-bg ((t (nil)))) + (term-default-fg-inv ((t (nil)))) + (term-default-bg-inv ((t (nil)))) + (term-bold ((t (:bold t)))) + (term-underline ((t (:underline t)))) + (term-invisible ((t (nil)))) + (term-invisible-inv ((t (nil)))) + (term-white ((t (:foreground "#c0c0c0")))) + (term-whitebg ((t (:background "#c0c0c0")))) + (term-black ((t (:foreground "black")))) + (term-blackbg ((t (:background "black")))) + (term-red ((t (:foreground "#ef8171")))) + (term-redbg ((t (:background "#ef8171")))) + (term-green ((t (:foreground "#e5f779")))) + (term-greenbg ((t (:background "#e5f779")))) + (term-yellow ((t (:foreground "#fff796")))) + (term-yellowbg ((t (:background "#fff796")))) + (term-blue ((t (:foreground "#4186be")))) + (term-bluebg ((t (:background "#4186be")))) + (term-magenta ((t (:foreground "#ef9ebe")))) + (term-magentabg ((t (:background "#ef9ebe")))) + (term-cyan ((t (:foreground "#71bebe")))) + (term-cyanbg ((t (:background "#71bebe")))) + (font-lock-keyword-face ((t (:foreground "#00ffff")))) + (font-lock-comment-face ((t (:foreground "Red")))) + (font-lock-string-face ((t (:foreground "#ffff00")))) + (font-lock-constant-face ((t (:foreground "#00ff00")))) + (font-lock-builtin-face ((t (:foreground "#ffaa00")))) + (font-lock-type-face ((t (:foreground "Coral")))) + (font-lock-warning-face ((t (:foreground "Red" :bold t)))) + (font-lock-function-name-face ((t (:foreground "#4186be")))) + (font-lock-variable-name-face ((t (:foreground "white" :bold t)))) + (message-header-to-face ((t (:foreground "#4186be" :bold t)))) + (message-header-cc-face ((t (:foreground "#4186be")))) + (message-header-subject-face ((t (:foreground "#4186be" :bold t)))) + (message-header-newsgroups-face ((t (:foreground "Coral" :bold t)))) + (message-header-other-face ((t (:foreground "steel blue")))) + (message-header-name-face ((t (:foreground "white")))) + (message-header-xheader-face ((t (:foreground "blue")))) + (message-separator-face ((t (:foreground "brown")))) + (message-cited-text-face ((t (:foreground "white")))) + (gnus-header-from-face ((t (:foreground "Coral")))) + (gnus-header-subject-face ((t (:foreground "#4186be")))) + (gnus-header-newsgroups-face ((t (:foreground "#4186be" :italic t)))) + (gnus-header-name-face ((t (:foreground "white")))) + (gnus-header-content-face ((t (:foreground "#4186be" :italic t)))) + (gnus-cite-attribution-face ((t (:italic t)))) + (gnus-cite-face-list ((t (:bold nil :foreground "red")))) + (gnus-group-news-1-face ((t (:foreground "ForestGreen" :bold t)))) + (gnus-group-news-1-empty-face ((t (:foreground "ForestGreen")))) + (gnus-group-news-2-face ((t (:foreground "CadetBlue4" :bold t)))) + (gnus-group-news-2-empty-face ((t (:foreground "CadetBlue4")))) + (gnus-group-news-3-face ((t (:bold t)))) + (gnus-group-news-3-empty-face ((t (nil)))) + (gnus-group-news-low-face ((t (:foreground "DarkGreen" :bold t)))) + (gnus-group-news-low-empty-face ((t (:foreground "DarkGreen")))) + (gnus-group-mail-1-face ((t (:foreground "DeepPink3" :bold t)))) + (gnus-group-mail-1-empty-face ((t (:foreground "DeepPink3")))) + (gnus-group-mail-2-face ((t (:foreground "HotPink3" :bold t)))) + (gnus-group-mail-2-empty-face ((t (:foreground "HotPink3")))) + (gnus-group-mail-3-face ((t (:foreground "magenta4" :bold t)))) + (gnus-group-mail-3-empty-face ((t (:foreground "magenta4")))) + (gnus-group-mail-low-face ((t (:foreground "DeepPink4" :bold t)))) + (gnus-group-mail-low-empty-face ((t (:foreground "DeepPink4")))) + (gnus-summary-selected-face ((t (:underline t)))) + (gnus-summary-cancelled-face ((t (:foreground "yellow" :background "black")))) + (gnus-summary-high-ticked-face ((t (:foreground "firebrick" :bold t)))) + (gnus-summary-low-ticked-face ((t (:foreground "firebrick" :italic t)))) + (gnus-summary-normal-ticked-face ((t (:foreground "firebrick")))) + (gnus-summary-high-ancient-face ((t (:foreground "RoyalBlue" :bold t)))) + (gnus-summary-low-ancient-face ((t (:foreground "RoyalBlue" :italic t)))) + (gnus-summary-normal-ancient-face ((t (:foreground "RoyalBlue")))) + (gnus-summary-high-unread-face ((t (:bold t)))) + (gnus-summary-low-unread-face ((t (:italic t)))) + (gnus-summary-normal-unread-face ((t (nil)))) + (gnus-summary-high-read-face ((t (:foreground "DarkGreen" :bold t)))) + (gnus-summary-low-read-face ((t (:foreground "DarkGreen" :italic t)))) + (gnus-summary-normal-read-face ((t (:foreground "DarkGreen")))) + (gnus-splash-face ((t (:foreground "ForestGreen")))) + (gnus-emphasis-bold ((t (:bold t)))) + (gnus-emphasis-italic ((t (:italic t)))) + (gnus-emphasis-underline ((t (:underline t)))) + (gnus-emphasis-underline-bold ((t (:bold t :underline t)))) + (gnus-emphasis-underline-italic ((t (:italic t :underline t)))) + (gnus-emphasis-bold-italic ((t (:bold t :italic t)))) + (gnus-emphasis-underline-bold-italic ((t (:bold t :italic t :underline t)))) + (gnus-signature-face ((t (:foreground "white")))) + (gnus-cite-face-1 ((t (:foreground "Khaki")))) + (gnus-cite-face-2 ((t (:foreground "Coral")))) + (gnus-cite-face-3 ((t (:foreground "#4186be")))) + (gnus-cite-face-4 ((t (:foreground "yellow green")))) + (gnus-cite-face-5 ((t (:foreground "IndianRed")))) + (highlight-changes-face ((t (:foreground "red")))) + (highlight-changes-delete-face ((t (:foreground "red" :underline t)))) + (show-paren-match-face ((t (:foreground "white" :background "purple")))) + (show-paren-mismatch-face ((t (:foreground "white" :background "red")))) + (cperl-nonoverridable-face ((t (:foreground "chartreuse3")))) + (cperl-array-face ((t (:foreground "Blue" :bold t :background "lightyellow2")))) + (cperl-hash-face ((t (:foreground "Red" :bold t :italic t :background "lightyellow2")))) + (makefile-space-face ((t (:background "hotpink")))) + (sgml-start-tag-face ((t (:foreground "mediumspringgreen")))) + (sgml-ignored-face ((t (:foreground "gray20" :background "gray60")))) + (sgml-doctype-face ((t (:foreground "orange")))) + (sgml-sgml-face ((t (:foreground "yellow")))) + (sgml-end-tag-face ((t (:foreground "greenyellow")))) + (sgml-entity-face ((t (:foreground "gold")))) + (flyspell-incorrect-face ((t (:foreground "OrangeRed" :bold t :underline t)))) + (flyspell-duplicate-face ((t (:foreground "Gold3" :bold t :underline t))))))) + +(defun color-theme-bharadwaj () + "Color theme by Girish Bharadwaj, created 2001-03-28. +Black on gainsboro. Includes BBDB, custom, cperl, cvs, dired, ediff, +erc, eshell, font-latex, font-lock, gnus, info, message, paren, sgml, +shell, speedbar, term, vhdl, viper, widget, woman, xref. Wow!" + (interactive) + (color-theme-install + '(color-theme-bharadwaj + ((background-color . "gainsboro") + (background-mode . light) + (background-toolbar-color . "#cf3ccf3ccf3c") + (border-color . "black") + (bottom-toolbar-shadow-color . "#79e77df779e7") + (cursor-color . "grey15") + (foreground-color . "black") + (mouse-color . "grey15") + (top-toolbar-shadow-color . "#fffffbeeffff") + (viper-saved-cursor-color-in-replace-mode . "Red3")) + ((gnus-mouse-face . highlight) + (smiley-mouse-face . highlight)) + (default ((t (nil)))) + (bbdb-company ((t (nil)))) + (bbdb-field-name ((t (:bold t)))) + (bbdb-field-value ((t (nil)))) + (bbdb-name ((t (:underline t)))) + (blank-space-face ((t (nil)))) + (blank-tab-face ((t (nil)))) + (blue ((t (nil)))) + (bold ((t (:bold t)))) + (bold-italic ((t (:bold t)))) + (border-glyph ((t (nil)))) + (calendar-today-face ((t (:underline t)))) + (comint-input-face ((t (:foreground "deepskyblue")))) + (cperl-array-face ((t (:bold t :background "lightyellow2" :foreground "Blue")))) + (cperl-hash-face ((t (:bold t :background "lightyellow2" :foreground "Red")))) + (cperl-nonoverridable-face ((t (:foreground "chartreuse3")))) + (custom-button-face ((t (:bold t)))) + (custom-changed-face ((t (:background "blue" :foreground "white")))) + (custom-documentation-face ((t (nil)))) + (custom-face-tag-face ((t (:underline t)))) + (custom-group-tag-face ((t (:underline t :bold t :foreground "blue")))) + (custom-group-tag-face-1 ((t (:underline t :foreground "red")))) + (custom-invalid-face ((t (:background "red" :foreground "yellow")))) + (custom-modified-face ((t (:background "blue" :foreground "white")))) + (custom-rogue-face ((t (:background "black" :foreground "pink")))) + (custom-saved-face ((t (:underline t)))) + (custom-set-face ((t (:background "white" :foreground "blue")))) + (custom-state-face ((t (:foreground "dark green")))) + (custom-variable-button-face ((t (:underline t :bold t)))) + (custom-variable-tag-face ((t (:underline t :bold t :foreground "blue")))) + (cvs-filename-face ((t (:foreground "blue4")))) + (cvs-handled-face ((t (:foreground "pink")))) + (cvs-header-face ((t (:bold t :foreground "blue4")))) + (cvs-marked-face ((t (:bold t :foreground "green3")))) + (cvs-msg-face ((t (nil)))) + (cvs-need-action-face ((t (:foreground "orange")))) + (cvs-unknown-face ((t (:foreground "red")))) + (diary-face ((t (:bold t :foreground "red")))) + (dired-face-boring ((t (:foreground "Gray65")))) + (dired-face-directory ((t (:bold t :foreground "forestgreen")))) + (dired-face-executable ((t (:foreground "indianred")))) + (dired-face-flagged ((t (:background "SlateGray")))) + (dired-face-marked ((t (:background "darkblue" :foreground "deepskyblue")))) + (dired-face-permissions ((t (nil)))) + (dired-face-setuid ((t (:foreground "Red")))) + (dired-face-socket ((t (:foreground "magenta")))) + (dired-face-symlink ((t (:foreground "grey95")))) + (display-time-mail-balloon-enhance-face ((t (:background "orange")))) + (display-time-mail-balloon-gnus-group-face ((t (:foreground "blue")))) + (display-time-time-balloon-face ((t (:foreground "red")))) + (ediff-current-diff-face-A ((t (:background "pale green" :foreground "firebrick")))) + (ediff-current-diff-face-Ancestor ((t (:background "VioletRed" :foreground "Black")))) + (ediff-current-diff-face-B ((t (:background "Yellow" :foreground "DarkOrchid")))) + (ediff-current-diff-face-C ((t (:background "Pink" :foreground "Navy")))) + (ediff-even-diff-face-A ((t (:background "light grey" :foreground "Black")))) + (ediff-even-diff-face-Ancestor ((t (:background "Grey" :foreground "White")))) + (ediff-even-diff-face-B ((t (:background "Grey" :foreground "White")))) + (ediff-even-diff-face-C ((t (:background "light grey" :foreground "Black")))) + (ediff-fine-diff-face-A ((t (:background "sky blue" :foreground "Navy")))) + (ediff-fine-diff-face-Ancestor ((t (:background "Green" :foreground "Black")))) + (ediff-fine-diff-face-B ((t (:background "cyan" :foreground "Black")))) + (ediff-fine-diff-face-C ((t (:background "Turquoise" :foreground "Black")))) + (ediff-odd-diff-face-A ((t (:background "Grey" :foreground "White")))) + (ediff-odd-diff-face-Ancestor ((t (:background "light grey" :foreground "Black")))) + (ediff-odd-diff-face-B ((t (:background "light grey" :foreground "Black")))) + (ediff-odd-diff-face-C ((t (:background "Grey" :foreground "White")))) + (erc-action-face ((t (:bold t)))) + (erc-bold-face ((t (:bold t)))) + (erc-default-face ((t (nil)))) + (erc-direct-msg-face ((t (nil)))) + (erc-error-face ((t (:bold t)))) + (erc-input-face ((t (nil)))) + (erc-inverse-face ((t (nil)))) + (erc-notice-face ((t (nil)))) + (erc-pal-face ((t (nil)))) + (erc-prompt-face ((t (nil)))) + (erc-underline-face ((t (nil)))) + (eshell-ls-archive-face ((t (:bold t :foreground "Orchid")))) + (eshell-ls-backup-face ((t (:foreground "OrangeRed")))) + (eshell-ls-clutter-face ((t (:bold t :foreground "OrangeRed")))) + (eshell-ls-directory-face ((t (:bold t :foreground "Blue")))) + (eshell-ls-executable-face ((t (:bold t :foreground "ForestGreen")))) + (eshell-ls-missing-face ((t (:bold t :foreground "Red")))) + (eshell-ls-picture-face ((t (nil)))) + (eshell-ls-product-face ((t (:foreground "OrangeRed")))) + (eshell-ls-readonly-face ((t (:foreground "Brown")))) + (eshell-ls-special-face ((t (:bold t :foreground "Magenta")))) + (eshell-ls-symlink-face ((t (:bold t :foreground "DarkCyan")))) + (eshell-ls-unreadable-face ((t (:foreground "Grey30")))) + (eshell-prompt-face ((t (:bold t :foreground "Red")))) + (eshell-test-failed-face ((t (:bold t :foreground "OrangeRed")))) + (eshell-test-ok-face ((t (:bold t :foreground "Green")))) + (excerpt ((t (nil)))) + (ff-paths-non-existant-file-face ((t (:bold t :foreground "NavyBlue")))) + (fg:black ((t (:foreground "black")))) + (fixed ((t (:bold t)))) + (flyspell-duplicate-face ((t (:underline t :bold t :foreground "Gold3")))) + (flyspell-incorrect-face ((t (:underline t :bold t :foreground "OrangeRed")))) + (font-latex-bold-face ((t (nil)))) + (font-latex-italic-face ((t (nil)))) + (font-latex-math-face ((t (nil)))) + (font-latex-sedate-face ((t (nil)))) + (font-latex-string-face ((t (nil)))) + (font-latex-warning-face ((t (nil)))) + (font-lock-builtin-face ((t (:foreground "ForestGreen")))) + (font-lock-comment-face ((t (:foreground "grey55")))) + (font-lock-constant-face ((t (:foreground "OliveDrab")))) + (font-lock-doc-string-face ((t (:bold t :foreground "blue4")))) + (font-lock-exit-face ((t (nil)))) + (font-lock-function-name-face ((t (:italic t :bold t :foreground "SlateBlue")))) + (font-lock-keyword-face ((t (:foreground "DarkBlue")))) + (font-lock-preprocessor-face ((t (:foreground "blue3")))) + (font-lock-reference-face ((t (:foreground "red3")))) + (font-lock-string-face ((t (:foreground "DarkRed")))) + (font-lock-type-face ((t (:foreground "SteelBlue4")))) + (font-lock-variable-name-face ((t (:foreground "DarkGoldenrod")))) + (font-lock-warning-face ((t (:bold t :foreground "VioletRed")))) + (fringe ((t (:background "grey95")))) + (gnus-cite-attribution-face ((t (:bold t)))) + (gnus-cite-face-1 ((t (:foreground "MidnightBlue")))) + (gnus-cite-face-10 ((t (:foreground "medium purple")))) + (gnus-cite-face-11 ((t (:foreground "turquoise")))) + (gnus-cite-face-2 ((t (:foreground "firebrick")))) + (gnus-cite-face-3 ((t (:foreground "dark green")))) + (gnus-cite-face-4 ((t (:foreground "OrangeRed")))) + (gnus-cite-face-5 ((t (:foreground "dark khaki")))) + (gnus-cite-face-6 ((t (:foreground "dark violet")))) + (gnus-cite-face-7 ((t (:foreground "SteelBlue4")))) + (gnus-cite-face-8 ((t (:foreground "magenta")))) + (gnus-cite-face-9 ((t (:foreground "violet")))) + (gnus-emphasis-bold ((t (:bold t)))) + (gnus-emphasis-bold-italic ((t (:bold t)))) + (gnus-emphasis-highlight-words ((t (nil)))) + (gnus-emphasis-italic ((t (nil)))) + (gnus-emphasis-underline ((t (:underline t)))) + (gnus-emphasis-underline-bold ((t (:underline t :bold t)))) + (gnus-emphasis-underline-bold-italic ((t (:underline t :bold t)))) + (gnus-emphasis-underline-italic ((t (:underline t)))) + (gnus-filterhist-face-1 ((t (nil)))) + (gnus-group-mail-1-empty-face ((t (:foreground "DeepPink3")))) + (gnus-group-mail-1-face ((t (:bold t :foreground "DeepPink3")))) + (gnus-group-mail-2-empty-face ((t (:foreground "HotPink3")))) + (gnus-group-mail-2-face ((t (:bold t :foreground "HotPink3")))) + (gnus-group-mail-3-empty-face ((t (:foreground "magenta4")))) + (gnus-group-mail-3-face ((t (:bold t :foreground "magenta4")))) + (gnus-group-mail-low-empty-face ((t (:foreground "DeepPink4")))) + (gnus-group-mail-low-face ((t (:bold t :foreground "DeepPink4")))) + (gnus-group-news-1-empty-face ((t (:foreground "ForestGreen")))) + (gnus-group-news-1-face ((t (:bold t :foreground "ForestGreen")))) + (gnus-group-news-2-empty-face ((t (:foreground "CadetBlue4")))) + (gnus-group-news-2-face ((t (:bold t :foreground "CadetBlue4")))) + (gnus-group-news-3-empty-face ((t (nil)))) + (gnus-group-news-3-face ((t (:bold t)))) + (gnus-group-news-4-empty-face ((t (nil)))) + (gnus-group-news-4-face ((t (:bold t)))) + (gnus-group-news-5-empty-face ((t (nil)))) + (gnus-group-news-5-face ((t (:bold t)))) + (gnus-group-news-6-empty-face ((t (nil)))) + (gnus-group-news-6-face ((t (:bold t)))) + (gnus-group-news-low-empty-face ((t (:foreground "DarkGreen")))) + (gnus-group-news-low-face ((t (:bold t :foreground "DarkGreen")))) + (gnus-header-content-face ((t (:foreground "indianred4")))) + (gnus-header-from-face ((t (:bold t :foreground "red3")))) + (gnus-header-name-face ((t (:bold t :foreground "maroon")))) + (gnus-header-newsgroups-face ((t (:bold t :foreground "MidnightBlue")))) + (gnus-header-subject-face ((t (:bold t :foreground "red4")))) + (gnus-picons-face ((t (:background "white" :foreground "black")))) + (gnus-picons-xbm-face ((t (:background "white" :foreground "black")))) + (gnus-signature-face ((t (nil)))) + (gnus-splash ((t (nil)))) + (gnus-splash-face ((t (:foreground "ForestGreen")))) + (gnus-summary-cancelled-face ((t (:background "black" :foreground "yellow")))) + (gnus-summary-high-ancient-face ((t (:bold t :foreground "RoyalBlue")))) + (gnus-summary-high-read-face ((t (:bold t :foreground "DarkGreen")))) + (gnus-summary-high-ticked-face ((t (:bold t :foreground "firebrick")))) + (gnus-summary-high-unread-face ((t (:bold t)))) + (gnus-summary-low-ancient-face ((t (:foreground "RoyalBlue")))) + (gnus-summary-low-read-face ((t (:foreground "DarkGreen")))) + (gnus-summary-low-ticked-face ((t (:bold t :foreground "firebrick")))) + (gnus-summary-low-unread-face ((t (nil)))) + (gnus-summary-normal-ancient-face ((t (:foreground "RoyalBlue")))) + (gnus-summary-normal-read-face ((t (:foreground "DarkGreen")))) + (gnus-summary-normal-ticked-face ((t (:bold t :foreground "firebrick")))) + (gnus-summary-normal-unread-face ((t (:bold t)))) + (gnus-summary-selected-face ((t (:underline t)))) + (gnus-x-face ((t (:background "white" :foreground "black")))) + (green ((t (nil)))) + (gui-button-face ((t (:background "grey75")))) + (gui-element ((t (:background "Gray80")))) + (highlight ((t (:background "LightSkyBlue")))) + (highlight-changes-delete-face ((t (:underline t :foreground "red")))) + (highlight-changes-face ((t (:foreground "red")))) + (highline-face ((t (:background "grey95")))) + (holiday-face ((t (:background "pink")))) + (html-helper-italic-face ((t (nil)))) + (info-menu-5 ((t (:underline t)))) + (info-node ((t (:bold t)))) + (info-xref ((t (:bold t)))) + (isearch ((t (:background "yellow")))) + (isearch-secondary ((t (:foreground "red3")))) + (italic ((t (nil)))) + (lazy-highlight-face ((t (:bold t :foreground "dark magenta")))) + (left-margin ((t (nil)))) + (linemenu-face ((t (nil)))) + (list-mode-item-selected ((t (nil)))) + (makefile-space-face ((t (:background "hotpink")))) + (message-cited-text-face ((t (:foreground "red")))) + (message-header-cc-face ((t (:bold t :foreground "MidnightBlue")))) + (message-header-name-face ((t (:foreground "cornflower blue")))) + (message-header-newsgroups-face ((t (:bold t :foreground "blue4")))) + (message-header-other-face ((t (:foreground "steel blue")))) + (message-header-subject-face ((t (:bold t :foreground "navy blue")))) + (message-header-to-face ((t (:bold t :foreground "MidnightBlue")))) + (message-header-xheader-face ((t (:foreground "blue")))) + (message-mml-face ((t (:bold t)))) + (message-separator-face ((t (:foreground "brown")))) + (modeline ((t (:background "white" :foreground "black")))) + (modeline-buffer-id ((t (:background "white" :foreground "black")))) + (modeline-mousable ((t (:background "white" :foreground "black")))) + (modeline-mousable-minor-mode ((t (:background "white" :foreground "black")))) + (paren-blink-off ((t (:foreground "gray80")))) + (paren-face-match ((t (:background "turquoise")))) + (paren-face-mismatch ((t (:background "purple" :foreground "white")))) + (paren-face-no-match ((t (:background "yellow" :foreground "black")))) + (paren-match ((t (:background "darkseagreen2")))) + (paren-mismatch ((t (:background "DeepPink" :foreground "black")))) + (paren-mismatch-face ((t (:bold t)))) + (paren-no-match-face ((t (:bold t)))) + (pointer ((t (nil)))) + (primary-selection ((t (nil)))) + (red ((t (nil)))) + (region ((t (:background "grey80")))) + (right-margin ((t (nil)))) + (secondary-selection ((t (:background "grey55")))) + (sgml-comment-face ((t (:foreground "dark turquoise")))) + (sgml-doctype-face ((t (nil)))) + (sgml-end-tag-face ((t (nil)))) + (sgml-entity-face ((t (nil)))) + (sgml-ignored-face ((t (nil)))) + (sgml-ms-end-face ((t (:foreground "green")))) + (sgml-ms-start-face ((t (:foreground "green")))) + (sgml-pi-face ((t (:foreground "lime green")))) + (sgml-sgml-face ((t (nil)))) + (sgml-short-ref-face ((t (:foreground "deep sky blue")))) + (sgml-start-tag-face ((t (nil)))) + (shell-option-face ((t (:foreground "blue")))) + (shell-output-2-face ((t (:foreground "darkseagreen")))) + (shell-output-3-face ((t (:foreground "slategrey")))) + (shell-output-face ((t (:foreground "palegreen")))) + (shell-prompt-face ((t (:foreground "red")))) + (show-paren-match-face ((t (:background "grey80")))) + (show-paren-mismatch-face ((t (:bold t :background "purple" :foreground "white")))) + (speedbar-button-face ((t (:bold t :foreground "green4")))) + (speedbar-directory-face ((t (:bold t :foreground "blue4")))) + (speedbar-file-face ((t (:bold t :foreground "cyan4")))) + (speedbar-highlight-face ((t (:background "green")))) + (speedbar-selected-face ((t (:underline t :foreground "red")))) + (speedbar-tag-face ((t (:foreground "brown")))) + (swbuff-current-buffer-face ((t (:bold t)))) + (template-message-face ((t (:bold t)))) + (term-black ((t (:foreground "black")))) + (term-blackbg ((t (:background "black")))) + (term-blue ((t (:foreground "blue")))) + (term-bluebg ((t (:background "blue")))) + (term-bold ((t (:bold t)))) + (term-cyan ((t (:foreground "cyan")))) + (term-cyanbg ((t (:background "cyan")))) + (term-default-bg ((t (nil)))) + (term-default-bg-inv ((t (nil)))) + (term-default-fg ((t (nil)))) + (term-default-fg-inv ((t (nil)))) + (term-green ((t (:foreground "green")))) + (term-greenbg ((t (:background "green")))) + (term-invisible ((t (nil)))) + (term-invisible-inv ((t (nil)))) + (term-magenta ((t (:foreground "magenta")))) + (term-magentabg ((t (:background "magenta")))) + (term-red ((t (:foreground "red")))) + (term-redbg ((t (:background "red")))) + (term-underline ((t (:underline t)))) + (term-white ((t (:foreground "white")))) + (term-whitebg ((t (:background "white")))) + (term-yellow ((t (:foreground "yellow")))) + (term-yellowbg ((t (:background "yellow")))) + (text-cursor ((t (:background "grey15" :foreground "gainsboro")))) + (toolbar ((t (nil)))) + (underline ((t (:underline t)))) + (vc-annotate-face-0046FF ((t (nil)))) + (vcursor ((t (:underline t :background "cyan" :foreground "blue")))) + (vertical-divider ((t (nil)))) + (vhdl-font-lock-attribute-face ((t (:foreground "Orchid")))) + (vhdl-font-lock-directive-face ((t (:foreground "CadetBlue")))) + (vhdl-font-lock-enumvalue-face ((t (:foreground "Gold4")))) + (vhdl-font-lock-function-face ((t (:foreground "Orchid4")))) + (vhdl-font-lock-prompt-face ((t (:bold t :foreground "Red")))) + (vhdl-font-lock-reserved-words-face ((t (:bold t :foreground "Orange")))) + (vhdl-font-lock-translate-off-face ((t (:background "LightGray")))) + (vhdl-speedbar-architecture-face ((t (:foreground "Blue")))) + (vhdl-speedbar-architecture-selected-face ((t (:underline t :foreground "Blue")))) + (vhdl-speedbar-configuration-face ((t (:foreground "DarkGoldenrod")))) + (vhdl-speedbar-configuration-selected-face ((t (:underline t :foreground "DarkGoldenrod")))) + (vhdl-speedbar-entity-face ((t (:foreground "ForestGreen")))) + (vhdl-speedbar-entity-selected-face ((t (:underline t :foreground "ForestGreen")))) + (vhdl-speedbar-instantiation-face ((t (:foreground "Brown")))) + (vhdl-speedbar-instantiation-selected-face ((t (:underline t :foreground "Brown")))) + (vhdl-speedbar-package-face ((t (:foreground "Grey50")))) + (vhdl-speedbar-package-selected-face ((t (:underline t :foreground "Grey50")))) + (viper-minibuffer-emacs-face ((t (:background "darkseagreen2" :foreground "Black")))) + (viper-minibuffer-insert-face ((t (:background "pink" :foreground "Black")))) + (viper-minibuffer-vi-face ((t (:background "grey" :foreground "DarkGreen")))) + (viper-replace-overlay-face ((t (:background "darkseagreen2" :foreground "Black")))) + (viper-search-face ((t (:background "khaki" :foreground "Black")))) + (vvb-face ((t (:background "pink" :foreground "black")))) + (widget-button-face ((t (:bold t)))) + (widget-button-pressed-face ((t (:foreground "red")))) + (widget-documentation-face ((t (:foreground "dark green")))) + (widget-field-face ((t (:background "navy" :foreground "white")))) + (widget-inactive-face ((t (:foreground "dim gray")))) + (widget-single-line-field-face ((t (:background "royalblue" :foreground "white")))) + (woman-bold-face ((t (:bold t)))) + (woman-italic-face ((t (nil)))) + (woman-unknown-face ((t (nil)))) + (xref-keyword-face ((t (:foreground "blue")))) + (xref-list-pilot-face ((t (:foreground "navy")))) + (xref-list-symbol-face ((t (:foreground "navy")))) + (yellow ((t (nil)))) + (zmacs-region ((t (:background "royalblue"))))))) + +(defun color-theme-oswald () + "Color theme by Tom Oswald, created 2001-04-18. +Green on black, includes font-lock, show-paren, and ediff." + (interactive) + (color-theme-install + '(color-theme-oswald + ((background-color . "black") + (background-mode . dark) + (border-color . "black") + (cursor-color . "black") + (foreground-color . "green") + (mouse-color . "black")) + ((blank-space-face . blank-space-face) + (blank-tab-face . blank-tab-face) + (list-matching-lines-face . bold) + (view-highlight-face . highlight)) + (default ((t (nil)))) + (blank-space-face ((t (:background "LightGray")))) + (blank-tab-face ((t (:background "green" :foreground "black")))) + (bold ((t (:bold t)))) + (bold-italic ((t (:italic t :bold t)))) + (ediff-current-diff-face-A ((t (:background "pale green" :foreground "firebrick")))) + (ediff-current-diff-face-Ancestor ((t (:background "VioletRed" :foreground "Black")))) + (ediff-current-diff-face-B ((t (:background "Yellow" :foreground "DarkOrchid")))) + (ediff-current-diff-face-C ((t (:background "Pink" :foreground "Navy")))) + (ediff-even-diff-face-A ((t (:background "light grey" :foreground "Black")))) + (ediff-even-diff-face-Ancestor ((t (:background "Grey" :foreground "White")))) + (ediff-even-diff-face-B ((t (:background "Grey" :foreground "White")))) + (ediff-even-diff-face-C ((t (:background "light grey" :foreground "Black")))) + (ediff-fine-diff-face-A ((t (:background "sky blue" :foreground "Navy")))) + (ediff-fine-diff-face-Ancestor ((t (:background "Green" :foreground "Black")))) + (ediff-fine-diff-face-B ((t (:background "cyan" :foreground "Black")))) + (ediff-fine-diff-face-C ((t (:background "Turquoise" :foreground "Black")))) + (ediff-odd-diff-face-A ((t (:background "Grey" :foreground "White")))) + (ediff-odd-diff-face-Ancestor ((t (:background "light grey" :foreground "Black")))) + (ediff-odd-diff-face-B ((t (:background "light grey" :foreground "Black")))) + (ediff-odd-diff-face-C ((t (:background "Grey" :foreground "White")))) + (font-lock-builtin-face ((t (:italic t :bold t :foreground "LightSteelBlue")))) + (font-lock-comment-face ((t (:italic t :foreground "LightGoldenrod4")))) + (font-lock-constant-face ((t (:italic t :foreground "HotPink")))) + (font-lock-doc-string-face ((t (:italic t :foreground "orange")))) + (font-lock-function-name-face ((t (:italic t :bold t :foreground "red")))) + (font-lock-keyword-face ((t (:foreground "red")))) + (font-lock-preprocessor-face ((t (:italic t :foreground "HotPink")))) + (font-lock-string-face ((t (:italic t :foreground "orange")))) + (font-lock-reference-face ((t (:italic t :bold t :foreground "LightSteelBlue")))) + (font-lock-type-face ((t (:italic t :foreground "LightSlateBlue")))) + (font-lock-variable-name-face ((t (:underline t :foreground "LightGoldenrod")))) + (font-lock-warning-face ((t (:bold t :foreground "Pink")))) + (highlight ((t (:background "yellow" :foreground "red")))) + (isearch ((t (:background "dim gray" :foreground "aquamarine")))) + (ispell-face ((t (:bold t :background "#3454b4" :foreground "yellow")))) + (italic ((t (:italic t)))) + (modeline ((t (:background "green" :foreground "black")))) + (modeline-buffer-id ((t (:background "green" :foreground "black")))) + (modeline-mousable ((t (:background "green" :foreground "black")))) + (modeline-mousable-minor-mode ((t (:background "green" :foreground "black")))) + (region ((t (:background "dim gray" :foreground "aquamarine")))) + (secondary-selection ((t (:background "darkslateblue" :foreground "light goldenrod")))) + (show-paren-match-face ((t (:background "turquoise" :foreground "black")))) + (show-paren-mismatch-face ((t (:background "purple" :foreground "white")))) + (underline ((t (:underline t)))) + (zmacs-region ((t (:background "dim gray" :foreground "aquamarine"))))))) + +(defun color-theme-salmon-diff () + "Salmon and aquamarine faces for diff and change-log modes. +This is intended for other color themes to use (eg. `color-theme-gnome2')." + (color-theme-install + '(color-theme-salmon-diff + nil + (change-log-acknowledgement-face ((t (:foreground "LightBlue")))) + (change-log-conditionals-face ((t (:bold t :weight bold :foreground "Aquamarine")))) + (change-log-date-face ((t (:foreground "LightSalmon")))) + (change-log-email-face ((t (:bold t :weight bold :foreground "Aquamarine")))) + (change-log-file-face ((t (:bold t :weight bold :foreground "Aquamarine")))) + (change-log-function-face ((t (:bold t :weight bold :foreground "Aquamarine")))) + (change-log-list-face ((t (:foreground "Salmon")))) + (change-log-name-face ((t (:foreground "Aquamarine")))) + (diff-added-face ((t (nil)))) + (diff-changed-face ((t (nil)))) + (diff-context-face ((t (:foreground "grey70")))) + (diff-file-header-face ((t (:bold t)))) + (diff-function-face ((t (:foreground "grey70")))) + (diff-header-face ((t (:foreground "light salmon")))) + (diff-hunk-header-face ((t (:foreground "light salmon")))) + (diff-index-face ((t (:bold t)))) + (diff-nonexistent-face ((t (:bold t)))) + (diff-removed-face ((t (nil)))) + (log-view-message-face ((t (:foreground "light salmon"))))))) + +(defun color-theme-robin-hood () + "`color-theme-gnome2' with navajo white on green. +This theme tries to avoid underlined and italic faces, because +the fonts either look ugly, or do not exist. The author himself +uses neep, for example." + (interactive) + (color-theme-gnome2) + (let ((color-theme-is-cumulative t)) + (color-theme-install + '(color-theme-robin-hood + ((foreground-color . "navajo white") + (background-color . "#304020")) + ((CUA-mode-read-only-cursor-color . "white") + (help-highlight-face . info-xref) + (list-matching-lines-buffer-name-face . bold)) + (default ((t (nil)))) + (button ((t (:bold t)))) + (calendar-today-face ((t (:foreground "lemon chiffon")))) + (custom-button-face ((t (:bold t :foreground "DodgerBlue1")))) + (diary-face ((t (:bold t :foreground "yellow")))) + (fringe ((t (:background "#003700")))) + (header-line ((t (:background "#030" :foreground "#AA7")))) + (holiday-face ((t (:bold t :foreground "peru")))) + (ido-subdir-face ((t (:foreground "MediumSlateBlue")))) + (isearch ((t (:foreground "pink" :background "red")))) + (isearch-lazy-highlight-face ((t (:foreground "red")))) + (menu ((t (:background "#304020" :foreground "navajo white")))) + (minibuffer-prompt ((t (:foreground "pale green")))) + (modeline ((t (:background "dark olive green" :foreground "wheat" :box (:line-width 1 :style released-button))))) + (mode-line-inactive ((t (:background "dark olive green" :foreground "khaki" :box (:line-width 1 :style released-button))))) + (semantic-dirty-token-face ((t (:background "grey22")))) + (tool-bar ((t (:background "#304020" :foreground "wheat" :box (:line-width 1 :style released-button))))) + (tooltip ((t (:background "lemon chiffon" :foreground "black")))))))) + +(defun color-theme-snowish () + "Color theme by Girish Bharadwaj, created 2001-05-17. +Dark slate gray on snow2, lots of blue colors. +Includes custom, eshell, font-lock, gnus, html-helper, +hyper-apropos, jde, message, paren, semantic, speedbar, +term, widget." + (interactive) + (color-theme-install + '(color-theme-snowish + ((background-color . "snow2") + (background-mode . light) + (cursor-color . "Red3") + (foreground-color . "darkslategray")) + ((buffers-tab-face . buffers-tab) + (gnus-mouse-face . highlight) + (sgml-set-face . t) + (smiley-mouse-face . highlight)) + (default ((t (nil)))) + (blue ((t (:foreground "blue")))) + (bold ((t (:bold t :foreground "peru")))) + (bold-italic ((t (:italic t :bold t)))) + (border-glyph ((t (nil)))) + (buffers-tab ((t (:background "snow2" :foreground "darkslategray")))) + (custom-button-face ((t (:bold t)))) + (custom-changed-face ((t (:background "blue" :foreground "white")))) + (custom-comment-face ((t (:background "gray85")))) + (custom-comment-tag-face ((t (:foreground "blue4")))) + (custom-documentation-face ((t (nil)))) + (custom-face-tag-face ((t (:underline t)))) + (custom-group-tag-face ((t (:underline t :foreground "blue")))) + (custom-group-tag-face-1 ((t (:underline t :foreground "red")))) + (custom-invalid-face ((t (:background "red" :foreground "yellow")))) + (custom-modified-face ((t (:background "blue" :foreground "white")))) + (custom-rogue-face ((t (:background "black" :foreground "pink")))) + (custom-saved-face ((t (:underline t)))) + (custom-set-face ((t (:background "white" :foreground "blue")))) + (custom-state-face ((t (:foreground "dark green")))) + (custom-variable-button-face ((t (:underline t :bold t)))) + (custom-variable-tag-face ((t (:underline t :foreground "blue")))) + (cyan ((t (:foreground "cyan")))) + (display-time-mail-balloon-enhance-face ((t (:background "orange")))) + (display-time-mail-balloon-gnus-group-face ((t (:foreground "blue")))) + (display-time-time-balloon-face ((t (:foreground "red")))) + (eshell-ls-archive-face ((t (:bold t :foreground "Orchid")))) + (eshell-ls-backup-face ((t (:foreground "OrangeRed")))) + (eshell-ls-clutter-face ((t (:bold t :foreground "OrangeRed")))) + (eshell-ls-directory-face ((t (:bold t :foreground "Blue")))) + (eshell-ls-executable-face ((t (:bold t :foreground "ForestGreen")))) + (eshell-ls-missing-face ((t (:bold t :foreground "Red")))) + (eshell-ls-product-face ((t (:foreground "OrangeRed")))) + (eshell-ls-readonly-face ((t (:foreground "Brown")))) + (eshell-ls-special-face ((t (:bold t :foreground "Magenta")))) + (eshell-ls-symlink-face ((t (:bold t :foreground "Dark Cyan")))) + (eshell-ls-unreadable-face ((t (:foreground "Grey30")))) + (eshell-prompt-face ((t (:bold t :foreground "Red")))) + (font-lock-builtin-face ((t (:underline t :foreground "blue")))) + (font-lock-comment-face ((t (:foreground "snow4")))) + (font-lock-constant-face ((t (:foreground "CadetBlue")))) + (font-lock-doc-string-face ((t (:foreground "mediumblue")))) + (font-lock-function-name-face ((t (:bold t :foreground "darkblue")))) + (font-lock-keyword-face ((t (:bold t :foreground "dodgerblue")))) + (font-lock-preprocessor-face ((t (:underline t :foreground "blue3")))) + (font-lock-reference-face ((t (:foreground "red3")))) + (font-lock-string-face ((t (:foreground "darkviolet")))) + (font-lock-type-face ((t (:foreground "goldenrod")))) + (font-lock-variable-name-face ((t (:foreground "tomato")))) + (font-lock-warning-face ((t (:bold t :foreground "Red")))) + (gnus-cite-attribution-face ((t (nil)))) + (gnus-cite-face-1 ((t (:foreground "MidnightBlue")))) + (gnus-cite-face-10 ((t (:foreground "medium purple")))) + (gnus-cite-face-11 ((t (:foreground "turquoise")))) + (gnus-cite-face-2 ((t (:foreground "firebrick")))) + (gnus-cite-face-3 ((t (:foreground "dark green")))) + (gnus-cite-face-4 ((t (:foreground "OrangeRed")))) + (gnus-cite-face-5 ((t (:foreground "dark khaki")))) + (gnus-cite-face-6 ((t (:foreground "dark violet")))) + (gnus-cite-face-7 ((t (:foreground "SteelBlue4")))) + (gnus-cite-face-8 ((t (:foreground "magenta")))) + (gnus-cite-face-9 ((t (:foreground "violet")))) + (gnus-emphasis-bold ((t (:bold t)))) + (gnus-emphasis-bold-italic ((t (nil)))) + (gnus-emphasis-highlight-words ((t (:background "black" :foreground "yellow")))) + (gnus-emphasis-italic ((t (nil)))) + (gnus-emphasis-underline ((t (:underline t)))) + (gnus-emphasis-underline-bold ((t (:underline t :bold t)))) + (gnus-emphasis-underline-bold-italic ((t (:underline t)))) + (gnus-emphasis-underline-italic ((t (:underline t)))) + (gnus-group-mail-1-empty-face ((t (:foreground "DeepPink3")))) + (gnus-group-mail-1-face ((t (:bold t :foreground "DeepPink3")))) + (gnus-group-mail-2-empty-face ((t (:foreground "HotPink3")))) + (gnus-group-mail-2-face ((t (:bold t :foreground "HotPink3")))) + (gnus-group-mail-3-empty-face ((t (:foreground "magenta4")))) + (gnus-group-mail-3-face ((t (:bold t :foreground "magenta4")))) + (gnus-group-mail-low-empty-face ((t (:foreground "DeepPink4")))) + (gnus-group-mail-low-face ((t (:bold t :foreground "DeepPink4")))) + (gnus-group-news-1-empty-face ((t (:foreground "ForestGreen")))) + (gnus-group-news-1-face ((t (:bold t :foreground "ForestGreen")))) + (gnus-group-news-2-empty-face ((t (:foreground "CadetBlue4")))) + (gnus-group-news-2-face ((t (:bold t :foreground "CadetBlue4")))) + (gnus-group-news-3-empty-face ((t (nil)))) + (gnus-group-news-3-face ((t (:bold t)))) + (gnus-group-news-4-empty-face ((t (nil)))) + (gnus-group-news-4-face ((t (:bold t)))) + (gnus-group-news-5-empty-face ((t (nil)))) + (gnus-group-news-5-face ((t (:bold t)))) + (gnus-group-news-6-empty-face ((t (nil)))) + (gnus-group-news-6-face ((t (:bold t)))) + (gnus-group-news-low-empty-face ((t (:foreground "DarkGreen")))) + (gnus-group-news-low-face ((t (:bold t :foreground "DarkGreen")))) + (gnus-header-content-face ((t (:foreground "indianred4")))) + (gnus-header-from-face ((t (:foreground "red3")))) + (gnus-header-name-face ((t (:foreground "maroon")))) + (gnus-header-newsgroups-face ((t (:foreground "MidnightBlue")))) + (gnus-header-subject-face ((t (:foreground "red4")))) + (gnus-picons-face ((t (:background "white" :foreground "black")))) + (gnus-picons-xbm-face ((t (:background "white" :foreground "black")))) + (gnus-signature-face ((t (nil)))) + (gnus-splash-face ((t (:foreground "Brown")))) + (gnus-summary-cancelled-face ((t (:background "black" :foreground "yellow")))) + (gnus-summary-high-ancient-face ((t (:bold t :foreground "RoyalBlue")))) + (gnus-summary-high-read-face ((t (:bold t :foreground "DarkGreen")))) + (gnus-summary-high-ticked-face ((t (:bold t :foreground "firebrick")))) + (gnus-summary-high-unread-face ((t (:bold t)))) + (gnus-summary-low-ancient-face ((t (:foreground "RoyalBlue")))) + (gnus-summary-low-read-face ((t (:foreground "DarkGreen")))) + (gnus-summary-low-ticked-face ((t (:foreground "firebrick")))) + (gnus-summary-low-unread-face ((t (nil)))) + (gnus-summary-normal-ancient-face ((t (:foreground "RoyalBlue")))) + (gnus-summary-normal-read-face ((t (:foreground "DarkGreen")))) + (gnus-summary-normal-ticked-face ((t (:foreground "firebrick")))) + (gnus-summary-normal-unread-face ((t (nil)))) + (gnus-summary-selected-face ((t (:underline t)))) + (gnus-x-face ((t (:background "white" :foreground "black")))) + (green ((t (:foreground "green")))) + (gui-button-face ((t (:background "grey75" :foreground "black")))) + (gui-element ((t (:background "#D4D0C8" :foreground "black")))) + (highlight ((t (:background "darkseagreen2")))) + (html-helper-bold-face ((t (:bold t)))) + (html-helper-bold-italic-face ((t (nil)))) + (html-helper-builtin-face ((t (:underline t :foreground "blue3")))) + (html-helper-italic-face ((t (:foreground "medium sea green")))) + (html-helper-underline-face ((t (:underline t)))) + (html-tag-face ((t (:bold t)))) + (hyper-apropos-documentation ((t (:foreground "darkred")))) + (hyper-apropos-heading ((t (:bold t)))) + (hyper-apropos-hyperlink ((t (:foreground "blue4")))) + (hyper-apropos-major-heading ((t (:bold t)))) + (hyper-apropos-section-heading ((t (nil)))) + (hyper-apropos-warning ((t (:bold t :foreground "red")))) + (info-menu-6 ((t (nil)))) + (isearch ((t (:background "paleturquoise")))) + (isearch-secondary ((t (:foreground "red3")))) + (italic ((t (nil)))) + (jde-bug-breakpoint-cursor ((t (:background "brown" :foreground "cyan")))) + (jde-bug-breakpoint-marker ((t (:background "yellow" :foreground "red")))) + (jde-java-font-lock-link-face ((t (:underline t :foreground "blue")))) + (jde-java-font-lock-number-face ((t (:foreground "RosyBrown")))) + (left-margin ((t (nil)))) + (list-mode-item-selected ((t (:background "gray68" :foreground "darkslategray")))) + (magenta ((t (:foreground "magenta")))) + (message-cited-text-face ((t (:foreground "red")))) + (message-header-cc-face ((t (:foreground "MidnightBlue")))) + (message-header-name-face ((t (:foreground "cornflower blue")))) + (message-header-newsgroups-face ((t (:foreground "blue4")))) + (message-header-other-face ((t (:foreground "steel blue")))) + (message-header-subject-face ((t (:bold t :foreground "navy blue")))) + (message-header-to-face ((t (:bold t :foreground "MidnightBlue")))) + (message-header-xheader-face ((t (:foreground "blue")))) + (message-mml-face ((t (:foreground "ForestGreen")))) + (message-separator-face ((t (:foreground "brown")))) + (modeline ((t (nil)))) + (modeline-buffer-id ((t (:background "#D4D0C8" :foreground "blue4")))) + (modeline-mousable ((t (:background "#D4D0C8" :foreground "firebrick")))) + (modeline-mousable-minor-mode ((t (:background "#D4D0C8" :foreground "green4")))) + (paren-blink-off ((t (:foreground "snow2")))) + (paren-match ((t (:background "darkseagreen2")))) + (paren-mismatch ((t (:background "snow2" :foreground "darkslategray")))) + (pointer ((t (nil)))) + (primary-selection ((t (:background "gray65")))) + (red ((t (:foreground "red")))) + (right-margin ((t (nil)))) + (secondary-selection ((t (:background "paleturquoise")))) + (semantic-intangible-face ((t (:foreground "gray25")))) + (semantic-read-only-face ((t (:background "gray25")))) + (senator-momentary-highlight-face ((t (:background "gray70")))) + (speedbar-button-face ((t (:foreground "green4")))) + (speedbar-directory-face ((t (:foreground "blue4")))) + (speedbar-file-face ((t (:foreground "cyan4")))) + (speedbar-highlight-face ((t (:background "green")))) + (speedbar-selected-face ((t (:underline t :foreground "red")))) + (speedbar-tag-face ((t (:foreground "brown")))) + (template-message-face ((t (:bold t)))) + (term-blue-bold-face ((t (:bold t :background "snow2" :foreground "blue")))) + (term-blue-face ((t (:foreground "blue")))) + (term-blue-inv-face ((t (:background "blue")))) + (term-blue-ul-face ((t (:underline t :background "snow2" :foreground "blue")))) + (term-cyan-bold-face ((t (:bold t :background "snow2" :foreground "cyan")))) + (term-cyan-face ((t (:foreground "cyan")))) + (term-cyan-inv-face ((t (:background "cyan")))) + (term-cyan-ul-face ((t (:underline t :background "snow2" :foreground "cyan")))) + (term-default-bold-face ((t (:bold t :background "snow2" :foreground "darkslategray")))) + (term-default-face ((t (:background "snow2" :foreground "darkslategray")))) + (term-default-inv-face ((t (:background "darkslategray" :foreground "snow2")))) + (term-default-ul-face ((t (:underline t :background "snow2" :foreground "darkslategray")))) + (term-green-bold-face ((t (:bold t :background "snow2" :foreground "green")))) + (term-green-face ((t (:foreground "green")))) + (term-green-inv-face ((t (:background "green")))) + (term-green-ul-face ((t (:underline t :background "snow2" :foreground "green")))) + (term-magenta-bold-face ((t (:bold t :background "snow2" :foreground "magenta")))) + (term-magenta-face ((t (:foreground "magenta")))) + (term-magenta-inv-face ((t (:background "magenta")))) + (term-magenta-ul-face ((t (:underline t :background "snow2" :foreground "magenta")))) + (term-red-bold-face ((t (:bold t :background "snow2" :foreground "red")))) + (term-red-face ((t (:foreground "red")))) + (term-red-inv-face ((t (:background "red")))) + (term-red-ul-face ((t (:underline t :background "snow2" :foreground "red")))) + (term-white-bold-face ((t (:bold t :background "snow2" :foreground "white")))) + (term-white-face ((t (:foreground "white")))) + (term-white-inv-face ((t (:background "snow2")))) + (term-white-ul-face ((t (:underline t :background "snow2" :foreground "white")))) + (term-yellow-bold-face ((t (:bold t :background "snow2" :foreground "yellow")))) + (term-yellow-face ((t (:foreground "yellow")))) + (term-yellow-inv-face ((t (:background "yellow")))) + (term-yellow-ul-face ((t (:underline t :background "snow2" :foreground "yellow")))) + (text-cursor ((t (:background "Red3" :foreground "snow2")))) + (toolbar ((t (nil)))) + (underline ((t (:underline t)))) + (vertical-divider ((t (nil)))) + (white ((t (:foreground "white")))) + (widget ((t (nil)))) + (widget-button-face ((t (:bold t)))) + (widget-button-pressed-face ((t (:foreground "red")))) + (widget-documentation-face ((t (:foreground "dark green")))) + (widget-field-face ((t (:background "gray85")))) + (widget-inactive-face ((t (:foreground "dim gray")))) + (yellow ((t (:foreground "yellow")))) + (zmacs-region ((t (:background "gray65"))))))) + +(defun color-theme-dark-laptop () + "Color theme by Laurent Michel, created 2001-05-24. +Includes custom, fl, font-lock, gnus, message, widget." + (interactive) + (color-theme-install + '(color-theme-dark-laptop + ((background-color . "black") + (background-mode . dark) + (border-color . "black") + (cursor-color . "yellow") + (foreground-color . "white") + (mouse-color . "sienna1")) + ((gnus-mouse-face . highlight) + (list-matching-lines-face . bold) + (view-highlight-face . highlight)) + (default ((t (nil)))) + (bold ((t (:bold t)))) + (bold-italic ((t (:italic t :bold t)))) + (custom-button-face ((t (nil)))) + (custom-changed-face ((t (:background "blue" :foreground "white")))) + (custom-documentation-face ((t (nil)))) + (custom-face-tag-face ((t (:underline t)))) + (custom-group-tag-face ((t (:underline t :foreground "light blue")))) + (custom-group-tag-face-1 ((t (:underline t :foreground "pink")))) + (custom-invalid-face ((t (:background "red" :foreground "yellow")))) + (custom-modified-face ((t (:background "blue" :foreground "white")))) + (custom-rogue-face ((t (:background "black" :foreground "pink")))) + (custom-saved-face ((t (:underline t)))) + (custom-set-face ((t (:background "white" :foreground "blue")))) + (custom-state-face ((t (:foreground "lime green")))) + (custom-variable-button-face ((t (:underline t :bold t)))) + (custom-variable-tag-face ((t (:underline t :foreground "light blue")))) + (fl-comment-face ((t (:foreground "pink")))) + (fl-doc-string-face ((t (:foreground "purple")))) + (fl-function-name-face ((t (:foreground "red")))) + (fl-keyword-face ((t (:foreground "cyan")))) + (fl-string-face ((t (:foreground "green")))) + (fl-type-face ((t (:foreground "yellow")))) + (font-lock-builtin-face ((t (:foreground "LightSteelBlue")))) + (font-lock-comment-face ((t (:foreground "OrangeRed")))) + (font-lock-constant-face ((t (:foreground "Aquamarine")))) + (font-lock-doc-string-face ((t (:foreground "LightSalmon")))) + (font-lock-function-name-face ((t (:foreground "LightSkyBlue")))) + (font-lock-keyword-face ((t (:foreground "Cyan")))) + (font-lock-preprocessor-face ((t (:foreground "Aquamarine")))) + (font-lock-reference-face ((t (:foreground "LightSteelBlue")))) + (font-lock-string-face ((t (:foreground "LightSalmon")))) + (font-lock-type-face ((t (:foreground "PaleGreen")))) + (font-lock-variable-name-face ((t (:foreground "LightGoldenrod")))) + (font-lock-warning-face ((t (:bold t :foreground "Pink")))) + (gnus-cite-attribution-face ((t (:italic t)))) + (gnus-cite-face-1 ((t (:bold t :foreground "deep sky blue")))) + (gnus-cite-face-10 ((t (:foreground "medium purple")))) + (gnus-cite-face-11 ((t (:foreground "turquoise")))) + (gnus-cite-face-2 ((t (:bold t :foreground "cyan")))) + (gnus-cite-face-3 ((t (:bold t :foreground "gold")))) + (gnus-cite-face-4 ((t (:foreground "light pink")))) + (gnus-cite-face-5 ((t (:foreground "pale green")))) + (gnus-cite-face-6 ((t (:bold t :foreground "chocolate")))) + (gnus-cite-face-7 ((t (:foreground "orange")))) + (gnus-cite-face-8 ((t (:foreground "magenta")))) + (gnus-cite-face-9 ((t (:foreground "violet")))) + (gnus-emphasis-bold ((t (:bold t)))) + (gnus-emphasis-bold-italic ((t (:italic t :bold t)))) + (gnus-emphasis-highlight-words ((t (:background "black" :foreground "yellow")))) + (gnus-emphasis-italic ((t (:italic t)))) + (gnus-emphasis-underline ((t (:underline t)))) + (gnus-emphasis-underline-bold ((t (:underline t :bold t)))) + (gnus-emphasis-underline-bold-italic ((t (:underline t :italic t :bold t)))) + (gnus-emphasis-underline-italic ((t (:underline t :italic t)))) + (gnus-group-mail-1-empty-face ((t (:foreground "aquamarine1")))) + (gnus-group-mail-1-face ((t (:bold t :foreground "aquamarine1")))) + (gnus-group-mail-2-empty-face ((t (:foreground "aquamarine2")))) + (gnus-group-mail-2-face ((t (:bold t :foreground "aquamarine2")))) + (gnus-group-mail-3-empty-face ((t (:foreground "aquamarine3")))) + (gnus-group-mail-3-face ((t (:bold t :foreground "aquamarine3")))) + (gnus-group-mail-low-empty-face ((t (:foreground "aquamarine4")))) + (gnus-group-mail-low-face ((t (:bold t :foreground "aquamarine4")))) + (gnus-group-news-1-empty-face ((t (:foreground "PaleTurquoise")))) + (gnus-group-news-1-face ((t (:bold t :foreground "PaleTurquoise")))) + (gnus-group-news-2-empty-face ((t (:foreground "turquoise")))) + (gnus-group-news-2-face ((t (:bold t :foreground "turquoise")))) + (gnus-group-news-3-empty-face ((t (nil)))) + (gnus-group-news-3-face ((t (:bold t)))) + (gnus-group-news-4-empty-face ((t (nil)))) + (gnus-group-news-4-face ((t (:bold t)))) + (gnus-group-news-5-empty-face ((t (nil)))) + (gnus-group-news-5-face ((t (:bold t)))) + (gnus-group-news-6-empty-face ((t (nil)))) + (gnus-group-news-6-face ((t (:bold t)))) + (gnus-group-news-low-empty-face ((t (:foreground "DarkTurquoise")))) + (gnus-group-news-low-face ((t (:bold t :foreground "DarkTurquoise")))) + (gnus-header-content-face ((t (:italic t :foreground "forest green")))) + (gnus-header-from-face ((t (:bold t :foreground "spring green")))) + (gnus-header-name-face ((t (:foreground "deep sky blue")))) + (gnus-header-newsgroups-face ((t (:italic t :bold t :foreground "purple")))) + (gnus-header-subject-face ((t (:bold t :foreground "orange")))) + (gnus-signature-face ((t (:bold t :foreground "khaki")))) + (gnus-splash-face ((t (:foreground "Brown")))) + (gnus-summary-cancelled-face ((t (:background "black" :foreground "yellow")))) + (gnus-summary-high-ancient-face ((t (:bold t :foreground "SkyBlue")))) + (gnus-summary-high-read-face ((t (:bold t :foreground "PaleGreen")))) + (gnus-summary-high-ticked-face ((t (:bold t :foreground "pink")))) + (gnus-summary-high-unread-face ((t (:bold t)))) + (gnus-summary-low-ancient-face ((t (:italic t :foreground "SkyBlue")))) + (gnus-summary-low-read-face ((t (:italic t :foreground "PaleGreen")))) + (gnus-summary-low-ticked-face ((t (:italic t :foreground "pink")))) + (gnus-summary-low-unread-face ((t (:italic t)))) + (gnus-summary-normal-ancient-face ((t (:foreground "SkyBlue")))) + (gnus-summary-normal-read-face ((t (:foreground "PaleGreen")))) + (gnus-summary-normal-ticked-face ((t (:foreground "pink")))) + (gnus-summary-normal-unread-face ((t (nil)))) + (gnus-summary-selected-face ((t (:underline t)))) + (highlight ((t (:background "darkolivegreen")))) + (italic ((t (:italic t)))) + (message-cited-text-face ((t (:bold t :foreground "red")))) + (message-header-cc-face ((t (:bold t :foreground "green4")))) + (message-header-name-face ((t (:bold t :foreground "orange")))) + (message-header-newsgroups-face ((t (:bold t :foreground "violet")))) + (message-header-other-face ((t (:bold t :foreground "chocolate")))) + (message-header-subject-face ((t (:bold t :foreground "yellow")))) + (message-header-to-face ((t (:bold t :foreground "cyan")))) + (message-header-xheader-face ((t (:bold t :foreground "light blue")))) + (message-mml-face ((t (:bold t :background "Green3")))) + (message-separator-face ((t (:foreground "blue3")))) + (modeline ((t (:background "white" :foreground "black")))) + (modeline-buffer-id ((t (:background "white" :foreground "black")))) + (modeline-mousable ((t (:background "white" :foreground "black")))) + (modeline-mousable-minor-mode ((t (:background "white" :foreground "black")))) + (region ((t (:background "blue")))) + (primary-selection ((t (:background "blue")))) + (isearch ((t (:background "blue")))) + (zmacs-region ((t (:background "blue")))) + (secondary-selection ((t (:background "darkslateblue")))) + (underline ((t (:underline t)))) + (widget-button-face ((t (:bold t)))) + (widget-button-pressed-face ((t (:foreground "red")))) + (widget-documentation-face ((t (:foreground "lime green")))) + (widget-field-face ((t (:background "dim gray")))) + (widget-inactive-face ((t (:foreground "light gray")))) + (widget-single-line-field-face ((t (:background "dim gray"))))))) + +(defun color-theme-taming-mr-arneson () + "Color theme by Erik Arneson, created 2001-06-12. +Light sky blue on black. Includes bbdb, cperl, custom, cvs, diff, +dired, font-lock, html-helper, hyper-apropos, info, isearch, man, +message, paren, shell, and widget." + (interactive) + (color-theme-install + '(color-theme-taming-mr-arneson + ((background-color . "black") + (background-mode . light) + (background-toolbar-color . "#cf3ccf3ccf3c") + (border-color . "#000000000000") + (bottom-toolbar-shadow-color . "#79e77df779e7") + (cursor-color . "Red3") + (foreground-color . "LightSkyBlue") + (top-toolbar-shadow-color . "#fffffbeeffff")) + ((buffers-tab-face . buffers-tab) + (cperl-here-face . font-lock-string-face) + (cperl-invalid-face quote default) + (cperl-pod-face . font-lock-comment-face) + (cperl-pod-head-face . font-lock-variable-name-face) + (ispell-highlight-face . highlight) + (vc-mode-face . highlight) + (vm-highlight-url-face . bold-italic) + (vm-highlighted-header-face . bold) + (vm-mime-button-face . gui-button-face) + (vm-summary-highlight-face . bold)) + (default ((t (nil)))) + (bbdb-company ((t (nil)))) + (bbdb-field-name ((t (:bold t)))) + (bbdb-field-value ((t (nil)))) + (bbdb-name ((t (:underline t)))) + (blue ((t (:foreground "blue")))) + (bold ((t (:bold t)))) + (bold-italic ((t (:bold t :foreground "yellow")))) + (border-glyph ((t (nil)))) + (buffers-tab ((t (:background "black" :foreground "LightSkyBlue")))) + (cperl-array-face ((t (:bold t :foreground "SkyBlue2")))) + (cperl-hash-face ((t (:foreground "LightBlue2")))) + (cperl-invalid-face ((t (:foreground "white")))) + (cperl-nonoverridable-face ((t (:foreground "chartreuse3")))) + (custom-button-face ((t (:bold t)))) + (custom-changed-face ((t (:background "blue" :foreground "white")))) + (custom-comment-face ((t (:foreground "white")))) + (custom-comment-tag-face ((t (:foreground "white")))) + (custom-documentation-face ((t (nil)))) + (custom-face-tag-face ((t (:underline t)))) + (custom-group-tag-face ((t (:underline t :foreground "blue")))) + (custom-group-tag-face-1 ((t (:underline t :foreground "red")))) + (custom-invalid-face ((t (:background "red" :foreground "yellow")))) + (custom-modified-face ((t (:background "blue" :foreground "white")))) + (custom-rogue-face ((t (:background "black" :foreground "pink")))) + (custom-saved-face ((t (:underline t)))) + (custom-set-face ((t (:background "white" :foreground "blue")))) + (custom-state-face ((t (:foreground "white")))) + (custom-variable-button-face ((t (:underline t :bold t)))) + (custom-variable-tag-face ((t (:underline t :foreground "blue")))) + (cvs-filename-face ((t (:foreground "white")))) + (cvs-handled-face ((t (:foreground "pink")))) + (cvs-header-face ((t (:foreground "green")))) + (cvs-marked-face ((t (:bold t :foreground "green3")))) + (cvs-msg-face ((t (:foreground "red")))) + (cvs-need-action-face ((t (:foreground "yellow")))) + (cvs-unknown-face ((t (:foreground "grey")))) + (diff-added-face ((t (nil)))) + (diff-changed-face ((t (nil)))) + (diff-file-header-face ((t (:bold t :background "grey70")))) + (diff-hunk-header-face ((t (:background "grey85")))) + (diff-index-face ((t (:bold t :background "grey70")))) + (diff-removed-face ((t (nil)))) + (dired-face-boring ((t (:foreground "Gray65")))) + (dired-face-directory ((t (:bold t :foreground "SkyBlue2")))) + (dired-face-executable ((t (:foreground "Green")))) + (dired-face-flagged ((t (:background "LightSlateGray")))) + (dired-face-header ((t (:background "grey75" :foreground "black")))) + (dired-face-marked ((t (:background "PaleVioletRed")))) + (dired-face-permissions ((t (:background "grey75" :foreground "black")))) + (dired-face-setuid ((t (:foreground "Red")))) + (dired-face-socket ((t (:foreground "magenta")))) + (dired-face-symlink ((t (:foreground "cyan")))) + (excerpt ((t (nil)))) + (fixed ((t (:bold t)))) + (font-lock-builtin-face ((t (:foreground "red3")))) + (font-lock-comment-face ((t (:foreground "red")))) + (font-lock-constant-face ((t (nil)))) + (font-lock-doc-string-face ((t (:foreground "turquoise")))) + (font-lock-function-name-face ((t (:foreground "white")))) + (font-lock-keyword-face ((t (:foreground "green")))) + (font-lock-preprocessor-face ((t (:foreground "green3")))) + (font-lock-reference-face ((t (:foreground "red3")))) + (font-lock-string-face ((t (:foreground "turquoise")))) + (font-lock-type-face ((t (:foreground "steelblue")))) + (font-lock-variable-name-face ((t (:foreground "magenta2")))) + (font-lock-warning-face ((t (:bold t :foreground "Red")))) + (green ((t (:foreground "green")))) + (gui-button-face ((t (:background "grey75" :foreground "black")))) + (gui-element ((t (nil)))) + (highlight ((t (:background "darkseagreen2" :foreground "blue")))) + (html-helper-bold-face ((t (:bold t)))) + (html-helper-italic-face ((t (:bold t :foreground "yellow")))) + (html-helper-underline-face ((t (:underline t)))) + (hyper-apropos-documentation ((t (:foreground "white")))) + (hyper-apropos-heading ((t (:bold t)))) + (hyper-apropos-hyperlink ((t (:foreground "sky blue")))) + (hyper-apropos-major-heading ((t (:bold t)))) + (hyper-apropos-section-heading ((t (:bold t)))) + (hyper-apropos-warning ((t (:bold t :foreground "red")))) + (info-node ((t (:bold t :foreground "yellow")))) + (info-xref ((t (:bold t)))) + (isearch ((t (:background "paleturquoise" :foreground "dark red")))) + (isearch-secondary ((t (:foreground "red3")))) + (italic ((t (:bold t :foreground "yellow")))) + (left-margin ((t (nil)))) + (list-mode-item-selected ((t (:background "gray68" :foreground "dark green")))) + (man-bold ((t (:bold t)))) + (man-heading ((t (:bold t)))) + (man-italic ((t (:foreground "yellow")))) + (man-xref ((t (:underline t)))) + (message-cited-text ((t (:foreground "orange")))) + (message-header-contents ((t (:foreground "white")))) + (message-headers ((t (:bold t :foreground "orange")))) + (message-highlighted-header-contents ((t (:bold t)))) + (message-url ((t (:bold t :foreground "pink")))) + (mmm-face ((t (:background "black" :foreground "green")))) + (modeline ((t (nil)))) + (modeline-buffer-id ((t (:background "Gray80" :foreground "blue4")))) + (modeline-mousable ((t (:background "Gray80" :foreground "firebrick")))) + (modeline-mousable-minor-mode ((t (:background "Gray80" :foreground "green4")))) + (paren-blink-off ((t (:foreground "gray80")))) + (paren-match ((t (:background "dark blue")))) + (paren-mismatch ((t (:background "DeepPink" :foreground "LightSkyBlue")))) + (pointer ((t (nil)))) + (primary-selection ((t (:background "gray65" :foreground "DarkBlue")))) + (red ((t (:foreground "red")))) + (region ((t (:background "gray65" :foreground "DarkBlue")))) + (right-margin ((t (nil)))) + (secondary-selection ((t (:background "paleturquoise" :foreground "black")))) + (shell-option-face ((t (:foreground "blue4")))) + (shell-output-2-face ((t (:foreground "green4")))) + (shell-output-3-face ((t (:foreground "green4")))) + (shell-output-face ((t (:bold t)))) + (shell-prompt-face ((t (:foreground "red4")))) + (text-cursor ((t (:background "Red3" :foreground "black")))) + (toolbar ((t (:background "Gray80" :foreground "black")))) + (underline ((t (:underline t)))) + (vertical-divider ((t (nil)))) + (vm-xface ((t (:background "white" :foreground "black")))) + (vmpc-pre-sig-face ((t (:foreground "forestgreen")))) + (vmpc-sig-face ((t (:foreground "steelblue")))) + (widget ((t (nil)))) + (widget-button-face ((t (:bold t)))) + (widget-button-pressed-face ((t (:foreground "red")))) + (widget-documentation-face ((t (:foreground "dark green")))) + (widget-field-face ((t (:background "gray85" :foreground "black")))) + (widget-inactive-face ((t (:foreground "dim gray")))) + (x-face ((t (:background "white" :foreground "black")))) + (xrdb-option-name-face ((t (:foreground "red")))) + (yellow ((t (:foreground "yellow")))) + (zmacs-region ((t (:background "gray65"))))))) + +(defun color-theme-digital-ofs1 () + "Color theme by Gareth Owen, created 2001-06-13. +This works well on an old, beat-up Digital Unix box with its 256 colour +display, on which other color themes hog too much of the palette. +Black on some shade of dark peach. Includes bbdb, cperl, custom, +cvs, diff, dired, ediff, erc, eshell, font-latex, font-lock, gnus, +highlight, hproperty, html-helper, hyper-apropos, info, jde, man, +message, paren, searchm, semantic, sgml, shell, speedbar, term, +vhdl, viper, w3m, widget, woman, x-symbol, xref." + (interactive) + (color-theme-install + '(color-theme-digital-ofs1 + ((background-color . "#CA94AA469193") + (background-mode . light) + (background-toolbar-color . "#cf3ccf3ccf3c") + (border-color . "black") + (bottom-toolbar-shadow-color . "#79e77df779e7") + (cursor-color . "Black") + (foreground-color . "Black") + (mouse-color . "Black") + (top-toolbar-shadow-color . "#fffffbeeffff") + (viper-saved-cursor-color-in-replace-mode . "Red3")) + ((Man-overstrike-face . bold) + (Man-underline-face . underline) + (gnus-mouse-face . highlight) + (goto-address-mail-face . italic) + (goto-address-mail-mouse-face . secondary-selection) + (goto-address-url-face . bold) + (goto-address-url-mouse-face . highlight) + (ispell-highlight-face . highlight) + (list-matching-lines-face . bold) + (rmail-highlight-face . font-lock-function-name-face) + (view-highlight-face . highlight)) + (default ((t (:bold t)))) + (bbdb-company ((t (:italic t)))) + (bbdb-field-name ((t (:bold t)))) + (bbdb-field-value ((t (nil)))) + (bbdb-name ((t (:underline t)))) + (blank-space-face ((t (nil)))) + (blank-tab-face ((t (nil)))) + (blue ((t (:bold t :foreground "blue")))) + (bold ((t (:bold t)))) + (bold-italic ((t (:italic t :bold t)))) + (border-glyph ((t (:bold t)))) + (buffers-tab ((t (:background "black" :foreground "LightSkyBlue")))) + (calendar-today-face ((t (:underline t :bold t :foreground "white")))) + (comint-input-face ((t (nil)))) + (cperl-array-face ((t (:bold t :background "lightyellow2" :foreground "Blue")))) + (cperl-hash-face ((t (:italic t :bold t :background "lightyellow2" :foreground "Red")))) + (cperl-here-face ((t (nil)))) + (cperl-invalid-face ((t (:foreground "white")))) + (cperl-nonoverridable-face ((t (:foreground "chartreuse3")))) + (cperl-pod-face ((t (nil)))) + (cperl-pod-head-face ((t (nil)))) + (custom-button-face ((t (:bold t)))) + (custom-changed-face ((t (:bold t :background "blue" :foreground "white")))) + (custom-comment-face ((t (:foreground "white")))) + (custom-comment-tag-face ((t (:foreground "white")))) + (custom-documentation-face ((t (:bold t)))) + (custom-face-tag-face ((t (:underline t :bold t)))) + (custom-group-tag-face ((t (:underline t :bold t :foreground "DarkBlue")))) + (custom-group-tag-face-1 ((t (:underline t :bold t :foreground "red")))) + (custom-invalid-face ((t (:bold t :background "red" :foreground "yellow")))) + (custom-modified-face ((t (:bold t :background "blue" :foreground "white")))) + (custom-rogue-face ((t (:bold t :background "black" :foreground "pink")))) + (custom-saved-face ((t (:underline t :bold t)))) + (custom-set-face ((t (:bold t :background "white" :foreground "blue")))) + (custom-state-face ((t (:bold t :foreground "dark green")))) + (custom-variable-button-face ((t (:underline t :bold t)))) + (custom-variable-tag-face ((t (:underline t :bold t :foreground "blue")))) + (cvs-filename-face ((t (:foreground "white")))) + (cvs-handled-face ((t (:foreground "pink")))) + (cvs-header-face ((t (:bold t :foreground "green")))) + (cvs-marked-face ((t (:bold t :foreground "green3")))) + (cvs-msg-face ((t (:italic t :foreground "red")))) + (cvs-need-action-face ((t (:foreground "yellow")))) + (cvs-unknown-face ((t (:foreground "grey")))) + (cyan ((t (:foreground "cyan")))) + (diary-face ((t (:bold t :foreground "red")))) + (diff-added-face ((t (nil)))) + (diff-changed-face ((t (nil)))) + (diff-file-header-face ((t (:bold t :background "grey70")))) + (diff-hunk-header-face ((t (:background "grey85")))) + (diff-index-face ((t (:bold t :background "grey70")))) + (diff-removed-face ((t (nil)))) + (dired-face-boring ((t (:foreground "Gray65")))) + (dired-face-directory ((t (:bold t)))) + (dired-face-executable ((t (:foreground "SeaGreen")))) + (dired-face-flagged ((t (:background "LightSlateGray")))) + (dired-face-header ((t (:background "grey75" :foreground "black")))) + (dired-face-marked ((t (:background "PaleVioletRed")))) + (dired-face-permissions ((t (:background "grey75" :foreground "black")))) + (dired-face-setuid ((t (:foreground "Red")))) + (dired-face-socket ((t (:foreground "magenta")))) + (dired-face-symlink ((t (:foreground "cyan")))) + (display-time-mail-balloon-enhance-face ((t (:bold t :background "orange")))) + (display-time-mail-balloon-gnus-group-face ((t (:bold t :foreground "blue")))) + (display-time-time-balloon-face ((t (:bold t :foreground "red")))) + (ediff-current-diff-face-A ((t (:background "pale green" :foreground "firebrick")))) + (ediff-current-diff-face-Ancestor ((t (:background "VioletRed" :foreground "Black")))) + (ediff-current-diff-face-B ((t (:background "Yellow" :foreground "DarkOrchid")))) + (ediff-current-diff-face-C ((t (:background "Pink" :foreground "Navy")))) + (ediff-even-diff-face-A ((t (:background "light grey" :foreground "Black")))) + (ediff-even-diff-face-Ancestor ((t (:background "Grey" :foreground "White")))) + (ediff-even-diff-face-B ((t (:background "Grey" :foreground "White")))) + (ediff-even-diff-face-C ((t (:background "light grey" :foreground "Black")))) + (ediff-fine-diff-face-A ((t (:background "sky blue" :foreground "Navy")))) + (ediff-fine-diff-face-Ancestor ((t (:background "Green" :foreground "Black")))) + (ediff-fine-diff-face-B ((t (:background "cyan" :foreground "Black")))) + (ediff-fine-diff-face-C ((t (:background "Turquoise" :foreground "Black")))) + (ediff-odd-diff-face-A ((t (:background "Grey" :foreground "White")))) + (ediff-odd-diff-face-Ancestor ((t (:background "light grey" :foreground "Black")))) + (ediff-odd-diff-face-B ((t (:background "light grey" :foreground "Black")))) + (ediff-odd-diff-face-C ((t (:background "Grey" :foreground "White")))) + (erc-action-face ((t (:bold t)))) + (erc-bold-face ((t (:bold t)))) + (erc-default-face ((t (nil)))) + (erc-direct-msg-face ((t (nil)))) + (erc-error-face ((t (:bold t)))) + (erc-input-face ((t (nil)))) + (erc-inverse-face ((t (nil)))) + (erc-notice-face ((t (nil)))) + (erc-pal-face ((t (nil)))) + (erc-prompt-face ((t (nil)))) + (erc-underline-face ((t (nil)))) + (eshell-ls-archive-face ((t (:bold t :foreground "Orchid")))) + (eshell-ls-backup-face ((t (:foreground "OrangeRed")))) + (eshell-ls-clutter-face ((t (:bold t :foreground "OrangeRed")))) + (eshell-ls-directory-face ((t (:bold t :foreground "Blue")))) + (eshell-ls-executable-face ((t (:bold t :foreground "ForestGreen")))) + (eshell-ls-missing-face ((t (:bold t :foreground "Red")))) + (eshell-ls-picture-face ((t (:foreground "Violet")))) + (eshell-ls-product-face ((t (:foreground "OrangeRed")))) + (eshell-ls-readonly-face ((t (:foreground "Brown")))) + (eshell-ls-special-face ((t (:bold t :foreground "Magenta")))) + (eshell-ls-symlink-face ((t (:bold t :foreground "DarkCyan")))) + (eshell-ls-text-face ((t (:foreground "medium aquamarine")))) + (eshell-ls-todo-face ((t (:bold t :foreground "aquamarine")))) + (eshell-ls-unreadable-face ((t (:foreground "Grey30")))) + (eshell-prompt-face ((t (:bold t :foreground "Red")))) + (eshell-test-failed-face ((t (:bold t :foreground "OrangeRed")))) + (eshell-test-ok-face ((t (:bold t :foreground "Green")))) + (excerpt ((t (:italic t)))) + (ff-paths-non-existant-file-face ((t (:bold t :foreground "NavyBlue")))) + (fg:black ((t (:foreground "black")))) + (fixed ((t (:bold t)))) + (fl-comment-face ((t (:foreground "medium purple")))) + (fl-doc-string-face ((t (nil)))) + (fl-function-name-face ((t (:foreground "green")))) + (fl-keyword-face ((t (:foreground "LightGreen")))) + (fl-string-face ((t (:foreground "light coral")))) + (fl-type-face ((t (:foreground "cyan")))) + (flyspell-duplicate-face ((t (:underline t :bold t :foreground "Gold3")))) + (flyspell-incorrect-face ((t (:underline t :bold t :foreground "OrangeRed")))) + (font-latex-bold-face ((t (:bold t)))) + (font-latex-italic-face ((t (:italic t)))) + (font-latex-math-face ((t (nil)))) + (font-latex-sedate-face ((t (nil)))) + (font-latex-string-face ((t (nil)))) + (font-latex-warning-face ((t (nil)))) + (font-lock-builtin-face ((t (:italic t :bold t :foreground "Orchid")))) + (font-lock-comment-face ((t (:bold t :foreground "Firebrick")))) + (font-lock-constant-face ((t (:italic t :bold t :foreground "CadetBlue")))) + (font-lock-doc-string-face ((t (:italic t :bold t :foreground "green4")))) + (font-lock-emphasized-face ((t (:bold t)))) + (font-lock-exit-face ((t (:foreground "green")))) + (font-lock-function-name-face ((t (:italic t :bold t :foreground "Blue")))) + (font-lock-keyword-face ((t (:bold t :foreground "dark olive green")))) + (font-lock-other-emphasized-face ((t (:italic t :bold t)))) + (font-lock-other-type-face ((t (:bold t :foreground "DarkBlue")))) + (font-lock-preprocessor-face ((t (:italic t :bold t :foreground "blue3")))) + (font-lock-reference-face ((t (:italic t :bold t :foreground "red3")))) + (font-lock-special-comment-face ((t (nil)))) + (font-lock-special-keyword-face ((t (nil)))) + (font-lock-string-face ((t (:italic t :bold t :foreground "DarkBlue")))) + (font-lock-type-face ((t (:italic t :bold t :foreground "DarkGreen")))) + (font-lock-variable-name-face ((t (:italic t :bold t :foreground "darkgreen")))) + (font-lock-warning-face ((t (:bold t :foreground "Red")))) + (fringe ((t (:background "grey95")))) + (gdb-arrow-face ((t (:bold t)))) + (gnus-cite-attribution-face ((t (:italic t :bold t)))) + (gnus-cite-face-1 ((t (:bold t :foreground "MidnightBlue")))) + (gnus-cite-face-10 ((t (:foreground "medium purple")))) + (gnus-cite-face-11 ((t (:foreground "turquoise")))) + (gnus-cite-face-2 ((t (:bold t :foreground "firebrick")))) + (gnus-cite-face-3 ((t (:bold t :foreground "dark green")))) + (gnus-cite-face-4 ((t (:foreground "OrangeRed")))) + (gnus-cite-face-5 ((t (:foreground "dark khaki")))) + (gnus-cite-face-6 ((t (:bold t :foreground "dark violet")))) + (gnus-cite-face-7 ((t (:foreground "SteelBlue4")))) + (gnus-cite-face-8 ((t (:foreground "magenta")))) + (gnus-cite-face-9 ((t (:foreground "violet")))) + (gnus-cite-face-list ((t (nil)))) + (gnus-emphasis-bold ((t (:bold t)))) + (gnus-emphasis-bold-italic ((t (:italic t :bold t)))) + (gnus-emphasis-highlight-words ((t (:background "black" :foreground "yellow")))) + (gnus-emphasis-italic ((t (:italic t)))) + (gnus-emphasis-underline ((t (:underline t)))) + (gnus-emphasis-underline-bold ((t (:underline t :bold t)))) + (gnus-emphasis-underline-bold-italic ((t (:underline t :italic t :bold t)))) + (gnus-emphasis-underline-italic ((t (:underline t :italic t)))) + (gnus-filterhist-face-1 ((t (nil)))) + (gnus-group-mail-1-empty-face ((t (:foreground "DeepPink3")))) + (gnus-group-mail-1-face ((t (:bold t :foreground "DeepPink3")))) + (gnus-group-mail-2-empty-face ((t (:foreground "HotPink3")))) + (gnus-group-mail-2-face ((t (:bold t :foreground "HotPink3")))) + (gnus-group-mail-3-empty-face ((t (:foreground "magenta4")))) + (gnus-group-mail-3-face ((t (:bold t :foreground "magenta4")))) + (gnus-group-mail-low-empty-face ((t (:foreground "DeepPink4")))) + (gnus-group-mail-low-face ((t (:bold t :foreground "DeepPink4")))) + (gnus-group-news-1-empty-face ((t (:foreground "ForestGreen")))) + (gnus-group-news-1-face ((t (:bold t :foreground "ForestGreen")))) + (gnus-group-news-2-empty-face ((t (:foreground "CadetBlue4")))) + (gnus-group-news-2-face ((t (:bold t :foreground "CadetBlue4")))) + (gnus-group-news-3-empty-face ((t (nil)))) + (gnus-group-news-3-face ((t (:bold t)))) + (gnus-group-news-4-empty-face ((t (nil)))) + (gnus-group-news-4-face ((t (:bold t)))) + (gnus-group-news-5-empty-face ((t (nil)))) + (gnus-group-news-5-face ((t (:bold t)))) + (gnus-group-news-6-empty-face ((t (nil)))) + (gnus-group-news-6-face ((t (:bold t)))) + (gnus-group-news-low-empty-face ((t (:foreground "DarkGreen")))) + (gnus-group-news-low-face ((t (:bold t :foreground "DarkGreen")))) + (gnus-header-content-face ((t (:italic t :foreground "indianred4")))) + (gnus-header-from-face ((t (:bold t :foreground "red3")))) + (gnus-header-name-face ((t (:bold t :foreground "maroon")))) + (gnus-header-newsgroups-face ((t (:italic t :bold t :foreground "MidnightBlue")))) + (gnus-header-subject-face ((t (:bold t :foreground "red4")))) + (gnus-picons-face ((t (:background "white" :foreground "black")))) + (gnus-picons-xbm-face ((t (:background "white" :foreground "black")))) + (gnus-signature-face ((t (:italic t :bold t)))) + (gnus-splash ((t (nil)))) + (gnus-splash-face ((t (:foreground "Brown")))) + (gnus-summary-cancelled-face ((t (:background "black" :foreground "yellow")))) + (gnus-summary-high-ancient-face ((t (:bold t :foreground "RoyalBlue")))) + (gnus-summary-high-read-face ((t (:bold t :foreground "DarkGreen")))) + (gnus-summary-high-ticked-face ((t (:bold t :foreground "firebrick")))) + (gnus-summary-high-unread-face ((t (:italic t :bold t)))) + (gnus-summary-low-ancient-face ((t (:italic t :foreground "RoyalBlue")))) + (gnus-summary-low-read-face ((t (:italic t :foreground "DarkGreen")))) + (gnus-summary-low-ticked-face ((t (:italic t :bold t :foreground "firebrick")))) + (gnus-summary-low-unread-face ((t (:italic t)))) + (gnus-summary-normal-ancient-face ((t (:foreground "RoyalBlue")))) + (gnus-summary-normal-read-face ((t (:foreground "DarkGreen")))) + (gnus-summary-normal-ticked-face ((t (:bold t :foreground "firebrick")))) + (gnus-summary-normal-unread-face ((t (:bold t)))) + (gnus-summary-selected-face ((t (:underline t)))) + (gnus-x-face ((t (:background "white" :foreground "black")))) + (green ((t (:bold t :foreground "green")))) + (gui-button-face ((t (:bold t :background "grey75" :foreground "black")))) + (gui-element ((t (:bold t :background "Gray80")))) + (highlight ((t (:bold t :background "darkseagreen2")))) + (highlight-changes-delete-face ((t (:underline t :foreground "red")))) + (highlight-changes-face ((t (:foreground "red")))) + (highline-face ((t (:background "black" :foreground "white")))) + (holiday-face ((t (:bold t :background "pink" :foreground "white")))) + (hproperty:but-face ((t (:bold t)))) + (hproperty:flash-face ((t (:bold t)))) + (hproperty:highlight-face ((t (:bold t)))) + (hproperty:item-face ((t (:bold t)))) + (html-helper-bold-face ((t (:bold t)))) + (html-helper-bold-italic-face ((t (nil)))) + (html-helper-builtin-face ((t (:underline t :foreground "blue3")))) + (html-helper-italic-face ((t (:italic t :bold t :foreground "yellow")))) + (html-helper-underline-face ((t (:underline t)))) + (html-tag-face ((t (:bold t)))) + (hyper-apropos-documentation ((t (:foreground "white")))) + (hyper-apropos-heading ((t (:bold t)))) + (hyper-apropos-hyperlink ((t (:foreground "sky blue")))) + (hyper-apropos-major-heading ((t (:bold t)))) + (hyper-apropos-section-heading ((t (:bold t)))) + (hyper-apropos-warning ((t (:bold t :foreground "red")))) + (ibuffer-marked-face ((t (:foreground "red")))) + (info-menu-5 ((t (:underline t :bold t)))) + (info-menu-6 ((t (nil)))) + (info-node ((t (:italic t :bold t)))) + (info-xref ((t (:bold t)))) + (isearch ((t (:bold t :background "paleturquoise")))) + (isearch-secondary ((t (:foreground "red3")))) + (ispell-face ((t (:bold t)))) + (italic ((t (:italic t :bold t)))) + (jde-bug-breakpoint-cursor ((t (:background "brown" :foreground "cyan")))) + (jde-bug-breakpoint-marker ((t (:background "yellow" :foreground "red")))) + (jde-java-font-lock-link-face ((t (:underline t :foreground "blue")))) + (jde-java-font-lock-number-face ((t (:foreground "RosyBrown")))) + (lazy-highlight-face ((t (:bold t :foreground "dark magenta")))) + (left-margin ((t (:bold t)))) + (linemenu-face ((t (nil)))) + (list-mode-item-selected ((t (:bold t :background "gray68")))) + (magenta ((t (:foreground "magenta")))) + (makefile-space-face ((t (:background "hotpink")))) + (man-bold ((t (:bold t)))) + (man-heading ((t (:bold t)))) + (man-italic ((t (:foreground "yellow")))) + (man-xref ((t (:underline t)))) + (message-cited-text ((t (:bold t :foreground "orange")))) + (message-cited-text-face ((t (:bold t :foreground "red")))) + (message-header-cc-face ((t (:bold t :foreground "MidnightBlue")))) + (message-header-contents ((t (:italic t :bold t :foreground "white")))) + (message-header-name-face ((t (:bold t :foreground "cornflower blue")))) + (message-header-newsgroups-face ((t (:italic t :bold t :foreground "blue4")))) + (message-header-other-face ((t (:bold t :foreground "steel blue")))) + (message-header-subject-face ((t (:bold t :foreground "navy blue")))) + (message-header-to-face ((t (:bold t :foreground "MidnightBlue")))) + (message-header-xheader-face ((t (:bold t :foreground "blue")))) + (message-headers ((t (:bold t :foreground "orange")))) + (message-highlighted-header-contents ((t (:bold t)))) + (message-mml-face ((t (:bold t :foreground "ForestGreen")))) + (message-separator-face ((t (:foreground "brown")))) + (message-url ((t (:bold t :foreground "pink")))) + (mmm-face ((t (:background "black" :foreground "green")))) + (modeline ((t (:bold t :background "Black" :foreground "#CA94AA469193")))) + (modeline-buffer-id ((t (:bold t :background "Gray80" :foreground "blue4")))) + (modeline-mousable ((t (:bold t :background "Gray80" :foreground "firebrick")))) + (modeline-mousable-minor-mode ((t (:bold t :background "Gray80" :foreground "green4")))) + (my-tab-face ((t (nil)))) + (nil ((t (nil)))) + (p4-diff-del-face ((t (:bold t)))) + (paren-blink-off ((t (:foreground "gray80")))) + (paren-face ((t (nil)))) + (paren-face-match ((t (nil)))) + (paren-face-mismatch ((t (nil)))) + (paren-face-no-match ((t (nil)))) + (paren-match ((t (:background "darkseagreen2")))) + (paren-mismatch ((t (:background "DeepPink" :foreground "black")))) + (paren-mismatch-face ((t (:bold t :background "DeepPink" :foreground "white")))) + (paren-no-match-face ((t (:bold t :background "yellow" :foreground "white")))) + (pointer ((t (:bold t)))) + (primary-selection ((t (:bold t :background "gray65")))) + (red ((t (:bold t :foreground "red")))) + (region ((t (:bold t :background "gray")))) + (right-margin ((t (:bold t)))) + (searchm-buffer ((t (:bold t)))) + (searchm-button ((t (:bold t)))) + (searchm-field ((t (nil)))) + (searchm-field-label ((t (:bold t)))) + (searchm-highlight ((t (:bold t)))) + (secondary-selection ((t (:bold t :background "paleturquoise")))) + (semantic-intangible-face ((t (:foreground "gray25")))) + (semantic-read-only-face ((t (:background "gray25")))) + (senator-momentary-highlight-face ((t (:background "gray70")))) + (setnu-line-number-face ((t (:italic t :bold t)))) + (sgml-comment-face ((t (:foreground "dark green")))) + (sgml-doctype-face ((t (:foreground "maroon")))) + (sgml-end-tag-face ((t (:foreground "blue2")))) + (sgml-entity-face ((t (:foreground "red2")))) + (sgml-ignored-face ((t (:background "gray90" :foreground "maroon")))) + (sgml-ms-end-face ((t (:foreground "maroon")))) + (sgml-ms-start-face ((t (:foreground "maroon")))) + (sgml-pi-face ((t (:foreground "maroon")))) + (sgml-sgml-face ((t (:foreground "maroon")))) + (sgml-short-ref-face ((t (:foreground "goldenrod")))) + (sgml-start-tag-face ((t (:foreground "blue2")))) + (shell-input-face ((t (:bold t)))) + (shell-option-face ((t (:bold t :foreground "blue4")))) + (shell-output-2-face ((t (:bold t :foreground "green4")))) + (shell-output-3-face ((t (:bold t :foreground "green4")))) + (shell-output-face ((t (:bold t)))) + (shell-prompt-face ((t (:bold t :foreground "red4")))) + (show-paren-match-face ((t (:bold t :background "turquoise")))) + (show-paren-mismatch-face ((t (:bold t :background "purple" :foreground "white")))) + (speedbar-button-face ((t (:bold t :foreground "magenta")))) + (speedbar-directory-face ((t (:bold t :foreground "orchid")))) + (speedbar-file-face ((t (:bold t :foreground "pink")))) + (speedbar-highlight-face ((t (:background "black")))) + (speedbar-selected-face ((t (:underline t :foreground "cyan")))) + (speedbar-tag-face ((t (:foreground "yellow")))) + (swbuff-current-buffer-face ((t (:bold t :foreground "red")))) + (template-message-face ((t (:bold t)))) + (term-black ((t (:foreground "black")))) + (term-blackbg ((t (:background "black")))) + (term-blue ((t (:foreground "blue")))) + (term-blue-bold-face ((t (:bold t :background "snow2" :foreground "blue")))) + (term-blue-face ((t (:foreground "blue")))) + (term-blue-inv-face ((t (:background "blue")))) + (term-blue-ul-face ((t (:underline t :background "snow2" :foreground "blue")))) + (term-bluebg ((t (:background "blue")))) + (term-bold ((t (:bold t)))) + (term-cyan ((t (:foreground "cyan")))) + (term-cyan-bold-face ((t (:bold t :background "snow2" :foreground "cyan")))) + (term-cyan-face ((t (:foreground "cyan")))) + (term-cyan-inv-face ((t (:background "cyan")))) + (term-cyan-ul-face ((t (:underline t :background "snow2" :foreground "cyan")))) + (term-cyanbg ((t (:background "cyan")))) + (term-default-bg ((t (nil)))) + (term-default-bg-inv ((t (nil)))) + (term-default-bold-face ((t (:bold t :background "snow2" :foreground "darkslategray")))) + (term-default-face ((t (:background "snow2" :foreground "darkslategray")))) + (term-default-fg ((t (nil)))) + (term-default-fg-inv ((t (nil)))) + (term-default-inv-face ((t (:background "darkslategray" :foreground "snow2")))) + (term-default-ul-face ((t (:underline t :background "snow2" :foreground "darkslategray")))) + (term-green ((t (:foreground "green")))) + (term-green-bold-face ((t (:bold t :background "snow2" :foreground "green")))) + (term-green-face ((t (:foreground "green")))) + (term-green-inv-face ((t (:background "green")))) + (term-green-ul-face ((t (:underline t :background "snow2" :foreground "green")))) + (term-greenbg ((t (:background "green")))) + (term-invisible ((t (nil)))) + (term-invisible-inv ((t (nil)))) + (term-magenta ((t (:foreground "magenta")))) + (term-magenta-bold-face ((t (:bold t :background "snow2" :foreground "magenta")))) + (term-magenta-face ((t (:foreground "magenta")))) + (term-magenta-inv-face ((t (:background "magenta")))) + (term-magenta-ul-face ((t (:underline t :background "snow2" :foreground "magenta")))) + (term-magentabg ((t (:background "magenta")))) + (term-red ((t (:foreground "red")))) + (term-red-bold-face ((t (:bold t :background "snow2" :foreground "red")))) + (term-red-face ((t (:foreground "red")))) + (term-red-inv-face ((t (:background "red")))) + (term-red-ul-face ((t (:underline t :background "snow2" :foreground "red")))) + (term-redbg ((t (:background "red")))) + (term-underline ((t (:underline t)))) + (term-white ((t (:foreground "white")))) + (term-white-bold-face ((t (:bold t :background "snow2" :foreground "white")))) + (term-white-face ((t (:foreground "white")))) + (term-white-inv-face ((t (:background "snow2")))) + (term-white-ul-face ((t (:underline t :background "snow2" :foreground "white")))) + (term-whitebg ((t (:background "white")))) + (term-yellow ((t (:foreground "yellow")))) + (term-yellow-bold-face ((t (:bold t :background "snow2" :foreground "yellow")))) + (term-yellow-face ((t (:foreground "yellow")))) + (term-yellow-inv-face ((t (:background "yellow")))) + (term-yellow-ul-face ((t (:underline t :background "snow2" :foreground "yellow")))) + (term-yellowbg ((t (:background "yellow")))) + (text-cursor ((t (:bold t :background "Red3" :foreground "gray80")))) + (toolbar ((t (:bold t :background "Gray80")))) + (underline ((t (:underline t :bold t)))) + (vc-annotate-face-0046FF ((t (nil)))) + (vcursor ((t (:underline t :background "cyan" :foreground "blue")))) + (vertical-divider ((t (:bold t :background "Gray80")))) + (vhdl-font-lock-attribute-face ((t (:foreground "Orchid")))) + (vhdl-font-lock-directive-face ((t (:foreground "CadetBlue")))) + (vhdl-font-lock-enumvalue-face ((t (:foreground "Gold4")))) + (vhdl-font-lock-function-face ((t (:foreground "Orchid4")))) + (vhdl-font-lock-generic-/constant-face ((t (nil)))) + (vhdl-font-lock-prompt-face ((t (:bold t :foreground "Red")))) + (vhdl-font-lock-reserved-words-face ((t (:bold t :foreground "Orange")))) + (vhdl-font-lock-translate-off-face ((t (:background "LightGray")))) + (vhdl-font-lock-type-face ((t (nil)))) + (vhdl-font-lock-variable-face ((t (nil)))) + (vhdl-speedbar-architecture-face ((t (:foreground "Blue")))) + (vhdl-speedbar-architecture-selected-face ((t (:underline t :foreground "Blue")))) + (vhdl-speedbar-configuration-face ((t (:foreground "DarkGoldenrod")))) + (vhdl-speedbar-configuration-selected-face ((t (:underline t :foreground "DarkGoldenrod")))) + (vhdl-speedbar-entity-face ((t (:foreground "ForestGreen")))) + (vhdl-speedbar-entity-selected-face ((t (:underline t :foreground "ForestGreen")))) + (vhdl-speedbar-instantiation-face ((t (:foreground "Brown")))) + (vhdl-speedbar-instantiation-selected-face ((t (:underline t :foreground "Brown")))) + (vhdl-speedbar-package-face ((t (:foreground "Grey50")))) + (vhdl-speedbar-package-selected-face ((t (:underline t :foreground "Grey50")))) + (vhdl-speedbar-subprogram-face ((t (nil)))) + (viper-minibuffer-emacs-face ((t (:background "darkseagreen2" :foreground "Black")))) + (viper-minibuffer-insert-face ((t (:background "pink" :foreground "Black")))) + (viper-minibuffer-vi-face ((t (:background "grey" :foreground "DarkGreen")))) + (viper-replace-overlay-face ((t (:background "darkseagreen2" :foreground "Black")))) + (viper-search-face ((t (:background "khaki" :foreground "Black")))) + (vm-xface ((t (:background "white" :foreground "black")))) + (vmpc-pre-sig-face ((t (:foreground "forestgreen")))) + (vmpc-sig-face ((t (:foreground "steelblue")))) + (vvb-face ((t (nil)))) + (w3m-anchor-face ((t (:bold t :foreground "DodgerBlue1")))) + (w3m-arrived-anchor-face ((t (:bold t :foreground "DodgerBlue3")))) + (w3m-header-line-location-content-face ((t (:background "dark olive green" :foreground "wheat")))) + (w3m-header-line-location-title-face ((t (:background "dark olive green" :foreground "beige")))) + (white ((t (:foreground "white")))) + (widget ((t (nil)))) + (widget-button-face ((t (:bold t)))) + (widget-button-pressed-face ((t (:bold t :foreground "red")))) + (widget-documentation-face ((t (:bold t :foreground "dark green")))) + (widget-field-face ((t (:bold t :background "gray85")))) + (widget-inactive-face ((t (:bold t :foreground "dim gray")))) + (widget-single-line-field-face ((t (:background "gray85")))) + (woman-bold-face ((t (:bold t)))) + (woman-italic-face ((t (:foreground "beige")))) + (woman-unknown-face ((t (:foreground "LightSalmon")))) + (x-face ((t (:bold t :background "white" :foreground "black")))) + (x-symbol-adobe-fontspecific-face ((t (nil)))) + (x-symbol-face ((t (nil)))) + (x-symbol-heading-face ((t (:bold t)))) + (x-symbol-info-face ((t (nil)))) + (x-symbol-invisible-face ((t (nil)))) + (x-symbol-revealed-face ((t (nil)))) + (xrdb-option-name-face ((t (:foreground "red")))) + (xref-keyword-face ((t (:foreground "blue")))) + (xref-list-default-face ((t (nil)))) + (xref-list-pilot-face ((t (:foreground "navy")))) + (xref-list-symbol-face ((t (:foreground "navy")))) + (yellow ((t (:bold t :foreground "yellow")))) + (zmacs-region ((t (:bold t :background "gray65"))))))) + +(defun color-theme-mistyday () + "Color theme by K.C. Hari Kumar, created 2001-06-13. +Black on mistyrose. Includes CUA, calendar, diary, font-latex and +font-lock. Uses backgrounds on some font-lock faces." + (interactive) + (color-theme-install + '(color-theme-mistyday + ((background-color . "mistyrose") + (background-mode . light) + (border-color . "black") + (cursor-color . "deep pink") + (foreground-color . "Black") + (mouse-color . "black")) + ((goto-address-mail-face . italic) + (goto-address-mail-mouse-face . secondary-selection) + (goto-address-url-face . bold) + (goto-address-url-mouse-face . highlight) + (list-matching-lines-face . bold) + (paren-match-face . paren-face-match) + (paren-mismatch-face . paren-face-mismatch) + (paren-no-match-face . paren-face-no-match)) + (default ((t (nil)))) + (CUA-global-mark-face ((t (:background "cyan" :foreground "black")))) + (CUA-rectangle-face ((t (:background "maroon" :foreground "white")))) + (CUA-rectangle-noselect-face ((t (:background "dimgray" :foreground "white")))) + (bold ((t (:bold t)))) + (bold-italic ((t (:italic t :bold t)))) + (calendar-today-face ((t (:underline t :background "Spring Green" :foreground "Brown")))) + (custom-button-face ((t (:background "dark slate grey" :foreground "azure")))) + (custom-documentation-face ((t (:background "white" :foreground "blue")))) + (diary-face ((t (:background "navy" :foreground "yellow")))) + (font-latex-bold-face ((t (:bold t :foreground "DarkOliveGreen")))) + (font-latex-italic-face ((t (:italic t :foreground "DarkOliveGreen")))) + (font-latex-math-face ((t (:foreground "navy")))) + (font-latex-sedate-face ((t (:foreground "DimGray")))) + (font-latex-string-face ((t (nil)))) + (font-latex-warning-face ((t (nil)))) + (font-lock-builtin-face ((t (:background "DarkTurquoise" :foreground "Navy")))) + (font-lock-comment-face ((t (:italic t :foreground "royal blue")))) + (font-lock-constant-face ((t (:background "pale green" :foreground "dark slate blue")))) + (font-lock-doc-string-face ((t (:background "medium aquamarine" :foreground "deep pink")))) + (font-lock-function-name-face ((t (:background "SpringGreen" :foreground "MidnightBlue")))) + (font-lock-keyword-face ((t (:foreground "dark magenta")))) + (font-lock-preprocessor-face ((t (:background "pale green" :foreground "dark slate blue")))) + (font-lock-reference-face ((t (:background "DarkTurquoise" :foreground "Navy")))) + (font-lock-string-face ((t (:background "medium aquamarine" :foreground "deep pink")))) + (font-lock-type-face ((t (:background "steel blue" :foreground "khaki")))) + (font-lock-variable-name-face ((t (:background "thistle" :foreground "orange red")))) + (font-lock-warning-face ((t (:background "LemonChiffon" :foreground "Red")))) + (highlight ((t (:background "dark slate grey" :foreground "light cyan")))) + (holiday-face ((t (:background "orangered" :foreground "lightyellow")))) + (ido-first-match-face ((t (:bold t)))) + (ido-only-match-face ((t (:foreground "ForestGreen")))) + (ido-subdir-face ((t (:foreground "red")))) + (italic ((t (:italic t)))) + (isearch ((t (:background "sienna" :foreground "light cyan")))) + (modeline ((t (:background "Royalblue4" :foreground "lawn green")))) + (modeline-buffer-id ((t (:background "Royalblue4" :foreground "lawn green")))) + (modeline-mousable ((t (:background "Royalblue4" :foreground "lawn green")))) + (modeline-mousable-minor-mode ((t (:background "Royalblue4" :foreground "lawn green")))) + (paren-face-match ((t (:background "turquoise")))) + (paren-face-mismatch ((t (:background "purple" :foreground "white")))) + (paren-face-no-match ((t (:background "yellow" :foreground "black")))) + (primary-selection ((t (:background "sienna" :foreground "light cyan")))) + (region ((t (:background "sienna" :foreground "light cyan")))) + (secondary-selection ((t (:background "forest green" :foreground "white smoke")))) + (underline ((t (:underline t)))) + (zmacs-region ((t (:background "sienna" :foreground "light cyan"))))))) + +(defun color-theme-marine () + "Color theme by Girish Bharadwaj, created 2001-06-22. +Matches the MS Windows Marine color theme. +Includes custom, font-lock, paren, widget." + (interactive) + (color-theme-install + '(color-theme-marine + ((background-color . "#9dcec9") + (background-mode . light) + (border-color . "black") + (cursor-color . "yellow") + (foreground-color . "darkslategray") + (mouse-color . "sienna1")) + ((buffers-tab-face . buffers-tab) + (gnus-mouse-face . highlight) + (smiley-mouse-face . highlight)) + (default ((t (nil)))) + (blue ((t (:foreground "blue")))) + (bold ((t (:bold t)))) + (bold-italic ((t (nil)))) + (border-glyph ((t (nil)))) + (buffers-tab ((t (:background "#9dcec9" :foreground "darkslategray")))) + (custom-button-face ((t (nil)))) + (custom-changed-face ((t (:background "blue" :foreground "white")))) + (custom-comment-face ((t (:background "gray85")))) + (custom-comment-tag-face ((t (:foreground "blue4")))) + (custom-documentation-face ((t (nil)))) + (custom-face-tag-face ((t (:underline t)))) + (custom-group-tag-face ((t (:underline t :foreground "blue")))) + (custom-group-tag-face-1 ((t (:underline t :foreground "deeppink")))) + (custom-invalid-face ((t (:background "red" :foreground "yellow")))) + (custom-modified-face ((t (:background "blue" :foreground "white")))) + (custom-rogue-face ((t (:background "black" :foreground "pink")))) + (custom-saved-face ((t (:underline t)))) + (custom-set-face ((t (:background "white" :foreground "blue")))) + (custom-state-face ((t (:foreground "darkgreen")))) + (custom-variable-button-face ((t (:underline t :bold t)))) + (custom-variable-tag-face ((t (:underline t :foreground "blue")))) + (display-time-mail-balloon-enhance-face ((t (:background "orange")))) + (display-time-mail-balloon-gnus-group-face ((t (:foreground "blue")))) + (display-time-time-balloon-face ((t (:foreground "red")))) + (font-lock-builtin-face ((t (:foreground "SteelBlue")))) + (font-lock-comment-face ((t (:foreground "cadetblue")))) + (font-lock-constant-face ((t (:foreground "OrangeRed")))) + (font-lock-doc-string-face ((t (:foreground "Salmon")))) + (font-lock-function-name-face ((t (:bold t :foreground "NavyBlue")))) + (font-lock-keyword-face ((t (:bold t :foreground "purple")))) + (font-lock-preprocessor-face ((t (:foreground "SteelBlue")))) + (font-lock-reference-face ((t (:foreground "SteelBlue")))) + (font-lock-string-face ((t (:foreground "royalblue")))) + (font-lock-type-face ((t (:foreground "darkmagenta")))) + (font-lock-variable-name-face ((t (:foreground "violetred")))) + (font-lock-warning-face ((t (:bold t :foreground "red")))) + (green ((t (:foreground "green")))) + (gui-button-face ((t (:background "grey75" :foreground "black")))) + (gui-element ((t (:background "#489088" :foreground "black")))) + (highlight ((t (:background "darkolivegreen" :foreground "white")))) + (isearch ((t (:background "blue")))) + (isearch-secondary ((t (:foreground "red3")))) + (italic ((t (nil)))) + (left-margin ((t (nil)))) + (list-mode-item-selected ((t (:background "gray68" :foreground "darkslategray")))) + (modeline ((t (:background "black" :foreground "white")))) + (modeline-buffer-id ((t (:background "black" :foreground "white")))) + (modeline-mousable ((t (:background "black" :foreground "white")))) + (modeline-mousable-minor-mode ((t (:background "black" :foreground "white")))) + (paren-blink-off ((t (:foreground "black")))) + (paren-match ((t (:background "darkolivegreen" :foreground "white")))) + (paren-mismatch ((t (:background "#9dcec9" :foreground "darkslategray")))) + (pointer ((t (nil)))) + (primary-selection ((t (:background "blue")))) + (red ((t (:foreground "red")))) + (region ((t (:background "blue")))) + (right-margin ((t (nil)))) + (secondary-selection ((t (:background "darkslateblue" :foreground "white")))) + (template-message-face ((t (:bold t)))) + (text-cursor ((t (:background "yellow" :foreground "#9dcec9")))) + (toolbar ((t (nil)))) + (underline ((t (:underline t)))) + (vertical-divider ((t (nil)))) + (widget ((t (nil)))) + (widget-button-face ((t (:bold t)))) + (widget-button-pressed-face ((t (:foreground "red")))) + (widget-documentation-face ((t (:foreground "forestgreen")))) + (widget-field-face ((t (:background "gray")))) + (widget-inactive-face ((t (:foreground "dimgray")))) + (widget-single-line-field-face ((t (:background "dim gray" :foreground "white")))) + (yellow ((t (:foreground "yellow")))) + (zmacs-region ((t (:background "blue"))))))) + +(defun color-theme-blue-erc () + "Color theme for erc faces only. +This is intended for other color themes to use (eg. `color-theme-gnome2')." + (color-theme-install + '(color-theme-blue-erc + nil + (erc-action-face ((t (nil)))) + (erc-bold-face ((t (:bold t)))) + (erc-current-nick-face ((t (:bold t :foreground "yellow")))) + (erc-default-face ((t (nil)))) + (erc-direct-msg-face ((t (:foreground "pale green")))) + (erc-error-face ((t (:bold t :foreground "IndianRed")))) + (erc-highlight-face ((t (:bold t :foreground "pale green")))) + (erc-input-face ((t (:foreground "light blue")))) + (erc-inverse-face ((t (:background "steel blue")))) + (erc-keyword-face ((t (:foreground "orange" :bold t)))) + (erc-notice-face ((t (:foreground "light salmon")))) + (erc-notice-face ((t (:foreground "MediumAquamarine")))) + (erc-pal-face ((t (:foreground "pale green")))) + (erc-prompt-face ((t (:foreground "light blue" :bold t)))) + (fg:erc-color-face0 ((t (:foreground "white")))) + (fg:erc-color-face1 ((t (:foreground "beige")))) + (fg:erc-color-face2 ((t (:foreground "lemon chiffon")))) + (fg:erc-color-face3 ((t (:foreground "light cyan")))) + (fg:erc-color-face4 ((t (:foreground "powder blue")))) + (fg:erc-color-face5 ((t (:foreground "sky blue")))) + (fg:erc-color-face6 ((t (:foreground "dark sea green")))) + (fg:erc-color-face7 ((t (:foreground "pale green")))) + (fg:erc-color-face8 ((t (:foreground "medium spring green")))) + (fg:erc-color-face9 ((t (:foreground "khaki")))) + (fg:erc-color-face10 ((t (:foreground "pale goldenrod")))) + (fg:erc-color-face11 ((t (:foreground "light goldenrod yellow")))) + (fg:erc-color-face12 ((t (:foreground "light yellow")))) + (fg:erc-color-face13 ((t (:foreground "yellow")))) + (fg:erc-color-face14 ((t (:foreground "light goldenrod")))) + (fg:erc-color-face15 ((t (:foreground "lime green")))) + (bg:erc-color-face0 ((t (nil)))) + (bg:erc-color-face1 ((t (nil)))) + (bg:erc-color-face2 ((t (nil)))) + (bg:erc-color-face3 ((t (nil)))) + (bg:erc-color-face4 ((t (nil)))) + (bg:erc-color-face5 ((t (nil)))) + (bg:erc-color-face6 ((t (nil)))) + (bg:erc-color-face7 ((t (nil)))) + (bg:erc-color-face8 ((t (nil)))) + (bg:erc-color-face9 ((t (nil)))) + (bg:erc-color-face10 ((t (nil)))) + (bg:erc-color-face11 ((t (nil)))) + (bg:erc-color-face12 ((t (nil)))) + (bg:erc-color-face13 ((t (nil)))) + (bg:erc-color-face14 ((t (nil)))) + (bg:erc-color-face15 ((t (nil))))))) + +(defun color-theme-dark-erc () + "Color theme for erc faces only. +This is intended for other color themes to use (eg. `color-theme-late-night')." + (interactive) + (color-theme-install + '(color-theme-dark-erc + nil + (erc-action-face ((t (nil)))) + (erc-bold-face ((t (:bold t)))) + (erc-current-nick-face ((t (:bold t)))) + (erc-default-face ((t (nil)))) + (erc-direct-msg-face ((t (nil)))) + (erc-error-face ((t (:bold t :foreground "IndianRed")))) + (erc-highlight-face ((t (:bold t :foreground "pale green")))) + (erc-input-face ((t (:foreground "#555")))) + (erc-inverse-face ((t (:background "steel blue")))) + (erc-keyword-face ((t (:foreground "#999" :bold t)))) + (erc-nick-msg-face ((t (:foreground "#888")))) + (erc-notice-face ((t (:foreground "#444")))) + (erc-pal-face ((t (:foreground "#888")))) + (erc-prompt-face ((t (:foreground "#777" :bold t)))) + (erc-timestamp-face ((t (:foreground "#777" :bold t)))) + (fg:erc-color-face0 ((t (:foreground "white")))) + (fg:erc-color-face1 ((t (:foreground "beige")))) + (fg:erc-color-face2 ((t (:foreground "lemon chiffon")))) + (fg:erc-color-face3 ((t (:foreground "light cyan")))) + (fg:erc-color-face4 ((t (:foreground "powder blue")))) + (fg:erc-color-face5 ((t (:foreground "sky blue")))) + (fg:erc-color-face6 ((t (:foreground "dark sea green")))) + (fg:erc-color-face7 ((t (:foreground "pale green")))) + (fg:erc-color-face8 ((t (:foreground "medium spring green")))) + (fg:erc-color-face9 ((t (:foreground "khaki")))) + (fg:erc-color-face10 ((t (:foreground "pale goldenrod")))) + (fg:erc-color-face11 ((t (:foreground "light goldenrod yellow")))) + (fg:erc-color-face12 ((t (:foreground "light yellow")))) + (fg:erc-color-face13 ((t (:foreground "yellow")))) + (fg:erc-color-face14 ((t (:foreground "light goldenrod")))) + (fg:erc-color-face15 ((t (:foreground "lime green")))) + (bg:erc-color-face0 ((t (nil)))) + (bg:erc-color-face1 ((t (nil)))) + (bg:erc-color-face2 ((t (nil)))) + (bg:erc-color-face3 ((t (nil)))) + (bg:erc-color-face4 ((t (nil)))) + (bg:erc-color-face5 ((t (nil)))) + (bg:erc-color-face6 ((t (nil)))) + (bg:erc-color-face7 ((t (nil)))) + (bg:erc-color-face8 ((t (nil)))) + (bg:erc-color-face9 ((t (nil)))) + (bg:erc-color-face10 ((t (nil)))) + (bg:erc-color-face11 ((t (nil)))) + (bg:erc-color-face12 ((t (nil)))) + (bg:erc-color-face13 ((t (nil)))) + (bg:erc-color-face14 ((t (nil)))) + (bg:erc-color-face15 ((t (nil))))))) + +(defun color-theme-subtle-blue () + "Color theme by Chris McMahan, created 2001-09-06. +Light blue background. Includes bbdb, comint, cperl, custom, cvs, +diary, dired, display-time, ecb, ediff, erc, eshell, font-lock, +gnus, html-helper, info, isearch, jde, message, paren, semantic, +sgml, speedbar, term, vhdl, viper, vm, widget, woman, xref, xxml." + (interactive) + (color-theme-install + '(color-theme-subtle-blue + ((background-color . "#65889C") + (background-mode . dark) + (background-toolbar-color . "#cf3ccf3ccf3c") + (border-color . "black") + (bottom-toolbar-shadow-color . "#79e77df779e7") + (cursor-color . "white") + (foreground-color . "#eedfcc") + (mouse-color . "Grey") + (top-toolbar-shadow-color . "#fffffbeeffff") + (viper-saved-cursor-color-in-replace-mode . "Red3")) + ((blank-space-face . blank-space-face) + (blank-tab-face . blank-tab-face) + (ecb-source-in-directories-buffer-face . ecb-sources-face) + (gnus-mouse-face . highlight) + (list-matching-lines-face . bold) + (view-highlight-face . highlight) + (vm-highlight-url-face . my-url-face) + (vm-highlighted-header-face . my-url-face) + (vm-mime-button-face . gui-button-face) + (vm-summary-highlight-face . my-summary-highlight-face)) + (default ((t (nil)))) + (bbdb-company ((t (:italic t)))) + (bbdb-field-name ((t (:bold t :foreground "MediumAquamarine")))) + (bbdb-field-value ((t (nil)))) + (bbdb-name ((t (:underline t)))) + (blank-space-face ((t (:background "gray80")))) + (blank-tab-face ((t (:background "LightBlue" :foreground "DarkSlateGray")))) + (blue ((t (:foreground "blue")))) + (bold ((t (:bold t :foreground "MediumAquamarine")))) + (bold-italic ((t (:italic t :bold t :foreground "SkyBlue")))) + (border ((t (:background "black")))) + (border-glyph ((t (nil)))) + (calendar-today-face ((t (:underline t)))) + (comint-highlight-input ((t (:bold t)))) + (comint-highlight-prompt ((t (:foreground "cyan")))) + (comint-input-face ((t (:foreground "deepskyblue")))) + (cperl-array-face ((t (:bold t :foreground "Yellow")))) + (cperl-hash-face ((t (:italic t :bold t :foreground "White")))) + (cperl-nonoverridable-face ((t (:foreground "SkyBlue")))) + (cursor ((t (:background "white")))) + (custom-button-face ((t (:underline t :bold t :foreground "MediumAquaMarine")))) + (custom-button-pressed-face ((t (:background "lightgrey" :foreground "black")))) + (custom-changed-face ((t (:background "blue" :foreground "white")))) + (custom-comment-face ((t (:background "dim gray")))) + (custom-comment-tag-face ((t (:foreground "gray80")))) + (custom-documentation-face ((t (:foreground "Grey")))) + (custom-face-tag-face ((t (:underline t)))) + (custom-group-tag-face ((t (:bold t :foreground "MediumAquamarine")))) + (custom-group-tag-face-1 ((t (:foreground "MediumAquaMarine")))) + (custom-invalid-face ((t (:background "red" :foreground "yellow")))) + (custom-modified-face ((t (:background "blue" :foreground "white")))) + (custom-rogue-face ((t (:background "black" :foreground "pink")))) + (custom-saved-face ((t (:underline t)))) + (custom-set-face ((t (:background "white" :foreground "blue")))) + (custom-state-face ((t (:foreground "yellow")))) + (custom-variable-button-face ((t (:underline t :bold t)))) + (custom-variable-tag-face ((t (:bold t :foreground "Aquamarine")))) + (cvs-filename-face ((t (:foreground "blue4")))) + (cvs-handled-face ((t (:foreground "pink")))) + (cvs-header-face ((t (:bold t :foreground "blue4")))) + (cvs-marked-face ((t (:bold t :foreground "green3")))) + (cvs-msg-face ((t (:italic t)))) + (cvs-need-action-face ((t (:foreground "orange")))) + (cvs-unknown-face ((t (:foreground "red")))) + (diary-face ((t (:bold t :foreground "cyan")))) + (dired-face-boring ((t (:foreground "Gray65")))) + (dired-face-directory ((t (:bold t :foreground "sky blue")))) + (dired-face-executable ((t (:foreground "MediumAquaMarine")))) + (dired-face-flagged ((t (:foreground "Cyan")))) + (dired-face-marked ((t (:foreground "cyan")))) + (dired-face-permissions ((t (:foreground "aquamarine")))) + (dired-face-setuid ((t (:foreground "LightSalmon")))) + (dired-face-socket ((t (:foreground "LightBlue")))) + (dired-face-symlink ((t (:foreground "gray95")))) + (display-time-mail-balloon-enhance-face ((t (:background "orange")))) + (display-time-mail-balloon-gnus-group-face ((t (:foreground "blue")))) + (display-time-time-balloon-face ((t (:foreground "red")))) + (ecb-sources-face ((t (:foreground "LightBlue1")))) + (ediff-current-diff-face-A ((t (:background "pale green" :foreground "firebrick")))) + (ediff-current-diff-face-Ancestor ((t (:background "VioletRed" :foreground "Black")))) + (ediff-current-diff-face-B ((t (:background "Yellow" :foreground "DarkOrchid")))) + (ediff-current-diff-face-C ((t (:background "indianred" :foreground "white")))) + (ediff-even-diff-face-A ((t (:background "light gray" :foreground "Black")))) + (ediff-even-diff-face-Ancestor ((t (:background "Gray" :foreground "White")))) + (ediff-even-diff-face-B ((t (:background "Gray" :foreground "White")))) + (ediff-even-diff-face-C ((t (:background "light gray" :foreground "Black")))) + (ediff-fine-diff-face-A ((t (:background "sky blue" :foreground "Navy")))) + (ediff-fine-diff-face-Ancestor ((t (:background "Green" :foreground "Black")))) + (ediff-fine-diff-face-B ((t (:background "cyan" :foreground "Black")))) + (ediff-fine-diff-face-C ((t (:background "Turquoise" :foreground "Black")))) + (ediff-odd-diff-face-A ((t (:background "Gray" :foreground "White")))) + (ediff-odd-diff-face-Ancestor ((t (:background "light gray" :foreground "Black")))) + (ediff-odd-diff-face-B ((t (:background "light gray" :foreground "Black")))) + (ediff-odd-diff-face-C ((t (:background "Gray" :foreground "White")))) + (erc-action-face ((t (:bold t)))) + (erc-bold-face ((t (:bold t)))) + (erc-default-face ((t (nil)))) + (erc-direct-msg-face ((t (:foreground "LightSalmon")))) + (erc-error-face ((t (:bold t :foreground "yellow")))) + (erc-input-face ((t (:foreground "Beige")))) + (erc-inverse-face ((t (:background "wheat" :foreground "darkslategrey")))) + (erc-notice-face ((t (:foreground "MediumAquamarine")))) + (erc-pal-face ((t (:foreground "PaleGreen")))) + (erc-prompt-face ((t (:foreground "MediumAquamarine")))) + (erc-underline-face ((t (:underline t)))) + (eshell-ls-archive-face ((t (:bold t :foreground "wheat")))) + (eshell-ls-backup-face ((t (:foreground "Grey")))) + (eshell-ls-clutter-face ((t (:bold t :foreground "wheat")))) + (eshell-ls-directory-face ((t (:bold t :foreground "Yellow")))) + (eshell-ls-executable-face ((t (:bold t :foreground "wheat")))) + (eshell-ls-missing-face ((t (:bold t :foreground "wheat")))) + (eshell-ls-picture-face ((t (:foreground "wheat")))) + (eshell-ls-product-face ((t (:foreground "wheat")))) + (eshell-ls-readonly-face ((t (:foreground "wheat")))) + (eshell-ls-special-face ((t (:bold t :foreground "wheat")))) + (eshell-ls-symlink-face ((t (:bold t :foreground "White")))) + (eshell-ls-text-face ((t (:foreground "wheat")))) + (eshell-ls-todo-face ((t (:foreground "wheat")))) + (eshell-ls-unreadable-face ((t (:foreground "wheat3")))) + (eshell-prompt-face ((t (:bold t :foreground "PaleGreen")))) + (eshell-test-failed-face ((t (:bold t :foreground "OrangeRed")))) + (eshell-test-ok-face ((t (:bold t :foreground "Green")))) + (excerpt ((t (:italic t)))) + (ff-paths-non-existant-file-face ((t (:bold t :foreground "NavyBlue")))) + (flyspell-duplicate-face ((t (:underline t :bold t :foreground "Gold3")))) + (flyspell-incorrect-face ((t (:underline t :bold t :foreground "OrangeRed")))) + (font-latex-italic-face ((t (nil)))) + (font-latex-math-face ((t (nil)))) + (font-latex-sedate-face ((t (:foreground "Gray85")))) + (font-latex-string-face ((t (:foreground "orange")))) + (font-latex-warning-face ((t (:foreground "gold")))) + (font-lock-builtin-face ((t (:foreground "PaleGreen")))) + (font-lock-comment-face ((t (:italic t :foreground "Wheat3")))) + (font-lock-constant-face ((t (:foreground "LightBlue")))) + (font-lock-doc-face ((t (:bold t :foreground "DarkSeaGreen")))) + (font-lock-doc-string-face ((t (:bold t :foreground "DarkSeaGreen")))) + (font-lock-exit-face ((t (:foreground "green")))) + (font-lock-function-name-face ((t (:italic t :bold t :foreground "cyan")))) + (font-lock-keyword-face ((t (:bold t :foreground "LightBlue")))) + (font-lock-preprocessor-face ((t (:foreground "blue3")))) + (font-lock-reference-face ((t (:foreground "PaleGreen")))) + (font-lock-string-face ((t (:italic t :foreground "MediumAquamarine")))) + (font-lock-type-face ((t (:bold t :foreground "LightBlue")))) + (font-lock-variable-name-face ((t (:italic t :bold t :foreground "LightBlue")))) + (font-lock-warning-face ((t (:bold t :foreground "LightSalmon")))) + (fringe ((t (:background "darkslategrey")))) + (gnus-cite-attribution-face ((t (:italic t :bold t)))) + (gnus-cite-face-1 ((t (:foreground "LightBlue")))) + (gnus-cite-face-10 ((t (:foreground "LightBlue")))) + (gnus-cite-face-11 ((t (:foreground "LightBlue")))) + (gnus-cite-face-2 ((t (:foreground "LightBlue")))) + (gnus-cite-face-3 ((t (:foreground "LightBlue")))) + (gnus-cite-face-4 ((t (:foreground "LightBlue")))) + (gnus-cite-face-5 ((t (:foreground "LightBlue")))) + (gnus-cite-face-6 ((t (:foreground "LightBlue")))) + (gnus-cite-face-7 ((t (:foreground "LightBlue")))) + (gnus-cite-face-8 ((t (:foreground "LightBlue")))) + (gnus-cite-face-9 ((t (:foreground "LightBlue")))) + (gnus-emphasis-bold ((t (:bold t)))) + (gnus-emphasis-bold-italic ((t (:italic t :bold t)))) + (gnus-emphasis-highlight-words ((t (:background "black" :foreground "yellow")))) + (gnus-emphasis-italic ((t (:italic t)))) + (gnus-emphasis-underline ((t (:underline t)))) + (gnus-emphasis-underline-bold ((t (:underline t :bold t)))) + (gnus-emphasis-underline-bold-italic ((t (:underline t :italic t :bold t)))) + (gnus-emphasis-underline-italic ((t (:underline t :italic t)))) + (gnus-filterhist-face-1 ((t (nil)))) + (gnus-group-mail-1-empty-face ((t (:foreground "gray80")))) + (gnus-group-mail-1-face ((t (:bold t :foreground "light cyan")))) + (gnus-group-mail-2-empty-face ((t (:foreground "gray80")))) + (gnus-group-mail-2-face ((t (:bold t :foreground "turquoise")))) + (gnus-group-mail-3-empty-face ((t (:foreground "gray80")))) + (gnus-group-mail-3-face ((t (:bold t :foreground "LightBlue")))) + (gnus-group-mail-low-empty-face ((t (:foreground "gray80")))) + (gnus-group-mail-low-face ((t (:bold t :foreground "LightBlue")))) + (gnus-group-news-1-empty-face ((t (:foreground "gray80")))) + (gnus-group-news-1-face ((t (:bold t :foreground "green yellow")))) + (gnus-group-news-2-empty-face ((t (:foreground "gray80")))) + (gnus-group-news-2-face ((t (:bold t :foreground "Aquamarine")))) + (gnus-group-news-3-empty-face ((t (:foreground "gray80")))) + (gnus-group-news-3-face ((t (:bold t :foreground "LightBlue")))) + (gnus-group-news-4-empty-face ((t (:foreground "gray80")))) + (gnus-group-news-4-face ((t (:bold t :foreground "Wheat")))) + (gnus-group-news-5-empty-face ((t (:foreground "gray80")))) + (gnus-group-news-5-face ((t (:bold t :foreground "MediumAquamarine")))) + (gnus-group-news-6-empty-face ((t (:foreground "gray80")))) + (gnus-group-news-6-face ((t (:bold t :foreground "MediumAquamarine")))) + (gnus-group-news-low-empty-face ((t (:foreground "gray80")))) + (gnus-group-news-low-face ((t (:bold t :foreground "yellow green")))) + (gnus-header-content-face ((t (:italic t :foreground "LightSkyBlue3")))) + (gnus-header-from-face ((t (:bold t :foreground "light cyan")))) + (gnus-header-name-face ((t (:bold t :foreground "LightBlue")))) + (gnus-header-newsgroups-face ((t (:italic t :bold t :foreground "LightSkyBlue3")))) + (gnus-header-subject-face ((t (:bold t :foreground "light cyan")))) + (gnus-picons-face ((t (:background "white" :foreground "black")))) + (gnus-picons-xbm-face ((t (:background "white" :foreground "black")))) + (gnus-signature-face ((t (:italic t :foreground "LightBlue")))) + (gnus-splash ((t (:foreground "Brown")))) + (gnus-splash-face ((t (:foreground "LightBlue")))) + (gnus-summary-cancelled-face ((t (:background "black" :foreground "gray80")))) + (gnus-summary-high-ancient-face ((t (:bold t :foreground "LightBlue")))) + (gnus-summary-high-read-face ((t (:bold t :foreground "gray80")))) + (gnus-summary-high-ticked-face ((t (:bold t :foreground "burlywood")))) + (gnus-summary-high-unread-face ((t (:italic t :bold t :foreground "wheat")))) + (gnus-summary-low-ancient-face ((t (:italic t :foreground "LightBlue")))) + (gnus-summary-low-read-face ((t (:italic t :foreground "light sea green")))) + (gnus-summary-low-ticked-face ((t (:italic t :bold t :foreground "LightBlue")))) + (gnus-summary-low-unread-face ((t (:italic t :foreground "light sea green")))) + (gnus-summary-normal-ancient-face ((t (:foreground "gray80")))) + (gnus-summary-normal-read-face ((t (:foreground "gray80")))) + (gnus-summary-normal-ticked-face ((t (:bold t :foreground "sandy brown")))) + (gnus-summary-normal-unread-face ((t (:bold t :foreground "wheat")))) + (gnus-summary-selected-face ((t (:underline t)))) + (gnus-x-face ((t (:background "white" :foreground "black")))) + (green ((t (:foreground "green")))) + (gui-button-face ((t (:background "cyan" :foreground "#65889C")))) + (gui-element ((t (:background "Gray")))) + (header-line ((t (:background "grey20" :foreground "grey90")))) + (highlight ((t (:background "PaleGreen" :foreground "DarkGreen")))) + (highlight-changes-delete-face ((t (:underline t :foreground "red")))) + (highlight-changes-face ((t (:foreground "red")))) + (highline-face ((t (:background "SeaGreen")))) + (holiday-face ((t (:background "DimGray")))) + (html-helper-bold-face ((t (:foreground "DarkRed")))) + (html-helper-italic-face ((t (:foreground "DarkBlue")))) + (html-helper-underline-face ((t (:underline t :foreground "Black")))) + (html-tag-face ((t (:foreground "Blue")))) + (info-menu-5 ((t (:underline t)))) + (info-node ((t (:underline t :italic t :bold t :foreground "light blue")))) + (info-xref ((t (:bold t :foreground "light blue")))) + (isearch ((t (:background "Aquamarine" :foreground "SteelBlue")))) + (isearch-lazy-highlight-face ((t (:background "paleturquoise4")))) + (isearch-secondary ((t (:foreground "red3")))) + (italic ((t (:italic t)))) + (jde-bug-breakpoint-cursor ((t (:background "brown" :foreground "cyan")))) + (jde-bug-breakpoint-marker ((t (:background "yellow" :foreground "red")))) + (jde-java-font-lock-api-face ((t (:foreground "LightBlue")))) + (jde-java-font-lock-bold-face ((t (:bold t)))) + (jde-java-font-lock-code-face ((t (nil)))) + (jde-java-font-lock-constant-face ((t (:foreground "LightBlue")))) + (jde-java-font-lock-doc-tag-face ((t (:foreground "LightBlue")))) + (jde-java-font-lock-italic-face ((t (:italic t)))) + (jde-java-font-lock-link-face ((t (:underline t :foreground "LightBlue")))) + (jde-java-font-lock-modifier-face ((t (:foreground "LightBlue")))) + (jde-java-font-lock-number-face ((t (:foreground "LightBlue")))) + (jde-java-font-lock-package-face ((t (:foreground "LightBlue")))) + (jde-java-font-lock-pre-face ((t (nil)))) + (jde-java-font-lock-underline-face ((t (:underline t)))) + (lazy-highlight-face ((t (:bold t :foreground "dark magenta")))) + (left-margin ((t (nil)))) + (linemenu-face ((t (:background "gray30")))) + (list-mode-item-selected ((t (nil)))) + (makefile-space-face ((t (:background "hotpink")))) + (menu ((t (:background "wheat" :foreground "gray30")))) + (message-cited-text-face ((t (:foreground "White")))) + (message-header-cc-face ((t (:bold t :foreground "light cyan")))) + (message-header-name-face ((t (:foreground "LightBlue")))) + (message-header-newsgroups-face ((t (:italic t :bold t :foreground "LightSkyBlue3")))) + (message-header-other-face ((t (:foreground "LightSkyBlue3")))) + (message-header-subject-face ((t (:bold t :foreground "light cyan")))) + (message-header-to-face ((t (:bold t :foreground "light cyan")))) + (message-header-xheader-face ((t (:foreground "LightBlue")))) + (message-mml-face ((t (:bold t :foreground "LightBlue")))) + (message-separator-face ((t (:foreground "LightBlue")))) + (mmm-default-submode-face ((t (:background "#c0c0c5")))) + (modeline ((t (:background "#4f657d" :foreground "gray80")))) + (modeline-buffer-id ((t (:background "#4f657d" :foreground "gray80")))) + (modeline-mousable ((t (:background "#4f657d" :foreground "gray80")))) + (modeline-mousable-minor-mode ((t (:background "#4f657d" :foreground "gray80")))) + (mouse ((t (:background "Grey")))) + (my-summary-highlight-face ((t (:foreground "White")))) + (my-url-face ((t (:foreground "PaleTurquoise")))) + (nil ((t (nil)))) + (paren-blink-off ((t (:foreground "gray")))) + (paren-face-match ((t (:background "turquoise")))) + (paren-face-mismatch ((t (:background "purple" :foreground "white")))) + (paren-face-no-match ((t (:background "yellow" :foreground "black")))) + (paren-match ((t (:background "darkseagreen2")))) + (paren-mismatch ((t (:background "DeepPink" :foreground "black")))) + (paren-mismatch-face ((t (:bold t)))) + (paren-no-match-face ((t (:bold t)))) + (pointer ((t (nil)))) + (primary-selection ((t (:background "gray65")))) + (red ((t (:foreground "red")))) + (region ((t (:background "CadetBlue" :foreground "gray80")))) + (right-margin ((t (nil)))) + (scroll-bar ((t (nil)))) + (secondary-selection ((t (:background "LightBlue" :foreground "#4f657d")))) + (semantic-dirty-token-face ((t (:background "gray10")))) + (semantic-intangible-face ((t (:foreground "gray25")))) + (semantic-read-only-face ((t (:background "gray25")))) + (senator-intangible-face ((t (:foreground "gray75")))) + (senator-momentary-highlight-face ((t (:background "gray80")))) + (senator-read-only-face ((t (:background "#664444")))) + (sgml-comment-face ((t (:foreground "dark turquoise")))) + (sgml-doctype-face ((t (:foreground "red")))) + (sgml-end-tag-face ((t (:foreground "blue")))) + (sgml-entity-face ((t (:foreground "magenta")))) + (sgml-ignored-face ((t (:background "gray60" :foreground "gray40")))) + (sgml-ms-end-face ((t (:foreground "green")))) + (sgml-ms-start-face ((t (:foreground "yellow")))) + (sgml-pi-face ((t (:foreground "lime green")))) + (sgml-sgml-face ((t (:foreground "brown")))) + (sgml-short-ref-face ((t (:foreground "deep sky blue")))) + (sgml-start-tag-face ((t (:foreground "dark green")))) + (shell-option-face ((t (:foreground "blue")))) + (shell-output-2-face ((t (:foreground "darkseagreen")))) + (shell-output-3-face ((t (:foreground "slategray")))) + (shell-output-face ((t (:foreground "palegreen")))) + (shell-prompt-face ((t (:foreground "red")))) + (show-paren-match-face ((t (:background "Aquamarine" :foreground "steel blue")))) + (show-paren-mismatch-face ((t (:bold t :background "IndianRed" :foreground "White")))) + (speedbar-button-face ((t (:bold t :foreground "LightBlue")))) + (speedbar-directory-face ((t (:bold t :foreground "yellow")))) + (speedbar-file-face ((t (:bold t :foreground "wheat")))) + (speedbar-highlight-face ((t (:background "sea green")))) + (speedbar-selected-face ((t (:underline t)))) + (speedbar-tag-face ((t (:foreground "LightBlue")))) + (swbuff-current-buffer-face ((t (:bold t :foreground "red")))) + (template-message-face ((t (:bold t)))) + (term-black ((t (:foreground "black")))) + (term-blackbg ((t (:background "black")))) + (term-blue ((t (:foreground "blue")))) + (term-bluebg ((t (:background "blue")))) + (term-bold ((t (:bold t)))) + (term-cyan ((t (:foreground "cyan")))) + (term-cyanbg ((t (:background "cyan")))) + (term-default-bg ((t (nil)))) + (term-default-bg-inv ((t (nil)))) + (term-default-fg ((t (nil)))) + (term-default-fg-inv ((t (nil)))) + (term-green ((t (:foreground "green")))) + (term-greenbg ((t (:background "green")))) + (term-invisible ((t (nil)))) + (term-invisible-inv ((t (nil)))) + (term-magenta ((t (:foreground "magenta")))) + (term-magentabg ((t (:background "magenta")))) + (term-red ((t (:foreground "red")))) + (term-redbg ((t (:background "red")))) + (term-underline ((t (:underline t)))) + (term-white ((t (:foreground "white")))) + (term-whitebg ((t (:background "white")))) + (term-yellow ((t (:foreground "yellow")))) + (term-yellowbg ((t (:background "yellow")))) + (text-cursor ((t (:background "Red3" :foreground "white")))) + (tool-bar ((t (:background "grey75" :foreground "black")))) + (toolbar ((t (:background "Gray")))) + (trailing-whitespace ((t (:background "red")))) + (underline ((t (:underline t)))) + (variable-pitch ((t (nil)))) + (vc-annotate-face-0046FF ((t (:background "black" :foreground "wheat")))) + (vcursor ((t (:underline t :background "cyan" :foreground "blue")))) + (vertical-divider ((t (:background "Gray")))) + (vhdl-font-lock-attribute-face ((t (:foreground "Orchid")))) + (vhdl-font-lock-directive-face ((t (:foreground "CadetBlue")))) + (vhdl-font-lock-enumvalue-face ((t (:foreground "Gold4")))) + (vhdl-font-lock-function-face ((t (:foreground "Orchid4")))) + (vhdl-font-lock-prompt-face ((t (:bold t :foreground "Red")))) + (vhdl-font-lock-reserved-words-face ((t (:bold t :foreground "Orange")))) + (vhdl-font-lock-translate-off-face ((t (:background "LightGray")))) + (vhdl-speedbar-architecture-face ((t (:foreground "Blue")))) + (vhdl-speedbar-architecture-selected-face ((t (:underline t :foreground "Blue")))) + (vhdl-speedbar-configuration-face ((t (:foreground "DarkGoldenrod")))) + (vhdl-speedbar-configuration-selected-face ((t (:underline t :foreground "DarkGoldenrod")))) + (vhdl-speedbar-entity-face ((t (:foreground "ForestGreen")))) + (vhdl-speedbar-entity-selected-face ((t (:underline t :foreground "ForestGreen")))) + (vhdl-speedbar-instantiation-face ((t (:foreground "Brown")))) + (vhdl-speedbar-instantiation-selected-face ((t (:underline t :foreground "Brown")))) + (vhdl-speedbar-package-face ((t (:foreground "Gray50")))) + (vhdl-speedbar-package-selected-face ((t (:underline t :foreground "Gray50")))) + (viper-minibuffer-emacs-face ((t (:background "darkseagreen2" :foreground "Black")))) + (viper-minibuffer-insert-face ((t (:background "pink" :foreground "Black")))) + (viper-minibuffer-vi-face ((t (:background "gray" :foreground "DarkGreen")))) + (viper-replace-overlay-face ((t (:background "darkseagreen2" :foreground "Black")))) + (viper-search-face ((t (:background "khaki" :foreground "Black")))) + (vm-header-content-face ((t (:italic t :foreground "gray80")))) + (vm-header-from-face ((t (:italic t :background "#65889C" :foreground "cyan")))) + (vm-header-name-face ((t (:foreground "cyan")))) + (vm-header-subject-face ((t (:foreground "cyan")))) + (vm-header-to-face ((t (:italic t :foreground "cyan")))) + (vm-message-cited-face ((t (:foreground "Gray80")))) + (vm-summary-face-1 ((t (:foreground "MediumAquamarine")))) + (vm-summary-face-2 ((t (:foreground "MediumAquamarine")))) + (vm-summary-face-3 ((t (:foreground "MediumAquamarine")))) + (vm-summary-face-4 ((t (:foreground "MediumAquamarine")))) + (vm-summary-highlight-face ((t (:foreground "White")))) + (vmpc-pre-sig-face ((t (:foreground "Aquamarine")))) + (vmpc-sig-face ((t (:foreground "LightBlue")))) + (vvb-face ((t (:background "pink" :foreground "black")))) + (widget-button-face ((t (:bold t)))) + (widget-button-pressed-face ((t (:foreground "cyan")))) + (widget-documentation-face ((t (:foreground "LightBlue")))) + (widget-field-face ((t (:foreground "LightBlue")))) + (widget-inactive-face ((t (:foreground "Wheat3")))) + (widget-single-line-field-face ((t (:foreground "LightBlue")))) + (woman-bold-face ((t (:bold t)))) + (woman-italic-face ((t (:foreground "beige")))) + (woman-unknown-face ((t (:foreground "LightSalmon")))) + (xref-keyword-face ((t (:foreground "Cyan")))) + (xref-list-pilot-face ((t (:foreground "navy")))) + (xref-list-symbol-face ((t (:foreground "navy")))) + (xxml-emph-1-face ((t (:background "lightyellow")))) + (xxml-emph-2-face ((t (:background "lightyellow")))) + (xxml-header-1-face ((t (:background "seashell1" :foreground "MediumAquamarine")))) + (xxml-header-2-face ((t (:background "seashell1" :foreground "SkyBlue")))) + (xxml-header-3-face ((t (:background "seashell1")))) + (xxml-header-4-face ((t (:background "seashell1")))) + (xxml-interaction-face ((t (:background "lightcyan")))) + (xxml-rug-face ((t (:background "cyan")))) + (xxml-sparkle-face ((t (:background "yellow")))) + (xxml-unbreakable-space-face ((t (:underline t :foreground "grey")))) + (yellow ((t (:foreground "yellow")))) + (zmacs-region ((t (:background "#4f657d"))))))) + +(defun color-theme-dark-blue () + "Color theme by Chris McMahan, created 2001-09-09. +Based on `color-theme-subtle-blue' with a slightly darker background." + (interactive) + (color-theme-subtle-blue) + (let ((color-theme-is-cumulative t)) + (color-theme-install + '(color-theme-dark-blue + ((background-color . "#537182") + (foreground-color . "AntiqueWhite2")) + nil + (default ((t (nil)))) + (blank-space-face ((t (:background "LightGray")))) + (blank-tab-face ((t (:background "Wheat" :foreground "DarkSlateGray")))) + (cursor ((t (:background "LightGray")))) + (dired-face-executable ((t (:foreground "green yellow")))) + (dired-face-flagged ((t (:foreground "tomato")))) + (dired-face-marked ((t (:foreground "light salmon")))) + (dired-face-setuid ((t (:foreground "Red")))) + (dired-face-socket ((t (:foreground "magenta")))) + (fixed ((t (:bold t)))) + (font-lock-comment-face ((t (:italic t :foreground "Gray80")))) + (font-lock-doc-face ((t (:bold t)))) + (font-lock-function-name-face ((t (:italic t :bold t :foreground "Yellow")))) + (font-lock-string-face ((t (:italic t :foreground "DarkSeaGreen")))) + (font-lock-type-face ((t (:bold t :foreground "YellowGreen")))) + (gui-button-face ((t (:background "DarkSalmon" :foreground "white")))) + (modeline ((t (:background "#c1ccd9" :foreground "#4f657d")))) + (modeline-buffer-id ((t (:background "#c1ccd9" :foreground "#4f657d")))) + (modeline-mousable ((t (:background "#c1ccd9" :foreground "#4f657d")))) + (modeline-mousable-minor-mode ((t (:background "#c1ccd9" :foreground "#4f657d")))) + (my-url-face ((t (:foreground "LightBlue")))) + (region ((t (:background "PaleTurquoise4" :foreground "gray80")))) + (secondary-selection ((t (:background "sea green" :foreground "yellow")))) + (vm-header-content-face ((t (:italic t :foreground "wheat")))) + (vm-header-from-face ((t (:italic t :foreground "wheat")))) + (widget-button-pressed-face ((t (:foreground "red")))) + (xref-keyword-face ((t (:foreground "blue")))) + (zmacs-region ((t (:background "SlateGray")))))))) + +(defun color-theme-jonadabian-slate () + "Another slate-and-wheat color theme by Jonadab the Unsightly One. +Updated 2001-10-12." + (interactive) + (color-theme-install + '(color-theme-jonadabian-slate + ((background-color . "#305050") + (background-mode . dark) + (border-color . "black") + (cursor-color . "medium turquoise") + (foreground-color . "#CCBB77") + (mouse-color . "black")) + ((list-matching-lines-face . bold) + (ued-mode-keyname-face . modeline) + (view-highlight-face . highlight)) + (default ((t (nil)))) + (fringe ((t (:background "#007080")))) + (bold ((t (:bold t :foreground "#EEDDAA")))) + (gnus-emphasis-bold ((t (:bold t :foreground "#EEDDAA")))) + (gnus-emphasis-underline-bold ((t (:underline t :bold t :foreground "#EEDDAA")))) + (bold-italic ((t (:italic t :bold t :foreground "#AA0000")))) + (gnus-emphasis-bold-italic ((t (:italic t :bold t :foreground "#AA0000")))) + (gnus-emphasis-underline-bold-italic ((t (:underline t :italic t :bold t :foreground "#AA0000")))) + (gnus-emphasis-underline-italic ((t (:underline t :italic t :bold t :foreground "#AA0000")))) + (calendar-today-face ((t (:underline t :background "darkslategrey")))) + (cperl-array-face ((t (:background "#004060")))) + (cperl-hash-face ((t (:background "#004400")))) + (custom-button-face ((t (:background "dark blue" :foreground "rgbi:1.00/1.00/0.00")))) + (custom-documentation-face ((t (:foreground "#10D010")))) + (custom-face-tag-face ((t (:underline t :foreground "goldenrod")))) + (custom-group-tag-face ((t (:underline t :foreground "light blue")))) + (custom-group-tag-face-1 ((t (:underline t :foreground "pink")))) + (custom-invalid-face ((t (:background "red" :foreground "yellow")))) + (custom-modified-face ((t (:background "blue" :foreground "white")))) + (custom-rogue-face ((t (:background "black" :foreground "pink")))) + (custom-saved-face ((t (:underline t)))) + (custom-set-face ((t (:foreground "#6666dd")))) + (custom-state-face ((t (:foreground "mediumaquamarine")))) + (custom-variable-button-face ((t (:underline t :bold t)))) + (custom-variable-tag-face ((t (:underline t :foreground "light blue")))) + (diary-face ((t (:foreground "red")))) + (eshell-ls-archive-face ((t (:foreground "green")))) + (eshell-ls-backup-face ((t (:foreground "grey60")))) + (eshell-ls-clutter-face ((t (:bold t :foreground "OrangeRed")))) + (eshell-ls-directory-face ((t (:bold t :foreground "SkyBlue")))) + (eshell-ls-executable-face ((t (:foreground "white")))) + (eshell-ls-missing-face ((t (:foreground "red")))) + (eshell-ls-product-face ((t (:foreground "LightSalmon")))) + (eshell-ls-readonly-face ((t (:foreground "indian red")))) + (eshell-ls-special-face ((t (:foreground "yellow")))) + (eshell-ls-symlink-face ((t (:foreground "#6666dd")))) + (eshell-ls-unreadable-face ((t (:foreground "red")))) + (eshell-prompt-face ((t (:bold t :background "#305050" :foreground "#EEDD99")))) + (font-lock-builtin-face ((t (:foreground "LightSteelBlue")))) + (font-lock-comment-face ((t (:italic t :bold t :foreground "grey66")))) + (font-lock-constant-face ((t (:foreground "indian red")))) + (font-lock-function-name-face ((t (:foreground "#D0D000")))) + (font-lock-keyword-face ((t (:foreground "#00BBBB")))) + (font-lock-string-face ((t (:foreground "#10D010")))) + (font-lock-type-face ((t (:bold t :foreground "#ff7788")))) + (font-lock-variable-name-face ((t (:foreground "#eeddaa")))) + (font-lock-warning-face ((t (:bold t :foreground "Pink")))) + (header-line ((t (:box (:line-width 1 :style released-button))))) + (highlight ((t (:background "#226644")))) + (highlight-changes-delete-face ((t (:background "navy" :foreground "red")))) + (highlight-changes-face ((t (:background "navy")))) + (holiday-face ((t (:foreground "#ff7744")))) + (italic ((t (:italic t :foreground "#AA0000")))) + (gnus-emphasis-italic ((t (:italic t :foreground "#AA0000")))) + (modeline ((t (:background "#007080" :foreground "cyan")))) + (modeline-buffer-id ((t (:background "#007080" :foreground "cyan")))) + (modeline-mousable ((t (:background "#007080" :foreground "cyan")))) + (modeline-mousable-minor-mode ((t (:background "#007080" :foreground "cyan")))) + (region ((t (:background "#226644")))) + (secondary-selection ((t (:background "darkslategrey")))) + (sgml-comment-face ((t (:foreground "grey60")))) + (sgml-doctype-face ((t (:foreground "red")))) + (sgml-end-tag-face ((t (:foreground "#00D0D0")))) + (sgml-entity-face ((t (:foreground "indian red")))) + (sgml-ignored-face ((t (:background "gray60" :foreground "gray40")))) + (sgml-ms-end-face ((t (:foreground "green")))) + (sgml-ms-start-face ((t (:foreground "green")))) + (sgml-pi-face ((t (:foreground "lime green")))) + (sgml-sgml-face ((t (:foreground "brown")))) + (sgml-short-ref-face ((t (:foreground "deep sky blue")))) + (sgml-start-tag-face ((t (:foreground "#D0D000")))) + (show-paren-match-face ((t (:background "#400055" :foreground "cyan")))) + (show-paren-mismatch-face ((t (:background "red")))) + (special-string-face ((t (:foreground "light green")))) + (term-black ((t (:background "#000055" :foreground "black")))) + (term-blackbg ((t (:background "black" :foreground "#CCBB77")))) + (term-blue ((t (:background "#000055" :foreground "blue")))) + (term-bluebg ((t (:background "blue" :foreground "#CCBB77")))) + (term-bold ((t (:bold t :background "#000055" :foreground "#CCBB77")))) + (term-cyan ((t (:background "#000055" :foreground "cyan")))) + (term-cyanbg ((t (:background "darkcyan")))) + (term-default-bg ((t (:foreground "#CCBB77")))) + (term-default-bg-inv ((t (:foreground "#CCBB77")))) + (term-default-fg ((t (:background "#000055")))) + (term-default-fg-inv ((t (:background "#000055")))) + (term-green ((t (:background "#000055" :foreground "green")))) + (term-greenbg ((t (:background "darkgreen")))) + (term-invisible ((t (:foreground "#CCBB77")))) + (term-invisible-inv ((t (:foreground "#CCBB77")))) + (term-magenta ((t (:background "#000055" :foreground "magenta")))) + (term-magentabg ((t (:background "darkmagenta")))) + (term-red ((t (:background "#000055" :foreground "red")))) + (term-redbg ((t (:background "darkred")))) + (term-underline ((t (:underline t :background "#000055" :foreground "#CCBB77")))) + (term-white ((t (:background "#000055" :foreground "white")))) + (term-whitebg ((t (:background "grey50")))) + (term-yellow ((t (:background "#000055" :foreground "yellow")))) + (term-yellowbg ((t (:background "#997700")))) + (trailing-whitespace ((t (:background "#23415A")))) + (underline ((t (:underline t)))) + (gnus-emphasis-underline ((t (:underline t)))) + (widget-button-face ((t (:bold t)))) + (widget-button-pressed-face ((t (:foreground "red")))) + (widget-documentation-face ((t (:foreground "green")))) + (widget-field-face ((t (:background "grey35" :foreground "black")))) + (widget-inactive-face ((t (:foreground "gray")))) + (widget-single-line-field-face ((t (:background "dim gray"))))))) + +(defun color-theme-gray1 () + "Color theme by Paul Pulli, created 2001-10-19." + (interactive) + (color-theme-install + '(color-theme-gray1 + ((background-color . "darkgray") + (background-mode . light) + (background-toolbar-color . "#949494949494") + (border-color . "#000000000000") + (bottom-toolbar-shadow-color . "#595959595959") + (cursor-color . "Yellow") + (foreground-color . "black") + (top-toolbar-shadow-color . "#b2b2b2b2b2b2")) + nil + (default ((t (nil)))) + (blue ((t (:foreground "blue")))) + (bold ((t (:bold t)))) + (bold-italic ((t (:italic t :bold t)))) + (border-glyph ((t (nil)))) + (cperl-here-face ((t (:background "gray68" :foreground "DeepPink")))) + (font-lock-builtin-face ((t (:bold t :foreground "red3")))) + (font-lock-comment-face ((t (:foreground "gray50")))) + (font-lock-constant-face ((t (:bold t :foreground "blue3")))) + (font-lock-doc-string-face ((t (:foreground "black")))) + (font-lock-function-name-face ((t (:bold t :foreground "DeepPink3")))) + (font-lock-keyword-face ((t (:bold t :foreground "red")))) + (font-lock-other-type-face ((t (:bold t :foreground "green4")))) + (font-lock-preprocessor-face ((t (:bold t :foreground "blue3")))) + (font-lock-reference-face ((t (:bold t :foreground "red3")))) + (font-lock-string-face ((t (:foreground "red")))) + (font-lock-type-face ((t (:bold t :foreground "white")))) + (font-lock-variable-name-face ((t (:bold t :foreground "blue3")))) + (font-lock-warning-face ((t (:bold t :foreground "Red")))) + (green ((t (:foreground "green4")))) + (gui-button-face ((t (:background "black" :foreground "red")))) + (gui-element ((t (:background "gray58")))) + (highlight ((t (:background "magenta" :foreground "yellow")))) + (isearch ((t (:background "red" :foreground "yellow")))) + (italic ((t (:italic t)))) + (left-margin ((t (nil)))) + (list-mode-item-selected ((t (:background "gray90" :foreground "purple")))) + (m4-face ((t (:background "gray90" :foreground "orange3")))) + (message-cited-text ((t (nil)))) + (message-header-contents ((t (nil)))) + (message-headers ((t (nil)))) + (message-highlighted-header-contents ((t (nil)))) + (modeline ((t (:background "#aa80aa" :foreground "White")))) + (modeline-buffer-id ((t (:background "#aa80aa" :foreground "linen")))) + (modeline-mousable ((t (:background "#aa80aa" :foreground "cyan")))) + (modeline-mousable-minor-mode ((t (:background "#aa80aa" :foreground "yellow")))) + (paren-blink-off ((t (:foreground "gray58")))) + (paren-blink-on ((t (:foreground "purple")))) + (paren-match ((t (:background "gray68" :foreground "white")))) + (paren-mismatch ((t (:background "DeepPink" :foreground "black")))) + (pointer ((t (nil)))) + (primary-selection ((t (:background "gray")))) + (red ((t (:foreground "red")))) + (right-margin ((t (nil)))) + (secondary-selection ((t (:background "paleturquoise")))) + (text-cursor ((t (:background "Yellow" :foreground "darkgray")))) + (toolbar ((t (:background "#aa80aa" :foreground "linen")))) + (underline ((t (:underline t)))) + (vertical-divider ((t (nil)))) + (x-face ((t (:background "black" :foreground "lavenderblush")))) + (yellow ((t (:foreground "yellow3")))) + (zmacs-region ((t (:background "paleturquoise" :foreground "black"))))))) + +(defun color-theme-word-perfect () + "White on blue background, based on WordPerfect 5.1. +Color theme by Thomas Gehrlein, created 2001-10-21." + (interactive) + (color-theme-install + '(color-theme-word-perfect + ((background-color . "blue4") + (background-mode . dark) + (border-color . "black") + (cursor-color . "gold") + (foreground-color . "white") + (mouse-color . "black")) + ((ecb-source-in-directories-buffer-face . ecb-sources-face) + (gnus-mouse-face . highlight) + (goto-address-mail-face . italic) + (goto-address-mail-mouse-face . secondary-selection) + (goto-address-url-face . bold) + (goto-address-url-mouse-face . highlight) + (list-matching-lines-face . bold) + (view-highlight-face . highlight)) + (default ((t (nil)))) + (bbdb-field-name ((t (:foreground "lime green")))) + (bbdb-field-value ((t (:foreground "white")))) + (bbdb-name ((t (:underline t :foreground "lime green")))) + (bold ((t (:bold t :foreground "white")))) + (bold-italic ((t (:italic t :bold t :foreground "yellow")))) + (calendar-today-face ((t (:underline t :foreground "deep sky blue")))) + (diary-face ((t (:foreground "gold")))) + (ecb-sources-face ((t (:foreground "LightBlue1")))) + (edb-inter-field-face ((t (:foreground "deep sky blue")))) + (edb-normal-summary-face ((t (:foreground "gold")))) + (emacs-wiki-bad-link-face ((t (:underline "coral" :bold t :foreground "coral")))) + (emacs-wiki-link-face ((t (:underline "cyan" :bold t :foreground "cyan")))) + (font-lock-builtin-face ((t (:foreground "LightSteelBlue")))) + (font-lock-comment-face ((t (:foreground "deep sky blue")))) + (font-lock-constant-face ((t (:foreground "lime green")))) + (font-lock-doc-face ((t (:foreground "gold")))) + (font-lock-doc-string-face ((t (:foreground "gold")))) + (font-lock-function-name-face ((t (:background "blue4" :foreground "IndianRed")))) + (font-lock-keyword-face ((t (:foreground "lime green")))) + (font-lock-preprocessor-face ((t (:foreground "lime green")))) + (font-lock-reference-face ((t (:foreground "LightSteelBlue")))) + (font-lock-string-face ((t (:foreground "gold")))) + (font-lock-type-face ((t (:foreground "lime green")))) + (font-lock-variable-name-face ((t (:foreground "LightGoldenrod")))) + (font-lock-warning-face ((t (:bold t :foreground "firebrick")))) + (gnus-emphasis-bold ((t (:foreground "yellow2")))) + (gnus-emphasis-bold-italic ((t (:foreground "yellow2")))) + (gnus-emphasis-italic ((t (:foreground "yellow2")))) + (gnus-emphasis-underline ((t (:foreground "yellow2")))) + (gnus-emphasis-underline-bold ((t (:foreground "yellow2")))) + (gnus-emphasis-underline-bold-italic ((t (:foreground "yellow2")))) + (gnus-emphasis-underline-italic ((t (:foreground "yellow2")))) + (gnus-group-mail-1-empty-face ((t (:foreground "aquamarine1")))) + (gnus-group-mail-1-face ((t (:bold t :foreground "aquamarine1")))) + (gnus-group-mail-2-empty-face ((t (:foreground "aquamarine2")))) + (gnus-group-mail-2-face ((t (:bold t :foreground "aquamarine2")))) + (gnus-group-mail-3-empty-face ((t (:foreground "aquamarine3")))) + (gnus-group-mail-3-face ((t (:bold t :foreground "aquamarine3")))) + (gnus-group-mail-low-empty-face ((t (:foreground "aquamarine4")))) + (gnus-group-mail-low-face ((t (:bold t :foreground "aquamarine4")))) + (gnus-group-news-1-empty-face ((t (:foreground "PaleTurquoise")))) + (gnus-group-news-1-face ((t (:bold t :foreground "PaleTurquoise")))) + (gnus-group-news-2-empty-face ((t (:foreground "turquoise")))) + (gnus-group-news-2-face ((t (:bold t :foreground "turquoise")))) + (gnus-group-news-3-empty-face ((t (:foreground "deep sky blue")))) + (gnus-group-news-3-face ((t (:bold t :foreground "deep sky blue")))) + (gnus-group-news-low-empty-face ((t (:foreground "DarkTurquoise")))) + (gnus-group-news-low-face ((t (:bold t :foreground "DarkTurquoise")))) + (gnus-header-content-face ((t (:foreground "gold")))) + (gnus-header-from-face ((t (:foreground "gold")))) + (gnus-header-name-face ((t (:foreground "deep sky blue")))) + (gnus-header-newsgroups-face ((t (:foreground "gold")))) + (gnus-header-subject-face ((t (:foreground "gold")))) + (gnus-signature-face ((t (:foreground "gold")))) + (gnus-splash-face ((t (:foreground "firebrick")))) + (gnus-summary-cancelled-face ((t (:background "black" :foreground "deep sky blue")))) + (gnus-summary-high-ancient-face ((t (:bold t :foreground "deep sky blue")))) + (gnus-summary-high-read-face ((t (:bold t :foreground "deep sky blue")))) + (gnus-summary-high-ticked-face ((t (:bold t :foreground "deep sky blue")))) + (gnus-summary-high-unread-face ((t (:bold t :foreground "lime green")))) + (gnus-summary-low-ancient-face ((t (:italic t :foreground "deep sky blue")))) + (gnus-summary-low-read-face ((t (:italic t :foreground "deep sky blue")))) + (gnus-summary-low-ticked-face ((t (:italic t :foreground "deep sky blue")))) + (gnus-summary-low-unread-face ((t (:italic t :foreground "lime green")))) + (gnus-summary-normal-ancient-face ((t (:foreground "deep sky blue")))) + (gnus-summary-normal-read-face ((t (:foreground "deep sky blue")))) + (gnus-summary-normal-ticked-face ((t (:foreground "deep sky blue")))) + (gnus-summary-normal-unread-face ((t (:foreground "lime green")))) + (gnus-summary-selected-face ((t (:underline t :foreground "gold")))) + (highlight ((t (:background "steel blue" :foreground "black")))) + (holiday-face ((t (:background "blue4" :foreground "IndianRed1")))) + (info-menu-5 ((t (:underline t :foreground "gold")))) + (info-node ((t (:italic t :bold t :foreground "gold")))) + (info-xref ((t (:bold t :foreground "gold")))) + (isearch ((t (:background "firebrick" :foreground "white")))) + (italic ((t (:italic t :foreground "yellow2")))) + (message-cited-text-face ((t (:foreground "gold")))) + (message-header-cc-face ((t (:bold t :foreground "green4")))) + (message-header-name-face ((t (:foreground "deep sky blue")))) + (message-header-newsgroups-face ((t (:italic t :bold t :foreground "gold")))) + (message-header-other-face ((t (:foreground "gold")))) + (message-header-subject-face ((t (:foreground "gold")))) + (message-header-to-face ((t (:bold t :foreground "gold")))) + (message-header-xheader-face ((t (:foreground "blue")))) + (message-separator-face ((t (:foreground "lime green")))) + (modeline ((t (:foreground "white" :background "black")))) + (modeline-buffer-id ((t (:foreground "white" :background "black")))) + (modeline-mousable ((t (:foreground "white" :background "black")))) + (modeline-mousable-minor-mode ((t (:foreground "white" :background "black")))) + (overlay-empty-face ((t (nil)))) + (primary-selection ((t (:background "firebrick" :foreground "white")))) + (region ((t (:background "firebrick" :foreground "white")))) + (secondary-selection ((t (:background "yellow2" :foreground "black")))) + (semantic-dirty-token-face ((t (:background "gray10")))) + (show-paren-match-face ((t (:background "deep sky blue" :foreground "black")))) + (show-paren-mismatch-face ((t (:background "firebrick" :foreground "white")))) + (underline ((t (:underline t :background "blue4" :foreground "white"))))))) + +;; In order to produce this, follow these steps: +;; +;; 0. Make sure .Xresources and .Xdefaults don't have any Emacs related +;; entries. +;; +;; 1. cd into the Emacs lisp directory and run the following command: +;; ( for d in `find -type d`; \ +;; do grep --files-with-matches 'defface[ ]' $d/*.el; \ +;; done ) | sort | uniq +;; Put the result in a lisp block, using load-library calls. +;; +;; Repeat this for any directories on your load path which you want to +;; include in the standard. This might include W3, eshell, etc. +;; +;; Add some of the libraries that don't use defface: +;; +;; 2. Start emacs using the --no-init-file and --no-site-file command line +;; arguments. Evaluate the lisp block you prepared. +;; 3. Load color-theme and run color-theme-print. Save the output and use it +;; to define color-theme-standard. +;; +;; (progn +;; (load-library "add-log") +;; (load-library "calendar") +;; (load-library "comint") +;; (load-library "cus-edit") +;; (load-library "cus-face") +;; (load-library "custom") +;; (load-library "diff-mode") +;; (load-library "ediff-init") +;; (load-library "re-builder") +;; (load-library "viper-init") +;; (load-library "enriched") +;; (load-library "em-ls") +;; (load-library "em-prompt") +;; (load-library "esh-test") +;; (load-library "faces") +;; (load-library "font-lock") +;; (load-library "generic-x") +;; (load-library "gnus-art") +;; (load-library "gnus-cite") +;; (load-library "gnus") +;; (load-library "message") +;; (load-library "hilit-chg") +;; (load-library "hi-lock") +;; (load-library "info") +;; (load-library "isearch") +;; (load-library "log-view") +;; (load-library "paren") +;; (load-library "pcvs-info") +;; (load-library "antlr-mode") +;; (load-library "cperl-mode") +;; (load-library "ebrowse") +;; (load-library "idlwave") +;; (load-library "idlw-shell") +;; (load-library "make-mode") +;; (load-library "sh-script") +;; (load-library "vhdl-mode") +;; (load-library "smerge-mode") +;; (load-library "speedbar") +;; (load-library "strokes") +;; (load-library "artist") +;; (load-library "flyspell") +;; (load-library "texinfo") +;; (load-library "tex-mode") +;; (load-library "tooltip") +;; (load-library "vcursor") +;; (load-library "wid-edit") +;; (load-library "woman") +;; (load-library "term") +;; (load-library "man") +;; (load-file "/home/alex/elisp/color-theme.el") +;; (color-theme-print)) +;; +;; 4. Make the color theme usable on Xemacs (add more faces, resolve +;; :inherit attributes) +;; +(defun color-theme-emacs-21 () + "Color theme used by Emacs 21.1. +Added and adapted for XEmacs by Alex Schroeder. Adaptation mostly +consisted of resolving :inherit attributes and adding missing faces. +This theme includes faces from the following Emacs libraries: add-log +calendar comint cus-edit cus-face custom diff-mode ediff-init re-builder +viper-init enriched em-ls em-prompt esh-test faces font-lock generic-x +gnus-art gnus-cite gnus message hilit-chg hi-lock info isearch log-view +paren pcvs-info antlr-mode cperl-mode ebrowse idlwave idlw-shell +make-mode sh-script vhdl-mode smerge-mode speedbar strokes artist +flyspell texinfo tex-mode tooltip vcursor wid-edit woman term man" + (interactive) + (color-theme-install + '(color-theme-emacs-21 + ((background-color . "white") + (background-mode . light) + (border-color . "black") + (cursor-color . "black") + (foreground-color . "black") + (mouse-color . "black")) + ((Man-overstrike-face . bold) + (Man-underline-face . underline) + (cperl-here-face . font-lock-string-face) + (cperl-invalid-face . underline) + (cperl-pod-face . font-lock-comment-face) + (cperl-pod-head-face . font-lock-variable-name-face) + (gnus-article-button-face . bold) + (gnus-article-mouse-face . highlight) + (gnus-cite-attribution-face . gnus-cite-attribution-face) + (gnus-mouse-face . highlight) + (gnus-signature-face . gnus-signature-face) + (gnus-summary-selected-face . gnus-summary-selected-face) + (help-highlight-face . underline) + (idlwave-class-arrow-face . bold) + (idlwave-shell-breakpoint-face . idlwave-shell-bp-face) + (idlwave-shell-expression-face . secondary-selection) + (idlwave-shell-stop-line-face . highlight) + (ispell-highlight-face . highlight) + (list-matching-lines-face . bold) + (view-highlight-face . highlight) + (viper-insert-state-cursor-color . "Green") + (viper-replace-overlay-cursor-color . "Red") + (widget-mouse-face . highlight)) + (default ((t (:stipple nil :background "white" :foreground "black" :inverse-video nil :box nil :strike-through nil :overline nil :underline nil :slant normal :weight normal :width normal :family "adobe-courier")))) + (Info-title-1-face ((t (:bold t :weight bold :family "helv" :height 1.728)))) + (Info-title-2-face ((t (:bold t :family "helv" :weight bold :height 1.44)))) + (Info-title-3-face ((t (:bold t :weight bold :family "helv" :height 1.2)))) + (Info-title-4-face ((t (:bold t :family "helv" :weight bold)))) + (antlr-font-lock-keyword-face ((t (:bold t :foreground "black" :weight bold)))) + (antlr-font-lock-literal-face ((t (:bold t :foreground "brown4" :weight bold)))) + (antlr-font-lock-ruledef-face ((t (:bold t :foreground "blue" :weight bold)))) + (antlr-font-lock-ruleref-face ((t (:foreground "blue4")))) + (antlr-font-lock-tokendef-face ((t (:bold t :foreground "blue" :weight bold)))) + (antlr-font-lock-tokenref-face ((t (:foreground "orange4")))) + (bold ((t (:bold t :weight bold)))) + (bold-italic ((t (:italic t :bold t :slant italic :weight bold)))) + (border ((t (:background "black")))) + (calendar-today-face ((t (:underline t)))) + (change-log-acknowledgement-face ((t (:foreground "Firebrick")))) + (change-log-conditionals-face ((t (:foreground "DarkGoldenrod")))) + (change-log-date-face ((t (:foreground "RosyBrown")))) + (change-log-email-face ((t (:foreground "DarkGoldenrod")))) + (change-log-file-face ((t (:foreground "Blue")))) + (change-log-function-face ((t (:foreground "DarkGoldenrod")))) + (change-log-list-face ((t (:foreground "Purple")))) + (change-log-name-face ((t (:foreground "CadetBlue")))) + (comint-highlight-input ((t (:bold t :weight bold)))) + (comint-highlight-prompt ((t (:foreground "dark blue")))) + (cperl-array-face ((t (:bold t :background "lightyellow2" :foreground "Blue" :weight bold)))) + (cperl-hash-face ((t (:italic t :bold t :background "lightyellow2" :foreground "Red" :slant italic :weight bold)))) + (cperl-nonoverridable-face ((t (:foreground "chartreuse3")))) + (cursor ((t (:background "black")))) + (custom-button-face ((t (:background "lightgrey" :foreground "black" :box (:line-width 2 :style released-button))))) + (custom-button-pressed-face ((t (:background "lightgrey" :foreground "black" :box (:line-width 2 :style pressed-button))))) + (custom-changed-face ((t (:background "blue" :foreground "white")))) + (custom-comment-face ((t (:background "gray85")))) + (custom-comment-tag-face ((t (:foreground "blue4")))) + (custom-documentation-face ((t (nil)))) + (custom-face-tag-face ((t (:bold t :family "helv" :weight bold :height 1.2)))) + (custom-group-tag-face ((t (:bold t :foreground "blue" :weight bold :height 1.2)))) + (custom-group-tag-face-1 ((t (:bold t :family "helv" :foreground "red" :weight bold :height 1.2)))) + (custom-invalid-face ((t (:background "red" :foreground "yellow")))) + (custom-modified-face ((t (:background "blue" :foreground "white")))) + (custom-rogue-face ((t (:background "black" :foreground "pink")))) + (custom-saved-face ((t (:underline t)))) + (custom-set-face ((t (:background "white" :foreground "blue")))) + (custom-state-face ((t (:foreground "dark green")))) + (custom-variable-button-face ((t (:bold t :underline t :weight bold)))) + (custom-variable-tag-face ((t (:bold t :family "helv" :foreground "blue" :weight bold :height 1.2)))) + (cvs-filename-face ((t (:foreground "blue4")))) + (cvs-handled-face ((t (:foreground "pink")))) + (cvs-header-face ((t (:bold t :foreground "blue4" :weight bold)))) + (cvs-marked-face ((t (:bold t :foreground "green3" :weight bold)))) + (cvs-msg-face ((t (:italic t :slant italic)))) + (cvs-need-action-face ((t (:foreground "orange")))) + (cvs-unknown-face ((t (:foreground "red")))) + (diary-face ((t (:foreground "red")))) + (diff-added-face ((t (nil)))) + (diff-changed-face ((t (nil)))) + (diff-context-face ((t (:foreground "grey50")))) + (diff-file-header-face ((t (:bold t :background "grey70" :weight bold)))) + (diff-function-face ((t (:foreground "grey50")))) + (diff-header-face ((t (:background "grey85")))) + (diff-hunk-header-face ((t (:background "grey85")))) + (diff-index-face ((t (:bold t :weight bold :background "grey70")))) + (diff-nonexistent-face ((t (:bold t :weight bold :background "grey70")))) + (diff-removed-face ((t (nil)))) + (dired-face-boring ((t (:foreground "RosyBrown")))) + (dired-face-directory ((t (:foreground "Blue")))) + (dired-face-executable ((t (nil)))) + (dired-face-flagged ((t (:foreground "Red" :weight bold)))) + (dired-face-marked ((t (:foreground "Red" :weight bold)))) + (dired-face-permissions ((t (nil)))) + (dired-face-setuid ((t (nil)))) + (dired-face-socket ((t (nil)))) + (dired-face-symlink ((t (:foreground "Purple")))) + (ebrowse-default-face ((t (nil)))) + (ebrowse-file-name-face ((t (:italic t :slant italic)))) + (ebrowse-member-attribute-face ((t (:foreground "red")))) + (ebrowse-member-class-face ((t (:foreground "purple")))) + (ebrowse-progress-face ((t (:background "blue")))) + (ebrowse-root-class-face ((t (:bold t :foreground "blue" :weight bold)))) + (ebrowse-tree-mark-face ((t (:foreground "red")))) + (ediff-current-diff-face-A ((t (:background "pale green" :foreground "firebrick")))) + (ediff-current-diff-face-Ancestor ((t (:background "VioletRed" :foreground "Black")))) + (ediff-current-diff-face-B ((t (:background "Yellow" :foreground "DarkOrchid")))) + (ediff-current-diff-face-C ((t (:background "Pink" :foreground "Navy")))) + (ediff-even-diff-face-A ((t (:background "light grey" :foreground "Black")))) + (ediff-even-diff-face-Ancestor ((t (:background "Grey" :foreground "White")))) + (ediff-even-diff-face-B ((t (:background "Grey" :foreground "White")))) + (ediff-even-diff-face-C ((t (:background "light grey" :foreground "Black")))) + (ediff-fine-diff-face-A ((t (:background "sky blue" :foreground "Navy")))) + (ediff-fine-diff-face-Ancestor ((t (:background "Green" :foreground "Black")))) + (ediff-fine-diff-face-B ((t (:background "cyan" :foreground "Black")))) + (ediff-fine-diff-face-C ((t (:background "Turquoise" :foreground "Black")))) + (ediff-odd-diff-face-A ((t (:background "Grey" :foreground "White")))) + (ediff-odd-diff-face-Ancestor ((t (:background "light grey" :foreground "Black")))) + (ediff-odd-diff-face-B ((t (:background "light grey" :foreground "Black")))) + (ediff-odd-diff-face-C ((t (:background "Grey" :foreground "White")))) + (eshell-ls-archive-face ((t (:bold t :foreground "Orchid" :weight bold)))) + (eshell-ls-backup-face ((t (:foreground "OrangeRed")))) + (eshell-ls-clutter-face ((t (:bold t :foreground "OrangeRed" :weight bold)))) + (eshell-ls-directory-face ((t (:bold t :foreground "Blue" :weight bold)))) + (eshell-ls-executable-face ((t (:bold t :foreground "ForestGreen" :weight bold)))) + (eshell-ls-missing-face ((t (:bold t :foreground "Red" :weight bold)))) + (eshell-ls-product-face ((t (:foreground "OrangeRed")))) + (eshell-ls-readonly-face ((t (:foreground "Brown")))) + (eshell-ls-special-face ((t (:bold t :foreground "Magenta" :weight bold)))) + (eshell-ls-symlink-face ((t (:bold t :foreground "Dark Cyan" :weight bold)))) + (eshell-ls-unreadable-face ((t (:foreground "Grey30")))) + (eshell-prompt-face ((t (:bold t :foreground "Red" :weight bold)))) + (eshell-test-failed-face ((t (:bold t :foreground "OrangeRed" :weight bold)))) + (eshell-test-ok-face ((t (:bold t :foreground "Green" :weight bold)))) + (excerpt ((t (:italic t :slant italic)))) + (fixed ((t (:bold t :weight bold)))) + (fixed-pitch ((t (:family "courier")))) + (flyspell-duplicate-face ((t (:bold t :foreground "Gold3" :underline t :weight bold)))) + (flyspell-incorrect-face ((t (:bold t :foreground "OrangeRed" :underline t :weight bold)))) + (font-lock-builtin-face ((t (:foreground "Orchid")))) + (font-lock-comment-face ((t (:foreground "Firebrick")))) + (font-lock-constant-face ((t (:foreground "CadetBlue")))) + (font-lock-doc-face ((t (:foreground "RosyBrown")))) + (font-lock-doc-string-face ((t (:foreground "RosyBrown")))) + (font-lock-function-name-face ((t (:foreground "Blue")))) + (font-lock-keyword-face ((t (:foreground "Purple")))) + (font-lock-preprocessor-face ((t (:foreground "CadetBlue")))) + (font-lock-reference-face ((t (:foreground "Orchid")))) + (font-lock-string-face ((t (:foreground "RosyBrown")))) + (font-lock-type-face ((t (:foreground "ForestGreen")))) + (font-lock-variable-name-face ((t (:foreground "DarkGoldenrod")))) + (font-lock-warning-face ((t (:bold t :foreground "Red" :weight bold)))) + (fringe ((t (:background "grey95")))) + (gnus-cite-attribution-face ((t (:italic t :slant italic)))) + (gnus-cite-face-1 ((t (:foreground "MidnightBlue")))) + (gnus-cite-face-10 ((t (:foreground "medium purple")))) + (gnus-cite-face-11 ((t (:foreground "turquoise")))) + (gnus-cite-face-2 ((t (:foreground "firebrick")))) + (gnus-cite-face-3 ((t (:foreground "dark green")))) + (gnus-cite-face-4 ((t (:foreground "OrangeRed")))) + (gnus-cite-face-5 ((t (:foreground "dark khaki")))) + (gnus-cite-face-6 ((t (:foreground "dark violet")))) + (gnus-cite-face-7 ((t (:foreground "SteelBlue4")))) + (gnus-cite-face-8 ((t (:foreground "magenta")))) + (gnus-cite-face-9 ((t (:foreground "violet")))) + (gnus-emphasis-bold ((t (:bold t :weight bold)))) + (gnus-emphasis-bold-italic ((t (:italic t :bold t :slant italic :weight bold)))) + (gnus-emphasis-highlight-words ((t (:background "black" :foreground "yellow")))) + (gnus-emphasis-italic ((t (:italic t :slant italic)))) + (gnus-emphasis-underline ((t (:underline t)))) + (gnus-emphasis-underline-bold ((t (:bold t :underline t :weight bold)))) + (gnus-emphasis-underline-bold-italic ((t (:italic t :bold t :underline t :slant italic :weight bold)))) + (gnus-emphasis-underline-italic ((t (:italic t :underline t :slant italic)))) + (gnus-group-mail-1-empty-face ((t (:foreground "DeepPink3")))) + (gnus-group-mail-1-face ((t (:bold t :foreground "DeepPink3" :weight bold)))) + (gnus-group-mail-2-empty-face ((t (:foreground "HotPink3")))) + (gnus-group-mail-2-face ((t (:bold t :foreground "HotPink3" :weight bold)))) + (gnus-group-mail-3-empty-face ((t (:foreground "magenta4")))) + (gnus-group-mail-3-face ((t (:bold t :foreground "magenta4" :weight bold)))) + (gnus-group-mail-low-empty-face ((t (:foreground "DeepPink4")))) + (gnus-group-mail-low-face ((t (:bold t :foreground "DeepPink4" :weight bold)))) + (gnus-group-news-1-empty-face ((t (:foreground "ForestGreen")))) + (gnus-group-news-1-face ((t (:bold t :foreground "ForestGreen" :weight bold)))) + (gnus-group-news-2-empty-face ((t (:foreground "CadetBlue4")))) + (gnus-group-news-2-face ((t (:bold t :foreground "CadetBlue4" :weight bold)))) + (gnus-group-news-3-empty-face ((t (nil)))) + (gnus-group-news-3-face ((t (:bold t :weight bold)))) + (gnus-group-news-4-empty-face ((t (nil)))) + (gnus-group-news-4-face ((t (:bold t :weight bold)))) + (gnus-group-news-5-empty-face ((t (nil)))) + (gnus-group-news-5-face ((t (:bold t :weight bold)))) + (gnus-group-news-6-empty-face ((t (nil)))) + (gnus-group-news-6-face ((t (:bold t :weight bold)))) + (gnus-group-news-low-empty-face ((t (:foreground "DarkGreen")))) + (gnus-group-news-low-face ((t (:bold t :foreground "DarkGreen" :weight bold)))) + (gnus-header-content-face ((t (:italic t :foreground "indianred4" :slant italic)))) + (gnus-header-from-face ((t (:foreground "red3")))) + (gnus-header-name-face ((t (:foreground "maroon")))) + (gnus-header-newsgroups-face ((t (:italic t :foreground "MidnightBlue" :slant italic)))) + (gnus-header-subject-face ((t (:foreground "red4")))) + (gnus-signature-face ((t (:italic t :slant italic)))) + (gnus-splash-face ((t (:foreground "Brown")))) + (gnus-summary-cancelled-face ((t (:background "black" :foreground "yellow")))) + (gnus-summary-high-ancient-face ((t (:bold t :foreground "RoyalBlue" :weight bold)))) + (gnus-summary-high-read-face ((t (:bold t :foreground "DarkGreen" :weight bold)))) + (gnus-summary-high-ticked-face ((t (:bold t :foreground "firebrick" :weight bold)))) + (gnus-summary-high-unread-face ((t (:bold t :weight bold)))) + (gnus-summary-low-ancient-face ((t (:italic t :foreground "RoyalBlue" :slant italic)))) + (gnus-summary-low-read-face ((t (:italic t :foreground "DarkGreen" :slant italic)))) + (gnus-summary-low-ticked-face ((t (:italic t :foreground "firebrick" :slant italic)))) + (gnus-summary-low-unread-face ((t (:italic t :slant italic)))) + (gnus-summary-normal-ancient-face ((t (:foreground "RoyalBlue")))) + (gnus-summary-normal-read-face ((t (:foreground "DarkGreen")))) + (gnus-summary-normal-ticked-face ((t (:foreground "firebrick")))) + (gnus-summary-normal-unread-face ((t (nil)))) + (gnus-summary-selected-face ((t (:underline t)))) + (header-line ((t (:box (:line-width -1 :style released-button) :background "grey90" :foreground "grey20" :box nil)))) + (hi-black-b ((t (:bold t :weight bold)))) + (hi-black-hb ((t (:bold t :family "helv" :weight bold :height 1.67)))) + (hi-blue ((t (:background "light blue")))) + (hi-blue-b ((t (:bold t :foreground "blue" :weight bold)))) + (hi-green ((t (:background "green")))) + (hi-green-b ((t (:bold t :foreground "green" :weight bold)))) + (hi-pink ((t (:background "pink")))) + (hi-red-b ((t (:bold t :foreground "red" :weight bold)))) + (hi-yellow ((t (:background "yellow")))) + (highlight ((t (:background "darkseagreen2")))) + (highlight-changes-delete-face ((t (:foreground "red" :underline t)))) + (highlight-changes-face ((t (:foreground "red")))) + (holiday-face ((t (:background "pink")))) + (idlwave-help-link-face ((t (:foreground "Blue")))) + (idlwave-shell-bp-face ((t (:background "Pink" :foreground "Black")))) + (info-header-node ((t (:italic t :bold t :weight bold :slant italic :foreground "brown")))) + (info-header-xref ((t (:bold t :weight bold :foreground "magenta4")))) + (info-menu-5 ((t (:foreground "red1")))) + (info-menu-header ((t (:bold t :family "helv" :weight bold)))) + (info-node ((t (:italic t :bold t :foreground "brown" :slant italic :weight bold)))) + (info-xref ((t (:bold t :foreground "magenta4" :weight bold)))) + (isearch ((t (:background "magenta4" :foreground "lightskyblue1")))) + (isearch-lazy-highlight-face ((t (:background "paleturquoise")))) + (italic ((t (:italic t :slant italic)))) + (log-view-file-face ((t (:bold t :background "grey70" :weight bold)))) + (log-view-message-face ((t (:background "grey85")))) + (makefile-space-face ((t (:background "hotpink")))) + (menu ((t (nil)))) + (message-cited-text-face ((t (:foreground "red")))) + (message-header-cc-face ((t (:foreground "MidnightBlue")))) + (message-header-name-face ((t (:foreground "cornflower blue")))) + (message-header-newsgroups-face ((t (:italic t :bold t :foreground "blue4" :slant italic :weight bold)))) + (message-header-other-face ((t (:foreground "steel blue")))) + (message-header-subject-face ((t (:bold t :foreground "navy blue" :weight bold)))) + (message-header-to-face ((t (:bold t :foreground "MidnightBlue" :weight bold)))) + (message-header-xheader-face ((t (:foreground "blue")))) + (message-mml-face ((t (:foreground "ForestGreen")))) + (message-separator-face ((t (:foreground "brown")))) + (modeline ((t (:background "grey75" :foreground "black" :box (:line-width -1 :style released-button))))) + (modeline-buffer-id ((t (:bold t :background "grey75" :foreground "black" :box (:line-width -1 :style released-button))))) + (modeline-mousable ((t (:background "grey75" :foreground "black" :box (:line-width -1 :style released-button))))) + (modeline-mousable-minor-mode ((t (:background "grey75" :foreground "black" :box (:line-width -1 :style released-button))))) + (mouse ((t (:background "black")))) + (primary-selection ((t (:background "lightgoldenrod2")))) + (reb-match-0 ((t (:background "lightblue")))) + (reb-match-1 ((t (:background "aquamarine")))) + (reb-match-2 ((t (:background "springgreen")))) + (reb-match-3 ((t (:background "yellow")))) + (region ((t (:background "lightgoldenrod2")))) + (scroll-bar ((t (:background "grey75")))) + (secondary-selection ((t (:background "yellow")))) + (sh-heredoc-face ((t (:foreground "tan")))) + (show-paren-match-face ((t (:background "turquoise")))) + (show-paren-mismatch-face ((t (:background "purple" :foreground "white")))) + (show-tabs-space-face ((t (:foreground "yellow")))) + (show-tabs-tab-face ((t (:foreground "red")))) + (smerge-base-face ((t (:foreground "red")))) + (smerge-markers-face ((t (:background "grey85")))) + (smerge-mine-face ((t (:foreground "blue")))) + (smerge-other-face ((t (:foreground "darkgreen")))) + (speedbar-button-face ((t (:foreground "green4")))) + (speedbar-directory-face ((t (:foreground "blue4")))) + (speedbar-file-face ((t (:foreground "cyan4")))) + (speedbar-highlight-face ((t (:background "green")))) + (speedbar-selected-face ((t (:foreground "red" :underline t)))) + (speedbar-tag-face ((t (:foreground "brown")))) + (strokes-char-face ((t (:background "lightgray")))) + (term-black ((t (:stipple nil :background "white" :foreground "black" :inverse-video nil :box nil :strike-through nil :overline nil :underline nil :slant normal :weight normal :width normal :family "adobe-courier")))) + (term-blackbg ((t (:stipple nil :background "black" :foreground "black" :inverse-video nil :box nil :strike-through nil :overline nil :underline nil :slant normal :weight normal :width normal :family "adobe-courier")))) + (term-blue ((t (:stipple nil :background "white" :foreground "blue" :inverse-video nil :box nil :strike-through nil :overline nil :underline nil :slant normal :weight normal :width normal :family "adobe-courier")))) + (term-bluebg ((t (:stipple nil :background "blue" :foreground "black" :inverse-video nil :box nil :strike-through nil :overline nil :underline nil :slant normal :weight normal :width normal :family "adobe-courier")))) + (term-bold ((t (:bold t :stipple nil :background "white" :foreground "black" :inverse-video nil :box nil :strike-through nil :overline nil :underline nil :slant normal :weight bold :width normal :family "adobe-courier")))) + (term-cyan ((t (:stipple nil :background "white" :foreground "cyan" :inverse-video nil :box nil :strike-through nil :overline nil :underline nil :slant normal :weight normal :width normal :family "adobe-courier")))) + (term-cyanbg ((t (:stipple nil :background "cyan" :foreground "black" :inverse-video nil :box nil :strike-through nil :overline nil :underline nil :slant normal :weight normal :width normal :family "adobe-courier")))) + (term-default ((t (:stipple nil :background "white" :foreground "black" :inverse-video nil :box nil :strike-through nil :overline nil :underline nil :slant normal :weight normal :width normal :family "adobe-courier")))) + (term-default-bg ((t (:stipple nil :foreground "black" :inverse-video nil :box nil :strike-through nil :overline nil :underline nil :slant normal :weight normal :width normal :family "adobe-courier")))) + (term-default-bg-inv ((t (:stipple nil :foreground "black" :inverse-video nil :box nil :strike-through nil :overline nil :underline nil :slant normal :weight normal :width normal :family "adobe-courier")))) + (term-default-fg ((t (:stipple nil :background "white" :inverse-video nil :box nil :strike-through nil :overline nil :underline nil :slant normal :weight normal :width normal :family "adobe-courier")))) + (term-default-fg-inv ((t (:stipple nil :background "white" :inverse-video nil :box nil :strike-through nil :overline nil :underline nil :slant normal :weight normal :width normal :family "adobe-courier")))) + (term-green ((t (:stipple nil :background "white" :foreground "green" :inverse-video nil :box nil :strike-through nil :overline nil :underline nil :slant normal :weight normal :width normal :family "adobe-courier")))) + (term-greenbg ((t (:stipple nil :background "green" :foreground "black" :inverse-video nil :box nil :strike-through nil :overline nil :underline nil :slant normal :weight normal :width normal :family "adobe-courier")))) + (term-invisible ((t (:stipple nil :foreground "black" :inverse-video nil :box nil :strike-through nil :overline nil :underline nil :slant normal :weight normal :width normal :family "adobe-courier")))) + (term-invisible-inv ((t (:stipple nil :foreground "black" :inverse-video nil :box nil :strike-through nil :overline nil :underline nil :slant normal :weight normal :width normal :family "adobe-courier")))) + (term-magenta ((t (:stipple nil :background "white" :foreground "magenta" :inverse-video nil :box nil :strike-through nil :overline nil :underline nil :slant normal :weight normal :width normal :family "adobe-courier")))) + (term-magentabg ((t (:stipple nil :background "magenta" :foreground "black" :inverse-video nil :box nil :strike-through nil :overline nil :underline nil :slant normal :weight normal :width normal :family "adobe-courier")))) + (term-red ((t (:stipple nil :background "white" :foreground "red" :inverse-video nil :box nil :strike-through nil :overline nil :underline nil :slant normal :weight normal :width normal :family "adobe-courier")))) + (term-redbg ((t (:stipple nil :background "red" :foreground "black" :inverse-video nil :box nil :strike-through nil :overline nil :underline nil :slant normal :weight normal :width normal :family "adobe-courier")))) + (term-underline ((t (:stipple nil :background "white" :foreground "black" :inverse-video nil :box nil :strike-through nil :overline nil :underline t :slant normal :weight normal :width normal :family "adobe-courier")))) + (term-white ((t (:stipple nil :background "white" :foreground "white" :inverse-video nil :box nil :strike-through nil :overline nil :underline nil :slant normal :weight normal :width normal :family "adobe-courier")))) + (term-whitebg ((t (:stipple nil :background "white" :foreground "black" :inverse-video nil :box nil :strike-through nil :overline nil :underline nil :slant normal :weight normal :width normal :family "adobe-courier")))) + (term-yellow ((t (:stipple nil :background "white" :foreground "yellow" :inverse-video nil :box nil :strike-through nil :overline nil :underline nil :slant normal :weight normal :width normal :family "adobe-courier")))) + (term-yellowbg ((t (:stipple nil :background "yellow" :foreground "black" :inverse-video nil :box nil :strike-through nil :overline nil :underline nil :slant normal :weight normal :width normal :family "adobe-courier")))) + (tex-math-face ((t (:foreground "RosyBrown")))) + (texinfo-heading-face ((t (:foreground "Blue")))) + (tool-bar ((t (:background "grey75" :foreground "black" :box (:line-width 1 :style released-button))))) + (tooltip ((t (:background "lightyellow" :foreground "black")))) + (trailing-whitespace ((t (:background "red")))) + (underline ((t (:underline t)))) + (variable-pitch ((t (:family "helv")))) + (vcursor ((t (:background "cyan" :foreground "blue" :underline t)))) + (vhdl-font-lock-attribute-face ((t (:foreground "Orchid")))) + (vhdl-font-lock-directive-face ((t (:foreground "CadetBlue")))) + (vhdl-font-lock-enumvalue-face ((t (:foreground "Gold4")))) + (vhdl-font-lock-function-face ((t (:foreground "Orchid4")))) + (vhdl-font-lock-prompt-face ((t (:bold t :foreground "Red" :weight bold)))) + (vhdl-font-lock-reserved-words-face ((t (:bold t :foreground "Orange" :weight bold)))) + (vhdl-font-lock-translate-off-face ((t (:background "LightGray")))) + (vhdl-speedbar-architecture-face ((t (:foreground "Blue")))) + (vhdl-speedbar-architecture-selected-face ((t (:foreground "Blue" :underline t)))) + (vhdl-speedbar-configuration-face ((t (:foreground "DarkGoldenrod")))) + (vhdl-speedbar-configuration-selected-face ((t (:foreground "DarkGoldenrod" :underline t)))) + (vhdl-speedbar-entity-face ((t (:foreground "ForestGreen")))) + (vhdl-speedbar-entity-selected-face ((t (:foreground "ForestGreen" :underline t)))) + (vhdl-speedbar-instantiation-face ((t (:foreground "Brown")))) + (vhdl-speedbar-instantiation-selected-face ((t (:foreground "Brown" :underline t)))) + (vhdl-speedbar-package-face ((t (:foreground "Grey50")))) + (vhdl-speedbar-package-selected-face ((t (:foreground "Grey50" :underline t)))) + (viper-minibuffer-emacs-face ((t (:background "darkseagreen2" :foreground "Black")))) + (viper-minibuffer-insert-face ((t (:background "pink" :foreground "Black")))) + (viper-minibuffer-vi-face ((t (:background "grey" :foreground "DarkGreen")))) + (viper-replace-overlay-face ((t (:background "darkseagreen2" :foreground "Black")))) + (viper-search-face ((t (:background "khaki" :foreground "Black")))) + (widget-button-face ((t (:bold t :weight bold)))) + (widget-button-pressed-face ((t (:foreground "red")))) + (widget-documentation-face ((t (:foreground "dark green")))) + (widget-field-face ((t (:background "gray85")))) + (widget-inactive-face ((t (:foreground "dim gray")))) + (widget-single-line-field-face ((t (:background "gray85")))) + (woman-addition-face ((t (:foreground "orange")))) + (woman-bold-face ((t (:bold t :foreground "blue" :weight bold)))) + (woman-italic-face ((t (:italic t :foreground "red" :underline t :slant italic)))) + (woman-unknown-face ((t (:foreground "brown")))) + (zmacs-region ((t (:background "lightgoldenrod2"))))))) + +(defun color-theme-jsc-light2 () + "Color theme by John S Cooper, created 2001-10-29. +This builds on `color-theme-jsc-light'." + (interactive) + (color-theme-jsc-light) + (let ((color-theme-is-cumulative t)) + (color-theme-install + '(color-theme-jsc-light2 + ((vc-annotate-very-old-color . "#0046FF") + (senator-eldoc-use-color . t)) + nil + (bold ((t (:bold t :weight bold)))) + (bold-italic ((t (:italic t :bold t :slant italic :weight bold)))) + (change-log-file-face ((t (:foreground "Blue")))) + (change-log-name-face ((t (:foreground "Maroon")))) + (comint-highlight-prompt ((t (:foreground "dark blue")))) + (custom-button-face ((t (:background "lightgrey" :foreground "black" :box (:line-width 2 :style released-button))))) + (custom-face-tag-face ((t (:bold t :family "helv" :weight bold :height 1.2)))) + (custom-group-tag-face ((t (:bold t :foreground "blue" :weight bold :height 1.2)))) + (custom-group-tag-face-1 ((t (:bold t :family "helv" :foreground "red" :weight bold :height 1.2)))) + (custom-variable-tag-face ((t (:bold t :family "helv" :foreground "blue" :weight bold :height 1.2)))) + (font-lock-constant-face ((t (:foreground "Maroon")))) + (font-lock-function-name-face ((t (:foreground "Blue")))) + (font-lock-type-face ((t (:italic t :foreground "Navy" :slant italic)))) + (fringe ((t (:background "grey88")))) + (gnus-group-mail-1-empty-face ((t (:foreground "Blue2")))) + (gnus-group-news-1-empty-face ((t (:foreground "ForestGreen")))) + (gnus-group-news-1-face ((t (:bold t :foreground "ForestGreen" :weight bold)))) + (gnus-header-content-face ((t (:italic t :foreground "indianred4" :slant italic)))) + (gnus-header-name-face ((t (:bold t :foreground "maroon" :weight bold)))) + (gnus-header-subject-face ((t (:foreground "red4")))) + (gnus-signature-face ((t (:italic t :slant italic)))) + (gnus-summary-high-read-face ((t (:bold t :foreground "DarkGreen" :weight bold)))) + (gnus-summary-high-unread-face ((t (:bold t :weight bold)))) + (gnus-summary-normal-read-face ((t (:foreground "DarkGreen")))) + (gnus-summary-normal-ticked-face ((t (:foreground "Navy")))) + (gnus-summary-normal-unread-face ((t (:bold t :foreground "DarkGreen" :weight bold)))) + (header-line ((t (:background "grey90" :foreground "grey20" :box nil)))) + (highlight ((t (:background "darkseagreen2")))) + (ido-subdir-face ((t (:foreground "red")))) + (isearch ((t (:background "magenta4" :foreground "lightskyblue1")))) + (mode-line ((t (:background "grey88" :foreground "black" :box (:line-width -1 :style released-button))))) + (region ((t (:background "lightgoldenrod2")))) + (scroll-bar ((t (nil)))) + (secondary-selection ((t (:background "yellow")))) + (show-paren-match-face ((t (:background "turquoise")))) + (show-paren-mismatch-face ((t (:background "purple" :foreground "white")))) + (tooltip ((t (:background "lightyellow" :foreground "black")))))))) + +(defun color-theme-ld-dark () + "Dark Color theme by Linh Dang, created 2001-11-06." + (interactive) + (color-theme-install + '(color-theme-ld-dark + ((background-color . "black") + (background-mode . dark) + (border-color . "black") + (cursor-color . "yellow") + (foreground-color . "white") + (mouse-color . "white")) + ((align-highlight-change-face . highlight) + (align-highlight-nochange-face . secondary-selection) + (apropos-keybinding-face . underline) + (apropos-label-face . italic) + (apropos-match-face . secondary-selection) + (apropos-property-face . bold-italic) + (apropos-symbol-face . bold) + (ebnf-except-border-color . "Black") + (ebnf-line-color . "Black") + (ebnf-non-terminal-border-color . "Black") + (ebnf-repeat-border-color . "Black") + (ebnf-special-border-color . "Black") + (ebnf-terminal-border-color . "Black") + (gnus-article-button-face . bold) + (gnus-article-mouse-face . highlight) + (gnus-carpal-button-face . bold) + (gnus-carpal-header-face . bold-italic) + (gnus-cite-attribution-face . gnus-cite-attribution-face) + (gnus-mouse-face . highlight) + (gnus-selected-tree-face . modeline) + (gnus-signature-face . gnus-signature-face) + (gnus-summary-selected-face . gnus-summary-selected-face) + (help-highlight-face . underline) + (list-matching-lines-face . bold) + (ps-line-number-color . "black") + (ps-zebra-color . 0.95) + (tags-tag-face . default) + (vc-annotate-very-old-color . "#0046FF") + (view-highlight-face . highlight) + (widget-mouse-face . highlight)) + (default ((t (:stipple nil :background "black" :foreground "white" :inverse-video nil :box nil :strike-through nil :overline nil :underline nil :slant normal :weight normal :width normal :family "outline-courier new")))) + (Info-title-1-face ((t (:bold t :weight bold :family "helv" :height 1.728)))) + (Info-title-2-face ((t (:bold t :family "helv" :weight bold :height 1.44)))) + (Info-title-3-face ((t (:bold t :weight bold :family "helv" :height 1.2)))) + (Info-title-4-face ((t (:bold t :family "helv" :weight bold)))) + (bbdb-company ((t (:italic t :slant italic)))) + (bbdb-field-name ((t (:bold t :weight bold)))) + (bbdb-field-value ((t (nil)))) + (bbdb-name ((t (:underline t)))) + (bold ((t (:bold t :weight bold)))) + (bold-italic ((t (:italic t :bold t :slant italic :weight bold)))) + (border ((t (:background "black")))) + (change-log-acknowledgement-face ((t (:italic t :slant oblique :foreground "AntiqueWhite3")))) + (change-log-conditionals-face ((t (:foreground "Aquamarine")))) + (change-log-date-face ((t (:italic t :slant oblique :foreground "BurlyWood")))) + (change-log-email-face ((t (:foreground "Aquamarine")))) + (change-log-file-face ((t (:bold t :family "Verdana" :weight bold :foreground "LightSkyBlue" :height 0.9)))) + (change-log-function-face ((t (:foreground "Aquamarine")))) + (change-log-list-face ((t (:foreground "LightSkyBlue")))) + (change-log-name-face ((t (:bold t :weight bold :foreground "Gold")))) + (clear-case-mode-string-face ((t (:bold t :family "Arial" :box (:line-width 2 :color "grey" :style released-button) :foreground "black" :background "grey" :weight bold :height 0.9)))) + (comint-highlight-input ((t (:bold t :weight bold)))) + (comint-highlight-prompt ((t (:foreground "cyan")))) + (cursor ((t (:background "yellow")))) + (custom-button-face ((t (:background "lightgrey" :foreground "black" :box (:line-width 2 :style released-button))))) + (custom-button-pressed-face ((t (:background "lightgrey" :foreground "black" :box (:line-width 2 :style pressed-button))))) + (custom-changed-face ((t (:background "blue" :foreground "white")))) + (custom-comment-face ((t (:background "dim gray")))) + (custom-comment-tag-face ((t (:foreground "gray80")))) + (custom-documentation-face ((t (nil)))) + (custom-face-tag-face ((t (:bold t :family "helv" :weight bold :height 1.1)))) + (custom-group-tag-face ((t (:bold t :family "helv" :foreground "light blue" :weight bold :height 1.1)))) + (custom-group-tag-face-1 ((t (:bold t :family "helv" :foreground "pink" :weight bold :height 1.1)))) + (custom-invalid-face ((t (:background "red" :foreground "yellow")))) + (custom-modified-face ((t (:background "blue" :foreground "white")))) + (custom-rogue-face ((t (:background "black" :foreground "pink")))) + (custom-saved-face ((t (:underline t)))) + (custom-set-face ((t (:background "white" :foreground "blue")))) + (custom-state-face ((t (:foreground "lime green")))) + (custom-variable-button-face ((t (:bold t :underline t :weight bold)))) + (custom-variable-tag-face ((t (:bold t :family "helv" :foreground "light blue" :weight bold :height 1.2)))) + (diff-added-face ((t (nil)))) + (diff-changed-face ((t (nil)))) + (diff-context-face ((t (:foreground "grey70")))) + (diff-file-header-face ((t (:bold t :background "grey60" :weight bold)))) + (diff-function-face ((t (:foreground "grey70")))) + (diff-header-face ((t (:background "grey45")))) + (diff-hunk-header-face ((t (:background "grey45")))) + (diff-index-face ((t (:bold t :weight bold :background "grey60")))) + (diff-nonexistent-face ((t (:bold t :weight bold :background "grey60")))) + (diff-removed-face ((t (nil)))) + (fixed-pitch ((t (:family "courier")))) + (font-lock-builtin-face ((t (:foreground "SteelBlue")))) + (font-lock-comment-face ((t (:italic t :foreground "AntiqueWhite3" :slant oblique)))) + (font-lock-constant-face ((t (:bold t :foreground "Gold" :weight bold)))) + (font-lock-doc-face ((t (:italic t :slant oblique :foreground "BurlyWood")))) + (font-lock-doc-string-face ((t (:italic t :slant oblique :foreground "BurlyWood")))) + (font-lock-function-name-face ((t (:bold t :foreground "LightSkyBlue" :weight bold :height 0.9 :family "Verdana")))) + (font-lock-keyword-face ((t (:foreground "LightSkyBlue")))) + (font-lock-preprocessor-face ((t (:bold t :foreground "Gold" :weight bold)))) + (font-lock-reference-face ((t (:foreground "SteelBlue")))) + (font-lock-string-face ((t (:italic t :foreground "BurlyWood" :slant oblique)))) + (font-lock-type-face ((t (:bold t :foreground "PaleGreen" :weight bold :height 0.9 :family "Verdana")))) + (font-lock-variable-name-face ((t (:foreground "Aquamarine")))) + (font-lock-warning-face ((t (:bold t :foreground "chocolate" :weight bold)))) + (fringe ((t (:family "outline-courier new" :width normal :weight normal :slant normal :underline nil :overline nil :strike-through nil :box nil :inverse-video nil :stipple nil :background "grey4" :foreground "Wheat")))) + (gnus-cite-attribution-face ((t (:italic t :slant italic)))) + (gnus-cite-face-1 ((t (:foreground "light blue")))) + (gnus-cite-face-10 ((t (:foreground "medium purple")))) + (gnus-cite-face-11 ((t (:foreground "turquoise")))) + (gnus-cite-face-2 ((t (:foreground "light cyan")))) + (gnus-cite-face-3 ((t (:foreground "light yellow")))) + (gnus-cite-face-4 ((t (:foreground "light pink")))) + (gnus-cite-face-5 ((t (:foreground "pale green")))) + (gnus-cite-face-6 ((t (:foreground "beige")))) + (gnus-cite-face-7 ((t (:foreground "orange")))) + (gnus-cite-face-8 ((t (:foreground "magenta")))) + (gnus-cite-face-9 ((t (:foreground "violet")))) + (gnus-emphasis-bold ((t (:bold t :weight bold)))) + (gnus-emphasis-bold-italic ((t (:italic t :bold t :slant italic :weight bold)))) + (gnus-emphasis-highlight-words ((t (:background "black" :foreground "yellow")))) + (gnus-emphasis-italic ((t (:italic t :slant italic)))) + (gnus-emphasis-underline ((t (:underline t)))) + (gnus-emphasis-underline-bold ((t (:bold t :underline t :weight bold)))) + (gnus-emphasis-underline-bold-italic ((t (:italic t :bold t :underline t :slant italic :weight bold)))) + (gnus-emphasis-underline-italic ((t (:italic t :underline t :slant italic)))) + (gnus-group-mail-1-empty-face ((t (:foreground "aquamarine1")))) + (gnus-group-mail-1-face ((t (:bold t :foreground "aquamarine1" :weight bold)))) + (gnus-group-mail-2-empty-face ((t (:foreground "aquamarine2")))) + (gnus-group-mail-2-face ((t (:bold t :foreground "aquamarine2" :weight bold)))) + (gnus-group-mail-3-empty-face ((t (:foreground "aquamarine3")))) + (gnus-group-mail-3-face ((t (:bold t :foreground "aquamarine3" :weight bold)))) + (gnus-group-mail-low-empty-face ((t (:foreground "aquamarine4")))) + (gnus-group-mail-low-face ((t (:bold t :foreground "aquamarine4" :weight bold)))) + (gnus-group-news-1-empty-face ((t (:foreground "PaleTurquoise")))) + (gnus-group-news-1-face ((t (:bold t :foreground "PaleTurquoise" :weight bold)))) + (gnus-group-news-2-empty-face ((t (:foreground "turquoise")))) + (gnus-group-news-2-face ((t (:bold t :foreground "turquoise" :weight bold)))) + (gnus-group-news-3-empty-face ((t (nil)))) + (gnus-group-news-3-face ((t (:bold t :weight bold)))) + (gnus-group-news-4-empty-face ((t (nil)))) + (gnus-group-news-4-face ((t (:bold t :weight bold)))) + (gnus-group-news-5-empty-face ((t (nil)))) + (gnus-group-news-5-face ((t (:bold t :weight bold)))) + (gnus-group-news-6-empty-face ((t (nil)))) + (gnus-group-news-6-face ((t (:bold t :weight bold)))) + (gnus-group-news-low-empty-face ((t (:foreground "DarkTurquoise")))) + (gnus-group-news-low-face ((t (:bold t :foreground "DarkTurquoise" :weight bold)))) + (gnus-header-content-face ((t (:italic t :foreground "forest green" :slant italic)))) + (gnus-header-from-face ((t (:foreground "spring green")))) + (gnus-header-name-face ((t (:foreground "SeaGreen")))) + (gnus-header-newsgroups-face ((t (:italic t :foreground "yellow" :slant italic)))) + (gnus-header-subject-face ((t (:foreground "SeaGreen3")))) + (gnus-signature-face ((t (:italic t :slant italic)))) + (gnus-splash-face ((t (:foreground "Brown")))) + (gnus-summary-cancelled-face ((t (:background "black" :foreground "yellow")))) + (gnus-summary-high-ancient-face ((t (:bold t :foreground "SkyBlue" :weight bold)))) + (gnus-summary-high-read-face ((t (:bold t :foreground "PaleGreen" :weight bold)))) + (gnus-summary-high-ticked-face ((t (:bold t :foreground "pink" :weight bold)))) + (gnus-summary-high-unread-face ((t (:bold t :weight bold)))) + (gnus-summary-low-ancient-face ((t (:italic t :foreground "SkyBlue" :slant italic)))) + (gnus-summary-low-read-face ((t (:italic t :foreground "PaleGreen" :slant italic)))) + (gnus-summary-low-ticked-face ((t (:italic t :foreground "pink" :slant italic)))) + (gnus-summary-low-unread-face ((t (:italic t :slant italic)))) + (gnus-summary-normal-ancient-face ((t (:foreground "SkyBlue")))) + (gnus-summary-normal-read-face ((t (:foreground "PaleGreen")))) + (gnus-summary-normal-ticked-face ((t (:foreground "pink")))) + (gnus-summary-normal-unread-face ((t (nil)))) + (gnus-summary-selected-face ((t (:underline t)))) + (header-line ((t (:family "Arial" :background "grey20" :foreground "grey75" :box (:line-width 3 :color "grey20" :style released-button) :height 0.9)))) + (highlight ((t (:background "darkolivegreen")))) + (info-header-node ((t (:italic t :bold t :weight bold :slant italic :foreground "white")))) + (info-header-xref ((t (:bold t :weight bold :foreground "cyan")))) + (info-menu-5 ((t (:foreground "red1")))) + (info-menu-header ((t (:bold t :family "helv" :weight bold)))) + (info-node ((t (:italic t :bold t :foreground "white" :slant italic :weight bold)))) + (info-xref ((t (:bold t :foreground "cyan" :weight bold)))) + (isearch ((t (:background "palevioletred2")))) + (isearch-lazy-highlight-face ((t (:background "paleturquoise4")))) + (italic ((t (:italic t :slant italic)))) + (makefile-space-face ((t (:background "hotpink")))) + (menu ((t (nil)))) + (message-cited-text-face ((t (:foreground "red")))) + (message-header-cc-face ((t (:bold t :foreground "green4" :weight bold)))) + (message-header-name-face ((t (:foreground "DarkGreen")))) + (message-header-newsgroups-face ((t (:italic t :bold t :foreground "yellow" :slant italic :weight bold)))) + (message-header-other-face ((t (:foreground "#b00000")))) + (message-header-subject-face ((t (:foreground "green3")))) + (message-header-to-face ((t (:bold t :foreground "green2" :weight bold)))) + (message-header-xheader-face ((t (:foreground "blue")))) + (message-mml-face ((t (:foreground "ForestGreen")))) + (message-separator-face ((t (:foreground "blue3")))) + (modeline ((t (:background "grey" :foreground "black" :box (:line-width 2 :color "grey" :style released-button) :height 0.9 :family "Arial")))) + (modeline-mousable-minor-mode ((t (:background "grey" :foreground "black" :box (:line-width 2 :color "grey" :style released-button) :height 0.9 :family "Arial")))) + (modeline-mousable ((t (:background "grey" :foreground "black" :box (:line-width 2 :color "grey" :style released-button) :height 0.9 :family "Arial")))) + (modeline-buffer-id ((t (:background "grey" :foreground "black" :box (:line-width 2 :color "grey" :style released-button) :height 0.9 :family "Arial")))) + (mouse ((t (:background "white")))) + (primary-selection ((t (:background "DarkSlateGray")))) + (region ((t (:background "DarkSlateGray")))) + (scroll-bar ((t (nil)))) + (secondary-selection ((t (:background "SkyBlue4")))) + (tool-bar ((t (:background "grey75" :foreground "black" :box (:line-width 1 :style released-button))))) + (trailing-whitespace ((t (:background "white")))) + (underline ((t (:underline t)))) + (variable-pitch ((t (:family "helv")))) + (widget-button-face ((t (:bold t :weight bold)))) + (widget-button-pressed-face ((t (:foreground "red")))) + (widget-documentation-face ((t (:foreground "lime green")))) + (widget-field-face ((t (:background "dim gray")))) + (widget-inactive-face ((t (:foreground "light gray")))) + (widget-single-line-field-face ((t (:background "dim gray")))) + (zmacs-region ((t (:background "DarkSlateGray"))))))) + +(defun color-theme-deep-blue () + "Color theme by Tomas Cerha, created 2001-11-13." + (interactive) + (color-theme-install + '(color-theme-deep-blue + ((background-color . "#102e4e") + (background-mode . dark) + (border-color . "black") + (cursor-color . "green") + (foreground-color . "#eeeeee") + (mouse-color . "white")) + ((browse-kill-ring-separator-face . bold) + (display-time-mail-face . mode-line) + (help-highlight-face . underline) + (list-matching-lines-face . secondary-selection) + (vc-annotate-very-old-color . "#0046FF") + (view-highlight-face . highlight) + (widget-mouse-face . highlight)) + (default ((t (:stipple nil :background "#102e4e" :foreground "#eeeeee" :inverse-video nil :box nil :strike-through nil :overline nil :underline nil :slant normal :weight normal :width normal :family "misc-fixed")))) + (Info-title-1-face ((t (:bold t :weight bold :family "helv" :height 1.728)))) + (Info-title-2-face ((t (:bold t :family "helv" :weight bold :height 1.44)))) + (Info-title-3-face ((t (:bold t :weight bold :family "helv" :height 1.2)))) + (Info-title-4-face ((t (:bold t :family "helv" :weight bold)))) + (bold ((t (:bold t :weight bold)))) + (bold-italic ((t (:italic t :bold t :slant italic :weight bold)))) + (border ((t (:background "black")))) + (calendar-today-face ((t (:background "blue")))) + (change-log-acknowledgement-face ((t (:italic t :slant italic :foreground "CadetBlue")))) + (change-log-conditionals-face ((t (:foreground "SeaGreen2")))) + (change-log-date-face ((t (:foreground "burlywood")))) + (change-log-email-face ((t (:foreground "SeaGreen2")))) + (change-log-file-face ((t (:bold t :weight bold :foreground "goldenrod")))) + (change-log-function-face ((t (:foreground "SeaGreen2")))) + (change-log-list-face ((t (:bold t :weight bold :foreground "DeepSkyBlue1")))) + (change-log-name-face ((t (:foreground "gold")))) + (comint-highlight-input ((t (:bold t :weight bold)))) + (comint-highlight-prompt ((t (:foreground "cyan")))) + (cursor ((t (:background "green" :foreground "black")))) + (cvs-filename-face ((t (:foreground "lightblue")))) + (cvs-handled-face ((t (:foreground "pink")))) + (cvs-header-face ((t (:bold t :foreground "lightyellow" :weight bold)))) + (cvs-marked-face ((t (:bold t :foreground "green" :weight bold)))) + (cvs-msg-face ((t (:italic t :slant italic)))) + (cvs-need-action-face ((t (:foreground "orange")))) + (cvs-unknown-face ((t (:foreground "red")))) + (diary-face ((t (:foreground "orange red")))) + (diff-added-face ((t (nil)))) + (diff-changed-face ((t (nil)))) + (diff-context-face ((t (:foreground "grey70")))) + (diff-file-header-face ((t (:bold t :background "grey60" :weight bold)))) + (diff-function-face ((t (:foreground "grey70")))) + (diff-header-face ((t (:background "grey45")))) + (diff-hunk-header-face ((t (:background "grey45")))) + (diff-index-face ((t (:bold t :weight bold :background "grey60")))) + (diff-nonexistent-face ((t (:bold t :weight bold :background "grey60")))) + (diff-removed-face ((t (nil)))) + (fixed-pitch ((t (:family "fixed")))) + (font-latex-bold-face ((t (:bold t :foreground "OliveDrab" :weight bold)))) + (font-latex-italic-face ((t (:italic t :foreground "OliveDrab" :slant italic)))) + (font-latex-math-face ((t (:foreground "burlywood")))) + (font-latex-sedate-face ((t (:foreground "LightGray")))) + (font-latex-string-face ((t (:foreground "LightSalmon")))) + (font-latex-warning-face ((t (:bold t :foreground "Pink" :weight bold)))) + (font-lock-builtin-face ((t (:foreground "LightCoral")))) + (font-lock-comment-face ((t (:italic t :foreground "CadetBlue" :slant italic)))) + (font-lock-constant-face ((t (:foreground "gold")))) + (font-lock-doc-face ((t (:foreground "BlanchedAlmond")))) + (font-lock-doc-string-face ((t (:foreground "BlanchedAlmond")))) + (font-lock-function-name-face ((t (:bold t :foreground "goldenrod" :weight bold)))) + (font-lock-keyword-face ((t (:bold t :foreground "DeepSkyBlue1" :weight bold)))) + (font-lock-preprocessor-face ((t (:foreground "gold")))) + (font-lock-reference-face ((t (:foreground "LightCoral")))) + (font-lock-string-face ((t (:foreground "burlywood")))) + (font-lock-type-face ((t (:foreground "CadetBlue1")))) + (font-lock-variable-name-face ((t (:foreground "SeaGreen2")))) + (font-lock-warning-face ((t (:foreground "yellow")))) + (fringe ((t (:background "#405060")))) + (header-line ((t (:box (:line-width 2 :style released-button) :background "grey20" :foreground "grey90" :box nil)))) + (highlight ((t (:background "darkgreen")))) + (holiday-face ((t (:foreground "green")))) + (info-header-node ((t (:foreground "DeepSkyBlue1")))) + (info-header-xref ((t (:bold t :weight bold :foreground "SeaGreen2")))) + (info-menu-5 ((t (:foreground "wheat")))) + (info-menu-header ((t (:bold t :family "helv" :weight bold)))) + (info-node ((t (:foreground "DeepSkyBlue1")))) + (info-xref ((t (:bold t :foreground "SeaGreen2" :weight bold)))) + (isearch ((t (:background "palevioletred2" :foreground "brown4")))) + (isearch-lazy-highlight-face ((t (:background "paleturquoise4")))) + (italic ((t (:italic t :slant italic)))) + (menu ((t (:background "gray" :foreground "black" :family "helvetica")))) + (modeline ((t (:background "gray" :foreground "black" :box (:line-width 2 :style released-button))))) + (modeline-buffer-id ((t (:background "gray" :foreground "black" :box (:line-width 2 :style released-button))))) + (modeline-mousable ((t (:background "gray" :foreground "black" :box (:line-width 2 :style released-button))))) + (modeline-mousable-minor-mode ((t (:background "gray" :foreground "black" :box (:line-width 2 :style released-button))))) + (mouse ((t (:background "white")))) + (region ((t (:background "DarkCyan")))) + (scroll-bar ((t (:background "gray" :foreground "#506070")))) + (secondary-selection ((t (:background "yellow" :foreground "gray10")))) + (show-paren-match-face ((t (:bold t :foreground "yellow" :weight bold)))) + (show-paren-mismatch-face ((t (:bold t :foreground "red" :weight bold)))) + (tool-bar ((t (:background "grey75" :foreground "black" :box (:line-width 1 :style released-button))))) + (tooltip ((t (:background "lightyellow" :foreground "black")))) + (trailing-whitespace ((t (:background "#102e4e")))) + (underline ((t (:underline t)))) + (variable-pitch ((t (:family "helv")))) + (widget-button-face ((t (:bold t :weight bold)))) + (widget-button-pressed-face ((t (:foreground "red")))) + (widget-documentation-face ((t (:foreground "lime green")))) + (widget-field-face ((t (:background "dim gray")))) + (widget-inactive-face ((t (:foreground "light gray")))) + (widget-single-line-field-face ((t (:background "dim gray"))))))) + +(defun color-theme-kingsajz () + "Color theme by Olgierd \"Kingsajz\" Ziolko, created 2001-12-04. +Another theme with wheat on DarkSlatGrey. Based on Subtle Hacker. +Used on Emacs 21.1 @ WinMe. Not tested on any other systems. + +Some faces uses Andale mono font (nice fixed-width font). +It is available at: http://www.microsoft.com/typography/downloads/andale32.exe + +Hail Eris! All hail Discordia!" + (interactive) + (color-theme-install + '(color-theme-kingsajz + ((background-color . "darkslategrey") + (background-mode . dark) + (border-color . "black") + (cursor-color . "LightGray") + (foreground-color . "wheat") + (mouse-color . "Grey")) + ((apropos-keybinding-face . underline) + (apropos-label-face face italic mouse-face highlight) + (apropos-match-face . secondary-selection) + (apropos-property-face . bold-italic) + (apropos-symbol-face . info-xref) + (display-time-mail-face . mode-line) + (gnus-article-button-face . bold) + (gnus-article-mouse-face . highlight) + (gnus-carpal-button-face . bold) + (gnus-carpal-header-face . bold-italic) + (gnus-cite-attribution-face . gnus-cite-attribution-face) + (gnus-mouse-face . highlight) + (gnus-selected-tree-face . modeline) + (gnus-signature-face . gnus-signature-face) + (gnus-summary-selected-face . gnus-summary-selected-face) + (gnus-treat-display-xface . head) + (help-highlight-face . underline) + (list-matching-lines-face . bold) + (view-highlight-face . highlight) + (widget-mouse-face . highlight)) + (default ((t (:stipple nil :background "darkslategrey" :foreground "wheat" :inverse-video nil :box nil :strike-through nil :overline nil :underline nil :slant normal :weight normal :width normal :family "outline-andale mono")))) + (bbdb-field-name ((t (:foreground "green")))) + (bg:erc-color-face0 ((t (:background "White")))) + (bg:erc-color-face1 ((t (:background "black")))) + (bg:erc-color-face10 ((t (:background "lightblue1")))) + (bg:erc-color-face11 ((t (:background "cyan")))) + (bg:erc-color-face12 ((t (:background "blue")))) + (bg:erc-color-face13 ((t (:background "deeppink")))) + (bg:erc-color-face14 ((t (:background "gray50")))) + (bg:erc-color-face15 ((t (:background "gray90")))) + (bg:erc-color-face2 ((t (:background "blue4")))) + (bg:erc-color-face3 ((t (:background "green4")))) + (bg:erc-color-face4 ((t (:background "red")))) + (bg:erc-color-face5 ((t (:background "brown")))) + (bg:erc-color-face6 ((t (:background "purple")))) + (bg:erc-color-face7 ((t (:background "orange")))) + (bg:erc-color-face8 ((t (:background "yellow")))) + (bg:erc-color-face9 ((t (:background "green")))) + (blue ((t (:foreground "cyan")))) + (bold ((t (:bold t :foreground "OrangeRed" :weight bold :family "Arial")))) + (bold-italic ((t (:italic t :bold t :slant italic :weight bold :family "Arial")))) + (border ((t (:background "black")))) + (calendar-today-face ((t (:underline t)))) + (comint-highlight-input ((t (:bold t :weight bold)))) + (comint-highlight-prompt ((t (:foreground "cyan")))) + (cperl-array-face ((t (:foreground "Yellow")))) + (cperl-hash-face ((t (:foreground "White")))) + (cperl-nonoverridable-face ((t (:foreground "SkyBlue")))) + (cursor ((t (:background "LightGray")))) + (custom-button-face ((t (:foreground "MediumSlateBlue" :underline t)))) + (custom-button-pressed-face ((t (:background "lightgrey" :foreground "black" :box (:line-width 2 :style pressed-button))))) + (custom-changed-face ((t (:background "blue" :foreground "white")))) + (custom-comment-face ((t (:background "dim gray")))) + (custom-comment-tag-face ((t (:foreground "gray80")))) + (custom-documentation-face ((t (:foreground "Grey")))) + (custom-face-tag-face ((t (:bold t :family "Arial" :weight bold :height 1.2)))) + (custom-group-tag-face ((t (:foreground "MediumAquamarine")))) + (custom-group-tag-face-1 ((t (:bold t :family "Arial" :foreground "pink" :weight bold :height 1.2)))) + (custom-invalid-face ((t (:background "red" :foreground "yellow")))) + (custom-modified-face ((t (:background "blue" :foreground "white")))) + (custom-rogue-face ((t (:background "black" :foreground "pink")))) + (custom-saved-face ((t (:underline t)))) + (custom-set-face ((t (:background "white" :foreground "blue")))) + (custom-state-face ((t (:foreground "Coral")))) + (custom-variable-button-face ((t (:underline t)))) + (custom-variable-tag-face ((t (:foreground "Aquamarine")))) + (date ((t (:foreground "green")))) + (diary-face ((t (:bold t :foreground "IndianRed" :weight bold)))) + (dired-face-directory ((t (:bold t :foreground "sky blue" :weight bold)))) + (dired-face-executable ((t (:foreground "green yellow")))) + (dired-face-flagged ((t (:foreground "tomato")))) + (dired-face-marked ((t (:foreground "light salmon")))) + (dired-face-permissions ((t (:foreground "aquamarine")))) + (erc-action-face ((t (:bold t :weight bold)))) + (erc-bold-face ((t (:bold t :weight bold)))) + (erc-default-face ((t (nil)))) + (erc-direct-msg-face ((t (:foreground "pale green")))) + (erc-error-face ((t (:bold t :foreground "IndianRed" :weight bold)))) + (erc-highlight-face ((t (:bold t :foreground "pale green" :weight bold)))) + (erc-host-danger-face ((t (:foreground "red")))) + (erc-input-face ((t (:foreground "light blue")))) + (erc-inverse-face ((t (:background "steel blue")))) + (erc-notice-face ((t (:foreground "light salmon")))) + (erc-pal-face ((t (:foreground "pale green")))) + (erc-prompt-face ((t (:bold t :foreground "light blue" :weight bold)))) + (erc-underline-face ((t (:underline t)))) + (eshell-ls-archive-face ((t (:bold t :foreground "IndianRed" :weight bold)))) + (eshell-ls-backup-face ((t (:foreground "Grey")))) + (eshell-ls-clutter-face ((t (:bold t :foreground "DimGray" :weight bold)))) + (eshell-ls-directory-face ((t (:bold t :foreground "MediumSlateBlue" :weight bold)))) + (eshell-ls-executable-face ((t (:bold t :foreground "Coral" :weight bold)))) + (eshell-ls-missing-face ((t (:bold t :foreground "black" :weight bold)))) + (eshell-ls-picture-face ((t (:foreground "Violet")))) + (eshell-ls-product-face ((t (:foreground "LightSalmon")))) + (eshell-ls-readonly-face ((t (:foreground "Aquamarine")))) + (eshell-ls-special-face ((t (:bold t :foreground "Gold" :weight bold)))) + (eshell-ls-symlink-face ((t (:bold t :foreground "White" :weight bold)))) + (eshell-ls-text-face ((t (:foreground "medium aquamarine")))) + (eshell-ls-todo-face ((t (:bold t :foreground "aquamarine" :weight bold)))) + (eshell-ls-unreadable-face ((t (:foreground "DimGray")))) + (eshell-prompt-face ((t (:foreground "powder blue")))) + (face-1 ((t (:stipple nil :foreground "royal blue" :family "andale mono")))) + (face-2 ((t (:stipple nil :foreground "DeepSkyBlue1" :overline nil :underline nil :slant normal :family "outline-andale mono")))) + (face-3 ((t (:stipple nil :foreground "NavajoWhite3")))) + (fg:erc-color-face0 ((t (:foreground "white")))) + (fg:erc-color-face1 ((t (:foreground "beige")))) + (fg:erc-color-face10 ((t (:foreground "pale goldenrod")))) + (fg:erc-color-face11 ((t (:foreground "light goldenrod yellow")))) + (fg:erc-color-face12 ((t (:foreground "light yellow")))) + (fg:erc-color-face13 ((t (:foreground "yellow")))) + (fg:erc-color-face14 ((t (:foreground "light goldenrod")))) + (fg:erc-color-face15 ((t (:foreground "lime green")))) + (fg:erc-color-face2 ((t (:foreground "lemon chiffon")))) + (fg:erc-color-face3 ((t (:foreground "light cyan")))) + (fg:erc-color-face4 ((t (:foreground "powder blue")))) + (fg:erc-color-face5 ((t (:foreground "sky blue")))) + (fg:erc-color-face6 ((t (:foreground "dark sea green")))) + (fg:erc-color-face7 ((t (:foreground "pale green")))) + (fg:erc-color-face8 ((t (:foreground "medium spring green")))) + (fg:erc-color-face9 ((t (:foreground "khaki")))) + (fixed-pitch ((t (:family "courier")))) + (font-lock-builtin-face ((t (:bold t :foreground "PaleGreen" :weight bold)))) + (font-lock-comment-face ((t (:foreground "White")))) + (font-lock-constant-face ((t (:bold t :foreground "Aquamarine" :weight bold)))) + (font-lock-doc-face ((t (:italic t :slant italic :foreground "LightSalmon")))) + (font-lock-doc-string-face ((t (:foreground "LightSalmon")))) + (font-lock-function-name-face ((t (:bold t :foreground "MediumSlateBlue" :weight bold)))) + (font-lock-keyword-face ((t (:foreground "Salmon")))) + (font-lock-preprocessor-face ((t (:foreground "Salmon")))) + (font-lock-reference-face ((t (:foreground "pale green")))) + (font-lock-string-face ((t (:italic t :foreground "LightSalmon" :slant italic)))) + (font-lock-type-face ((t (:bold t :foreground "YellowGreen" :weight bold)))) + (font-lock-variable-name-face ((t (:italic t :bold t :foreground "Aquamarine" :slant italic :weight bold)))) + (font-lock-warning-face ((t (:bold t :foreground "IndianRed" :weight bold)))) + (fringe ((t (:background "darkslategrey")))) + (gnus-cite-attribution-face ((t (:family "arial")))) + (gnus-cite-face-1 ((t (:foreground "DarkGoldenrod3")))) + (gnus-cite-face-10 ((t (nil)))) + (gnus-cite-face-11 ((t (nil)))) + (gnus-cite-face-2 ((t (:foreground "IndianRed3")))) + (gnus-cite-face-3 ((t (:foreground "tomato")))) + (gnus-cite-face-4 ((t (:foreground "yellow green")))) + (gnus-cite-face-5 ((t (:foreground "SteelBlue3")))) + (gnus-cite-face-6 ((t (:foreground "Azure3")))) + (gnus-cite-face-7 ((t (:foreground "Azure4")))) + (gnus-cite-face-8 ((t (:foreground "SpringGreen4")))) + (gnus-cite-face-9 ((t (:foreground "SlateGray4")))) + (gnus-emphasis-bold ((t (:bold t :foreground "greenyellow" :weight bold :family "Arial")))) + (gnus-emphasis-bold-italic ((t (:italic t :bold t :foreground "OrangeRed1" :slant italic :weight bold :family "arial")))) + (gnus-emphasis-highlight-words ((t (:background "black" :foreground "khaki")))) + (gnus-emphasis-italic ((t (:italic t :bold t :foreground "orange" :slant italic :weight bold :family "Arial")))) + (gnus-emphasis-underline ((t (:foreground "greenyellow" :underline t)))) + (gnus-emphasis-underline-bold ((t (:bold t :foreground "khaki" :underline t :weight bold :family "Arial")))) + (gnus-emphasis-underline-bold-italic ((t (:italic t :bold t :underline t :slant italic :weight bold :family "Arial")))) + (gnus-emphasis-underline-italic ((t (:italic t :foreground "orange" :underline t :slant italic :family "Arial")))) + (gnus-group-mail-1-empty-face ((t (:foreground "Salmon4")))) + (gnus-group-mail-1-face ((t (:bold t :foreground "firebrick1" :weight bold)))) + (gnus-group-mail-2-empty-face ((t (:foreground "turquoise4")))) + (gnus-group-mail-2-face ((t (:bold t :foreground "turquoise" :weight bold)))) + (gnus-group-mail-3-empty-face ((t (:foreground "LightCyan4")))) + (gnus-group-mail-3-face ((t (:bold t :foreground "LightCyan1" :weight bold)))) + (gnus-group-mail-low-empty-face ((t (:foreground "SteelBlue4")))) + (gnus-group-mail-low-face ((t (:bold t :foreground "SteelBlue2" :weight bold)))) + (gnus-group-news-1-empty-face ((t (:foreground "Salmon4")))) + (gnus-group-news-1-face ((t (:bold t :foreground "FireBrick1" :weight bold)))) + (gnus-group-news-2-empty-face ((t (:foreground "darkorange3")))) + (gnus-group-news-2-face ((t (:bold t :foreground "dark orange" :weight bold)))) + (gnus-group-news-3-empty-face ((t (:foreground "turquoise4")))) + (gnus-group-news-3-face ((t (:bold t :foreground "Aquamarine" :weight bold)))) + (gnus-group-news-4-empty-face ((t (:foreground "SpringGreen4")))) + (gnus-group-news-4-face ((t (:bold t :foreground "SpringGreen2" :weight bold)))) + (gnus-group-news-5-empty-face ((t (:foreground "OliveDrab4")))) + (gnus-group-news-5-face ((t (:bold t :foreground "OliveDrab2" :weight bold)))) + (gnus-group-news-6-empty-face ((t (:foreground "DarkGoldenrod4")))) + (gnus-group-news-6-face ((t (:bold t :foreground "DarkGoldenrod3" :weight bold)))) + (gnus-group-news-low-empty-face ((t (:foreground "wheat4")))) + (gnus-group-news-low-face ((t (:bold t :foreground "tan4" :weight bold)))) + (gnus-header-content-face ((t (:foreground "LightSkyBlue3")))) + (gnus-header-from-face ((t (:bold t :foreground "light cyan" :weight bold)))) + (gnus-header-name-face ((t (:bold t :foreground "DodgerBlue1" :weight bold)))) + (gnus-header-newsgroups-face ((t (:italic t :bold t :foreground "LightSkyBlue3" :slant italic :weight bold)))) + (gnus-header-subject-face ((t (:bold t :foreground "light cyan" :weight bold)))) + (gnus-signature-face ((t (:italic t :foreground "salmon" :slant italic)))) + (gnus-splash-face ((t (:foreground "Firebrick1")))) + (gnus-summary-cancelled-face ((t (:background "black" :foreground "yellow")))) + (gnus-summary-high-ancient-face ((t (:bold t :foreground "MistyRose4" :weight bold)))) + (gnus-summary-high-read-face ((t (:bold t :foreground "tomato3" :weight bold)))) + (gnus-summary-high-ticked-face ((t (:bold t :foreground "coral" :weight bold)))) + (gnus-summary-high-unread-face ((t (:italic t :bold t :foreground "red1" :slant italic :weight bold)))) + (gnus-summary-low-ancient-face ((t (:italic t :foreground "DarkSeaGreen4" :slant italic)))) + (gnus-summary-low-read-face ((t (:foreground "SeaGreen4")))) + (gnus-summary-low-ticked-face ((t (:italic t :foreground "Green4" :slant italic)))) + (gnus-summary-low-unread-face ((t (:italic t :foreground "green3" :slant italic)))) + (gnus-summary-normal-ancient-face ((t (:foreground "RoyalBlue")))) + (gnus-summary-normal-read-face ((t (:foreground "khaki4")))) + (gnus-summary-normal-ticked-face ((t (:foreground "khaki3")))) + (gnus-summary-normal-unread-face ((t (:foreground "khaki")))) + (gnus-summary-selected-face ((t (:foreground "gold" :underline t)))) + (green ((t (:foreground "green")))) + (gui-button-face ((t (:foreground "red" :background "black")))) + (gui-element ((t (:bold t :background "#ffffff" :foreground "#000000" :weight bold)))) + (header-line ((t (:box (:line-width -1 :style released-button) :background "grey20" :foreground "grey90" :box nil)))) + (highlight ((t (:background "PaleGreen" :foreground "DarkGreen")))) + (highline-face ((t (:background "SeaGreen")))) + (holiday-face ((t (:background "DimGray")))) + (info-menu-5 ((t (:underline t)))) + (info-node ((t (:bold t :foreground "DodgerBlue1" :underline t :weight bold)))) + (info-xref ((t (:bold t :foreground "DodgerBlue3" :weight bold)))) + (isearch ((t (:background "sea green" :foreground "black")))) + (isearch-lazy-highlight-face ((t (:background "paleturquoise4")))) + (italic ((t (:italic t :foreground "chocolate3" :slant italic)))) + (menu ((t (nil)))) + (message-cited-text-face ((t (:foreground "White")))) + (message-header-cc-face ((t (:foreground "light cyan")))) + (message-header-name-face ((t (:foreground "DodgerBlue1")))) + (message-header-newsgroups-face ((t (:italic t :bold t :foreground "LightSkyBlue3" :slant italic :weight bold)))) + (message-header-other-face ((t (:foreground "LightSkyBlue3")))) + (message-header-subject-face ((t (:bold t :foreground "light cyan" :weight bold)))) + (message-header-to-face ((t (:bold t :foreground "light cyan" :weight bold)))) + (message-header-xheader-face ((t (:foreground "DodgerBlue3")))) + (message-mml-face ((t (:foreground "ForestGreen")))) + (message-separator-face ((t (:background "cornflower blue" :foreground "chocolate")))) + (modeline ((t (:background "dark olive green" :foreground "wheat" :box (:line-width -1 :style released-button))))) + (modeline-buffer-id ((t (:bold t :background "dark olive green" :foreground "beige" :weight bold :family "arial")))) + (modeline-mousable ((t (:bold t :background "dark olive green" :foreground "yellow green" :weight bold :family "arial")))) + (modeline-mousable-minor-mode ((t (:bold t :background "dark olive green" :foreground "wheat" :weight bold :family "arial")))) + (mouse ((t (:background "Grey")))) + (paren-blink-off ((t (:foreground "brown")))) + (region ((t (:background "dark cyan" :foreground "cyan")))) + (ruler-mode-column-number-face ((t (:box (:color "grey76" :line-width 1 :style released-button) :background "grey76" :stipple nil :inverse-video nil :strike-through nil :overline nil :underline nil :slant normal :weight normal :width normal :family "outline-andale mono" :foreground "black")))) + (ruler-mode-current-column-face ((t (:bold t :box (:color "grey76" :line-width 1 :style released-button) :background "grey76" :stipple nil :inverse-video nil :strike-through nil :overline nil :underline nil :slant normal :width normal :family "outline-andale mono" :foreground "yellow" :weight bold)))) + (ruler-mode-default-face ((t (:family "outline-andale mono" :width normal :weight normal :slant normal :underline nil :overline nil :strike-through nil :inverse-video nil :stipple nil :background "grey76" :foreground "grey64" :box (:color "grey76" :line-width 1 :style released-button))))) + (ruler-mode-fill-column-face ((t (:box (:color "grey76" :line-width 1 :style released-button) :background "grey76" :stipple nil :inverse-video nil :strike-through nil :overline nil :underline nil :slant normal :weight normal :width normal :family "outline-andale mono" :foreground "red")))) + (ruler-mode-margins-face ((t (:box (:color "grey76" :line-width 1 :style released-button) :foreground "grey64" :stipple nil :inverse-video nil :strike-through nil :overline nil :underline nil :slant normal :weight normal :width normal :family "outline-andale mono" :background "grey64")))) + (ruler-mode-tab-stop-face ((t (:box (:color "grey76" :line-width 1 :style released-button) :background "grey76" :stipple nil :inverse-video nil :strike-through nil :overline nil :underline nil :slant normal :weight normal :width normal :family "outline-andale mono" :foreground "steelblue")))) + (scroll-bar ((t (nil)))) + (secondary-selection ((t (:background "Aquamarine" :foreground "SlateBlue")))) + (show-paren-match-face ((t (:bold t :background "Aquamarine" :foreground "steel blue" :weight bold)))) + (show-paren-mismatch-face ((t (:background "Red" :foreground "White")))) + (swbuff-current-buffer-face ((t (:bold t :foreground "red" :weight bold)))) + (text-cursor ((t (:background "Red" :foreground "white")))) + (tool-bar ((t (:background "grey75" :foreground "black" :box (:line-width 1 :style released-button))))) + (trailing-whitespace ((t (:background "red")))) + (underline ((t (:underline t)))) + (variable-pitch ((t (:family "Arial")))) + (w3m-anchor-face ((t (:bold t :foreground "DodgerBlue1" :weight bold)))) + (w3m-arrived-anchor-face ((t (:bold t :foreground "DodgerBlue3" :weight bold)))) + (w3m-header-line-location-content-face ((t (:background "dark olive green" :foreground "wheat")))) + (w3m-header-line-location-title-face ((t (:background "dark olive green" :foreground "beige")))) + (widget-button-face ((t (:bold t :foreground "green" :weight bold :family "courier")))) + (widget-button-pressed-face ((t (:foreground "red")))) + (widget-documentation-face ((t (:foreground "lime green")))) + (widget-field-face ((t (:foreground "LightBlue")))) + (widget-inactive-face ((t (:foreground "DimGray")))) + (widget-single-line-field-face ((t (:foreground "LightBlue")))) + (woman-bold-face ((t (:bold t :weight bold :family "Arial")))) + (woman-italic-face ((t (:italic t :foreground "beige" :slant italic :family "Arial")))) + (woman-unknown-face ((t (:foreground "LightSalmon")))) + (zmacs-region ((t (:background "dark cyan" :foreground "cyan"))))))) + +(defun color-theme-comidia () + "Color theme by Marcelo Dias de Toledo, created 2001-12-17. +Steel blue on black." + (interactive) + (color-theme-install + '(color-theme-comidia + ((background-color . "Black") + (background-mode . dark) + (border-color . "black") + (cursor-color . "SteelBlue") + (foreground-color . "SteelBlue") + (mouse-color . "SteelBlue")) + ((display-time-mail-face . mode-line) + (gnus-mouse-face . highlight) + (gnus-summary-selected-face . gnus-summary-selected-face) + (help-highlight-face . underline) + (ispell-highlight-face . highlight) + (list-matching-lines-face . bold) + (view-highlight-face . highlight) + (widget-mouse-face . highlight)) + (default ((t (:stipple nil :background "Black" :foreground "SteelBlue" :inverse-video nil :box nil :strike-through nil :overline nil :underline nil :slant normal :weight normal :width semi-condensed :family "misc-fixed")))) + (bg:erc-color-face0 ((t (:background "White")))) + (bg:erc-color-face1 ((t (:background "black")))) + (bg:erc-color-face10 ((t (:background "lightblue1")))) + (bg:erc-color-face11 ((t (:background "cyan")))) + (bg:erc-color-face12 ((t (:background "blue")))) + (bg:erc-color-face13 ((t (:background "deeppink")))) + (bg:erc-color-face14 ((t (:background "gray50")))) + (bg:erc-color-face15 ((t (:background "gray90")))) + (bg:erc-color-face2 ((t (:background "blue4")))) + (bg:erc-color-face3 ((t (:background "green4")))) + (bg:erc-color-face4 ((t (:background "red")))) + (bg:erc-color-face5 ((t (:background "brown")))) + (bg:erc-color-face6 ((t (:background "purple")))) + (bg:erc-color-face7 ((t (:background "orange")))) + (bg:erc-color-face8 ((t (:background "yellow")))) + (bg:erc-color-face9 ((t (:background "green")))) + (bold ((t (:bold t :weight bold)))) + (bold-italic ((t (:italic t :bold t :slant italic :weight bold)))) + (border ((t (:background "black")))) + (comint-highlight-input ((t (:bold t :weight bold)))) + (comint-highlight-prompt ((t (:foreground "cyan")))) + (cursor ((t (:background "SteelBlue")))) + (erc-action-face ((t (:bold t :weight bold)))) + (erc-bold-face ((t (:bold t :weight bold)))) + (erc-dangerous-host-face ((t (:foreground "red")))) + (erc-default-face ((t (nil)))) + (erc-direct-msg-face ((t (:foreground "IndianRed")))) + (erc-error-face ((t (:background "Red" :foreground "White")))) + (erc-fool-face ((t (:foreground "dim gray")))) + (erc-input-face ((t (:foreground "brown")))) + (erc-inverse-face ((t (:background "Black" :foreground "White")))) + (erc-keyword-face ((t (:bold t :foreground "pale green" :weight bold)))) + (erc-notice-face ((t (:bold t :foreground "SlateBlue" :weight bold)))) + (erc-pal-face ((t (:bold t :foreground "Magenta" :weight bold)))) + (erc-prompt-face ((t (:bold t :background "lightBlue2" :foreground "Black" :weight bold)))) + (erc-timestamp-face ((t (:bold t :foreground "green" :weight bold)))) + (erc-underline-face ((t (:underline t)))) + (fg:erc-color-face0 ((t (:foreground "White")))) + (fg:erc-color-face1 ((t (:foreground "black")))) + (fg:erc-color-face10 ((t (:foreground "lightblue1")))) + (fg:erc-color-face11 ((t (:foreground "cyan")))) + (fg:erc-color-face12 ((t (:foreground "blue")))) + (fg:erc-color-face13 ((t (:foreground "deeppink")))) + (fg:erc-color-face14 ((t (:foreground "gray50")))) + (fg:erc-color-face15 ((t (:foreground "gray90")))) + (fg:erc-color-face2 ((t (:foreground "blue4")))) + (fg:erc-color-face3 ((t (:foreground "green4")))) + (fg:erc-color-face4 ((t (:foreground "red")))) + (fg:erc-color-face5 ((t (:foreground "brown")))) + (fg:erc-color-face6 ((t (:foreground "purple")))) + (fg:erc-color-face7 ((t (:foreground "orange")))) + (fg:erc-color-face8 ((t (:foreground "yellow")))) + (fg:erc-color-face9 ((t (:foreground "green")))) + (fixed-pitch ((t (:family "courier")))) + (font-lock-builtin-face ((t (:foreground "LightSteelBlue")))) + (font-lock-comment-face ((t (:foreground "chocolate1")))) + (font-lock-constant-face ((t (:foreground "Aquamarine")))) + (font-lock-doc-face ((t (:foreground "LightSalmon")))) + (font-lock-doc-string-face ((t (:foreground "LightSalmon")))) + (font-lock-function-name-face ((t (:foreground "LightSkyBlue")))) + (font-lock-keyword-face ((t (:foreground "Cyan")))) + (font-lock-preprocessor-face ((t (:foreground "Aquamarine")))) + (font-lock-reference-face ((t (:foreground "LightSteelBlue")))) + (font-lock-string-face ((t (:foreground "LightSalmon")))) + (font-lock-type-face ((t (:foreground "PaleGreen")))) + (font-lock-variable-name-face ((t (:foreground "LightGoldenrod")))) + (font-lock-warning-face ((t (:bold t :foreground "Pink" :weight bold)))) + (fringe ((t (:background "grey10")))) + (gnus-group-mail-1-empty-face ((t (:foreground "aquamarine1")))) + (gnus-group-mail-1-face ((t (:bold t :foreground "aquamarine1" :weight bold)))) + (gnus-group-mail-2-empty-face ((t (:foreground "aquamarine2")))) + (gnus-group-mail-2-face ((t (:bold t :foreground "aquamarine2" :weight bold)))) + (gnus-group-mail-3-empty-face ((t (:foreground "aquamarine3")))) + (gnus-group-mail-3-face ((t (:bold t :foreground "aquamarine3" :weight bold)))) + (gnus-group-mail-low-empty-face ((t (:foreground "aquamarine4")))) + (gnus-group-mail-low-face ((t (:bold t :foreground "aquamarine4" :weight bold)))) + (gnus-group-news-1-empty-face ((t (:foreground "PaleTurquoise")))) + (gnus-group-news-1-face ((t (:bold t :foreground "PaleTurquoise" :weight bold)))) + (gnus-group-news-2-empty-face ((t (:foreground "turquoise")))) + (gnus-group-news-2-face ((t (:bold t :foreground "turquoise" :weight bold)))) + (gnus-group-news-3-empty-face ((t (nil)))) + (gnus-group-news-3-face ((t (:bold t :weight bold)))) + (gnus-group-news-4-empty-face ((t (nil)))) + (gnus-group-news-4-face ((t (:bold t :weight bold)))) + (gnus-group-news-5-empty-face ((t (nil)))) + (gnus-group-news-5-face ((t (:bold t :weight bold)))) + (gnus-group-news-6-empty-face ((t (nil)))) + (gnus-group-news-6-face ((t (:bold t :weight bold)))) + (gnus-group-news-low-empty-face ((t (:foreground "DarkTurquoise")))) + (gnus-group-news-low-face ((t (:bold t :foreground "DarkTurquoise" :weight bold)))) + (gnus-splash-face ((t (:foreground "Brown")))) + (gnus-summary-cancelled-face ((t (:background "black" :foreground "yellow")))) + (gnus-summary-high-ancient-face ((t (:bold t :foreground "SkyBlue" :weight bold)))) + (gnus-summary-high-read-face ((t (:bold t :foreground "PaleGreen" :weight bold)))) + (gnus-summary-high-ticked-face ((t (:bold t :foreground "pink" :weight bold)))) + (gnus-summary-high-unread-face ((t (:bold t :weight bold)))) + (gnus-summary-low-ancient-face ((t (:italic t :foreground "SkyBlue" :slant italic)))) + (gnus-summary-low-read-face ((t (:italic t :foreground "PaleGreen" :slant italic)))) + (gnus-summary-low-ticked-face ((t (:italic t :foreground "pink" :slant italic)))) + (gnus-summary-low-unread-face ((t (:italic t :slant italic)))) + (gnus-summary-normal-ancient-face ((t (:foreground "SkyBlue")))) + (gnus-summary-normal-read-face ((t (:foreground "PaleGreen")))) + (gnus-summary-normal-ticked-face ((t (:foreground "pink")))) + (gnus-summary-normal-unread-face ((t (nil)))) + (gnus-summary-selected-face ((t (:underline t)))) + (header-line ((t (:family "neep" :width condensed :box (:line-width 1 :style none) :background "grey20" :foreground "grey90" :box nil)))) + (highlight ((t (:background "darkolivegreen")))) + (isearch ((t (:background "palevioletred2" :foreground "brown4")))) + (isearch-lazy-highlight-face ((t (:background "paleturquoise4")))) + (italic ((t (:italic t :slant italic)))) + (menu ((t (nil)))) + (message-cited-text-face ((t (:foreground "red")))) + (message-header-cc-face ((t (:bold t :foreground "green4" :weight bold)))) + (message-header-name-face ((t (:foreground "DarkGreen")))) + (message-header-newsgroups-face ((t (:italic t :bold t :foreground "yellow" :slant italic :weight bold)))) + (message-header-other-face ((t (:foreground "#b00000")))) + (message-header-subject-face ((t (:foreground "green3")))) + (message-header-to-face ((t (:bold t :foreground "green2" :weight bold)))) + (message-header-xheader-face ((t (:foreground "blue")))) + (message-mml-face ((t (:foreground "ForestGreen")))) + (message-separator-face ((t (:foreground "blue3")))) + (modeline ((t (:background "Gray10" :foreground "SteelBlue" :box (:line-width 1 :style none) :width condensed :family "neep")))) + (modeline-buffer-id ((t (:background "Gray10" :foreground "SteelBlue" :box (:line-width 1 :style none) :width condensed :family "neep")))) + (modeline-mousable-minor-mode ((t (:background "Gray10" :foreground "SteelBlue" :box (:line-width 1 :style none) :width condensed :family "neep")))) + (modeline-mousable ((t (:background "Gray10" :foreground "SteelBlue" :box (:line-width 1 :style none) :width condensed :family "neep")))) + (mouse ((t (:background "SteelBlue")))) + (primary-selection ((t (:background "blue3")))) + (region ((t (:background "blue3")))) + (scroll-bar ((t (:background "grey75")))) + (secondary-selection ((t (:background "SkyBlue4")))) + (speedbar-button-face ((t (:foreground "green3")))) + (speedbar-directory-face ((t (:foreground "light blue")))) + (speedbar-file-face ((t (:foreground "cyan")))) + (speedbar-highlight-face ((t (:background "sea green")))) + (speedbar-selected-face ((t (:foreground "red" :underline t)))) + (speedbar-tag-face ((t (:foreground "yellow")))) + (tool-bar ((t (:background "grey75" :foreground "black" :box (:line-width 1 :style released-button))))) + (tooltip ((t (:background "lightyellow" :foreground "black")))) + (trailing-whitespace ((t (:background "red")))) + (underline ((t (:underline t)))) + (variable-pitch ((t (:family "helv")))) + (widget-button-face ((t (:bold t :weight bold)))) + (widget-button-pressed-face ((t (:foreground "red")))) + (widget-documentation-face ((t (:foreground "lime green")))) + (widget-field-face ((t (:background "dim gray")))) + (widget-inactive-face ((t (:foreground "light gray")))) + (widget-single-line-field-face ((t (:background "dim gray")))) + (zmacs-region ((t (:background "blue3"))))))) + +(defun color-theme-katester () + "Color theme by walterh@rocketmail.com, created 2001-12-12. +A pastelly-mac like color-theme." + (interactive) + (color-theme-standard) + (let ((color-theme-is-cumulative t)) + (color-theme-install + '(color-theme-katester + ((background-color . "ivory") + (cursor-color . "slateblue") + (foreground-color . "black") + (mouse-color . "slateblue")) + (default ((t ((:background "ivory" :foreground "black"))))) + (bold ((t (:bold t)))) + (font-lock-string-face ((t (:foreground "maroon")))) + (font-lock-keyword-face ((t (:foreground "blue")))) + (font-lock-constant-face ((t (:foreground "darkblue")))) + (font-lock-type-face ((t (:foreground "black")))) + (font-lock-variable-name-face ((t (:foreground "black")))) + (font-lock-function-name-face ((t (:bold t :underline t)))) + (font-lock-comment-face ((t (:background "seashell")))) + (highlight ((t (:background "lavender")))) + (italic ((t (:italic t)))) + (modeline ((t (:background "moccasin" :foreground "black")))) + (region ((t (:background "lavender" )))) + (underline ((t (:underline t)))))))) + +(defun color-theme-arjen () + "Color theme by awiersma, created 2001-08-27." + (interactive) + (color-theme-install + '(color-theme-arjen + ((background-color . "black") + (background-mode . dark) + (border-color . "black") + (cursor-color . "yellow") + (foreground-color . "White") + (mouse-color . "sienna1")) + ((buffers-tab-face . buffers-tab) + (cperl-here-face . font-lock-string-face) + (cperl-invalid-face quote underline) + (cperl-pod-face . font-lock-comment-face) + (cperl-pod-head-face . font-lock-variable-name-face) + (vc-mode-face . highlight)) + (default ((t (:background "black" :foreground "white")))) + (blue ((t (:foreground "blue")))) + (bold ((t (:bold t)))) + (bold-italic ((t (:bold t)))) + (border-glyph ((t (nil)))) + (buffers-tab ((t (:background "black" :foreground "white")))) + (calendar-today-face ((t (:underline t)))) + (cperl-array-face ((t (:foreground "darkseagreen")))) + (cperl-hash-face ((t (:foreground "darkseagreen")))) + (cperl-nonoverridable-face ((t (:foreground "SkyBlue")))) + (custom-button-face ((t (nil)))) + (custom-changed-face ((t (:background "blue" :foreground "white")))) + (custom-documentation-face ((t (nil)))) + (custom-face-tag-face ((t (:underline t)))) + (custom-group-tag-face ((t (:underline t :foreground "light blue")))) + (custom-group-tag-face-1 ((t (:underline t :foreground "pink")))) + (custom-invalid-face ((t (:background "red" :foreground "yellow")))) + (custom-modified-face ((t (:background "blue" :foreground "white")))) + (custom-rogue-face ((t (:background "black" :foreground "pink")))) + (custom-saved-face ((t (:underline t)))) + (custom-set-face ((t (:background "white" :foreground "blue")))) + (custom-state-face ((t (:foreground "lime green")))) + (custom-variable-button-face ((t (:underline t :bold t)))) + (custom-variable-tag-face ((t (:underline t :foreground "light blue")))) + (diary-face ((t (:foreground "IndianRed")))) + (erc-action-face ((t (:bold t)))) + (erc-bold-face ((t (:bold t)))) + (erc-default-face ((t (nil)))) + (erc-direct-msg-face ((t (:foreground "sandybrown")))) + (erc-error-face ((t (:bold t :foreground "IndianRed")))) + (erc-input-face ((t (:foreground "Beige")))) + (erc-inverse-face ((t (:background "wheat" :foreground "darkslategrey")))) + (erc-notice-face ((t (:foreground "MediumAquamarine")))) + (erc-pal-face ((t (:foreground "pale green")))) + (erc-prompt-face ((t (:foreground "MediumAquamarine")))) + (erc-underline-face ((t (:underline t)))) + (eshell-ls-archive-face ((t (:bold t :foreground "IndianRed")))) + (eshell-ls-backup-face ((t (:foreground "Grey")))) + (eshell-ls-clutter-face ((t (:foreground "DimGray")))) + (eshell-ls-directory-face ((t (:bold t :foreground "MediumSlateBlue")))) + (eshell-ls-executable-face ((t (:foreground "Coral")))) + (eshell-ls-missing-face ((t (:foreground "black")))) + (eshell-ls-picture-face ((t (:foreground "Violet")))) + (eshell-ls-product-face ((t (:foreground "sandybrown")))) + (eshell-ls-readonly-face ((t (:foreground "Aquamarine")))) + (eshell-ls-special-face ((t (:foreground "Gold")))) + (eshell-ls-symlink-face ((t (:foreground "White")))) + (eshell-ls-unreadable-face ((t (:foreground "DimGray")))) + (eshell-prompt-face ((t (:foreground "MediumAquamarine")))) + (fl-comment-face ((t (:foreground "pink")))) + (fl-doc-string-face ((t (:foreground "purple")))) + (fl-function-name-face ((t (:foreground "red")))) + (fl-keyword-face ((t (:foreground "cadetblue")))) + (fl-string-face ((t (:foreground "green")))) + (fl-type-face ((t (:foreground "yellow")))) + (font-lock-builtin-face ((t (:foreground "LightSteelBlue")))) + (font-lock-comment-face ((t (:foreground "IndianRed")))) + (font-lock-constant-face ((t (:foreground "Aquamarine")))) + (font-lock-doc-string-face ((t (:foreground "DarkOrange")))) + (font-lock-function-name-face ((t (:foreground "YellowGreen")))) + (font-lock-keyword-face ((t (:foreground "PaleYellow")))) + (font-lock-preprocessor-face ((t (:foreground "Aquamarine")))) + (font-lock-reference-face ((t (:foreground "SlateBlue")))) + (font-lock-string-face ((t (:foreground "Orange")))) + (font-lock-type-face ((t (:foreground "Green")))) + (font-lock-variable-name-face ((t (:foreground "darkseagreen")))) + (font-lock-warning-face ((t (:bold t :foreground "Pink")))) + (qt-classes-face ((t (:foreground "Red")))) + (gnus-cite-attribution-face ((t (nil)))) + (gnus-cite-face-1 ((t (:bold nil :foreground "deep sky blue")))) + (gnus-cite-face-10 ((t (:foreground "medium purple")))) + (gnus-cite-face-11 ((t (:foreground "turquoise")))) + (gnus-cite-face-2 ((t (:bold nil :foreground "cadetblue")))) + (gnus-cite-face-3 ((t (:bold nil :foreground "gold")))) + (gnus-cite-face-4 ((t (:foreground "light pink")))) + (gnus-cite-face-5 ((t (:foreground "pale green")))) + (gnus-cite-face-6 ((t (:bold nil :foreground "chocolate")))) + (gnus-cite-face-7 ((t (:foreground "orange")))) + (gnus-cite-face-8 ((t (:foreground "magenta")))) + (gnus-cite-face-9 ((t (:foreground "violet")))) + (gnus-emphasis-bold ((t (:bold nil)))) + (gnus-emphasis-bold-italic ((t (:bold nil)))) + (gnus-emphasis-highlight-words ((t (:background "black" :foreground "yellow")))) + (gnus-emphasis-italic ((t (nil)))) + (gnus-emphasis-underline ((t (:underline t)))) + (gnus-emphasis-underline-bold ((t (:underline t :bold nil)))) + (gnus-emphasis-underline-bold-italic ((t (:underline t :bold nil)))) + (gnus-emphasis-underline-italic ((t (:underline t)))) + (gnus-group-mail-1-empty-face ((t (:foreground "aquamarine1")))) + (gnus-group-mail-1-face ((t (:bold nil :foreground "aquamarine1")))) + (gnus-group-mail-2-empty-face ((t (:foreground "aquamarine2")))) + (gnus-group-mail-2-face ((t (:bold nil :foreground "aquamarine2")))) + (gnus-group-mail-3-empty-face ((t (:foreground "aquamarine3")))) + (gnus-group-mail-3-face ((t (:bold nil :foreground "aquamarine3")))) + (gnus-group-mail-low-empty-face ((t (:foreground "aquamarine4")))) + (gnus-group-mail-low-face ((t (:bold nil :foreground "aquamarine4")))) + (gnus-group-news-1-empty-face ((t (:foreground "PaleTurquoise")))) + (gnus-group-news-1-face ((t (:bold nil :foreground "PaleTurquoise")))) + (gnus-group-news-2-empty-face ((t (:foreground "turquoise")))) + (gnus-group-news-2-face ((t (:bold nil :foreground "turquoise")))) + (gnus-group-news-3-empty-face ((t (nil)))) + (gnus-group-news-3-face ((t (:bold nil)))) + (gnus-group-news-4-empty-face ((t (nil)))) + (gnus-group-news-4-face ((t (:bold nil)))) + (gnus-group-news-5-empty-face ((t (nil)))) + (gnus-group-news-5-face ((t (:bold nil)))) + (gnus-group-news-6-empty-face ((t (nil)))) + (gnus-group-news-6-face ((t (:bold nil)))) + (gnus-group-news-low-empty-face ((t (:foreground "DarkTurquoise")))) + (gnus-group-news-low-face ((t (:bold nil :foreground "DarkTurquoise")))) + (gnus-header-content-face ((t (:foreground "forest green")))) + (gnus-header-from-face ((t (:bold nil :foreground "spring green")))) + (gnus-header-name-face ((t (:foreground "deep sky blue")))) + (gnus-header-newsgroups-face ((t (:bold nil :foreground "purple")))) + (gnus-header-subject-face ((t (:bold nil :foreground "orange")))) + (gnus-signature-face ((t (:bold nil :foreground "khaki")))) + (gnus-splash-face ((t (:foreground "Brown")))) + (gnus-summary-cancelled-face ((t (:background "black" :foreground "yellow")))) + (gnus-summary-high-ancient-face ((t (:bold nil :foreground "SkyBlue")))) + (gnus-summary-high-read-face ((t (:bold nil :foreground "PaleGreen")))) + (gnus-summary-high-ticked-face ((t (:bold nil :foreground "pink")))) + (gnus-summary-high-unread-face ((t (:bold nil)))) + (gnus-summary-low-ancient-face ((t (:foreground "SkyBlue")))) + (gnus-summary-low-read-face ((t (:foreground "PaleGreen")))) + (gnus-summary-low-ticked-face ((t (:foreground "pink")))) + (gnus-summary-low-unread-face ((t (nil)))) + (gnus-summary-normal-ancient-face ((t (:foreground "SkyBlue")))) + (gnus-summary-normal-read-face ((t (:foreground "PaleGreen")))) + (gnus-summary-normal-ticked-face ((t (:foreground "pink")))) + (gnus-summary-normal-unread-face ((t (nil)))) + (gnus-summary-selected-face ((t (:underline t)))) + (green ((t (:foreground "green")))) + (gui-button-face ((t (:background "grey75" :foreground "black")))) + (gui-element ((t (:background "#D4D0C8" :foreground "black")))) + (highlight ((t (:background "darkolivegreen")))) + (highline-face ((t (:background "SeaGreen")))) + (holiday-face ((t (:background "DimGray")))) + (info-menu-5 ((t (:underline t)))) + (info-node ((t (:underline t :bold t :foreground "DodgerBlue1")))) + (info-xref ((t (:underline t :foreground "DodgerBlue1")))) + (isearch ((t (:background "blue")))) + (isearch-secondary ((t (:foreground "red3")))) + (italic ((t (nil)))) + (left-margin ((t (nil)))) + (list-mode-item-selected ((t (:background "gray68" :foreground "white")))) + (message-cited-text-face ((t (:bold t :foreground "green")))) + (message-header-cc-face ((t (:bold t :foreground "green4")))) + (message-header-name-face ((t (:bold t :foreground "orange")))) + (message-header-newsgroups-face ((t (:bold t :foreground "violet")))) + (message-header-other-face ((t (:bold t :foreground "chocolate")))) + (message-header-subject-face ((t (:bold t :foreground "yellow")))) + (message-header-to-face ((t (:bold t :foreground "cadetblue")))) + (message-header-xheader-face ((t (:bold t :foreground "light blue")))) + (message-mml-face ((t (:bold t :foreground "Green3")))) + (message-separator-face ((t (:foreground "blue3")))) + (modeline ((t (:background "DarkRed" :foreground "white" :box (:line-width 1 :style released-button))))) + (modeline-buffer-id ((t (:background "DarkRed" :foreground "white")))) + (modeline-mousable ((t (:background "DarkRed" :foreground "white")))) + (modeline-mousable-minor-mode ((t (:background "DarkRed" :foreground "white")))) + (p4-depot-added-face ((t (:foreground "blue")))) + (p4-depot-deleted-face ((t (:foreground "red")))) + (p4-depot-unmapped-face ((t (:foreground "grey30")))) + (p4-diff-change-face ((t (:foreground "dark green")))) + (p4-diff-del-face ((t (:foreground "red")))) + (p4-diff-file-face ((t (:background "gray90")))) + (p4-diff-head-face ((t (:background "gray95")))) + (p4-diff-ins-face ((t (:foreground "blue")))) + (pointer ((t (nil)))) + (primary-selection ((t (:background "blue")))) + (red ((t (:foreground "red")))) + (region ((t (:background "blue")))) + (right-margin ((t (nil)))) + (secondary-selection ((t (:background "darkslateblue")))) + (show-paren-match-face ((t (:background "Aquamarine" :foreground "SlateBlue")))) + (show-paren-mismatch-face ((t (:background "Red" :foreground "White")))) + (text-cursor ((t (:background "yellow" :foreground "black")))) + (toolbar ((t (nil)))) + (underline ((nil (:underline nil)))) + (vertical-divider ((t (nil)))) + (widget ((t (nil)))) + (widget-button-face ((t (:bold t)))) + (widget-button-pressed-face ((t (:foreground "red")))) + (widget-documentation-face ((t (:foreground "lime green")))) + (widget-field-face ((t (:background "dim gray")))) + (widget-inactive-face ((t (:foreground "light gray")))) + (widget-single-line-field-face ((t (:background "dim gray")))) + (woman-bold-face ((t (:bold t)))) + (woman-italic-face ((t (:foreground "beige")))) + (woman-unknown-face ((t (:foreground "LightSalmon")))) + (yellow ((t (:foreground "yellow")))) + (zmacs-region ((t (:background "snow" :foreground "blue"))))))) + +(defun color-theme-tty-dark () + "Color theme by Oivvio Polite, created 2002-02-01. Good for tty display." + (interactive) + (color-theme-install + '(color-theme-tty-dark + ((background-color . "black") + (background-mode . dark) + (border-color . "blue") + (cursor-color . "red") + (foreground-color . "white") + (mouse-color . "black")) + ((ispell-highlight-face . highlight) + (list-matching-lines-face . bold) + (tinyreplace-:face . highlight) + (view-highlight-face . highlight)) + (default ((t (nil)))) + (bold ((t (:underline t :background "black" :foreground "white")))) + (bold-italic ((t (:underline t :foreground "white")))) + (calendar-today-face ((t (:underline t)))) + (diary-face ((t (:foreground "red")))) + (font-lock-builtin-face ((t (:foreground "blue")))) + (font-lock-comment-face ((t (:foreground "cyan")))) + (font-lock-constant-face ((t (:foreground "magenta")))) + (font-lock-function-name-face ((t (:foreground "cyan")))) + (font-lock-keyword-face ((t (:foreground "red")))) + (font-lock-string-face ((t (:foreground "green")))) + (font-lock-type-face ((t (:foreground "yellow")))) + (font-lock-variable-name-face ((t (:foreground "blue")))) + (font-lock-warning-face ((t (:bold t :foreground "magenta")))) + (highlight ((t (:background "blue" :foreground "yellow")))) + (holiday-face ((t (:background "cyan")))) + (info-menu-5 ((t (:underline t)))) + (info-node ((t (:italic t :bold t)))) + (info-xref ((t (:bold t)))) + (italic ((t (:underline t :background "red")))) + (message-cited-text-face ((t (:foreground "red")))) + (message-header-cc-face ((t (:bold t :foreground "green")))) + (message-header-name-face ((t (:foreground "green")))) + (message-header-newsgroups-face ((t (:italic t :bold t :foreground "yellow")))) + (message-header-other-face ((t (:foreground "#b00000")))) + (message-header-subject-face ((t (:foreground "green")))) + (message-header-to-face ((t (:bold t :foreground "green")))) + (message-header-xheader-face ((t (:foreground "blue")))) + (message-mml-face ((t (:foreground "green")))) + (message-separator-face ((t (:foreground "blue")))) + + (modeline ((t (:background "white" :foreground "blue")))) + (modeline-buffer-id ((t (:background "white" :foreground "red")))) + (modeline-mousable ((t (:background "white" :foreground "magenta")))) + (modeline-mousable-minor-mode ((t (:background "white" :foreground "yellow")))) + (region ((t (:background "white" :foreground "black")))) + (zmacs-region ((t (:background "cyan" :foreground "black")))) + (secondary-selection ((t (:background "blue")))) + (show-paren-match-face ((t (:background "red")))) + (show-paren-mismatch-face ((t (:background "magenta" :foreground "white")))) + (underline ((t (:underline t))))))) + +(defun color-theme-aliceblue () + "Color theme by Girish Bharadwaj, created 2002-03-27. +Includes comint prompt, custom, font-lock, isearch, +jde, senator, speedbar, and widget." + (interactive) + (color-theme-install + '(color-theme-aliceblue + ((background-color . "AliceBlue") + (background-mode . light) + (border-color . "black") + (cursor-color . "black") + (foreground-color . "DarkSlateGray4") + (mouse-color . "black")) + ((help-highlight-face . underline) + (list-matching-lines-face . bold) + (semantic-which-function-use-color . t) + (senator-eldoc-use-color . t) + (view-highlight-face . highlight) + (widget-mouse-face . highlight)) + (default ((t (:stipple nil :background "AliceBlue" :foreground "DarkSlateGray4" :inverse-video nil :box nil :strike-through nil :overline nil :underline nil :slant normal :weight normal :width normal :family "outline-courier new")))) + (bold ((t (:bold t :weight bold)))) + (bold-italic ((t (:italic t :bold t :slant italic :weight bold)))) + (border ((t (:background "black")))) + (comint-highlight-input ((t (:bold t :weight bold)))) + (comint-highlight-prompt ((t (:foreground "dark blue")))) + (cursor ((t (:background "black")))) + (custom-button-face ((t (:background "lightgrey" :foreground "black" :box (:line-width 2 :style released-button))))) + (custom-button-pressed-face ((t (:background "lightgrey" :foreground "black" :box (:line-width 2 :style pressed-button))))) + (custom-changed-face ((t (:background "blue" :foreground "white")))) + (custom-comment-face ((t (:background "gray85")))) + (custom-comment-tag-face ((t (:foreground "blue4")))) + (custom-documentation-face ((t (nil)))) + (custom-face-tag-face ((t (:bold t :family "helv" :weight bold :height 1.2)))) + (custom-group-tag-face ((t (:bold t :foreground "blue" :weight bold :height 1.2)))) + (custom-group-tag-face-1 ((t (:bold t :family "helv" :foreground "red" :weight bold :height 1.2)))) + (custom-invalid-face ((t (:background "red" :foreground "yellow")))) + (custom-modified-face ((t (:background "blue" :foreground "white")))) + (custom-rogue-face ((t (:background "black" :foreground "pink")))) + (custom-saved-face ((t (:underline t)))) + (custom-set-face ((t (:background "white" :foreground "blue")))) + (custom-state-face ((t (:foreground "dark green")))) + (custom-variable-button-face ((t (:bold t :underline t :weight bold)))) + (custom-variable-tag-face ((t (:bold t :family "helv" :foreground "blue" :weight bold :height 1.2)))) + (fixed-pitch ((t (:family "courier")))) + (font-lock-builtin-face ((t (:foreground "Orchid")))) + (font-lock-comment-face ((t (:italic t :foreground "Firebrick" :slant oblique)))) + (font-lock-constant-face ((t (:foreground "CadetBlue")))) + (font-lock-function-name-face ((t (:bold t :foreground "Blue" :weight extra-bold :family "outline-verdana")))) + (font-lock-keyword-face ((t (:bold t :foreground "Purple" :weight semi-bold :family "outline-verdana")))) + (font-lock-preprocessor-face ((t (:foreground "CadetBlue")))) + (font-lock-reference-face ((t (:foreground "Orchid")))) + (font-lock-string-face ((t (:foreground "RosyBrown")))) + (font-lock-type-face ((t (:italic t :foreground "ForestGreen" :slant italic)))) + (font-lock-variable-name-face ((t (:foreground "DarkGoldenrod" :width condensed)))) + (font-lock-warning-face ((t (:bold t :foreground "Red" :weight bold)))) + (fringe ((t (:background "DarkSlateBlue")))) + (header-line ((t (:box (:line-width -1 :style released-button) :background "grey90" :foreground "grey20" :box nil)))) + (highlight ((t (:background "darkseagreen2")))) + (isearch ((t (:background "magenta4" :foreground "lightskyblue1")))) + (isearch-lazy-highlight-face ((t (:background "paleturquoise")))) + (italic ((t (:italic t :slant italic)))) + (jde-bug-breakpoint-cursor ((t (:background "brown" :foreground "cyan")))) + (jde-db-active-breakpoint-face ((t (:background "red" :foreground "black")))) + (jde-db-requested-breakpoint-face ((t (:background "yellow" :foreground "black")))) + (jde-db-spec-breakpoint-face ((t (:background "green" :foreground "black")))) + (jde-java-font-lock-api-face ((t (:foreground "dark goldenrod")))) + (jde-java-font-lock-bold-face ((t (:bold t :weight bold)))) + (jde-java-font-lock-code-face ((t (nil)))) + (jde-java-font-lock-constant-face ((t (:foreground "CadetBlue")))) + (jde-java-font-lock-doc-tag-face ((t (:foreground "green4")))) + (jde-java-font-lock-italic-face ((t (:italic t :slant italic)))) + (jde-java-font-lock-link-face ((t (:foreground "blue" :underline t :slant normal)))) + (jde-java-font-lock-modifier-face ((t (:foreground "Orchid")))) + (jde-java-font-lock-number-face ((t (:foreground "RosyBrown")))) + (jde-java-font-lock-operator-face ((t (:foreground "medium blue")))) + (jde-java-font-lock-package-face ((t (:foreground "blue3")))) + (jde-java-font-lock-pre-face ((t (nil)))) + (jde-java-font-lock-underline-face ((t (:underline t)))) + (menu ((t (nil)))) + (modeline ((t (:background "grey75" :foreground "black" :box (:line-width -1 :style released-button))))) + (modeline-buffer-id ((t (:background "grey75" :foreground "black")))) + (modeline-mousable ((t (:background "grey75" :foreground "black")))) + (modeline-mousable-minor-mode ((t (:background "grey75" :foreground "black")))) + (mouse ((t (:background "black")))) + (primary-selection ((t (:background "lightgoldenrod2")))) + (region ((t (:background "lightgoldenrod2")))) + (scroll-bar ((t (nil)))) + (secondary-selection ((t (:background "yellow")))) + (semantic-dirty-token-face ((t (:background "lightyellow")))) + (semantic-unmatched-syntax-face ((t (:underline "red")))) + (senator-intangible-face ((t (:foreground "gray25")))) + (senator-momentary-highlight-face ((t (:background "gray70")))) + (senator-read-only-face ((t (:background "#CCBBBB")))) + (show-paren-match-face ((t (:background "turquoise")))) + (show-paren-mismatch-face ((t (:background "purple" :foreground "white")))) + (speedbar-button-face ((t (:foreground "green4")))) + (speedbar-directory-face ((t (:foreground "blue4")))) + (speedbar-file-face ((t (:foreground "cyan4")))) + (speedbar-highlight-face ((t (:background "green")))) + (speedbar-selected-face ((t (:foreground "red" :underline t)))) + (speedbar-tag-face ((t (:foreground "brown")))) + (template-message-face ((t (:bold t :weight bold)))) + (tool-bar ((t (:background "grey75" :foreground "black" :box (:line-width 1 :style released-button))))) + (trailing-whitespace ((t (:background "red")))) + (underline ((t (:underline t)))) + (variable-pitch ((t (:family "helv")))) + (widget-button-face ((t (:bold t :weight bold)))) + (widget-button-pressed-face ((t (:foreground "red")))) + (widget-documentation-face ((t (:foreground "dark green")))) + (widget-field-face ((t (:background "gray85")))) + (widget-inactive-face ((t (:foreground "dim gray")))) + (widget-single-line-field-face ((t (:background "gray85")))) + (trailing-whitespace ((t (:background "red")))) + (underline ((t (:underline t)))) + (variable-pitch ((t (:family "helv")))) + (widget-button-face ((t (:bold t :weight bold)))) + (widget-button-pressed-face ((t (:foreground "red")))) + (widget-documentation-face ((t (:foreground "dark green")))) + (widget-field-face ((t (:background "gray85")))) + (widget-inactive-face ((t (:foreground "dim gray")))) + (widget-single-line-field-face ((t (:background "gray85")))) + (zmacs-region ((t (:background "lightgoldenrod2"))))))) + +(defun color-theme-black-on-gray () + "Color theme by sbhojwani, created 2002-04-03. +Includes ecb, font-lock, paren, semantic, and widget faces. +Some of the font-lock faces are disabled, ie. they look just +like the default face. This is for people that don't like +the look of \"angry fruit salad\" when editing." + (interactive) + (color-theme-install + '(color-theme-black-on-gray + ((background-color . "white") + (background-mode . light) + (border-color . "blue") + (foreground-color . "black")) + ((buffers-tab-face . buffers-tab) + (ecb-directories-general-face . ecb-default-general-face) + (ecb-directory-face . ecb-default-highlight-face) + (ecb-history-face . ecb-default-highlight-face) + (ecb-history-general-face . ecb-default-general-face) + (ecb-method-face . ecb-default-highlight-face) + (ecb-methods-general-face . ecb-default-general-face) + (ecb-source-face . ecb-default-highlight-face) + (ecb-source-in-directories-buffer-face . ecb-source-in-directories-buffer-face) + (ecb-sources-general-face . ecb-default-general-face) + (ecb-token-header-face . ecb-token-header-face)) + (default ((t (nil)))) + (blue ((t (:foreground "blue")))) + (bold ((t (:bold t :size "10pt")))) + (bold-italic ((t (:italic t :bold t :size "10pt")))) + (border-glyph ((t (:size "11pt")))) + (buffers-tab ((t (:background "gray75")))) + (display-time-mail-balloon-enhance-face ((t (:background "orange")))) + (display-time-mail-balloon-gnus-group-face ((t (:foreground "blue")))) + (display-time-time-balloon-face ((t (:foreground "red")))) + (ecb-bucket-token-face ((t (:bold t :size "10pt")))) + (ecb-default-general-face ((t (nil)))) + (ecb-default-highlight-face ((t (:background "cornflower blue" :foreground "yellow")))) + (ecb-directories-general-face ((t (nil)))) + (ecb-directory-face ((t (:background "cornflower blue" :foreground "yellow")))) + (ecb-history-face ((t (:background "cornflower blue" :foreground "yellow")))) + (ecb-history-general-face ((t (nil)))) + (ecb-method-face ((t (:background "cornflower blue" :foreground "yellow")))) + (ecb-methods-general-face ((t (nil)))) + (ecb-source-face ((t (:background "cornflower blue" :foreground "yellow")))) + (ecb-source-in-directories-buffer-face ((t (:foreground "medium blue")))) + (ecb-sources-general-face ((t (nil)))) + (ecb-token-header-face ((t (:background "SeaGreen1")))) + (ecb-type-token-class-face ((t (:bold t :size "10pt")))) + (ecb-type-token-enum-face ((t (:bold t :size "10pt")))) + (ecb-type-token-group-face ((t (:bold t :size "10pt" :foreground "dimgray")))) + (ecb-type-token-interface-face ((t (:bold t :size "10pt")))) + (ecb-type-token-struct-face ((t (:bold t :size "10pt")))) + (ecb-type-token-typedef-face ((t (:bold t :size "10pt")))) + (font-lock-builtin-face ((t (:foreground "red3")))) + (font-lock-constant-face ((t (:foreground "blue3")))) + (font-lock-comment-face ((t (:foreground "blue")))) + (font-lock-doc-face ((t (:foreground "green4")))) + (font-lock-doc-string-face ((t (:foreground "green4")))) + (font-lock-function-name-face ((t (nil)))) + (font-lock-keyword-face ((t (nil)))) + (font-lock-preprocessor-face ((t (:foreground "blue3")))) + (font-lock-reference-face ((t (:foreground "red3")))) + (font-lock-string-face ((t (nil)))) + (font-lock-type-face ((t (nil)))) + (font-lock-variable-name-face ((t (nil)))) + (font-lock-warning-face ((t (nil)))) + (green ((t (:foreground "green")))) + (gui-button-face ((t (:background "grey75")))) + (gui-element ((t (:size "8pt" :background "gray75")))) + (highlight ((t (:background "darkseagreen2")))) + (isearch ((t (:background "paleturquoise")))) + (isearch-secondary ((t (:foreground "red3")))) + (italic ((t (:size "10pt")))) + (left-margin ((t (nil)))) + (list-mode-item-selected ((t (:background "gray68")))) + (modeline ((t (:background "gray75")))) + (modeline-buffer-id ((t (:background "gray75" :foreground "blue4")))) + (modeline-mousable ((t (:background "gray75" :foreground "firebrick")))) + (modeline-mousable-minor-mode ((t (:background "gray75" :foreground "green4")))) + (paren-blink-off ((t (:foreground "gray")))) + (paren-match ((t (:background "darkseagreen2")))) + (paren-mismatch ((t (nil)))) + (pointer ((t (nil)))) + (primary-selection ((t (:background "gray65")))) + (red ((t (:foreground "red")))) + (region ((t (:background "gray65")))) + (right-margin ((t (nil)))) + (secondary-selection ((t (:background "paleturquoise")))) + (semantic-dirty-token-face ((t (nil)))) + (semantic-unmatched-syntax-face ((t (nil)))) + (text-cursor ((t (:background "red" :foreground "gray")))) + (toolbar ((t (:background "gray75")))) + (underline ((t (:underline t)))) + (vertical-divider ((t (:background "gray75")))) + (widget ((t (:size "8pt" :background "gray75")))) + (widget-button-face ((t (:bold t)))) + (widget-button-pressed-face ((t (:foreground "red")))) + (widget-documentation-face ((t (:foreground "dark green")))) + (widget-field-face ((t (:background "gray85")))) + (widget-inactive-face ((t (nil)))) + (yellow ((t (:foreground "yellow")))) + (zmacs-region ((t (:background "gray65"))))))) + +(defun color-theme-dark-blue2 () + "Color theme by Chris McMahan, created 2002-04-12. +Includes antlr, bbdb, change-log, comint, cperl, custom cvs, diff, +dired, display-time, ebrowse, ecb, ediff, erc, eshell, fl, font-lock, +gnus, hi, highlight, html-helper, hyper-apropos, info, isearch, jde, +message, mmm, paren, semantic, senator, sgml, smerge, speedbar, +strokes, term, vhdl, viper, vm, widget, xref, xsl, xxml. Yes, it is +a large theme." + (interactive) + (color-theme-install + '(color-theme-dark-blue2 + ((background-color . "#233b5a") + (background-mode . dark) + (background-toolbar-color . "#cf3ccf3ccf3c") + (border-color . "black") + (bottom-toolbar-shadow-color . "#79e77df779e7") + (cursor-color . "Yellow") + (foreground-color . "#fff8dc") + (mouse-color . "Grey") + (top-toolbar-shadow-color . "#fffffbeeffff") + (viper-saved-cursor-color-in-replace-mode . "Red3")) + ((blank-space-face . blank-space-face) + (blank-tab-face . blank-tab-face) + (cperl-invalid-face . underline) + (ecb-directories-general-face . ecb-directories-general-face) + (ecb-directory-face . ecb-directory-face) + (ecb-history-face . ecb-history-face) + (ecb-history-general-face . ecb-history-general-face) + (ecb-method-face . ecb-method-face) + (ecb-methods-general-face . ecb-methods-general-face) + (ecb-source-face . ecb-source-face) + (ecb-source-in-directories-buffer-face . ecb-sources-face) + (ecb-sources-general-face . ecb-sources-general-face) + (ecb-token-header-face . ecb-token-header-face) + (gnus-article-button-face . bold) + (gnus-article-mouse-face . highlight) + (gnus-cite-attribution-face . gnus-cite-attribution-face) + (gnus-signature-face . gnus-signature-face) + (gnus-summary-selected-face . gnus-summary-selected-face) + (help-highlight-face . underline) + (highline-face . highline-face) + (highline-vertical-face . highline-vertical-face) + (list-matching-lines-face . bold) + (ps-zebra-color . 0.95) + (senator-eldoc-use-color . t) + (sgml-set-face . t) + (tags-tag-face . default) + (view-highlight-face . highlight) + (vm-highlight-url-face . bold-italic) + (vm-highlighted-header-face . bold) + (vm-mime-button-face . gui-button-face) + (vm-summary-highlight-face . bold) + (widget-mouse-face . highlight)) + (default ((t (:stipple nil :background "#233b5a" :foreground "#fff8dc" :inverse-video nil :box nil :strike-through nil :overline nil :underline nil :slant normal :weight normal :width normal :family "outline-lucida console")))) + (Info-title-1-face ((t (:bold t :weight bold :height 1.728 :family "helv")))) + (Info-title-2-face ((t (:bold t :weight bold :height 1.44 :family "helv")))) + (Info-title-3-face ((t (:bold t :weight bold :height 1.2 :family "helv")))) + (Info-title-4-face ((t (:bold t :weight bold :family "helv")))) + (antlr-font-lock-keyword-face ((t (:bold t :foreground "Gray85" :weight bold)))) + (antlr-font-lock-literal-face ((t (:bold t :foreground "Gray85" :weight bold)))) + (antlr-font-lock-ruledef-face ((t (:bold t :foreground "Gray85" :weight bold)))) + (antlr-font-lock-ruleref-face ((t (:foreground "Gray85")))) + (antlr-font-lock-tokendef-face ((t (:bold t :foreground "Gray85" :weight bold)))) + (antlr-font-lock-tokenref-face ((t (:foreground "Gray85")))) + (bbdb-company ((t (:italic t :slant italic)))) + (bbdb-field-name ((t (:bold t :weight bold)))) + (bbdb-field-value ((t (nil)))) + (bbdb-name ((t (:underline t)))) + (bg:erc-color-face0 ((t (:background "White")))) + (bg:erc-color-face1 ((t (:background "black")))) + (bg:erc-color-face10 ((t (:background "lightblue1")))) + (bg:erc-color-face11 ((t (:background "cyan")))) + (bg:erc-color-face12 ((t (:background "blue")))) + (bg:erc-color-face13 ((t (:background "deeppink")))) + (bg:erc-color-face14 ((t (:background "gray50")))) + (bg:erc-color-face15 ((t (:background "gray90")))) + (bg:erc-color-face2 ((t (:background "blue4")))) + (bg:erc-color-face3 ((t (:background "green4")))) + (bg:erc-color-face4 ((t (:background "red")))) + (bg:erc-color-face5 ((t (:background "brown")))) + (bg:erc-color-face6 ((t (:background "purple")))) + (bg:erc-color-face7 ((t (:background "orange")))) + (bg:erc-color-face8 ((t (:background "yellow")))) + (bg:erc-color-face9 ((t (:background "green")))) + (blank-space-face ((t (:background "LightGray")))) + (blank-tab-face ((t (:background "Wheat")))) + (blue ((t (:foreground "blue")))) + (bold ((t (:bold t :foreground "cyan" :weight bold)))) + (bold-italic ((t (:italic t :bold t :foreground "cyan2" :slant italic :weight bold)))) + (border ((t (:background "black")))) + (border-glyph ((t (nil)))) + (buffers-tab ((t (:background "gray30" :foreground "LightSkyBlue")))) + (calendar-today-face ((t (:underline t)))) + (change-log-acknowledgement-face ((t (:foreground "firebrick")))) + (change-log-conditionals-face ((t (:background "sienna" :foreground "khaki")))) + (change-log-date-face ((t (:foreground "gold")))) + (change-log-email-face ((t (:foreground "khaki" :underline t)))) + (change-log-file-face ((t (:bold t :foreground "lemon chiffon" :weight bold)))) + (change-log-function-face ((t (:background "sienna" :foreground "khaki")))) + (change-log-list-face ((t (:foreground "wheat")))) + (change-log-name-face ((t (:bold t :foreground "light goldenrod" :weight bold)))) + (comint-highlight-input ((t (:bold t :weight bold)))) + (comint-highlight-prompt ((t (:foreground "cyan")))) + (comint-input-face ((t (:foreground "deepskyblue")))) + (cperl-array-face ((t (:bold t :background "lightyellow2" :foreground "Blue" :weight bold)))) + (cperl-hash-face ((t (:italic t :bold t :background "lightyellow2" :foreground "Red" :slant italic :weight bold)))) + (cperl-invalid-face ((t (:foreground "white")))) + (cperl-nonoverridable-face ((t (:foreground "chartreuse3")))) + (cursor ((t (:background "Yellow")))) + (custom-button-face ((t (:bold t :weight bold)))) + (custom-button-pressed-face ((t (:background "lightgrey" :foreground "gray30")))) + (custom-changed-face ((t (:background "blue" :foreground "white")))) + (custom-comment-face ((t (:foreground "white")))) + (custom-comment-tag-face ((t (:foreground "white")))) + (custom-documentation-face ((t (:foreground "light blue")))) + (custom-face-tag-face ((t (:underline t)))) + (custom-group-tag-face ((t (:bold t :foreground "gray85" :underline t :weight bold)))) + (custom-group-tag-face-1 ((t (:foreground "gray85" :underline t)))) + (custom-invalid-face ((t (:background "red" :foreground "yellow")))) + (custom-modified-face ((t (:background "blue" :foreground "white")))) + (custom-rogue-face ((t (:background "gray30" :foreground "pink")))) + (custom-saved-face ((t (:underline t)))) + (custom-set-face ((t (:background "white" :foreground "blue")))) + (custom-state-face ((t (:foreground "gray85")))) + (custom-variable-button-face ((t (:bold t :underline t :weight bold)))) + (custom-variable-tag-face ((t (:bold t :foreground "gray85" :underline t :weight bold)))) + (cvs-filename-face ((t (:foreground "white")))) + (cvs-handled-face ((t (:foreground "pink")))) + (cvs-header-face ((t (:foreground "green")))) + (cvs-marked-face ((t (:bold t :foreground "green3" :weight bold)))) + (cvs-msg-face ((t (:foreground "gray85")))) + (cvs-need-action-face ((t (:foreground "yellow")))) + (cvs-unknown-face ((t (:foreground "grey")))) + (cyan ((t (:foreground "cyan")))) + (diary-face ((t (:bold t :foreground "gray85" :weight bold)))) + (diff-added-face ((t (nil)))) + (diff-changed-face ((t (nil)))) + (diff-context-face ((t (:foreground "grey50")))) + (diff-file-header-face ((t (:bold t :background "grey70" :weight bold)))) + (diff-function-face ((t (:foreground "grey50")))) + (diff-header-face ((t (:foreground "lemon chiffon")))) + (diff-hunk-header-face ((t (:background "grey85")))) + (diff-index-face ((t (:bold t :background "grey70" :weight bold)))) + (diff-nonexistent-face ((t (:bold t :background "grey70" :weight bold)))) + (diff-removed-face ((t (nil)))) + (dired-face-boring ((t (:foreground "Gray65")))) + (dired-face-directory ((t (:bold t :weight bold)))) + (dired-face-executable ((t (:foreground "gray85")))) + (dired-face-flagged ((t (:background "LightSlateGray")))) + (dired-face-header ((t (:background "grey75" :foreground "gray30")))) + (dired-face-marked ((t (:background "PaleVioletRed")))) + (dired-face-permissions ((t (:background "grey75" :foreground "gray30")))) + (dired-face-setuid ((t (:foreground "gray85")))) + (dired-face-socket ((t (:foreground "gray85")))) + (dired-face-symlink ((t (:foreground "cyan")))) + (display-time-mail-balloon-enhance-face ((t (:background "orange")))) + (display-time-mail-balloon-gnus-group-face ((t (:foreground "blue")))) + (display-time-time-balloon-face ((t (:foreground "gray85")))) + (ebrowse-default-face ((t (nil)))) + (ebrowse-file-name-face ((t (:italic t :slant italic)))) + (ebrowse-member-attribute-face ((t (:foreground "red")))) + (ebrowse-member-class-face ((t (:foreground "Gray85")))) + (ebrowse-progress-face ((t (:background "blue")))) + (ebrowse-root-class-face ((t (:bold t :foreground "Gray85" :weight bold)))) + (ebrowse-tree-mark-face ((t (:foreground "Gray85")))) + (ecb-bucket-token-face ((t (:bold t :weight bold)))) + (ecb-default-general-face ((t (:height 1.0)))) + (ecb-default-highlight-face ((t (:background "magenta" :height 1.0)))) + (ecb-directories-general-face ((t (:height 0.9)))) + (ecb-directory-face ((t (:background "Cyan4")))) + (ecb-history-face ((t (:background "Cyan4")))) + (ecb-history-general-face ((t (:height 0.9)))) + (ecb-method-face ((t (:background "Cyan4" :slant normal :weight normal)))) + (ecb-methods-general-face ((t (:slant normal)))) + (ecb-source-face ((t (:background "Cyan4")))) + (ecb-source-in-directories-buffer-face ((t (:foreground "LightBlue1")))) + (ecb-sources-face ((t (:foreground "LightBlue1")))) + (ecb-sources-general-face ((t (:height 0.9)))) + (ecb-token-header-face ((t (:background "Steelblue4")))) + (ecb-type-token-class-face ((t (:bold t :weight bold)))) + (ecb-type-token-enum-face ((t (:bold t :weight bold)))) + (ecb-type-token-group-face ((t (:bold t :foreground "dim gray" :weight bold)))) + (ecb-type-token-interface-face ((t (:bold t :weight bold)))) + (ecb-type-token-struct-face ((t (:bold t :weight bold)))) + (ecb-type-token-typedef-face ((t (:bold t :weight bold)))) + (ediff-current-diff-face-A ((t (:background "pale green" :foreground "firebrick")))) + (ediff-current-diff-face-Ancestor ((t (:background "VioletRed" :foreground "Gray30")))) + (ediff-current-diff-face-B ((t (:background "Yellow" :foreground "DarkOrchid")))) + (ediff-current-diff-face-C ((t (:background "Pink" :foreground "Navy")))) + (ediff-even-diff-face-A ((t (:background "light grey" :foreground "Gray30")))) + (ediff-even-diff-face-Ancestor ((t (:background "Grey" :foreground "White")))) + (ediff-even-diff-face-B ((t (:background "Grey" :foreground "White")))) + (ediff-even-diff-face-C ((t (:background "light grey" :foreground "Gray30")))) + (ediff-fine-diff-face-A ((t (:background "sky blue" :foreground "Navy")))) + (ediff-fine-diff-face-Ancestor ((t (:background "Green" :foreground "Gray30")))) + (ediff-fine-diff-face-B ((t (:background "cyan" :foreground "Gray30")))) + (ediff-fine-diff-face-C ((t (:background "Turquoise" :foreground "Gray30")))) + (ediff-odd-diff-face-A ((t (:background "Grey" :foreground "White")))) + (ediff-odd-diff-face-Ancestor ((t (:background "light grey" :foreground "Gray30")))) + (ediff-odd-diff-face-B ((t (:background "light grey" :foreground "Gray30")))) + (ediff-odd-diff-face-C ((t (:background "Grey" :foreground "White")))) + (erc-action-face ((t (:bold t :weight bold)))) + (erc-bold-face ((t (:bold t :weight bold)))) + (erc-dangerous-host-face ((t (:foreground "red")))) + (erc-default-face ((t (nil)))) + (erc-direct-msg-face ((t (:foreground "pale green")))) + (erc-error-face ((t (:bold t :foreground "gray85" :weight bold)))) + (erc-fool-face ((t (:foreground "Gray85")))) + (erc-highlight-face ((t (:bold t :foreground "pale green" :weight bold)))) + (erc-input-face ((t (:foreground "light blue")))) + (erc-inverse-face ((t (:background "Black" :foreground "White")))) + (erc-keyword-face ((t (:bold t :foreground "pale green" :weight bold)))) + (erc-notice-face ((t (:foreground "light salmon")))) + (erc-pal-face ((t (:foreground "pale green")))) + (erc-prompt-face ((t (:bold t :foreground "light blue" :weight bold)))) + (erc-timestamp-face ((t (:bold t :foreground "green" :weight bold)))) + (erc-underline-face ((t (:underline t)))) + (eshell-ls-archive-face ((t (:bold t :weight bold)))) + (eshell-ls-backup-face ((t (:foreground "gray85")))) + (eshell-ls-clutter-face ((t (:bold t :foreground "gray85" :weight bold)))) + (eshell-ls-directory-face ((t (:bold t :foreground "Cyan" :weight bold)))) + (eshell-ls-executable-face ((t (:bold t :weight bold)))) + (eshell-ls-missing-face ((t (:bold t :weight bold)))) + (eshell-ls-picture-face ((t (:foreground "gray85")))) + (eshell-ls-product-face ((t (:foreground "gray85")))) + (eshell-ls-readonly-face ((t (:foreground "gray70")))) + (eshell-ls-special-face ((t (:bold t :weight bold)))) + (eshell-ls-symlink-face ((t (:bold t :weight bold)))) + (eshell-ls-text-face ((t (:foreground "gray85")))) + (eshell-ls-todo-face ((t (:bold t :weight bold)))) + (eshell-ls-unreadable-face ((t (:foreground "gray85")))) + (eshell-prompt-face ((t (:bold t :foreground "Yellow" :weight bold)))) + (eshell-test-failed-face ((t (:bold t :weight bold)))) + (eshell-test-ok-face ((t (:bold t :weight bold)))) + (excerpt ((t (:italic t :slant italic)))) + (ff-paths-non-existant-file-face ((t (:bold t :foreground "gray85" :weight bold)))) + (fg:black ((t (:foreground "black")))) + (fg:erc-color-face0 ((t (:foreground "White")))) + (fg:erc-color-face1 ((t (:foreground "black")))) + (fg:erc-color-face10 ((t (:foreground "lightblue1")))) + (fg:erc-color-face11 ((t (:foreground "cyan")))) + (fg:erc-color-face12 ((t (:foreground "blue")))) + (fg:erc-color-face13 ((t (:foreground "deeppink")))) + (fg:erc-color-face14 ((t (:foreground "gray50")))) + (fg:erc-color-face15 ((t (:foreground "gray90")))) + (fg:erc-color-face2 ((t (:foreground "blue4")))) + (fg:erc-color-face3 ((t (:foreground "green4")))) + (fg:erc-color-face4 ((t (:foreground "red")))) + (fg:erc-color-face5 ((t (:foreground "brown")))) + (fg:erc-color-face6 ((t (:foreground "purple")))) + (fg:erc-color-face7 ((t (:foreground "orange")))) + (fg:erc-color-face8 ((t (:foreground "yellow")))) + (fg:erc-color-face9 ((t (:foreground "green")))) + (fixed ((t (:bold t :weight bold)))) + (fixed-pitch ((t (:family "outline-lucida console")))) + (fl-comment-face ((t (:foreground "gray85")))) + (fl-function-name-face ((t (:foreground "green")))) + (fl-keyword-face ((t (:foreground "LightGreen")))) + (fl-string-face ((t (:foreground "light coral")))) + (fl-type-face ((t (:foreground "cyan")))) + (flyspell-duplicate-face ((t (:bold t :foreground "Gold3" :underline t :weight bold)))) + (flyspell-incorrect-face ((t (:bold t :foreground "OrangeRed" :underline t :weight bold)))) + (font-latex-bold-face ((t (nil)))) + (font-latex-italic-face ((t (nil)))) + (font-latex-math-face ((t (nil)))) + (font-latex-sedate-face ((t (:foreground "Gray85")))) + (font-latex-string-face ((t (:foreground "orange")))) + (font-latex-warning-face ((t (:foreground "gold")))) + (font-lock-builtin-face ((t (:bold t :foreground "LightSteelBlue" :weight bold)))) + (font-lock-comment-face ((t (:italic t :foreground "medium aquamarine" :slant italic)))) + (font-lock-constant-face ((t (:bold t :foreground "Aquamarine" :weight bold)))) + (font-lock-doc-face ((t (:bold t :weight bold)))) + (font-lock-doc-string-face ((t (:bold t :foreground "aquamarine" :weight bold)))) + (font-lock-exit-face ((t (:foreground "green")))) + (font-lock-function-name-face ((t (:italic t :bold t :foreground "LightSkyBlue" :slant italic :weight bold)))) + (font-lock-keyword-face ((t (:bold t :foreground "Cyan" :weight bold)))) + (font-lock-preprocessor-face ((t (:foreground "Gray85")))) + (font-lock-reference-face ((t (:foreground "cyan")))) + (font-lock-string-face ((t (:italic t :foreground "aquamarine" :slant italic)))) + (font-lock-type-face ((t (:bold t :foreground "PaleGreen" :weight bold)))) + (font-lock-variable-name-face ((t (:italic t :bold t :foreground "LightGoldenrod" :slant italic :weight bold)))) + (font-lock-warning-face ((t (:bold t :foreground "Salmon" :weight bold)))) + (fringe ((t (:background "#3c5473")))) + (gnus-cite-attribution-face ((t (:italic t :bold t :foreground "beige" :underline t :slant italic :weight bold)))) + (gnus-cite-face-1 ((t (:foreground "gold")))) + (gnus-cite-face-10 ((t (:foreground "coral")))) + (gnus-cite-face-11 ((t (:foreground "turquoise")))) + (gnus-cite-face-2 ((t (:foreground "wheat")))) + (gnus-cite-face-3 ((t (:foreground "light pink")))) + (gnus-cite-face-4 ((t (:foreground "khaki")))) + (gnus-cite-face-5 ((t (:foreground "pale green")))) + (gnus-cite-face-6 ((t (:foreground "beige")))) + (gnus-cite-face-7 ((t (:foreground "orange")))) + (gnus-cite-face-8 ((t (:foreground "magenta")))) + (gnus-cite-face-9 ((t (:foreground "violet")))) + (gnus-emphasis-bold ((t (:bold t :foreground "light gray" :weight bold)))) + (gnus-emphasis-bold-italic ((t (:italic t :bold t :foreground "cyan" :slant italic :weight bold)))) + (gnus-emphasis-highlight-words ((t (:background "gray30" :foreground "gold")))) + (gnus-emphasis-italic ((t (:italic t :foreground "cyan" :slant italic)))) + (gnus-emphasis-underline ((t (:foreground "white" :underline t)))) + (gnus-emphasis-underline-bold ((t (:bold t :foreground "white" :underline t :weight bold)))) + (gnus-emphasis-underline-bold-italic ((t (:italic t :bold t :foreground "white" :underline t :slant italic :weight bold)))) + (gnus-emphasis-underline-italic ((t (:italic t :foreground "white" :underline t :slant italic)))) + (gnus-filterhist-face-1 ((t (nil)))) + (gnus-group-mail-1-empty-face ((t (:foreground "Magenta")))) + (gnus-group-mail-1-face ((t (:bold t :foreground "Magenta" :weight bold)))) + (gnus-group-mail-2-empty-face ((t (:foreground "aquamarine2")))) + (gnus-group-mail-2-face ((t (:bold t :foreground "aquamarine2" :weight bold)))) + (gnus-group-mail-3-empty-face ((t (:foreground "Cyan")))) + (gnus-group-mail-3-face ((t (:bold t :foreground "Cyan" :weight bold)))) + (gnus-group-mail-low-empty-face ((t (:foreground "Wheat")))) + (gnus-group-mail-low-face ((t (:bold t :foreground "Gray85" :weight bold)))) + (gnus-group-news-1-empty-face ((t (:foreground "PaleTurquoise")))) + (gnus-group-news-1-face ((t (:bold t :foreground "PaleTurquoise" :weight bold)))) + (gnus-group-news-2-empty-face ((t (:foreground "turquoise")))) + (gnus-group-news-2-face ((t (:bold t :foreground "turquoise" :weight bold)))) + (gnus-group-news-3-empty-face ((t (:foreground "wheat")))) + (gnus-group-news-3-face ((t (:bold t :foreground "Wheat" :weight bold)))) + (gnus-group-news-4-empty-face ((t (:foreground "Aquamarine")))) + (gnus-group-news-4-face ((t (:bold t :weight bold)))) + (gnus-group-news-5-empty-face ((t (:foreground "MediumAquamarine")))) + (gnus-group-news-5-face ((t (:bold t :weight bold)))) + (gnus-group-news-6-empty-face ((t (:foreground "MediumAquamarine")))) + (gnus-group-news-6-face ((t (:bold t :weight bold)))) + (gnus-group-news-low-empty-face ((t (:foreground "MediumAquamarine")))) + (gnus-group-news-low-face ((t (:bold t :foreground "MediumAquamarine" :weight bold)))) + (gnus-header-content-face ((t (:italic t :foreground "Wheat" :slant italic)))) + (gnus-header-from-face ((t (:bold t :foreground "light yellow" :weight bold)))) + (gnus-header-name-face ((t (:bold t :foreground "Wheat" :weight bold)))) + (gnus-header-newsgroups-face ((t (:italic t :bold t :foreground "gold" :slant italic :weight bold)))) + (gnus-header-subject-face ((t (:bold t :foreground "Gold" :weight bold)))) + (gnus-picons-face ((t (:background "white" :foreground "gray30")))) + (gnus-picons-xbm-face ((t (:background "white" :foreground "gray30")))) + (gnus-signature-face ((t (:italic t :foreground "white" :slant italic)))) + (gnus-splash ((t (:foreground "Brown")))) + (gnus-splash-face ((t (:foreground "orange")))) + (gnus-summary-cancelled-face ((t (:background "gray30" :foreground "orange")))) + (gnus-summary-high-ancient-face ((t (:bold t :foreground "SkyBlue" :weight bold)))) + (gnus-summary-high-read-face ((t (:bold t :foreground "gray85" :weight bold)))) + (gnus-summary-high-ticked-face ((t (:bold t :foreground "coral" :weight bold)))) + (gnus-summary-high-unread-face ((t (:italic t :bold t :foreground "gold" :slant italic :weight bold)))) + (gnus-summary-low-ancient-face ((t (:italic t :foreground "SkyBlue" :slant italic)))) + (gnus-summary-low-read-face ((t (:italic t :foreground "gray85" :slant italic)))) + (gnus-summary-low-ticked-face ((t (:italic t :bold t :foreground "coral" :slant italic :weight bold)))) + (gnus-summary-low-unread-face ((t (:italic t :foreground "white" :slant italic)))) + (gnus-summary-normal-ancient-face ((t (:foreground "SkyBlue")))) + (gnus-summary-normal-read-face ((t (:foreground "gray70")))) + (gnus-summary-normal-ticked-face ((t (:bold t :foreground "pink" :weight bold)))) + (gnus-summary-normal-unread-face ((t (:bold t :foreground "gray85" :weight bold)))) + (gnus-summary-selected-face ((t (:foreground "white" :underline t)))) + (gnus-x-face ((t (:background "white" :foreground "gray30")))) + (green ((t (:foreground "green")))) + (gui-button-face ((t (:background "grey75" :foreground "gray30")))) + (gui-element ((t (:background "Gray80")))) + (header-line ((t (:background "grey20" :foreground "grey90")))) + (hi-black-b ((t (:bold t :weight bold)))) + (hi-black-hb ((t (:bold t :weight bold :height 1.67 :family "helv")))) + (hi-blue ((t (:background "light blue")))) + (hi-blue-b ((t (:bold t :foreground "blue" :weight bold)))) + (hi-green ((t (:background "green")))) + (hi-green-b ((t (:bold t :foreground "green" :weight bold)))) + (hi-pink ((t (:background "pink")))) + (hi-red-b ((t (:bold t :foreground "red" :weight bold)))) + (hi-yellow ((t (:background "yellow")))) + (highlight ((t (:background "SkyBlue3")))) + (highlight-changes-delete-face ((t (:foreground "gray85" :underline t)))) + (highlight-changes-face ((t (:foreground "gray85")))) + (highline-face ((t (:background "#3c5473")))) + (highline-vertical-face ((t (:background "lightcyan")))) + (holiday-face ((t (:background "pink" :foreground "gray30")))) + (html-helper-bold-face ((t (:bold t :weight bold)))) + (html-helper-bold-italic-face ((t (nil)))) + (html-helper-builtin-face ((t (:foreground "gray85" :underline t)))) + (html-helper-italic-face ((t (:bold t :foreground "yellow" :weight bold)))) + (html-helper-underline-face ((t (:underline t)))) + (html-tag-face ((t (:bold t :weight bold)))) + (hyper-apropos-documentation ((t (:foreground "white")))) + (hyper-apropos-heading ((t (:bold t :weight bold)))) + (hyper-apropos-hyperlink ((t (:foreground "sky blue")))) + (hyper-apropos-major-heading ((t (:bold t :weight bold)))) + (hyper-apropos-section-heading ((t (:bold t :weight bold)))) + (hyper-apropos-warning ((t (:bold t :foreground "gray85" :weight bold)))) + (ibuffer-marked-face ((t (:foreground "gray85")))) + (idlwave-help-link-face ((t (:foreground "Blue")))) + (idlwave-shell-bp-face ((t (:background "Pink" :foreground "Black")))) + (info-header-node ((t (:italic t :bold t :foreground "brown" :slant italic :weight bold)))) + (info-header-xref ((t (:bold t :foreground "magenta4" :weight bold)))) + (info-menu-5 ((t (:underline t)))) + (info-menu-6 ((t (nil)))) + (info-menu-header ((t (:bold t :weight bold :family "helv")))) + (info-node ((t (:italic t :bold t :slant italic :weight bold)))) + (info-xref ((t (:bold t :weight bold)))) + (isearch ((t (:background "LightSeaGreen")))) + (isearch-lazy-highlight-face ((t (:background "cyan4")))) + (isearch-secondary ((t (:foreground "red3")))) + (italic ((t (:italic t :bold t :slant italic :weight bold)))) + (jde-bug-breakpoint-cursor ((t (:background "brown" :foreground "cyan")))) + (jde-bug-breakpoint-marker ((t (:background "yellow" :foreground "red")))) + (jde-java-font-lock-api-face ((t (:foreground "LightBlue")))) + (jde-java-font-lock-bold-face ((t (:bold t :weight bold)))) + (jde-java-font-lock-code-face ((t (nil)))) + (jde-java-font-lock-constant-face ((t (:foreground "LightBlue")))) + (jde-java-font-lock-doc-tag-face ((t (:foreground "LightBlue")))) + (jde-java-font-lock-italic-face ((t (:italic t :slant italic)))) + (jde-java-font-lock-link-face ((t (:foreground "cyan3" :underline t)))) + (jde-java-font-lock-modifier-face ((t (:foreground "LightBlue")))) + (jde-java-font-lock-number-face ((t (:foreground "RosyBrown")))) + (jde-java-font-lock-operator-face ((t (:foreground "cyan3")))) + (jde-java-font-lock-package-face ((t (:foreground "LightBlue")))) + (jde-java-font-lock-pre-face ((t (nil)))) + (jde-java-font-lock-underline-face ((t (:underline t)))) + (lazy-highlight-face ((t (:bold t :foreground "yellow" :weight bold)))) + (left-margin ((t (nil)))) + (linemenu-face ((t (:background "gray30")))) + (list-mode-item-selected ((t (:background "gray68")))) + (log-view-file-face ((t (:bold t :background "grey70" :weight bold)))) + (log-view-message-face ((t (:background "grey85")))) + (magenta ((t (:foreground "gray85")))) + (makefile-space-face ((t (:background "hotpink" :foreground "white")))) + (man-bold ((t (:bold t :weight bold)))) + (man-heading ((t (:bold t :weight bold)))) + (man-italic ((t (:foreground "yellow")))) + (man-xref ((t (:underline t)))) + (menu ((t (:background "wheat" :foreground "gray30")))) + (message-cited-text ((t (:foreground "orange")))) + (message-cited-text-face ((t (:foreground "medium aquamarine")))) + (message-header-cc-face ((t (:bold t :foreground "gray85" :weight bold)))) + (message-header-contents ((t (:foreground "white")))) + (message-header-name-face ((t (:foreground "gray85")))) + (message-header-newsgroups-face ((t (:italic t :bold t :foreground "yellow" :slant italic :weight bold)))) + (message-header-other-face ((t (:foreground "gray85")))) + (message-header-subject-face ((t (:bold t :foreground "green3" :weight bold)))) + (message-header-to-face ((t (:bold t :foreground "green2" :weight bold)))) + (message-header-xheader-face ((t (:foreground "blue")))) + (message-headers ((t (:bold t :foreground "orange" :weight bold)))) + (message-highlighted-header-contents ((t (:bold t :weight bold)))) + (message-mml-face ((t (:bold t :foreground "gray85" :weight bold)))) + (message-separator-face ((t (:foreground "gray85")))) + (message-url ((t (:bold t :foreground "pink" :weight bold)))) + (mmm-default-submode-face ((t (:background "#c0c0c5")))) + (mmm-face ((t (:background "black" :foreground "green")))) + (modeline ((t (:background "#3c5473" :foreground "lightgray" :box (:line-width -1 :style released-button :family "helv"))))) + (modeline-buffer-id ((t (:background "white" :foreground "DeepSkyBlue3" :slant normal :weight normal :width normal :family "outline-verdana")))) + (modeline-mousable ((t (:background "white" :foreground "DeepSkyBlue3")))) + (modeline-mousable-minor-mode ((t (:background "white" :foreground "DeepSkyBlue3")))) + (mouse ((t (:background "Grey")))) + (my-summary-highlight-face ((t (:background "PaleTurquoise4" :foreground "White")))) + (my-url-face ((t (:foreground "LightBlue")))) + (nil ((t (nil)))) + (paren-blink-off ((t (:foreground "gray80")))) + (paren-face-match ((t (:background "turquoise")))) + (paren-face-mismatch ((t (:background "purple" :foreground "white")))) + (paren-face-no-match ((t (:background "yellow" :foreground "gray30")))) + (paren-match ((t (:background "darkseagreen2")))) + (paren-mismatch ((t (:background "RosyBrown" :foreground "gray30")))) + (paren-mismatch-face ((t (:bold t :background "white" :foreground "red" :weight bold)))) + (paren-no-match-face ((t (:bold t :background "white" :foreground "red" :weight bold)))) + (pointer ((t (nil)))) + (primary-selection ((t (:background "gray40")))) + (reb-match-0 ((t (:background "lightblue")))) + (reb-match-1 ((t (:background "aquamarine")))) + (reb-match-2 ((t (:background "springgreen")))) + (reb-match-3 ((t (:background "yellow")))) + (red ((t (:foreground "red")))) + (region ((t (:background "Cyan4")))) + (right-margin ((t (nil)))) + (scroll-bar ((t (:background "grey75")))) + (secondary-selection ((t (:background "gray60")))) + (semantic-dirty-token-face ((t (:background "gray10")))) + (semantic-intangible-face ((t (:foreground "gray25")))) + (semantic-read-only-face ((t (:background "gray25")))) + (semantic-unmatched-syntax-face ((t (:underline "red")))) + (senator-intangible-face ((t (:foreground "gray75")))) + (senator-momentary-highlight-face ((t (:background "gray70")))) + (senator-read-only-face ((t (:background "#664444")))) + (sgml-comment-face ((t (:foreground "dark turquoise")))) + (sgml-doctype-face ((t (:foreground "turquoise")))) + (sgml-end-tag-face ((t (:foreground "aquamarine")))) + (sgml-entity-face ((t (:foreground "gray85")))) + (sgml-ignored-face ((t (:background "gray60" :foreground "gray40")))) + (sgml-ms-end-face ((t (:foreground "green")))) + (sgml-ms-start-face ((t (:foreground "yellow")))) + (sgml-pi-face ((t (:foreground "lime green")))) + (sgml-sgml-face ((t (:foreground "brown")))) + (sgml-short-ref-face ((t (:foreground "deep sky blue")))) + (sgml-start-tag-face ((t (:foreground "aquamarine")))) + (sh-heredoc-face ((t (:foreground "tan")))) + (shell-option-face ((t (:foreground "gray85")))) + (shell-output-2-face ((t (:foreground "gray85")))) + (shell-output-3-face ((t (:foreground "gray85")))) + (shell-output-face ((t (:bold t :weight bold)))) + (shell-prompt-face ((t (:foreground "yellow")))) + (show-paren-match-face ((t (:bold t :background "turquoise" :weight bold)))) + (show-paren-mismatch-face ((t (:bold t :background "RosyBrown" :foreground "white" :weight bold)))) + (show-tabs-space-face ((t (:foreground "yellow")))) + (show-tabs-tab-face ((t (:foreground "red")))) + (smerge-base-face ((t (:foreground "red")))) + (smerge-markers-face ((t (:background "grey85")))) + (smerge-mine-face ((t (:foreground "Gray85")))) + (smerge-other-face ((t (:foreground "darkgreen")))) + (speedbar-button-face ((t (:bold t :weight bold)))) + (speedbar-directory-face ((t (:bold t :weight bold)))) + (speedbar-file-face ((t (:bold t :weight bold)))) + (speedbar-highlight-face ((t (:background "sea green")))) + (speedbar-selected-face ((t (:underline t)))) + (speedbar-tag-face ((t (:foreground "yellow")))) + (strokes-char-face ((t (:background "lightgray")))) + (swbuff-current-buffer-face ((t (:bold t :foreground "gray85" :weight bold)))) + (template-message-face ((t (:bold t :weight bold)))) + (term-black ((t (:foreground "black")))) + (term-blackbg ((t (:background "black")))) + (term-blue ((t (:foreground "blue")))) + (term-bluebg ((t (:background "blue")))) + (term-bold ((t (:bold t :weight bold)))) + (term-cyan ((t (:foreground "cyan")))) + (term-cyanbg ((t (:background "cyan")))) + (term-default ((t (:background "gray80" :foreground "gray30" :inverse-video nil :box nil :strike-through nil :overline nil :underline nil :slant normal :weight normal :width normal :family "outline-lucida console")))) + (term-default-bg ((t (nil)))) + (term-default-bg-inv ((t (nil)))) + (term-default-fg ((t (nil)))) + (term-default-fg-inv ((t (nil)))) + (term-green ((t (:foreground "green")))) + (term-greenbg ((t (:background "green")))) + (term-invisible ((t (nil)))) + (term-invisible-inv ((t (nil)))) + (term-magenta ((t (:foreground "magenta")))) + (term-magentabg ((t (:background "magenta")))) + (term-red ((t (:foreground "red")))) + (term-redbg ((t (:background "red")))) + (term-underline ((t (:underline t)))) + (term-white ((t (:foreground "white")))) + (term-whitebg ((t (:background "white")))) + (term-yellow ((t (:foreground "yellow")))) + (term-yellowbg ((t (:background "yellow")))) + (tex-math-face ((t (:foreground "RosyBrown")))) + (texinfo-heading-face ((t (:foreground "Blue")))) + (text-cursor ((t (:background "Red3" :foreground "gray80")))) + (tool-bar ((t (:background "grey75" :foreground "black")))) + (toolbar ((t (:background "Gray80")))) + (tooltip ((t (:background "lightyellow" :foreground "black")))) + (trailing-whitespace ((t (:background "red")))) + (underline ((t (:underline t)))) + (variable-pitch ((t (:family "helv")))) + (vc-annotate-face-0046FF ((t (:background "black" :foreground "wheat")))) + (vcursor ((t (:background "cyan" :foreground "blue" :underline t)))) + (vertical-divider ((t (:background "Gray80")))) + (vhdl-font-lock-attribute-face ((t (:foreground "gray85")))) + (vhdl-font-lock-directive-face ((t (:foreground "gray85")))) + (vhdl-font-lock-enumvalue-face ((t (:foreground "gray85")))) + (vhdl-font-lock-function-face ((t (:foreground "gray85")))) + (vhdl-font-lock-prompt-face ((t (:bold t :foreground "gray85" :weight bold)))) + (vhdl-font-lock-reserved-words-face ((t (:bold t :foreground "gray85" :weight bold)))) + (vhdl-font-lock-translate-off-face ((t (:background "LightGray")))) + (vhdl-speedbar-architecture-face ((t (:foreground "gray85")))) + (vhdl-speedbar-architecture-selected-face ((t (:foreground "gray85" :underline t)))) + (vhdl-speedbar-configuration-face ((t (:foreground "gray85")))) + (vhdl-speedbar-configuration-selected-face ((t (:foreground "gray85" :underline t)))) + (vhdl-speedbar-entity-face ((t (:foreground "gray85")))) + (vhdl-speedbar-entity-selected-face ((t (:foreground "gray85" :underline t)))) + (vhdl-speedbar-instantiation-face ((t (:foreground "gray85")))) + (vhdl-speedbar-instantiation-selected-face ((t (:foreground "gray85" :underline t)))) + (vhdl-speedbar-package-face ((t (:foreground "gray85")))) + (vhdl-speedbar-package-selected-face ((t (:foreground "gray85" :underline t)))) + (viper-minibuffer-emacs-face ((t (:background "darkseagreen2" :foreground "Black")))) + (viper-minibuffer-insert-face ((t (:background "pink" :foreground "Black")))) + (viper-minibuffer-vi-face ((t (:background "grey" :foreground "DarkGreen")))) + (viper-replace-overlay-face ((t (:background "darkseagreen2" :foreground "Black")))) + (viper-search-face ((t (:background "khaki" :foreground "Black")))) + (vm-header-content-face ((t (:italic t :foreground "wheat" :slant italic)))) + (vm-header-from-face ((t (:italic t :foreground "wheat" :slant italic)))) + (vm-header-name-face ((t (:foreground "cyan")))) + (vm-header-subject-face ((t (:foreground "cyan")))) + (vm-header-to-face ((t (:italic t :foreground "cyan" :slant italic)))) + (vm-message-cited-face ((t (:foreground "Gray80")))) + (vm-monochrome-image ((t (:background "white" :foreground "gray30")))) + (vm-summary-face-1 ((t (:foreground "MediumAquamarine")))) + (vm-summary-face-2 ((t (:foreground "MediumAquamarine")))) + (vm-summary-face-3 ((t (:foreground "MediumAquamarine")))) + (vm-summary-face-4 ((t (:foreground "MediumAquamarine")))) + (vm-summary-highlight-face ((t (:foreground "White")))) + (vm-xface ((t (:background "white" :foreground "gray30")))) + (vmpc-pre-sig-face ((t (:foreground "gray85")))) + (vmpc-sig-face ((t (:foreground "gray85")))) + (vvb-face ((t (:background "pink" :foreground "gray30")))) + (w3m-anchor-face ((t (:bold t :foreground "gray85" :weight bold)))) + (w3m-arrived-anchor-face ((t (:bold t :foreground "gray85" :weight bold)))) + (w3m-header-line-location-content-face ((t (:background "dark olive green" :foreground "wheat")))) + (w3m-header-line-location-title-face ((t (:background "dark olive green" :foreground "beige")))) + (white ((t (:foreground "white")))) + (widget ((t (nil)))) + (widget-button-face ((t (:bold t :weight bold)))) + (widget-button-pressed-face ((t (:foreground "gray85")))) + (widget-documentation-face ((t (:foreground "dark green")))) + (widget-field-face ((t (:background "gray85" :foreground "gray30")))) + (widget-inactive-face ((t (:foreground "dim gray")))) + (widget-single-line-field-face ((t (:background "dim gray" :foreground "white")))) + (woman-addition-face ((t (:foreground "orange")))) + (woman-bold-face ((t (:bold t :weight bold)))) + (woman-italic-face ((t (:foreground "beige")))) + (woman-unknown-face ((t (:foreground "LightSalmon")))) + (x-face ((t (:background "white" :foreground "gray30")))) + (xrdb-option-name-face ((t (:foreground "gray85")))) + (xref-keyword-face ((t (:foreground "gray85")))) + (xref-list-default-face ((t (nil)))) + (xref-list-pilot-face ((t (:foreground "gray85")))) + (xref-list-symbol-face ((t (:foreground "navy")))) + (xsl-fo-alternate-face ((t (:foreground "Yellow")))) + (xsl-fo-main-face ((t (:foreground "PaleGreen")))) + (xsl-other-element-face ((t (:foreground "Coral")))) + (xsl-xslt-alternate-face ((t (:foreground "LightGray")))) + (xsl-xslt-main-face ((t (:foreground "Wheat")))) + (xxml-emph-1-face ((t (:background "lightyellow")))) + (xxml-emph-2-face ((t (:background "lightyellow")))) + (xxml-header-1-face ((t (:background "seashell1" :foreground "MediumAquamarine")))) + (xxml-header-2-face ((t (:background "seashell1" :foreground "SkyBlue")))) + (xxml-header-3-face ((t (:background "seashell1")))) + (xxml-header-4-face ((t (:background "seashell1")))) + (xxml-interaction-face ((t (:background "lightcyan")))) + (xxml-rug-face ((t (:background "cyan")))) + (xxml-sparkle-face ((t (:background "yellow")))) + (xxml-unbreakable-space-face ((t (:foreground "grey" :underline t)))) + (yellow ((t (:foreground "yellow")))) + (zmacs-region ((t (:background "Cyan4"))))))) + +(defun color-theme-blue-mood () + "Color theme by Nelson Loyola, created 2002-04-15. +Includes cperl, custom, font-lock, p4, speedbar, widget." + (interactive) + (color-theme-install + '(color-theme-blue-mood + ((background-color . "DodgerBlue4") + (background-mode . dark) + (background-toolbar-color . "#bfbfbfbfbfbf") + (border-color . "Blue") + (border-color . "#000000000000") + (bottom-toolbar-shadow-color . "#6c6c68686868") + (cursor-color . "DarkGoldenrod1") + (foreground-color . "white smoke") + (mouse-color . "black") + (top-toolbar-shadow-color . "#e5e5e0e0e1e1")) + ((vc-annotate-very-old-color . "#0046FF")) + (default ((t (nil)))) + (blue ((t (:foreground "blue")))) + (bold ((t (:bold t)))) + (bold-italic ((t (nil)))) + (border-glyph ((t (nil)))) + (cmode-bracket-face ((t (:bold t)))) + (cperl-array-face ((t (:bold t :foreground "wheat")))) + (cperl-hash-face ((t (:bold t :foreground "chartreuse")))) + (custom-button-face ((t (nil)))) + (custom-changed-face ((t (:background "blue" :foreground "white")))) + (custom-documentation-face ((t (nil)))) + (custom-face-tag-face ((t (:underline t)))) + (custom-group-tag-face ((t (:underline t :foreground "blue")))) + (custom-group-tag-face-1 ((t (:underline t :foreground "red")))) + (custom-invalid-face ((t (:background "red" :foreground "yellow")))) + (custom-modified-face ((t (:background "blue" :foreground "white")))) + (custom-rogue-face ((t (:background "black" :foreground "pink")))) + (custom-saved-face ((t (:underline t)))) + (custom-set-face ((t (:background "white" :foreground "blue")))) + (custom-state-face ((t (:bold t :foreground "cyan")))) + (custom-variable-button-face ((t (:underline t :bold t)))) + (custom-variable-tag-face ((t (:underline t :foreground "blue")))) + (ff-paths-non-existant-file-face ((t (:bold t :foreground "NavyBlue")))) + (font-lock-builtin-face ((t (:bold t :foreground "wheat")))) + (font-lock-comment-face ((t (:bold t :foreground "gray72")))) + (font-lock-constant-face ((t (:bold t :foreground "cyan3")))) + (font-lock-doc-string-face ((t (:foreground "#00C000")))) + (font-lock-function-name-face ((t (:bold t :foreground "chartreuse")))) + (font-lock-keyword-face ((t (:bold t :foreground "gold1")))) + (font-lock-other-emphasized-face ((t (:bold t :foreground "gold1")))) + (font-lock-other-type-face ((t (:bold t :foreground "gold1")))) + (font-lock-preprocessor-face ((t (:foreground "plum")))) + (font-lock-reference-face ((t (:bold t :foreground "orangered")))) + (font-lock-string-face ((t (:foreground "tomato")))) + (font-lock-type-face ((t (:bold t :foreground "gold1")))) + (font-lock-variable-name-face ((t (:foreground "light yellow")))) + (font-lock-warning-face ((t (:foreground "tomato")))) + (green ((t (:foreground "green")))) + (gui-button-face ((t (:background "grey75" :foreground "black")))) + (gui-element ((t (:size "nil" :background "#e7e3d6" :foreground" #000000")))) + (highlight ((t (:background "red" :foreground "yellow")))) + (isearch ((t (:bold t :background "pale turquoise" :foreground "blue")))) + (italic ((t (nil)))) + (lazy-highlight-face ((t (:bold t :foreground "dark magenta")))) + (left-margin ((t (nil)))) + (list-mode-item-selected ((t (:bold t :background "gray68" :foreground "yellow")))) + (modeline ((t (:background "goldenrod" :foreground "darkblue")))) + (modeline-buffer-id ((t (:background "goldenrod" :foreground "darkblue")))) + (modeline-mousable ((t (:background "goldenrod" :foreground "darkblue")))) + (modeline-mousable-minor-mode ((t (:background "goldenrod" :foreground "darkblue")))) + (my-tab-face ((t (:background "SlateBlue1")))) + (p4-depot-added-face ((t (:foreground "steelblue1")))) + (p4-depot-deleted-face ((t (:foreground "red")))) + (p4-depot-unmapped-face ((t (:foreground "grey90")))) + (p4-diff-change-face ((t (:foreground "dark green")))) + (p4-diff-del-face ((t (:bold t :foreground "salmon")))) + (p4-diff-file-face ((t (:background "blue")))) + (p4-diff-head-face ((t (:background "blue")))) + (p4-diff-ins-face ((t (:foreground "steelblue1")))) + (paren-blink-off ((t (:foreground "DodgerBlue4")))) + (paren-match ((t (:background "red" :foreground "yellow")))) + (paren-mismatch ((t (:background "DeepPink")))) + (pointer ((t (:background "white")))) + (primary-selection ((t (:bold t :background "medium sea green")))) + (red ((t (:foreground "red")))) + (region ((t (:background "red" :foreground "yellow")))) + (right-margin ((t (nil)))) + (secondary-selection ((t (:background "gray91" :foreground "sienna3")))) + (show-paren-match-face ((t (:background "cyan3" :foreground "blue")))) + (show-paren-mismatch-face ((t (:background "red" :foreground "blue")))) + (show-trailing-whitespace ((t (:background "red" :foreground "blue")))) + (speedbar-button-face ((t (:foreground "white")))) + (speedbar-directory-face ((t (:foreground "gray")))) + (speedbar-file-face ((t (:foreground "gold1")))) + (speedbar-highlight-face ((t (:background "lightslateblue" :foreground "gold1")))) + (speedbar-selected-face ((t (:underline t :foreground "red")))) + (speedbar-tag-face ((t (:foreground "chartreuse")))) + (text-cursor ((t (:background "DarkGoldenrod1" :foreground "DodgerBlue4")))) + (toolbar ((t (:background "#e7e3d6" :foreground "#000000")))) + (underline ((t (:underline t)))) + (vertical-divider ((t (:background "#e7e3d6" :foreground "#000000")))) + (widget-button-face ((t (:bold t)))) + (widget-button-pressed-face ((t (:foreground "red")))) + (widget-documentation-face ((t (:foreground "dark green")))) + (widget-field-face ((t (:background "gray85")))) + (widget-inactive-face ((t (:foreground "dim gray")))) + (widget-single-line-field-face ((t (:background "gray85")))) + (yellow ((t (:foreground "yellow")))) + (zmacs-region ((t (:background "white" :foreground "midnightblue"))))))) + +(defun color-theme-euphoria () + "Color theme by oGLOWo, created 2000-04-19. +Green on black theme including font-lock, speedbar, and widget." + (interactive) + (color-theme-install + '(color-theme-euphoria + ((background-color . "black") + (background-mode . dark) + (border-color . "black") + (cursor-color . "yellow") + (foreground-color . "#00ff00") + (mouse-color . "yellow")) + ((help-highlight-face . underline) + (list-matching-lines-face . bold) + (widget-mouse-face . highlight)) + (default ((t (:stipple nil :background "black" :foreground "#00ff00" :inverse-video nil :box nil :strike-through nil :overline nil :underline nil :slant normal :weight normal :width normal :family "misc-fixed")))) + (bold ((t (:bold t :weight bold)))) + (bold-italic ((t (:italic t :bold t :slant italic :weight bold)))) + (border ((t (:background "black")))) + (comint-highlight-input ((t (:bold t :weight bold)))) + (comint-highlight-prompt ((t (:foreground "cyan")))) + (cursor ((t (:background "yellow")))) + (fixed-pitch ((t (:family "courier")))) + (font-lock-builtin-face ((t (:foreground "magenta")))) + (font-lock-comment-face ((t (:foreground "deeppink")))) + (font-lock-constant-face ((t (:foreground "blue")))) + (font-lock-doc-face ((t (:foreground "cyan")))) + (font-lock-doc-string-face ((t (:foreground "cyan")))) + (font-lock-function-name-face ((t (:foreground "purple")))) + (font-lock-keyword-face ((t (:foreground "red")))) + (font-lock-preprocessor-face ((t (:foreground "blue1")))) + (font-lock-reference-face ((t (nil)))) + (font-lock-string-face ((t (:foreground "cyan")))) + (font-lock-type-face ((t (:foreground "yellow")))) + (font-lock-variable-name-face ((t (:foreground "violet")))) + (font-lock-warning-face ((t (:bold t :foreground "red" :weight bold)))) + (fringe ((t (:background "gray16" :foreground "#00ff00")))) + (header-line ((t (:box (:line-width -1 :style released-button) :background "grey20" :foreground "grey90" :box nil)))) + (highlight ((t (:background "darkolivegreen")))) + (horizontal-divider ((t (:background "gray16" :foreground "#00ff00")))) + (isearch ((t (:background "palevioletred2" :foreground "brown4")))) + (isearch-lazy-highlight-face ((t (:background "paleturquoise4")))) + (italic ((t (:italic t :slant italic)))) + (menu ((t (:background "gray16" :foreground "green")))) + (modeline ((t (:background "gray16" :foreground "#00ff00" :box (:line-width -1 :style released-button))))) + (modeline-buffer-id ((t (:background "gray16" :foreground "#00ff00")))) + (modeline-mousable ((t (:background "gray16" :foreground "#00ff00")))) + (modeline-mousable-minor-mode ((t (:background "gray16" :foreground "#00ff00")))) + (mouse ((t (:background "yellow")))) + (primary-selection ((t (:background "#00ff00" :foreground "black")))) + (region ((t (:background "steelblue" :foreground "white")))) + (scroll-bar ((t (:background "gray16" :foreground "#00ff00")))) + (secondary-selection ((t (:background "#00ff00" :foreground "black")))) + (show-paren-match-face ((t (:background "turquoise")))) + (show-paren-mismatch-face ((t (:background "purple" :foreground "white")))) + (speedbar-button-face ((t (:foreground "#00ff00")))) + (speedbar-directory-face ((t (:foreground "#00ff00")))) + (speedbar-file-face ((t (:foreground "cyan")))) + (speedbar-highlight-face ((t (:background "#00ff00" :foreground "purple")))) + (speedbar-selected-face ((t (:foreground "deeppink" :underline t)))) + (speedbar-tag-face ((t (:foreground "yellow")))) + (tool-bar ((t (:background "gray16" :foreground "green" :box (:line-width 1 :style released-button))))) + (tooltip ((t (:background "gray16" :foreground "#00ff00")))) + (trailing-whitespace ((t (:background "red")))) + (underline ((t (:underline t)))) + (variable-pitch ((t (:family "helv")))) + (vertical-divider ((t (:background "gray16" :foreground "#00ff00")))) + (widget-button-face ((t (:bold t :weight bold)))) + (widget-button-pressed-face ((t (:foreground "red")))) + (widget-documentation-face ((t (:foreground "lime green")))) + (widget-field-face ((t (:background "dim gray")))) + (widget-inactive-face ((t (:foreground "light gray")))) + (widget-single-line-field-face ((t (:background "dim gray")))) + (zmacs-region ((t (:background "steelblue" :foreground "white"))))))) + +(defun color-theme-resolve () + "Color theme by Damien Elmes, created 2002-04-24. +A white smoke on blue color theme." + (interactive) + (color-theme-install + '(color-theme-resolve + ((background-color . "#00457f") + (background-mode . dark) + (border-color . "black") + (cursor-color . "DarkGoldenrod1") + (foreground-color . "white smoke") + (mouse-color . "white")) + ((display-time-mail-face . mode-line) + (help-highlight-face . underline) + (list-matching-lines-face . bold) + (view-highlight-face . highlight) + (widget-mouse-face . highlight)) + (default ((t (:stipple nil :background "#00457f" :foreground "white smoke" :inverse-video nil :box nil :strike-through nil :overline nil :underline nil :slant normal :weight normal :width normal :family "b&h-lucidatypewriter")))) + (bold ((t (:bold t :foreground "snow2" :weight bold)))) + (bold-italic ((t (:italic t :bold t :slant italic :weight bold)))) + (border ((t (:background "black")))) + (calendar-today-face ((t (:underline t)))) + (comint-highlight-input ((t (:bold t :weight bold)))) + (comint-highlight-prompt ((t (:foreground "cyan")))) + (cperl-array-face ((t (:bold t :foreground "wheat" :weight bold)))) + (cperl-hash-face ((t (:bold t :foreground "chartreuse" :weight bold)))) + (cursor ((t (:background "DarkGoldenrod1")))) + (diary-face ((t (:foreground "yellow")))) + (erc-input-face ((t (:foreground "lightblue2")))) + (erc-notice-face ((t (:foreground "lightyellow3")))) + (fixed-pitch ((t (:family "courier")))) + (font-latex-bold-face ((t (:bold t :foreground "DarkOliveGreen" :weight bold)))) + (font-latex-italic-face ((t (:italic t :foreground "DarkOliveGreen" :slant italic)))) + (font-latex-math-face ((t (:foreground "burlywood")))) + (font-latex-sedate-face ((t (:foreground "LightGray")))) + (font-latex-string-face ((t (:foreground "RosyBrown")))) + (font-latex-warning-face ((t (:bold t :foreground "Red" :weight bold)))) + (font-lock-builtin-face ((t (:foreground "wheat")))) + (font-lock-comment-face ((t (:foreground "light steel blue")))) + (font-lock-constant-face ((t (:foreground "seashell3")))) + (font-lock-doc-face ((t (:foreground "plum")))) + (font-lock-doc-string-face ((t (:foreground "#008000")))) + (font-lock-function-name-face ((t (:foreground "thistle1")))) + (font-lock-keyword-face ((t (:foreground "wheat")))) + (font-lock-other-emphasized-face ((t (:bold t :foreground "gold1" :weight bold)))) + (font-lock-other-type-face ((t (:bold t :foreground "gold1" :weight bold)))) + (font-lock-preprocessor-face ((t (:foreground "#800080")))) + (font-lock-reference-face ((t (:foreground "wheat")))) + (font-lock-string-face ((t (:foreground "plum")))) + (font-lock-type-face ((t (:foreground "lawn green")))) + (font-lock-variable-name-face ((t (:foreground "light yellow")))) + (font-lock-warning-face ((t (:foreground "plum")))) + (fringe ((t (:background "#000000")))) + (gnus-cite-attribution-face ((t (:italic t :slant italic)))) + (gnus-cite-face-1 ((t (:foreground "light blue")))) + (gnus-cite-face-10 ((t (:foreground "medium purple")))) + (gnus-cite-face-11 ((t (:foreground "turquoise")))) + (gnus-cite-face-2 ((t (:foreground "light cyan")))) + (gnus-cite-face-3 ((t (:foreground "light yellow")))) + (gnus-cite-face-4 ((t (:foreground "light pink")))) + (gnus-cite-face-5 ((t (:foreground "pale green")))) + (gnus-cite-face-6 ((t (:foreground "beige")))) + (gnus-cite-face-7 ((t (:foreground "orange")))) + (gnus-cite-face-8 ((t (:foreground "magenta")))) + (gnus-cite-face-9 ((t (:foreground "violet")))) + (gnus-emphasis-bold ((t (:bold t :weight bold)))) + (gnus-emphasis-bold-italic ((t (:italic t :bold t :slant italic :weight bold)))) + (gnus-emphasis-highlight-words ((t (:background "black" :foreground "yellow")))) + (gnus-emphasis-italic ((t (:italic t :slant italic)))) + (gnus-emphasis-underline ((t (:underline t)))) + (gnus-emphasis-underline-bold ((t (:bold t :underline t :weight bold)))) + (gnus-emphasis-underline-bold-italic ((t (:italic t :bold t :underline t :slant italic :weight bold)))) + (gnus-emphasis-underline-italic ((t (:italic t :underline t :slant italic)))) + (gnus-group-mail-1-empty-face ((t (:foreground "aquamarine1")))) + (gnus-group-mail-1-face ((t (:bold t :foreground "aquamarine1" :weight bold)))) + (gnus-group-mail-2-empty-face ((t (:foreground "aquamarine2")))) + (gnus-group-mail-2-face ((t (:bold t :foreground "aquamarine2" :weight bold)))) + (gnus-group-mail-3-empty-face ((t (:foreground "aquamarine3")))) + (gnus-group-mail-3-face ((t (:bold t :foreground "aquamarine3" :weight bold)))) + (gnus-group-mail-low-empty-face ((t (:foreground "aquamarine4")))) + (gnus-group-mail-low-face ((t (:bold t :foreground "aquamarine4" :weight bold)))) + (gnus-group-news-1-empty-face ((t (:foreground "PaleTurquoise")))) + (gnus-group-news-1-face ((t (:bold t :foreground "PaleTurquoise" :weight bold)))) + (gnus-group-news-2-empty-face ((t (:foreground "turquoise")))) + (gnus-group-news-2-face ((t (:bold t :foreground "turquoise" :weight bold)))) + (gnus-group-news-3-empty-face ((t (nil)))) + (gnus-group-news-3-face ((t (:bold t :weight bold)))) + (gnus-group-news-4-empty-face ((t (nil)))) + (gnus-group-news-4-face ((t (:bold t :weight bold)))) + (gnus-group-news-5-empty-face ((t (nil)))) + (gnus-group-news-5-face ((t (:bold t :weight bold)))) + (gnus-group-news-6-empty-face ((t (nil)))) + (gnus-group-news-6-face ((t (:bold t :weight bold)))) + (gnus-group-news-low-empty-face ((t (:foreground "DarkTurquoise")))) + (gnus-group-news-low-face ((t (:bold t :foreground "DarkTurquoise" :weight bold)))) + (gnus-header-content-face ((t (:italic t :foreground "snow2" :slant italic)))) + (gnus-header-from-face ((t (:foreground "spring green")))) + (gnus-header-name-face ((t (:bold t :foreground "snow2" :weight bold)))) + (gnus-header-newsgroups-face ((t (:italic t :foreground "yellow" :slant italic)))) + (gnus-header-subject-face ((t (:bold t :foreground "peach puff" :weight bold)))) + (gnus-signature-face ((t (:italic t :slant italic)))) + (gnus-splash-face ((t (:foreground "Brown")))) + (gnus-summary-cancelled-face ((t (:background "black" :foreground "yellow")))) + (gnus-summary-high-ancient-face ((t (:bold t :foreground "SkyBlue" :weight bold)))) + (gnus-summary-high-read-face ((t (:bold t :foreground "PaleGreen" :weight bold)))) + (gnus-summary-high-ticked-face ((t (:bold t :foreground "pink" :weight bold)))) + (gnus-summary-high-unread-face ((t (:bold t :weight bold)))) + (gnus-summary-low-ancient-face ((t (:italic t :foreground "SkyBlue" :slant italic)))) + (gnus-summary-low-read-face ((t (:italic t :foreground "PaleGreen" :slant italic)))) + (gnus-summary-low-ticked-face ((t (:italic t :foreground "pink" :slant italic)))) + (gnus-summary-low-unread-face ((t (:italic t :slant italic)))) + (gnus-summary-normal-ancient-face ((t (:foreground "SkyBlue")))) + (gnus-summary-normal-read-face ((t (:foreground "PaleGreen")))) + (gnus-summary-normal-ticked-face ((t (:foreground "pink")))) + (gnus-summary-normal-unread-face ((t (nil)))) + (gnus-summary-selected-face ((t (:underline t)))) + (header-line ((t (:background "grey20" :foreground "grey90")))) + (highlight ((t (:background "gray91" :foreground "firebrick")))) + (highline-face ((t (:background "paleturquoise" :foreground "black")))) + (holiday-face ((t (:background "chocolate4")))) + (isearch ((t (:background "palevioletred2" :foreground "brown4")))) + (isearch-lazy-highlight-face ((t (:background "paleturquoise4")))) + (italic ((t (:italic t :slant italic)))) + (menu ((t (nil)))) + (message-cited-text-face ((t (:foreground "seashell3")))) + (message-header-cc-face ((t (:bold t :foreground "snow2" :weight bold)))) + (message-header-name-face ((t (:bold t :foreground "snow1" :weight bold)))) + (message-header-newsgroups-face ((t (:italic t :bold t :foreground "blue4" :slant italic :weight bold)))) + (message-header-other-face ((t (:foreground "snow2")))) + (message-header-subject-face ((t (:bold t :foreground "snow2" :weight bold)))) + (message-header-to-face ((t (:bold t :foreground "snow2" :weight bold)))) + (message-header-xheader-face ((t (:foreground "blue")))) + (message-mml-face ((t (:foreground "ForestGreen")))) + (message-separator-face ((t (:foreground "misty rose")))) + (modeline ((t (:foreground "white" :background "#001040" :box (:line-width -1 :style released-button))))) + (modeline-buffer-id ((t (:foreground "white" :background "#001040")))) + (modeline-mousable ((t (:foreground "white" :background "#001040")))) + (modeline-mousable-minor-mode ((t (:foreground "white" :background "#001040")))) + (mouse ((t (:background "white")))) + (my-tab-face ((t (:background "SlateBlue1")))) + (p4-diff-del-face ((t (:bold t :foreground "salmon" :weight bold)))) + (primary-selection ((t (:background "gray91" :foreground "DodgerBlue4")))) + (region ((t (:background "gray91" :foreground "DodgerBlue4")))) + (scroll-bar ((t (:background "grey75")))) + (secondary-selection ((t (:background "gray91" :foreground "sienna3")))) + (show-paren-match-face ((t (:background "cyan3" :foreground "blue")))) + (show-paren-mismatch-face ((t (:background "red" :foreground "blue")))) + (tool-bar ((t (:background "grey75" :foreground "black")))) + (tooltip ((t (:background "lightyellow" :foreground "black")))) + (trailing-whitespace ((t (:background "red")))) + (underline ((t (:underline t)))) + (variable-pitch ((t (:family "helv")))) + (widget-button-face ((t (:bold t :weight bold)))) + (widget-button-pressed-face ((t (:foreground "red")))) + (widget-documentation-face ((t (:foreground "dark green")))) + (widget-field-face ((t (:background "steel blue")))) + (widget-inactive-face ((t (:foreground "grey")))) + (widget-single-line-field-face ((t (:background "gray85")))) + (zmacs-region ((t (:background "gray91" :foreground "DodgerBlue4"))))))) + +(defun color-theme-xp () + "Color theme by Girish Bharadwaj, created 2002-04-25. +Includes custom, erc, font-lock, jde, semantic, speedbar, widget." + (interactive) + (color-theme-install + '(color-theme-xp + ((background-color . "lightyellow2") + (background-mode . light) + (border-color . "black") + (cursor-color . "black") + (foreground-color . "gray20") + (mouse-color . "black")) + ((help-highlight-face . underline) + (list-matching-lines-face . bold) + (semantic-which-function-use-color . t) + (senator-eldoc-use-color . t) + (view-highlight-face . highlight) + (widget-mouse-face . highlight)) + (default ((t (:stipple nil :background "lightyellow2" :foreground "gray20" :inverse-video nil :box nil :strike-through nil :overline nil :underline nil :slant normal :weight normal :width normal :family "outline-courier new")))) + (bg:erc-color-face0 ((t (:background "White")))) + (bg:erc-color-face1 ((t (:background "black")))) + (bg:erc-color-face10 ((t (:background "lightblue1")))) + (bg:erc-color-face11 ((t (:background "cyan")))) + (bg:erc-color-face12 ((t (:background "blue")))) + (bg:erc-color-face13 ((t (:background "deeppink")))) + (bg:erc-color-face14 ((t (:background "gray50")))) + (bg:erc-color-face15 ((t (:background "gray90")))) + (bg:erc-color-face2 ((t (:background "blue4")))) + (bg:erc-color-face3 ((t (:background "green4")))) + (bg:erc-color-face4 ((t (:background "red")))) + (bg:erc-color-face5 ((t (:background "brown")))) + (bg:erc-color-face6 ((t (:background "purple")))) + (bg:erc-color-face7 ((t (:background "orange")))) + (bg:erc-color-face8 ((t (:background "yellow")))) + (bg:erc-color-face9 ((t (:background "green")))) + (bold ((t (:bold t :weight bold)))) + (bold-italic ((t (:italic t :bold t :slant italic :weight bold)))) + (border ((t (:background "black")))) + (button ((t (:underline t)))) + (comint-highlight-input ((t (:bold t :weight bold)))) + (comint-highlight-prompt ((t (:foreground "dark blue")))) + (cursor ((t (:background "black")))) + (custom-button-face ((t (:background "lightgrey" :foreground "black" :box (:line-width 2 :style released-button))))) + (custom-button-pressed-face ((t (:background "lightgrey" :foreground "black" :box (:line-width 2 :style pressed-button))))) + (custom-changed-face ((t (:background "blue" :foreground "white")))) + (custom-comment-face ((t (:background "gray85")))) + (custom-comment-tag-face ((t (:foreground "blue4")))) + (custom-documentation-face ((t (nil)))) + (custom-face-tag-face ((t (:bold t :family "helv" :weight bold :height 1.2)))) + (custom-group-tag-face ((t (:bold t :foreground "blue" :weight bold :height 1.2)))) + (custom-group-tag-face-1 ((t (:bold t :family "helv" :foreground "red" :weight bold :height 1.2)))) + (custom-invalid-face ((t (:background "red" :foreground "yellow")))) + (custom-modified-face ((t (:background "blue" :foreground "white")))) + (custom-rogue-face ((t (:background "black" :foreground "pink")))) + (custom-saved-face ((t (:underline t)))) + (custom-set-face ((t (:background "white" :foreground "blue")))) + (custom-state-face ((t (:foreground "dark green")))) + (custom-variable-button-face ((t (:bold t :underline t :weight bold)))) + (custom-variable-tag-face ((t (:bold t :family "helv" :foreground "blue" :weight bold :height 1.2)))) + (erc-action-face ((t (:bold t :weight bold)))) + (erc-bold-face ((t (:bold t :weight bold)))) + (erc-default-face ((t (nil)))) + (erc-direct-msg-face ((t (:foreground "IndianRed")))) + (erc-error-face ((t (:background "Red" :foreground "White")))) + (erc-input-face ((t (:foreground "brown")))) + (erc-inverse-face ((t (:background "Black" :foreground "White")))) + (erc-notice-face ((t (:bold t :foreground "SlateBlue" :weight bold)))) + (erc-prompt-face ((t (:bold t :background "lightBlue2" :foreground "Black" :weight bold)))) + (erc-timestamp-face ((t (:bold t :foreground "green" :weight bold)))) + (erc-underline-face ((t (:underline t)))) + (fg:erc-color-face0 ((t (:foreground "White")))) + (fg:erc-color-face1 ((t (:foreground "black")))) + (fg:erc-color-face10 ((t (:foreground "lightblue1")))) + (fg:erc-color-face11 ((t (:foreground "cyan")))) + (fg:erc-color-face12 ((t (:foreground "blue")))) + (fg:erc-color-face13 ((t (:foreground "deeppink")))) + (fg:erc-color-face14 ((t (:foreground "gray50")))) + (fg:erc-color-face15 ((t (:foreground "gray90")))) + (fg:erc-color-face2 ((t (:foreground "blue4")))) + (fg:erc-color-face3 ((t (:foreground "green4")))) + (fg:erc-color-face4 ((t (:foreground "red")))) + (fg:erc-color-face5 ((t (:foreground "brown")))) + (fg:erc-color-face6 ((t (:foreground "purple")))) + (fg:erc-color-face7 ((t (:foreground "orange")))) + (fg:erc-color-face8 ((t (:foreground "yellow")))) + (fg:erc-color-face9 ((t (:foreground "green")))) + (fixed-pitch ((t (:family "courier")))) + (font-lock-builtin-face ((t (:foreground "magenta3" :underline t :height 0.9)))) + (font-lock-comment-face ((t (:italic t :foreground "gray60" :slant oblique :height 0.9)))) + (font-lock-constant-face ((t (:bold t :foreground "medium purple" :weight bold :height 0.9)))) + (font-lock-function-name-face ((t (:bold t :foreground "black" :weight bold)))) + (font-lock-keyword-face ((t (:bold t :foreground "blue" :weight bold)))) + (font-lock-string-face ((t (:foreground "red" :height 0.9)))) + (font-lock-type-face ((t (:foreground "Royalblue")))) + (font-lock-variable-name-face ((t (:bold t :foreground "maroon" :weight bold :height 0.9)))) + (font-lock-warning-face ((t (:bold t :foreground "Red" :weight bold)))) + (fringe ((t (:background "dodgerblue")))) + (header-line ((t (:underline "red" :overline "red" :background "grey90" :foreground "grey20" :box nil)))) + (highlight ((t (:background "darkseagreen2")))) + (isearch ((t (:background "magenta2" :foreground "lightskyblue1")))) + (isearch-lazy-highlight-face ((t (:background "paleturquoise")))) + (italic ((t (:italic t :slant italic)))) + (jde-bug-breakpoint-cursor ((t (:background "brown" :foreground "cyan")))) + (jde-db-active-breakpoint-face ((t (:background "red" :foreground "black")))) + (jde-db-requested-breakpoint-face ((t (:background "yellow" :foreground "black")))) + (jde-db-spec-breakpoint-face ((t (:background "green" :foreground "black")))) + (jde-java-font-lock-api-face ((t (:foreground "dark goldenrod")))) + (jde-java-font-lock-bold-face ((t (:bold t :weight bold)))) + (jde-java-font-lock-code-face ((t (nil)))) + (jde-java-font-lock-constant-face ((t (:foreground "CadetBlue")))) + (jde-java-font-lock-doc-tag-face ((t (:foreground "green4")))) + (jde-java-font-lock-italic-face ((t (:italic t :slant italic)))) + (jde-java-font-lock-link-face ((t (:foreground "cadetblue" :underline t :slant normal)))) + (jde-java-font-lock-modifier-face ((t (:foreground "Orchid")))) + (jde-java-font-lock-number-face ((t (:foreground "RosyBrown")))) + (jde-java-font-lock-operator-face ((t (:foreground "medium blue")))) + (jde-java-font-lock-package-face ((t (:foreground "blue3")))) + (jde-java-font-lock-pre-face ((t (nil)))) + (jde-java-font-lock-underline-face ((t (:underline t)))) + (menu ((t (nil)))) + (minibuffer-prompt ((t (:foreground "dark blue")))) + (modeline ((t (:background "dodgerblue" :foreground "black" :overline "red" :underline "red")))) + (modeline-buffer-id ((t (:background "dodgerblue" :foreground "black")))) + (modeline-mousable ((t (:background "dodgerblue" :foreground "black")))) + (modeline-mousable-minor-mode ((t (:background "dodgerblue" :foreground "black")))) + (mode-line-inactive ((t (:italic t :underline "red" :overline "red" :background "white" :foreground "cadetblue" :box (:line-width -1 :color "grey75") :slant oblique :weight light)))) + (mouse ((t (:background "black")))) + (primary-selection ((t (:background "lightgoldenrod2")))) + (region ((t (:background "lightgoldenrod2")))) + (scroll-bar ((t (nil)))) + (secondary-selection ((t (:background "yellow")))) + (semantic-dirty-token-face ((t (:background "lightyellow")))) + (semantic-unmatched-syntax-face ((t (:underline "red")))) + (senator-intangible-face ((t (:foreground "gray25")))) + (senator-momentary-highlight-face ((t (:background "gray70")))) + (senator-read-only-face ((t (:background "#CCBBBB")))) + (show-paren-match-face ((t (:background "turquoise")))) + (show-paren-mismatch-face ((t (:background "purple" :foreground "white")))) + (speedbar-button-face ((t (:foreground "green4")))) + (speedbar-directory-face ((t (:foreground "blue4")))) + (speedbar-file-face ((t (:foreground "cyan4")))) + (speedbar-highlight-face ((t (:background "green")))) + (speedbar-selected-face ((t (:foreground "red" :underline t)))) + (speedbar-tag-face ((t (:foreground "brown")))) + (template-message-face ((t (:bold t :weight bold)))) + (tool-bar ((t (:background "grey75" :foreground "black" :box (:line-width 1 :style released-button))))) + (tooltip ((t (:background "lightyellow" :foreground "black")))) + (trailing-whitespace ((t (:background "red")))) + (underline ((t (:underline t)))) + (variable-pitch ((t (:family "helv")))) + (widget-button-face ((t (:bold t :weight bold)))) + (widget-button-pressed-face ((t (:foreground "red")))) + (widget-documentation-face ((t (:foreground "dark green")))) + (widget-field-face ((t (:background "gray85")))) + (widget-inactive-face ((t (:foreground "dim gray")))) + (widget-single-line-field-face ((t (:background "gray85")))) + (zmacs-region ((t (:background "lightgoldenrod2"))))))) + +(defun color-theme-gray30 () + "Color theme by Girish Bharadwaj, created 2002-04-22." + (interactive) + (color-theme-install + '(color-theme-gray30 + ((background-color . "grey30") + (background-mode . dark) + (border-color . "black") + (cursor-color . "black") + (foreground-color . "gainsboro") + (mouse-color . "black")) + ((help-highlight-face . underline) + (list-matching-lines-face . bold) + (semantic-which-function-use-color . t) + (senator-eldoc-use-color . t) + (widget-mouse-face . highlight)) + (default ((t (:stipple nil :background "grey30" :foreground "gainsboro" :inverse-video nil :box nil :strike-through nil :overline nil :underline nil :slant normal :weight normal :width normal :family "outline-courier new")))) + (bg:erc-color-face0 ((t (:background "White")))) + (bg:erc-color-face1 ((t (:background "black")))) + (bg:erc-color-face10 ((t (:background "lightblue1")))) + (bg:erc-color-face11 ((t (:background "cyan")))) + (bg:erc-color-face12 ((t (:background "blue")))) + (bg:erc-color-face13 ((t (:background "deeppink")))) + (bg:erc-color-face14 ((t (:background "gray50")))) + (bg:erc-color-face15 ((t (:background "gray90")))) + (bg:erc-color-face2 ((t (:background "blue4")))) + (bg:erc-color-face3 ((t (:background "green4")))) + (bg:erc-color-face4 ((t (:background "red")))) + (bg:erc-color-face5 ((t (:background "brown")))) + (bg:erc-color-face6 ((t (:background "purple")))) + (bg:erc-color-face7 ((t (:background "orange")))) + (bg:erc-color-face8 ((t (:background "yellow")))) + (bg:erc-color-face9 ((t (:background "green")))) + (bold ((t (:bold t :weight bold)))) + (bold-italic ((t (:italic t :bold t :slant italic :weight bold)))) + (border ((t (:background "black")))) + (button ((t (:underline t)))) + (comint-highlight-input ((t (:bold t :weight bold)))) + (comint-highlight-prompt ((t (:foreground "cyan")))) + (cursor ((t (:background "black")))) + (custom-button-face ((t (:background "lightgrey" :foreground "black" :box (:line-width 2 :style released-button))))) + (custom-button-pressed-face ((t (:background "lightgrey" :foreground "black" :box (:line-width 2 :style pressed-button))))) + (custom-changed-face ((t (:background "blue" :foreground "white")))) + (custom-comment-face ((t (:background "dim gray")))) + (custom-comment-tag-face ((t (:foreground "gray80")))) + (custom-documentation-face ((t (nil)))) + (custom-face-tag-face ((t (:bold t :family "helv" :weight bold :height 1.2)))) + (custom-group-tag-face ((t (:bold t :foreground "light blue" :weight bold :height 1.2)))) + (custom-group-tag-face-1 ((t (:bold t :family "helv" :foreground "pink" :weight bold :height 1.2)))) + (custom-invalid-face ((t (:background "red" :foreground "yellow")))) + (custom-modified-face ((t (:background "blue" :foreground "white")))) + (custom-rogue-face ((t (:background "black" :foreground "pink")))) + (custom-saved-face ((t (:underline t)))) + (custom-set-face ((t (:background "white" :foreground "blue")))) + (custom-state-face ((t (:foreground "lime green")))) + (custom-variable-button-face ((t (:bold t :underline t :weight bold)))) + (custom-variable-tag-face ((t (:bold t :family "helv" :foreground "light blue" :weight bold :height 1.2)))) + (erc-action-face ((t (:bold t :weight bold)))) + (erc-bold-face ((t (:bold t :weight bold)))) + (erc-default-face ((t (nil)))) + (erc-direct-msg-face ((t (:foreground "IndianRed")))) + (erc-error-face ((t (:background "Red" :foreground "White")))) + (erc-input-face ((t (:foreground "brown")))) + (erc-inverse-face ((t (:background "Black" :foreground "White")))) + (erc-notice-face ((t (:bold t :foreground "SlateBlue" :weight bold)))) + (erc-prompt-face ((t (:bold t :background "lightBlue2" :foreground "Black" :weight bold)))) + (erc-timestamp-face ((t (:bold t :foreground "green" :weight bold)))) + (erc-underline-face ((t (:underline t)))) + (eshell-ls-archive-face ((t (:bold t :foreground "Orchid" :weight bold)))) + (eshell-ls-backup-face ((t (:foreground "LightSalmon")))) + (eshell-ls-clutter-face ((t (:bold t :foreground "OrangeRed" :weight bold)))) + (eshell-ls-directory-face ((t (:bold t :foreground "SkyBlue" :weight bold)))) + (eshell-ls-executable-face ((t (:bold t :foreground "Green" :weight bold)))) + (eshell-ls-missing-face ((t (:bold t :foreground "Red" :weight bold)))) + (eshell-ls-product-face ((t (:foreground "LightSalmon")))) + (eshell-ls-readonly-face ((t (:foreground "Pink")))) + (eshell-ls-special-face ((t (:bold t :foreground "Magenta" :weight bold)))) + (eshell-ls-symlink-face ((t (:bold t :foreground "Cyan" :weight bold)))) + (eshell-ls-unreadable-face ((t (:foreground "DarkGrey")))) + (fg:erc-color-face0 ((t (:foreground "White")))) + (fg:erc-color-face1 ((t (:foreground "black")))) + (fg:erc-color-face10 ((t (:foreground "lightblue1")))) + (fg:erc-color-face11 ((t (:foreground "cyan")))) + (fg:erc-color-face12 ((t (:foreground "blue")))) + (fg:erc-color-face13 ((t (:foreground "deeppink")))) + (fg:erc-color-face14 ((t (:foreground "gray50")))) + (fg:erc-color-face15 ((t (:foreground "gray90")))) + (fg:erc-color-face2 ((t (:foreground "blue4")))) + (fg:erc-color-face3 ((t (:foreground "green4")))) + (fg:erc-color-face4 ((t (:foreground "red")))) + (fg:erc-color-face5 ((t (:foreground "brown")))) + (fg:erc-color-face6 ((t (:foreground "purple")))) + (fg:erc-color-face7 ((t (:foreground "orange")))) + (fg:erc-color-face8 ((t (:foreground "yellow")))) + (fg:erc-color-face9 ((t (:foreground "green")))) + (fixed-pitch ((t (:family "courier")))) + (font-lock-builtin-face ((t (:foreground "LightSkyBlue" :underline t)))) + (font-lock-comment-face ((t (:italic t :foreground "lightgreen" :slant oblique)))) + (font-lock-constant-face ((t (:foreground "Aquamarine")))) + (font-lock-function-name-face ((t (:bold t :foreground "DodgerBlue" :weight bold :height 1.05)))) + (font-lock-keyword-face ((t (:foreground "LightPink" :height 1.05)))) + (font-lock-string-face ((t (:foreground "LightSalmon")))) + (font-lock-type-face ((t (:foreground "yellow" :height 1.05)))) + (font-lock-variable-name-face ((t (:foreground "gold")))) + (font-lock-warning-face ((t (:bold t :foreground "Pink" :weight bold)))) + (fringe ((t (:background "grey10")))) + (header-line ((t (:box (:line-width -1 :style released-button) :background "grey20" :foreground "grey90" :box nil)))) + (highlight ((t (:background "darkolivegreen")))) + (isearch ((t (:background "palevioletred2" :foreground "brown4")))) + (isearch-lazy-highlight-face ((t (:background "paleturquoise4")))) + (italic ((t (:italic t :slant italic)))) + (jde-bug-breakpoint-cursor ((t (:background "brown" :foreground "cyan")))) + (jde-db-active-breakpoint-face ((t (:background "red" :foreground "black")))) + (jde-db-requested-breakpoint-face ((t (:background "yellow" :foreground "black")))) + (jde-db-spec-breakpoint-face ((t (:background "green" :foreground "black")))) + (jde-java-font-lock-api-face ((t (:foreground "light goldenrod")))) + (jde-java-font-lock-bold-face ((t (:bold t :weight bold)))) + (jde-java-font-lock-code-face ((t (nil)))) + (jde-java-font-lock-constant-face ((t (:foreground "Aquamarine")))) + (jde-java-font-lock-doc-tag-face ((t (:foreground "light coral")))) + (jde-java-font-lock-italic-face ((t (:italic t :slant italic)))) + (jde-java-font-lock-link-face ((t (:foreground "cadetblue" :underline t :slant normal)))) + (jde-java-font-lock-modifier-face ((t (:foreground "LightSteelBlue")))) + (jde-java-font-lock-number-face ((t (:foreground "LightSalmon")))) + (jde-java-font-lock-operator-face ((t (:foreground "medium blue")))) + (jde-java-font-lock-package-face ((t (:foreground "steelblue1")))) + (jde-java-font-lock-pre-face ((t (nil)))) + (jde-java-font-lock-underline-face ((t (:underline t)))) + (menu ((t (nil)))) + (minibuffer-prompt ((t (:foreground "cyan")))) + (mode-line ((t (:background "grey75" :foreground "black" :box (:line-width -1 :style released-button))))) + (mode-line-inactive ((t (:background "grey30" :foreground "grey80" :box (:line-width -1 :color "grey40" :style nil) :weight light)))) + (mouse ((t (:background "black")))) + (primary-selection ((t (:background "blue3")))) + (region ((t (:background "blue3")))) + (scroll-bar ((t (nil)))) + (secondary-selection ((t (:background "SkyBlue4")))) + (semantic-dirty-token-face ((t (:background "lightyellow")))) + (semantic-unmatched-syntax-face ((t (:underline "red")))) + (senator-intangible-face ((t (:foreground "gray75")))) + (senator-momentary-highlight-face ((t (:background "gray30")))) + (senator-read-only-face ((t (:background "#664444")))) + (show-paren-match-face ((t (:background "steelblue3")))) + (show-paren-mismatch-face ((t (:background "purple" :foreground "white")))) + (speedbar-button-face ((t (:foreground "green3")))) + (speedbar-directory-face ((t (:foreground "light blue")))) + (speedbar-file-face ((t (:foreground "cyan")))) + (speedbar-highlight-face ((t (:background "sea green")))) + (speedbar-selected-face ((t (:foreground "red" :underline t)))) + (speedbar-tag-face ((t (:foreground "yellow")))) + (template-message-face ((t (:bold t :weight bold)))) + (tool-bar ((t (:background "grey75" :foreground "black" :box (:line-width 1 :style released-button))))) + (tooltip ((t (:background "lightyellow" :foreground "black")))) + (trailing-whitespace ((t (:background "red")))) + (underline ((t (:underline t)))) + (variable-pitch ((t (:family "helv")))) + (widget-button-face ((t (:bold t :weight bold)))) + (widget-button-pressed-face ((t (:foreground "red")))) + (widget-documentation-face ((t (:foreground "lime green")))) + (widget-field-face ((t (:background "dim gray")))) + (widget-inactive-face ((t (:foreground "light gray")))) + (widget-single-line-field-face ((t (:background "dim gray")))) + (zmacs-region ((t (:background "blue3"))))))) + +(defun color-theme-dark-green () + "Color theme by ces93, created 2002-03-30." + (interactive) + (color-theme-install + '(color-theme-dark-green + ((background-mode . light) + (background-toolbar-color . "#e79ddf7ddf7d") + (border-color . "#000000000000") + (bottom-toolbar-shadow-color . "#8e3886178617") + (top-toolbar-shadow-color . "#ffffffffffff")) + nil + (default ((t (nil)))) + (blue ((t (:foreground "blue")))) + (bold ((t (:bold t)))) + (bold-italic ((t (:italic t :bold t)))) + (border-glyph ((t (nil)))) + (fringe ((t (nil)))) + (green ((t (:foreground "green")))) + (gui-button-face ((t (:background "grey75" :foreground "black")))) + (gui-element ((t (:background "#ffffff" :foreground "#000000")))) + (highlight ((t (:background "gray" :foreground "darkred")))) + (isearch ((t (:background "LightSlateGray" :foreground "red")))) + (italic ((t (:italic t)))) + (left-margin ((t (nil)))) + (list-mode-item-selected ((t (:background "gray68")))) + (mode-line ((t (:background "LightSlateGray" :foreground "black")))) + (modeline ((t (:background "LightSlateGray" :foreground "black")))) + (modeline-buffer-id ((t (:background "LightSlateGray" :foreground "blue4")))) + (modeline-mousable ((t (:background "LightSlateGray" :foreground "firebrick")))) + (modeline-mousable-minor-mode ((t (:background "LightSlateGray" :foreground "green4")))) + (pointer ((t (:background "#ffffff" :foreground "#000000")))) + (primary-selection ((t (:background "gray65")))) + (red ((t (:foreground "red")))) + (region ((t (:background "gray65")))) + (right-margin ((t (nil)))) + (rpm-spec-dir-face ((t (:foreground "green")))) + (rpm-spec-doc-face ((t (:foreground "magenta")))) + (rpm-spec-ghost-face ((t (:foreground "red")))) + (rpm-spec-macro-face ((t (:foreground "purple")))) + (rpm-spec-package-face ((t (:foreground "red")))) + (rpm-spec-tag-face ((t (:foreground "blue")))) + (secondary-selection ((t (:background "paleturquoise")))) + (text-cursor ((t (:background "Red3" :foreground "DarkSlateGray")))) + (tool-bar ((t (nil)))) + (toolbar ((t (:background "#ffffff" :foreground "#000000")))) + (underline ((t (:underline t)))) + (vertical-divider ((t (:background "#ffffff" :foreground "#000000")))) + (widget-button-face ((t (:bold t)))) + (widget-button-pressed-face ((t (:foreground "red")))) + (widget-documentation-face ((t (:foreground "dark green")))) + (widget-field-face ((t (:background "gray85")))) + (widget-inactive-face ((t (:foreground "dim gray")))) + (yellow ((t (:foreground "yellow")))) + (zmacs-region ((t (:background "darkorange" :foreground "black"))))))) + +(defun color-theme-whateveryouwant () + "Color theme by Fabien Penso, created 2002-05-02." + (interactive) + (color-theme-install + '(color-theme-whateveryouwant + ((background-color . "white") + (background-mode . light) + (border-color . "black") + (cursor-color . "black") + (foreground-color . "black") + (mouse-color . "black")) + ((cperl-here-face . font-lock-string-face) + (cperl-invalid-face . underline) + (cperl-pod-face . font-lock-comment-face) + (cperl-pod-head-face . font-lock-variable-name-face) + (display-time-mail-face . mode-line) + (gnus-article-button-face . bold) + (gnus-article-mouse-face . highlight) + (gnus-carpal-button-face . bold) + (gnus-carpal-header-face . bold-italic) + (gnus-cite-attribution-face . gnus-cite-attribution-face) + (gnus-mouse-face . highlight) + (gnus-selected-tree-face . modeline) + (gnus-signature-face . gnus-signature-face) + (gnus-summary-selected-face . gnus-summary-selected-face) + (gnus-treat-display-xface . head) + (help-highlight-face . underline) + (ispell-highlight-face . flyspell-incorrect-face) + (list-matching-lines-face . bold) + (sgml-set-face . t) + (view-highlight-face . highlight) + (widget-mouse-face . highlight) + (x-face-mouse-face . highlight)) + (default ((t (:stipple nil :background "white" :foreground "black" :inverse-video nil :box nil :strike-through nil :overline nil :underline nil :slant normal :weight normal :height 116 :width normal :family "monotype-courier new")))) + (Info-title-1-face ((t (:bold t :weight bold :height 1.728 :family "helv")))) + (Info-title-2-face ((t (:bold t :weight bold :height 1.44 :family "helv")))) + (Info-title-3-face ((t (:bold t :weight bold :height 1.2 :family "helv")))) + (Info-title-4-face ((t (:bold t :weight bold :family "helv")))) + (antlr-font-lock-keyword-face ((t (:bold t :foreground "black" :weight bold)))) + (antlr-font-lock-literal-face ((t (:bold t :foreground "brown4" :weight bold)))) + (antlr-font-lock-ruledef-face ((t (:bold t :foreground "blue" :weight bold)))) + (antlr-font-lock-ruleref-face ((t (:foreground "blue4")))) + (antlr-font-lock-tokendef-face ((t (:bold t :foreground "blue" :weight bold)))) + (antlr-font-lock-tokenref-face ((t (:foreground "orange4")))) + (bbdb-company ((t (:italic t :slant italic)))) + (bbdb-field-name ((t (:bold t :foreground "gray40" :weight bold)))) + (bbdb-field-value ((t (nil)))) + (bbdb-name ((t (:underline t)))) + (bold ((t (:bold t :foreground "gray40" :weight bold)))) + (bold-italic ((t (:italic t :bold t :slant italic :weight bold)))) + (border ((t (:background "black")))) + (calendar-today-face ((t (:underline t)))) + (change-log-acknowledgement-face ((t (:foreground "Firebrick")))) + (change-log-conditionals-face ((t (:foreground "DarkGoldenrod")))) + (change-log-date-face ((t (:foreground "RosyBrown")))) + (change-log-email-face ((t (:foreground "DarkGoldenrod")))) + (change-log-file-face ((t (:foreground "Blue")))) + (change-log-function-face ((t (:foreground "DarkGoldenrod")))) + (change-log-list-face ((t (:foreground "Purple")))) + (change-log-name-face ((t (:foreground "CadetBlue")))) + (comint-highlight-input ((t (:bold t :weight bold)))) + (comint-highlight-prompt ((t (:foreground "dark blue")))) + (cperl-array-face ((t (:bold t :background "lightyellow2" :foreground "Blue" :weight bold)))) + (cperl-hash-face ((t (:italic t :bold t :background "lightyellow2" :foreground "Red" :slant italic :weight bold)))) + (cperl-nonoverridable-face ((t (:foreground "chartreuse3")))) + (cursor ((t (:background "black")))) + (custom-button-face ((t (:background "lightgrey" :foreground "black" :box (:line-width 2 :style released-button))))) + (custom-button-pressed-face ((t (:background "lightgrey" :foreground "black" :box (:line-width 2 :style pressed-button))))) + (custom-changed-face ((t (:background "blue" :foreground "white")))) + (custom-comment-face ((t (:background "gray85")))) + (custom-comment-tag-face ((t (:foreground "blue4")))) + (custom-documentation-face ((t (nil)))) + (custom-face-tag-face ((t (:bold t :weight bold :height 1.2 :family "helv")))) + (custom-group-tag-face ((t (:bold t :foreground "blue" :weight bold :height 1.2)))) + (custom-group-tag-face-1 ((t (:bold t :foreground "red" :weight bold :height 1.2 :family "helv")))) + (custom-invalid-face ((t (:background "red" :foreground "yellow")))) + (custom-modified-face ((t (:background "blue" :foreground "white")))) + (custom-rogue-face ((t (:background "black" :foreground "pink")))) + (custom-saved-face ((t (:underline t)))) + (custom-set-face ((t (:background "white" :foreground "blue")))) + (custom-state-face ((t (:foreground "dark green")))) + (custom-variable-button-face ((t (:bold t :underline t :weight bold)))) + (custom-variable-tag-face ((t (:bold t :foreground "blue" :weight bold :height 1.2 :family "helv")))) + (cvs-filename-face ((t (:foreground "blue4")))) + (cvs-handled-face ((t (:foreground "pink")))) + (cvs-header-face ((t (:bold t :foreground "blue4" :weight bold)))) + (cvs-marked-face ((t (:bold t :foreground "green3" :weight bold)))) + (cvs-msg-face ((t (:italic t :slant italic)))) + (cvs-need-action-face ((t (:foreground "orange")))) + (cvs-unknown-face ((t (:foreground "red")))) + (diary-face ((t (:foreground "red")))) + (diff-added-face ((t (nil)))) + (diff-changed-face ((t (nil)))) + (diff-context-face ((t (:foreground "grey50")))) + (diff-file-header-face ((t (:bold t :background "grey70" :weight bold)))) + (diff-function-face ((t (:foreground "grey50")))) + (diff-header-face ((t (:background "grey85")))) + (diff-hunk-header-face ((t (:background "grey85")))) + (diff-index-face ((t (:bold t :background "grey70" :weight bold)))) + (diff-nonexistent-face ((t (:bold t :background "grey70" :weight bold)))) + (diff-removed-face ((t (nil)))) + (dired-face-boring ((t (:foreground "RosyBrown")))) + (dired-face-directory ((t (:foreground "Blue")))) + (dired-face-executable ((t (nil)))) + (dired-face-flagged ((t (:bold t :foreground "Red" :weight bold)))) + (dired-face-marked ((t (:bold t :foreground "Red" :weight bold)))) + (dired-face-permissions ((t (nil)))) + (dired-face-setuid ((t (nil)))) + (dired-face-socket ((t (nil)))) + (dired-face-symlink ((t (:foreground "Purple")))) + (ebrowse-default-face ((t (nil)))) + (ebrowse-file-name-face ((t (:italic t :slant italic)))) + (ebrowse-member-attribute-face ((t (:foreground "red")))) + (ebrowse-member-class-face ((t (:foreground "purple")))) + (ebrowse-progress-face ((t (:background "blue")))) + (ebrowse-root-class-face ((t (:bold t :foreground "blue" :weight bold)))) + (ebrowse-tree-mark-face ((t (:foreground "red")))) + (ediff-current-diff-face-A ((t (:background "pale green" :foreground "firebrick")))) + (ediff-current-diff-face-Ancestor ((t (:background "VioletRed" :foreground "Black")))) + (ediff-current-diff-face-B ((t (:background "Yellow" :foreground "DarkOrchid")))) + (ediff-current-diff-face-C ((t (:background "Pink" :foreground "Navy")))) + (ediff-even-diff-face-A ((t (:background "light grey" :foreground "Black")))) + (ediff-even-diff-face-Ancestor ((t (:background "Grey" :foreground "White")))) + (ediff-even-diff-face-B ((t (:background "Grey" :foreground "White")))) + (ediff-even-diff-face-C ((t (:background "light grey" :foreground "Black")))) + (ediff-fine-diff-face-A ((t (:background "sky blue" :foreground "Navy")))) + (ediff-fine-diff-face-Ancestor ((t (:background "Green" :foreground "Black")))) + (ediff-fine-diff-face-B ((t (:background "cyan" :foreground "Black")))) + (ediff-fine-diff-face-C ((t (:background "Turquoise" :foreground "Black")))) + (ediff-odd-diff-face-A ((t (:background "Grey" :foreground "White")))) + (ediff-odd-diff-face-Ancestor ((t (:background "light grey" :foreground "Black")))) + (ediff-odd-diff-face-B ((t (:background "light grey" :foreground "Black")))) + (ediff-odd-diff-face-C ((t (:background "Grey" :foreground "White")))) + (erc-action-face ((t (:bold t :weight bold)))) + (erc-bold-face ((t (:bold t :weight bold)))) + (erc-default-face ((t (nil)))) + (erc-direct-msg-face ((t (:foreground "LightSalmon")))) + (erc-error-face ((t (:bold t :foreground "IndianRed" :weight bold)))) + (erc-input-face ((t (:foreground "Beige")))) + (erc-inverse-face ((t (:background "wheat" :foreground "darkslategrey")))) + (erc-notice-face ((t (:foreground "MediumAquamarine")))) + (erc-pal-face ((t (:foreground "pale green")))) + (erc-prompt-face ((t (:foreground "MediumAquamarine")))) + (erc-underline-face ((t (:underline t)))) + (eshell-ls-archive-face ((t (:bold t :foreground "Orchid" :weight bold)))) + (eshell-ls-backup-face ((t (:foreground "OrangeRed")))) + (eshell-ls-clutter-face ((t (:bold t :foreground "OrangeRed" :weight bold)))) + (eshell-ls-directory-face ((t (:bold t :foreground "Blue" :weight bold)))) + (eshell-ls-executable-face ((t (:bold t :foreground "ForestGreen" :weight bold)))) + (eshell-ls-missing-face ((t (:bold t :foreground "Red" :weight bold)))) + (eshell-ls-picture-face ((t (:foreground "Violet")))) + (eshell-ls-product-face ((t (:foreground "OrangeRed")))) + (eshell-ls-readonly-face ((t (:foreground "Brown")))) + (eshell-ls-special-face ((t (:bold t :foreground "Magenta" :weight bold)))) + (eshell-ls-symlink-face ((t (:bold t :foreground "Dark Cyan" :weight bold)))) + (eshell-ls-unreadable-face ((t (:foreground "Grey30")))) + (eshell-prompt-face ((t (:bold t :foreground "#aa0000" :weight bold :width condensed :family "neep-alt")))) + (eshell-test-failed-face ((t (:bold t :foreground "OrangeRed" :weight bold)))) + (eshell-test-ok-face ((t (:bold t :foreground "Green" :weight bold)))) + (excerpt ((t (:italic t :slant italic)))) + (fixed ((t (:bold t :weight bold)))) + (fixed-pitch ((t (:family "courier")))) + (flyspell-duplicate-face ((t (:bold t :foreground "Gold3" :underline t :weight bold)))) + (flyspell-incorrect-face ((t (:bold t :foreground "OrangeRed" :underline t :weight bold)))) + (font-latex-bold-face ((t (:bold t :foreground "DarkOliveGreen" :weight bold)))) + (font-latex-italic-face ((t (:italic t :foreground "DarkOliveGreen" :slant italic)))) + (font-latex-math-face ((t (:foreground "SaddleBrown")))) + (font-latex-sedate-face ((t (:foreground "DimGray")))) + (font-latex-string-face ((t (:foreground "RosyBrown")))) + (font-latex-warning-face ((t (:bold t :foreground "Red" :weight bold)))) + (font-lock-builtin-face ((t (:foreground "dodgerblue3")))) + (font-lock-comment-face ((t (:foreground "#cc0000" :width semi-condensed :family "helvetica")))) + (font-lock-constant-face ((t (:foreground "CadetBlue")))) + (font-lock-doc-face ((t (:foreground "RosyBrown")))) + (font-lock-doc-string-face ((t (:foreground "RosyBrown")))) + (font-lock-function-name-face ((t (:bold t :foreground "navy" :weight bold :height 100)))) + (font-lock-keyword-face ((t (:bold t :foreground "red4" :weight bold)))) + (font-lock-preprocessor-face ((t (:foreground "CadetBlue")))) + (font-lock-reference-face ((t (:foreground "Orchid")))) + (font-lock-string-face ((t (:foreground "navy")))) + (font-lock-type-face ((t (:bold t :foreground "black" :weight bold)))) + (font-lock-variable-name-face ((t (:foreground "black")))) + (font-lock-warning-face ((t (:foreground "orange2")))) + (fringe ((t (:background "white")))) + (gnus-cite-attribution-face ((t (:italic t :slant italic)))) + (gnus-cite-face-1 ((t (:foreground "MidnightBlue")))) + (gnus-cite-face-10 ((t (:foreground "medium purple")))) + (gnus-cite-face-11 ((t (:foreground "turquoise")))) + (gnus-cite-face-2 ((t (:foreground "firebrick")))) + (gnus-cite-face-3 ((t (:foreground "dark green")))) + (gnus-cite-face-4 ((t (:foreground "OrangeRed")))) + (gnus-cite-face-5 ((t (:foreground "dark khaki")))) + (gnus-cite-face-6 ((t (:foreground "dark violet")))) + (gnus-cite-face-7 ((t (:foreground "SteelBlue4")))) + (gnus-cite-face-8 ((t (:foreground "magenta")))) + (gnus-cite-face-9 ((t (:foreground "violet")))) + (gnus-emphasis-bold ((t (:bold t :weight bold)))) + (gnus-emphasis-bold-italic ((t (:italic t :bold t :slant italic :weight bold)))) + (gnus-emphasis-highlight-words ((t (:background "black" :foreground "yellow")))) + (gnus-emphasis-italic ((t (:italic t :slant italic)))) + (gnus-emphasis-underline ((t (:underline t)))) + (gnus-emphasis-underline-bold ((t (:bold t :underline t :weight bold)))) + (gnus-emphasis-underline-bold-italic ((t (:italic t :bold t :underline t :slant italic :weight bold)))) + (gnus-emphasis-underline-italic ((t (:italic t :underline t :slant italic)))) + (gnus-group-mail-1-empty-face ((t (:foreground "DeepPink3")))) + (gnus-group-mail-1-face ((t (:bold t :foreground "DeepPink3" :weight bold)))) + (gnus-group-mail-2-empty-face ((t (:foreground "HotPink3")))) + (gnus-group-mail-2-face ((t (:bold t :foreground "HotPink3" :weight bold)))) + (gnus-group-mail-3-empty-face ((t (:foreground "magenta4")))) + (gnus-group-mail-3-face ((t (:bold t :foreground "magenta4" :weight bold)))) + (gnus-group-mail-low-empty-face ((t (:foreground "DeepPink4")))) + (gnus-group-mail-low-face ((t (:bold t :foreground "DeepPink4" :weight bold)))) + (gnus-group-news-1-empty-face ((t (:foreground "red" :weight normal :height 120 :family "courier")))) + (gnus-group-news-1-face ((t (:foreground "red" :weight normal :height 120 :family "courier")))) + (gnus-group-news-2-empty-face ((t (:foreground "CadetBlue4")))) + (gnus-group-news-2-face ((t (:bold t :foreground "CadetBlue4" :weight bold)))) + (gnus-group-news-3-empty-face ((t (nil)))) + (gnus-group-news-3-face ((t (:bold t :weight bold)))) + (gnus-group-news-4-empty-face ((t (nil)))) + (gnus-group-news-4-face ((t (:bold t :weight bold)))) + (gnus-group-news-5-empty-face ((t (nil)))) + (gnus-group-news-5-face ((t (:bold t :weight bold)))) + (gnus-group-news-6-empty-face ((t (nil)))) + (gnus-group-news-6-face ((t (:bold t :weight bold)))) + (gnus-group-news-low-empty-face ((t (:foreground "DarkGreen")))) + (gnus-group-news-low-face ((t (:bold t :foreground "DarkGreen" :weight bold)))) + (gnus-header-content-face ((t (:foreground "goldenrod" :slant normal :family "helvetica")))) + (gnus-header-from-face ((t (:bold t :foreground "grey75" :weight bold :height 140 :family "helvetica")))) + (gnus-header-name-face ((t (:foreground "grey75" :height 120 :family "helvetica")))) + (gnus-header-newsgroups-face ((t (:italic t :foreground "MidnightBlue" :slant italic)))) + (gnus-header-subject-face ((t (:bold t :foreground "firebrick" :weight bold :height 160 :family "helvetica")))) + (gnus-picon-face ((t (:background "white" :foreground "black")))) + (gnus-picon-xbm-face ((t (:background "white" :foreground "black")))) + (gnus-signature-face ((t (:italic t :slant italic)))) + (gnus-splash-face ((t (:foreground "Brown")))) + (gnus-summary-cancelled-face ((t (:background "black" :foreground "yellow")))) + (gnus-summary-high-ancient-face ((t (:bold t :foreground "RoyalBlue" :weight bold)))) + (gnus-summary-high-read-face ((t (:bold t :foreground "DarkGreen" :weight bold)))) + (gnus-summary-high-ticked-face ((t (:bold t :foreground "firebrick" :weight bold)))) + (gnus-summary-high-unread-face ((t (:bold t :weight bold)))) + (gnus-summary-low-ancient-face ((t (:italic t :foreground "RoyalBlue" :slant italic)))) + (gnus-summary-low-read-face ((t (:italic t :foreground "DarkGreen" :slant italic)))) + (gnus-summary-low-ticked-face ((t (:italic t :foreground "firebrick" :slant italic)))) + (gnus-summary-low-unread-face ((t (:italic t :slant italic)))) + (gnus-summary-normal-ancient-face ((t (:foreground "grey65" :height 110 :width condensed :family "neep")))) + (gnus-summary-normal-read-face ((t (:foreground "grey75" :height 110 :width condensed :family "neep")))) + (gnus-summary-normal-ticked-face ((t (:bold t :foreground "firebrick" :weight bold :height 110 :width condensed :family "neep")))) + (gnus-summary-normal-unread-face ((t (:foreground "firebrick" :height 110 :width condensed :family "neep")))) + (gnus-summary-selected-face ((t (:background "gold" :foreground "black" :box (:line-width 1 :color "yellow" :style released-button) :height 140 :width condensed :family "neep")))) + (header-line ((t (:background "grey90" :foreground "grey20" :box nil)))) + (hi-black-b ((t (:bold t :weight bold)))) + (hi-black-hb ((t (:bold t :weight bold :height 1.67 :family "helv")))) + (hi-blue ((t (:background "light blue")))) + (hi-blue-b ((t (:bold t :foreground "blue" :weight bold)))) + (hi-green ((t (:background "green")))) + (hi-green-b ((t (:bold t :foreground "green" :weight bold)))) + (hi-pink ((t (:background "pink")))) + (hi-red-b ((t (:bold t :foreground "red" :weight bold)))) + (hi-yellow ((t (:background "yellow")))) + (highlight ((t (:background "black" :foreground "white")))) + (highlight-changes-delete-face ((t (:foreground "red" :underline t)))) + (highlight-changes-face ((t (:foreground "red")))) + (highline-face ((t (:background "gray80")))) + (holiday-face ((t (:background "pink")))) + (idlwave-help-link-face ((t (:foreground "Blue")))) + (idlwave-shell-bp-face ((t (:background "Pink" :foreground "Black")))) + (info-header-node ((t (:italic t :bold t :foreground "brown" :slant italic :weight bold)))) + (info-header-xref ((t (:bold t :foreground "magenta4" :weight bold)))) + (info-menu-5 ((t (:foreground "red1")))) + (info-menu-header ((t (:bold t :weight bold :family "helv")))) + (info-node ((t (:italic t :bold t :foreground "brown" :slant italic :weight bold)))) + (info-xref ((t (:bold t :foreground "magenta4" :weight bold)))) + (isearch ((t (:background "magenta4" :foreground "lightskyblue1")))) + (isearch-lazy-highlight-face ((t (:background "paleturquoise")))) + (italic ((t (:italic t :slant italic)))) + (log-view-file-face ((t (:bold t :background "grey70" :weight bold)))) + (log-view-message-face ((t (:background "grey85")))) + (makefile-space-face ((t (:background "hotpink")))) + (menu ((t (nil)))) + (message-cited-text-face ((t (:foreground "red")))) + (message-header-cc-face ((t (:foreground "grey45" :weight normal :family "helvetica")))) + (message-header-name-face ((t (:foreground "cornflower blue")))) + (message-header-newsgroups-face ((t (:italic t :bold t :foreground "blue4" :slant italic :weight bold)))) + (message-header-other-face ((t (:foreground "steel blue")))) + (message-header-subject-face ((t (:bold t :foreground "navy blue" :weight bold)))) + (message-header-to-face ((t (:bold t :foreground "grey60" :weight bold :height 120 :family "helvetica")))) + (message-header-xheader-face ((t (:foreground "blue")))) + (message-mml-face ((t (:foreground "ForestGreen")))) + (message-separator-face ((t (:foreground "brown")))) + (mode-line ((t (:background "grey90" :foreground "black" :box (:line-width 1 :style none) :width condensed :family "neep")))) + (modeline-buffer-id ((t (:bold t :background "grey75" :foreground "black" :box (:line-width -1 :style released-button) :weight bold)))) + (modeline-mousable ((t (:background "grey75" :foreground "black" :box (:line-width -1 :style released-button))))) + (modeline-mousable-minor-mode ((t (:background "grey75" :foreground "black" :box (:line-width -1 :style released-button))))) + (mouse ((t (:background "black")))) + (mpg123-face-cur ((t (:background "#004080" :foreground "yellow")))) + (mpg123-face-slider ((t (:background "yellow" :foreground "black")))) + (primary-selection ((t (:background "lightgoldenrod2")))) + (reb-match-0 ((t (:background "lightblue")))) + (reb-match-1 ((t (:background "aquamarine")))) + (reb-match-2 ((t (:background "springgreen")))) + (reb-match-3 ((t (:background "yellow")))) + (region ((t (:background "#aa0000" :foreground "white")))) + (scroll-bar ((t (:background "grey75")))) + (secondary-selection ((t (:background "yellow")))) + (sgml-comment-face ((t (:italic t :foreground "SeaGreen" :slant italic)))) + (sgml-doctype-face ((t (:bold t :foreground "FireBrick" :weight bold)))) + (sgml-end-tag-face ((t (:stipple nil :background "white" :foreground "SlateBlue" :inverse-video nil :box nil :strike-through nil :overline nil :underline nil :slant normal :weight normal :height 116 :width normal :family "monotype-courier new")))) + (sgml-entity-face ((t (:stipple nil :background "SlateBlue" :foreground "Red" :inverse-video nil :box nil :strike-through nil :overline nil :underline nil :slant normal :weight normal :height 116 :width normal :family "monotype-courier new")))) + (sgml-ignored-face ((t (nil)))) + (sgml-ms-end-face ((t (nil)))) + (sgml-ms-start-face ((t (nil)))) + (sgml-pi-face ((t (:bold t :foreground "gray40" :weight bold)))) + (sgml-sgml-face ((t (:bold t :foreground "gray40" :weight bold)))) + (sgml-short-ref-face ((t (nil)))) + (sgml-shortref-face ((t (:bold t :foreground "gray40" :weight bold)))) + (sgml-start-tag-face ((t (:stipple nil :background "white" :foreground "SlateBlue" :inverse-video nil :box nil :strike-through nil :overline nil :underline nil :slant normal :weight normal :height 116 :width normal :family "monotype-courier new")))) + (sh-heredoc-face ((t (:foreground "tan")))) + (show-paren-match-face ((t (:background "gray80" :foreground "black")))) + (show-paren-mismatch-face ((t (:background "red" :foreground "yellow")))) + (show-tabs-space-face ((t (:foreground "yellow")))) + (show-tabs-tab-face ((t (:foreground "red")))) + (smerge-base-face ((t (:foreground "red")))) + (smerge-markers-face ((t (:background "grey85")))) + (smerge-mine-face ((t (:foreground "blue")))) + (smerge-other-face ((t (:foreground "darkgreen")))) + (speedbar-button-face ((t (:foreground "green4")))) + (speedbar-directory-face ((t (:foreground "blue4")))) + (speedbar-file-face ((t (:foreground "cyan4")))) + (speedbar-highlight-face ((t (:background "green")))) + (speedbar-selected-face ((t (:foreground "red" :underline t)))) + (speedbar-tag-face ((t (:foreground "brown")))) + (strokes-char-face ((t (:background "lightgray")))) + (term-black ((t (:stipple nil :background "white" :foreground "black" :inverse-video nil :box nil :strike-through nil :overline nil :underline nil :slant normal :weight normal :width normal :family "adobe-courier")))) + (term-blackbg ((t (:stipple nil :background "black" :foreground "black" :inverse-video nil :box nil :strike-through nil :overline nil :underline nil :slant normal :weight normal :width normal :family "adobe-courier")))) + (term-blue ((t (:stipple nil :background "white" :foreground "blue" :inverse-video nil :box nil :strike-through nil :overline nil :underline nil :slant normal :weight normal :width normal :family "adobe-courier")))) + (term-bluebg ((t (:stipple nil :background "blue" :foreground "black" :inverse-video nil :box nil :strike-through nil :overline nil :underline nil :slant normal :weight normal :width normal :family "adobe-courier")))) + (term-bold ((t (:bold t :stipple nil :background "white" :foreground "black" :inverse-video nil :box nil :strike-through nil :overline nil :underline nil :slant normal :weight bold :width normal :family "adobe-courier")))) + (term-cyan ((t (:stipple nil :background "white" :foreground "cyan" :inverse-video nil :box nil :strike-through nil :overline nil :underline nil :slant normal :weight normal :width normal :family "adobe-courier")))) + (term-cyanbg ((t (:stipple nil :background "cyan" :foreground "black" :inverse-video nil :box nil :strike-through nil :overline nil :underline nil :slant normal :weight normal :width normal :family "adobe-courier")))) + (term-default ((t (:stipple nil :background "white" :foreground "black" :inverse-video nil :box nil :strike-through nil :overline nil :underline nil :slant normal :weight normal :width normal :family "adobe-courier")))) + (term-default-bg ((t (:stipple nil :foreground "black" :inverse-video nil :box nil :strike-through nil :overline nil :underline nil :slant normal :weight normal :width normal :family "adobe-courier")))) + (term-default-bg-inv ((t (:stipple nil :foreground "black" :inverse-video nil :box nil :strike-through nil :overline nil :underline nil :slant normal :weight normal :width normal :family "adobe-courier")))) + (term-default-fg ((t (:stipple nil :background "white" :inverse-video nil :box nil :strike-through nil :overline nil :underline nil :slant normal :weight normal :width normal :family "adobe-courier")))) + (term-default-fg-inv ((t (:stipple nil :background "white" :inverse-video nil :box nil :strike-through nil :overline nil :underline nil :slant normal :weight normal :width normal :family "adobe-courier")))) + (term-green ((t (:stipple nil :background "white" :foreground "green" :inverse-video nil :box nil :strike-through nil :overline nil :underline nil :slant normal :weight normal :width normal :family "adobe-courier")))) + (term-greenbg ((t (:stipple nil :background "green" :foreground "black" :inverse-video nil :box nil :strike-through nil :overline nil :underline nil :slant normal :weight normal :width normal :family "adobe-courier")))) + (term-invisible ((t (:stipple nil :foreground "black" :inverse-video nil :box nil :strike-through nil :overline nil :underline nil :slant normal :weight normal :width normal :family "adobe-courier")))) + (term-invisible-inv ((t (:stipple nil :foreground "black" :inverse-video nil :box nil :strike-through nil :overline nil :underline nil :slant normal :weight normal :width normal :family "adobe-courier")))) + (term-magenta ((t (:stipple nil :background "white" :foreground "magenta" :inverse-video nil :box nil :strike-through nil :overline nil :underline nil :slant normal :weight normal :width normal :family "adobe-courier")))) + (term-magentabg ((t (:stipple nil :background "magenta" :foreground "black" :inverse-video nil :box nil :strike-through nil :overline nil :underline nil :slant normal :weight normal :width normal :family "adobe-courier")))) + (term-red ((t (:stipple nil :background "white" :foreground "red" :inverse-video nil :box nil :strike-through nil :overline nil :underline nil :slant normal :weight normal :width normal :family "adobe-courier")))) + (term-redbg ((t (:stipple nil :background "red" :foreground "black" :inverse-video nil :box nil :strike-through nil :overline nil :underline nil :slant normal :weight normal :width normal :family "adobe-courier")))) + (term-underline ((t (:stipple nil :background "white" :foreground "black" :inverse-video nil :box nil :strike-through nil :overline nil :underline t :slant normal :weight normal :width normal :family "adobe-courier")))) + (term-white ((t (:stipple nil :background "white" :foreground "white" :inverse-video nil :box nil :strike-through nil :overline nil :underline nil :slant normal :weight normal :width normal :family "adobe-courier")))) + (term-whitebg ((t (:stipple nil :background "white" :foreground "black" :inverse-video nil :box nil :strike-through nil :overline nil :underline nil :slant normal :weight normal :width normal :family "adobe-courier")))) + (term-yellow ((t (:stipple nil :background "white" :foreground "yellow" :inverse-video nil :box nil :strike-through nil :overline nil :underline nil :slant normal :weight normal :width normal :family "adobe-courier")))) + (term-yellowbg ((t (:stipple nil :background "yellow" :foreground "black" :inverse-video nil :box nil :strike-through nil :overline nil :underline nil :slant normal :weight normal :width normal :family "adobe-courier")))) + (tex-math-face ((t (:foreground "RosyBrown")))) + (texinfo-heading-face ((t (:foreground "Blue")))) + (tool-bar ((t (:background "grey75" :foreground "black" :box (:line-width 1 :style released-button))))) + (tooltip ((t (:background "lightyellow" :foreground "black")))) + (trailing-whitespace ((t (:background "red")))) + (underline ((t (:foreground "navy" :underline t)))) + (variable-pitch ((t (:family "helv")))) + (vcursor ((t (:background "cyan" :foreground "blue" :underline t)))) + (vhdl-font-lock-attribute-face ((t (:foreground "Orchid")))) + (vhdl-font-lock-directive-face ((t (:foreground "CadetBlue")))) + (vhdl-font-lock-enumvalue-face ((t (:foreground "Gold4")))) + (vhdl-font-lock-function-face ((t (:foreground "Orchid4")))) + (vhdl-font-lock-prompt-face ((t (:bold t :foreground "Red" :weight bold)))) + (vhdl-font-lock-reserved-words-face ((t (:bold t :foreground "Orange" :weight bold)))) + (vhdl-font-lock-translate-off-face ((t (:background "LightGray")))) + (vhdl-speedbar-architecture-face ((t (:foreground "Blue")))) + (vhdl-speedbar-architecture-selected-face ((t (:foreground "Blue" :underline t)))) + (vhdl-speedbar-configuration-face ((t (:foreground "DarkGoldenrod")))) + (vhdl-speedbar-configuration-selected-face ((t (:foreground "DarkGoldenrod" :underline t)))) + (vhdl-speedbar-entity-face ((t (:foreground "ForestGreen")))) + (vhdl-speedbar-entity-selected-face ((t (:foreground "ForestGreen" :underline t)))) + (vhdl-speedbar-instantiation-face ((t (:foreground "Brown")))) + (vhdl-speedbar-instantiation-selected-face ((t (:foreground "Brown" :underline t)))) + (vhdl-speedbar-package-face ((t (:foreground "Grey50")))) + (vhdl-speedbar-package-selected-face ((t (:foreground "Grey50" :underline t)))) + (viper-minibuffer-emacs-face ((t (:background "darkseagreen2" :foreground "Black")))) + (viper-minibuffer-insert-face ((t (:background "pink" :foreground "Black")))) + (viper-minibuffer-vi-face ((t (:background "grey" :foreground "DarkGreen")))) + (viper-replace-overlay-face ((t (:background "darkseagreen2" :foreground "Black")))) + (viper-search-face ((t (:background "khaki" :foreground "Black")))) + (widget-button-face ((t (:bold t :weight bold)))) + (widget-button-pressed-face ((t (:foreground "red")))) + (widget-documentation-face ((t (:foreground "dark green")))) + (widget-field-face ((t (:background "gray85")))) + (widget-inactive-face ((t (:foreground "dim gray")))) + (widget-single-line-field-face ((t (:background "gray85")))) + (woman-addition-face ((t (:foreground "orange")))) + (woman-bold-face ((t (:bold t :foreground "blue" :weight bold)))) + (woman-italic-face ((t (:italic t :foreground "red" :underline t :slant italic)))) + (woman-unknown-face ((t (:foreground "brown")))) + (zmacs-region ((t (:background "lightgoldenrod2"))))))) + +(defun color-theme-bharadwaj-slate () + "Color theme by Girish Bharadwaj, created 2002-05-06." + (interactive) + (color-theme-install + '(color-theme-bharadwaj-slate + ((background-color . "DarkSlateGray") + (background-mode . dark) + (border-color . "black") + (cursor-color . "khaki") + (foreground-color . "palegreen") + (mouse-color . "black")) + ((display-time-mail-face . mode-line) + (gnus-article-button-face . bold) + (gnus-article-mouse-face . highlight) + (gnus-mouse-face . highlight) + (help-highlight-face . underline) + (ibuffer-deletion-face . font-lock-type-face) + (ibuffer-filter-group-name-face . bold) + (ibuffer-marked-face . font-lock-warning-face) + (ibuffer-title-face . font-lock-type-face) + (list-matching-lines-buffer-name-face . underline) + (list-matching-lines-face . bold) + (semantic-which-function-use-color . t) + (senator-eldoc-use-color . t) + (view-highlight-face . highlight) + (widget-mouse-face . highlight)) + (default ((t (:stipple nil :background "DarkSlateGray" :foreground "palegreen" :inverse-video nil :box nil :strike-through nil :overline nil :underline nil :slant normal :weight normal :width normal :family "outline-lucida sans typewriter")))) + (bg:erc-color-face0 ((t (:background "White")))) + (bg:erc-color-face1 ((t (:background "black")))) + (bg:erc-color-face10 ((t (:background "lightblue1")))) + (bg:erc-color-face11 ((t (:background "cyan")))) + (bg:erc-color-face12 ((t (:background "blue")))) + (bg:erc-color-face13 ((t (:background "deeppink")))) + (bg:erc-color-face14 ((t (:background "gray50")))) + (bg:erc-color-face15 ((t (:background "gray90")))) + (bg:erc-color-face2 ((t (:background "blue4")))) + (bg:erc-color-face3 ((t (:background "green4")))) + (bg:erc-color-face4 ((t (:background "red")))) + (bg:erc-color-face5 ((t (:background "brown")))) + (bg:erc-color-face6 ((t (:background "purple")))) + (bg:erc-color-face7 ((t (:background "orange")))) + (bg:erc-color-face8 ((t (:background "yellow")))) + (bg:erc-color-face9 ((t (:background "green")))) + (bold ((t (:bold t :weight bold)))) + (bold-italic ((t (:italic t :bold t :slant italic :weight bold)))) + (border ((t (:background "black")))) + (button ((t (:underline t)))) + (comint-highlight-input ((t (:bold t :weight bold)))) + (comint-highlight-prompt ((t (:foreground "cyan")))) + (cursor ((t (:background "khaki")))) + (custom-button-face ((t (:background "lightgrey" :foreground "black" :box (:line-width 2 :style released-button))))) + (custom-button-pressed-face ((t (:background "lightgrey" :foreground "black" :box (:line-width 2 :style pressed-button))))) + (custom-changed-face ((t (:background "blue" :foreground "white")))) + (custom-comment-face ((t (:background "dim gray")))) + (custom-comment-tag-face ((t (:foreground "gray80")))) + (custom-documentation-face ((t (nil)))) + (custom-face-tag-face ((t (:bold t :family "helv" :weight bold :height 1.2)))) + (custom-group-tag-face ((t (:bold t :foreground "light blue" :weight bold :height 1.2)))) + (custom-group-tag-face-1 ((t (:bold t :family "helv" :foreground "pink" :weight bold :height 1.2)))) + (custom-invalid-face ((t (:background "red" :foreground "yellow")))) + (custom-modified-face ((t (:background "blue" :foreground "white")))) + (custom-rogue-face ((t (:background "black" :foreground "pink")))) + (custom-saved-face ((t (:underline t)))) + (custom-set-face ((t (:background "white" :foreground "blue")))) + (custom-state-face ((t (:foreground "lime green")))) + (custom-variable-button-face ((t (:bold t :underline t :weight bold)))) + (custom-variable-tag-face ((t (:bold t :family "helv" :foreground "light blue" :weight bold :height 1.2)))) + (erc-action-face ((t (:bold t :box (:line-width 2 :color "grey75") :weight bold)))) + (erc-bold-face ((t (:bold t :weight bold)))) + (erc-default-face ((t (nil)))) + (erc-direct-msg-face ((t (:foreground "IndianRed")))) + (erc-error-face ((t (:background "Red" :foreground "White")))) + (erc-input-face ((t (:foreground "lightblue")))) + (erc-inverse-face ((t (:background "Black" :foreground "White")))) + (erc-notice-face ((t (:bold t :foreground "dodgerblue" :weight bold)))) + (erc-prompt-face ((t (:bold t :background "black" :foreground "white" :weight bold)))) + (erc-timestamp-face ((t (:bold t :foreground "green" :weight bold)))) + (erc-underline-face ((t (:underline t)))) + (eshell-ls-archive-face ((t (:bold t :foreground "Orchid" :weight bold)))) + (eshell-ls-backup-face ((t (:foreground "LightSalmon")))) + (eshell-ls-clutter-face ((t (:bold t :foreground "OrangeRed" :weight bold)))) + (eshell-ls-directory-face ((t (:bold t :foreground "SkyBlue" :weight bold)))) + (eshell-ls-executable-face ((t (:bold t :foreground "Green" :weight bold)))) + (eshell-ls-missing-face ((t (:bold t :foreground "Red" :weight bold)))) + (eshell-ls-product-face ((t (:foreground "LightSalmon")))) + (eshell-ls-readonly-face ((t (:foreground "Pink")))) + (eshell-ls-special-face ((t (:bold t :foreground "Magenta" :weight bold)))) + (eshell-ls-symlink-face ((t (:bold t :foreground "Cyan" :weight bold)))) + (eshell-ls-unreadable-face ((t (:foreground "DarkGrey")))) + (eshell-prompt-face ((t (:bold t :foreground "Pink" :weight bold)))) + (fg:erc-color-face0 ((t (:foreground "White")))) + (fg:erc-color-face1 ((t (:foreground "black")))) + (fg:erc-color-face10 ((t (:foreground "lightblue1")))) + (fg:erc-color-face11 ((t (:foreground "cyan")))) + (fg:erc-color-face12 ((t (:foreground "blue")))) + (fg:erc-color-face13 ((t (:foreground "deeppink")))) + (fg:erc-color-face14 ((t (:foreground "gray50")))) + (fg:erc-color-face15 ((t (:foreground "gray90")))) + (fg:erc-color-face2 ((t (:foreground "blue4")))) + (fg:erc-color-face3 ((t (:foreground "green4")))) + (fg:erc-color-face4 ((t (:foreground "red")))) + (fg:erc-color-face5 ((t (:foreground "brown")))) + (fg:erc-color-face6 ((t (:foreground "purple")))) + (fg:erc-color-face7 ((t (:foreground "orange")))) + (fg:erc-color-face8 ((t (:foreground "yellow")))) + (fg:erc-color-face9 ((t (:foreground "green")))) + (fixed-pitch ((t (:family "courier")))) + (font-lock-builtin-face ((t (:bold t :foreground "pink" :weight bold :height 1.1)))) + (font-lock-comment-face ((t (:foreground "violet" :height 1.0)))) + (font-lock-constant-face ((t (:bold t :foreground "tomato" :weight bold :height 1.0)))) + (font-lock-function-name-face ((t (:bold t :foreground "DodgerBlue" :weight bold)))) + (font-lock-keyword-face ((t (:bold t :foreground "turquoise" :weight bold)))) + (font-lock-preprocessor-face ((t (:bold t :foreground "tomato" :weight bold :height 1.0)))) + (font-lock-reference-face ((t (:bold t :foreground "pink" :weight bold :height 1.1)))) + (font-lock-string-face ((t (:foreground "red" :height 1.0)))) + (font-lock-type-face ((t (:foreground "lightblue3")))) + (font-lock-variable-name-face ((t (:bold t :foreground "gray" :weight bold :height 1.0)))) + (font-lock-warning-face ((t (:bold t :foreground "Pink" :weight bold)))) + (fringe ((t (:background "DarkSlateGray")))) + (gnus-cite-attribution-face ((t (:italic t :slant italic)))) + (gnus-cite-face-1 ((t (:foreground "light blue")))) + (gnus-cite-face-10 ((t (:foreground "medium purple")))) + (gnus-cite-face-11 ((t (:foreground "turquoise")))) + (gnus-cite-face-2 ((t (:foreground "light cyan")))) + (gnus-cite-face-3 ((t (:foreground "light yellow")))) + (gnus-cite-face-4 ((t (:foreground "light pink")))) + (gnus-cite-face-5 ((t (:foreground "pale green")))) + (gnus-cite-face-6 ((t (:foreground "beige")))) + (gnus-cite-face-7 ((t (:foreground "orange")))) + (gnus-cite-face-8 ((t (:foreground "magenta")))) + (gnus-cite-face-9 ((t (:foreground "violet")))) + (gnus-emphasis-bold ((t (:bold t :weight bold)))) + (gnus-emphasis-bold-italic ((t (:italic t :bold t :slant italic :weight bold)))) + (gnus-emphasis-highlight-words ((t (:background "black" :foreground "yellow")))) + (gnus-emphasis-italic ((t (:italic t :slant italic)))) + (gnus-emphasis-underline ((t (:underline t)))) + (gnus-emphasis-underline-bold ((t (:bold t :underline t :weight bold)))) + (gnus-emphasis-underline-bold-italic ((t (:italic t :bold t :underline t :slant italic :weight bold)))) + (gnus-emphasis-underline-italic ((t (:italic t :underline t :slant italic)))) + (gnus-group-mail-1-empty-face ((t (:foreground "aquamarine1")))) + (gnus-group-mail-1-face ((t (:bold t :foreground "aquamarine1" :weight bold)))) + (gnus-group-mail-2-empty-face ((t (:foreground "aquamarine2")))) + (gnus-group-mail-2-face ((t (:bold t :foreground "aquamarine2" :weight bold)))) + (gnus-group-mail-3-empty-face ((t (:foreground "aquamarine3")))) + (gnus-group-mail-3-face ((t (:bold t :foreground "aquamarine3" :weight bold)))) + (gnus-group-mail-low-empty-face ((t (:foreground "aquamarine4")))) + (gnus-group-mail-low-face ((t (:bold t :foreground "aquamarine4" :weight bold)))) + (gnus-group-news-1-empty-face ((t (:foreground "PaleTurquoise")))) + (gnus-group-news-1-face ((t (:bold t :foreground "PaleTurquoise" :weight bold)))) + (gnus-group-news-2-empty-face ((t (:foreground "turquoise")))) + (gnus-group-news-2-face ((t (:bold t :foreground "turquoise" :weight bold)))) + (gnus-group-news-3-empty-face ((t (nil)))) + (gnus-group-news-3-face ((t (:bold t :weight bold)))) + (gnus-group-news-4-empty-face ((t (nil)))) + (gnus-group-news-4-face ((t (:bold t :weight bold)))) + (gnus-group-news-5-empty-face ((t (nil)))) + (gnus-group-news-5-face ((t (:bold t :weight bold)))) + (gnus-group-news-6-empty-face ((t (nil)))) + (gnus-group-news-6-face ((t (:bold t :weight bold)))) + (gnus-group-news-low-empty-face ((t (:foreground "DarkTurquoise")))) + (gnus-group-news-low-face ((t (:bold t :foreground "DarkTurquoise" :weight bold)))) + (gnus-header-content-face ((t (:italic t :foreground "forest green" :slant italic)))) + (gnus-header-from-face ((t (:foreground "spring green")))) + (gnus-header-name-face ((t (:foreground "SeaGreen")))) + (gnus-header-newsgroups-face ((t (:italic t :foreground "yellow" :slant italic)))) + (gnus-header-subject-face ((t (:foreground "SeaGreen3")))) + (gnus-signature-face ((t (:italic t :slant italic)))) + (gnus-splash-face ((t (:foreground "Brown")))) + (gnus-summary-cancelled-face ((t (:background "black" :foreground "yellow")))) + (gnus-summary-high-ancient-face ((t (:bold t :foreground "SkyBlue" :weight bold)))) + (gnus-summary-high-read-face ((t (:bold t :foreground "PaleGreen" :weight bold)))) + (gnus-summary-high-ticked-face ((t (:bold t :foreground "pink" :weight bold)))) + (gnus-summary-high-unread-face ((t (:bold t :weight bold)))) + (gnus-summary-low-ancient-face ((t (:italic t :foreground "SkyBlue" :slant italic)))) + (gnus-summary-low-read-face ((t (:italic t :foreground "PaleGreen" :slant italic)))) + (gnus-summary-low-ticked-face ((t (:italic t :foreground "pink" :slant italic)))) + (gnus-summary-low-unread-face ((t (:italic t :slant italic)))) + (gnus-summary-normal-ancient-face ((t (:foreground "SkyBlue")))) + (gnus-summary-normal-read-face ((t (:foreground "PaleGreen")))) + (gnus-summary-normal-ticked-face ((t (:foreground "pink")))) + (gnus-summary-normal-unread-face ((t (nil)))) + (gnus-summary-selected-face ((t (:underline t)))) + (header-line ((t (:underline "blueviolet" :overline "blueviolet" :box (:line-width -1 :style released-button) :background "grey20" :foreground "grey90" :box nil)))) + (highlight ((t (:background "darkolivegreen")))) + (html-helper-bold-face ((t (:bold t :foreground "wheat" :weight bold)))) + (html-helper-italic-face ((t (:italic t :foreground "spring green" :slant italic)))) + (html-helper-underline-face ((t (:foreground "cornsilk" :underline t)))) + (html-tag-face ((t (:bold t :foreground "deep sky blue" :weight bold)))) + (info-menu-6 ((t (nil)))) + (isearch ((t (:background "palevioletred2" :foreground "brown4")))) + (isearch-lazy-highlight-face ((t (:background "paleturquoise4")))) + (italic ((t (:italic t :slant italic)))) + (jde-bug-breakpoint-cursor ((t (:background "brown" :foreground "cyan")))) + (jde-db-active-breakpoint-face ((t (:background "red" :foreground "black")))) + (jde-db-requested-breakpoint-face ((t (:background "yellow" :foreground "black")))) + (jde-db-spec-breakpoint-face ((t (:background "green" :foreground "black")))) + (jde-java-font-lock-api-face ((t (:foreground "light goldenrod")))) + (jde-java-font-lock-bold-face ((t (:bold t :weight bold)))) + (jde-java-font-lock-code-face ((t (nil)))) + (jde-java-font-lock-constant-face ((t (:foreground "Aquamarine")))) + (jde-java-font-lock-doc-tag-face ((t (:foreground "light coral")))) + (jde-java-font-lock-italic-face ((t (:italic t :slant italic)))) + (jde-java-font-lock-link-face ((t (:foreground "blue" :underline t :slant normal)))) + (jde-java-font-lock-modifier-face ((t (:foreground "LightSteelBlue")))) + (jde-java-font-lock-number-face ((t (:foreground "LightSalmon")))) + (jde-java-font-lock-operator-face ((t (:foreground "medium blue")))) + (jde-java-font-lock-package-face ((t (:foreground "steelblue1")))) + (jde-java-font-lock-pre-face ((t (nil)))) + (jde-java-font-lock-underline-face ((t (:underline t)))) + (menu ((t (nil)))) + (message-cited-text-face ((t (:foreground "red")))) + (message-header-cc-face ((t (:bold t :foreground "green4" :weight bold)))) + (message-header-name-face ((t (:foreground "DarkGreen")))) + (message-header-newsgroups-face ((t (:italic t :bold t :foreground "yellow" :slant italic :weight bold)))) + (message-header-other-face ((t (:foreground "#b00000")))) + (message-header-subject-face ((t (:foreground "green3")))) + (message-header-to-face ((t (:bold t :foreground "green2" :weight bold)))) + (message-header-xheader-face ((t (:foreground "blue")))) + (message-mml-face ((t (:foreground "ForestGreen")))) + (message-separator-face ((t (:foreground "blue3")))) + (minibuffer-prompt ((t (:foreground "cyan")))) + (mode-line ((t (:background "Darkslategray" :foreground "white" :box (:line-width -1 :style released-button) :overline "blueviolet" :underline "blueviolet")))) + (mode-line-inactive ((t (:italic t :underline "blueviolet" :overline "blueviolet" :background "white" :foreground "cadetblue" :box (:line-width -1 :color "grey75") :slant oblique :weight light)))) + (modeline ((t (:background "Darkslategray" :foreground "white" :box (:line-width -1 :style released-button) :overline "blueviolet" :underline "blueviolet")))) + (modeline-buffer-id ((t (:background "Darkslategray" :foreground "white" :box (:line-width -1 :style released-button) :overline "blueviolet" :underline "blueviolet")))) + (modeline-mousable ((t (:background "Darkslategray" :foreground "white" :box (:line-width -1 :style released-button) :overline "blueviolet" :underline "blueviolet")))) + (modeline-mousable-minor-mode ((t (:background "Darkslategray" :foreground "white" :box (:line-width -1 :style released-button) :overline "blueviolet" :underline "blueviolet")))) + (mouse ((t (:background "black")))) + (primary-selection ((t (:background "dimgray")))) + (region ((t (:background "dimgray")))) + (scroll-bar ((t (nil)))) + (secondary-selection ((t (:background "SkyBlue4")))) + (semantic-dirty-token-face ((t (:background "lightyellow")))) + (semantic-unmatched-syntax-face ((t (:underline "red")))) + (senator-intangible-face ((t (:foreground "gray75")))) + (senator-momentary-highlight-face ((t (:background "gray30")))) + (senator-read-only-face ((t (:background "#664444")))) + (show-paren-match-face ((t (:bold t :foreground "lightblue" :weight bold :height 1.1)))) + (show-paren-mismatch-face ((t (:bold t :foreground "red" :weight bold :height 1.1)))) + (show-tabs-space-face ((t (:foreground "yellow")))) + (show-tabs-tab-face ((t (:foreground "red")))) + (speedbar-button-face ((t (:foreground "green3")))) + (speedbar-directory-face ((t (:foreground "light blue")))) + (speedbar-file-face ((t (:foreground "cyan")))) + (speedbar-highlight-face ((t (:background "sea green")))) + (speedbar-selected-face ((t (:foreground "red" :underline t)))) + (speedbar-tag-face ((t (:foreground "yellow")))) + (template-message-face ((t (:bold t :weight bold)))) + (term-black ((t (:foreground "black")))) + (term-blackbg ((t (:background "black")))) + (term-blue ((t (:foreground "blue")))) + (term-bluebg ((t (:background "blue")))) + (term-bold ((t (:bold t :weight bold)))) + (term-cyan ((t (:foreground "cyan")))) + (term-cyanbg ((t (:background "cyan")))) + (term-default ((t (:stipple nil :background "DarkSlateGray" :foreground "palegreen" :inverse-video nil :box nil :strike-through nil :overline nil :underline nil :slant normal :weight normal :width normal :family "outline-lucida sans typewriter")))) + (term-default-bg ((t (nil)))) + (term-default-bg-inv ((t (nil)))) + (term-default-fg ((t (nil)))) + (term-default-fg-inv ((t (nil)))) + (term-green ((t (:foreground "green")))) + (term-greenbg ((t (:background "green")))) + (term-invisible ((t (nil)))) + (term-invisible-inv ((t (nil)))) + (term-magenta ((t (:foreground "magenta")))) + (term-magentabg ((t (:background "magenta")))) + (term-red ((t (:foreground "red")))) + (term-redbg ((t (:background "red")))) + (term-underline ((t (:underline t)))) + (term-white ((t (:foreground "white")))) + (term-whitebg ((t (:background "white")))) + (term-yellow ((t (:foreground "yellow")))) + (term-yellowbg ((t (:background "yellow")))) + (tool-bar ((t (:background "DarkSlateGray" :foreground "White" :box (:line-width 1 :color "blue"))))) + (tooltip ((t (:background "lightyellow" :foreground "black")))) + (trailing-whitespace ((t (:background "red")))) + (underline ((t (:underline t)))) + (variable-pitch ((t (:family "helv")))) + (widget-button-face ((t (:bold t :weight bold)))) + (widget-button-pressed-face ((t (:foreground "red")))) + (widget-documentation-face ((t (:foreground "lime green")))) + (widget-field-face ((t (:background "dim gray")))) + (widget-inactive-face ((t (:foreground "light gray")))) + (widget-single-line-field-face ((t (:background "dim gray")))) + (zmacs-region ((t (:background "dimgray"))))))) + +(defun color-theme-lethe () + "Color theme by Ivica Loncar, created 2002-08-02. +Some additional X resources as suggested by the author: + +Emacs*menubar.Foreground: Yellow +Emacs*menubar.Background: #1a2b3c +Emacs*menubar.topShadowColor: gray +Emacs*menubar.bottomShadowColor: dimgray + +Some fonts I really like (note: this fonts are not highly +available): + +Emacs.default.attributeFont: -letl-*-medium-r-*-*-*-*-*-*-*-*-iso8859-2 +Emacs*menubar*Font: -etl-fixed-medium-r-normal--14-*-*-*-*-*-iso8859-1 + +Mouse fix: + +Emacs*dialog*XmPushButton.translations:#override\n\ + : Arm()\n\ + ,: Activate()\ + Disarm()\n\ + (2+): MultiArm()\n\ + (2+): MultiActivate()\n\ + : Activate()\ + Disarm()\n\ + osfSelect: ArmAndActivate()\n\ + osfActivate: ArmAndActivate()\n\ + osfHelp: Help()\n\ + ~Shift ~Meta ~Alt Return: ArmAndActivate()\n\ + : Enter()\n\ + : Leave()\n + +Bonus: do not use 3D modeline." + (interactive) + (color-theme-install + '(color-theme-lethe + ((background-color . "black") + (background-mode . dark) + (background-toolbar-color . "#000000000000") + (border-color . "#000000000000") + (bottom-toolbar-shadow-color . "red") + (cursor-color . "red") + (foreground-color . "peachpuff") + (mouse-color . "red") + (top-toolbar-shadow-color . "#f5f5f5f5f5f5")) + ((buffers-tab-face . buffers-tab) + (cscope-use-face . t) + (gnus-mouse-face . highlight)) + (default ((t (nil)))) + (bg:erc-color-face0 ((t (:background "White")))) + (bg:erc-color-face1 ((t (nil)))) + (bg:erc-color-face10 ((t (:background "lightblue1")))) + (bg:erc-color-face11 ((t (:background "cyan")))) + (bg:erc-color-face12 ((t (:background "blue")))) + (bg:erc-color-face13 ((t (:background "deeppink")))) + (bg:erc-color-face14 ((t (:background "gray50")))) + (bg:erc-color-face15 ((t (:background "gray90")))) + (bg:erc-color-face2 ((t (:background "blue4")))) + (bg:erc-color-face3 ((t (:background "green4")))) + (bg:erc-color-face4 ((t (:background "red")))) + (bg:erc-color-face5 ((t (:background "brown")))) + (bg:erc-color-face6 ((t (:background "purple")))) + (bg:erc-color-face7 ((t (:background "orange")))) + (bg:erc-color-face8 ((t (:background "yellow")))) + (bg:erc-color-face9 ((t (:background "green")))) + (blue ((t (:foreground "blue")))) + (bold ((t (:bold t)))) + (bold-italic ((t (:italic t :bold t)))) + (border ((t (nil)))) + (border-glyph ((t (nil)))) + (buffers-tab ((t (:bold t :foreground "red")))) + (button ((t (:underline t)))) + (calendar-today-face ((t (:underline t)))) + (comint-highlight-input ((t (:bold t)))) + (comint-highlight-prompt ((t (:foreground "cyan")))) + (cperl-array-face ((t (:bold t :background "lightyellow2" :foreground "Blue")))) + (cperl-hash-face ((t (:italic t :bold t :background "lightyellow2" :foreground "Red")))) + (cperl-nonoverridable-face ((t (:foreground "chartreuse3")))) + (cscope-file-face ((t (:foreground "blue")))) + (cscope-function-face ((t (:foreground "magenta")))) + (cscope-line-face ((t (:foreground "green")))) + (cscope-line-number-face ((t (:foreground "red")))) + (cscope-mouse-face ((t (:background "blue" :foreground "white")))) + (cursor ((t (nil)))) + (custom-button-face ((t (nil)))) + (custom-button-pressed-face ((t (:background "lightgrey" :foreground "black")))) + (custom-changed-face ((t (:background "blue" :foreground "white")))) + (custom-comment-face ((t (:background "dim gray")))) + (custom-comment-tag-face ((t (:foreground "gray80")))) + (custom-documentation-face ((t (nil)))) + (custom-face-tag-face ((t (:underline t)))) + (custom-group-tag-face ((t (:underline t :foreground "blue")))) + (custom-group-tag-face-1 ((t (:underline t :foreground "red")))) + (custom-invalid-face ((t (:background "red" :foreground "yellow")))) + (custom-modified-face ((t (:background "blue" :foreground "white")))) + (custom-rogue-face ((t (:foreground "pink")))) + (custom-saved-face ((t (:underline t)))) + (custom-set-face ((t (:background "white" :foreground "blue")))) + (custom-state-face ((t (:foreground "dark green")))) + (custom-variable-button-face ((t (:underline t :bold t)))) + (custom-variable-tag-face ((t (:underline t :foreground "blue")))) + (cyan ((t (:foreground "cyan")))) + (diary-face ((t (:foreground "red")))) + (dired-face-boring ((t (:foreground "Gray65")))) + (dired-face-directory ((t (:bold t)))) + (dired-face-executable ((t (:foreground "SeaGreen")))) + (dired-face-flagged ((t (:background "LightSlateGray")))) + (dired-face-marked ((t (:background "PaleVioletRed")))) + (dired-face-permissions ((t (:background "grey75" :foreground "black")))) + (dired-face-setuid ((t (:foreground "Red")))) + (dired-face-socket ((t (:foreground "magenta")))) + (dired-face-symlink ((t (:foreground "cyan")))) + (display-time-mail-balloon-enhance-face ((t (:background "orange")))) + (display-time-mail-balloon-gnus-group-face ((t (:foreground "blue")))) + (display-time-time-balloon-face ((t (:foreground "red")))) + (ediff-current-diff-face-A ((t (:background "pale green" :foreground "firebrick")))) + (ediff-current-diff-face-Ancestor ((t (:background "VioletRed" :foreground "Black")))) + (ediff-current-diff-face-B ((t (:background "Yellow" :foreground "DarkOrchid")))) + (ediff-current-diff-face-C ((t (:background "Pink" :foreground "Navy")))) + (ediff-even-diff-face-A ((t (:background "light grey" :foreground "Black")))) + (ediff-even-diff-face-Ancestor ((t (:background "Grey" :foreground "White")))) + (ediff-even-diff-face-B ((t (:background "Grey" :foreground "White")))) + (ediff-even-diff-face-C ((t (:background "light grey" :foreground "Black")))) + (ediff-fine-diff-face-A ((t (:background "sky blue" :foreground "Navy")))) + (ediff-fine-diff-face-Ancestor ((t (:background "Green" :foreground "Black")))) + (ediff-fine-diff-face-B ((t (:background "cyan" :foreground "Black")))) + (ediff-fine-diff-face-C ((t (:background "Turquoise" :foreground "Black")))) + (ediff-odd-diff-face-A ((t (:background "Grey" :foreground "White")))) + (ediff-odd-diff-face-Ancestor ((t (:background "light grey" :foreground "Black")))) + (ediff-odd-diff-face-B ((t (:background "light grey" :foreground "Black")))) + (ediff-odd-diff-face-C ((t (:background "Grey" :foreground "White")))) + (erc-action-face ((t (:bold t)))) + (erc-bold-face ((t (:bold t)))) + (erc-default-face ((t (nil)))) + (erc-direct-msg-face ((t (:foreground "IndianRed")))) + (erc-error-face ((t (:background "Red" :foreground "White")))) + (erc-input-face ((t (:foreground "brown")))) + (erc-inverse-face ((t (:background "Black" :foreground "White")))) + (erc-notice-face ((t (:bold t :foreground "SlateBlue")))) + (erc-prompt-face ((t (:bold t :background "lightBlue2" :foreground "Black")))) + (erc-timestamp-face ((t (:bold t :foreground "green")))) + (erc-underline-face ((t (:underline t)))) + (eshell-ls-archive-face ((t (:bold t :foreground "Orchid")))) + (eshell-ls-backup-face ((t (:foreground "OrangeRed")))) + (eshell-ls-clutter-face ((t (:bold t :foreground "OrangeRed")))) + (eshell-ls-directory-face ((t (:bold t :foreground "Blue")))) + (eshell-ls-executable-face ((t (:bold t :foreground "ForestGreen")))) + (eshell-ls-missing-face ((t (:bold t :foreground "Red")))) + (eshell-ls-product-face ((t (:foreground "OrangeRed")))) + (eshell-ls-readonly-face ((t (:foreground "Brown")))) + (eshell-ls-special-face ((t (:bold t :foreground "Magenta")))) + (eshell-ls-symlink-face ((t (:bold t :foreground "DarkCyan")))) + (eshell-ls-unreadable-face ((t (:foreground "Grey30")))) + (eshell-prompt-face ((t (:bold t :foreground "Red")))) + (eshell-test-failed-face ((t (:bold t :foreground "OrangeRed")))) + (eshell-test-ok-face ((t (:bold t :foreground "Green")))) + (excerpt ((t (:italic t)))) + (fg:erc-color-face0 ((t (:foreground "White")))) + (fg:erc-color-face1 ((t (:foreground "black")))) + (fg:erc-color-face10 ((t (:foreground "lightblue1")))) + (fg:erc-color-face11 ((t (:foreground "cyan")))) + (fg:erc-color-face12 ((t (:foreground "blue")))) + (fg:erc-color-face13 ((t (:foreground "deeppink")))) + (fg:erc-color-face14 ((t (:foreground "gray50")))) + (fg:erc-color-face15 ((t (:foreground "gray90")))) + (fg:erc-color-face2 ((t (:foreground "blue4")))) + (fg:erc-color-face3 ((t (:foreground "green4")))) + (fg:erc-color-face4 ((t (:foreground "red")))) + (fg:erc-color-face5 ((t (:foreground "brown")))) + (fg:erc-color-face6 ((t (:foreground "purple")))) + (fg:erc-color-face7 ((t (:foreground "orange")))) + (fg:erc-color-face8 ((t (:foreground "yellow")))) + (fg:erc-color-face9 ((t (:foreground "green")))) + (fixed ((t (:bold t)))) + (fixed-pitch ((t (:size "16")))) + (flyspell-duplicate-face ((t (:underline t :bold t :foreground "Gold3")))) + (flyspell-incorrect-face ((t (:underline t :bold t :foreground "OrangeRed")))) + (font-lock-builtin-face ((t (:foreground "Orchid")))) + (font-lock-comment-face ((t (:bold t :foreground "cyan")))) + (font-lock-constant-face ((t (:foreground "CadetBlue")))) + (font-lock-doc-face ((t (:bold t :foreground "red")))) + (font-lock-doc-string-face ((t (:bold t :foreground "red")))) + (font-lock-function-name-face ((t (:bold t :foreground "white")))) + (font-lock-keyword-face ((t (:bold t :foreground "yellow")))) + (font-lock-preprocessor-face ((t (:bold t :foreground "blue")))) + (font-lock-reference-face ((t (:foreground "red3")))) + (font-lock-string-face ((t (:bold t :foreground "magenta")))) + (font-lock-type-face ((t (:bold t :foreground "lightgreen")))) + (font-lock-variable-name-face ((t (:bold t :foreground "white")))) + (font-lock-warning-face ((t (:bold t :foreground "Red")))) + (fringe ((t (:background "grey95")))) + (gdb-arrow-face ((t (:bold t :background "yellow" :foreground "red")))) + (gnus-cite-attribution-face ((t (:italic t)))) + (gnus-cite-face-1 ((t (:foreground "MidnightBlue")))) + (gnus-cite-face-10 ((t (:foreground "medium purple")))) + (gnus-cite-face-11 ((t (:foreground "turquoise")))) + (gnus-cite-face-2 ((t (:foreground "firebrick")))) + (gnus-cite-face-3 ((t (:foreground "dark green")))) + (gnus-cite-face-4 ((t (:foreground "OrangeRed")))) + (gnus-cite-face-5 ((t (:foreground "dark khaki")))) + (gnus-cite-face-6 ((t (:foreground "dark violet")))) + (gnus-cite-face-7 ((t (:foreground "SteelBlue4")))) + (gnus-cite-face-8 ((t (:foreground "magenta")))) + (gnus-cite-face-9 ((t (:foreground "violet")))) + (gnus-emphasis-bold ((t (:bold t)))) + (gnus-emphasis-bold-italic ((t (:italic t :bold t)))) + (gnus-emphasis-highlight-words ((t (:foreground "yellow")))) + (gnus-emphasis-italic ((t (:italic t)))) + (gnus-emphasis-underline ((t (:underline t)))) + (gnus-emphasis-underline-bold ((t (:underline t :bold t)))) + (gnus-emphasis-underline-bold-italic ((t (:underline t :italic t :bold t)))) + (gnus-emphasis-underline-italic ((t (:underline t :italic t)))) + (gnus-group-mail-1-empty-face ((t (:foreground "DeepPink3")))) + (gnus-group-mail-1-face ((t (:bold t :foreground "DeepPink3")))) + (gnus-group-mail-2-empty-face ((t (:foreground "HotPink3")))) + (gnus-group-mail-2-face ((t (:bold t :foreground "HotPink3")))) + (gnus-group-mail-3-empty-face ((t (:foreground "magenta4")))) + (gnus-group-mail-3-face ((t (:bold t :foreground "magenta4")))) + (gnus-group-mail-low-empty-face ((t (:foreground "DeepPink4")))) + (gnus-group-mail-low-face ((t (:bold t :foreground "DeepPink4")))) + (gnus-group-news-1-empty-face ((t (:foreground "ForestGreen")))) + (gnus-group-news-1-face ((t (:bold t :foreground "ForestGreen")))) + (gnus-group-news-2-empty-face ((t (:foreground "CadetBlue4")))) + (gnus-group-news-2-face ((t (:bold t :foreground "CadetBlue4")))) + (gnus-group-news-3-empty-face ((t (nil)))) + (gnus-group-news-3-face ((t (:bold t)))) + (gnus-group-news-4-empty-face ((t (nil)))) + (gnus-group-news-4-face ((t (:bold t)))) + (gnus-group-news-5-empty-face ((t (nil)))) + (gnus-group-news-5-face ((t (:bold t)))) + (gnus-group-news-6-empty-face ((t (nil)))) + (gnus-group-news-6-face ((t (:bold t)))) + (gnus-group-news-low-empty-face ((t (:foreground "DarkGreen")))) + (gnus-group-news-low-face ((t (:bold t :foreground "DarkGreen")))) + (gnus-header-content-face ((t (:italic t :foreground "indianred4")))) + (gnus-header-from-face ((t (:foreground "red3")))) + (gnus-header-name-face ((t (:foreground "maroon")))) + (gnus-header-newsgroups-face ((t (:italic t :foreground "MidnightBlue")))) + (gnus-header-subject-face ((t (:foreground "red4")))) + (gnus-picons-face ((t (:background "white" :foreground "black")))) + (gnus-picons-xbm-face ((t (:background "white" :foreground "black")))) + (gnus-signature-face ((t (:italic t)))) + (gnus-splash-face ((t (:foreground "ForestGreen")))) + (gnus-summary-cancelled-face ((t (:foreground "yellow")))) + (gnus-summary-high-ancient-face ((t (:bold t :foreground "RoyalBlue")))) + (gnus-summary-high-read-face ((t (:bold t :foreground "DarkGreen")))) + (gnus-summary-high-ticked-face ((t (:bold t :foreground "firebrick")))) + (gnus-summary-high-unread-face ((t (:bold t)))) + (gnus-summary-low-ancient-face ((t (:italic t :foreground "RoyalBlue")))) + (gnus-summary-low-read-face ((t (:italic t :foreground "DarkGreen")))) + (gnus-summary-low-ticked-face ((t (:italic t :foreground "firebrick")))) + (gnus-summary-low-unread-face ((t (:italic t)))) + (gnus-summary-normal-ancient-face ((t (:foreground "RoyalBlue")))) + (gnus-summary-normal-read-face ((t (:foreground "DarkGreen")))) + (gnus-summary-normal-ticked-face ((t (:foreground "firebrick")))) + (gnus-summary-normal-unread-face ((t (nil)))) + (gnus-summary-selected-face ((t (:underline t)))) + (gnus-x-face ((t (:background "white" :foreground "black")))) + (green ((t (:foreground "green")))) + (gui-button-face ((t (:background "grey75" :foreground "black")))) + (gui-element ((t (:size "12" :background "Gray80" :foreground "black")))) + (header-line ((t (:background "grey20" :foreground "grey90")))) + (highlight ((t (:bold t :background "yellow" :foreground "red")))) + (highlight-changes-delete-face ((t (:underline t :foreground "red")))) + (highlight-changes-face ((t (:foreground "red")))) + (highline-face ((t (:background "paleturquoise")))) + (holiday-face ((t (:background "pink")))) + (hyper-apropos-documentation ((t (:foreground "#aaaaaa")))) + (hyper-apropos-heading ((t (:bold t :foreground "#999999")))) + (hyper-apropos-hyperlink ((t (:foreground "Violet")))) + (hyper-apropos-major-heading ((t (:bold t :foreground "#ff0000")))) + (hyper-apropos-section-heading ((t (:italic t :bold t :foreground "#33aa55")))) + (hyper-apropos-warning ((t (:bold t :foreground "red")))) + (info-menu-5 ((t (:underline t)))) + (info-node ((t (:italic t :bold t)))) + (info-xref ((t (:bold t)))) + (isearch ((t (:background "paleturquoise")))) + (isearch-lazy-highlight-face ((t (:background "paleturquoise4")))) + (isearch-secondary ((t (:foreground "red3")))) + (italic ((t (:italic t)))) + (jde-bug-breakpoint-cursor ((t (:background "brown" :foreground "cyan")))) + (jde-db-active-breakpoint-face ((t (:background "red" :foreground "black")))) + (jde-db-requested-breakpoint-face ((t (:background "yellow" :foreground "black")))) + (jde-db-spec-breakpoint-face ((t (:background "green" :foreground "black")))) + (jde-java-font-lock-api-face ((t (:foreground "light goldenrod")))) + (jde-java-font-lock-bold-face ((t (:bold t)))) + (jde-java-font-lock-code-face ((t (nil)))) + (jde-java-font-lock-constant-face ((t (:foreground "Aquamarine")))) + (jde-java-font-lock-doc-tag-face ((t (:foreground "light coral")))) + (jde-java-font-lock-italic-face ((t (:italic t)))) + (jde-java-font-lock-link-face ((t (:underline t :foreground "cadetblue")))) + (jde-java-font-lock-modifier-face ((t (:foreground "LightSteelBlue")))) + (jde-java-font-lock-number-face ((t (:foreground "LightSalmon")))) + (jde-java-font-lock-operator-face ((t (:foreground "medium blue")))) + (jde-java-font-lock-package-face ((t (:foreground "steelblue1")))) + (jde-java-font-lock-pre-face ((t (nil)))) + (jde-java-font-lock-underline-face ((t (:underline t)))) + (left-margin ((t (nil)))) + (list-mode-item-selected ((t (:background "gray68")))) + (magenta ((t (:foreground "magenta")))) + (makefile-space-face ((t (:background "hotpink")))) + (menu ((t (nil)))) + (message-cited-text-face ((t (:foreground "red")))) + (message-header-cc-face ((t (:foreground "MidnightBlue")))) + (message-header-name-face ((t (:foreground "cornflower blue")))) + (message-header-newsgroups-face ((t (:italic t :bold t :foreground "blue4")))) + (message-header-other-face ((t (:foreground "steel blue")))) + (message-header-subject-face ((t (:bold t :foreground "navy blue")))) + (message-header-to-face ((t (:bold t :foreground "MidnightBlue")))) + (message-header-xheader-face ((t (:foreground "blue")))) + (message-mml-face ((t (:bold t :foreground "cyan")))) + (message-separator-face ((t (:foreground "brown")))) + (minibuffer-prompt ((t (:foreground "cyan")))) + (mode-line ((t (:background "grey75" :foreground "black")))) + (mode-line-inactive ((t (:background "grey30" :foreground "grey80")))) + (modeline ((t (:bold t :background "red" :foreground "yellow")))) + (modeline-buffer-id ((t (:bold t :background "red" :foreground "yellow")))) + (modeline-mousable ((t (:background "red" :foreground "yellow")))) + (modeline-mousable-minor-mode ((t (:background "red" :foreground "green4")))) + (mouse ((t (nil)))) + (paren-blink-off ((t (:foreground "black")))) + (paren-match ((t (:bold t :background "yellow" :foreground "red")))) + (paren-mismatch ((t (:background "DeepPink")))) + (pointer ((t (nil)))) + (primary-selection ((t (:background "gray65")))) + (red ((t (:foreground "red")))) + (region ((t (:background "gray75")))) + (right-margin ((t (nil)))) + (scroll-bar ((t (nil)))) + (secondary-selection ((t (:background "paleturquoise")))) + (semantic-dirty-token-face ((t (:background "lightyellow")))) + (semantic-unmatched-syntax-face ((t (nil)))) + (senator-intangible-face ((t (:foreground "gray75")))) + (senator-momentary-highlight-face ((t (:background "gray30")))) + (senator-read-only-face ((t (:background "#664444")))) + (show-paren-match-face ((t (:background "turquoise")))) + (show-paren-mismatch-face ((t (:background "purple" :foreground "white")))) + (speedbar-button-face ((t (:foreground "green4")))) + (speedbar-directory-face ((t (:foreground "blue4")))) + (speedbar-file-face ((t (:foreground "cyan4")))) + (speedbar-highlight-face ((t (:background "green")))) + (speedbar-selected-face ((t (:underline t :foreground "red")))) + (speedbar-tag-face ((t (:foreground "brown")))) + (template-message-face ((t (:bold t)))) + (term-black ((t (:foreground "black")))) + (term-blackbg ((t (nil)))) + (term-blue ((t (:foreground "blue")))) + (term-blue-bold-face ((t (:bold t :foreground "blue")))) + (term-blue-face ((t (:foreground "blue")))) + (term-blue-inv-face ((t (:background "blue")))) + (term-blue-ul-face ((t (:underline t :foreground "blue")))) + (term-bluebg ((t (:background "blue")))) + (term-bold ((t (:bold t)))) + (term-cyan ((t (:foreground "cyan")))) + (term-cyan-bold-face ((t (:bold t :foreground "cyan")))) + (term-cyan-face ((t (:foreground "cyan")))) + (term-cyan-inv-face ((t (:background "cyan")))) + (term-cyan-ul-face ((t (:underline t :foreground "cyan")))) + (term-cyanbg ((t (:background "cyan")))) + (term-default-bg ((t (nil)))) + (term-default-bg-inv ((t (nil)))) + (term-default-bold-face ((t (:bold t)))) + (term-default-face ((t (nil)))) + (term-default-fg ((t (nil)))) + (term-default-fg-inv ((t (nil)))) + (term-default-inv-face ((t (:background "peachpuff" :foreground "black")))) + (term-default-ul-face ((t (:underline t)))) + (term-green ((t (:foreground "green")))) + (term-green-bold-face ((t (:bold t :foreground "green")))) + (term-green-face ((t (:foreground "green")))) + (term-green-inv-face ((t (:background "green")))) + (term-green-ul-face ((t (:underline t :foreground "green")))) + (term-greenbg ((t (:background "green")))) + (term-invisible ((t (nil)))) + (term-invisible-inv ((t (nil)))) + (term-magenta ((t (:foreground "magenta")))) + (term-magenta-bold-face ((t (:bold t :foreground "magenta")))) + (term-magenta-face ((t (:foreground "magenta")))) + (term-magenta-inv-face ((t (:background "magenta")))) + (term-magenta-ul-face ((t (:underline t :foreground "magenta")))) + (term-magentabg ((t (:background "magenta")))) + (term-red ((t (:foreground "red")))) + (term-red-bold-face ((t (:bold t :foreground "red")))) + (term-red-face ((t (:foreground "red")))) + (term-red-inv-face ((t (:background "red")))) + (term-red-ul-face ((t (:underline t :foreground "red")))) + (term-redbg ((t (:background "red")))) + (term-underline ((t (:underline t)))) + (term-white ((t (:foreground "white")))) + (term-white-bold-face ((t (:bold t :foreground "white")))) + (term-white-face ((t (:foreground "white")))) + (term-white-inv-face ((t (nil)))) + (term-white-ul-face ((t (:underline t :foreground "white")))) + (term-whitebg ((t (:background "white")))) + (term-yellow ((t (:foreground "yellow")))) + (term-yellow-bold-face ((t (:bold t :foreground "yellow")))) + (term-yellow-face ((t (:foreground "yellow")))) + (term-yellow-inv-face ((t (:background "yellow")))) + (term-yellow-ul-face ((t (:underline t :foreground "yellow")))) + (term-yellowbg ((t (:background "yellow")))) + (text-cursor ((t (:background "red" :foreground "black")))) + (tool-bar ((t (:background "grey75" :foreground "black")))) + (toolbar ((t (:background "Gray80" :foreground "black")))) + (tooltip ((t (:background "lightyellow" :foreground "black")))) + (trailing-whitespace ((t (:background "red")))) + (underline ((t (:underline t)))) + (variable-pitch ((t (nil)))) + (vcursor ((t (:underline t :background "cyan" :foreground "blue")))) + (vertical-divider ((t (:background "Gray80" :foreground "black")))) + (vhdl-font-lock-attribute-face ((t (:foreground "Orchid")))) + (vhdl-font-lock-directive-face ((t (:foreground "CadetBlue")))) + (vhdl-font-lock-enumvalue-face ((t (:foreground "Gold4")))) + (vhdl-font-lock-function-face ((t (:foreground "Orchid4")))) + (vhdl-font-lock-prompt-face ((t (:bold t :foreground "Red")))) + (vhdl-font-lock-reserved-words-face ((t (:bold t :foreground "Orange")))) + (vhdl-font-lock-translate-off-face ((t (:background "LightGray")))) + (vhdl-speedbar-architecture-face ((t (:foreground "Blue")))) + (vhdl-speedbar-architecture-selected-face ((t (:underline t :foreground "Blue")))) + (vhdl-speedbar-configuration-face ((t (:foreground "DarkGoldenrod")))) + (vhdl-speedbar-configuration-selected-face ((t (:underline t :foreground "DarkGoldenrod")))) + (vhdl-speedbar-entity-face ((t (:foreground "ForestGreen")))) + (vhdl-speedbar-entity-selected-face ((t (:underline t :foreground "ForestGreen")))) + (vhdl-speedbar-instantiation-face ((t (:foreground "Brown")))) + (vhdl-speedbar-instantiation-selected-face ((t (:underline t :foreground "Brown")))) + (vhdl-speedbar-package-face ((t (:foreground "Grey50")))) + (vhdl-speedbar-package-selected-face ((t (:underline t :foreground "Grey50")))) + (viper-minibuffer-emacs-face ((t (:background "darkseagreen2" :foreground "Black")))) + (viper-minibuffer-insert-face ((t (:background "pink" :foreground "Black")))) + (viper-minibuffer-vi-face ((t (:background "grey" :foreground "DarkGreen")))) + (viper-replace-overlay-face ((t (:background "darkseagreen2" :foreground "Black")))) + (viper-search-face ((t (:background "khaki" :foreground "Black")))) + (white ((t (:foreground "white")))) + (widget ((t (:size "12" :background "Gray80" :foreground "black")))) + (widget-button-face ((t (:bold t)))) + (widget-button-pressed-face ((t (:foreground "red")))) + (widget-documentation-face ((t (:foreground "dark green")))) + (widget-field-face ((t (nil)))) + (widget-inactive-face ((t (:foreground "dim gray")))) + (widget-single-line-field-face ((t (:background "gray85")))) + (x-face ((t (:bold t :background "wheat" :foreground "black")))) + (xrdb-option-name-face ((t (:bold t :foreground "yellow")))) + (xrdb-option-value-face ((t (:bold t :foreground "magenta")))) + (yellow ((t (:foreground "yellow")))) + (zmacs-region ((t (:background "white" :foreground "black"))))))) + +(defun color-theme-shaman () + "Color theme by shaman, created 2002-11-11." + (interactive) + (color-theme-install + '(color-theme-shaman + ((background-color . "#456345") + (background-mode . dark) + (background-toolbar-color . "#cf3ccf3ccf3c") + (border-color . "#000000000000") + (bottom-toolbar-shadow-color . "#79e77df779e7") + (foreground-color . "White") + (top-toolbar-shadow-color . "#f7defbeef7de")) + ((buffers-tab-face . buffers-tab)) + (default ((t (nil)))) + (blue ((t (:foreground "blue")))) + (bold ((t (:bold t :size "12")))) + (bold-italic ((t (:italic t :bold t :size "12")))) + (border-glyph ((t (nil)))) + (buffers-tab ((t (:background "Gray80" :foreground "black")))) + (font-lock-builtin-face ((t (:foreground "cadetblue2")))) + (font-lock-comment-face ((t (:foreground "gray80")))) + (font-lock-constant-face ((t (:foreground "steelblue1")))) + (font-lock-doc-face ((t (:foreground "light coral")))) + (font-lock-doc-string-face ((t (:foreground "light coral")))) + (font-lock-function-name-face ((t (:foreground "aquamarine")))) + (font-lock-keyword-face ((t (:foreground "cyan")))) + (font-lock-preprocessor-face ((t (:foreground "steelblue1")))) + (font-lock-reference-face ((t (:foreground "cadetblue2")))) + (font-lock-string-face ((t (:foreground "tan")))) + (font-lock-type-face ((t (:foreground "wheat")))) + (font-lock-variable-name-face ((t (:foreground "cyan3")))) + (font-lock-warning-face ((t (:bold t :size "12" :foreground "Pink")))) + (fringe ((t (nil)))) + (gnus-x-face ((t (:background "white" :foreground "black")))) + (green ((t (:foreground "green")))) + (gui-button-face ((t (:background "grey75" :foreground "black")))) + (gui-element ((t (:size "12" :background "Gray80" :foreground "black")))) + (highlight ((t (:background "darkseagreen2")))) + (isearch ((t (:background "paleturquoise")))) + (isearch-secondary ((t (:foreground "red3")))) + (italic ((t (:italic t :size "12")))) + (left-margin ((t (nil)))) + (list-mode-item-selected ((t (:background "gray68")))) + (message-cited-text-face ((t (:foreground "red")))) + (message-header-cc-face ((t (:bold t :foreground "green4")))) + (message-header-name-face ((t (:foreground "DarkGreen")))) + (message-header-newsgroups-face ((t (:bold t :foreground "yellow")))) + (message-header-other-face ((t (:foreground "#b00000")))) + (message-header-subject-face ((t (:foreground "green3")))) + (message-header-to-face ((t (:bold t :foreground "green2")))) + (message-header-xheader-face ((t (:foreground "blue")))) + (message-mml-face ((t (:foreground "ForestGreen")))) + (message-separator-face ((t (:foreground "blue3")))) + (mode-line ((t (:background "Gray80" :foreground "black")))) + (modeline ((t (:background "Gray80" :foreground "black")))) + (modeline-buffer-id ((t (:background "Gray80" :foreground "blue4")))) + (modeline-mousable ((t (:background "Gray80" :foreground "firebrick")))) + (modeline-mousable-minor-mode ((t (:background "Gray80" :foreground "green4")))) + (pointer ((t (:foreground "White")))) + (primary-selection ((t (:background "gray65")))) + (red ((t (:foreground "red")))) + (region ((t (:background "gray65")))) + (right-margin ((t (nil)))) + (rpm-spec-dir-face ((t (:foreground "green")))) + (rpm-spec-doc-face ((t (:foreground "magenta")))) + (rpm-spec-ghost-face ((t (:foreground "red")))) + (rpm-spec-macro-face ((t (:foreground "yellow")))) + (rpm-spec-package-face ((t (:foreground "red")))) + (rpm-spec-tag-face ((t (:foreground "blue")))) + (rpm-spec-var-face ((t (:foreground "maroon")))) + (secondary-selection ((t (:background "paleturquoise")))) + (text-cursor ((t (:background "Pink" :foreground "Black")))) + (tool-bar ((t (nil)))) + (toolbar ((t (:background "Gray80" :foreground "black")))) + (underline ((t (:underline t)))) + (vertical-divider ((t (:background "Gray80" :foreground "black")))) + (widget ((t (:size "12" :background "Gray80" :foreground "black")))) + (widget-button-face ((t (:bold t)))) + (widget-button-pressed-face ((t (:foreground "red")))) + (widget-documentation-face ((t (:foreground "lime green")))) + (widget-field-face ((t (:background "dim gray")))) + (widget-inactive-face ((t (:foreground "light gray")))) + (yellow ((t (:foreground "yellow")))) + (zmacs-region ((t (:background "gray65"))))))) + +(defun color-theme-emacs-nw () + "Follow emacs21's color-theme, with -nw getting 100% compatibility. + +Alex's `color-theme-emacs-21' follows emacs21's theme, but in the +current scheme of things, that means that when it works on X, it won't +work in -nw perfectly. The modeline and menuline will have same +colors as the rest of emacs, which can be particularly disturbing when +there are multiple windows. + +OTOH, `color-theme-emacs-nw' follows emacs21's theme but the goal is +100% -nw compatibility, and in X; we shall try for decent color +scheme, and as much compability default emacs21's X as possble. +Bugs to deego@gnufans.org. + +TODO: Try to make this theme relative to color-theme-emacs-21 rather +than absolute, viz: call that first and then tweak minor stuff." + (interactive) + (color-theme-install + '(color-theme-emacs-nw + ((background-color . "white") + (background-mode . light) + (border-color . "black") + (cursor-color . "black") + (foreground-color . "black") + (mouse-color . "black")) + ((Man-overstrike-face . bold) + (Man-underline-face . underline) + (cperl-here-face . font-lock-string-face) + (cperl-invalid-face . underline) + (cperl-pod-face . font-lock-comment-face) + (cperl-pod-head-face . font-lock-variable-name-face) + (gnus-article-button-face . bold) + (gnus-article-mouse-face . highlight) + (gnus-cite-attribution-face . gnus-cite-attribution-face) + (gnus-mouse-face . highlight) + (gnus-signature-face . gnus-signature-face) + (gnus-summary-selected-face . gnus-summary-selected-face) + (help-highlight-face . underline) + (idlwave-class-arrow-face . bold) + (idlwave-shell-breakpoint-face . idlwave-shell-bp-face) + (idlwave-shell-expression-face . secondary-selection) + (idlwave-shell-stop-line-face . highlight) + (ispell-highlight-face . highlight) + (list-matching-lines-face . bold) + (view-highlight-face . highlight) + (viper-insert-state-cursor-color . "Green") + (viper-replace-overlay-cursor-color . "Red") + (widget-mouse-face . highlight)) + (default ((t (:stipple nil :background "white" :foreground "black" :inverse-video nil :box nil :strike-through nil :overline nil :underline nil :slant normal :weight normal :width normal :family "adobe-courier")))) + (Info-title-1-face ((t (:bold t :weight bold :family "helv" :height 1.728)))) + (Info-title-2-face ((t (:bold t :family "helv" :weight bold :height 1.44)))) + (Info-title-3-face ((t (:bold t :weight bold :family "helv" :height 1.2)))) + (Info-title-4-face ((t (:bold t :family "helv" :weight bold)))) + (antlr-font-lock-keyword-face ((t (:bold t :foreground "black" :weight bold)))) + (antlr-font-lock-literal-face ((t (:bold t :foreground "brown4" :weight bold)))) + (antlr-font-lock-ruledef-face ((t (:bold t :foreground "blue" :weight bold)))) + (antlr-font-lock-ruleref-face ((t (:foreground "blue4")))) + (antlr-font-lock-tokendef-face ((t (:bold t :foreground "blue" :weight bold)))) + (antlr-font-lock-tokenref-face ((t (:foreground "orange4")))) + (bold ((t (:bold t :weight bold)))) + (bold-italic ((t (:italic t :bold t :slant italic :weight bold)))) + (border ((t (:background "black")))) + (calendar-today-face ((t (:underline t)))) + (change-log-acknowledgement-face ((t (:foreground "Firebrick")))) + (change-log-conditionals-face ((t (:foreground "DarkGoldenrod")))) + (change-log-date-face ((t (:foreground "RosyBrown")))) + (change-log-email-face ((t (:foreground "DarkGoldenrod")))) + (change-log-file-face ((t (:foreground "Blue")))) + (change-log-function-face ((t (:foreground "DarkGoldenrod")))) + (change-log-list-face ((t (:foreground "Purple")))) + (change-log-name-face ((t (:foreground "CadetBlue")))) + (comint-highlight-input ((t (:bold t :weight bold)))) + (comint-highlight-prompt ((t (:foreground "dark blue")))) + (cperl-array-face ((t (:bold t :background "lightyellow2" :foreground "Blue" :weight bold)))) + (cperl-hash-face ((t (:italic t :bold t :background "lightyellow2" :foreground "Red" :slant italic :weight bold)))) + (cperl-nonoverridable-face ((t (:foreground "chartreuse3")))) + (cursor ((t (:background "black")))) + (custom-button-face ((t (:background "lightgrey" :foreground "black" :box (:line-width 2 :style released-button))))) + (custom-button-pressed-face ((t (:background "lightgrey" :foreground "black" :box (:line-width 2 :style pressed-button))))) + (custom-changed-face ((t (:background "blue" :foreground "white")))) + (custom-comment-face ((t (:background "gray85")))) + (custom-comment-tag-face ((t (:foreground "blue4")))) + (custom-documentation-face ((t (nil)))) + (custom-face-tag-face ((t (:bold t :family "helv" :weight bold :height 1.2)))) + (custom-group-tag-face ((t (:bold t :foreground "blue" :weight bold :height 1.2)))) + (custom-group-tag-face-1 ((t (:bold t :family "helv" :foreground "red" :weight bold :height 1.2)))) + (custom-invalid-face ((t (:background "red" :foreground "yellow")))) + (custom-modified-face ((t (:background "blue" :foreground "white")))) + (custom-rogue-face ((t (:background "black" :foreground "pink")))) + (custom-saved-face ((t (:underline t)))) + (custom-set-face ((t (:background "white" :foreground "blue")))) + (custom-state-face ((t (:foreground "dark green")))) + (custom-variable-button-face ((t (:bold t :underline t :weight bold)))) + (custom-variable-tag-face ((t (:bold t :family "helv" :foreground "blue" :weight bold :height 1.2)))) + (cvs-filename-face ((t (:foreground "blue4")))) + (cvs-handled-face ((t (:foreground "pink")))) + (cvs-header-face ((t (:bold t :foreground "blue4" :weight bold)))) + (cvs-marked-face ((t (:bold t :foreground "green3" :weight bold)))) + (cvs-msg-face ((t (:italic t :slant italic)))) + (cvs-need-action-face ((t (:foreground "orange")))) + (cvs-unknown-face ((t (:foreground "red")))) + (diary-face ((t (:foreground "red")))) + (diff-added-face ((t (nil)))) + (diff-changed-face ((t (nil)))) + (diff-context-face ((t (:foreground "grey50")))) + (diff-file-header-face ((t (:bold t :background "grey70" :weight bold)))) + (diff-function-face ((t (:foreground "grey50")))) + (diff-header-face ((t (:background "grey85")))) + (diff-hunk-header-face ((t (:background "grey85")))) + (diff-index-face ((t (:bold t :weight bold :background "grey70")))) + (diff-nonexistent-face ((t (:bold t :weight bold :background "grey70")))) + (diff-removed-face ((t (nil)))) + (dired-face-boring ((t (:foreground "RosyBrown")))) + (dired-face-directory ((t (:foreground "Blue")))) + (dired-face-executable ((t (nil)))) + (dired-face-flagged ((t (:foreground "Red" :weight bold)))) + (dired-face-marked ((t (:foreground "Red" :weight bold)))) + (dired-face-permissions ((t (nil)))) + (dired-face-setuid ((t (nil)))) + (dired-face-socket ((t (nil)))) + (dired-face-symlink ((t (:foreground "Purple")))) + (ebrowse-default-face ((t (nil)))) + (ebrowse-file-name-face ((t (:italic t :slant italic)))) + (ebrowse-member-attribute-face ((t (:foreground "red")))) + (ebrowse-member-class-face ((t (:foreground "purple")))) + (ebrowse-progress-face ((t (:background "blue")))) + (ebrowse-root-class-face ((t (:bold t :foreground "blue" :weight bold)))) + (ebrowse-tree-mark-face ((t (:foreground "red")))) + (ediff-current-diff-face-A ((t (:background "pale green" :foreground "firebrick")))) + (ediff-current-diff-face-Ancestor ((t (:background "VioletRed" :foreground "Black")))) + (ediff-current-diff-face-B ((t (:background "Yellow" :foreground "DarkOrchid")))) + (ediff-current-diff-face-C ((t (:background "Pink" :foreground "Navy")))) + (ediff-even-diff-face-A ((t (:background "light grey" :foreground "Black")))) + (ediff-even-diff-face-Ancestor ((t (:background "Grey" :foreground "White")))) + (ediff-even-diff-face-B ((t (:background "Grey" :foreground "White")))) + (ediff-even-diff-face-C ((t (:background "light grey" :foreground "Black")))) + (ediff-fine-diff-face-A ((t (:background "sky blue" :foreground "Navy")))) + (ediff-fine-diff-face-Ancestor ((t (:background "Green" :foreground "Black")))) + (ediff-fine-diff-face-B ((t (:background "cyan" :foreground "Black")))) + (ediff-fine-diff-face-C ((t (:background "Turquoise" :foreground "Black")))) + (ediff-odd-diff-face-A ((t (:background "Grey" :foreground "White")))) + (ediff-odd-diff-face-Ancestor ((t (:background "light grey" :foreground "Black")))) + (ediff-odd-diff-face-B ((t (:background "light grey" :foreground "Black")))) + (ediff-odd-diff-face-C ((t (:background "Grey" :foreground "White")))) + (eshell-ls-archive-face ((t (:bold t :foreground "Orchid" :weight bold)))) + (eshell-ls-backup-face ((t (:foreground "OrangeRed")))) + (eshell-ls-clutter-face ((t (:bold t :foreground "OrangeRed" :weight bold)))) + (eshell-ls-directory-face ((t (:bold t :foreground "Blue" :weight bold)))) + (eshell-ls-executable-face ((t (:bold t :foreground "ForestGreen" :weight bold)))) + (eshell-ls-missing-face ((t (:bold t :foreground "Red" :weight bold)))) + (eshell-ls-product-face ((t (:foreground "OrangeRed")))) + (eshell-ls-readonly-face ((t (:foreground "Brown")))) + (eshell-ls-special-face ((t (:bold t :foreground "Magenta" :weight bold)))) + (eshell-ls-symlink-face ((t (:bold t :foreground "Dark Cyan" :weight bold)))) + (eshell-ls-unreadable-face ((t (:foreground "Grey30")))) + (eshell-prompt-face ((t (:bold t :foreground "Red" :weight bold)))) + (eshell-test-failed-face ((t (:bold t :foreground "OrangeRed" :weight bold)))) + (eshell-test-ok-face ((t (:bold t :foreground "Green" :weight bold)))) + (excerpt ((t (:italic t :slant italic)))) + (fixed ((t (:bold t :weight bold)))) + (fixed-pitch ((t (:family "courier")))) + (flyspell-duplicate-face ((t (:bold t :foreground "Gold3" :underline t :weight bold)))) + (flyspell-incorrect-face ((t (:bold t :foreground "OrangeRed" :underline t :weight bold)))) + (font-lock-builtin-face ((t (:foreground "Orchid")))) + (font-lock-comment-face ((t (:foreground "Firebrick")))) + (font-lock-constant-face ((t (:foreground "CadetBlue")))) + (font-lock-doc-face ((t (:foreground "RosyBrown")))) + (font-lock-doc-string-face ((t (:foreground "RosyBrown")))) + (font-lock-function-name-face ((t (:foreground "Blue")))) + (font-lock-keyword-face ((t (:foreground "Purple")))) + (font-lock-preprocessor-face ((t (:foreground "CadetBlue")))) + (font-lock-reference-face ((t (:foreground "Orchid")))) + (font-lock-string-face ((t (:foreground "RosyBrown")))) + (font-lock-type-face ((t (:foreground "ForestGreen")))) + (font-lock-variable-name-face ((t (:foreground "DarkGoldenrod")))) + (font-lock-warning-face ((t (:bold t :foreground "Red" :weight bold)))) + (fringe ((t (:background "grey95")))) + (gnus-cite-attribution-face ((t (:italic t :slant italic)))) + (gnus-cite-face-1 ((t (:foreground "MidnightBlue")))) + (gnus-cite-face-10 ((t (:foreground "medium purple")))) + (gnus-cite-face-11 ((t (:foreground "turquoise")))) + (gnus-cite-face-2 ((t (:foreground "firebrick")))) + (gnus-cite-face-3 ((t (:foreground "dark green")))) + (gnus-cite-face-4 ((t (:foreground "OrangeRed")))) + (gnus-cite-face-5 ((t (:foreground "dark khaki")))) + (gnus-cite-face-6 ((t (:foreground "dark violet")))) + (gnus-cite-face-7 ((t (:foreground "SteelBlue4")))) + (gnus-cite-face-8 ((t (:foreground "magenta")))) + (gnus-cite-face-9 ((t (:foreground "violet")))) + (gnus-emphasis-bold ((t (:bold t :weight bold)))) + (gnus-emphasis-bold-italic ((t (:italic t :bold t :slant italic :weight bold)))) + (gnus-emphasis-highlight-words ((t (:background "black" :foreground "yellow")))) + (gnus-emphasis-italic ((t (:italic t :slant italic)))) + (gnus-emphasis-underline ((t (:underline t)))) + (gnus-emphasis-underline-bold ((t (:bold t :underline t :weight bold)))) + (gnus-emphasis-underline-bold-italic ((t (:italic t :bold t :underline t :slant italic :weight bold)))) + (gnus-emphasis-underline-italic ((t (:italic t :underline t :slant italic)))) + (gnus-group-mail-1-empty-face ((t (:foreground "DeepPink3")))) + (gnus-group-mail-1-face ((t (:bold t :foreground "DeepPink3" :weight bold)))) + (gnus-group-mail-2-empty-face ((t (:foreground "HotPink3")))) + (gnus-group-mail-2-face ((t (:bold t :foreground "HotPink3" :weight bold)))) + (gnus-group-mail-3-empty-face ((t (:foreground "magenta4")))) + (gnus-group-mail-3-face ((t (:bold t :foreground "magenta4" :weight bold)))) + (gnus-group-mail-low-empty-face ((t (:foreground "DeepPink4")))) + (gnus-group-mail-low-face ((t (:bold t :foreground "DeepPink4" :weight bold)))) + (gnus-group-news-1-empty-face ((t (:foreground "ForestGreen")))) + (gnus-group-news-1-face ((t (:bold t :foreground "ForestGreen" :weight bold)))) + (gnus-group-news-2-empty-face ((t (:foreground "CadetBlue4")))) + (gnus-group-news-2-face ((t (:bold t :foreground "CadetBlue4" :weight bold)))) + (gnus-group-news-3-empty-face ((t (nil)))) + (gnus-group-news-3-face ((t (:bold t :weight bold)))) + (gnus-group-news-4-empty-face ((t (nil)))) + (gnus-group-news-4-face ((t (:bold t :weight bold)))) + (gnus-group-news-5-empty-face ((t (nil)))) + (gnus-group-news-5-face ((t (:bold t :weight bold)))) + (gnus-group-news-6-empty-face ((t (nil)))) + (gnus-group-news-6-face ((t (:bold t :weight bold)))) + (gnus-group-news-low-empty-face ((t (:foreground "DarkGreen")))) + (gnus-group-news-low-face ((t (:bold t :foreground "DarkGreen" :weight bold)))) + (gnus-header-content-face ((t (:italic t :foreground "indianred4" :slant italic)))) + (gnus-header-from-face ((t (:foreground "red3")))) + (gnus-header-name-face ((t (:foreground "maroon")))) + (gnus-header-newsgroups-face ((t (:italic t :foreground "MidnightBlue" :slant italic)))) + (gnus-header-subject-face ((t (:foreground "red4")))) + (gnus-signature-face ((t (:italic t :slant italic)))) + (gnus-splash-face ((t (:foreground "Brown")))) + (gnus-summary-cancelled-face ((t (:background "black" :foreground "yellow")))) + (gnus-summary-high-ancient-face ((t (:bold t :foreground "RoyalBlue" :weight bold)))) + (gnus-summary-high-read-face ((t (:bold t :foreground "DarkGreen" :weight bold)))) + (gnus-summary-high-ticked-face ((t (:bold t :foreground "firebrick" :weight bold)))) + (gnus-summary-high-unread-face ((t (:bold t :weight bold)))) + (gnus-summary-low-ancient-face ((t (:italic t :foreground "RoyalBlue" :slant italic)))) + (gnus-summary-low-read-face ((t (:italic t :foreground "DarkGreen" :slant italic)))) + (gnus-summary-low-ticked-face ((t (:italic t :foreground "firebrick" :slant italic)))) + (gnus-summary-low-unread-face ((t (:italic t :slant italic)))) + (gnus-summary-normal-ancient-face ((t (:foreground "RoyalBlue")))) + (gnus-summary-normal-read-face ((t (:foreground "DarkGreen")))) + (gnus-summary-normal-ticked-face ((t (:foreground "firebrick")))) + (gnus-summary-normal-unread-face ((t (nil)))) + (gnus-summary-selected-face ((t (:underline t)))) + (header-line ((t (:box (:line-width -1 :style released-button) :background "grey90" :foreground "grey20" :box nil)))) + (hi-black-b ((t (:bold t :weight bold)))) + (hi-black-hb ((t (:bold t :family "helv" :weight bold :height 1.67)))) + (hi-blue ((t (:background "light blue")))) + (hi-blue-b ((t (:bold t :foreground "blue" :weight bold)))) + (hi-green ((t (:background "green")))) + (hi-green-b ((t (:bold t :foreground "green" :weight bold)))) + (hi-pink ((t (:background "pink")))) + (hi-red-b ((t (:bold t :foreground "red" :weight bold)))) + (hi-yellow ((t (:background "yellow")))) + (highlight ((t (:background "darkseagreen2")))) + (highlight-changes-delete-face ((t (:foreground "red" :underline t)))) + (highlight-changes-face ((t (:foreground "red")))) + (holiday-face ((t (:background "pink")))) + (idlwave-help-link-face ((t (:foreground "Blue")))) + (idlwave-shell-bp-face ((t (:background "Pink" :foreground "Black")))) + (info-header-node ((t (:italic t :bold t :weight bold :slant italic :foreground "brown")))) + (info-header-xref ((t (:bold t :weight bold :foreground "magenta4")))) + (info-menu-5 ((t (:foreground "red1")))) + (info-menu-header ((t (:bold t :family "helv" :weight bold)))) + (info-node ((t (:italic t :bold t :foreground "brown" :slant italic :weight bold)))) + (info-xref ((t (:bold t :foreground "magenta4" :weight bold)))) + (isearch ((t (:background "magenta4" :foreground "lightskyblue1")))) + (isearch-lazy-highlight-face ((t (:background "paleturquoise")))) + (italic ((t (:italic t :slant italic)))) + (log-view-file-face ((t (:bold t :background "grey70" :weight bold)))) + (log-view-message-face ((t (:background "grey85")))) + (makefile-space-face ((t (:background "hotpink")))) + (menu ((t (:background "grey50" :foreground "white" :box (:line-width -1 :style released-button))))) + (message-cited-text-face ((t (:foreground "red")))) + (message-header-cc-face ((t (:foreground "MidnightBlue")))) + (message-header-name-face ((t (:foreground "cornflower blue")))) + (message-header-newsgroups-face ((t (:italic t :bold t :foreground "blue4" :slant italic :weight bold)))) + (message-header-other-face ((t (:foreground "steel blue")))) + (message-header-subject-face ((t (:bold t :foreground "navy blue" :weight bold)))) + (message-header-to-face ((t (:bold t :foreground "MidnightBlue" :weight bold)))) + (message-header-xheader-face ((t (:foreground "blue")))) + (message-mml-face ((t (:foreground "ForestGreen")))) + (message-separator-face ((t (:foreground "brown")))) + (mode-line ((t (:background "grey50" :foreground "white" :box (:line-width -1 :style released-button))))) + (modeline ((t (:background "grey50" :foreground "white" :box (:line-width -1 :style released-button))))) + (modeline-buffer-id ((t (:bold t :background "grey75" :foreground "black" :box (:line-width -1 :style released-button))))) + (modeline-mousable ((t (:background "grey75" :foreground "black" :box (:line-width -1 :style released-button))))) + (modeline-mousable-minor-mode ((t (:background "grey75" :foreground "black" :box (:line-width -1 :style released-button))))) + (mouse ((t (:background "black")))) + (primary-selection ((t (:background "lightgoldenrod2")))) + (reb-match-0 ((t (:background "lightblue")))) + (reb-match-1 ((t (:background "aquamarine")))) + (reb-match-2 ((t (:background "springgreen")))) + (reb-match-3 ((t (:background "yellow")))) + (region ((t (:background "lightgoldenrod2")))) + (scroll-bar ((t (:background "grey75")))) + (secondary-selection ((t (:background "yellow")))) + (sh-heredoc-face ((t (:foreground "tan")))) + (show-paren-match-face ((t (:background "turquoise")))) + (show-paren-mismatch-face ((t (:background "purple" :foreground "white")))) + (show-tabs-space-face ((t (:foreground "yellow")))) + (show-tabs-tab-face ((t (:foreground "red")))) + (smerge-base-face ((t (:foreground "red")))) + (smerge-markers-face ((t (:background "grey85")))) + (smerge-mine-face ((t (:foreground "blue")))) + (smerge-other-face ((t (:foreground "darkgreen")))) + (speedbar-button-face ((t (:foreground "green4")))) + (speedbar-directory-face ((t (:foreground "blue4")))) + (speedbar-file-face ((t (:foreground "cyan4")))) + (speedbar-highlight-face ((t (:background "green")))) + (speedbar-selected-face ((t (:foreground "red" :underline t)))) + (speedbar-tag-face ((t (:foreground "brown")))) + (strokes-char-face ((t (:background "lightgray")))) + (term-black ((t (:stipple nil :background "white" :foreground "black" :inverse-video nil :box nil :strike-through nil :overline nil :underline nil :slant normal :weight normal :width normal :family "adobe-courier")))) + (term-blackbg ((t (:stipple nil :background "black" :foreground "black" :inverse-video nil :box nil :strike-through nil :overline nil :underline nil :slant normal :weight normal :width normal :family "adobe-courier")))) + (term-blue ((t (:stipple nil :background "white" :foreground "blue" :inverse-video nil :box nil :strike-through nil :overline nil :underline nil :slant normal :weight normal :width normal :family "adobe-courier")))) + (term-bluebg ((t (:stipple nil :background "blue" :foreground "black" :inverse-video nil :box nil :strike-through nil :overline nil :underline nil :slant normal :weight normal :width normal :family "adobe-courier")))) + (term-bold ((t (:bold t :stipple nil :background "white" :foreground "black" :inverse-video nil :box nil :strike-through nil :overline nil :underline nil :slant normal :weight bold :width normal :family "adobe-courier")))) + (term-cyan ((t (:stipple nil :background "white" :foreground "cyan" :inverse-video nil :box nil :strike-through nil :overline nil :underline nil :slant normal :weight normal :width normal :family "adobe-courier")))) + (term-cyanbg ((t (:stipple nil :background "cyan" :foreground "black" :inverse-video nil :box nil :strike-through nil :overline nil :underline nil :slant normal :weight normal :width normal :family "adobe-courier")))) + (term-default ((t (:stipple nil :background "white" :foreground "black" :inverse-video nil :box nil :strike-through nil :overline nil :underline nil :slant normal :weight normal :width normal :family "adobe-courier")))) + (term-default-bg ((t (:stipple nil :foreground "black" :inverse-video nil :box nil :strike-through nil :overline nil :underline nil :slant normal :weight normal :width normal :family "adobe-courier")))) + (term-default-bg-inv ((t (:stipple nil :foreground "black" :inverse-video nil :box nil :strike-through nil :overline nil :underline nil :slant normal :weight normal :width normal :family "adobe-courier")))) + (term-default-fg ((t (:stipple nil :background "white" :inverse-video nil :box nil :strike-through nil :overline nil :underline nil :slant normal :weight normal :width normal :family "adobe-courier")))) + (term-default-fg-inv ((t (:stipple nil :background "white" :inverse-video nil :box nil :strike-through nil :overline nil :underline nil :slant normal :weight normal :width normal :family "adobe-courier")))) + (term-green ((t (:stipple nil :background "white" :foreground "green" :inverse-video nil :box nil :strike-through nil :overline nil :underline nil :slant normal :weight normal :width normal :family "adobe-courier")))) + (term-greenbg ((t (:stipple nil :background "green" :foreground "black" :inverse-video nil :box nil :strike-through nil :overline nil :underline nil :slant normal :weight normal :width normal :family "adobe-courier")))) + (term-invisible ((t (:stipple nil :foreground "black" :inverse-video nil :box nil :strike-through nil :overline nil :underline nil :slant normal :weight normal :width normal :family "adobe-courier")))) + (term-invisible-inv ((t (:stipple nil :foreground "black" :inverse-video nil :box nil :strike-through nil :overline nil :underline nil :slant normal :weight normal :width normal :family "adobe-courier")))) + (term-magenta ((t (:stipple nil :background "white" :foreground "magenta" :inverse-video nil :box nil :strike-through nil :overline nil :underline nil :slant normal :weight normal :width normal :family "adobe-courier")))) + (term-magentabg ((t (:stipple nil :background "magenta" :foreground "black" :inverse-video nil :box nil :strike-through nil :overline nil :underline nil :slant normal :weight normal :width normal :family "adobe-courier")))) + (term-red ((t (:stipple nil :background "white" :foreground "red" :inverse-video nil :box nil :strike-through nil :overline nil :underline nil :slant normal :weight normal :width normal :family "adobe-courier")))) + (term-redbg ((t (:stipple nil :background "red" :foreground "black" :inverse-video nil :box nil :strike-through nil :overline nil :underline nil :slant normal :weight normal :width normal :family "adobe-courier")))) + (term-underline ((t (:stipple nil :background "white" :foreground "black" :inverse-video nil :box nil :strike-through nil :overline nil :underline t :slant normal :weight normal :width normal :family "adobe-courier")))) + (term-white ((t (:stipple nil :background "white" :foreground "white" :inverse-video nil :box nil :strike-through nil :overline nil :underline nil :slant normal :weight normal :width normal :family "adobe-courier")))) + (term-whitebg ((t (:stipple nil :background "white" :foreground "black" :inverse-video nil :box nil :strike-through nil :overline nil :underline nil :slant normal :weight normal :width normal :family "adobe-courier")))) + (term-yellow ((t (:stipple nil :background "white" :foreground "yellow" :inverse-video nil :box nil :strike-through nil :overline nil :underline nil :slant normal :weight normal :width normal :family "adobe-courier")))) + (term-yellowbg ((t (:stipple nil :background "yellow" :foreground "black" :inverse-video nil :box nil :strike-through nil :overline nil :underline nil :slant normal :weight normal :width normal :family "adobe-courier")))) + (tex-math-face ((t (:foreground "RosyBrown")))) + (texinfo-heading-face ((t (:foreground "Blue")))) + (tool-bar ((t (:background "grey75" :foreground "black" :box (:line-width 1 :style released-button))))) + (tooltip ((t (:background "lightyellow" :foreground "black")))) + (trailing-whitespace ((t (:background "red")))) + (underline ((t (:underline t)))) + (variable-pitch ((t (:family "helv")))) + (vcursor ((t (:background "cyan" :foreground "blue" :underline t)))) + (vhdl-font-lock-attribute-face ((t (:foreground "Orchid")))) + (vhdl-font-lock-directive-face ((t (:foreground "CadetBlue")))) + (vhdl-font-lock-enumvalue-face ((t (:foreground "Gold4")))) + (vhdl-font-lock-function-face ((t (:foreground "Orchid4")))) + (vhdl-font-lock-prompt-face ((t (:bold t :foreground "Red" :weight bold)))) + (vhdl-font-lock-reserved-words-face ((t (:bold t :foreground "Orange" :weight bold)))) + (vhdl-font-lock-translate-off-face ((t (:background "LightGray")))) + (vhdl-speedbar-architecture-face ((t (:foreground "Blue")))) + (vhdl-speedbar-architecture-selected-face ((t (:foreground "Blue" :underline t)))) + (vhdl-speedbar-configuration-face ((t (:foreground "DarkGoldenrod")))) + (vhdl-speedbar-configuration-selected-face ((t (:foreground "DarkGoldenrod" :underline t)))) + (vhdl-speedbar-entity-face ((t (:foreground "ForestGreen")))) + (vhdl-speedbar-entity-selected-face ((t (:foreground "ForestGreen" :underline t)))) + (vhdl-speedbar-instantiation-face ((t (:foreground "Brown")))) + (vhdl-speedbar-instantiation-selected-face ((t (:foreground "Brown" :underline t)))) + (vhdl-speedbar-package-face ((t (:foreground "Grey50")))) + (vhdl-speedbar-package-selected-face ((t (:foreground "Grey50" :underline t)))) + (viper-minibuffer-emacs-face ((t (:background "darkseagreen2" :foreground "Black")))) + (viper-minibuffer-insert-face ((t (:background "pink" :foreground "Black")))) + (viper-minibuffer-vi-face ((t (:background "grey" :foreground "DarkGreen")))) + (viper-replace-overlay-face ((t (:background "darkseagreen2" :foreground "Black")))) + (viper-search-face ((t (:background "khaki" :foreground "Black")))) + (widget-button-face ((t (:bold t :weight bold)))) + (widget-button-pressed-face ((t (:foreground "red")))) + (widget-documentation-face ((t (:foreground "dark green")))) + (widget-field-face ((t (:background "gray85")))) + (widget-inactive-face ((t (:foreground "dim gray")))) + (widget-single-line-field-face ((t (:background "gray85")))) + (woman-addition-face ((t (:foreground "orange")))) + (woman-bold-face ((t (:bold t :foreground "blue" :weight bold)))) + (woman-italic-face ((t (:italic t :foreground "red" :underline t :slant italic)))) + (woman-unknown-face ((t (:foreground "brown")))) + (zmacs-region ((t (:background "lightgoldenrod2"))))))) + +(defun color-theme-late-night () + "Color theme by Alex Schroeder, created 2003-08-07. +This theme is for use late at night, with only little light in the room. +The goal was to make something as dark and subtle as the text console in +its default 80x25 state -- dark grey on black." + (interactive) + (let ((color-theme-is-cumulative t)) + (color-theme-dark-erc) + (color-theme-dark-gnus) + ;; (color-theme-dark-diff) + ;; (color-theme-dark-eshell) + (color-theme-dark-info) + (color-theme-dark-font-lock) + (color-theme-install + '(color-theme-late-night + ((background-color . "#000") + (background-mode . dark) + (background-toolbar-color . "#000") + (border-color . "#000") + (bottom-toolbar-shadow-color . "#000") + (cursor-color . "#888") + (foreground-color . "#666") + (top-toolbar-shadow-color . "#111")) + (default ((t (nil)))) + (bold ((t (:bold t)))) + (button ((t (:bold t)))) + (custom-button-face ((t (:bold t :foreground "#999")))) + (fringe ((t (:background "#111" :foreground "#444")))) + (header-line ((t (:background "#333" :foreground "#000")))) + (highlight ((t (:background "dark slate blue" :foreground "light blue")))) + (holiday-face ((t (:background "#000" :foreground "#777")))) + (isearch ((t (:foreground "pink" :background "red")))) + (isearch-lazy-highlight-face ((t (:foreground "red")))) + (italic ((t (:bold t)))) + (menu ((t (:background "#111" :foreground "#444")))) + (minibuffer-prompt ((t (:foreground "555")))) + (modeline ((t (:background "#111" :foreground "#444")))) + (mode-line-inactive ((t (:background "#000" :foreground "#444")))) + (modeline-buffer-id ((t (:background "#000" :foreground "#555")))) + (modeline-mousable ((t (:background "#000" :foreground "#555")))) + (modeline-mousable-minor-mode ((t (:background "#000" :foreground "#555")))) + (region ((t (:background "dark cyan" :foreground "cyan")))) + (secondary-selection ((t (:background "Aquamarine" :foreground "SlateBlue")))) + (show-paren-match-face ((t (:foreground "white" :background "light slate blue")))) + (show-paren-mismatch-face ((t (:foreground "white" :background "red")))) + (tool-bar ((t (:background "#111" :foreground "#777")))) + (tooltip ((t (:background "#333" :foreground "#777")))) + (underline ((t (:bold t)))) + (variable-pitch ((t (nil)))) + (widget-button-face ((t (:bold t :foreground "#888")))) + (widget-field-face ((t (:bold t :foreground "#999")))))))) + +(defun color-theme-clarity () + "White on black color theme by Richard Wellum, created 2003-01-16." + (interactive) + (color-theme-install + '(color-theme-clarity + ((background-color . "black") + (background-mode . dark) + (border-color . "white") + (cursor-color . "yellow") + (foreground-color . "white") + (mouse-color . "white")) + ((CUA-mode-global-mark-cursor-color . "cyan") + (CUA-mode-normal-cursor-color . "yellow") + (CUA-mode-overwrite-cursor-color . "red") + (CUA-mode-read-only-cursor-color . "green") + (help-highlight-face . underline) + (ibuffer-dired-buffer-face . font-lock-function-name-face) + (ibuffer-help-buffer-face . font-lock-comment-face) + (ibuffer-hidden-buffer-face . font-lock-warning-face) + (ibuffer-occur-match-face . font-lock-warning-face) + (ibuffer-read-only-buffer-face . font-lock-type-face) + (ibuffer-special-buffer-face . font-lock-keyword-face) + (ibuffer-title-face . font-lock-type-face) + (list-matching-lines-face . bold) + (ps-line-number-color . "black") + (ps-zebra-color . 0.95) + (tags-tag-face . default) + (view-highlight-face . highlight) + (widget-mouse-face . highlight)) + (default ((t (nil)))) + (CUA-global-mark-face ((t (:background "cyan" :foreground "black")))) + (CUA-rectangle-face ((t (:background "maroon" :foreground "white")))) + (CUA-rectangle-noselect-face ((t (:background "dimgray" :foreground "white")))) + (bold ((t (:bold t :weight bold)))) + (bold-italic ((t (:italic t :bold t :slant italic :weight bold)))) + (border ((t (:background "white")))) + (clearcase-dired-checkedout-face ((t (:foreground "red")))) + (comint-highlight-input ((t (:bold t :weight bold)))) + (comint-highlight-prompt ((t (:foreground "cyan")))) + (cursor ((t (:background "yellow")))) + (fixed-pitch ((t (:family "courier")))) + (flash-paren-face-off ((t (nil)))) + (flash-paren-face-on ((t (nil)))) + (flash-paren-face-region ((t (nil)))) + (font-lock-builtin-face ((t (:foreground "LightSteelBlue")))) + (font-lock-comment-face ((t (:foreground "OrangeRed")))) + (font-lock-constant-face ((t (:foreground "Aquamarine")))) + (font-lock-doc-face ((t (:foreground "LightSalmon")))) + (font-lock-function-name-face ((t (:foreground "LightSkyBlue")))) + (font-lock-keyword-face ((t (:foreground "Cyan")))) + (font-lock-string-face ((t (:foreground "LightSalmon")))) + (font-lock-type-face ((t (:foreground "PaleGreen")))) + (font-lock-variable-name-face ((t (:foreground "LightGoldenrod")))) + (font-lock-warning-face ((t (:bold t :foreground "Pink" :weight bold)))) + (fringe ((t (:background "grey10")))) + (header-line ((t (:box (:line-width -1 :style released-button) :foreground "grey20" :background "grey90" :box nil)))) + (highlight ((t (:background "darkolivegreen")))) + (ibuffer-deletion-face ((t (:foreground "red")))) + (ibuffer-marked-face ((t (:foreground "green")))) + (isearch ((t (:background "palevioletred2" :foreground "brown4")))) + (isearch-lazy-highlight-face ((t (:background "paleturquoise4")))) + (italic ((t (:italic t :slant italic)))) + (menu ((t (nil)))) + (mode-line ((t (:foreground "yellow" :background "darkslateblue" :box (:line-width -1 :style released-button))))) + (mouse ((t (:background "white")))) + (region ((t (:background "blue")))) + (scroll-bar ((t (nil)))) + (secondary-selection ((t (:background "darkslateblue")))) + (show-block-face1 ((t (:background "gray10")))) + (show-block-face2 ((t (:background "gray15")))) + (show-block-face3 ((t (:background "gray20")))) + (show-block-face4 ((t (:background "gray25")))) + (show-block-face5 ((t (:background "gray30")))) + (show-block-face6 ((t (:background "gray35")))) + (show-block-face7 ((t (:background "gray40")))) + (show-block-face8 ((t (:background "gray45")))) + (show-block-face9 ((t (:background "gray50")))) + (show-paren-match-face ((t (:background "turquoise")))) + (show-paren-mismatch-face ((t (:background "purple" :foreground "white")))) + (tool-bar ((t (:background "grey75" :foreground "black" :box (:line-width 1 :style released-button))))) + (tooltip ((t (:background "lightyellow" :foreground "black")))) + (trailing-whitespace ((t (:background "red")))) + (underline ((t (:underline t)))) + (variable-pitch ((t (:family "helv")))) + (widget-button-face ((t (:bold t :weight bold)))) + (widget-button-pressed-face ((t (:foreground "red")))) + (widget-documentation-face ((t (:foreground "lime green")))) + (widget-field-face ((t (:background "dim gray")))) + (widget-inactive-face ((t (:foreground "light gray")))) + (widget-single-line-field-face ((t (:background "dim gray"))))))) + +(defun color-theme-andreas () + "Color theme by Andreas Busch, created 2003-02-06." + (interactive) + (color-theme-install + '(color-theme-andreas + ((background-mode . light) + (background-color . "white") + (background-toolbar-color . "#cccccccccccc") + (border-color . "#000000000000") + (bottom-toolbar-shadow-color . "#7a7a7a7a7a7a") + (foreground-color . "black") + (top-toolbar-shadow-color . "#f5f5f5f5f5f5")) + ((gnus-mouse-face . highlight) + (ispell-highlight-face . highlight)) + (default ((t (nil)))) + (OrangeRed ((t (nil)))) + (blue ((t (:foreground "blue")))) + (bold ((t (:bold t)))) + (bold-italic ((t (:italic t :bold t)))) + (border-glyph ((t (nil)))) + (calendar-today-face ((t (:underline t)))) + (color-mode-face-@ ((t (:foreground "orange")))) + (color-mode-face-a ((t (:foreground "blue")))) + (color-mode-face-b ((t (:foreground "red")))) + (color-mode-face-c ((t (:foreground "green3")))) + (color-mode-face-d ((t (:background "red" :foreground "white")))) + (color-mode-face-e ((t (:background "orange" :foreground "blue")))) + (color-mode-face-f ((t (:background "blue" :foreground "yellow")))) + (color-mode-face-g ((t (:background "lightblue" :foreground "brown")))) + (color-mode-face-h ((t (:background "brown" :foreground "white")))) + (custom-button-face ((t (:bold t)))) + (custom-changed-face ((t (:background "blue" :foreground "white")))) + (custom-documentation-face ((t (nil)))) + (custom-face-tag-face ((t (:underline t)))) + (custom-group-tag-face ((t (:underline t :foreground "blue")))) + (custom-group-tag-face-1 ((t (:underline t :foreground "red")))) + (custom-invalid-face ((t (:background "red" :foreground "yellow")))) + (custom-modified-face ((t (:background "blue" :foreground "white")))) + (custom-rogue-face ((t (:background "black" :foreground "pink")))) + (custom-saved-face ((t (:underline t)))) + (custom-set-face ((t (:background "white" :foreground "blue")))) + (custom-state-face ((t (:foreground "dark green")))) + (custom-variable-button-face ((t (:underline t :bold t :background "gray90")))) + (custom-variable-tag-face ((t (:underline t :background "gray95" :foreground "blue")))) + (diary-face ((t (:foreground "red")))) + (display-time-mail-balloon-enhance-face ((t (:background "orange")))) + (display-time-mail-balloon-gnus-group-face ((t (:foreground "blue")))) + (display-time-time-balloon-face ((t (:foreground "red")))) + (emacs-wiki-bad-link-face ((t (:bold t :foreground "red")))) + (emacs-wiki-link-face ((t (:bold t :foreground "green")))) + (font-lock-comment-face ((t (:foreground "orange1")))) + (font-lock-doc-string-face ((t (:foreground "green4")))) + (font-lock-function-name-face ((t (:foreground "blue3")))) + (font-lock-keyword-face ((t (:foreground "red1")))) + (font-lock-preprocessor-face ((t (:foreground "blue3")))) + (font-lock-reference-face ((t (:foreground "red3")))) + (font-lock-string-face ((t (:foreground "green4")))) + (font-lock-type-face ((t (:foreground "#6920ac")))) + (font-lock-variable-name-face ((t (:foreground "blue3")))) + (font-lock-warning-face ((t (:bold t :foreground "Red")))) + (gnu-cite-face-3 ((t (nil)))) + (gnu-cite-face-4 ((t (nil)))) + (gnus-cite-attribution-face ((t (:underline t)))) + (gnus-cite-face-1 ((t (:foreground "MidnightBlue")))) + (gnus-cite-face-10 ((t (:foreground "medium purple")))) + (gnus-cite-face-11 ((t (:foreground "turquoise")))) + (gnus-cite-face-2 ((t (:foreground "firebrick")))) + (gnus-cite-face-3 ((t (:foreground "dark green")))) + (gnus-cite-face-4 ((t (:foreground "OrangeRed")))) + (gnus-cite-face-5 ((t (:foreground "dark khaki")))) + (gnus-cite-face-6 ((t (:foreground "dark violet")))) + (gnus-cite-face-7 ((t (:foreground "SteelBlue4")))) + (gnus-cite-face-8 ((t (:foreground "magenta")))) + (gnus-cite-face-9 ((t (:foreground "violet")))) + (gnus-emphasis-bold ((t (:bold t)))) + (gnus-emphasis-bold-italic ((t (:italic t :bold t)))) + (gnus-emphasis-italic ((t (:italic t)))) + (gnus-emphasis-underline ((t (:underline t)))) + (gnus-emphasis-underline-bold ((t (:underline t :bold t)))) + (gnus-emphasis-underline-bold-italic ((t (:underline t :italic t :bold t)))) + (gnus-emphasis-underline-italic ((t (:underline t :italic t)))) + (gnus-group-mail-1-empty-face ((t (:foreground "DeepPink3")))) + (gnus-group-mail-1-face ((t (:bold t :foreground "DeepPink3")))) + (gnus-group-mail-2-empty-face ((t (:foreground "HotPink3")))) + (gnus-group-mail-2-face ((t (:bold t :foreground "HotPink3")))) + (gnus-group-mail-3-empty-face ((t (:foreground "magenta4")))) + (gnus-group-mail-3-face ((t (:bold t :foreground "magenta4")))) + (gnus-group-mail-low-empty-face ((t (:foreground "DeepPink4")))) + (gnus-group-mail-low-face ((t (:bold t :foreground "DeepPink4")))) + (gnus-group-news-1-empty-face ((t (:foreground "ForestGreen")))) + (gnus-group-news-1-face ((t (:bold t :foreground "ForestGreen")))) + (gnus-group-news-2-empty-face ((t (:foreground "CadetBlue4")))) + (gnus-group-news-2-face ((t (:bold t :foreground "CadetBlue4")))) + (gnus-group-news-3-empty-face ((t (nil)))) + (gnus-group-news-3-face ((t (:bold t)))) + (gnus-group-news-4-empty-face ((t (nil)))) + (gnus-group-news-4-face ((t (:bold t)))) + (gnus-group-news-5-empty-face ((t (nil)))) + (gnus-group-news-5-face ((t (:bold t)))) + (gnus-group-news-6-empty-face ((t (nil)))) + (gnus-group-news-6-face ((t (:bold t)))) + (gnus-group-news-low-empty-face ((t (:foreground "DarkGreen")))) + (gnus-group-news-low-face ((t (:bold t :foreground "DarkGreen")))) + (gnus-header-content-face ((t (:italic t :foreground "indianred4")))) + (gnus-header-from-face ((t (:bold t :foreground "red3")))) + (gnus-header-name-face ((t (:foreground "maroon")))) + (gnus-header-newsgroups-face ((t (:italic t :bold t :foreground "MidnightBlue")))) + (gnus-header-subject-face ((t (:bold t :foreground "red4")))) + (gnus-splash-face ((t (:foreground "red")))) + (gnus-summary-cancelled-face ((t (:background "black" :foreground "yellow")))) + (gnus-summary-high-ancient-face ((t (:bold t :foreground "RoyalBlue")))) + (gnus-summary-high-read-face ((t (:bold t :foreground "DarkGreen")))) + (gnus-summary-high-ticked-face ((t (:bold t :foreground "DarkRed")))) + (gnus-summary-high-unread-face ((t (:bold t)))) + (gnus-summary-low-ancient-face ((t (:italic t :foreground "RoyalBlue")))) + (gnus-summary-low-read-face ((t (:italic t :foreground "DarkGreen")))) + (gnus-summary-low-ticked-face ((t (:italic t :foreground "firebrick")))) + (gnus-summary-low-unread-face ((t (:italic t)))) + (gnus-summary-normal-ancient-face ((t (:foreground "RoyalBlue")))) + (gnus-summary-normal-read-face ((t (:foreground "DarkGreen")))) + (gnus-summary-normal-ticked-face ((t (:foreground "Red")))) + (gnus-summary-normal-unread-face ((t (nil)))) + (gnus-summary-selected-face ((t (:underline t)))) + (gnus-x-face ((t (nil)))) + (green ((t (:foreground "green")))) + (gui-button-face ((t (:background "grey75")))) + (gui-element ((t (:background "Gray80")))) + (highlight ((t (nil)))) + (holiday-face ((t (:background "pink")))) + (hyper-apropos-documentation ((t (:foreground "darkred")))) + (hyper-apropos-heading ((t (:bold t)))) + (hyper-apropos-hyperlink ((t (:foreground "blue4")))) + (hyper-apropos-major-heading ((t (:bold t)))) + (hyper-apropos-section-heading ((t (:italic t :bold t)))) + (hyper-apropos-warning ((t (:bold t :foreground "red")))) + (info-node ((t (:italic t :bold t)))) + (info-xref ((t (:bold t)))) + (isearch ((t (:background "yellow" :foreground "red")))) + (italic ((t (:italic t)))) + (kai-gnus-cite-face-1 ((t (:foreground "LightCyan4")))) + (kai-gnus-cite-face-2 ((t (:foreground "LightSkyBlue2")))) + (kai-gnus-cite-face-3 ((t (:foreground "DodgerBlue3")))) + (kai-gnus-group-mail-face ((t (:foreground "darkslategrey")))) + (kai-gnus-group-nonempty-mail-face ((t (:foreground "DarkRed")))) + (kai-gnus-group-starred-face ((t (:foreground "grey50")))) + (left-margin ((t (nil)))) + (list-mode-item-selected ((t (:background "gray68")))) + (message-cited-text ((t (:italic t)))) + (message-cited-text-face ((t (:foreground "red")))) + (message-header-cc-face ((t (:foreground "MidnightBlue")))) + (message-header-contents ((t (:italic t)))) + (message-header-name-face ((t (:foreground "cornflower blue")))) + (message-header-newsgroups-face ((t (:italic t :bold t :foreground "blue4")))) + (message-header-other-face ((t (:foreground "steel blue")))) + (message-header-subject-face ((t (:bold t :foreground "navy blue")))) + (message-header-to-face ((t (:bold t :foreground "MidnightBlue")))) + (message-header-xheader-face ((t (:foreground "blue")))) + (message-headers ((t (:bold t)))) + (message-highlighted-header-contents ((t (:italic t :bold t)))) + (message-mml-face ((t (:foreground "ForestGreen")))) + (message-separator-face ((t (:foreground "brown")))) + (modeline ((t (:background "Gray75" :foreground "Black")))) + (modeline-buffer-id ((t (:background "Gray75" :foreground "blue4")))) + (modeline-mousable ((t (:background "Gray75" :foreground "firebrick")))) + (modeline-mousable-minor-mode ((t (:background "Gray75" :foreground "green4")))) + (paren-blink-off ((t (:foreground "gray80")))) + (paren-match ((t (:background "red" :foreground "white")))) + (paren-mismatch ((t (:background "DeepPink")))) + (pointer ((t (:foreground "blue")))) + (primary-selection ((t (:background "gray65")))) + (red ((t (:foreground "red")))) + (region ((t (:background "gray75")))) + (right-margin ((t (nil)))) + (secondary-selection ((t (:background "paleturquoise")))) + (text-cursor ((t (:background "red" :foreground "LightYellow1")))) + (toolbar ((t (:background "Gray80")))) + (underline ((t (:underline t)))) + (vertical-divider ((t (:background "Gray80")))) + (widget-button-face ((t (:bold t)))) + (widget-button-pressed-face ((t (:foreground "red")))) + (widget-documentation-face ((t (:foreground "dark green")))) + (widget-field-face ((t (:background "gray85")))) + (widget-inactive-face ((t (:foreground "dim gray")))) + (x-face ((t (:background "white")))) + (yellow ((t (:foreground "yellow")))) + (zmacs-region ((t (:background "gray65" :foreground "yellow"))))))) + +(defun color-theme-charcoal-black () + "Color theme by Lars Chr. Hausmann, created 2003-03-24." + (interactive) + (color-theme-install + '(color-theme-charcoal-black + ((background-color . "Grey15") + (background-mode . dark) + (border-color . "Grey") + (cursor-color . "Grey") + (foreground-color . "Grey") + (mouse-color . "Grey")) + ((display-time-mail-face . mode-line) + (gnus-article-button-face . bold) + (gnus-article-mouse-face . highlight) + (gnus-mouse-face . highlight) + (gnus-server-agent-face . gnus-server-agent-face) + (gnus-server-closed-face . gnus-server-closed-face) + (gnus-server-denied-face . gnus-server-denied-face) + (gnus-server-offline-face . gnus-server-offline-face) + (gnus-server-opened-face . gnus-server-opened-face) + (gnus-signature-face . gnus-signature-face) + (gnus-summary-selected-face . gnus-summary-selected-face) + (help-highlight-face . underline) + (list-matching-lines-face . bold) + (mime-button-face . bold) + (mime-button-mouse-face . highlight) + (sgml-set-face . t) + (tags-tag-face . default) + (view-highlight-face . highlight) + (widget-mouse-face . highlight)) + (default ((t (:stipple nil :background "Grey15" :foreground "Grey" :inverse-video nil :box nil :strike-through nil :overline nil :underline nil :slant normal :weight normal :height 87 :width semi-condensed :family "misc-fixed")))) + (Info-title-1-face ((t (:bold t :weight bold :family "helv" :height 1.728)))) + (Info-title-2-face ((t (:bold t :family "helv" :weight bold :height 1.44)))) + (Info-title-3-face ((t (:bold t :weight bold :family "helv" :height 1.2)))) + (Info-title-4-face ((t (:bold t :family "helv" :weight bold)))) + (bg:erc-color-face0 ((t (nil)))) + (bg:erc-color-face1 ((t (nil)))) + (bg:erc-color-face10 ((t (nil)))) + (bg:erc-color-face11 ((t (nil)))) + (bg:erc-color-face12 ((t (nil)))) + (bg:erc-color-face13 ((t (nil)))) + (bg:erc-color-face14 ((t (nil)))) + (bg:erc-color-face15 ((t (nil)))) + (bg:erc-color-face2 ((t (nil)))) + (bg:erc-color-face3 ((t (nil)))) + (bg:erc-color-face4 ((t (nil)))) + (bg:erc-color-face5 ((t (nil)))) + (bg:erc-color-face6 ((t (nil)))) + (bg:erc-color-face7 ((t (nil)))) + (bg:erc-color-face8 ((t (nil)))) + (bg:erc-color-face9 ((t (nil)))) + (bold ((t (:bold t :weight bold)))) + (bold-italic ((t (:bold t :foreground "beige" :weight bold)))) + (border ((t (:background "Grey")))) + (calendar-today-face ((t (:underline t)))) + (comint-highlight-input ((t (:bold t :weight bold)))) + (comint-highlight-prompt ((t (:foreground "cyan")))) + (cperl-array-face ((t (:bold t :foreground "light salmon" :weight bold)))) + (cperl-hash-face ((t (:italic t :bold t :foreground "beige" :slant italic :weight bold)))) + (cperl-nonoverridable-face ((t (:foreground "aquamarine")))) + (cursor ((t (:background "Grey")))) + (custom-button-face ((t (:foreground "gainsboro")))) + (custom-button-pressed-face ((t (:background "lightgrey" :foreground "black" :box (:line-width 2 :style pressed-button))))) + (custom-changed-face ((t (:background "blue" :foreground "white")))) + (custom-comment-face ((t (:background "dim gray")))) + (custom-comment-tag-face ((t (:foreground "gray80")))) + (custom-documentation-face ((t (:foreground "light blue")))) + (custom-face-tag-face ((t (:underline t)))) + (custom-group-tag-face ((t (:bold t :foreground "pale turquoise" :weight bold)))) + (custom-group-tag-face-1 ((t (:foreground "pale turquoise" :underline t)))) + (custom-invalid-face ((t (:background "red" :foreground "yellow")))) + (custom-modified-face ((t (:background "blue" :foreground "white")))) + (custom-rogue-face ((t (:background "black" :foreground "pink")))) + (custom-saved-face ((t (:underline t)))) + (custom-set-face ((t (:background "white" :foreground "blue")))) + (custom-state-face ((t (:foreground "light salmon")))) + (custom-variable-button-face ((t (:bold t :underline t :weight bold)))) + (custom-variable-tag-face ((t (:bold t :foreground "turquoise" :weight bold)))) + (diary-face ((t (:foreground "red")))) + (dired-face-directory ((t (:bold t :foreground "sky blue" :weight bold)))) + (dired-face-executable ((t (:foreground "green yellow")))) + (dired-face-flagged ((t (:foreground "tomato")))) + (dired-face-marked ((t (:foreground "light salmon")))) + (dired-face-permissions ((t (:foreground "aquamarine")))) + (erc-action-face ((t (nil)))) + (erc-bold-face ((t (:bold t :weight bold)))) + (erc-default-face ((t (nil)))) + (erc-direct-msg-face ((t (:foreground "pale green")))) + (erc-error-face ((t (:bold t :foreground "IndianRed" :weight bold)))) + (erc-highlight-face ((t (:bold t :foreground "pale green" :weight bold)))) + (erc-input-face ((t (:foreground "light blue")))) + (erc-inverse-face ((t (:background "steel blue")))) + (erc-notice-face ((t (:foreground "light salmon")))) + (erc-pal-face ((t (:foreground "pale green")))) + (erc-prompt-face ((t (:bold t :foreground "light blue" :weight bold)))) + (eshell-ls-archive-face ((t (:bold t :foreground "medium purple" :weight bold)))) + (eshell-ls-backup-face ((t (:foreground "dim gray")))) + (eshell-ls-clutter-face ((t (:foreground "dim gray")))) + (eshell-ls-directory-face ((t (:bold t :foreground "medium slate blue" :weight bold)))) + (eshell-ls-executable-face ((t (:bold t :foreground "aquamarine" :weight bold)))) + (eshell-ls-missing-face ((t (:foreground "black")))) + (eshell-ls-picture-face ((t (:foreground "violet")))) + (eshell-ls-product-face ((t (:foreground "light steel blue")))) + (eshell-ls-readonly-face ((t (:foreground "aquamarine")))) + (eshell-ls-special-face ((t (:foreground "gold")))) + (eshell-ls-symlink-face ((t (:foreground "white")))) + (eshell-ls-unreadable-face ((t (:foreground "dim gray")))) + (eshell-prompt-face ((t (:bold t :foreground "light sky blue" :weight bold)))) + (excerpt ((t (:italic t :slant italic)))) + (fg:erc-color-face0 ((t (:foreground "white")))) + (fg:erc-color-face1 ((t (:foreground "beige")))) + (fg:erc-color-face10 ((t (:foreground "pale goldenrod")))) + (fg:erc-color-face11 ((t (:foreground "light goldenrod yellow")))) + (fg:erc-color-face12 ((t (:foreground "light yellow")))) + (fg:erc-color-face13 ((t (:foreground "yellow")))) + (fg:erc-color-face14 ((t (:foreground "light goldenrod")))) + (fg:erc-color-face15 ((t (:foreground "lime green")))) + (fg:erc-color-face2 ((t (:foreground "lemon chiffon")))) + (fg:erc-color-face3 ((t (:foreground "light cyan")))) + (fg:erc-color-face4 ((t (:foreground "powder blue")))) + (fg:erc-color-face5 ((t (:foreground "sky blue")))) + (fg:erc-color-face6 ((t (:foreground "dark sea green")))) + (fg:erc-color-face7 ((t (:foreground "pale green")))) + (fg:erc-color-face8 ((t (:foreground "medium spring green")))) + (fg:erc-color-face9 ((t (:foreground "khaki")))) + (fixed ((t (:bold t :weight bold)))) + (fixed-pitch ((t (:family "courier")))) + (flyspell-duplicate-face ((t (:bold t :foreground "Gold3" :underline t :weight bold)))) + (flyspell-incorrect-face ((t (:bold t :foreground "OrangeRed" :underline t :weight bold)))) + (font-lock-builtin-face ((t (:foreground "aquamarine")))) + (font-lock-comment-face ((t (:foreground "light blue")))) + (font-lock-constant-face ((t (:foreground "pale green")))) + (font-lock-doc-face ((t (:foreground "light sky blue")))) + (font-lock-doc-string-face ((t (:foreground "sky blue")))) + (font-lock-function-name-face ((t (:bold t :foreground "aquamarine" :weight bold)))) + (font-lock-keyword-face ((t (:bold t :foreground "pale turquoise" :weight bold)))) + (font-lock-reference-face ((t (:foreground "pale green")))) + (font-lock-string-face ((t (:foreground "light sky blue")))) + (font-lock-type-face ((t (:bold t :foreground "sky blue" :weight bold)))) + (font-lock-variable-name-face ((t (:bold t :foreground "turquoise" :weight bold)))) + (font-lock-warning-face ((t (:bold t :foreground "Red" :weight bold)))) + (fringe ((t (:background "Grey15")))) + (gnus-cite-face-1 ((t (:foreground "LightSalmon")))) + (gnus-cite-face-2 ((t (:foreground "Khaki")))) + (gnus-cite-face-3 ((t (:foreground "Coral")))) + (gnus-cite-face-4 ((t (:foreground "yellow green")))) + (gnus-cite-face-5 ((t (:foreground "dark khaki")))) + (gnus-cite-face-6 ((t (:foreground "bisque")))) + (gnus-cite-face-7 ((t (:foreground "peru")))) + (gnus-cite-face-8 ((t (:foreground "light coral")))) + (gnus-cite-face-9 ((t (:foreground "plum")))) + (gnus-emphasis-bold ((t (:bold t :weight bold)))) + (gnus-emphasis-bold-italic ((t (:italic t :bold t :slant italic :weight bold)))) + (gnus-emphasis-highlight-words ((t (:background "black" :foreground "yellow")))) + (gnus-emphasis-italic ((t (:italic t :slant italic)))) + (gnus-emphasis-strikethru ((t (nil)))) + (gnus-emphasis-underline ((t (:underline t)))) + (gnus-emphasis-underline-bold ((t (:bold t :underline t :weight bold)))) + (gnus-emphasis-underline-bold-italic ((t (:italic t :bold t :underline t :slant italic :weight bold)))) + (gnus-emphasis-underline-italic ((t (:italic t :underline t :slant italic)))) + (gnus-group-mail-1-empty-face ((t (:foreground "White")))) + (gnus-group-mail-1-face ((t (:bold t :foreground "White" :weight bold)))) + (gnus-group-mail-2-empty-face ((t (:foreground "light cyan")))) + (gnus-group-mail-2-face ((t (:bold t :foreground "light cyan" :weight bold)))) + (gnus-group-mail-3-empty-face ((t (:foreground "LightBlue")))) + (gnus-group-mail-3-face ((t (:bold t :foreground "LightBlue" :weight bold)))) + (gnus-group-mail-low-empty-face ((t (:foreground "Aquamarine")))) + (gnus-group-mail-low-face ((t (:bold t :foreground "Aquamarine" :weight bold)))) + (gnus-group-news-1-empty-face ((t (:foreground "White")))) + (gnus-group-news-1-face ((t (:bold t :foreground "White" :weight bold)))) + (gnus-group-news-2-empty-face ((t (:foreground "light cyan")))) + (gnus-group-news-2-face ((t (:bold t :foreground "light cyan" :weight bold)))) + (gnus-group-news-3-empty-face ((t (:foreground "LightBlue")))) + (gnus-group-news-3-face ((t (:bold t :foreground "LightBlue" :weight bold)))) + (gnus-group-news-4-empty-face ((t (:foreground "Aquamarine")))) + (gnus-group-news-4-face ((t (:bold t :foreground "Aquamarine" :weight bold)))) + (gnus-group-news-5-empty-face ((t (:foreground "MediumAquamarine")))) + (gnus-group-news-5-face ((t (:bold t :foreground "MediumAquamarine" :weight bold)))) + (gnus-group-news-6-empty-face ((t (:foreground "MediumAquamarine")))) + (gnus-group-news-6-face ((t (:bold t :foreground "MediumAquamarine" :weight bold)))) + (gnus-group-news-low-empty-face ((t (:foreground "MediumAquamarine")))) + (gnus-group-news-low-face ((t (:bold t :foreground "MediumAquamarine" :weight bold)))) + (gnus-header-content-face ((t (:foreground "LightSkyBlue3")))) + (gnus-header-from-face ((t (:bold t :foreground "light cyan" :weight bold)))) + (gnus-header-name-face ((t (:bold t :foreground "LightBlue" :weight bold)))) + (gnus-header-newsgroups-face ((t (:italic t :bold t :foreground "MediumAquamarine" :slant italic :weight bold)))) + (gnus-header-subject-face ((t (:bold t :foreground "light cyan" :weight bold)))) + (gnus-server-agent-face ((t (:bold t :foreground "PaleTurquoise" :weight bold)))) + (gnus-server-closed-face ((t (:italic t :foreground "Light Steel Blue" :slant italic)))) + (gnus-server-denied-face ((t (:bold t :foreground "Pink" :weight bold)))) + (gnus-server-offline-face ((t (:bold t :foreground "Yellow" :weight bold)))) + (gnus-server-opened-face ((t (:bold t :foreground "Green1" :weight bold)))) + (gnus-signature-face ((t (:foreground "Grey")))) + (gnus-splash-face ((t (:foreground "ForestGreen")))) + (gnus-summary-cancelled-face ((t (:background "Black" :foreground "Yellow")))) + (gnus-summary-high-ancient-face ((t (:bold t :foreground "MediumAquamarine" :weight bold)))) + (gnus-summary-high-read-face ((t (:bold t :foreground "Aquamarine" :weight bold)))) + (gnus-summary-high-ticked-face ((t (:bold t :foreground "LightSalmon" :weight bold)))) + (gnus-summary-high-unread-face ((t (:italic t :bold t :foreground "beige" :slant italic :weight bold)))) + (gnus-summary-low-ancient-face ((t (:italic t :foreground "DimGray" :slant italic)))) + (gnus-summary-low-read-face ((t (:foreground "slate gray")))) + (gnus-summary-low-ticked-face ((t (:foreground "Pink")))) + (gnus-summary-low-unread-face ((t (:foreground "LightGray")))) + (gnus-summary-normal-ancient-face ((t (:foreground "MediumAquamarine")))) + (gnus-summary-normal-read-face ((t (:foreground "Aquamarine")))) + (gnus-summary-normal-ticked-face ((t (:foreground "LightSalmon")))) + (gnus-summary-normal-unread-face ((t (nil)))) + (gnus-summary-selected-face ((t (:underline t)))) + (header-line ((t (:box (:line-width -1 :style released-button) :background "grey20" :foreground "grey90" :box nil)))) + (highlight ((t (:background "dark slate blue" :foreground "light blue")))) + (highline-face ((t (:background "DeepSkyBlue4")))) + (holiday-face ((t (:background "pink")))) + (info-header-node ((t (:bold t :weight bold)))) + (info-header-xref ((t (:bold t :weight bold :foreground "sky blue")))) + (info-menu-5 ((t (:underline t)))) + (info-menu-header ((t (:bold t :family "helv" :weight bold)))) + (info-node ((t (:bold t :weight bold)))) + (info-xref ((t (:bold t :foreground "sky blue" :weight bold)))) + (isearch ((t (:background "slate blue")))) + (isearch-lazy-highlight-face ((t (:background "paleturquoise4")))) + (italic ((t (:foreground "sky blue")))) + (jde-bug-breakpoint-cursor ((t (:background "brown" :foreground "cyan")))) + (jde-bug-breakpoint-marker ((t (:background "yellow" :foreground "red")))) + (jde-java-font-lock-api-face ((t (:foreground "light goldenrod")))) + (jde-java-font-lock-bold-face ((t (:bold t :weight bold)))) + (jde-java-font-lock-code-face ((t (nil)))) + (jde-java-font-lock-constant-face ((t (:foreground "Aquamarine")))) + (jde-java-font-lock-doc-tag-face ((t (:foreground "light coral")))) + (jde-java-font-lock-italic-face ((t (:italic t :slant italic)))) + (jde-java-font-lock-link-face ((t (:foreground "blue" :underline t :slant normal)))) + (jde-java-font-lock-modifier-face ((t (:foreground "LightSteelBlue")))) + (jde-java-font-lock-number-face ((t (:foreground "LightSalmon")))) + (jde-java-font-lock-package-face ((t (:foreground "steelblue1")))) + (jde-java-font-lock-pre-face ((t (nil)))) + (jde-java-font-lock-underline-face ((t (:underline t)))) + (makefile-space-face ((t (:background "hotpink")))) + (menu ((t (:background "MidnightBlue" :foreground "Grey")))) + (message-cited-text-face ((t (:foreground "LightSalmon")))) + (message-header-cc-face ((t (:foreground "light cyan")))) + (message-header-name-face ((t (:foreground "LightBlue")))) + (message-header-newsgroups-face ((t (:italic t :bold t :foreground "MediumAquamarine" :slant italic :weight bold)))) + (message-header-other-face ((t (:foreground "MediumAquamarine")))) + (message-header-subject-face ((t (:bold t :foreground "light cyan" :weight bold)))) + (message-header-to-face ((t (:bold t :foreground "light cyan" :weight bold)))) + (message-header-xheader-face ((t (:foreground "MediumAquamarine")))) + (message-mml-face ((t (:foreground "ForestGreen")))) + (message-separator-face ((t (:foreground "chocolate")))) + (mode-line ((t (:background "grey75" :foreground "black" :box (:line-width -1 :style released-button))))) + (mouse ((t (:background "Grey")))) + (region ((t (:background "DarkSlateBlue")))) + (scroll-bar ((t (:background "grey75")))) + (secondary-selection ((t (:background "steel blue")))) + (semantic-dirty-token-face ((t (:background "gray10")))) + (semantic-unmatched-syntax-face ((t (:underline "red")))) + (show-paren-match-face ((t (:background "light slate blue" :foreground "white")))) + (show-paren-mismatch-face ((t (:background "red" :foreground "white")))) + (speedbar-button-face ((t (:foreground "seashell2")))) + (speedbar-directory-face ((t (:foreground "seashell3")))) + (speedbar-file-face ((t (:foreground "seashell4")))) + (speedbar-highlight-face ((t (:background "dark slate blue" :foreground "wheat")))) + (speedbar-selected-face ((t (:foreground "seashell1" :underline t)))) + (speedbar-separator-face ((t (:background "blue" :foreground "white" :overline "gray")))) + (speedbar-tag-face ((t (:foreground "antique white")))) + (tool-bar ((t (:background "grey75" :foreground "black" :box (:line-width 1 :style released-button))))) + (tooltip ((t (:background "lightyellow" :foreground "black")))) + (trailing-whitespace ((t (:background "red")))) + (underline ((t (:underline t)))) + (variable-pitch ((t (:family "helv")))) + (widget-button-face ((t (:bold t :weight bold)))) + (widget-button-pressed-face ((t (:foreground "red")))) + (widget-documentation-face ((t (:foreground "light blue")))) + (widget-field-face ((t (:background "RoyalBlue4" :foreground "wheat")))) + (widget-inactive-face ((t (:foreground "dim gray")))) + (widget-single-line-field-face ((t (:background "slate blue" :foreground "wheat")))) + (woman-bold-face ((t (:bold t :foreground "sky blue" :weight bold)))) + (woman-italic-face ((t (:foreground "deep sky blue")))) + (woman-unknown-face ((t (:foreground "LightSalmon")))) + (zmacs-region ((t (:background "DarkSlateBlue"))))))) + +(defun color-theme-vim-colors () + "Color theme by Michael Soulier, created 2003-03-26." + (interactive) + (color-theme-install + '(color-theme-vim-colors + ((background-color . "#ffffff") + (background-mode . light) + (border-color . "black") + (cursor-color . "#000000") + (foreground-color . "#000000") + (mouse-color . "#000000")) + ((Man-overstrike-face . bold) + (Man-underline-face . underline) + (apropos-keybinding-face . underline) + (apropos-label-face . italic) + (apropos-match-face . secondary-selection) + (apropos-property-face . bold-italic) + (apropos-symbol-face . bold) + (cperl-here-face . font-lock-string-face) + (cperl-invalid-face quote underline) + (cperl-pod-face . font-lock-comment-face) + (cperl-pod-head-face . font-lock-variable-name-face) + (help-highlight-face . underline) + (ispell-highlight-face . highlight) + (list-matching-lines-face . bold) + (rpm-spec-dir-face . rpm-spec-dir-face) + (rpm-spec-doc-face . rpm-spec-doc-face) + (rpm-spec-ghost-face . rpm-spec-ghost-face) + (rpm-spec-macro-face . rpm-spec-macro-face) + (rpm-spec-package-face . rpm-spec-package-face) + (rpm-spec-tag-face . rpm-spec-tag-face) + (tags-tag-face . default) + (view-highlight-face . highlight) + (widget-mouse-face . highlight)) + (default ((t (:background "#ffffff" :foreground "#000000")))) + (Info-title-1-face ((t (nil)))) + (Info-title-2-face ((t (nil)))) + (Info-title-3-face ((t (nil)))) + (Info-title-4-face ((t (:bold (bold extra-bold ultra-bold))))) + (bold ((t (:bold (bold extra-bold ultra-bold))))) + (bold-italic ((t (:italic (italic oblique) :bold (bold extra-bold ultra-bold))))) + (border ((t (:background "black")))) + (comint-highlight-input ((t (:bold (bold extra-bold ultra-bold))))) + (comint-highlight-prompt ((t (:foreground "dark blue")))) + (cperl-array-face ((t (:foreground "brown")))) + (cperl-hash-face ((t (:foreground "red")))) + (cperl-nonoverridable-face ((t (:foreground "#008b8b")))) + (cursor ((t (:background "#000000")))) + (fixed-pitch ((t (nil)))) + (font-lock-builtin-face ((t (:foreground "purple")))) + (font-lock-comment-face ((t (:foreground "blue")))) + (font-lock-constant-face ((t (:foreground "green4")))) + (font-lock-doc-face ((t (:background "#f2f2f2")))) + (font-lock-function-name-face ((t (:foreground "#008b8b")))) + (font-lock-keyword-face ((t (:bold (bold extra-bold ultra-bold) :foreground "#a52a2a")))) + (font-lock-string-face ((t (:background "#f2f2f2" :foreground "#ff00ff")))) + (font-lock-type-face ((t (:foreground "ForestGreen")))) + (font-lock-variable-name-face ((t (:foreground "#008b8b")))) + (font-lock-warning-face ((t (:bold (bold extra-bold ultra-bold) :foreground "Red")))) + (fringe ((t (:background "#e5e5e5")))) + (header-line ((t (:background "grey90" :foreground "grey20")))) + (highlight ((t (:background "darkseagreen2")))) + (info-header-node ((t (nil)))) + (info-header-xref ((t (nil)))) + (info-menu-5 ((t (:foreground "red1")))) + (info-menu-header ((t (:bold (bold extra-bold ultra-bold))))) + (info-node ((t (:italic (italic oblique) :bold (bold extra-bold ultra-bold) :foreground "brown")))) + (info-xref ((t (:bold (bold extra-bold ultra-bold) :foreground "magenta4")))) + (isearch ((t (:background "magenta4" :foreground "lightskyblue1")))) + (isearch-lazy-highlight-face ((t (:background "paleturquoise")))) + (italic ((t (:italic (italic oblique))))) + (menu ((t (nil)))) + (mode-line ((t (:background "grey75" :foreground "black")))) + (mouse ((t (:background "#000000")))) + (region ((t (:background "lightgoldenrod2")))) + (rpm-spec-dir-face ((t (:foreground "green")))) + (rpm-spec-doc-face ((t (:foreground "magenta")))) + (rpm-spec-ghost-face ((t (:foreground "red")))) + (rpm-spec-macro-face ((t (:foreground "purple")))) + (rpm-spec-package-face ((t (:foreground "red")))) + (rpm-spec-tag-face ((t (:foreground "blue")))) + (scroll-bar ((t (:background "grey75" :foreground "#000000")))) + (secondary-selection ((t (:background "yellow")))) + (sh-heredoc-face ((t (:foreground "tan")))) + (show-paren-match-face ((t (:background "turquoise")))) + (show-paren-mismatch-face ((t (:background "purple" :foreground "white")))) + (tool-bar ((t (:background "grey75" :foreground "black")))) + (tooltip ((t (:background "lightyellow" :foreground "black")))) + (trailing-whitespace ((t (:background "red")))) + (underline ((t (:underline t)))) + (variable-pitch ((t (nil)))) + (widget-button-face ((t (:bold (bold extra-bold ultra-bold))))) + (widget-button-pressed-face ((t (:foreground "red")))) + (widget-documentation-face ((t (:foreground "dark green")))) + (widget-field-face ((t (:background "gray85")))) + (widget-inactive-face ((t (:foreground "dim gray")))) + (widget-single-line-field-face ((t (:background "gray85"))))))) + +(defun color-theme-calm-forest () + "Color theme by Artur Hefczyc, created 2003-04-18." + (interactive) + (color-theme-install + '(color-theme-calm-forest + ((background-color . "gray12") + (background-mode . dark) + (border-color . "black") + (cursor-color . "orange") + (foreground-color . "green") + (mouse-color . "yellow")) + ((help-highlight-face . underline) + (list-matching-lines-face . bold) + (senator-eldoc-use-color . t) + (view-highlight-face . highlight) + (widget-mouse-face . highlight)) + (default ((t (:stipple nil :background "gray12" :foreground "green" :inverse-video nil :box nil +:strike-through nil :overline nil :underline nil :slant normal :weight normal :height 98 :width +normal :family "outline-courier new")))) + (Info-title-1-face ((t (:bold t :weight bold :family "helv" :height 1.728)))) + (Info-title-2-face ((t (:bold t :family "helv" :weight bold :height 1.44)))) + (Info-title-3-face ((t (:bold t :weight bold :family "helv" :height 1.2)))) + (Info-title-4-face ((t (:bold t :family "helv" :weight bold)))) + (bold ((t (:bold t :weight bold)))) + (bold-italic ((t (:italic t :bold t :slant italic :weight bold)))) + (border ((t (:background "black")))) + (comint-highlight-input ((t (:bold t :weight bold)))) + (comint-highlight-prompt ((t (:foreground "cyan")))) + (cparen-around-andor-face ((t (:bold t :foreground "maroon" :weight bold)))) + (cparen-around-begin-face ((t (:foreground "maroon")))) + (cparen-around-conditional-face ((t (:bold t :foreground "RoyalBlue" :weight bold)))) + (cparen-around-define-face ((t (:bold t :foreground "Blue" :weight bold)))) + (cparen-around-lambda-face ((t (:foreground "LightSeaGreen")))) + (cparen-around-letdo-face ((t (:bold t :foreground "LightSeaGreen" :weight bold)))) + (cparen-around-quote-face ((t (:foreground "SaddleBrown")))) + (cparen-around-set!-face ((t (:foreground "OrangeRed")))) + (cparen-around-syntax-rules-face ((t (:foreground "Magenta")))) + (cparen-around-vector-face ((t (:foreground "chocolate")))) + (cparen-binding-face ((t (:foreground "ForestGreen")))) + (cparen-binding-list-face ((t (:bold t :foreground "ForestGreen" :weight bold)))) + (cparen-conditional-clause-face ((t (:foreground "RoyalBlue")))) + (cparen-normal-paren-face ((t (:foreground "grey50")))) + (cursor ((t (:background "orange")))) + (custom-button-face ((t (:background "lightgrey" :foreground "black" :box (:line-width 2 :style +released-button))))) + (custom-button-pressed-face ((t (:background "lightgrey" :foreground "black" :box (:line-width +2 :style pressed-button))))) + (custom-changed-face ((t (:background "blue" :foreground "white")))) + (custom-comment-face ((t (:background "dim gray")))) + (custom-comment-tag-face ((t (:foreground "gray80")))) + (custom-documentation-face ((t (nil)))) + (custom-face-tag-face ((t (:bold t :family "helv" :weight bold :height 1.2)))) + (custom-group-tag-face ((t (:bold t :foreground "light blue" :weight bold :height 1.2)))) + (custom-group-tag-face-1 ((t (:bold t :family "helv" :foreground "pink" :weight bold :height +1.2)))) + (custom-invalid-face ((t (:background "red" :foreground "yellow")))) + (custom-modified-face ((t (:background "blue" :foreground "white")))) + (custom-rogue-face ((t (:background "black" :foreground "pink")))) + (custom-saved-face ((t (:underline t)))) + (custom-set-face ((t (:background "white" :foreground "blue")))) + (custom-state-face ((t (:foreground "lime green")))) + (custom-variable-button-face ((t (:bold t :underline t :weight bold)))) + (custom-variable-tag-face ((t (:bold t :family "helv" :foreground "light blue" :weight bold +:height 1.2)))) + (eieio-custom-slot-tag-face ((t (:foreground "light blue")))) + (extra-whitespace-face ((t (:background "pale green")))) + (fixed-pitch ((t (:family "courier")))) + (font-latex-bold-face ((t (:bold t :foreground "OliveDrab" :weight bold)))) + (font-latex-italic-face ((t (:italic t :foreground "OliveDrab" :slant italic)))) + (font-latex-math-face ((t (:foreground "burlywood")))) + (font-latex-sedate-face ((t (:foreground "LightGray")))) + (font-latex-string-face ((t (:foreground "RosyBrown")))) + (font-latex-warning-face ((t (:bold t :foreground "Red" :weight bold)))) + (font-lock-builtin-face ((t (:foreground "LightSteelBlue")))) + (font-lock-comment-face ((t (:foreground "chocolate1")))) + (font-lock-constant-face ((t (:foreground "Aquamarine")))) + (font-lock-doc-face ((t (:foreground "LightSalmon")))) + (font-lock-function-name-face ((t (:foreground "LightSkyBlue")))) + (font-lock-keyword-face ((t (:foreground "Cyan")))) + (font-lock-string-face ((t (:foreground "LightSalmon")))) + (font-lock-type-face ((t (:foreground "PaleGreen")))) + (font-lock-variable-name-face ((t (:foreground "LightGoldenrod")))) + (font-lock-warning-face ((t (:bold t :foreground "Pink" :weight bold)))) + (fringe ((t (:background "grey10")))) + (header-line ((t (:box (:line-width -1 :style released-button) :background "grey20" :foreground +"grey90" :box nil)))) + (highlight ((t (:background "darkolivegreen")))) + (info-header-node ((t (:italic t :bold t :weight bold :slant italic :foreground "white")))) + (info-header-xref ((t (:bold t :weight bold :foreground "cyan")))) + (info-menu-5 ((t (:foreground "red1")))) + (info-menu-header ((t (:bold t :family "helv" :weight bold)))) + (info-node ((t (:italic t :bold t :foreground "white" :slant italic :weight bold)))) + (info-xref ((t (:bold t :foreground "cyan" :weight bold)))) + (isearch ((t (:background "palevioletred2" :foreground "brown4")))) + (isearch-lazy-highlight-face ((t (:background "paleturquoise4")))) + (italic ((t (:italic t :slant italic)))) + (jde-bug-breakpoint-cursor ((t (:background "brown" :foreground "cyan")))) + (jde-db-active-breakpoint-face ((t (:background "red" :foreground "black")))) + (jde-db-requested-breakpoint-face ((t (:background "yellow" :foreground "black")))) + (jde-db-spec-breakpoint-face ((t (:background "green" :foreground "black")))) + (jde-java-font-lock-api-face ((t (:foreground "light goldenrod")))) + (jde-java-font-lock-bold-face ((t (:bold t :weight bold)))) + (jde-java-font-lock-code-face ((t (nil)))) + (jde-java-font-lock-constant-face ((t (:foreground "Aquamarine")))) + (jde-java-font-lock-doc-tag-face ((t (:foreground "light coral")))) + (jde-java-font-lock-italic-face ((t (:italic t :slant italic)))) + (jde-java-font-lock-link-face ((t (:foreground "blue" :underline t :slant normal)))) + (jde-java-font-lock-modifier-face ((t (:foreground "LightSteelBlue")))) + (jde-java-font-lock-number-face ((t (:foreground "LightSalmon")))) + (jde-java-font-lock-operator-face ((t (:foreground "medium blue")))) + (jde-java-font-lock-package-face ((t (:foreground "steelblue1")))) + (jde-java-font-lock-pre-face ((t (nil)))) + (jde-java-font-lock-underline-face ((t (:underline t)))) + (menu ((t (nil)))) + (mode-line ((t (:background "grey75" :foreground "black" :box (:line-width -1 :style +released-button))))) + (mouse ((t (:background "yellow")))) + (region ((t (:background "blue3")))) + (scroll-bar ((t (nil)))) + (secondary-selection ((t (:background "SkyBlue4")))) + (semantic-dirty-token-face ((t (:background "gray10")))) + (semantic-unmatched-syntax-face ((t (:underline "red")))) + (senator-intangible-face ((t (:foreground "gray75")))) + (senator-momentary-highlight-face ((t (:background "gray30")))) + (senator-read-only-face ((t (:background "#664444")))) + (show-paren-match-face ((t (:background "turquoise")))) + (show-paren-mismatch-face ((t (:background "purple" :foreground "white")))) + (speedbar-button-face ((t (:foreground "green3")))) + (speedbar-directory-face ((t (:foreground "light blue")))) + (speedbar-file-face ((t (:foreground "cyan")))) + (speedbar-highlight-face ((t (:background "sea green")))) + (speedbar-selected-face ((t (:foreground "red" :underline t)))) + (speedbar-separator-face ((t (:background "blue" :foreground "white" :overline "gray")))) + (speedbar-tag-face ((t (:foreground "yellow")))) + (tool-bar ((t (:background "grey75" :foreground "black" :box (:line-width 1 :style +released-button))))) + (trailing-whitespace ((t (:background "red")))) + (underline ((t (:underline t)))) + (variable-pitch ((t (:family "helv")))) + (widget-button-face ((t (:bold t :weight bold)))) + (widget-button-pressed-face ((t (:foreground "red")))) + (widget-documentation-face ((t (:foreground "lime green")))) + (widget-field-face ((t (:background "dim gray")))) + (widget-inactive-face ((t (:foreground "light gray")))) + (widget-single-line-field-face ((t (:background "dim gray"))))))) + +(defun color-theme-lawrence () + "Color theme by lawrence mitchell . +Mainly shades of green. +Contains faces for erc, gnus, most of jde." + (interactive) + (color-theme-install + '(color-theme-lawrence + ((background-color . "black") + (background-mode . dark) + (border-color . "black") + (cursor-color . "green") + (foreground-color . "#00CC00") + (mouse-color . "black")) + ((erc-button-face . bold) + (erc-button-mouse-face . highlight) + (gnus-article-button-face . bold) + (gnus-article-mouse-face . highlight) + (gnus-cite-attribution-face . gnus-cite-attribution-face) + (gnus-mouse-face . highlight) + (gnus-server-agent-face . gnus-server-agent-face) + (gnus-server-closed-face . gnus-server-closed-face) + (gnus-server-denied-face . gnus-server-denied-face) + (gnus-server-offline-face . gnus-server-offline-face) + (gnus-server-opened-face . gnus-server-opened-face) + (gnus-signature-face . gnus-signature-face) + (gnus-summary-selected-face . gnus-summary-selected-face) + (gnus-treat-display-face . head) + (gnus-treat-display-xface . head) + (list-matching-lines-buffer-name-face . underline) + (list-matching-lines-face . bold) + (paren-match-face . paren-face-match) + (paren-mismatch-face . paren-face-mismatch) + (paren-no-match-face . paren-face-no-match) + (sgml-set-face . t) + (tags-tag-face . default) + (view-highlight-face . highlight) + (widget-mouse-face . highlight)) + (default ((t (nil)))) + (Buffer-menu-buffer-face ((t (:bold t :weight bold)))) + (bg:erc-color-face0 ((t (:background "White")))) + (bg:erc-color-face1 ((t (:background "black")))) + (bg:erc-color-face10 ((t (:background "lightblue1")))) + (bg:erc-color-face11 ((t (:background "cyan")))) + (bg:erc-color-face12 ((t (:background "blue")))) + (bg:erc-color-face13 ((t (:background "deeppink")))) + (bg:erc-color-face14 ((t (:background "gray50")))) + (bg:erc-color-face15 ((t (:background "gray90")))) + (bg:erc-color-face2 ((t (:background "blue4")))) + (bg:erc-color-face3 ((t (:background "green4")))) + (bg:erc-color-face4 ((t (:background "red")))) + (bg:erc-color-face5 ((t (:background "brown")))) + (bg:erc-color-face6 ((t (:background "purple")))) + (bg:erc-color-face7 ((t (:background "orange")))) + (bg:erc-color-face8 ((t (:background "yellow")))) + (bg:erc-color-face9 ((t (:background "green")))) + (bold ((t (:bold t :foreground "#00CC00" :background "black")))) + (bold-italic ((t (:italic t :bold t :slant oblique :weight semi-bold)))) + (border ((t (:background "black")))) + (button ((t (:underline t)))) + (comint-highlight-input ((t (nil)))) + (comint-highlight-prompt ((t (:bold t :foreground "#00CC00" :background "black" :weight bold)))) + (cursor ((t (:background "green")))) + (custom-button-face ((t (:bold t :foreground "#00CC00" :background "black")))) + (custom-button-pressed-face ((t (nil)))) + (custom-changed-face ((t (:italic t :foreground "#00CC00" :background "black" :slant oblique)))) + (custom-comment-face ((t (nil)))) + (custom-comment-tag-face ((t (nil)))) + (custom-documentation-face ((t (nil)))) + (custom-face-tag-face ((t (nil)))) + (custom-group-tag-face ((t (nil)))) + (custom-group-tag-face-1 ((t (nil)))) + (custom-invalid-face ((t (:foreground "#00CC00" :background "black" :strike-through t)))) + (custom-modified-face ((t (nil)))) + (custom-rogue-face ((t (nil)))) + (custom-saved-face ((t (nil)))) + (custom-set-face ((t (nil)))) + (custom-state-face ((t (nil)))) + (custom-variable-button-face ((t (nil)))) + (custom-variable-tag-face ((t (nil)))) + (erc-action-face ((t (:bold t :weight semi-bold)))) + (erc-bold-face ((t (:bold t :weight bold)))) + (erc-current-nick-face ((t (:bold t :foreground "LightSeaGreen" :weight semi-bold)))) + (erc-dangerous-host-face ((t (:foreground "red")))) + (erc-default-face ((t (nil)))) + (erc-direct-msg-face ((t (:foreground "IndianRed")))) + (erc-error-face ((t (:bold t :weight semi-bold :background "darkblue" :foreground "#00CC00")))) + (erc-fool-face ((t (:foreground "dim gray")))) + (erc-input-face ((t (:foreground "springgreen")))) + (erc-inverse-face ((t (:bold t :background "Darkgreen" :foreground "Black" :weight semi-bold)))) + (erc-keyword-face ((t (:bold t :foreground "pale green" :weight bold)))) + (erc-nick-default-face ((t (:bold t :weight semi-bold)))) + (erc-nick-msg-face ((t (:bold t :foreground "springgreen" :weight semi-bold)))) + (erc-notice-face ((t (:foreground "seagreen" :weight normal)))) + (erc-pal-face ((t (:bold t :foreground "Magenta" :weight bold)))) + (erc-prompt-face ((t (:bold t :background "lightBlue2" :foreground "Black" :weight semi-bold)))) + (erc-timestamp-face ((t (:foreground "seagreen" :weight normal)))) + (erc-underline-face ((t (:underline t)))) + (fg:erc-color-face0 ((t (:foreground "White")))) + (fg:erc-color-face1 ((t (:foreground "black")))) + (fg:erc-color-face10 ((t (:foreground "lightblue1")))) + (fg:erc-color-face11 ((t (:foreground "cyan")))) + (fg:erc-color-face12 ((t (:foreground "blue")))) + (fg:erc-color-face13 ((t (:foreground "deeppink")))) + (fg:erc-color-face14 ((t (:foreground "gray50")))) + (fg:erc-color-face15 ((t (:foreground "gray90")))) + (fg:erc-color-face2 ((t (:foreground "blue4")))) + (fg:erc-color-face3 ((t (:foreground "green4")))) + (fg:erc-color-face4 ((t (:foreground "red")))) + (fg:erc-color-face5 ((t (:foreground "brown")))) + (fg:erc-color-face6 ((t (:foreground "purple")))) + (fg:erc-color-face7 ((t (:foreground "orange")))) + (fg:erc-color-face8 ((t (:foreground "yellow")))) + (fg:erc-color-face9 ((t (:foreground "green")))) + (fixed-pitch ((t (nil)))) + (font-latex-string-face ((t (:bold t :weight semi-bold :foreground "seagreen" :background "black")))) + (font-latex-warning-face ((t (:bold t :weight semi-bold :background "darkblue" :foreground "#00CC00")))) + (font-lock-builtin-face ((t (:foreground "seagreen1")))) + (font-lock-comment-face ((t (:background "black" :foreground "medium spring green")))) + (font-lock-constant-face ((t (nil)))) + (font-lock-doc-face ((t (:bold t :background "black" :foreground "seagreen" :weight semi-bold)))) + (font-lock-function-name-face ((t (:bold t :foreground "#00CC00" :background "black")))) + (font-lock-keyword-face ((t (:bold t :background "black" :foreground "green" :underline t :weight semi-bold)))) + (font-lock-preprocessor-face ((t (:foreground "#00ccdd")))) + (font-lock-string-face ((t (:bold t :background "black" :foreground "seagreen" :weight semi-bold)))) + (font-lock-type-face ((t (nil)))) + (font-lock-variable-name-face ((t (nil)))) + (font-lock-warning-face ((t (:bold t :foreground "#00CC00" :background "darkblue" :weight semi-bold)))) + (fringe ((t (:foreground "#00CC00" :background "#151515")))) + (gnus-cite-attribution-face ((t (:italic t :foreground "#00CC00" :background "black" :slant italic)))) + (gnus-cite-face-1 ((t (:background "black" :foreground "springgreen")))) + (gnus-cite-face-10 ((t (nil)))) + (gnus-cite-face-11 ((t (nil)))) + (gnus-cite-face-2 ((t (:background "black" :foreground "lightseagreen")))) + (gnus-cite-face-3 ((t (:background "black" :foreground "darkseagreen")))) + (gnus-cite-face-4 ((t (:background "black" :foreground "forestgreen")))) + (gnus-cite-face-5 ((t (:background "black" :foreground "springgreen")))) + (gnus-cite-face-6 ((t (:background "black" :foreground "springgreen")))) + (gnus-cite-face-7 ((t (:background "black" :foreground "springgreen")))) + (gnus-cite-face-8 ((t (:background "black" :foreground "springgreen")))) + (gnus-cite-face-9 ((t (:background "black" :foreground "springgreen")))) + (gnus-emphasis-bold ((t (:bold t :weight semi-bold)))) + (gnus-emphasis-bold-italic ((t (:italic t :bold t :slant italic :weight semi-bold)))) + (gnus-emphasis-highlight-words ((t (:bold t :foreground "#00CC00" :background "black" :underline t :weight bold)))) + (gnus-emphasis-italic ((t (:italic t :slant italic)))) + (gnus-emphasis-strikethru ((t (nil)))) + (gnus-emphasis-underline ((t (:underline t)))) + (gnus-emphasis-underline-bold ((t (:bold t :underline t :weight semi-bold)))) + (gnus-emphasis-underline-bold-italic ((t (:italic t :bold t :underline t :slant italic :weight semi-bold)))) + (gnus-emphasis-underline-italic ((t (:italic t :underline t :slant italic)))) + (gnus-group-mail-1-empty-face ((t (nil)))) + (gnus-group-mail-1-face ((t (:bold t :foreground "#00CC00" :background "black" :weight bold)))) + (gnus-group-mail-2-empty-face ((t (nil)))) + (gnus-group-mail-2-face ((t (:bold t :foreground "#00CC00" :background "black" :weight bold)))) + (gnus-group-mail-3-empty-face ((t (nil)))) + (gnus-group-mail-3-face ((t (:bold t :foreground "#00CC00" :background "black" :weight bold)))) + (gnus-group-mail-low-empty-face ((t (nil)))) + (gnus-group-mail-low-face ((t (:bold t :foreground "#00CC00" :background "black" :weight bold)))) + (gnus-group-news-1-empty-face ((t (nil)))) + (gnus-group-news-1-face ((t (:bold t :foreground "#00CC00" :background "black" :weight bold)))) + (gnus-group-news-2-empty-face ((t (nil)))) + (gnus-group-news-2-face ((t (:bold t :foreground "#00CC00" :background "black" :weight bold)))) + (gnus-group-news-3-empty-face ((t (nil)))) + (gnus-group-news-3-face ((t (:bold t :foreground "#00CC00" :background "black" :weight bold)))) + (gnus-group-news-4-empty-face ((t (nil)))) + (gnus-group-news-4-face ((t (:bold t :foreground "#00CC00" :background "black" :weight bold)))) + (gnus-group-news-5-empty-face ((t (nil)))) + (gnus-group-news-5-face ((t (:bold t :foreground "#00CC00" :background "black" :weight bold)))) + (gnus-group-news-6-empty-face ((t (nil)))) + (gnus-group-news-6-face ((t (:bold t :foreground "#00CC00" :background "black" :weight bold)))) + (gnus-group-news-low-empty-face ((t (nil)))) + (gnus-group-news-low-face ((t (:bold t :foreground "#00CC00" :background "black" :weight bold)))) + (gnus-header-content-face ((t (:background "black" :foreground "springgreen")))) + (gnus-header-from-face ((t (nil)))) + (gnus-header-name-face ((t (nil)))) + (gnus-header-newsgroups-face ((t (nil)))) + (gnus-header-subject-face ((t (nil)))) + (gnus-server-agent-face ((t (:bold t :foreground "PaleTurquoise" :weight bold)))) + (gnus-server-closed-face ((t (:italic t :foreground "Light Steel Blue" :slant italic)))) + (gnus-server-denied-face ((t (:bold t :foreground "Pink" :weight semi-bold)))) + (gnus-server-offline-face ((t (:bold t :foreground "Yellow" :weight bold)))) + (gnus-server-opened-face ((t (:bold t :foreground "Green1" :weight semi-bold)))) + (gnus-signature-face ((t (:background "black" :foreground "springgreen" :slant normal)))) + (gnus-splash-face ((t (:bold t :foreground "#00CC00" :background "black" :weight bold)))) + (gnus-summary-cancelled-face ((t (:foreground "#00CC00" :background "black" :strike-through t)))) + (gnus-summary-high-ancient-face ((t (nil)))) + (gnus-summary-high-read-face ((t (nil)))) + (gnus-summary-high-ticked-face ((t (:background "black" :foreground "seagreen")))) + (gnus-summary-high-undownloaded-face ((t (:bold t :foreground "LightGray" :weight bold)))) + (gnus-summary-high-unread-face ((t (:bold t :foreground "#00CC00" :background "black" :weight bold)))) + (gnus-summary-low-ancient-face ((t (nil)))) + (gnus-summary-low-read-face ((t (nil)))) + (gnus-summary-low-ticked-face ((t (nil)))) + (gnus-summary-low-undownloaded-face ((t (:italic t :foreground "LightGray" :slant italic :weight normal)))) + (gnus-summary-low-unread-face ((t (:bold t :foreground "#00CC00" :background "black" :weight bold)))) + (gnus-summary-normal-ancient-face ((t (nil)))) + (gnus-summary-normal-read-face ((t (nil)))) + (gnus-summary-normal-ticked-face ((t (:bold t :foreground "#00CC00" :background "black")))) + (gnus-summary-normal-undownloaded-face ((t (:foreground "LightGray" :weight normal)))) + (gnus-summary-normal-unread-face ((t (nil)))) + (gnus-summary-selected-face ((t (:background "#101010")))) + (gnus-x-face ((t (:background "white" :foreground "black")))) + (header-line ((t (nil)))) + (highlight ((t (:foreground "#00CC00" :background "darkgreen")))) + (ido-first-match-face ((t (:bold t :weight bold)))) + (ido-indicator-face ((t (:background "red" :foreground "yellow" :width condensed)))) + (ido-only-match-face ((t (:foreground "ForestGreen")))) + (ido-subdir-face ((t (:foreground "red")))) + (isearch ((t (:background "seagreen" :foreground "black")))) + (isearch-lazy-highlight-face ((t (:background "darkseagreen" :foreground "black")))) + (italic ((t (:italic t :foreground "#00CC00" :background "black" :slant oblique)))) + (menu ((t (:bold t :background "black" :foreground "green" :box (:line-width -1 :color "#606060") :weight semi-bold)))) + (message-cited-text-face ((t (:italic t :foreground "#00CC00" :background "black" :slant oblique)))) + (message-header-cc-face ((t (nil)))) + (message-header-name-face ((t (nil)))) + (message-header-newsgroups-face ((t (:bold t :foreground "#00CC00" :background "black")))) + (message-header-other-face ((t (:bold t :foreground "#00CC00" :background "black")))) + (message-header-subject-face ((t (:bold t :foreground "#00CC00" :background "black")))) + (message-header-to-face ((t (:bold t :foreground "#00CC00" :background "black")))) + (message-header-xheader-face ((t (nil)))) + (message-mml-face ((t (:italic t :foreground "#00CC00" :background "black" :slant oblique)))) + (message-separator-face ((t (nil)))) + (minibuffer-prompt ((t (:background "black" :foreground "seagreen")))) + (mode-line ((t (:bold t :background "#404040" :foreground "green" :box (:line-width -1 :color "#606060") :weight semi-bold)))) + (mode-line-inactive ((t (:bold t :weight semi-bold :box (:line-width -1 :color "#606060") :foreground "green" :background "#101010")))) + (mouse ((t (:background "black")))) + (paren-face ((t (:background "black" :foreground "darkgreen")))) + (paren-face-match ((t (:background "black" :foreground "springgreen")))) + (paren-face-mismatch ((t (:foreground "#00CC00" :background "black" :strike-through t)))) + (paren-face-no-match ((t (:background "black" :foreground "red")))) + (region ((t (:background "seagreen" :foreground "black")))) + (scroll-bar ((t (nil)))) + (secondary-selection ((t (:background "darkseagreen" :foreground "black")))) + (semantic-dirty-token-face ((t (:background "gray10")))) + (semantic-unmatched-syntax-face ((t (:underline "red")))) + (sgml-end-tag-face ((t (:foreground "seagreen")))) + (sgml-start-tag-face ((t (:foreground "seagreen")))) + (tabbar-button-face ((t (:background "black" :foreground "#00cc00" :box (:line-width 2 :color "black" :style released-button))))) + (tabbar-default-face ((t (:background "black" :foreground "#00cc00")))) + (tabbar-selected-face ((t (:background "black" :foreground "springgreen" :box (:line-width 2 :color "black" :style released-button))))) + (tabbar-separator-face ((t (:foreground "#00cc00" :background "black")))) + (tabbar-unselected-face ((t (:background "black" :foreground "seagreen" :box (:line-width 2 :color "black" :style pressed-button))))) + (tool-bar ((t (:box (:line-width 1 :style released-button))))) + (tooltip ((t (nil)))) + (trailing-whitespace ((t (:background "lightseagreen" :foreground "black")))) + (underline ((t (:foreground "#00CC00" :background "black" :underline t)))) + (variable-pitch ((t (:underline nil :foreground "#00CC00" :background "black")))) + (widget-button-face ((t (:bold t :foreground "#00CC00" :background "black")))) + (widget-button-pressed-face ((t (nil)))) + (widget-documentation-face ((t (nil)))) + (widget-field-face ((t (:italic t :foreground "#00CC00" :background "black" :slant oblique)))) + (widget-inactive-face ((t (nil)))) + (widget-single-line-field-face ((t (nil))))))) + +(defun color-theme-matrix () + "Color theme by walterh@rocketmail.com, created 2003-10-16." + (interactive) + (color-theme-install + '(color-theme-matrix + ((background-color . "black") + (background-mode . dark) + (background-toolbar-color . "bisque") + (border-color . "orange") + (bottom-toolbar-shadow-color . "#909099999999") + (cursor-color . "#7eff00") + (foreground-color . "#7eff00") + (mouse-color . "#7eff00") + (top-toolbar-shadow-color . "#ffffffffffff")) + ((help-highlight-face . underline) + (list-matching-lines-face . bold) + (rmail-highlight-face . font-lock-function-name-face) + (view-highlight-face . highlight) + (widget-mouse-face . highlight)) + (default ((t (:stipple nil :background "black" :foreground +"#7eff00" :inverse-video nil :box nil :strike-through nil :overline nil +:underline nil :slant normal :weight normal :height 90 :width normal +:family "outline-courier new")))) + (Buffer-menu-buffer-face ((t (nil)))) + (CUA-global-mark-face ((t (nil)))) + (CUA-rectangle-face ((t (nil)))) + (CUA-rectangle-noselect-face ((t (nil)))) + (Info-title-1-face ((t (nil)))) + (Info-title-2-face ((t (nil)))) + (Info-title-3-face ((t (nil)))) + (Info-title-4-face ((t (nil)))) + (antlr-font-lock-keyword-face ((t (nil)))) + (antlr-font-lock-literal-face ((t (nil)))) + (antlr-font-lock-ruledef-face ((t (nil)))) + (antlr-font-lock-ruleref-face ((t (nil)))) + (antlr-font-lock-tokendef-face ((t (nil)))) + (antlr-font-lock-tokenref-face ((t (nil)))) + (bbdb-company ((t (nil)))) + (bbdb-field-name ((t (nil)))) + (bbdb-field-value ((t (nil)))) + (bbdb-name ((t (nil)))) + (bg:erc-color-face0 ((t (nil)))) + (bg:erc-color-face1 ((t (nil)))) + (bg:erc-color-face10 ((t (nil)))) + (bg:erc-color-face11 ((t (nil)))) + (bg:erc-color-face12 ((t (nil)))) + (bg:erc-color-face13 ((t (nil)))) + (bg:erc-color-face14 ((t (nil)))) + (bg:erc-color-face15 ((t (nil)))) + (bg:erc-color-face2 ((t (nil)))) + (bg:erc-color-face3 ((t (nil)))) + (bg:erc-color-face4 ((t (nil)))) + (bg:erc-color-face5 ((t (nil)))) + (bg:erc-color-face6 ((t (nil)))) + (bg:erc-color-face7 ((t (nil)))) + (bg:erc-color-face8 ((t (nil)))) + (bg:erc-color-face9 ((t (nil)))) + (blank-space-face ((t (nil)))) + (blank-tab-face ((t (nil)))) + (blue ((t (nil)))) + (bold ((t (:bold t :weight bold)))) + (bold-italic ((t (:bold t :weight bold)))) + (border ((t (:background "orange")))) + (border-glyph ((t (nil)))) + (buffers-tab ((t (nil)))) + (button ((t (nil)))) + (calendar-today-face ((t (nil)))) + (change-log-acknowledgement-face ((t (nil)))) + (change-log-conditionals-face ((t (nil)))) + (change-log-date-face ((t (nil)))) + (change-log-email-face ((t (nil)))) + (change-log-file-face ((t (nil)))) + (change-log-function-face ((t (nil)))) + (change-log-list-face ((t (nil)))) + (change-log-name-face ((t (nil)))) + (clearcase-dired-checkedout-face ((t (nil)))) + (comint-highlight-input ((t (nil)))) + (comint-highlight-prompt ((t (nil)))) + (cparen-around-andor-face ((t (nil)))) + (cparen-around-begin-face ((t (nil)))) + (cparen-around-conditional-face ((t (nil)))) + (cparen-around-define-face ((t (nil)))) + (cparen-around-lambda-face ((t (nil)))) + (cparen-around-letdo-face ((t (nil)))) + (cparen-around-quote-face ((t (nil)))) + (cparen-around-set!-face ((t (nil)))) + (cparen-around-syntax-rules-face ((t (nil)))) + (cparen-around-vector-face ((t (nil)))) + (cparen-binding-face ((t (nil)))) + (cparen-binding-list-face ((t (nil)))) + (cparen-conditional-clause-face ((t (nil)))) + (cparen-normal-paren-face ((t (nil)))) + (cperl-array-face ((t (nil)))) + (cperl-hash-face ((t (nil)))) + (cperl-invalid-face ((t (nil)))) + (cperl-nonoverridable-face ((t (nil)))) + (cursor ((t (:background "#7eff00" :foreground "black")))) + (custom-button-face ((t (nil)))) + (custom-button-pressed-face ((t (nil)))) + (custom-changed-face ((t (nil)))) + (custom-comment-face ((t (nil)))) + (custom-comment-tag-face ((t (nil)))) + (custom-documentation-face ((t (nil)))) + (custom-face-tag-face ((t (nil)))) + (custom-group-tag-face ((t (nil)))) + (custom-group-tag-face-1 ((t (nil)))) + (custom-invalid-face ((t (nil)))) + (custom-modified-face ((t (nil)))) + (custom-rogue-face ((t (nil)))) + (custom-saved-face ((t (nil)))) + (custom-set-face ((t (nil)))) + (custom-state-face ((t (nil)))) + (custom-variable-button-face ((t (nil)))) + (custom-variable-tag-face ((t (nil)))) + (cvs-filename-face ((t (nil)))) + (cvs-handled-face ((t (nil)))) + (cvs-header-face ((t (nil)))) + (cvs-marked-face ((t (nil)))) + (cvs-msg-face ((t (nil)))) + (cvs-need-action-face ((t (nil)))) + (cvs-unknown-face ((t (nil)))) + (cyan ((t (nil)))) + (diary-face ((t (nil)))) + (diff-added-face ((t (nil)))) + (diff-changed-face ((t (nil)))) + (diff-context-face ((t (nil)))) + (diff-file-header-face ((t (nil)))) + (diff-function-face ((t (nil)))) + (diff-header-face ((t (nil)))) + (diff-hunk-header-face ((t (nil)))) + (diff-index-face ((t (nil)))) + (diff-nonexistent-face ((t (nil)))) + (diff-removed-face ((t (nil)))) + (dired-face-boring ((t (nil)))) + (dired-face-directory ((t (nil)))) + (dired-face-executable ((t (nil)))) + (dired-face-flagged ((t (nil)))) + (dired-face-header ((t (nil)))) + (dired-face-marked ((t (nil)))) + (dired-face-permissions ((t (nil)))) + (dired-face-setuid ((t (nil)))) + (dired-face-socket ((t (nil)))) + (dired-face-symlink ((t (nil)))) + (display-time-mail-balloon-enhance-face ((t (nil)))) + (display-time-mail-balloon-gnus-group-face ((t (nil)))) + (display-time-time-balloon-face ((t (nil)))) + (ebrowse-default-face ((t (nil)))) + (ebrowse-file-name-face ((t (nil)))) + (ebrowse-member-attribute-face ((t (nil)))) + (ebrowse-member-class-face ((t (nil)))) + (ebrowse-progress-face ((t (nil)))) + (ebrowse-root-class-face ((t (nil)))) + (ebrowse-tree-mark-face ((t (nil)))) + (ecb-sources-face ((t (nil)))) + (edb-inter-field-face ((t (nil)))) + (edb-normal-summary-face ((t (nil)))) + (ediff-current-diff-face-A ((t (nil)))) + (ediff-current-diff-face-Ancestor ((t (nil)))) + (ediff-current-diff-face-B ((t (nil)))) + (ediff-current-diff-face-C ((t (nil)))) + (ediff-even-diff-face-A ((t (nil)))) + (ediff-even-diff-face-Ancestor ((t (nil)))) + (ediff-even-diff-face-B ((t (nil)))) + (ediff-even-diff-face-C ((t (nil)))) + (ediff-fine-diff-face-A ((t (nil)))) + (ediff-fine-diff-face-Ancestor ((t (nil)))) + (ediff-fine-diff-face-B ((t (nil)))) + (ediff-fine-diff-face-C ((t (nil)))) + (ediff-odd-diff-face-A ((t (nil)))) + (ediff-odd-diff-face-Ancestor ((t (nil)))) + (ediff-odd-diff-face-B ((t (nil)))) + (ediff-odd-diff-face-C ((t (nil)))) + (eieio-custom-slot-tag-face ((t (nil)))) + (emacs-wiki-bad-link-face ((t (nil)))) + (emacs-wiki-link-face ((t (nil)))) + (erc-action-face ((t (nil)))) + (erc-bold-face ((t (nil)))) + (erc-current-nick-face ((t (nil)))) + (erc-dangerous-host-face ((t (nil)))) + (erc-default-face ((t (nil)))) + (erc-direct-msg-face ((t (nil)))) + (erc-error-face ((t (nil)))) + (erc-fool-face ((t (nil)))) + (erc-highlight-face ((t (nil)))) + (erc-input-face ((t (nil)))) + (erc-inverse-face ((t (nil)))) + (erc-keyword-face ((t (nil)))) + (erc-nick-default-face ((t (nil)))) + (erc-nick-msg-face ((t (nil)))) + (erc-notice-face ((t (nil)))) + (erc-pal-face ((t (nil)))) + (erc-prompt-face ((t (nil)))) + (erc-timestamp-face ((t (nil)))) + (erc-underline-face ((t (nil)))) + (eshell-ls-archive-face ((t (nil)))) + (eshell-ls-backup-face ((t (nil)))) + (eshell-ls-clutter-face ((t (nil)))) + (eshell-ls-directory-face ((t (nil)))) + (eshell-ls-executable-face ((t (nil)))) + (eshell-ls-missing-face ((t (nil)))) + (eshell-ls-picture-face ((t (nil)))) + (eshell-ls-product-face ((t (nil)))) + (eshell-ls-readonly-face ((t (nil)))) + (eshell-ls-special-face ((t (nil)))) + (eshell-ls-symlink-face ((t (nil)))) + (eshell-ls-text-face ((t (nil)))) + (eshell-ls-todo-face ((t (nil)))) + (eshell-ls-unreadable-face ((t (nil)))) + (eshell-prompt-face ((t (nil)))) + (eshell-test-failed-face ((t (nil)))) + (eshell-test-ok-face ((t (nil)))) + (excerpt ((t (nil)))) + (extra-whitespace-face ((t (nil)))) + (ff-paths-non-existant-file-face ((t (nil)))) + (fg:black ((t (nil)))) + (fg:erc-color-face0 ((t (nil)))) + (fg:erc-color-face1 ((t (nil)))) + (fg:erc-color-face10 ((t (nil)))) + (fg:erc-color-face11 ((t (nil)))) + (fg:erc-color-face12 ((t (nil)))) + (fg:erc-color-face13 ((t (nil)))) + (fg:erc-color-face14 ((t (nil)))) + (fg:erc-color-face15 ((t (nil)))) + (fg:erc-color-face2 ((t (nil)))) + (fg:erc-color-face3 ((t (nil)))) + (fg:erc-color-face4 ((t (nil)))) + (fg:erc-color-face5 ((t (nil)))) + (fg:erc-color-face6 ((t (nil)))) + (fg:erc-color-face7 ((t (nil)))) + (fg:erc-color-face8 ((t (nil)))) + (fg:erc-color-face9 ((t (nil)))) + (fixed ((t (nil)))) + (fixed-pitch ((t (nil)))) + (fl-comment-face ((t (nil)))) + (fl-function-name-face ((t (nil)))) + (fl-keyword-face ((t (nil)))) + (fl-string-face ((t (nil)))) + (fl-type-face ((t (nil)))) + (flash-paren-face-off ((t (nil)))) + (flash-paren-face-on ((t (nil)))) + (flash-paren-face-region ((t (nil)))) + (flyspell-duplicate-face ((t (nil)))) + (flyspell-incorrect-face ((t (nil)))) + (font-latex-bold-face ((t (nil)))) + (font-latex-italic-face ((t (nil)))) + (font-latex-math-face ((t (nil)))) + (font-latex-sedate-face ((t (nil)))) + (font-latex-string-face ((t (nil)))) + (font-latex-warning-face ((t (nil)))) + (font-lock-builtin-face ((t (:foreground "pink2")))) + (font-lock-comment-face ((t (:italic t :background "black" :slant +italic)))) + (font-lock-constant-face ((t (:foreground "magenta")))) + (font-lock-doc-face ((t (nil)))) + (font-lock-doc-string-face ((t (nil)))) + (font-lock-exit-face ((t (nil)))) + (font-lock-function-name-face ((t (:bold t :underline t :weight +bold)))) + (font-lock-keyword-face ((t (:foreground "yellow1")))) + (font-lock-other-emphasized-face ((t (nil)))) + (font-lock-other-type-face ((t (nil)))) + (font-lock-preprocessor-face ((t (nil)))) + (font-lock-reference-face ((t (nil)))) + (font-lock-special-comment-face ((t (nil)))) + (font-lock-special-keyword-face ((t (nil)))) + (font-lock-string-face ((t (:foreground "yellow2")))) + (font-lock-type-face ((t (:foreground "LightYellow1")))) + (font-lock-variable-name-face ((t (:foreground "light green")))) + (font-lock-warning-face ((t (nil)))) + (fringe ((t (nil)))) + (gnus-cite-attribution-face ((t (nil)))) + (gnus-cite-face-1 ((t (nil)))) + (gnus-cite-face-10 ((t (nil)))) + (gnus-cite-face-11 ((t (nil)))) + (gnus-cite-face-2 ((t (nil)))) + (gnus-cite-face-3 ((t (nil)))) + (gnus-cite-face-4 ((t (nil)))) + (gnus-cite-face-5 ((t (nil)))) + (gnus-cite-face-6 ((t (nil)))) + (gnus-cite-face-7 ((t (nil)))) + (gnus-cite-face-8 ((t (nil)))) + (gnus-cite-face-9 ((t (nil)))) + (gnus-emphasis-bold ((t (nil)))) + (gnus-emphasis-bold-italic ((t (nil)))) + (gnus-emphasis-highlight-words ((t (nil)))) + (gnus-emphasis-italic ((t (nil)))) + (gnus-emphasis-strikethru ((t (nil)))) + (gnus-emphasis-underline ((t (nil)))) + (gnus-emphasis-underline-bold ((t (nil)))) + (gnus-emphasis-underline-bold-italic ((t (nil)))) + (gnus-emphasis-underline-italic ((t (nil)))) + (gnus-filterhist-face-1 ((t (nil)))) + (gnus-group-mail-1-empty-face ((t (nil)))) + (gnus-group-mail-1-face ((t (nil)))) + (gnus-group-mail-2-empty-face ((t (nil)))) + (gnus-group-mail-2-face ((t (nil)))) + (gnus-group-mail-3-empty-face ((t (nil)))) + (gnus-group-mail-3-face ((t (nil)))) + (gnus-group-mail-low-empty-face ((t (nil)))) + (gnus-group-mail-low-face ((t (nil)))) + (gnus-group-news-1-empty-face ((t (nil)))) + (gnus-group-news-1-face ((t (nil)))) + (gnus-group-news-2-empty-face ((t (nil)))) + (gnus-group-news-2-face ((t (nil)))) + (gnus-group-news-3-empty-face ((t (nil)))) + (gnus-group-news-3-face ((t (nil)))) + (gnus-group-news-4-empty-face ((t (nil)))) + (gnus-group-news-4-face ((t (nil)))) + (gnus-group-news-5-empty-face ((t (nil)))) + (gnus-group-news-5-face ((t (nil)))) + (gnus-group-news-6-empty-face ((t (nil)))) + (gnus-group-news-6-face ((t (nil)))) + (gnus-group-news-low-empty-face ((t (nil)))) + (gnus-group-news-low-face ((t (nil)))) + (gnus-header-content-face ((t (nil)))) + (gnus-header-from-face ((t (nil)))) + (gnus-header-name-face ((t (nil)))) + (gnus-header-newsgroups-face ((t (nil)))) + (gnus-header-subject-face ((t (nil)))) + (gnus-picon-face ((t (nil)))) + (gnus-picon-xbm-face ((t (nil)))) + (gnus-picons-face ((t (nil)))) + (gnus-picons-xbm-face ((t (nil)))) + (gnus-server-agent-face ((t (nil)))) + (gnus-server-closed-face ((t (nil)))) + (gnus-server-denied-face ((t (nil)))) + (gnus-server-offline-face ((t (nil)))) + (gnus-server-opened-face ((t (nil)))) + (gnus-signature-face ((t (nil)))) + (gnus-splash ((t (nil)))) + (gnus-splash-face ((t (nil)))) + (gnus-summary-cancelled-face ((t (nil)))) + (gnus-summary-high-ancient-face ((t (nil)))) + (gnus-summary-high-read-face ((t (nil)))) + (gnus-summary-high-ticked-face ((t (nil)))) + (gnus-summary-high-undownloaded-face ((t (nil)))) + (gnus-summary-high-unread-face ((t (nil)))) + (gnus-summary-low-ancient-face ((t (nil)))) + (gnus-summary-low-read-face ((t (nil)))) + (gnus-summary-low-ticked-face ((t (nil)))) + (gnus-summary-low-undownloaded-face ((t (nil)))) + (gnus-summary-low-unread-face ((t (nil)))) + (gnus-summary-normal-ancient-face ((t (nil)))) + (gnus-summary-normal-read-face ((t (nil)))) + (gnus-summary-normal-ticked-face ((t (nil)))) + (gnus-summary-normal-undownloaded-face ((t (nil)))) + (gnus-summary-normal-unread-face ((t (nil)))) + (gnus-summary-selected-face ((t (nil)))) + (gnus-x-face ((t (nil)))) + (green ((t (nil)))) + (gui-button-face ((t (nil)))) + (gui-element ((t (nil)))) + (header-line ((t (nil)))) + (hi-black-b ((t (nil)))) + (hi-black-hb ((t (nil)))) + (hi-blue ((t (nil)))) + (hi-blue-b ((t (nil)))) + (hi-green ((t (nil)))) + (hi-green-b ((t (nil)))) + (hi-pink ((t (nil)))) + (hi-red-b ((t (nil)))) + (hi-yellow ((t (nil)))) + (highlight ((t (:background "#7eff00" :foreground "black")))) + (highlight-changes-delete-face ((t (nil)))) + (highlight-changes-face ((t (nil)))) + (highline-face ((t (nil)))) + (holiday-face ((t (nil)))) + (html-helper-bold-face ((t (nil)))) + (html-helper-bold-italic-face ((t (nil)))) + (html-helper-builtin-face ((t (nil)))) + (html-helper-italic-face ((t (nil)))) + (html-helper-underline-face ((t (nil)))) + (html-tag-face ((t (nil)))) + (hyper-apropos-documentation ((t (nil)))) + (hyper-apropos-heading ((t (nil)))) + (hyper-apropos-hyperlink ((t (nil)))) + (hyper-apropos-major-heading ((t (nil)))) + (hyper-apropos-section-heading ((t (nil)))) + (hyper-apropos-warning ((t (nil)))) + (ibuffer-deletion-face ((t (nil)))) + (ibuffer-marked-face ((t (nil)))) + (idlwave-help-link-face ((t (nil)))) + (idlwave-shell-bp-face ((t (nil)))) + (ido-first-match-face ((t (nil)))) + (ido-indicator-face ((t (nil)))) + (ido-only-match-face ((t (nil)))) + (ido-subdir-face ((t (nil)))) + (info-header-node ((t (nil)))) + (info-header-xref ((t (nil)))) + (info-menu-5 ((t (nil)))) + (info-menu-6 ((t (nil)))) + (info-menu-header ((t (nil)))) + (info-node ((t (nil)))) + (info-xref ((t (nil)))) + (isearch ((t (nil)))) + (isearch-lazy-highlight-face ((t (nil)))) + (isearch-secondary ((t (nil)))) + (italic ((t (:underline t)))) + (jde-bug-breakpoint-cursor ((t (nil)))) + (jde-bug-breakpoint-marker ((t (nil)))) + (jde-db-active-breakpoint-face ((t (nil)))) + (jde-db-requested-breakpoint-face ((t (nil)))) + (jde-db-spec-breakpoint-face ((t (nil)))) + (jde-java-font-lock-api-face ((t (nil)))) + (jde-java-font-lock-bold-face ((t (nil)))) + (jde-java-font-lock-code-face ((t (nil)))) + (jde-java-font-lock-constant-face ((t (nil)))) + (jde-java-font-lock-doc-tag-face ((t (nil)))) + (jde-java-font-lock-italic-face ((t (nil)))) + (jde-java-font-lock-link-face ((t (nil)))) + (jde-java-font-lock-modifier-face ((t (nil)))) + (jde-java-font-lock-number-face ((t (nil)))) + (jde-java-font-lock-operator-face ((t (nil)))) + (jde-java-font-lock-package-face ((t (nil)))) + (jde-java-font-lock-pre-face ((t (nil)))) + (jde-java-font-lock-underline-face ((t (nil)))) + (lazy-highlight-face ((t (nil)))) + (left-margin ((t (nil)))) + (linemenu-face ((t (nil)))) + (list-mode-item-selected ((t (nil)))) + (log-view-file-face ((t (nil)))) + (log-view-message-face ((t (nil)))) + (magenta ((t (nil)))) + (makefile-space-face ((t (nil)))) + (man-bold ((t (nil)))) + (man-heading ((t (nil)))) + (man-italic ((t (nil)))) + (man-xref ((t (nil)))) + (menu ((t (nil)))) + (message-cited-text ((t (nil)))) + (message-cited-text-face ((t (nil)))) + (message-header-cc-face ((t (nil)))) + (message-header-contents ((t (nil)))) + (message-header-name-face ((t (nil)))) + (message-header-newsgroups-face ((t (nil)))) + (message-header-other-face ((t (nil)))) + (message-header-subject-face ((t (nil)))) + (message-header-to-face ((t (nil)))) + (message-header-xheader-face ((t (nil)))) + (message-headers ((t (nil)))) + (message-highlighted-header-contents ((t (nil)))) + (message-mml-face ((t (nil)))) + (message-separator-face ((t (nil)))) + (message-url ((t (nil)))) + (minibuffer-prompt ((t (nil)))) + (mmm-face ((t (nil)))) + (mode-line ((t (:bold t :background "gray" :foreground "black" +:weight bold)))) + (mode-line-inactive ((t (nil)))) + (modeline-buffer-id ((t (:background "orange" :foreground +"black")))) + (modeline-mousable ((t (:background "orange" :foreground +"black")))) + (modeline-mousable-minor-mode ((t (:background "orange" +:foreground "black")))) + (mouse ((t (nil)))) + (mpg123-face-cur ((t (nil)))) + (mpg123-face-slider ((t (nil)))) + (my-tab-face ((t (nil)))) + (nil ((t (nil)))) + (overlay-empty-face ((t (nil)))) + (p4-diff-del-face ((t (nil)))) + (paren-blink-off ((t (nil)))) + (paren-face ((t (nil)))) + (paren-face-match ((t (nil)))) + (paren-face-mismatch ((t (nil)))) + (paren-face-no-match ((t (nil)))) + (paren-match ((t (nil)))) + (paren-mismatch ((t (nil)))) + (paren-mismatch-face ((t (nil)))) + (paren-no-match-face ((t (nil)))) + (pointer ((t (nil)))) + (primary-selection ((t (nil)))) + (reb-match-0 ((t (nil)))) + (reb-match-1 ((t (nil)))) + (reb-match-2 ((t (nil)))) + (reb-match-3 ((t (nil)))) + (red ((t (nil)))) + (region ((t (:background "#7eff00" :foreground "black")))) + (right-margin ((t (nil)))) + (rpm-spec-dir-face ((t (nil)))) + (rpm-spec-doc-face ((t (nil)))) + (rpm-spec-ghost-face ((t (nil)))) + (rpm-spec-macro-face ((t (nil)))) + (rpm-spec-package-face ((t (nil)))) + (rpm-spec-tag-face ((t (nil)))) + (rpm-spec-var-face ((t (nil)))) + (scroll-bar ((t (nil)))) + (secondary-selection ((t (:background "orange" :foreground +"black")))) + (semantic-dirty-token-face ((t (nil)))) + (semantic-intangible-face ((t (nil)))) + (semantic-read-only-face ((t (nil)))) + (semantic-unmatched-syntax-face ((t (nil)))) + (senator-intangible-face ((t (nil)))) + (senator-momentary-highlight-face ((t (nil)))) + (senator-read-only-face ((t (nil)))) + (sgml-comment-face ((t (nil)))) + (sgml-doctype-face ((t (nil)))) + (sgml-end-tag-face ((t (nil)))) + (sgml-entity-face ((t (nil)))) + (sgml-ignored-face ((t (nil)))) + (sgml-ms-end-face ((t (nil)))) + (sgml-ms-start-face ((t (nil)))) + (sgml-pi-face ((t (nil)))) + (sgml-sgml-face ((t (nil)))) + (sgml-short-ref-face ((t (nil)))) + (sgml-shortref-face ((t (nil)))) + (sgml-start-tag-face ((t (nil)))) + (sh-heredoc-face ((t (nil)))) + (shell-option-face ((t (nil)))) + (shell-output-2-face ((t (nil)))) + (shell-output-3-face ((t (nil)))) + (shell-output-face ((t (nil)))) + (shell-prompt-face ((t (nil)))) + (show-block-face1 ((t (nil)))) + (show-block-face2 ((t (nil)))) + (show-block-face3 ((t (nil)))) + (show-block-face4 ((t (nil)))) + (show-block-face5 ((t (nil)))) + (show-block-face6 ((t (nil)))) + (show-block-face7 ((t (nil)))) + (show-block-face8 ((t (nil)))) + (show-block-face9 ((t (nil)))) + (show-paren-match-face ((t (:background "orange" :foreground +"black")))) + (show-paren-mismatch-face ((t (:underline t)))) + (show-tabs-space-face ((t (nil)))) + (show-tabs-tab-face ((t (nil)))) + (smerge-base-face ((t (nil)))) + (smerge-markers-face ((t (nil)))) + (smerge-mine-face ((t (nil)))) + (smerge-other-face ((t (nil)))) + (speedbar-button-face ((t (nil)))) + (speedbar-directory-face ((t (nil)))) + (speedbar-file-face ((t (nil)))) + (speedbar-highlight-face ((t (nil)))) + (speedbar-selected-face ((t (nil)))) + (speedbar-separator-face ((t (nil)))) + (speedbar-tag-face ((t (nil)))) + (strokes-char-face ((t (nil)))) + (swbuff-current-buffer-face ((t (nil)))) + (tabbar-button-face ((t (nil)))) + (tabbar-default-face ((t (nil)))) + (tabbar-selected-face ((t (nil)))) + (tabbar-separator-face ((t (nil)))) + (tabbar-unselected-face ((t (nil)))) + (template-message-face ((t (nil)))) + (term-black ((t (nil)))) + (term-blackbg ((t (nil)))) + (term-blue ((t (nil)))) + (term-blue-bold-face ((t (nil)))) + (term-blue-face ((t (nil)))) + (term-blue-inv-face ((t (nil)))) + (term-blue-ul-face ((t (nil)))) + (term-bluebg ((t (nil)))) + (term-bold ((t (nil)))) + (term-cyan ((t (nil)))) + (term-cyan-bold-face ((t (nil)))) + (term-cyan-face ((t (nil)))) + (term-cyan-inv-face ((t (nil)))) + (term-cyan-ul-face ((t (nil)))) + (term-cyanbg ((t (nil)))) + (term-default ((t (nil)))) + (term-default-bg ((t (nil)))) + (term-default-bg-inv ((t (nil)))) + (term-default-bold-face ((t (nil)))) + (term-default-face ((t (nil)))) + (term-default-fg ((t (nil)))) + (term-default-fg-inv ((t (nil)))) + (term-default-inv-face ((t (nil)))) + (term-default-ul-face ((t (nil)))) + (term-green ((t (nil)))) + (term-green-bold-face ((t (nil)))) + (term-green-face ((t (nil)))) + (term-green-inv-face ((t (nil)))) + (term-green-ul-face ((t (nil)))) + (term-greenbg ((t (nil)))) + (term-invisible ((t (nil)))) + (term-invisible-inv ((t (nil)))) + (term-magenta ((t (nil)))) + (term-magenta-bold-face ((t (nil)))) + (term-magenta-face ((t (nil)))) + (term-magenta-inv-face ((t (nil)))) + (term-magenta-ul-face ((t (nil)))) + (term-magentabg ((t (nil)))) + (term-red ((t (nil)))) + (term-red-bold-face ((t (nil)))) + (term-red-face ((t (nil)))) + (term-red-inv-face ((t (nil)))) + (term-red-ul-face ((t (nil)))) + (term-redbg ((t (nil)))) + (term-underline ((t (nil)))) + (term-white ((t (nil)))) + (term-white-bold-face ((t (nil)))) + (term-white-face ((t (nil)))) + (term-white-inv-face ((t (nil)))) + (term-white-ul-face ((t (nil)))) + (term-whitebg ((t (nil)))) + (term-yellow ((t (nil)))) + (term-yellow-bold-face ((t (nil)))) + (term-yellow-face ((t (nil)))) + (term-yellow-inv-face ((t (nil)))) + (term-yellow-ul-face ((t (nil)))) + (term-yellowbg ((t (nil)))) + (tex-math-face ((t (nil)))) + (texinfo-heading-face ((t (nil)))) + (text-cursor ((t (nil)))) + (tool-bar ((t (nil)))) + (tooltip ((t (nil)))) + (trailing-whitespace ((t (nil)))) + (underline ((t (:underline t)))) + (variable-pitch ((t (nil)))) + (vc-annotate-face-0046FF ((t (nil)))) + (vcursor ((t (nil)))) + (vertical-divider ((t (nil)))) + (vhdl-font-lock-attribute-face ((t (nil)))) + (vhdl-font-lock-directive-face ((t (nil)))) + (vhdl-font-lock-enumvalue-face ((t (nil)))) + (vhdl-font-lock-function-face ((t (nil)))) + (vhdl-font-lock-generic-/constant-face ((t (nil)))) + (vhdl-font-lock-prompt-face ((t (nil)))) + (vhdl-font-lock-reserved-words-face ((t (nil)))) + (vhdl-font-lock-translate-off-face ((t (nil)))) + (vhdl-font-lock-type-face ((t (nil)))) + (vhdl-font-lock-variable-face ((t (nil)))) + (vhdl-speedbar-architecture-face ((t (nil)))) + (vhdl-speedbar-architecture-selected-face ((t (nil)))) + (vhdl-speedbar-configuration-face ((t (nil)))) + (vhdl-speedbar-configuration-selected-face ((t (nil)))) + (vhdl-speedbar-entity-face ((t (nil)))) + (vhdl-speedbar-entity-selected-face ((t (nil)))) + (vhdl-speedbar-instantiation-face ((t (nil)))) + (vhdl-speedbar-instantiation-selected-face ((t (nil)))) + (vhdl-speedbar-package-face ((t (nil)))) + (vhdl-speedbar-package-selected-face ((t (nil)))) + (vhdl-speedbar-subprogram-face ((t (nil)))) + (viper-minibuffer-emacs-face ((t (nil)))) + (viper-minibuffer-insert-face ((t (nil)))) + (viper-minibuffer-vi-face ((t (nil)))) + (viper-replace-overlay-face ((t (nil)))) + (viper-search-face ((t (nil)))) + (vm-xface ((t (nil)))) + (vmpc-pre-sig-face ((t (nil)))) + (vmpc-sig-face ((t (nil)))) + (w3m-anchor-face ((t (nil)))) + (w3m-arrived-anchor-face ((t (nil)))) + (w3m-header-line-location-content-face ((t (nil)))) + (w3m-header-line-location-title-face ((t (nil)))) + (white ((t (nil)))) + (widget ((t (nil)))) + (widget-button-face ((t (nil)))) + (widget-button-pressed-face ((t (nil)))) + (widget-documentation-face ((t (nil)))) + (widget-field-face ((t (nil)))) + (widget-inactive-face ((t (nil)))) + (widget-single-line-field-face ((t (nil)))) + (woman-addition-face ((t (nil)))) + (woman-bold-face ((t (nil)))) + (woman-italic-face ((t (nil)))) + (woman-unknown-face ((t (nil)))) + (x-face ((t (nil)))) + (xrdb-option-name-face ((t (nil)))) + (xref-keyword-face ((t (nil)))) + (xref-list-default-face ((t (nil)))) + (xref-list-pilot-face ((t (nil)))) + (xref-list-symbol-face ((t (nil)))) + (yellow ((t (nil)))) + (zmacs-region ((t (nil))))))) + +(defun color-theme-feng-shui () + "Color theme by walterh@rocketmail.com (www.xanadb.com), created + 2003-10-16. Evolved from color-theme-katester" + (interactive) + (color-theme-install + '(color-theme-feng-shui + ((background-color . "ivory") + (background-mode . light) + (border-color . "black") + (cursor-color . "slateblue") + (foreground-color . "black") + (mouse-color . "slateblue")) + ((help-highlight-face . underline) + (list-matching-lines-face . bold) + (view-highlight-face . highlight) + (widget-mouse-face . highlight)) + (default ((t (:stipple nil :background "ivory" :foreground "black" +:inverse-video nil :box nil :strike-through nil :overline nil +:underline nil :slant normal :weight normal :height 90 :width normal +:family "outline-courier new")))) + (bold ((t (:bold t :weight bold)))) + (bold-italic ((t (:italic t :bold t :slant italic :weight bold)))) + (border ((t (:background "black")))) + (cursor ((t (:background "slateblue" :foreground "black")))) + (fixed-pitch ((t (:family "courier")))) + (font-lock-builtin-face ((t (:foreground "black")))) + (font-lock-comment-face ((t (:italic t :background "seashell" +:slant italic)))) + (font-lock-constant-face ((t (:foreground "darkblue")))) + (font-lock-doc-face ((t (:background "lemonChiffon")))) + (font-lock-function-name-face ((t (:bold t :underline t :weight +bold)))) + (font-lock-keyword-face ((t (:foreground "blue")))) + (font-lock-string-face ((t (:background "lemonChiffon")))) + (font-lock-type-face ((t (:foreground "black")))) + (font-lock-variable-name-face ((t (:foreground "black")))) + (font-lock-warning-face ((t (:bold t :foreground "Red" :weight +bold)))) + (fringe ((t (:background "grey95")))) + (header-line ((t (:bold t :weight bold :underline t :background +"grey90" :foreground "grey20" :box nil)))) + (highlight ((t (:background "mistyRose" :foreground "black")))) + (isearch ((t (:background "magenta4" :foreground +"lightskyblue1")))) + (isearch-lazy-highlight-face ((t (:background "paleturquoise")))) + (italic ((t (:italic t :slant italic)))) + (menu ((t (nil)))) + (mode-line ((t (:bold t :background "mistyRose" :foreground "navy" +:underline t :weight bold)))) + (mouse ((t (:background "slateblue")))) + (region ((t (:background "lavender" :foreground "black")))) + (scroll-bar ((t (nil)))) + (secondary-selection ((t (:background "yellow")))) + (tool-bar ((t (:background "grey75" :foreground "black" :box +(:line-width 1 :style released-button))))) + (trailing-whitespace ((t (:background "red")))) + (underline ((t (:underline t)))) + (variable-pitch ((t (:family "helv")))) + (widget-button-face ((t (:bold t :weight bold)))) + (widget-button-pressed-face ((t (:foreground "red")))) + (widget-documentation-face ((t (:foreground "dark green")))) + (widget-field-face ((t (:background "gray85")))) + (widget-inactive-face ((t (:foreground "dim gray")))) + (widget-single-line-field-face ((t (:background "gray85"))))))) + +(provide 'color-theme) + +;;; color-theme.el ends here diff --git a/emacs.d/color-theme/color-theme.elc b/emacs.d/color-theme/color-theme.elc new file mode 100644 index 0000000..7bb6b8d Binary files /dev/null and b/emacs.d/color-theme/color-theme.elc differ diff --git a/emacs.d/find-recursive.el b/emacs.d/find-recursive.el new file mode 100644 index 0000000..b9ef740 --- /dev/null +++ b/emacs.d/find-recursive.el @@ -0,0 +1,137 @@ +;; find-recursive.el -- Find files recursively into a directory +;; +;; Copyright (C) 2001 Ovidiu Predescu +;; +;; Author: Ovidiu Predescu +;; Date: March 26, 2001 +;; +;; This program is free software; you can redistribute it and/or +;; modify it under the terms of the GNU General Public License +;; as published by the Free Software Foundation; either version 2 +;; of the License, or (at your option) any later version. +;; +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. +;; +;; You should have received a copy of the GNU General Public License +;; along with this program; if not, write to the Free Software +;; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. + +;; +;; Setup: put this file in your Lisp path and add the following line in +;; your .emacs: +;; +;; (require 'find-recursive) +;; + +(require 'cl) + +(defcustom find-recursive-exclude-files '(".*.class$" ".*~$" ".*.elc$") + "List of regular expressions of files to be excluded when recursively searching for files." + :type '(repeat (string :tag "File regexp"))) + +(defun find-file-recursively (file-regexp directory) + (interactive "sFile name to search for recursively: \nDIn directory: ") + (let ((directory (if (equal (substring directory -1) "/") + directory + (concat directory "/"))) + (matches + (find-recursive-filter-out + find-recursive-exclude-files + (find-recursive-directory-relative-files directory "" file-regexp)))) + (cond ((eq (length matches) 0) (message "No file(s) found!")) + ((eq (length matches) 1) + (find-file (concat directory (car matches)))) + (t + (run-with-timer 0.001 nil + (lambda () + (dispatch-event + (make-event 'key-press '(key tab))))) + (let ((file (completing-read "Choose file: " + (mapcar 'list matches) + nil t))) + (if (or (eq file nil) (equal file "")) + (message "No file selected.") + (find-file (concat directory file)))))))) + +(defun find-recursive-directory-relative-files (directory + relative-directory + file-regexp) + (let* ((full-dir (concat directory "/" relative-directory)) + (matches + (mapcar + (function (lambda (x) + (concat relative-directory x))) + (find-recursive-filter-out '(nil) + (directory-files full-dir nil + file-regexp nil t)))) + (inner + (mapcar + (function + (lambda (dir) + (find-recursive-directory-relative-files directory + (concat relative-directory + dir "/") + file-regexp))) + (find-recursive-filter-out '(nil "\\." "\\.\\.") + (directory-files full-dir nil ".*" + nil 'directories))))) + (mapcar (function (lambda (dir) (setq matches (append matches dir)))) + inner) + matches)) + +(defun find-recursive-filter-out (remove-list list) + "Remove all the elements in *remove-list* from *list*" + (if (eq list nil) + nil + (let ((elem (car list)) + (rest (cdr list))) + (if (some + (lambda (regexp) + (if (or (eq elem nil) (eq regexp nil)) + nil + (not (eq (string-match regexp elem) nil)))) + remove-list) + (find-recursive-filter-out remove-list rest) + (cons elem (find-recursive-filter-out remove-list rest)))))) + +(defvar find-recursive-running-xemacs (string-match "XEmacs\\|Lucid" emacs-version)) + +(if find-recursive-running-xemacs + nil + (defadvice directory-files (after + directory-files-xemacs + (dirname &optional full match nosort files-only) + activate) + "Add an additional argument, FILES-ONLY to the list of arguments +for GNU Emacs. If the symbol is t, then only the files in the +directory will be returned. If FILES-ONLY is nil, then both files and +directories are selected. If FILES-ONLY is not nil and not t, then +only sundirectories are returned." + (setq ad-return-value + (cond ((null files-only) ad-return-value) + ((eq files-only t) + (find-recursive-remove-if (lambda (f) + (file-directory-p + (concat dirname "/" f))) + ad-return-value)) + (t + (find-recursive-remove-if (lambda (f) + (not (file-directory-p + (concat dirname "/" f)))) + ad-return-value))))) + + (defun find-recursive-remove-if (func list) + "Removes all elements satisfying FUNC from LIST." + (let ((result nil)) + (while list + (if (not (funcall func (car list))) + (setq result (cons (car list) result))) + (setq list (cdr list))) + (nreverse result)))) + +(global-set-key [(control x) (meta f)] 'find-file-recursively) + +(provide 'find-recursive) diff --git a/emacs.d/games/tetris-scores b/emacs.d/games/tetris-scores new file mode 100644 index 0000000..0f138b7 --- /dev/null +++ b/emacs.d/games/tetris-scores @@ -0,0 +1 @@ +00666 Tue Jun 19 18:22:15 2007 diff --git a/emacs.d/haskell/ChangeLog b/emacs.d/haskell/ChangeLog new file mode 100644 index 0000000..c8aaed0 --- /dev/null +++ b/emacs.d/haskell/ChangeLog @@ -0,0 +1,541 @@ +2007-02-14 Stefan Monnier + + * haskell-cabal.el: New file. + + * haskell-indent.el (haskell-indent-look-past-empty-line): Typo. + + * inf-haskell.el (with-selected-window): Define while compiling. + +2007-02-10 Stefan Monnier + + * haskell-font-lock.el (haskell-font-lock-keywords-create): + Remove qualified and hiding from the reserved identifiers. + Add a special rule for import statements. + + * haskell-doc.el (haskell-doc-get-current-word): Remove. + Change all refs to it, to use haskell-ident-at-point instead. + + * inf-haskell.el (inferior-haskell-info-xref-re): New cst. + (inferior-haskell-error-regexp-alist): Use it to highlight xref info. + (inferior-haskell-type, inferior-haskell-info) + (inferior-haskell-find-definition): New funs. + Contributed by Matthew Danish . + + * haskell-mode.el (haskell-ident-at-point): New fun. + Copy of haskell-doc-get-current-word. + (haskell-mode-map): Add bindings for inferior-haskell-(type|info|find). + +2007-02-09 Stefan Monnier + + * haskell-indent.el (haskell-indent-back-to-indentation): Simplify. + (haskell-indent-look-past-empty-line): New var. + (haskell-indent-start-of-def): Use it. + + * fontlock.hs: Add test case. + + * haskell-font-lock.el (haskell-font-lock-version): Remove. + + * haskell-doc.el (haskell-doc-version): Remove. + (haskell-doc-get-current-word): Correctly distinguish + variable identifiers and infix identifiers. + (haskell-doc-rescan-files): Avoid switch-to-buffer. + (haskell-doc-imported-list): Operate on current buffer. + (haskell-doc-make-global-fct-index): Adjust call. + +2006-11-20 Stefan Monnier + + * haskell-doc.el (haskell-doc-mode-print-current-symbol-info): + Fix thinko. + +2006-10-19 Stefan Monnier + + * inf-haskell.el (inferior-haskell-load-file): Simplify and make more + robust at the same time. + + * haskell-doc.el: Drop p-c-idle-h in favor of run-with-idle-timer. + (haskell-doc-timer, haskell-doc-buffers): New vars. + (haskell-doc-mode): Use them. + (haskell-doc-check-active): Update the check. + (haskell-doc-mode-print-current-symbol-info): Don't sit-for unless it's + really needed. Remove the interactive spec. + +2006-09-25 Stefan Monnier + + * haskell-mode.el (haskell-mode-menu): Fix typo. + +2006-09-20 Stefan Monnier + + * haskell-font-lock.el (haskell-font-lock-keywords-create): Use a more + precise test for literate haskell highlighting. + + * haskell-mode.el (haskell-mode-menu): New menu. + (haskell-mode): Use new name `eldoc-documentation-function'. + +2006-05-18 Stefan Monnier + + * inf-haskell.el (inferior-haskell-wait-for-prompt): New fun, extracted + from inferior-haskell-send-command. + (inferior-haskell-send-command): Use it. + (inferior-haskell-wait-and-jump): New custom var. + (inferior-haskell-load-file): Use it. + +2006-05-17 Stefan Monnier + + * inf-haskell.el (inferior-haskell-mode): Use shell-dirtrack-mode + if possible. + + * haskell-hugs.el (haskell-hugs-start-process): + * haskell-ghci.el (haskell-ghci-start-process): + Use comint-input-filter-functions rather than the outdated + comint-input-sentinel. Reported by Jerry James . + +2005-12-09 Stefan Monnier + + * indent.hs: Add some erroneous cases. + + * haskell-font-lock.el (haskell-font-lock-keywords-create): + Minor regexp fiddling. + +2005-11-23 Stefan Monnier + + * haskell-indent.el (haskell-indent-next-symbol): Simplify. + (haskell-indent-comment): Rename from haskell-indent-inside-comment. + (haskell-indent-skip-lexeme-forward) + (haskell-indent-offset-after-info, haskell-indent-hanging-p): New funs. + (haskell-indent-inhibit-after-offset, haskell-indent-dont-hang): + New variables. + (haskell-indent-closing-keyword, haskell-indent-after-keyword-column) + (haskell-indent-inside-paren): New functions, extracted + from haskell-indent-indentation-info. Use the above new functions. + (haskell-indent-indentation-info): Use them. + (haskell-indent-after-keywords): Add data for ( and {. + + * haskell-font-lock.el (haskell-font-lock-keywords-create): `as' is not + a reserved keyword, apparently, and is used as var name. + +2005-11-21 Stefan Monnier + + * haskell-*.el (turn-(on|off)-*): Make non-interactive. + + * haskell-decl-scan.el (haskell-decl-scan-mode): New minor mode. + (turn-on-haskell-decl-scan): Use it. + + * haskell-doc.el (haskell-doc-extract-types): Get labelled data working. + (haskell-doc-prelude-types): Update via auto-generation. + + * haskell-doc.el (haskell-doc-extract-types): Get it partly working. + (haskell-doc-fetch-lib-urls): Don't use a literal if we apply + `nreverse' on it later on. + (haskell-doc-prelude-types): Update some parts by auto-generation. + (haskell-doc-grab, haskell-doc-string-nub-ws): Simplify. + + * haskell-doc.el (haskell-doc-maintainer, haskell-doc-varlist) + (haskell-doc-submit-bug-report, haskell-doc-ftp-site) + (haskell-doc-visit-home): Remove. + (haskell-doc-reserved-ids, haskell-doc-fetch-lib-urls) + (haskell-doc-extract-and-insert-types): New funs. + (haskell-doc-reserved-ids): Fix type of `map'. + +2005-11-20 Stefan Monnier + + * inf-haskell.el (inferior-haskell-load-file): Fix the + compilation-parsing-end fiddling so it doesn't get moved inadvertently. + + * haskell-font-lock.el (haskell-font-lock-symbols-alist): Some XEmacs + versions define make-char but not charsetp. + (haskell-font-lock-symbols-keywords): Add a `keep' arg so + de-highlighting in strings works correctly even in Emacs-21. + + * haskell-doc.el: Add coding cookie. + +2005-11-14 Stefan Monnier + + * haskell-decl-scan.el (haskell-ds-get-variable): Massage. + (haskell-ds-move-to-decl, haskell-ds-generic-find-next-decl): + Use with-syntax-table. + +2005-11-14 Dave Love + + * haskell-decl-scan.el: Docstring fixes. + (haskell-ds-keys): Delete. + (turn-on-haskell-decl-scan): Inline it here. + Use beginning-of-defun-function if available. + + * haskell-font-lock.el (haskell-font-lock-keywords-create): Add pattern + for numbers and strings for arguments to toplevel declarations. + +2005-11-14 Stefan Monnier + + * inf-haskell.el (inferior-haskell-error-regexp-alist): Fix GHCi + regexp, add support for warnings. + +2005-11-11 Stefan Monnier + + * Makefile (dist): Remove profile file and avoid ztar. + + * inf-haskell.el (inferior-haskell-command): Provide a default. + (with-selected-window): Define if necessary. + (inferior-haskell-load-file): Display the buffer. + + * haskell-indent.el (haskell-indent-indentation-info): Typo. + + * haskell-ghci.el (haskell-ghci-mode): Use define-derived-mode. + +2005-11-07 Stefan Monnier + + * Release version 2.1. + + * haskell-indent.el (haskell-indent-inside-comment): Rename `start' arg + into `open' and add a new `start' arg. + (haskell-indent-after-keywords): Change defaults for `in'. + (haskell-indent-indentation-info): Fix confusion between pos and col. + (haskell-indent-mode): Autoload. + + * haskell-indent.el (haskell-indent-find-matching-start): + Add `pred' and `start' arguments. + (haskell-indent-filter-let-no-in): New fun. + (haskell-indent-indentation-info): Use them to correctly match `let's + with `in's even when some of the `let's have no matching `in'. + +2005-11-06 Stefan Monnier + + * haskell-indent.el: Reduce the use of dyn-bound haskell-indent-info. + (haskell-indent-push-col): Don't duplicate info. + (haskell-indent-line-indentation): Handle let-in-do. Remove dead code. + (haskell-indent-inside-comment): Move rest of code from + haskell-indent-indentation-info. + + * haskell-indent.el (haskell-literate): Declare. + (haskell-running-xemacs, event-basic-type, read-event): Remove. + (haskell-indent-get-beg-of-line, haskell-indent-get-end-of-line): + Remove. Use line-(beginning|end)-position instead. + (haskell-indent-mark-active): Move the xemacs test inside the defun. + (haskell-indent-info): Rename from indent-info. Update users. + (haskell-indent-bolp, haskell-indent-inside-comment): + Use line-beginning-position. + (haskell-indent-within-literate-code): Use `case'. + (haskell-indent-put-region-in-literate): Bind more comment-* vars. + (haskell-indent-virtual-indentation): Add the missing `start' arg. + (haskell-indent-mode): Move before first use. + (haskell-indent-stand-alone-mode): Use haskell-indent-mode. + Rename from haskell-stand-alone-indent-mode. Use define-derived-mode. + (hugs-mode-map, hugs-syntax-table): + Rename to haskell-stand-alone-indent-mode-(map|syntax-table). + + * haskell-doc.el (haskell-doc-xemacs-p, haskell-doc-emacs-p) + (haskell-doc-message): Remove. + (haskell-doc-is-id-char-at): Remove. + (haskell-doc-get-current-word): Rewrite. + +2005-11-04 Stefan Monnier + + * haskell-indent.el (haskell-indent-indentation-info): Fix detection of + hanging let/if/case statements. + + * haskell-mode.el (haskell-mode): Fix typo. + +2005-11-04 Stefan Monnier + + * inf-haskell.el (inferior-haskell-mode): Hide compilation bindings. + + * haskell-indent.el (haskell-indent-after-keywords): New var. + (haskell-indent-virtual-indentation): New fun. + (haskell-indent-indentation-info): Use them to indent after keywords. + + * haskell-simple-indent.el (haskell-simple-indent): Minor simplif. + (turn-on-haskell-simple-indent): Don't bind \t and \n. + + * haskell-mode.el (haskell-vars, haskell-mode-generic): Remove. + (haskell-mode-hook): Rename from haskell-mode-hooks. + (haskell-mode): Use define-derived-mode. Inline haskell-mode-generic + and haskell-vars. + (literate-haskell-mode): Use define-derived-mode. + + * fontlock.hs: Add some entries for infix declarations. + +2005-10-12 Stefan Monnier + + * haskell-indent.el (haskell-indent-start-keywords-re): Use regexp-opt. + (haskell-indent-type-at-point): Accept ' in identifiers. + (haskell-indent-find-case): Tell match-data to not generate markers. + (haskell-indent-line-indentation): Ignore off-side keywords in comments + and strings. + (haskell-indent-find-matching-start): Generalize. + Rename from haskell-indent-find-let. + (haskell-indent-indentation-info): Use it for of, then, and else. + +2005-09-28 Stefan Monnier + + * haskell-indent.el (haskell-indent-in-comment): Don't fail at EOB. + + * haskell-font-lock.el (haskell-font-lock-symbols-alist): Add "not". + (haskell-font-lock-compose-symbol): Handle alphanum identifiers. + Fix incorrect handling of . when used for qualified names. + +2005-09-26 Stefan Monnier + + * haskell-font-lock.el (haskell-font-lock-symbols-alist): Prefer the + unicode version of lambda. Add two symbols from the Omega language and + from Paterson's arrow syntax. + +2005-08-24 Steve Chamberlain (tiny patch) + + * haskell-doc.el (haskell-doc-message): Paren typo. + +2005-08-23 Stefan Monnier + + * haskell-doc.el (haskell-doc-show-type): Assume that the availability + of display-message won't change at runtime. + + * haskell-font-lock.el (haskell-font-lock-keywords-create): Try and + work around a bug that seems to be in Emacs-21.3 rather than in + haskell-font-lock.el. Reported by Steve Chamberlain . + +2005-07-18 Stefan Monnier + + * inf-haskell.el (haskell-program-name): Fix defcustom delcaration. + + * haskell-doc.el (haskell-doc-message): Remove. + (haskell-doc-show-type): Inline it. Don't do anything for if there's + no doc to show. + +2005-02-02 Stefan Monnier + + * haskell-hugs.el (haskell-hugs-mode-map): + * haskell-ghci.el (haskell-ghci-mode-map): Remove. + +2005-01-26 Stefan Monnier + + * haskell-indent.el (haskell-indent-inside-comment): Don't assume that + column(pos+2) = column(pos)+2. + (haskell-indent-indentation-info): Fix indentation of , and ;. + Add arg `start'. Restrict choice of indentation for comments. + (haskell-indent-event-type): Remove. + (haskell-indent-last-info): New var. + (haskell-indent-cycle): Use it to store info from one invocation to + the next, so we can do cycling outside of the function. + Don't cycle directly any more. Instead, recognize repeated invocations + via last-command and friends. + Use indent-line-function rather than hardcoding indent-to-left-margin. + (haskell-indent-insert-where): Don't save excursion. + (haskell-indent-layout-indent-info): Minor simplifications. + (haskell-indent-line-indentation): Don't ignore code on a line + before a string. + + * haskell-hugs.el (haskell-hugs-last-loaded-file): Remove. + (haskell-hugs-start-process): Fix misuse of make-variable-buffer-local. + (haskell-hugs-go): Quote file name. Simplify. + + * haskell-ghci.el (haskell-ghci-last-loaded-file): Remove. + (haskell-ghci-start-process): Fix misuse of make-variable-buffer-local. + (haskell-ghci-go): Quote file name. Simplify. + + * haskell-mode.el (haskell-version): Keep it up-to-date. + + * inf-haskell.el (inferior-haskell-load-file): Quote file name. + +2004-12-10 Stefan Monnier + + * haskell-indent.el (haskell-indent-start-of-def): Only go backward. + (haskell-indent-in-string): Simplify. + (haskell-indent-in-comment): Simplify. + (haskell-indent-comment): Remove. + (haskell-indent-inside-comment): New fun. + (haskell-indent-indentation-info): Assume we're at the indentation. + Handle comments differently. + (haskell-indent-cycle): Go to indentation and then save excursion + around haskell-indent-indentation-info. + + * haskell-doc.el (haskell-doc-minor-mode-string): Make it dynamic. + (haskell-doc-install-keymap): Remove conflicting C-c C-o binding. + (haskell-doc-mode): Make a nil arg turn the mode ON. + (turn-on-haskell-doc-mode): Make it an alias for haskell-doc-mode. + (haskell-doc-mode): Don't touch haskell-doc-minor-mode-string. + (haskell-doc-show-global-types): Don't touch + haskell-doc-minor-mode-string. Call haskell-doc-make-global-fct-index. + (haskell-doc-check-active): Fix message. + (define-key-after): Don't define. + (haskell-doc-install-keymap): Check existence of define-key-after. + + * haskell-mode.el (haskell-literate-default): Fix custom type. + (haskell-vars): Ignore comments when doing C-M-f. + + * indent.hs: More test cases. + + * inf-haskell.el (haskell-program-name): Use ghci if hugs is absent. + (inferior-haskell-load-file): Reset compilation-parsing-end. + +2004-11-25 Stefan Monnier + + * Release version 2.0. + + * .emacs: Remove. + + * haskell-decl-scan.el (haskell-ds-imenu-label-cmp): Undo last + idiotic change. + + * haskell-doc.el (haskell-doc-sym-doc): Make even the last char bold. + + * haskell-mode.el (haskell-mode-map): Typo. + + * inf-haskell.el (inferior-haskell-mode): Typo. + (inferior-haskell-wait-for-output): Remove. + (inferior-haskell-send-command): New function. + (inferior-haskell-load-file): Use it. + + * index.html: + * installation-guide.html: Partial fixup. + +2004-11-24 Stefan Monnier + + * haskell-mode.el (turn-on-haskell-hugs, turn-on-haskell-ghci): + Mark them as obsolete. + (haskell-mode-map): Add bindings for the inferior-haskell commands. + + * inf-haskell.el: New file. + + * haskell-doc.el (haskell-doc-install-keymap): Don't blindly assume + there's a Hugs menu. + +2004-11-22 Stefan Monnier + + * haskell-indent.el (turn-on-haskell-indent, turn-off-haskell-indent): + Use C-c C-foo rather than C-c foo to follow coding conventions. + + * haskell-font-lock.el (haskell-font-lock-symbols-alist): Add . = â—‹. + +2004-10-25 Stefan Monnier + + * haskell-indent.el (haskell-indent-indentation-info): Don't use layout + for paren-closing elements. + +2004-10-20 Stefan Monnier + + * haskell-indent.el (haskell-indent-indentation-info): Only use + the new `in' indentation rule if the `let' is on the left of the decl. + +2004-10-19 Stefan Monnier + + * haskell-indent.el (haskell-indent-find-let): New function. + (haskell-indent-indentation-info): Use it to indent `in'. + + * haskell-font-lock.el (haskell-default-face): Add missing declaration. + + * haskell-indent.el (haskell-indent-open-structure): Simplify. + (haskell-indent-contour-line): Work even when `start' is in the middle + of a line. + (haskell-indent-layout-indent-info): New fun extracted from + haskell-indent-indentation-info. + (haskell-indent-indentation-info): Use it as before. Use it also to + handle layout-within-open-structure. + +2004-10-18 Stefan Monnier + + * haskell-font-lock.el (haskell-font-lock-keywords-create): + Use explicit `symbol-value' to work around limitations in XEmacs's + implementation of font-lock. + (haskell-basic-syntactic-keywords): Fix up char-constants some more. + +2004-10-14 Stefan Monnier + + * haskell-doc.el (turn-off-haskell-doc-mode) + (haskell-doc-current-info): Don't autoload. + + * haskell-decl-scan.el (haskell-ds-match-string): + Use match-string-no-properties if available. + (haskell-ds-syntax-table): Use haskell-mode-syntax-table. + (haskell-ds-imenu-label-cmp): Use car-less-than-car if available. + (haskell-ds-imenu): Remove obsolete incorrect code. + + * haskell-mode.el: Set things up so that mode-hook functions are not + necessary, and generic functions can be used instead, like + global-font-lock-mode. + (haskell-enum-from-to): Remove. + (turn-on-haskell-font-lock): Make obsolete. + (haskell-running-xemacs): Remove. + (haskell-mode-syntax-table): Fiddle with non-ascii chars. + Fix up comment syntax in XEmacs. + (haskell-vars): Improve comment-start-skip. + Add comment-end-skip. Setup imenu, eldoc, and font-lock. + Tweak handling of tabs to be on the safe side. + (haskell-mode-hooks): Declare and mention some useful ideas. + (literate-haskell-mode): Simplify. + (haskell-comment-indent): Remove. The default works as well. + + * haskell-font-lock.el: Remove level 1 fontification. + (haskell-font-lock-keywords-1, haskell-font-lock-keywords-2) + (bird-literate-haskell-font-lock-keywords-1) + (bird-literate-haskell-font-lock-keywords-2) + (latex-literate-haskell-font-lock-keywords-1) + (latex-literate-haskell-font-lock-keywords-2): Remove. + (bird-literate-haskell-font-lock-keywords) + (latex-literate-haskell-font-lock-keywords): Rename. + (haskell-font-lock-keywords-create): Remove `level' arg. + (haskell-fl-syntax): Remove. Assume the major modes sets it right. + (haskell-font-lock-choose-keywords) + (haskell-font-lock-choose-syntactic-keywords): New funs. + (haskell-font-lock-defaults-create): Use them. + (turn-off-haskell-font-lock, turn-on-haskell-font-lock): Simplify. + + * haskell-hugs.el (haskell-hugs-mode): Use define-derived-mode. + (run-hugs): New alias. + (haskell-hugs-wait-for-output): Don't loop if the process is dead. + + * haskell-font-lock.el (haskell-font-lock-compose-symbol): New fun. + (haskell-font-lock-symbols-keywords): Use it. + (haskell-string-char-face): Remove. + (haskell-font-lock-keywords-create): Hardcode font-lock-string-face. + (haskell-fl-syntax): Fix typos. Keep " as a string delimiter. + +2004-10-13 Stefan Monnier + + * haskell-doc.el (haskell-doc): New group. + (haskell-doc-show-reserved, haskell-doc-show-prelude) + (haskell-doc-show-strategy, haskell-doc-show-user-defined) + (haskell-doc-chop-off-context, haskell-doc-chop-off-fctname): + Make them custom vars. + (haskell-doc-keymap): Declare and fill it right there. + (haskell-doc-mode): Simplify. + (haskell-doc-toggle-var): Make it into what it was supposed to be. + (haskell-doc-mode-print-current-symbol-info): Simplify. + (haskell-doc-current-info): New autoloaded function. + (haskell-doc-sym-doc): New fun extracted from haskell-doc-show-type. + (haskell-doc-show-type): Use it. + (haskell-doc-wrapped-type-p): Remove unused var `lim'. + (haskell-doc-forward-sexp-safe, haskell-doc-current-symbol): + Remove. Unused. + (haskell-doc-visit-home): Don't require ange-ftp, it's autoloaded. + (haskell-doc-install-keymap): Simplify. + + * haskell-decl-scan.el (literate-haskell-ds-create-imenu-index) + (haskell-ds-generic-create-imenu-index): Remove. + (haskell-ds-bird-p): New function. + (haskell-ds-backward-decl, haskell-ds-forward-decl): Use it. + (haskell-ds-create-imenu-index): Use it to make it generic. + (haskell-ds-imenu): Remove now-unused arg. + (turn-on-haskell-decl-scan): Fix up call to haskell-ds-imenu. + (haskell-ds-running-xemacs): Remove. + (haskell-ds-func-menu-next): Make generic. + (literate-haskell-ds-func-menu-next): Delete. + (haskell-ds-func-menu): Remove unused arg. + (turn-on-haskell-decl-scan): Simplify. + + * haskell-indent.el: Don't load CL at runtime. + (haskell-indent-start-of-def, haskell-indent-type-at-point): + Don't hardcode point-min == 1. + (indent-info): Declare it. + (haskell-indent-empty, haskell-indent-ident, haskell-indent-other) + (haskell-indent-line-indentation): Use `string'. + (haskell-indent-valdef-indentation): Fix `case' arms syntax. + (haskell-indent-indentation-info): Remove unused var `pt'. + (haskell-indent-align-def): Remove unused var `defpos'. + (turn-on-haskell-indent): Don't bind TAB. + (turn-off-haskell-indent): Don't unbind TAB and DEL. + (hugs-syntax-table): Use the `n' for nested comments. + (haskell-stand-alone-indent-mode): Fix `comment-end'. + +;; Local Variables: +;; coding: utf-8 +;; End: + +# arch-tag: a2606dc4-fab7-4b2f-bbe9-0a51db643511 diff --git a/emacs.d/haskell/Makefile b/emacs.d/haskell/Makefile new file mode 100644 index 0000000..4b71aef --- /dev/null +++ b/emacs.d/haskell/Makefile @@ -0,0 +1,54 @@ +EMACS = emacs + +ELFILES = \ + haskell-font-lock.el \ + haskell-mode.el \ + haskell-doc.el \ + haskell-decl-scan.el \ + inf-haskell.el \ + haskell-indent.el + +ELCFILES = $(ELFILES:.el=.elc) +# AUTOLOADS = $(PACKAGE)-startup.el +AUTOLOADS = haskell-site-file.el + +%.elc: %.el + $(EMACS) --batch --eval '(setq load-path (cons "." load-path))' \ + -f batch-byte-compile $< + +all: $(ELCFILES) $(AUTOLOADS) + +info: + # No Texinfo file, sorry. + +###################################################################### +### don't look below ### +###################################################################### + +PACKAGE=haskell-mode + +$(AUTOLOADS): $(ELFILES) + [ -f $@ ] || echo ' ' >$@ + $(EMACS) --batch --eval '(setq generated-autoload-file "'`pwd`'/$@")' -f batch-update-autoloads "." + +## + +TAG = $(shell echo v$(VERSION) | tr '.' '_') +ftpdir=/u/monnier/html/elisp/ +cvsmodule=$(shell cat CVS/Repository) +cvsroot=$(shell cat CVS/Root) + +dist: + cvs tag -F $(TAG) &&\ + cd $(TMP) &&\ + unset CVSREAD; cvs -d $(cvsroot) export -kv -r $(TAG) -d $(PACKAGE)-$(VERSION) $(cvsmodule) &&\ + cd $(PACKAGE)-$(VERSION) &&\ + make info $(AUTOLOADS) &&\ + rm -f gmon.out;\ + cd .. &&\ + tar zcf $(PACKAGE)-$(VERSION).tar.gz $(PACKAGE)-$(VERSION) &&\ + rm -rf $(PACKAGE)-$(VERSION) + mv $(TMP)/$(PACKAGE)-$(VERSION).tar.gz $(ftpdir)/ + ln -sf $(PACKAGE)-$(VERSION).tar.gz $(ftpdir)/$(PACKAGE).tar.gz + +# arch-tag: 1ab314c8-3821-44fb-b533-dd58f5d75ba4 diff --git a/emacs.d/haskell/NEWS b/emacs.d/haskell/NEWS new file mode 100644 index 0000000..b27aaf0 --- /dev/null +++ b/emacs.d/haskell/NEWS @@ -0,0 +1,54 @@ +Changes since 2.2: + +* Trivial support for Cabal package description files. + +* Minor bug fixes. + +Changes since 2.1: + +* There are now commands to find type and info of identifiers by querying an + inferior haskell process. Available under C-c C-t, C-c C-i, and C-c M-. + +* Indentation now looks back further, until a line that has no indentation. + To recover the earlier behavior of stopping at the first empty line + instead, configure haskell-indent-look-past-empty-line. + +* inf-haskell can wait until a file load completes and jump directly to the + first error, like haskell-ghci and haskell-hugs used to do. See the var + inferior-haskell-wait-and-jump. + +Changes since 2.0: + +* inf-haskell uses ghci if hugs is absent. + +* Fix up some binding conflicts (C-c C-o in haskell-doc) + +* Many (hopefully minor) changes to the indentation. + +* New symbols in haskell-font-lock-symbols-alist. + +Changes since 1.45: + +* keybindings C-c have been replaced by C-c C- so as not + to collide with minor modes. + +* The following modules are now automatically activated without having to + add anything to haskell-mode-hook: + haskell-font-lock (just turn on global-font-lock-mode). + haskell-decl-scan (just bind `imenu' to some key). + +* In recent Emacsen, haskell-doc hooks into eldoc-mode. + +* haskell-hugs and haskell-ghci are superceded by inf-haskell. + +* Indentation rules have been improved when using layout inside parens/braces. + +* Symbols like -> and \ can be displayed as actual arrows and lambdas. + See haskell-font-lock-symbols. + +* Tweaks to the font-lock settings. Among other things paren-matching + with things like \(x,y) should work correctly now. + +* New maintainer . + +# arch-tag: e50204f2-98e4-438a-bcd1-a49afde5efa5 diff --git a/emacs.d/haskell/README b/emacs.d/haskell/README new file mode 100644 index 0000000..b4a8085 --- /dev/null +++ b/emacs.d/haskell/README @@ -0,0 +1,83 @@ +Haskell Mode for Emacs +---------------------- +Version number: v2_3. + +This is the Haskell mode package for Emacs. Its use should be mostly +self-explanatory if you're accustomed to Emacs. + +When Emacs is started up, it normally runs a file called ~/.emacs located in +your home directory. This file should contain all of your personal +customisations written as a series of Elisp commands. In order to install +the Haskell mode, you have to tell Emacs where to find it. This is done by +adding some commands to the init file. + +Installation +------------ + +- If you are using XEmacs, the haskell-mode package may be available for + installation through the XEmacs package UI. + +- If you are using Debian, you may be able to install the package + haskell-mode with a command like "apt-get install haskell-mode". + +Otherwise: + +- Download and unpack the basic mode and modules into a suitable directory, + e.g. ~/lib/emacs/haskell-mode/ where ~ stands for your home directory. + +- Assuming you have placed the basic mode haskell-mode.el and the modules + you want to use in the directory ~/lib/emacs/haskell-mode/, add the + following command to your init file (~/.emacs): + + (load "~/lib/emacs/haskell-mode/haskell-site-file") + + adding the following lines according to which modules you want to use: + + (add-hook 'haskell-mode-hook 'turn-on-haskell-doc-mode) + (add-hook 'haskell-mode-hook 'turn-on-haskell-indent) + ;;(add-hook 'haskell-mode-hook 'turn-on-haskell-simple-indent) + + Note that the two indentation modules are mutually exclusive - add at + most one. Note that the line of code for simple indentation is commented + out (using a preceeding ;) in preference for the more advanced + indentation module. Installation is now complete! + +The other modules are automatically loaded when needed in the following way: + +- Font locking: just turn it on via `global-font-lock-mode' or do + (add-hook 'haskell-mode-hook 'font-lock-mode) + +- Declaration scanning: just use M-x imenu or bind `imenu' to a key. E.g. + (global-set-key [(control meta down-mouse-3)] 'imenu) or you can also add + it to the menubar with (add-hook 'haskell-mode-hook 'imenu-add-menubar-index) + +- Interaction with inferior Haskell interpreter: just hit C-c C-z or C-c C-l. + + +Customization +------------- + +Most customizations are on the functionality of a particular module. +See the documentation of that module for information on its +customisation. + + +Known problems +-------------- + +It seems that some version of XEmacs come without the fsf-compat package +(which provides functions such as `line-end-position') and it seems that +even if your XEmacs does have the fsf-compat package installed it does not +autoload its part. Thus you may have to install the fsf-compat package and +add (require 'goto-addr) in your .emacs. + + +Support +------- + +Any problems, do mail me and I will try my best +to help you! + + + + diff --git a/emacs.d/haskell/fontlock.hs b/emacs.d/haskell/fontlock.hs new file mode 100644 index 0000000..ddd9adb --- /dev/null +++ b/emacs.d/haskell/fontlock.hs @@ -0,0 +1,49 @@ +-- Comments are coloured brightly and stand out clearly. + +import qualified Foo as F hiding (toto) +import qualified Foo hiding (toto) +import qualified Foo as F (toto) +import Foo as F hiding (toto) +import Foo hiding (toto) +import Foo as F (toto) + +hiding = 1 +qualified = 3 +as = 2 + +repeat :: a -> [a] +repeat xs = xs where xs = x:xs -- Keywords are also bright. + +head :: [a] -> a +head (x:_) = x +head [] = error "PreludeList.head: empty list" -- Strings are coloured softly. + +data Maybe a = Nothing | Just a -- Type constructors, data + deriving (Eq, Ord, Read, Show) -- constructors, class names + -- and module names are coloured + -- closer to ordinary code. + +recognize +++ infix :: Operator Declarations +as `well` as = This Form +(+) and this one = as well + +instance Show Toto where + fun1 arg1 = foo -- FIXME: `fun1' should be highlighted. + +constStr = "hello \ + \asdgfasgf\ + \asf" + +{- +map :: (a -> b) -> [a] -> [b] -- Commenting out large sections of +map f [] = [] -- code can be misleading. Coloured +map f (x:xs) = f x : map f xs -- comments reveal unused definitions. +-} + +-- Note: the least significant bit is the first element of the list +bdigits :: Int -> [Int] +bdigits 0 = [0] +bdigits 1 = [1] +bdigits n | n>1 = n `mod` 2 : + +-- arch-tag: a0d08cc2-4a81-4139-93bc-b3c6be0b5fb2 diff --git a/emacs.d/haskell/haskell-cabal.el b/emacs.d/haskell/haskell-cabal.el new file mode 100644 index 0000000..8309ca6 --- /dev/null +++ b/emacs.d/haskell/haskell-cabal.el @@ -0,0 +1,106 @@ +;;; haskell-cabal.el --- Support for Cabal packages + +;; Copyright (C) 2007 Stefan Monnier + +;; Author: Stefan Monnier + +;; This file is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 2, or (at your option) +;; any later version. + +;; This file is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs; see the file COPYING. If not, write to +;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, +;; Boston, MA 02110-1301, USA. + +;;; Commentary: + +;; + +;;; Code: + +;; (defun haskell-cabal-extract-fields-from-doc () +;; (require 'xml) +;; (require 'cl) +;; (let ((section (completing-read +;; "Section: " +;; '("general-fields" "library" "executable" "buildinfo")))) +;; (goto-char (point-min)) +;; (search-forward (concat ""))) +;; (let* ((xml (xml-parse-region +;; (progn (search-forward "") (match-beginning 0)) +;; (progn (search-forward "") (point)))) +;; (varlist (remove-if-not 'consp (cddar xml))) +;; (syms (mapcar (lambda (entry) (caddr (assq 'literal (assq 'term entry)))) +;; varlist)) +;; (fields (mapcar (lambda (sym) (substring-no-properties sym 0 -1)) syms))) +;; fields)) + +(defconst haskell-cabal-general-fields + ;; Extracted with (haskell-cabal-extract-fields-from-doc "general-fields") + '("name" "version" "cabal-version" "license" "license-file" "copyright" + "author" "maintainer" "stability" "homepage" "package-url" "synopsis" + "description" "category" "tested-with" "build-depends" "data-files" + "extra-source-files" "extra-tmp-files")) + +(defconst haskell-cabal-library-fields + ;; Extracted with (haskell-cabal-extract-fields-from-doc "library") + '("exposed-modules")) + +(defconst haskell-cabal-executable-fields + ;; Extracted with (haskell-cabal-extract-fields-from-doc "executable") + '("executable" "main-is")) + +(defconst haskell-cabal-buildinfo-fields + ;; Extracted with (haskell-cabal-extract-fields-from-doc "buildinfo") + '("buildable" "other-modules" "hs-source-dirs" "extensions" "ghc-options" + "ghc-prof-options" "hugs-options" "nhc-options" "includes" + "install-includes" "include-dirs" "c-sources" "extra-libraries" + "extra-lib-dirs" "cc-options" "ld-options" "frameworks")) + +(defvar haskell-cabal-mode-syntax-table + (let ((st (make-syntax-table))) + st)) + +(defvar haskell-cabal-font-lock-keywords + ;; The comment syntax can't be described simply in syntax-table. We could + ;; use font-lock-syntactic-keywords, but is it worth it? + '(("^--.*" . font-lock-comment-face) + ("^\\([^ :]+\\):" (1 font-lock-keyword-face)))) + +(defvar haskell-cabal-buffers nil + "List of Cabal buffers.") + +(defun haskell-cabal-buffers-clean (&optional buffer) + (let ((bufs ())) + (dolist (buf haskell-cabal-buffers) + (if (and (buffer-live-p buf) (not (eq buf buffer)) + (with-current-buffer buf (derived-mode-p 'haskell-cabal-mode))) + (push buf bufs))) + (setq haskell-cabal-buffers bufs))) + +(defun haskell-cabal-unregister-buffer () + (haskell-cabal-buffers-clean (current-buffer))) + +;;;###autoload +(add-to-list 'auto-mode-alist '("\\.cabal\\'" . haskell-cabal-mode)) + +;;;###autoload +(define-derived-mode haskell-cabal-mode fundamental-mode "Haskell-Cabal" + "Major mode for Cabal package description files." + (set (make-local-variable 'font-lock-defaults) + '(haskell-cabal-font-lock-keywords t t nil nil)) + (add-to-list 'haskell-cabal-buffers (current-buffer)) + (add-hook 'change-major-mode-hook 'haskell-cabal-unregister-buffer nil 'local) + (add-hook 'kill-buffer-hook 'haskell-cabal-unregister-buffer nil 'local)) + +(provide 'haskell-cabal) + +;; arch-tag: d455f920-5e4d-42b6-a2c7-4a7e84a05c29 +;;; haskell-cabal.el ends here diff --git a/emacs.d/haskell/haskell-decl-scan.el b/emacs.d/haskell/haskell-decl-scan.el new file mode 100644 index 0000000..ea1f27c --- /dev/null +++ b/emacs.d/haskell/haskell-decl-scan.el @@ -0,0 +1,695 @@ +;;; haskell-decl-scan.el --- Declaration scanning module for Haskell Mode + +;; Copyright (C) 2004, 2005 Free Software Foundation, Inc. +;; Copyright (C) 1997-1998 Graeme E Moss + +;; Author: 1997-1998 Graeme E Moss +;; Maintainer: Stefan Monnier +;; Keywords: declarations menu files Haskell +;; URL: http://cvs.haskell.org/cgi-bin/cvsweb.cgi/fptools/CONTRIB/haskell-modes/emacs/haskell-decl-scan.el?rev=HEAD + +;; This file is not part of GNU Emacs. + +;; This file is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 2, or (at your option) +;; any later version. + +;; This file is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs; see the file COPYING. If not, write to the +;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, +;; Boston, MA 02111-1307, USA. + + +;;; Commentary: + +;; Purpose: +;; +;; Top-level declarations are scanned and placed in a menu. Supports +;; full Latin1 Haskell 1.4 as well as literate scripts. +;; +;; +;; Installation: +;; +;; To turn declaration scanning on for all Haskell buffers under the +;; Haskell mode of Moss&Thorn, add this to .emacs: +;; +;; (add-hook haskell-mode-hook 'turn-on-haskell-decl-scan) +;; +;; Otherwise, call `turn-on-haskell-decl-scan'. +;; +;; +;; Customisation: +;; +;; None available so far. +;; +;; +;; History: +;; +;; If you have any problems or suggestions, after consulting the list +;; below, email gem@cs.york.ac.uk quoting the version of the library +;; you are using, the version of Emacs you are using, and a small +;; example of the problem or suggestion. Note that this library +;; requires a reasonably recent version of Emacs. +;; +;; Uses `imenu' under Emacs, and `func-menu' under XEmacs. +;; +;; Version 1.2: +;; Added support for LaTeX-style literate scripts. +;; +;; Version 1.1: +;; Use own syntax table. Fixed bug for very small buffers. Use +;; markers instead of pointers (markers move with the text). +;; +;; Version 1.0: +;; Brought over from Haskell mode v1.1. +;; +;; +;; Present Limitations/Future Work (contributions are most welcome!): +;; +;; . Declarations requiring information extending beyond starting line +;; don't get scanned properly, eg. +;; > class Eq a => +;; > Test a +;; +;; . Comments placed in the midst of the first few lexemes of a +;; declaration will cause havoc, eg. +;; > infixWithComments :: Int -> Int -> Int +;; > x {-nastyComment-} `infixWithComments` y = x + y +;; but are not worth worrying about. +;; +;; . Would be nice to scan other top-level declarations such as +;; methods of a class, datatype field labels... any more? +;; +;; . Support for GreenCard? +;; +;; . Re-running (literate-)haskell-imenu should not cause the problems +;; that it does. The ability to turn off scanning would also be +;; useful. (Note that re-running (literate-)haskell-mode seems to +;; cause no problems.) +;; +;; . Inconsistency: we define the start of a declaration in `imenu' as +;; the start of the line the declaration starts on, but in +;; `func-menu' as the start of the name that the declaration is +;; given (eg. "class Eq a => Ord a ..." starts at "class" in `imenu' +;; but at "Ord" in `func-menu'). This avoids rescanning of the +;; buffer by the goto functions of `func-menu' but allows `imenu' to +;; have the better definition of the start of the declaration (IMO). +;; +;; . `func-menu' cannot cope well with spaces in declaration names. +;; This is unavoidable in "instance Eq Int" (changing the spaces to +;; underscores would cause rescans of the buffer). Note though that +;; `fume-prompt-function-goto' (usually bound to "C-c g") does cope +;; with spaces okay. +;; +;; . Would like to extend the goto functions given by `func-menu' +;; under XEmacs to Emacs. Would have to implement these +;; ourselves as `imenu' does not provide them. +;; +;; . `func-menu' uses its own syntax table when grabbing a declaration +;; name to lookup (why doesn't it use the syntax table of the +;; buffer?) so some declaration names will not be grabbed correctly, +;; eg. "fib'" will be grabbed as "fib" since "'" is not a word or +;; symbol constituent under the syntax table `func-menu' uses. + +;; All functions/variables start with +;; `(turn-(on/off)-)haskell-decl-scan' or `haskell-ds-'. + +;; The imenu support is based on code taken from `hugs-mode', +;; thanks go to Chris Van Humbeeck. + +;; Version. + +;;; Code: + +(require 'haskell-mode) + +(defconst haskell-decl-scan-version "1.11" + "Version number of haskell-decl-scan.") +(defun haskell-decl-scan-version () + "Echo the current version of haskell-decl-scan in the minibuffer." + (interactive) + (message "Using haskell-decl-scan version %s" haskell-decl-scan-version)) + +;;###autoload +;; As `cl' defines macros that `imenu' uses, we must require them at +;; compile time. +(eval-when-compile + (require 'cl) + (condition-case nil + (require 'imenu) + (error nil))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; General declaration scanning functions. + +(defalias 'haskell-ds-match-string + (if (fboundp 'match-string-no-properties) + 'match-string-no-properties + (lambda (num) + "As `match-string' except that the string is stripped of properties." + (format "%s" (match-string num))))) + +(defvar haskell-ds-start-keywords-re + (concat "\\(\\<" + "class\\|data\\|i\\(mport\\|n\\(fix\\(\\|[lr]\\)\\|stance\\)\\)\\|" + "module\\|primitive\\|type\\|newtype" + "\\)\\>") + "Keywords that may start a declaration.") + +(defvar haskell-ds-syntax-table + (let ((table (copy-syntax-table haskell-mode-syntax-table))) + (modify-syntax-entry ?\' "w" table) + (modify-syntax-entry ?_ "w" table) + (modify-syntax-entry ?\\ "_" table) + table) + "Syntax table used for Haskell declaration scanning.") + + +(defun haskell-ds-get-variable (prefix) + "Return variable involved in value binding or type signature. +Assumes point is looking at the regexp PREFIX followed by the +start of a declaration (perhaps in the middle of a series of +declarations concerning a single variable). Otherwise return nil. +Point is not changed." + ;; I think I can now handle all declarations bar those with comments + ;; nested before the second lexeme. + (save-excursion + (with-syntax-table haskell-ds-syntax-table + (if (looking-at prefix) (goto-char (match-end 0))) + ;; Keyword. + (if (looking-at haskell-ds-start-keywords-re) + nil + (or ;; Parenthesized symbolic variable. + (and (looking-at "(\\(\\s_+\\))") (haskell-ds-match-string 1)) + ;; General case. + (if (looking-at + (if (eq ?\( (char-after)) + ;; Skip paranthesised expression. + (progn + (forward-sexp) + ;; Repeating this code and avoiding moving point if + ;; possible speeds things up. + "\\(\\'\\)?\\s-*\\(\\s_+\\|`\\(\\sw+\\)`\\)") + "\\(\\sw+\\)?\\s-*\\(\\s_+\\|`\\(\\sw+\\)`\\)")) + (let ((match2 (haskell-ds-match-string 2))) + ;; Weed out `::', `=' and `|' from potential infix + ;; symbolic variable. + (if (member match2 '("::" "=" "|")) + ;; Variable identifier. + (haskell-ds-match-string 1) + (if (eq (aref match2 0) ?\`) + ;; Infix variable identifier. + (haskell-ds-match-string 3) + ;; Infix symbolic variable. + match2)))) + ;; Variable identifier. + (and (looking-at "\\sw+") (haskell-ds-match-string 0))))))) + +(defun haskell-ds-move-to-start-regexp (inc regexp) + "Move to beginning of line that succeeds/precedes (INC = 1/-1) +current line that starts with REGEXP and is not in `font-lock-comment-face'." + ;; Making this defsubst instead of defun appears to have little or + ;; no effect on efficiency. It is probably not called enough to do + ;; so. + (while (and (= (forward-line inc) 0) + (or (not (looking-at regexp)) + (eq (get-text-property (point) 'face) + 'font-lock-comment-face))))) + +(defvar literate-haskell-ds-line-prefix "> ?" + "Regexp matching start of a line of Bird-style literate code. +Current value is \"> \" as we assume top-level declarations start +at column 3. Must not contain the special \"^\" regexp as we may +not use the regexp at the start of a regexp string. Note this is +only for `imenu' support.") + +(defvar haskell-ds-start-decl-re "\\(\\sw\\|(\\)" + "The regexp that starts a Haskell declaration.") + +(defvar literate-haskell-ds-start-decl-re + (concat literate-haskell-ds-line-prefix haskell-ds-start-decl-re) + "The regexp that starts a Bird-style literate Haskell declaration.") + +(defun haskell-ds-move-to-decl (direction bird-literate fix) + "General function for moving to the start of a declaration, +either forwards or backwards from point, with normal or with Bird-style +literate scripts. If DIRECTION is t, then forward, else backward. If +BIRD-LITERATE is t, then treat as Bird-style literate scripts, else +normal scripts. Returns point if point is left at the start of a +declaration, and nil otherwise, ie. because point is at the beginning +or end of the buffer and no declaration starts there. If FIX is t, +then point does not move if already at the start of a declaration." + ;; As `haskell-ds-get-variable' cannot separate an infix variable + ;; identifier out of a value binding with non-alphanumeric first + ;; argument, this function will treat such value bindings as + ;; separate from the declarations surrounding it. + (let ( ;; The variable typed or bound in the current series of + ;; declarations. + name + ;; The variable typed or bound in the new declaration. + newname + ;; Hack to solve hard problem for Bird-style literate scripts + ;; that start with a declaration. We are in the abyss if + ;; point is before start of this declaration. + abyss + (line-prefix (if bird-literate literate-haskell-ds-line-prefix "")) + ;; The regexp to match for the start of a declaration. + (start-decl-re (if bird-literate + literate-haskell-ds-start-decl-re + haskell-ds-start-decl-re)) + (increment (if direction 1 -1)) + (bound (if direction (point-max) (point-min)))) + ;; Change syntax table. + (with-syntax-table haskell-ds-syntax-table + ;; Move to beginning of line that starts the "current + ;; declaration" (dependent on DIRECTION and FIX), and then get + ;; the variable typed or bound by this declaration, if any. + (let ( ;; Where point was at call of function. + (here (point)) + ;; Where the declaration on this line (if any) starts. + (start (progn + (beginning-of-line) + ;; Checking the face to ensure a declaration starts + ;; here seems to be the only addition to make this + ;; module support LaTeX-style literate scripts. + (if (and (looking-at start-decl-re) + (not (eq (get-text-property (point) 'face) + 'font-lock-comment-face))) + (match-beginning 1))))) + (if (and start + ;; This complicated boolean determines whether we + ;; should include the declaration that starts on the + ;; current line as the "current declaration" or not. + (or (and (or (and direction (not fix)) + (and (not direction) fix)) + (>= here start)) + (and (or (and direction fix) + (and (not direction) (not fix))) + (> here start)))) + ;; If so, we are already at start of the current line, so + ;; do nothing. + () + ;; If point was before start of a declaration on the first + ;; line of the buffer (possible for Bird-style literate + ;; scripts) then we are in the abyss. + (if (and start (bobp)) + (setq abyss t) + ;; Otherwise we move to the start of the first declaration + ;; on a line preceeding the current one. + (haskell-ds-move-to-start-regexp -1 start-decl-re)))) + ;; If we are in the abyss, position and return as appropriate. + (if abyss + (if (not direction) + nil + (re-search-forward (concat "\\=" line-prefix) nil t) + (point)) + ;; Get the variable typed or bound by this declaration, if any. + (setq name (haskell-ds-get-variable line-prefix)) + (if (not name) + ;; If no such variable, stop at the start of this + ;; declaration if moving backward, or move to the next + ;; declaration if moving forward. + (if direction + (haskell-ds-move-to-start-regexp 1 start-decl-re)) + ;; If there is a variable, find the first + ;; succeeding/preceeding declaration that does not type or + ;; bind it. Check for reaching start/end of buffer. + (haskell-ds-move-to-start-regexp increment start-decl-re) + (while (and (/= (point) bound) + (and (setq newname (haskell-ds-get-variable line-prefix)) + (string= name newname))) + (setq name newname) + (haskell-ds-move-to-start-regexp increment start-decl-re)) + ;; If we are going backward, and have either reached a new + ;; declaration or the beginning of a buffer that does not + ;; start with a declaration, move forward to start of next + ;; declaration (which must exist). Otherwise, we are done. + (if (and (not direction) + (or (and (looking-at start-decl-re) + (not (string= name + ;; Note we must not use + ;; newname here as this may + ;; not have been set if we + ;; have reached the beginning + ;; of the buffer. + (haskell-ds-get-variable + line-prefix)))) + (and (not (looking-at start-decl-re)) + (bobp)))) + (haskell-ds-move-to-start-regexp 1 start-decl-re))) + ;; Store whether we are at the start of a declaration or not. + ;; Used to calculate final result. + (let ((at-start-decl (looking-at start-decl-re))) + ;; If we are at the beginning of a line, move over + ;; line-prefix, if present at point. + (if (bolp) + (re-search-forward (concat "\\=" line-prefix) (point-max) t)) + ;; Return point if at the start of a declaration and nil + ;; otherwise. + (if at-start-decl (point) nil)))))) + +(defun haskell-ds-bird-p () + (and (boundp 'haskell-literate) (eq haskell-literate 'bird))) + +(defun haskell-ds-backward-decl () + "Move point backward to the first character preceding the current +point that starts a top-level declaration. A series of declarations +concerning one variable is treated as one declaration by this +function. So, if point is within a top-level declaration then move it +to the start of that declaration. If point is already at the start of +a top-level declaration, then move it to the start of the preceding +declaration. Returns point if point is left at the start of a +declaration, and nil otherwise, ie. because point is at the beginning +of the buffer and no declaration starts there." + (interactive) + (haskell-ds-move-to-decl nil (haskell-ds-bird-p) nil)) + +(defun haskell-ds-forward-decl () + "As `haskell-ds-backward-decl' but forward." + (interactive) + (haskell-ds-move-to-decl t (haskell-ds-bird-p) nil)) + +(defun haskell-ds-generic-find-next-decl (bird-literate) + "Find the name, position and type of the declaration at or after point. +Return ((NAME . (START-POSITION . NAME-POSITION)) . TYPE) +if one exists and nil otherwise. The start-position is at the start +of the declaration, and the name-position is at the start of the name +of the declaration. The name is a string, the positions are buffer +positions and the type is one of the symbols \"variable\", \"datatype\", +\"class\", \"import\" and \"instance\"." + (let (;; The name, type and name-position of the declaration to + ;; return. + name + type + name-pos + ;; Buffer positions marking the start and end of the space + ;; containing a declaration. + start + end) + ;; Change to declaration scanning syntax. + (with-syntax-table haskell-ds-syntax-table + ;; Stop when we are at the end of the buffer or when a valid + ;; declaration is grabbed. + (while (not (or (eobp) name)) + ;; Move forward to next declaration at or after point. + (haskell-ds-move-to-decl t bird-literate t) + ;; Start and end of search space is currently just the starting + ;; line of the declaration. + (setq start (point) + end (progn (end-of-line) (point))) + (goto-char start) + (cond + ;; If the start of the top-level declaration does not begin + ;; with a starting keyword, then (if legal) must be a type + ;; signature or value binding, and the variable concerned is + ;; grabbed. + ((not (looking-at haskell-ds-start-keywords-re)) + (setq name (haskell-ds-get-variable "")) + (if name + (progn + (setq type 'variable) + (re-search-forward (regexp-quote name) end t) + (setq name-pos (match-beginning 0))))) + ;; User-defined datatype declaration. + ((re-search-forward "\\=\\(data\\|newtype\\|type\\)\\>" end t) + (re-search-forward "=>" end t) + (if (looking-at "[ \t]*\\(\\sw+\\)") + (progn + (setq name (haskell-ds-match-string 1)) + (setq name-pos (match-beginning 1)) + (setq type 'datatype)))) + ;; Class declaration. + ((re-search-forward "\\=class\\>" end t) + (re-search-forward "=>" end t) + (if (looking-at "[ \t]*\\(\\sw+\\)") + (progn + (setq name (haskell-ds-match-string 1)) + (setq name-pos (match-beginning 1)) + (setq type 'class)))) + ;; Import declaration. + ((looking-at "import[ \t]+\\(qualified[ \t]+\\)?\\(\\sw+\\)") + (setq name (haskell-ds-match-string 2)) + (setq name-pos (match-beginning 2)) + (setq type 'import)) + ;; Instance declaration. + ((re-search-forward "\\=instance[ \t]+" end t) + (re-search-forward "=>[ \t]+" end t) + ;; The instance "title" starts just after the `instance' (and + ;; any context) and finishes just before the _first_ `where' + ;; if one exists. This solution is ugly, but I can't find a + ;; nicer one---a simple regexp will pick up the last `where', + ;; which may be rare but nevertheless... + (setq name-pos (point)) + (setq name (format "%s" + (buffer-substring + (point) + (progn + ;; Look for a `where'. + (if (re-search-forward "\\" end t) + ;; Move back to just before the `where'. + (progn + (re-search-backward "\\s-where") + (point)) + ;; No `where' so move to last non-whitespace + ;; before `end'. + (progn + (goto-char end) + (skip-chars-backward " \t") + (point))))))) + ;; If we did not manage to extract a name, cancel this + ;; declaration (eg. when line ends in "=> "). + (if (string-match "^[ \t]*$" name) (setq name nil)) + (setq type 'instance))) + ;; Move past start of current declaration. + (goto-char end)) + ;; If we have a valid declaration then return it, otherwise return + ;; nil. + (if name + (cons (cons name (cons (copy-marker start t) (copy-marker name-pos t))) + type) + nil)))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Declaration scanning via `imenu'. + +(defun haskell-ds-create-imenu-index () + "Function for finding `imenu' declarations in Haskell mode. +Finds all declarations (classes, variables, imports, instances and +datatypes) in a Haskell file for the `imenu' package." + ;; Each list has elements of the form `(INDEX-NAME . INDEX-POSITION)'. + ;; These lists are nested using `(INDEX-TITLE . INDEX-ALIST)'. + (let* ((bird-literate (haskell-ds-bird-p)) + (index-alist '()) + (index-class-alist '()) ;; Classes + (index-var-alist '()) ;; Variables + (index-imp-alist '()) ;; Imports + (index-inst-alist '()) ;; Instances + (index-type-alist '()) ;; Datatypes + ;; Variables for showing progress. + (bufname (buffer-name)) + (divisor-of-progress (max 1 (/ (point-max) 100))) + ;; The result we wish to return. + result) + (goto-char (point-min)) + ;; Loop forwards from the beginning of the buffer through the + ;; starts of the top-level declarations. + (while (< (point) (point-max)) + (message "Scanning declarations in %s... (%3d%%)" bufname + (/ (point) divisor-of-progress)) + ;; Grab the next declaration. + (setq result (haskell-ds-generic-find-next-decl bird-literate)) + (if result + ;; If valid, extract the components of the result. + (let* ((name-posns (car result)) + (name (car name-posns)) + (posns (cdr name-posns)) + (start-pos (car posns)) + (type (cdr result)) + ;; Place `(name . start-pos)' in the correct alist. + (alist (cond + ((eq type 'variable) 'index-var-alist) + ((eq type 'datatype) 'index-type-alist) + ((eq type 'class) 'index-class-alist) + ((eq type 'import) 'index-imp-alist) + ((eq type 'instance) 'index-inst-alist)))) + (set alist (cons (cons name start-pos) (eval alist)))))) + ;; Now sort all the lists, label them, and place them in one list. + (message "Sorting declarations in %s..." bufname) + (and index-type-alist + (push (cons "Datatypes" + (sort index-type-alist 'haskell-ds-imenu-label-cmp)) + index-alist)) + (and index-inst-alist + (push (cons "Instances" + (sort index-inst-alist 'haskell-ds-imenu-label-cmp)) + index-alist)) + (and index-imp-alist + (push (cons "Imports" + (sort index-imp-alist 'haskell-ds-imenu-label-cmp)) + index-alist)) + (and index-var-alist + (push (cons "Variables" + (sort index-var-alist 'haskell-ds-imenu-label-cmp)) + index-alist)) + (and index-class-alist + (push (cons "Classes" + (sort index-class-alist 'haskell-ds-imenu-label-cmp)) + index-alist)) + (message "Sorting declarations in %s...done" bufname) + ;; Return the alist. + index-alist)) + +(defun haskell-ds-imenu-label-cmp (el1 el2) + "Predicate to compare labels in lists from `haskell-ds-create-imenu-index'." + (string< (car el1) (car el2))) + +(defun haskell-ds-imenu () + "Install `imenu' for Haskell scripts." + (setq imenu-create-index-function 'haskell-ds-create-imenu-index) + (if (fboundp 'imenu-add-to-menubar) + (imenu-add-to-menubar "Declarations"))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Declaration scanning via `func-menu'. + +(defun haskell-ds-func-menu-next (buffer) + "Non-literate Haskell version of `haskell-ds-generic-func-menu-next'." + (haskell-ds-generic-func-menu-next (haskell-ds-bird-p) buffer)) + +(defun haskell-ds-generic-func-menu-next (bird-literate buffer) + "Return `(name . pos)' of next declaration." + (set-buffer buffer) + (let ((result (haskell-ds-generic-find-next-decl bird-literate))) + (if result + (let* ((name-posns (car result)) + (name (car name-posns)) + (posns (cdr name-posns)) + (name-pos (cdr posns)) + ;;(type (cdr result)) + ) + (cons ;(concat + ;; func-menu has problems with spaces, and adding a + ;; qualifying keyword will not allow the "goto fn" + ;; functions to work properly. Sigh. + ;; (cond + ;; ((eq type 'variable) "") + ;; ((eq type 'datatype) "datatype ") + ;; ((eq type 'class) "class ") + ;; ((eq type 'import) "import ") + ;; ((eq type 'instance) "instance ")) + name;) + name-pos)) + nil))) + +(defvar haskell-ds-func-menu-regexp + (concat "^" haskell-ds-start-decl-re) + "Regexp to match the start of a possible declaration.") + +(defvar literate-haskell-ds-func-menu-regexp + (concat "^" literate-haskell-ds-start-decl-re) + "As `haskell-ds-func-menu-regexp' but for Bird-style literate scripts.") + +(defvar fume-menubar-menu-name) +(defvar fume-function-name-regexp-alist) +(defvar fume-find-function-name-method-alist) + +(defun haskell-ds-func-menu () + "Use `func-menu' to establish declaration scanning for Haskell scripts." + (require 'func-menu) + (set (make-local-variable 'fume-menubar-menu-name) "Declarations") + (set (make-local-variable 'fume-function-name-regexp-alist) + (if (haskell-ds-bird-p) + '((haskell-mode . literate-haskell-ds-func-menu-regexp)) + '((haskell-mode . haskell-ds-func-menu-regexp)))) + (set (make-local-variable 'fume-find-function-name-method-alist) + '((haskell-mode . haskell-ds-func-menu-next))) + (fume-add-menubar-entry) + (local-set-key "\C-cl" 'fume-list-functions) + (local-set-key "\C-cg" 'fume-prompt-function-goto) + (local-set-key [(meta button1)] 'fume-mouse-function-goto)) + +;; The main functions to turn on declaration scanning. +(defun turn-on-haskell-decl-scan () + "Unconditionally activate `haskell-decl-scan-mode'." + (haskell-decl-scan-mode 1)) + +(defvar haskell-decl-scan-mode nil) +(make-variable-buffer-local 'haskell-decl-scan-mode) + +;;;###autoload +(defun haskell-decl-scan-mode (&optional arg) + "Minor mode for declaration scanning for Haskell mode. +Top-level declarations are scanned and listed in the menu item \"Declarations\". +Selecting an item from this menu will take point to the start of the +declaration. + +\\[haskell-ds-forward-decl] and \\[haskell-ds-backward-decl] move forward and backward to the start of a declaration. + +Under XEmacs, the following keys are also defined: + +\\[fume-list-functions] lists the declarations of the current buffer, +\\[fume-prompt-function-goto] prompts for a declaration to move to, and +\\[fume-mouse-function-goto] moves to the declaration whose name is at point. + +This may link with `haskell-doc' (only for Emacs currently). + +For non-literate and LaTeX-style literate scripts, we assume the +common convention that top-level declarations start at the first +column. For Bird-style literate scripts, we assume the common +convention that top-level declarations start at the third column, +ie. after \"> \". + +Anything in `font-lock-comment-face' is not considered for a +declaration. Therefore, using Haskell font locking with comments +coloured in `font-lock-comment-face' improves declaration scanning. + +To turn on declaration scanning for all Haskell buffers, add this to +.emacs: + + (add-hook 'haskell-mode-hook 'turn-on-haskell-decl-scan) + +To turn declaration scanning on for the current buffer, call +`turn-on-haskell-decl-scan'. + +Literate Haskell scripts are supported: If the value of +`haskell-literate' (automatically set by the Haskell mode of +Moss&Thorn) is 'bird, a Bird-style literate script is assumed. If it +is nil or 'latex, a non-literate or LaTeX-style literate script is +assumed, respectively. + +Invokes `haskell-decl-scan-hook' if not nil. + +Use `haskell-decl-scan-version' to find out what version this is." + (if (boundp 'beginning-of-defun-function) + (if haskell-decl-scan-mode + (progn + (set (make-local-variable 'beginning-of-defun-function) + 'haskell-ds-backward-decl) + (set (make-local-variable 'end-of-defun-function) + 'haskell-ds-forward-decl)) + (kill-local-variable 'beginning-of-defun-function) + (kill-local-variable 'end-of-defun-function)) + (local-set-key "\M-\C-e" + (if haskell-decl-scan-mode 'haskell-ds-forward-decl)) + (local-set-key "\M-\C-a" + (if haskell-decl-scan-mode 'haskell-ds-backward-decl))) + (if haskell-decl-scan-mode + (if (fboundp 'imenu) + (haskell-ds-imenu) + (haskell-ds-func-menu)) + ;; How can we cleanly remove that menus? + (local-set-key [menu-bar index] nil)) + (run-hooks 'haskell-decl-scan-mode-hook)) + +;; Provide ourselves: + +(provide 'haskell-decl-scan) + +;; arch-tag: f4335fd8-4b6c-472e-9899-004d47d94818 +;;; haskell-decl-scan.el ends here diff --git a/emacs.d/haskell/haskell-doc.el b/emacs.d/haskell/haskell-doc.el new file mode 100644 index 0000000..05689d0 --- /dev/null +++ b/emacs.d/haskell/haskell-doc.el @@ -0,0 +1,1915 @@ +;;; haskell-doc.el --- show function types in echo area -*- coding: iso-8859-1 -*- + +;; Copyright (C) 2004, 2005, 2006, 2007 Free Software Foundation, Inc. +;; Copyright (C) 1997 Hans-Wolfgang Loidl + +;; Author: Hans-Wolfgang Loidl +;; Temporary Maintainer and Hacker: Graeme E Moss +;; Keywords: extensions, minor mode, language mode, Haskell +;; Created: 1997-06-17 +;; URL: http://cvs.haskell.org/cgi-bin/cvsweb.cgi/fptools/CONTRIB/haskell-modes/emacs/haskell-doc.el?rev=HEAD + +;;; Copyright: +;; ========== + +;; 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; if not, you can either send email to this +;; program's maintainer or write to: The Free Software Foundation, +;; Inc.; 59 Temple Place, Suite 330; Boston, MA 02111-1307, USA. + +;;; Commentary: +;; =========== + +;; This program shows the type of the Haskell function under the cursor in the +;; minibuffer. It acts as a kind of "emacs background process", by regularly +;; checking the word under the cursor and matching it against a list of +;; prelude, library, local and global functions. + +;; The preferred usage of this package is in combination with +;; `haskell-hugs-mode'. +;; In that case `haskell-doc-mode' checks an internal variable updated by +;; `imenu' to access the types of all local functions. In `haskell-mode' this +;; is not possible. However, types of prelude functions are still shown. + +;; To show types of global functions, i.e. functions defined in a module +;; imported by the current module, call the function +;; `turn-on-haskell-doc-global-types'. This automatically loads all modules +;; and builds `imenu' tables to get the types of all functions (again this +;; currently requires `haskell-hugs-mode'). +;; Note: The modules are loaded recursively, so you might pull in +;; many modules by just turning on global function support. +;; This features is currently not very well supported. + +;; This program was inspired by the `eldoc.el' package by Noah Friedman. + +;;; Installation: +;; ============= + +;; One useful way to enable this minor mode is to put the following in your +;; .emacs: +;; +;; (autoload 'turn-on-haskell-doc-mode "haskell-doc" nil t) + +;; and depending on the major mode you use for your Haskell programs: +;; (add-hook 'hugs-mode-hook 'turn-on-haskell-doc-mode) ; hugs-mode +;; or +;; (add-hook 'haskell-mode-hook 'turn-on-haskell-doc-mode) ; haskell-mode + +;;; Customisation: +;; ============== + +;; You can control what exactly is shown by setting the following variables to +;; either t or nil: +;; `haskell-doc-show-global-types' (default: nil) +;; `haskell-doc-show-reserved' (default: t) +;; `haskell-doc-show-prelude' (default: t) +;; `haskell-doc-show-strategy' (default: t) +;; `haskell-doc-show-user-defined' (default: t) + +;; If you want to define your own strings for some identifiers define an +;; alist of (ID . STRING) and set `haskell-doc-show-user-defined' to t. +;; E.g: +;; +;; (setq haskell-doc-show-user-defined t) +;; (setq haskell-doc-user-defined-ids +;; (list +;; '("main" . "just another pathetic main function") +;; '("foo" . "a very dummy name") +;; '("bar" . "another dummy name"))) + +;; The following two variables are useful to make the type fit on one line: +;; If `haskell-doc-chop-off-context' is non-nil the context part of the type +;; of a local fct will be eliminated (default: t). +;; If `haskell-doc-chop-off-fctname' is non-nil the function name is not +;; shown together with the type (default: nil). + +;;; Internals: +;; ========== + +;; `haskell-doc-mode' is implemented as a minor-mode. So, you can combine it +;; with any other mode. To enable it just type +;; M-x turn-on-haskell-doc-mode + +;; These are the names of the functions that can be called directly by the +;; user (with keybindings in `haskell-hugs-mode' and `haskell-mode'): +;; `haskell-doc-mode' ... toggle haskell-doc-mode; with prefix turn it on +;; unconditionally if the prefix is greater 0 otherwise +;; turn it off +;; Key: CTRL-c CTRL-o (CTRL-u CTRL-c CTRL-o) +;; `haskell-doc-ask-mouse-for-type' ... show the type of the id under the mouse +;; Key: C-S-M-mouse-3 +;; `haskell-doc-show-reserved' ... toggle echoing of reserved id's types +;; `haskell-doc-show-prelude' ... toggle echoing of prelude id's types +;; `haskell-doc-show-strategy' ... toggle echoing of strategy id's types +;; `haskell-doc-show-user-defined' ... toggle echoing of user def id's types +;; `haskell-doc-check-active' ... check whether haskell-doc is active; +;; Key: CTRL-c ESC-/ + +;;; ToDo: +;; ===== + +;; - Fix byte-compile problems in `haskell-doc-prelude-types' for getArgs etc +;; - Write a parser for .hi files and make haskell-doc independent from +;; hugs-mode. Read library interfaces via this parser. +;; - Indicate kind of object with colours +;; - Handle multi-line types +;; - Encode i-am-fct info in the alist of ids and types. + +;;; Bugs: +;; ===== + +;; - Some prelude fcts aren't displayed properly. This might be due to a +;; name clash of Haskell and Elisp functions (e.g. length) which +;; confuses emacs when reading `haskell-doc-prelude-types' + +;;; Changelog: +;; ========== +;; haskell-doc.el,v +;; Revision 1.26 2007/02/10 06:28:55 monnier +;; (haskell-doc-get-current-word): Remove. +;; Change all refs to it, to use haskell-ident-at-point instead. +;; +;; Revision 1.25 2007/02/09 21:53:42 monnier +;; (haskell-doc-get-current-word): Correctly distinguish +;; variable identifiers and infix identifiers. +;; (haskell-doc-rescan-files): Avoid switch-to-buffer. +;; (haskell-doc-imported-list): Operate on current buffer. +;; (haskell-doc-make-global-fct-index): Adjust call. +;; +;; Revision 1.24 2006/11/20 20:18:24 monnier +;; (haskell-doc-mode-print-current-symbol-info): Fix thinko. +;; +;; Revision 1.23 2006/10/20 03:12:31 monnier +;; Drop post-command-idle-hook in favor of run-with-idle-timer. +;; (haskell-doc-timer, haskell-doc-buffers): New vars. +;; (haskell-doc-mode): Use them. +;; (haskell-doc-check-active): Update the check. +;; (haskell-doc-mode-print-current-symbol-info): Remove the interactive spec. +;; Don't sit-for unless it's really needed. +;; +;; Revision 1.22 2006/09/20 18:42:35 monnier +;; Doc fix. +;; +;; Revision 1.21 2005/11/21 21:48:52 monnier +;; * haskell-doc.el (haskell-doc-extract-types): Get labelled data working. +;; (haskell-doc-prelude-types): Update via auto-generation. +;; +;; * haskell-doc.el (haskell-doc-extract-types): Get it partly working. +;; (haskell-doc-fetch-lib-urls): Don't use a literal if we apply +;; `nreverse' on it later on. +;; (haskell-doc-prelude-types): Update some parts by auto-generation. +;; (haskell-doc-grab, haskell-doc-string-nub-ws): Simplify. +;; +;; * haskell-doc.el (haskell-doc-maintainer, haskell-doc-varlist) +;; (haskell-doc-submit-bug-report, haskell-doc-ftp-site) +;; (haskell-doc-visit-home): Remove. +;; (haskell-doc-reserved-ids, haskell-doc-fetch-lib-urls) +;; (haskell-doc-extract-and-insert-types): New funs. +;; (haskell-doc-reserved-ids): Fix type of `map'. +;; +;; Revision 1.20 2005/11/21 21:27:57 monnier +;; (haskell-doc-extract-types): Get labelled data working. +;; (haskell-doc-prelude-types): Update via auto-generation. +;; +;; Revision 1.19 2005/11/21 20:44:13 monnier +;; (haskell-doc-extract-types): Get it partly working. +;; (haskell-doc-fetch-lib-urls): Don't use a literal if we apply +;; `nreverse' on it later on. +;; (haskell-doc-prelude-types): Update some parts by auto-generation. +;; (haskell-doc-grab, haskell-doc-string-nub-ws): Simplify. +;; +;; Revision 1.18 2005/11/21 18:02:15 monnier +;; (haskell-doc-maintainer, haskell-doc-varlist) +;; (haskell-doc-submit-bug-report, haskell-doc-ftp-site) +;; (haskell-doc-visit-home): Remove. +;; (haskell-doc-reserved-ids, haskell-doc-fetch-lib-urls) +;; (haskell-doc-extract-and-insert-types): New funs. +;; (haskell-doc-reserved-ids): Fix type of `map'. +;; +;; Revision 1.17 2005/11/20 23:55:09 monnier +;; Add coding cookie. +;; +;; Revision 1.16 2005/11/07 01:28:16 monnier +;; (haskell-doc-xemacs-p, haskell-doc-emacs-p) +;; (haskell-doc-message): Remove. +;; (haskell-doc-is-id-char-at): Remove. +;; (haskell-doc-get-current-word): Rewrite. +;; +;; Revision 1.15 2005/11/04 17:11:12 monnier +;; Add arch-tag. +;; +;; Revision 1.14 2005/08/24 11:36:32 monnier +;; (haskell-doc-message): Paren typo. +;; +;; Revision 1.13 2005/08/23 19:23:27 monnier +;; (haskell-doc-show-type): Assume that the availability +;; of display-message won't change at runtime. +;; +;; Revision 1.12 2005/07/18 21:04:14 monnier +;; (haskell-doc-message): Remove. +;; (haskell-doc-show-type): inline it. Do nothing for if there's no doc to show. +;; +;; Revision 1.11 2004/12/10 17:33:18 monnier +;; (haskell-doc-minor-mode-string): Make it dynamic. +;; (haskell-doc-install-keymap): Remove conflicting C-c C-o binding. +;; (haskell-doc-mode): Make a nil arg turn the mode ON. +;; (turn-on-haskell-doc-mode): Make it an alias for haskell-doc-mode. +;; (haskell-doc-mode): Don't touch haskell-doc-minor-mode-string. +;; (haskell-doc-show-global-types): Don't touch +;; haskell-doc-minor-mode-string. Call haskell-doc-make-global-fct-index. +;; (haskell-doc-check-active): Fix message. +;; (define-key-after): Don't define. +;; (haskell-doc-install-keymap): Check existence of define-key-after. +;; +;; Revision 1.10 2004/11/25 23:03:23 monnier +;; (haskell-doc-sym-doc): Make even the last char bold. +;; +;; Revision 1.9 2004/11/24 22:14:36 monnier +;; (haskell-doc-install-keymap): Don't blindly assume there's a Hugs menu. +;; +;; Revision 1.8 2004/11/22 10:45:35 simonmar +;; Fix type of getLine +;; +;; Revision 1.7 2004/10/14 22:27:47 monnier +;; (turn-off-haskell-doc-mode, haskell-doc-current-info): Don't autoload. +;; +;; Revision 1.6 2004/10/13 22:45:22 monnier +;; (haskell-doc): New group. +;; (haskell-doc-show-reserved, haskell-doc-show-prelude) +;; (haskell-doc-show-strategy, haskell-doc-show-user-defined) +;; (haskell-doc-chop-off-context, haskell-doc-chop-off-fctname): +;; Make them custom vars. +;; (haskell-doc-keymap): Declare and fill it right there. +;; (haskell-doc-mode): Simplify. +;; (haskell-doc-toggle-var): Make it into what it was supposed to be. +;; (haskell-doc-mode-print-current-symbol-info): Simplify. +;; (haskell-doc-current-info): New autoloaded function. +;; (haskell-doc-sym-doc): New fun extracted from haskell-doc-show-type. +;; (haskell-doc-show-type): Use it. +;; (haskell-doc-wrapped-type-p): Remove unused var `lim'. +;; (haskell-doc-forward-sexp-safe, haskell-doc-current-symbol): Remove. Unused. +;; (haskell-doc-visit-home): Don't require ange-ftp, it's autoloaded. +;; (haskell-doc-install-keymap): Simplify. +;; +;; Revision 1.5 2003/01/09 11:56:26 simonmar +;; Patches from Ville Skyttä , the XEmacs maintainer of +;; the haskell-mode: +;; +;; - Make the auto-mode-alist modifications autoload-only. +;; +;; Revision 1.4 2002/10/14 09:55:03 simonmar +;; Patch to update the Prelude/libraries function names and to remove +;; support for older versions of Haskell. +;; +;; Submitted by: Anders Lau Olsen +;; +;; Revision 1.3 2002/04/30 09:34:37 rrt +;; Remove supporting Haskell 1.4 and 1.2 from the ToDo list. It's Far Too Late. +;; +;; Add (require 'imenu). Thanks to N. Y. Kwok. +;; +;; Revision 1.2 2002/04/23 14:45:10 simonmar +;; Tweaks to the doc strings and support for customization, from +;; Ville Skyttä . +;; +;; Revision 1.1 2001/07/19 16:17:36 rrt +;; Add the current version of the Moss/Thorn/Marlow Emacs mode, along with its +;; web pages and sample files. This is now the preferred mode, and the +;; haskell.org pages are being changed to reflect that. Also includes the new +;; GHCi mode from Chris Webb. +;; +;; Revision 1.6 1998/12/10 16:27:25 hwloidl +;; Minor changes ("Doc" as modeline string, mouse-3 moved to C-S-M-mouse-3) +;; +;; Revision 1.5 1998/09/24 14:25:46 gem +;; Fixed minor compatibility bugs with Haskell mode of Moss&Thorn. +;; Disabled M-/ binding. +;; +;; Revision 1.4 1997/11/12 23:51:19 hwloidl +;; Fixed start-up problem under emacs-19.34. +;; Added support for wrapped (multi-line) types and 2 vars to control the +;; behaviour with long fct types +;; +;; Revision 1.3 1997/11/03 00:48:03 hwloidl +;; Major revision for first release. +;; Added alists for showing prelude fcts, haskell syntax, and strategies +;; Added mouse interface to show type under mouse +;; Fixed bug which causes demon to fall over +;; Works now with hugs-mode and haskell-mode under emacs 19.34,20 and xemacs 19.15 +;; + +;;; Code: +;; ===== + +;;@menu +;;* Constants and Variables:: +;;* Install as minor mode:: +;;* Menubar Support:: +;;* Haskell Doc Mode:: +;;* Switch it on or off:: +;;* Check:: +;;* Top level function:: +;;* Mouse interface:: +;;* Print fctsym:: +;;* Movement:: +;;* Bug Reports:: +;;* Visit home site:: +;;* Index:: +;;* Token:: +;;@end menu + +;;@node top, Constants and Variables, (dir), (dir) +;;@top + +;;@node Constants and Variables, Install as minor mode, top, top +;;@section Constants and Variables + +;;@menu +;;* Emacs portability:: +;;* Maintenance stuff:: +;;* Mode Variable:: +;;* Variables:: +;;* Prelude types:: +;;* Test membership:: +;;@end menu + +;;@node Emacs portability, Maintenance stuff, Constants and Variables, Constants and Variables +;;@subsection Emacs portability + +(require 'haskell-mode) +(eval-when-compile (require 'cl)) + +(defgroup haskell-doc nil + "Show Haskell function types in echo area." + :group 'haskell + :prefix "haskell-doc-") + +;;@node Mode Variable, Variables, Maintenance stuff, Constants and Variables +;;@subsection Mode Variable + +(defvar haskell-doc-mode nil + "*If non-nil, show the type of the function near point or a related comment. + +If the identifier near point is a Haskell keyword and the variable +`haskell-doc-show-reserved' is non-nil show a one line summary +of the syntax. + +If the identifier near point is a Prelude or one of the standard library +functions and `haskell-doc-show-prelude' is non-nil show its type. + +If the identifier near point is local \(i.e. defined in this module\) check +the `imenu' list of functions for the type. This obviously requires that +your language mode uses `imenu' \(`haskell-hugs-mode' 0.6 for example\). + +If the identifier near point is global \(i.e. defined in an imported module\) +and the variable `haskell-doc-show-global-types' is non-nil show the type of its +function. + +If the identifier near point is a standard strategy or a function, type related +related to strategies and `haskell-doc-show-strategy' is non-nil show the type +of the function. Strategies are special to the parallel execution of Haskell. +If you're not interested in that just turn it off. + +If the identifier near point is a user defined function that occurs as key +in the alist `haskell-doc-user-defined-ids' and the variable +`haskell-doc-show-user-defined' is non-nil show the type of the function. + +This variable is buffer-local.") +(make-variable-buffer-local 'haskell-doc-mode) + +(defvar haskell-doc-mode-hook nil + "Hook invoked when entering `haskell-doc-mode'.") + +(defvar haskell-doc-index nil + "Variable holding an alist matching file names to fct-type alists. +The function `haskell-doc-make-global-fct-index' rebuilds this variables \(similar to an +`imenu' rescan\). +This variable is buffer-local.") +(make-variable-buffer-local 'haskell-doc-index) + +(defcustom haskell-doc-show-global-types nil + "If non-nil, search for the types of global functions by loading the files. +This variable is buffer-local." + :type 'boolean) +(make-variable-buffer-local 'haskell-doc-show-global-types) + +(defcustom haskell-doc-show-reserved t + "If non-nil, show a documentation string for reserved ids. +This variable is buffer-local." + :type 'boolean) +(make-variable-buffer-local 'haskell-doc-show-reserved) + +(defcustom haskell-doc-show-prelude t + "If non-nil, show a documentation string for prelude functions. +This variable is buffer-local." + :type 'boolean) +(make-variable-buffer-local 'haskell-doc-show-prelude) + +(defcustom haskell-doc-show-strategy t + "If non-nil, show a documentation string for strategies. +This variable is buffer-local." + :type 'boolean) +(make-variable-buffer-local 'haskell-doc-show-strategy) + +(defcustom haskell-doc-show-user-defined t + "If non-nil, show a documentation string for user defined ids. +This variable is buffer-local." + :type 'boolean) +(make-variable-buffer-local 'haskell-doc-show-user-defined) + +(defcustom haskell-doc-chop-off-context t + "If non-nil eliminate the context part in a Haskell type." + :type 'boolean) + +(defcustom haskell-doc-chop-off-fctname nil + "If non-nil omit the function name and show only the type." + :type 'boolean) + +(defvar haskell-doc-search-distance 40 ; distance in characters + "*How far to search when looking for the type declaration of fct under cursor.") + +;;@node Variables, Prelude types, Mode Variable, Constants and Variables +;;@subsection Variables + +(defvar haskell-doc-idle-delay 0.50 + "*Number of seconds of idle time to wait before printing. +If user input arrives before this interval of time has elapsed after the +last input, no documentation will be printed. + +If this variable is set to 0, no idle time is required.") + +(defvar haskell-doc-argument-case 'identity ; 'upcase + "Case to display argument names of functions, as a symbol. +This has two preferred values: `upcase' or `downcase'. +Actually, any name of a function which takes a string as an argument and +returns another string is acceptable.") + +(defvar haskell-doc-mode-message-commands nil + "*Obarray of command names where it is appropriate to print in the echo area. + +This is not done for all commands since some print their own +messages in the echo area, and these functions would instantly overwrite +them. But `self-insert-command' as well as most motion commands are good +candidates. + +It is probably best to manipulate this data structure with the commands +`haskell-doc-add-command' and `haskell-doc-remove-command'.") + +;;(cond ((null haskell-doc-mode-message-commands) +;; ;; If you increase the number of buckets, keep it a prime number. +;; (setq haskell-doc-mode-message-commands (make-vector 31 0)) +;; (let ((list '("self-insert-command" +;; "next-" "previous-" +;; "forward-" "backward-" +;; "beginning-of-" "end-of-" +;; "goto-" +;; "recenter" +;; "scroll-")) +;; (syms nil)) +;; (while list +;; (setq syms (all-completions (car list) obarray 'fboundp)) +;; (setq list (cdr list)) +;; (while syms +;; (set (intern (car syms) haskell-doc-mode-message-commands) t) +;; (setq syms (cdr syms))))))) + +;; Bookkeeping; the car contains the last symbol read from the buffer. +;; The cdr contains the string last displayed in the echo area, so it can +;; be printed again if necessary without reconsing. +(defvar haskell-doc-last-data '(nil . nil)) + +(defvar haskell-doc-minor-mode-string + '(haskell-doc-show-global-types " DOC" " Doc") + "*String to display in mode line when Haskell-Doc Mode is enabled.") + + +;;@node Prelude types, Test membership, Variables, Constants and Variables +;;@subsection Prelude types + +;;@cindex haskell-doc-reserved-ids + +(defvar haskell-doc-reserved-ids + '(("case" . "case exp of { alts [;] }") + ("class" . "class [context =>] simpleclass [where { cbody [;] }]") + ("data" . "data [context =>] simpletype = constrs [deriving]") + ("default" . "default (type1 , ... , typen)") + ("deriving" . "deriving (dclass | (dclass1, ... , dclassn))") ; used with data or newtype + ("do" . "do { stmts [;] } stmts -> exp [; stmts] | pat <- exp ; stmts | let decllist ; stmts") + ("else" . "if exp then exp else exp") + ("if" . "if exp then exp else exp") + ("import" . "import [qualified] modid [as modid] [impspec]") + ("in" . "let decllist in exp") + ("infix" . "infix [digit] ops") + ("infixl" . "infixl [digit] ops") + ("infixr" . "infixr [digit] ops") + ("instance" . "instance [context =>] qtycls inst [where { valdefs [;] }]") + ("let" . "let { decl; ...; decl [;] } in exp") + ("module" . "module modid [exports] where body") + ("newtype" . "newtype [context =>] simpletype = con atype [deriving]") + ("of" . "case exp of { alts [;] }") + ("then" . "if exp then exp else exp") + ("type" . "type simpletype = type") + ("where" . "exp where { decl; ...; decl [;] }") ; check that ; see also class, instance, module + ("as" . "import [qualified] modid [as modid] [impspec]") + ("qualified" . "import [qualified] modid [as modid] [impspec]") + ("hiding" . "hiding ( import1 , ... , importn [ , ] )")) + "An alist of reserved identifiers. +Each element is of the form (ID . DOC) where both ID and DOC are strings. +DOC should be a concise single-line string describing the construct in which +the keyword is used.") + +;;@cindex haskell-doc-prelude-types + +(defun haskell-doc-extract-types (url) + (with-temp-buffer + (insert-file-contents url) + (goto-char (point-min)) + (while (search-forward " " nil t) (replace-match " " t t)) + + ;; First, focus on the actual code, removing the surrouding HTML text. + (goto-char (point-min)) + (let ((last (point-min)) + (modules nil)) + (while (re-search-forward "^module +\\([[:alnum:]]+\\)" nil t) + (let ((module (match-string 1))) + (if (member module modules) + ;; The library nodes of the HTML doc contain modules twice: + ;; once at the top, with only type declarations, and once at + ;; the bottom with an actual sample implementation which may + ;; include declaration of non-exported values. + ;; We're now at this second occurrence is the implementation + ;; which should thus be ignored. + nil + (push module modules) + (delete-region last (point)) + (search-forward "") + ;; Some of the blocks of code are split. + (while (looking-at "\\(<[^<>]+>[ \t\n]*\\)*") + (goto-char (match-end 0)) + (search-forward "")) + (setq last (point))))) + (delete-region last (point-max)) + + ;; Then process the HTML encoding to get back to pure ASCII. + (goto-char (point-min)) + (while (search-forward "
" nil t) (replace-match "\n" t t)) + ;; (goto-char (point-min)) + ;; (while (re-search-forward "<[^<>]+>" nil t) (replace-match "" t t)) + (goto-char (point-min)) + (while (search-forward ">" nil t) (replace-match ">" t t)) + (goto-char (point-min)) + (while (search-forward "<" nil t) (replace-match "<" t t)) + (goto-char (point-min)) + (while (search-forward "&" nil t) (replace-match "&" t t)) + (goto-char (point-min)) + (if (re-search-forward "&[a-z]+;" nil t) + (error "Unexpected charref %s" (match-string 0))) + ;; Remove TABS. + (goto-char (point-min)) + (while (search-forward "\t" nil t) (replace-match " " t t)) + + ;; Finally, extract the actual data. + (goto-char (point-min)) + (let* ((elems nil) + (space-re "[ \t\n]*\\(?:--.*\n[ \t\n]*\\)*") + (comma-re (concat " *," space-re)) + ;; A list of identifiers. We have to be careful to weed out + ;; entries like "ratPrec = 7 :: Int". Also ignore entries + ;; which start with a < since they're actually in the HTML text + ;; part. And the list may be spread over several lines, cut + ;; after a comma. + (idlist-re + (concat "\\([^< \t\n][^ \t\n]*" + "\\(?:" comma-re "[^ \t\n]+\\)*\\)")) + ;; A type. A few types are spread over 2 lines, + ;; cut after the "=>", so we have to handle these as well. + (type-re "\\(.*[^\n>]\\(?:>[ \t\n]+.*[^\n>]\\)*\\) *$") + ;; A decl of a list of values, possibly indented. + (val-decl-re + (concat "^\\( +\\)?" idlist-re "[ \t\n]*::[ \t\n]*" type-re)) + (re (concat + ;; 3 possibilities: a class decl, a data decl, or val decl. + ;; First, let's match a class decl. + "^class \\(?:.*=>\\)? *\\(.*[^ \t\n]\\)[ \t\n]*where" + + ;; Or a value decl: + "\\|" val-decl-re + + "\\|" ;; Or a data decl. We only handle single-arm + ;; datatypes with labels. + "^data +\\([[:alnum:]][[:alnum:] ]*[[:alnum:]]\\)" + " *=.*{\\([^}]+\\)}" + )) + (re-class (concat "^[^ \t\n]\\|" re)) + curclass) + (while (re-search-forward (if curclass re-class re) nil t) + (cond + ;; A class decl. + ((match-end 1) (setq curclass (match-string 1))) + ;; A value decl. + ((match-end 4) + (let ((type (match-string 4)) + (vars (match-string 3)) + (indented (match-end 2))) + (if (string-match "[ \t\n][ \t\n]+" type) + (setq type (replace-match " " t t type))) + (if (string-match " *\\(--.*\\)?\\'" type) + (setq type (substring type 0 (match-beginning 0)))) + (if indented + (if curclass + (if (string-match "\\`\\(.*[^ \t\n]\\) *=> *" type) + (let ((classes (match-string 1 type))) + (setq type (substring type (match-end 0))) + (if (string-match "\\`(.*)\\'" classes) + (setq classes (substring classes 1 -1))) + (setq type (concat "(" curclass ", " classes + ") => " type))) + (setq type (concat curclass " => " type))) + ;; It's actually not an error: just a type annotation on + ;; some local variable. + ;; (error "Indentation outside a class in %s: %s" + ;; module vars) + nil) + (setq curclass nil)) + (dolist (var (split-string vars comma-re t)) + (if (string-match "(.*)" var) (setq var (substring var 1 -1))) + (push (cons var type) elems)))) + ;; A datatype decl. + ((match-end 5) + (setq curclass nil) + (let ((name (match-string 5))) + (save-excursion + (save-restriction + (narrow-to-region (match-beginning 6) (match-end 6)) + (goto-char (point-min)) + (while (re-search-forward val-decl-re nil t) + (let ((vars (match-string 2)) + (type (match-string 3))) + (if (string-match "[ \t\n][ \t\n]+" type) + (setq type (replace-match " " t t type))) + (if (string-match " *\\(--.*\\)?\\'" type) + (setq type (substring type 0 (match-beginning 0)))) + (if (string-match ",\\'" type) + (setq type (substring type 0 -1))) + (setq type (concat name " -> " type)) + (dolist (var (split-string vars comma-re t)) + (if (string-match "(.*)" var) + (setq var (substring var 1 -1))) + (push (cons var type) elems)))))))) + + ;; The end of a class declaration. + (t (setq curclass nil) (beginning-of-line)))) + (cons (car (last modules)) elems))))) + +(defun haskell-doc-fetch-lib-urls (base-url) + (with-temp-buffer + (insert-file-contents base-url) + (goto-char (point-min)) + (search-forward "Part II: Libraries") + (delete-region (point-min) (point)) + (search-forward "") + (delete-region (point) (point-max)) + (goto-char (point-min)) + (let ((libs (list "standard-prelude.html"))) + (while (re-search-forward "" nil t) + (push (match-string 1) libs)) + (mapcar (lambda (s) (expand-file-name s (file-name-directory base-url))) + (nreverse libs))))) + +(defun haskell-doc-extract-and-insert-types (url) + "Fetch the types from the online doc and insert them at point. +URL is the URL of the online doc." + (interactive (if current-prefix-arg + (read-file-name "URL: ") + (list "http://www.haskell.org/onlinereport/"))) + (let ((urls (haskell-doc-fetch-lib-urls url))) + (dolist (url urls) + (let ((data (haskell-doc-extract-types url))) + (insert ";; " (pop data)) (indent-according-to-mode) (newline) + (dolist (elem (sort data (lambda (x y) (string-lessp (car x) (car y))))) + (prin1 elem (current-buffer)) + (indent-according-to-mode) (newline)))))) + +(defvar haskell-doc-prelude-types + ;; This list was auto generated by `haskell-doc-extract-and-insert-types'. + '( + ;; Prelude + ("!!" . "[a] -> Int -> a") + ("$" . "(a -> b) -> a -> b") + ("$!" . "(a -> b) -> a -> b") + ("&&" . "Bool -> Bool -> Bool") + ("*" . "Num a => a -> a -> a") + ("**" . "Floating a => a -> a -> a") + ("+" . "Num a => a -> a -> a") + ("++" . "[a] -> [a] -> [a]") + ("-" . "Num a => a -> a -> a") + ("." . "(b -> c) -> (a -> b) -> a -> c") + ("/" . "Fractional a => a -> a -> a") + ("/=" . "Eq a => a -> a -> Bool") + ("<" . "Ord a => a -> a -> Bool") + ("<=" . "Ord a => a -> a -> Bool") + ("=<<" . "Monad m => (a -> m b) -> m a -> m b") + ("==" . "Eq a => a -> a -> Bool") + (">" . "Ord a => a -> a -> Bool") + (">=" . "Ord a => a -> a -> Bool") + (">>" . "Monad m => m a -> m b -> m b") + (">>=" . "Monad m => m a -> (a -> m b) -> m b") + ("^" . "(Num a, Integral b) => a -> b -> a") + ("^^" . "(Fractional a, Integral b) => a -> b -> a") + ("abs" . "Num a => a -> a") + ("acos" . "Floating a => a -> a") + ("acosh" . "Floating a => a -> a") + ("all" . "(a -> Bool) -> [a] -> Bool") + ("and" . "[Bool] -> Bool") + ("any" . "(a -> Bool) -> [a] -> Bool") + ("appendFile" . "FilePath -> String -> IO ()") + ("asTypeOf" . "a -> a -> a") + ("asin" . "Floating a => a -> a") + ("asinh" . "Floating a => a -> a") + ("atan" . "Floating a => a -> a") + ("atan2" . "RealFloat a => a -> a -> a") + ("atanh" . "Floating a => a -> a") + ("break" . "(a -> Bool) -> [a] -> ([a],[a])") + ("catch" . "IO a -> (IOError -> IO a) -> IO a") + ("ceiling" . "(RealFrac a, Integral b) => a -> b") + ("compare" . "Ord a => a -> a -> Ordering") + ("concat" . "[[a]] -> [a]") + ("concatMap" . "(a -> [b]) -> [a] -> [b]") + ("const" . "a -> b -> a") + ("cos" . "Floating a => a -> a") + ("cosh" . "Floating a => a -> a") + ("curry" . "((a, b) -> c) -> a -> b -> c") + ("cycle" . "[a] -> [a]") + ("decodeFloat" . "RealFloat a => a -> (Integer,Int)") + ("div" . "Integral a => a -> a -> a") + ("divMod" . "Integral a => a -> a -> (a,a)") + ("drop" . "Int -> [a] -> [a]") + ("dropWhile" . "(a -> Bool) -> [a] -> [a]") + ("either" . "(a -> c) -> (b -> c) -> Either a b -> c") + ("elem" . "(Eq a) => a -> [a] -> Bool") + ("encodeFloat" . "RealFloat a => Integer -> Int -> a") + ("enumFrom" . "Enum a => a -> [a]") + ("enumFromThen" . "Enum a => a -> a -> [a]") + ("enumFromThenTo" . "Enum a => a -> a -> a -> [a]") + ("enumFromTo" . "Enum a => a -> a -> [a]") + ("error" . "String -> a") + ("even" . "(Integral a) => a -> Bool") + ("exp" . "Floating a => a -> a") + ("exponent" . "RealFloat a => a -> Int") + ("fail" . "Monad m => String -> m a") + ("filter" . "(a -> Bool) -> [a] -> [a]") + ("flip" . "(a -> b -> c) -> b -> a -> c") + ("floatDigits" . "RealFloat a => a -> Int") + ("floatRadix" . "RealFloat a => a -> Integer") + ("floatRange" . "RealFloat a => a -> (Int,Int)") + ("floor" . "(RealFrac a, Integral b) => a -> b") + ("fmap" . "Functor f => (a -> b) -> f a -> f b") + ("foldl" . "(a -> b -> a) -> a -> [b] -> a") + ("foldl1" . "(a -> a -> a) -> [a] -> a") + ("foldr" . "(a -> b -> b) -> b -> [a] -> b") + ("foldr1" . "(a -> a -> a) -> [a] -> a") + ("fromEnum" . "Enum a => a -> Int") + ("fromInteger" . "Num a => Integer -> a") + ("fromIntegral" . "(Integral a, Num b) => a -> b") + ("fromRational" . "Fractional a => Rational -> a") + ("fst" . "(a,b) -> a") + ("gcd" . "(Integral a) => a -> a -> a") + ("getChar" . "IO Char") + ("getContents" . "IO String") + ("getLine" . "IO String") + ("head" . "[a] -> a") + ("id" . "a -> a") + ("init" . "[a] -> [a]") + ("interact" . "(String -> String) -> IO ()") + ("ioError" . "IOError -> IO a") + ("isDenormalized" . "RealFloat a => a -> Bool") + ("isIEEE" . "RealFloat a => a -> Bool") + ("isInfinite" . "RealFloat a => a -> Bool") + ("isNaN" . "RealFloat a => a -> Bool") + ("isNegativeZero" . "RealFloat a => a -> Bool") + ("iterate" . "(a -> a) -> a -> [a]") + ("last" . "[a] -> a") + ("lcm" . "(Integral a) => a -> a -> a") + ("length" . "[a] -> Int") + ("lex" . "ReadS String") + ("lines" . "String -> [String]") + ("log" . "Floating a => a -> a") + ("logBase" . "Floating a => a -> a -> a") + ("lookup" . "(Eq a) => a -> [(a,b)] -> Maybe b") + ("map" . "(a -> b) -> [a] -> [b]") + ("mapM" . "Monad m => (a -> m b) -> [a] -> m [b]") + ("mapM_" . "Monad m => (a -> m b) -> [a] -> m ()") + ("max" . "Ord a => a -> a -> a") + ("maxBound" . "Bounded a => a") + ("maximum" . "(Ord a) => [a] -> a") + ("maybe" . "b -> (a -> b) -> Maybe a -> b") + ("min" . "Ord a => a -> a -> a") + ("minBound" . "Bounded a => a") + ("minimum" . "(Ord a) => [a] -> a") + ("mod" . "Integral a => a -> a -> a") + ("negate" . "Num a => a -> a") + ("not" . "Bool -> Bool") + ("notElem" . "(Eq a) => a -> [a] -> Bool") + ("null" . "[a] -> Bool") + ("numericEnumFrom" . "(Fractional a) => a -> [a]") + ("numericEnumFromThen" . "(Fractional a) => a -> a -> [a]") + ("numericEnumFromThenTo" . "(Fractional a, Ord a) => a -> a -> a -> [a]") + ("numericEnumFromTo" . "(Fractional a, Ord a) => a -> a -> [a]") + ("odd" . "(Integral a) => a -> Bool") + ("or" . "[Bool] -> Bool") + ("otherwise" . "Bool") + ("pi" . "Floating a => a") + ("pred" . "Enum a => a -> a") + ("print" . "Show a => a -> IO ()") + ("product" . "(Num a) => [a] -> a") + ("properFraction" . "(RealFrac a, Integral b) => a -> (b,a)") + ("putChar" . "Char -> IO ()") + ("putStr" . "String -> IO ()") + ("putStrLn" . "String -> IO ()") + ("quot" . "Integral a => a -> a -> a") + ("quotRem" . "Integral a => a -> a -> (a,a)") + ("read" . "(Read a) => String -> a") + ("readFile" . "FilePath -> IO String") + ("readIO" . "Read a => String -> IO a") + ("readList" . "Read a => ReadS [a]") + ("readLn" . "Read a => IO a") + ("readParen" . "Bool -> ReadS a -> ReadS a") + ("reads" . "(Read a) => ReadS a") + ("readsPrec" . "Read a => Int -> ReadS a") + ("realToFrac" . "(Real a, Fractional b) => a -> b") + ("recip" . "Fractional a => a -> a") + ("rem" . "Integral a => a -> a -> a") + ("repeat" . "a -> [a]") + ("replicate" . "Int -> a -> [a]") + ("return" . "Monad m => a -> m a") + ("reverse" . "[a] -> [a]") + ("round" . "(RealFrac a, Integral b) => a -> b") + ("scaleFloat" . "RealFloat a => Int -> a -> a") + ("scanl" . "(a -> b -> a) -> a -> [b] -> [a]") + ("scanl1" . "(a -> a -> a) -> [a] -> [a]") + ("scanr" . "(a -> b -> b) -> b -> [a] -> [b]") + ("scanr1" . "(a -> a -> a) -> [a] -> [a]") + ("seq" . "a -> b -> b") + ("sequence" . "Monad m => [m a] -> m [a]") + ("sequence_" . "Monad m => [m a] -> m ()") + ("show" . "Show a => a -> String") + ("showChar" . "Char -> ShowS") + ("showList" . "Show a => [a] -> ShowS") + ("showParen" . "Bool -> ShowS -> ShowS") + ("showString" . "String -> ShowS") + ("shows" . "(Show a) => a -> ShowS") + ("showsPrec" . "Show a => Int -> a -> ShowS") + ("significand" . "RealFloat a => a -> a") + ("signum" . "Num a => a -> a") + ("sin" . "Floating a => a -> a") + ("sinh" . "Floating a => a -> a") + ("snd" . "(a,b) -> b") + ("span" . "(a -> Bool) -> [a] -> ([a],[a])") + ("splitAt" . "Int -> [a] -> ([a],[a])") + ("sqrt" . "Floating a => a -> a") + ("subtract" . "(Num a) => a -> a -> a") + ("succ" . "Enum a => a -> a") + ("sum" . "(Num a) => [a] -> a") + ("tail" . "[a] -> [a]") + ("take" . "Int -> [a] -> [a]") + ("takeWhile" . "(a -> Bool) -> [a] -> [a]") + ("tan" . "Floating a => a -> a") + ("tanh" . "Floating a => a -> a") + ("toEnum" . "Enum a => Int -> a") + ("toInteger" . "Integral a => a -> Integer") + ("toRational" . "Real a => a -> Rational") + ("truncate" . "(RealFrac a, Integral b) => a -> b") + ("uncurry" . "(a -> b -> c) -> ((a, b) -> c)") + ("undefined" . "a") + ("unlines" . "[String] -> String") + ("until" . "(a -> Bool) -> (a -> a) -> a -> a") + ("unwords" . "[String] -> String") + ("unzip" . "[(a,b)] -> ([a],[b])") + ("unzip3" . "[(a,b,c)] -> ([a],[b],[c])") + ("userError" . "String -> IOError") + ("words" . "String -> [String]") + ("writeFile" . "FilePath -> String -> IO ()") + ("zip" . "[a] -> [b] -> [(a,b)]") + ("zip3" . "[a] -> [b] -> [c] -> [(a,b,c)]") + ("zipWith" . "(a->b->c) -> [a]->[b]->[c]") + ("zipWith3" . "(a->b->c->d) -> [a]->[b]->[c]->[d]") + ("||" . "Bool -> Bool -> Bool") + ;; Ratio + ("%" . "(Integral a) => a -> a -> Ratio a") + ("approxRational" . "(RealFrac a) => a -> a -> Rational") + ("denominator" . "(Integral a) => Ratio a -> a") + ("numerator" . "(Integral a) => Ratio a -> a") + ;; Complex + ("cis" . "(RealFloat a) => a -> Complex a") + ("conjugate" . "(RealFloat a) => Complex a -> Complex a") + ("imagPart" . "(RealFloat a) => Complex a -> a") + ("magnitude" . "(RealFloat a) => Complex a -> a") + ("mkPolar" . "(RealFloat a) => a -> a -> Complex a") + ("phase" . "(RealFloat a) => Complex a -> a") + ("polar" . "(RealFloat a) => Complex a -> (a,a)") + ("realPart" . "(RealFloat a) => Complex a -> a") + ;; Numeric + ("floatToDigits" . "(RealFloat a) => Integer -> a -> ([Int], Int)") + ("fromRat" . "(RealFloat a) => Rational -> a") + ("lexDigits" . "ReadS String") + ("readDec" . "(Integral a) => ReadS a") + ("readFloat" . "(RealFrac a) => ReadS a") + ("readHex" . "(Integral a) => ReadS a") + ("readInt" . "(Integral a) => a -> (Char -> Bool) -> (Char -> Int) -> ReadS a") + ("readOct" . "(Integral a) => ReadS a") + ("readSigned" . "(Real a) => ReadS a -> ReadS a") + ("showEFloat" . "(RealFloat a) => Maybe Int -> a -> ShowS") + ("showFFloat" . "(RealFloat a) => Maybe Int -> a -> ShowS") + ("showFloat" . "(RealFloat a) => a -> ShowS") + ("showGFloat" . "(RealFloat a) => Maybe Int -> a -> ShowS") + ("showHex" . "Integral a => a -> ShowS") + ("showInt" . "Integral a => a -> ShowS") + ("showIntAtBase" . "Integral a => a -> (Int -> Char) -> a -> ShowS") + ("showOct" . "Integral a => a -> ShowS") + ("showSigned" . "(Real a) => (a -> ShowS) -> Int -> a -> ShowS") + ;; Ix + ("inRange" . "Ix a => (a,a) -> a -> Bool") + ("index" . "Ix a => (a,a) -> a -> Int") + ("range" . "Ix a => (a,a) -> [a]") + ("rangeSize" . "Ix a => (a,a) -> Int") + ;; Array + ("!" . "(Ix a) => Array a b -> a -> b") + ("//" . "(Ix a) => Array a b -> [(a,b)] -> Array a b") + ("accum" . "(Ix a) => (b -> c -> b) -> Array a b -> [(a,c)]") + ("accumArray" . "(Ix a) => (b -> c -> b) -> b -> (a,a) -> [(a,c)]") + ("array" . "(Ix a) => (a,a) -> [(a,b)] -> Array a b") + ("assocs" . "(Ix a) => Array a b -> [(a,b)]") + ("bounds" . "(Ix a) => Array a b -> (a,a)") + ("elems" . "(Ix a) => Array a b -> [b]") + ("indices" . "(Ix a) => Array a b -> [a]") + ("ixmap" . "(Ix a, Ix b) => (a,a) -> (a -> b) -> Array b c") + ("listArray" . "(Ix a) => (a,a) -> [b] -> Array a b") + ;; List + ("\\\\" . "Eq a => [a] -> [a] -> [a]") + ("delete" . "Eq a => a -> [a] -> [a]") + ("deleteBy" . "(a -> a -> Bool) -> a -> [a] -> [a]") + ("deleteFirstsBy" . "(a -> a -> Bool) -> [a] -> [a] -> [a]") + ("elemIndex" . "Eq a => a -> [a] -> Maybe Int") + ("elemIndices" . "Eq a => a -> [a] -> [Int]") + ("find" . "(a -> Bool) -> [a] -> Maybe a") + ("findIndex" . "(a -> Bool) -> [a] -> Maybe Int") + ("findIndices" . "(a -> Bool) -> [a] -> [Int]") + ("genericDrop" . "Integral a => a -> [b] -> [b]") + ("genericIndex" . "Integral a => [b] -> a -> b") + ("genericLength" . "Integral a => [b] -> a") + ("genericReplicate" . "Integral a => a -> b -> [b]") + ("genericSplitAt" . "Integral a => a -> [b] -> ([b],[b])") + ("genericTake" . "Integral a => a -> [b] -> [b]") + ("group" . "Eq a => [a] -> [[a]]") + ("groupBy" . "(a -> a -> Bool) -> [a] -> [[a]]") + ("inits" . "[a] -> [[a]]") + ("insert" . "Ord a => a -> [a] -> [a]") + ("insertBy" . "(a -> a -> Ordering) -> a -> [a] -> [a]") + ("intersect" . "Eq a => [a] -> [a] -> [a]") + ("intersectBy" . "(a -> a -> Bool) -> [a] -> [a] -> [a]") + ("intersperse" . "a -> [a] -> [a]") + ("isPrefixOf" . "Eq a => [a] -> [a] -> Bool") + ("isSuffixOf" . "Eq a => [a] -> [a] -> Bool") + ("mapAccumL" . "(a -> b -> (a, c)) -> a -> [b] -> (a, [c])") + ("mapAccumR" . "(a -> b -> (a, c)) -> a -> [b] -> (a, [c])") + ("maximumBy" . "(a -> a -> Ordering) -> [a] -> a") + ("minimumBy" . "(a -> a -> Ordering) -> [a] -> a") + ("nub" . "Eq a => [a] -> [a]") + ("nubBy" . "(a -> a -> Bool) -> [a] -> [a]") + ("partition" . "(a -> Bool) -> [a] -> ([a],[a])") + ("sort" . "Ord a => [a] -> [a]") + ("sortBy" . "(a -> a -> Ordering) -> [a] -> [a]") + ("tails" . "[a] -> [[a]]") + ("transpose" . "[[a]] -> [[a]]") + ("unfoldr" . "(b -> Maybe (a,b)) -> b -> [a]") + ("union" . "Eq a => [a] -> [a] -> [a]") + ("unionBy" . "(a -> a -> Bool) -> [a] -> [a] -> [a]") + ("unzip4" . "[(a,b,c,d)] -> ([a],[b],[c],[d])") + ("unzip5" . "[(a,b,c,d,e)] -> ([a],[b],[c],[d],[e])") + ("unzip6" . "[(a,b,c,d,e,f)] -> ([a],[b],[c],[d],[e],[f])") + ("unzip7" . "[(a,b,c,d,e,f,g)] -> ([a],[b],[c],[d],[e],[f],[g])") + ("zip4" . "[a] -> [b] -> [c] -> [d] -> [(a,b,c,d)]") + ("zip5" . "[a] -> [b] -> [c] -> [d] -> [e] -> [(a,b,c,d,e)]") + ("zip6" . "[a] -> [b] -> [c] -> [d] -> [e] -> [f]") + ("zip7" . "[a] -> [b] -> [c] -> [d] -> [e] -> [f] -> [g]") + ("zipWith4" . "(a->b->c->d->e) -> [a]->[b]->[c]->[d]->[e]") + ("zipWith5" . "(a->b->c->d->e->f) ->") + ("zipWith6" . "(a->b->c->d->e->f->g) -> [a]->[b]->[c]->[d]->[e]->[f]->[g]") + ("zipWith7" . "(a->b->c->d->e->f->g->h) -> [a]->[b]->[c]->[d]->[e]->[f]->[g]->[h]") + ;; Maybe + ("catMaybes" . "[Maybe a] -> [a]") + ("fromJust" . "Maybe a -> a") + ("fromMaybe" . "a -> Maybe a -> a") + ("isJust" . "Maybe a -> Bool") + ("isNothing" . "Maybe a -> Bool") + ("listToMaybe" . "[a] -> Maybe a") + ("mapMaybe" . "(a -> Maybe b) -> [a] -> [b]") + ("maybeToList" . "Maybe a -> [a]") + ;; Char + ("chr" . "Int -> Char") + ("digitToInt" . "Char -> Int") + ("intToDigit" . "Int -> Char") + ("isAlpha" . "Char -> Bool") + ("isAlphaNum" . "Char -> Bool") + ("isAscii" . "Char -> Bool") + ("isControl" . "Char -> Bool") + ("isDigit" . "Char -> Bool") + ("isHexDigit" . "Char -> Bool") + ("isLatin1" . "Char -> Bool") + ("isLower" . "Char -> Bool") + ("isOctDigit" . "Char -> Bool") + ("isPrint" . "Char -> Bool") + ("isSpace" . "Char -> Bool") + ("isUpper" . "Char -> Bool") + ("lexLitChar" . "ReadS String") + ("ord" . "Char -> Int") + ("readLitChar" . "ReadS Char") + ("showLitChar" . "Char -> ShowS") + ("toLower" . "Char -> Char") + ("toUpper" . "Char -> Char") + ;; Monad + ("ap" . "Monad m => m (a -> b) -> m a -> m b") + ("filterM" . "Monad m => (a -> m Bool) -> [a] -> m [a]") + ("foldM" . "Monad m => (a -> b -> m a) -> a -> [b] -> m a") + ("guard" . "MonadPlus m => Bool -> m ()") + ("join" . "Monad m => m (m a) -> m a") + ("liftM" . "Monad m => (a -> b) -> (m a -> m b)") + ("liftM2" . "Monad m => (a -> b -> c) -> (m a -> m b -> m c)") + ("liftM3" . "Monad m => (a -> b -> c -> d) -> (m a -> m b -> m c -> m d)") + ("liftM4" . "Monad m => (a -> b -> c -> d -> e) -> (m a -> m b -> m c -> m d -> m e)") + ("liftM5" . "Monad m => (a -> b -> c -> d -> e -> f) -> (m a -> m b -> m c -> m d -> m e -> m f)") + ("mapAndUnzipM" . "Monad m => (a -> m (b,c)) -> [a] -> m ([b], [c])") + ("mplus" . "MonadPlus m => m a -> m a -> m a") + ("msum" . "MonadPlus m => [m a] -> m a") + ("mzero" . "MonadPlus m => m a") + ("unless" . "Monad m => Bool -> m () -> m ()") + ("when" . "Monad m => Bool -> m () -> m ()") + ("zipWithM" . "Monad m => (a -> b -> m c) -> [a] -> [b] -> m [c]") + ("zipWithM_" . "Monad m => (a -> b -> m c) -> [a] -> [b] -> m ()") + ;; IO + ("bracket" . "IO a -> (a -> IO b) -> (a -> IO c) -> IO c") + ("bracket_" . "IO a -> (a -> IO b) -> IO c -> IO c") + ("hClose" . "Handle -> IO ()") + ("hFileSize" . "Handle -> IO Integer") + ("hFlush" . "Handle -> IO ()") + ("hGetBuffering" . "Handle -> IO BufferMode") + ("hGetChar" . "Handle -> IO Char") + ("hGetContents" . "Handle -> IO String") + ("hGetLine" . "Handle -> IO String") + ("hGetPosn" . "Handle -> IO HandlePosn") + ("hIsClosed" . "Handle -> IO Bool") + ("hIsEOF" . "Handle -> IO Bool") + ("hIsOpen" . "Handle -> IO Bool") + ("hIsReadable" . "Handle -> IO Bool") + ("hIsSeekable" . "Handle -> IO Bool") + ("hIsWritable" . "Handle -> IO Bool") + ("hLookAhead" . "Handle -> IO Char") + ("hPrint" . "Show a => Handle -> a -> IO ()") + ("hPutChar" . "Handle -> Char -> IO ()") + ("hPutStr" . "Handle -> String -> IO ()") + ("hPutStrLn" . "Handle -> String -> IO ()") + ("hReady" . "Handle -> IO Bool") + ("hSeek" . "Handle -> SeekMode -> Integer -> IO ()") + ("hSetBuffering" . "Handle -> BufferMode -> IO ()") + ("hSetPosn" . "HandlePosn -> IO ()") + ("hWaitForInput" . "Handle -> Int -> IO Bool") + ("ioeGetErrorString" . "IOError -> String") + ("ioeGetFileName" . "IOError -> Maybe FilePath") + ("ioeGetHandle" . "IOError -> Maybe Handle") + ("isAlreadyExistsError" . "IOError -> Bool") + ("isAlreadyInUseError" . "IOError -> Bool") + ("isDoesNotExistError" . "IOError -> Bool") + ("isEOF" . "IO Bool") + ("isEOFError" . "IOError -> Bool") + ("isFullError" . "IOError -> Bool") + ("isIllegalOperation" . "IOError -> Bool") + ("isPermissionError" . "IOError -> Bool") + ("isUserError" . "IOError -> Bool") + ("openFile" . "FilePath -> IOMode -> IO Handle") + ("stderr" . "Handle") + ("stdin" . "Handle") + ("stdout" . "Handle") + ("try" . "IO a -> IO (Either IOError a)") + ;; Directory + ("createDirectory" . "FilePath -> IO ()") + ("doesDirectoryExist" . "FilePath -> IO Bool") + ("doesFileExist" . "FilePath -> IO Bool") + ("executable" . "Permissions -> Bool") + ("getCurrentDirectory" . "IO FilePath") + ("getDirectoryContents" . "FilePath -> IO [FilePath]") + ("getModificationTime" . "FilePath -> IO ClockTime") + ("getPermissions" . "FilePath -> IO Permissions") + ("readable" . "Permissions -> Bool") + ("removeDirectory" . "FilePath -> IO ()") + ("removeFile" . "FilePath -> IO ()") + ("renameDirectory" . "FilePath -> FilePath -> IO ()") + ("renameFile" . "FilePath -> FilePath -> IO ()") + ("searchable" . "Permissions -> Bool") + ("setCurrentDirectory" . "FilePath -> IO ()") + ("setPermissions" . "FilePath -> Permissions -> IO ()") + ("writable" . "Permissions -> Bool") + ;; System + ("exitFailure" . "IO a") + ("exitWith" . "ExitCode -> IO a") + ("getArgs" . "IO [String]") + ("getEnv" . "String -> IO String") + ("getProgName" . "IO String") + ("system" . "String -> IO ExitCode") + ;; Time + ("addToClockTime" . "TimeDiff -> ClockTime -> ClockTime") + ("calendarTimeToString" . "CalendarTime -> String") + ("ctDay" . "CalendarTime -> Int") + ("ctHour" . "CalendarTime -> Int") + ("ctIsDST" . "CalendarTime -> Bool") + ("ctMin" . "CalendarTime -> Int") + ("ctMonth" . "CalendarTime -> Month") + ("ctPicosec" . "CalendarTime -> Integer") + ("ctSec" . "CalendarTime -> Int") + ("ctTZ" . "CalendarTime -> Int") + ("ctTZName" . "CalendarTime -> String") + ("ctWDay" . "CalendarTime -> Day") + ("ctYDay" . "CalendarTime -> Int") + ("ctYear" . "CalendarTime -> Int") + ("diffClockTimes" . "ClockTime -> ClockTime -> TimeDiff") + ("formatCalendarTime" . "TimeLocale -> String -> CalendarTime -> String") + ("getClockTime" . "IO ClockTime") + ("tdDay" . "TimeDiff -> Int") + ("tdHour" . "TimeDiff -> Int") + ("tdMin" . "TimeDiff -> Int") + ("tdMonth" . "TimeDiff -> Int") + ("tdPicosec" . "TimeDiff -> Integer") + ("tdSec" . "TimeDiff -> Int") + ("tdYear" . "TimeDiff -> Int") + ("toCalendarTime" . "ClockTime -> IO CalendarTime") + ("toClockTime" . "CalendarTime -> ClockTime") + ("toUTCTime" . "ClockTime -> CalendarTime") + ;; Locale + ("amPm" . "TimeLocale -> (String, String)") + ("dateFmt" . "TimeLocale -> String") + ("dateTimeFmt" . "TimeLocale -> String") + ("defaultTimeLocale" . "TimeLocale") + ("months" . "TimeLocale -> [(String, String)]") + ("time12Fmt" . "TimeLocale -> String") + ("timeFmt" . "TimeLocale -> String") + ("wDays" . "TimeLocale -> [(String, String)]") + ;; CPUTime + ("cpuTimePrecision" . "Integer") + ("getCPUTime" . "IO Integer") + ;; Random + ("genRange" . "RandomGen g => g -> (Int, Int)") + ("getStdGen" . "IO StdGen") + ("getStdRandom" . "(StdGen -> (a, StdGen)) -> IO a") + ("mkStdGen" . "Int -> StdGen") + ("newStdGen" . "IO StdGen") + ("next" . "RandomGen g => g -> (Int, g)") + ("random" . "(Random a, RandomGen g) => g -> (a, g)") + ("randomIO" . "Random a => IO a") + ("randomR" . "(Random a, RandomGen g) => (a, a) -> g -> (a, g)") + ("randomRIO" . "Random a => (a,a) -> IO a") + ("randomRs" . "(Random a, RandomGen g) => (a, a) -> g -> [a]") + ("randoms" . "(Random a, RandomGen g) => g -> [a]") + ("setStdGen" . "StdGen -> IO ()") + ("split" . "RandomGen g => g -> (g, g)") + ) + "Alist of prelude functions and their types.") + +;;@cindex haskell-doc-strategy-ids + +(defvar haskell-doc-strategy-ids + (list + '("par" . "Done -> Done -> Done ; [infixr 0]") + '("seq" . "Done -> Done -> Done ; [infixr 1]") + + '("using" . "a -> Strategy a -> a ; [infixl 0]") + '("demanding" . "a -> Done -> a ; [infixl 0]") + '("sparking" . "a -> Done -> a ; [infixl 0]") + + '(">||" . "Done -> Done -> Done ; [infixr 2]") + '(">|" . "Done -> Done -> Done ; [infixr 3]") + '("$||" . "(a -> b) -> Strategy a -> a -> b ; [infixl 6]") + '("$|" . "(a -> b) -> Strategy a -> a -> b ; [infixl 6]") + '(".|" . "(b -> c) -> Strategy b -> (a -> b) -> (a -> c) ; [infixl 9]") + '(".||" . "(b -> c) -> Strategy b -> (a -> b) -> (a -> c) ; [infixl 9]") + '("-|" . "(a -> b) -> Strategy b -> (b -> c) -> (a -> c) ; [infixl 9]") + '("-||" . "(a -> b) -> Strategy b -> (b -> c) -> (a -> c) ; [infixl 9]") + + '("Done" . "type Done = ()") + '("Strategy" . "type Strategy a = a -> Done") + + '("r0" . "Strategy a") + '("rwhnf" . "Eval a => Strategy a") + '("rnf" . "Strategy a") + '("NFData" . "class Eval a => NFData a where rnf :: Strategy a") + '("NFDataIntegral" ."class (NFData a, Integral a) => NFDataIntegral a") + '("NFDataOrd" . "class (NFData a, Ord a) => NFDataOrd a") + + '("markStrat" . "Int -> Strategy a -> Strategy a") + + '("seqPair" . "Strategy a -> Strategy b -> Strategy (a,b)") + '("parPair" . "Strategy a -> Strategy b -> Strategy (a,b)") + '("seqTriple" . "Strategy a -> Strategy b -> Strategy c -> Strategy (a,b,c)") + '("parTriple" . "Strategy a -> Strategy b -> Strategy c -> Strategy (a,b,c)") + + '("parList" . "Strategy a -> Strategy [a]") + '("parListN" . "(Integral b) => b -> Strategy a -> Strategy [a]") + '("parListNth" . "Int -> Strategy a -> Strategy [a]") + '("parListChunk" . "Int -> Strategy a -> Strategy [a]") + '("parMap" . "Strategy b -> (a -> b) -> [a] -> [b]") + '("parFlatMap" . "Strategy [b] -> (a -> [b]) -> [a] -> [b]") + '("parZipWith" . "Strategy c -> (a -> b -> c) -> [a] -> [b] -> [c]") + '("seqList" . "Strategy a -> Strategy [a]") + '("seqListN" . "(Integral a) => a -> Strategy b -> Strategy [b]") + '("seqListNth" . "Int -> Strategy b -> Strategy [b]") + + '("parBuffer" . "Int -> Strategy a -> [a] -> [a]") + + '("seqArr" . "(Ix b) => Strategy a -> Strategy (Array b a)") + '("parArr" . "(Ix b) => Strategy a -> Strategy (Array b a)") + + '("fstPairFstList" . "(NFData a) => Strategy [(a,b)]") + '("force" . "(NFData a) => a -> a ") + '("sforce" . "(NFData a) => a -> b -> b") + ) +"alist of strategy functions and their types as defined in Strategies.lhs.") + +(defvar haskell-doc-user-defined-ids nil + "alist of functions and strings defined by the user.") + +;;@node Test membership, , Prelude types, Constants and Variables +;;@subsection Test membership + +;;@cindex haskell-doc-is-of +(defsubst haskell-doc-is-of (fn types) + "Check whether FN is one of the functions in the alist TYPES and return the type." + (assoc fn types) ) + +;;@node Install as minor mode, Menubar Support, Constants and Variables, top +;;@section Install as minor mode + +;; Put this minor mode on the global minor-mode-alist. +(or (assq 'haskell-doc-mode (default-value 'minor-mode-alist)) + (setq-default minor-mode-alist + (append (default-value 'minor-mode-alist) + '((haskell-doc-mode haskell-doc-minor-mode-string))))) + + +;;@node Menubar Support, Haskell Doc Mode, Install as minor mode, top +;;@section Menubar Support + +;; get imenu +(require 'imenu) + +;; a dummy definition needed for xemacs (I know, it's horrible :-( + +;;@cindex haskell-doc-install-keymap + +(defvar haskell-doc-keymap + (let ((map (make-sparse-keymap))) + (define-key map [visit] + '("Visit FTP home site" . haskell-doc-visit-home)) + (define-key map [submit] + '("Submit bug report" . haskell-doc-submit-bug-report)) + (define-key map [dummy] '("---" . nil)) + (define-key map [make-index] + '("Make global fct index" . haskell-doc-make-global-fct-index)) + (define-key map [global-types-on] + '("Toggle display of global types" . haskell-doc-show-global-types)) + (define-key map [strategy-on] + '("Toggle display of strategy ids" . haskell-doc-show-strategy)) + (define-key map [user-defined-on] + '("Toggle display of user defined ids" . haskell-doc-show-user-defined)) + (define-key map [prelude-on] + '("Toggle display of prelude functions" . haskell-doc-show-prelude)) + (define-key map [reserved-ids-on] + '("Toggle display of reserved ids" . haskell-doc-show-reserved)) + (define-key map [haskell-doc-on] + '("Toggle haskell-doc mode" . haskell-doc-mode)) + map)) + +(defun haskell-doc-install-keymap () + "Install a menu for `haskell-doc-mode' as a submenu of \"Hugs\"." + (interactive) + ;; Add the menu to the hugs menu as last entry. + (let ((hugsmap (lookup-key (current-local-map) [menu-bar Hugs]))) + (if (not (or (featurep 'xemacs) ; XEmacs has problems here + (not (keymapp hugsmap)) + (lookup-key hugsmap [haskell-doc]))) + (if (functionp 'define-key-after) + (define-key-after hugsmap [haskell-doc] + (cons "Haskell-doc" haskell-doc-keymap) + [Haskell-doc mode])))) + ;; Add shortcuts for these commands. + (local-set-key "\C-c\e/" 'haskell-doc-check-active) + ;; Conflicts with the binding of haskell-insert-otherwise. + ;; (local-set-key "\C-c\C-o" 'haskell-doc-mode) + (local-set-key [(control shift meta mouse-3)] + 'haskell-doc-ask-mouse-for-type)) + + +;;@node Haskell Doc Mode, Switch it on or off, Menubar Support, top +;;@section Haskell Doc Mode + +;;@cindex haskell-doc-mode + +(defvar haskell-doc-timer nil) +(defvar haskell-doc-buffers nil) + +;;;###autoload +(defun haskell-doc-mode (&optional arg) + "Enter `haskell-doc-mode' for showing fct types in the echo area. +See variable docstring." + (interactive (list (or current-prefix-arg 'toggle))) + + (setq haskell-doc-mode + (cond + ((eq arg 'toggle) (not haskell-doc-mode)) + (arg (> (prefix-numeric-value arg) 0)) + (t))) + + ;; First, unconditionally turn the mode OFF. + + (setq haskell-doc-buffers (delq (current-buffer) haskell-doc-buffers)) + ;; Refresh the buffers list. + (dolist (buf haskell-doc-buffers) + (unless (and (buffer-live-p buf) + (with-current-buffer buf haskell-doc-mode)) + (setq haskell-doc-buffers (delq buf haskell-doc-buffers)))) + ;; Turn off the idle timer (or idle post-command-hook). + (when (and haskell-doc-timer (null haskell-doc-buffers)) + (cancel-timer haskell-doc-timer) + (setq haskell-doc-timer nil)) + (remove-hook 'post-command-hook + 'haskell-doc-mode-print-current-symbol-info 'local) + + (when haskell-doc-mode + ;; Turning the mode ON. + (push (current-buffer) haskell-doc-buffers) + + (if (fboundp 'run-with-idle-timer) + (unless haskell-doc-timer + (setq haskell-doc-timer + (run-with-idle-timer + haskell-doc-idle-delay t + 'haskell-doc-mode-print-current-symbol-info))) + (add-hook 'post-command-hook + 'haskell-doc-mode-print-current-symbol-info nil 'local)) + (and haskell-doc-show-global-types + (haskell-doc-make-global-fct-index)) ; build type index for global fcts + + (haskell-doc-install-keymap) + + (run-hooks 'haskell-doc-mode-hook)) + + (and (interactive-p) + (message "haskell-doc-mode is %s" + (if haskell-doc-mode "enabled" "disabled"))) + haskell-doc-mode) + +(defmacro haskell-doc-toggle-var (id prefix) + ;; toggle variable or set it based on prefix value + `(setq ,id + (if ,prefix + (>= (prefix-numeric-value ,prefix) 0) + (not ,id))) ) + +;;@cindex haskell-doc-show-global-types +(defun haskell-doc-show-global-types (&optional prefix) + "Turn on global types information in `haskell-doc-mode'." + (interactive "P") + (haskell-doc-toggle-var haskell-doc-show-global-types prefix) + (if haskell-doc-show-global-types + (haskell-doc-make-global-fct-index))) + +;;@cindex haskell-doc-show-reserved +(defun haskell-doc-show-reserved (&optional prefix) + "Toggle the automatic display of a doc string for reserved ids." + (interactive "P") + (haskell-doc-toggle-var haskell-doc-show-reserved prefix)) + +;;@cindex haskell-doc-show-prelude +(defun haskell-doc-show-prelude (&optional prefix) + "Toggle the automatic display of a doc string for reserved ids." + (interactive "P") + (haskell-doc-toggle-var haskell-doc-show-prelude prefix)) + +;;@cindex haskell-doc-show-strategy +(defun haskell-doc-show-strategy (&optional prefix) + "Toggle the automatic display of a doc string for strategy ids." + (interactive "P") + (haskell-doc-toggle-var haskell-doc-show-strategy prefix)) + +;;@cindex haskell-doc-show-user-defined +(defun haskell-doc-show-user-defined (&optional prefix) + "Toggle the automatic display of a doc string for user defined ids." + (interactive "P") + (haskell-doc-toggle-var haskell-doc-show-user-defined prefix)) + +;;@node Switch it on or off, Check, Haskell Doc Mode, top +;;@section Switch it on or off + +;;@cindex turn-on-haskell-doc-mode + +;;;###autoload +(defalias 'turn-on-haskell-doc-mode 'haskell-doc-mode) + +;;@cindex turn-off-haskell-doc-mode + +(defun turn-off-haskell-doc-mode () + "Unequivocally turn off `haskell-doc-mode' (which see)." + (haskell-doc-mode 0)) + +;;@node Check, Top level function, Switch it on or off, top +;;@section Check + +;;@cindex haskell-doc-check-active + +(defun haskell-doc-check-active () + "Check whether the print function is hooked in. +Should be the same as the value of `haskell-doc-mode' but alas currently it +is not." + (interactive) + (message "%s" + (if (or (and haskell-doc-mode haskell-doc-timer) + (memq 'haskell-doc-mode-print-current-symbol-info + post-command-hook)) + "haskell-doc is ACTIVE" + (substitute-command-keys + "haskell-doc is not ACTIVE \(Use \\[haskell-doc-mode] to turn it on\)")))) + +;;@node Top level function, Mouse interface, Check, top +;;@section Top level function + +;;@cindex haskell-doc-mode-print-current-symbol-info +;; This is the function hooked into the elisp command engine +(defun haskell-doc-mode-print-current-symbol-info () + "Print the type of the symbol under the cursor. + +This function is run by an idle timer to print the type + automatically if `haskell-doc-mode' is turned on." + (and haskell-doc-mode + (not executing-kbd-macro) + ;; Having this mode operate in the minibuffer makes it impossible to + ;; see what you're doing. + (not (eq (selected-window) (minibuffer-window))) + ;; take a nap, if run straight from post-command-hook. + (if (fboundp 'run-with-idle-timer) t + (sit-for haskell-doc-idle-delay)) + ;; good morning! read the word under the cursor for breakfast + (haskell-doc-show-type))) + ;; ;; ToDo: find surrounding fct + ;; (cond ((eq current-symbol current-fnsym) + ;; (haskell-doc-show-type current-fnsym)) + ;; (t + ;; (or nil ; (haskell-doc-print-var-docstring current-symbol) + ;; (haskell-doc-show-type current-fnsym))))))) + +(defun haskell-doc-current-info () + "Return the info about symbol at point. +Meant for `eldoc-documentation-function'." + (haskell-doc-sym-doc (haskell-ident-at-point))) + + +;;@node Mouse interface, Print fctsym, Top level function, top +;;@section Mouse interface for interactive query + +;;@cindex haskell-doc-ask-mouse-for-type +(defun haskell-doc-ask-mouse-for-type (event) + "Read the identifier under the mouse and echo its type. +This uses the same underlying function `haskell-doc-show-type' as the hooked +function. Only the user interface is different." + (interactive "e") + (save-excursion + (select-window (posn-window (event-end event))) + (goto-char (posn-point (event-end event))) + (haskell-doc-show-type))) + + +;;@node Print fctsym, Movement, Mouse interface, top +;;@section Print fctsym + +;;@menu +;;* Show type:: +;;* Aux:: +;;* Global fct type:: +;;* Local fct type:: +;;@end menu + +;;@node Show type, Aux, Print fctsym, Print fctsym +;;@subsection Show type + +;;@cindex haskell-doc-show-type + +;;;###autoload +(defun haskell-doc-show-type (&optional sym) + "Show the type of the function near point. +For the function under point, show the type in the echo area. +This information is extracted from the `haskell-doc-prelude-types' alist +of prelude functions and their types, or from the local functions in the +current buffer." + (interactive) + (unless sym (setq sym (haskell-ident-at-point))) + ;; if printed before do not print it again + (unless (string= sym (car haskell-doc-last-data)) + (let ((doc (haskell-doc-sym-doc sym))) + (when doc + ;; In emacs 19.29 and later, and XEmacs 19.13 and later, all + ;; messages are recorded in a log. Do not put haskell-doc messages + ;; in that log since they are legion. + (if (eval-when-compile (fboundp 'display-message)) + ;; XEmacs 19.13 way of preventing log messages. + ;;(display-message 'no-log (format )) + ;; XEmacs 19.15 seems to be a bit different. + (display-message 'message (format "%s" doc)) + (let ((message-log-max nil)) + (message "%s" doc))))))) + + +(defun haskell-doc-sym-doc (sym) + "Show the type of the function near point. +For the function under point, show the type in the echo area. +This information is extracted from the `haskell-doc-prelude-types' alist +of prelude functions and their types, or from the local functions in the +current buffer." + (let ((i-am-prelude nil) + (i-am-fct nil) + (type nil) + (is-reserved (haskell-doc-is-of sym haskell-doc-reserved-ids)) + (is-prelude (haskell-doc-is-of sym haskell-doc-prelude-types)) + (is-strategy (haskell-doc-is-of sym haskell-doc-strategy-ids)) + (is-user-defined (haskell-doc-is-of sym haskell-doc-user-defined-ids)) + (is-prelude (haskell-doc-is-of sym haskell-doc-prelude-types))) + (cond + ;; if reserved id (i.e. Haskell keyword + ((and haskell-doc-show-reserved + is-reserved) + (setq type (cdr is-reserved)) + (setcdr haskell-doc-last-data type)) + ;; if built-in function get type from docstring + ((and (not (null haskell-doc-show-prelude)) + is-prelude) + (setq type (cdr is-prelude)) ; (cdr (assoc sym haskell-doc-prelude-types))) + (if (= 2 (length type)) ; horrible hack to remove bad formatting + (setq type (car (cdr type)))) + (setq i-am-prelude t) + (setq i-am-fct t) + (setcdr haskell-doc-last-data type)) + ((and haskell-doc-show-strategy + is-strategy) + (setq i-am-fct t) + (setq type (cdr is-strategy)) + (setcdr haskell-doc-last-data type)) + ((and haskell-doc-show-user-defined + is-user-defined) + ;; (setq i-am-fct t) + (setq type (cdr is-user-defined)) + (setcdr haskell-doc-last-data type)) + (t + (let ( (x (haskell-doc-get-and-format-fct-type sym)) ) + (if (null x) + (setcdr haskell-doc-last-data nil) ; if not found reset last data + (setq type (car x)) + (setq i-am-fct (string= "Variables" (cdr x))) + (if (and haskell-doc-show-global-types (null type)) + (setq type (haskell-doc-get-global-fct-type sym))) + (setcdr haskell-doc-last-data type)))) ) + ;; ToDo: encode i-am-fct info into alist of types + (and type + ;; drop `::' if it's not a fct + (let ( (str (cond ((and i-am-fct (not haskell-doc-chop-off-fctname)) + (format "%s :: %s" sym type)) + (t + (format "%s" type)))) ) + (if i-am-prelude + (add-text-properties 0 (length str) '(face bold) str)) + str)))) + + +;; ToDo: define your own notion of `near' to find surrounding fct +;;(defun haskell-doc-fnsym-in-current-sexp () +;; (let* ((p (point)) +;; (sym (progn +;; (forward-word -1) +;; (while (and (forward-word -1) ; (haskell-doc-forward-sexp-safe -1) +;; (> (point) (point-min)))) +;; (cond ((or (= (point) (point-min)) +;; (memq (or (char-after (point)) 0) +;; '(?\( ?\")) +;; ;; If we hit a quotation mark before a paren, we +;; ;; are inside a specific string, not a list of +;; ;; symbols. +;; (eq (or (char-after (1- (point))) 0) ?\")) +;; nil) +;; (t (condition-case nil +;; (read (current-buffer)) +;; (error nil))))))) +;; (goto-char p) +;; (if sym +;; (format "%s" sym) +;; sym))) + +;; (and (symbolp sym) +;; sym))) + +;;@node Aux, Global fct type, Show type, Print fctsym +;;@subsection Aux + +;; ToDo: handle open brackets to decide if it's a wrapped type + +;;@cindex haskell-doc-grab-line +(defun haskell-doc-grab-line (fct-and-pos) + "Get the type of an \(FCT POSITION\) pair from the current buffer." + ;; (if (null fct-and-pos) + ;; "" ; fn is not a local fct + (let ( (str "")) + (goto-char (cdr fct-and-pos)) + (beginning-of-line) + ;; search for start of type (phsp give better bound?) + (if (null (search-forward "::" (+ (point) haskell-doc-search-distance) t)) + "" + (setq str (haskell-doc-grab)) ; leaves point at end of line + (while (haskell-doc-wrapped-type-p) ; while in a multi-line type expr + (forward-line 1) + (beginning-of-line) + (skip-chars-forward " \t") + (setq str (concat str (haskell-doc-grab)))) + (haskell-doc-string-nub-ws ; squeeze string + (if haskell-doc-chop-off-context ; no context + (haskell-doc-chop-off-context str) + str))))) + ;; (concat (car fct-and-pos) "::" (haskell-doc-string-nub-ws str)))) + +;;@cindex haskell-doc-wrapped-type-p +(defun haskell-doc-wrapped-type-p () + "Check whether the type under the cursor is wrapped over several lines. +The cursor must be at the end of a line, which contains the type. +Currently, only the following is checked: +If this line ends with a `->' or the next starts with an `->' it is a +multi-line type \(same for `=>'\). +`--' comments are ignored. +ToDo: Check for matching parenthesis!. " + (save-excursion + (let ( (here (point)) + (lim (progn (beginning-of-line) (point))) + ;; (foo "") + (res nil) + ) + (goto-char here) + (search-backward "--" lim t) ; skip over `--' comment + (skip-chars-backward " \t") + (if (bolp) ; skip empty lines + (progn + (forward-line 1) + (end-of-line) + (setq res (haskell-doc-wrapped-type-p))) + (forward-char -1) + ;; (setq foo (concat foo (char-to-string (preceding-char)) (char-to-string (following-char)))) + (if (or (and (or (char-equal (preceding-char) ?-) (char-equal (preceding-char) ?=)) + (char-equal (following-char) ?>)) ; (or -!> =!> + (char-equal (following-char) ?,)) ; !,) + (setq res t) + (forward-line) + (let ((here (point))) + (goto-char here) + (skip-chars-forward " \t") + (if (looking-at "--") ; it is a comment line + (progn + (forward-line 1) + (end-of-line) + (setq res (haskell-doc-wrapped-type-p))) + (forward-char 1) + ;; (setq foo (concat foo (char-to-string (preceding-char)) (char-to-string (following-char)))) + ;; (message "|%s|" foo) + (if (and (or (char-equal (preceding-char) ?-) (char-equal (preceding-char) ?=)) + (char-equal (following-char) ?>)) ; -!> or =!> + (setq res t)))))) + res))) + +;;@cindex haskell-doc-grab +(defun haskell-doc-grab () + "Return the text from point to the end of the line, chopping off comments. +Leaves point at end of line." + (let ((str (buffer-substring-no-properties + (point) (progn (end-of-line) (point))))) + (if (string-match "--" str) + (substring str 0 (match-beginning 0)) + str))) + +;;@cindex haskell-doc-string-nub-ws +(defun haskell-doc-string-nub-ws (str) + "Replace all sequences of whitespaces in STR by just one whitespace. +ToDo: Also eliminate leading and trainling whitespace." + (let ((i -1)) + (while (setq i (string-match " [ \t\n]+\\|[\t\n]+" str (1+ i))) + (setq str (replace-match " " t t str))) + str)) + +;; ToDo: make this more efficient!! +;;(defun haskell-doc-string-nub-ws (str) +;; "Replace all sequences of whitespaces in STR by just one whitespace." +;; (let ( (res "") +;; (l (length str)) +;; (i 0) +;; (j 0) +;; (in-ws nil)) +;; (while (< i l) +;; (let* ( (c (string-to-char (substring str i (1+ i)))) +;; (is-ws (eq (char-syntax c) ? )) ) +;; (if (not (and in-ws is-ws)) +;; (setq res (concat res (char-to-string c)))) +;; (setq in-ws is-ws) +;; (setq i (1+ i)))) +;; res)) + +;;@cindex haskell-doc-chop-off-context +(defun haskell-doc-chop-off-context (str) + "Eliminate the contex in a type represented by the string STR." + (let ((i (string-match "=>" str)) ) + (if (null i) + str + (substring str (+ i 2))))) + +;;@cindex haskell-doc-get-imenu-info +(defun haskell-doc-get-imenu-info (obj kind) + "Returns a string describing OBJ of KIND \(Variables, Types, Data\)." + (cond ((or (eq major-mode 'haskell-hugs-mode) + ;; GEM: Haskell Mode does not work with Haskell Doc + ;; under XEmacs 20.x + (and (eq major-mode 'haskell-mode) + (not (and (featurep 'xemacs) + (string-match "^20" emacs-version))))) + (let* ((imenu-info-alist (cdr (assoc kind imenu--index-alist))) + ;; (names (mapcar 'car imenu-info-alist)) + (x (assoc obj imenu-info-alist))) + (if x + (haskell-doc-grab-line x) + nil))) + (t + ;; (error "Cannot get local functions in %s mode, sorry" major-mode))) ) + nil))) + +;;@node Global fct type, Local fct type, Aux, Print fctsym +;;@subsection Global fct type + +;; ToDo: +;; - modular way of defining a mapping of module name to file +;; - use a path to search for file (not just current directory) + +;;@cindex haskell-doc-imported-list + +(defun haskell-doc-imported-list () + "Return a list of the imported modules in current buffer" + (interactive "fName of outer `include' file: ") ; (buffer-file-name)) + (let ((imported-file-list (list buffer-file-name))) + (widen) + (goto-char (point-min)) + (while (re-search-forward "^\\s-*import\\s-+\\([^ \t\n]+\\)" nil t) + (let ((basename (match-string 1))) + (dolist (ext '(".hs" ".lhs")) + (let ((file (concat basename ext))) + (if (file-exists-p file) + (push file imported-file-list)))))) + (nreverse imported-file-list) + ;;(message imported-file-list) + )) + +;; ToDo: generalise this to "Types" etc (not just "Variables") + +;;@cindex haskell-doc-rescan-files + +(defun haskell-doc-rescan-files (filelist) + "Does an `imenu' rescan on every file in FILELIST and returns the fct-list. +This function switches to and potentially loads many buffers." + (save-current-buffer + (mapcar (lambda (f) + (set-buffer (find-file-noselect f)) + (imenu--make-index-alist) + (cons f + (mapcar (lambda (x) + `(,(car x) . ,(haskell-doc-grab-line x))) + (cdr (assoc "Variables" imenu--index-alist))))) + filelist))) + +;;@cindex haskell-doc-make-global-fct-index + +(defun haskell-doc-make-global-fct-index () + "Scan imported files for types of global fcts and update `haskell-doc-index'." + (interactive) + (setq haskell-doc-index + (haskell-doc-rescan-files (haskell-doc-imported-list)))) + +;; ToDo: use a separate munge-type function to format type concisely + +;;@cindex haskell-doc-get-global-fct-type + +(defun haskell-doc-get-global-fct-type (&optional sym) + "Get type for function symbol SYM by examining `haskell-doc-index'." + (interactive) ; "fName of outer `include' file: \nsFct:") + (save-excursion + ;; (switch-to-buffer "*scratch*") + ;; (goto-char (point-max)) + ;; ;; Produces a list of fct-type alists + ;; (if (null sym) + ;; (setq sym (progn (forward-word -1) (read (current-buffer))))) + (or sym + (current-word)) + (let* ( (fn sym) ; (format "%s" sym)) + (fal haskell-doc-index) + (res "") ) + (while (not (null fal)) + (let* ( (l (car fal)) + (f (car l)) + (x (assoc fn (cdr l))) ) + (if (not (null x)) + (let* ( (ty (cdr x)) ; the type as string + (idx (string-match "::" ty)) + (str (if (null idx) + ty + (substring ty (+ idx 2)))) ) + (setq res (format "[%s] %s" f str)))) + (setq fal (cdr fal)))) + res))) ; (message res)) ) + +;;@node Local fct type, , Global fct type, Print fctsym +;;@subsection Local fct type + +;;@cindex haskell-doc-get-and-format-fct-type + +(defun haskell-doc-get-and-format-fct-type (fn) + "Get the type and kind of FN by checking local and global functions." + (save-excursion + (save-match-data + (let ((docstring "") + (doc nil) + ) + ;; is it a local function? + (setq docstring (haskell-doc-get-imenu-info fn "Variables")) + (if (not (null docstring)) + ;; (string-match (format "^%s\\s-+::\\s-+\\(.*\\)$" fn) docstring)) + (setq doc `(,docstring . "Variables"))) ; `(,(match-string 1 docstring) . "Variables") )) + ;; is it a type declaration? + (setq docstring (haskell-doc-get-imenu-info fn "Types")) + (if (not (null docstring)) + ;; (string-match (format "^\\s-*type\\s-+%s.*$" fn) docstring)) + (setq doc `(,docstring . "Types"))) ; `(,(match-string 0 docstring) . "Types")) ) + (if (not (null docstring)) + ;; (string-match (format "^\\s-*data.*%s.*$" fn) docstring)) + (setq doc `(,docstring . "Data"))) ; (setq doc `(,(match-string 0 docstring) . "Data")) ) + ;; return the result + doc )))) + + +;;@appendix + +;;@node Index, Token, Visit home site, top +;;@section Index + +;;@index +;;* haskell-doc-ask-mouse-for-type:: +;;* haskell-doc-check-active:: +;;* haskell-doc-chop-off-context:: +;;* haskell-doc-get-and-format-fct-type:: +;;* haskell-doc-get-global-fct-type:: +;;* haskell-doc-get-imenu-info:: +;;* haskell-doc-grab:: +;;* haskell-doc-grab-line:: +;;* haskell-doc-imported-list:: +;;* haskell-doc-install-keymap:: +;;* haskell-doc-is-of:: +;;* haskell-doc-make-global-fct-index:: +;;* haskell-doc-mode:: +;;* haskell-doc-mode-print-current-symbol-info:: +;;* haskell-doc-prelude-types:: +;;* haskell-doc-rescan-files:: +;;* haskell-doc-reserved-ids:: +;;* haskell-doc-show-global-types:: +;;* haskell-doc-show-prelude:: +;;* haskell-doc-show-reserved:: +;;* haskell-doc-show-strategy:: +;;* haskell-doc-show-type:: +;;* haskell-doc-show-user-defined:: +;;* haskell-doc-strategy-ids:: +;;* haskell-doc-string-nub-ws:: +;;* haskell-doc-submit-bug-report:: +;;* haskell-doc-visit-home:: +;;* haskell-doc-wrapped-type-p:: +;;* turn-off-haskell-doc-mode:: +;;* turn-on-haskell-doc-mode:: +;;@end index + +;;@node Token, , Index, top +;;@section Token + +(provide 'haskell-doc) + +;; arch-tag: 6492eb7e-7048-47ac-a331-da09e1eb6254 +;;; haskell-doc.el ends here diff --git a/emacs.d/haskell/haskell-font-lock.el b/emacs.d/haskell/haskell-font-lock.el new file mode 100644 index 0000000..71a3daf --- /dev/null +++ b/emacs.d/haskell/haskell-font-lock.el @@ -0,0 +1,554 @@ +;;; haskell-font-lock.el --- Font locking module for Haskell Mode + +;; Copyright 2003, 2004, 2005, 2006, 2007 Free Software Foundation, Inc. +;; Copyright 1997-1998 Graeme E Moss, and Tommy Thorn + +;; Authors: 1997-1998 Graeme E Moss and +;; Tommy Thorn +;; 2003 Dave Love +;; Keywords: faces files Haskell + +;; This file is not part of GNU Emacs. + +;; This file is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 2, or (at your option) +;; any later version. + +;; This file is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs; see the file COPYING. If not, write to the +;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, +;; Boston, MA 02111-1307, USA. + + +;;; Commentary: + +;; Purpose: +;; +;; To support fontification of standard Haskell keywords, symbols, +;; functions, etc. Supports full Haskell 1.4 as well as LaTeX- and +;; Bird-style literate scripts. +;; +;; Installation: +;; +;; To turn font locking on for all Haskell buffers under the Haskell +;; mode of Moss&Thorn, add this to .emacs: +;; +;; (add-hook 'haskell-mode-hook 'turn-on-haskell-font-lock) +;; +;; Otherwise, call `turn-on-haskell-font-lock'. +;; +;; +;; Customisation: +;; +;; The colours and level of font locking may be customised. See the +;; documentation on `turn-on-haskell-font-lock' for more details. +;; +;; +;; History: +;; +;; If you have any problems or suggestions, after consulting the list +;; below, email gem@cs.york.ac.uk and thorn@irisa.fr quoting the +;; version of the mode you are using, the version of Emacs you are +;; using, and a small example of the problem or suggestion. Note that +;; this module requires a reasonably recent version of Emacs. It +;; requires Emacs 21 to cope with Unicode characters and to do proper +;; syntactic fontification. +;; +;; Version 1.3: +;; From Dave Love: +;; Support for proper behaviour (including with Unicode identifiers) +;; in Emacs 21 only hacked in messily to avoid disturbing the old +;; stuff. Needs integrating more cleanly. Allow literate comment +;; face to be customized. Some support for fontifying definitions. +;; (I'm not convinced the faces should be customizable -- fontlock +;; faces are normally expected to be consistent.) +;; +;; Version 1.2: +;; Added support for LaTeX-style literate scripts. Allow whitespace +;; after backslash to end a line for string continuations. +;; +;; Version 1.1: +;; Use own syntax table. Use backquote (neater). Stop ''' being +;; highlighted as quoted character. Fixed `\"' fontification bug +;; in comments. +;; +;; Version 1.0: +;; Brought over from Haskell mode v1.1. +;; +;; Present Limitations/Future Work (contributions are most welcome!): +;; +;; . Debatable whether `()' `[]' `(->)' `(,)' `(,,)' etc. should be +;; highlighted as constructors or not. Should the `->' in +;; `id :: a -> a' be considered a constructor or a keyword? If so, +;; how do we distinguish this from `\x -> x'? What about the `\'? +;; +;; . XEmacs can support both `--' comments and `{- -}' comments +;; simultaneously. If XEmacs is detected, this should be used. +;; +;; . Support for GreenCard? +;; + +;; All functions/variables start with +;; `(turn-(on/off)-)haskell-font-lock' or `haskell-fl-'. + +;;; Code: + +(eval-when-compile + (require 'haskell-mode) + (require 'cl)) +(require 'font-lock) + +(defcustom haskell-font-lock-symbols nil + "Display \\ and -> and such using symbols in fonts. +This may sound like a neat trick, but be extra careful: it changes the +alignment and can thus lead to nasty surprises w.r.t layout. +If t, try to use whichever font is available. Otherwise you can +set it to a particular font of your preference among `japanese-jisx0208' +and `unicode'." + :group 'haskell + :type '(choice (const nil) + (const t) + (const unicode) + (const japanese-jisx0208))) + +(defconst haskell-font-lock-symbols-alist + (append + ;; Prefer single-width Unicode font for lambda. + (and (fboundp 'decode-char) + (memq haskell-font-lock-symbols '(t unicode)) + (list (cons "\\" (decode-char 'ucs 955)))) + ;; The symbols can come from a JIS0208 font. + (and (fboundp 'make-char) (fboundp 'charsetp) (charsetp 'japanese-jisx0208) + (memq haskell-font-lock-symbols '(t japanese-jisx0208)) + (list (cons "not" (make-char 'japanese-jisx0208 34 76)) + (cons "\\" (make-char 'japanese-jisx0208 38 75)) + (cons "->" (make-char 'japanese-jisx0208 34 42)) + (cons "<-" (make-char 'japanese-jisx0208 34 43)) + (cons "=>" (make-char 'japanese-jisx0208 34 77)))) + ;; Or a unicode font. + (and (fboundp 'decode-char) + (memq haskell-font-lock-symbols '(t unicode)) + (list (cons "not" (decode-char 'ucs 172)) + (cons "->" (decode-char 'ucs 8594)) + (cons "<-" (decode-char 'ucs 8592)) + (cons "=>" (decode-char 'ucs 8658)) + (cons "~>" (decode-char 'ucs 8669)) ;; Omega language + ;; (cons "~>" (decode-char 'ucs 8605)) ;; less desirable + (cons "-<" (decode-char 'ucs 8610)) ;; Paterson's arrow syntax + ;; (cons "-<" (decode-char 'ucs 10521)) ;; nicer but uncommon + (cons "::" (decode-char 'ucs 8759)) + (cons "." (decode-char 'ucs 9675)))))) + +;; Use new vars for the font-lock faces. The indirection allows people to +;; use different faces than in other modes, as before. +(defvar haskell-keyword-face 'font-lock-keyword-face) +(defvar haskell-constructor-face 'font-lock-type-face) +;; This used to be `font-lock-variable-name-face' but it doesn't result in +;; a highlighting that's consistent with other modes (it's mostly used +;; for function defintions). +(defvar haskell-definition-face 'font-lock-function-name-face) +;; This is probably just wrong, but it used to use +;; `font-lock-function-name-face' with a result that was not consistent with +;; other major modes, so I just exchanged with `haskell-definition-face'. +(defvar haskell-operator-face 'font-lock-variable-name-face) +(defvar haskell-default-face nil) +(defvar haskell-literate-comment-face 'font-lock-doc-face + "Face with which to fontify literate comments. +Set to `default' to avoid fontification of them.") + +(defconst haskell-emacs21-features (string-match "[[:alpha:]]" "x") + "Non-nil if we have regexp char classes. +Assume this means we have other useful features from Emacs 21.") + +(defun haskell-font-lock-compose-symbol (alist) + "Compose a sequence of ascii chars into a symbol. +Regexp match data 0 points to the chars." + ;; Check that the chars should really be composed into a symbol. + (let* ((start (match-beginning 0)) + (end (match-end 0)) + (syntaxes (cond + ((eq (char-syntax (char-after start)) ?w) '(?w)) + ;; Special case for the . used for qualified names. + ((and (eq (char-after start) ?\.) (= end (1+ start))) + '(?_ ?\\ ?w)) + (t '(?_ ?\\))))) + (if (or (memq (char-syntax (or (char-before start) ?\ )) syntaxes) + (memq (char-syntax (or (char-after end) ?\ )) syntaxes) + (memq (get-text-property start 'face) + '(font-lock-doc-face font-lock-string-face + font-lock-comment-face))) + ;; No composition for you. Let's actually remove any composition + ;; we may have added earlier and which is now incorrect. + (remove-text-properties start end '(composition)) + ;; That's a symbol alright, so add the composition. + (compose-region start end (cdr (assoc (match-string 0) alist))))) + ;; Return nil because we're not adding any face property. + nil) + +(defun haskell-font-lock-symbols-keywords () + (when (fboundp 'compose-region) + (let ((alist nil)) + (dolist (x haskell-font-lock-symbols-alist) + (when (and (if (fboundp 'char-displayable-p) + (char-displayable-p (cdr x)) + t) + (not (assoc (car x) alist))) ;Not yet in alist. + (push x alist))) + (when alist + `((,(regexp-opt (mapcar 'car alist) t) + (0 (haskell-font-lock-compose-symbol ',alist) + ;; In Emacs-21, if the `override' field is nil, the face + ;; expressions is only evaluated if the text has currently + ;; no face. So force evaluation by using `keep'. + keep))))))) + +;; The font lock regular expressions. +(defun haskell-font-lock-keywords-create (literate) + "Create fontification definitions for Haskell scripts. +Returns keywords suitable for `font-lock-keywords'." + (let* (;; Bird-style literate scripts start a line of code with + ;; "^>", otherwise a line of code starts with "^". + (line-prefix (if (eq literate 'bird) "^> ?" "^")) + + ;; Most names are borrowed from the lexical syntax of the Haskell + ;; report. + ;; Some of these definitions have been superseded by using the + ;; syntax table instead. + + ;; (ASCsymbol "-!#$%&*+./<=>?@\\\\^|~") + ;; Put the minus first to make it work in ranges. + ;; (ISOsymbol "\241-\277\327\367") + (ISOlarge "\300-\326\330-\337") + (ISOsmall "\340-\366\370-\377") + (small + (if haskell-emacs21-features "[:lower:]" (concat "a-z" ISOsmall))) + (large + (if haskell-emacs21-features "[:upper:]" (concat "A-Z" ISOlarge))) + (alnum + (if haskell-emacs21-features "[:alnum:]" (concat small large "0-9"))) + ;; (symbol + ;; (concat ASCsymbol ISOsymbol)) + + ;; We allow _ as the first char to fit GHC + (varid (concat "\\b[" small "_][" alnum "'_]*\\b")) + (conid (concat "\\b[" large "][" alnum "'_]*\\b")) + (modid (concat "\\b" conid "\\(\\." conid "\\)*\\b")) + (qvarid (concat modid "\\." varid)) + (qconid (concat modid "\\." conid)) + (sym + ;; We used to use the below for non-Emacs21, but I think the + ;; regexp based on syntax works for other emacsen as well. -- Stef + ;; (concat "[" symbol ":]+") + ;; Add backslash to the symbol-syntax chars. This seems to + ;; be thrown for some reason by backslash's escape syntax. + "\\(\\s_\\|\\\\\\)+") + + ;; Reserved operations + (reservedsym + (concat "\\S_" + ;; (regexp-opt '(".." "::" "=" "\\" "|" "<-" "->" + ;; "@" "~" "=>") t) + "\\(->\\|\\.\\.\\|::\\|<-\\|=>\\|[=@\\|~]\\)" + "\\S_")) + ;; Reserved identifiers + (reservedid + (concat "\\<" + ;; `as', `hiding', and `qualified' are part of the import + ;; spec syntax, but they are not reserved. + ;; `_' can go in here since it has temporary word syntax. + ;; (regexp-opt + ;; '("case" "class" "data" "default" "deriving" "do" + ;; "else" "if" "import" "in" "infix" "infixl" + ;; "infixr" "instance" "let" "module" "newtype" "of" + ;; "then" "type" "where" "_") t) + "\\(_\\|c\\(ase\\|lass\\)\\|d\\(ata\\|e\\(fault\\|riving\\)\\|o\\)\\|else\\|i\\(mport\\|n\\(fix[lr]?\\|stance\\)\\|[fn]\\)\\|let\\|module\\|newtype\\|of\\|t\\(hen\\|ype\\)\\|where\\)" + "\\>")) + + ;; This unreadable regexp matches strings and character + ;; constants. We need to do this with one regexp to handle + ;; stuff like '"':"'". The regexp is the composition of + ;; "([^"\\]|\\.)*" for strings and '([^\\]|\\.[^']*)' for + ;; characters, allowing for string continuations. + ;; Could probably be improved... + (string-and-char + (concat "\\(\\(\"\\|" line-prefix "[ \t]*\\\\\\)\\([^\"\\\\\n]\\|\\\\.\\)*\\(\"\\|\\\\[ \t]*$\\)\\|'\\([^'\\\\\n]\\|\\\\.[^'\n]*\\)'\\)")) + + ;; Top-level declarations + (topdecl-var + (concat line-prefix "\\(" varid "\\)\\s-*\\(" + ;; A toplevel declaration can be followed by a definition + ;; (=), a type (::), a guard, or a pattern which can + ;; either be a variable, a constructor, a parenthesized + ;; thingy, or an integer or a string. + varid "\\|" conid "\\|::\\|=\\||\\|\\s(\\|[0-9\"']\\)")) + (topdecl-var2 + (concat line-prefix "\\(" varid "\\|" conid "\\)\\s-*`\\(" varid "\\)`")) + (topdecl-sym + (concat line-prefix "\\(" varid "\\|" conid "\\)\\s-*\\(" sym "\\)")) + (topdecl-sym2 (concat line-prefix "(\\(" sym "\\))")) + + keywords) + + (setq keywords + `(;; NOTICE the ordering below is significant + ;; + ("^#.*$" 0 'font-lock-warning-face t) + ,@(unless haskell-emacs21-features ;Supports nested comments? + ;; Expensive. + `((,string-and-char 1 font-lock-string-face))) + + ;; This was originally at the very end (and needs to be after + ;; all the comment/string/doc highlighting) but it seemed to + ;; trigger a bug in Emacs-21.3 which caused the compositions to + ;; be "randomly" dropped. Moving it earlier seemed to reduce + ;; the occurrence of the bug. + ,@(haskell-font-lock-symbols-keywords) + + (,reservedid 1 (symbol-value 'haskell-keyword-face)) + (,reservedsym 1 (symbol-value 'haskell-operator-face)) + ;; Special case for `as', `hiding', and `qualified', which are + ;; keywords in import statements but are not otherwise reserved. + ("\\\\)[ \t]*\\)?[^ \t\n()]+[ \t]*\\(?:\\(\\\\)[ \t]*[^ \t\n()]+[ \t]*\\)?\\(\\\\)?" + (1 (symbol-value 'haskell-keyword-face) nil lax) + (2 (symbol-value 'haskell-keyword-face) nil lax) + (3 (symbol-value 'haskell-keyword-face) nil lax)) + + ;; Toplevel Declarations. + ;; Place them *before* generic id-and-op highlighting. + (,topdecl-var (1 (symbol-value 'haskell-definition-face))) + (,topdecl-var2 (2 (symbol-value 'haskell-definition-face))) + (,topdecl-sym (2 (symbol-value 'haskell-definition-face))) + (,topdecl-sym2 (1 (symbol-value 'haskell-definition-face))) + + ;; These four are debatable... + ("(\\(,*\\|->\\))" 0 (symbol-value 'haskell-constructor-face)) + ("\\[\\]" 0 (symbol-value 'haskell-constructor-face)) + ;; Expensive. + (,qvarid 0 haskell-default-face) + (,qconid 0 (symbol-value 'haskell-constructor-face)) + (,(concat "\`" varid "\`") 0 (symbol-value 'haskell-operator-face)) + ;; Expensive. + (,conid 0 (symbol-value 'haskell-constructor-face)) + + ;; Very expensive. + (,sym 0 (if (eq (char-after (match-beginning 0)) ?:) + haskell-constructor-face + haskell-operator-face)))) + (unless (boundp 'font-lock-syntactic-keywords) + (case literate + (bird + (setq keywords + `(("^[^>\n].*$" 0 haskell-comment-face t) + ,@keywords + ("^>" 0 haskell-default-face t)))) + (latex + (setq keywords + `((haskell-fl-latex-comments 0 'font-lock-comment-face t) + ,@keywords))))) + keywords)) + +;; The next three aren't used in Emacs 21. + +(defvar haskell-fl-latex-cache-pos nil + "Position of cache point used by `haskell-fl-latex-cache-in-comment'. +Should be at the start of a line.") + +(defvar haskell-fl-latex-cache-in-comment nil + "If `haskell-fl-latex-cache-pos' is outside a +\\begin{code}..\\end{code} block (and therefore inside a comment), +this variable is set to t, otherwise nil.") + +(defun haskell-fl-latex-comments (end) + "Sets `match-data' according to the region of the buffer before end +that should be commented under LaTeX-style literate scripts." + (let ((start (point))) + (if (= start end) + ;; We're at the end. No more to fontify. + nil + (if (not (eq start haskell-fl-latex-cache-pos)) + ;; If the start position is not cached, calculate the state + ;; of the start. + (progn + (setq haskell-fl-latex-cache-pos start) + ;; If the previous \begin{code} or \end{code} is a + ;; \begin{code}, then start is not in a comment, otherwise + ;; it is in a comment. + (setq haskell-fl-latex-cache-in-comment + (if (and + (re-search-backward + "^\\(\\(\\\\begin{code}\\)\\|\\(\\\\end{code}\\)\\)$" + (point-min) t) + (match-end 2)) + nil t)) + ;; Restore position. + (goto-char start))) + (if haskell-fl-latex-cache-in-comment + (progn + ;; If start is inside a comment, search for next \begin{code}. + (re-search-forward "^\\\\begin{code}$" end 'move) + ;; Mark start to end of \begin{code} (if present, till end + ;; otherwise), as a comment. + (set-match-data (list start (point))) + ;; Return point, as a normal regexp would. + (point)) + ;; If start is inside a code block, search for next \end{code}. + (if (re-search-forward "^\\\\end{code}$" end t) + ;; If one found, mark it as a comment, otherwise finish. + (point)))))) + +(defconst haskell-basic-syntactic-keywords + '(;; Character constants (since apostrophe can't have string syntax). + ;; Beware: do not match something like 's-}' or '\n"+' since the first ' + ;; might be inside a comment or a string. + ;; This still gets fooled with "'"'"'"'"'"', but ... oh well. + ("\\Sw\\('\\)\\([^\\'\n]\\|\\\\.[^\\'\n \"}]*\\)\\('\\)" (1 "|") (3 "|")) + ;; The \ is not escaping in \(x,y) -> x + y. + ("\\(\\\\\\)(" (1 ".")) + ;; The second \ in a gap does not quote the subsequent char. + ;; It's probably not worth the trouble, tho. + ;; ("^[ \t]*\\(\\\\\\)" (1 ".")) + ;; Deal with instances of `--' which don't form a comment. + ("\\s_\\{3,\\}" (0 (if (string-match "\\`-*\\'" (match-string 0)) + ;; Sequence of hyphens. Do nothing in + ;; case of things like `{---'. + nil + "_"))))) ; other symbol sequence + +(defconst haskell-bird-syntactic-keywords + (cons '("^[^\n>]" (0 "<")) + haskell-basic-syntactic-keywords)) + +(defconst haskell-latex-syntactic-keywords + (append + '(("^\\\\begin{code}\\(\n\\)" 1 "!") + ;; Note: buffer is widened during font-locking. + ("\\`\\(.\\|\n\\)" (1 "!")) ; start comment at buffer start + ("^\\(\\\\\\)end{code}$" 1 "!")) + haskell-basic-syntactic-keywords)) + +(defun haskell-syntactic-face-function (state) + "`font-lock-syntactic-face-function' for Haskell." + (cond + ((nth 3 state) font-lock-string-face) ; as normal + ;; Else comment. If it's from syntax table, use default face. + ((or (eq 'syntax-table (nth 7 state)) + (and (eq haskell-literate 'bird) + (memq (char-before (nth 8 state)) '(nil ?\n)))) + haskell-literate-comment-face) + (t font-lock-comment-face))) + +(defconst haskell-font-lock-keywords + (haskell-font-lock-keywords-create nil) + "Font lock definitions for non-literate Haskell.") + +(defconst haskell-font-lock-bird-literate-keywords + (haskell-font-lock-keywords-create 'bird) + "Font lock definitions for Bird-style literate Haskell.") + +(defconst haskell-font-lock-latex-literate-keywords + (haskell-font-lock-keywords-create 'latex) + "Font lock definitions for LaTeX-style literate Haskell.") + +(defun haskell-font-lock-choose-keywords () + (let ((literate (if (boundp 'haskell-literate) haskell-literate))) + (case literate + (bird haskell-font-lock-bird-literate-keywords) + (latex haskell-font-lock-latex-literate-keywords) + (t haskell-font-lock-keywords)))) + +(defun haskell-font-lock-choose-syntactic-keywords () + (let ((literate (if (boundp 'haskell-literate) haskell-literate))) + (case literate + (bird haskell-bird-syntactic-keywords) + (latex haskell-latex-syntactic-keywords) + (t haskell-basic-syntactic-keywords)))) + +(defun haskell-font-lock-defaults-create () + "Locally set `font-lock-defaults' for Haskell." + (set (make-local-variable 'font-lock-defaults) + '(haskell-font-lock-choose-keywords + nil nil ((?\' . "w") (?_ . "w")) nil + (font-lock-syntactic-keywords + . haskell-font-lock-choose-syntactic-keywords) + (font-lock-syntactic-face-function + . haskell-syntactic-face-function) + ;; Get help from font-lock-syntactic-keywords. + (parse-sexp-lookup-properties . t)))) + +;; The main functions. +(defun turn-on-haskell-font-lock () + "Turns on font locking in current buffer for Haskell 1.4 scripts. + +Changes the current buffer's `font-lock-defaults', and adds the +following variables: + + `haskell-keyword-face' for reserved keywords and syntax, + `haskell-constructor-face' for data- and type-constructors, class names, + and module names, + `haskell-operator-face' for symbolic and alphanumeric operators, + `haskell-default-face' for ordinary code. + +The variables are initialised to the following font lock default faces: + + `haskell-keyword-face' `font-lock-keyword-face' + `haskell-constructor-face' `font-lock-type-face' + `haskell-operator-face' `font-lock-function-name-face' + `haskell-default-face' + +Two levels of fontification are defined: level one (the default) +and level two (more colour). The former does not colour operators. +Use the variable `font-lock-maximum-decoration' to choose +non-default levels of fontification. For example, adding this to +.emacs: + + (setq font-lock-maximum-decoration '((haskell-mode . 2) (t . 0))) + +uses level two fontification for `haskell-mode' and default level for +all other modes. See documentation on this variable for further +details. + +To alter an attribute of a face, add a hook. For example, to change +the foreground colour of comments to brown, add the following line to +.emacs: + + (add-hook 'haskell-font-lock-hook + (lambda () + (set-face-foreground 'haskell-comment-face \"brown\"))) + +Note that the colours available vary from system to system. To see +what colours are available on your system, call +`list-colors-display' from emacs. + +To turn font locking on for all Haskell buffers, add this to .emacs: + + (add-hook 'haskell-mode-hook 'turn-on-haskell-font-lock) + +To turn font locking on for the current buffer, call +`turn-on-haskell-font-lock'. To turn font locking off in the current +buffer, call `turn-off-haskell-font-lock'. + +Bird-style literate Haskell scripts are supported: If the value of +`haskell-literate-bird-style' (automatically set by the Haskell mode +of Moss&Thorn) is non-nil, a Bird-style literate script is assumed. + +Invokes `haskell-font-lock-hook' if not nil." + (haskell-font-lock-defaults-create) + (run-hooks 'haskell-font-lock-hook) + (turn-on-font-lock)) + +(defun turn-off-haskell-font-lock () + "Turns off font locking in current buffer." + (font-lock-mode -1)) + +;; Provide ourselves: + +(provide 'haskell-font-lock) + +;; arch-tag: 89fd122e-8378-4c7f-83a3-1f49a64e458d +;;; haskell-font-lock.el ends here diff --git a/emacs.d/haskell/haskell-ghci.el b/emacs.d/haskell/haskell-ghci.el new file mode 100644 index 0000000..087138b --- /dev/null +++ b/emacs.d/haskell/haskell-ghci.el @@ -0,0 +1,332 @@ +;;; haskell-ghci.el --- A GHCi interaction mode + +;; Copyright (C) 2004, 2005, 2006 Free Software Foundation, Inc. +;; Copyright (C) 2001 Chris Webb +;; Copyright (C) 1998, 1999 Guy Lapalme + +;; Keywords: inferior mode, GHCi interaction mode, Haskell + +;;; This file is not part of GNU Emacs. + +;; This file is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 2, or (at your option) +;; any later version. + +;; This file is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs; see the file COPYING. If not, write to the +;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, +;; Boston, MA 02111-1307, USA. + + +;;; Commentary: + +;; Purpose: +;; +;; To send a Haskell buffer to another buffer running a GHCi +;; interpreter. +;; +;; This mode is derived from version 1.1 of Guy Lapalme's +;; haskell-hugs.el, which can be obtained from: +;; +;; http://www.iro.umontreal.ca/~lapalme/Hugs-interaction.html +;; +;; This in turn was adapted from Chris Van Humbeeck's hugs-mode.el, +;; which can be obtained from: +;; +;; http://www-i2.informatik.rwth-aachen.de/Forschung/FP/Haskell/hugs-mode.el +;; +;; +;; Installation: +;; +;; To use with Moss and Thorn's haskell-mode.el +;; +;; http://www.haskell.org/haskell-mode +;; +;; add this to .emacs: +;; +;; (add-hook haskell-mode-hook 'turn-on-haskell-ghci) +;; +;; +;; Customisation: +;; +;; The name of the GHCi interpreter is in haskell-ghci-program-name. +;; +;; Arguments can be sent to the GHCi interpreter when it is started by +;; setting haskell-ghci-program-args (empty by default) to a list of +;; string args to pass it. This value can be set interactively by +;; calling C-c C-s with an argument (i.e. C-u C-c C-s). +;; +;; `haskell-ghci-hook' is invoked in the *ghci* buffer once GHCi is +;; started. +;; +;; All functions/variables start with `turn-{on,off}-haskell-ghci' or +;; `haskell-ghci-'. + +;;; Code: + +(defgroup haskell-ghci nil + "Major mode for interacting with an inferior GHCi session." + :group 'haskell + :prefix "haskell-ghci-") + +(defun turn-on-haskell-ghci () + "Turn on Haskell interaction mode with a GHCi interpreter running in an +another Emacs buffer named *ghci*. +Maps the following commands in the haskell keymap: + \\\\[haskell-ghci-start-process] to create the GHCi buffer and start a GHCi process in it. + \\[haskell-ghci-load-file] to save the current buffer and load it by sending the :load command to GHCi. + \\[haskell-ghci-reload-file] to send the :reload command to GHCi without saving the buffer. + \\[haskell-ghci-show-ghci-buffer] to show the GHCi buffer and go to it." + (local-set-key "\C-c\C-s" 'haskell-ghci-start-process) + (local-set-key "\C-c\C-l" 'haskell-ghci-load-file) + (local-set-key "\C-c\C-r" 'haskell-ghci-reload-file) + (local-set-key "\C-c\C-n" 'haskell-ghci-locate-next-error) + (local-set-key "\C-c\C-b" 'haskell-ghci-show-ghci-buffer)) + +(defun turn-off-haskell-ghci () + "Turn off Haskell interaction mode with a GHCi interpreter within a buffer." + (local-unset-key "\C-c\C-s") + (local-unset-key "\C-c\C-l") + (local-unset-key "\C-c\C-r") + (local-unset-key "\C-c\C-b")) + +(define-derived-mode haskell-ghci-mode comint-mode "Haskell GHCi" + "Major mode for interacting with an inferior GHCi session. + +The commands available from within a Haskell script are: + \\\\[haskell-ghci-start-process] to create the GHCi buffer and start a GHCi process in it. + \\[haskell-ghci-load-file] to save the current buffer and load it by sending the :load command to GHCi. + \\[haskell-ghci-reload-file] to send the :reload command to GHCi without saving the buffer. + \\[haskell-ghci-show-ghci-buffer] to show the GHCi buffer and go to it. + +\\Commands: +\\[comint-send-input] after end of GHCi output sends line as input to GHCi. +\\[comint-send-input] before end of GHCI output copies rest of line and sends it to GHCI as input. +\\[comint-kill-input] and \\[backward-kill-word] are kill commands, imitating normal Unix input editing. +\\[comint-interrupt-subjob] interrupts the comint or its current subjob if any. +\\[comint-stop-subjob] stops, likewise. \\[comint-quit-subjob] sends quit signal.") + + +;; GHCi interface: + +(require 'comint) +(require 'shell) + +(defvar haskell-ghci-process nil + "The active GHCi subprocess corresponding to current buffer.") + +(defvar haskell-ghci-process-buffer nil + "*Buffer used for communication with GHCi subprocess for current buffer.") + +(defcustom haskell-ghci-program-name "ghci" + "*The name of the GHCi interpreter program." + :type 'string + :group 'haskell-ghci) + +(defcustom haskell-ghci-program-args nil + "*A list of string args to pass when starting the GHCi interpreter." + :type '(repeat string) + :group 'haskell-ghci) + +(defvar haskell-ghci-load-end nil + "Position of the end of the last load command.") + +(defvar haskell-ghci-error-pos nil + "Position of the end of the last load command.") + +(defvar haskell-ghci-send-end nil + "Position of the end of the last send command.") + +(defun haskell-ghci-start-process (arg) + "Start a GHCi process and invoke `haskell-ghci-hook' if not nil. +Prompt for a list of args if called with an argument." + (interactive "P") + (if arg + ;; XXX [CDW] Fix to use more natural 'string' version of the + ;; XXX arguments rather than a sexp. + (setq haskell-ghci-program-args + (read-minibuffer (format "List of args for %s:" + haskell-ghci-program-name) + (prin1-to-string haskell-ghci-program-args)))) + + ;; Start the GHCi process in a new comint buffer. + (message "Starting GHCi process `%s'." haskell-ghci-program-name) + (setq haskell-ghci-process-buffer + (apply 'make-comint + "ghci" haskell-ghci-program-name nil + haskell-ghci-program-args)) + (setq haskell-ghci-process + (get-buffer-process haskell-ghci-process-buffer)) + + ;; Select GHCi buffer temporarily. + (set-buffer haskell-ghci-process-buffer) + (haskell-ghci-mode) + (make-local-variable 'shell-cd-regexp) + (make-local-variable 'shell-dirtrackp) + + ;; Track directory changes using the `:cd' command. + (setq shell-cd-regexp ":cd") + (setq shell-dirtrackp t) + (add-hook 'comint-input-filter-functions 'shell-directory-tracker nil 'local) + + ;; GHCi prompt should be of the form `ModuleName> '. + (setq comint-prompt-regexp "^\\*?[A-Z][\\._a-zA-Z0-9]*\\( \\*?[A-Z][\\._a-zA-Z0-9]*\\)*> ") + + ;; History syntax of comint conflicts with Haskell, e.g. !!, so better + ;; turn it off. + (setq comint-input-autoexpand nil) + (run-hooks 'haskell-ghci-hook) + + ;; Clear message area. + (message "")) + +(defun haskell-ghci-wait-for-output () + "Wait until output arrives and go to the last input." + (while (progn + (goto-char comint-last-input-end) + (not (re-search-forward comint-prompt-regexp nil t))) + (accept-process-output haskell-ghci-process))) + +(defun haskell-ghci-send (&rest string) + "Send `haskell-ghci-process' the arguments (one or more strings). +A newline is sent after the strings and they are inserted into the +current buffer after the last output." + (haskell-ghci-wait-for-output) ; wait for prompt + (goto-char (point-max)) ; position for this input + (apply 'insert string) + (comint-send-input) + (setq haskell-ghci-send-end (marker-position comint-last-input-end))) + +(defun haskell-ghci-go (load-command cd) + "Save the current buffer and load its file into the GHCi process. +The first argument LOAD-COMMAND specifies how the file should be +loaded: as a new file (\":load \") or as a reload (\":reload \"). + +If the second argument CD is non-nil, change directory in the GHCi +process to the current buffer's directory before loading the file. + +If the variable `haskell-ghci-command' is set then its value will be +sent to the GHCi process after the load command. This can be used for a +top-level expression to evaluate." + (hack-local-variables) ; in case they've changed + (save-buffer) + (let ((file (if (string-equal load-command ":load ") + (concat "\"" buffer-file-name "\"") + "")) + (dir (expand-file-name default-directory)) + (cmd (and (boundp 'haskell-ghci-command) + haskell-ghci-command + (if (stringp haskell-ghci-command) + haskell-ghci-command + (symbol-name haskell-ghci-command))))) + (if (and haskell-ghci-process-buffer + (eq (process-status haskell-ghci-process) 'run)) + ;; Ensure the GHCi buffer is selected. + (set-buffer haskell-ghci-process-buffer) + ;; Start Haskell-GHCi process. + (haskell-ghci-start-process nil)) + + (if cd (haskell-ghci-send (concat ":cd " dir))) + ;; Wait until output arrives and go to the last input. + (haskell-ghci-wait-for-output) + (haskell-ghci-send load-command file) + ;; Error message search starts from last load command. + (setq haskell-ghci-load-end (marker-position comint-last-input-end)) + (setq haskell-ghci-error-pos haskell-ghci-load-end) + (if cmd (haskell-ghci-send cmd)) + ;; Wait until output arrives and go to the last input. + (haskell-ghci-wait-for-output))) + +(defun haskell-ghci-load-file (cd) + "Save a ghci buffer file and load its file. +If CD (prefix argument if interactive) is non-nil, change directory in +the GHCi process to the current buffer's directory before loading the +file. If there is an error, set the cursor at the error line otherwise +show the *ghci* buffer." + (interactive "P") + (haskell-ghci-gen-load-file ":load " cd)) + +(defun haskell-ghci-reload-file (cd) + "Save a ghci buffer file and load its file. +If CD (prefix argument if interactive) is non-nil, change the GHCi +process to the current buffer's directory before loading the file. +If there is an error, set the cursor at the error line otherwise show +the *ghci* buffer." + (interactive "P") + (haskell-ghci-gen-load-file ":reload " cd)) + +(defun haskell-ghci-gen-load-file (cmd cd) + "Save a ghci buffer file and load its file or reload depending on CMD. +If CD is non-nil, change the process to the current buffer's directory +before loading the file. If there is an error, set the cursor at the +error line otherwise show the *ghci* buffer." + + ;; Execute (re)load command. + (save-excursion (haskell-ghci-go cmd cd)) + + ;; Show *ghci* buffer. + (pop-to-buffer haskell-ghci-process-buffer) + (goto-char haskell-ghci-load-end) + + ;; Did we finish loading without error? + (if (re-search-forward + "^Ok, modules loaded" nil t) + (progn (goto-char (point-max)) + (recenter 2) + (message "There were no errors.")) + + ;; Something went wrong. If possible, be helpful and pinpoint the + ;; first error in the file whilst leaving the error visible in the + ;; *ghci* buffer. + (goto-char haskell-ghci-load-end) + (haskell-ghci-locate-next-error))) + + +(defun haskell-ghci-locate-next-error () + "Go to the next error shown in the *ghci* buffer." + (interactive) + (if (buffer-live-p haskell-ghci-process-buffer) + (progn (pop-to-buffer haskell-ghci-process-buffer) + (goto-char haskell-ghci-error-pos) + (if (re-search-forward + "^[^\/]*\\([^:\n]+\\):\\([0-9]+\\)" nil t) + (let ((efile (buffer-substring (match-beginning 1) + (match-end 1))) + (eline (string-to-int + (buffer-substring (match-beginning 2) + (match-end 2))))) + + (recenter 2) + (setq haskell-ghci-error-pos (point)) + (message "GHCi error on line %d of %s." + eline (file-name-nondirectory efile)) + (if (file-exists-p efile) + (progn (find-file-other-window efile) + (goto-line eline) + (recenter)))) + + ;; We got an error without a file and line number, so put the + ;; point at end of the *ghci* buffer ready to deal with it. + (goto-char (point-max)) + (recenter -2) + (message "No more errors found."))) + (message "No *ghci* buffer found."))) + +(defun haskell-ghci-show-ghci-buffer () + "Go to the *ghci* buffer." + (interactive) + (if (or (not haskell-ghci-process-buffer) + (not (buffer-live-p haskell-ghci-process-buffer))) + (haskell-ghci-start-process nil)) + (pop-to-buffer haskell-ghci-process-buffer)) + +(provide 'haskell-ghci) + +;; arch-tag: f0bade4b-288d-4329-9791-98c1e24167ac +;;; haskell-ghci.el ends here diff --git a/emacs.d/haskell/haskell-hugs.el b/emacs.d/haskell/haskell-hugs.el new file mode 100644 index 0000000..620d21c --- /dev/null +++ b/emacs.d/haskell/haskell-hugs.el @@ -0,0 +1,316 @@ +;;; haskell-hugs.el --- simplistic interaction mode with a + +;; Copyright 2004, 2005, 2006 Free Software Foundation, Inc. +;; Copyright 1998, 1999 Guy Lapalme + +;; Hugs interpreter for Haskell developped by +;; The University of Nottingham and Yale University, 1994-1997. +;; Web: http://www.haskell.org/hugs. +;; In standard Emacs terminology, this would be called +;; inferior-hugs-mode + +;; Keywords: Hugs inferior mode, Hugs interaction mode +;; URL: http://cvs.haskell.org/cgi-bin/cvsweb.cgi/fptools/CONTRIB/haskell-modes/emacs/haskell-hugs.el?rev=HEAD + +;; This file is not part of GNU Emacs. + +;; This file is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 2, or (at your option) +;; any later version. + +;; This file is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs; see the file COPYING. If not, write to the +;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, +;; Boston, MA 02111-1307, USA. + + +;;; Commentary: + +;; Purpose: +;; +;; To send a Haskell buffer to another buffer running a Hugs interpreter +;; The functions are adapted from the Hugs Mode developed by +;; Chris Van Humbeeck +;; which used to be available at: +;; http://www-i2.informatik.rwth-aachen.de/Forschung/FP/Haskell/hugs-mode.el +;; +;; Installation: +;; +;; To use with the Haskell mode of +;; Moss&Thorn +;; add this to .emacs: +;; +;; (add-hook haskell-mode-hook 'turn-on-haskell-hugs) +;; +;; Customisation: +;; The name of the hugs interpreter is in variable +;; haskell-hugs-program-name +;; Arguments can be sent to the Hugs interpreter when it is called +;; by setting the value of the variable +;; haskell-hugs-program-args +;; which by default contains '("+.") so that the progress of the +;; interpreter is visible without any "^H" in the *hugs* Emacs buffer. +;; +;; This value can be interactively by calling C-cC-s with an +;; argument. +;; +;; If the command does not seem to respond, see the +;; content of the `comint-prompt-regexp' variable +;; to check that it waits for the appropriate Hugs prompt +;; the current value is appropriate for Hugs 1.3 and 1.4 +;; +;; +;; `haskell-hugs-hook' is invoked in the *hugs* once it is started. +;; +;;; All functions/variables start with +;;; `(turn-(on/off)-)haskell-hugs' or `haskell-hugs-'. + +(defgroup haskell-hugs nil + "Major mode for interacting with an inferior Hugs session." + :group 'haskell + :prefix "haskell-hugs-") + +(defun turn-on-haskell-hugs () + "Turn on Haskell interaction mode with a Hugs interpreter running in an +another Emacs buffer named *hugs*. +Maps the followind commands in the haskell keymap. + \\[haskell-hugs-load-file] + to save the current buffer and load it by sending the :load command + to Hugs. + \\[haskell-hugs-reload-file] + to send the :reload command to Hugs without saving the buffer. + \\[haskell-hugs-show-hugs-buffer] + to show the Hugs buffer and go to it." + (local-set-key "\C-c\C-s" 'haskell-hugs-start-process) + (local-set-key "\C-c\C-l" 'haskell-hugs-load-file) + (local-set-key "\C-c\C-r" 'haskell-hugs-reload-file) + (local-set-key "\C-c\C-b" 'haskell-hugs-show-hugs-buffer)) + +(defun turn-off-haskell-hugs () + "Turn off Haskell interaction mode with a Hugs interpreter within a buffer." + (local-unset-key "\C-c\C-s") + (local-unset-key "\C-c\C-l") + (local-unset-key "\C-c\C-r") + (local-unset-key "\C-c\C-b")) + +(define-derived-mode haskell-hugs-mode comint-mode "Haskell Hugs" +;; called by haskell-hugs-start-process, +;; itself called by haskell-hugs-load-file +;; only when the file is loaded the first time + "Major mode for interacting with an inferior Hugs session. + +The commands available from within a Haskell script are: + \\\\[haskell-hugs-load-file] + to save the current buffer and load it by sending the :load command + to Hugs. + \\[haskell-hugs-reload-file] + to send the :reload command to Hugs without saving the buffer. + \\[haskell-hugs-show-hugs-buffer] + to show the Hugs buffer and go to it. + +\\ +Commands: +Return at end of buffer sends line as input. +Return not at end copies rest of line to end and sends it. +\\[comint-kill-input] and \\[backward-kill-word] are kill commands, +imitating normal Unix input editing. +\\[comint-interrupt-subjob] interrupts the comint or its current +subjob if any. +\\[comint-stop-subjob] stops, likewise. + \\[comint-quit-subjob] sends quit signal." + ) + +;; Hugs-interface + +(require 'comint) +(require 'shell) + +(defvar haskell-hugs-process nil + "The active Hugs subprocess corresponding to current buffer.") + +(defvar haskell-hugs-process-buffer nil + "*Buffer used for communication with Hugs subprocess for current buffer.") + +(defcustom haskell-hugs-program-name "hugs" + "*The name of the command to start the Hugs interpreter." + :type 'string + :group 'haskell-hugs) + +(defcustom haskell-hugs-program-args '("+.") + "*A list of string args to send to the hugs process." + :type '(repeat string) + :group 'haskell-hugs) + +(defvar haskell-hugs-load-end nil + "Position of the end of the last load command.") + +(defvar haskell-hugs-send-end nil + "Position of the end of the last send command.") + +(defalias 'run-hugs 'haskell-hugs-start-process) + +(defun haskell-hugs-start-process (arg) + "Start a Hugs process and invokes `haskell-hugs-hook' if not nil. +Prompts for a list of args if called with an argument." + (interactive "P") + (message "Starting `hugs-process' %s" haskell-hugs-program-name) + (if arg + (setq haskell-hugs-program-args + (read-minibuffer "List of args for Hugs:" + (prin1-to-string haskell-hugs-program-args)))) + (setq haskell-hugs-process-buffer + (apply 'make-comint + "hugs" haskell-hugs-program-name nil + haskell-hugs-program-args)) + (setq haskell-hugs-process + (get-buffer-process haskell-hugs-process-buffer)) + ;; Select Hugs buffer temporarily + (set-buffer haskell-hugs-process-buffer) + (haskell-hugs-mode) + (make-local-variable 'shell-cd-regexp) + (make-local-variable 'shell-dirtrackp) + (setq shell-cd-regexp ":cd") + (setq shell-dirtrackp t) + (add-hook 'comint-input-filter-functions 'shell-directory-tracker nil 'local) + ; ? or module name in Hugs 1.4 + (setq comint-prompt-regexp "^\? \\|^[A-Z][_a-zA-Z0-9\.]*> ") + ;; comint's history syntax conflicts with Hugs syntax, eg. !! + (setq comint-input-autoexpand nil) + (run-hooks 'haskell-hugs-hook) + (message "") + ) + +(defun haskell-hugs-wait-for-output () + "Wait until output arrives and go to the last input." + (while (progn + (goto-char comint-last-input-end) + (and + (not (re-search-forward comint-prompt-regexp nil t)) + (accept-process-output haskell-hugs-process))))) + +(defun haskell-hugs-send (&rest string) + "Send `haskell-hugs-process' the arguments (one or more strings). +A newline is sent after the strings and they are inserted into the +current buffer after the last output." + ;; Wait until output arrives and go to the last input. + (haskell-hugs-wait-for-output) + ;; Position for this input. + (goto-char (point-max)) + (apply 'insert string) + (comint-send-input) + (setq haskell-hugs-send-end (marker-position comint-last-input-end))) + +(defun haskell-hugs-go (load-command cd) + "Save the current buffer and load its file into the Hugs process. +The first argument LOAD-COMMAND specifies how the file should be +loaded: as a new file (\":load \") or as a reload (\":reload \"). + +If the second argument CD is non-nil, change the Haskell-Hugs process to the +current buffer's directory before loading the file. + +If the variable `haskell-hugs-command' is set then its value will be sent to +the Hugs process after the load command. This can be used for a +top-level expression to evaluate." + (hack-local-variables) ;; In case they've changed + (save-buffer) + (let ((file (if (string-equal load-command ":load ") + (concat "\"" buffer-file-name "\"") + "")) + (dir (expand-file-name default-directory)) + (cmd (and (boundp 'haskell-hugs-command) + haskell-hugs-command + (if (stringp haskell-hugs-command) + haskell-hugs-command + (symbol-name haskell-hugs-command))))) + (if (and haskell-hugs-process-buffer + (eq (process-status haskell-hugs-process) 'run)) + ;; Ensure the Hugs buffer is selected. + (set-buffer haskell-hugs-process-buffer) + ;; Start Haskell-Hugs process. + (haskell-hugs-start-process nil)) + + (if cd (haskell-hugs-send (concat ":cd " dir))) + ;; Wait until output arrives and go to the last input. + (haskell-hugs-wait-for-output) + (haskell-hugs-send load-command file) + ;; Error message search starts from last load command. + (setq haskell-hugs-load-end (marker-position comint-last-input-end)) + (if cmd (haskell-hugs-send cmd)) + ;; Wait until output arrives and go to the last input. + (haskell-hugs-wait-for-output))) + +(defun haskell-hugs-load-file (cd) + "Save a hugs buffer file and load its file. +If CD (prefix argument if interactive) is non-nil, change the Hugs +process to the current buffer's directory before loading the file. +If there is an error, set the cursor at the error line otherwise show +the Hugs buffer." + (interactive "P") + (haskell-hugs-gen-load-file ":load " cd) + ) + +(defun haskell-hugs-reload-file (cd) + "Save a hugs buffer file and load its file. +If CD (prefix argument if interactive) is non-nil, change the Hugs +process to the current buffer's directory before loading the file. +If there is an error, set the cursor at the error line otherwise show +the Hugs buffer." + (interactive "P") + (haskell-hugs-gen-load-file ":reload " cd) + ) + +(defun haskell-hugs-gen-load-file (cmd cd) + "Save a hugs buffer file and load its file or reload depending on CMD. +If CD is non-nil, change the process to the current buffer's directory +before loading the file. If there is an error, set the cursor at the +error line otherwise show the Hugs buffer." + (save-excursion (haskell-hugs-go cmd cd)) + ;; Ensure the Hugs buffer is selected. + (set-buffer haskell-hugs-process-buffer) + ;; Error message search starts from last load command. + (goto-char haskell-hugs-load-end) + (if (re-search-forward + "^ERROR \"\\([^ ]*\\)\"\\( (line \\([0-9]*\\))\\|\\)" nil t) + (let ((efile (buffer-substring (match-beginning 1) + (match-end 1))) + (eline (if (match-beginning 3) + (string-to-int (buffer-substring (match-beginning 3) + (match-end 3))))) + (emesg (buffer-substring (1+ (point)) + (save-excursion (end-of-line) (point))))) + (pop-to-buffer haskell-hugs-process-buffer) ; show *hugs* buffer + (goto-char (point-max)) + (recenter) + (message "Hugs error %s %s" + (file-name-nondirectory efile) emesg) + (if (file-exists-p efile) + (progn (find-file-other-window efile) + (if eline (goto-line eline)) + (recenter))) + ) + (pop-to-buffer haskell-hugs-process-buffer) ; show *hugs* buffer + (goto-char (point-max)) + (message "There were no errors.") + (recenter 2) ; show only the end... + ) + ) + +(defun haskell-hugs-show-hugs-buffer () + "Goes to the Hugs buffer." + (interactive) + (if (or (not haskell-hugs-process-buffer) + (not (buffer-live-p haskell-hugs-process-buffer))) + (haskell-hugs-start-process nil)) + (pop-to-buffer haskell-hugs-process-buffer) + ) + +(provide 'haskell-hugs) + +;; arch-tag: c2a621e9-d743-4361-a459-983fbf1d4589 +;;; haskell-hugs.el ends here diff --git a/emacs.d/haskell/haskell-indent.el b/emacs.d/haskell/haskell-indent.el new file mode 100644 index 0000000..f42ab83 --- /dev/null +++ b/emacs.d/haskell/haskell-indent.el @@ -0,0 +1,1533 @@ +;;; haskell-indent.el --- "semi-intelligent" indentation module for Haskell Mode + +;; Copyright 2004, 2005, 2007 Free Software Foundation, Inc. +;; Copyright 1997-1998 Guy Lapalme + +;; Author: 1997-1998 Guy Lapalme + +;; Keywords: indentation Haskell layout-rule +;; Version: 1.2 +;; URL: http://www.iro.umontreal.ca/~lapalme/layout/index.html + +;;; This file is not part of GNU Emacs. + +;; This file is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 2, or (at your option) +;; any later version. + +;; This file is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs; see the file COPYING. If not, write to the +;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, +;; Boston, MA 02111-1307, USA. + + +;;; Commentary: + +;; Purpose: +;; +;; To support automatic indentation of Haskell programs using +;; the layout rule descrived in section 1.5 and appendix B.3 of the +;; the Haskell report. The rationale and the implementation principles +;; are described in an article to appear in Journal of Functional Programming. +;; "Dynamic tabbing for automatic indentation with the layout rule" +;; +;; It supports literate scripts. +;; Haskell indentation is performed +;; within \begin{code}...\end{code} sections of a literate script +;; and in lines beginning with > with Bird style literate script +;; TAB aligns to the left column outside of these sections. +;; +;; Installation: +;; +;; To turn indentation on for all Haskell buffers under the Haskell +;; mode of Moss&Thorn +;; add this to .emacs: +;; +;; (add-hook haskell-mode-hook 'turn-on-haskell-indent) +;; +;; Otherwise, call `turn-on-haskell-indent'. +;; +;; +;; Customisation: +;; The "standard" offset for statements is 4 spaces. +;; It can be changed by setting the variable "haskell-indent-offset" to +;; another value +;; +;; The default number of blanks after > in a Bird style literate script +;; is 1; it can be changed by setting the variable +;; "haskell-indent-literate-Bird-default-offset" +;; +;; `haskell-indent-hook' is invoked if not nil. +;; +;; All functions/variables start with +;; `(turn-(on/off)-)haskell-indent' or `haskell-indent-'. + +;; This file can also be used as a hook for the Hugs Mode developed by +;; Chris Van Humbeeck +;; It can be obtained at: +;; http://www-i2.informatik.rwth-aachen.de/Forschung/FP/Haskell/hugs-mode.el +;; +;; For the Hugs mode put the following in your .emacs +;; +;;(setq auto-mode-alist (append auto-mode-alist '(("\\.hs\\'" . hugs-mode)))) +;;(autoload 'hugs-mode "hugs-mode" "Go into hugs mode" t) +;; +;; If only the indentation mode is used then replace the two +;; preceding lines with +;;(setq auto-mode-alist (append auto-mode-alist +;; '(("\\.hs\\'" . turn-on-haskell-indent)))) +;;(autoload 'turn-on-haskell-indent "hindent" "Indentation mode for Haskell" t) +;; +;; For indentation in both cases then add the following to your .emacs +;;(add-hook 'hugs-mode-hook 'turn-on-haskell-indent) +;;(autoload 'haskell-indent-cycle "hindent" "Indentation cycle for Haskell" t) +;; + +;;; Code: + +(eval-when-compile (require 'cl)) ;need defs of push and pop +(defvar haskell-literate) + +(defgroup haskell-indent nil + "Haskell indentation." + :group 'haskell + :prefix "haskell-indent-") + +(defcustom haskell-indent-offset 4 + "Indentation of Haskell statements with respect to containing block." + :type 'integer + :group 'haskell-indent) + +(defcustom haskell-indent-literate-Bird-default-offset 1 + "Default number of blanks after > in a Bird style literate script." + :type 'integer + :group 'haskell-indent) + +(defcustom haskell-indent-rhs-align-column 0 + "Column on which to align right-hand sides (use 0 for ad-hoc alignment)." + :type 'integer + :group 'haskell-indent) + +(defun haskell-indent-point-to-col (apoint) + "Return the column number of APOINT." + (save-excursion + (goto-char apoint) + (current-column))) + +(defconst haskell-indent-start-keywords-re + (concat "\\<" + (regexp-opt '("class" "data" "import" "infix" "infixl" "infixr" + "instance" "module" "newtype" "primitive" "type") t) + "\\>") + "Regexp describing keywords to complete when standing at the first word +of a line.") + + +;; Customizations for different kinds of environments +;; in which dealing with low-level events are different. +(defun haskell-indent-mark-active () + (if (featurep 'xemacs) + (if zmacs-regions + zmacs-region-active-p + t) + mark-active)) + +;; for pushing indentation information + +(defvar haskell-indent-info) ;Used with dynamic scoping. + +(defun haskell-indent-push-col (col &optional name) + "Push indentation information for the column COL. +The info is followed by NAME (if present). +Makes sure that the same indentation info is not pushed twice. +Uses free var `haskell-indent-info'." + (let ((tmp (cons col name))) + (if (member tmp haskell-indent-info) + haskell-indent-info + (push tmp haskell-indent-info)))) + +(defun haskell-indent-push-pos (pos &optional name) + "Pushes indentation information for the column corresponding to POS +followed by NAME (if present)." + (haskell-indent-push-col (haskell-indent-point-to-col pos) name)) + +(defun haskell-indent-push-pos-offset (pos &optional offset) + "Pushes indentation information for the column corresponding to POS +followed by an OFFSET (if present use its value otherwise use +`haskell-indent-offset')." + (haskell-indent-push-col (+ (haskell-indent-point-to-col pos) + (or offset haskell-indent-offset)))) + +;; redefinition of some Emacs function for dealing with +;; Bird Style literate scripts + +(defun haskell-indent-bolp () + "`bolp' but dealing with Bird-style literate scripts." + (or (bolp) + (and (eq haskell-literate 'bird) + (<= (current-column) (1+ haskell-indent-literate-Bird-default-offset)) + (eq (char-after (line-beginning-position)) ?\>)))) + +(defun haskell-indent-empty-line-p () + "Checks if the current line is empty; deals with Bird style scripts." + (save-excursion + (beginning-of-line) + (if (and (eq haskell-literate 'bird) + (eq (following-char) ?\>)) + (forward-char 1)) + (looking-at "[ \t]*$"))) + +(defun haskell-indent-back-to-indentation () + "`back-to-indentation' function but dealing with Bird-style literate scripts." + (if (and (eq haskell-literate 'bird) + (progn (beginning-of-line) (eq (following-char) ?\>))) + (progn + (forward-char 1) + (skip-chars-forward " \t")) + (back-to-indentation))) + +(defun haskell-indent-current-indentation () + "`current-indentation' function but dealing with Bird-style literate +scripts." + (if (eq haskell-literate 'bird) + (save-excursion + (haskell-indent-back-to-indentation) + (current-column)) + (current-indentation))) + +(defun haskell-indent-backward-to-indentation (n) + "`backward-to-indentation' function but dealing with Bird-style literate +scripts." + (if (eq haskell-literate 'bird) + (progn + (forward-line (- n)) + (haskell-indent-back-to-indentation)) + (backward-to-indentation n))) + +(defun haskell-indent-forward-line (&optional n) + "`forward-line' function but dealing with Bird-style literate scripts." + (prog1 + (forward-line n) + (if (and (eq haskell-literate 'bird) (eq (following-char) ?\>)) + (progn (forward-char 1) ; skip > and initial blanks... + (skip-chars-forward " \t"))))) + +(defun haskell-indent-line-to (n) + "`indent-line-to' function but dealing with Bird-style literate scripts." + (if (eq haskell-literate 'bird) + (progn + (beginning-of-line) + (if (eq (following-char) ?\>) + (delete-char 1)) + (delete-horizontal-space) ; remove any starting TABs so + (indent-line-to n) ; that indent-line only adds spaces + (save-excursion + (beginning-of-line) + (if (> n 0) (delete-char 1)) ; delete the first space before + (insert ?\>))) ; inserting a > + (indent-line-to n))) + +(defun haskell-indent-skip-blanks-and-newlines-forward (end) + "Skips forward blanks, tabs and newlines until END taking +account of Bird style literate scripts." + (skip-chars-forward " \t\n" end) + (if (eq haskell-literate 'bird) + (while (and (bolp) (eq (following-char) ?\>)) + (forward-char 1) ; skip > + (skip-chars-forward " \t\n" end)))) + +(defun haskell-indent-skip-blanks-and-newlines-backward (start) + "Skips backward blanks, tabs and newlines upto START +taking account of Bird style literate scripts." + (skip-chars-backward " \t\n" start) + (if (eq haskell-literate 'bird) + (while (and (eq (current-column) 1) + (eq (preceding-char) ?\>)) + (forward-char -1) ; skip back > + (skip-chars-backward " \t\n" start)))) + +;; specific functions for literate code + +(defun haskell-indent-within-literate-code () + "Checks if point is within a part of literate Haskell code and if so +returns its start otherwise returns NIL: +If it is Bird Style, then returns the position of the > +otherwise returns the ending position \\begin{code}." + (save-excursion + (case haskell-literate + (bird + (beginning-of-line) + (if (or (eq (following-char) ?\>) + (and (bolp) (forward-line -1) (eq (following-char) ?\>))) + (progn + (while (and (zerop (forward-line -1)) + (eq (following-char) ?\>))) + (if (not (eq (following-char) ?\>)) + (forward-line)) + (point)))) + ;; Look for a \begin{code} or \end{code} line. + (latex + (if (re-search-backward + "^\\(\\\\begin{code}$\\)\\|\\(\\\\end{code}$\\)" nil t) + ;; within a literate code part if it was a \\begin{code}. + (match-end 1))) + (t (error "haskell-indent-within-literate-code: should not happen!"))))) + +(defun haskell-indent-put-region-in-literate (beg end &optional arg) + "Put lines of the region as a piece of literate code. +With C-u prefix arg, remove indication that the region is literate code. +It deals with both Bird style and non Bird-style scripts." + (interactive "r\nP") + (unless haskell-literate + (error "Cannot put a region in literate in a non literate script")) + (if (eq haskell-literate 'bird) + (let ((comment-start "> ") ; Change dynamic bindings for + (comment-start-skip "^> ?") ; comment-region. + (comment-end "") + (comment-end-skip "\n") + (comment-style 'plain)) + (comment-region beg end arg)) + ;; Not Bird style. + (if arg ; Remove the literate indication. + (save-excursion + (goto-char end) ; Remove end. + (if (re-search-backward "^\\\\end{code}[ \t\n]*\\=" + (line-beginning-position -2) t) + (delete-region (point) (line-beginning-position 2))) + (goto-char beg) ; Remove end. + (beginning-of-line) + (if (looking-at "\\\\begin{code}") + (kill-line 1))) + (save-excursion ; Add the literate indication. + (goto-char end) + (unless (bolp) (newline)) + (insert "\\end{code}\n") + (goto-char beg) + (unless (bolp) (newline)) + (insert "\\begin{code}\n"))))) + + ;;; Start of indentation code + +(defcustom haskell-indent-look-past-empty-line t + "If nil, indentation engine will not look past an empty line for layout points." + :type 'boolean) + +(defun haskell-indent-start-of-def () + "Return the position of the start of a definition. +The start of a def is expected to be recognizable by starting in column 0, +unless `haskell-indent-look-past-empty-line' is nil, in which case we +take a coarser approximation and stop at the first empty line." + (save-excursion + (let ((start-code (and haskell-literate + (haskell-indent-within-literate-code))) + (top-col (if (eq haskell-literate 'bird) 2 0)) + (save-point (point))) + ;; determine the starting point of the current piece of code + (setq start-code (if start-code (1+ start-code) (point-min))) + ;; go backward until the first preceding empty line + (haskell-indent-forward-line -1) + (while (and (if haskell-indent-look-past-empty-line + (or (> (haskell-indent-current-indentation) top-col) + (haskell-indent-empty-line-p)) + (and (> (haskell-indent-current-indentation) top-col) + (not (haskell-indent-empty-line-p)))) + (> (point) start-code) + (= 0 (haskell-indent-forward-line -1)))) + ;; go forward after the empty line + (if (haskell-indent-empty-line-p) + (haskell-indent-forward-line 1)) + (setq start-code (point)) + ;; find the first line of code which is not a comment + (forward-comment (point-max)) + (if (> (point) save-point) + start-code + (point))))) + +(defun haskell-indent-open-structure (start end) + "If any structure (list or tuple) is not closed, between START and END, +returns the location of the opening symbol, nil otherwise." + (save-excursion + (nth 1 (parse-partial-sexp start end)))) + +(defun haskell-indent-in-string (start end) + "If a string is not closed , between START and END, returns the +location of the opening symbol, nil otherwise." + (save-excursion + (let ((pps (parse-partial-sexp start end))) + (if (nth 3 pps) (nth 8 pps))))) + +(defun haskell-indent-in-comment (start end) + "Check, starting from START, if END is at or within a comment. +Returns the location of the start of the comment, nil otherwise." + (let (pps) + (assert (<= start end)) + (cond ((= start end) nil) + ((nth 4 (save-excursion (setq pps (parse-partial-sexp start end)))) + (nth 8 pps)) + ;; We also want to say that we are *at* the beginning of a comment. + ((and (not (nth 8 pps)) + (>= (point-max) (+ end 2)) + (nth 4 (save-excursion + (setq pps (parse-partial-sexp end (+ end 2)))))) + (nth 8 pps))))) + +(defvar haskell-indent-off-side-keywords-re + "\\<\\(do\\|let\\|of\\|where\\)\\>[ \t]*") + +(defun haskell-indent-type-at-point () + "Return the type of the line (also puts information in `match-data')." + (cond + ((haskell-indent-empty-line-p) 'empty) + ((haskell-indent-in-comment (point-min) (point)) 'comment) + ((looking-at "\\(\\([a-zA-Z]\\(\\sw\\|'\\)*\\)\\|_\\)[ \t\n]*") 'ident) + ((looking-at "\\(|[^|]\\)[ \t\n]*") 'guard) + ((looking-at "\\(=[^>=]\\|::\\|->\\|<-\\)[ \t\n]*") 'rhs) + (t 'other))) + +(defvar haskell-indent-current-line-first-ident "" + "Global variable that keeps track of the first ident of the line to indent.") + + +(defun haskell-indent-contour-line (start end) + "Generate contour information between START and END points." + (if (< start end) + (save-excursion + (goto-char end) + (haskell-indent-skip-blanks-and-newlines-backward start) + (let ((cur-col (current-column)) ; maximum column number + (fl 0) ; number of lines that forward-line could not advance + contour) + (while (and (> cur-col 0) (= fl 0) (>= (point) start)) + (haskell-indent-back-to-indentation) + (if (< (point) start) (goto-char start)) + (and (not (member (haskell-indent-type-at-point) + '(empty comment))) ; skip empty and comment lines + (< (current-column) cur-col) ; less indented column found + (push (point) contour) ; new contour point found + (setq cur-col (current-column))) + (setq fl (haskell-indent-forward-line -1))) + contour)))) + +(defun haskell-indent-next-symbol (end) + "Puts point to the next following symbol." + (skip-syntax-forward ")" end) + (if (< (point) end) + (progn + (forward-sexp 1) + (haskell-indent-skip-blanks-and-newlines-forward end)))) + +(defun haskell-indent-separate-valdef (start end) + "Returns a list of positions for important parts of a valdef." + (save-excursion + (let (valname valname-string aft-valname + guard aft-guard + rhs-sign aft-rhs-sign + type) + ;; "parse" a valdef separating important parts + (goto-char start) + (setq type (haskell-indent-type-at-point)) + (if (or (memq type '(ident other))) ; possible start of a value def + (progn + (if (eq type 'ident) + (progn + (setq valname (match-beginning 0)) + (setq valname-string (match-string 0)) + (goto-char (match-end 0))) + (skip-chars-forward " \t" end) + (setq valname (point)) ; type = other + (haskell-indent-next-symbol end)) + (while (and (< (point) end) + (setq type (haskell-indent-type-at-point)) + (or (memq type '(ident other)))) + (if (null aft-valname) + (setq aft-valname (point))) + (haskell-indent-next-symbol end)))) + (if (and (< (point) end) (eq type 'guard)) ; start of a guard + (progn + (setq guard (match-beginning 0)) + (goto-char (match-end 0)) + (while (and (< (point) end) + (setq type (haskell-indent-type-at-point)) + (not (eq type 'rhs))) + (if (null aft-guard) + (setq aft-guard (point))) + (haskell-indent-next-symbol end)))) + (if (and (< (point) end) (eq type 'rhs)) ; start of a rhs + (progn + (setq rhs-sign (match-beginning 0)) + (goto-char (match-end 0)) + (if (< (point) end) + (setq aft-rhs-sign (point))))) + (list valname valname-string aft-valname + guard aft-guard rhs-sign aft-rhs-sign)))) + +(defsubst haskell-indent-no-otherwise (guard) + "Check if there is no otherwise at GUARD." + (save-excursion + (goto-char guard) + (not (looking-at "|[ \t]*otherwise\\>")))) + + +(defun haskell-indent-guard (start end end-visible indent-info) + "Finds indentation information for a line starting with a guard." + (save-excursion + (let* ((haskell-indent-info indent-info) + (sep (haskell-indent-separate-valdef start end)) + (valname (nth 0 sep)) + (guard (nth 3 sep)) + (rhs-sign (nth 5 sep))) + ;; push information indentation for the visible part + (if (and guard (< guard end-visible) (haskell-indent-no-otherwise guard)) + (haskell-indent-push-pos guard) + (if rhs-sign + (haskell-indent-push-pos rhs-sign) ; probably within a data definition... + (if valname + (haskell-indent-push-pos-offset valname)))) + haskell-indent-info))) + +(defun haskell-indent-rhs (start end end-visible indent-info) + "Finds indentation information for a line starting with a rhs." + (save-excursion + (let* ((haskell-indent-info indent-info) + (sep (haskell-indent-separate-valdef start end)) + (valname (nth 0 sep)) + (guard (nth 3 sep)) + (rhs-sign (nth 5 sep))) + ;; push information indentation for the visible part + (if (and rhs-sign (< rhs-sign end-visible)) + (haskell-indent-push-pos rhs-sign) + (if (and guard (< guard end-visible)) + (haskell-indent-push-pos-offset guard) + (if valname ; always visible !! + (haskell-indent-push-pos-offset valname)))) + haskell-indent-info))) + +(defconst haskell-indent-decision-table + (let ((or "\\)\\|\\(")) + (concat "\\(" + "1.1.11" or ; 1= vn gd rh arh + "1.1.10" or ; 2= vn gd rh + "1.1100" or ; 3= vn gd agd + "1.1000" or ; 4= vn gd + "1.0011" or ; 5= vn rh arh + "1.0010" or ; 6= vn rh + "110000" or ; 7= vn avn + "100000" or ; 8= vn + "001.11" or ; 9= gd rh arh + "001.10" or ;10= gd rh + "001100" or ;11= gd agd + "001000" or ;12= gd + "000011" or ;13= rh arh + "000010" or ;14= rh + "000000" ;15= + "\\)"))) + +(defun haskell-indent-find-case (test) + "Find the index that matches in the decision table." + (if (string-match haskell-indent-decision-table test) + ;; use the fact that the resulting match-data is a list of the form + ;; (0 6 [2*(n-1) nil] 0 6) where n is the number of the matching regexp + ;; so n= ((length match-data)/2)-1 + (- (/ (length (match-data 'integers)) 2) 1) + (error "haskell-indent-find-case: impossible case: %s" test))) + +(defun haskell-indent-empty (start end end-visible indent-info) + "Finds indentation points for an empty line." + (save-excursion + (let* ((haskell-indent-info indent-info) + (sep (haskell-indent-separate-valdef start end)) + (valname (pop sep)) + (valname-string (pop sep)) + (aft-valname (pop sep)) + (guard (pop sep)) + (aft-guard (pop sep)) + (rhs-sign (pop sep)) + (aft-rhs-sign (pop sep)) + (last-line (= end end-visible)) + (test (string + (if valname ?1 ?0) + (if (and aft-valname (< aft-valname end-visible)) ?1 ?0) + (if (and guard (< guard end-visible)) ?1 ?0) + (if (and aft-guard (< aft-guard end-visible)) ?1 ?0) + (if (and rhs-sign (< rhs-sign end-visible)) ?1 ?0) + (if (and aft-rhs-sign (< aft-rhs-sign end-visible)) ?1 ?0)))) + (if (and valname-string ; special case for start keywords + (string-match haskell-indent-start-keywords-re valname-string)) + (progn + (haskell-indent-push-pos valname) + ;; very special for data keyword + (if (string-match "\\" valname-string) + (if rhs-sign (haskell-indent-push-pos rhs-sign) + (haskell-indent-push-pos-offset valname)) + (haskell-indent-push-pos-offset valname))) + (case ; general case + (haskell-indent-find-case test) + ;; "1.1.11" 1= vn gd rh arh + (1 (haskell-indent-push-pos valname) + (haskell-indent-push-pos valname valname-string) + (if (haskell-indent-no-otherwise guard) (haskell-indent-push-pos guard "| ")) + (haskell-indent-push-pos aft-rhs-sign)) + ;; "1.1.10" 2= vn gd rh + (2 (haskell-indent-push-pos valname) + (haskell-indent-push-pos valname valname-string) + (if last-line + (haskell-indent-push-pos-offset guard) + (if (haskell-indent-no-otherwise guard) (haskell-indent-push-pos guard "| ")))) + ;; "1.1100" 3= vn gd agd + (3 (haskell-indent-push-pos valname) + (haskell-indent-push-pos aft-guard) + (if last-line (haskell-indent-push-pos-offset valname))) + ;; "1.1000" 4= vn gd + (4 (haskell-indent-push-pos valname) + (if last-line (haskell-indent-push-pos-offset guard 2))) + ;; "1.0011" 5= vn rh arh + (5 (haskell-indent-push-pos valname) + (if (or (and aft-valname (= (char-after rhs-sign) ?\=)) + (= (char-after rhs-sign) ?\:)) + (haskell-indent-push-pos valname valname-string)) + (haskell-indent-push-pos aft-rhs-sign)) + ;; "1.0010" 6= vn rh + (6 (haskell-indent-push-pos valname) + (haskell-indent-push-pos valname valname-string) + (if last-line (haskell-indent-push-pos-offset valname))) + ;; "110000" 7= vn avn + (7 (haskell-indent-push-pos valname) + (if last-line + (haskell-indent-push-pos aft-valname) + (haskell-indent-push-pos valname valname-string))) + ;; "100000" 8= vn + (8 (haskell-indent-push-pos valname)) + ;; "001.11" 9= gd rh arh + (9 (if (haskell-indent-no-otherwise guard) (haskell-indent-push-pos guard "| ")) + (haskell-indent-push-pos aft-rhs-sign)) + ;; "001.10" 10= gd rh + (10 (if (haskell-indent-no-otherwise guard) (haskell-indent-push-pos guard "| ")) + (if last-line (haskell-indent-push-pos-offset guard))) + ;; "001100" 11= gd agd + (11 (if (haskell-indent-no-otherwise guard) (haskell-indent-push-pos guard "| ")) + (haskell-indent-push-pos aft-guard)) + ;; "001000" 12= gd + (12 (if (haskell-indent-no-otherwise guard) (haskell-indent-push-pos guard "| ")) + (if last-line (haskell-indent-push-pos-offset guard 2))) + ;; "000011" 13= rh arh + (13 (haskell-indent-push-pos aft-rhs-sign)) + ;; "000010" 14= rh + (14 (if last-line (haskell-indent-push-pos-offset rhs-sign 2 ))) + ;; "000000" 15= + (t (error "haskell-indent-empty: %s impossible case" test )))) + haskell-indent-info))) + +(defun haskell-indent-ident (start end end-visible indent-info) + "Finds indentation points for a line starting with an identifier." + (save-excursion + (let* + ((haskell-indent-info indent-info) + (sep (haskell-indent-separate-valdef start end)) + (valname (pop sep)) + (valname-string (pop sep)) + (aft-valname (pop sep)) + (guard (pop sep)) + (aft-guard (pop sep)) + (rhs-sign (pop sep)) + (aft-rhs-sign (pop sep)) + (last-line (= end end-visible)) + (is-where + (string-match "where[ \t]*" haskell-indent-current-line-first-ident)) + (diff-first ; not a function def with the same name + (not(string= valname-string haskell-indent-current-line-first-ident))) + ;; (is-type-def + ;; (and rhs-sign (eq (char-after rhs-sign) ?\:))) + (test (string + (if valname ?1 ?0) + (if (and aft-valname (< aft-valname end-visible)) ?1 ?0) + (if (and guard (< guard end-visible)) ?1 ?0) + (if (and aft-guard (< aft-guard end-visible)) ?1 ?0) + (if (and rhs-sign (< rhs-sign end-visible)) ?1 ?0) + (if (and aft-rhs-sign (< aft-rhs-sign end-visible)) ?1 ?0)))) + (if (and valname-string ; special case for start keywords + (string-match haskell-indent-start-keywords-re valname-string)) + (progn + (haskell-indent-push-pos valname) + (if (string-match "\\" valname-string) + ;; very special for data keyword + (if aft-rhs-sign (haskell-indent-push-pos aft-rhs-sign) + (haskell-indent-push-pos-offset valname)) + (if (not (string-match + haskell-indent-start-keywords-re + haskell-indent-current-line-first-ident)) + (haskell-indent-push-pos-offset valname)))) + (if (string= haskell-indent-current-line-first-ident "::") + (if valname (haskell-indent-push-pos valname)) + (case ; general case + (haskell-indent-find-case test) + ;; "1.1.11" 1= vn gd rh arh + (1 (if is-where + (haskell-indent-push-pos guard) + (haskell-indent-push-pos valname) + (if diff-first (haskell-indent-push-pos aft-rhs-sign)))) + ;; "1.1.10" 2= vn gd rh + (2 (if is-where + (haskell-indent-push-pos guard) + (haskell-indent-push-pos valname) + (if last-line + (haskell-indent-push-pos-offset guard)))) + ;; "1.1100" 3= vn gd agd + (3 (if is-where + (haskell-indent-push-pos-offset guard) + (haskell-indent-push-pos valname) + (if diff-first + (haskell-indent-push-pos aft-guard)))) + ;; "1.1000" 4= vn gd + (4 (if is-where + (haskell-indent-push-pos guard) + (haskell-indent-push-pos valname) + (if last-line + (haskell-indent-push-pos-offset guard 2)))) + ;; "1.0011" 5= vn rh arh + (5 (if is-where + (haskell-indent-push-pos-offset valname) + (haskell-indent-push-pos valname) + (if diff-first + (haskell-indent-push-pos aft-rhs-sign)))) + ;; "1.0010" 6= vn rh + (6 (if is-where + (haskell-indent-push-pos-offset valname) + (haskell-indent-push-pos valname) + (if last-line + (haskell-indent-push-pos-offset valname)))) + ;; "110000" 7= vn avn + (7 (if is-where + (haskell-indent-push-pos-offset valname) + (haskell-indent-push-pos valname) + (if last-line + (haskell-indent-push-pos aft-valname)))) + ;; "100000" 8= vn + (8 (if is-where + (haskell-indent-push-pos-offset valname) + (haskell-indent-push-pos valname))) + ;; "001.11" 9= gd rh arh + (9 (if is-where + (haskell-indent-push-pos guard) + (haskell-indent-push-pos aft-rhs-sign))) + ;; "001.10" 10= gd rh + (10 (if is-where + (haskell-indent-push-pos guard) + (if last-line + (haskell-indent-push-pos-offset guard)))) + ;; "001100" 11= gd agd + (11 (if is-where + (haskell-indent-push-pos guard) + (if (haskell-indent-no-otherwise guard) + (haskell-indent-push-pos aft-guard)))) + ;; "001000" 12= gd + (12 (if last-line (haskell-indent-push-pos-offset guard 2))) + ;; "000011" 13= rh arh + (13 (haskell-indent-push-pos aft-rhs-sign)) + ;; "000010" 14= rh + (14 (if last-line (haskell-indent-push-pos-offset rhs-sign 2))) + ;; "000000" 15= + (t (error "haskell-indent-ident: %s impossible case" test ))))) + haskell-indent-info))) + +(defun haskell-indent-other (start end end-visible indent-info) + "Finds indentation points for a non-empty line starting with something other +than an identifier, a guard or rhs." + (save-excursion + (let* ((haskell-indent-info indent-info) + (sep (haskell-indent-separate-valdef start end)) + (valname (pop sep)) + (valname-string (pop sep)) + (aft-valname (pop sep)) + (guard (pop sep)) + (aft-guard (pop sep)) + (rhs-sign (pop sep)) + (aft-rhs-sign (pop sep)) + (last-line (= end end-visible)) + (test (string + (if valname ?1 ?0) + (if (and aft-valname (< aft-valname end-visible)) ?1 ?0) + (if (and guard (< guard end-visible)) ?1 ?0) + (if (and aft-guard (< aft-guard end-visible)) ?1 ?0) + (if (and rhs-sign (< rhs-sign end-visible)) ?1 ?0) + (if (and aft-rhs-sign (< aft-rhs-sign end-visible)) ?1 ?0)))) + (if (and valname-string ; special case for start keywords + (string-match haskell-indent-start-keywords-re valname-string)) + (haskell-indent-push-pos-offset valname) + (case ; general case + (haskell-indent-find-case test) + ;; "1.1.11" 1= vn gd rh arh + (1 (haskell-indent-push-pos aft-rhs-sign)) + ;; "1.1.10" 2= vn gd rh + (2 (if last-line + (haskell-indent-push-pos-offset guard) + (haskell-indent-push-pos-offset rhs-sign 2))) + ;; "1.1100" 3= vn gd agd + (3 (haskell-indent-push-pos aft-guard)) + ;; "1.1000" 4= vn gd + (4 (haskell-indent-push-pos-offset guard 2)) + ;; "1.0011" 5= vn rh arh + (5 (haskell-indent-push-pos valname) + (haskell-indent-push-pos aft-rhs-sign)) + ;; "1.0010" 6= vn rh + (6 (if last-line + (haskell-indent-push-pos-offset valname) + (haskell-indent-push-pos-offset rhs-sign 2))) + ;; "110000" 7= vn avn + (7 (haskell-indent-push-pos-offset aft-valname)) + ;; "100000" 8= vn + (8 (haskell-indent-push-pos valname)) + ;; "001.11" 9= gd rh arh + (9 (haskell-indent-push-pos aft-rhs-sign)) + ;; "001.10" 10= gd rh + (10 (if last-line + (haskell-indent-push-pos-offset guard) + (haskell-indent-push-pos-offset rhs-sign 2))) + ;; "001100" 11= gd agd + (11 (if (haskell-indent-no-otherwise guard) + (haskell-indent-push-pos aft-guard))) + ;; "001000" 12= gd + (12 (if last-line (haskell-indent-push-pos-offset guard 2))) + ;; "000011" 13= rh arh + (13 (haskell-indent-push-pos aft-rhs-sign)) + ;; "000010" 14= rh + (14 (if last-line (haskell-indent-push-pos-offset rhs-sign 2))) + ;; "000000" 15= + (t (error "haskell-indent-other: %s impossible case" test )))) + haskell-indent-info))) + +(defun haskell-indent-valdef-indentation (start end end-visible curr-line-type + indent-info) + "Find indentation information for a value definition." + (let ((haskell-indent-info indent-info)) + (if (< start end-visible) + (case curr-line-type + (empty (haskell-indent-empty start end end-visible indent-info)) + (ident (haskell-indent-ident start end end-visible indent-info)) + (guard (haskell-indent-guard start end end-visible indent-info)) + (rhs (haskell-indent-rhs start end end-visible indent-info)) + (comment (error "Comment indent should never happen")) + (other (haskell-indent-other start end end-visible indent-info))) + haskell-indent-info))) + +(defun haskell-indent-line-indentation (line-start line-end end-visible + curr-line-type indent-info) + "Compute indentation info between LINE-START and END-VISIBLE. +Separate a line of program into valdefs between offside keywords +and find indentation info for each part." + (save-excursion + ;; point is (already) at line-start + (assert (eq (point) line-start)) + (let ((haskell-indent-info indent-info) + (start (or (haskell-indent-in-comment line-start line-end) + (haskell-indent-in-string line-start line-end)))) + (if start ; if comment at the end + (setq line-end start)) ; end line before it + ;; loop on all parts separated by off-side-keywords + (while (and (re-search-forward haskell-indent-off-side-keywords-re + line-end t) + (not (or (haskell-indent-in-comment line-start (point)) + (haskell-indent-in-string line-start (point))))) + (let ((beg-match (match-beginning 0)) ; save beginning of match + (end-match (match-end 0))) ; save end of match + ;; Do not try to find indentation points if off-side-keyword at + ;; the start... + (if (or (< line-start beg-match) + ;; Actually, if we're looking at a "let" inside a "do", we + ;; should add the corresponding indentation point. + (eq (char-after beg-match) ?l)) + (setq haskell-indent-info + (haskell-indent-valdef-indentation line-start beg-match + end-visible + curr-line-type + haskell-indent-info))) + ;; ...but keep the start of the line if keyword alone on the line + (if (= line-end end-match) + (haskell-indent-push-pos beg-match)) + (setq line-start end-match) + (goto-char line-start))) + (haskell-indent-valdef-indentation line-start line-end end-visible + curr-line-type haskell-indent-info)))) + + +(defun haskell-indent-layout-indent-info (start contour-line) + (let ((haskell-indent-info nil) + (curr-line-type (haskell-indent-type-at-point)) + line-start line-end end-visible) + (save-excursion + (if (eq curr-line-type 'ident) + (let ; guess the type of line + ((sep + (haskell-indent-separate-valdef + (point) (line-end-position)))) + ;; if the first ident is where or the start of a def + ;; keep it in a global variable + (setq haskell-indent-current-line-first-ident + (if (string-match "where[ \t]*" (nth 1 sep)) + (nth 1 sep) + (if (nth 5 sep) ; is there a rhs-sign + (if (= (char-after (nth 5 sep)) ?\:) ;is it a typdef + "::" (nth 1 sep)) + ""))))) + (while contour-line ; explore the contour points + (setq line-start (pop contour-line)) + (goto-char line-start) + (setq line-end (line-end-position)) + (setq end-visible ; visible until the column of the + (if contour-line ; next contour point + (save-excursion + (move-to-column + (haskell-indent-point-to-col (car contour-line))) + (point)) + line-end)) + (unless (or (haskell-indent-open-structure start line-start) + (haskell-indent-in-comment start line-start)) + (setq haskell-indent-info + (haskell-indent-line-indentation line-start line-end + end-visible curr-line-type + haskell-indent-info))))) + haskell-indent-info)) + +(defun haskell-indent-find-matching-start (regexp limit &optional pred start) + (let ((open (haskell-indent-open-structure limit (point)))) + (if open (setq limit (1+ open)))) + (unless start (setq start (point))) + (when (re-search-backward regexp limit t) + (let ((nestedcase (match-end 1)) + (outer (or (haskell-indent-in-string limit (point)) + (haskell-indent-in-comment limit (point)) + (haskell-indent-open-structure limit (point)) + (if (and pred (funcall pred start)) (point))))) + (cond + (outer + (goto-char outer) + (haskell-indent-find-matching-start regexp limit pred start)) + (nestedcase + ;; Nested case. + (and (haskell-indent-find-matching-start regexp limit pred) + (haskell-indent-find-matching-start regexp limit pred start))) + (t (point)))))) + +(defun haskell-indent-filter-let-no-in (start) + "Return non-nil if point is in front of a `let' that has no `in'. +START is the position of the presumed `in'." + ;; We're looking at either `in' or `let'. + (when (looking-at "let") + (ignore-errors + (save-excursion + (forward-word 1) + (forward-comment (point-max)) + (if (looking-at "{") + (progn + (forward-sexp 1) + (forward-comment (point-max)) + (< (point) start)) + ;; Use the layout rule to see whether this let is already closed + ;; without an `in'. + (let ((col (current-column))) + (while (progn (forward-line 1) (haskell-indent-back-to-indentation) + (< (point) start)) + (when (< (current-column) col) + (setq col nil) + (goto-char start))) + (null col))))))) + +(defun haskell-indent-comment (open start) + "Compute indent info for comments and text inside comments. +OPEN is the start position of the comment in which point is." + ;; Ideally we'd want to guess whether it's commented out code or + ;; whether it's text. Instead, we'll assume it's text. + (save-excursion + (if (= open (point)) + ;; We're actually just in front of a comment: align with following + ;; code or with comment on previous line. + (let ((prev-line-info + (cond + ((eq (char-after) ?\{) nil) ;Align as if it were code. + ((and (forward-comment -1) + (> (line-beginning-position 3) open)) + ;; We're after another comment and there's no empty line + ;; between us. + (list (list (haskell-indent-point-to-col (point))))) + (t nil)))) ;Else align as if it were code + ;; Align with following code. + (forward-comment (point-max)) + ;; There are several possible indentation points for this code-line, + ;; but the only valid indentation point for the comment is the one + ;; that the user will select for the code-line. Obviously we can't + ;; know that, so we just assume that the code-line is already at its + ;; proper place. + ;; Strictly speaking "assume it's at its proper place" would mean + ;; we'd just use (current-column), but since this is using info from + ;; lines further down and it's common to reindent line-by-line, + ;; we'll align not with the current indentation, but with the + ;; one that auto-indentation "will" select. + (append + prev-line-info + (let ((indent-info (save-excursion + (haskell-indent-indentation-info start))) + (col (current-column))) + ;; Sort the indent-info so that the current indentation comes + ;; out first. + (setq indent-info + (sort indent-info + (lambda (x y) + (<= (abs (- col (car x))) (abs (- col (car y))))))) + indent-info))) + + ;; We really are inside a comment. + (if (looking-at "-}") + (progn + (forward-char 2) + (forward-comment -1) + (list (list (1+ (haskell-indent-point-to-col (point)))))) + (let ((offset (if (looking-at "--?") + (- (match-beginning 0) (match-end 0))))) + (forward-line -1) ;Go to previous line. + (haskell-indent-back-to-indentation) + (if (< (point) start) (goto-char start)) + + (list (list (if (looking-at comment-start-skip) + (if offset + (+ 2 offset (haskell-indent-point-to-col (point))) + (haskell-indent-point-to-col (match-end 0))) + (haskell-indent-point-to-col (point)))))))))) + +(defun haskell-indent-closing-keyword (start) + (let ((open (save-excursion + (haskell-indent-find-matching-start + (case (char-after) + (?i "\\<\\(?:\\(in\\)\\|let\\)\\>") + (?o "\\<\\(?:\\(of\\)\\|case\\)\\>") + (?t "\\<\\(?:\\(then\\)\\|if\\)\\>") + (?e "\\<\\(?:\\(else\\)\\|if\\)\\>")) + start + (if (eq (char-after) ?i) + ;; Filter out the `let's that have no `in'. + 'haskell-indent-filter-let-no-in))))) + ;; For a "hanging let/case/if at EOL" we should use a different + ;; indentation scheme. + (save-excursion + (goto-char open) + (if (haskell-indent-hanging-p) + (setq open (haskell-indent-virtual-indentation start)))) + (list (list (haskell-indent-point-to-col open))))) + +(defcustom haskell-indent-after-keywords + '(("where" 2 0) + ("of" 2) + ("do" 2) + ("in" 2 0) + ("{" 2) + "if" + "then" + "else" + "let") + "Keywords after which indentation should be indented by some offset. +Each keyword info can have the following forms: + + KEYWORD | (KEYWORD OFFSET [OFFSET-HANGING]) + +If absent OFFSET-HANGING defaults to OFFSET. +If absent OFFSET defaults to `haskell-indent-offset'. + +OFFSET-HANGING is the offset to use in the case where the keyword +is at the end of an otherwise-non-empty line." + :type '(repeat (choice string + (cons :tag "" (string :tag "keyword:") + (cons :tag "" (integer :tag "offset") + (choice (const nil) + (list :tag "" + (integer :tag "offset-pending")))))))) + +(defun haskell-indent-skip-lexeme-forward () + (and (zerop (skip-syntax-forward "w")) + (skip-syntax-forward "_") + (skip-syntax-forward "(") + (skip-syntax-forward ")"))) + +(defvar haskell-indent-inhibit-after-offset nil) + +(defun haskell-indent-offset-after-info () + "Return the info from `haskell-indent-after-keywords' for keyword at point." + (let ((id (buffer-substring + (point) + (save-excursion + (haskell-indent-skip-lexeme-forward) + (point))))) + (or (assoc id haskell-indent-after-keywords) + (car (member id haskell-indent-after-keywords))))) + +(defcustom haskell-indent-dont-hang '("(") + "Lexemes that should never be considered as hanging." + :type '(repeat string)) + +(defun haskell-indent-hanging-p () + ;; A Hanging keyword is one that's at the end of a line except it's not at + ;; the beginning of a line. + (not (or (= (current-column) (haskell-indent-current-indentation)) + (save-excursion + (let ((lexeme + (buffer-substring + (point) + (progn (haskell-indent-skip-lexeme-forward) (point))))) + (or (member lexeme haskell-indent-dont-hang) + (> (line-end-position) + (progn (forward-comment (point-max)) (point))))))))) + +(defun haskell-indent-after-keyword-column (offset-info start &optional default) + (unless offset-info + (setq offset-info (haskell-indent-offset-after-info))) + (unless default (setq default haskell-indent-offset)) + (setq offset-info + (if haskell-indent-inhibit-after-offset '(0) (cdr-safe offset-info))) + (if (not (haskell-indent-hanging-p)) + (+ (current-column) (or (car offset-info) default)) + ;; The keyword is hanging at the end of the line. + (+ (haskell-indent-virtual-indentation start) + (or (cadr offset-info) (car offset-info) default)))) + +(defun haskell-indent-inside-paren (open) + ;; there is an open structure to complete + (if (looking-at "\\s)\\|[;,]") + ;; A close-paren or a , or ; can only correspond syntactically to + ;; the open-paren at `open'. So there is no ambiguity. + (progn + (if (or (and (eq (char-after) ?\;) (eq (char-after open) ?\()) + (and (eq (char-after) ?\,) (eq (char-after open) ?\{))) + (message "Mismatched punctuation: `%c' in %c...%c" + (char-after) (char-after open) + (if (eq (char-after open) ?\() ?\) ?\}))) + (save-excursion + (goto-char open) + (list (list + (if (haskell-indent-hanging-p) + (haskell-indent-virtual-indentation nil) + (haskell-indent-point-to-col open)))))) + ;; There might still be layout within the open structure. + (let* ((end (point)) + (basic-indent-info + ;; Anything else than a ) is subject to layout. + (if (looking-at "\\s.\\|\\$ ") + (haskell-indent-point-to-col open) ; align a punct with ( + (let ((follow (save-excursion + (goto-char (1+ open)) + (haskell-indent-skip-blanks-and-newlines-forward end) + (point)))) + (if (= follow end) + (save-excursion + (goto-char open) + (haskell-indent-after-keyword-column nil nil 1)) + (haskell-indent-point-to-col follow))))) + (open-column (haskell-indent-point-to-col open)) + (contour-line (haskell-indent-contour-line (1+ open) end))) + (if (null contour-line) + (list (list basic-indent-info)) + (let ((indent-info + (haskell-indent-layout-indent-info + (1+ open) contour-line))) + ;; Fix up indent info. + (let ((base-elem (assoc open-column indent-info))) + (if base-elem + (progn (setcar base-elem basic-indent-info) + (setcdr base-elem nil)) + (setq indent-info + (append indent-info (list (list basic-indent-info))))) + indent-info)))))) + +(defun haskell-indent-virtual-indentation (start) + "Compute the \"virtual indentation\" of text at point. +The \"virtual indentation\" is the indentation that text at point would have +had, if it had been placed on its own line." + (let ((col (current-column)) + (haskell-indent-inhibit-after-offset (haskell-indent-hanging-p))) + (if (save-excursion (skip-chars-backward " \t") (bolp)) + ;; If the text is indeed on its own line, than the virtual indent is + ;; the current indentation. + col + ;; Else, compute the indentation that it would have had. + (let ((info (haskell-indent-indentation-info start)) + (max -1)) + ;; `info' is a list of possible indent points. Each indent point is + ;; assumed to correspond to a different parse. So we need to find + ;; the parse that corresponds to the case at hand (where there's no + ;; line break), which is assumed to always be the + ;; deepest indentation. + (dolist (x info) + (setq x (car x)) + ;; Sometimes `info' includes the current indentation (or yet + ;; deeper) by mistake, because haskell-indent-indentation-info + ;; wasn't designed to be called on a piece of text that is not at + ;; BOL. So ignore points past `col'. + (if (and (> x max) (not (>= x col))) + (setq max x))) + ;; In case all the indent points are past `col', just use `col'. + (if (>= max 0) max col))))) + +(defun haskell-indent-indentation-info (&optional start) + "Return a list of possible indentations for the current line. +These are then used by `haskell-indent-cycle'. +START if non-nil is a presumed start pos of the current definition." + (unless start (setq start (haskell-indent-start-of-def))) + (let (open contour-line) + (cond + ;; in string? + ((setq open (haskell-indent-in-string start (point))) + (list (list (+ (haskell-indent-point-to-col open) + (if (looking-at "\\\\") 0 1))))) + + ;; in comment ? + ((setq open (haskell-indent-in-comment start (point))) + (haskell-indent-comment open start)) + + ;; Closing the declaration part of a `let' or the test exp part of a case. + ((looking-at "\\(?:in\\|of\\|then\\|else\\)\\>") + (haskell-indent-closing-keyword start)) + + ;; Right after a special keyword. + ((save-excursion + (forward-comment (- (point-max))) + (when (and (not (zerop (skip-syntax-backward "w"))) + (setq open (haskell-indent-offset-after-info))) + (list (list (haskell-indent-after-keyword-column open start)))))) + + ;; open structure? ie ( { [ + ((setq open (haskell-indent-open-structure start (point))) + (haskell-indent-inside-paren open)) + + ;; full indentation + ((setq contour-line (haskell-indent-contour-line start (point))) + (haskell-indent-layout-indent-info start contour-line)) + + (t + ;; simple contour just one indentation at start + (list (list (if (and (eq haskell-literate 'bird) + (eq (haskell-indent-point-to-col start) 1)) + ;; for a Bird style literate script put default offset + ;; in the case of no indentation + (1+ haskell-indent-literate-Bird-default-offset) + (haskell-indent-point-to-col start)))))))) + +(defvar haskell-indent-last-info nil) + + +(defun haskell-indent-cycle () + "Indentation cycle. +We stay in the cycle as long as the TAB key is pressed." + (interactive "*") + (if (and haskell-literate + (not (haskell-indent-within-literate-code))) + ;; use the ordinary tab for text... + (funcall (default-value 'indent-line-function)) + (let ((marker (if (> (current-column) (haskell-indent-current-indentation)) + (point-marker))) + (bol (progn (beginning-of-line) (point)))) + (haskell-indent-back-to-indentation) + (unless (and (eq last-command this-command) + (eq bol (car haskell-indent-last-info))) + (save-excursion + (setq haskell-indent-last-info + (list bol (haskell-indent-indentation-info) 0 0)))) + + (let* ((il (nth 1 haskell-indent-last-info)) + (index (nth 2 haskell-indent-last-info)) + (last-insert-length (nth 3 haskell-indent-last-info)) + (indent-info (nth index il))) + + (haskell-indent-line-to (car indent-info)) ; insert indentation + (delete-char last-insert-length) + (setq last-insert-length 0) + (let ((text (cdr indent-info))) + (if text + (progn + (insert text) + (setq last-insert-length (length text))))) + + (setq haskell-indent-last-info + (list bol il (% (1+ index) (length il)) last-insert-length)) + + (if (= (length il) 1) + (message "Sole indentation") + (message "Indent cycle (%d)..." (length il))) + + (if marker + (goto-char (marker-position marker))))))) + +;;; alignment functions + +(defun haskell-indent-shift-columns (dest-column region-stack) + "Shifts columns in region-stack to go to DEST-COLUMN. +Elements of the stack are pairs of points giving the start and end +of the regions to move." + (let (reg col diffcol reg-end) + (while (setq reg (pop region-stack)) + (setq reg-end (copy-marker (cdr reg))) + (goto-char (car reg)) + (setq col (current-column)) + (setq diffcol (- dest-column col)) + (if (not (zerop diffcol)) + (catch 'end-of-buffer + (while (<= (point) (marker-position reg-end)) + (if (< diffcol 0) + (backward-delete-char-untabify (- diffcol) nil) + (insert-char ?\ diffcol)) + (end-of-line 2) ; should be (forward-line 1) + (if (eobp) ; but it adds line at the end... + (throw 'end-of-buffer nil)) + (move-to-column col))))))) + +(defun haskell-indent-align-def (p-arg type) + "Align guards or rhs within the current definition before point. +If P-ARG is t align all defs up to the mark. +TYPE is either 'guard or 'rhs." + (save-excursion + (let (start-block end-block + (maxcol (if (eq type 'rhs) haskell-indent-rhs-align-column 0)) + contour sep defname defnamepos + defcol pos lastpos + regstack eqns-start start-found) + ;; find the starting and ending boundary points for alignment + (if p-arg + (if (mark) ; aligning everything in the region + (progn + (when (> (mark) (point)) (exchange-point-and-mark)) + (setq start-block + (save-excursion + (goto-char (mark)) + (line-beginning-position))) + (setq end-block + (progn (if (haskell-indent-bolp) + (haskell-indent-forward-line -1)) + (line-end-position)))) + (error "The mark is not set for aligning definitions")) + ;; aligning the current definition + (setq start-block (haskell-indent-start-of-def)) + (setq end-block (line-end-position))) + ;; find the start of the current valdef using the contour line + ;; in reverse order because we need the nearest one from the end + (setq contour + (reverse (haskell-indent-contour-line start-block end-block))) + (setq pos (car contour)) ; keep the start of the first contour + ;; find the nearest start of a definition + (while (and (not defname) contour) + (goto-char (pop contour)) + (if (haskell-indent-open-structure start-block (point)) + nil + (setq sep (haskell-indent-separate-valdef (point) end-block)) + (if (nth 5 sep) ; is there a rhs? + (progn (setq defnamepos (nth 0 sep)) + (setq defname (nth 1 sep)))))) + ;; start building the region stack + (if defnamepos + (progn ; there is a valdef + ;; find the start of each equation or guard + (if p-arg ; when indenting a region + ;; accept any start of id or pattern as def name + (setq defname "\\<\\|(")) + (setq defcol (haskell-indent-point-to-col defnamepos)) + (goto-char pos) + (setq end-block (line-end-position)) + (catch 'top-of-buffer + (while (and (not start-found) + (>= (point) start-block)) + (if (<= (haskell-indent-current-indentation) defcol) + (progn + (move-to-column defcol) + (if (and (looking-at defname) ; start of equation + (not (haskell-indent-open-structure start-block (point)))) + (push (cons (point) 'eqn) eqns-start) + ;; found a less indented point not starting an equation + (setq start-found t))) + ;; more indented line + (haskell-indent-back-to-indentation) + (if (and (eq (haskell-indent-type-at-point) 'guard) ; start of a guard + (not (haskell-indent-open-structure start-block (point)))) + (push (cons (point) 'gd) eqns-start))) + (if (bobp) + (throw 'top-of-buffer nil) + (haskell-indent-backward-to-indentation 1)))) + ;; remove the spurious guards before the first equation + (while (and eqns-start (eq (cdar eqns-start) 'gd)) + (pop eqns-start)) + ;; go through each equation to find the region to indent + (while eqns-start + (let ((eqn (caar eqns-start))) + (setq lastpos (if (cdr eqns-start) + (save-excursion + (goto-char (caadr eqns-start)) + (haskell-indent-forward-line -1) + (line-end-position)) + end-block)) + (setq sep (haskell-indent-separate-valdef eqn lastpos))) + (if (eq type 'guard) + (setq pos (nth 3 sep)) + ;; check if what follows a rhs sign is more indented or not + (let ((rhs (nth 5 sep)) + (aft-rhs (nth 6 sep))) + (if (and rhs aft-rhs + (> (haskell-indent-point-to-col rhs) + (haskell-indent-point-to-col aft-rhs))) + (setq pos aft-rhs) + (setq pos rhs)))) + (if pos + (progn ; update region stack + (push (cons pos (or lastpos pos)) regstack) + (setq maxcol ; find the highest column number + (max maxcol + (progn ;find the previous non-empty column + (goto-char pos) + (skip-chars-backward + " \t" + (line-beginning-position)) + (if (haskell-indent-bolp) + ;;if on an empty prefix + (haskell-indent-point-to-col pos) ;keep original indent + (1+ (haskell-indent-point-to-col (point))))))))) + (pop eqns-start)) + ;; now shift according to the region stack + (if regstack + (haskell-indent-shift-columns maxcol regstack))))))) + +(defun haskell-indent-align-guards-and-rhs (start end) + "Align the guards and rhs of functions in the region which must be active." + ;; The `start' and `end' args are dummys right now: they're just there so + ;; we can use the "r" interactive spec which properly signals an error. + (interactive "*r") + (haskell-indent-align-def t 'guard) + (haskell-indent-align-def t 'rhs)) + +;;; insertion functions + +(defun haskell-indent-insert-equal () + "Insert an = sign and align the previous rhs of the current function." + (interactive "*") + (if (or (haskell-indent-bolp) + (/= (preceding-char) ?\ )) + (insert ?\ )) + (insert "= ") + (haskell-indent-align-def (haskell-indent-mark-active) 'rhs)) + +(defun haskell-indent-insert-guard (&optional text) + "Insert and align a guard sign (|) followed by optional TEXT. +Alignment works only if all guards are to the south-east of their |." + (interactive "*") + (let ((pc (if (haskell-indent-bolp) ?\012 + (preceding-char))) + (pc1 (or (char-after (- (point) 2)) 0))) + ;; check what guard to insert depending on the previous context + (if (= pc ?\ ) ; x = any char other than blank or | + (if (/= pc1 ?\|) + (insert "| ") ; after " x" + ()) ; after " |" + (if (= pc ?\|) + (if (= pc1 ?\|) + (insert " | ") ; after "||" + (insert " ")) ; after "x|" + (insert " | "))) ; general case + (if text (insert text)) + (haskell-indent-align-def (haskell-indent-mark-active) 'guard))) + +(defun haskell-indent-insert-otherwise () + "Insert a guard sign (|) followed by 'otherwise' and align the +previous guards of the current function." + (interactive "*") + (haskell-indent-insert-guard "otherwise") + (haskell-indent-insert-equal)) + +(defun haskell-indent-insert-where () + "Insert and a where keyword at point and indent the resulting +line with an indentation cycle." + (interactive "*") + (insert "where ") + (haskell-indent-cycle)) + + +;;; haskell-indent-mode + +(defvar haskell-indent-mode nil + "Indicates if the semi-intelligent Haskell indentation mode is in effect +in the current buffer.") +(make-variable-buffer-local 'haskell-indent-mode) + +(defun turn-on-haskell-indent () + "Turn on ``intelligent'' haskell indentation mode." + (set (make-local-variable 'indent-line-function) 'haskell-indent-cycle) + ;; Removed: remapping DEL seems a bit naughty --SDM + ;; (local-set-key "\177" 'backward-delete-char-untabify) + ;; The binding to TAB is already handled by indent-line-function. --Stef + ;; (local-set-key "\t" 'haskell-indent-cycle) + (local-set-key [?\C-c ?\C-=] 'haskell-indent-insert-equal) + (local-set-key [?\C-c ?\C-|] 'haskell-indent-insert-guard) + (local-set-key [?\C-c ?\C-o] 'haskell-indent-insert-otherwise) + (local-set-key [?\C-c ?\C-w] 'haskell-indent-insert-where) + (local-set-key [?\C-c ?\C-.] 'haskell-indent-align-guards-and-rhs) + (local-set-key [?\C-c ?\C->] 'haskell-indent-put-region-in-literate) + (setq haskell-indent-mode t) + (run-hooks 'haskell-indent-hook)) + +(defun turn-off-haskell-indent () + "Turn off ``intelligent'' haskell indentation mode that deals with +the layout rule of Haskell." + (kill-local-variable 'indent-line-function) + ;; (local-unset-key "\t") + ;; (local-unset-key "\177") + (local-unset-key [?\C-c ?\C-=]) + (local-unset-key [?\C-c ?\C-|]) + (local-unset-key [?\C-c ?\C-o]) + (local-unset-key [?\C-c ?\C-w]) + (local-unset-key [?\C-c ?\C-.]) + (local-unset-key [?\C-c ?\C->]) + (setq haskell-indent-mode nil)) + +;; Put this minor mode on the global minor-mode-alist. +(or (assq 'haskell-indent-mode (default-value 'minor-mode-alist)) + (setq-default minor-mode-alist + (append (default-value 'minor-mode-alist) + '((haskell-indent-mode " Ind"))))) + +;;;###autoload +(defun haskell-indent-mode (&optional arg) + "``intelligent'' Haskell indentation mode that deals with +the layout rule of Haskell. \\[haskell-indent-cycle] starts the cycle +which proposes new possibilities as long as the TAB key is pressed. +Any other key or mouse click terminates the cycle and is interpreted +except for RET which merely exits the cycle. +Other special keys are: + \\[haskell-indent-insert-equal] + inserts an = + \\[haskell-indent-insert-guard] + inserts an | + \\[haskell-indent-insert-otherwise] + inserts an | otherwise = +these functions also align the guards and rhs of the current definition + \\[haskell-indent-insert-where] + inserts a where keyword + \\[haskell-indent-align-guards-and-rhs] + aligns the guards and rhs of the region + \\[haskell-indent-put-region-in-literate] + makes the region a piece of literate code in a literate script + +Note: \\[indent-region] which applies \\[haskell-indent-cycle] for each line +of the region also works but it stops and asks for any line having more +than one possible indentation. +Use TAB to cycle until the right indentation is found and then RET to go the +next line to indent. + +Invokes `haskell-indent-hook' if not nil." + (interactive "P") + (setq haskell-indent-mode + (if (null arg) (not haskell-indent-mode) + (> (prefix-numeric-value arg) 0))) + (if haskell-indent-mode + (turn-on-haskell-indent) + (turn-off-haskell-indent))) + +(provide 'haskell-indent) + +;; arch-tag: e4e5e90a-12e2-4002-b5cb-7b2375710013 +;;; haskell-indent.el ends here diff --git a/emacs.d/haskell/haskell-mode.el b/emacs.d/haskell/haskell-mode.el new file mode 100644 index 0000000..5f634dc --- /dev/null +++ b/emacs.d/haskell/haskell-mode.el @@ -0,0 +1,483 @@ +;;; haskell-mode.el --- A Haskell editing mode -*-coding: iso-8859-1;-*- + +;; Copyright (C) 2003, 2004, 2005, 2006, 2007 Free Software Foundation, Inc +;; Copyright (C) 1992, 1997-1998 Simon Marlow, Graeme E Moss, and Tommy Thorn + +;; Authors: 1992 Simon Marlow +;; 1997-1998 Graeme E Moss and +;; Tommy Thorn , +;; 2001-2002 Reuben Thomas (>=v1.4) +;; 2003 Dave Love +;; Keywords: faces files Haskell +;; Version: v2_3 +;; URL: http://www.haskell.org/haskell-mode/ + +;; This file is not part of GNU Emacs. + +;; This file is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 2, or (at your option) +;; any later version. + +;; This file is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs; see the file COPYING. If not, write to the +;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, +;; Boston, MA 02111-1307, USA. + + +;;; Commentary: + +;; Purpose: +;; +;; To provide a pleasant mode to browse and edit Haskell files, linking +;; into the following supported modules: +;; +;; `haskell-font-lock', Graeme E Moss and Tommy Thorn +;; Fontifies standard Haskell keywords, symbols, functions, etc. +;; +;; `haskell-decl-scan', Graeme E Moss +;; Scans top-level declarations, and places them in a menu. +;; +;; `haskell-doc', Hans-Wolfgang Loidl +;; Echoes types of functions or syntax of keywords when the cursor is idle. +;; +;; `haskell-indent', Guy Lapalme +;; Intelligent semi-automatic indentation. +;; +;; `haskell-simple-indent', Graeme E Moss and Heribert Schuetz +;; Simple indentation. +;; +;; `inf-haskell' +;; Interaction with an inferior Haskell process. +;; It replaces the previous two modules: +;; `haskell-hugs', Guy Lapalme +;; `haskell-ghci', Chris Web +;; +;; +;; This mode supports full Haskell 1.4 including literate scripts. +;; In some versions of (X)Emacs it may only support Latin-1, not Unicode. +;; +;; Installation: +;; +;; Put in your ~/.emacs: +;; +;; (setq auto-mode-alist +;; (append auto-mode-alist +;; '(("\\.[hg]s$" . haskell-mode) +;; ("\\.hi$" . haskell-mode) +;; ("\\.l[hg]s$" . literate-haskell-mode)))) +;; +;; (autoload 'haskell-mode "haskell-mode" +;; "Major mode for editing Haskell scripts." t) +;; (autoload 'literate-haskell-mode "haskell-mode" +;; "Major mode for editing literate Haskell scripts." t) +;; +;; with `haskell-mode.el' accessible somewhere on the load-path. +;; To add a directory `~/lib/emacs' (for example) to the load-path, +;; add the following to .emacs: +;; +;; (setq load-path (cons "~/lib/emacs" load-path)) +;; +;; To turn any of the supported modules on for all buffers, add the +;; appropriate line(s) to .emacs: +;; +;; (add-hook 'haskell-mode-hook 'turn-on-haskell-decl-scan) +;; (add-hook 'haskell-mode-hook 'turn-on-haskell-doc-mode) +;; (add-hook 'haskell-mode-hook 'turn-on-haskell-indent) +;; (add-hook 'haskell-mode-hook 'turn-on-haskell-simple-indent) +;; +;; Make sure the module files are also on the load-path. Note that +;; the two indentation modules are mutually exclusive: Use only one. +;; +;; +;; Customisation: +;; +;; Set the value of `haskell-literate-default' to your preferred +;; literate style: 'bird or 'latex, within .emacs as follows: +;; +;; (setq haskell-literate-default 'latex) +;; +;; Also see the customisations of the modules. +;; +;; +;; History: +;; +;; This mode is based on an editing mode by Simon Marlow 11/1/92 +;; and heavily modified by Graeme E Moss and Tommy Thorn 7/11/98. +;; +;; If you have any problems or suggestions specific to a supported +;; module, consult that module for a list of known bugs, and an +;; author to contact via email. For general problems or suggestions, +;; consult the list below, then email gem@cs.york.ac.uk and +;; thorn@irisa.fr quoting the version of the mode you are using, the +;; version of Emacs you are using, and a small example of the problem +;; or suggestion. +;; +;; Version 1.43: +;; Various tweaks to doc strings and customization support from +;; Ville Skyttä . +;; +;; Version 1.42: +;; Added autoload for GHCi inferior mode (thanks to Scott +;; Williams for the bug report and fix). +;; +;; Version 1.41: +;; Improved packaging, and made a couple more variables +;; interactively settable. +;; +;; Version 1.4: +;; Added GHCi mode from Chris Webb, and tidied up a little. +;; +;; Version 1.3: +;; The literate or non-literate style of a buffer is now indicated +;; by just the variable haskell-literate: nil, 'bird, or 'latex. +;; For literate buffers with ambiguous style, the value of +;; haskell-literate-default is used. +;; +;; Version 1.2: +;; Separated off font locking, declaration scanning and simple +;; indentation, and made them separate modules. Modules can be +;; added easily now. Support for modules haskell-doc, +;; haskell-indent, and haskell-hugs. Literate and non-literate +;; modes integrated into one mode, and literate buffer indicated by +;; value of haskell-literate(-bird-style). +;; +;; Version 1.1: +;; Added support for declaration scanning under XEmacs via +;; func-menu. Moved operators to level two fontification. +;; +;; Version 1.0: +;; Added a nice indention support from Heribert Schuetz +;; : +;; +;; I have just hacked an Emacs Lisp function which you might prefer +;; to `indent-relative' in haskell-mode.el. See below. It is not +;; really Haskell-specific because it does not take into account +;; keywords like `do', `of', and `let' (where the layout rule +;; applies), but I already find it useful. +;; +;; Cleaned up the imenu support. Added support for literate scripts. +;; +;; Version 0.103 [HWL]: +;; From Hans Wolfgang Loidl : +;; +;; I (HWL) added imenu support by copying the appropriate functions +;; from hugs-mode. A menu-bar item "Declarations" is now added in +;; haskell mode. The new code, however, needs some clean-up. +;; +;; Version 0.102: +;; +;; Moved C-c C-c key binding to comment-region. Leave M-g M-g to do +;; the work. comment-start-skip is changed to comply with comment-start. +;; +;; Version 0.101: +;; +;; Altered indent-line-function to indent-relative. +;; +;; Version 0.100: +;; +;; First official release. + +;; Present Limitations/Future Work (contributions are most welcome!): +;; +;; . Would like RET in Bird-style literate mode to add a ">" at the +;; start of a line when previous line starts with ">". Or would +;; "> " be better? +;; +;; . Support for GreenCard? +;; + +;;; Code: + +(eval-when-compile (require 'cl)) + +;; All functions/variables start with `(literate-)haskell-'. + +;; Version of mode. +(defconst haskell-version "v2_3" + "`haskell-mode' version number.") +(defun haskell-version () + "Echo the current version of `haskell-mode' in the minibuffer." + (interactive) + (message "Using haskell-mode version %s" haskell-version)) + +(defgroup haskell nil + "Major mode for editing Haskell programs." + :group 'languages + :prefix "haskell-") + +;; Set up autoloads for the modules we supply +(autoload 'turn-on-haskell-decl-scan "haskell-decl-scan" + "Turn on Haskell declaration scanning." t) +(autoload 'turn-on-haskell-doc-mode "haskell-doc" + "Turn on Haskell Doc minor mode." t) +(autoload 'turn-on-haskell-indent "haskell-indent" + "Turn on Haskell indentation." t) +(autoload 'turn-on-haskell-simple-indent "haskell-simple-indent" + "Turn on simple Haskell indentation." t) + +;; Functionality provided in other files. +(autoload 'haskell-ds-create-imenu-index "haskell-decl-scan") +(autoload 'haskell-font-lock-choose-keywords "haskell-font-lock") +(autoload 'haskell-doc-current-info "haskell-doc") + +;; Obsolete functions. +(defun turn-on-haskell-font-lock () + (turn-on-font-lock) + (message "turn-on-haskell-font-lock is obsolete. Use turn-on-font-lock instead.")) +(defun turn-on-haskell-hugs () + (message "haskell-hugs is obsolete.") + (load "haskell-hugs") + (turn-on-haskell-hugs)) +(defun turn-on-haskell-ghci () + (message "haskell-ghci is obsolete.") + (load "haskell-ghci") + (turn-on-haskell-ghci)) + + +;; Are we looking at a literate script? +(defvar haskell-literate nil + "*If not nil, the current buffer contains a literate Haskell script. +Possible values are: `bird' and `latex', for Bird-style and LaTeX-style +literate scripts respectively. Set by `haskell-mode' and +`literate-haskell-mode'. For an ambiguous literate buffer -- ie. does +not contain either \"\\begin{code}\" or \"\\end{code}\" on a line on +its own, nor does it contain \">\" at the start of a line -- the value +of `haskell-literate-default' is used. + +Always buffer-local.") +(make-variable-buffer-local 'haskell-literate) +;; Default literate style for ambiguous literate buffers. +(defcustom haskell-literate-default 'bird + "*Default value for `haskell-literate'. +Used if the style of a literate buffer is ambiguous. This variable should +be set to the preferred literate style." + :type '(choice (const bird) (const latex) (const nil))) + +;; Mode maps. +(defvar haskell-mode-map + (let ((map (make-sparse-keymap))) + ;; Bindings for the inferior haskell process: + ;; (define-key map [?\M-C-x] 'inferior-haskell-send-defun) + ;; (define-key map [?\C-x ?\C-e] 'inferior-haskell-send-last-sexp) + ;; (define-key map [?\C-c ?\C-r] 'inferior-haskell-send-region) + (define-key map [?\C-c ?\C-z] 'switch-to-haskell) + (define-key map [?\C-c ?\C-l] 'inferior-haskell-load-file) + ;; Non standard in other inferior-modes, but traditional in haskell. + (define-key map [?\C-c ?\C-r] 'inferior-haskell-reload-file) + (define-key map [?\C-c ?\C-b] 'switch-to-haskell) + ;; (define-key map [?\C-c ?\C-s] 'inferior-haskell-start-process) + ;; That's what M-; is for. + ;; (define-key map "\C-c\C-c" 'comment-region) + + (define-key map (kbd "C-c C-t") 'inferior-haskell-type) + (define-key map (kbd "C-c C-i") 'inferior-haskell-info) + (define-key map (kbd "C-c M-.") 'inferior-haskell-find-definition) + map) + "Keymap used in Haskell mode.") + +(easy-menu-define haskell-mode-menu haskell-mode-map + "Menu for the Haskell major mode." + ;; Suggestions from Pupeno : + ;; - choose the underlying interpreter + ;; - look up docs + `("Haskell" + ["Indent line" indent-according-to-mode] + ["Indent region" indent-region mark-active] + ["(Un)Comment region" comment-region mark-active] + "---" + ["Start interpreter" switch-to-haskell] + ["Load file" inferior-haskell-load-file] + "---" + ,(if (default-boundp 'eldoc-documentation-function) + ["Doc mode" eldoc-mode + :style toggle :selected (bound-and-true-p eldoc-mode)] + ["Doc mode" haskell-doc-mode + :style toggle :selected (and (boundp 'haskell-doc-mode) haskell-doc-mode)]) + ["Customize" (customize-group 'haskell)] + )) + +;; Syntax table. +(defvar haskell-mode-syntax-table + (let ((table (make-syntax-table))) + (modify-syntax-entry ?\ " " table) + (modify-syntax-entry ?\t " " table) + (modify-syntax-entry ?\" "\"" table) + (modify-syntax-entry ?\' "\'" table) + (modify-syntax-entry ?_ "w" table) + (modify-syntax-entry ?\( "()" table) + (modify-syntax-entry ?\) ")(" table) + (modify-syntax-entry ?\[ "(]" table) + (modify-syntax-entry ?\] ")[" table) + + (cond ((featurep 'xemacs) + ;; I don't know whether this is equivalent to the below + ;; (modulo nesting). -- fx + (modify-syntax-entry ?{ "(}5" table) + (modify-syntax-entry ?} "){8" table) + (modify-syntax-entry ?- "_ 1267" table)) + (t + ;; In Emacs 21, the `n' indicates that they nest. + ;; The `b' annotation is actually ignored because it's only + ;; meaningful on the second char of a comment-starter, so + ;; on Emacs 20 and before we get wrong results. --Stef + (modify-syntax-entry ?\{ "(}1nb" table) + (modify-syntax-entry ?\} "){4nb" table) + (modify-syntax-entry ?- "_ 123" table))) + (modify-syntax-entry ?\n ">" table) + + (let (i lim) + (map-char-table + (lambda (k v) + (when (equal v '(1)) + ;; The current Emacs 22 codebase can pass either a char + ;; or a char range. + (if (consp k) + (setq i (car k) + lim (cdr k)) + (setq i k + lim k)) + (while (<= i lim) + (when (> i 127) + (modify-syntax-entry i "_" table)) + (setq i (1+ i))))) + (standard-syntax-table))) + + (modify-syntax-entry ?\` "$`" table) + (modify-syntax-entry ?\\ "\\" table) + (mapcar (lambda (x) + (modify-syntax-entry x "_" table)) + ;; Some of these are actually OK by default. + "!#$%&*+./:<=>?@^|~") + (unless (featurep 'mule) + ;; Non-ASCII syntax should be OK, at least in Emacs. + (mapcar (lambda (x) + (modify-syntax-entry x "_" table)) + (concat "¡¢£¤¥¦§¨©ª«¬­®¯°±²³´µ¶·¸¹º»¼½¾¿" + "×÷")) + (mapcar (lambda (x) + (modify-syntax-entry x "w" table)) + (concat "ÀÁÂÃÄÅÆÇÈÉÊËÌÍÎÏÐÑÒÓÔÕÖ" + "ØÙÚÛÜÝÞß" + "àáâãäåæçèéêëìíîïðñòóôõö" + "øùúûüýþÿ"))) + table) + "Syntax table used in Haskell mode.") + +(defun haskell-ident-at-point () + "Return the identifier under point, or nil if none found." + (save-excursion + (if (looking-at "\\s_") + (buffer-substring-no-properties + (progn (skip-syntax-backward "_") (point)) + (progn (skip-syntax-forward "_") (point))) + (buffer-substring-no-properties + (progn (skip-syntax-backward "w'") (skip-syntax-forward "'") (point)) + (progn (skip-syntax-forward "w'") (point)))))) + +;; Various mode variables. + +(defcustom haskell-mode-hook nil + "Hook run after entering Haskell mode." + :type 'hook + :options '(turn-on-haskell-indent turn-on-font-lock turn-on-eldoc-mode + imenu-add-menubar-index)) + +(defvar eldoc-print-current-symbol-info-function) + +;; The main mode functions +;;;###autoload +(define-derived-mode haskell-mode fundamental-mode "Haskell" + "Major mode for editing Haskell programs. Last adapted for Haskell 1.4. +Blank lines separate paragraphs, comments start with `-- '. + +\\\\[indent-for-comment] will place a comment at an appropriate place on the current line. +\\[comment-region] comments (or with prefix arg, uncomments) each line in the region. + +Literate scripts are supported via `literate-haskell-mode'. The +variable `haskell-literate' indicates the style of the script in the +current buffer. See the documentation on this variable for more +details. + +Modules can hook in via `haskell-mode-hook'. The following modules +are supported with an `autoload' command: + + `haskell-decl-scan', Graeme E Moss + Scans top-level declarations, and places them in a menu. + + `haskell-doc', Hans-Wolfgang Loidl + Echoes types of functions or syntax of keywords when the cursor is idle. + + `haskell-indent', Guy Lapalme + Intelligent semi-automatic indentation. + + `haskell-simple-indent', Graeme E Moss and Heribert Schuetz + Simple indentation. + +Module X is activated using the command `turn-on-X'. For example, +`haskell-font-lock' is activated using `turn-on-haskell-font-lock'. +For more information on a module, see the help for its `turn-on-X' +function. Some modules can be deactivated using `turn-off-X'. (Note +that `haskell-doc' is irregular in using `turn-(on/off)-haskell-doc-mode'.) + +Use `haskell-version' to find out what version this is. + +Invokes `haskell-mode-hook' if not nil." + (set (make-local-variable 'paragraph-start) (concat "^$\\|" page-delimiter)) + (set (make-local-variable 'paragraph-separate) paragraph-start) + (set (make-local-variable 'comment-start) "-- ") + (set (make-local-variable 'comment-padding) 0) + (set (make-local-variable 'comment-start-skip) "[-{]-[ \t]*") + (set (make-local-variable 'comment-end) "") + (set (make-local-variable 'comment-end-skip) "[ \t]*\\(-}\\|\\s>\\)") + (set (make-local-variable 'parse-sexp-ignore-comments) t) + ;; Set things up for eldoc-mode. + (set (make-local-variable 'eldoc-documentation-function) + 'haskell-doc-current-info) + ;; Set things up for imenu. + (set (make-local-variable 'imenu-create-index-function) + 'haskell-ds-create-imenu-index) + ;; Set things up for font-lock. + (set (make-local-variable 'font-lock-defaults) + '(haskell-font-lock-choose-keywords + nil nil ((?\' . "w") (?_ . "w")) nil + (font-lock-syntactic-keywords + . haskell-font-lock-choose-syntactic-keywords) + (font-lock-syntactic-face-function + . haskell-syntactic-face-function) + ;; Get help from font-lock-syntactic-keywords. + (parse-sexp-lookup-properties . t))) + ;; Haskell's layout rules mean that TABs have to be handled with extra care. + ;; The safer option is to avoid TABs. The second best is to make sure + ;; TABs stops are 8 chars apart, as mandated by the Haskell Report. --Stef + (set (make-local-variable 'indent-tabs-mode) nil) + (set (make-local-variable 'tab-width) 8) + (setq haskell-literate nil)) + +;;;###autoload +(define-derived-mode literate-haskell-mode haskell-mode "LitHaskell" + "As `haskell-mode' but for literate scripts." + (setq haskell-literate + (save-excursion + (goto-char (point-min)) + (cond + ((re-search-forward "^\\\\\\(begin\\|end\\){code}$" nil t) 'latex) + ((re-search-forward "^>" nil t) 'bird) + (t haskell-literate-default))))) + +;;;###autoload(add-to-list 'auto-mode-alist '("\\.\\(?:[gh]s\\|hi\\)\\'" . haskell-mode)) +;;;###autoload(add-to-list 'auto-mode-alist '("\\.l[gh]s\\'" . literate-haskell-mode)) +;;;###autoload(add-hook 'haskell-mode-hook 'turn-on-haskell-doc-mode) +;;;###autoload(add-hook 'haskell-mode-hook 'turn-on-haskell-indent) + +;; Provide ourselves: + +(provide 'haskell-mode) + +;; arch-tag: b2237ec0-ddb0-4c86-9339-52d410264980 +;;; haskell-mode.el ends here diff --git a/emacs.d/haskell/haskell-simple-indent.el b/emacs.d/haskell/haskell-simple-indent.el new file mode 100644 index 0000000..2bf6dd3 --- /dev/null +++ b/emacs.d/haskell/haskell-simple-indent.el @@ -0,0 +1,154 @@ +;;; haskell-simple-indent.el --- Simple indentation module for Haskell Mode + +;; Copyright (C) 1998 Heribert Schuetz, Graeme E Moss + +;; Authors: +;; 1998 Heribert Schuetz and +;; Graeme E Moss +;; Keywords: indentation files Haskell +;; Version: 1.0 +;; URL: http://www.cs.york.ac.uk/~gem/haskell-mode/simple-indent.html + +;; This file is not part of GNU Emacs. + +;; This file is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 2, or (at your option) +;; any later version. + +;; This file is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs; see the file COPYING. If not, write to the +;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, +;; Boston, MA 02111-1307, USA. + + +;;; Commentary: + +;; Purpose: +;; +;; To support simple indentation of Haskell scripts. +;; +;; +;; Installation: +;; +;; To bind TAB to the indentation command for all Haskell buffers, add +;; this to .emacs: +;; +;; (add-hook 'haskell-mode-hook 'turn-on-haskell-simple-indent) +;; +;; Otherwise, call `turn-on-haskell-simple-indent'. +;; +;; +;; Customisation: +;; +;; None supported. +;; +;; +;; History: +;; +;; If you have any problems or suggestions, after consulting the list +;; below, email gem@cs.york.ac.uk quoting the version of you are +;; using, the version of Emacs you are using, and a small example of +;; the problem or suggestion. +;; +;; Version 1.0: +;; Brought over from Haskell mode v1.1. +;; +;; Present Limitations/Future Work (contributions are most welcome!): +;; +;; (None so far.) + +;;; Code: + +;; All functions/variables start with +;; `(turn-(on/off)-)haskell-simple-indent'. + +;; Version. +(defconst haskell-simple-indent-version "1.2" + "`haskell-simple-indent' version number.") +(defun haskell-simple-indent-version () + "Echo the current version of `haskell-simple-indent' in the minibuffer." + (interactive) + (message "Using haskell-simple-indent version %s" + haskell-simple-indent-version)) + +;; Partly stolen from `indent-relative' in indent.el: +(defun haskell-simple-indent () + "Space out to under next visible indent point. +Indent points are positions of non-whitespace following whitespace in +lines preceeding point. A position is visible if it is to the left of +the first non-whitespace of every nonblank line between the position and +the current line. If there is no visible indent point beyond the current +column, `tab-to-tab-stop' is done instead." + (interactive) + (let* ((start-column (current-column)) + (invisible-from nil) ; `nil' means infinity here + (indent + (catch 'haskell-simple-indent-break + (save-excursion + (while (progn (beginning-of-line) + (not (bobp))) + (forward-line -1) + (if (not (looking-at "[ \t]*\n")) + (let ((this-indentation (current-indentation))) + (if (or (not invisible-from) + (< this-indentation invisible-from)) + (if (> this-indentation start-column) + (setq invisible-from this-indentation) + (let ((end (line-beginning-position 2))) + (move-to-column start-column) + ;; Is start-column inside a tab on this line? + (if (> (current-column) start-column) + (backward-char 1)) + (or (looking-at "[ \t]") + (skip-chars-forward "^ \t" end)) + (skip-chars-forward " \t" end) + (let ((col (current-column))) + (throw 'haskell-simple-indent-break + (if (or (= (point) end) + (and invisible-from + (> col invisible-from))) + invisible-from + col))))))))))))) + (if indent + (let ((opoint (point-marker))) + (indent-line-to indent) + (if (> opoint (point)) + (goto-char opoint)) + (set-marker opoint nil)) + (tab-to-tab-stop)))) + +(defvar haskell-simple-indent-old) + +;; The main functions. +(defun turn-on-haskell-simple-indent () + "Set `indent-line-function' to a simple indentation function. +TAB will now move the cursor to the next indent point in the previous +nonblank line. An indent point is a non-whitespace character following +whitespace. + +Runs `haskell-simple-indent-hook'. + +Use `haskell-simple-indent-version' to find out what version this is." + (set (make-local-variable 'haskell-simple-indent-old) indent-line-function) + (set (make-local-variable 'indent-line-function) 'haskell-simple-indent) + (run-hooks 'haskell-simple-indent-hook)) + +(defun turn-off-haskell-simple-indent () + "Return `indent-line-function' to original value. +I.e. the value before `turn-on-haskell-simple-indent' was called." + (when (local-variable-p 'haskell-simple-indent-old) + (setq indent-line-function haskell-simple-indent-old) + (kill-local-variable 'haskell-simple-indent-old))) + +;; Provide ourselves: + +(provide 'haskell-simple-indent) + +;; arch-tag: 18a08122-723b-485e-b958-e1cf8218b816 +;;; haskell-simple-indent.el ends here diff --git a/emacs.d/haskell/haskell-site-file.el b/emacs.d/haskell/haskell-site-file.el new file mode 100644 index 0000000..98ff76d --- /dev/null +++ b/emacs.d/haskell/haskell-site-file.el @@ -0,0 +1,218 @@ +;;; haskell-site-file.el --- automatically extracted autoloads +;; +;;; Code: + +(add-to-list 'load-path + (or (file-name-directory load-file-name) (car load-path))) + + + +;;;### (autoloads (haskell-cabal-mode) "haskell-cabal" "haskell-cabal.el" +;;;;;; (17875 26421)) +;;; Generated autoloads from haskell-cabal.el + +(add-to-list (quote auto-mode-alist) (quote ("\\.cabal\\'" . haskell-cabal-mode))) + +(autoload (quote haskell-cabal-mode) "haskell-cabal" "\ +Major mode for Cabal package description files. + +\(fn)" t nil) + +;;;*** + +;;;### (autoloads (haskell-decl-scan-mode) "haskell-decl-scan" "haskell-decl-scan.el" +;;;;;; (17282 16501)) +;;; Generated autoloads from haskell-decl-scan.el + +(autoload (quote haskell-decl-scan-mode) "haskell-decl-scan" "\ +Minor mode for declaration scanning for Haskell mode. +Top-level declarations are scanned and listed in the menu item \"Declarations\". +Selecting an item from this menu will take point to the start of the +declaration. + +\\[haskell-ds-forward-decl] and \\[haskell-ds-backward-decl] move forward and backward to the start of a declaration. + +Under XEmacs, the following keys are also defined: + +\\[fume-list-functions] lists the declarations of the current buffer, +\\[fume-prompt-function-goto] prompts for a declaration to move to, and +\\[fume-mouse-function-goto] moves to the declaration whose name is at point. + +This may link with `haskell-doc' (only for Emacs currently). + +For non-literate and LaTeX-style literate scripts, we assume the +common convention that top-level declarations start at the first +column. For Bird-style literate scripts, we assume the common +convention that top-level declarations start at the third column, +ie. after \"> \". + +Anything in `font-lock-comment-face' is not considered for a +declaration. Therefore, using Haskell font locking with comments +coloured in `font-lock-comment-face' improves declaration scanning. + +To turn on declaration scanning for all Haskell buffers, add this to +.emacs: + + (add-hook 'haskell-mode-hook 'turn-on-haskell-decl-scan) + +To turn declaration scanning on for the current buffer, call +`turn-on-haskell-decl-scan'. + +Literate Haskell scripts are supported: If the value of +`haskell-literate' (automatically set by the Haskell mode of +Moss&Thorn) is 'bird, a Bird-style literate script is assumed. If it +is nil or 'latex, a non-literate or LaTeX-style literate script is +assumed, respectively. + +Invokes `haskell-decl-scan-hook' if not nil. + +Use `haskell-decl-scan-version' to find out what version this is. + +\(fn &optional ARG)" nil nil) + +;;;*** + +;;;### (autoloads (haskell-doc-show-type haskell-doc-mode) "haskell-doc" +;;;;;; "haskell-doc.el" (17869 26151)) +;;; Generated autoloads from haskell-doc.el + +(autoload (quote haskell-doc-mode) "haskell-doc" "\ +Enter `haskell-doc-mode' for showing fct types in the echo area. +See variable docstring. + +\(fn &optional ARG)" t nil) + +(defalias (quote turn-on-haskell-doc-mode) (quote haskell-doc-mode)) + +(autoload (quote haskell-doc-show-type) "haskell-doc" "\ +Show the type of the function near point. +For the function under point, show the type in the echo area. +This information is extracted from the `haskell-doc-prelude-types' alist +of prelude functions and their types, or from the local functions in the +current buffer. + +\(fn &optional SYM)" t nil) + +;;;*** + +;;;### (autoloads (haskell-indent-mode) "haskell-indent" "haskell-indent.el" +;;;;;; (17875 21187)) +;;; Generated autoloads from haskell-indent.el + +(autoload (quote haskell-indent-mode) "haskell-indent" "\ +``intelligent'' Haskell indentation mode that deals with +the layout rule of Haskell. \\[haskell-indent-cycle] starts the cycle +which proposes new possibilities as long as the TAB key is pressed. +Any other key or mouse click terminates the cycle and is interpreted +except for RET which merely exits the cycle. +Other special keys are: + \\[haskell-indent-insert-equal] + inserts an = + \\[haskell-indent-insert-guard] + inserts an | + \\[haskell-indent-insert-otherwise] + inserts an | otherwise = +these functions also align the guards and rhs of the current definition + \\[haskell-indent-insert-where] + inserts a where keyword + \\[haskell-indent-align-guards-and-rhs] + aligns the guards and rhs of the region + \\[haskell-indent-put-region-in-literate] + makes the region a piece of literate code in a literate script + +Note: \\[indent-region] which applies \\[haskell-indent-cycle] for each line +of the region also works but it stops and asks for any line having more +than one possible indentation. +Use TAB to cycle until the right indentation is found and then RET to go the +next line to indent. + +Invokes `haskell-indent-hook' if not nil. + +\(fn &optional ARG)" t nil) + +;;;*** + +;;;### (autoloads (literate-haskell-mode haskell-mode) "haskell-mode" +;;;;;; "haskell-mode.el" (17869 25437)) +;;; Generated autoloads from haskell-mode.el + +(autoload (quote haskell-mode) "haskell-mode" "\ +Major mode for editing Haskell programs. Last adapted for Haskell 1.4. +Blank lines separate paragraphs, comments start with `-- '. + +\\\\[indent-for-comment] will place a comment at an appropriate place on the current line. +\\[comment-region] comments (or with prefix arg, uncomments) each line in the region. + +Literate scripts are supported via `literate-haskell-mode'. The +variable `haskell-literate' indicates the style of the script in the +current buffer. See the documentation on this variable for more +details. + +Modules can hook in via `haskell-mode-hook'. The following modules +are supported with an `autoload' command: + + `haskell-decl-scan', Graeme E Moss + Scans top-level declarations, and places them in a menu. + + `haskell-doc', Hans-Wolfgang Loidl + Echoes types of functions or syntax of keywords when the cursor is idle. + + `haskell-indent', Guy Lapalme + Intelligent semi-automatic indentation. + + `haskell-simple-indent', Graeme E Moss and Heribert Schuetz + Simple indentation. + +Module X is activated using the command `turn-on-X'. For example, +`haskell-font-lock' is activated using `turn-on-haskell-font-lock'. +For more information on a module, see the help for its `turn-on-X' +function. Some modules can be deactivated using `turn-off-X'. (Note +that `haskell-doc' is irregular in using `turn-(on/off)-haskell-doc-mode'.) + +Use `haskell-version' to find out what version this is. + +Invokes `haskell-mode-hook' if not nil. + +\(fn)" t nil) + +(autoload (quote literate-haskell-mode) "haskell-mode" "\ +As `haskell-mode' but for literate scripts. + +\(fn)" t nil) +(add-to-list 'auto-mode-alist '("\\.\\(?:[gh]s\\|hi\\)\\'" . haskell-mode)) +(add-to-list 'auto-mode-alist '("\\.l[gh]s\\'" . literate-haskell-mode)) +(add-hook 'haskell-mode-hook 'turn-on-haskell-doc-mode) +(add-hook 'haskell-mode-hook 'turn-on-haskell-indent) + +;;;*** + +;;;### (autoloads (inferior-haskell-load-file switch-to-haskell) +;;;;;; "inf-haskell" "inf-haskell.el" (17875 21120)) +;;; Generated autoloads from inf-haskell.el + +(defalias (quote run-haskell) (quote switch-to-haskell)) + +(autoload (quote switch-to-haskell) "inf-haskell" "\ +Show the inferior-haskell buffer. Start the process if needed. + +\(fn &optional ARG)" t nil) + +(autoload (quote inferior-haskell-load-file) "inf-haskell" "\ +Pass the current buffer's file to the inferior haskell process. + +\(fn &optional RELOAD)" t nil) + +;;;*** + +;;;### (autoloads nil nil ("haskell-font-lock.el" "haskell-ghci.el" +;;;;;; "haskell-hugs.el" "haskell-simple-indent.el") (17875 26544 +;;;;;; 864790)) + +;;;*** + +;; Local Variables: +;; version-control: never +;; no-byte-compile: t +;; no-update-autoloads: t +;; End: +;;; haskell-site-file.el ends here diff --git a/emacs.d/haskell/indent.hs b/emacs.d/haskell/indent.hs new file mode 100644 index 0000000..88daf5e --- /dev/null +++ b/emacs.d/haskell/indent.hs @@ -0,0 +1,157 @@ +------------------------------------------------------------------------- +-- Comments with allcaps `FIXME' indicate places where the indentation -- +-- fails to find the correct indentation, whereas comments with -- +-- lowercase `fixme' indicate places where impossible indentations -- +-- are uselessly proposed. -- +------------------------------------------------------------------------- + +-- compute the list of binary digits corresponding to an integer +-- Note: the least significant bit is the first element of the list +bdigits :: Int -> [Int] +bdigits 0 = [0] +bdigits 1 = [1] +bdigits n | n>1 = n `mod` 2 : + bdigits (n `div` 2) + | otherwise = error "bdigits of a negative number" + +-- compute the value of an integer given its list of binary digits +-- Note: the least significant bit is the first element of the list +bvalue :: [Int]->Int +bvalue [] = error "bvalue of []" +bvalue s = bval 1 s + where + bval e [] = 0 + bval e [] = 0 -- fixme: can't align with `where'. + bval e (b:bs) | b==0 || b=="dd of " = b*e + bval (2*e) bs + | otherwise = error "ill digit" -- Spurious 3rd step. + foo + +-- fixme: tab on the line above should insert `bvalue' at some point. + +{- text + indentation + inside comments + -} +toto a = ( hello + , there -- indentation of leading , and ; + -- indentation of this comment. + , my friends ) + +lili x = do let ofs x = 1 + print x + +titi b = + let -- fixme: can't indent at column 0 + x = let toto = 1 + tata = 2 -- fixme: can't indent lower than `toto'. + in + toto in + do expr1 + {- text + - indentation + - inside comments + -} + let foo s = let fro = 1 + fri = 2 -- fixme: can't indent lower than `fro'. + in + hello + foo2 = bar2 -- fixme: can't align with arg `s' in foo. + foo1 = bar2 -- fixme: Can't be column 0. + expr2 + +tata c = + let bar = case foo -- fixme: can't be col 0. + of 1 -> blabla + 2 -> blibli -- fixme: only one possible indentation here. + bar = case foo of + _ -> blabla + bar' = case foo + of _ -> blabla + toto -> plulu + +turlu d = if test + then + ifturl + else + adfaf + +turlu d = if test then + ifturl + else + sg + +turly fg = toto + where + hello = 2 + + +-- test from John Goerzen + +x myVariableThing = case myVariablething of + Just z -> z + Nothing -> 0 -- fixme: "spurious" additional indents. + +foo = let x = 1 in toto + titi -- FIXME + +foo = let foo x y = toto + where + toto = 2 + +instance Show Toto where + foo x 4 = 50 + +data Toto = Foo + | Bar + deriving (Show) -- FIXME + +foo = let toto x = do let bar = 2 + return 1 + in 3 + + eval env (Llambda x e) = -- FIXME: sole indentation is self??? + Vfun (\v -> eval (\y -> if (x == y) then v else env y) -- FIXME + e) -- FIXME + +foo = case findprop attr props of + Just x -> x + +data T = T { granularity :: (Int, Int, Int, Int) -- FIXME: self indentation? + , items :: Map (Int, Int, Int, Int) [Item] } + +foo = case foo of + [] -> + case bar of + [] -> + return () + (x:xs) -> -- FIXME + +bar = do toto + if titi + then tutu -- FIXME + else tata -- FIXME + +insert :: Ord a => a -> b -> TreeMap a b -> TreeMap a b +insert x v Empty = Node 0 x v Empty Empty +insert x v (Node d x' v' t1 t2) + | x == x' = Node d x v t1 t2 + | x < x' = Node ? x' v' (insert x v t1 Empty) t2 + | -- FIXME: wrong indent *if at EOB* + + +tinsertb x v (Node x' v' d1 t1 d2 t2) + | x == x' = (1 + max d1 d2, Node x v d1 t1 d2 t2) + | x < x' = + case () of + _ | d1' <= d2 + 1 => (1 + max d1' d2, Node x' v' d1' t1' d2 t2) + -- d1' == d2 + 2: Need to rotate to rebalance. FIXME CRASH + else let (Node x'' v'' d1'' t1'' d2'' t2'') = t1' + +test = if True then + toto + else if False then + tata -- FIXME + else -- FIXME + titi + +-- arch-tag: de0069e3-c0a0-495c-b441-d4ff6e0509b1 diff --git a/emacs.d/haskell/inf-haskell.el b/emacs.d/haskell/inf-haskell.el new file mode 100644 index 0000000..843b4b5 --- /dev/null +++ b/emacs.d/haskell/inf-haskell.el @@ -0,0 +1,328 @@ +;;; inf-haskell.el --- Interaction with an inferior Haskell process. + +;; Copyright (C) 2004, 2005, 2006, 2007 Free Software Foundation, Inc. + +;; Author: Stefan Monnier +;; Keywords: Haskell + +;; This file is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 2, or (at your option) +;; any later version. + +;; This file is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs; see the file COPYING. If not, write to +;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330, +;; Boston, MA 02111-1307, USA. + +;;; Commentary: + +;; The code is made of 2 parts: a major mode for the buffer that holds the +;; inferior process's session and a minor mode for use in source buffers. + +;;; Code: + +(require 'comint) +(require 'shell) ;For directory tracking. +(require 'compile) +(require 'haskell-mode) +(eval-when-compile (require 'cl)) + +;; Here I depart from the inferior-haskell- prefix. +;; Not sure if it's a good idea. +(defcustom haskell-program-name + ;; Arbitrarily give preference to hugs over ghci. + (or (cond + ((not (fboundp 'executable-find)) nil) + ((executable-find "hugs") "hugs \"+.\"") + ((executable-find "ghci") "ghci")) + "hugs \"+.\"") + "The name of the command to start the inferior Haskell process. +The command can include arguments." + ;; Custom only supports the :options keyword for a few types, e.g. not + ;; for string. + ;; :options '("hugs \"+.\"" "ghci") + :group 'haskell + :type '(choice string (repeat string))) + +(defconst inferior-haskell-info-xref-re + "\t-- Defined at \\(.+\\):\\([0-9]+\\):\\([0-9]+\\)$") + +(defconst inferior-haskell-error-regexp-alist + ;; The format of error messages used by Hugs. + `(("^ERROR \"\\(.+?\\)\"\\(:\\| line \\)\\([0-9]+\\) - " 1 3) + ;; Format of error messages used by GHCi. + ("^\\(.+?\\):\\([0-9]+\\):\\(\\([0-9]+\\):\\)?\\( \\|\n +\\)\\(Warning\\)?" + 1 2 4 ,@(if (fboundp 'compilation-fake-loc) '((6)))) + ;; Info xrefs. + ,@(if (fboundp 'compilation-fake-loc) + `((,inferior-haskell-info-xref-re + 1 2 3 0)))) + "Regexps for error messages generated by inferior Haskell processes. +The format should be the same as for `compilation-error-regexp-alist'.") + +(define-derived-mode inferior-haskell-mode comint-mode "Inf-Haskell" + "Major mode for interacting with an inferior Haskell process." + (set (make-local-variable 'comint-prompt-regexp) + "^\\*?[A-Z][\\._a-zA-Z0-9]*\\( \\*?[A-Z][\\._a-zA-Z0-9]*\\)*> ") + (set (make-local-variable 'comint-input-autoexpand) nil) + + ;; Setup directory tracking. + (set (make-local-variable 'shell-cd-regexp) ":cd") + (condition-case nil + (shell-dirtrack-mode 1) + (error ;The minor mode function may not exist or not accept an arg. + (set (make-local-variable 'shell-dirtrackp) t) + (add-hook 'comint-input-filter-functions 'shell-directory-tracker + nil 'local))) + + ;; Setup `compile' support so you can just use C-x ` and friends. + (set (make-local-variable 'compilation-error-regexp-alist) + inferior-haskell-error-regexp-alist) + (if (and (not (boundp 'minor-mode-overriding-map-alist)) + (fboundp 'compilation-shell-minor-mode)) + ;; If we can't remove compilation-minor-mode bindings, at least try to + ;; use compilation-shell-minor-mode, so there are fewer + ;; annoying bindings. + (compilation-shell-minor-mode 1) + ;; Else just use compilation-minor-mode but without its bindings because + ;; things like mouse-2 are simply too annoying. + (compilation-minor-mode 1) + (let ((map (make-sparse-keymap))) + (dolist (keys '([menu-bar] [follow-link])) + ;; Preserve some of the bindings. + (define-key map keys (lookup-key compilation-minor-mode-map keys))) + (add-to-list 'minor-mode-overriding-map-alist + (cons 'compilation-minor-mode map))))) + +(defun inferior-haskell-string-to-strings (string &optional separator) + "Split the STRING into a list of strings. +The SEPARATOR regexp defaults to \"\\s-+\"." + (let ((sep (or separator "\\s-+")) + (i (string-match "[\"]" string))) + (if (null i) (split-string string sep) ; no quoting: easy + (append (unless (eq i 0) (split-string (substring string 0 i) sep)) + (let ((rfs (read-from-string string i))) + (cons (car rfs) + (inferior-haskell-string-to-strings + (substring string (cdr rfs)) sep))))))) + +(defun inferior-haskell-command (arg) + (inferior-haskell-string-to-strings + (if (null arg) haskell-program-name + (read-string "Command to run haskell: " haskell-program-name)))) + +(defvar inferior-haskell-buffer nil + "The buffer in which the inferior process is running.") + +(defun inferior-haskell-start-process (command) + "Start an inferior haskell process. +With universal prefix \\[universal-argument], prompts for a command, +otherwise uses `haskell-program-name'. +It runs the hook `inferior-haskell-hook' after starting the process and +setting up the inferior-haskell buffer." + (interactive (list (inferior-haskell-command current-prefix-arg))) + (setq inferior-haskell-buffer + (apply 'make-comint "haskell" (car command) nil (cdr command))) + (with-current-buffer inferior-haskell-buffer + (inferior-haskell-mode) + (run-hooks 'inferior-haskell-hook))) + +(defun inferior-haskell-process (&optional arg) + (or (if (buffer-live-p inferior-haskell-buffer) + (get-buffer-process inferior-haskell-buffer)) + (progn + (let ((current-prefix-arg arg)) + (call-interactively 'inferior-haskell-start-process)) + ;; Try again. + (inferior-haskell-process arg)))) + +;;;###autoload +(defalias 'run-haskell 'switch-to-haskell) +;;;###autoload +(defun switch-to-haskell (&optional arg) + "Show the inferior-haskell buffer. Start the process if needed." + (interactive "P") + (let ((proc (inferior-haskell-process arg))) + (pop-to-buffer (process-buffer proc)))) + +(eval-when-compile + (unless (fboundp 'with-selected-window) + (defmacro with-selected-window (win &rest body) + `(save-selected-window + (select-window ,win) + ,@body)))) + +(defcustom inferior-haskell-wait-and-jump nil + "If non-nil, wait for file loading to terminate and jump to the error." + :type 'boolean + :group 'haskell) + +(defun inferior-haskell-wait-for-prompt (proc) + "Wait until PROC sends us a prompt. +The process PROC should be associated to a comint buffer." + (with-current-buffer (process-buffer proc) + (while (progn + (goto-char comint-last-input-end) + (and (not (re-search-forward comint-prompt-regexp nil t)) + (accept-process-output proc)))))) + +;;;###autoload +(defun inferior-haskell-load-file (&optional reload) + "Pass the current buffer's file to the inferior haskell process." + (interactive) + (let ((file buffer-file-name) + (proc (inferior-haskell-process))) + (save-buffer) + (with-current-buffer (process-buffer proc) + ;; Not sure if it's useful/needed and if it actually works. + ;; (unless (equal (file-name-as-directory default-directory) + ;; (file-name-directory file)) + ;; (inferior-haskell-send-string + ;; proc (concat ":cd " (file-name-directory file) "\n"))) + (compilation-forget-errors) + (let ((parsing-end (marker-position (process-mark proc)))) + (inferior-haskell-send-command + proc (if reload ":reload" (concat ":load \"" file "\""))) + ;; Move the parsing-end marker after sending the command so + ;; that it doesn't point just to the insertion point. + ;; Otherwise insertion may move the marker (if done with + ;; insert-before-markers) and we'd then miss some errors. + (if (boundp 'compilation-parsing-end) + (if (markerp compilation-parsing-end) + (set-marker compilation-parsing-end parsing-end) + (setq compilation-parsing-end parsing-end)))) + (with-selected-window (display-buffer (current-buffer)) + (goto-char (point-max))) + (when inferior-haskell-wait-and-jump + (inferior-haskell-wait-for-prompt proc) + (ignore-errors ;Don't beep if there were no errors. + (next-error)))))) + +(defun inferior-haskell-send-command (proc str) + (setq str (concat str "\n")) + (with-current-buffer (process-buffer proc) + (inferior-haskell-wait-for-prompt proc) + (goto-char (process-mark proc)) + (insert-before-markers str) + (move-marker comint-last-input-end (point)) + (comint-send-string proc str))) + +(defun inferior-haskell-reload-file () + "Tell the inferior haskell process to reread the current buffer's file." + (interactive) + (inferior-haskell-load-file 'reload)) + +(defun inferior-haskell-type (expr &optional insert-value) + "Query the haskell process for the type of the given expression. +If optional argument `insert-value' is non-nil, insert the type above point +in the buffer. This can be done interactively with the \\[universal-argument] prefix. +The returned info is cached for reuse by `haskell-doc-mode'." + (interactive + (let ((sym (haskell-ident-at-point))) + (list (read-string (if (> (length sym) 0) + (format "Show type of (default %s): " sym) + "Show type of: ") + nil nil sym) + current-prefix-arg))) + (if (string-match "\\`\\s_+\\'" expr) (setq expr (concat "(" expr ")"))) + (let* ((proc (inferior-haskell-process)) + (type + (with-current-buffer (process-buffer proc) + (let ((parsing-end ; Remember previous spot. + (marker-position (process-mark proc)))) + (inferior-haskell-send-command proc (concat ":type " expr)) + ;; Find new point. + (goto-char (point-max)) + (inferior-haskell-wait-for-prompt proc) + ;; Back up to the previous end-of-line. + (end-of-line 0) + ;; Extract the type output + (buffer-substring-no-properties + (save-excursion (goto-char parsing-end) + (line-beginning-position 2)) + (point)))))) + (if (not (string-match (concat "\\`" (regexp-quote expr) "[ \t]+::[ \t]*") + type)) + (error "No type info: %s" type) + + ;; Cache for reuse by haskell-doc. + (when (and (boundp 'haskell-doc-mode) haskell-doc-mode + (boundp 'haskell-doc-user-defined-ids) + ;; Haskell-doc only works for idents, not arbitrary expr. + (string-match "\\`(?\\(\\s_+\\|\\(\\sw\\|\\s'\\)+\\)?[ \t]*::[ \t]*" + type)) + (let ((sym (match-string 1 type))) + (setq haskell-doc-user-defined-ids + (cons (cons sym (substring type (match-end 0))) + (remove-if (lambda (item) (equal (car item) sym)) + haskell-doc-user-defined-ids))))) + + (if (interactive-p) (message type)) + (when insert-value + (beginning-of-line) + (insert type "\n")) + type))) + +(defun inferior-haskell-info (sym) + "Query the haskell process for the info of the given expression." + (interactive + (let ((sym (haskell-ident-at-point))) + (list (read-string (if (> (length sym) 0) + (format "Show info of (default %s): " sym) + "Show info of: ") + nil nil sym)))) + (let ((proc (inferior-haskell-process))) + (with-current-buffer (process-buffer proc) + (let ((parsing-end ; Remember previous spot. + (marker-position (process-mark proc)))) + (inferior-haskell-send-command proc (concat ":info " sym)) + ;; Find new point. + (goto-char (point-max)) + (inferior-haskell-wait-for-prompt proc) + ;; Move to previous end-of-line + (end-of-line 0) + (let ((result + (buffer-substring-no-properties + (save-excursion (goto-char parsing-end) + (line-beginning-position 2)) + (point)))) + ;; Move back to end of process buffer + (goto-char (point-max)) + (if (interactive-p) (message "%s" result)) + result))))) + +(defun inferior-haskell-find-definition (sym) + "Attempt to locate and jump to the definition of the given expression." + (interactive + (let ((sym (haskell-ident-at-point))) + (list (read-string (if (> (length sym) 0) + (format "Find definition of (default %s): " sym) + "Find definition of: ") + nil nil sym)))) + (let ((info (inferior-haskell-info sym))) + (if (not (string-match inferior-haskell-info-xref-re info)) + (error "No source information available") + (let ((file (match-string-no-properties 1 info)) + (line (string-to-number + (match-string-no-properties 2 info))) + (col (string-to-number + (match-string-no-properties 3 info)))) + (when file + ;; Push current location marker on the ring used by `find-tag' + (require 'etags) + (ring-insert find-tag-marker-ring (point-marker)) + (pop-to-buffer (find-file-noselect file)) + (when line + (goto-line line) + (when col (move-to-column col)))))))) + +(provide 'inf-haskell) + +;; arch-tag: 61804287-63dd-4052-bc0e-90f691b34b40 +;;; inf-haskell.el ends here diff --git a/emacs.d/inf-ruby.el b/emacs.d/inf-ruby.el new file mode 100644 index 0000000..0a7eb76 --- /dev/null +++ b/emacs.d/inf-ruby.el @@ -0,0 +1,417 @@ +;;; -*-Emacs-Lisp-*- +;;; +;;; $Id$ +;;; $Author$ +;;; $Date$ +;;; +;;; Inferior Ruby Mode - ruby process in a buffer. +;;; adapted from cmuscheme.el +;;; +;;; Usage: +;;; +;;; (0) check ruby-program-name variable that can run your environment. +;;; +;;; (1) modify .emacs to use ruby-mode +;;; for example : +;;; +;;; (autoload 'ruby-mode "ruby-mode" +;;; "Mode for editing ruby source files" t) +;;; (setq auto-mode-alist +;;; (append '(("\\.rb$" . ruby-mode)) auto-mode-alist)) +;;; (setq interpreter-mode-alist (append '(("ruby" . ruby-mode)) +;;; interpreter-mode-alist)) +;;; +;;; (2) set to load inf-ruby and set inf-ruby key definition in ruby-mode. +;;; +;;; (autoload 'run-ruby "inf-ruby" +;;; "Run an inferior Ruby process") +;;; (autoload 'inf-ruby-keys "inf-ruby" +;;; "Set local key defs for inf-ruby in ruby-mode") +;;; (add-hook 'ruby-mode-hook +;;; '(lambda () +;;; (inf-ruby-keys) +;;; )) +;;; +;;; HISTORY +;;; senda - 8 Apr 1998: Created. +;;; $Log$ +;;; Revision 1.7 2004/07/27 08:11:36 matz +;;; * eval.c (rb_eval): copy on write for argument local variable +;;; assignment. +;;; +;;; * eval.c (assign): ditto. +;;; +;;; * eval.c (rb_call0): update ruby_frame->argv with the default +;;; value used for the optional arguments. +;;; +;;; * object.c (Init_Object): "===" calls rb_obj_equal() directly. +;;; [ruby-list:39937] +;;; +;;; Revision 1.6 2002/09/07 14:35:46 nobu +;;; * misc/inf-ruby.el (inferior-ruby-error-regexp-alist): regexp +;;; alist for error message from ruby. +;;; +;;; * misc/inf-ruby.el (inferior-ruby-mode): fixed for Emacs. +;;; +;;; * misc/inf-ruby.el (ruby-send-region): compilation-parse-errors +;;; doesn't parse first line, so insert separators before each +;;; evaluations. +;;; +;;; Revision 1.5 2002/08/19 10:05:47 nobu +;;; * misc/inf-ruby.el (inf-ruby-keys): ruby-send-definition +;;; conflicted with ruby-insert-end. +;;; +;;; * misc/inf-ruby.el (inferior-ruby-mode): compilation-minor-mode. +;;; +;;; * misc/inf-ruby.el (ruby-send-region): send as here document to +;;; adjust source file/line. [ruby-talk:47113], [ruby-dev:17965] +;;; +;;; * misc/inf-ruby.el (ruby-send-terminator): added to make unique +;;; terminator. +;;; +;;; Revision 1.4 2002/01/29 07:16:09 matz +;;; * file.c (rb_stat_rdev_major): added. [new] +;;; +;;; * file.c (rb_stat_rdev_minor): added. [new] +;;; +;;; * file.c (rb_stat_inspect): print mode in octal. +;;; +;;; Revision 1.3 1999/12/01 09:24:18 matz +;;; 19991201 +;;; +;;; Revision 1.2 1999/08/13 05:45:18 matz +;;; 1.4.0 +;;; +;;; Revision 1.1.1.1.2.1 1999/07/15 07:59:59 matz +;;; 990715 +;;; +;;; Revision 1.1.1.1 1999/01/20 04:59:36 matz +;;; ruby 1.3 cycle +;;; +;;; Revision 1.1.2.1 1998/12/16 07:30:36 matz +;;; first public release of 1.1d (pre1.2) series +;;; +;;; Revision 1.4 1998/05/20 02:45:58 senda +;;; default program to irb +;;; +;;; Revision 1.3 1998/04/10 04:11:30 senda +;;; modification by Matsumoto san (1.1b9_09) +;;; remove-in-string defined +;;; global variable : +;;; inferior-ruby-first-prompt-pattern +;;; inferior-ruby-prompt-pattern +;;; defined +;;; +;;; Revision 1.2 1998/04/09 07:53:42 senda +;;; remove M-C-x in inferior-ruby-mode +;;; +;;; Revision 1.1 1998/04/09 07:28:36 senda +;;; Initial revision +;;; +;;; + +(require 'comint) +(require 'compile) +(require 'ruby-mode) + +;; +;; you may change these variables +;; +;(defvar ruby-program-name "rbc --noreadline" +; "*Program invoked by the run-ruby command") +; +;(defvar inferior-ruby-first-prompt-pattern "^rbc0> *" +; "first prompt regex pattern of ruby interpreter.") +; +;(defvar inferior-ruby-prompt-pattern "^\\(rbc.[>*\"'] *\\)+" +; "prompt regex pattern of ruby interpreter.") + +;;;; for irb +(defvar ruby-program-name "irb --inf-ruby-mode" + "*Program invoked by the run-ruby command") + +(defvar inferior-ruby-first-prompt-pattern "^irb(.*)[0-9:]+0> *" + "first prompt regex pattern of ruby interpreter.") + +(defvar inferior-ruby-prompt-pattern "^\\(irb(.*)[0-9:]+[>*\"'] *\\)+" + "prompt regex pattern of ruby interpreter.") + +;; +;; mode variables +;; +(defvar inferior-ruby-mode-hook nil + "*Hook for customising inferior-ruby mode.") +(defvar inferior-ruby-mode-map nil + "*Mode map for inferior-ruby-mode") + +(defconst inferior-ruby-error-regexp-alist + '(("SyntaxError: compile error\n^\\([^\(].*\\):\\([1-9][0-9]*\\):" 1 2) + ("^\tfrom \\([^\(].*\\):\\([1-9][0-9]*\\)\\(:in `.*'\\)?$" 1 2))) + +(cond ((not inferior-ruby-mode-map) + (setq inferior-ruby-mode-map + (copy-keymap comint-mode-map)) +; (define-key inferior-ruby-mode-map "\M-\C-x" ;gnu convention +; 'ruby-send-definition) +; (define-key inferior-ruby-mode-map "\C-x\C-e" 'ruby-send-last-sexp) + (define-key inferior-ruby-mode-map "\C-c\C-l" 'ruby-load-file) +)) + +(defun inf-ruby-keys () + "Set local key defs for inf-ruby in ruby-mode" + (define-key ruby-mode-map "\M-\C-x" 'ruby-send-definition) +; (define-key ruby-mode-map "\C-x\C-e" 'ruby-send-last-sexp) + (define-key ruby-mode-map "\C-c\C-b" 'ruby-send-block) + (define-key ruby-mode-map "\C-c\M-b" 'ruby-send-block-and-go) + (define-key ruby-mode-map "\C-c\C-x" 'ruby-send-definition) + (define-key ruby-mode-map "\C-c\M-x" 'ruby-send-definition-and-go) + (define-key ruby-mode-map "\C-c\C-r" 'ruby-send-region) + (define-key ruby-mode-map "\C-c\M-r" 'ruby-send-region-and-go) + (define-key ruby-mode-map "\C-c\C-z" 'switch-to-ruby) + (define-key ruby-mode-map "\C-c\C-l" 'ruby-load-file) + (define-key ruby-mode-map "\C-c\C-s" 'run-ruby) +) + +(defvar ruby-buffer nil "current ruby (actually irb) process buffer.") + +(defun inferior-ruby-mode () + "Major mode for interacting with an inferior ruby (irb) process. + +The following commands are available: +\\{inferior-ruby-mode-map} + +A ruby process can be fired up with M-x run-ruby. + +Customisation: Entry to this mode runs the hooks on comint-mode-hook and +inferior-ruby-mode-hook (in that order). + +You can send text to the inferior ruby process from other buffers containing +Ruby source. + switch-to-ruby switches the current buffer to the ruby process buffer. + ruby-send-definition sends the current definition to the ruby process. + ruby-send-region sends the current region to the ruby process. + + ruby-send-definition-and-go, ruby-send-region-and-go, + switch to the ruby process buffer after sending their text. +For information on running multiple processes in multiple buffers, see +documentation for variable ruby-buffer. + +Commands: +Return after the end of the process' output sends the text from the + end of process to point. +Return before the end of the process' output copies the sexp ending at point + to the end of the process' output, and sends it. +Delete converts tabs to spaces as it moves back. +Tab indents for ruby; with argument, shifts rest + of expression rigidly with the current line. +C-M-q does Tab on each line starting within following expression. +Paragraphs are separated only by blank lines. # start comments. +If you accidentally suspend your process, use \\[comint-continue-subjob] +to continue it." + (interactive) + (comint-mode) + ;; Customise in inferior-ruby-mode-hook + ;(setq comint-prompt-regexp "^[^>\n]*>+ *") + (setq comint-prompt-regexp inferior-ruby-prompt-pattern) + ;;(scheme-mode-variables) + (ruby-mode-variables) + (setq major-mode 'inferior-ruby-mode) + (setq mode-name "Inferior Ruby") + (setq mode-line-process '(":%s")) + (use-local-map inferior-ruby-mode-map) + (setq comint-input-filter (function ruby-input-filter)) + (setq comint-get-old-input (function ruby-get-old-input)) + (compilation-shell-minor-mode t) + (make-local-variable 'compilation-error-regexp-alist) + (setq compilation-error-regexp-alist inferior-ruby-error-regexp-alist) + (run-hooks 'inferior-ruby-mode-hook)) + +(defvar inferior-ruby-filter-regexp "\\`\\s *\\S ?\\S ?\\s *\\'" + "*Input matching this regexp are not saved on the history list. +Defaults to a regexp ignoring all inputs of 0, 1, or 2 letters.") + +(defun ruby-input-filter (str) + "Don't save anything matching inferior-ruby-filter-regexp" + (not (string-match inferior-ruby-filter-regexp str))) + +;; adapted from replace-in-string in XEmacs (subr.el) +(defun remove-in-string (str regexp) + "Remove all matches in STR for REGEXP and returns the new string." + (let ((rtn-str "") (start 0) match prev-start) + (while (setq match (string-match regexp str start)) + (setq prev-start start + start (match-end 0) + rtn-str (concat rtn-str (substring str prev-start match)))) + (concat rtn-str (substring str start)))) + +(defun ruby-get-old-input () + "Snarf the sexp ending at point" + (save-excursion + (let ((end (point))) + (re-search-backward inferior-ruby-first-prompt-pattern) + (remove-in-string (buffer-substring (point) end) + inferior-ruby-prompt-pattern) + ))) + +(defun ruby-args-to-list (string) + (let ((where (string-match "[ \t]" string))) + (cond ((null where) (list string)) + ((not (= where 0)) + (cons (substring string 0 where) + (ruby-args-to-list (substring string (+ 1 where) + (length string))))) + (t (let ((pos (string-match "[^ \t]" string))) + (if (null pos) + nil + (ruby-args-to-list (substring string pos + (length string))))))))) + +(defun run-ruby (cmd) + "Run an inferior Ruby process, input and output via buffer *ruby*. +If there is a process already running in `*ruby*', switch to that buffer. +With argument, allows you to edit the command line (default is value +of `ruby-program-name'). Runs the hooks `inferior-ruby-mode-hook' +\(after the `comint-mode-hook' is run). +\(Type \\[describe-mode] in the process buffer for a list of commands.)" + + (interactive (list (if current-prefix-arg + (read-string "Run Ruby: " ruby-program-name) + ruby-program-name))) + (if (not (comint-check-proc "*ruby*")) + (let ((cmdlist (ruby-args-to-list cmd))) + (set-buffer (apply 'make-comint "ruby" (car cmdlist) + nil (cdr cmdlist))) + (inferior-ruby-mode))) + (setq ruby-program-name cmd) + (setq ruby-buffer "*ruby*") + (pop-to-buffer "*ruby*")) + +(defconst ruby-send-terminator "--inf-ruby-%x-%d-%d-%d--" + "Template for irb here document terminator. +Must not contain ruby meta characters.") + +(defconst ruby-eval-separator "") + +(defun ruby-send-region (start end) + "Send the current region to the inferior Ruby process." + (interactive "r") + (let (term (file (buffer-file-name)) line) + (save-excursion + (save-restriction + (widen) + (goto-char start) + (setq line (+ start (forward-line (- start)) 1)) + (goto-char start) + (while (progn + (setq term (apply 'format ruby-send-terminator (random) (current-time))) + (re-search-forward (concat "^" (regexp-quote term) "$") end t))))) + ;; compilation-parse-errors parses from second line. + (save-excursion + (let ((m (process-mark (ruby-proc)))) + (set-buffer (marker-buffer m)) + (goto-char m) + (insert ruby-eval-separator "\n") + (set-marker m (point)))) + (comint-send-string (ruby-proc) (format "eval <<'%s', nil, %S, %d\n" term file line)) + (comint-send-region (ruby-proc) start end) + (comint-send-string (ruby-proc) (concat "\n" term "\n")))) + +(defun ruby-send-definition () + "Send the current definition to the inferior Ruby process." + (interactive) + (save-excursion + (ruby-end-of-defun) + (let ((end (point))) + (ruby-beginning-of-defun) + (ruby-send-region (point) end)))) + +;(defun ruby-send-last-sexp () +; "Send the previous sexp to the inferior Ruby process." +; (interactive) +; (ruby-send-region (save-excursion (backward-sexp) (point)) (point))) + +(defun ruby-send-block () + "Send the current block to the inferior Ruby process." + (interactive) + (save-excursion + (ruby-end-of-block) + (end-of-line) + (let ((end (point))) + (ruby-beginning-of-block) + (ruby-send-region (point) end)))) + +(defun switch-to-ruby (eob-p) + "Switch to the ruby process buffer. +With argument, positions cursor at end of buffer." + (interactive "P") + (if (get-buffer ruby-buffer) + (pop-to-buffer ruby-buffer) + (error "No current process buffer. See variable ruby-buffer.")) + (cond (eob-p + (push-mark) + (goto-char (point-max))))) + +(defun ruby-send-region-and-go (start end) + "Send the current region to the inferior Ruby process. +Then switch to the process buffer." + (interactive "r") + (ruby-send-region start end) + (switch-to-ruby t)) + +(defun ruby-send-definition-and-go () + "Send the current definition to the inferior Ruby. +Then switch to the process buffer." + (interactive) + (ruby-send-definition) + (switch-to-ruby t)) + +(defun ruby-send-block-and-go () + "Send the current block to the inferior Ruby. +Then switch to the process buffer." + (interactive) + (ruby-send-block) + (switch-to-ruby t)) + +(defvar ruby-source-modes '(ruby-mode) + "*Used to determine if a buffer contains Ruby source code. +If it's loaded into a buffer that is in one of these major modes, it's +considered a ruby source file by ruby-load-file. +Used by these commands to determine defaults.") + +(defvar ruby-prev-l/c-dir/file nil + "Caches the last (directory . file) pair. +Caches the last pair used in the last ruby-load-file command. +Used for determining the default in the +next one.") + +(defun ruby-load-file (file-name) + "Load a Ruby file into the inferior Ruby process." + (interactive (comint-get-source "Load Ruby file: " ruby-prev-l/c-dir/file + ruby-source-modes t)) ; T because LOAD + ; needs an exact name + (comint-check-source file-name) ; Check to see if buffer needs saved. + (setq ruby-prev-l/c-dir/file (cons (file-name-directory file-name) + (file-name-nondirectory file-name))) + (comint-send-string (ruby-proc) (concat "(load \"" + file-name + "\"\)\n"))) + +(defun ruby-proc () + "Returns the current ruby process. See variable ruby-buffer." + (let ((proc (get-buffer-process (if (eq major-mode 'inferior-ruby-mode) + (current-buffer) + ruby-buffer)))) + (or proc + (error "No current process. See variable ruby-buffer")))) + +;;; Do the user's customisation... + +(defvar inf-ruby-load-hook nil + "This hook is run when inf-ruby is loaded in. +This is a good place to put keybindings.") + +(run-hooks 'inf-ruby-load-hook) + +(provide 'inf-ruby) + +;;; inf-ruby.el ends here diff --git a/emacs.d/paren-mode.el b/emacs.d/paren-mode.el new file mode 100644 index 0000000..bb44ea8 --- /dev/null +++ b/emacs.d/paren-mode.el @@ -0,0 +1,1812 @@ +;;; -*- Mode: Emacs-Lisp; outline-regexp: " \n;;;;+" -*- + +;;;;;; Paredit: Parenthesis-Editing Minor Mode +;;;;;; Version 20 + +;;; This code is written by Taylor R. Campbell (except where explicitly +;;; noted) and placed in the Public Domain. All warranties are +;;; disclaimed. + +;;; Add this to your .emacs after adding paredit.el to /path/to/elisp/: +;;; +;;; (add-to-list 'load-path "/path/to/elisp/") +;;; (autoload 'paredit-mode "paredit" +;;; "Minor mode for pseudo-structurally editing Lisp code." +;;; t) +;;; (add-hook '...-mode-hook (lambda () (paredit-mode +1))) +;;; +;;; Usually the ... will be lisp or scheme or both. Alternatively, you +;;; can manually toggle this mode with M-x paredit-mode. Customization +;;; of paredit can be accomplished with `eval-after-load': +;;; +;;; (eval-after-load 'paredit +;;; '(progn ...redefine keys, &c....)) +;;; +;;; This should run in GNU Emacs 21 or later and XEmacs 21.5 or later. +;;; It is highly unlikely to work in earlier versions of GNU Emacs, and +;;; it may have obscure problems in earlier versions of XEmacs due to +;;; the way its syntax parser reports conditions, as a result of which +;;; the code that uses the syntax parser must mask *all* error +;;; conditions, not just those generated by the syntax parser. + +;;; This mode changes the keybindings for a number of simple keys, +;;; notably (, ), ", \, and ;. The bracket keys (round or square) are +;;; defined to insert parenthesis pairs and move past the close, +;;; respectively; the double-quote key is multiplexed to do both, and +;;; also insert an escape if within a string; backslashes prompt the +;;; user for the next character to input, because a lone backslash can +;;; break structure inadvertently; and semicolons ensure that they do +;;; not accidentally comment valid structure. (Use M-; to comment an +;;; expression.) These all have their ordinary behaviour when inside +;;; comments, and, outside comments, if truly necessary, you can insert +;;; them literally with C-q. +;;; +;;; These keybindings are set up for my preference. One particular +;;; preference which I've seen vary greatly from person to person is +;;; whether the command to move past a closing delimiter ought to +;;; insert a newline. Since I find this behaviour to be more common +;;; than that which inserts no newline, I have ) bound to it, and the +;;; more involved M-) to perform the less common action. This bothers +;;; some users, though, and they prefer the other way around. This +;;; code, which you can use `eval-after-load' to put in your .emacs, +;;; will exchange the bindings: +;;; +;;; (define-key paredit-mode-map (kbd ")") +;;; 'paredit-close-parenthesis) +;;; (define-key paredit-mode-map (kbd "M-)") +;;; 'paredit-close-parenthesis-and-newline) +;;; +;;; Paredit also changes the bindings of keys for deleting and killing, +;;; so that they will not destroy any S-expression structure by killing +;;; or deleting only one side of a bracket or quote pair. If the point +;;; is on a closing bracket, DEL will move left over it; if it is on an +;;; opening bracket, C-d will move right over it. Only if the point is +;;; between a pair of brackets will C-d or DEL delete them, and in that +;;; case it will delete both simultaneously. M-d and M-DEL kill words, +;;; but skip over any S-expression structure. C-k kills from the start +;;; of the line, either to the line's end, if it contains only balanced +;;; expressions; to the first closing bracket, if the point is within a +;;; form that ends on the line; or up to the end of the last expression +;;; that starts on the line after the point. +;;; +;;; Automatic reindentation is performed as locally as possible, to +;;; ensure that Emacs does not interfere with custom indentation used +;;; elsewhere in some S-expression. It is performed only by the +;;; advanced S-expression frobnication commands, and only on the forms +;;; that were immediately operated upon (& their subforms). +;;; +;;; This code is written for clarity, not efficiency. S-expressions +;;; are frequently walked over redundantly. If you have problems with +;;; some of the commands taking too long to execute, tell me, but first +;;; make sure that what you're doing is reasonable: it is stylistically +;;; bad to have huge, long, hideously nested code anyway. +;;; +;;; Questions, bug reports, comments, feature suggestions, &c., can be +;;; addressed to the author via mail on the host mumble.net to campbell +;;; or via IRC on irc.freenode.net in the #paredit channel under the +;;; nickname Riastradh. + +;;; This assumes Unix-style LF line endings. + +(defconst paredit-version 20) + +(eval-and-compile + + (defun paredit-xemacs-p () + ;; No idea I got this definition from. Edward O'Connor (hober on + ;; IRC) suggested the current definition. + ;; (and (boundp 'running-xemacs) + ;; running-xemacs) + (featurep 'xemacs)) + + (defun paredit-gnu-emacs-p () + (not (paredit-xemacs-p))) + + (defmacro xcond (&rest clauses) + "Exhaustive COND. +Signal an error if no clause matches." + `(cond ,@clauses + (t (error "XCOND lost.")))) + + (defalias 'paredit-warn (if (fboundp 'warn) 'warn 'message)) + + (defvar paredit-sexp-error-type + (with-temp-buffer + (insert "(") + (condition-case condition + (backward-sexp) + (error (if (eq (car condition) 'error) + (paredit-warn "%s%s%s%s" + "Paredit is unable to discriminate" + " S-expression parse errors from" + " other errors. " + " This may cause obscure problems. " + " Please upgrade Emacs.")) + (car condition))))) + + (defmacro paredit-handle-sexp-errors (body &rest handler) + `(condition-case () + ,body + (,paredit-sexp-error-type ,@handler))) + + (put 'paredit-handle-sexp-errors 'lisp-indent-function 1) + + (defmacro paredit-ignore-sexp-errors (&rest body) + `(paredit-handle-sexp-errors (progn ,@body) + nil)) + + (put 'paredit-ignore-sexp-errors 'lisp-indent-function 0) + + nil) + +;;;; Minor Mode Definition + +(defvar paredit-mode-map (make-sparse-keymap) + "Keymap for the paredit minor mode.") + +(define-minor-mode paredit-mode + "Minor mode for pseudo-structurally editing Lisp code. +\\" + :lighter " Paredit" + ;; If we're enabling paredit-mode, the prefix to this code that + ;; DEFINE-MINOR-MODE inserts will have already set PAREDIT-MODE to + ;; true. If this is the case, then first check the parentheses, and + ;; if there are any imbalanced ones we must inhibit the activation of + ;; paredit mode. We skip the check, though, if the user supplied a + ;; prefix argument interactively. + (if (and paredit-mode + (not current-prefix-arg)) + (if (not (fboundp 'check-parens)) + (paredit-warn "`check-parens' is not defined; %s" + "be careful of malformed S-expressions.") + (condition-case condition + (check-parens) + (error (setq paredit-mode nil) + (signal (car condition) (cdr condition))))))) + +;;; Old functions from when there was a different mode for emacs -nw. + +(defun enable-paredit-mode () + "Turn on pseudo-structural editing of Lisp code. + +Deprecated: use `paredit-mode' instead." + (interactive) + (paredit-mode +1)) + +(defun disable-paredit-mode () + "Turn off pseudo-structural editing of Lisp code. + +Deprecated: use `paredit-mode' instead." + (interactive) + (paredit-mode -1)) + +(defvar paredit-backward-delete-key + (xcond ((paredit-xemacs-p) "BS") + ((paredit-gnu-emacs-p) "DEL"))) + +(defvar paredit-forward-delete-keys + (xcond ((paredit-xemacs-p) '("DEL")) + ((paredit-gnu-emacs-p) '("" "")))) + +;;;; Paredit Keys + +;;; Separating the definition and initialization of this variable +;;; simplifies the development of paredit, since re-evaluating DEFVAR +;;; forms doesn't actually do anything. + +(defvar paredit-commands nil + "List of paredit commands with their keys and examples.") + +;;; Each specifier is of the form: +;;; (key[s] function (example-input example-output) ...) +;;; where key[s] is either a single string suitable for passing to KBD +;;; or a list of such strings. Entries in this list may also just be +;;; strings, in which case they are headings for the next entries. + +(progn (setq paredit-commands + `( + "Basic Insertion Commands" + ("(" paredit-open-parenthesis + ("(a b |c d)" + "(a b (|) c d)") + ("(foo \"bar |baz\" quux)" + "(foo \"bar (|baz\" quux)")) + (")" paredit-close-parenthesis-and-newline + ("(defun f (x| ))" + "(defun f (x)\n |)") + ("; (Foo.|" + "; (Foo.)|")) + ("M-)" paredit-close-parenthesis + ("(a b |c )" "(a b c)|") + ("; Hello,| world!" + "; Hello,)| world!")) + ("[" paredit-open-bracket + ("(a b |c d)" + "(a b [|] c d)") + ("(foo \"bar |baz\" quux)" + "(foo \"bar [baz\" quux)")) + ("]" paredit-close-bracket + ("(define-key keymap [frob| ] 'frobnicate)" + "(define-key keymap [frob]| 'frobnicate)") + ("; [Bar.|" + "; [Bar.]|")) + ("\"" paredit-doublequote + ("(frob grovel |full lexical)" + "(frob grovel \"|\" full lexical)") + ("(foo \"bar |baz\" quux)" + "(foo \"bar \\\"|baz\" quux)")) + ("M-\"" paredit-meta-doublequote + ("(foo \"bar |baz\" quux)" + "(foo \"bar baz\"\n |quux)") + ("(foo |(bar #\\x \"baz \\\\ quux\") zot)" + ,(concat "(foo \"|(bar #\\\\x \\\"baz \\\\" + "\\\\ quux\\\")\" zot)"))) + ("\\" paredit-backslash + ("(string #|)\n ; Escaping character... (x)" + "(string #\\x|)") + ("\"foo|bar\"\n ; Escaping character... (\")" + "\"foo\\\"|bar\"")) + (";" paredit-semicolon + ("|(frob grovel)" + ";|\n(frob grovel)") + ("(frob grovel) |" + "(frob grovel) ;|")) + ("M-;" paredit-comment-dwim + ("(foo |bar) ; baz" + "(foo bar) ; |baz") + ("(frob grovel)|" + "(frob grovel) ;|") + (" (foo bar)\n|\n (baz quux)" + " (foo bar)\n ;; |\n (baz quux)") + (" (foo bar) |(baz quux)" + " (foo bar)\n ;; |\n (baz quux)") + ("|(defun hello-world ...)" + ";;; |\n(defun hello-world ...)")) + + ("C-j" paredit-newline + ("(let ((n (frobbotz))) |(display (+ n 1)\nport))" + ,(concat "(let ((n (frobbotz)))" + "\n |(display (+ n 1)" + "\n port))"))) + + "Deleting & Killing" + (("C-d" ,@paredit-forward-delete-keys) + paredit-forward-delete + ("(quu|x \"zot\")" "(quu| \"zot\")") + ("(quux |\"zot\")" + "(quux \"|zot\")" + "(quux \"|ot\")") + ("(foo (|) bar)" "(foo | bar)") + ("|(foo bar)" "(|foo bar)")) + (,paredit-backward-delete-key + paredit-backward-delete + ("(\"zot\" q|uux)" "(\"zot\" |uux)") + ("(\"zot\"| quux)" + "(\"zot|\" quux)" + "(\"zo|\" quux)") + ("(foo (|) bar)" "(foo | bar)") + ("(foo bar)|" "(foo bar|)")) + ("C-k" paredit-kill + ("(foo bar)| ; Useless comment!" + "(foo bar)|") + ("(|foo bar) ; Useful comment!" + "(|) ; Useful comment!") + ("|(foo bar) ; Useless line!" + "|") + ("(foo \"|bar baz\"\n quux)" + "(foo \"|\"\n quux)")) + ("M-d" paredit-forward-kill-word + ("|(foo bar) ; baz" + "(| bar) ; baz" + "(|) ; baz" + "() ;|") + (";;;| Frobnicate\n(defun frobnicate ...)" + ";;;|\n(defun frobnicate ...)" + ";;;\n(| frobnicate ...)")) + (,(concat "M-" paredit-backward-delete-key) + paredit-backward-kill-word + ("(foo bar) ; baz\n(quux)|" + "(foo bar) ; baz\n(|)" + "(foo bar) ; |\n()" + "(foo |) ; \n()" + "(|) ; \n()")) + + "Movement & Navigation" + ("C-M-f" paredit-forward + ("(foo |(bar baz) quux)" + "(foo (bar baz)| quux)") + ("(foo (bar)|)" + "(foo (bar))|")) + ("C-M-b" paredit-backward + ("(foo (bar baz)| quux)" + "(foo |(bar baz) quux)") + ("(|(foo) bar)" + "|((foo) bar)")) +;;;("C-M-u" backward-up-list) ; These two are built-in. +;;;("C-M-d" down-list) + ("C-M-p" backward-down-list) ; Built-in, these are FORWARD- + ("C-M-n" up-list) ; & BACKWARD-LIST, which have + ; no need given C-M-f & C-M-b. + + "Depth-Changing Commands" + ("M-(" paredit-wrap-sexp + ("(foo |bar baz)" + "(foo (|bar) baz)")) + ("M-s" paredit-splice-sexp + ("(foo (bar| baz) quux)" + "(foo bar| baz quux)")) + (("M-" "ESC ") + paredit-splice-sexp-killing-backward + ("(foo (let ((x 5)) |(sqrt n)) bar)" + "(foo (sqrt n) bar)")) + (("M-" "ESC ") + paredit-splice-sexp-killing-forward + ("(a (b c| d e) f)" + "(a b c f)")) + ("M-r" paredit-raise-sexp + ("(dynamic-wind in (lambda () |body) out)" + "(dynamic-wind in |body out)" + "|body")) + + "Barfage & Slurpage" + (("C-)" "C-") + paredit-forward-slurp-sexp + ("(foo (bar |baz) quux zot)" + "(foo (bar |baz quux) zot)") + ("(a b ((c| d)) e f)" + "(a b ((c| d) e) f)")) + (("C-}" "C-") + paredit-forward-barf-sexp + ("(foo (bar |baz quux) zot)" + "(foo (bar |baz) quux zot)")) + (("C-(" "C-M-" "ESC C-") + paredit-backward-slurp-sexp + ("(foo bar (baz| quux) zot)" + "(foo (bar baz| quux) zot)") + ("(a b ((c| d)) e f)" + "(a (b (c| d)) e f)")) + (("C-{" "C-M-" "ESC C-") + paredit-backward-barf-sexp + ("(foo (bar baz |quux) zot)" + "(foo bar (baz |quux) zot)")) + + "Miscellaneous Commands" + ("M-S" paredit-split-sexp + ("(hello| world)" + "(hello)| (world)") + ("\"Hello, |world!\"" + "\"Hello, \"| \"world!\"")) + ("M-J" paredit-join-sexps + ("(hello)| (world)" + "(hello| world)") + ("\"Hello, \"| \"world!\"" + "\"Hello, |world!\"") + ("hello-\n| world" + "hello-|world")) + ("C-c C-M-l" paredit-recentre-on-sexp) + )) + nil) ; end of PROGN + +;;;;; Command Examples + +(eval-and-compile + (defmacro paredit-do-commands (vars string-case &rest body) + (let ((spec (nth 0 vars)) + (keys (nth 1 vars)) + (fn (nth 2 vars)) + (examples (nth 3 vars))) + `(dolist (,spec paredit-commands) + (if (stringp ,spec) + ,string-case + (let ((,keys (let ((k (car ,spec))) + (cond ((stringp k) (list k)) + ((listp k) k) + (t (error "Invalid paredit command %s." + ,spec))))) + (,fn (cadr ,spec)) + (,examples (cddr ,spec))) + ,@body))))) + + (put 'paredit-do-commands 'lisp-indent-function 2)) + +(defun paredit-define-keys () + (paredit-do-commands (spec keys fn examples) + nil ; string case + (dolist (key keys) + (define-key paredit-mode-map (read-kbd-macro key) fn)))) + +(defun paredit-function-documentation (fn) + (let ((original-doc (get fn 'paredit-original-documentation)) + (doc (documentation fn 'function-documentation))) + (or original-doc + (progn (put fn 'paredit-original-documentation doc) + doc)))) + +(defun paredit-annotate-mode-with-examples () + (let ((contents + (list (paredit-function-documentation 'paredit-mode)))) + (paredit-do-commands (spec keys fn examples) + (push (concat "\n \n" spec "\n") + contents) + (let ((name (symbol-name fn))) + (if (string-match (symbol-name 'paredit-) name) + (push (concat "\n\n\\[" name "]\t" name + (if examples + (mapconcat (lambda (example) + (concat + "\n" + (mapconcat 'identity + example + "\n --->\n") + "\n")) + examples + "") + "\n (no examples)\n")) + contents)))) + (put 'paredit-mode 'function-documentation + (apply 'concat (reverse contents)))) + ;; PUT returns the huge string we just constructed, which we don't + ;; want it to return. + nil) + +(defun paredit-annotate-functions-with-examples () + (paredit-do-commands (spec keys fn examples) + nil ; string case + (put fn 'function-documentation + (concat (paredit-function-documentation fn) + "\n\n\\\\[" (symbol-name fn) "]\n" + (mapconcat (lambda (example) + (concat "\n" + (mapconcat 'identity + example + "\n ->\n") + "\n")) + examples + ""))))) + +;;;;; HTML Examples + +(defun paredit-insert-html-examples () + "Insert HTML for a paredit quick reference table." + (interactive) + (let ((insert-lines (lambda (&rest lines) + (mapc (lambda (line) (insert line) (newline)) + lines))) + (html-keys (lambda (keys) + (mapconcat 'paredit-html-quote keys ", "))) + (html-example + (lambda (example) + (concat "
"
+                   (mapconcat 'paredit-html-quote
+                              example
+                              (concat "
" + "    --->" + "
"))
+                   "
"))) + (firstp t)) + (paredit-do-commands (spec keys fn examples) + (progn (if (not firstp) + (insert "\n") + (setq firstp nil)) + (funcall insert-lines + (concat "

" spec "

") + "" + " " + " " + " " + " " + " ")) + (let ((name (symbol-name fn))) + (if (string-match (symbol-name 'paredit-) name) + (funcall insert-lines + " " + (concat " ") + (concat " ") + (concat " ") + " "))))) + (insert "
CommandKeysExamples
" name "" + (funcall html-keys keys) + "" + (if examples + (mapconcat html-example examples + "
") + "(no examples)") + "
\n")) + +(defun paredit-html-quote (string) + (with-temp-buffer + (dotimes (i (length string)) + (insert (let ((c (elt string i))) + (cond ((eq c ?\<) "<") + ((eq c ?\>) ">") + ((eq c ?\&) "&") + ((eq c ?\') "'") + ((eq c ?\") """) + (t c))))) + (buffer-string))) + +;;;; Delimiter Insertion + +(eval-and-compile + (defun paredit-conc-name (&rest strings) + (intern (apply 'concat strings))) + + (defmacro define-paredit-pair (open close name) + `(progn + (defun ,(paredit-conc-name "paredit-open-" name) (&optional n) + ,(concat "Insert a balanced " name " pair. +With a prefix argument N, put the closing " name " after N + S-expressions forward. +If the region is active, `transient-mark-mode' is enabled, and the + region's start and end fall in the same parenthesis depth, insert a + " name " pair around the region. +If in a string or a comment, insert a single " name ". +If in a character literal, do nothing. This prevents changing what was + in the character literal to a meaningful delimiter unintentionally.") + (interactive "P") + (cond ((or (paredit-in-string-p) + (paredit-in-comment-p)) + (insert ,open)) + ((not (paredit-in-char-p)) + (paredit-insert-pair n ,open ,close 'goto-char)))) + (defun ,(paredit-conc-name "paredit-close-" name) () + ,(concat "Move past one closing delimiter and reindent. +\(Agnostic to the specific closing delimiter.) +If in a string or comment, insert a single closing " name ". +If in a character literal, do nothing. This prevents changing what was + in the character literal to a meaningful delimiter unintentionally.") + (interactive) + (paredit-move-past-close ,close)) + (defun ,(paredit-conc-name "paredit-close-" name "-and-newline") () + ,(concat "Move past one closing delimiter, add a newline," + " and reindent. +If there was a margin comment after the closing delimiter, preserve it + on the same line.") + (interactive) + (paredit-move-past-close-and-newline ,close))))) + +(define-paredit-pair ?\( ?\) "parenthesis") +(define-paredit-pair ?\[ ?\] "bracket") +(define-paredit-pair ?\{ ?\} "brace") +(define-paredit-pair ?\< ?\> "brocket") + +(defun paredit-move-past-close (close) + (cond ((or (paredit-in-string-p) + (paredit-in-comment-p)) + (insert close)) + ((not (paredit-in-char-p)) + (paredit-move-past-close-and-reindent) + (paredit-blink-paren-match nil)))) + +(defun paredit-move-past-close-and-newline (close) + (cond ((or (paredit-in-string-p) + (paredit-in-comment-p)) + (insert close)) + (t (if (paredit-in-char-p) (forward-char)) + (paredit-move-past-close-and-reindent) + (let ((comment.point (paredit-find-comment-on-line))) + (newline) + (if comment.point + (save-excursion + (forward-line -1) + (end-of-line) + (indent-to (cdr comment.point)) + (insert (car comment.point))))) + (lisp-indent-line) + (paredit-ignore-sexp-errors (indent-sexp)) + (paredit-blink-paren-match t)))) + +(defun paredit-find-comment-on-line () + "Find a margin comment on the current line. +If such a comment exists, delete the comment (including all leading + whitespace) and return a cons whose car is the comment as a string + and whose cdr is the point of the comment's initial semicolon, + relative to the start of the line." + (save-excursion + (catch 'return + (while t + (if (search-forward ";" (point-at-eol) t) + (if (not (or (paredit-in-string-p) + (paredit-in-char-p))) + (let* ((start (progn (backward-char) ;before semicolon + (point))) + (comment (buffer-substring start + (point-at-eol)))) + (paredit-skip-whitespace nil (point-at-bol)) + (delete-region (point) (point-at-eol)) + (throw 'return + (cons comment (- start (point-at-bol)))))) + (throw 'return nil)))))) + +(defun paredit-insert-pair (n open close forward) + (let* ((regionp (and (paredit-region-active-p) + (paredit-region-safe-for-insert-p))) + (end (and regionp + (not n) + (prog1 (region-end) + (goto-char (region-beginning)))))) + (let ((spacep (paredit-space-for-delimiter-p nil open))) + (if spacep (insert " ")) + (insert open) + (save-excursion + ;; Move past the desired region. + (cond (n (funcall forward + (save-excursion + (forward-sexp (prefix-numeric-value n)) + (point)))) + (regionp (funcall forward (+ end (if spacep 2 1))))) + (insert close) + (if (paredit-space-for-delimiter-p t close) + (insert " ")))))) + +(defun paredit-region-safe-for-insert-p () + (save-excursion + (let ((beginning (region-beginning)) + (end (region-end))) + (goto-char beginning) + (let* ((beginning-state (paredit-current-parse-state)) + (end-state (parse-partial-sexp beginning end + nil nil beginning-state))) + (and (= (nth 0 beginning-state) ; 0. depth in parens + (nth 0 end-state)) + (eq (nth 3 beginning-state) ; 3. non-nil if inside a + (nth 3 end-state)) ; string + (eq (nth 4 beginning-state) ; 4. comment status, yada + (nth 4 end-state)) + (eq (nth 5 beginning-state) ; 5. t if following char + (nth 5 end-state))))))) ; quote + +(defun paredit-space-for-delimiter-p (endp delimiter) + ;; If at the buffer limit, don't insert a space. If there is a word, + ;; symbol, other quote, or non-matching parenthesis delimiter (i.e. a + ;; close when want an open the string or an open when we want to + ;; close the string), do insert a space. + (and (not (if endp (eobp) (bobp))) + (memq (char-syntax (if endp + (char-after) + (char-before))) + (list ?w ?_ ?\" + (let ((matching (matching-paren delimiter))) + (and matching (char-syntax matching))))))) + +(defun paredit-move-past-close-and-reindent () + (let ((orig (point))) + (up-list) + (if (catch 'return ; This CATCH returns T if it + (while t ; should delete leading spaces + (save-excursion ; and NIL if not. + (let ((before-paren (1- (point)))) + (back-to-indentation) + (cond ((not (eq (point) before-paren)) + ;; Can't call PAREDIT-DELETE-LEADING-WHITESPACE + ;; here -- we must return from SAVE-EXCURSION + ;; first. + (throw 'return t)) + ((save-excursion (forward-line -1) + (end-of-line) + (paredit-in-comment-p)) + ;; Moving the closing parenthesis any further + ;; would put it into a comment, so we just + ;; indent the closing parenthesis where it is + ;; and abort the loop, telling its continuation + ;; that no leading whitespace should be deleted. + (lisp-indent-line) + (throw 'return nil)) + (t (delete-indentation))))))) + (paredit-delete-leading-whitespace)))) + +(defun paredit-delete-leading-whitespace () + ;; This assumes that we're on the closing parenthesis already. + (save-excursion + (backward-char) + (while (let ((syn (char-syntax (char-before)))) + (and (or (eq syn ?\ ) (eq syn ?-)) ; whitespace syntax + ;; The above line is a perfect example of why the + ;; following test is necessary. + (not (paredit-in-char-p (1- (point)))))) + (backward-delete-char 1)))) + +(defun paredit-blink-paren-match (another-line-p) + (if (and blink-matching-paren + (or (not show-paren-mode) another-line-p)) + (paredit-ignore-sexp-errors + (save-excursion + (backward-sexp) + (forward-sexp) + ;; SHOW-PAREN-MODE inhibits any blinking, so we disable it + ;; locally here. + (let ((show-paren-mode nil)) + (blink-matching-open)))))) + +(defun paredit-doublequote (&optional n) + "Insert a pair of double-quotes. +With a prefix argument N, wrap the following N S-expressions in + double-quotes, escaping intermediate characters if necessary. +If the region is active, `transient-mark-mode' is enabled, and the + region's start and end fall in the same parenthesis depth, insert a + pair of double-quotes around the region, again escaping intermediate + characters if necessary. +Inside a comment, insert a literal double-quote. +At the end of a string, move past the closing double-quote. +In the middle of a string, insert a backslash-escaped double-quote. +If in a character literal, do nothing. This prevents accidentally + changing a what was in the character literal to become a meaningful + delimiter unintentionally." + (interactive "P") + (cond ((paredit-in-string-p) + (if (eq (cdr (paredit-string-start+end-points)) + (point)) + (forward-char) ; We're on the closing quote. + (insert ?\\ ?\" ))) + ((paredit-in-comment-p) + (insert ?\" )) + ((not (paredit-in-char-p)) + (paredit-insert-pair n ?\" ?\" 'paredit-forward-for-quote)))) + +(defun paredit-meta-doublequote (&optional n) + "Move to the end of the string, insert a newline, and indent. +If not in a string, act as `paredit-doublequote'; if no prefix argument + is specified and the region is not active or `transient-mark-mode' is + disabled, the default is to wrap one S-expression, however, not + zero." + (interactive "P") + (if (not (paredit-in-string-p)) + (paredit-doublequote (or n + (and (not (paredit-region-active-p)) + 1))) + (let ((start+end (paredit-string-start+end-points))) + (goto-char (1+ (cdr start+end))) + (newline) + (lisp-indent-line) + (paredit-ignore-sexp-errors (indent-sexp))))) + +(defun paredit-forward-for-quote (end) + (let ((state (paredit-current-parse-state))) + (while (< (point) end) + (let ((new-state (parse-partial-sexp (point) (1+ (point)) + nil nil state))) + (if (paredit-in-string-p new-state) + (if (not (paredit-in-string-escape-p)) + (setq state new-state) + ;; Escape character: turn it into an escaped escape + ;; character by appending another backslash. + (insert ?\\ ) + ;; Now the point is after both escapes, and we want to + ;; rescan from before the first one to after the second + ;; one. + (setq state + (parse-partial-sexp (- (point) 2) (point) + nil nil state)) + ;; Advance the end point, since we just inserted a new + ;; character. + (setq end (1+ end))) + ;; String: escape by inserting a backslash before the quote. + (backward-char) + (insert ?\\ ) + ;; The point is now between the escape and the quote, and we + ;; want to rescan from before the escape to after the quote. + (setq state + (parse-partial-sexp (1- (point)) (1+ (point)) + nil nil state)) + ;; Advance the end point for the same reason as above. + (setq end (1+ end))))))) + +;;;; Escape Insertion + +(defun paredit-backslash () + "Insert a backslash followed by a character to escape." + (interactive) + (insert ?\\ ) + ;; This funny conditional is necessary because PAREDIT-IN-COMMENT-P + ;; assumes that PAREDIT-IN-STRING-P already returned false; otherwise + ;; it may give erroneous answers. + (if (or (paredit-in-string-p) + (not (paredit-in-comment-p))) + (let ((delp t)) + (unwind-protect (setq delp + (call-interactively 'paredit-escape)) + ;; We need this in an UNWIND-PROTECT so that the backlash is + ;; left in there *only* if PAREDIT-ESCAPE return NIL normally + ;; -- in any other case, such as the user hitting C-g or an + ;; error occurring, we must delete the backslash to avoid + ;; leaving a dangling escape. (This control structure is a + ;; crock.) + (if delp (backward-delete-char 1)))))) + +;;; This auxiliary interactive function returns true if the backslash +;;; should be deleted and false if not. + +(defun paredit-escape (char) + ;; I'm too lazy to figure out how to do this without a separate + ;; interactive function. + (interactive "cEscaping character...") + (if (eq char 127) ; The backslash was a typo, so + t ; the luser wants to delete it. + (insert char) ; (Is there a better way to + nil)) ; express the rubout char? + ; ?\^? works, but ugh...) + +;;; The placement of this function in this file is totally random. + +(defun paredit-newline () + "Insert a newline and indent it. +This is like `newline-and-indent', but it not only indents the line + that the point is on but also the S-expression following the point, + if there is one. +Move forward one character first if on an escaped character. +If in a string, just insert a literal newline." + (interactive) + (if (paredit-in-string-p) + (newline) + (if (and (not (paredit-in-comment-p)) (paredit-in-char-p)) + (forward-char)) + (newline-and-indent) + ;; Indent the following S-expression, but don't signal an error if + ;; there's only a closing parenthesis after the point. + (paredit-ignore-sexp-errors (indent-sexp)))) + +;;;; Comment Insertion + +(defun paredit-semicolon (&optional n) + "Insert a semicolon, moving any code after the point to a new line. +If in a string, comment, or character literal, insert just a literal + semicolon, and do not move anything to the next line. +With a prefix argument N, insert N semicolons." + (interactive "P") + (if (not (or (paredit-in-string-p) + (paredit-in-comment-p) + (paredit-in-char-p) + ;; No more code on the line after the point. + (save-excursion + (paredit-skip-whitespace t (point-at-eol)) + (or (eolp) + ;; Let the user prefix semicolons to existing + ;; comments. + (eq (char-after) ?\;))))) + ;; Don't use NEWLINE-AND-INDENT, because that will delete all of + ;; the horizontal whitespace first, but we just want to move the + ;; code following the point onto the next line while preserving + ;; the point on this line. + ;++ Why indent only the line? + (save-excursion (newline) (lisp-indent-line))) + (insert (make-string (if n (prefix-numeric-value n) 1) + ?\; ))) + +(defun paredit-comment-dwim (&optional arg) + "Call the Lisp comment command you want (Do What I Mean). +This is like `comment-dwim', but it is specialized for Lisp editing. +If transient mark mode is enabled and the mark is active, comment or + uncomment the selected region, depending on whether it was entirely + commented not not already. +If there is already a comment on the current line, with no prefix + argument, indent to that comment; with a prefix argument, kill that + comment. +Otherwise, insert a comment appropriate for the context and ensure that + any code following the comment is moved to the next line. +At the top level, where indentation is calculated to be at column 0, + insert a triple-semicolon comment; within code, where the indentation + is calculated to be non-zero, and on the line there is either no code + at all or code after the point, insert a double-semicolon comment; + and if the point is after all code on the line, insert a single- + semicolon margin comment at `comment-column'." + (interactive "*P") + (require 'newcomment) + (comment-normalize-vars) + (cond ((paredit-region-active-p) + (comment-or-uncomment-region (region-beginning) + (region-end) + arg)) + ((paredit-comment-on-line-p) + (if arg + (comment-kill (if (integerp arg) arg nil)) + (comment-indent))) + (t (paredit-insert-comment)))) + +(defun paredit-comment-on-line-p () + (save-excursion + (beginning-of-line) + (let ((comment-p nil)) + ;; Search forward for a comment beginning. If there is one, set + ;; COMMENT-P to true; if not, it will be nil. + (while (progn (setq comment-p + (search-forward ";" (point-at-eol) + ;; t -> no error + t)) + (and comment-p + (or (paredit-in-string-p) + (paredit-in-char-p (1- (point)))))) + (forward-char)) + comment-p))) + +(defun paredit-insert-comment () + (let ((code-after-p + (save-excursion (paredit-skip-whitespace t (point-at-eol)) + (not (eolp)))) + (code-before-p + (save-excursion (paredit-skip-whitespace nil (point-at-bol)) + (not (bolp))))) + (if (and (bolp) + ;; We have to use EQ 0 here and not ZEROP because ZEROP + ;; signals an error if its argument is non-numeric, but + ;; CALCULATE-LISP-INDENT may return nil. + (eq (let ((indent (calculate-lisp-indent))) + (if (consp indent) + (car indent) + indent)) + 0)) + ;; Top-level comment + (progn (if code-after-p (save-excursion (newline))) + (insert ";;; ")) + (if code-after-p + ;; Code comment + (progn (if code-before-p + ;++ Why NEWLINE-AND-INDENT here and not just + ;++ NEWLINE, or PAREDIT-NEWLINE? + (newline-and-indent)) + (lisp-indent-line) + (insert ";; ") + ;; Move the following code. (NEWLINE-AND-INDENT will + ;; delete whitespace after the comment, though, so use + ;; NEWLINE & LISP-INDENT-LINE manually here.) + (save-excursion (newline) + (lisp-indent-line))) + ;; Margin comment + (progn (indent-to comment-column + 1) ; 1 -> force one leading space + (insert ?\; )))))) + +;;;; Character Deletion + +(defun paredit-forward-delete (&optional arg) + "Delete a character forward or move forward over a delimiter. +If on an opening S-expression delimiter, move forward into the + S-expression. +If on a closing S-expression delimiter, refuse to delete unless the + S-expression is empty, in which case delete the whole S-expression. +With a prefix argument, simply delete a character forward, without + regard for delimiter balancing." + (interactive "P") + (cond ((or arg (eobp)) + (delete-char 1)) + ((paredit-in-string-p) + (paredit-forward-delete-in-string)) + ((paredit-in-comment-p) + ;++ What to do here? This could move a partial S-expression + ;++ into a comment and thereby invalidate the file's form, + ;++ or move random text out of a comment. + (delete-char 1)) + ((paredit-in-char-p) ; Escape -- delete both chars. + (backward-delete-char 1) + (delete-char 1)) + ((eq (char-after) ?\\ ) ; ditto + (delete-char 2)) + ((let ((syn (char-syntax (char-after)))) + (or (eq syn ?\( ) + (eq syn ?\" ))) + (forward-char)) + ((and (not (paredit-in-char-p (1- (point)))) + (eq (char-syntax (char-after)) ?\) ) + (eq (char-before) (matching-paren (char-after)))) + (backward-delete-char 1) ; Empty list -- delete both + (delete-char 1)) ; delimiters. + ;; Just delete a single character, if it's not a closing + ;; parenthesis. (The character literal case is already + ;; handled by now.) + ((not (eq (char-syntax (char-after)) ?\) )) + (delete-char 1)))) + +(defun paredit-forward-delete-in-string () + (let ((start+end (paredit-string-start+end-points))) + (cond ((not (eq (point) (cdr start+end))) + ;; If it's not the close-quote, it's safe to delete. But + ;; first handle the case that we're in a string escape. + (cond ((paredit-in-string-escape-p) + ;; We're right after the backslash, so backward + ;; delete it before deleting the escaped character. + (backward-delete-char 1)) + ((eq (char-after) ?\\ ) + ;; If we're not in a string escape, but we are on a + ;; backslash, it must start the escape for the next + ;; character, so delete the backslash before deleting + ;; the next character. + (delete-char 1))) + (delete-char 1)) + ((eq (1- (point)) (car start+end)) + ;; If it is the close-quote, delete only if we're also right + ;; past the open-quote (i.e. it's empty), and then delete + ;; both quotes. Otherwise we refuse to delete it. + (backward-delete-char 1) + (delete-char 1))))) + +(defun paredit-backward-delete (&optional arg) + "Delete a character backward or move backward over a delimiter. +If on a closing S-expression delimiter, move backward into the + S-expression. +If on an opening S-expression delimiter, refuse to delete unless the + S-expression is empty, in which case delete the whole S-expression. +With a prefix argument, simply delete a character backward, without + regard for delimiter balancing." + (interactive "P") + (cond ((or arg (bobp)) + (backward-delete-char 1)) ;++ should this untabify? + ((paredit-in-string-p) + (paredit-backward-delete-in-string)) + ((paredit-in-comment-p) + (backward-delete-char 1)) + ((paredit-in-char-p) ; Escape -- delete both chars. + (backward-delete-char 1) + (delete-char 1)) + ((paredit-in-char-p (1- (point))) + (backward-delete-char 2)) ; ditto + ((let ((syn (char-syntax (char-before)))) + (or (eq syn ?\) ) + (eq syn ?\" ))) + (backward-char)) + ((and (eq (char-syntax (char-before)) ?\( ) + (eq (char-after) (matching-paren (char-before)))) + (backward-delete-char 1) ; Empty list -- delete both + (delete-char 1)) ; delimiters. + ;; Delete it, unless it's an opening parenthesis. The case + ;; of character literals is already handled by now. + ((not (eq (char-syntax (char-before)) ?\( )) + (backward-delete-char-untabify 1)))) + +(defun paredit-backward-delete-in-string () + (let ((start+end (paredit-string-start+end-points))) + (cond ((not (eq (1- (point)) (car start+end))) + ;; If it's not the open-quote, it's safe to delete. + (if (paredit-in-string-escape-p) + ;; If we're on a string escape, since we're about to + ;; delete the backslash, we must first delete the + ;; escaped char. + (delete-char 1)) + (backward-delete-char 1) + (if (paredit-in-string-escape-p) + ;; If, after deleting a character, we find ourselves in + ;; a string escape, we must have deleted the escaped + ;; character, and the backslash is behind the point, so + ;; backward delete it. + (backward-delete-char 1))) + ((eq (point) (cdr start+end)) + ;; If it is the open-quote, delete only if we're also right + ;; past the close-quote (i.e. it's empty), and then delete + ;; both quotes. Otherwise we refuse to delete it. + (backward-delete-char 1) + (delete-char 1))))) + +;;;; Killing + +(defun paredit-kill (&optional arg) + "Kill a line as if with `kill-line', but respecting delimiters. +In a string, act exactly as `kill-line' but do not kill past the + closing string delimiter. +On a line with no S-expressions on it starting after the point or + within a comment, act exactly as `kill-line'. +Otherwise, kill all S-expressions that start after the point." + (interactive "P") + (cond (arg (kill-line)) + ((paredit-in-string-p) + (paredit-kill-line-in-string)) + ((or (paredit-in-comment-p) + (save-excursion + (paredit-skip-whitespace t (point-at-eol)) + (or (eq (char-after) ?\; ) + (eolp)))) + ;** Be careful about trailing backslashes. + (kill-line)) + (t (paredit-kill-sexps-on-line)))) + +(defun paredit-kill-line-in-string () + (if (save-excursion (paredit-skip-whitespace t (point-at-eol)) + (eolp)) + (kill-line) + (save-excursion + ;; Be careful not to split an escape sequence. + (if (paredit-in-string-escape-p) + (backward-char)) + (let ((beginning (point))) + (while (not (or (eolp) + (eq (char-after) ?\" ))) + (forward-char) + ;; Skip past escaped characters. + (if (eq (char-before) ?\\ ) + (forward-char))) + (kill-region beginning (point)))))) + +(defun paredit-kill-sexps-on-line () + (if (paredit-in-char-p) ; Move past the \ and prefix. + (backward-char 2)) ; (# in Scheme/CL, ? in elisp) + (let ((beginning (point)) + (eol (point-at-eol))) + (let ((end-of-list-p (paredit-forward-sexps-to-kill beginning eol))) + ;; If we got to the end of the list and it's on the same line, + ;; move backward past the closing delimiter before killing. (This + ;; allows something like killing the whitespace in ( ).) + (if end-of-list-p (progn (up-list) (backward-char))) + (if kill-whole-line + (paredit-kill-sexps-on-whole-line beginning) + (kill-region beginning + ;; If all of the S-expressions were on one line, + ;; i.e. we're still on that line after moving past + ;; the last one, kill the whole line, including + ;; any comments; otherwise just kill to the end of + ;; the last S-expression we found. Be sure, + ;; though, not to kill any closing parentheses. + (if (and (not end-of-list-p) + (eq (point-at-eol) eol)) + eol + (point))))))) + +;;; Please do not try to understand this code unless you have a VERY +;;; good reason to do so. I gave up trying to figure it out well +;;; enough to explain it, long ago. + +(defun paredit-forward-sexps-to-kill (beginning eol) + (let ((end-of-list-p nil) + (firstp t)) + ;; Move to the end of the last S-expression that started on this + ;; line, or to the closing delimiter if the last S-expression in + ;; this list is on the line. + (catch 'return + (while t + ;; This and the `kill-whole-line' business below fix a bug that + ;; inhibited any S-expression at the very end of the buffer + ;; (with no trailing newline) from being deleted. It's a + ;; bizarre fix that I ought to document at some point, but I am + ;; too busy at the moment to do so. + (if (and kill-whole-line (eobp)) (throw 'return nil)) + (save-excursion + (paredit-handle-sexp-errors (forward-sexp) + (up-list) + (setq end-of-list-p (eq (point-at-eol) eol)) + (throw 'return nil)) + (if (or (and (not firstp) + (not kill-whole-line) + (eobp)) + (paredit-handle-sexp-errors + (progn (backward-sexp) nil) + t) + (not (eq (point-at-eol) eol))) + (throw 'return nil))) + (forward-sexp) + (if (and firstp + (not kill-whole-line) + (eobp)) + (throw 'return nil)) + (setq firstp nil))) + end-of-list-p)) + +(defun paredit-kill-sexps-on-whole-line (beginning) + (kill-region beginning + (or (save-excursion ; Delete trailing indentation... + (paredit-skip-whitespace t) + (and (not (eq (char-after) ?\; )) + (point))) + ;; ...or just use the point past the newline, if + ;; we encounter a comment. + (point-at-eol))) + (cond ((save-excursion (paredit-skip-whitespace nil (point-at-bol)) + (bolp)) + ;; Nothing but indentation before the point, so indent it. + (lisp-indent-line)) + ((eobp) nil) ; Protect the CHAR-SYNTAX below against NIL. + ;; Insert a space to avoid invalid joining if necessary. + ((let ((syn-before (char-syntax (char-before))) + (syn-after (char-syntax (char-after)))) + (or (and (eq syn-before ?\) ) ; Separate opposing + (eq syn-after ?\( )) ; parentheses, + (and (eq syn-before ?\" ) ; string delimiter + (eq syn-after ?\" )) ; pairs, + (and (memq syn-before '(?_ ?w)) ; or word or symbol + (memq syn-after '(?_ ?w))))) ; constituents. + (insert " ")))) + +;;;;; Killing Words + +;;; This is tricky and asymmetrical because backward parsing is +;;; extraordinarily difficult or impossible, so we have to implement +;;; killing in both directions by parsing forward. + +(defun paredit-forward-kill-word () + "Kill a word forward, skipping over intervening delimiters." + (interactive) + (let ((beginning (point))) + (skip-syntax-forward " -") + (let* ((parse-state (paredit-current-parse-state)) + (state (paredit-kill-word-state parse-state 'char-after))) + (while (not (or (eobp) + (eq ?w (char-syntax (char-after))))) + (setq parse-state + (progn (forward-char 1) (paredit-current-parse-state)) +;; (parse-partial-sexp (point) (1+ (point)) +;; nil nil parse-state) + ) + (let* ((old-state state) + (new-state + (paredit-kill-word-state parse-state 'char-after))) + (cond ((not (eq old-state new-state)) + (setq parse-state + (paredit-kill-word-hack old-state + new-state + parse-state)) + (setq state + (paredit-kill-word-state parse-state + 'char-after)) + (setq beginning (point))))))) + (goto-char beginning) + (kill-word 1))) + +(defun paredit-backward-kill-word () + "Kill a word backward, skipping over any intervening delimiters." + (interactive) + (if (not (or (bobp) + (eq (char-syntax (char-before)) ?w))) + (let ((end (point))) + (backward-word 1) + (forward-word 1) + (goto-char (min end (point))) + (let* ((parse-state (paredit-current-parse-state)) + (state + (paredit-kill-word-state parse-state 'char-before))) + (while (and (< (point) end) + (progn + (setq parse-state + (parse-partial-sexp (point) (1+ (point)) + nil nil parse-state)) + (or (eq state + (paredit-kill-word-state parse-state + 'char-before)) + (progn (backward-char 1) nil))))) + (if (and (eq state 'comment) + (eq ?\# (char-after (point))) + (eq ?\| (char-before (point)))) + (backward-char 1))))) + (backward-kill-word 1)) + +;;; Word-Killing Auxiliaries + +(defun paredit-kill-word-state (parse-state adjacent-char-fn) + (cond ((paredit-in-comment-p parse-state) 'comment) + ((paredit-in-string-p parse-state) 'string) + ((memq (char-syntax (funcall adjacent-char-fn)) + '(?\( ?\) )) + 'delimiter) + (t 'other))) + +;;; This optionally advances the point past any comment delimiters that +;;; should probably not be touched, based on the last state change and +;;; the characters around the point. It returns a new parse state, +;;; starting from the PARSE-STATE parameter. + +(defun paredit-kill-word-hack (old-state new-state parse-state) + (cond ((and (not (eq old-state 'comment)) + (not (eq new-state 'comment)) + (not (paredit-in-string-escape-p)) + (eq ?\# (char-before)) + (eq ?\| (char-after))) + (forward-char 1) + (paredit-current-parse-state) +;; (parse-partial-sexp (point) (1+ (point)) +;; nil nil parse-state) + ) + ((and (not (eq old-state 'comment)) + (eq new-state 'comment) + (eq ?\; (char-before))) + (skip-chars-forward ";") + (paredit-current-parse-state) +;; (parse-partial-sexp (point) (save-excursion +;; (skip-chars-forward ";")) +;; nil nil parse-state) + ) + (t parse-state))) + +;;;; Cursor and Screen Movement + +(eval-and-compile + (defmacro defun-saving-mark (name bvl doc &rest body) + `(defun ,name ,bvl + ,doc + ,(xcond ((paredit-xemacs-p) + '(interactive "_")) + ((paredit-gnu-emacs-p) + '(interactive))) + ,@body))) + +(defun-saving-mark paredit-forward () + "Move forward an S-expression, or up an S-expression forward. +If there are no more S-expressions in this one before the closing + delimiter, move past that closing delimiter; otherwise, move forward + past the S-expression following the point." + (paredit-handle-sexp-errors + (forward-sexp) + ;++ Is it necessary to use UP-LIST and not just FORWARD-CHAR? + (if (paredit-in-string-p) (forward-char) (up-list)))) + +(defun-saving-mark paredit-backward () + "Move backward an S-expression, or up an S-expression backward. +If there are no more S-expressions in this one before the opening + delimiter, move past that opening delimiter backward; otherwise, move + move backward past the S-expression preceding the point." + (paredit-handle-sexp-errors + (backward-sexp) + (if (paredit-in-string-p) (backward-char) (backward-up-list)))) + +;;; Why is this not in lisp.el? + +(defun backward-down-list (&optional arg) + "Move backward and descend into one level of parentheses. +With ARG, do this that many times. +A negative argument means move forward but still descend a level." + (interactive "p") + (down-list (- (or arg 1)))) + +;;; Thanks to Marco Baringer for suggesting & writing this function. + +(defun paredit-recentre-on-sexp (&optional n) + "Recentre the screen on the S-expression following the point. +With a prefix argument N, encompass all N S-expressions forward." + (interactive "P") + (save-excursion + (forward-sexp n) + (let ((end-point (point))) + (backward-sexp n) + (let* ((start-point (point)) + (start-line (count-lines (point-min) (point))) + (lines-on-sexps (count-lines start-point end-point))) + (goto-line (+ start-line (/ lines-on-sexps 2))) + (recenter))))) + +;;;; Depth-Changing Commands: Wrapping, Splicing, & Raising + +(defun paredit-wrap-sexp (&optional n) + "Wrap the following S-expression in a list. +If a prefix argument N is given, wrap N S-expressions. +Automatically indent the newly wrapped S-expression. +As a special case, if the point is at the end of a list, simply insert + a pair of parentheses, rather than insert a lone opening parenthesis + and then signal an error, in the interest of preserving structure." + (interactive "P") + (paredit-handle-sexp-errors + (paredit-insert-pair (or n + (and (not (paredit-region-active-p)) + 1)) + ?\( ?\) + 'goto-char) + (insert ?\) ) + (backward-char)) + (save-excursion (backward-up-list) (indent-sexp))) + +;;; Thanks to Marco Baringer for the suggestion of a prefix argument +;;; for PAREDIT-SPLICE-SEXP. (I, Taylor R. Campbell, however, still +;;; implemented it, in case any of you lawyer-folk get confused by the +;;; remark in the top of the file about explicitly noting code written +;;; by other people.) + +(defun paredit-splice-sexp (&optional arg) + "Splice the list that the point is on by removing its delimiters. +With a prefix argument as in `C-u', kill all S-expressions backward in + the current list before splicing all S-expressions forward into the + enclosing list. +With two prefix arguments as in `C-u C-u', kill all S-expressions + forward in the current list before splicing all S-expressions + backward into the enclosing list. +With a numerical prefix argument N, kill N S-expressions backward in + the current list before splicing the remaining S-expressions into the + enclosing list. If N is negative, kill forward. +This always creates a new entry on the kill ring." + (interactive "P") + (save-excursion + (paredit-kill-surrounding-sexps-for-splice arg) + (backward-up-list) ; Go up to the beginning... + (save-excursion + (forward-sexp) ; Go forward an expression, to + (backward-delete-char 1)) ; delete the end delimiter. + (delete-char 1) ; ...to delete the open char. + (paredit-ignore-sexp-errors + (backward-up-list) ; Reindent, now that the + (indent-sexp)))) ; structure has changed. + +(defun paredit-kill-surrounding-sexps-for-splice (arg) + (cond ((paredit-in-string-p) (error "Splicing illegal in strings.")) + ((or (not arg) (eq arg 0)) nil) + ((or (numberp arg) (eq arg '-)) + ;; Kill ARG S-expressions before/after the point by saving + ;; the point, moving across them, and killing the region. + (let* ((arg (if (eq arg '-) -1 arg)) + (saved (paredit-point-at-sexp-boundary (- arg)))) + (paredit-ignore-sexp-errors (backward-sexp arg)) + (kill-region-new saved (point)))) + ((consp arg) + (let ((v (car arg))) + (if (= v 4) ; one prefix argument + ;; Move backward until we hit the open paren; then + ;; kill that selected region. + (let ((end (paredit-point-at-sexp-start))) + (paredit-ignore-sexp-errors + (while (not (bobp)) + (backward-sexp))) + (kill-region-new (point) end)) + ;; Move forward until we hit the close paren; then + ;; kill that selected region. + (let ((beginning (paredit-point-at-sexp-end))) + (paredit-ignore-sexp-errors + (while (not (eobp)) + (forward-sexp))) + (kill-region-new beginning (point)))))) + (t (error "Bizarre prefix argument: %s" arg)))) + +(defun paredit-splice-sexp-killing-backward (&optional n) + "Splice the list the point is on by removing its delimiters, and + also kill all S-expressions before the point in the current list. +With a prefix argument N, kill only the preceding N S-expressions." + (interactive "P") + (paredit-splice-sexp (if n + (prefix-numeric-value n) + '(4)))) + +(defun paredit-splice-sexp-killing-forward (&optional n) + "Splice the list the point is on by removing its delimiters, and + also kill all S-expressions after the point in the current list. +With a prefix argument N, kill only the following N S-expressions." + (interactive "P") + (paredit-splice-sexp (if n + (- (prefix-numeric-value n)) + '(16)))) + +(defun paredit-raise-sexp (&optional n) + "Raise the following S-expression in a tree, deleting its siblings. +With a prefix argument N, raise the following N S-expressions. If N + is negative, raise the preceding N S-expressions." + (interactive "p") + ;; Select the S-expressions we want to raise in a buffer substring. + (let* ((bound (save-excursion (forward-sexp n) (point))) + (sexps (save-excursion ;++ Is this necessary? + (if (and n (< n 0)) + (buffer-substring bound + (paredit-point-at-sexp-end)) + (buffer-substring (paredit-point-at-sexp-start) + bound))))) + ;; Move up to the list we're raising those S-expressions out of and + ;; delete it. + (backward-up-list) + (delete-region (point) (save-excursion (forward-sexp) (point))) + (save-excursion (insert sexps)) ; Insert & reindent the sexps. + (save-excursion (let ((n (abs (or n 1)))) + (while (> n 0) + (paredit-forward-and-indent) + (setq n (1- n))))))) + +;;;; Slurpage & Barfage + +(defun paredit-forward-slurp-sexp () + "Add the S-expression following the current list into that list + by moving the closing delimiter. +Automatically reindent the newly slurped S-expression with respect to + its new enclosing form. +If in a string, move the opening double-quote forward by one + S-expression and escape any intervening characters as necessary, + without altering any indentation or formatting." + (interactive) + (save-excursion + (cond ((or (paredit-in-comment-p) + (paredit-in-char-p)) + (error "Invalid context for slurpage")) + ((paredit-in-string-p) + (paredit-forward-slurp-into-string)) + (t + (paredit-forward-slurp-into-list))))) + +(defun paredit-forward-slurp-into-list () + (up-list) ; Up to the end of the list to + (let ((close (char-before))) ; save and delete the closing + (backward-delete-char 1) ; delimiter. + (catch 'return ; Go to the end of the desired + (while t ; S-expression, going up a + (paredit-handle-sexp-errors ; list if it's not in this, + (progn (paredit-forward-and-indent) + (throw 'return nil)) + (up-list)))) + (insert close))) ; to insert that delimiter. + +(defun paredit-forward-slurp-into-string () + (goto-char (1+ (cdr (paredit-string-start+end-points)))) + ;; Signal any errors that we might get first, before mucking with the + ;; buffer's contents. + (save-excursion (forward-sexp)) + (let ((close (char-before))) + (backward-delete-char 1) + (paredit-forward-for-quote (save-excursion (forward-sexp) (point))) + (insert close))) + +(defun paredit-forward-barf-sexp () + "Remove the last S-expression in the current list from that list + by moving the closing delimiter. +Automatically reindent the newly barfed S-expression with respect to + its new enclosing form." + (interactive) + (save-excursion + (up-list) ; Up to the end of the list to + (let ((close (char-before))) ; save and delete the closing + (backward-delete-char 1) ; delimiter. + (paredit-ignore-sexp-errors ; Go back to where we want to + (backward-sexp)) ; insert the delimiter. + (paredit-skip-whitespace nil) ; Skip leading whitespace. + (cond ((bobp) + (error "Barfing all subexpressions with no open-paren?")) + ((paredit-in-comment-p) ; Don't put the close-paren in + (newline-and-indent))) ; a comment. + (insert close)) + ;; Reindent all of the newly barfed S-expressions. + (paredit-forward-and-indent))) + +(defun paredit-backward-slurp-sexp () + "Add the S-expression preceding the current list into that list + by moving the closing delimiter. +Automatically reindent the whole form into which new S-expression was + slurped. +If in a string, move the opening double-quote backward by one + S-expression and escape any intervening characters as necessary, + without altering any indentation or formatting." + (interactive) + (save-excursion + (cond ((or (paredit-in-comment-p) + (paredit-in-char-p)) + (error "Invalid context for slurpage")) + ((paredit-in-string-p) + (paredit-backward-slurp-into-string)) + (t + (paredit-backward-slurp-into-list))))) + +(defun paredit-backward-slurp-into-list () + (backward-up-list) + (let ((open (char-after))) + (delete-char 1) + (catch 'return + (while t + (paredit-handle-sexp-errors + (progn (backward-sexp) + (throw 'return nil)) + (backward-up-list)))) + (insert open)) + ;; Reindent the line at the beginning of wherever we inserted the + ;; opening parenthesis, and then indent the whole S-expression. + (backward-up-list) + (lisp-indent-line) + (indent-sexp)) + +(defun paredit-backward-slurp-into-string () + (goto-char (car (paredit-string-start+end-points))) + ;; Signal any errors that we might get first, before mucking with the + ;; buffer's contents. + (save-excursion (backward-sexp)) + (let ((open (char-after)) + (target (point))) + (message "open = %S" open) + (delete-char 1) + (backward-sexp) + (insert open) + (paredit-forward-for-quote target))) + +(defun paredit-backward-barf-sexp () + "Remove the first S-expression in the current list from that list + by moving the closing delimiter. +Automatically reindent the barfed S-expression and the form from which + it was barfed." + (interactive) + (save-excursion + (backward-up-list) + (let ((open (char-after))) + (delete-char 1) + (paredit-ignore-sexp-errors + (paredit-forward-and-indent)) + (while (progn (paredit-skip-whitespace t) + (eq (char-after) ?\; )) + (forward-line 1)) + (if (eobp) + (error + "Barfing all subexpressions with no close-paren?")) + ;** Don't use `insert' here. Consider, e.g., barfing from + ;** (foo|) + ;** and how `save-excursion' works. + (insert-before-markers open)) + (backward-up-list) + (lisp-indent-line) + (indent-sexp))) + +;;;; Splitting & Joining + +(defun paredit-split-sexp () + "Split the list or string the point is on into two." + (interactive) + (cond ((paredit-in-string-p) + (insert "\"") + (save-excursion (insert " \""))) + ((or (paredit-in-comment-p) + (paredit-in-char-p)) + (error "Invalid context for `paredit-split-sexp'")) + (t (let ((open (save-excursion (backward-up-list) + (char-after))) + (close (save-excursion (up-list) + (char-before)))) + (delete-horizontal-space) + (insert close) + (save-excursion (insert ?\ ) + (insert open) + (backward-char) + (indent-sexp)))))) + +(defun paredit-join-sexps () + "Join the S-expressions adjacent on either side of the point. +Both must be lists, strings, or atoms; error if there is a mismatch." + (interactive) + ;++ How ought this to handle comments intervening symbols or strings? + (save-excursion + (if (or (paredit-in-comment-p) + (paredit-in-string-p) + (paredit-in-char-p)) + (error "Invalid context in which to join S-expressions.") + (let ((left-point (save-excursion (paredit-point-at-sexp-end))) + (right-point (save-excursion + (paredit-point-at-sexp-start)))) + (let ((left-char (char-before left-point)) + (right-char (char-after right-point))) + (let ((left-syntax (char-syntax left-char)) + (right-syntax (char-syntax right-char))) + (cond ((>= left-point right-point) + (error "Can't join a datum with itself.")) + ((and (eq left-syntax ?\) ) + (eq right-syntax ?\( ) + (eq left-char (matching-paren right-char)) + (eq right-char (matching-paren left-char))) + ;; Leave intermediate formatting alone. + (goto-char right-point) + (delete-char 1) + (goto-char left-point) + (backward-delete-char 1) + (backward-up-list) + (indent-sexp)) + ((and (eq left-syntax ?\" ) + (eq right-syntax ?\" )) + ;; Delete any intermediate formatting. + (delete-region (1- left-point) + (1+ right-point))) + ((and (memq left-syntax '(?w ?_)) ; Word or symbol + (memq right-syntax '(?w ?_))) + (delete-region left-point right-point)) + (t + (error "Mismatched S-expressions to join."))))))))) + +;;;; Utilities + +(defun paredit-in-string-escape-p () + "True if the point is on a character escape of a string. +This is true only if the character is preceded by an odd number of + backslashes. +This assumes that `paredit-in-string-p' has already returned true." + (let ((oddp nil)) + (save-excursion + (while (eq (char-before) ?\\ ) + (setq oddp (not oddp)) + (backward-char))) + oddp)) + +(defun paredit-in-char-p (&optional arg) + "True if the point is immediately after a character literal. +A preceding escape character, not preceded by another escape character, + is considered a character literal prefix. (This works for elisp, + Common Lisp, and Scheme.) +Assumes that `paredit-in-string-p' is false, so that it need not handle + long sequences of preceding backslashes in string escapes. (This + assumes some other leading character token -- ? in elisp, # in Scheme + and Common Lisp.)" + (let ((arg (or arg (point)))) + (and (eq (char-before arg) ?\\ ) + (not (eq (char-before (1- arg)) ?\\ ))))) + +(defun paredit-forward-and-indent () + "Move forward an S-expression, indenting it fully. +Indent with `lisp-indent-line' and then `indent-sexp'." + (forward-sexp) ; Go forward, and then find the + (save-excursion ; beginning of this next + (backward-sexp) ; S-expression. + (lisp-indent-line) ; Indent its opening line, and + (indent-sexp))) ; the rest of it. + +(defun paredit-skip-whitespace (trailing-p &optional limit) + "Skip past any whitespace, or until the point LIMIT is reached. +If TRAILING-P is nil, skip leading whitespace; otherwise, skip trailing + whitespace." + (funcall (if trailing-p 'skip-chars-forward 'skip-chars-backward) + " \t\n " ; This should skip using the syntax table, but LF + limit)) ; is a comment end, not newline, in Lisp mode. + +(defalias 'paredit-region-active-p + (xcond ((paredit-xemacs-p) 'region-active-p) + ((paredit-gnu-emacs-p) + (lambda () + (and mark-active transient-mark-mode))))) + +(defun kill-region-new (start end) + "Kill the region between START and END. +Do not append to any current kill, and + do not let the next kill append to this one." + (interactive "r") ;Eh, why not? + ;; KILL-REGION sets THIS-COMMAND to tell the next kill that the last + ;; command was a kill. It also checks LAST-COMMAND to see whether it + ;; should append. If we bind these locally, any modifications to + ;; THIS-COMMAND will be masked, and it will not see LAST-COMMAND to + ;; indicate that it should append. + (let ((this-command nil) + (last-command nil)) + (kill-region start end))) + +;;;;; S-expression Parsing Utilities + +;++ These routines redundantly traverse S-expressions a great deal. +;++ If performance issues arise, this whole section will probably have +;++ to be refactored to preserve the state longer, like paredit.scm +;++ does, rather than to traverse the definition N times for every key +;++ stroke as it presently does. + +(defun paredit-current-parse-state () + "Return parse state of point from beginning of defun." + (let ((point (point))) + (beginning-of-defun) + ;; Calling PARSE-PARTIAL-SEXP will advance the point to its second + ;; argument (unless parsing stops due to an error, but we assume it + ;; won't in paredit-mode). + (parse-partial-sexp (point) point))) + +(defun paredit-in-string-p (&optional state) + "True if the parse state is within a double-quote-delimited string. +If no parse state is supplied, compute one from the beginning of the + defun to the point." + ;; 3. non-nil if inside a string (the terminator character, really) + (and (nth 3 (or state (paredit-current-parse-state))) + t)) + +(defun paredit-string-start+end-points (&optional state) + "Return a cons of the points of open and close quotes of the string. +The string is determined from the parse state STATE, or the parse state + from the beginning of the defun to the point. +This assumes that `paredit-in-string-p' has already returned true, i.e. + that the point is already within a string." + (save-excursion + ;; 8. character address of start of comment or string; nil if not + ;; in one + (let ((start (nth 8 (or state (paredit-current-parse-state))))) + (goto-char start) + (forward-sexp 1) + (cons start (1- (point)))))) + +(defun paredit-in-comment-p (&optional state) + "True if parse state STATE is within a comment. +If no parse state is supplied, compute one from the beginning of the + defun to the point." + ;; 4. nil if outside a comment, t if inside a non-nestable comment, + ;; else an integer (the current comment nesting) + (and (nth 4 (or state (paredit-current-parse-state))) + t)) + +(defun paredit-point-at-sexp-boundary (n) + (cond ((< n 0) (paredit-point-at-sexp-start)) + ((= n 0) (point)) + ((> n 0) (paredit-point-at-sexp-end)))) + +(defun paredit-point-at-sexp-start () + (forward-sexp) + (backward-sexp) + (point)) + +(defun paredit-point-at-sexp-end () + (backward-sexp) + (forward-sexp) + (point)) + +;;;; Initialization + +(paredit-define-keys) +(paredit-annotate-mode-with-examples) +(paredit-annotate-functions-with-examples) + +(provide 'paredit) diff --git a/emacs.d/psvn.el b/emacs.d/psvn.el new file mode 100644 index 0000000..ed03cb4 --- /dev/null +++ b/emacs.d/psvn.el @@ -0,0 +1,5815 @@ +;;; psvn.el --- Subversion interface for emacs +;; Copyright (C) 2002-2007 by Stefan Reichoer + +;; Author: Stefan Reichoer, +;; $Id: psvn.el 25475 2007-06-20 18:56:24Z xsteve $ + +;; psvn.el is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 2, or (at your option) +;; any later version. + +;; psvn.el is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs; see the file COPYING. If not, write to +;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330, +;; Boston, MA 02111-1307, USA. + +;;; Commentary + +;; psvn.el is tested with GNU Emacs 21.3 on windows, debian linux, +;; freebsd5, red hat el4, ubuntu edgy with svn 1.4.0 + +;; psvn.el needs at least svn 1.1.0 +;; if you upgrade to a higher version, you need to do a fresh checkout + +;; psvn.el is an interface for the revision control tool subversion +;; (see http://subversion.tigris.org) +;; psvn.el provides a similar interface for subversion as pcl-cvs for cvs. +;; At the moment the following commands are implemented: +;; +;; M-x svn-status: run 'svn -status -v' +;; M-x svn-examine (like pcl-cvs cvs-examine) is alias for svn-status +;; +;; and show the result in the svn-status-buffer-name buffer (normally: *svn-status*). +;; If svn-status-verbose is set to nil, only "svn status" without "-v" +;; is run. Currently you have to toggle this variable manually. +;; This buffer uses svn-status mode in which the following keys are defined: +;; g - svn-status-update: run 'svn status -v' +;; M-s - svn-status-update: run 'svn status -v' +;; C-u g - svn-status-update: run 'svn status -vu' +;; = - svn-status-show-svn-diff run 'svn diff' +;; l - svn-status-show-svn-log run 'svn log' +;; i - svn-status-info run 'svn info' +;; r - svn-status-revert run 'svn revert' +;; X v - svn-status-resolved run 'svn resolved' +;; U - svn-status-update-cmd run 'svn update' +;; M-u - svn-status-update-cmd run 'svn update' +;; c - svn-status-commit run 'svn commit' +;; a - svn-status-add-file run 'svn add --non-recursive' +;; A - svn-status-add-file-recursively run 'svn add' +;; + - svn-status-make-directory run 'svn mkdir' +;; R - svn-status-mv run 'svn mv' +;; C - svn-status-cp run 'svn cp' +;; D - svn-status-rm run 'svn rm' +;; M-c - svn-status-cleanup run 'svn cleanup' +;; k - svn-status-lock run 'svn lock' +;; K - svn-status-unlock run 'svn unlock' +;; b - svn-status-blame run 'svn blame' +;; X e - svn-status-export run 'svn export' +;; RET - svn-status-find-file-or-examine-directory +;; ^ - svn-status-examine-parent +;; ~ - svn-status-get-specific-revision +;; E - svn-status-ediff-with-revision +;; X X - svn-status-resolve-conflicts +;; s - svn-status-show-process-buffer +;; h - svn-status-pop-to-partner-buffer +;; e - svn-status-toggle-edit-cmd-flag +;; ? - svn-status-toggle-hide-unknown +;; _ - svn-status-toggle-hide-unmodified +;; m - svn-status-set-user-mark +;; u - svn-status-unset-user-mark +;; $ - svn-status-toggle-elide +;; w - svn-status-copy-current-line-info +;; DEL - svn-status-unset-user-mark-backwards +;; * ! - svn-status-unset-all-usermarks +;; * ? - svn-status-mark-unknown +;; * A - svn-status-mark-added +;; * M - svn-status-mark-modified +;; * D - svn-status-mark-deleted +;; * * - svn-status-mark-changed +;; * . - svn-status-mark-by-file-ext +;; * % - svn-status-mark-filename-regexp +;; . - svn-status-goto-root-or-return +;; f - svn-status-find-file +;; o - svn-status-find-file-other-window +;; C-o - svn-status-find-file-other-window-noselect +;; v - svn-status-view-file-other-window +;; I - svn-status-parse-info +;; V - svn-status-svnversion +;; P l - svn-status-property-list +;; P s - svn-status-property-set +;; P d - svn-status-property-delete +;; P e - svn-status-property-edit-one-entry +;; P i - svn-status-property-ignore-file +;; P I - svn-status-property-ignore-file-extension +;; P C-i - svn-status-property-edit-svn-ignore +;; P k - svn-status-property-set-keyword-list +;; P K i - svn-status-property-set-keyword-id +;; P K d - svn-status-property-set-keyword-date +;; P y - svn-status-property-set-eol-style +;; P x - svn-status-property-set-executable +;; P m - svn-status-property-set-mime-type +;; H - svn-status-use-history +;; x - svn-status-update-buffer +;; q - svn-status-bury-buffer + +;; C-x C-j - svn-status-dired-jump + +;; The output in the buffer contains this header to ease reading +;; of svn output: +;; FPH BASE CMTD Author em File +;; F = Filemark +;; P = Property mark +;; H = History mark +;; BASE = local base revision +;; CMTD = last committed revision +;; Author = author of change +;; em = "**" or "(Update Available)" [see `svn-status-short-mod-flag-p'] +;; if file can be updated +;; File = path/filename +;; + +;; To use psvn.el put the following line in your .emacs: +;; (require 'psvn) +;; Start the svn interface with M-x svn-status + +;; The latest version of psvn.el can be found at: +;; http://www.xsteve.at/prg/emacs/psvn.el +;; Or you can check it out from the subversion repository: +;; svn co http://svn.collab.net/repos/svn/trunk/contrib/client-side/emacs emacs-svn + +;; TODO: +;; * shortcut for svn propset svn:keywords "Date" psvn.el +;; * docstrings for the functions +;; * perhaps shortcuts for ranges, dates +;; * when editing the command line - offer help from the svn client +;; * finish svn-status-property-set +;; * Add repository browser +;; * Get rid of all byte-compiler warnings +;; * SVK working copy support +;; * multiple independent buffers in svn-status-mode +;; There are "TODO" comments in other parts of this file as well. + +;; Overview over the implemented/not (yet) implemented svn sub-commands: +;; * add implemented +;; * blame implemented +;; * cat implemented +;; * checkout (co) implemented +;; * cleanup implemented +;; * commit (ci) implemented +;; * copy (cp) implemented +;; * delete (del, remove, rm) implemented +;; * diff (di) implemented +;; * export implemented +;; * help (?, h) +;; * import used (in svn-admin-create-trunk-directory) +;; * info implemented +;; * list (ls) implemented +;; * lock implemented +;; * log implemented +;; * merge +;; * mkdir implemented +;; * move (mv, rename, ren) implemented +;; * propdel (pdel) implemented +;; * propedit (pedit, pe) not needed +;; * propget (pget, pg) used (in svn-status-property-edit) +;; * proplist (plist, pl) implemented +;; * propset (pset, ps) used (in svn-prop-edit-do-it) +;; * resolved implemented +;; * revert implemented +;; * status (stat, st) implemented +;; * switch (sw) +;; * unlock implemented +;; * update (up) implemented + +;; For the not yet implemented commands you should use the command line +;; svn client. If there are user requests for any missing commands I will +;; probably implement them. + +;; Comments / suggestions and bug reports are welcome! + +;; Development notes +;; ----------------- + +;; "svn-" is the package prefix used in psvn.el. There are also longer +;; prefixes which clarify the code and help symbol completion, but they +;; are not intended to prevent name clashes with other packages. All +;; interactive commands meant to be used only in a specific mode should +;; have names beginning with the name of that mode: for example, +;; "svn-status-add-file" in "svn-status-mode". "psvn" should be used +;; only in names of files, customization groups, and features. If SVK +;; support is ever added, it should use "svn-svk-" when no existing +;; prefix is applicable. + +;; Many of the variables marked as `risky-local-variable' are probably +;; impossible to abuse, as the commands that read them are used only in +;; buffers that are not visiting any files. Better safe than sorry. + +;;; Code: + +(require 'easymenu) + +(eval-when-compile (require 'dired)) +(eval-when-compile (require 'ediff-util)) +(eval-when-compile (require 'elp)) +(eval-when-compile (require 'pp)) + +(condition-case nil + (progn + (require 'diff-mode)) + (error nil)) + +(defconst svn-psvn-revision "$Id: psvn.el 25475 2007-06-20 18:56:24Z xsteve $" + "The revision number of psvn.") + +;;; user setable variables +(defcustom svn-status-verbose t + "*Add '-v' to svn status call. +This can be toggled with \\[svn-status-toggle-svn-verbose-flag]." + :type 'boolean + :group 'psvn) +(defcustom svn-log-edit-file-name "++svn-log++" + "*Name of a saved log file. +This can be either absolute, or relative to the default directory +of the `svn-log-edit-buffer-name' buffer." + :type 'file + :group 'psvn) +(put 'svn-log-edit-file-name 'risky-local-variable t) +(defcustom svn-log-edit-insert-files-to-commit t + "*Insert the filelist to commit in the *svn-log* buffer" + :type 'boolean + :group 'psvn) +(defcustom svn-log-edit-use-log-edit-mode + (and (condition-case nil (require 'log-edit) (error nil)) t) + "*Use log-edit-mode as base for svn-log-edit-mode +This variable takes effect only when psvn.el is being loaded." + :type 'boolean + :group 'psvn) +(defcustom svn-log-edit-paragraph-start + "$\\|[ \t]*$\\|##.*$\\|\\*.*:.*$\\|[ \t]+(.+):.*$" + "*Value used for `paragraph-start' in `svn-log-edit-buffer-name' buffer." + :type 'regexp + :group 'psvn) +(defcustom svn-log-edit-paragraph-separate "$\\|##.*$" + "*Value used for `paragraph-separate' in `svn-log-edit-buffer-name' buffer." + :type 'regexp + :group 'psvn) +(defcustom svn-status-hide-unknown nil + "*Hide unknown files in `svn-status-buffer-name' buffer. +This can be toggled with \\[svn-status-toggle-hide-unknown]." + :type 'boolean + :group 'psvn) +(defcustom svn-status-hide-unmodified nil + "*Hide unmodified files in `svn-status-buffer-name' buffer. +This can be toggled with \\[svn-status-toggle-hide-unmodified]." + :type 'boolean + :group 'psvn) +(defcustom svn-status-sort-status-buffer t + "*Whether to sort the `svn-status-buffer-name' buffer. + +Setting this variable to nil speeds up \\[M-x svn-status], however the +listing may then become incorrect. + +This can be toggled with \\[svn-status-toggle-sort-status-buffer]." + :type 'boolean + :group 'psvn) + +(defcustom svn-status-ediff-delete-temporary-files nil + "*Whether to delete temporary ediff files. If set to ask, ask the user" + :type '(choice (const t) + (const nil) + (const ask)) + :group 'psvn) + +(defcustom svn-status-changelog-style 'changelog + "*The changelog style that is used for `svn-file-add-to-changelog'. +Possible values are: + 'changelog: use `add-change-log-entry-other-window' + 'svn-dev: use commit messages that are used by the svn developers + a function: This function is called to add a new entry to the changelog file. +" + :type '(set (const changelog) + (const svn-dev)) + :group 'psvn) + +(defcustom svn-status-unmark-files-after-list '(commit revert) + "*List of operations after which all user marks will be removed. +Possible values are: commit, revert." + :type '(set (const commit) + (const revert)) + :group 'psvn) + +(defcustom svn-status-preserve-window-configuration t + "*Try to preserve the window configuration." + :type 'boolean + :group 'psvn) + +(defcustom svn-status-auto-revert-buffers t + "*Auto revert buffers that have changed on disk." + :type 'boolean + :group 'psvn) + +(defcustom svn-status-negate-meaning-of-arg-commands '() + "*List of operations that should use a negated meaning of the prefix argument. +The supported functions are `svn-status' and `svn-status-set-user-mark'." + :type '(set (function-item svn-status) + (function-item svn-status-set-user-mark)) + :group 'psvn) + +(defcustom svn-status-svn-executable "svn" + "*The name of the svn executable. +This can be either absolute or looked up on `exec-path'." + ;; Don't use (file :must-match t). It doesn't know about `exec-path'. + :type 'file + :group 'psvn) +(put 'svn-status-svn-executable 'risky-local-variable t) + +(defcustom svn-status-default-export-directory "~/" "*The default directory that is suggested svn export." + :type 'file + :group 'psvn) + +(defcustom svn-status-svn-environment-var-list '("LC_MESSAGES=C" "LC_ALL=") + "*A list of environment variables that should be set for that svn process. +Each element is either a string \"VARIABLE=VALUE\" which will be added to +the environment when svn is run, or just \"VARIABLE\" which causes that +variable to be entirely removed from the environment. + +The default setting is '(\"LC_MESSAGES=C\" \"LC_ALL=\"). This ensures that the svn command +line client does not output localized strings. psvn.el relies on the english +messages." + :type '(repeat string) + :group 'psvn) +(put 'svn-status-svn-environment-var-list 'risky-local-variable t) + +(defcustom svn-browse-url-function nil + ;; If the user hasn't changed `svn-browse-url-function', then changing + ;; `browse-url-browser-function' should affect psvn even after it has + ;; been loaded. + "Function to display a Subversion related WWW page in a browser. +So far, this is used only for \"trac\" issue tracker integration. +By default, this is nil, which means use `browse-url-browser-function'. +Any non-nil value overrides that variable, with the same syntax." + ;; It would be nice to show the full list of browsers supported by + ;; browse-url, but (custom-variable-type 'browse-url-browser-function) + ;; returns just `function' if browse-url has not yet been loaded, + ;; and there seems to be no easy way to autoload browse-url when + ;; the custom-type of svn-browse-url-function is actually needed. + ;; So I'll only offer enough choices to cover all supported types. + :type `(choice (const :tag "Specified by `browse-url-browser-function'" nil) + (function :value browse-url-default-browser + ;; In XEmacs 21.4.17, the `function' widget matches + ;; all objects. Constrain it here so that alists + ;; fall through to the next choice. Accept either + ;; a symbol (fbound or not) or a lambda expression. + :match ,(lambda (widget value) + (or (symbolp value) (functionp value)))) + (svn-alist :tag "Regexp/function association list" + :key-type regexp :value-type function + :value (("." . browse-url-default-browser)))) + :link '(emacs-commentary-link "browse-url") + :group 'psvn) +;; (put 'svn-browse-url-function 'risky-local-variable t) +;; already implied by "-function" suffix + +(defcustom svn-status-window-alist + '((diff "*svn-diff*") (log "*svn-log*") (info t) (blame t) (proplist t) (update t)) + "An alist to specify which windows should be used for svn command outputs. +The following keys are supported: diff, log, info, blame, proplist, update. +The following values can be given: +nil ... show in `svn-process-buffer-name' buffer +t ... show in dedicated *svn-info* buffer +invisible ... don't show the buffer (eventually useful for update) +a string ... show in a buffer named string" + :type '(svn-alist + :key-type symbol + :value-type (group + (choice + (const :tag "Show in *svn-process* buffer" nil) + (const :tag "Show in dedicated *svn-info* buffer" t) + (const :tag "Don't show the output" invisible) + (string :tag "Show in a buffer named")))) + :options '(diff log info blame proplist update) + :group 'psvn) + +(defcustom svn-status-short-mod-flag-p t + "*Whether the mark for out of date files is short or long. + +If this variable is is t, and a file is out of date (i.e., there is a newer +version in the repository than the working copy), then the file will +be marked by \"**\" + +If this variable is nil, and the file is out of date then the longer phrase +\"(Update Available)\" is used. + +In either case the mark gets the face +`svn-status-update-available-face', and will only be visible if +`\\[svn-status-update]' is run with a prefix argument" + :type '(choice (const :tag "Short \"**\"" t) + (const :tag "Long \"(Update Available)\"" nil)) + :group 'psvn) + +(defvar svn-status-debug-level 0 "The psvn.el debugging verbosity level. +The higher the number, the more debug messages are shown. + +See `svn-status-message' for the meaning of values for that variable.") + +(defvar svn-bookmark-list nil "A list of locations for a quick access via `svn-status-via-bookmark'") +;;(setq svn-bookmark-list '(("proj1" . "~/work/proj1") +;; ("doc1" . "~/docs/doc1"))) + +(defvar svn-status-buffer-name "*svn-status*" "Name for the svn status buffer") +(defvar svn-process-buffer-name "*svn-process*" "Name for the svn process buffer") +(defvar svn-log-edit-buffer-name "*svn-log-edit*" "Name for the svn log-edit buffer") + +(defcustom svn-status-use-header-line + (if (boundp 'header-line-format) t 'inline) + "*Whether a header line should be used. +When t: Use the emacs header line +When 'inline: Insert the header line in the `svn-status-buffer-name' buffer +Otherwise: Don't display a header line" + :type '(choice (const :tag "Show column titles as a header line" t) + (const :tag "Insert column titles as text in the buffer" inline) + (other :tag "No column titles" nil)) + :group 'psvn) + +;;; default arguments to pass to svn commands +;; TODO: When customizing, an option menu or completion might be nice.... +(defcustom svn-status-default-log-arguments '("-v") + "*List of arguments to pass to svn log. +\(used in `svn-status-show-svn-log'; override these by giving prefixes\)." + :type '(repeat string) + :group 'psvn) +(put 'svn-status-default-log-arguments 'risky-local-variable t) + +(defcustom svn-status-default-commit-arguments '() + "*List of arguments to pass to svn commit. +If you don't like recursive commits, set this value to (\"-N\") +or mark the directory before committing it. +Do not put an empty string here, except as an argument of an option: +Subversion and the operating system may treat that as a file name +equivalent to \".\", so you would commit more than you intended." + :type '(repeat string) + :group 'psvn) +(put 'svn-status-default-commit-arguments 'risky-local-variable t) + +(defcustom svn-status-default-diff-arguments '() + "*A list of arguments that is passed to the svn diff command. +If you'd like to suppress whitespace changes use the following value: +'(\"--diff-cmd\" \"diff\" \"-x\" \"-wbBu\")" + :type '(repeat string) + :group 'psvn) +(put 'svn-status-default-diff-arguments 'risky-local-variable t) + +(defvar svn-trac-project-root nil + "Path for an eventual existing trac issue tracker. +This can be set with \\[svn-status-set-trac-project-root].") + +(defvar svn-status-module-name nil + "*A short name for the actual project. +This can be set with \\[svn-status-set-module-name].") + +(defvar svn-status-branch-list nil + "*A list of known branches for the actual project +This can be set with \\[svn-status-set-branch-list]. + +The list contains full repository paths or shortcuts starting with \# +\# at the beginning is replaced by the repository url. +\#1\# has the special meaning that all paths below the given directory +will be considered for interactive selections. + +A useful setting might be: '\(\"\#trunk\" \"\#1\#tags\" \"\#1\#branches\")") + +(defvar svn-status-load-state-before-svn-status t + "*Whether to automatically restore state from ++psvn.state file before running svn-status.") + +;;; hooks +(defvar svn-status-mode-hook nil "Hook run when entering `svn-status-mode'.") +(defvar svn-log-edit-mode-hook nil "Hook run when entering `svn-log-edit-mode'.") +(defvar svn-log-edit-done-hook nil "Hook run after commiting files via svn.") +;; (put 'svn-log-edit-mode-hook 'risky-local-variable t) +;; (put 'svn-log-edit-done-hook 'risky-local-variable t) +;; already implied by "-hook" suffix + +(defvar svn-post-process-svn-output-hook nil "Hook that can be used to preprocess the output from svn. +The function `svn-status-remove-control-M' can be useful for that hook") + +(when (eq system-type 'windows-nt) + (add-hook 'svn-post-process-svn-output-hook 'svn-status-remove-control-M)) + +(defvar svn-status-svn-process-coding-system locale-coding-system + "The coding system that is used for the svn command line client. +It is used in svn-run, if it is not nil.") + +(defvar svn-status-svn-file-coding-system 'undecided-unix + "The coding system that is used to save files that are loaded as +parameter or data files via the svn command line client. +It is used in the following functions: `svn-prop-edit-do-it', `svn-log-edit-done'. +You could set it to 'utf-8") + +(defcustom svn-status-use-ido-completion + (fboundp 'ido-completing-read) + "*Use ido completion functionality." + :type 'boolean + :group 'psvn) + +(defvar svn-status-completing-read-function + (if svn-status-use-ido-completion 'ido-completing-read 'completing-read)) + +;;; experimental features +(defvar svn-status-track-user-input nil "Track user/password queries. +This feature is implemented via a process filter. +It is an experimental feature.") + +(defvar svn-status-refresh-info nil "Whether `svn-status-update-buffer' should call `svn-status-parse-info'.") + +;;; Customize group +(defgroup psvn nil + "Subversion interface for Emacs." + :group 'tools) + +(defgroup psvn-faces nil + "psvn faces." + :group 'psvn) + + +(eval-and-compile + (require 'cl) + (defconst svn-xemacsp (featurep 'xemacs)) + (if svn-xemacsp + (require 'overlay) + (require 'overlay nil t))) + +(defcustom svn-status-display-full-path nil + "Specifies how the filenames look like in the listing. +If t, their full path name will be displayed, else only the filename." + :type 'boolean + :group 'psvn) + +(defcustom svn-status-prefix-key [(control x) (meta s)] + "Prefix key for the psvn commands in the global keymap." + :type '(choice (const [(control x) ?v ?S]) + (const [(super s)]) + (const [(hyper s)]) + (const [(control x) ?v]) + (const [(control x) ?V]) + (sexp)) + :group 'psvn + :set (lambda (var value) + (if (boundp var) + (global-unset-key (symbol-value var))) + (set var value) + (global-set-key (symbol-value var) 'svn-global-keymap))) + +(defcustom svn-admin-default-create-directory "~/" + "*The default directory that is suggested for `svn-admin-create'." + :type 'string + :group 'psvn) + +(defvar svn-status-custom-hide-function nil + "A function that receives a line-info and decides whether to hide that line. +See psvn.el for an example function.") +;; (put 'svn-status-custom-hide-function 'risky-local-variable t) +;; already implied by "-function" suffix + + +;; Use the normally used mode for files ending in .~HEAD~, .~BASE~, ... +(add-to-list 'auto-mode-alist '("\\.~?\\(HEAD\\|BASE\\|PREV\\)~?\\'" ignore t)) + +;;; internal variables +(defvar svn-status-directory-history nil "List of visited svn working directories.") +(defvar svn-process-cmd nil) +(defvar svn-status-info nil) +(defvar svn-status-filename-to-buffer-position-cache (make-hash-table :test 'equal :weakness t)) +(defvar svn-status-base-info nil "The parsed result from the svn info command.") +(defvar svn-status-initial-window-configuration nil) +(defvar svn-status-default-column 23) +(defvar svn-status-default-revision-width 4) +(defvar svn-status-default-author-width 9) +(defvar svn-status-line-format " %c%c%c %4s %4s %-9s") +(defvar svn-start-of-file-list-line-number 0) +(defvar svn-status-files-to-commit nil + "List of files to commit at `svn-log-edit-done'. +This is always set together with `svn-status-recursive-commit'.") +(defvar svn-status-recursive-commit nil + "Non-nil if the next commit should be recursive. +This is always set together with `svn-status-files-to-commit'.") +(defvar svn-log-edit-update-log-entry nil + "Revision number whose log entry is being edited. +This is nil if the log entry is for a new commit.") +(defvar svn-status-pre-commit-window-configuration nil) +(defvar svn-status-pre-propedit-window-configuration nil) +(defvar svn-status-head-revision nil) +(defvar svn-status-root-return-info nil) +(defvar svn-status-property-edit-must-match-flag nil) +(defvar svn-status-propedit-property-name nil "The property name for the actual svn propset command") +(defvar svn-status-propedit-file-list nil) +(defvar svn-status-mode-line-process "") +(defvar svn-status-mode-line-process-status "") +(defvar svn-status-mode-line-process-edit-flag "") +(defvar svn-status-edit-svn-command nil) +(defvar svn-status-update-previous-process-output nil) +(defvar svn-pre-run-asynch-recent-keys nil) +(defvar svn-pre-run-mode-line-process nil) +(defvar svn-status-temp-dir + (expand-file-name + (or + (when (boundp 'temporary-file-directory) temporary-file-directory) ;emacs + ;; XEmacs 21.4.17 can return "/tmp/kalle" from (temp-directory). + ;; `file-name-as-directory' adds a slash so we can append a file name. + (when (fboundp 'temp-directory) (file-name-as-directory (temp-directory))) + "/tmp/")) "The directory that is used to store temporary files for psvn.") +;; Because `temporary-file-directory' is not a risky local variable in +;; GNU Emacs 22.0.51, we don't mark `svn-status-temp-dir' as such either. +(defvar svn-temp-suffix (make-temp-name ".")) +(put 'svn-temp-suffix 'risky-local-variable t) +(defvar svn-status-temp-file-to-remove nil) +(put 'svn-status-temp-file-to-remove 'risky-local-variable t) +(defvar svn-status-temp-arg-file (concat svn-status-temp-dir "svn.arg" svn-temp-suffix)) +(put 'svn-status-temp-arg-file 'risky-local-variable t) +(defvar svn-status-options nil) +(defvar svn-status-remote) +(defvar svn-status-commit-rev-number nil) +(defvar svn-status-update-rev-number nil) +(defvar svn-status-operated-on-dot nil) +(defvar svn-status-last-commit-author nil) +(defvar svn-status-elided-list nil) +(defvar svn-status-last-output-buffer-name nil "The buffer name for the buffer that holds the output from the last executed svn command") +(defvar svn-status-pre-run-svn-buffer nil) +(defvar svn-status-update-list nil) +(defvar svn-transient-buffers) +(defvar svn-ediff-windows) +(defvar svn-ediff-result) +(defvar svn-status-last-diff-options nil) +(defvar svn-status-blame-file-name nil) +(defvar svn-admin-last-repository-dir nil "The last repository url for various operations.") +(defvar svn-last-cmd-ring (make-ring 30) "Ring that holds the last executed svn commands (for debugging purposes)") +(defvar svn-status-cached-version-string nil) +(defvar svn-client-version nil "The version number of the used svn client") +(defvar svn-status-get-line-information-for-file nil) +(defvar svn-status-base-dir-cache (make-hash-table :test 'equal :weakness nil)) + +(defvar svn-status-partner-buffer nil "The partner buffer for this svn related buffer") +(make-variable-buffer-local 'svn-status-partner-buffer) + +;; Emacs 21 defines these in ediff-init.el but it seems more robust +;; to just declare the variables here than try to load that file. +;; It is Ediff's job to declare these as risky-local-variable if needed. +(defvar ediff-buffer-A) +(defvar ediff-buffer-B) +(defvar ediff-buffer-C) +(defvar ediff-quit-hook) + +;; Ditto for log-edit.el. +(defvar log-edit-initial-files) +(defvar log-edit-callback) +(defvar log-edit-listfun) + +;; Ediff does not use this variable in GNU Emacs 20.7, GNU Emacs 21.4, +;; nor XEmacs 21.4.17. However, pcl-cvs (a.k.a. pcvs) does. +;; TODO: Check if this should be moved into the "svn-" namespace. +(defvar ediff-after-quit-destination-buffer) + +;; That is an example for the svn-status-custom-hide-function: +;; Note: For many cases it is a better solution to ignore files or +;; file extensions via the svn-ignore properties (on P i, P I) +;; (setq svn-status-custom-hide-function 'svn-status-hide-pyc-files) +;; (defun svn-status-hide-pyc-files (info) +;; "Hide all pyc files in the `svn-status-buffer-name' buffer." +;; (let* ((fname (svn-status-line-info->filename-nondirectory info)) +;; (fname-len (length fname))) +;; (and (> fname-len 4) (string= (substring fname (- fname-len 4)) ".pyc")))) + +;;; faces +(defface svn-status-marked-face + '((((type tty) (class color)) (:foreground "green" :weight light)) + (((class color) (background light)) (:foreground "green3")) + (((class color) (background dark)) (:foreground "palegreen2")) + (t (:weight bold))) + "Face to highlight the mark for user marked files in svn status buffers." + :group 'psvn-faces) + +(defface svn-status-marked-popup-face + '((((type tty) (class color)) (:foreground "green" :weight light)) + (((class color) (background light)) (:foreground "green3")) + (((class color) (background dark)) (:foreground "palegreen2")) + (t (:weight bold))) + "Face to highlight the actual file, if a popup menu is activated." + :group 'psvn-faces) + +(defface svn-status-update-available-face + '((((type tty) (class color)) (:foreground "magenta" :weight light)) + (((class color) (background light)) (:foreground "magenta")) + (((class color) (background dark)) (:foreground "yellow")) + (t (:weight bold))) + "Face used to highlight the 'out of date' mark. +\(i.e., the mark used when there is a newer version in the repository +than the working copy.\) + +See also `svn-status-short-mod-flag-p'." + :group 'psvn-faces) + +;based on cvs-filename-face +(defface svn-status-directory-face + '((((type tty) (class color)) (:foreground "lightblue" :weight light)) + (((class color) (background light)) (:foreground "blue4")) + (((class color) (background dark)) (:foreground "lightskyblue1")) + (t (:weight bold))) + "Face for directories in *svn-status* buffers. +See `svn-status--line-info->directory-p' for what counts as a directory." + :group 'psvn-faces) + +;based on font-lock-comment-face +(defface svn-status-filename-face + '((((class color) (background light)) (:foreground "chocolate")) + (((class color) (background dark)) (:foreground "beige"))) + "Face for non-directories in *svn-status* buffers. +See `svn-status--line-info->directory-p' for what counts as a directory." + :group 'psvn-faces) + +;not based on anything, may be horribly ugly! +(defface svn-status-symlink-face + '((((class color) (background light)) (:foreground "cornflower blue")) + (((class color) (background dark)) (:foreground "cyan"))) + "Face for symlinks in *svn-status* buffers. + +This is the face given to the actual link (i.e., the versioned item), +the target of the link gets either `svn-status-filename-face' or +`svn-status-directory-face'." + :group 'psvn-faces) + +;based on font-lock-warning-face +(defface svn-status-locked-face + '((t + (:weight bold :foreground "Red"))) + "Face for the phrase \"[ LOCKED ]\" `svn-status-buffer-name' buffers." + :group 'psvn-faces) + +;based on vhdl-font-lock-directive-face +(defface svn-status-switched-face + '((((class color) + (background light)) + (:foreground "CadetBlue")) + (((class color) + (background dark)) + (:foreground "Aquamarine")) + (t + (:bold t :italic t))) + "Face for the phrase \"(switched)\" non-directories in svn status buffers." + :group 'psvn-faces) + +(if svn-xemacsp + (defface svn-status-blame-highlight-face + '((((type tty) (class color)) (:foreground "green" :weight light)) + (((class color) (background light)) (:foreground "green3")) + (((class color) (background dark)) (:foreground "palegreen2")) + (t (:weight bold))) + "Default face for highlighting a line in svn status blame mode." + :group 'psvn-faces) + (defface svn-status-blame-highlight-face + '((t :inherit highlight)) + "Default face for highlighting a line in svn status blame mode." + :group 'psvn-faces)) + +(defface svn-status-blame-rev-number-face + '((((class color) (background light)) (:foreground "DarkGoldenrod")) + (((class color) (background dark)) (:foreground "LightGoldenrod")) + (t (:weight bold :slant italic))) + "Face to highlight revision numbers in the svn-blame mode." + :group 'psvn-faces) + +(defvar svn-highlight t) +;; stolen from PCL-CVS +(defun svn-add-face (str face &optional keymap) + "Return string STR decorated with the specified FACE. +If `svn-highlight' is nil then just return STR." + (when svn-highlight + ;; Do not use `list*'; cl.el might not have been loaded. We could + ;; put (require 'cl) at the top but let's try to manage without. + (add-text-properties 0 (length str) + `(face ,face + mouse-face highlight) +;; 18.10.2004: the keymap parameter is not used (yet) in psvn.el +;; ,@(when keymap +;; `(mouse-face highlight +;; local-map ,keymap))) + str)) + str) + +(defun svn-status-maybe-add-face (condition text face) + "If CONDITION then add FACE to TEXT. +Else return TEXT unchanged." + (if condition + (svn-add-face text face) + text)) + +(defun svn-status-choose-face-to-add (condition text face1 face2) + "If CONDITION then add FACE1 to TEXT, else add FACE2 to TEXT." + (if condition + (svn-add-face text face1) + (svn-add-face text face2))) + +(defun svn-status-maybe-add-string (condition string face) + "If CONDITION then return STRING decorated with FACE. +Otherwise, return \"\"." + (if condition + (svn-add-face string face) + "")) + +;; compatibility +;; emacs 20 +(defalias 'svn-point-at-eol + (if (fboundp 'point-at-eol) 'point-at-eol 'line-end-position)) +(defalias 'svn-point-at-bol + (if (fboundp 'point-at-bol) 'point-at-bol 'line-beginning-position)) +(defalias 'svn-read-directory-name + (if (fboundp 'read-directory-name) 'read-directory-name 'read-file-name)) + +(eval-when-compile + (if (not (fboundp 'gethash)) + (require 'cl-macs))) +(defalias 'svn-puthash (if (fboundp 'puthash) 'puthash 'cl-puthash)) + +;; emacs 21 +(if (fboundp 'line-number-at-pos) + (defalias 'svn-line-number-at-pos 'line-number-at-pos) + (defun svn-line-number-at-pos (&optional pos) + "Return (narrowed) buffer line number at position POS. +If POS is nil, use current buffer location." + (let ((opoint (or pos (point))) start) + (save-excursion + (goto-char (point-min)) + (setq start (point)) + (goto-char opoint) + (forward-line 0) + (1+ (count-lines start (point))))))) + +; xemacs +;; Evaluate the defsubst at compile time, so that the byte compiler +;; knows the definition and can inline calls. It cannot detect the +;; defsubst automatically from within the if form. +(eval-and-compile + (if (fboundp 'match-string-no-properties) + (defalias 'svn-match-string-no-properties 'match-string-no-properties) + (defsubst svn-match-string-no-properties (match) + (buffer-substring-no-properties (match-beginning match) (match-end match))))) + +;; XEmacs 21.4.17 does not have an `alist' widget. Define a replacement. +;; To find out whether the `alist' widget exists, we cannot check just +;; (get 'alist 'widget-type), because GNU Emacs 21.4 defines it in +;; "wid-edit.el", which is not preloaded; it will be autoloaded when +;; `widget-create' is called. Instead, we call `widgetp', which is +;; also autoloaded from "wid-edit.el". XEmacs 21.4.17 does not have +;; `widgetp' either, so we check that first. +(if (and (fboundp 'widgetp) (widgetp 'alist)) + (define-widget 'svn-alist 'alist + "An association list. +Use this instead of `alist', for XEmacs 21.4 compatibility.") + (define-widget 'svn-alist 'list + "An association list. +Use this instead of `alist', for XEmacs 21.4 compatibility." + :convert-widget 'svn-alist-convert-widget + :tag "Association List" + :key-type 'sexp + :value-type 'sexp) + (defun svn-alist-convert-widget (widget) + (let* ((value-type (widget-get widget :value-type)) + (option-widgets (loop for option in (widget-get widget :options) + collect `(cons :format "%v" + (const :format "%t: %v\n" + :tag "Key" + ,option) + ,value-type)))) + (widget-put widget :args + `(,@(when option-widgets + `((set :inline t :format "%v" + ,@option-widgets))) + (editable-list :inline t + (cons :format "%v" + ,(widget-get widget :key-type) + ,value-type))))) + widget)) + + +;;; keymaps + +(defvar svn-global-keymap nil "Global keymap for psvn.el. +To bind this to a different key, customize `svn-status-prefix-key'.") +(put 'svn-global-keymap 'risky-local-variable t) +(when (not svn-global-keymap) + (setq svn-global-keymap (make-sparse-keymap)) + (define-key svn-global-keymap (kbd "v") 'svn-status-version) + (define-key svn-global-keymap (kbd "s") 'svn-status-this-directory) + (define-key svn-global-keymap (kbd "b") 'svn-status-via-bookmark) + (define-key svn-global-keymap (kbd "h") 'svn-status-use-history) + (define-key svn-global-keymap (kbd "u") 'svn-status-update-cmd) + (define-key svn-global-keymap (kbd "=") 'svn-status-show-svn-diff) + (define-key svn-global-keymap (kbd "f =") 'svn-file-show-svn-diff) + (define-key svn-global-keymap (kbd "f e") 'svn-file-show-svn-ediff) + (define-key svn-global-keymap (kbd "f l") 'svn-status-show-svn-log) + (define-key svn-global-keymap (kbd "f b") 'svn-status-blame) + (define-key svn-global-keymap (kbd "f a") 'svn-file-add-to-changelog) + (define-key svn-global-keymap (kbd "c") 'svn-status-commit) + (define-key svn-global-keymap (kbd "S") 'svn-status-switch-to-status-buffer) + (define-key svn-global-keymap (kbd "o") 'svn-status-pop-to-status-buffer)) + +(defvar svn-status-diff-mode-map () + "Keymap used in `svn-status-diff-mode' for additional commands that are not defined in diff-mode.") +(put 'svn-status-diff-mode-map 'risky-local-variable t) ;for Emacs 20.7 + +(when (not svn-status-diff-mode-map) + (setq svn-status-diff-mode-map (copy-keymap diff-mode-shared-map)) + (define-key svn-status-diff-mode-map [?g] 'revert-buffer) + (define-key svn-status-diff-mode-map [?s] 'svn-status-pop-to-status-buffer) + (define-key svn-status-diff-mode-map [?c] 'svn-status-diff-pop-to-commit-buffer) + (define-key svn-status-diff-mode-map [?w] 'svn-status-diff-save-current-defun-as-kill)) + +(defvar svn-global-trac-map () + "Subkeymap used in `svn-global-keymap' for trac issue tracker commands.") +(put 'svn-global-trac-map 'risky-local-variable t) ;for Emacs 20.7 +(when (not svn-global-trac-map) + (setq svn-global-trac-map (make-sparse-keymap)) + (define-key svn-global-trac-map (kbd "w") 'svn-trac-browse-wiki) + (define-key svn-global-trac-map (kbd "t") 'svn-trac-browse-timeline) + (define-key svn-global-trac-map (kbd "m") 'svn-trac-browse-roadmap) + (define-key svn-global-trac-map (kbd "s") 'svn-trac-browse-source) + (define-key svn-global-trac-map (kbd "r") 'svn-trac-browse-report) + (define-key svn-global-trac-map (kbd "i") 'svn-trac-browse-ticket) + (define-key svn-global-trac-map (kbd "c") 'svn-trac-browse-changeset) + (define-key svn-global-keymap (kbd "t") svn-global-trac-map)) + +;; The setter of `svn-status-prefix-key' makes a binding in the global +;; map refer to the `svn-global-keymap' symbol, rather than directly +;; to the keymap. Emacs then implicitly uses the symbol-function. +;; This has the advantage that `describe-bindings' (C-h b) can show +;; the name of the keymap and link to its documentation. +(defalias 'svn-global-keymap svn-global-keymap) +;; `defalias' of GNU Emacs 21.4 doesn't allow a docstring argument. +(put 'svn-global-keymap 'function-documentation + '(documentation-property 'svn-global-keymap 'variable-documentation t)) + + +;; named after SVN_WC_ADM_DIR_NAME in svn_wc.h +(defun svn-wc-adm-dir-name () + "Return the name of the \".svn\" subdirectory or equivalent." + (if (and (eq system-type 'windows-nt) + (getenv "SVN_ASP_DOT_NET_HACK")) + "_svn" + ".svn")) + +(defun svn-log-edit-file-name (&optional curdir) + "Get the name of the saved log edit file +If curdir, return `svn-log-edit-file-name' +Otherwise position svn-log-edit-file-name in the root directory of this working copy" + (if curdir + svn-log-edit-file-name + (concat (svn-status-base-dir) svn-log-edit-file-name))) + +(defun svn-status-message (level &rest args) + "If LEVEL is lower than `svn-status-debug-level' print ARGS using `message'. + +Guideline for numbers: +1 - error messages, 3 - non-serious error messages, 5 - messages for things +that take a long time, 7 - not very important messages on stuff, 9 - messages +inside loops." + (if (<= level svn-status-debug-level) + (apply 'message args))) + +(defun svn-status-flatten-list (list) + "Flatten any lists within ARGS, so that there are no sublists." + (loop for item in list + if (listp item) nconc (svn-status-flatten-list item) + else collect item)) + +(defun svn-status-window-line-position (w) + "Return the window line at point for window W, or nil if W is nil." + (svn-status-message 3 "About to count lines; selected window is %s" (selected-window)) + (and w (count-lines (window-start w) (point)))) + +;;;###autoload +(defun svn-checkout (repos-url path) + "Run svn checkout REPOS-URL PATH." + (interactive (list (read-string "Checkout from repository Url: ") + (svn-read-directory-name "Checkout to directory: "))) + (svn-run t t 'checkout "checkout" repos-url (expand-file-name path))) + +;;;###autoload (defalias 'svn-examine 'svn-status) +(defalias 'svn-examine 'svn-status) + +;;;###autoload +(defun svn-status (dir &optional arg) + "Examine the status of Subversion working copy in directory DIR. +If ARG is -, allow editing of the parameters. One could add -N to +run svn status non recursively to make it faster. +For every other non nil ARG pass the -u argument to `svn status', which +asks svn to connect to the repository and check to see if there are updates +there. + +If there is no .svn directory, examine if there is CVS and run +`cvs-examine'. Otherwise ask if to run `dired'." + (interactive (list (svn-read-directory-name "SVN status directory: " + nil default-directory nil) + current-prefix-arg)) + (let ((svn-dir (format "%s%s" + (file-name-as-directory dir) + (svn-wc-adm-dir-name))) + (cvs-dir (format "%sCVS" (file-name-as-directory dir)))) + (cond + ((file-directory-p svn-dir) + (setq arg (svn-status-possibly-negate-meaning-of-arg arg 'svn-status)) + (svn-status-1 dir arg)) + ((and (file-directory-p cvs-dir) + (fboundp 'cvs-examine)) + (cvs-examine dir nil)) + (t + (when (y-or-n-p + (format + (concat + "%s " + "is not Subversion controlled (missing %s " + "directory). " + "Run dired instead? ") + dir + (svn-wc-adm-dir-name))) + (dired dir)))))) + +(defvar svn-status-display-new-status-buffer nil) +(defun svn-status-1 (dir &optional arg) + "Examine DIR. See `svn-status' for more information." + (unless (file-directory-p dir) + (error "%s is not a directory" dir)) + (setq dir (file-name-as-directory dir)) + (when svn-status-load-state-before-svn-status + (unless (string= dir (car svn-status-directory-history)) + (let ((default-directory dir)) ;otherwise svn-status-base-dir looks in the wrong place + (svn-status-load-state t)))) + (setq svn-status-directory-history (delete dir svn-status-directory-history)) + (add-to-list 'svn-status-directory-history dir) + (if (string= (buffer-name) svn-status-buffer-name) + (setq svn-status-display-new-status-buffer nil) + (setq svn-status-display-new-status-buffer t) + ;;(message "psvn: Saving initial window configuration") + (setq svn-status-initial-window-configuration + (current-window-configuration))) + (let* ((cur-buf (current-buffer)) + (status-buf (get-buffer-create svn-status-buffer-name)) + (proc-buf (get-buffer-create svn-process-buffer-name)) + (want-edit (eq arg '-)) + (status-option (if want-edit + (if svn-status-verbose "-v" "") + (if svn-status-verbose + (if arg "-uv" "-v") + (if arg "-u" "")))) + (svn-status-edit-svn-command + (or want-edit svn-status-edit-svn-command))) + (save-excursion + (set-buffer status-buf) + (setq default-directory dir) + (set-buffer proc-buf) + (setq default-directory dir + svn-status-remote (when arg t)) + (set-buffer cur-buf) + (svn-run t t 'status "status" status-option)))) + +(defun svn-status-this-directory (arg) + "Run `svn-status' for the `default-directory'" + (interactive "P") + (svn-status default-directory arg)) + +(defun svn-status-use-history () + "Interactively select a different directory from `svn-status-directory-history'." + (interactive) + (let* ((in-status-buffer (eq major-mode 'svn-status-mode)) + (hist (if in-status-buffer (cdr svn-status-directory-history) svn-status-directory-history)) + (dir (funcall svn-status-completing-read-function "svn-status on directory: " hist)) + (svn-buffer-available (with-current-buffer (get-buffer svn-status-buffer-name) (string= default-directory dir)))) + (if (file-directory-p dir) + (if svn-buffer-available + (svn-status-switch-to-status-buffer) + (unless svn-status-refresh-info + (setq svn-status-refresh-info 'once)) + (svn-status dir)) + (error "%s is not a directory" dir)))) + +(defun svn-had-user-input-since-asynch-run () + (not (equal (recent-keys) svn-pre-run-asynch-recent-keys))) + +(defun svn-process-environment () + "Construct the environment for the svn process. +It is a combination of `svn-status-svn-environment-var-list' and +the usual `process-environment'." + ;; If there are duplicate elements in `process-environment', then GNU + ;; Emacs 21.4 guarantees that the first one wins; but GNU Emacs 20.7 + ;; and XEmacs 21.4.17 don't document what happens. We'll just remove + ;; any duplicates ourselves, then. This also gives us an opportunity + ;; to handle the "VARIABLE" syntax that none of them supports. + (loop with found = '() + for elt in (append svn-status-svn-environment-var-list + process-environment) + for has-value = (string-match "=" elt) + for name = (substring elt 0 has-value) + unless (member name found) + do (push name found) + and when has-value + collect elt)) + +(defun svn-run (run-asynchron clear-process-buffer cmdtype &rest arglist) + "Run svn with arguments ARGLIST. + +If RUN-ASYNCHRON is t then run svn asynchronously. + +If CLEAR-PROCESS-BUFFER is t then erase the contents of the +`svn-process-buffer-name' buffer before commencing. + +CMDTYPE is a symbol such as 'mv, 'revert, or 'add, representing the +command to run. + +ARGLIST is a list of arguments \(which must include the command name, +for example: '(\"revert\" \"file1\"\) +ARGLIST is flattened and any every nil value is discarded. + +If the variable `svn-status-edit-svn-command' is non-nil then the user +can edit ARGLIST before running svn. + +The hook svn-pre-run-hook allows to monitor/modify the ARGLIST." + (setq arglist (svn-status-flatten-list arglist)) + (if (eq (process-status "svn") nil) + (progn + (when svn-status-edit-svn-command + (setq arglist (append + (list (car arglist)) + (split-string + (read-from-minibuffer + (format "svn %s flags: " (car arglist)) + (mapconcat 'identity (cdr arglist) " "))))) + (when (eq svn-status-edit-svn-command t) + (svn-status-toggle-edit-cmd-flag t)) + (message "svn-run %s: %S" cmdtype arglist)) + (run-hooks 'svn-pre-run-hook) + (unless (eq mode-line-process 'svn-status-mode-line-process) + (setq svn-pre-run-mode-line-process mode-line-process) + (setq mode-line-process 'svn-status-mode-line-process)) + (setq svn-status-pre-run-svn-buffer (current-buffer)) + (let* ((proc-buf (get-buffer-create svn-process-buffer-name)) + (svn-exe svn-status-svn-executable) + (svn-proc)) + (when (listp (car arglist)) + (setq arglist (car arglist))) + (save-excursion + (set-buffer proc-buf) + (unless (file-executable-p default-directory) + (message "psvn: workaround in %s needed: %s no longer exists" (current-buffer) default-directory) + (cd (expand-file-name "~"))) + (setq buffer-read-only nil) + (buffer-disable-undo) + (fundamental-mode) + (if clear-process-buffer + (delete-region (point-min) (point-max)) + (goto-char (point-max))) + (setq svn-process-cmd cmdtype) + (setq svn-status-last-commit-author nil) + (setq svn-status-mode-line-process-status (format " running %s" cmdtype)) + (svn-status-update-mode-line) + (sit-for 0.1) + (ring-insert svn-last-cmd-ring (list (current-time-string) arglist default-directory)) + (if run-asynchron + (progn + ;;(message "running asynchron: %s %S" svn-exe arglist) + (setq svn-pre-run-asynch-recent-keys (recent-keys)) + (let ((process-environment (svn-process-environment)) + (process-connection-type nil)) + ;; Communicate with the subprocess via pipes rather + ;; than via a pseudoterminal, so that if the svn+ssh + ;; scheme is being used, SSH will not ask for a + ;; passphrase via stdio; psvn.el is currently unable + ;; to answer such prompts. Instead, SSH will run + ;; x11-ssh-askpass if possible. If Emacs is being + ;; run on a TTY without $DISPLAY, this will fail; in + ;; such cases, the user should start ssh-agent and + ;; then run ssh-add explicitly. + (setq svn-proc (apply 'start-process "svn" proc-buf svn-exe arglist))) + (when svn-status-svn-process-coding-system + (set-process-coding-system svn-proc svn-status-svn-process-coding-system + svn-status-svn-process-coding-system)) + (set-process-sentinel svn-proc 'svn-process-sentinel) + (when svn-status-track-user-input + (set-process-filter svn-proc 'svn-process-filter))) + ;;(message "running synchron: %s %S" svn-exe arglist) + (let ((process-environment (svn-process-environment))) + ;; `call-process' ignores `process-connection-type' and + ;; never opens a pseudoterminal. + (apply 'call-process svn-exe nil proc-buf nil arglist)) + (setq svn-status-last-output-buffer-name svn-process-buffer-name) + (run-hooks 'svn-post-process-svn-output-hook) + (setq svn-status-mode-line-process-status "") + (svn-status-update-mode-line) + (when svn-pre-run-mode-line-process + (setq mode-line-process svn-pre-run-mode-line-process) + (setq svn-pre-run-mode-line-process nil)))))) + (error "You can only run one svn process at once!"))) + +(defun svn-process-sentinel-fixup-path-seperators () + "Convert all path separators to UNIX style. +\(This is a no-op unless `system-type' is windows-nt\)" + (when (eq system-type 'windows-nt) + (save-excursion + (goto-char (point-min)) + (while (search-forward "\\" nil t) + (replace-match "/"))))) + +(defun svn-process-sentinel (process event) + ;;(princ (format "Process: %s had the event `%s'" process event))) + ;;(save-excursion + (let ((act-buf (current-buffer))) + (when svn-pre-run-mode-line-process + (with-current-buffer svn-status-pre-run-svn-buffer + (setq mode-line-process svn-pre-run-mode-line-process)) + (setq svn-pre-run-mode-line-process nil)) + (set-buffer (process-buffer process)) + (setq svn-status-mode-line-process-status "") + (svn-status-update-mode-line) + (cond ((string= event "finished\n") + (run-hooks 'svn-post-process-svn-output-hook) + (cond ((eq svn-process-cmd 'status) + ;;(message "svn status finished") + (svn-process-sentinel-fixup-path-seperators) + (svn-parse-status-result) + (svn-status-apply-elide-list) + (when svn-status-update-previous-process-output + (set-buffer (process-buffer process)) + (delete-region (point-min) (point-max)) + (insert "Output from svn command:\n") + (insert svn-status-update-previous-process-output) + (goto-char (point-min)) + (setq svn-status-update-previous-process-output nil)) + (when svn-status-update-list + ;; (message "Using svn-status-update-list: %S" svn-status-update-list) + (save-excursion + (svn-status-update-with-command-list svn-status-update-list)) + (setq svn-status-update-list nil)) + (when svn-status-display-new-status-buffer + (set-window-configuration svn-status-initial-window-configuration) + (if (svn-had-user-input-since-asynch-run) + (message "svn status finished") + (switch-to-buffer svn-status-buffer-name)))) + ((eq svn-process-cmd 'log) + (svn-status-show-process-output 'log t) + (pop-to-buffer svn-status-last-output-buffer-name) + (svn-log-view-mode) + (forward-line 2) + (unless (looking-at "Changed paths:") + (forward-line 1)) + (font-lock-fontify-buffer) + (message "svn log finished")) + ((eq svn-process-cmd 'info) + (svn-status-show-process-output 'info t) + (message "svn info finished")) + ((eq svn-process-cmd 'ls) + (svn-status-show-process-output 'info t) + (message "svn ls finished")) + ((eq svn-process-cmd 'diff) + (svn-status-activate-diff-mode) + (message "svn diff finished")) + ((eq svn-process-cmd 'parse-info) + (svn-status-parse-info-result)) + ((eq svn-process-cmd 'blame) + (svn-status-show-process-output 'blame t) + (when svn-status-pre-run-svn-buffer + (with-current-buffer svn-status-pre-run-svn-buffer + (unless (eq major-mode 'svn-status-mode) + (let ((src-line-number (svn-line-number-at-pos))) + (pop-to-buffer (get-buffer svn-status-last-output-buffer-name)) + (goto-line src-line-number))))) + (with-current-buffer (get-buffer svn-status-last-output-buffer-name) + (svn-status-activate-blame-mode)) + (message "svn blame finished")) + ((eq svn-process-cmd 'commit) + (svn-process-sentinel-fixup-path-seperators) + (svn-status-remove-temp-file-maybe) + (when (member 'commit svn-status-unmark-files-after-list) + (svn-status-unset-all-usermarks)) + (svn-status-update-with-command-list (svn-status-parse-commit-output)) + (svn-revert-some-buffers) + (run-hooks 'svn-log-edit-done-hook) + (setq svn-status-files-to-commit nil + svn-status-recursive-commit nil) + (message "svn: Committed revision %s." svn-status-commit-rev-number)) + ((eq svn-process-cmd 'update) + (svn-status-show-process-output 'update t) + (setq svn-status-update-list (svn-status-parse-update-output)) + (svn-revert-some-buffers) + (svn-status-update) + (if (car svn-status-update-rev-number) + (message "svn: Updated to revision %s." (cadr svn-status-update-rev-number)) + (message "svn: At revision %s." (cadr svn-status-update-rev-number)))) + ((eq svn-process-cmd 'add) + (svn-status-update-with-command-list (svn-status-parse-ar-output)) + (message "svn add finished")) + ((eq svn-process-cmd 'lock) + (svn-status-update) + (message "svn lock finished")) + ((eq svn-process-cmd 'unlock) + (svn-status-update) + (message "svn unlock finished")) + ((eq svn-process-cmd 'mkdir) + (svn-status-update) + (message "svn mkdir finished")) + ((eq svn-process-cmd 'revert) + (when (member 'revert svn-status-unmark-files-after-list) + (svn-status-unset-all-usermarks)) + (svn-status-update) + (message "svn revert finished")) + ((eq svn-process-cmd 'resolved) + (svn-status-update) + (message "svn resolved finished")) + ((eq svn-process-cmd 'rm) + (svn-status-update-with-command-list (svn-status-parse-ar-output)) + (message "svn rm finished")) + ((eq svn-process-cmd 'cleanup) + (message "svn cleanup finished")) + ((eq svn-process-cmd 'proplist) + (svn-status-show-process-output 'proplist t) + (message "svn proplist finished")) + ((eq svn-process-cmd 'checkout) + (svn-status default-directory)) + ((eq svn-process-cmd 'proplist-parse) + (svn-status-property-parse-property-names)) + ((eq svn-process-cmd 'propset) + (svn-status-remove-temp-file-maybe) + (if (member svn-status-propedit-property-name '("svn:keywords")) + (svn-status-update-with-command-list (svn-status-parse-property-output)) + (svn-status-update))) + ((eq svn-process-cmd 'propdel) + (svn-status-update)))) + ((string= event "killed\n") + (message "svn process killed")) + ((string-match "exited abnormally" event) + (while (accept-process-output process 0 100)) + ;; find last error message and show it. + (goto-char (point-max)) + (message "svn failed: %s" + (if (re-search-backward "^svn: \\(.*\\)" nil t) + (match-string 1) + event))) + (t + (message "svn process had unknown event: %s" event)) + (svn-status-show-process-output nil t)))) + +(defun svn-process-filter (process str) + "Track the svn process output and ask user questions in the minibuffer when appropriate." + (save-window-excursion + (set-buffer svn-process-buffer-name) + ;;(message "svn-process-filter: %s" str) + (goto-char (point-max)) + (insert str) + (save-excursion + (goto-char (svn-point-at-bol)) + (when (looking-at "Password for '\\(.+\\)': ") + ;(svn-status-show-process-buffer) + (let ((passwd (read-passwd + (format "Enter svn password for %s: " (match-string 1))))) + (svn-process-send-string-and-newline passwd t))) + (when (looking-at "Username: ") + (let ((user-name (read-string "Username for svn operation: "))) + (svn-process-send-string-and-newline user-name))) + (when (looking-at "(R)eject, accept (t)emporarily or accept (p)ermanently") + (svn-status-show-process-buffer) + (let ((answer (read-string "(R)eject, accept (t)emporarily or accept (p)ermanently? "))) + (svn-process-send-string (substring answer 0 1))))))) + +(defun svn-revert-some-buffers (&optional tree) + "Reverts all buffers visiting a file in TREE that aren't modified. +To be run after a commit, an update or a merge." + (interactive) + (let ((tree (or (svn-status-base-dir) tree))) + (dolist (buffer (buffer-list)) + (with-current-buffer buffer + (when (not (buffer-modified-p)) + (let ((file (buffer-file-name))) + (when file + (let ((root (svn-status-base-dir (file-name-directory file))) + (point-pos (point))) + (when (and root + (string= root tree) + ;; buffer is modified and in the tree TREE. + svn-status-auto-revert-buffers) + ;; (message "svn-revert-some-buffers: %s %s" (buffer-file-name) (verify-visited-file-modtime (current-buffer))) + ;; Keep the buffer if the file doesn't exist + (when (and (file-exists-p file) (not (verify-visited-file-modtime (current-buffer)))) + (revert-buffer t t) + (goto-char point-pos))))))))))) + +(defun svn-parse-rev-num (str) + (if (and str (stringp str) + (save-match-data (string-match "^[0-9]+" str))) + (string-to-number str) + -1)) + +(defsubst svn-status-make-ui-status () + "Make a ui-status structure for a file in a svn working copy. +The initial values in the structure returned by this function +are good for a file or directory that the user hasn't seen before. + +The ui-status structure keeps track of how the file or directory +should be displayed in svn-status mode. Updating the svn-status +buffer from the working copy preserves the ui-status if possible. +User commands modify this structure; each file or directory must +thus have its own copy. + +Currently, the ui-status is a list (USER-MARK USER-ELIDE). +USER-MARK is non-nil iff the user has marked the file or directory, + typically with `svn-status-set-user-mark'. To read USER-MARK, + call `svn-status-line-info->has-usermark'. +USER-ELIDE is non-nil iff the user has elided the file or directory + from the svn-status buffer, typically with `svn-status-toggle-elide'. + To read USER-ELIDE, call `svn-status-line-info->user-elide'. + +Call `svn-status-line-info->ui-status' to access the whole ui-status +structure." + (list nil nil)) + +(defun svn-status-make-dummy-dirs (dir-list old-ui-information) + (append (mapcar (lambda (dir) + (svn-status-make-line-info + dir + (gethash dir old-ui-information))) + dir-list) + svn-status-info)) + +(defun svn-status-make-line-info (&optional + path + ui + file-mark prop-mark + local-rev last-change-rev + author + update-mark + locked-mark + with-history-mark + switched-mark + locked-repo-mark + psvn-extra-info) + "Create a new line-info from the given arguments +Anything left nil gets a sensible default. +nb: LOCKED-MARK refers to the kind of locks you get after an error, + LOCKED-REPO-MARK is the kind managed with `svn lock'" + (list (or ui (svn-status-make-ui-status)) + (or file-mark ? ) + (or prop-mark ? ) + (or path "") + (or local-rev ? ) + (or last-change-rev ? ) + (or author "") + update-mark + locked-mark + with-history-mark + switched-mark + locked-repo-mark + psvn-extra-info)) + +(defvar svn-user-names-including-blanks nil "A list of svn user names that include blanks.") +;;(setq svn-user-names-including-blanks '("feng shui" "mister blank")) +;;(add-hook 'svn-pre-parse-status-hook 'svn-status-parse-fixup-user-names-including-blanks) + +(defun svn-status-parse-fixup-user-names-including-blanks () + "Helper function to allow user names that include blanks. +Add this function to the `svn-pre-parse-status-hook'. The variable +`svn-user-names-including-blanks' must be configured to hold all user names that contain +blanks. This function replaces the blanks with '-' to allow further processing with +the usual parsing functionality in `svn-parse-status-result'." + (when svn-user-names-including-blanks + (goto-char (point-min)) + (let ((search-string (concat " \\(" (mapconcat 'concat svn-user-names-including-blanks "\\|") "\\) "))) + (save-match-data + (save-excursion + (while (re-search-forward search-string (point-max) t) + (replace-match (replace-regexp-in-string " " "-" (match-string 1)) nil nil nil 1))))))) + +(defun svn-parse-status-result () + "Parse the `svn-process-buffer-name' buffer. +The results are used to build the `svn-status-info' variable." + (setq svn-status-head-revision nil) + (save-excursion + (let ((old-ui-information (svn-status-ui-information-hash-table)) + (svn-marks) + (svn-file-mark) + (svn-property-mark) + (svn-wc-locked-mark) + (svn-repo-locked-mark) + (svn-with-history-mark) + (svn-switched-mark) + (svn-update-mark) + (local-rev) + (last-change-rev) + (author) + (path) + (dir) + (revision-width svn-status-default-revision-width) + (author-width svn-status-default-author-width) + (svn-marks-length (if svn-status-verbose + (if svn-status-remote + 8 6) + (if svn-status-remote + ;; not verbose + 8 7))) + (dir-set '(".")) + (externals-map (make-hash-table :test 'equal)) + (skip-double-external-dir-entry-name nil)) + (set-buffer svn-process-buffer-name) + (setq svn-status-info nil) + (run-hooks 'svn-pre-parse-status-hook) + (goto-char (point-min)) + (while (< (point) (point-max)) + (cond + ((= (svn-point-at-eol) (svn-point-at-bol)) ;skip blank lines + nil) + ((looking-at "Status against revision:[ ]+\\([0-9]+\\)") + ;; the above message appears for the main listing plus once for each svn:externals entry + (unless svn-status-head-revision + (setq svn-status-head-revision (match-string 1)))) + ((looking-at "Performing status on external item at '\\(.*\\)'") + ;; The *next* line has info about the directory named in svn:externals + ;; [ie the directory in (match-string 1)] + ;; we should parse it, and merge the info with what we have already know + ;; but for now just ignore the line completely + ; (forward-line) + ;; Actually, this seems to not always be the case + ;; I have an example where we are in an svn:external which + ;; is itself inside a svn:external, this need not be true: + ;; the next line is not 'X dir' but just 'dir', so we + ;; actually need to parse that line, or the results will + ;; not contain dir! + ;; so we should merge lines 'X dir' with ' dir', but for now + ;; we just leave both in the results + + ;; My attempt to merge the lines uses skip-double-external-dir-entry-name + ;; and externals-map + (setq skip-double-external-dir-entry-name (match-string-no-properties 1)) + ;; (message "Going to skip %s" skip-double-external-dir-entry-name) + nil) + (t + (setq svn-marks (buffer-substring (point) (+ (point) svn-marks-length)) + svn-file-mark (elt svn-marks 0) ; 1st column - M,A,C,D,G,? etc + svn-property-mark (elt svn-marks 1) ; 2nd column - M,C (properties) + svn-wc-locked-mark (elt svn-marks 2) ; 3rd column - L or blank + svn-with-history-mark (elt svn-marks 3) ; 4th column - + or blank + svn-switched-mark (elt svn-marks 4) ; 5th column - S or blank + svn-repo-locked-mark (elt svn-marks 5)) ; 6th column - K,O,T,B or blank + (when svn-status-remote + (setq svn-update-mark (elt svn-marks 7))) ; 8th column - * or blank + (when (eq svn-property-mark ?\ ) (setq svn-property-mark nil)) + (when (eq svn-wc-locked-mark ?\ ) (setq svn-wc-locked-mark nil)) + (when (eq svn-with-history-mark ?\ ) (setq svn-with-history-mark nil)) + (when (eq svn-switched-mark ?\ ) (setq svn-switched-mark nil)) + (when (eq svn-update-mark ?\ ) (setq svn-update-mark nil)) + (when (eq svn-repo-locked-mark ?\ ) (setq svn-repo-locked-mark nil)) + (forward-char svn-marks-length) + (skip-chars-forward " ") + ;; (message "after marks: '%s'" (buffer-substring (point) (line-end-position))) + (cond + ((looking-at "\\([-?]\\|[0-9]+\\) +\\([-?]\\|[0-9]+\\) +\\([^ ]+\\) *\\(.+\\)$") + (setq local-rev (svn-parse-rev-num (match-string 1)) + last-change-rev (svn-parse-rev-num (match-string 2)) + author (match-string 3) + path (match-string 4))) + ((looking-at "\\([-?]\\|[0-9]+\\) +\\([^ ]+\\)$") + (setq local-rev (svn-parse-rev-num (match-string 1)) + last-change-rev -1 + author "?" + path (match-string 2))) + ((looking-at "\\(.*\\)") + (setq path (match-string 1) + local-rev -1 + last-change-rev -1 + author (if (eq svn-file-mark ?X) "" "?"))) ;clear author of svn:externals dirs + (t + (error "Unknown status line format"))) + (unless path (setq path ".")) + (setq dir (file-name-directory path)) + (if (and (not svn-status-verbose) dir) + (let ((dirname (directory-file-name dir))) + (if (not (member dirname dir-set)) + (setq dir-set (cons dirname dir-set))))) + (if (and skip-double-external-dir-entry-name (string= skip-double-external-dir-entry-name path)) + ;; merge this entry to a previous saved one + (let ((info (gethash path externals-map))) + ;; (message "skip-double-external-dir-entry-name: %s - path: %s" skip-double-external-dir-entry-name path) + (if info + (progn + (svn-status-line-info->set-localrev info local-rev) + (svn-status-line-info->set-lastchangerev info last-change-rev) + (svn-status-line-info->set-author info author) + (svn-status-message 3 "merging entry for %s to %s" path info) + (setq skip-double-external-dir-entry-name nil)) + (message "psvn: %s not handled correct, please report this case." path))) + (setq svn-status-info + (cons (svn-status-make-line-info path + (gethash path old-ui-information) + svn-file-mark + svn-property-mark + local-rev + last-change-rev + author + svn-update-mark + svn-wc-locked-mark + svn-with-history-mark + svn-switched-mark + svn-repo-locked-mark + nil) ;;psvn-extra-info + svn-status-info))) + (when (eq svn-file-mark ?X) + (svn-puthash (match-string 1) (car svn-status-info) externals-map) + (svn-status-message 3 "found external: %s %S" (match-string 1) (car svn-status-info))) + (setq revision-width (max revision-width + (length (number-to-string local-rev)) + (length (number-to-string last-change-rev)))) + (setq author-width (max author-width (length author))))) + (forward-line 1)) + (unless svn-status-verbose + (setq svn-status-info (svn-status-make-dummy-dirs dir-set + old-ui-information))) + (setq svn-status-default-column + (+ 6 revision-width revision-width author-width + (if svn-status-short-mod-flag-p 3 0))) + (setq svn-status-line-format (format " %%c%%c%%c %%%ds %%%ds %%-%ds" + revision-width + revision-width + author-width)) + (setq svn-status-info (nreverse svn-status-info)) + (when svn-status-sort-status-buffer + (setq svn-status-info (sort svn-status-info 'svn-status-sort-predicate)))))) + +;;(string-lessp "." "%") => nil +;(svn-status-sort-predicate '(t t t ".") '(t t t "%")) => t +(defun svn-status-sort-predicate (a b) + "Return t if A should appear before B in the `svn-status-buffer-name' buffer. +A and B must be line-info's." + (string-lessp (concat (svn-status-line-info->full-path a) "/") + (concat (svn-status-line-info->full-path b) "/"))) + +(defun svn-status-remove-temp-file-maybe () + "Remove any (no longer required) temporary files created by psvn.el." + (when svn-status-temp-file-to-remove + (when (file-exists-p svn-status-temp-file-to-remove) + (delete-file svn-status-temp-file-to-remove)) + (when (file-exists-p svn-status-temp-arg-file) + (delete-file svn-status-temp-arg-file)) + (setq svn-status-temp-file-to-remove nil))) + +(defun svn-status-remove-control-M () + "Remove ^M at end of line in the whole buffer." + (interactive) + (let ((buffer-read-only nil)) + (save-match-data + (save-excursion + (goto-char (point-min)) + (while (re-search-forward "\r$" (point-max) t) + (replace-match "" nil nil)))))) + +(condition-case nil + ;;(easy-menu-add-item nil '("tools") ["SVN Status" svn-status t] "PCL-CVS") + (easy-menu-add-item nil '("tools") ["SVN Status" svn-status t]) + (error (message "psvn: could not install menu"))) + +(defvar svn-status-mode-map () "Keymap used in `svn-status-mode' buffers.") +(put 'svn-status-mode-map 'risky-local-variable t) ;for Emacs 20.7 +(defvar svn-status-mode-mark-map () + "Subkeymap used in `svn-status-mode' for mark commands.") +(put 'svn-status-mode-mark-map 'risky-local-variable t) ;for Emacs 20.7 +(defvar svn-status-mode-property-map () + "Subkeymap used in `svn-status-mode' for property commands.") +(put 'svn-status-mode-property-map 'risky-local-variable t) ;for Emacs 20.7 +(defvar svn-status-mode-options-map () + "Subkeymap used in `svn-status-mode' for option commands.") +(put 'svn-status-mode-options-map 'risky-local-variable t) ;for Emacs 20.7 +(defvar svn-status-mode-trac-map () + "Subkeymap used in `svn-status-mode' for trac issue tracker commands.") +(put 'svn-status-mode-trac-map 'risky-local-variable t) ;for Emacs 20.7 +(defvar svn-status-mode-extension-map () + "Subkeymap used in `svn-status-mode' for some seldom used commands.") +(put 'svn-status-mode-extension-map 'risky-local-variable t) ;for Emacs 20.7 +(defvar svn-status-mode-branch-map () + "Subkeymap used in `svn-status-mode' for branching commands.") +(put 'svn-status-mode-extension-map 'risky-local-variable t) ;for Emacs 20.7 + +(when (not svn-status-mode-map) + (setq svn-status-mode-map (make-sparse-keymap)) + (suppress-keymap svn-status-mode-map) + ;; Don't use (kbd ""); it's unreachable with GNU Emacs 21.3 on a TTY. + (define-key svn-status-mode-map (kbd "RET") 'svn-status-find-file-or-examine-directory) + (define-key svn-status-mode-map (kbd "") 'svn-status-mouse-find-file-or-examine-directory) + (define-key svn-status-mode-map (kbd "^") 'svn-status-examine-parent) + (define-key svn-status-mode-map (kbd "s") 'svn-status-show-process-buffer) + (define-key svn-status-mode-map (kbd "h") 'svn-status-pop-to-partner-buffer) + (define-key svn-status-mode-map (kbd "f") 'svn-status-find-files) + (define-key svn-status-mode-map (kbd "o") 'svn-status-find-file-other-window) + (define-key svn-status-mode-map (kbd "C-o") 'svn-status-find-file-other-window-noselect) + (define-key svn-status-mode-map (kbd "v") 'svn-status-view-file-other-window) + (define-key svn-status-mode-map (kbd "e") 'svn-status-toggle-edit-cmd-flag) + (define-key svn-status-mode-map (kbd "g") 'svn-status-update) + (define-key svn-status-mode-map (kbd "M-s") 'svn-status-update) ;; PCL-CVS compatibility + (define-key svn-status-mode-map (kbd "q") 'svn-status-bury-buffer) + (define-key svn-status-mode-map (kbd "x") 'svn-status-redraw-status-buffer) + (define-key svn-status-mode-map (kbd "H") 'svn-status-use-history) + (define-key svn-status-mode-map (kbd "m") 'svn-status-set-user-mark) + (define-key svn-status-mode-map (kbd "u") 'svn-status-unset-user-mark) + ;; This matches a binding of `dired-unmark-all-files' in `dired-mode-map' + ;; of both GNU Emacs and XEmacs. It seems unreachable with XEmacs on + ;; TTY, but if that's a problem then its Dired needs fixing too. + ;; Or you could just use "*!". + (define-key svn-status-mode-map "\M-\C-?" 'svn-status-unset-all-usermarks) + ;; The key that normally deletes characters backwards should here + ;; instead unmark files backwards. In GNU Emacs, that would be (kbd + ;; "DEL") aka [?\177], but XEmacs treats those as [(delete)] and + ;; would bind a key that normally deletes forwards. [(backspace)] + ;; is unreachable with GNU Emacs on a tty. Try to recognize the + ;; dialect and act accordingly. + ;; + ;; XEmacs has a `delete-forward-p' function that checks the + ;; `delete-key-deletes-forward' option. We don't use those, for two + ;; reasons: psvn.el may be loaded before user customizations, and + ;; XEmacs allows simultaneous connections to multiple devices with + ;; different keyboards. + (define-key svn-status-mode-map + (if (member (kbd "DEL") '([(delete)] [delete])) + [(backspace)] ; XEmacs + (kbd "DEL")) ; GNU Emacs + 'svn-status-unset-user-mark-backwards) + (define-key svn-status-mode-map (kbd "$") 'svn-status-toggle-elide) + (define-key svn-status-mode-map (kbd "w") 'svn-status-copy-current-line-info) + (define-key svn-status-mode-map (kbd ".") 'svn-status-goto-root-or-return) + (define-key svn-status-mode-map (kbd "I") 'svn-status-parse-info) + (define-key svn-status-mode-map (kbd "V") 'svn-status-svnversion) + (define-key svn-status-mode-map (kbd "?") 'svn-status-toggle-hide-unknown) + (define-key svn-status-mode-map (kbd "_") 'svn-status-toggle-hide-unmodified) + (define-key svn-status-mode-map (kbd "a") 'svn-status-add-file) + (define-key svn-status-mode-map (kbd "A") 'svn-status-add-file-recursively) + (define-key svn-status-mode-map (kbd "+") 'svn-status-make-directory) + (define-key svn-status-mode-map (kbd "R") 'svn-status-mv) + (define-key svn-status-mode-map (kbd "C") 'svn-status-cp) + (define-key svn-status-mode-map (kbd "D") 'svn-status-rm) + (define-key svn-status-mode-map (kbd "c") 'svn-status-commit) + (define-key svn-status-mode-map (kbd "M-c") 'svn-status-cleanup) + (define-key svn-status-mode-map (kbd "k") 'svn-status-lock) + (define-key svn-status-mode-map (kbd "K") 'svn-status-unlock) + (define-key svn-status-mode-map (kbd "U") 'svn-status-update-cmd) + (define-key svn-status-mode-map (kbd "M-u") 'svn-status-update-cmd) + (define-key svn-status-mode-map (kbd "r") 'svn-status-revert) + (define-key svn-status-mode-map (kbd "l") 'svn-status-show-svn-log) + (define-key svn-status-mode-map (kbd "i") 'svn-status-info) + (define-key svn-status-mode-map (kbd "b") 'svn-status-blame) + (define-key svn-status-mode-map (kbd "=") 'svn-status-show-svn-diff) + ;; [(control ?=)] is unreachable on TTY, but you can use "*u" instead. + ;; (Is the "u" mnemonic for something?) + (define-key svn-status-mode-map (kbd "C-=") 'svn-status-show-svn-diff-for-marked-files) + (define-key svn-status-mode-map (kbd "~") 'svn-status-get-specific-revision) + (define-key svn-status-mode-map (kbd "E") 'svn-status-ediff-with-revision) + + (define-key svn-status-mode-map (kbd "n") 'svn-status-next-line) + (define-key svn-status-mode-map (kbd "p") 'svn-status-previous-line) + (define-key svn-status-mode-map (kbd "") 'svn-status-next-line) + (define-key svn-status-mode-map (kbd "") 'svn-status-previous-line) + (define-key svn-status-mode-map (kbd "C-x C-j") 'svn-status-dired-jump) + (define-key svn-status-mode-map [down-mouse-3] 'svn-status-popup-menu) + (setq svn-status-mode-mark-map (make-sparse-keymap)) + (define-key svn-status-mode-map (kbd "*") svn-status-mode-mark-map) + (define-key svn-status-mode-mark-map (kbd "!") 'svn-status-unset-all-usermarks) + (define-key svn-status-mode-mark-map (kbd "?") 'svn-status-mark-unknown) + (define-key svn-status-mode-mark-map (kbd "A") 'svn-status-mark-added) + (define-key svn-status-mode-mark-map (kbd "M") 'svn-status-mark-modified) + (define-key svn-status-mode-mark-map (kbd "D") 'svn-status-mark-deleted) + (define-key svn-status-mode-mark-map (kbd "*") 'svn-status-mark-changed) + (define-key svn-status-mode-mark-map (kbd ".") 'svn-status-mark-by-file-ext) + (define-key svn-status-mode-mark-map (kbd "%") 'svn-status-mark-filename-regexp) + (define-key svn-status-mode-mark-map (kbd "u") 'svn-status-show-svn-diff-for-marked-files)) +(when (not svn-status-mode-property-map) + (setq svn-status-mode-property-map (make-sparse-keymap)) + (define-key svn-status-mode-property-map (kbd "l") 'svn-status-property-list) + (define-key svn-status-mode-property-map (kbd "s") 'svn-status-property-set) + (define-key svn-status-mode-property-map (kbd "d") 'svn-status-property-delete) + (define-key svn-status-mode-property-map (kbd "e") 'svn-status-property-edit-one-entry) + (define-key svn-status-mode-property-map (kbd "i") 'svn-status-property-ignore-file) + (define-key svn-status-mode-property-map (kbd "I") 'svn-status-property-ignore-file-extension) + ;; XEmacs 21.4.15 on TTY (vt420) converts `C-i' to `TAB', + ;; which [(control ?i)] won't match. Handle it separately. + ;; On GNU Emacs, the following two forms bind the same key, + ;; reducing clutter in `where-is'. + (define-key svn-status-mode-property-map [(control ?i)] 'svn-status-property-edit-svn-ignore) + (define-key svn-status-mode-property-map (kbd "TAB") 'svn-status-property-edit-svn-ignore) + (define-key svn-status-mode-property-map (kbd "k") 'svn-status-property-set-keyword-list) + (define-key svn-status-mode-property-map (kbd "Ki") 'svn-status-property-set-keyword-id) + (define-key svn-status-mode-property-map (kbd "Kd") 'svn-status-property-set-keyword-date) + (define-key svn-status-mode-property-map (kbd "y") 'svn-status-property-set-eol-style) + (define-key svn-status-mode-property-map (kbd "x") 'svn-status-property-set-executable) + (define-key svn-status-mode-property-map (kbd "m") 'svn-status-property-set-mime-type) + ;; TODO: Why is `svn-status-select-line' in `svn-status-mode-property-map'? + (define-key svn-status-mode-property-map (kbd "RET") 'svn-status-select-line) + (define-key svn-status-mode-map (kbd "P") svn-status-mode-property-map)) +(when (not svn-status-mode-extension-map) + (setq svn-status-mode-extension-map (make-sparse-keymap)) + (define-key svn-status-mode-extension-map (kbd "v") 'svn-status-resolved) + (define-key svn-status-mode-extension-map (kbd "X") 'svn-status-resolve-conflicts) + (define-key svn-status-mode-extension-map (kbd "e") 'svn-status-export) + (define-key svn-status-mode-map (kbd "X") svn-status-mode-extension-map)) +(when (not svn-status-mode-options-map) + (setq svn-status-mode-options-map (make-sparse-keymap)) + (define-key svn-status-mode-options-map (kbd "s") 'svn-status-save-state) + (define-key svn-status-mode-options-map (kbd "l") 'svn-status-load-state) + (define-key svn-status-mode-options-map (kbd "x") 'svn-status-toggle-sort-status-buffer) + (define-key svn-status-mode-options-map (kbd "v") 'svn-status-toggle-svn-verbose-flag) + (define-key svn-status-mode-options-map (kbd "f") 'svn-status-toggle-display-full-path) + (define-key svn-status-mode-options-map (kbd "t") 'svn-status-set-trac-project-root) + (define-key svn-status-mode-options-map (kbd "n") 'svn-status-set-module-name) + (define-key svn-status-mode-options-map (kbd "c") 'svn-status-set-changelog-style) + (define-key svn-status-mode-options-map (kbd "b") 'svn-status-set-branch-list) + (define-key svn-status-mode-map (kbd "O") svn-status-mode-options-map)) +(when (not svn-status-mode-trac-map) + (setq svn-status-mode-trac-map (make-sparse-keymap)) + (define-key svn-status-mode-trac-map (kbd "w") 'svn-trac-browse-wiki) + (define-key svn-status-mode-trac-map (kbd "t") 'svn-trac-browse-timeline) + (define-key svn-status-mode-trac-map (kbd "m") 'svn-trac-browse-roadmap) + (define-key svn-status-mode-trac-map (kbd "r") 'svn-trac-browse-report) + (define-key svn-status-mode-trac-map (kbd "s") 'svn-trac-browse-source) + (define-key svn-status-mode-trac-map (kbd "i") 'svn-trac-browse-ticket) + (define-key svn-status-mode-trac-map (kbd "c") 'svn-trac-browse-changeset) + (define-key svn-status-mode-map (kbd "T") svn-status-mode-trac-map)) +(when (not svn-status-mode-branch-map) + (setq svn-status-mode-branch-map (make-sparse-keymap)) + (define-key svn-status-mode-branch-map (kbd "d") 'svn-branch-diff) + (define-key svn-status-mode-map (kbd "B") svn-status-mode-branch-map)) + +(easy-menu-define svn-status-mode-menu svn-status-mode-map + "'svn-status-mode' menu" + '("SVN" + ["svn status" svn-status-update t] + ["svn update" svn-status-update-cmd t] + ["svn commit" svn-status-commit t] + ["svn log" svn-status-show-svn-log t] + ["svn info" svn-status-info t] + ["svn blame" svn-status-blame t] + ("Diff" + ["svn diff current file" svn-status-show-svn-diff t] + ["svn diff marked files" svn-status-show-svn-diff-for-marked-files t] + ["svn ediff current file" svn-status-ediff-with-revision t] + ["svn resolve conflicts" svn-status-resolve-conflicts] + ) + ["svn cat ..." svn-status-get-specific-revision t] + ["svn add" svn-status-add-file t] + ["svn add recursively" svn-status-add-file-recursively t] + ["svn mkdir..." svn-status-make-directory t] + ["svn mv..." svn-status-mv t] + ["svn cp..." svn-status-cp t] + ["svn rm..." svn-status-rm t] + ["svn export..." svn-status-export t] + ["Up Directory" svn-status-examine-parent t] + ["Elide Directory" svn-status-toggle-elide t] + ["svn revert" svn-status-revert t] + ["svn resolved" svn-status-resolved t] + ["svn cleanup" svn-status-cleanup t] + ["svn lock" svn-status-lock t] + ["svn unlock" svn-status-unlock t] + ["Show Process Buffer" svn-status-show-process-buffer t] + ("Branch" + ["diff" svn-branch-diff t] + ["Set Branch list" svn-status-set-branch-list t] + ) + ("Property" + ["svn proplist" svn-status-property-list t] + ["Set Multiple Properties..." svn-status-property-set t] + ["Edit One Property..." svn-status-property-edit-one-entry t] + ["svn propdel..." svn-status-property-delete t] + "---" + ["svn:ignore File..." svn-status-property-ignore-file t] + ["svn:ignore File Extension..." svn-status-property-ignore-file-extension t] + ["Edit svn:ignore Property" svn-status-property-edit-svn-ignore t] + "---" + ["Edit svn:keywords List" svn-status-property-set-keyword-list t] + ["Add/Remove Id to/from svn:keywords" svn-status-property-set-keyword-id t] + ["Add/Remove Date to/from svn:keywords" svn-status-property-set-keyword-date t] + "---" + ["Select svn:eol-style" svn-status-property-set-eol-style t] + ["Set svn:executable" svn-status-property-set-executable t] + ["Set svn:mime-type" svn-status-property-set-mime-type t] + ) + ("Options" + ["Save Options" svn-status-save-state t] + ["Load Options" svn-status-load-state t] + ["Set Trac project root" svn-status-set-trac-project-root t] + ["Set Short module name" svn-status-set-module-name t] + ["Set Changelog style" svn-status-set-changelog-style t] + ["Set Branch list" svn-status-set-branch-list t] + ["Sort the *svn-status* buffer" svn-status-toggle-sort-status-buffer + :style toggle :selected svn-status-sort-status-buffer] + ["Use -v for svn status calls" svn-status-toggle-svn-verbose-flag + :style toggle :selected svn-status-verbose] + ["Display full path names" svn-status-toggle-display-full-path + :style toggle :selected svn-status-display-full-path] + ) + ("Trac" + ["Browse wiki" svn-trac-browse-wiki t] + ["Browse timeline" svn-trac-browse-timeline t] + ["Browse roadmap" svn-trac-browse-roadmap t] + ["Browse source" svn-trac-browse-source t] + ["Browse report" svn-trac-browse-report t] + ["Browse ticket" svn-trac-browse-ticket t] + ["Browse changeset" svn-trac-browse-changeset t] + ["Set Trac project root" svn-status-set-trac-project-root t] + ) + "---" + ["Edit Next SVN Cmd Line" svn-status-toggle-edit-cmd-flag t] + ["Work Directory History..." svn-status-use-history t] + ("Mark / Unmark" + ["Mark" svn-status-set-user-mark t] + ["Unmark" svn-status-unset-user-mark t] + ["Unmark all" svn-status-unset-all-usermarks t] + "---" + ["Mark/Unmark unknown" svn-status-mark-unknown t] + ["Mark/Unmark added" svn-status-mark-added t] + ["Mark/Unmark modified" svn-status-mark-modified t] + ["Mark/Unmark deleted" svn-status-mark-deleted t] + ["Mark/Unmark modified/added/deleted" svn-status-mark-changed t] + ["Mark/Unmark filename by extension" svn-status-mark-by-file-ext t] + ["Mark/Unmark filename by regexp" svn-status-mark-filename-regexp t] + ) + ["Hide Unknown" svn-status-toggle-hide-unknown + :style toggle :selected svn-status-hide-unknown] + ["Hide Unmodified" svn-status-toggle-hide-unmodified + :style toggle :selected svn-status-hide-unmodified] + ["Show Client versions" svn-status-version t] + ["Prepare bug report" svn-prepare-bug-report t] + )) + +(defvar svn-status-file-popup-menu-list + '(["open" svn-status-find-file-other-window t] + ["svn diff" svn-status-show-svn-diff t] + ["svn commit" svn-status-commit t] + ["svn log" svn-status-show-svn-log t] + ["svn blame" svn-status-blame t] + ["mark" svn-status-set-user-mark t] + ["unmark" svn-status-unset-user-mark t] + ["svn add" svn-status-add-file t] + ["svn add recursively" svn-status-add-file-recursively t] + ["svn mv..." svn-status-mv t] + ["svn rm..." svn-status-rm t] + ["svn lock" svn-status-lock t] + ["svn unlock" svn-status-unlock t] + ["svn info" svn-status-info t] + ) "A list of menu entries for `svn-status-popup-menu'") + +;; extend svn-status-file-popup-menu-list via: +;; (add-to-list 'svn-status-file-popup-menu-list ["commit" svn-status-commit t]) + +(defun svn-status-popup-menu (event) + "Display a file specific popup menu" + (interactive "e") + (mouse-set-point event) + (let* ((line-info (svn-status-get-line-information)) + (name (svn-status-line-info->filename line-info))) + (when line-info + (easy-menu-define svn-status-actual-popup-menu nil nil + (append (list name) svn-status-file-popup-menu-list)) + (svn-status-face-set-temporary-during-popup + 'svn-status-marked-popup-face (svn-point-at-bol) (svn-point-at-eol) + svn-status-actual-popup-menu)))) + +(defun svn-status-face-set-temporary-during-popup (face begin end menu &optional prefix) + "Put FACE on BEGIN and END in the buffer during Popup MENU. +PREFIX is passed to `popup-menu'." + (let (o) + (unwind-protect + (progn + (setq o (make-overlay begin end)) + (overlay-put o 'face face) + (sit-for 0) + (popup-menu menu prefix)) + (delete-overlay o)))) + +(defun svn-status-mode () + "Major mode used by psvn.el to display the output of \"svn status\". + +The Output has the following format: + FPH BASE CMTD Author em File +F = Filemark +P = Property mark +H = History mark +BASE = local base revision +CMTD = last committed revision +Author = author of change +em = \"**\" or \"(Update Available)\" [see `svn-status-short-mod-flag-p'] + if file can be updated +File = path/filename + +The following keys are defined: +\\{svn-status-mode-map}" + (interactive) + (kill-all-local-variables) + + (use-local-map svn-status-mode-map) + (easy-menu-add svn-status-mode-menu) + + (setq major-mode 'svn-status-mode) + (setq mode-name "svn-status") + (setq mode-line-process 'svn-status-mode-line-process) + (run-hooks 'svn-status-mode-hook) + (let ((view-read-only nil)) + (toggle-read-only 1))) + +(defun svn-status-update-mode-line () + (setq svn-status-mode-line-process + (concat svn-status-mode-line-process-edit-flag svn-status-mode-line-process-status)) + (force-mode-line-update)) + +(defun svn-status-bury-buffer (arg) + "Bury the buffers used by psvn.el +Currently this is: + `svn-status-buffer-name' + `svn-process-buffer-name' + `svn-log-edit-buffer-name' + *svn-property-edit* + *svn-log* + *svn-info* +When called with a prefix argument, ARG, switch back to the window configuration that was +in use before `svn-status' was called." + (interactive "P") + (cond (arg + (when svn-status-initial-window-configuration + (set-window-configuration svn-status-initial-window-configuration))) + (t + (let ((bl `(,svn-log-edit-buffer-name "*svn-property-edit*" "*svn-log*" "*svn-info*" ,svn-process-buffer-name))) + (while bl + (when (get-buffer (car bl)) + (bury-buffer (car bl))) + (setq bl (cdr bl))) + (when (string= (buffer-name) svn-status-buffer-name) + (bury-buffer)))))) + +(defun svn-status-save-some-buffers (&optional tree) + "Save all buffers visiting a file in TREE. +If TREE is not given, try `svn-status-base-dir' as TREE." + (interactive) + ;; (message "svn-status-save-some-buffers: tree1: %s" tree) + (let ((ok t) + (tree (or (svn-status-base-dir) + tree))) + ;; (message "svn-status-save-some-buffers: tree2: %s" tree) + (unless tree + (error "Not in a svn project tree")) + (dolist (buffer (buffer-list)) + (with-current-buffer buffer + (when (buffer-modified-p) + (let ((file (buffer-file-name))) + (when file + (let ((root (svn-status-base-dir (file-name-directory file)))) + ;; (message "svn-status-save-some-buffers: file: %s, root: %s" file root) + (when (and root + (string= root tree) + ;; buffer is modified and in the tree TREE. + (or (y-or-n-p (concat "Save buffer " (buffer-name) "? ")) + (setq ok nil))) + (save-buffer)))))))) + ok)) + +(defun svn-status-find-files () + "Open selected file(s) for editing. +See `svn-status-marked-files' for what counts as selected." + (interactive) + (let ((fnames (mapcar 'svn-status-line-info->full-path (svn-status-marked-files)))) + (mapc 'find-file fnames))) + + +(defun svn-status-find-file-other-window () + "Open the file in the other window for editing." + (interactive) + (svn-status-ensure-cursor-on-file) + (find-file-other-window (svn-status-line-info->filename + (svn-status-get-line-information)))) + +(defun svn-status-find-file-other-window-noselect () + "Open the file in the other window for editing, but don't select it." + (interactive) + (svn-status-ensure-cursor-on-file) + (display-buffer + (find-file-noselect (svn-status-line-info->filename + (svn-status-get-line-information))))) + +(defun svn-status-view-file-other-window () + "Open the file in the other window for viewing." + (interactive) + (svn-status-ensure-cursor-on-file) + (view-file-other-window (svn-status-line-info->filename + (svn-status-get-line-information)))) + +(defun svn-status-find-file-or-examine-directory () + "If point is on a directory, run `svn-status' on that directory. +Otherwise run `find-file'." + (interactive) + (svn-status-ensure-cursor-on-file) + (let ((line-info (svn-status-get-line-information))) + (if (svn-status-line-info->directory-p line-info) + (svn-status (svn-status-line-info->full-path line-info)) + (find-file (svn-status-line-info->filename line-info))))) + +(defun svn-status-examine-parent () + "Run `svn-status' on the parent of the current directory." + (interactive) + (svn-status (expand-file-name "../"))) + +(defun svn-status-mouse-find-file-or-examine-directory (event) + "Move point to where EVENT occurred, and do `svn-status-find-file-or-examine-directory' +EVENT could be \"mouse clicked\" or similar." + (interactive "e") + (mouse-set-point event) + (svn-status-find-file-or-examine-directory)) + +(defun svn-status-line-info->ui-status (line-info) + "Return the ui-status structure of LINE-INFO. +See `svn-status-make-ui-status' for information about the ui-status." + (nth 0 line-info)) + +(defun svn-status-line-info->has-usermark (line-info) (nth 0 (nth 0 line-info))) +(defun svn-status-line-info->user-elide (line-info) (nth 1 (nth 0 line-info))) + +(defun svn-status-line-info->filemark (line-info) (nth 1 line-info)) +(defun svn-status-line-info->propmark (line-info) (nth 2 line-info)) +(defun svn-status-line-info->filename (line-info) (nth 3 line-info)) +(defun svn-status-line-info->filename-nondirectory (line-info) + (file-name-nondirectory (svn-status-line-info->filename line-info))) +(defun svn-status-line-info->localrev (line-info) + (if (>= (nth 4 line-info) 0) + (nth 4 line-info) + nil)) +(defun svn-status-line-info->lastchangerev (line-info) + "Return the last revision in which LINE-INFO was modified." + (let ((l (nth 5 line-info))) + (if (and l (>= l 0)) + l + nil))) +(defun svn-status-line-info->author (line-info) + "Return the last author that changed the item that is represented in LINE-INFO." + (nth 6 line-info)) +(defun svn-status-line-info->update-available (line-info) + "Return whether LINE-INFO is out of date. +In other words, whether there is a newer version available in the +repository than the working copy." + (nth 7 line-info)) +(defun svn-status-line-info->locked (line-info) + "Return whether LINE-INFO represents a locked file. +This is column three of the `svn status' output. +The result will be nil or \"L\". +\(A file becomes locked when an operation is interupted; run \\[svn-status-cleanup]' +to unlock it.\)" + (nth 8 line-info)) +(defun svn-status-line-info->historymark (line-info) + "Mark from column four of output from `svn status'. +This will be nil unless the file is scheduled for addition with +history, when it will be \"+\"." + (nth 9 line-info)) +(defun svn-status-line-info->switched (line-info) + "Return whether LINE-INFO is switched relative to its parent. +This is column five of the output from `svn status'. +The result will be nil or \"S\"." + (nth 10 line-info)) +(defun svn-status-line-info->repo-locked (line-info) + "Return whether LINE-INFO contains some locking information. +This is column six of the output from `svn status'. +The result will be \"K\", \"O\", \"T\", \"B\" or nil." + (nth 11 line-info)) +(defun svn-status-line-info->psvn-extra-info (line-info) + "Return a list of extra information for psvn associated with LINE-INFO. +This list holds currently only one element: +* The action after a commit or update." + (nth 12 line-info)) + +(defun svn-status-line-info->is-visiblep (line-info) + "Return whether the line is visible or not" + (or (not (or (svn-status-line-info->hide-because-unknown line-info) + (svn-status-line-info->hide-because-unmodified line-info) + (svn-status-line-info->hide-because-custom-hide-function line-info) + (svn-status-line-info->hide-because-user-elide line-info))) + (svn-status-line-info->update-available line-info) ;; show the line, if an update is available + (svn-status-line-info->psvn-extra-info line-info) ;; show the line, if there is some extra info displayed on this line + )) + +(defun svn-status-line-info->hide-because-unknown (line-info) + (and svn-status-hide-unknown + (eq (svn-status-line-info->filemark line-info) ??))) + +(defun svn-status-line-info->hide-because-custom-hide-function (line-info) + (and svn-status-custom-hide-function + (apply svn-status-custom-hide-function (list line-info)))) + +(defun svn-status-line-info->hide-because-unmodified (line-info) + ;;(message " %S %S %S %S - %s" svn-status-hide-unmodified (svn-status-line-info->propmark line-info) ?_ + ;; (svn-status-line-info->filemark line-info) (svn-status-line-info->filename line-info)) + (and svn-status-hide-unmodified + (and (or (eq (svn-status-line-info->filemark line-info) ?_) + (eq (svn-status-line-info->filemark line-info) ? )) + (or (eq (svn-status-line-info->propmark line-info) ?_) + (eq (svn-status-line-info->propmark line-info) ? ) + (eq (svn-status-line-info->propmark line-info) nil))))) + +(defun svn-status-line-info->hide-because-user-elide (line-info) + (eq (svn-status-line-info->user-elide line-info) t)) + +(defun svn-status-line-info->show-user-elide-continuation (line-info) + (eq (svn-status-line-info->user-elide line-info) 'directory)) + +;; modify the line-info +(defun svn-status-line-info->set-filemark (line-info value) + (setcar (nthcdr 1 line-info) value)) + +(defun svn-status-line-info->set-propmark (line-info value) + (setcar (nthcdr 2 line-info) value)) + +(defun svn-status-line-info->set-localrev (line-info value) + (setcar (nthcdr 4 line-info) value)) + +(defun svn-status-line-info->set-author (line-info value) + (setcar (nthcdr 6 line-info) value)) + +(defun svn-status-line-info->set-lastchangerev (line-info value) + (setcar (nthcdr 5 line-info) value)) + +(defun svn-status-line-info->set-repo-locked (line-info value) + (setcar (nthcdr 11 line-info) value)) + +(defun svn-status-line-info->set-psvn-extra-info (line-info value) + (setcar (nthcdr 12 line-info) value)) + +(defun svn-status-copy-current-line-info (arg) + "Copy the current file name at point, using `svn-status-copy-filename-as-kill'. +If no file is at point, copy everything starting from ':' to the end of line." + (interactive "P") + (if (svn-status-get-line-information) + (svn-status-copy-filename-as-kill arg) + (save-excursion + (goto-char (svn-point-at-bol)) + (when (looking-at ".+?: *\\(.+\\)$") + (kill-new (svn-match-string-no-properties 1)) + (message "Copied: %s" (svn-match-string-no-properties 1)))))) + +(defun svn-status-copy-filename-as-kill (arg) + "Copy the actual file name to the kill-ring. +When called with the prefix argument 0, use the full path name." + (interactive "P") + (let ((str (if (eq arg 0) + (svn-status-line-info->full-path (svn-status-get-line-information)) + (svn-status-line-info->filename (svn-status-get-line-information))))) + (kill-new str) + (message "Copied %s" str))) + +(defun svn-status-get-child-directories (&optional dir) + "Return a list of subdirectories for DIR" + (interactive) + (let ((this-dir (concat (expand-file-name (or dir (svn-status-line-info->filename (svn-status-get-line-information)))) "/")) + (test-dir) + (sub-dir-list)) + ;;(message "this-dir %S" this-dir) + (dolist (line-info svn-status-info) + (when (svn-status-line-info->directory-p line-info) + (setq test-dir (svn-status-line-info->full-path line-info)) + (when (string= (file-name-directory test-dir) this-dir) + (add-to-list 'sub-dir-list (file-relative-name (svn-status-line-info->full-path line-info)) t)))) + sub-dir-list)) + +(defun svn-status-toggle-elide (arg) + "Toggle eliding of the current file or directory. +When called with a prefix argument, toggle the hiding of all subdirectories for the current directory." + (interactive "P") + (if arg + (let ((cur-line (svn-status-line-info->filename (svn-status-get-line-information)))) + (when (svn-status-line-info->user-elide (svn-status-get-line-information)) + (svn-status-toggle-elide nil)) + (dolist (dir-name (svn-status-get-child-directories)) + (svn-status-goto-file-name dir-name) + (svn-status-toggle-elide nil)) + (svn-status-goto-file-name cur-line)) + (let ((st-info svn-status-info) + (fname) + (test (svn-status-line-info->filename (svn-status-get-line-information))) + (len-test) + (len-fname) + (new-elide-mark t) + (elide-mark)) + (if (member test svn-status-elided-list) + (setq svn-status-elided-list (delete test svn-status-elided-list)) + (add-to-list 'svn-status-elided-list test)) + (when (string= test ".") + (setq test "")) + (setq len-test (length test)) + (while st-info + (setq fname (svn-status-line-info->filename (car st-info))) + (setq len-fname (length fname)) + (when (and (>= len-fname len-test) + (string= (substring fname 0 len-test) test)) + (setq elide-mark new-elide-mark) + (when (or (string= fname ".") + (and (= len-fname len-test) (svn-status-line-info->directory-p (car st-info)))) + (message "Elided directory %s and all its files." fname) + (setq new-elide-mark (not (svn-status-line-info->user-elide (car st-info)))) + (setq elide-mark (if new-elide-mark 'directory nil))) + ;;(message "elide-mark: %S member: %S" elide-mark (member fname svn-status-elided-list)) + (when (and (member fname svn-status-elided-list) (not elide-mark)) + (setq svn-status-elided-list (delete fname svn-status-elided-list))) + (setcar (nthcdr 1 (svn-status-line-info->ui-status (car st-info))) elide-mark)) + (setq st-info (cdr st-info)))) + ;;(message "svn-status-elided-list: %S" svn-status-elided-list) + (svn-status-update-buffer))) + +(defun svn-status-apply-elide-list () + "Elide files/directories according to `svn-status-elided-list'." + (interactive) + (let ((st-info svn-status-info) + (fname) + (len-fname) + (test) + (len-test) + (elided-list) + (elide-mark)) + (while st-info + (setq fname (svn-status-line-info->filename (car st-info))) + (setq len-fname (length fname)) + (setq elided-list svn-status-elided-list) + (setq elide-mark nil) + (while elided-list + (setq test (car elided-list)) + (when (string= test ".") + (setq test "")) + (setq len-test (length test)) + (when (and (>= len-fname len-test) + (string= (substring fname 0 len-test) test)) + (setq elide-mark t) + (when (or (string= fname ".") + (and (= len-fname len-test) (svn-status-line-info->directory-p (car st-info)))) + (setq elide-mark 'directory))) + (setq elided-list (cdr elided-list))) + ;;(message "fname: %s elide-mark: %S" fname elide-mark) + (setcar (nthcdr 1 (svn-status-line-info->ui-status (car st-info))) elide-mark) + (setq st-info (cdr st-info)))) + (svn-status-update-buffer)) + +(defun svn-status-update-with-command-list (cmd-list) + (save-excursion + (set-buffer svn-status-buffer-name) + (let ((st-info) + (found) + (action) + (fname (svn-status-line-info->filename (svn-status-get-line-information))) + (fname-pos (point)) + (column (current-column))) + (setq cmd-list (sort cmd-list '(lambda (item1 item2) (string-lessp (car item1) (car item2))))) + (while cmd-list + (unless st-info (setq st-info svn-status-info)) + ;;(message "%S" (caar cmd-list)) + (setq found nil) + (while (and (not found) st-info) + (setq found (string= (caar cmd-list) (svn-status-line-info->filename (car st-info)))) + ;;(message "found: %S" found) + (unless found (setq st-info (cdr st-info)))) + (unless found + (svn-status-message 3 "psvn: continue to search for %s" (caar cmd-list)) + (setq st-info svn-status-info) + (while (and (not found) st-info) + (setq found (string= (caar cmd-list) (svn-status-line-info->filename (car st-info)))) + (unless found (setq st-info (cdr st-info))))) + (if found + ;;update the info line + (progn + (setq action (cadar cmd-list)) + ;;(message "found %s, action: %S" (caar cmd-list) action) + (svn-status-annotate-status-buffer-entry action (car st-info))) + (svn-status-message 3 "psvn: did not find %s" (caar cmd-list))) + (setq cmd-list (cdr cmd-list))) + (if fname + (progn + (goto-char fname-pos) + (svn-status-goto-file-name fname) + (goto-char (+ column (svn-point-at-bol)))) + (goto-char (+ (next-overlay-change (point-min)) svn-status-default-column)))))) + +(defun svn-status-annotate-status-buffer-entry (action line-info) + (let ((tag-string)) + (svn-status-goto-file-name (svn-status-line-info->filename line-info)) + (when (and (member action '(committed added)) + svn-status-commit-rev-number) + (svn-status-line-info->set-localrev line-info svn-status-commit-rev-number) + (svn-status-line-info->set-lastchangerev line-info svn-status-commit-rev-number)) + (when svn-status-last-commit-author + (svn-status-line-info->set-author line-info svn-status-last-commit-author)) + (svn-status-line-info->set-psvn-extra-info line-info (list action)) + (cond ((equal action 'committed) + (setq tag-string " ") + (when (member (svn-status-line-info->repo-locked line-info) '(?K)) + (svn-status-line-info->set-repo-locked line-info nil))) + ((equal action 'added) + (setq tag-string " ")) + ((equal action 'deleted) + (setq tag-string " ")) + ((equal action 'replaced) + (setq tag-string " ")) + ((equal action 'updated) + (setq tag-string " ")) + ((equal action 'updated-props) + (setq tag-string " ")) + ((equal action 'conflicted) + (setq tag-string " ") + (svn-status-line-info->set-filemark line-info ?C)) + ((equal action 'merged) + (setq tag-string " ")) + ((equal action 'propset) + ;;(setq tag-string " ") + (svn-status-line-info->set-propmark line-info svn-status-file-modified-after-save-flag)) + ((equal action 'added-wc) + (svn-status-line-info->set-filemark line-info ?A) + (svn-status-line-info->set-localrev line-info 0)) + ((equal action 'deleted-wc) + (svn-status-line-info->set-filemark line-info ?D)) + (t + (error "Unknown action '%s for %s" action (svn-status-line-info->filename line-info)))) + (when (and tag-string (not (member action '(conflicted merged)))) + (svn-status-line-info->set-filemark line-info ? ) + (svn-status-line-info->set-propmark line-info ? )) + (let ((buffer-read-only nil)) + (delete-region (svn-point-at-bol) (svn-point-at-eol)) + (svn-insert-line-in-status-buffer line-info) + (backward-char 1) + (when tag-string + (insert tag-string)) + (delete-char 1)))) + + + +;; (svn-status-update-with-command-list '(("++ideas" committed) ("a.txt" committed) ("alf"))) +;; (svn-status-update-with-command-list (svn-status-parse-commit-output)) + +(defun svn-status-parse-commit-output () + "Parse the output of svn commit. +Return a list that is suitable for `svn-status-update-with-command-list'" + (save-excursion + (set-buffer svn-process-buffer-name) + (let ((action) + (file-name) + (skip) + (result)) + (goto-char (point-min)) + (setq svn-status-commit-rev-number nil) + (setq skip nil) ; set to t whenever we find a line not about a committed file + (while (< (point) (point-max)) + (cond ((= (svn-point-at-eol) (svn-point-at-bol)) ;skip blank lines + (setq skip t)) + ((looking-at "Sending") + (setq action 'committed)) + ((looking-at "Adding") + (setq action 'added)) + ((looking-at "Deleting") + (setq action 'deleted)) + ((looking-at "Replacing") + (setq action 'replaced)) + ((looking-at "Transmitting file data") + (setq skip t)) + ((looking-at "Committed revision \\([0-9]+\\)") + (setq svn-status-commit-rev-number + (string-to-number (svn-match-string-no-properties 1))) + (setq skip t)) + (t ;; this should never be needed(?) + (setq action 'unknown))) + (unless skip ;found an interesting line + (forward-char 15) + (when svn-status-operated-on-dot + ;; when the commit used . as argument, delete the trailing directory + ;; from the svn output + (search-forward "/" nil t)) + (setq file-name (buffer-substring-no-properties (point) (svn-point-at-eol))) + (unless svn-status-last-commit-author + (setq svn-status-last-commit-author (car (svn-status-info-for-path (expand-file-name (concat default-directory file-name)))))) + (setq result (cons (list file-name action) + result)) + (setq skip nil)) + (forward-line 1)) + result))) +;;(svn-status-parse-commit-output) +;;(svn-status-annotate-status-buffer-entry) + +(defun svn-status-parse-ar-output () + "Parse the output of svn add|remove. +Return a list that is suitable for `svn-status-update-with-command-list'" + (save-excursion + (set-buffer svn-process-buffer-name) + (let ((action) + (name) + (skip) + (result)) + (goto-char (point-min)) + (while (< (point) (point-max)) + (cond ((= (svn-point-at-eol) (svn-point-at-bol)) ;skip blank lines + (setq skip t)) + ((looking-at "A") + (setq action 'added-wc)) + ((looking-at "D") + (setq action 'deleted-wc)) + (t ;; this should never be needed(?) + (setq action 'unknown))) + (unless skip ;found an interesting line + (forward-char 10) + (setq name (buffer-substring-no-properties (point) (svn-point-at-eol))) + (setq result (cons (list name action) + result)) + (setq skip nil)) + (forward-line 1)) + result))) +;; (svn-status-parse-ar-output) +;; (svn-status-update-with-command-list (svn-status-parse-ar-output)) + +(defun svn-status-parse-update-output () + "Parse the output of svn update. +Return a list that is suitable for `svn-status-update-with-command-list'" + (save-excursion + (set-buffer svn-process-buffer-name) + (setq svn-status-update-rev-number nil) + (let ((action) + (name) + (skip) + (result)) + (goto-char (point-min)) + (while (< (point) (point-max)) + (cond ((= (svn-point-at-eol) (svn-point-at-bol)) ;skip blank lines + (setq skip t)) + ((looking-at "Updated to revision \\([0-9]+\\)") + (setq svn-status-update-rev-number + (list t (string-to-number (svn-match-string-no-properties 1)))) + (setq skip t)) + ((looking-at "At revision \\([0-9]+\\)") + (setq svn-status-update-rev-number + (list nil (string-to-number (svn-match-string-no-properties 1)))) + (setq skip t)) + ((looking-at "U") + (setq action 'updated)) + ((looking-at "A") + (setq action 'added)) + ((looking-at "D") + (setq skip t)) + ;;(setq action 'deleted)) ;;deleted files are not displayed in the svn status output. + ((looking-at "C") + (setq action 'conflicted)) + ((looking-at "G") + (setq action 'merged)) + + ((looking-at " U") + (setq action 'updated-props)) + + (t ;; this should never be needed(?) + (setq action (concat "parse-update: '" + (buffer-substring-no-properties (point) (+ 2 (point))) "'")))) + (unless skip ;found an interesting line + (forward-char 3) + (setq name (buffer-substring-no-properties (point) (svn-point-at-eol))) + (setq result (cons (list name action) + result)) + (setq skip nil)) + (forward-line 1)) + result))) +;; (svn-status-parse-update-output) +;; (svn-status-update-with-command-list (svn-status-parse-update-output)) + +(defun svn-status-parse-property-output () + "Parse the output of svn propset. +Return a list that is suitable for `svn-status-update-with-command-list'" + (save-excursion + (set-buffer svn-process-buffer-name) + (let ((result)) + (dolist (line (split-string (buffer-substring-no-properties (point-min) (point-max)) "\n")) + (message "%s" line) + (when (string-match "property '\\(.+\\)' set on '\\(.+\\)'" line) + ;;(message "property %s - file %s" (match-string 1 line) (match-string 2 line)) + (setq result (cons (list (match-string 2 line) 'propset) result)))) + result))) + +;; (svn-status-parse-property-output) +;; (svn-status-update-with-command-list (svn-status-parse-property-output)) + + +(defun svn-status-line-info->symlink-p (line-info) + "Return non-nil if LINE-INFO refers to a symlink, nil otherwise. +The value is the name of the file to which it is linked. \(See +`file-symlink-p'.\) + +On win32 systems this won't work, even though symlinks are supported +by subversion on such systems." + ;; on win32 would need to see how svn does symlinks + (file-symlink-p (svn-status-line-info->filename line-info))) + +(defun svn-status-line-info->directory-p (line-info) + "Return t if LINE-INFO refers to a directory, nil otherwise. +Symbolic links to directories count as directories (see `file-directory-p')." + (file-directory-p (svn-status-line-info->filename line-info))) + +(defun svn-status-line-info->full-path (line-info) + "Return the full path of the file represented by LINE-INFO." + (expand-file-name + (svn-status-line-info->filename line-info))) + +;;Not convinced that this is the fastest way, but... +(defun svn-status-count-/ (string) + "Return number of \"/\"'s in STRING." + (let ((n 0) + (last 0)) + (while (setq last (string-match "/" string (1+ last))) + (setq n (1+ n))) + n)) + +(defun svn-insert-line-in-status-buffer (line-info) + "Format LINE-INFO and insert the result in the current buffer." + (let ((usermark (if (svn-status-line-info->has-usermark line-info) "*" " ")) + (update-available (if (svn-status-line-info->update-available line-info) + (svn-add-face (if svn-status-short-mod-flag-p + "** " + " (Update Available)") + 'svn-status-update-available-face) + (if svn-status-short-mod-flag-p " " ""))) + (filename ;; file or /path/to/file + (concat + (if (or svn-status-display-full-path + svn-status-hide-unmodified) + (svn-add-face + (let ((dir-name (file-name-as-directory + (svn-status-line-info->directory-containing-line-info + line-info nil)))) + (if (and (<= 2 (length dir-name)) + (= ?. (aref dir-name 0)) + (= ?/ (aref dir-name 1))) + (substring dir-name 2) + dir-name)) + 'svn-status-directory-face) + ;; showing all files, so add indentation + (make-string (* 2 (svn-status-count-/ + (svn-status-line-info->filename line-info))) + 32)) + ;;symlinks get a different face + (let ((target (svn-status-line-info->symlink-p line-info))) + (if target + ;; name -> trget + ;; name gets symlink-face, target gets file/directory face + (concat + (svn-add-face (svn-status-line-info->filename-nondirectory line-info) + 'svn-status-symlink-face) + " -> " + (svn-status-choose-face-to-add + ;; TODO: could use different faces for + ;; unversioned targets and broken symlinks? + (svn-status-line-info->directory-p line-info) + target + 'svn-status-directory-face + 'svn-status-filename-face)) + ;; else target is not a link + (svn-status-choose-face-to-add + (svn-status-line-info->directory-p line-info) + (svn-status-line-info->filename-nondirectory line-info) + 'svn-status-directory-face + 'svn-status-filename-face))) + )) + (elide-hint (if (svn-status-line-info->show-user-elide-continuation line-info) " ..." ""))) + (svn-puthash (svn-status-line-info->filename line-info) + (point) + svn-status-filename-to-buffer-position-cache) + (insert (svn-status-maybe-add-face + (svn-status-line-info->has-usermark line-info) + (concat usermark + (format svn-status-line-format + (svn-status-line-info->filemark line-info) + (or (svn-status-line-info->propmark line-info) ? ) + (or (svn-status-line-info->historymark line-info) ? ) + (or (svn-status-line-info->localrev line-info) "") + (or (svn-status-line-info->lastchangerev line-info) "") + (svn-status-line-info->author line-info)) + (when svn-status-short-mod-flag-p update-available) + filename + (unless svn-status-short-mod-flag-p update-available) + (svn-status-maybe-add-string (svn-status-line-info->locked line-info) + " [ LOCKED ]" 'svn-status-locked-face) + (svn-status-maybe-add-string (svn-status-line-info->repo-locked line-info) + (let ((flag (svn-status-line-info->repo-locked line-info))) + (cond ((eq flag ?K) " [ REPO-LOCK-HERE ]") + ((eq flag ?O) " [ REPO-LOCK-OTHER ]") + ((eq flag ?T) " [ REPO-LOCK-STOLEN ]") + ((eq flag ?B) " [ REPO-LOCK-BROKEN ]") + (t " [ REPO-LOCK-UNKNOWN ]"))) + 'svn-status-locked-face) + (svn-status-maybe-add-string (svn-status-line-info->switched line-info) + " (switched)" 'svn-status-switched-face) + elide-hint) + 'svn-status-marked-face) + "\n"))) + +(defun svn-status-redraw-status-buffer () + "Redraw the `svn-status-buffer-name' buffer. +Additionally clear the psvn-extra-info field in all line-info lists." + (interactive) + (dolist (line-info svn-status-info) + (svn-status-line-info->set-psvn-extra-info line-info nil)) + (svn-status-update-buffer)) + +(defun svn-status-update-buffer () + "Update the `svn-status-buffer-name' buffer, using `svn-status-info'. + This function does not access the repository." + (interactive) + ;(message "buffer-name: %s" (buffer-name)) + (unless (string= (buffer-name) svn-status-buffer-name) + (set-buffer svn-status-buffer-name)) + (svn-status-mode) + (when svn-status-refresh-info + (when (eq svn-status-refresh-info 'once) + (setq svn-status-refresh-info nil)) + (svn-status-parse-info t)) + (let ((st-info svn-status-info) + (buffer-read-only nil) + (start-pos) + (overlay) + (unmodified-count 0) ;how many unmodified files are hidden + (unknown-count 0) ;how many unknown files are hidden + (custom-hide-count 0) ;how many files are hidden via svn-status-custom-hide-function + (marked-count 0) ;how many files are elided + (user-elide-count 0) + (first-line t) + (fname (svn-status-line-info->filename (svn-status-get-line-information))) + (fname-pos (point)) + (window-line-pos (svn-status-window-line-position (get-buffer-window (current-buffer)))) + (header-line-string) + (column (current-column))) + (delete-region (point-min) (point-max)) + (insert "\n") + ;; Insert all files and directories + (while st-info + (setq start-pos (point)) + (cond ((or (svn-status-line-info->has-usermark (car st-info)) first-line) + ;; Show a marked file and the "." always + (svn-insert-line-in-status-buffer (car st-info)) + (setq first-line nil)) + ((svn-status-line-info->update-available (car st-info)) + (svn-insert-line-in-status-buffer (car st-info))) + ((and svn-status-custom-hide-function + (apply svn-status-custom-hide-function (list (car st-info)))) + (setq custom-hide-count (1+ custom-hide-count))) + ((svn-status-line-info->hide-because-user-elide (car st-info)) + (setq user-elide-count (1+ user-elide-count))) + ((svn-status-line-info->hide-because-unknown (car st-info)) + (setq unknown-count (1+ unknown-count))) + ((svn-status-line-info->hide-because-unmodified (car st-info)) + (setq unmodified-count (1+ unmodified-count))) + (t + (svn-insert-line-in-status-buffer (car st-info)))) + (when (svn-status-line-info->has-usermark (car st-info)) + (setq marked-count (+ marked-count 1))) + (setq overlay (make-overlay start-pos (point))) + (overlay-put overlay 'svn-info (car st-info)) + (setq st-info (cdr st-info))) + ;; Insert status information at the buffer beginning + (goto-char (point-min)) + (insert (format "svn status for directory %s%s\n" + default-directory + (if svn-status-head-revision (format " (status against revision: %s)" + svn-status-head-revision) + ""))) + (when svn-status-module-name + (insert (format "Project name: %s\n" svn-status-module-name))) + (when svn-status-branch-list + (insert (format "Branches: %s\n" svn-status-branch-list))) + (when svn-status-base-info + (insert (concat "Repository Root: " (svn-status-base-info->repository-root) "\n")) + (insert (concat "Repository Url: " (svn-status-base-info->url) "\n"))) + (when svn-status-hide-unknown + (insert + (format "%d Unknown file(s) are hidden - press `?' to toggle hiding\n" + unknown-count))) + (when svn-status-hide-unmodified + (insert + (format "%d Unmodified file(s) are hidden - press `_' to toggle hiding\n" + unmodified-count))) + (when (> custom-hide-count 0) + (insert + (format "%d file(s) are hidden via the svn-status-custom-hide-function\n" + custom-hide-count))) + (when (> user-elide-count 0) + (insert (format "%d file(s) elided\n" user-elide-count))) + (insert (format "%d file(s) marked\n" marked-count)) + (setq header-line-string (concat (format svn-status-line-format + 70 80 72 "BASE" "CMTD" "Author") + (if svn-status-short-mod-flag-p "em " "") + "File")) + (cond ((eq svn-status-use-header-line t) + (setq header-line-format (concat " " header-line-string))) + ((eq svn-status-use-header-line 'inline) + (insert "\n " header-line-string "\n"))) + (setq svn-start-of-file-list-line-number (+ (count-lines (point-min) (point)) 1)) + (if fname + (progn + (goto-char fname-pos) + (svn-status-goto-file-name fname) + (goto-char (+ column (svn-point-at-bol))) + (when window-line-pos + (recenter window-line-pos))) + (goto-char (+ (next-overlay-change (point-min)) svn-status-default-column))))) + +(defun svn-status-parse-info (arg) + "Parse the svn info output for the base directory. +Show the repository url after this call in the `svn-status-buffer-name' buffer. +When called with the prefix argument 0, reset the information to nil. +This hides the repository information again. + +When ARG is t, don't update the svn status buffer. This is useful for +non-interactive use." + (interactive "P") + (if (eq arg 0) + (setq svn-status-base-info nil) + (let ((svn-process-buffer-name "*svn-info-output*")) + (when (get-buffer svn-process-buffer-name) + (kill-buffer svn-process-buffer-name)) + (svn-run nil t 'parse-info "info" ".") + (svn-status-parse-info-result))) + (unless (eq arg t) + (svn-status-update-buffer))) + +(defun svn-status-parse-info-result () + "Parse the result from the svn info command. +Put the found values in `svn-status-base-info'." + (let ((url) + (repository-root) + (last-changed-author)) + (save-excursion + (set-buffer svn-process-buffer-name) + (goto-char (point-min)) + (let ((case-fold-search t)) + (search-forward "url: ") + (setq url (buffer-substring-no-properties (point) (svn-point-at-eol))) + (when (search-forward "repository root: " nil t) + (setq repository-root (buffer-substring-no-properties (point) (svn-point-at-eol)))) + (when (search-forward "last changed author: " nil t) + (setq last-changed-author (buffer-substring-no-properties (point) (svn-point-at-eol)))))) + (setq svn-status-base-info `((url ,url) (repository-root ,repository-root) (last-changed-author ,last-changed-author))))) + +(defun svn-status-base-info->url () + "Extract the url part from `svn-status-base-info'." + (if svn-status-base-info + (cadr (assoc 'url svn-status-base-info)) + "")) + +(defun svn-status-base-info->repository-root () + "Extract the repository-root part from `svn-status-base-info'." + (if svn-status-base-info + (cadr (assoc 'repository-root svn-status-base-info)) + "")) + +(defun svn-status-checkout-prefix-path () + "When only a part of the svn repository is checked out, return the file path for this checkout." + (interactive) + (svn-status-parse-info t) + (let ((root (svn-status-base-info->repository-root)) + (url (svn-status-base-info->url)) + (p) + (base-dir (svn-status-base-dir)) + (wc-checkout-prefix)) + (setq p (substring url (length root))) + (setq wc-checkout-prefix (file-relative-name default-directory base-dir)) + (when (string= wc-checkout-prefix "./") + (setq wc-checkout-prefix "")) + ;; (message "svn-status-checkout-prefix-path: wc-checkout-prefix: '%s' p: '%s' base-dir: %s" wc-checkout-prefix p base-dir) + (setq p (substring p 0 (- (length p) (length wc-checkout-prefix)))) + (when (interactive-p) + (message "svn-status-checkout-prefix-path: '%s'" p)) + p)) + +(defun svn-status-ls (path &optional synchron) + "Run svn ls PATH." + (interactive "sPath for svn ls: ") + (svn-run (not synchron) t 'ls "ls" path) + (when synchron + (split-string (with-current-buffer svn-process-buffer-name + (buffer-substring-no-properties (point-min) (point-max)))))) + +(defun svn-status-ls-branches () + "Show, which branches exist for the actual working copy. +Note: this command assumes the proposed standard svn repository layout." + (interactive) + (svn-status-parse-info t) + (svn-status-ls (concat (svn-status-base-info->repository-root) "/branches"))) + +(defun svn-status-ls-tags () + "Show, which tags exist for the actual working copy. +Note: this command assumes the proposed standard svn repository layout." + (interactive) + (svn-status-parse-info t) + (svn-status-ls (concat (svn-status-base-info->repository-root) "/tags"))) + +(defun svn-status-toggle-edit-cmd-flag (&optional reset) + "Allow the user to edit the parameters for the next svn command. +This command toggles between +* editing the next command parameters (EditCmd) +* editing all all command parameters (EditCmd#) +* don't edit the command parameters () +The string in parentheses is shown in the status line to show the state." + (interactive) + (cond ((or reset (eq svn-status-edit-svn-command 'sticky)) + (setq svn-status-edit-svn-command nil)) + ((eq svn-status-edit-svn-command nil) + (setq svn-status-edit-svn-command t)) + ((eq svn-status-edit-svn-command t) + (setq svn-status-edit-svn-command 'sticky))) + (cond ((eq svn-status-edit-svn-command t) + (setq svn-status-mode-line-process-edit-flag " EditCmd")) + ((eq svn-status-edit-svn-command 'sticky) + (setq svn-status-mode-line-process-edit-flag " EditCmd#")) + (t + (setq svn-status-mode-line-process-edit-flag ""))) + (svn-status-update-mode-line)) + +(defun svn-status-goto-root-or-return () + "Bounce point between the root (\".\") and the current line." + (interactive) + (if (string= (svn-status-line-info->filename (svn-status-get-line-information)) ".") + (when svn-status-root-return-info + (svn-status-goto-file-name + (svn-status-line-info->filename svn-status-root-return-info))) + (setq svn-status-root-return-info (svn-status-get-line-information)) + (svn-status-goto-file-name "."))) + +(defun svn-status-next-line (nr-of-lines) + "Go to the next line that holds a file information. +When called with a prefix argument advance the given number of lines." + (interactive "p") + (while (progn + (next-line nr-of-lines) + (and (not (eobp)) + (not (svn-status-get-line-information))))) + (when (svn-status-get-line-information) + (goto-char (+ (svn-point-at-bol) svn-status-default-column)))) + +(defun svn-status-previous-line (nr-of-lines) + "Go to the previous line that holds a file information. +When called with a prefix argument go back the given number of lines." + (interactive "p") + (while (progn + (previous-line nr-of-lines) + (and (not (bobp)) + (not (svn-status-get-line-information))))) + (when (svn-status-get-line-information) + (goto-char (+ (svn-point-at-bol) svn-status-default-column)))) + +(defun svn-status-dired-jump () + "Jump to a dired buffer, containing the file at point." + (interactive) + (let* ((line-info (svn-status-get-line-information)) + (file-full-path (svn-status-line-info->full-path line-info))) + (let ((default-directory + (file-name-as-directory + (expand-file-name (svn-status-line-info->directory-containing-line-info line-info t))))) + (if (fboundp 'dired-jump-back) (dired-jump-back) (dired-jump))) ;; Xemacs uses dired-jump-back + (dired-goto-file file-full-path))) + +(defun svn-status-possibly-negate-meaning-of-arg (arg &optional command) + "Negate arg, if this-command is a member of svn-status-possibly-negate-meaning-of-arg." + (unless command + (setq command this-command)) + (if (member command svn-status-negate-meaning-of-arg-commands) + (not arg) + arg)) + +(defun svn-status-update (&optional arg) + "Run 'svn status -v'. +When called with a prefix argument run 'svn status -vu'." + (interactive "P") + (unless (interactive-p) + (save-excursion + (set-buffer svn-process-buffer-name) + (setq svn-status-update-previous-process-output + (buffer-substring (point-min) (point-max))))) + (svn-status default-directory arg)) + +(defun svn-status-get-line-information () + "Find out about the file under point. +The result may be parsed with the various `svn-status-line-info->...' functions." + (if (eq major-mode 'svn-status-mode) + (let ((svn-info nil)) + (dolist (overlay (overlays-at (point))) + (setq svn-info (or svn-info + (overlay-get overlay 'svn-info)))) + svn-info) + ;; different mode, means called not from the *svn-status* buffer + (if svn-status-get-line-information-for-file + (svn-status-make-line-info (if (eq svn-status-get-line-information-for-file 'relative) + (file-relative-name (buffer-file-name) (svn-status-base-dir)) + (buffer-file-name))) + (svn-status-make-line-info ".")))) + + +(defun svn-status-get-file-list (use-marked-files) + "Get either the selected files or the file under point. +USE-MARKED-FILES decides which we do. +See `svn-status-marked-files' for what counts as selected." + (if use-marked-files + (svn-status-marked-files) + (list (svn-status-get-line-information)))) + +(defun svn-status-get-file-list-names (use-marked-files) + (mapcar 'svn-status-line-info->filename (svn-status-get-file-list use-marked-files))) + +(defun svn-status-get-file-information () + "Find out about the file under point. +The result may be parsed with the various `svn-status-line-info->...' functions. +When called from a *svn-status* buffer, do the same as `svn-status-get-line-information'. +When called from a file buffer provide a structure that contains the filename." + (cond ((eq major-mode 'svn-status-mode) + (svn-status-get-line-information)) + (t + ;; a fake strukture that contains the buffername for the current buffer + (svn-status-make-line-info (buffer-file-name (current-buffer)))))) + +(defun svn-status-select-line () + "Return information about the file under point. +\(Only used for debugging\)" + (interactive) + (let ((info (svn-status-get-line-information))) + (if info + (message "%S hide-because-unknown: %S hide-because-unmodified: %S" info + (svn-status-line-info->hide-because-unknown info) + (svn-status-line-info->hide-because-unmodified info)) + (message "No file on this line")))) + +(defun svn-status-ensure-cursor-on-file () + "Raise an error unless point is on a valid file." + (unless (svn-status-get-line-information) + (error "No file on the current line"))) + +(defun svn-status-directory-containing-point (allow-self) + "Find the (full path of) directory containing the file under point. + +If ALLOW-SELF and the file is a directory, return that directory, +otherwise return the directory containing the file under point." + ;;the first `or' below is because s-s-g-l-i returns `nil' if + ;;point was outside the file list, but we need + ;;s-s-l-i->f to return a string to add to `default-directory'. + (let ((line-info (or (svn-status-get-line-information) + (svn-status-make-line-info)))) + (file-name-as-directory + (expand-file-name + (svn-status-line-info->directory-containing-line-info line-info allow-self))))) + +(defun svn-status-line-info->directory-containing-line-info (line-info allow-self) + "Find the directory containing for LINE-INFO. + +If ALLOW-SELF is t and LINE-INFO refers to a directory then return the +directory itself, in all other cases find the parent directory" + (if (and allow-self (svn-status-line-info->directory-p line-info)) + (svn-status-line-info->filename line-info) + ;;The next `or' is because (file-name-directory "file") returns nil + (or (file-name-directory (svn-status-line-info->filename line-info)) + "."))) + +(defun svn-status-set-user-mark (arg) + "Set a user mark on the current file or directory. +If the cursor is on a file this file is marked and the cursor advances to the next line. +If the cursor is on a directory all files in this directory are marked. + +If this function is called with a prefix argument, only the current line is +marked, even if it is a directory." + (interactive "P") + (setq arg (svn-status-possibly-negate-meaning-of-arg arg 'svn-status-set-user-mark)) + (let ((info (svn-status-get-line-information))) + (if info + (progn + (svn-status-apply-usermark t arg) + (svn-status-next-line 1)) + (message "No file on this line - cannot set a mark")))) + +(defun svn-status-unset-user-mark (arg) + "Remove a user mark on the current file or directory. +If the cursor is on a file, this file is unmarked and the cursor advances to the next line. +If the cursor is on a directory, all files in this directory are unmarked. + +If this function is called with a prefix argument, only the current line is +unmarked, even if is a directory." + (interactive "P") + (setq arg (svn-status-possibly-negate-meaning-of-arg arg 'svn-status-set-user-mark)) + (let ((info (svn-status-get-line-information))) + (if info + (progn + (svn-status-apply-usermark nil arg) + (svn-status-next-line 1)) + (message "No file on this line - cannot unset a mark")))) + +(defun svn-status-unset-user-mark-backwards () + "Remove a user mark from the previous file. +Then move to that line." + ;; This is consistent with `dired-unmark-backward' and + ;; `cvs-mode-unmark-up'. + (interactive) + (let ((info (save-excursion + (svn-status-next-line -1) + (svn-status-get-line-information)))) + (if info + (progn + (svn-status-next-line -1) + (svn-status-apply-usermark nil t)) + (message "No file on previous line - cannot unset a mark")))) + +(defun svn-status-apply-usermark (set-mark only-this-line) + "Do the work for the various marking/unmarking functions." + (let* ((st-info svn-status-info) + (mark-count 0) + (line-info (svn-status-get-line-information)) + (file-name (svn-status-line-info->filename line-info)) + (sub-file-regexp (if (file-directory-p file-name) + (concat "^" (regexp-quote + (file-name-as-directory file-name))) + nil)) + (newcursorpos-fname) + (i-fname) + (first-line t) + (current-line svn-start-of-file-list-line-number)) + (while st-info + (when (or (svn-status-line-info->is-visiblep (car st-info)) first-line) + (setq current-line (1+ current-line)) + (setq first-line nil)) + (setq i-fname (svn-status-line-info->filename (car st-info))) + (when (or (string= file-name i-fname) + (when sub-file-regexp + (string-match sub-file-regexp i-fname))) + (when (svn-status-line-info->is-visiblep (car st-info)) + (when (or (not only-this-line) (string= file-name i-fname)) + (setq newcursorpos-fname i-fname) + (unless (eq (car (svn-status-line-info->ui-status (car st-info))) set-mark) + (setcar (svn-status-line-info->ui-status (car st-info)) set-mark) + (setq mark-count (+ 1 mark-count)) + (save-excursion + (let ((buffer-read-only nil)) + (goto-line current-line) + (delete-region (svn-point-at-bol) (svn-point-at-eol)) + (svn-insert-line-in-status-buffer (car st-info)) + (delete-char 1))) + (message "%s %s" (if set-mark "Marked" "Unmarked") i-fname))))) + (setq st-info (cdr st-info))) + ;;(svn-status-update-buffer) + (svn-status-goto-file-name newcursorpos-fname) + (when (> mark-count 1) + (message "%s %d files" (if set-mark "Marked" "Unmarked") mark-count)))) + +(defun svn-status-apply-usermark-checked (check-function set-mark) + "Mark or unmark files, whether a given function returns t. +The function is called with the line information. Therefore the +svn-status-line-info->* functions can be used in the check." + (let ((st-info svn-status-info) + (mark-count 0)) + (while st-info + (when (apply check-function (list (car st-info))) + (unless (eq (svn-status-line-info->has-usermark (car st-info)) set-mark) + (setq mark-count (+ 1 mark-count)) + (message "%s %s" + (if set-mark "Marked" "Unmarked") + (svn-status-line-info->filename (car st-info)))) + (setcar (svn-status-line-info->ui-status (car st-info)) set-mark)) + (setq st-info (cdr st-info))) + (svn-status-update-buffer) + (when (> mark-count 1) + (message "%s %d files" (if set-mark "Marked" "Unmarked") mark-count)))) + +(defun svn-status-mark-unknown (arg) + "Mark all unknown files. +These are the files marked with '?' in the `svn-status-buffer-name' buffer. +If the function is called with a prefix arg, unmark all these files." + (interactive "P") + (svn-status-apply-usermark-checked + '(lambda (info) (eq (svn-status-line-info->filemark info) ??)) (not arg))) + +(defun svn-status-mark-added (arg) + "Mark all added files. +These are the files marked with 'A' in the `svn-status-buffer-name' buffer. +If the function is called with a prefix ARG, unmark all these files." + (interactive "P") + (svn-status-apply-usermark-checked + '(lambda (info) (eq (svn-status-line-info->filemark info) ?A)) (not arg))) + +(defun svn-status-mark-modified (arg) + "Mark all modified files. +These are the files marked with 'M' in the `svn-status-buffer-name' buffer. +If the function is called with a prefix ARG, unmark all these files." + (interactive "P") + (svn-status-apply-usermark-checked + '(lambda (info) (or (eq (svn-status-line-info->filemark info) ?M) + (eq (svn-status-line-info->filemark info) + svn-status-file-modified-after-save-flag))) + (not arg))) + +(defun svn-status-mark-deleted (arg) + "Mark all files scheduled for deletion. +These are the files marked with 'D' in the `svn-status-buffer-name' buffer. +If the function is called with a prefix ARG, unmark all these files." + (interactive "P") + (svn-status-apply-usermark-checked + '(lambda (info) (eq (svn-status-line-info->filemark info) ?D)) (not arg))) + +(defun svn-status-mark-changed (arg) + "Mark all files that could be committed. +This means we mark +* all modified files +* all files scheduled for addition +* all files scheduled for deletion + +The last two categories include all copied and moved files. +If called with a prefix ARG, unmark all such files." + (interactive "P") + (svn-status-mark-added arg) + (svn-status-mark-modified arg) + (svn-status-mark-deleted arg)) + +(defun svn-status-unset-all-usermarks () + (interactive) + (svn-status-apply-usermark-checked '(lambda (info) t) nil)) + +(defvar svn-status-regexp-history nil + "History list of regular expressions used in svn status commands.") + +(defun svn-status-read-regexp (prompt) + (read-from-minibuffer prompt nil nil nil 'svn-status-regexp-history)) + +(defun svn-status-mark-filename-regexp (regexp &optional unmark) + "Mark all files matching REGEXP. +If the function is called with a prefix arg, unmark all these files." + (interactive + (list (svn-status-read-regexp (concat (if current-prefix-arg "Unmark" "Mark") + " files (regexp): ")) + (if current-prefix-arg t nil))) + (svn-status-apply-usermark-checked + '(lambda (info) (string-match regexp (svn-status-line-info->filename-nondirectory info))) (not unmark))) + +(defun svn-status-mark-by-file-ext (ext &optional unmark) + "Mark all files matching the given file extension EXT. +If the function is called with a prefix arg, unmark all these files." + (interactive + (list (read-string (concat (if current-prefix-arg "Unmark" "Mark") + " files with extensions: ")) + (if current-prefix-arg t nil))) + (svn-status-apply-usermark-checked + '(lambda (info) (let ((case-fold-search nil)) + (string-match (concat "\\." ext "$") (svn-status-line-info->filename-nondirectory info)))) (not unmark))) + +(defun svn-status-toggle-hide-unknown () + (interactive) + (setq svn-status-hide-unknown (not svn-status-hide-unknown)) + (svn-status-update-buffer)) + +(defun svn-status-toggle-hide-unmodified () + (interactive) + (setq svn-status-hide-unmodified (not svn-status-hide-unmodified)) + (svn-status-update-buffer)) + +(defun svn-status-get-file-name-buffer-position (name) + "Find the buffer position for a file. +If the file is not found, return nil." + (let ((start-pos (let ((cached-pos (gethash name + svn-status-filename-to-buffer-position-cache))) + (when cached-pos + (goto-char (previous-overlay-change cached-pos))) + (point))) + (found)) + ;; performance optimization: search from point to end of buffer + (while (and (not found) (< (point) (point-max))) + (goto-char (next-overlay-change (point))) + (when (string= name (svn-status-line-info->filename + (svn-status-get-line-information))) + (setq start-pos (+ (point) svn-status-default-column)) + (setq found t))) + ;; search from buffer start to point + (goto-char (point-min)) + (while (and (not found) (< (point) start-pos)) + (goto-char (next-overlay-change (point))) + (when (string= name (svn-status-line-info->filename + (svn-status-get-line-information))) + (setq start-pos (+ (point) svn-status-default-column)) + (setq found t))) + (and found start-pos))) + +(defun svn-status-goto-file-name (name) + "Move the cursor the the line that displays NAME." + (let ((pos (svn-status-get-file-name-buffer-position name))) + (if pos + (goto-char pos) + (svn-status-message 7 "Note: svn-status-goto-file-name: %s not found" name)))) + +(defun svn-status-find-info-for-file-name (name) + (let* ((st-info svn-status-info) + (info)) + (while st-info + (when (string= name (svn-status-line-info->filename (car st-info))) + (setq info (car st-info)) + (setq st-info nil)) ; terminate loop + (setq st-info (cdr st-info))) + info)) + +(defun svn-status-marked-files () + "Return all files marked by `svn-status-set-user-mark', +or (if no files were marked) the file under point." + (if (eq major-mode 'svn-status-mode) + (let* ((st-info svn-status-info) + (file-list)) + (while st-info + (when (svn-status-line-info->has-usermark (car st-info)) + (setq file-list (append file-list (list (car st-info))))) + (setq st-info (cdr st-info))) + (or file-list + (if (svn-status-get-line-information) + (list (svn-status-get-line-information)) + nil))) + ;; different mode, means called not from the *svn-status* buffer + (if svn-status-get-line-information-for-file + (list (svn-status-make-line-info (if (eq svn-status-get-line-information-for-file 'relative) + (file-relative-name (buffer-file-name) (svn-status-base-dir)) + (buffer-file-name)))) + (list (svn-status-make-line-info "."))))) + +(defun svn-status-marked-file-names () + (mapcar 'svn-status-line-info->filename (svn-status-marked-files))) + +(defun svn-status-some-files-marked-p () + "Return non-nil iff a file has been marked by `svn-status-set-user-mark'. +Unlike `svn-status-marked-files', this does not select the file under point +if no files have been marked." + ;; `some' would be shorter but requires cl-seq at runtime. + ;; (Because it accepts both lists and vectors, it is difficult to inline.) + (loop for file in svn-status-info + thereis (svn-status-line-info->has-usermark file))) + +(defun svn-status-ui-information-hash-table () + (let ((st-info svn-status-info) + (svn-status-ui-information (make-hash-table :test 'equal))) + (while st-info + (svn-puthash (svn-status-line-info->filename (car st-info)) + (svn-status-line-info->ui-status (car st-info)) + svn-status-ui-information) + (setq st-info (cdr st-info))) + svn-status-ui-information)) + + +(defun svn-status-create-arg-file (file-name prefix file-info-list postfix) + (with-temp-file file-name + (insert prefix) + (let ((st-info file-info-list)) + (while st-info + (insert (svn-status-line-info->filename (car st-info))) + (insert "\n") + (setq st-info (cdr st-info))) + + (insert postfix)))) + +(defun svn-status-show-process-buffer-internal (&optional scroll-to-top) + (let ((cur-buff (current-buffer))) + (unless svn-status-preserve-window-configuration + (when (string= (buffer-name) svn-status-buffer-name) + (delete-other-windows))) + (pop-to-buffer svn-process-buffer-name) + (svn-process-mode) + (when scroll-to-top + (goto-char (point-min))) + (pop-to-buffer cur-buff))) + +(defun svn-status-show-process-output (cmd &optional scroll-to-top) + "Display the result of a svn command. +Consider svn-status-window-alist to choose the buffer name." + (let ((window-mode (cadr (assoc cmd svn-status-window-alist))) + (process-default-directory)) + (cond ((eq window-mode nil) ;; use *svn-process* buffer + (setq svn-status-last-output-buffer-name svn-process-buffer-name)) + ((eq window-mode t) ;; use *svn-info* buffer + (setq svn-status-last-output-buffer-name "*svn-info*")) + ((eq window-mode 'invisible) ;; don't display the buffer + (setq svn-status-last-output-buffer-name nil)) + (t + (setq svn-status-last-output-buffer-name window-mode))) + (when svn-status-last-output-buffer-name + (if window-mode + (progn + (unless svn-status-preserve-window-configuration + (when (string= (buffer-name) svn-status-buffer-name) + (delete-other-windows))) + (pop-to-buffer svn-process-buffer-name) + (setq process-default-directory default-directory) + (switch-to-buffer (get-buffer-create svn-status-last-output-buffer-name)) + (setq default-directory process-default-directory) + (let ((buffer-read-only nil)) + (delete-region (point-min) (point-max)) + (insert-buffer-substring svn-process-buffer-name) + (when scroll-to-top + (goto-char (point-min)))) + (when (eq window-mode t) ;; *svn-info* buffer + (svn-info-mode)) + (other-window 1)) + (svn-status-show-process-buffer-internal scroll-to-top))))) + +(defun svn-status-show-svn-log (arg) + "Run `svn log' on selected files. +The output is put into the *svn-log* buffer +The optional prefix argument ARG determines which switches are passed to `svn log': + no prefix --- use whatever is in the list `svn-status-default-log-arguments' + prefix argument of -1: --- use the -q switch (quiet) + prefix argument of 0 --- use no arguments + other prefix arguments: --- use the -v switch (verbose) + +See `svn-status-marked-files' for what counts as selected." + (interactive "P") + (let ((switches (cond ((eq arg 0) '()) + ((or (eq arg -1) (eq arg '-)) '("-q")) + (arg '("-v")) + (t svn-status-default-log-arguments))) + (svn-status-get-line-information-for-file t)) + ;; (message "svn-status-show-svn-log %S" arg) + (svn-status-create-arg-file svn-status-temp-arg-file "" (svn-status-marked-files) "") + (svn-run t t 'log "log" "--targets" svn-status-temp-arg-file switches) + (save-excursion + (set-buffer svn-process-buffer-name) + (svn-log-view-mode)))) + +(defun svn-status-version () + "Show the version numbers for psvn.el and the svn command line client. +The version number of the client is cached in `svn-client-version'." + (interactive) + (let ((window-conf (current-window-configuration)) + (version-string)) + (if (or (interactive-p) (not svn-status-cached-version-string)) + (progn + (svn-run nil t 'version "--version") + (when (interactive-p) + (svn-status-show-process-output 'info t)) + (with-current-buffer svn-status-last-output-buffer-name + (goto-char (point-min)) + (setq svn-client-version + (when (re-search-forward "svn, version \\([0-9\.]+\\) " nil t) + (mapcar 'string-to-number (split-string (match-string 1) "\\.")))) + (let ((buffer-read-only nil)) + (goto-char (point-min)) + (insert (format "psvn.el revision: %s\n\n" svn-psvn-revision))) + (setq version-string (buffer-substring-no-properties (point-min) (point-max)))) + (setq svn-status-cached-version-string version-string)) + (setq version-string svn-status-cached-version-string) + (unless (interactive-p) + (set-window-configuration window-conf) + version-string)))) + +(defun svn-status-info () + "Run `svn info' on all selected files. +See `svn-status-marked-files' for what counts as selected." + (interactive) + (svn-status-create-arg-file svn-status-temp-arg-file "" (svn-status-marked-files) "") + (svn-run t t 'info "info" "--targets" svn-status-temp-arg-file)) + +(defun svn-status-info-for-path (path) + "Run svn info on the given PATH. +Return some interesting parts of the resulting output. +At the moment a list containing the last changed author is returned." + (let ((svn-process-buffer-name "*svn-info-output*") + (last-changed-author)) + (svn-run nil t 'info "info" path) + (with-current-buffer svn-process-buffer-name + (goto-char (point-min)) + (when (search-forward "last changed author: " nil t) + (setq last-changed-author (buffer-substring-no-properties (point) (svn-point-at-eol))))) + (svn-status-message 7 "last-changed-author for '%s': %s" path last-changed-author) + (list last-changed-author))) + +(defun svn-status-blame (revision) + "Run `svn blame' on the current file. +When called with a prefix argument, ask the user for the REVISION to use. +When called from a file buffer, go to the current line in the resulting blame output." + (interactive "P") + (when current-prefix-arg + (setq revision (svn-status-read-revision-string "Blame for version: " "BASE"))) + (unless revision (setq revision "BASE")) + (setq svn-status-blame-file-name (svn-status-line-info->filename (svn-status-get-file-information))) + (svn-run t t 'blame "blame" "-r" revision svn-status-blame-file-name)) + +(defun svn-status-show-svn-diff (arg) + "Run `svn diff' on the current file. +If the current file is a directory, compare it recursively. +If there is a newer revision in the repository, the diff is done against HEAD, +otherwise compare the working copy with BASE. +If ARG then prompt for revision to diff against." + (interactive "P") + (svn-status-ensure-cursor-on-file) + (svn-status-show-svn-diff-internal (list (svn-status-get-line-information)) t + (if arg :ask :auto))) + +(defun svn-file-show-svn-diff (arg) + "Run `svn diff' on the current file. +If there is a newer revision in the repository, the diff is done against HEAD, +otherwise compare the working copy with BASE. +If ARG then prompt for revision to diff against." + (interactive "P") + (svn-status-show-svn-diff-internal (list (svn-status-make-line-info buffer-file-name)) nil + (if arg :ask :auto))) + +(defun svn-status-show-svn-diff-for-marked-files (arg) + "Run `svn diff' on all selected files. +If some files have been marked, compare those non-recursively; +this is because marking a directory with \\[svn-status-set-user-mark] +normally marks all of its files as well. +If no files have been marked, compare recursively the file at point. +If ARG then prompt for revision to diff against, else compare working copy with BASE." + (interactive "P") + (svn-status-show-svn-diff-internal (svn-status-marked-files) + (not (svn-status-some-files-marked-p)) + (if arg :ask "BASE"))) + +(defun svn-status-diff-show-changeset (rev &optional user-confirmation) + "Show the changeset for a given log entry. +When called with a prefix argument, ask the user for the revision." + (let* ((upper-rev rev) + (lower-rev (number-to-string (- (string-to-number upper-rev) 1))) + (rev-arg (concat lower-rev ":" upper-rev))) + (when user-confirmation + (setq rev-arg (read-string "Revision for changeset: " rev-arg))) + (svn-run nil t 'diff "diff" (concat "-r" rev-arg)) + (svn-status-activate-diff-mode))) + +(defun svn-status-show-svn-diff-internal (line-infos recursive revision) + ;; REVISION must be one of: + ;; - a string: whatever the -r option allows. + ;; - `:ask': asks the user to specify the revision, which then becomes + ;; saved in `minibuffer-history' rather than in `command-history'. + ;; - `:auto': use "HEAD" if an update is known to exist, "BASE" otherwise. + ;; In the future, `nil' might mean omit the -r option entirely; + ;; but that currently seems to imply "BASE", so we just use that. + (when (eq revision :ask) + (setq revision (svn-status-read-revision-string + "Diff with files for version: " "PREV"))) + + (setq svn-status-last-diff-options (list line-infos recursive revision)) + + (let ((clear-buf t) + (beginning nil)) + (dolist (line-info line-infos) + (svn-run nil clear-buf 'diff "diff" svn-status-default-diff-arguments + "-r" (if (eq revision :auto) + (if (svn-status-line-info->update-available line-info) + "HEAD" "BASE") + revision) + (unless recursive "--non-recursive") + (svn-status-line-info->filename line-info)) + (setq clear-buf nil) + + ;; "svn diff --non-recursive" skips only subdirectories, not files. + ;; But a non-recursive diff via psvn should skip files too, because + ;; the user would have marked them if he wanted them to be compared. + ;; So we'll look for the "Index: foo" line that marks the first file + ;; in the diff output, and delete it and everything that follows. + ;; This is made more complicated by the fact that `svn-status-activate-diff-mode' + ;; expects the output to be left in the *svn-process* buffer. + (unless recursive + ;; Check `directory-p' relative to the `default-directory' of the + ;; "*svn-status*" buffer, not that of the svn-process-buffer-name buffer. + (let ((directory-p (svn-status-line-info->directory-p line-info))) + (with-current-buffer svn-process-buffer-name + (when directory-p + (goto-char (or beginning (point-min))) + (when (re-search-forward "^Index: " nil t) + (delete-region (match-beginning 0) (point-max)))) + (goto-char (setq beginning (point-max)))))))) + (svn-status-activate-diff-mode)) + +(defun svn-status-diff-save-current-defun-as-kill () + "Copy the function name for the change at point to the kill-ring. +That function uses `add-log-current-defun'" + (interactive) + (let ((func-name (add-log-current-defun))) + (if func-name + (progn + (kill-new func-name) + (message "Copied %S" func-name)) + (message "No current defun detected.")))) + +(defun svn-status-diff-pop-to-commit-buffer () + "Temporary switch to the `svn-status-buffer-name' buffer and start a commit from there." + (interactive) + (let ((window-conf (current-window-configuration))) + (svn-status-switch-to-status-buffer) + (svn-status-commit) + (set-window-configuration window-conf) + (setq svn-status-pre-commit-window-configuration window-conf) + (pop-to-buffer svn-log-edit-buffer-name))) + +(defun svn-status-activate-diff-mode () + "Show the `svn-process-buffer-name' buffer, using the diff-mode." + (svn-status-show-process-output 'diff t) + (let ((working-directory default-directory)) + (save-excursion + (set-buffer svn-status-last-output-buffer-name) + (setq default-directory working-directory) + (svn-status-diff-mode) + (setq buffer-read-only t)))) + +(define-derived-mode svn-status-diff-mode fundamental-mode "svn-diff" + "Major mode to display svn diffs. Derives from `diff-mode'. + +Commands: +\\{svn-status-diff-mode-map} +" + (let ((diff-mode-shared-map (copy-keymap svn-status-diff-mode-map)) + major-mode mode-name) + (diff-mode) + (set (make-local-variable 'revert-buffer-function) 'svn-status-diff-update))) + +(defun svn-status-diff-update (arg noconfirm) + "Rerun the last svn diff command and update the *svn-diff* buffer." + (interactive) + (svn-status-save-some-buffers) + (save-window-excursion + (apply 'svn-status-show-svn-diff-internal svn-status-last-diff-options))) + +(defun svn-status-show-process-buffer () + "Show the content of the `svn-process-buffer-name' buffer" + (interactive) + (svn-status-show-process-output nil)) + +(defun svn-status-pop-to-partner-buffer () + "Pop to the `svn-status-partner-buffer' if that variable is set." + (interactive) + (when svn-status-partner-buffer + (let ((cur-buf (current-buffer))) + (pop-to-buffer svn-status-partner-buffer) + (setq svn-status-partner-buffer cur-buf)))) + +(defun svn-status-pop-to-new-partner-buffer (buffer) + "Call `pop-to-buffer' and register the current buffer as partner buffer for BUFFER." + (let ((cur-buf (current-buffer))) + (pop-to-buffer buffer) + (setq svn-status-partner-buffer cur-buf))) + +(defun svn-status-add-file-recursively (arg) + "Run `svn add' on all selected files. +When a directory is added, add files recursively. +See `svn-status-marked-files' for what counts as selected. +When this function is called with a prefix argument, use the actual file instead." + (interactive "P") + (message "adding: %S" (svn-status-get-file-list-names (not arg))) + (svn-status-create-arg-file svn-status-temp-arg-file "" (svn-status-get-file-list (not arg)) "") + (svn-run t t 'add "add" "--targets" svn-status-temp-arg-file)) + +(defun svn-status-add-file (arg) + "Run `svn add' on all selected files. +When a directory is added, don't add the files of the directory + (svn add --non-recursive is called). +See `svn-status-marked-files' for what counts as selected. +When this function is called with a prefix argument, use the actual file instead." + (interactive "P") + (message "adding: %S" (svn-status-get-file-list-names (not arg))) + (svn-status-create-arg-file svn-status-temp-arg-file "" (svn-status-get-file-list (not arg)) "") + (svn-run t t 'add "add" "--non-recursive" "--targets" svn-status-temp-arg-file)) + +(defun svn-status-lock (arg) + "Run `svn lock' on all selected files. +See `svn-status-marked-files' for what counts as selected." + (interactive "P") + (message "locking: %S" (svn-status-get-file-list-names t)) + (svn-status-create-arg-file svn-status-temp-arg-file "" (svn-status-get-file-list t) "") + (svn-run t t 'lock "lock" "--targets" svn-status-temp-arg-file)) + +(defun svn-status-unlock (arg) + "Run `svn unlock' on all selected files. +See `svn-status-marked-files' for what counts as selected." + (interactive "P") + (message "unlocking: %S" (svn-status-get-file-list-names t)) + (svn-status-create-arg-file svn-status-temp-arg-file "" (svn-status-get-file-list t) "") + (svn-run t t 'unlock "unlock" "--targets" svn-status-temp-arg-file)) + +(defun svn-status-make-directory (dir) + "Run `svn mkdir DIR'." + ;; TODO: Allow entering a URI interactively. + ;; Currently, `read-file-name' corrupts it. + (interactive (list (read-file-name "Make directory: " + (svn-status-directory-containing-point t)))) + (unless (string-match "^[^:/]+://" dir) ; Is it a URI? + (setq dir (file-relative-name dir))) + (svn-run t t 'mkdir "mkdir" "--" dir)) + +(defun svn-status-mv () + "Prompt for a destination, and `svn mv' selected files there. +See `svn-status-marked-files' for what counts as `selected'. + +If one file was selected then the destination DEST should be a +filename to rename the selected file to, or a directory to move the +file into; if multiple files were selected then DEST should be a +directory to move the selected files into. + +The default DEST is the directory containing point. + +BUG: If we've marked some directory containging a file as well as the +file itself, then we should just mv the directory, but this implementation +doesn't check for that. +SOLUTION: for each dir, umark all its contents (but not the dir +itself) before running mv." + (interactive) + (svn-status-mv-cp "mv" "Rename" "Move" "mv")) + +(defun svn-status-cp () + "See `svn-status-mv'" + (interactive) + (svn-status-mv-cp "cp" "Copy" "Copy" "cp")) + +(defun svn-status-mv-cp (command singleprompt manyprompt fallback) + "Run svn COMMAND on marked files, prompting for destination + +This function acts on `svn-status-marked-files': at the prompt the +user can enter a new file name, or an existing directory: this is used as the argument for svn COMMAND. + COMMAND --- string saying what to do: \"mv\" or \"cp\" + SINGLEPROMPT --- string at start of prompt when one file marked + MANYPROMPT --- string at start of prompt when multiple files marked + FALLBACK --- If any marked file is unversioned, use this instead of 'svn COMMAND'" + (let* ((marked-files (svn-status-marked-files)) + (num-of-files (length marked-files)) + dest) + (if (= 1 num-of-files) + ;; one file to act on: new name, or directory to hold results + (setq dest (read-file-name + (format "%s %s to: " singleprompt + (svn-status-line-info->filename (car marked-files))) + (svn-status-directory-containing-point t) + (svn-status-line-info->full-path (car marked-files)))) + ;;TODO: (when file-exists-p but-no-dir-p dest (error "%s already exists" dest)) + ;;multiple files selected, so prompt for existing directory to mv them into. + (setq dest (svn-read-directory-name + (format "%s %d files to directory: " manyprompt num-of-files) + (svn-status-directory-containing-point t) nil t)) + (unless (file-directory-p dest) + (error "%s is not a directory" dest))) + (when (string= dest "") + (error "No destination entered")) + (unless (string-match "^[^:/]+://" dest) ; Is it a URI? + (setq dest (file-relative-name dest))) + + ;;do the move: svn mv only lets us move things once at a time, so + ;;we need to run svn mv once for each file (hence second arg to + ;;svn-run is nil.) + + ;;TODO: before doing any moving, For every marked directory, + ;;ensure none of its contents are also marked, since we dont want + ;;to move both file *and* its parent... + ;; what about elided files? what if user marks a dir+contents, then presses `_' ? +;; ;one solution: +;; (dolist (original marked-files) +;; (when (svn-status-line-info->directory-p original) +;; ;; run svn-status-goto-file-name to move point to line of file +;; ;; run svn-status-unset-user-mark to unmark dir+all contents +;; ;; run svn-status-set-user-mark to remark dir +;; ;; maybe check for local mods here, and unmark if user does't say --force? +;; )) + (dolist (original marked-files) + (let ((original-name (svn-status-line-info->filename original)) + (original-filemarks (svn-status-line-info->filemark original)) + (original-propmarks (svn-status-line-info->propmark original)) + (moved nil)) + (cond + ((or (eq original-filemarks ?M) ;local mods: maybe do `svn mv --force' + (eq original-propmarks ?M)) ;local prop mods: maybe do `svn mv --force' + (if (yes-or-no-p + (format "%s has local modifications; use `--force' to really move it? " original-name)) + (progn + (svn-status-run-mv-cp command original-name dest t) + (setq moved t)) + (message "Not acting on %s" original-name))) + ((eq original-filemarks ??) ;original is unversioned: use fallback + (if (yes-or-no-p (format "%s is unversioned. Use `%s -i -- %s %s'? " + original-name fallback original-name dest)) + (progn (call-process fallback nil (get-buffer-create svn-process-buffer-name) nil + "-i" "--" original-name dest) + (setq moved t)) + ;;new files created by fallback are not in *svn-status* now, + ;;TODO: so call (svn-status-update) here? + (message "Not acting on %s" original-name))) + + ((eq original-filemarks ?A) ;;`A' (`svn add'ed, but not committed) + (message "Not acting on %s (commit it first)" original-name)) + + ((eq original-filemarks ? ) ;original is unmodified: can proceed + (svn-status-run-mv-cp command original-name dest) + (setq moved t)) + + ;;file has some other mark (eg conflicted) + (t + (if (yes-or-no-p + (format "The status of %s looks scary. Risk moving it anyway? " + original-name)) + (progn + (svn-status-run-mv-cp command original-name dest) + (setq moved t)) + (message "Not acting on %s" original-name)))) + (when moved + (message "psvn: did '%s' from %s to %s" command original-name dest) + ;; Silently rename the visited file of any buffer visiting this file. + (when (get-file-buffer original-name) + (with-current-buffer (get-file-buffer original-name) + (set-visited-file-name dest nil t)))))) + (svn-status-update))) + +(defun svn-status-run-mv-cp (command original destination &optional force) + "Actually run svn mv or svn cp. +This is just to prevent duplication in `svn-status-prompt-and-act-on-files'" + (if force + (svn-run nil t (intern command) command "--force" "--" original destination) + (svn-run nil t (intern command) command "--" original destination)) +;;;TODO: use something like the following instead of calling svn-status-update +;;; at the end of svn-status-mv-cp. +;; (let ((output (svn-status-parse-ar-output)) +;; newfile +;; buffer-read-only) ; otherwise insert-line-in-status-buffer fails +;; (dolist (new-file output) +;; (when (eq (cadr new-file) 'added-wc) +;; ;; files with 'wc-added action do not exist in *svn-status* +;; ;; buffer yet, so give each of them their own line-info +;; ;; TODO: need to insert the new line-info in a sensible place, ie in the correct directory! [svn-status-filename-to-buffer-position-cache might help?] + +;; (svn-insert-line-in-status-buffer +;; (svn-status-make-line-info (car new-file))))) +;; (svn-status-update-with-command-list output)) + ) + +(defun svn-status-revert () + "Run `svn revert' on all selected files. +See `svn-status-marked-files' for what counts as selected." + (interactive) + (let* ((marked-files (svn-status-marked-files)) + (num-of-files (length marked-files))) + (when (yes-or-no-p + (if (= 1 num-of-files) + (format "Revert %s? " (svn-status-line-info->filename (car marked-files))) + (format "Revert %d files? " num-of-files))) + (message "reverting: %S" (svn-status-marked-file-names)) + (svn-status-create-arg-file svn-status-temp-arg-file "" (svn-status-marked-files) "") + (svn-run t t 'revert "revert" "--targets" svn-status-temp-arg-file)))) + +(defun svn-status-rm (force) + "Run `svn rm' on all selected files. +See `svn-status-marked-files' for what counts as selected. +When called with a prefix argument add the command line switch --force. + +Forcing the deletion can also be used to delete files not under svn control." + (interactive "P") + (let* ((marked-files (svn-status-marked-files)) + (num-of-files (length marked-files))) + (when (yes-or-no-p + (if (= 1 num-of-files) + (format "%sRemove %s? " (if force "Force " "") (svn-status-line-info->filename (car marked-files))) + (format "%sRemove %d files? " (if force "Force " "") num-of-files))) + (message "removing: %S" (svn-status-marked-file-names)) + (svn-status-create-arg-file svn-status-temp-arg-file "" (svn-status-marked-files) "") + (if force + (save-excursion + (svn-run t t 'rm "rm" "--force" "--targets" svn-status-temp-arg-file) + (dolist (to-delete (svn-status-marked-files)) + (when (eq (svn-status-line-info->filemark to-delete) ??) + (svn-status-goto-file-name (svn-status-line-info->filename to-delete)) + (let ((buffer-read-only nil)) + (delete-region (svn-point-at-bol) (+ 1 (svn-point-at-eol))) + (delete to-delete svn-status-info))))) + (svn-run t t 'rm "rm" "--targets" svn-status-temp-arg-file))))) + +(defun svn-status-update-cmd (arg) + "Run svn update. +When called with a prefix argument, ask the user for the revision to update to. +When called with a negative prefix argument, only update the selected files." + (interactive "P") + (let* ((selective-update (or (and (numberp arg) (< arg 0)) (eq arg '-))) + (rev (when arg (svn-status-read-revision-string + (if selective-update + (format "Selected entries: Run svn update -r ") + (format "Directory: %s: Run svn update -r " default-directory)) + (if selective-update "HEAD" nil))))) + (if selective-update + (progn + (message "Running svn-update for %s" (svn-status-marked-file-names)) + (svn-run t t 'update "update" (when rev (list "-r" rev)) (svn-status-marked-file-names))) + (message "Running svn-update for %s" default-directory) + (svn-run t t 'update "update" (when rev (list "-r" rev)))))) + +(defun svn-status-commit () + "Commit selected files. +If some files have been marked, commit those non-recursively; +this is because marking a directory with \\[svn-status-set-user-mark] +normally marks all of its files as well. +If no files have been marked, commit recursively the file at point." + (interactive) + (svn-status-save-some-buffers) + (let* ((selected-files (svn-status-marked-files)) + (marked-files-p (svn-status-some-files-marked-p))) + (setq svn-status-files-to-commit selected-files + svn-status-recursive-commit (not marked-files-p)) + (svn-log-edit-show-files-to-commit) + (svn-status-pop-to-commit-buffer) + (when svn-log-edit-insert-files-to-commit + (svn-log-edit-insert-files-to-commit)))) + +(defun svn-status-pop-to-commit-buffer () + "Pop to the svn commit buffer. +If a saved log message exists in `svn-log-edit-file-name' insert it in the buffer." + (interactive) + (setq svn-status-pre-commit-window-configuration (current-window-configuration)) + (let* ((use-existing-buffer (get-buffer svn-log-edit-buffer-name)) + (commit-buffer (get-buffer-create svn-log-edit-buffer-name)) + (dir default-directory) + (log-edit-file-name)) + (pop-to-buffer commit-buffer) + (setq default-directory dir) + (setq log-edit-file-name (svn-log-edit-file-name)) + (unless use-existing-buffer + (when (and log-edit-file-name (file-readable-p log-edit-file-name)) + (insert-file-contents log-edit-file-name))) + (svn-log-edit-mode))) + +(defun svn-status-switch-to-status-buffer () + "Switch to the `svn-status-buffer-name' buffer." + (interactive) + (switch-to-buffer svn-status-buffer-name)) + +(defun svn-status-pop-to-status-buffer () + "Pop to the `svn-status-buffer-name' buffer." + (interactive) + (pop-to-buffer svn-status-buffer-name)) + +(defun svn-status-via-bookmark (bookmark) + "Allows a quick selection of a bookmark in `svn-bookmark-list'. +Run `svn-status' on the selected bookmark." + (interactive + (list + (let ((completion-ignore-case t)) + (funcall svn-status-completing-read-function "SVN status bookmark: " svn-bookmark-list)))) + (unless bookmark + (error "No bookmark specified")) + (let ((directory (cdr (assoc bookmark svn-bookmark-list)))) + (if (file-directory-p directory) + (svn-status directory) + (error "%s is not a directory" directory)))) + +(defun svn-status-export () + "Run `svn export' for the current working copy. +Ask the user for the destination path. +`svn-status-default-export-directory' is suggested as export directory." + (interactive) + (let* ((src default-directory) + (dir1-name (nth 1 (nreverse (split-string src "/")))) + (dest (read-file-name (format "Export %s to " src) (concat svn-status-default-export-directory dir1-name)))) + (svn-run t t 'export "export" (expand-file-name src) (expand-file-name dest)) + (message "svn-status-export %s %s" src dest))) + +(defun svn-status-cleanup (arg) + "Run `svn cleanup' on all selected files. +See `svn-status-marked-files' for what counts as selected. +When this function is called with a prefix argument, use the actual file instead." + (interactive "P") + (let ((file-names (svn-status-get-file-list-names (not arg)))) + (if file-names + (progn + (message "svn-status-cleanup %S" file-names) + (svn-run t t 'cleanup (append (list "cleanup") file-names))) + (message "No valid file selected - No status cleanup possible")))) + +(defun svn-status-resolved () + "Run `svn resolved' on all selected files. +See `svn-status-marked-files' for what counts as selected." + (interactive) + (let* ((marked-files (svn-status-marked-files)) + (num-of-files (length marked-files))) + (when (yes-or-no-p + (if (= 1 num-of-files) + (format "Resolve %s? " (svn-status-line-info->filename (car marked-files))) + (format "Resolve %d files? " num-of-files))) + (message "resolving: %S" (svn-status-marked-file-names)) + (svn-status-create-arg-file svn-status-temp-arg-file "" (svn-status-marked-files) "") + (svn-run t t 'resolved "resolved" "--targets" svn-status-temp-arg-file)))) + + +(defun svn-status-svnversion () + "Run svnversion on the directory that contains the file at point." + (interactive) + (svn-status-ensure-cursor-on-file) + (let ((simple-path (svn-status-line-info->filename (svn-status-get-line-information))) + (full-path (svn-status-line-info->full-path (svn-status-get-line-information))) + (version)) + (unless (file-directory-p simple-path) + (setq simple-path (or (file-name-directory simple-path) ".")) + (setq full-path (file-name-directory full-path))) + (setq version (shell-command-to-string (concat "svnversion -n " full-path))) + (message "svnversion for '%s': %s" simple-path version) + version)) + +;; -------------------------------------------------------------------------------- +;; Update the `svn-status-buffer-name' buffer, when a file is saved +;; -------------------------------------------------------------------------------- + +(defvar svn-status-file-modified-after-save-flag ?m + "Flag shown whenever a file is modified and saved in Emacs. +The flag is shown in the `svn-status-buffer-name' buffer. +Recommended values are ?m or ?M.") +(defun svn-status-after-save-hook () + "Set a modified indication, when a file is saved from a svn working copy." + (let* ((svn-dir (car-safe svn-status-directory-history)) + (svn-dir (when svn-dir (expand-file-name svn-dir))) + (file-dir (file-name-directory (buffer-file-name))) + (svn-dir-len (length (or svn-dir ""))) + (file-dir-len (length file-dir)) + (file-name)) + (when (and (get-buffer svn-status-buffer-name) + svn-dir + (>= file-dir-len svn-dir-len) + (string= (substring file-dir 0 svn-dir-len) svn-dir)) + (setq file-name (substring (buffer-file-name) svn-dir-len)) + ;;(message "In svn-status directory %S" file-name) + (let ((st-info svn-status-info) + (i-fname)) + (while st-info + (setq i-fname (svn-status-line-info->filename (car st-info))) + ;;(message "i-fname=%S" i-fname) + (when (and (string= file-name i-fname) + (not (eq (svn-status-line-info->filemark (car st-info)) ??))) + (svn-status-line-info->set-filemark (car st-info) + svn-status-file-modified-after-save-flag) + (save-window-excursion + (set-buffer svn-status-buffer-name) + (save-excursion + (let ((buffer-read-only nil) + (pos (svn-status-get-file-name-buffer-position i-fname))) + (if pos + (progn + (goto-char pos) + (delete-region (svn-point-at-bol) (svn-point-at-eol)) + (svn-insert-line-in-status-buffer (car st-info)) + (delete-char 1)) + (svn-status-message 3 "psvn: file %s not found, updating %s buffer content..." + i-fname svn-status-buffer-name) + (svn-status-update-buffer)))))) + (setq st-info (cdr st-info)))))) + nil) + +(add-hook 'after-save-hook 'svn-status-after-save-hook) + +;; -------------------------------------------------------------------------------- +;; Getting older revisions +;; -------------------------------------------------------------------------------- + +(defun svn-status-get-specific-revision (arg) + "Retrieve older revisions. +The older revisions are stored in backup files named F.~REVISION~. + +When the function is called without a prefix argument: get all marked files. +With a prefix argument: get only the actual file." + (interactive "P") + (svn-status-get-specific-revision-internal + (svn-status-get-file-list (not arg)) + :ask)) + +(defun svn-status-get-specific-revision-internal (line-infos revision) + "Retrieve older revisions of files. +LINE-INFOS is a list of line-info structures (see +`svn-status-get-line-information'). +REVISION is one of: +- a string: whatever the -r option allows. +- `:ask': asks the user to specify the revision, which then becomes + saved in `minibuffer-history' rather than in `command-history'. +- `:auto': Use \"HEAD\" if an update is known to exist, \"BASE\" otherwise. + +After the call, `svn-status-get-revision-file-info' will be an alist +\((WORKING-FILE-NAME . RETRIEVED-REVISION-FILE-NAME) ...). These file +names are relative to the directory where `svn-status' was run." + ;; In `svn-status-show-svn-diff-internal', there is a comment + ;; that REVISION `nil' might mean omitting the -r option entirely. + ;; That doesn't seem like a good idea with svn cat. + + ;; (message "svn-status-get-specific-revision-internal: %S %S" line-infos revision) + + (when (eq revision :ask) + (setq revision (svn-status-read-revision-string + "Get files for version: " "PREV"))) + + (let ((count (length line-infos))) + (if (= count 1) + (let ((line-info (car line-infos))) + (message "Getting revision %s of %s" + (if (eq revision :auto) + (if (svn-status-line-info->update-available line-info) + "HEAD" "BASE") + revision) + (svn-status-line-info->filename line-info))) + ;; We could compute "Getting HEAD of 8 files and BASE of 11 files" + ;; but that'd be more bloat than it's worth. + (message "Getting revision %s of %d files" + (if (eq revision :auto) "HEAD or BASE" revision) + count))) + + (let ((svn-status-get-specific-revision-file-info '())) + (dolist (line-info line-infos) + (let* ((revision (if (eq revision :auto) + (if (svn-status-line-info->update-available line-info) + "HEAD" "BASE") + revision)) ;must be a string by this point + (file-name (svn-status-line-info->filename line-info)) + ;; If REVISION is e.g. "HEAD", should we find out the actual + ;; revision number and save "foo.~123~" rather than "foo.~HEAD~"? + ;; OTOH, `auto-mode-alist' already ignores ".~HEAD~" suffixes, + ;; and if users often want to know the revision numbers of such + ;; files, they can use svn:keywords. + (file-name-with-revision (concat (file-name-nondirectory file-name) ".~" revision "~")) + (default-directory (concat (svn-status-base-dir) (file-name-directory file-name)))) + ;; `add-to-list' would unnecessarily check for duplicates. + (push (cons file-name (concat (file-name-directory file-name) file-name-with-revision)) svn-status-get-specific-revision-file-info) + ;; (message "file-name-with-revision: %s %S" file-name-with-revision (file-exists-p file-name-with-revision)) + (save-excursion + (if (or (not (file-exists-p file-name-with-revision)) ;; file does not exist + (not (string= (number-to-string (string-to-number revision)) revision))) ;; revision is not a number + (progn + (message "getting revision %s for %s" revision file-name) + (let ((content + (with-temp-buffer + (if (string= revision "BASE") + (insert-file-contents (concat (svn-wc-adm-dir-name) + "/text-base/" + (file-name-nondirectory file-name) + ".svn-base")) + (progn + (svn-run nil t 'cat "cat" "-r" revision (file-name-nondirectory file-name)) + ;;todo: error processing + ;;svn: Filesystem has no item + ;;svn: file not found: revision `15', path `/trunk/file.txt' + (insert-buffer-substring svn-process-buffer-name))) + (buffer-string)))) + (find-file file-name-with-revision) + (setq buffer-read-only nil) + (erase-buffer) ;Widen, because we'll save the whole buffer. + (insert content) + (goto-char (point-min)) + (save-buffer))) + (find-file file-name-with-revision))))) + ;;(message "default-directory: %s revision-file-info: %S" default-directory svn-status-get-specific-revision-file-info) + (nreverse svn-status-get-specific-revision-file-info))) + +(defun svn-status-ediff-with-revision (arg) + "Run ediff on the current file with a previous revision. +If ARG then prompt for revision to diff against." + (interactive "P") + (let* ((svn-status-get-specific-revision-file-info + (svn-status-get-specific-revision-internal + (list (svn-status-make-line-info + (file-relative-name + (svn-status-line-info->full-path (svn-status-get-line-information)) + (svn-status-base-dir)))) + (if arg :ask :auto))) + (ediff-after-quit-destination-buffer (current-buffer)) + (default-directory (svn-status-base-dir)) + (my-buffer (find-file-noselect (caar svn-status-get-specific-revision-file-info))) + (base-buff (find-file-noselect (cdar svn-status-get-specific-revision-file-info))) + (svn-transient-buffers (list my-buffer base-buff)) + (startup-hook '(svn-ediff-startup-hook))) + (ediff-buffers base-buff my-buffer startup-hook))) + +(defun svn-ediff-startup-hook () + ;; (message "svn-ediff-startup-hook: ediff-after-quit-hook-internal: %S" ediff-after-quit-hook-internal) + (add-hook 'ediff-after-quit-hook-internal + `(lambda () + (svn-ediff-exit-hook + ',ediff-after-quit-destination-buffer ',svn-transient-buffers)) + nil 'local)) + +(defun svn-ediff-exit-hook (svn-buf tmp-bufs) + ;; (message "svn-ediff-exit-hook: svn-buf: %s, tmp-bufs: %s" svn-buf tmp-bufs) + ;; kill the temp buffers (and their associated windows) + (dolist (tb tmp-bufs) + (when (and tb (buffer-live-p tb) (not (buffer-modified-p tb))) + (let* ((win (get-buffer-window tb t)) + (file-name (buffer-file-name tb)) + (is-temp-file (numberp (string-match "~\\([0-9]+\\|BASE\\)~" file-name)))) + ;; (message "svn-ediff-exit-hook - is-temp-file: %s, temp-buf:: %s - %s " is-temp-file (current-buffer) file-name) + (when (and win (> (count-windows) 1) + (delete-window win))) + (kill-buffer tb) + (when (and is-temp-file svn-status-ediff-delete-temporary-files) + (when (or (eq svn-status-ediff-delete-temporary-files t) + (y-or-n-p (format "Delete File '%s' ? " file-name))) + (delete-file file-name)))))) + ;; switch back to the *svn* buffer + (when (and svn-buf (buffer-live-p svn-buf) + (not (get-buffer-window svn-buf t))) + (ignore-errors (switch-to-buffer svn-buf)))) + + +(defun svn-status-read-revision-string (prompt &optional default-value) + "Prompt the user for a svn revision number." + (interactive) + (read-string prompt default-value)) + +(defun svn-file-show-svn-ediff (arg) + "Run ediff on the current file with a previous revision. +If ARG then prompt for revision to diff against." + (interactive "P") + (let ((svn-status-get-line-information-for-file 'relative) + (default-directory (svn-status-base-dir))) + (svn-status-ediff-with-revision arg))) + +;; -------------------------------------------------------------------------------- +;; SVN process handling +;; -------------------------------------------------------------------------------- + +(defun svn-process-kill () + "Kill the current running svn process." + (interactive) + (let ((process (get-process "svn"))) + (if process + (delete-process process) + (message "No running svn process")))) + +(defun svn-process-send-string (string &optional send-passwd) + "Send a string to the running svn process. +This is useful, if the running svn process asks the user a question. +Note: use C-q C-j to send a line termination character." + (interactive "sSend string to svn process: ") + (save-excursion + (set-buffer svn-process-buffer-name) + (goto-char (point-max)) + (let ((buffer-read-only nil)) + (insert (if send-passwd (make-string (length string) ?.) string))) + (set-marker (process-mark (get-process "svn")) (point))) + (process-send-string "svn" string)) + +(defun svn-process-send-string-and-newline (string &optional send-passwd) + "Send a string to the running svn process. +Just call `svn-process-send-string' with STRING and an end of line termination. +When called with a prefix argument, read the data from user as password." + (interactive (let* ((use-passwd current-prefix-arg) + (s (if use-passwd + (read-passwd "Send secret line to svn process: ") + (read-string "Send line to svn process: ")))) + (list s use-passwd))) + (svn-process-send-string (concat string "\n") send-passwd)) + +;; -------------------------------------------------------------------------------- +;; Property List stuff +;; -------------------------------------------------------------------------------- + +(defun svn-status-property-list () + (interactive) + (let ((file-names (svn-status-marked-file-names))) + (if file-names + (progn + (svn-run t t 'proplist (append (list "proplist" "-v") file-names))) + (message "No valid file selected - No property listing possible")))) + +(defun svn-status-proplist-start () + (svn-status-ensure-cursor-on-file) + (svn-run t t 'proplist-parse "proplist" (svn-status-line-info->filename + (svn-status-get-line-information)))) +(defun svn-status-property-edit-one-entry (arg) + "Edit a property. +When called with a prefix argument, it is possible to enter a new property." + (interactive "P") + (setq svn-status-property-edit-must-match-flag (not arg)) + (svn-status-proplist-start)) + +(defun svn-status-property-set () + (interactive) + (setq svn-status-property-edit-must-match-flag nil) + (svn-status-proplist-start)) + +(defun svn-status-property-delete () + (interactive) + (setq svn-status-property-edit-must-match-flag t) + (svn-status-proplist-start)) + +(defun svn-status-property-parse-property-names () + ;(svn-status-show-process-buffer-internal t) + (message "svn-status-property-parse-property-names") + (let ((pl) + (prop-name) + (prop-value)) + (save-excursion + (set-buffer svn-process-buffer-name) + (goto-char (point-min)) + (forward-line 1) + (while (looking-at " \\(.+\\)") + (setq pl (append pl (list (match-string 1)))) + (forward-line 1))) + ;(cond last-command: svn-status-property-set, svn-status-property-edit-one-entry + (cond ((eq last-command 'svn-status-property-edit-one-entry) + ;;(message "svn-status-property-edit-one-entry") + (setq prop-name + (completing-read "Set Property - Name: " (mapcar 'list pl) + nil svn-status-property-edit-must-match-flag)) + (unless (string= prop-name "") + (save-excursion + (set-buffer svn-status-buffer-name) + (svn-status-property-edit (list (svn-status-get-line-information)) + prop-name)))) + ((eq last-command 'svn-status-property-set) + (message "svn-status-property-set") + (setq prop-name + (completing-read "Set Property - Name: " (mapcar 'list pl) nil nil)) + (setq prop-value (read-from-minibuffer "Property value: ")) + (unless (string= prop-name "") + (save-excursion + (set-buffer svn-status-buffer-name) + (message "Setting property %s := %s for %S" prop-name prop-value + (svn-status-marked-file-names)) + (let ((file-names (svn-status-marked-file-names))) + (when file-names + (svn-run nil t 'propset + (append (list "propset" prop-name prop-value) file-names)) + ) + ) + (message "propset finished.") + ))) + ((eq last-command 'svn-status-property-delete) + (setq prop-name + (completing-read "Delete Property - Name: " (mapcar 'list pl) nil t)) + (unless (string= prop-name "") + (save-excursion + (set-buffer svn-status-buffer-name) + (let ((file-names (svn-status-marked-file-names))) + (when file-names + (message "Going to delete prop %s for %s" prop-name file-names) + (svn-run t t 'propdel + (append (list "propdel" prop-name) file-names)))))))))) + +(defun svn-status-property-edit (file-info-list prop-name &optional new-prop-value remove-values) + (let* ((commit-buffer (get-buffer-create "*svn-property-edit*")) + (dir default-directory) + ;; now only one file is implemented ... + (file-name (svn-status-line-info->filename (car file-info-list))) + (prop-value)) + (message "Edit property %s for file %s" prop-name file-name) + (svn-run nil t 'propget-parse "propget" prop-name file-name) + (save-excursion + (set-buffer svn-process-buffer-name) + (setq prop-value (if (> (point-max) 1) + (buffer-substring (point-min) (- (point-max) 1)) + ""))) + (setq svn-status-propedit-property-name prop-name) + (setq svn-status-propedit-file-list file-info-list) + (setq svn-status-pre-propedit-window-configuration (current-window-configuration)) + (pop-to-buffer commit-buffer) + ;; If the buffer has been narrowed, `svn-prop-edit-done' will use + ;; only the accessible part. So we need not erase the rest here. + (delete-region (point-min) (point-max)) + (setq default-directory dir) + (insert prop-value) + (svn-status-remove-control-M) + (when new-prop-value + (when (listp new-prop-value) + (if remove-values + (message "Remove prop values %S " new-prop-value) + (message "Adding new prop values %S " new-prop-value)) + (while new-prop-value + (goto-char (point-min)) + (if (re-search-forward (concat "^" (regexp-quote (car new-prop-value)) "$") nil t) + (when remove-values + (kill-whole-line 1)) + (unless remove-values + (goto-char (point-max)) + (when (> (current-column) 0) (insert "\n")) + (insert (car new-prop-value)))) + (setq new-prop-value (cdr new-prop-value))))) + (svn-prop-edit-mode))) + +(defun svn-status-property-set-property (file-info-list prop-name prop-value) + "Set a property on a given file list." + (save-excursion + (set-buffer (get-buffer-create "*svn-property-edit*")) + ;; If the buffer has been narrowed, `svn-prop-edit-do-it' will use + ;; only the accessible part. So we need not erase the rest here. + (delete-region (point-min) (point-max)) + (insert prop-value)) + (setq svn-status-propedit-file-list (svn-status-marked-files)) + (setq svn-status-propedit-property-name prop-name) + (svn-prop-edit-do-it nil) + (svn-status-update)) + + +(defun svn-status-get-directory (line-info) + (let* ((file-name (svn-status-line-info->filename line-info)) + (file-dir (file-name-directory file-name))) + ;;(message "file-dir: %S" file-dir) + (if file-dir + (substring file-dir 0 (- (length file-dir) 1)) + "."))) + +(defun svn-status-get-file-list-per-directory (files) + ;;(message "%S" files) + (let ((dir-list nil) + (i files) + (j) + (dir)) + (while i + (setq dir (svn-status-get-directory (car i))) + (setq j (assoc dir dir-list)) + (if j + (progn + ;;(message "dir already present %S %s" j dir) + (setcdr j (append (cdr j) (list (car i))))) + (setq dir-list (append dir-list (list (list dir (car i)))))) + (setq i (cdr i))) + ;;(message "svn-status-get-file-list-per-directory: %S" dir-list) + dir-list)) + +(defun svn-status-property-ignore-file () + (interactive) + (let ((d-list (svn-status-get-file-list-per-directory (svn-status-marked-files))) + (dir) + (f-info) + (ext-list)) + (while d-list + (setq dir (caar d-list)) + (setq f-info (cdar d-list)) + (setq ext-list (mapcar '(lambda (i) + (svn-status-line-info->filename-nondirectory i)) f-info)) + ;;(message "ignore in dir %s: %S" dir f-info) + (save-window-excursion + (when (y-or-n-p (format "Ignore %S for %s? " ext-list dir)) + (svn-status-property-edit + (list (svn-status-find-info-for-file-name dir)) "svn:ignore" ext-list) + (svn-prop-edit-do-it nil))) ; synchronous + (setq d-list (cdr d-list))) + (svn-status-update))) + +(defun svn-status-property-ignore-file-extension () + (interactive) + (let ((d-list (svn-status-get-file-list-per-directory (svn-status-marked-files))) + (dir) + (f-info) + (ext-list)) + (while d-list + (setq dir (caar d-list)) + (setq f-info (cdar d-list)) + ;;(message "ignore in dir %s: %S" dir f-info) + (setq ext-list nil) + (while f-info + (add-to-list 'ext-list (concat "*." + (file-name-extension + (svn-status-line-info->filename (car f-info))))) + (setq f-info (cdr f-info))) + ;;(message "%S" ext-list) + (save-window-excursion + (when (y-or-n-p (format "Ignore %S for %s? " ext-list dir)) + (svn-status-property-edit + (list (svn-status-find-info-for-file-name dir)) "svn:ignore" + ext-list) + (svn-prop-edit-do-it nil))) + (setq d-list (cdr d-list))) + (svn-status-update))) + +(defun svn-status-property-edit-svn-ignore () + (interactive) + (let* ((line-info (svn-status-get-line-information)) + (dir (if (svn-status-line-info->directory-p line-info) + (svn-status-line-info->filename line-info) + (svn-status-get-directory line-info)))) + (svn-status-property-edit + (list (svn-status-find-info-for-file-name dir)) "svn:ignore") + (message "Edit svn:ignore on %s" dir))) + + +(defun svn-status-property-set-keyword-list () + "Edit the svn:keywords property on the marked files." + (interactive) + ;;(message "Set svn:keywords for %S" (svn-status-marked-file-names)) + (svn-status-property-edit (svn-status-marked-files) "svn:keywords")) + +(defun svn-status-property-set-keyword-id (arg) + "Set/Remove Id from the svn:keywords property. +Normally Id is added to the svn:keywords property. + +When called with the prefix arg -, remove Id from the svn:keywords property." + (interactive "P") + (svn-status-property-edit (svn-status-marked-files) "svn:keywords" '("Id") (eq arg '-)) + (svn-prop-edit-do-it nil)) + +(defun svn-status-property-set-keyword-date (arg) + "Set/Remove Date from the svn:keywords property. +Normally Date is added to the svn:keywords property. + +When called with the prefix arg -, remove Date from the svn:keywords property." + (interactive "P") + (svn-status-property-edit (svn-status-marked-files) "svn:keywords" '("Date") (eq arg '-)) + (svn-prop-edit-do-it nil)) + + +(defun svn-status-property-set-eol-style () + "Edit the svn:eol-style property on the marked files." + (interactive) + (svn-status-property-set-property + (svn-status-marked-files) "svn:eol-style" + (completing-read "Set svn:eol-style for the marked files: " + (mapcar 'list '("native" "CRLF" "LF" "CR")) + nil t))) + +(defun svn-status-property-set-executable () + "Set the svn:executable property on the marked files." + (interactive) + (svn-status-property-set-property (svn-status-marked-files) "svn:executable" "*")) + +(defun svn-status-property-set-mime-type () + "Set the svn:mime-type property on the marked files." + (interactive) + (require 'mailcap nil t) + (let ((completion-ignore-case t) + (mime-types (when (fboundp 'mailcap-mime-types) + (mailcap-mime-types)))) + (svn-status-property-set-property + (svn-status-marked-files) "svn:mime-type" + (funcall svn-status-completing-read-function "Set svn:mime-type for the marked files: " + (mapcar (lambda (x) (cons x x)) ; for Emacs 21 + (sort mime-types 'string<)))))) + +;; -------------------------------------------------------------------------------- +;; svn-prop-edit-mode: +;; -------------------------------------------------------------------------------- + +(defvar svn-prop-edit-mode-map () "Keymap used in `svn-prop-edit-mode' buffers.") +(put 'svn-prop-edit-mode-map 'risky-local-variable t) ;for Emacs 20.7 + +(when (not svn-prop-edit-mode-map) + (setq svn-prop-edit-mode-map (make-sparse-keymap)) + (define-key svn-prop-edit-mode-map [(control ?c) (control ?c)] 'svn-prop-edit-done) + (define-key svn-prop-edit-mode-map [(control ?c) (control ?d)] 'svn-prop-edit-svn-diff) + (define-key svn-prop-edit-mode-map [(control ?c) (control ?s)] 'svn-prop-edit-svn-status) + (define-key svn-prop-edit-mode-map [(control ?c) (control ?l)] 'svn-prop-edit-svn-log) + (define-key svn-prop-edit-mode-map [(control ?c) (control ?q)] 'svn-prop-edit-abort)) + +(easy-menu-define svn-prop-edit-mode-menu svn-prop-edit-mode-map +"'svn-prop-edit-mode' menu" + '("SVN-PropEdit" + ["Commit" svn-prop-edit-done t] + ["Show Diff" svn-prop-edit-svn-diff t] + ["Show Status" svn-prop-edit-svn-status t] + ["Show Log" svn-prop-edit-svn-log t] + ["Abort" svn-prop-edit-abort t])) + +(defun svn-prop-edit-mode () + "Major Mode to edit file properties of files under svn control. +Commands: +\\{svn-prop-edit-mode-map}" + (interactive) + (kill-all-local-variables) + (use-local-map svn-prop-edit-mode-map) + (easy-menu-add svn-prop-edit-mode-menu) + (setq major-mode 'svn-prop-edit-mode) + (setq mode-name "svn-prop-edit")) + +(defun svn-prop-edit-abort () + (interactive) + (bury-buffer) + (set-window-configuration svn-status-pre-propedit-window-configuration)) + +(defun svn-prop-edit-done () + (interactive) + (svn-prop-edit-do-it t)) + +(defun svn-prop-edit-do-it (async) + "Run svn propset `svn-status-propedit-property-name' with the content of the +*svn-property-edit* buffer." + (message "svn propset %s on %s" + svn-status-propedit-property-name + (mapcar 'svn-status-line-info->filename svn-status-propedit-file-list)) + (save-excursion + (set-buffer (get-buffer "*svn-property-edit*")) + (when (fboundp 'set-buffer-file-coding-system) + (set-buffer-file-coding-system svn-status-svn-file-coding-system nil)) + (setq svn-status-temp-file-to-remove + (concat svn-status-temp-dir "svn-prop-edit.txt" svn-temp-suffix)) + (write-region (point-min) (point-max) svn-status-temp-file-to-remove nil 1)) + (when svn-status-propedit-file-list ; there are files to change properties + (svn-status-create-arg-file svn-status-temp-arg-file "" + svn-status-propedit-file-list "") + (setq svn-status-propedit-file-list nil) + (svn-run async t 'propset "propset" + svn-status-propedit-property-name + "--targets" svn-status-temp-arg-file + (when (eq svn-status-svn-file-coding-system 'utf-8) + '("--encoding" "UTF-8")) + "-F" (concat svn-status-temp-dir "svn-prop-edit.txt" svn-temp-suffix)) + (unless async (svn-status-remove-temp-file-maybe))) + (when svn-status-pre-propedit-window-configuration + (set-window-configuration svn-status-pre-propedit-window-configuration))) + +(defun svn-prop-edit-svn-diff (arg) + (interactive "P") + (set-buffer svn-status-buffer-name) + ;; Because propedit is not recursive in our use, neither is this diff. + (svn-status-show-svn-diff-internal svn-status-propedit-file-list nil + (if arg :ask "BASE"))) + +(defun svn-prop-edit-svn-log (arg) + (interactive "P") + (set-buffer svn-status-buffer-name) + (svn-status-show-svn-log arg)) + +(defun svn-prop-edit-svn-status () + (interactive) + (pop-to-buffer svn-status-buffer-name) + (other-window 1)) + +;; -------------------------------------------------------------------------------- +;; svn-log-edit-mode: +;; -------------------------------------------------------------------------------- + +(defvar svn-log-edit-mode-map () "Keymap used in `svn-log-edit-mode' buffers.") +(put 'svn-log-edit-mode-map 'risky-local-variable t) ;for Emacs 20.7 + +(defvar svn-log-edit-mode-menu) ;really defined with `easy-menu-define' below. + +(defun svn-log-edit-common-setup () + (set (make-local-variable 'paragraph-start) svn-log-edit-paragraph-start) + (set (make-local-variable 'paragraph-separate) svn-log-edit-paragraph-separate)) + +(if svn-log-edit-use-log-edit-mode + (define-derived-mode svn-log-edit-mode log-edit-mode "svn-log-edit" + "Wrapper around `log-edit-mode' for psvn.el" + (easy-menu-add svn-log-edit-mode-menu) + (setq svn-log-edit-update-log-entry nil) + (set (make-local-variable 'log-edit-callback) 'svn-log-edit-done) + (set (make-local-variable 'log-edit-listfun) 'svn-log-edit-files-to-commit) + (set (make-local-variable 'log-edit-initial-files) (log-edit-files)) + (svn-log-edit-common-setup) + (message "Press %s when you are done editing." + (substitute-command-keys "\\[log-edit-done]")) + ) + (defun svn-log-edit-mode () + "Major Mode to edit svn log messages. +Commands: +\\{svn-log-edit-mode-map}" + (interactive) + (kill-all-local-variables) + (use-local-map svn-log-edit-mode-map) + (easy-menu-add svn-log-edit-mode-menu) + (setq major-mode 'svn-log-edit-mode) + (setq mode-name "svn-log-edit") + (setq svn-log-edit-update-log-entry nil) + (svn-log-edit-common-setup) + (run-hooks 'svn-log-edit-mode-hook))) + +(when (not svn-log-edit-mode-map) + (setq svn-log-edit-mode-map (make-sparse-keymap)) + (unless svn-log-edit-use-log-edit-mode + (define-key svn-log-edit-mode-map (kbd "C-c C-c") 'svn-log-edit-done)) + (define-key svn-log-edit-mode-map (kbd "C-c C-d") 'svn-log-edit-svn-diff) + (define-key svn-log-edit-mode-map (kbd "C-c C-s") 'svn-log-edit-save-message) + (define-key svn-log-edit-mode-map (kbd "C-c C-i") 'svn-log-edit-svn-status) + (define-key svn-log-edit-mode-map (kbd "C-c C-l") 'svn-log-edit-svn-log) + (define-key svn-log-edit-mode-map (kbd "C-c C-?") 'svn-log-edit-show-files-to-commit) + (define-key svn-log-edit-mode-map (kbd "C-c C-z") 'svn-log-edit-erase-edit-buffer) + (define-key svn-log-edit-mode-map (kbd "C-c C-q") 'svn-log-edit-abort)) + +(easy-menu-define svn-log-edit-mode-menu svn-log-edit-mode-map +"'svn-log-edit-mode' menu" + '("SVN-Log" + ["Save to disk" svn-log-edit-save-message t] + ["Commit" svn-log-edit-done t] + ["Show Diff" svn-log-edit-svn-diff t] + ["Show Status" svn-log-edit-svn-status t] + ["Show Log" svn-log-edit-svn-log t] + ["Show files to commit" svn-log-edit-show-files-to-commit t] + ["Erase buffer" svn-log-edit-erase-edit-buffer] + ["Abort" svn-log-edit-abort t])) +(put 'svn-log-edit-mode-menu 'risky-local-variable t) + +(defun svn-log-edit-abort () + (interactive) + (bury-buffer) + (set-window-configuration svn-status-pre-commit-window-configuration)) + +(defun svn-log-edit-done () + "Finish editing the log message and run svn commit." + (interactive) + (svn-status-save-some-buffers) + (save-excursion + (set-buffer (get-buffer svn-log-edit-buffer-name)) + (when svn-log-edit-insert-files-to-commit + (svn-log-edit-remove-comment-lines)) + (when (fboundp 'set-buffer-file-coding-system) + (set-buffer-file-coding-system svn-status-svn-file-coding-system nil)) + (when (or svn-log-edit-update-log-entry svn-status-files-to-commit) + (setq svn-status-temp-file-to-remove + (concat svn-status-temp-dir "svn-log-edit.txt" svn-temp-suffix)) + (write-region (point-min) (point-max) svn-status-temp-file-to-remove nil 1)) + (bury-buffer)) + (if svn-log-edit-update-log-entry + (when (y-or-n-p "Update the log entry? ") + ;; svn propset svn:log --revprop -r11672 -F file + (svn-run nil t 'propset "propset" "svn:log" "--revprop" + (concat "-r" svn-log-edit-update-log-entry) + "-F" svn-status-temp-file-to-remove) + (save-excursion + (set-buffer svn-process-buffer-name) + (message "%s" (buffer-substring (point-min) (- (point-max) 1))))) + (when svn-status-files-to-commit ; there are files to commit + (setq svn-status-operated-on-dot + (and (= 1 (length svn-status-files-to-commit)) + (string= "." (svn-status-line-info->filename (car svn-status-files-to-commit))))) + (svn-status-create-arg-file svn-status-temp-arg-file "" + svn-status-files-to-commit "") + (svn-run t t 'commit "commit" + (unless svn-status-recursive-commit "--non-recursive") + "--targets" svn-status-temp-arg-file + "-F" svn-status-temp-file-to-remove + (when (eq svn-status-svn-file-coding-system 'utf-8) + '("--encoding" "UTF-8")) + svn-status-default-commit-arguments)) + (set-window-configuration svn-status-pre-commit-window-configuration) + (message "svn-log editing done"))) + +(defun svn-log-edit-svn-diff (arg) + "Show the diff we are about to commit. +If ARG then show diff between some other version of the selected files." + (interactive "P") + (set-buffer svn-status-buffer-name) ; TODO: is this necessary? + ;; This call is very much like `svn-status-show-svn-diff-for-marked-files' + ;; but uses commit-specific variables instead of the current marks. + (svn-status-show-svn-diff-internal svn-status-files-to-commit + svn-status-recursive-commit + (if arg :ask "BASE"))) + +(defun svn-log-edit-svn-log (arg) + (interactive "P") + (set-buffer svn-status-buffer-name) + (svn-status-show-svn-log arg)) + +(defun svn-log-edit-svn-status () + (interactive) + (pop-to-buffer svn-status-buffer-name) + (other-window 1)) + +(defun svn-log-edit-files-to-commit () + (mapcar 'svn-status-line-info->filename svn-status-files-to-commit)) + +(defun svn-log-edit-show-files-to-commit () + (interactive) + (message "Files to commit%s: %S" + (if svn-status-recursive-commit " recursively" "") + (svn-log-edit-files-to-commit))) + +(defun svn-log-edit-save-message () + "Save the current log message to the file `svn-log-edit-file-name'." + (interactive) + (let ((log-edit-file-name (svn-log-edit-file-name))) + (if (string= buffer-file-name log-edit-file-name) + (save-buffer) + (write-region (point-min) (point-max) log-edit-file-name)))) + +(defun svn-log-edit-erase-edit-buffer () + "Delete everything in the `svn-log-edit-buffer-name' buffer." + (interactive) + (set-buffer svn-log-edit-buffer-name) + (erase-buffer)) + +(defun svn-log-edit-insert-files-to-commit () + (interactive) + (svn-log-edit-remove-comment-lines) + (let ((buf-size (- (point-max) (point-min)))) + (save-excursion + (goto-char (point-min)) + (insert "## Lines starting with '## ' will be removed from the log message.\n") + (insert "## File(s) to commit" + (if svn-status-recursive-commit " recursively" "") ":\n") + (let ((file-list svn-status-files-to-commit)) + (while file-list + (insert (concat "## " (svn-status-line-info->filename (car file-list)) "\n")) + (setq file-list (cdr file-list))))) + (when (= 0 buf-size) + (goto-char (point-max))))) + +(defun svn-log-edit-remove-comment-lines () + (interactive) + (save-excursion + (goto-char (point-min)) + (flush-lines "^## .*"))) + +(defun svn-file-add-to-changelog (prefix-arg) + "Create a changelog entry for the function at point. +The variable `svn-status-changelog-style' allows to select the used changlog style" + (interactive "P") + (cond ((eq svn-status-changelog-style 'changelog) + (svn-file-add-to-log-changelog-style prefix-arg)) + ((eq svn-status-changelog-style 'svn-dev) + (svn-file-add-to-log-svn-dev-style prefix-arg)) + ((fboundp svn-status-changelog-style) + (funcall svn-status-changelog-style prefix-arg)) + (t + (error "Invalid setting for `svn-status-changelog-style'")))) + +(defun svn-file-add-to-log-changelog-style (curdir) + "Create a changelog entry for the function at point. +`add-change-log-entry-other-window' creates the header information. +If CURDIR, save the log file in the current directory, otherwise in the base directory of this working copy." + (interactive "P") + (add-change-log-entry-other-window nil (svn-log-edit-file-name curdir)) + (svn-log-edit-mode)) + +;; taken from svn-dev.el: svn-log-path-derive +(defun svn-dev-log-path-derive (path) + "Derive a relative directory path for absolute PATH, for a log entry." + (save-match-data + (let ((base (file-name-nondirectory path)) + (chop-spot (string-match + "\\(code/\\)\\|\\(src/\\)\\|\\(projects/\\)" + path))) + (if chop-spot + (progn + (setq path (substring path (match-end 0))) + ;; Kluge for Subversion developers. + (if (string-match "subversion/" path) + (substring path (+ (match-beginning 0) 11)) + path)) + (string-match (expand-file-name "~/") path) + (substring path (match-end 0)))))) + +;; taken from svn-dev.el: svn-log-message +(defun svn-file-add-to-log-svn-dev-style (prefix-arg) + "Add to an in-progress log message, based on context around point. +If PREFIX-ARG is negative, then use basenames only in +log messages, otherwise use full paths. The current defun name is +always used. + +If PREFIX-ARG is a list (e.g. by using C-u), save the log file in +the current directory, otherwise in the base directory of this +working copy. + +If the log message already contains material about this defun, then put +point there, so adding to that material is easy. + +Else if the log message already contains material about this file, put +point there, and push onto the kill ring the defun name with log +message dressing around it, plus the raw defun name, so yank and +yank-next are both useful. + +Else if there is no material about this defun nor file anywhere in the +log message, then put point at the end of the message and insert a new +entry for file with defun. +" + (interactive "P") + (let* ((short-file-names (and (numberp prefix-arg) (< prefix-arg 0))) + (curdir (listp prefix-arg)) + (this-file (if short-file-names + (file-name-nondirectory buffer-file-name) + (svn-dev-log-path-derive buffer-file-name))) + (this-defun (or (add-log-current-defun) + (save-excursion + (save-match-data + (if (eq major-mode 'c-mode) + (progn + (if (fboundp 'c-beginning-of-statement-1) + (c-beginning-of-statement-1) + (c-beginning-of-statement)) + (search-forward "(" nil t) + (forward-char -1) + (forward-sexp -1) + (buffer-substring + (point) + (progn (forward-sexp 1) (point))))))))) + (log-file (svn-log-edit-file-name curdir))) + (find-file log-file) + (goto-char (point-min)) + ;; Strip text properties from strings + (set-text-properties 0 (length this-file) nil this-file) + (set-text-properties 0 (length this-defun) nil this-defun) + ;; If log message for defun already in progress, add to it + (if (and + this-defun ;; we have a defun to work with + (search-forward this-defun nil t) ;; it's in the log msg already + (save-excursion ;; and it's about the same file + (save-match-data + (if (re-search-backward ; Ick, I want a real filename regexp! + "^\\*\\s-+\\([a-zA-Z0-9-_.@=+^$/%!?(){}<>]+\\)" nil t) + (string-equal (match-string 1) this-file) + t)))) + (if (re-search-forward ":" nil t) + (if (looking-at " ") (forward-char 1))) + ;; Else no log message for this defun in progress... + (goto-char (point-min)) + ;; But if log message for file already in progress, add to it. + (if (search-forward this-file nil t) + (progn + (if this-defun (progn + (kill-new (format "(%s): " this-defun)) + (kill-new this-defun))) + (search-forward ")" nil t) + (if (looking-at " ") (forward-char 1))) + ;; Found neither defun nor its file, so create new entry. + (goto-char (point-max)) + (if (not (bolp)) (insert "\n")) + (insert (format "\n* %s (%s): " this-file (or this-defun ""))) + ;; Finally, if no derived defun, put point where the user can + ;; type it themselves. + (if (not this-defun) (forward-char -3)))))) + +;; -------------------------------------------------------------------------------- +;; svn-log-view-mode: +;; -------------------------------------------------------------------------------- + +(defvar svn-log-view-mode-map () "Keymap used in `svn-log-view-mode' buffers.") +(put 'svn-log-view-mode-map 'risky-local-variable t) ;for Emacs 20.7 + +(when (not svn-log-view-mode-map) + (setq svn-log-view-mode-map (make-sparse-keymap)) + (suppress-keymap svn-log-view-mode-map) + (define-key svn-log-view-mode-map (kbd "p") 'svn-log-view-prev) + (define-key svn-log-view-mode-map (kbd "n") 'svn-log-view-next) + (define-key svn-log-view-mode-map (kbd "~") 'svn-log-get-specific-revision) + (define-key svn-log-view-mode-map (kbd "E") 'svn-log-ediff-specific-revision) + (define-key svn-log-view-mode-map (kbd "=") 'svn-log-view-diff) + (define-key svn-log-view-mode-map (kbd "RET") 'svn-log-find-file-at-point) + (define-key svn-log-view-mode-map (kbd "e") 'svn-log-edit-log-entry) + (define-key svn-log-view-mode-map (kbd "q") 'bury-buffer)) + +(defvar svn-log-view-popup-menu-map () + "Keymap used to show popup menu in `svn-log-view-mode' buffers.") +(put 'svn-log-view-popup-menu-map 'risky-local-variable t) ;for Emacs 20.7 +(when (not svn-log-view-popup-menu-map) + (setq svn-log-view-popup-menu-map (make-sparse-keymap)) + (suppress-keymap svn-log-view-popup-menu-map) + (define-key svn-log-view-popup-menu-map [down-mouse-3] 'svn-log-view-popup-menu)) + +(easy-menu-define svn-log-view-mode-menu svn-log-view-mode-map +"'svn-log-view-mode' menu" + '("SVN-LogView" + ["Show Changeset" svn-log-view-diff t] + ["Ediff file at point" svn-log-ediff-specific-revision t] + ["Find file at point" svn-log-find-file-at-point t] + ["Edit log message" svn-log-edit-log-entry t])) + +(defun svn-log-view-popup-menu (event) + (interactive "e") + (mouse-set-point event) + (let* ((rev (svn-log-revision-at-point))) + (when rev + (svn-status-face-set-temporary-during-popup + 'svn-status-marked-popup-face (svn-point-at-bol) (svn-point-at-eol) + svn-log-view-mode-menu)))) + +(defvar svn-log-view-font-lock-keywords + '(("^r[0-9]+ .+" (0 `(face + font-lock-keyword-face + mouse-face + highlight + keymap ,svn-log-view-popup-menu-map)))) + "Keywords in svn-log-view-mode.") +(put 'svn-log-view-font-lock-keywords 'risky-local-variable t) ;for Emacs 20.7 + +(define-derived-mode svn-log-view-mode fundamental-mode "svn-log-view" + "Major Mode to show the output from svn log. +Commands: +\\{svn-log-view-mode-map} +" + (use-local-map svn-log-view-mode-map) + (easy-menu-add svn-log-view-mode-menu) + (set (make-local-variable 'font-lock-defaults) '(svn-log-view-font-lock-keywords t))) + +(defun svn-log-view-next () + (interactive) + (when (re-search-forward "^r[0-9]+" nil t) + (beginning-of-line 2) + (unless (looking-at "Changed paths:") + (beginning-of-line 1)))) + +(defun svn-log-view-prev () + (interactive) + (when (re-search-backward "^r[0-9]+" nil t 2) + (beginning-of-line 2) + (unless (looking-at "Changed paths:") + (beginning-of-line 1)))) + +(defun svn-log-revision-at-point () + (save-excursion + (end-of-line) + (re-search-backward "^r\\([0-9]+\\)") + (svn-match-string-no-properties 1))) + +(defun svn-log-file-name-at-point (respect-checkout-prefix-path) + (let ((full-file-name) + (file-name) + (checkout-prefix-path (when respect-checkout-prefix-path (svn-status-checkout-prefix-path)))) + (save-excursion + (beginning-of-line) + (when (looking-at " [MA] /\\(.+\\)$") + (setq full-file-name (svn-match-string-no-properties 1)))) + (when (string= checkout-prefix-path "") + (setq checkout-prefix-path "/")) + (setq file-name + (if (eq (string-match (regexp-quote (substring checkout-prefix-path 1)) full-file-name) 0) + (substring full-file-name (- (length checkout-prefix-path) (if (string= checkout-prefix-path "/") 1 0))) + full-file-name)) + ;; (message "svn-log-file-name-at-point %s prefix: '%s', full-file-name: %s" file-name checkout-prefix-path full-file-name) + file-name)) + +(defun svn-log-find-file-at-point () + (interactive) + (let ((file-name (svn-log-file-name-at-point t))) + (when file-name + (let ((default-directory (svn-status-base-dir))) + ;;(message "svn-log-file-name-at-point: %s, default-directory: %s" file-name default-directory) + (find-file file-name))))) + +(defun svn-log-view-diff (arg) + "Show the changeset for a given log entry. +When called with a prefix argument, ask the user for the revision." + (interactive "P") + (svn-status-diff-show-changeset (svn-log-revision-at-point) arg)) + +(defun svn-log-get-specific-revision () + "Get an older revision of the file at point via svn cat." + (interactive) + ;; (message "%S" (svn-status-make-line-info (svn-log-file-name-at-point t))) + (let ((default-directory (svn-status-base-dir))) + (svn-status-get-specific-revision-internal + (list (svn-status-make-line-info (svn-log-file-name-at-point nil))) + (svn-log-revision-at-point)))) + +(defun svn-log-ediff-specific-revision () + "Call ediff for the file at point to view a changeset" + (interactive) + ;; (message "svn-log-ediff-specific-revision: %s" (svn-log-file-name-at-point t)) + (let* ((cur-buf (current-buffer)) + (upper-rev (svn-log-revision-at-point)) + (lower-rev (number-to-string (- (string-to-number upper-rev) 1))) + (file-name (svn-log-file-name-at-point t)) + (default-directory (svn-status-base-dir)) + (upper-rev-file-name (when file-name + (cdar (svn-status-get-specific-revision-internal + (list (svn-status-make-line-info file-name)) upper-rev)))) + (lower-rev-file-name (when file-name + (cdar (svn-status-get-specific-revision-internal + (list (svn-status-make-line-info file-name)) lower-rev))))) + ;;(message "%S %S" upper-rev-file-name lower-rev-file-name) + (if file-name + (let* ((ediff-after-quit-destination-buffer cur-buf) + (newer-buffer (find-file-noselect upper-rev-file-name)) + (base-buff (find-file-noselect lower-rev-file-name)) + (svn-transient-buffers (list base-buff newer-buffer)) + (startup-hook '(svn-ediff-startup-hook))) + (ediff-buffers base-buff newer-buffer startup-hook)) + (message "No file at point")))) + +(defun svn-log-edit-log-entry () + "Edit the given log entry." + (interactive) + (let ((rev (svn-log-revision-at-point)) + (log-message)) + (svn-run nil t 'propget-parse "propget" "--revprop" (concat "-r" rev) "svn:log") + (save-excursion + (set-buffer svn-process-buffer-name) + (setq log-message (if (> (point-max) 1) + (buffer-substring (point-min) (- (point-max) 1)) + ""))) + (svn-status-pop-to-commit-buffer) + ;; If the buffer has been narrowed, `svn-log-edit-done' will use + ;; only the accessible part. So we need not erase the rest here. + (delete-region (point-min) (point-max)) + (insert log-message) + (goto-char (point-min)) + (setq svn-log-edit-update-log-entry rev))) + +;; -------------------------------------------------------------------------------- +;; svn-info-mode +;; -------------------------------------------------------------------------------- +(defvar svn-info-mode-map () "Keymap used in `svn-info-mode' buffers.") +(put 'svn-info-mode-map 'risky-local-variable t) ;for Emacs 20.7 + +(when (not svn-info-mode-map) + (setq svn-info-mode-map (make-sparse-keymap)) + (define-key svn-info-mode-map [?s] 'svn-status-pop-to-status-buffer) + (define-key svn-info-mode-map (kbd "h") 'svn-status-pop-to-partner-buffer) + (define-key svn-info-mode-map (kbd "n") 'next-line) + (define-key svn-info-mode-map (kbd "p") 'previous-line) + (define-key svn-info-mode-map (kbd "RET") 'svn-info-show-context) + (define-key svn-info-mode-map [?q] 'bury-buffer)) + +(defun svn-info-mode () + "Major Mode to view informative output from svn." + (interactive) + (kill-all-local-variables) + (use-local-map svn-info-mode-map) + (setq major-mode 'svn-info-mode) + (setq mode-name "svn-info") + (toggle-read-only 1)) + +(defun svn-info-show-context () + "Show the context for a line in the info buffer. +Currently is the output from the svn update command known." + (interactive) + (cond ((save-excursion + (goto-char (point-max)) + (forward-line -1) + (beginning-of-line) + (looking-at "Updated to revision")) + ;; svn-info contains info from an svn update + (let ((cur-pos (point)) + (file-name (buffer-substring-no-properties + (progn (beginning-of-line) (re-search-forward ".. +") (point)) + (line-end-position))) + (pos)) + (goto-char cur-pos) + (with-current-buffer svn-status-buffer-name + (setq pos (svn-status-get-file-name-buffer-position file-name))) + (when pos + (svn-status-pop-to-new-partner-buffer svn-status-buffer-name) + (goto-char pos)))))) + +;; -------------------------------------------------------------------------------- +;; svn blame minor mode +;; -------------------------------------------------------------------------------- + +(unless (assq 'svn-blame-mode minor-mode-alist) + (setq minor-mode-alist + (cons (list 'svn-blame-mode " SvnBlame") + minor-mode-alist))) + +(defvar svn-blame-mode-map () "Keymap used in `svn-blame-mode' buffers.") +(put 'svn-blame-mode-map 'risky-local-variable t) ;for Emacs 20.7 + +(when (not svn-blame-mode-map) + (setq svn-blame-mode-map (make-sparse-keymap)) + (define-key svn-blame-mode-map [?s] 'svn-status-pop-to-status-buffer) + (define-key svn-blame-mode-map (kbd "n") 'next-line) + (define-key svn-blame-mode-map (kbd "p") 'previous-line) + (define-key svn-blame-mode-map (kbd "RET") 'svn-blame-open-source-file) + (define-key svn-blame-mode-map (kbd "a") 'svn-blame-highlight-author) + (define-key svn-blame-mode-map (kbd "r") 'svn-blame-highlight-revision) + (define-key svn-blame-mode-map (kbd "=") 'svn-blame-show-changeset) + (define-key svn-blame-mode-map [?q] 'bury-buffer)) + +(easy-menu-define svn-blame-mode-menu svn-blame-mode-map +"svn blame minor mode menu" + '("SvnBlame" + ["Jump to source location" svn-blame-open-source-file t] + ["Show changeset" svn-blame-show-changeset t] + ["Highlight by author" svn-blame-highlight-author t] + ["Highlight by revision" svn-blame-highlight-revision t])) + +(or (assq 'svn-blame-mode minor-mode-map-alist) + (setq minor-mode-map-alist + (cons (cons 'svn-blame-mode svn-blame-mode-map) minor-mode-map-alist))) + +(make-variable-buffer-local 'svn-blame-mode) + +(defun svn-blame-mode (&optional arg) + "Toggle svn blame minor mode. +With ARG, turn svn blame minor mode on if ARG is positive, off otherwise. + +Note: This mode does not yet work on XEmacs... +It is probably because the revisions are in 'before-string properties of overlays + +Key bindings: +\\{svn-blame-mode-map}" + (interactive "P") + (setq svn-blame-mode (if (null arg) + (not svn-blame-mode) + (> (prefix-numeric-value arg) 0))) + (if svn-blame-mode + (progn + (easy-menu-add svn-blame-mode-menu) + (toggle-read-only 1)) + (easy-menu-remove svn-blame-mode-menu)) + (force-mode-line-update)) + +(defun svn-status-activate-blame-mode () + "Activate the svn blame minor in the current buffer. +The current buffer must contain a valid output from svn blame" + (save-excursion + (goto-char (point-min)) + (let ((buffer-read-only nil) + (line (svn-line-number-at-pos)) + (limit (point-max)) + (info-end-col (save-excursion (forward-word 2) (+ (current-column) 1))) + (s) + ov) + ;; remove the old overlays (only for testing) + ;; (dolist (ov (overlays-in (point) limit)) + ;; (when (overlay-get ov 'svn-blame-line-info) + ;; (delete-overlay ov))) + (while (and (not (eobp)) (< (point) limit)) + (setq ov (make-overlay (point) (point))) + (overlay-put ov 'svn-blame-line-info t) + (setq s (buffer-substring-no-properties (svn-point-at-bol) (+ (svn-point-at-bol) info-end-col))) + (overlay-put ov 'before-string (propertize s 'face 'svn-status-blame-rev-number-face)) + (overlay-put ov 'rev-info (delete "" (split-string s " "))) + (delete-region (svn-point-at-bol) (+ (svn-point-at-bol) info-end-col)) + (forward-line) + (setq line (1+ line))))) + (let* ((buf-name (format "*svn-blame: %s*" (file-relative-name svn-status-blame-file-name))) + (buffer (get-buffer buf-name))) + (when buffer + (kill-buffer buffer)) + (rename-buffer buf-name)) + ;; use the correct mode for the displayed blame output + (let ((buffer-file-name svn-status-blame-file-name)) + (normal-mode) + (set (make-local-variable 'svn-status-blame-file-name) svn-status-blame-file-name)) + (font-lock-fontify-buffer) + (svn-blame-mode 1)) + +(defun svn-blame-open-source-file () + "Jump to the source file location for the current position in the svn blame buffer" + (interactive) + (let ((src-line-number (svn-line-number-at-pos)) + (src-line-col (current-column))) + (find-file-other-window svn-status-blame-file-name) + (goto-line src-line-number) + (forward-char src-line-col))) + +(defun svn-blame-show-changeset (arg) + "Show a diff for the revision at point. +When called with a prefix argument, allow the user to edit the revision." + (interactive "P") + (let ((rev)) + (dolist (ov (overlays-in (svn-point-at-bol) (line-end-position))) + (when (overlay-get ov 'svn-blame-line-info) + (setq rev (car (overlay-get ov 'rev-info))))) + (svn-status-diff-show-changeset rev arg))) + +(defun svn-blame-highlight-line-maybe (compare-func) + (let ((reference-value) + (is-highlighted) + (consider-this-line) + (hl-ov)) + (dolist (ov (overlays-in (svn-point-at-bol) (line-end-position))) + (when (overlay-get ov 'svn-blame-line-info) + (setq reference-value (funcall compare-func ov))) + (when (overlay-get ov 'svn-blame-highlighted) + (setq is-highlighted t))) + (save-excursion + (goto-char (point-min)) + (while (not (eobp)) + (setq consider-this-line nil) + (dolist (ov (overlays-in (svn-point-at-bol) (line-end-position))) + (when (overlay-get ov 'svn-blame-line-info) + (when (string= reference-value (funcall compare-func ov)) + (setq consider-this-line t)))) + (when consider-this-line + (dolist (ov (overlays-in (svn-point-at-bol) (line-end-position))) + (when (and (overlay-get ov 'svn-blame-highlighted) is-highlighted) + (delete-overlay ov)) + (unless is-highlighted + (setq hl-ov (make-overlay (svn-point-at-bol) (line-end-position))) + (overlay-put hl-ov 'svn-blame-highlighted t) + (overlay-put hl-ov 'face 'svn-status-blame-highlight-face)))) + (forward-line))))) + +(defun svn-blame-highlight-author-field (ov) + (cadr (overlay-get ov 'rev-info))) + +(defun svn-blame-highlight-author () + "(Un)Highlight all lines with the same author." + (interactive) + (svn-blame-highlight-line-maybe 'svn-blame-highlight-author-field)) + +(defun svn-blame-highlight-revision-field (ov) + (car (overlay-get ov 'rev-info))) + +(defun svn-blame-highlight-revision () + "(Un)Highlight all lines with the same revision." + (interactive) + (svn-blame-highlight-line-maybe 'svn-blame-highlight-revision-field)) + +;; -------------------------------------------------------------------------------- +;; svn-process-mode +;; -------------------------------------------------------------------------------- +(defvar svn-process-mode-map () "Keymap used in `svn-process-mode' buffers.") +(put 'svn-process-mode-map 'risky-local-variable t) ;for Emacs 20.7 + +(when (not svn-process-mode-map) + (setq svn-process-mode-map (make-sparse-keymap)) + (define-key svn-process-mode-map (kbd "RET") 'svn-process-send-string-and-newline) + (define-key svn-process-mode-map [?s] 'svn-process-send-string) + (define-key svn-process-mode-map [?q] 'bury-buffer)) + +(easy-menu-define svn-process-mode-menu svn-process-mode-map +"'svn-process-mode' menu" + '("SvnProcess" + ["Send line to process" svn-process-send-string-and-newline t] + ["Send raw string to process" svn-process-send-string t] + ["Bury process buffer" bury-buffer t])) + +(defun svn-process-mode () + "Major Mode to view process output from svn. + +You can send a new line terminated string to the process via \\[svn-process-send-string-and-newline] +You can send raw data to the process via \\[svn-process-send-string]." + (interactive) + (kill-all-local-variables) + (use-local-map svn-process-mode-map) + (easy-menu-add svn-log-view-mode-menu) + (setq major-mode 'svn-process-mode) + (setq mode-name "svn-process")) + +;; -------------------------------------------------------------------------------- +;; svn status persistent options +;; -------------------------------------------------------------------------------- + +(defun svn-status-repo-for-path (directory) + "Find the repository root for DIRECTORY." + (let ((old-process-default-dir)) + (with-current-buffer (get-buffer-create svn-process-buffer-name) + (setq old-process-default-dir default-directory) + (setq default-directory directory)) ;; update the default-directory for the *svn-process* buffer + (svn-run nil t 'parse-info "info" ".") + (with-current-buffer svn-process-buffer-name + ;; (message "svn-status-repo-for-path: %s: default-directory: %s directory: %s old-process-default-dir: %s" svn-process-buffer-name default-directory directory old-process-default-dir) + (setq default-directory old-process-default-dir) + (goto-char (point-min)) + (let ((case-fold-search t)) + (if (search-forward "repository root: " nil t) + (buffer-substring-no-properties (point) (svn-point-at-eol)) + (when (search-forward "repository uuid: " nil t) + (message "psvn.el: Detected an old svn working copy in '%s'. Please check it out again to get a 'Repository Root' entry in the svn info output." + default-directory) + (concat "Svn Repo UUID: " (buffer-substring-no-properties (point) (svn-point-at-eol))))))))) + +(defun svn-status-base-dir (&optional start-directory) + "Find the svn root directory for the current working copy. +Return nil, if not in a svn working copy." + (let* ((start-dir (expand-file-name (or start-directory default-directory))) + (base-dir (gethash start-dir svn-status-base-dir-cache 'not-found))) + ;;(message "svn-status-base-dir: %S %S" start-dir base-dir) + (if (not (eq base-dir 'not-found)) + base-dir + ;; (message "calculating base-dir for %s" start-dir) + (unless svn-client-version + (svn-status-version)) + (let* ((base-dir start-dir) + (repository-root (svn-status-repo-for-path base-dir)) + (dot-svn-dir (concat base-dir (svn-wc-adm-dir-name))) + (in-tree (and repository-root (file-exists-p dot-svn-dir))) + (dir-below (expand-file-name base-dir))) + ;; (message "repository-root: %s start-dir: %s" repository-root start-dir) + (if (and (<= (car svn-client-version) 1) (< (cadr svn-client-version) 3)) + (setq base-dir (svn-status-base-dir-for-ancient-svn-client start-dir)) ;; svn version < 1.3 + (while (when (and dir-below (file-exists-p dot-svn-dir)) + (setq base-dir (file-name-directory dot-svn-dir)) + (string-match "\\(.+/\\).+/" dir-below) + (setq dir-below + (and (string-match "\\(.*/\\)[^/]+/" dir-below) + (match-string 1 dir-below))) + ;; (message "base-dir: %s, dir-below: %s, dot-svn-dir: %s in-tree: %s" base-dir dir-below dot-svn-dir in-tree) + (when dir-below + (if (string= (svn-status-repo-for-path dir-below) repository-root) + (setq dot-svn-dir (concat dir-below (svn-wc-adm-dir-name))) + (setq dir-below nil))))) + (setq base-dir (and in-tree base-dir))) + (svn-puthash start-dir base-dir svn-status-base-dir-cache) + (svn-status-message 7 "svn-status-base-dir %s => %s" start-dir base-dir) + base-dir)))) + +(defun svn-status-base-dir-for-ancient-svn-client (&optional start-directory) + "Find the svn root directory for the current working copy. +Return nil, if not in a svn working copy. +This function is used for svn clients version 1.2 and below." + (let* ((base-dir (expand-file-name (or start-directory default-directory))) + (dot-svn-dir (concat base-dir (svn-wc-adm-dir-name))) + (in-tree (file-exists-p dot-svn-dir)) + (dir-below (expand-file-name default-directory))) + (while (when (and dir-below (file-exists-p dot-svn-dir)) + (setq base-dir (file-name-directory dot-svn-dir)) + (string-match "\\(.+/\\).+/" dir-below) + (setq dir-below + (and (string-match "\\(.*/\\)[^/]+/" dir-below) + (match-string 1 dir-below))) + (setq dot-svn-dir (concat dir-below (svn-wc-adm-dir-name))))) + (and in-tree base-dir))) + +(defun svn-status-save-state () + "Save psvn persistent options for this working copy to a file." + (interactive) + (let ((buf (find-file (concat (svn-status-base-dir) "++psvn.state")))) + (erase-buffer) ;Widen, because we'll save the whole buffer. + ;; TO CHECK: why is svn-status-options a global variable?? + (setq svn-status-options + (list + (list "svn-trac-project-root" svn-trac-project-root) + (list "sort-status-buffer" svn-status-sort-status-buffer) + (list "elide-list" svn-status-elided-list) + (list "module-name" svn-status-module-name) + (list "branch-list" svn-status-branch-list) + (list "changelog-style" svn-status-changelog-style) + )) + (insert (pp-to-string svn-status-options)) + (save-buffer) + (kill-buffer buf))) + +(defun svn-status-load-state (&optional no-error) + "Load psvn persistent options for this working copy from a file." + (interactive) + (let ((file (concat (svn-status-base-dir) "++psvn.state"))) + (if (file-readable-p file) + (with-temp-buffer + (insert-file-contents file) + (setq svn-status-options (read (current-buffer))) + (setq svn-status-sort-status-buffer + (nth 1 (assoc "sort-status-buffer" svn-status-options))) + (setq svn-trac-project-root + (nth 1 (assoc "svn-trac-project-root" svn-status-options))) + (setq svn-status-elided-list + (nth 1 (assoc "elide-list" svn-status-options))) + (setq svn-status-module-name + (nth 1 (assoc "module-name" svn-status-options))) + (setq svn-status-branch-list + (nth 1 (assoc "branch-list" svn-status-options))) + (setq svn-status-changelog-style + (nth 1 (assoc "changelog-style" svn-status-options))) + (when (and (interactive-p) svn-status-elided-list (svn-status-apply-elide-list))) + (message "psvn.el: loaded %s" file)) + (if no-error + (setq svn-trac-project-root nil + svn-status-elided-list nil + svn-status-module-name nil + svn-status-branch-list nil + svn-status-changelog-style 'changelog) + (error "psvn.el: %s is not readable." file))))) + +(defun svn-status-toggle-sort-status-buffer () + "Toggle sorting of the *svn-status* buffer. + +If you turn off sorting, you can speed up \\[svn-status]. However, +the buffer is not correctly sorted then. This function will be +removed again, when a faster parsing and display routine for +`svn-status' is available." + (interactive) + (setq svn-status-sort-status-buffer (not svn-status-sort-status-buffer)) + (message "The %s buffer will %sbe sorted." svn-status-buffer-name + (if svn-status-sort-status-buffer "" "not "))) + +(defun svn-status-toggle-svn-verbose-flag () + "Toggle `svn-status-verbose'. " + (interactive) + (setq svn-status-verbose (not svn-status-verbose)) + (message "svn status calls will %suse the -v flag." (if svn-status-verbose "" "not "))) + +(defun svn-status-toggle-display-full-path () + "Toggle displaying the full path in the `svn-status-buffer-name' buffer" + (interactive) + (setq svn-status-display-full-path (not svn-status-display-full-path)) + (message "The %s buffer will%s use full path names." svn-status-buffer-name + (if svn-status-display-full-path "" " not")) + (svn-status-update-buffer)) + +(defun svn-status-set-trac-project-root () + (interactive) + (setq svn-trac-project-root + (read-string "Trac project root (e.g.: http://projects.edgewall.com/trac/): " + svn-trac-project-root)) + (when (yes-or-no-p "Save the new setting for svn-trac-project-root to disk? ") + (svn-status-save-state))) + +(defun svn-status-set-module-name () + "Interactively set `svn-status-module-name'." + (interactive) + (setq svn-status-module-name + (read-string "Short Unit Name (e.g.: MyProject): " + svn-status-module-name)) + (when (yes-or-no-p "Save the new setting for svn-status-module-name to disk? ") + (svn-status-save-state))) + +(defun svn-status-set-changelog-style () + "Interactively set `svn-status-changelog-style'." + (interactive) + (setq svn-status-changelog-style + (intern (funcall svn-status-completing-read-function "svn-status on directory: " '("changelog" "svn-dev" "other")))) + (when (string= svn-status-changelog-style 'other) + (setq svn-status-changelog-style (car (find-function-read)))) + (when (yes-or-no-p "Save the new setting for svn-status-changelog-style to disk? ") + (svn-status-save-state))) + +(defun svn-status-set-branch-list () + "Interactively set `svn-status-branch-list'." + (interactive) + (setq svn-status-branch-list + (split-string (read-string "Branch list: " + (mapconcat 'identity svn-status-branch-list " ")))) + (when (yes-or-no-p "Save the new setting for svn-status-branch-list to disk? ") + (svn-status-save-state))) + +(defun svn-browse-url (url) + "Call `browse-url', using `svn-browse-url-function'." + (let ((browse-url-browser-function (or svn-browse-url-function + browse-url-browser-function))) + (browse-url url))) + +;; -------------------------------------------------------------------------------- +;; svn status trac integration +;; -------------------------------------------------------------------------------- +(defun svn-trac-browse-wiki () + "Open the trac wiki view for the current svn repository." + (interactive) + (unless svn-trac-project-root + (svn-status-set-trac-project-root)) + (svn-browse-url (concat svn-trac-project-root "wiki"))) + +(defun svn-trac-browse-timeline () + "Open the trac timeline view for the current svn repository." + (interactive) + (unless svn-trac-project-root + (svn-status-set-trac-project-root)) + (svn-browse-url (concat svn-trac-project-root "timeline"))) + +(defun svn-trac-browse-roadmap () + "Open the trac roadmap view for the current svn repository." + (interactive) + (unless svn-trac-project-root + (svn-status-set-trac-project-root)) + (svn-browse-url (concat svn-trac-project-root "roadmap"))) + +(defun svn-trac-browse-source () + "Open the trac source browser for the current svn repository." + (interactive) + (unless svn-trac-project-root + (svn-status-set-trac-project-root)) + (svn-browse-url (concat svn-trac-project-root "browser"))) + +(defun svn-trac-browse-report (arg) + "Open the trac report view for the current svn repository. +When called with a prefix argument, display the given report number." + (interactive "P") + (unless svn-trac-project-root + (svn-status-set-trac-project-root)) + (svn-browse-url (concat svn-trac-project-root "report" (if (numberp arg) (format "/%s" arg) "")))) + +(defun svn-trac-browse-changeset (changeset-nr) + "Show a changeset in the trac issue tracker." + (interactive (list (read-number "Browse changeset number: " (number-at-point)))) + (unless svn-trac-project-root + (svn-status-set-trac-project-root)) + (svn-browse-url (concat svn-trac-project-root "changeset/" (number-to-string changeset-nr)))) + +(defun svn-trac-browse-ticket (ticket-nr) + "Show a ticket in the trac issue tracker." + (interactive (list (read-number "Browse ticket number: " (number-at-point)))) + (unless svn-trac-project-root + (svn-status-set-trac-project-root)) + (svn-browse-url (concat svn-trac-project-root "ticket/" (number-to-string ticket-nr)))) + +;;;------------------------------------------------------------ +;;; resolve conflicts using ediff +;;;------------------------------------------------------------ +(defun svn-resolve-conflicts-ediff (&optional name-A name-B) + "Invoke ediff to resolve conflicts in the current buffer. +The conflicts must be marked with rcsmerge conflict markers." + (interactive) + (let* ((found nil) + (file-name (file-name-nondirectory buffer-file-name)) + (your-buffer (generate-new-buffer + (concat "*" file-name + " " (or name-A "WORKFILE") "*"))) + (other-buffer (generate-new-buffer + (concat "*" file-name + " " (or name-B "CHECKED-IN") "*"))) + (result-buffer (current-buffer))) + (save-excursion + (set-buffer your-buffer) + (erase-buffer) + (insert-buffer-substring result-buffer) + (goto-char (point-min)) + (while (re-search-forward "^<<<<<<< .\\(mine\\|working\\)\n" nil t) + (setq found t) + (replace-match "") + (if (not (re-search-forward "^=======\n" nil t)) + (error "Malformed conflict marker")) + (replace-match "") + (let ((start (point))) + (if (not (re-search-forward "^>>>>>>> .\\(r[0-9]+\\|merge.*\\)\n" nil t)) + (error "Malformed conflict marker")) + (delete-region start (point)))) + (if (not found) + (progn + (kill-buffer your-buffer) + (kill-buffer other-buffer) + (error "No conflict markers found"))) + (set-buffer other-buffer) + (erase-buffer) + (insert-buffer-substring result-buffer) + (goto-char (point-min)) + (while (re-search-forward "^<<<<<<< .\\(mine\\|working\\)\n" nil t) + (let ((start (match-beginning 0))) + (if (not (re-search-forward "^=======\n" nil t)) + (error "Malformed conflict marker")) + (delete-region start (point)) + (if (not (re-search-forward "^>>>>>>> .\\(r[0-9]+\\|merge.*\\)\n" nil t)) + (error "Malformed conflict marker")) + (replace-match ""))) + (let ((config (current-window-configuration)) + (ediff-default-variant 'default-B)) + + ;; Fire up ediff. + + (set-buffer (ediff-merge-buffers your-buffer other-buffer)) + + ;; Ediff is now set up, and we are in the control buffer. + ;; Do a few further adjustments and take precautions for exit. + + (make-local-variable 'svn-ediff-windows) + (setq svn-ediff-windows config) + (make-local-variable 'svn-ediff-result) + (setq svn-ediff-result result-buffer) + (make-local-variable 'ediff-quit-hook) + (setq ediff-quit-hook + (lambda () + (let ((buffer-A ediff-buffer-A) + (buffer-B ediff-buffer-B) + (buffer-C ediff-buffer-C) + (result svn-ediff-result) + (windows svn-ediff-windows)) + (ediff-cleanup-mess) + (set-buffer result) + (erase-buffer) + (insert-buffer-substring buffer-C) + (kill-buffer buffer-A) + (kill-buffer buffer-B) + (kill-buffer buffer-C) + (set-window-configuration windows) + (message "Conflict resolution finished; you may save the buffer")))) + (message "Please resolve conflicts now; exit ediff when done") + nil)))) + +(defun svn-resolve-conflicts (filename) + (let ((buff (find-file-noselect filename))) + (if buff + (progn (switch-to-buffer buff) + (svn-resolve-conflicts-ediff)) + (error "can not open file %s" filename)))) + +(defun svn-status-resolve-conflicts () + "Resolve conflict in the selected file" + (interactive) + (let ((file-info (svn-status-get-line-information))) + (or (and file-info + (= ?C (svn-status-line-info->filemark file-info)) + (svn-resolve-conflicts + (svn-status-line-info->full-path file-info))) + (error "can not resolve conflicts at this point")))) + + +;; -------------------------------------------------------------------------------- +;; Working with branches +;; -------------------------------------------------------------------------------- + +(defun svn-branch-select (&optional prompt) + "Select a branch interactively from `svn-status-branch-list'" + (interactive) + (unless prompt + (setq prompt "Select branch: ")) + (let* ((branch (funcall svn-status-completing-read-function prompt svn-status-branch-list)) + (directory) + (base-url)) + (when (string-match "#\\(1#\\)?\\(.+\\)" branch) + (setq directory (match-string 2 branch)) + (setq base-url (concat (svn-status-base-info->repository-root) "/" directory)) + (save-match-data + (svn-status-parse-info t)) + (if (eq (length (match-string 1 branch)) 0) + (setq branch base-url) + (let ((svn-status-branch-list (svn-status-ls base-url t))) + (setq branch (concat (svn-status-base-info->repository-root) "/" + directory "/" + (svn-branch-select (format "Select branch from '%s': " directory))))))) + branch)) + +(defun svn-branch-diff (branch1 branch2) + "Show the diff between two svn repository urls. +When called interactively, use `svn-branch-select' to choose two branches from `svn-status-branch-list'." + (interactive + (let* ((branch1 (svn-branch-select "svn diff branch1: ")) + (branch2 (svn-branch-select (format "svn diff %s against: " branch1)))) + (list branch1 branch2))) + (svn-run t t 'diff "diff" svn-status-default-diff-arguments branch1 branch2)) + +;; -------------------------------------------------------------------------------- +;; svnadmin interface +;; -------------------------------------------------------------------------------- +(defun svn-admin-create (dir) + "Run svnadmin create DIR." + (interactive (list (expand-file-name + (svn-read-directory-name "Create a svn repository at: " + svn-admin-default-create-directory nil nil)))) + (shell-command-to-string (concat "svnadmin create " dir)) + (setq svn-admin-last-repository-dir (concat "file://" dir)) + (message "Svn repository created at %s" dir) + (run-hooks 'svn-admin-create-hook)) + +;; - Import an empty directory +;; cd to an empty directory +;; svn import -m "Initial import" . file:///home/stefan/svn_repos/WaldiConfig/trunk +(defun svn-admin-create-trunk-directory () + "Import an empty trunk directory to `svn-admin-last-repository-dir'. +Set `svn-admin-last-repository-dir' to the new created trunk url." + (interactive) + (let ((empty-temp-dir-name (make-temp-name svn-status-temp-dir))) + (make-directory empty-temp-dir-name t) + (setq svn-admin-last-repository-dir (concat svn-admin-last-repository-dir "/trunk")) + (svn-run nil t 'import "import" "-m" "Created trunk directory" + empty-temp-dir-name svn-admin-last-repository-dir) + (delete-directory empty-temp-dir-name))) + +(defun svn-admin-start-import () + "Start to import the current working directory in a subversion repository. +The user is asked to perform the following two steps: +1. Create a local repository +2. Add a trunk directory to that repository + +After that step the empty base directory (either the root directory or +the trunk directory of the selected repository) is checked out in the current +working directory." + (interactive) + (if (y-or-n-p "Create local repository? ") + (progn + (call-interactively 'svn-admin-create) + (when (y-or-n-p "Add a trunk directory? ") + (svn-admin-create-trunk-directory))) + (setq svn-admin-last-repository-dir (read-string "Repository Url: "))) + (svn-checkout svn-admin-last-repository-dir ".")) + +;; -------------------------------------------------------------------------------- +;; svn status profiling +;; -------------------------------------------------------------------------------- +;;; Note about profiling psvn: +;; (load-library "elp") +;; M-x elp-reset-all +;; (elp-instrument-package "svn-") +;; M-x svn-status +;; M-x elp-results + +(defun svn-status-elp-init () + (interactive) + (require 'elp) + (elp-reset-all) + (elp-instrument-package "svn-") + (message "Run the desired svn command (e.g. M-x svn-status), then use M-x elp-results.")) + +(defun svn-status-last-commands (&optional string-prefix) + "Return a string with the last executed svn commands" + (interactive) + (unless string-prefix + (setq string-prefix "")) + (with-output-to-string + (dolist (e (ring-elements svn-last-cmd-ring)) + (princ (format "%s%s: svn %s <%s>\n" string-prefix (nth 0 e) (mapconcat 'concat (nth 1 e) " ") (nth 2 e)))))) + +;; -------------------------------------------------------------------------------- +;; reporting bugs +;; -------------------------------------------------------------------------------- +(defun svn-insert-indented-lines (text) + "Helper function to insert TEXT, indented by two characters." + (dolist (line (split-string text "\n")) + (insert (format " %s\n" line)))) + +(defun svn-prepare-bug-report () + "Create the buffer *psvn-bug-report*. This buffer can be useful to debug problems with psvn.el" + (interactive) + (let* ((last-output-buffer-name (or svn-status-last-output-buffer-name "*svn-process*")) + (last-svn-cmd-output (with-current-buffer last-output-buffer-name + (buffer-substring-no-properties (point-min) (point-max))))) + (switch-to-buffer "*psvn-bug-report*") + (delete-region (point-min) (point-max)) + (insert "This buffer holds some debug informations for psvn.el\n") + (insert "Please enter a description of the observed and the wanted behaviour\n") + (insert "and send it to the author (stefan@xsteve.at) to allow easier debugging\n\n") + (insert "Revisions:\n") + (svn-insert-indented-lines (svn-status-version)) + (insert "Language environment:\n") + (dolist (elem (svn-process-environment)) + (when (member (car (split-string elem "=")) '("LC_MESSAGES" "LC_ALL" "LANG")) + (insert (format " %s\n" elem)))) + (insert "\nLast svn commands:\n") + (svn-insert-indented-lines (svn-status-last-commands)) + (insert (format "\nContent of the <%s> buffer:\n" last-output-buffer-name)) + (svn-insert-indented-lines last-svn-cmd-output) + (goto-char (point-min)))) + +;; -------------------------------------------------------------------------------- +;; Make it easier to reload psvn, if a distribution has an older version +;; Just add the following to your .emacs: +;; (svn-prepare-for-reload) +;; (load "/path/to/psvn.el") + +;; Note the above will only work, if the loaded psvn.el has already the +;; function svn-prepare-for-reload +;; If this is not the case, do the following: +;; (load "/path/to/psvn.el");;make svn-prepare-for-reload available +;; (svn-prepare-for-reload) +;; (load "/path/to/psvn.el");; update the keybindings +;; -------------------------------------------------------------------------------- + +(defvar svn-prepare-for-reload-dont-touch-list '() "A list of variables that should not be touched by `svn-prepare-for-reload'") +(defvar svn-prepare-for-reload-variables-list '(svn-global-keymap svn-status-diff-mode-map svn-global-trac-map svn-status-mode-map + svn-status-mode-property-map svn-status-mode-extension-map + svn-status-mode-options-map svn-status-mode-trac-map svn-status-mode-branch-map + svn-log-edit-mode-map svn-log-view-mode-map + svn-log-view-popup-menu-map svn-info-mode-map svn-blame-mode-map svn-process-mode-map) + "A list of variables that should be set to nil via M-x `svn-prepare-for-reload'") +(defun svn-prepare-for-reload () + "This function resets some psvn.el variables to nil. +It makes reloading a newer version of psvn.el easier, if for example the used +GNU/Linux distribution uses an older version. + +The variables specified in `svn-prepare-for-reload-variables-list' will be reseted by this function. + +A variable will keep its value, if it is specified in `svn-prepare-for-reload-dont-touch-list'." + (interactive) + (dolist (var svn-prepare-for-reload-variables-list) + (unless (member var svn-prepare-for-reload-dont-touch-list) + (message (format "Resetting value of %s to nil" var))) + (set var nil))) + +(provide 'psvn) + +;; Local Variables: +;; indent-tabs-mode: nil +;; End: +;;; psvn.el ends here diff --git a/emacs.d/rails/.svn/README.txt b/emacs.d/rails/.svn/README.txt new file mode 100644 index 0000000..271a8ce --- /dev/null +++ b/emacs.d/rails/.svn/README.txt @@ -0,0 +1,2 @@ +This is a Subversion working copy administrative directory. +Visit http://subversion.tigris.org/ for more information. diff --git a/emacs.d/rails/.svn/dir-prop-base b/emacs.d/rails/.svn/dir-prop-base new file mode 100644 index 0000000..7c318ae --- /dev/null +++ b/emacs.d/rails/.svn/dir-prop-base @@ -0,0 +1,7 @@ +K 10 +svn:ignore +V 20 +*.elc +rails-test.el + +END diff --git a/emacs.d/rails/.svn/dir-props b/emacs.d/rails/.svn/dir-props new file mode 100644 index 0000000..7c318ae --- /dev/null +++ b/emacs.d/rails/.svn/dir-props @@ -0,0 +1,7 @@ +K 10 +svn:ignore +V 20 +*.elc +rails-test.el + +END diff --git a/emacs.d/rails/.svn/empty-file b/emacs.d/rails/.svn/empty-file new file mode 100644 index 0000000..e69de29 diff --git a/emacs.d/rails/.svn/entries b/emacs.d/rails/.svn/entries new file mode 100644 index 0000000..f2ed680 --- /dev/null +++ b/emacs.d/rails/.svn/entries @@ -0,0 +1,357 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/emacs.d/rails/.svn/format b/emacs.d/rails/.svn/format new file mode 100644 index 0000000..b8626c4 --- /dev/null +++ b/emacs.d/rails/.svn/format @@ -0,0 +1 @@ +4 diff --git a/emacs.d/rails/.svn/prop-base/ChangeLog.svn-base b/emacs.d/rails/.svn/prop-base/ChangeLog.svn-base new file mode 100644 index 0000000..bdbd305 --- /dev/null +++ b/emacs.d/rails/.svn/prop-base/ChangeLog.svn-base @@ -0,0 +1,5 @@ +K 13 +svn:eol-style +V 6 +native +END diff --git a/emacs.d/rails/.svn/prop-base/History.svn-base b/emacs.d/rails/.svn/prop-base/History.svn-base new file mode 100644 index 0000000..e69de29 diff --git a/emacs.d/rails/.svn/prop-base/README.svn-base b/emacs.d/rails/.svn/prop-base/README.svn-base new file mode 100644 index 0000000..7d936ce --- /dev/null +++ b/emacs.d/rails/.svn/prop-base/README.svn-base @@ -0,0 +1,9 @@ +K 13 +svn:eol-style +V 6 +native +K 12 +svn:keywords +V 6 +Id URL +END diff --git a/emacs.d/rails/.svn/prop-base/inflections.el.svn-base b/emacs.d/rails/.svn/prop-base/inflections.el.svn-base new file mode 100644 index 0000000..1a9a163 --- /dev/null +++ b/emacs.d/rails/.svn/prop-base/inflections.el.svn-base @@ -0,0 +1,5 @@ +K 12 +svn:keywords +V 6 +Id URL +END diff --git a/emacs.d/rails/.svn/prop-base/predictive-prog-mode.el.svn-base b/emacs.d/rails/.svn/prop-base/predictive-prog-mode.el.svn-base new file mode 100644 index 0000000..e69de29 diff --git a/emacs.d/rails/.svn/prop-base/rails-bytecompile.el.svn-base b/emacs.d/rails/.svn/prop-base/rails-bytecompile.el.svn-base new file mode 100644 index 0000000..1a9a163 --- /dev/null +++ b/emacs.d/rails/.svn/prop-base/rails-bytecompile.el.svn-base @@ -0,0 +1,5 @@ +K 12 +svn:keywords +V 6 +Id URL +END diff --git a/emacs.d/rails/.svn/prop-base/rails-cmd-proxy.el.svn-base b/emacs.d/rails/.svn/prop-base/rails-cmd-proxy.el.svn-base new file mode 100644 index 0000000..1a9a163 --- /dev/null +++ b/emacs.d/rails/.svn/prop-base/rails-cmd-proxy.el.svn-base @@ -0,0 +1,5 @@ +K 12 +svn:keywords +V 6 +Id URL +END diff --git a/emacs.d/rails/.svn/prop-base/rails-compat.el.svn-base b/emacs.d/rails/.svn/prop-base/rails-compat.el.svn-base new file mode 100644 index 0000000..e69de29 diff --git a/emacs.d/rails/.svn/prop-base/rails-controller-layout.el.svn-base b/emacs.d/rails/.svn/prop-base/rails-controller-layout.el.svn-base new file mode 100644 index 0000000..1a9a163 --- /dev/null +++ b/emacs.d/rails/.svn/prop-base/rails-controller-layout.el.svn-base @@ -0,0 +1,5 @@ +K 12 +svn:keywords +V 6 +Id URL +END diff --git a/emacs.d/rails/.svn/prop-base/rails-controller-minor-mode.el.svn-base b/emacs.d/rails/.svn/prop-base/rails-controller-minor-mode.el.svn-base new file mode 100644 index 0000000..7d936ce --- /dev/null +++ b/emacs.d/rails/.svn/prop-base/rails-controller-minor-mode.el.svn-base @@ -0,0 +1,9 @@ +K 13 +svn:eol-style +V 6 +native +K 12 +svn:keywords +V 6 +Id URL +END diff --git a/emacs.d/rails/.svn/prop-base/rails-core.el.svn-base b/emacs.d/rails/.svn/prop-base/rails-core.el.svn-base new file mode 100644 index 0000000..7d936ce --- /dev/null +++ b/emacs.d/rails/.svn/prop-base/rails-core.el.svn-base @@ -0,0 +1,9 @@ +K 13 +svn:eol-style +V 6 +native +K 12 +svn:keywords +V 6 +Id URL +END diff --git a/emacs.d/rails/.svn/prop-base/rails-features.el.svn-base b/emacs.d/rails/.svn/prop-base/rails-features.el.svn-base new file mode 100644 index 0000000..e69de29 diff --git a/emacs.d/rails/.svn/prop-base/rails-find.el.svn-base b/emacs.d/rails/.svn/prop-base/rails-find.el.svn-base new file mode 100644 index 0000000..e69de29 diff --git a/emacs.d/rails/.svn/prop-base/rails-fixture-minor-mode.el.svn-base b/emacs.d/rails/.svn/prop-base/rails-fixture-minor-mode.el.svn-base new file mode 100644 index 0000000..1a9a163 --- /dev/null +++ b/emacs.d/rails/.svn/prop-base/rails-fixture-minor-mode.el.svn-base @@ -0,0 +1,5 @@ +K 12 +svn:keywords +V 6 +Id URL +END diff --git a/emacs.d/rails/.svn/prop-base/rails-functional-test-minor-mode.el.svn-base b/emacs.d/rails/.svn/prop-base/rails-functional-test-minor-mode.el.svn-base new file mode 100644 index 0000000..1a9a163 --- /dev/null +++ b/emacs.d/rails/.svn/prop-base/rails-functional-test-minor-mode.el.svn-base @@ -0,0 +1,5 @@ +K 12 +svn:keywords +V 6 +Id URL +END diff --git a/emacs.d/rails/.svn/prop-base/rails-helper-minor-mode.el.svn-base b/emacs.d/rails/.svn/prop-base/rails-helper-minor-mode.el.svn-base new file mode 100644 index 0000000..1a9a163 --- /dev/null +++ b/emacs.d/rails/.svn/prop-base/rails-helper-minor-mode.el.svn-base @@ -0,0 +1,5 @@ +K 12 +svn:keywords +V 6 +Id URL +END diff --git a/emacs.d/rails/.svn/prop-base/rails-layout-minor-mode.el.svn-base b/emacs.d/rails/.svn/prop-base/rails-layout-minor-mode.el.svn-base new file mode 100644 index 0000000..7d936ce --- /dev/null +++ b/emacs.d/rails/.svn/prop-base/rails-layout-minor-mode.el.svn-base @@ -0,0 +1,9 @@ +K 13 +svn:eol-style +V 6 +native +K 12 +svn:keywords +V 6 +Id URL +END diff --git a/emacs.d/rails/.svn/prop-base/rails-lib.el.svn-base b/emacs.d/rails/.svn/prop-base/rails-lib.el.svn-base new file mode 100644 index 0000000..7d936ce --- /dev/null +++ b/emacs.d/rails/.svn/prop-base/rails-lib.el.svn-base @@ -0,0 +1,9 @@ +K 13 +svn:eol-style +V 6 +native +K 12 +svn:keywords +V 6 +Id URL +END diff --git a/emacs.d/rails/.svn/prop-base/rails-log.el.svn-base b/emacs.d/rails/.svn/prop-base/rails-log.el.svn-base new file mode 100644 index 0000000..1a9a163 --- /dev/null +++ b/emacs.d/rails/.svn/prop-base/rails-log.el.svn-base @@ -0,0 +1,5 @@ +K 12 +svn:keywords +V 6 +Id URL +END diff --git a/emacs.d/rails/.svn/prop-base/rails-mailer-minor-mode.el.svn-base b/emacs.d/rails/.svn/prop-base/rails-mailer-minor-mode.el.svn-base new file mode 100644 index 0000000..1a9a163 --- /dev/null +++ b/emacs.d/rails/.svn/prop-base/rails-mailer-minor-mode.el.svn-base @@ -0,0 +1,5 @@ +K 12 +svn:keywords +V 6 +Id URL +END diff --git a/emacs.d/rails/.svn/prop-base/rails-migration-minor-mode.el.svn-base b/emacs.d/rails/.svn/prop-base/rails-migration-minor-mode.el.svn-base new file mode 100644 index 0000000..1a9a163 --- /dev/null +++ b/emacs.d/rails/.svn/prop-base/rails-migration-minor-mode.el.svn-base @@ -0,0 +1,5 @@ +K 12 +svn:keywords +V 6 +Id URL +END diff --git a/emacs.d/rails/.svn/prop-base/rails-model-layout.el.svn-base b/emacs.d/rails/.svn/prop-base/rails-model-layout.el.svn-base new file mode 100644 index 0000000..1a9a163 --- /dev/null +++ b/emacs.d/rails/.svn/prop-base/rails-model-layout.el.svn-base @@ -0,0 +1,5 @@ +K 12 +svn:keywords +V 6 +Id URL +END diff --git a/emacs.d/rails/.svn/prop-base/rails-model-minor-mode.el.svn-base b/emacs.d/rails/.svn/prop-base/rails-model-minor-mode.el.svn-base new file mode 100644 index 0000000..1a9a163 --- /dev/null +++ b/emacs.d/rails/.svn/prop-base/rails-model-minor-mode.el.svn-base @@ -0,0 +1,5 @@ +K 12 +svn:keywords +V 6 +Id URL +END diff --git a/emacs.d/rails/.svn/prop-base/rails-navigation.el.svn-base b/emacs.d/rails/.svn/prop-base/rails-navigation.el.svn-base new file mode 100644 index 0000000..7d936ce --- /dev/null +++ b/emacs.d/rails/.svn/prop-base/rails-navigation.el.svn-base @@ -0,0 +1,9 @@ +K 13 +svn:eol-style +V 6 +native +K 12 +svn:keywords +V 6 +Id URL +END diff --git a/emacs.d/rails/.svn/prop-base/rails-plugin-minor-mode.el.svn-base b/emacs.d/rails/.svn/prop-base/rails-plugin-minor-mode.el.svn-base new file mode 100644 index 0000000..1a9a163 --- /dev/null +++ b/emacs.d/rails/.svn/prop-base/rails-plugin-minor-mode.el.svn-base @@ -0,0 +1,5 @@ +K 12 +svn:keywords +V 6 +Id URL +END diff --git a/emacs.d/rails/.svn/prop-base/rails-project.el.svn-base b/emacs.d/rails/.svn/prop-base/rails-project.el.svn-base new file mode 100644 index 0000000..e69de29 diff --git a/emacs.d/rails/.svn/prop-base/rails-rake.el.svn-base b/emacs.d/rails/.svn/prop-base/rails-rake.el.svn-base new file mode 100644 index 0000000..e69de29 diff --git a/emacs.d/rails/.svn/prop-base/rails-ruby.el.svn-base b/emacs.d/rails/.svn/prop-base/rails-ruby.el.svn-base new file mode 100644 index 0000000..7d936ce --- /dev/null +++ b/emacs.d/rails/.svn/prop-base/rails-ruby.el.svn-base @@ -0,0 +1,9 @@ +K 13 +svn:eol-style +V 6 +native +K 12 +svn:keywords +V 6 +Id URL +END diff --git a/emacs.d/rails/.svn/prop-base/rails-scripts.el.svn-base b/emacs.d/rails/.svn/prop-base/rails-scripts.el.svn-base new file mode 100644 index 0000000..7d936ce --- /dev/null +++ b/emacs.d/rails/.svn/prop-base/rails-scripts.el.svn-base @@ -0,0 +1,9 @@ +K 13 +svn:eol-style +V 6 +native +K 12 +svn:keywords +V 6 +Id URL +END diff --git a/emacs.d/rails/.svn/prop-base/rails-snippets-feature.el.svn-base b/emacs.d/rails/.svn/prop-base/rails-snippets-feature.el.svn-base new file mode 100644 index 0000000..e69de29 diff --git a/emacs.d/rails/.svn/prop-base/rails-speedbar-feature.el.svn-base b/emacs.d/rails/.svn/prop-base/rails-speedbar-feature.el.svn-base new file mode 100644 index 0000000..e69de29 diff --git a/emacs.d/rails/.svn/prop-base/rails-test.el.svn-base b/emacs.d/rails/.svn/prop-base/rails-test.el.svn-base new file mode 100644 index 0000000..e69de29 diff --git a/emacs.d/rails/.svn/prop-base/rails-ui.el.svn-base b/emacs.d/rails/.svn/prop-base/rails-ui.el.svn-base new file mode 100644 index 0000000..7d936ce --- /dev/null +++ b/emacs.d/rails/.svn/prop-base/rails-ui.el.svn-base @@ -0,0 +1,9 @@ +K 13 +svn:eol-style +V 6 +native +K 12 +svn:keywords +V 6 +Id URL +END diff --git a/emacs.d/rails/.svn/prop-base/rails-unit-test-minor-mode.el.svn-base b/emacs.d/rails/.svn/prop-base/rails-unit-test-minor-mode.el.svn-base new file mode 100644 index 0000000..1a9a163 --- /dev/null +++ b/emacs.d/rails/.svn/prop-base/rails-unit-test-minor-mode.el.svn-base @@ -0,0 +1,5 @@ +K 12 +svn:keywords +V 6 +Id URL +END diff --git a/emacs.d/rails/.svn/prop-base/rails-view-minor-mode.el.svn-base b/emacs.d/rails/.svn/prop-base/rails-view-minor-mode.el.svn-base new file mode 100644 index 0000000..7d936ce --- /dev/null +++ b/emacs.d/rails/.svn/prop-base/rails-view-minor-mode.el.svn-base @@ -0,0 +1,9 @@ +K 13 +svn:eol-style +V 6 +native +K 12 +svn:keywords +V 6 +Id URL +END diff --git a/emacs.d/rails/.svn/prop-base/rails-ws.el.svn-base b/emacs.d/rails/.svn/prop-base/rails-ws.el.svn-base new file mode 100644 index 0000000..7d936ce --- /dev/null +++ b/emacs.d/rails/.svn/prop-base/rails-ws.el.svn-base @@ -0,0 +1,9 @@ +K 13 +svn:eol-style +V 6 +native +K 12 +svn:keywords +V 6 +Id URL +END diff --git a/emacs.d/rails/.svn/prop-base/rails.el.svn-base b/emacs.d/rails/.svn/prop-base/rails.el.svn-base new file mode 100644 index 0000000..7d936ce --- /dev/null +++ b/emacs.d/rails/.svn/prop-base/rails.el.svn-base @@ -0,0 +1,9 @@ +K 13 +svn:eol-style +V 6 +native +K 12 +svn:keywords +V 6 +Id URL +END diff --git a/emacs.d/rails/.svn/prop-base/untabify-file.el.svn-base b/emacs.d/rails/.svn/prop-base/untabify-file.el.svn-base new file mode 100644 index 0000000..e69de29 diff --git a/emacs.d/rails/.svn/props/ChangeLog.svn-work b/emacs.d/rails/.svn/props/ChangeLog.svn-work new file mode 100644 index 0000000..bdbd305 --- /dev/null +++ b/emacs.d/rails/.svn/props/ChangeLog.svn-work @@ -0,0 +1,5 @@ +K 13 +svn:eol-style +V 6 +native +END diff --git a/emacs.d/rails/.svn/props/History.svn-work b/emacs.d/rails/.svn/props/History.svn-work new file mode 100644 index 0000000..e69de29 diff --git a/emacs.d/rails/.svn/props/README.svn-work b/emacs.d/rails/.svn/props/README.svn-work new file mode 100644 index 0000000..7d936ce --- /dev/null +++ b/emacs.d/rails/.svn/props/README.svn-work @@ -0,0 +1,9 @@ +K 13 +svn:eol-style +V 6 +native +K 12 +svn:keywords +V 6 +Id URL +END diff --git a/emacs.d/rails/.svn/props/inflections.el.svn-work b/emacs.d/rails/.svn/props/inflections.el.svn-work new file mode 100644 index 0000000..1a9a163 --- /dev/null +++ b/emacs.d/rails/.svn/props/inflections.el.svn-work @@ -0,0 +1,5 @@ +K 12 +svn:keywords +V 6 +Id URL +END diff --git a/emacs.d/rails/.svn/props/predictive-prog-mode.el.svn-work b/emacs.d/rails/.svn/props/predictive-prog-mode.el.svn-work new file mode 100644 index 0000000..e69de29 diff --git a/emacs.d/rails/.svn/props/rails-bytecompile.el.svn-work b/emacs.d/rails/.svn/props/rails-bytecompile.el.svn-work new file mode 100644 index 0000000..1a9a163 --- /dev/null +++ b/emacs.d/rails/.svn/props/rails-bytecompile.el.svn-work @@ -0,0 +1,5 @@ +K 12 +svn:keywords +V 6 +Id URL +END diff --git a/emacs.d/rails/.svn/props/rails-cmd-proxy.el.svn-work b/emacs.d/rails/.svn/props/rails-cmd-proxy.el.svn-work new file mode 100644 index 0000000..1a9a163 --- /dev/null +++ b/emacs.d/rails/.svn/props/rails-cmd-proxy.el.svn-work @@ -0,0 +1,5 @@ +K 12 +svn:keywords +V 6 +Id URL +END diff --git a/emacs.d/rails/.svn/props/rails-compat.el.svn-work b/emacs.d/rails/.svn/props/rails-compat.el.svn-work new file mode 100644 index 0000000..e69de29 diff --git a/emacs.d/rails/.svn/props/rails-controller-layout.el.svn-work b/emacs.d/rails/.svn/props/rails-controller-layout.el.svn-work new file mode 100644 index 0000000..1a9a163 --- /dev/null +++ b/emacs.d/rails/.svn/props/rails-controller-layout.el.svn-work @@ -0,0 +1,5 @@ +K 12 +svn:keywords +V 6 +Id URL +END diff --git a/emacs.d/rails/.svn/props/rails-controller-minor-mode.el.svn-work b/emacs.d/rails/.svn/props/rails-controller-minor-mode.el.svn-work new file mode 100644 index 0000000..7d936ce --- /dev/null +++ b/emacs.d/rails/.svn/props/rails-controller-minor-mode.el.svn-work @@ -0,0 +1,9 @@ +K 13 +svn:eol-style +V 6 +native +K 12 +svn:keywords +V 6 +Id URL +END diff --git a/emacs.d/rails/.svn/props/rails-core.el.svn-work b/emacs.d/rails/.svn/props/rails-core.el.svn-work new file mode 100644 index 0000000..7d936ce --- /dev/null +++ b/emacs.d/rails/.svn/props/rails-core.el.svn-work @@ -0,0 +1,9 @@ +K 13 +svn:eol-style +V 6 +native +K 12 +svn:keywords +V 6 +Id URL +END diff --git a/emacs.d/rails/.svn/props/rails-features.el.svn-work b/emacs.d/rails/.svn/props/rails-features.el.svn-work new file mode 100644 index 0000000..e69de29 diff --git a/emacs.d/rails/.svn/props/rails-find.el.svn-work b/emacs.d/rails/.svn/props/rails-find.el.svn-work new file mode 100644 index 0000000..e69de29 diff --git a/emacs.d/rails/.svn/props/rails-fixture-minor-mode.el.svn-work b/emacs.d/rails/.svn/props/rails-fixture-minor-mode.el.svn-work new file mode 100644 index 0000000..1a9a163 --- /dev/null +++ b/emacs.d/rails/.svn/props/rails-fixture-minor-mode.el.svn-work @@ -0,0 +1,5 @@ +K 12 +svn:keywords +V 6 +Id URL +END diff --git a/emacs.d/rails/.svn/props/rails-functional-test-minor-mode.el.svn-work b/emacs.d/rails/.svn/props/rails-functional-test-minor-mode.el.svn-work new file mode 100644 index 0000000..1a9a163 --- /dev/null +++ b/emacs.d/rails/.svn/props/rails-functional-test-minor-mode.el.svn-work @@ -0,0 +1,5 @@ +K 12 +svn:keywords +V 6 +Id URL +END diff --git a/emacs.d/rails/.svn/props/rails-helper-minor-mode.el.svn-work b/emacs.d/rails/.svn/props/rails-helper-minor-mode.el.svn-work new file mode 100644 index 0000000..1a9a163 --- /dev/null +++ b/emacs.d/rails/.svn/props/rails-helper-minor-mode.el.svn-work @@ -0,0 +1,5 @@ +K 12 +svn:keywords +V 6 +Id URL +END diff --git a/emacs.d/rails/.svn/props/rails-layout-minor-mode.el.svn-work b/emacs.d/rails/.svn/props/rails-layout-minor-mode.el.svn-work new file mode 100644 index 0000000..7d936ce --- /dev/null +++ b/emacs.d/rails/.svn/props/rails-layout-minor-mode.el.svn-work @@ -0,0 +1,9 @@ +K 13 +svn:eol-style +V 6 +native +K 12 +svn:keywords +V 6 +Id URL +END diff --git a/emacs.d/rails/.svn/props/rails-lib.el.svn-work b/emacs.d/rails/.svn/props/rails-lib.el.svn-work new file mode 100644 index 0000000..7d936ce --- /dev/null +++ b/emacs.d/rails/.svn/props/rails-lib.el.svn-work @@ -0,0 +1,9 @@ +K 13 +svn:eol-style +V 6 +native +K 12 +svn:keywords +V 6 +Id URL +END diff --git a/emacs.d/rails/.svn/props/rails-log.el.svn-work b/emacs.d/rails/.svn/props/rails-log.el.svn-work new file mode 100644 index 0000000..1a9a163 --- /dev/null +++ b/emacs.d/rails/.svn/props/rails-log.el.svn-work @@ -0,0 +1,5 @@ +K 12 +svn:keywords +V 6 +Id URL +END diff --git a/emacs.d/rails/.svn/props/rails-mailer-minor-mode.el.svn-work b/emacs.d/rails/.svn/props/rails-mailer-minor-mode.el.svn-work new file mode 100644 index 0000000..1a9a163 --- /dev/null +++ b/emacs.d/rails/.svn/props/rails-mailer-minor-mode.el.svn-work @@ -0,0 +1,5 @@ +K 12 +svn:keywords +V 6 +Id URL +END diff --git a/emacs.d/rails/.svn/props/rails-migration-minor-mode.el.svn-work b/emacs.d/rails/.svn/props/rails-migration-minor-mode.el.svn-work new file mode 100644 index 0000000..1a9a163 --- /dev/null +++ b/emacs.d/rails/.svn/props/rails-migration-minor-mode.el.svn-work @@ -0,0 +1,5 @@ +K 12 +svn:keywords +V 6 +Id URL +END diff --git a/emacs.d/rails/.svn/props/rails-model-layout.el.svn-work b/emacs.d/rails/.svn/props/rails-model-layout.el.svn-work new file mode 100644 index 0000000..1a9a163 --- /dev/null +++ b/emacs.d/rails/.svn/props/rails-model-layout.el.svn-work @@ -0,0 +1,5 @@ +K 12 +svn:keywords +V 6 +Id URL +END diff --git a/emacs.d/rails/.svn/props/rails-model-minor-mode.el.svn-work b/emacs.d/rails/.svn/props/rails-model-minor-mode.el.svn-work new file mode 100644 index 0000000..1a9a163 --- /dev/null +++ b/emacs.d/rails/.svn/props/rails-model-minor-mode.el.svn-work @@ -0,0 +1,5 @@ +K 12 +svn:keywords +V 6 +Id URL +END diff --git a/emacs.d/rails/.svn/props/rails-navigation.el.svn-work b/emacs.d/rails/.svn/props/rails-navigation.el.svn-work new file mode 100644 index 0000000..7d936ce --- /dev/null +++ b/emacs.d/rails/.svn/props/rails-navigation.el.svn-work @@ -0,0 +1,9 @@ +K 13 +svn:eol-style +V 6 +native +K 12 +svn:keywords +V 6 +Id URL +END diff --git a/emacs.d/rails/.svn/props/rails-plugin-minor-mode.el.svn-work b/emacs.d/rails/.svn/props/rails-plugin-minor-mode.el.svn-work new file mode 100644 index 0000000..1a9a163 --- /dev/null +++ b/emacs.d/rails/.svn/props/rails-plugin-minor-mode.el.svn-work @@ -0,0 +1,5 @@ +K 12 +svn:keywords +V 6 +Id URL +END diff --git a/emacs.d/rails/.svn/props/rails-project.el.svn-work b/emacs.d/rails/.svn/props/rails-project.el.svn-work new file mode 100644 index 0000000..e69de29 diff --git a/emacs.d/rails/.svn/props/rails-rake.el.svn-work b/emacs.d/rails/.svn/props/rails-rake.el.svn-work new file mode 100644 index 0000000..e69de29 diff --git a/emacs.d/rails/.svn/props/rails-ruby.el.svn-work b/emacs.d/rails/.svn/props/rails-ruby.el.svn-work new file mode 100644 index 0000000..7d936ce --- /dev/null +++ b/emacs.d/rails/.svn/props/rails-ruby.el.svn-work @@ -0,0 +1,9 @@ +K 13 +svn:eol-style +V 6 +native +K 12 +svn:keywords +V 6 +Id URL +END diff --git a/emacs.d/rails/.svn/props/rails-scripts.el.svn-work b/emacs.d/rails/.svn/props/rails-scripts.el.svn-work new file mode 100644 index 0000000..7d936ce --- /dev/null +++ b/emacs.d/rails/.svn/props/rails-scripts.el.svn-work @@ -0,0 +1,9 @@ +K 13 +svn:eol-style +V 6 +native +K 12 +svn:keywords +V 6 +Id URL +END diff --git a/emacs.d/rails/.svn/props/rails-snippets-feature.el.svn-work b/emacs.d/rails/.svn/props/rails-snippets-feature.el.svn-work new file mode 100644 index 0000000..e69de29 diff --git a/emacs.d/rails/.svn/props/rails-speedbar-feature.el.svn-work b/emacs.d/rails/.svn/props/rails-speedbar-feature.el.svn-work new file mode 100644 index 0000000..e69de29 diff --git a/emacs.d/rails/.svn/props/rails-test.el.svn-work b/emacs.d/rails/.svn/props/rails-test.el.svn-work new file mode 100644 index 0000000..e69de29 diff --git a/emacs.d/rails/.svn/props/rails-ui.el.svn-work b/emacs.d/rails/.svn/props/rails-ui.el.svn-work new file mode 100644 index 0000000..7d936ce --- /dev/null +++ b/emacs.d/rails/.svn/props/rails-ui.el.svn-work @@ -0,0 +1,9 @@ +K 13 +svn:eol-style +V 6 +native +K 12 +svn:keywords +V 6 +Id URL +END diff --git a/emacs.d/rails/.svn/props/rails-unit-test-minor-mode.el.svn-work b/emacs.d/rails/.svn/props/rails-unit-test-minor-mode.el.svn-work new file mode 100644 index 0000000..1a9a163 --- /dev/null +++ b/emacs.d/rails/.svn/props/rails-unit-test-minor-mode.el.svn-work @@ -0,0 +1,5 @@ +K 12 +svn:keywords +V 6 +Id URL +END diff --git a/emacs.d/rails/.svn/props/rails-view-minor-mode.el.svn-work b/emacs.d/rails/.svn/props/rails-view-minor-mode.el.svn-work new file mode 100644 index 0000000..7d936ce --- /dev/null +++ b/emacs.d/rails/.svn/props/rails-view-minor-mode.el.svn-work @@ -0,0 +1,9 @@ +K 13 +svn:eol-style +V 6 +native +K 12 +svn:keywords +V 6 +Id URL +END diff --git a/emacs.d/rails/.svn/props/rails-ws.el.svn-work b/emacs.d/rails/.svn/props/rails-ws.el.svn-work new file mode 100644 index 0000000..7d936ce --- /dev/null +++ b/emacs.d/rails/.svn/props/rails-ws.el.svn-work @@ -0,0 +1,9 @@ +K 13 +svn:eol-style +V 6 +native +K 12 +svn:keywords +V 6 +Id URL +END diff --git a/emacs.d/rails/.svn/props/rails.el.svn-work b/emacs.d/rails/.svn/props/rails.el.svn-work new file mode 100644 index 0000000..7d936ce --- /dev/null +++ b/emacs.d/rails/.svn/props/rails.el.svn-work @@ -0,0 +1,9 @@ +K 13 +svn:eol-style +V 6 +native +K 12 +svn:keywords +V 6 +Id URL +END diff --git a/emacs.d/rails/.svn/props/untabify-file.el.svn-work b/emacs.d/rails/.svn/props/untabify-file.el.svn-work new file mode 100644 index 0000000..e69de29 diff --git a/emacs.d/rails/.svn/text-base/ChangeLog.svn-base b/emacs.d/rails/.svn/text-base/ChangeLog.svn-base new file mode 100644 index 0000000..0ddb440 --- /dev/null +++ b/emacs.d/rails/.svn/text-base/ChangeLog.svn-base @@ -0,0 +1,1028 @@ +2007-05-23 Dmitry Galinsky + + * rails-test.el (rails-test:line-regexp): bug #10792: updated regexp + +2007-05-05 Dmitry Galinsky + + * rails.el: fixed #10613, wrong comparsion of emacs major-version + +2007-05-03 Dmitry Galinsky + + * rails-test.el (rails-test:line-regexp): patch #10532, allows '-' to occur in the errror filepath (thanks Peter Williams) + +2007-04-27 Dmitry Galinsky + + * rails.el: raise a error if emacs-rails run on old version of Emacs (less 22). + + * rails-ruby.el: check available flymake before setup ruby-flymake. + +2007-04-25 Dmitry Galinsky + + * rails-speedbar-feature.el (rails-speedbar:expand-directory) + (rails-speedbar:display): updated view mode of "views". + + * rails-compat.el (try-complete-abbrev): don't expand a snippet inside comments or strings. + +2007-04-20 Dmitry Galinsky + + * rails-core.el (rails-core:menu-letters-list) + (rails-core:prepare-menu): created, append a prefix to each label of menu-item from MENU. + +2007-04-19 Dmitry Galinsky + + * rails-speedbar-feature.el (rails-speedbar:expand-tags): append list of templates in controllers + (rails-speedbar:line-directory): created + + * rails-core.el (rails-core:helper-file): append the test/test_helper + (rails-core:views-dir): strip the "_controller" sufix + (rails-core:helpers): added the test/test_helper support + + * rails-speedbar-feature.el (rails-speedbar:line-directory) + (rails-speedbar:root, rails-speedbar:in-root): created + (rails-speedbar-feature:install): install speedbar-mode-line-functions + + * rails-ruby.el (completion-dynamic-syntax-alist): removed + + * rails-core.el (rails-core:class-by-file): updated + +2007-04-18 Dmitry Galinsky + + * rails.el (ruby-mode-hook): removed predictive-prog-mode, it will incorect work in latest CVS builds of Emacs + +2007-04-13 Dmitry Galinsky + + * rails-ruby.el (flymake-ruby-init): apply patch #10056, thanks Rémi Vanicat + + * rails-core.el (rails-core:class-by-file): handle first digit[s] in filename + + * rails-lib.el (capital-word-p): return nil if first char is not + + * inflections.el: rollback to using separate variables instead of structure + +2007-04-12 Dmitry Galinsky + + * rails-test.el: fixed #10053 bug, added rails-core:regexp-for-match-views to compilation-error-regexp + + * predictive-prog-mode.el (activate-predictive-inside-comments): toggle predictive mode using 'predictive-main-dict variable, looking at previous word + + * rails-core.el (rails-core:class-by-file): detect already capitalized words + +2007-04-10 Dmitry Galinsky + + * rails-snippets-feature.el (rails-snippets-feature:list): updated + + * rails-test.el (rails-test:error-regexp-alist): updated + +2007-04-09 Dmitry Galinsky + + * rails-ui.el (rails-minor-mode-prefix-key): created + (rails-key): created + + * predictive-prog-mode.el (predictive-prog-text-faces): fixed compilation warning + +2007-04-08 Dmitry Galinsky + + * rails-speedbar-feature.el (rails-speedbar:roots): created + +2007-04-06 Dmitry Galinsky + + * rails-lib.el (capital-word-p): better word comparsion + + * predictive-prog-mode.el, untabify-file.el: created separate minor-mode + + * rails-compat.el: removed predictive-prog-mode declaration + + * rails-features.el: created + + * rails-predictive-prog-mode-feature.el: created and place into it + predictive-program-mode + + * rails-snippets-feature.el: created + + * rails-ui.el (rails-minor-mode-map): removed snippets menu + + * rails-untabify-feature.el: created and place into it untabify + hook + + * rails.el (find-file-hooks): cleanup + +2007-04-05 Dmitry Galinsky + + * rails.el (auto-mode-alist): added Rakefile to auto-mode-alist + + * rails-ui.el (rails-minor-mode-test-current-method-key): created + + * rails-*-test-minor-mode (rails-unit-test-minor-mode rails-functional-test-minor-mode): + changed hotkey "C-c ." to "C-c C-c ,", the old conflicted with ECB + + * rails-ruby.el (flymake-ruby-load): apply flymake-mode only if + buffer-file-name matched flymake-allowed-file-name-masks + +2007-04-04 Dmitry Galinsky + + * rails-ruby.el (flymake-ruby-load): updated + + * rails-ui.el: reduced the menu length + +2007-04-03 Dmitry Galinsky + + * rails-ruby.el (flymake-ruby-load): updated + + * rails-controller-layout.el (rails-controller-layout:keymap): + created menu group for current minor-mode + + * rails-model-layout.el (rails-model-layout:keymap): created menu + group for current minor-mode + + * rails-core.el (rails-core:controller-file-by-model) + (rails-core:mailer-file, rails-core:mailer-exist-p) + (rails-core:migration-file-by-model) + (rails-core:model-by-migration-filename) + (rails-core:unit-test-exist-p, rails-core:fixture-exist-p) + (rails-core:current-mailer): created + + * rails-model-layout.el (rails-model-layout:keymap): removed mode specific menu + + * rails-controller-layout.el (rails-controller-layout:keymap): removed mode specific menu + + * rails-compat.el (predictive-prog-mode): don't start inside strings + + * rails-core.el: using completion-posn-at-point-as-event instead custom function + + * rails-ui.el (rails-minor-mode-db-menu-bar-map): updated + + * rails-model-layout.el (rails-model-layout:keymap): created + + * rails-core.el (rails-core:buffer-file-match): allow passing nil + + * rails-controller-layout.el (rails-controller-layout:keymap): created + + * rails-cmd-proxy.el (rails-cmd-proxy:convert-buffer-from-remote): fixed compilation warning + + * rails-ruby.el: added flymake support to on the fly syntax check in ruby-mode + + * rails-test.el (rails-test:error-regexp-alist): updated + +2007-04-02 Dmitry Galinsky + + * rails-lib.el (merge-abbrev-tables): mark abbrev as system + +2007-04-01 Dmitry Galinsky + + * rails-snippets.el: updated snippets + + * rails-ui.el (rails-minor-mode-nav-menu-bar-map): created separate menu entry for "Navigate", "Database", "Tests" + + * rails-test.el (rails-test:error-regexp-alist): updated regexp to match errors + + * rails-snippets.el (rails-snippets:list): new snippet group RESTful + + * rails-ruby.el (ruby-align-rules-list): updated regexp for align + + * rails-rake.el (rails-rake:migrate) + (rails-rake:migrate-with-version) + (rails-rake:migrate-to-prev-version): created + + * rails-lib.el: added alias string-join to strings-join + + * rails-core.el (rails-core:mailer-file): fixed bug #9721 + (rails-core:migration-versions): created + + * rails-compat.el (indent-or-complete): restored completion-ui support + +2007-03-30 Dmitry Galinsky + + * rails-test.el (rails-test:error-regexp-alist): updated + + * rails-scripts.el (rails-script:run): added + `rails-cmd-proxy:convert-buffer-from-remote' to + `after-change-functions' + + * rails-ruby.el: added `align' integration code + + * rails-lib.el (string-repeat): created + + * rails-cmd-proxy.el (rails-cmd-proxy:convert-buffer-from-remote): created + + * rails-project.el: created + + * rails-compat.el: created + +2007-03-29 Dmitry Galinsky + + * rails.el (indented-or-complete): added support completion-ui + (activate-predictive-inside-strings): created + (ruby-mode-hook): added pcomplete activation code + + * rails-test.el (rails-test:print-result): don't scroll on top + + * rails-navigation.el (rails-nav:goto-functional-tests): created + (rails-nav:goto-unit-tests): created + + * rails-core.el (rails-core:functional-tests): created + (rails-core:unit-tests): created + + * rails-cmd-proxy.el: updated + + * rails-scripts.el (rails-script:output-mode): updated + + * rails.el (indent-or-complete): updated + + * rails-test.el (rails-test:run): cleanup + + * rails-rake.el (rails-rake:list-of-tasks-without-tests): created + (rails-rake:list-of-tasks): renamed from rails-rake:tasks-list + + * rails-ui.el: created seperate menu group for tests + + * rails-test.el: created, Added tests integration with the compile library + + * rails-scripts.el: refactored + + * rails-rake.el: refactored + + * rails-lib.el (rails-completing-read): created + +2007-03-28 Dmitry Galinsky + + * rails-rake.el (rails-rake:task): removed rails-rake:output-mode + + * rails.el: added forward declaration of try-complete-abbrev, + index-or-complete and setup variable + hippie-expand-try-function-alist + + * rails-snippets.el (rails-snippets:list): updated + + * rails-core.el (rails-core:menu-position): fixed error at `window-live-p' + + * rails-ui.el (rails-minor-mode-menu-bar-map): added menu item for "test current method" + + * rails-ws.el (rails-ws:start): added missing parameter the + rails-ws:default-server-type to startup command + + * rails-scripts.el (rails-script:toggle-output-window): created + + * rails-ws.el (rails-ws:start): fixed bug [#9619], incorect setup of default directory + + * rails-snippets.el (rails-snippets-menu-list): removed + (rails-snippets:create-keymap, rails-snippets:create-lambda) + (rails-snippets:list): created + + * rails-lib.el (create-snippets-and-menumap-from-dsl): removed + +2007-03-27 Dmitry Galinsky + + * rails-snippets.el (rails-snippets-menu-list): updated snippets, + add the "assert_template" snippet + + * rails-rake.el (rails-rake:test-current): created + (rails-rake:run-test-file): created + (rails-rake:test-current-method): created + + * rails-unit-test-minor-mode.el (rails-unit-test-minor-mode): + added hotkey [C-c .] to run test of current method + + * rails-functional-test-minor-mode.el (rails-functional-test-minor-mode): + added hotkey [C-c .] to run test of current method + + * rails-core.el (rails-core:functional-test-file) + (rails-core:unit-test-file, rails-core:observer-p) + (rails-core:mailer-p): allow passing nil + (rails-core:current-method-name): renamed from rails-core:current-function-name + + * rails-scripts.el (rails-script:output-mode-popup-buffer, + rails-script:output-mode-push-first-button): created + (rails-script:output-mode): using hooks instead local-variables + + * rails-rake.el (rails-rake:output-mode): using hooks instead local-variables + + * rails-lib.el (buffer-visible-p): optimization, using `get-buffer-window' + + * rails-model-layout.el (rails-model-layout:switch-to): + display message if file not exists + + * rails-controller-layout.el (rails-controller-layout:switch-to): + display message if file not exists + + * rails-model-layout.el (rails-model-layout:switch-to) + (rails-model-layout:menu): added migrations support + + * rails-migration-minor-mode.el (rails-migration-minor-mode): popup menu entry + + * rails-core.el (rails-core:model-exist-p): return nil if observer + or mailer + (rails-core:migration-file): allow passing a migration name + without number (ex. "CreateUsers") + (rails-core:current-model): added migrations support + (rails-core:migration-file): renamed from migrate-file + + * rails-controller-layout.el (rails-controller-layout:switch-to): + added migration support + + * inflections.el (singularize-string, pluralize-string): allow passing nil + +2007-03-26 Dmitry Galinsky + + * rails-find.el (rails-find:gen): call ido-find-file if possible + + * rails-rake.el (rails-rake:report-result): prints results of all tests + + * rails-ruby.el: fixed compilation warnning + + * rails-rake.el, rails-scripts.el: updated, printed result of tests + + * rails-lib.el, rails.el: fix compilation error [#9547] + + * rails.el (rails-templates-list): added support "erb" and "liquid" + + * rails-lib.el: fixed compilation warnings + + * rails-rake.el: fixed compilation warnings + + * rails-ui.el: updated + + * rails-scripts.el: updated + (rails-script:rake-tests-alist): removed + + * rails-ruby.el (run-ruby-in-buffer): moved from rails-scripts.el + + * rails-rake.el: created + + * rails-core.el (rails-core:migrations): added optional parameter to stip numbers + + * rails-cmd-proxy.el (rails-cmd-proxy:start-process): created + + * rails-scripts.el (rails-script:sentinel-proc): updated + (rails-script:generation-buffer-name): removed + (rails-script:run): updated + (rails-script:create-project): updated + + * rails-lib.el (buffer-visible-p): created + + * rails-core.el (rails-core:file): return nil if FILE-NAME is nil + +2007-03-25 Dmitry Galinsky + + * rails-log.el (rails-log:buffer-name): renamed from rails-log:get-buffer-name + + * rails-core.el (rails-core:add-to-rails-menubar): removed + (rails-core:mailer-file): maked as alias + (rails-core:controller-name): renamed from rails-core:full-controller-name + (rails-core:regex-for-match-view): cleanup + (rails-core:button-action): created + + * rails-find.el: created + + * rails-navigation.el: moved rails-find-* to separate file rails-find.el + + * rails.el (rails-find-file-function): removed variable + + * rails-ui.el (rails-minor-mode-menu-bar-map): update indentation + + * rails-scripts.el: refactored code + +2007-03-24 Dmitry Galinsky + + * rails-unit-test-minor-mode.el (rails-unit-test-minor-mode): fixed + + * rails-navigation.el (rails-line-->controller+action): replace + call rails-core:open-controller+action to + rails-controller-layout:switch-to-action-in-controller + + * rails-snippets.el (snippet-insert): added advice + (rails-snippets-menu-list): updated snippets + + * rails-ws.el (rails-ws:sentinel-proc): change format of the message + (rails-ws:start): fixed + + * rails-navigation.el: removed old style goto-* functions + + * rails.el (ruby-mode-hook): bind ruby-toggle-string<>symbol to [C-:] in ruby mode + + * rails-ui.el (rails-minor-mode-map): added [M-S-up] & [M-S-down] hotkeys + + * rails-snippets.el (rails-snippets-menu-list): updated, split snippets to separate modes + + * rails-ruby.el (ruby-toggle-string<>simbol): created + + * rails-migration-minor-mode.el (rails-migration-minor-mode): created + +2007-03-23 Dmitry Galinsky + + * rails.el (ruby-mode-hook): added [C-:] hotkey to easy switch between strings and symbols + + * rails-ruby.el (ruby-toggle-string<>simbol): created + + * rails.el (ruby-mode-hook): added [C-c f] hotkey to popup `major-menu-mode` menu + + * rails-core.el (rails-core:menu-position): created variable + (rails-core:menu): using `rails-core:menu-position` + + * rails-snippets.el (rails-snippets-menu-list): splited snippets into separate modes + + * rails-navigation.el (rails-nav:goto-fixtures): created + + * rails-core.el (rails-core:fixtures): created + + * rails-view-minor-mode.el (rails-view-minor-mode): cleanup and switch to use + `rails-controller-layout`, added support mailers + + * rails-unit-test-minor-mode.el (rails-unit-test-minor-mode): added support mailers + + * rails-navigation.el (rails-nav:goto-mailers): created + + * rails-model-layout.el: added support mailers + + * rails-mailer-minor-mode.el: created + + * rails-helper-minor-mode.el: cleanup and switch to use `rails-controller-layout` + + * rails-functional-test-minor-mode.el: cleanup and switch to use + `rails-controller-layout`, added support mailers + + * rails-core.el: created functions: rails-core:model-exist-p, + rails-core:mailer-file, rails-core:mailer-p, rails-core:mailers, + rails-core:current-function-name. Cleanup unsed functions. + + * rails-controller-minor-mode.el: cleanup and switch to use `rails-controller-layout` + + * rails-controller-layout.el: created + + * rails.el (rails-directory<-->types): rename fixtures to fixture + + * rails-unit-test-minor-mode.el: using functions from `rails-model-layout` to navigate + + * rails-model-minor-mode.el: using functions from `rails-model-layout` to navigate + + * rails-model-layout.el: created + + * rails-lib.el (string=~): created, by Howard Yeh + + * rails-fixture-minor-mode.el: created + + * rails-core.el (rails-core:controller-exist-p): create + (rails-core:fixture-file): used `pluralize-string` to match fixture + (rails-core:current-model): used `pluralize-string` to match fixture + + * inflections.el: created, by Howard Yeh + + * rails-cmd-proxy.el: created + + * rails-ws.el (rails-ws:stop): stopped server with interrupt-process + (rails-ws:start): starting server useing rails-cmd-proxy:start-process-shell-command + + * rails.el (rails-apply-for-buffer-type): added support to load + new style submodes + + * rails-lib.el (merge-abbrev-tables): created this function + + * moved all rails-for-* to rails-*-minor-mode + + * rails-snippets.el (rails-snippets-menu-list): closed bug #9460, + incorect indentation in snippets + +2007-03-19 Dmitry Galinsky + + * rails-scripts.el (rails-rake): restore ask to save modified + buffers before run rake test:* + + * rails-core.el (rails-core:layout-file): support template types + on go to layout menu + + * rails-for-controller.el (rails-controller:create-view-for-action): create function + (rails-controller:switch-to-view): allow select template type on create + + * rails.el: add support haml template engine + +2007-03-15 Dmitry Galinsky + + * rails-scripts.el (rails-rake-tests): using `compile` + + * rails-ui.el (rails-minor-mode-menu-bar-map): add (interactive) + to lambda functions + +2007-03-13 Dmitry Galinsky + + * rails-for-model.el: create + + * rails-for-unit-test.el: create + + * rails-core.el (rails-core:buffer-type): support lambda + expression in rails-directory<-->types + + * rails-scripts.el (rails-rake): ask to save modified buffers + before run rake test:* + +2007-02-02 Dmitry Galinsky + + * rails-snippets.el (rails-snippets-menu-list): bug #8381 (bad + "ff" snippet) + +2007-01-30 Dmitry Galinsky + + * rails-snippets.el: create and place into it all snippets code + + * rails-ui.el: drop snippets declaration, make separate menu + "Snippets" + +2007-01-29 Dmitry Galinsky + + * rails-lib.el: create function compile-snippet and + create-snippets-and-menumap-from-dsl + + * rails-ui.el (ruby-mode-abbrev-table): add mai snippet (add_index + in migrations) + + * rails.el (rails-db-parameters): patch #8232 (by Ronaldo Ferraz) + Console is not starting because env is not quoted in the function + call, resulting in a Ruby error + + * rails-ws.el, rails-wi.el: patch #8233 (by Ronaldo Ferraz) Fixes + a couple of UI messages and allows web server selection auto-save + +2007-01-28 Dmitry Galinsky + + * *.el: fix bytecompile warnings + + * rails-core.el: remove dublicate of fucntion rails-core:helper-file + + * rails-navigation.el: patch #8228 + + * rails.el (ruby-mode-hook): remove variables tab-width and indent-tabs + + * rails-ws.el: make variable rails-ws:default-server-type are + customized (to fix #8223) + + * rails-lib.el: add cross declaration indent-or-complete (to fix #8221) + +2007-01-27 Dmitry Galinsky + + * rails-for-controller.el (rails-controller:switch-with-menu): + call rails-controller:switch-to-view for "Current view" + + * rails-log.el (rails-log:open-file): run rails-minor-mode in log buffer + + * rails-ui.el: update "Open log" menu + + * rails.el: relete function rails-open-log, and place all log + related fuction to rails-log.el + + * rails-log.el: create + + * rails-lib.el (apply-colorize-to-buffer): create + + * rails-ws.el: update rails-ws:*browser* functions + + * rails.el (rails-directory<-->types): add plugin directory + + * rails-for-view.el (rails-view:switch-with-menu): update menu title + + * rails-for-plugin.el: create + + * rails-for-helper.el (rails-helper:switch-with-menu): update menu + title + + * rails-for-functional-test.el (rails-for-functional-test:switch-with-menu): + update-menu-title + + * rails-for-controller.el (rails-controller:switch-with-menu): + update menu title + + * rails-core.el (rails-core:menu): fix menu position + add new functions rails-core:plugin-files, rails-core:plugin-file, + rails-core:current-plugin + +2007-01-26 Dmitry Galinsky + + * rails-ui.el (rails-minor-mode-menu-bar-map): rename menu item + WEBrick to Web Server. Update menu group Web Server + + * rails.el (rails-ws): add variable rails-default-environment + + * rails-ws.el: rename from rails-webrick, complete rewrite and + cleanup + + * rails-navigation.el (rails-nav:create-goto-menu): now support + nested lists in append-to-menu (ex. (list (cons) (cons))) + (rails-nav:create-new-layout): cleanup + (rails-nav:goto-layouts): cleanup + + * rails-core.el + (rails-core:plugins): fix invalid path passed into directory-files + (rails-core:layouts): new function + + * rails-for-view.el (rails-for-view): remove detect mmm-mode, + always apply hotkeys to mmm-mode-map (if exist) + + * rails.el: apply ruby-mode to *.rake files and setup utf8 encoding + + * rails-lib.el (list->alist): skip if LIST entry is list + +2007-01-25 Dmitry Galinsky + + * rails-navigation.el, rails-ui.el: add rails-nav:goto-plugins + + * rails-ruby.el: remove advice for ruby-indent-command + + * rails-lib.el (def-snips): fix indentation + + * rails-core.el: fix list ordered in rails-core:* add + rails-core:observer-p + + * rails.el (rails-open-log): fix path to log file + + * rails.el: cleanup initialization code + +2007-01-24 Dmitry Galinsky + + * rails-ui.el: create key bindings and menu items to latest + changes + + * rails-scripts.el: add more targets to generate and destroy + cleanup targets create variables: rails-generate-params-list, + rails-destroy-params-list + + * rails-navigation.el: create another implementation menu: + rails-nav:goto-file-with-menu-from-list, rewrite rails:nav:goto-* + to use this + + * rails-core.el: rewrite rails-core:(controllers,models,etc), add + more functions to lookup plugins, migrations, etc + +2007-01-23 Dmitry Galinsky + + * rails-scripts.el (rails-rake-tests): store selected value, set it to default + + * rails-webrick.el (rails-webrick:start): fix #8088 (Akira Ikeda) + + * rails-core.el: add rails-core to eval-when-compile + + * rails-ui.el (rails-minor-mode-map): rebind some hotkeys fix + snippents (bad indent after end ruby keyword) + + * rails-scripts.el: complete rewrite all script functions to using autocomplete + + * rails.el (rails-db-parameters): apply patch #8065 (thanks Akira Ikeda) + +2007-01-22 Dmitry Galinsky + + * rails-ui.el (ruby-mode-abbrev-table): fix indentation for `end' ruby keyword + +2007-01-21 Dmitry Galinsky + + rename rails-for-rhtml to rails-for-view add rails-for-helper + functionaly add *:switch-with-menu for helpers, functional-test + cleanup rails-for-controller, rails-for-view + + * rails.el: remove rails-for-alist using rails-directory<-->type + for match current type and apply specific mode + + * rails-scripts.el (rails-run-script): fix #8035 + + * rails-lib.el (yml-value): fix #8037 + +2007-01-13 Dmitry Galinsky + + * rails-core.el: apply patch #7342 + +2007-01-09 ronaldo + + * rails.el: added a host parameter to the rails-db-conf struct + fixed problems with YAML parameter parsing + in (rails-db-parameters) simplified (rails-db-parameters) to avoid + using database.yml directly + (rails-run-sql) now changes directory to the root for the benefit + of sqlite3 + + * rails-lib.el: changed yml-next-value to yml-value and added a + broader search scope + +2007-01-08 ronaldo + + * rails.el: added support for other ri utilities (fast-ri, for + example) added support for coloring on ri buffer + +2006-12-25 Dmitry Galinsky + + * rails-lib.el (yml-next-value): return nil if key not found + + * rails.el: add sqlite support + +2006-12-18 Dmitry Galinsky + + * rails-core.el (rails-core:class-by-file): fix lowercase letter after "::" + + * rails-for-rhtml.el: apply patch #7300 + + * rails-for-controller.el: apply patch #7300 + + * rails.el: apply patch #7301, #7295 + + * rails-lib.el (rails-lib:run-secondary-switch): apply patch #7314 + +2006-12-11 ronaldo + + * rails-scripts.el: fixed problems with prompt patterns in the + inferior ruby mode call + +2006-12-05 ronaldo + + * rails.el: added support for minimal helper switching + + * rails-for-helper.el: added support for minimal helper switching + +2006-12-03 ronaldo + + * rails.el: added a customization option to use Emacs w3m for API + browsing + + * rails-lib.el: added a function to aid in browsing the API with + Emacs w3m + +2006-12-03 Dmitry Galinsky + + * rails-ruby.el (ruby-indent-command): using around filter + + * rails.el (ruby-mode-hook): symbols _ and : interpreted as word + + * rails-core.el (rails-core:class-by-file): apply patch #6377 + + * rails-webrick.el: Apply patch from Ray Baxter: remove + rails-webrick:open-url and add rails-webrick:server-name + +2006-12-01 ronaldo + + * rails.el: fixed to load needed ruby inferior mode (inf-ruby) + added a couple of new customization options + + * rails-ui.el reordered the snippets menu alphabetically changed + the key sequences for the tests scripts to use a more intuitive + set + + * rails.el: refactored and renamed rails-configured-api-root to + rails-has-api-root added a minor customization to the default + layout template minor documentation fixes + + * rails-lib.el: add (rails-alternative-browse-url) + + * rails-scripts.el: added an indication of the task being run on + rake calls fixed the inferior-mode call in (run-ruby-in-buffer) to + work on w32 added an alternative way to browse API URLs on Windows + in case the primary way fails added messages to the test scripts + +2006-12-01 Dmitry Galinsky + + * rails-navigation.el: add "go to action" "go to partial" now + support insert_html|replace_html + + * rails-core.el: add rails-core:view-name + +2006-11-30 ronaldo + + * *.el: fixed documentation strings to better reflect Emacs + conventions + + * rails-ruby.el: changed ruby-indent-or-complete into an + advice (it works in text-only terminals now) * rails-ui.el: added + a bunch of new snippets refactored key sequences to follow proper + mode conventions added new menus (rake tests, customize, start + default webrick) changed switch menu to use a richer set of + options + + * rails-scripts.el: added rake tasks for tests (all, integration, + functional, unit and recent tests) + + * rails-core.el: added a check for the API docs, allowing the user + to generate them if needed added a check for the existence of the + API files to avoid unnecessary messages + + * rails.el: changed the default layout template and moved it to a + customization variable + +2006-11-29 ronaldo + + * rails-for-controller.el: fixed to use rails-core:menu + + * rails-core.el: added a way to automatically recognize if it's + running under a text-only terminal to avoid crashing Emacs when + using x-popup-menu + + * rails-for-rhtml: changed to use rails-core:menu instead of + x-popup-menu + +2006-11-28 ronaldo + + * rails-core.el: created a set of customization options + (customize-group 'rails) + + * rails-for-rhtml: fixed the partial creation functions to allow + both transient and non-transient markers + +2006-10-03 Dmitry Galinsky + + * rails.el: do not apply untabify in makefile-mode + + * rails-ruby.el: small fix in ruby-indent-or-complete + +2006-06-10 CrazyPit + + * rails-core.el: rails-quoted-file (needed to fix bug with space + in path) + + * rails-navigation.el: new rules to + rails-goto-file-on-current-line, rails-find for fixtures + + * rails.el: rails-browse-api + + * rails-lib.el: new helper functions write-string-to-file, + read-from-file + + * rails-webrick.el: fix bug with space in path + + * rails-scipts.el: add caching for rake tasks + +2006-04-19 CrazyPit + + * rails-navigation.el: rails-nav:create-new-layout updated, text + moved to variable rails-layout-template, name add. rails goto file + from string for layout now used rails-nav:create-new-layout if + layout with this name does not exist + + * rails.el: add modify syntax to ruby-mode-hook for "!" symbol, + add local modifying syntax for rails-browse-api-at-point + + +2006-04-17 Dmitry Galinsky + + * rails-ui.el: apply snippets to nxml-mode-abbrev-table + +2006-04-11 Dmitry Galinsky + + * rails-for-controller.el + (rails-controller:switch-to-view): using rais-core:menu + (rails-controller:switch-with-menu): using rails-core:menu + + * rails-navigation.el: new function rails-nav:create=new-layout + (rails-nav:goto-file-with-menu): add optional parameter + append-to-menu + + * rails-for-rhtml.el: drop + rails-for-rhtml:switch-to-controller-action + + * rails-for-controller.el: drop + rails-for-controller:switch-by-current-controller, + rails-for-controller:switch-to-functional-test, + rails-for-controller:switch-to-helper, + rails-for-controller:switch-to-view2, + rails-for-controller:switch-to-controller + rails-for-controller:switch-to-views + (rails-controller:switch-with-menu): mark partials, add separator + + * rails-lib.el (snippet-menu-line): add snippet abbrevation in + menu + + * rails-ui.el (rails-minor-mode-menu-bar-map): drop menu + items [webrick brows], [webrick auto-brows] + +2006-04-04 CrazyPit + + * rails-navigation.el, rails-lib.el, rails-ui.el: rails-lib:goto-* + renamed to rails-nav:goto-* and moved to rails-navigation.el + +2006-04-01 CrazyPit + + * rails-core.el: new function js-file, partial-name updated. + + * rails-navigation.el: new rule for switching line to + file (rails-line-->js) + + * rails-scipts.el: bugfix in run-ruby-in-buffer + + * rails-ui.el: new snippet %for + + * rails-webrick.el: rails-webrick:start now interactive, + auto-open-browser work only in controllers and views. + + * rails.el: bugfix in rails-create-tags + +2006-03-31 CrazyPit + + * rails-navigation.el: rails-goto-file-from-file change, now use + funcall instead rails-goto-menu-call, function + rails-goto-menu-call removed. + + * rails-for-controller.el: views-for-current-action now using lexical closures. + + * rails-lib.el: fix bug in snippet-menu-line + + * rails.el: fix bug in rails-get-api-entries + +2006-03-30 CrazyPit + + * rails.el: interface to Rails HTML API + documentaion. rails-browse-api-at-point, rails-browse-api-method, + rails-browse-api-class, rails-get-api-entries + + * rails-lib.el: new function capital-word-p + + * rails-scipts.el: Rake integration - new functions rails-rake and + rails-rake-tasks. Running ruby consoles and breakpointers in + separated buffers for each project: new functions + run-ruby-in-buffer, rails-run-interactive and rails-run-console, + rails-run-breakpointer updated + + * rails-core.el new macro in-root + + * rails.el: new variable rails-tags-command, rails-open-log now + interactive + cleanup, rails-create-tags cleanup, new hook for + dired mode + + * rails-navigation.el: new variable rails-find-file-function, 3 + new rails-finds. + + * rails-ui.el: cleanup, add many new hotkeys + +2006-03-28 CrazyPit + + * rails-ui.el: create rails-ui.el, move UI code from rails.el to + rails-ui.el + + * rails-navigation.el: rails-goto-controller-->view, + rails-goto-view-->controller rails-goto-all-->simple, + rails-goto-all-->helper, rails-goto-all-->functional-test, + rails-goto-all-->controller extracted to other files. Refactoring + of rails-goto-file-from-file-actions and rails-goto-file-from-file + now run-time generation and invisible, helper function + rails-goto-menu-call. menu items available. + + * rails-for-rhtml.el: switch-to-controller-action added + + * rails-for-controller.el: + views-for-current-action. switch-by-current-controller, + switch-to-functional-test, switch-to-helper, switch-to-view2, + switch-to-controller -- extracted with renaming from + rails-navigation.el. + + * rails-core.el: fix in functional-test-file, + + long-controller-name added, rails-core:menu upadte (posn-at-point + call added) + +2006-03-28 Dmitry Galinsky + + * rails-for-controller.el: new functions + rails-controller:get-current-controller-and-action, + rails-controller:switch-with-menu + (rails-for-controller): setup variables rails-primary-switch-func, + rails-secondary-switch-func + + * rails-core.el (rails-core:helper-file): fix invalid path + (rails-core:functional-test-file): fix invalid path + (rails-core:get-view-files): ACTION is optional parameter + + * rails-for-rhtml.el: new functions rails-rhtml:switch-with-menu, + rails-rhtml:switch-to-helper, + rails-rhtml:get-current-controller-and-action + (rails-for-rhtml): setup variables rails-primary-switch-func, + rails-secondary-switch-func + + * rails.el: add variables rails-primary-switch-func, + rails-secondary-switch-func + + * rails-lib.el: add interactive functions + rails-lib:run-primary-switch-func, + rails-lib:run-secondary-switch-func + +2006-03-28 CrazyPit + + * rails.el: rails-run-sql with stuff + + * rails-navigation.el: rails finds added + + * rails-scipts.el: generators/destroyers, shells and rails-create + project added from test branch + + * rails-navigation.el: rails-goto-file-on-current-line and + rails-goto-file-from-file function with stuff added from test + branch + +2006-03-27 CrazyPit + + * rails-lib.el: many helper functions from test branch added + + * rails-core.el: functions from test branch added, class-by-file + updated + new variable rails-core:class-dirs, get-model-view + updated + + * rails-webrick.el: open-browser updated, + open-browser-on-controller, auto-open-browser added + +2006-03-22 Dmitry Galinsky + + * rails-core.el: add macro rails-core:local-add-to-rails-menubar + +2006-03-21 Dmitry Galinsky + + * rails.el: split into two files + + * rails-core.el: move to this all helper function and macros + diff --git a/emacs.d/rails/.svn/text-base/History.svn-base b/emacs.d/rails/.svn/text-base/History.svn-base new file mode 100644 index 0000000..b1cfaeb --- /dev/null +++ b/emacs.d/rails/.svn/text-base/History.svn-base @@ -0,0 +1,100 @@ +0.5.99.5 +* Fixed bug [#10613]: Wrong comparison of emacs-major-version +* Apply patch [#10532]: allows '-' to occur in the errror filepath (thanks Peter Williams) +* Fixed bug [#10417]: ruby-flymake had applying only if flymake is + available. +* Raise a error if emacs-rails run on old version of Emacs (less 22) +* Updated view mode of "views" +* Fixed bug [#10357]: code expansion shouldn't occur in comment lines. + +0.5.99.4 +* Added the test/test_helper in list of helpers. +* Added list of templates in speedbar. +* Fixed bug [#10056]: when one open file in a read only directory, + flymake try to open a new file and failed (thanks Rémi Vanicat). +* Fixed bug [#9991]: allow setup key prefix for rails-minor-mode. +* Fixed bug [#10053]: don't match rhtml/rxml/rjs files in test output (thanks Rémi Vanicat). + +0.5.99.3 +* Added speedbar integration, type [F11] to toogle speedbar. +* Fixed bug #9880: the hotkey "C-c ." conflicted with ECB, changed to "C-c C-c ,". +* New hotkeys, to easy switch without a popup menu between a + controller or a model related files. + In model layout: + - "C-c m" go to model + - "C-c u" go to unit test + - "C-c g" go to migration + - "C-c c" go to controller + - "C-c x" go to fixture + - "C-c n" go to mailer + In controller layout: + - "C-c g" go to migration + - "C-c m" go to model + - "C-c h" go to helper + - "C-c f" go to functional test + - "C-c c" go to controller + - "C-c u" go to unit test +* Fixed bug #9783 (remove-postfix: Wrong type argument: arrayp, nil). +* Updated the compilation output, for better highlight of error and warnings. +* Added the flymake support to on the fly syntax checked in the ruby-mode. + +0.5.99.2 +* Added new dynamic snippets for RESTful, + for instance: in controller UsersController type "rshow" + will be expand to "user_url(@user)" and display tooltip "GET /users/1". +* Added migration support - migrate, migrate to previous version, + migrate to version. +* Created separate menubar entries named "Navigate", "Database", "Tests". +* Fixed bug #9721: Emacs 21.4.x can't load rails-core.el with error "Wrong + number of arguments: #". +* Added support pcompletion in ruby-mode (if possible). +* Added new "Go to unit tests" and "Go to functional tests" hotkeys + and menu entries. +* Added tests integration with the compile library. +* New [C-c /] hotkey to toggle output window. + +0.5.99.1 +* Fixed bug #9619, script/server fails to start with [C-c C-c w s]. +* Added hotkeys for tests: + - [C-c C-c .] running a test for current model/controller (global) + - [C-c .] running a test for current method (in a functional/unit test) +* Prints total of tests, asertions, failures, errors after end of + tests running. +* Fixed recursive "require" error after compilation #9547. + +0.5.99 +* Improvement of tests and rails scripts output; run asynchronous, + colorize output, etc. +* New [C-:] hotkey to easy switch between strings and symbols at point + in ruby-mode. +* New [C-c f] hotkey to popup a menu with list of functions in + ruby-mode. + +0.5.4 +* Added mailers support. +* Added fixtures support. +* Fixed incorrect indentation in snippets [#9460]. +* Added support template types in layouts menu. +* Added support haml template engine. +* Use `compile` to run `rake tests`. +* Ask to save modified buffers before run rake. +* Added "quick switch" to support models and unit tests. + +0.5.3 +* Create separate menubar entry "Snippets". +* Allow web server selection auto-save. +* Corrected errors at work with sql. +* Fixed byte-compile warnings. + +0.5.2 +* Fixed bugs: #8221, #8223. +* Using system `tail` program for display log files. + +0.5.1 at 27.01.2007 +* Support plugin: quick menu "Go to plugins" and navigate inside + plugin. +* Update Web Server support, add Lighttd to list of supported servers. +* Automatic apply ruby-mode to *.rake files and setup utf-8 encoding. +* Add more targets to generate/destroy. +* Add autocomplete in generate/destroy/rake/test commands. +* Small fixes indentation in snippets. diff --git a/emacs.d/rails/.svn/text-base/README.svn-base b/emacs.d/rails/.svn/text-base/README.svn-base new file mode 100644 index 0000000..f292af8 --- /dev/null +++ b/emacs.d/rails/.svn/text-base/README.svn-base @@ -0,0 +1,142 @@ +It is minor mode for editing "Ruby On Rails":ror code with +"Emacs":emacs. This minor mode makes your work much easier and user +friendly + + +== Instalation + +You need download last release from RubyForge page +"http://rubyforge.org/projects/emacs-rails" and and unpack +it to directory containing libraries of Emacs, by default it's +$HOME/.emacs.d/ + +You can also use SVN + + cd $HOME/.emacs.d/ + svn co svn://rubyforge/var/svn/emacs-rails/trunk emacs-rails + +Download and install required libraries + +* "http://www.kazmier.com/computer/snippet.el":snippets +* "http://www.webweavertech.com/ovidiu/emacs/find-recursive.txt":frecursive + +*Alert:* From 0.44 release emacs-rails will require the + "inf-ruby":inf-ruby. + +After that you must add this code in $HOME/.emacs + + (setq load-path (cons "~/.emacs.d/rails" load-path)) + (require 'rails) + +For Windows users: you can use your help in CHM format (the default +*ri*). This will require utility "KeyHH":keyhh. And add to a file +.emacs + + (setq rails-chm-file "full_path_to_rails_chm_manual") + +After that you can run Emacs. Almost all available actions are in the +menu [Ruby On Rails]. The snippets are in the menu [Ruby On +Rails-Snippets], for the convenience, they are divided into +categories. + +To change default setting, select [Ruby On Rails - Customize]. + +== First Acquaintance + +Go to directory with your rails application and open any file in Emacs: + + cd $HOME/project/simple_rails_application + emacs app/controllers/application.rb + +There must be "RoR" sign in the list of active minor-modes in status +bar. Thi means, that emacs-rails is enabled and ready to help you in +your not so easy work. + +Almoust all actions are in the "RubyOnRails" menu. You can check it +out and try some of them. Don't forget, that menu will help you only +first time. After that you better use hot keys for effective work, you +can find them in the brackets. + +== Features + +* TextMate-like snippets +* Display of colored log files +* Integration with script/generate and script/destroy (controller, + model, scaffold, migration, etc) +* Integration with script/console and script/breakpointer +* Run rake %(key)C-c C-c r% +* Quick start svn-status in RAILS_ROOT %(key)f9% +* Documentation search using *ri* or *chm* file and Rails API + reference in HTML %(key)f1% +* Quick access to the main configuration files +* Automatic TAGS generation in RAILS_ROOT directory + +=== Management of WEBrick/Mongrel + +* Your can select Webrick, Mongrel or Lighttpd +* Start/stop application server %(key)C-c C-c w s% +* Automatic browsing on current action (from view or controller) + %(key)C-c C-c w a% + +=== Navigation in RAILS_ROOT hierarchy + +* Quick switch stylesheets, javascripts, migrations, layouts, helpers, + controllers, models, observers, plugins +* In controller file: go to views, functional test, helper + %(key)C-down% +* Switch between action/view %(key)Ñ-up% +* Go to file in current line (example: cursor at line [redirect_to + controller => :home, :action => "show"], will be open action "show" + in "home" controller) %(key)C-RET% +* Quick access to the main configuration files using menu + +Other hot keys + +* %(key)C-c C-c g g% rails-nav:goto-migrate +* %(key)C-c C-c g j% rails-nav:goto-javascripts +* %(key)C-c C-c g s% rails-nav:goto-stylesheets +* %(key)C-c C-c g l% rails-nav:goto-layouts +* %(key)C-c C-c g h% rails-nav:goto-helpers +* %(key)C-c C-c g c% rails-nav:goto-controllers +* %(key)C-c C-c g m% rails-nav:goto-models +* %(key)C-c C-c g o% rails-nav:goto-observers +* %(key)C-c C-c g p% rails-nav:goto-plugins + +=== ERb refactoring + +* Create partial from selection %(key)C-c p% +* Create helper from block %(key)C-c b% + += Bugs + +emacs-rails designed for current CVS version of Emacs (future Emacs22) +more probably some functions will not work in older version, or will +work with errors, so if it is possible, try to update. I will not tell +you why you should use CVS version, just take my word. + +In some version from CVS some time ago, when you use emacs-rails, +sintax highlight in rhtml was not working, so just update to the +newest version from CVS. + +If you find error, place it description in "BugTrack":bugtrack. + += Links + +* "Emacs W32 (CVS version for Windows)":http://ourcomments.org/Emacs/EmacsW32.html +* "HowToUseEmacsWithRails":http://wiki.rubyonrails.org/rails/pages/HowToUseEmacsWithRails +* "http://scott.elitists.net/users/scott/posts/rails-on-emacs":http://scott.elitists.net/users/scott/posts/rails-on-emacs +* "http://www.emacswiki.org/cgi-bin/wiki/RubyMode":http://www.emacswiki.org/cgi-bin/wiki/RubyMode +* "Emacs screencast":screencast +* "Effective Emacs":effectiveemacs + +[bugtrack]http://rubyforge.org/tracker/?atid=5809&group_id=1484&func=browse +[effectiveemacs]http://steve.yegge.googlepages.com/effective-emacs +[screencast]http://emacsonrails.drozdov.net/ +[lisp]http://en.wikipedia.org/wiki/Lisp_programming_language +[frecursive]http://www.webweavertech.com/ovidiu/emacs/find-recursive.txt +[keyhh]http://www.keyworks.net/keyhh.htm +[snippets]http://www.kazmier.com/computer/snippet.el +[emacs]http://www.gnu.org/software/emacs/ +[ror]http://rubyonrails.org +[emacs-rails]http://rubyforge.org/projects/emacs-rails +[inf-ruby]http://svn.ruby-lang.org/cgi-bin/viewvc.cgi/trunk/misc/inf-ruby.el?view=co \ No newline at end of file diff --git a/emacs.d/rails/.svn/text-base/inflections.el.svn-base b/emacs.d/rails/.svn/text-base/inflections.el.svn-base new file mode 100644 index 0000000..64b5077 --- /dev/null +++ b/emacs.d/rails/.svn/text-base/inflections.el.svn-base @@ -0,0 +1,114 @@ +;;; inflections.el --- + +;; Copyright (C) 2006 Dmitry Galinsky + +;; Authors: Dmitry Galinsky , +;; Howard Yeh + +;; Keywords: ruby rails languages oop +;; $URL$ +;; $Id$ + +;;; License + +;; This program is free software; you can redistribute it and/or +;; modify it under the terms of the GNU General Public License +;; as published by the Free Software Foundation; either version 2 +;; of the License, or (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program; if not, write to the Free Software +;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. + +;;; Code: + +(defvar inflection-singulars nil) +(defvar inflection-plurals nil) +(defvar inflection-irregulars nil) +(defvar inflection-uncountables nil) + +(defmacro define-inflectors (&rest specs) + (loop for (type . rest) in specs do + (case type + (:singular (push rest inflection-singulars)) + (:plural (push rest inflection-plurals)) + (:irregular (push rest inflection-irregulars)) + (:uncountable (setf inflection-uncountables + (append rest inflection-uncountables)))))) + +(define-inflectors + (:plural "$" "s") + (:plural "s$" "s") + (:plural "\\(ax\\|test\\)is$" "\\1es") + (:plural "\\(octop\\|vir\\)us$" "\\1i") + (:plural "\\(alias\\|status\\)$" "\\1es") + (:plural "\\(bu\\)s$" "\\1ses") + (:plural "\\(buffal\\|tomat\\)o$" "\\1oes") + (:plural "\\([ti]\\)um$" "\\1a") + (:plural "sis$" "ses") + (:plural "\\(?:\\([^f]\\)fe\\|\\([lr]\\)f\\)$" "\\1\\2ves") + (:plural "\\(hive\\)$" "\\1s") + (:plural "\\([^aeiouy]\\|qu\\)y$" "\\1ies") + (:plural "\\(x\\|ch\\|ss\\|sh\\)$" "\\1es") + (:plural "\\(matr\\|vert\\|ind\\)ix\\|ex$" "\\1ices") + (:plural "\\([m\\|l]\\)ouse$" "\\1ice") + (:plural "^\\(ox\\)$" "\\1en") + (:plural "\\(quiz\\)$" "\\1zes") + + (:singular "s$" "") + (:singular "\\(n\\)ews$" "\\1ews") + (:singular "\\([ti]\\)a$" "\\1um") + (:singular "\\(\\(a\\)naly\\|\\(b\\)a\\|\\(d\\)iagno\\|\\(p\\)arenthe\\|\\(p\\)rogno\\|\\(s\\)ynop\\|\\(t\\)he\\)ses$" "\\1\\2sis") + (:singular "\\(^analy\\)ses$" "\\1sis") + (:singular "\\([^f]\\)ves$" "\\1fe") + (:singular "\\(hive\\)s$" "\\1") + (:singular "\\(tive\\)s$" "\\1") + (:singular "\\([lr]\\)ves$" "\\1f") + (:singular "\\([^aeiouy]\\|qu\\)ies$" "\\1y") + (:singular "\\(s\\)eries$" "\\1eries") + (:singular "\\(m\\)ovies$" "\\1ovie") + (:singular "\\(x\\|ch\\|ss\\|sh\\)es$" "\\1") + (:singular "\\([m\\|l]\\)ice$" "\\1ouse") + (:singular "\\(bus\\)es$" "\\1") + (:singular "\\(o\\)es$" "\\1") + (:singular "\\(shoe\\)s$" "\\1") + (:singular "\\(cris\\|ax\\|test\\)es$" "\\1is") + (:singular "\\(octop\\|vir\\)i$" "\\1us") + (:singular "\\(alias\\|status\\)es$" "\\1") + (:singular "^\\(ox\\)en" "\\1") + (:singular "\\(vert\\|ind\\)ices$" "\\1ex") + (:singular "\\(matr\\)ices$" "\\1ix") + (:singular "\\(quiz\\)zes$" "\\1") + + (:irregular "person" "people") + (:irregular "man" "men") + (:irregular "child" "children") + (:irregular "sex" "sexes") + (:irregular "move" "moves") + + (:uncountable "equipment" "information" "rice" "money" "species" "series" "fish" "sheep")) + +(defun singularize-string (str) + (when (stringp str) + (or (car (member str inflection-uncountables)) + (caar (member* str inflection-irregulars :key 'cadr :test 'equal)) + (loop for (from to) in inflection-singulars + for singular = (string=~ from str (sub to)) + when singular do (return singular)) + str))) + +(defun pluralize-string (str) + (when (stringp str) + (or (car (member str inflection-uncountables)) + (cadar (member* str inflection-irregulars :key 'car :test 'equal)) + (loop for (from to) in inflection-plurals + for plurals = (string=~ from str (sub to)) + when plurals do (return plurals)) + str))) + +(provide 'inflections) diff --git a/emacs.d/rails/.svn/text-base/predictive-prog-mode.el.svn-base b/emacs.d/rails/.svn/text-base/predictive-prog-mode.el.svn-base new file mode 100644 index 0000000..8bbb88c --- /dev/null +++ b/emacs.d/rails/.svn/text-base/predictive-prog-mode.el.svn-base @@ -0,0 +1,69 @@ +;;; predictive-prog-mode.el --- + +;; Copyright (C) 2006 Dmitry Galinsky + +;; Authors: Dmitry Galinsky , + +;; Keywords: ruby rails languages oop +;; $URL: svn+ssh://rubyforge/var/svn/emacs-rails/trunk/rails.el $ +;; $Id: rails.el 149 2007-03-29 15:07:49Z dimaexe $ + +;;; License + +;; This program is free software; you can redistribute it and/or +;; modify it under the terms of the GNU General Public License +;; as published by the Free Software Foundation; either version 2 +;; of the License, or (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program; if not, write to the Free Software +;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. + +;;; Code: + +(eval-when-compile + (require 'predictive nil t) + (require 'completion-ui nil t)) + +(require 'flyspell) + +(defconst predictive-prog-text-faces + '(font-lock-comment-face font-lock-doc-face) + "Faces corresponding to text in programming-mode buffers.") + +(defvar predictive-prog-mode-main-dict nil) + +(defun activate-predictive-inside-comments (start end len) + "Looking at symbol at point and activate the `predictive-mode' +if there a string or a comment." + (save-excursion + (let ((p (get-text-property (- (point) 1) 'face)) + (f (get-text-property (point) 'face))) + (if (or (memq f predictive-prog-text-faces) + (memq p predictive-prog-text-faces)) + (setq predictive-main-dict predictive-prog-mode-main-dict) + (setq predictive-main-dict nil))))) + +(defun predictive-prog-mode () + "Enable the `predictive-mode' inside strings and comments +only, like `flyspell-prog-mode'." + (interactive) + (when (fboundp 'predictive-mode) + (set (make-local-variable 'predictive-main-dict) nil) + (set (make-local-variable 'predictive-prog-mode-main-dict) predictive-main-dict) + (if (find 'activate-predictive-inside-comments after-change-functions) + (progn + (remove-hook 'after-change-functions 'activate-predictive-inside-comments t) + (predictive-mode -1)) + (progn +; (set (make-local-variable 'predictive-use-auto-learn-cache) nil) + (set (make-local-variable 'predictive-dict-autosave-on-kill-buffer) nil) + (predictive-mode 1) + (add-hook 'after-change-functions 'activate-predictive-inside-comments nil t))))) + +(provide 'predictive-prog-mode) diff --git a/emacs.d/rails/.svn/text-base/rails-bytecompile.el.svn-base b/emacs.d/rails/.svn/text-base/rails-bytecompile.el.svn-base new file mode 100644 index 0000000..b060da1 --- /dev/null +++ b/emacs.d/rails/.svn/text-base/rails-bytecompile.el.svn-base @@ -0,0 +1,5 @@ +(require 'rails) + +(mapcar + #'byte-compile-file + (directory-files "./" t "\\.el$")) \ No newline at end of file diff --git a/emacs.d/rails/.svn/text-base/rails-cmd-proxy.el.svn-base b/emacs.d/rails/.svn/text-base/rails-cmd-proxy.el.svn-base new file mode 100644 index 0000000..df154c7 --- /dev/null +++ b/emacs.d/rails/.svn/text-base/rails-cmd-proxy.el.svn-base @@ -0,0 +1,120 @@ +;;; rails-cmd-proxy.el --- + +;; Copyright (C) 2006 Dmitry Galinsky + +;; Authors: Dmitry Galinsky + +;; Keywords: ruby rails languages oop +;; $URL$ +;; $Id$ + +;;; License + +;; This program is free software; you can redistribute it and/or +;; modify it under the terms of the GNU General Public License +;; as published by the Free Software Foundation; either version 2 +;; of the License, or (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program; if not, write to the Free Software +;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. + +;;; Code: + +(defstruct rails-cmd-proxy:struct local remote args) + +(defvar rails-cmd-proxy:directories-list + '(("y:" "/mnt/www" "-t @server-cmd"))) + +(defvar rails-cmd-proxy:remote-cmd + "plink") + +(defun rails-cmd-proxy:lookup (root &optional lookup-local) + "Lookup ROOT using `rails-cmd-proxy:directories-list' and +return the `rails-cmd-proxy:struct'. If not found ROOT return +nil." + (loop for (local remote args) in rails-cmd-proxy:directories-list + when (string-match (concat "^" (if lookup-local remote local)) root) + do (return + (make-rails-cmd-proxy:struct + :local local + :remote remote + :args args)))) + +(defun rails-cmd-proxy:convert (proxy-struct path &optional reverse) + "Convert PATH from local to remote using PROXY-STRUCT, +otherwise if set REVERSE convert from remote to local." + (let* ((local (rails-cmd-proxy:struct-local proxy-struct)) + (remote (rails-cmd-proxy:struct-remote proxy-struct)) + (regexp (concat "^" (if reverse remote local))) + (replacement (if reverse local remote))) + (when (string-match regexp path) + (replace-regexp-in-string regexp replacement path)))) + +(defun rails-cmd-proxy:construct-remote-cmd (proxy-struct root command &optional command-args) + (let ((root (rails-cmd-proxy:convert proxy-struct root)) + (args (rails-cmd-proxy:struct-args proxy-struct))) + (if command-args + (format "%s \"cd %s && %s %s\"" args root command command-args) + (format "%s \"cd %s && %s\"" args root command)))) + +;; remote wrappers + +(defun rails-cmd-proxy:start-process (name buffer command command-args) + "" + (rails-project:with-root + (root) + (let ((proxy-struct (rails-cmd-proxy:lookup root)) + (command command) + (command-args command-args)) + (when proxy-struct + (setq command-args + (rails-cmd-proxy:construct-remote-cmd proxy-struct + root + command + command-args)) + (setq command rails-cmd-proxy:remote-cmd)) + (start-process-shell-command name + buffer + command + command-args)))) + +(defun rails-cmd-proxy:shell-command-to-string (command) + (rails-project:with-root + (root) + (let ((proxy-struct (rails-cmd-proxy:lookup root)) + (command command)) + (when proxy-struct + (setq command + (format "%s %s" + rails-cmd-proxy:remote-cmd + (rails-cmd-proxy:construct-remote-cmd proxy-struct + root + command)))) + (shell-command-to-string command)))) + +;; helper functions + +(defun rails-cmd-proxy:convert-buffer-from-remote (start end len) + (when-bind + (struct (rails-cmd-proxy:lookup default-directory)) + (save-excursion + (goto-char start) + (let* ((local (rails-cmd-proxy:struct-local struct)) + (remote (rails-cmd-proxy:struct-remote struct)) + (root default-directory) + (remote-with-root (concat remote (substring root (length local)))) + (buffer-read-only nil) + point) + (while (setq point (re-search-forward (format "^\\s-*\\(%s\\)" + remote-with-root) end t)) + (replace-match (format "%s " + (string-repeat " " (- (length (match-string 1)) 1))) + nil t nil 1)))))) + +(provide 'rails-cmd-proxy) diff --git a/emacs.d/rails/.svn/text-base/rails-compat.el.svn-base b/emacs.d/rails/.svn/text-base/rails-compat.el.svn-base new file mode 100644 index 0000000..2845713 --- /dev/null +++ b/emacs.d/rails/.svn/text-base/rails-compat.el.svn-base @@ -0,0 +1,88 @@ +;;; rails-compat.el --- + +;; Copyright (C) 2006 Dmitry Galinsky + +;; Authors: Dmitry Galinsky , + +;; Keywords: ruby rails languages oop +;; $URL: svn+ssh://rubyforge/var/svn/emacs-rails/trunk/rails.el $ +;; $Id: rails.el 149 2007-03-29 15:07:49Z dimaexe $ + +;;; License + +;; This program is free software; you can redistribute it and/or +;; modify it under the terms of the GNU General Public License +;; as published by the Free Software Foundation; either version 2 +;; of the License, or (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program; if not, write to the Free Software +;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. + +;;; Code: + +(eval-when-compile + (require 'snippet nil t) + (require 'completion-ui nil t)) + +(when (fboundp 'indent-or-complete) + (message "WARNNING: the `indent-or-complete' already defined.")) + +(defun indent-or-complete () + "Complete if point is at end of left a leave word, otherwise indent line." + (interactive) + (cond + ;; snippet + ((and (boundp 'snippet) + snippet) + (snippet-next-field)) + + ;; completion-ui + ((and (fboundp 'completion-overlay-at-point) + (completion-overlay-at-point)) + (let* ((ov (completion-overlay-at-point)) + (end (overlay-end ov)) + ;; setup as last command + (last-input-event 32) + (last-command-event 32)) + ;; skip message output + (flet ((message (format-string &rest args) nil)) + (completion-self-insert)))) + + ;; hippie-expand + ((looking-at "\\_>") + ;; skip message output + (flet ((message (format-string &rest args) nil)) + (hippie-expand nil))) + + ;; run default indent command + (t (indent-for-tab-command)))) + +(when (fboundp 'try-complete-abbrev) + (message "WARRNING: the function `try-complete-abbrev' already defined")) + +(defun try-complete-abbrev (old) + (let ((point-end (point)) + (point-start (point)) + distance) + (save-excursion + (while (not (zerop (setq distance (skip-syntax-backward "w")))) + (setq point-start (+ point-start distance)))) + (when (and (not (= point-start point-end)) + (not (memq + (get-text-property (- point-end 1) 'face) + '(font-lock-string-face font-lock-comment-face font-lock-doc-face)))) + (let ((abbr (buffer-substring-no-properties point-start point-end))) + (when (and (abbrev-symbol abbr) + (expand-abbrev)) + t))))) + +(unless (find 'try-complete-abbrev hippie-expand-try-functions-list) + (add-to-list 'hippie-expand-try-functions-list 'try-complete-abbrev)) + +(provide 'rails-compat) diff --git a/emacs.d/rails/.svn/text-base/rails-controller-layout.el.svn-base b/emacs.d/rails/.svn/text-base/rails-controller-layout.el.svn-base new file mode 100644 index 0000000..0b7eeee --- /dev/null +++ b/emacs.d/rails/.svn/text-base/rails-controller-layout.el.svn-base @@ -0,0 +1,216 @@ +;;; rails-controller-layout.el --- + +;; Copyright (C) 2006 Dmitry Galinsky + +;; Authors: Dmitry Galinsky + +;; Keywords: ruby rails languages oop +;; $URL$ +;; $Id$ + +;;; License + +;; This program is free software; you can redistribute it and/or +;; modify it under the terms of the GNU General Public License +;; as published by the Free Software Foundation; either version 2 +;; of the License, or (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program; if not, write to the Free Software +;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. + +;;; Code: + +(defvar rails-controller-layout:recent-template-type nil) + +(defun rails-controller-layout:switch-to-action-in-controller (controller-name action-name) + "Open CONTROLLER-NAME and go to ACTION-NAME." + (if (or (rails-core:find-file-if-exist (rails-core:controller-file controller-name)) + (rails-core:find-file-if-exist (rails-core:mailer-file controller-name))) + (progn + (goto-char (point-min)) + (when action-name + (if (search-forward-regexp (concat "^[ ]*def[ ]*" action-name) nil t) + (recenter)) + (message (format "%s: %s" (substring (symbol-name (rails-core:buffer-type)) 1) controller-name)))))) + +(defun rails-controller-layout:switch-to-view (controller-name action-name) + "Open the ACTION-NAME file for CONTROLLER-NAME in the views directory." + (when action-name + (let ((views (rails-controller-layout:view-files controller-name action-name)) + (title (substring (symbol-name (rails-core:buffer-type)) 1))) + (cond + ((= (length views) 1) + (find-file (first views)) + (message "%s: %s#%s" title controller-name action-name)) + ((= (length views) 0) + (rails-controller-layout:create-view-for-action controller-name action-name)))))) + +(defun rails-controller-layout:toggle-action-view () + (interactive) + (let ((controller-name (rails-core:current-controller)) + (action-name (rails-core:current-action))) + (case (rails-core:buffer-type) + (:view + (rails-controller-layout:switch-to-action-in-controller controller-name action-name)) + (:mailer + (rails-controller-layout:switch-to-view controller-name action-name)) + (:controller + (if action-name + (rails-controller-layout:switch-to-view controller-name action-name) + (rails-controller-layout:switch-to :functional-test)))))) + +(defun rails-controller-layout:create-view-for-action (controller-name action-name) + (let ((type + (if rails-controller-layout:recent-template-type + rails-controller-layout:recent-template-type + (car rails-templates-list)))) + (setq type + (completing-read (format "View for %s#%s not found, create %s.[%s]? " + controller-name action-name action-name type) + rails-templates-list + nil t type)) + (setq rails-controller-layout:recent-template-type type) + (let ((file (rails-core:file (concat "app/views/" + (replace-regexp-in-string "_controller" "" + (rails-core:file-by-class controller-name t)))))) + (make-directory file t) + (find-file (format "%s/%s.%s" file action-name type))))) + +(defun rails-controller-layout:view-files (controller-name &optional action) + "Retun a list containing the view file for CONTROLLER-NAME#ACTION. +If the action is nil, return all views for the controller." + (rails-project:with-root + (root) + (directory-files + (rails-core:file + (rails-core:views-dir + (rails-core:short-controller-name controller-name))) t + (if action + (concat "^" action (rails-core:regex-for-match-view)) + (rails-core:regex-for-match-view))))) + +(defun rails-controller-layout:views-menu (controller-name) + "Make menu of view for CONTROLLER-NAME." + (let (menu) + (setq menu + (mapcar (lambda(i) + (list (concat (if (string-match "^_" (file-name-nondirectory i)) "Partial" "View") + ": " + (file-name-nondirectory i)) + i)) + (rails-controller-layout:view-files controller-name nil))) + (when (zerop (length menu)) + (setq menu (list))) + menu)) + +(defun rails-controller-layout:keymap (type) + (let* ((name (capitalize (substring (symbol-name type) 1))) + (map (make-sparse-keymap)) + (menu (make-sparse-keymap))) + (when type + (define-keys menu + ([goto-migration] '(menu-item "Go to Migration" + rails-controller-layout:switch-to-migration + :enable (and (not (rails-core:current-mailer)) + (rails-core:migration-file-by-model + (singularize-string (rails-core:current-controller)))))) + ([goto-model] '(menu-item "Go to Model" + rails-controller-layout:switch-to-model + :enable (and (not (rails-core:current-mailer)) + (rails-core:model-exist-p + (singularize-string (rails-core:current-controller)))))) + ([goto-helper] '(menu-item "Go to Helper" + rails-controller-layout:switch-to-helper + :enable (and (not (rails-core:current-mailer)) + (not (eq (rails-core:buffer-type) :helper))))) + ([goto-ftest] '(menu-item "Go to Functional Test" + rails-controller-layout:switch-to-functional-test + :enable (and (not (rails-core:current-mailer)) + (not (eq (rails-core:buffer-type) :functional-test))))) + ([goto-controller] '(menu-item "Go to Controller" + rails-controller-layout:switch-to-controller + :enable (and (not (rails-core:current-mailer)) + (not (eq (rails-core:buffer-type) :controller))))) + ([goto-utest] '(menu-item "Go to Unit Test" + rails-controller-layout:switch-to-unit-test + :enable (rails-core:current-mailer)))) + (define-keys map + ((rails-key "g") 'rails-controller-layout:switch-to-migration) + ((rails-key "m") 'rails-controller-layout:switch-to-model) + ((rails-key "h") 'rails-controller-layout:switch-to-helper) + ((rails-key "f") 'rails-controller-layout:switch-to-functional-test) + ((rails-key "c") 'rails-controller-layout:switch-to-controller) + ((rails-key "u") 'rails-controller-layout:switch-to-unit-test) + ([menu-bar rails-controller-layout] (cons name menu)))) + map)) + +(defun rails-controller-layout:switch-to (type) + (let* ((name (capitalize (substring (symbol-name type) 1))) + (controller (rails-core:current-controller)) + (model (singularize-string controller)) + (mailer (rails-core:current-mailer)) + (item (case type + (:helper (rails-core:helper-file controller)) + (:functional-test (rails-core:functional-test-file controller)) + (:controller (rails-core:controller-file controller)) + (:model (rails-core:model-file model)) + (:unit-test (rails-core:unit-test-file mailer)) + (:migration (rails-core:migration-file-by-model model))))) + (if item + (let ((file (rails-core:file item))) + (if (file-exists-p file) + (progn + (find-file file) + (message (format "%s: %s" (substring (symbol-name type) 1) item))) + (message "File %s not exists" file))) + (message "%s not found" name)))) + +(defun rails-controller-layout:switch-to-helper () (interactive) (rails-controller-layout:switch-to :helper)) +(defun rails-controller-layout:switch-to-functional-test () (interactive) (rails-controller-layout:switch-to :functional-test)) +(defun rails-controller-layout:switch-to-controller () (interactive) (rails-controller-layout:switch-to :controller)) +(defun rails-controller-layout:switch-to-model () (interactive) (rails-controller-layout:switch-to :model)) +(defun rails-controller-layout:switch-to-migration () (interactive) (rails-controller-layout:switch-to :migration)) +(defun rails-controller-layout:switch-to-unit-test () (interactive) (rails-controller-layout:switch-to :unit-test)) + +(defun rails-controller-layout:menu () + (interactive) + (let* ((type (rails-core:buffer-type)) + (title (capitalize (substring (symbol-name type) 1))) + (controller (rails-core:current-controller)) + (action (rails-core:current-action)) + (model (singularize-string controller)) + (mailer (rails-core:current-mailer)) + (item (rails-controller-layout:views-menu (or controller mailer)))) + (add-to-list 'item (rails-core:menu-separator)) + (when controller + (when (rails-core:model-exist-p model) + (when (rails-core:migration-file-by-model model) + (add-to-list 'item (cons "Migration" :migration))) + (add-to-list 'item (cons "Model" :model))) + (unless (eq type :helper) + (add-to-list 'item (cons "Helper" :helper))) + (unless (eq type :functional-test) + (add-to-list 'item (cons "Functional Test" :functional-test))) + (unless (eq type :controller) + (add-to-list 'item (cons "Controller" :controller)))) + (when mailer + (add-to-list 'item (cons "Unit Test" (rails-core:unit-test-file mailer))) + (when (eq type :view) + (add-to-list 'item (cons "Mailer" (rails-core:mailer-file mailer))))) + (setq item + (rails-core:menu + (list (concat title " " controller + (when action (format " (%s)" action))) + (cons "Please select.." + item)))) + (typecase item + (symbol (rails-controller-layout:switch-to item)) + (string (rails-core:find-file-if-exist item))))) + +(provide 'rails-controller-layout) diff --git a/emacs.d/rails/.svn/text-base/rails-controller-minor-mode.el.svn-base b/emacs.d/rails/.svn/text-base/rails-controller-minor-mode.el.svn-base new file mode 100644 index 0000000..d4d6cde --- /dev/null +++ b/emacs.d/rails/.svn/text-base/rails-controller-minor-mode.el.svn-base @@ -0,0 +1,37 @@ +;;; rails-controller-minor-mode.el --- minor mode for RubyOnRails controllers + +;; Copyright (C) 2006-2007 Dmitry Galinsky + +;; Authors: Dmitry Galinsky , +;; Rezikov Peter + +;; Keywords: ruby rails languages oop +;; $URL$ +;; $Id$ + +;;; License + +;; This program is free software; you can redistribute it and/or +;; modify it under the terms of the GNU General Public License +;; as published by the Free Software Foundation; either version 2 +;; of the License, or (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program; if not, write to the Free Software +;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. + +;;; Code: + +(define-minor-mode rails-controller-minor-mode + "Minor mode for RubyOnRails controllers." + :lighter " Controller" + :keymap (rails-controller-layout:keymap :controller) + (setq rails-secondary-switch-func 'rails-controller-layout:menu) + (setq rails-primary-switch-func 'rails-controller-layout:toggle-action-view)) + +(provide 'rails-controller-minor-mode) diff --git a/emacs.d/rails/.svn/text-base/rails-core.el.svn-base b/emacs.d/rails/.svn/text-base/rails-core.el.svn-base new file mode 100644 index 0000000..fd73a83 --- /dev/null +++ b/emacs.d/rails/.svn/text-base/rails-core.el.svn-base @@ -0,0 +1,635 @@ +;;; rails-core.el --- core helper functions and macros for emacs-rails + +;; Copyright (C) 2006 Dmitry Galinsky + +;; Authors: Dmitry Galinsky , +;; Rezikov Peter + +;; Keywords: ruby rails languages oop +;; $URL$ +;; $Id$ + +;;; License + +;; This program is free software; you can redistribute it and/or +;; modify it under the terms of the GNU General Public License +;; as published by the Free Software Foundation; either version 2 +;; of the License, or (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program; if not, write to the Free Software +;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. + +(eval-when-compile + (require 'rails-lib)) + +(defvar rails-core:class-dirs + '("app/controllers" + "app/views" + "app/models" + "app/helpers" + "test/unit" + "test/functional" + "test/fixtures") + "Directories with Rails classes") + +(defun rails-core:class-by-file (filename) + "Return the class associated with FILENAME. + /(app/models|app/controllers|app/helpers|test/unit|test/functional)/foo/bar_baz + --> Foo::BarBaz" + (let* ((case-fold-search nil) + (path (replace-regexp-in-string + (format + "\\(.*\\(%s\\)/\\)?\\([^\.]+\\)\\(.*\\)?" + (strings-join "\\|" rails-core:class-dirs)) "\\3" filename)) + (path (replace-regexp-in-string "/" " " path)) + (path (replace-regexp-in-string "_" " " path))) + (replace-regexp-in-string + " " "" + (replace-regexp-in-string + " " "::" + (if (string-match "^ *\\([0-9]+ *\\)?[A-Z]" path) + path + (capitalize path)))))) + +(defun rails-core:file-by-class (classname &optional do-not-append-ext) + "Return the filename associated with CLASSNAME. +If the optional parameter DO-NOT-APPEND-EXT is set this function +will not append \".rb\" to result." + (let* ((case-fold-search nil) + (path (replace-regexp-in-string "::" "/" classname)) + (path (replace-regexp-in-string "\\([A-Z]+\\)\\([A-Z][a-z]\\)" "\\1_\\2" path)) + (path (replace-regexp-in-string "\\([a-z\\d]\\)\\([A-Z]\\)" "\\1_\\2" path))) + (concat (downcase path) + (unless do-not-append-ext ".rb")))) + +;;;;;;;;;; Files ;;;;;;;;;; + +(defun rails-core:file (file-name) + "Return the full path for FILE-NAME in a Rails directory." + (when file-name + (if (file-name-absolute-p file-name) + file-name + (rails-project:with-root + (root) + (concat root file-name))))) + +(defun rails-core:quoted-file (file-name) + "Return the quoted full path for FILE-NAME in a Rails directory." + (concat "\"" (rails-core:file file-name) "\"")) + +(defun rails-core:find-file (file-name) + "Open the file named FILE_NAME in a Rails directory." + (when-bind (file (rails-core:file file-name)) + (find-file file))) + +(defun rails-core:find-file-if-exist (file-name) + "Open the file named FILE-NAME in a Rails directory only if the file exists." + (let ((file-name (rails-core:file file-name))) + (when (file-exists-p file-name) + (find-file file-name)))) + +(defun rails-core:find-or-ask-to-create (question file) + "Open the file named FILE in a Rails directory if it exists. If +it does not exist, ask to create it using QUESTION as a prompt." + (find-or-ask-to-create question (rails-core:file file))) + +;; Funtions, that retrun Rails objects full pathes + +(defun rails-core:model-file (model-name) + "Return the model file from the model name." + (when model-name + (concat "app/models/" (rails-core:file-by-class model-name)))) + +(defun rails-core:model-exist-p (model-name) + "Return t if controller CONTROLLER-NAME exist." + (when model-name + (and (file-exists-p + (rails-core:file + (rails-core:model-file model-name))) + (not (rails-core:observer-p model-name)) + (not (rails-core:mailer-p model-name))))) + +(defun rails-core:controller-file (controller-name) + "Return the path to the controller CONTROLLER-NAME." + (when controller-name + (concat "app/controllers/" + (rails-core:file-by-class + (rails-core:short-controller-name controller-name) t) + (unless (string-equal controller-name "Application") "_controller") + ".rb"))) + +(defun rails-core:controller-exist-p (controller-name) + "Return t if controller CONTROLLER-NAME exist." + (when controller-name + (file-exists-p + (rails-core:file + (rails-core:controller-file controller-name))))) + +(defun rails-core:controller-file-by-model (model) + (when model + (let ((controller (pluralize-string model))) + (when (rails-core:controller-exist-p controller) + (rails-core:controller-file controller))))) + +(defun rails-core:observer-file (observer-name) + "Return the path to the observer OBSERVER-NAME." + (when observer-name + (rails-core:model-file (concat observer-name "Observer")))) + +(defun rails-core:mailer-file (mailer) + (when (and mailer + (rails-core:mailer-p mailer)) + (rails-core:model-file mailer))) + +(defun rails-core:mailer-exist-p (mailer) + (when mailer + (file-exists-p (rails-core:file (rails-core:mailer-file mailer))))) + +(defun rails-core:migration-file (migration-name) + "Return the model file from the MIGRATION-NAME." + (when migration-name + (let ((dir "db/migrate/") + (name (replace-regexp-in-string + " " "_" + (rails-core:file-by-class migration-name)))) + (when (string-match "^[^0-9]+[^_]" name) ; try search when the name without migration number + (let ((files (directory-files (rails-core:file dir) + nil + (concat "[0-9]+_" name "$")))) + (setq name (if files + (car files) + nil)))) + (when name + (concat dir name))))) + +(defun rails-core:migration-file-by-model (model) + (when model + (rails-core:migration-file + (concat "Create" (rails-core:class-by-file (pluralize-string model)))))) + +(defun rails-core:model-by-migration-filename (migration-filename) + (when migration-filename + (let ((model-name (singularize-string + (string=~ "[0-9]+_create_\\(\\w+\\)\.rb" (buffer-name) $1)))) + (when (and model-name + (rails-core:model-exist-p model-name)) + model-name)))) + +(defun rails-core:plugin-file (plugin file) + "Return the path to the FILE in Rails PLUGIN." + (concat "vendor/plugins/" plugin "/" file)) + +(defun rails-core:layout-file (layout) + "Return the path to the layout file named LAYOUT." + (let ((its rails-templates-list) + filename) + (while (and (car its) + (not filename)) + (when (file-exists-p (format "%sapp/views/layouts/%s.%s" (rails-project:root) layout (car its))) + (setq filename (format "app/views/layouts/%s.%s" layout (car its)))) + (setq its (cdr its))) + filename)) + +(defun rails-core:js-file (js) + "Return the path to the JavaScript file named JS." + (concat "public/javascripts/" js ".js")) + +(defun rails-core:partial-name (name) + "Return the file name of partial NAME." + (if (string-match "/" name) + (concat "app/views/" + (replace-regexp-in-string "\\([^/]*\\)$" "_\\1.rhtml" name)) + (concat (rails-core:views-dir (rails-core:current-controller)) + "_" name ".rhtml"))) + +(defun rails-core:view-name (name) + "Return the file name of view NAME." + (concat (rails-core:views-dir (rails-core:current-controller)) + name ".rhtml")) ;; BUG: will fix it + +(defun rails-core:helper-file (controller) + "Return the helper file name for the controller named +CONTROLLER." + (if (string= "Test/TestHelper" controller) + (rails-core:file (rails-core:file-by-class "Test/TestHelper")) + (when controller + (format "app/helpers/%s_helper.rb" + (replace-regexp-in-string "_controller" "" + (rails-core:file-by-class controller t)))))) + +(defun rails-core:functional-test-file (controller) + "Return the functional test file name for the controller named +CONTROLLER." + (when controller + (format "test/functional/%s_test.rb" + (rails-core:file-by-class (rails-core:long-controller-name controller) t)))) + +(defun rails-core:unit-test-file (model) + "Return the unit test file name for the model named MODEL." + (when model + (format "test/unit/%s_test.rb" (rails-core:file-by-class model t)))) + +(defun rails-core:unit-test-exist-p (model) + "Return the unit test file name for the model named MODEL." + (let ((test (rails-core:unit-test-file model))) + (when test + (file-exists-p (rails-core:file test))))) + +(defun rails-core:fixture-file (model) + "Return the fixtures file name for the model named MODEL." + (when model + (format "test/fixtures/%s.yml" (pluralize-string (rails-core:file-by-class model t))))) + +(defun rails-core:fixture-exist-p (model) + (when model + (file-exists-p + (rails-core:file (rails-core:fixture-file model))))) + +(defun rails-core:views-dir (controller) + "Return the view directory name for the controller named CONTROLLER." + (format "app/views/%s/" (replace-regexp-in-string "_controller" "" (rails-core:file-by-class controller t)))) + +(defun rails-core:stylesheet-name (name) + "Return the file name of the stylesheet named NAME." + (concat "public/stylesheets/" name ".css")) + +(defun rails-core:controller-name (controller-file) + "Return the class name of the controller named CONTROLLER. + Bar in Foo dir -> Foo::Bar" + (rails-core:class-by-file + (if (eq (elt controller-file 0) 47) ;;; 47 == '/' + (subseq controller-file 1) + (let ((current-controller (rails-core:current-controller))) + (if (string-match ":" current-controller) + (concat (replace-regexp-in-string "[^:]*$" "" current-controller) + controller-file) + controller-file))))) + +(defun rails-core:short-controller-name (controller) + "Convert FooController -> Foo." + (remove-postfix controller "Controller" )) + +(defun rails-core:long-controller-name (controller) + "Convert Foo/FooController -> FooController." + (if (string-match "Controller$" controller) + controller + (concat controller "Controller"))) + +;;;;;;;;;; Functions that return collection of Rails objects ;;;;;;;;;; +(defun rails-core:observer-p (name) + (when name + (if (string-match "\\(Observer\\|_observer\\(\\.rb\\)?\\)$" name) + t nil))) + +(defun rails-core:mailer-p (name) + (when name + (if (string-match "\\(Mailer\\|Notifier\\|_mailer\\|_notifier\\(\\.rb\\)?\\)$" name) + t nil))) + +(defun rails-core:controllers (&optional cut-contoller-suffix) + "Return a list of Rails controllers. Remove the '_controller' +suffix if CUT-CONTOLLER-SUFFIX is non nil." + (mapcar + #'(lambda (controller) + (rails-core:class-by-file + (if cut-contoller-suffix + (replace-regexp-in-string "_controller\\." "." controller) + controller))) + (delete-if-not + #'(lambda (controller) + (string-match "\\(application\\|[a-z0-9_]+_controller\\)\\.rb$" + controller)) + (find-recursive-files "\\.rb$" (rails-core:file "app/controllers/"))))) + +(defun rails-core:functional-tests () + "Return a list of Rails functional tests." + (mapcar + #'(lambda(it) + (remove-postfix (rails-core:class-by-file it) + "ControllerTest")) + (find-recursive-files "\\.rb$" (rails-core:file "test/functional/")))) + +(defun rails-core:models () + "Return a list of Rails models." + (mapcar + #'rails-core:class-by-file + (delete-if + #'(lambda (file) (or (rails-core:observer-p file) + (rails-core:mailer-p file))) + (find-recursive-files "\\.rb$" (rails-core:file "app/models/"))))) + +(defun rails-core:unit-tests () + "Return a list of Rails functional tests." + (mapcar + #'(lambda(it) + (remove-postfix (rails-core:class-by-file it) + "Test")) + (find-recursive-files "\\.rb$" (rails-core:file "test/unit/")))) + +(defun rails-core:observers () + "Return a list of Rails observers." + (mapcar + #'(lambda (observer) (replace-regexp-in-string "Observer$" "" observer)) + (mapcar + #'rails-core:class-by-file + (find-recursive-files "\\(_observer\\)\\.rb$" (rails-core:file "app/models/"))))) + +(defun rails-core:mailers () + "Return a list of Rails mailers." + (mapcar + #'rails-core:class-by-file + (find-recursive-files "\\(_mailer\\|_notifier\\)\\.rb$" (rails-core:file "app/models/")))) + +(defun rails-core:helpers () + "Return a list of Rails helpers." + (append + (mapcar + #'(lambda (helper) (replace-regexp-in-string "Helper$" "" helper)) + (mapcar + #'rails-core:class-by-file + (find-recursive-files "_helper\\.rb$" (rails-core:file "app/helpers/")))) + (list "Test/TestHelper"))) + +(defun rails-core:migrations (&optional strip-numbers) + "Return a list of Rails migrations." + (let (migrations) + (setq + migrations + (reverse + (mapcar + #'(lambda (migration) + (replace-regexp-in-string "^\\([0-9]+\\)" "\\1 " migration)) + (mapcar + #'rails-core:class-by-file + (find-recursive-files "^[0-9]+_.*\\.rb$" (rails-core:file "db/migrate/")))))) + (if strip-numbers + (mapcar #'(lambda(i) (car (last (split-string i " ")))) + migrations) + migrations))) + +(defun rails-core:migration-versions (&optional with-zero) + "Return a list of migtaion versions as the list of strings. If +second argument WITH-ZERO is present, append the \"000\" version +of migration." + (let ((ver (mapcar + #'(lambda(it) (car (split-string it " "))) + (rails-core:migrations)))) + (if with-zero + (append ver '("000")) + ver))) + +(defun rails-core:plugins () + "Return a list of Rails plugins." + (mapcar + #'file-name-nondirectory + (delete-if-not + #'file-directory-p + (directory-files (rails-core:file "vendor/plugins") t "^[^\\.]")))) + +(defun rails-core:plugin-files (plugin) + "Return a list of files in specific Rails plugin." + (find-recursive-files "^[^.]" (rails-core:file (concat "vendor/plugins/" plugin)))) + +(defun rails-core:layouts () + "Return a list of Rails layouts." + (mapcar + #'(lambda (l) + (replace-regexp-in-string "\\.[^.]+$" "" l)) + (find-recursive-files (rails-core:regex-for-match-view) (rails-core:file "app/views/layouts")))) + +(defun rails-core:fixtures () + "Return a list of Rails fixtures." + (mapcar + #'(lambda (l) + (replace-regexp-in-string "\\.[^.]+$" "" l)) + (find-recursive-files "\\.yml$" (rails-core:file "test/fixtures/")))) + +(defun rails-core:regex-for-match-view () + "Return a regex to match Rails view templates. +The file extensions used for views are defined in `rails-templates-list'." + (format "\\.\\(%s\\)$" (strings-join "\\|" rails-templates-list))) + +(defun rails-core:get-view-files (controller-class &optional action) + "Retun a list containing the view file for CONTROLLER-CLASS#ACTION. +If the action is nil, return all views for the controller." + (rails-project:with-root + (root) + (directory-files + (rails-core:file + (rails-core:views-dir + (rails-core:short-controller-name controller-class))) t + (if action + (concat "^" action (rails-core:regex-for-match-view)) + (rails-core:regex-for-match-view))))) + +(defun rails-core:extract-ancestors (classes) + "Return the parent classes from a list of classes named CLASSES." + (delete "" + (uniq-list + (mapcar (lambda (class) + (replace-regexp-in-string + "::[^:]*$" "::" + (replace-regexp-in-string "^[^:]*$" "" class))) + classes)))) + +(defun rails-core:models-ancestors () + "Return the parent classes of models." + (rails-core:extract-ancestors (rails-core:models))) + +(defun rails-core:controllers-ancestors () + "Return the parent classes of controllers." + (rails-core:extract-ancestors (rails-core:controllers))) + +;;;;;;;;;; Getting Controllers/Model/Action from current buffer ;;;;;;;;;; + +(defun rails-core:current-controller () + "Return the current Rails controller." + (let* ((file-class (rails-core:class-by-file (buffer-file-name)))) + (unless (rails-core:mailer-p file-class) + (case (rails-core:buffer-type) + (:controller (rails-core:short-controller-name file-class)) + (:view (rails-core:class-by-file + (directory-file-name (directory-of-file (buffer-file-name))))) + (:helper (remove-postfix file-class "Helper")) + (:functional-test (remove-postfix file-class "ControllerTest")))))) + +(defun rails-core:current-model () + "Return the current Rails model." + (let* ((file-class (rails-core:class-by-file (buffer-file-name)))) + (unless (rails-core:mailer-p file-class) + (case (rails-core:buffer-type) + (:migration (rails-core:model-by-migration-filename (buffer-name))) + (:model file-class) + (:unit-test (remove-postfix file-class "Test")) + (:fixture (singularize-string file-class)))))) + +(defun rails-core:current-mailer () + "Return the current Rails Mailer, else return nil." + (let* ((file-class (rails-core:class-by-file (buffer-file-name))) + (test (remove-postfix file-class "Test"))) + (when (or (rails-core:mailer-p file-class) + (rails-core:mailer-p test)) + (case (rails-core:buffer-type) + (:mailer file-class) + (:unit-test test) + (:view (rails-core:class-by-file + (directory-file-name (directory-of-file (buffer-file-name))))))))) + +(defun rails-core:current-action () + "Return the current action in the current Rails controller." + (case (rails-core:buffer-type) + (:controller (rails-core:current-method-name)) + (:mailer (rails-core:current-method-name)) + (:view (string-match "/\\([a-z0-9_]+\\)\.[a-z]+$" (buffer-file-name)) + (match-string 1 (buffer-file-name))))) + +(defun rails-core:current-helper () + "Return the current helper" + (rails-core:current-controller)) + +(defun rails-core:current-plugin () + "Return the current plugin name." + (let ((name (buffer-file-name))) + (when (string-match "vendor\\/plugins\\/\\([^\\/]+\\)" name) + (match-string 1 name)))) + +(defun rails-core:current-method-name () + (save-excursion + (when (search-backward-regexp "^[ ]*def \\([a-z0-9_]+\\)" nil t) + (match-string-no-properties 1)))) + +;;;;;;;;;; Determination of buffer type ;;;;;;;;;; + +(defun rails-core:buffer-file-match (regexp) + "Match the current buffer file name to RAILS_ROOT + REGEXP." + (when-bind (file (rails-core:file regexp)) + (string-match file + (buffer-file-name (current-buffer))))) + +(defun rails-core:buffer-type () + "Return the type of the current Rails file or nil if the type +cannot be determinated." + (loop for (type dir func) in rails-directory<-->types + when (and (rails-core:buffer-file-match dir) + (if func + (apply func (list (buffer-file-name (current-buffer)))) + t)) + do (return type))) + + +;;;;;;;;;; Rails minor mode Buttons ;;;;;;;;;; + +(define-button-type 'rails-button + 'follow-link t + 'action #'rails-core:button-action) + +(defun rails-core:button-action (button) + (let* ((file-name (button-get button :rails:file-name)) + (line-number (button-get button :rails:line-number)) + (file (rails-core:file file-name))) + (when (and file + (file-exists-p file)) + (find-file-other-window file) + (when line-number + (goto-line line-number))))) + + +;;;;;;;;;; Rails minor mode logs ;;;;;;;;;; + +(defun rails-log-add (message) + "Add MESSAGE to the Rails minor mode log in RAILS_ROOT." + (rails-project:with-root + (root) + (append-string-to-file (rails-core:file "log/rails-minor-mode.log") + (format "%s: %s\n" + (format-time-string "%Y/%m/%d %H:%M:%S") message)))) + +(defun rails-logged-shell-command (command buffer) + "Execute a shell command in the buffer and write the results to +the Rails minor mode log." + (shell-command (format "%s %s" rails-ruby-command command) buffer) + (rails-log-add + (format "\n%s> %s\n%s" (rails-project:name) + command (buffer-string-by-name buffer)))) + +;;;;;;;;;; Rails menu ;;;;;;;;;; + +(defun rails-core:menu-separator () + (unless (rails-use-text-menu) 'menu (list "--" "--"))) + +(if (fboundp 'completion-posn-at-point-as-event) + (defun rails-core:menu-position () + (completion-posn-at-point-as-event nil nil nil (+ (frame-char-height) 2))) + (defun rails-core:menu-position () + (list '(300 50) (get-buffer-window (current-buffer))))) + +(defun rails-core:menu (menu) + "Show a menu." + (let ((result + (if (rails-use-text-menu) + (tmm-prompt menu) + (x-popup-menu (rails-core:menu-position) + (rails-core:prepare-menu menu))))) + (if (listp result) + (first result) + result))) + +(defvar rails-core:menu-letters-list + (let ((res '())) + (loop for i from (string-to-char "1") upto (string-to-char "9") + do (add-to-list 'res (char-to-string i) t)) + (loop for i from (string-to-char "a") upto (string-to-char "z") + do (add-to-list 'res (char-to-string i) t)) + res) + "List contains 0-9a-z letter") + +(defun rails-core:prepare-menu (menu) + "Append a prefix to each label of menu-item from MENU." + (let ((title (car menu)) + (menu (cdr menu)) + (result '()) + (result-line '()) + (letter 0)) + (dolist (line menu) + (setq result-line '()) + (dolist (it line) + (typecase it + (cons + (rails-core:menu-separator) + (if (and (string= (car (rails-core:menu-separator)) (car it)) + (string= (cadr (rails-core:menu-separator)) (cadr it))) + (add-to-list 'result-line it t) + (progn + (add-to-list 'result-line (cons (format "%s) %s" (nth letter rails-core:menu-letters-list) (car it)) + (cdr it)) t) + (setq letter (+ 1 letter))))) + (t + (add-to-list 'result-line it t)))) + (add-to-list 'result result-line t)) + (cons title result))) + +;;;;;;;;;; Misc ;;;;;;;;;; + +(defun rails-core:erb-block-string () + "Return the contents of the current ERb block." + (save-excursion + (save-match-data + (let ((start (point))) + (search-backward-regexp "<%[=]?") + (let ((from (match-end 0))) + (search-forward "%>") + (let ((to (match-beginning 0))) + (when (>= to start) + (buffer-substring-no-properties from to)))))))) + +(defun rails-core:rhtml-buffer-p () + "Return non nil if the current buffer is rhtml file." + (string-match "\\.rhtml$" (buffer-file-name))) + +(provide 'rails-core) diff --git a/emacs.d/rails/.svn/text-base/rails-features.el.svn-base b/emacs.d/rails/.svn/text-base/rails-features.el.svn-base new file mode 100644 index 0000000..14c4d1a --- /dev/null +++ b/emacs.d/rails/.svn/text-base/rails-features.el.svn-base @@ -0,0 +1,45 @@ +;;; rails-features.el --- + +;; Copyright (C) 2006 Dmitry Galinsky + +;; Authors: Dmitry Galinsky + +;; Keywords: ruby rails languages oop +;; $URL: svn+ssh://rubyforge/var/svn/emacs-rails/trunk/rails-ruby.el $ +;; $Id: rails-ruby.el 166 2007-04-05 17:44:57Z dimaexe $ + +;;; License + +;; This program is free software; you can redistribute it and/or +;; modify it under the terms of the GNU General Public License +;; as published by the Free Software Foundation; either version 2 +;; of the License, or (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program; if not, write to the Free Software +;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. + +;;; Code: + +(defvar rails-features:list + '(rails-snippets-feature + rails-speedbar-feature) + "List of features") + +(defvar rails-features:installed-p nil) + +(defun rails-features:install () + (unless rails-features:installed-p + (dolist (feature rails-features:list) + (when (require feature nil t) + (apply + (intern (concat (symbol-name feature) ":install")) + (list)))) + (setq rails-features:installed-p t))) + +(provide 'rails-features) \ No newline at end of file diff --git a/emacs.d/rails/.svn/text-base/rails-find.el.svn-base b/emacs.d/rails/.svn/text-base/rails-find.el.svn-base new file mode 100644 index 0000000..f06ad62 --- /dev/null +++ b/emacs.d/rails/.svn/text-base/rails-find.el.svn-base @@ -0,0 +1,54 @@ +;;; rails-find.el --- + +;; Copyright (C) 2006 Dmitry Galinsky + +;; Authors: Dmitry Galinsky , +;; Rezikov Peter + +;; Keywords: ruby rails languages oop +;; $URL: svn+ssh://rubyforge/var/svn/emacs-rails/trunk/rails-navigation.el $ +;; $Id: rails-navigation.el 111 2007-03-24 22:28:12Z dimaexe $ + +;;; License + +;; This program is free software; you can redistribute it and/or +;; modify it under the terms of the GNU General Public License +;; as published by the Free Software Foundation; either version 2 +;; of the License, or (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program; if not, write to the Free Software +;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. + +(defmacro rails-find:gen (name dir) + "Define new rails-find function" + (let ((dir (concat dir "/"))) + `(defun ,(intern (concat "rails-find:" name)) () + ,(format "Run find-file in Rails \"%s\" dir" dir) + (interactive) + (let ((default-directory (rails-core:file ,dir))) + (call-interactively ',(if (fboundp 'ido-find-file) + 'ido-find-file + 'find-file)))))) + +(rails-find:gen "controller" "app/controllers") +(rails-find:gen "view" "app/views") +(rails-find:gen "layout" "app/views/layouts") +(rails-find:gen "db" "db") +(rails-find:gen "public" "public") +(rails-find:gen "helpers" "app/helpers") +(rails-find:gen "models" "app/models") +(rails-find:gen "config" "config") +(rails-find:gen "lib" "lib") +(rails-find:gen "tasks" "lib/tasks") +(rails-find:gen "stylesheets" "public/stylesheets") +(rails-find:gen "javascripts" "public/javascripts") +(rails-find:gen "migrate" "db/migrate") +(rails-find:gen "fixtures" "test/fixtures") + +(provide 'rails-find) \ No newline at end of file diff --git a/emacs.d/rails/.svn/text-base/rails-fixture-minor-mode.el.svn-base b/emacs.d/rails/.svn/text-base/rails-fixture-minor-mode.el.svn-base new file mode 100644 index 0000000..372f807 --- /dev/null +++ b/emacs.d/rails/.svn/text-base/rails-fixture-minor-mode.el.svn-base @@ -0,0 +1,36 @@ +;;; rails-fixture-minor-mode.el --- minor mode for RubyOnRails fixtures + +;; Copyright (C) 2006 Dmitry Galinsky + +;; Authors: Dmitry Galinsky + +;; Keywords: ruby rails languages oop +;; $URL$ +;; $Id$ + +;;; License + +;; This program is free software; you can redistribute it and/or +;; modify it under the terms of the GNU General Public License +;; as published by the Free Software Foundation; either version 2 +;; of the License, or (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program; if not, write to the Free Software +;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. + +;;; Code: + +(define-minor-mode rails-fixture-minor-mode + "Minor mode for RubyOnRails fixtures." + :lighter " Fixture" + :keymap (rails-model-layout:keymap :fixture) + (setq rails-primary-switch-func 'rails-model-layout:switch-to-unit-test) + (setq rails-secondary-switch-func 'rails-model-layout:menu)) + +(provide 'rails-fixture-minor-mode) \ No newline at end of file diff --git a/emacs.d/rails/.svn/text-base/rails-functional-test-minor-mode.el.svn-base b/emacs.d/rails/.svn/text-base/rails-functional-test-minor-mode.el.svn-base new file mode 100644 index 0000000..b217797 --- /dev/null +++ b/emacs.d/rails/.svn/text-base/rails-functional-test-minor-mode.el.svn-base @@ -0,0 +1,39 @@ +;;; rails-functional-test-minor-mode.el --- minor mode for RubyOnRails functional tests + +;; Copyright (C) 2006 Dmitry Galinsky + +;; Authors: Dmitry Galinsky + +;; Keywords: ruby rails languages oop +;; $URL$ +;; $Id$ + +;;; License + +;; This program is free software; you can redistribute it and/or +;; modify it under the terms of the GNU General Public License +;; as published by the Free Software Foundation; either version 2 +;; of the License, or (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program; if not, write to the Free Software +;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. + +;;; Code: + +(define-minor-mode rails-functional-test-minor-mode + "Minor mode for RubyOnRails functional tests." + :lighter " FTest" + :keymap (let ((map (rails-controller-layout:keymap :functional-test))) + (define-key map rails-minor-mode-test-current-method-key 'rails-test:run-current-method) + (define-key map [menu-bar rails-controller-layout run] '("Test current method" . rails-test:run-current-method)) + map) + (setq rails-primary-switch-func 'rails-controller-layout:switch-to-controller) + (setq rails-secondary-switch-func 'rails-controller-layout:menu)) + +(provide 'rails-functional-test-minor-mode) \ No newline at end of file diff --git a/emacs.d/rails/.svn/text-base/rails-helper-minor-mode.el.svn-base b/emacs.d/rails/.svn/text-base/rails-helper-minor-mode.el.svn-base new file mode 100644 index 0000000..f3f8c8c --- /dev/null +++ b/emacs.d/rails/.svn/text-base/rails-helper-minor-mode.el.svn-base @@ -0,0 +1,36 @@ +;;; rails-helper-minor-mode.el --- minor mode for RubyOnRails helpers + +;; Copyright (C) 2006 Dmitry Galinsky + +;; Authors: Dmitry Galinsky + +;; Keywords: ruby rails languages oop +;; $URL$ +;; $Id$ + +;;; License + +;; This program is free software; you can redistribute it and/or +;; modify it under the terms of the GNU General Public License +;; as published by the Free Software Foundation; either version 2 +;; of the License, or (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program; if not, write to the Free Software +;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. + +;;; Code: + +(define-minor-mode rails-helper-minor-mode + "Minor mode for RubyOnRails helpers." + :lighter " Helper" + :keymap (rails-controller-layout:keymap :helper) + (setq rails-primary-switch-func 'rails-controller-layout:switch-to-controller) + (setq rails-secondary-switch-func 'rails-controller-layout:menu)) + +(provide 'rails-helper-minor-mode) \ No newline at end of file diff --git a/emacs.d/rails/.svn/text-base/rails-layout-minor-mode.el.svn-base b/emacs.d/rails/.svn/text-base/rails-layout-minor-mode.el.svn-base new file mode 100644 index 0000000..e2d619e --- /dev/null +++ b/emacs.d/rails/.svn/text-base/rails-layout-minor-mode.el.svn-base @@ -0,0 +1,35 @@ +;;; rails-layout-minor-mode.el --- minor mode for RubyOnRails layouts + +;; Copyright (C) 2006 Dmitry Galinsky + +;; Authors: Dmitry Galinsky + +;; Keywords: ruby rails languages oop +;; $URL$ +;; $Id$ + +;;; License + +;; This program is free software; you can redistribute it and/or +;; modify it under the terms of the GNU General Public License +;; as published by the Free Software Foundation; either version 2 +;; of the License, or (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program; if not, write to the Free Software +;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. + +;;; Code: + +(define-minor-mode rails-layout-minor-mode + "Minor mode for RubyOnRails layouts." + nil + " layout" + nil) + +(provide 'rails-layout-minor-mode) diff --git a/emacs.d/rails/.svn/text-base/rails-lib.el.svn-base b/emacs.d/rails/.svn/text-base/rails-lib.el.svn-base new file mode 100644 index 0000000..828dc78 --- /dev/null +++ b/emacs.d/rails/.svn/text-base/rails-lib.el.svn-base @@ -0,0 +1,407 @@ +;;; rails-lib.el --- + +;; Copyright (C) 2006 Dmitry Galinsky + +;; Authors: Dmitry Galinsky , +;; Rezikov Peter +;; Howard Yeh + +;; Keywords: ruby rails languages oop +;; $URL$ +;; $Id$ + +;;; License + +;; This program is free software; you can redistribute it and/or +;; modify it under the terms of the GNU General Public License +;; as published by the Free Software Foundation; either version 2 +;; of the License, or (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program; if not, write to the Free Software +;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. + +;;; Code: + +(defun rails-lib:run-primary-switch () + "Run the primary switch function." + (interactive) + (if rails-primary-switch-func + (apply rails-primary-switch-func nil))) + +(defun rails-lib:run-secondary-switch () + "Run the secondary switch function." + (interactive) + (if rails-secondary-switch-func + (apply rails-secondary-switch-func nil))) + +;;;;; Non Rails realted helper functions ;;;;; + +;; Syntax macro + +(defmacro* when-bind ((var expr) &rest body) + "Binds VAR to the result of EXPR. +If EXPR is not nil exeutes BODY. + + (when-bind (var (func foo)) + (do-somth (with var)))." + `(let ((,var ,expr)) + (when ,var + ,@body))) + +;; Lists + +(defun list->alist (list) + "Convert ((a . b) c d) to ((a . b) (c . c) (d . d))." + (mapcar + #'(lambda (el) + (if (listp el) el(cons el el))) + list)) + +(defun uniq-list (list) + "Return a list of unique elements." + (let ((result '())) + (dolist (elem list) + (when (not (member elem result)) + (push elem result))) + (nreverse result))) + +;; Strings + +(defun string-repeat (char num) + (let ((len num) + (str "")) + (while (not (zerop len)) + (setq len (- len 1)) + (setq str (concat char str))) + str)) + + +(defmacro string=~ (regex string &rest body) + "regex matching similar to the =~ operator found in other languages." + (let ((str (gensym))) + `(lexical-let ((,str ,string)) + ;; Use lexical-let to make closures (in flet). + (when (string-match ,regex ,str) + (symbol-macrolet ,(loop for i to 9 collect + (let ((sym (intern (concat "$" (number-to-string i))))) + `(,sym (match-string ,i ,str)))) + (flet (($ (i) (match-string i ,str)) + (sub (replacement &optional (i 0) &key fixedcase literal-string) + (replace-match replacement fixedcase literal-string ,str i))) + (symbol-macrolet ( ;;before + ($b (substring ,str 0 (match-beginning 0))) + ;;match + ($m (match-string 0 ,str)) + ;;after + ($a (substring ,str (match-end 0) (length ,str)))) + ,@body))))))) + +(defun string-not-empty (str) ;(+) + "Return t if string STR is not empty." + (and (stringp str) (not (or (string-equal "" str) + (string-match "^ +$" str))))) + +(defun yml-value (name) + "Return the value of the parameter named NAME in the current +buffer or an empty string." + (save-excursion + (goto-char (point-min)) + (if (search-forward-regexp (format "%s:[ ]*\\(.*\\)[ ]*$" name) nil t) + (match-string 1) + ""))) + +(defun current-line-string () + "Return the string value of the current line." + (buffer-substring-no-properties + (progn (beginning-of-line) (point)) + (progn (end-of-line) (point)))) + +(defun remove-prefix (word prefix) + "Remove the PREFIX string in WORD if it exists. +PrefixBla -> Bla." + (replace-regexp-in-string (format "^%s" prefix) "" word)) + +(defun remove-postfix (word postfix) + "Remove the POSTFIX string in WORD if it exists. +BlaPostfix -> Bla." + (replace-regexp-in-string (format "%s$" postfix) "" word)) + +(defun strings-join (separator strings) + "Join all STRINGS using a SEPARATOR." + (mapconcat 'identity strings separator)) + +(defalias 'string-join 'strings-join) + +(defun capital-word-p (word) + "Return t if first letter of WORD is uppercased." + (= (elt word 0) + (elt (capitalize word) 0))) + +;;;;;;;; def-snips stuff ;;;; + +(defun snippet-abbrev-function-name (abbrev-table abbrev-name) + "Return the name of the snippet abbreviation function in the +ABBREV-TABLE for the abbreviation ABBREV-NAME." + (intern (concat "snippet-abbrev-" + (snippet-strip-abbrev-table-suffix + (symbol-name abbrev-table)) + "-" + abbrev-name))) + +(defun snippet-menu-description-variable (table name) + "Return a variable for the menu description of the snippet ABBREV-NAME in ABBREV-TABLE." + (intern + (concat + (symbol-name (snippet-abbrev-function-name table name)) + "-menu-description"))) + +(defmacro* def-snips ((&rest abbrev-tables) &rest snips) + "Generate snippets with menu documentaion in several ABBREV-TABLES. + + (def-snip (some-mode-abbrev-table other-mode-abbrev-table) + (\"abbr\" \"some snip $${foo}\" \"menu documentation\") + (\"anabr\" \"other snip $${bar}\" \"menu documentation\") +" + `(progn + ,@(loop for table in abbrev-tables + collect + `(snippet-with-abbrev-table ',table + ,@(loop for (name template desc) in snips collect + `(,name . ,template))) + append + (loop for (name template desc) in snips collect + `(setf ,(snippet-menu-description-variable table name) + ,desc))))) + +(defun snippet-menu-description (abbrev-table name) + "Return the menu descripton for the snippet named NAME in +ABBREV-TABLE." + (symbol-value (snippet-menu-description-variable abbrev-table name))) + +(defun snippet-menu-line (abbrev-table name) + "Generate a menu line for the snippet NAME in ABBREV-TABLE." + (cons + (concat name "\t" (snippet-menu-description abbrev-table name)) + (lexical-let ((func-name (snippet-abbrev-function-name abbrev-table name))) + (lambda () (interactive) (funcall func-name))))) + +;;; Define keys + +(defmacro define-keys (key-map &rest key-funcs) + "Define key bindings for KEY-MAP (create KEY-MAP, if it does +not exist." + `(progn + (unless (boundp ',key-map) + (setf ,key-map (make-keymap))) + ,@(mapcar + #'(lambda (key-func) + `(define-key ,key-map ,(first key-func) ,(second key-func))) + key-funcs))) + +;; Files + +(defun append-string-to-file (file string) + "Append a string to end of a file." + (write-region string nil file t)) + +(defun write-string-to-file (file string) + "Write a string to a file (erasing the previous content)." + (write-region string nil file)) + +(defun read-from-file (file-name) + "Read sexpr from a file named FILE-NAME." + (with-temp-buffer + (insert-file-contents file-name) + (read (current-buffer)))) + +;; File hierarchy functions + +(defun find-recursive-files (file-regexp directory) + "Return a list of files, found in DIRECTORY and match them to FILE-REGEXP." + (find-recursive-filter-out + find-recursive-exclude-files + (find-recursive-directory-relative-files directory "" file-regexp))) + +(defun directory-name (path) + "Return the name of a directory with a given path. +For example, (path \"/foo/bar/baz/../\") returns bar." + ;; Rewrite me + (let ((old-path default-directory)) + (cd path) + (let ((dir (pwd))) + (cd old-path) + (replace-regexp-in-string "^Directory[ ]*" "" dir)))) + +(defun find-or-ask-to-create (question file) + "Open file if it exists. If it does not exist, ask to create +it." + (if (file-exists-p file) + (find-file file) + (when (y-or-n-p question) + (when (string-match "\\(.*\\)/[^/]+$" file) + (make-directory (match-string 1 file) t)) + (find-file file)))) + +(defun directory-of-file (file-name) + "Return the parent directory of a file named FILE-NAME." + (replace-regexp-in-string "[^/]*$" "" file-name)) + +;; Buffers + +(defun buffer-string-by-name (buffer-name) + "Return the content of buffer named BUFFER-NAME as a string." + (interactive) + (save-excursion + (set-buffer buffer-name) + (buffer-string))) + +(defun buffer-visible-p (buffer-name) + (if (get-buffer-window buffer-name) t nil)) + +;; Misc + +(defun rails-browse-api-url (url) + "Browse preferentially with Emacs w3m browser." + (if rails-browse-api-with-w3m + (when (fboundp 'w3m-find-file) + (w3m-find-file (remove-prefix url "file://"))) + (rails-alternative-browse-url url))) + +(defun rails-alternative-browse-url (url &rest args) + "Fix a problem with Internet Explorer not being able to load +URLs with anchors via ShellExecute. It will only be invoked it +the user explicit sets `rails-use-alternative-browse-url'." + (if (and (eq system-type 'windows-nt) rails-use-alternative-browse-url) + (w32-shell-execute "open" "iexplore" url) + (browse-url url args))) + +;; abbrev +;; from http://www.opensource.apple.com/darwinsource/Current/emacs-59/emacs/lisp/derived.el +(defun merge-abbrev-tables (old new) + "Merge an old abbrev table into a new one. +This function requires internal knowledge of how abbrev tables work, +presuming that they are obarrays with the abbrev as the symbol, the expansion +as the value of the symbol, and the hook as the function definition." + (when old + (mapatoms + (lambda(it) + (or (intern-soft (symbol-name it) new) + (define-abbrev new + (symbol-name it) + (symbol-value it) + (symbol-function it) + nil + t))) + old))) + +;; Colorize + +(defun apply-colorize-to-buffer (name) + (let ((buffer (current-buffer))) + (set-buffer name) + (make-local-variable 'after-change-functions) + (add-hook 'after-change-functions + '(lambda (start end len) + (ansi-color-apply-on-region start end))) + (set-buffer buffer))) + +;; completion-read +(defun rails-completing-read (prompt table history require-match) + (let ((history-value (symbol-value history))) + (list (completing-read + (format "%s?%s: " + prompt + (if (car history-value) + (format " (%s)" (car history-value)) + "")) + (list->alist table) ; table + nil ; predicate + require-match ; require-match + nil ; initial input + history ; hist + (car history-value))))) ;def + +;; MMM + +;; (defvar mmm-indent-sandbox-finish-position nil) + +;; (defun mmm-run-indent-with-sandbox (indent-func) +;; (interactive) +;; (let* ((fragment-name "*mmm-indent-sandbox*") +;; (ovl (mmm-overlay-at (point))) +;; (current (when ovl (overlay-buffer ovl))) +;; (start (when ovl (overlay-start ovl))) +;; (end (when ovl (overlay-end ovl))) +;; (current-pos (when ovl (point))) +;; (ovl-line-start (when start +;; (progn (goto-char start) +;; (line-beginning-position)))) +;; (current-line-start (when current-pos +;; (progn (goto-char current-pos) +;; (line-beginning-position)))) +;; (fragment-pos (when (and start end) (- (point) (- start 1)))) +;; (ovl-offset (when ovl (- (progn +;; (goto-char start) +;; (while (not (looking-at "<")) +;; (goto-char (- (point) 1))) +;; (point)) +;; ovl-line-start))) +;; (content (when (and start end) (buffer-substring-no-properties start end))) +;; (fragment (when content (get-buffer-create fragment-name)))) +;; (when fragment +;; (setq mmm-indent-sandbox-finish-position nil) +;; (save-excursion +;; (set-buffer fragment-name) +;; (beginning-of-buffer) +;; (insert content) +;; (goto-char fragment-pos) +;; (funcall indent-func t) +;; (let ((start-line) +;; (end-line) +;; (kill-after-start) +;; (finish-pos (- (+ start (point)) 1)) +;; (indented (buffer-substring-no-properties (line-beginning-position) (line-end-position)))) +;; (set-buffer current) +;; (kill-buffer fragment-name) +;; (princ ovl-offset) +;; (goto-char current-pos) +;; (setq start-line (line-beginning-position)) +;; (setq end-line (line-end-position)) +;; (when (> start start-line) +;; (setq start-line (+ start 1)) +;; (setq kill-after-start t)) +;; (when (> end-line end) +;; (setq end-line end)) +;; (kill-region start-line end-line) +;; (goto-char start-line) +;; (unless (= ovl-line-start current-line-start) +;; (dotimes (i ovl-offset) +;; (setq indented (concat " " indented)))) +;; ;; (insert-char (string-to-char " ") ovl-offset)) +;; (insert indented) +;; (when kill-after-start +;; (goto-char (+ start 1)) +;; (backward-delete-char 1)) +;; ;; (setq mmm-indent-sandbox-finish-position finish-pos))) +;; (if (= ovl-line-start current-line-start) +;; (setq mmm-indent-sandbox-finish-position finish-pos) +;; (setq mmm-indent-sandbox-finish-position (+ finish-pos ovl-offset))))) +;; (goto-char mmm-indent-sandbox-finish-position)))) + +;; (defadvice ruby-indent-line (around mmm-sandbox-ruby-indent-line) +;; (if (and (fboundp 'mmm-overlay-at) +;; (mmm-overlay-at (point))) +;; (mmm-run-indent-with-sandbox 'ruby-indent-line) +;; ad-do-it)) +;; (ad-activate 'ruby-indent-line) + + +;; Cross define functions from my rc files + +(provide 'rails-lib) \ No newline at end of file diff --git a/emacs.d/rails/.svn/text-base/rails-log.el.svn-base b/emacs.d/rails/.svn/text-base/rails-log.el.svn-base new file mode 100644 index 0000000..66578b8 --- /dev/null +++ b/emacs.d/rails/.svn/text-base/rails-log.el.svn-base @@ -0,0 +1,79 @@ +;;; rails-log.el --- provide features for Rails log files + +;; Copyright (C) 2006 Dmitry Galinsky + +;; Authors: Dmitry Galinsky + +;; Keywords: ruby rails languages oop +;; $URL$ +;; $Id$ + +;;; License + +;; This program is free software; you can redistribute it and/or +;; modify it under the terms of the GNU General Public License +;; as published by the Free Software Foundation; either version 2 +;; of the License, or (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program; if not, write to the Free Software +;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. + +;;; Code: + +(defvar rails-log:last-log nil) + +(defun rails-log:files () + (directory-files (rails-core:file "log") nil "\\.log$")) + +(defun rails-log:buffer-name (log-file) + (concat "*" log-file "*")) + +(defun rails-log:open-file (log-file) + (let ((buffer (rails-log:buffer-name log-file)) + (current (buffer-name))) + (unless (get-buffer buffer) + (get-buffer-create buffer) + (set-buffer buffer) + (setq auto-window-vscroll t) + (rails-minor-mode t) + (setq buffer-read-only t) + (set-buffer current) + (apply-colorize-to-buffer buffer)) + (start-process "tail" + buffer + "tail" + "-f" (rails-core:file (concat "log/" log-file))))) + +(defun rails-log:open (log-file) + (interactive + (list (completing-read "Select log (with autocomplete): " + (list->alist (rails-log:files)) + nil + t + rails-log:last-log))) + (setq rails-log:last-log log-file) + (let ((name (rails-log:buffer-name log-file))) + (unless (get-buffer name) + (rails-log:open-file log-file)) + (switch-to-buffer name) + (recenter t))) + +(defun rails-log:open-production () + (interactive) + (rails-log:open "production.log")) + +(defun rails-log:open-development () + (interactive) + (rails-log:open "development.log")) + +(defun rails-log:open-test () + (interactive) + (rails-log:open "test.log")) + +(provide 'rails-log) \ No newline at end of file diff --git a/emacs.d/rails/.svn/text-base/rails-mailer-minor-mode.el.svn-base b/emacs.d/rails/.svn/text-base/rails-mailer-minor-mode.el.svn-base new file mode 100644 index 0000000..90b400a --- /dev/null +++ b/emacs.d/rails/.svn/text-base/rails-mailer-minor-mode.el.svn-base @@ -0,0 +1,37 @@ +;;; rails-mailer-minor-mode.el --- minor mode for RubyOnRails mailers + +;; Copyright (C) 2006-2007 Dmitry Galinsky + +;; Authors: Dmitry Galinsky , +;; Rezikov Peter + +;; Keywords: ruby rails languages oop +;; $URL$ +;; $Id$ + +;;; License + +;; This program is free software; you can redistribute it and/or +;; modify it under the terms of the GNU General Public License +;; as published by the Free Software Foundation; either version 2 +;; of the License, or (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program; if not, write to the Free Software +;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. + +;;; Code: + +(define-minor-mode rails-mailer-minor-mode + "Minor mode for RubyOnRails mailers." + :lighter " Mailer" + :keymap (rails-controller-layout:keymap :mailer) + (setq rails-secondary-switch-func 'rails-controller-layout:menu) + (setq rails-primary-switch-func 'rails-controller-layout:toggle-action-view)) + +(provide 'rails-mailer-minor-mode) diff --git a/emacs.d/rails/.svn/text-base/rails-migration-minor-mode.el.svn-base b/emacs.d/rails/.svn/text-base/rails-migration-minor-mode.el.svn-base new file mode 100644 index 0000000..3f31651 --- /dev/null +++ b/emacs.d/rails/.svn/text-base/rails-migration-minor-mode.el.svn-base @@ -0,0 +1,36 @@ +;;; rails-migration-minor-mode.el --- minor mode for RubyOnRails migration + +;; Copyright (C) 2006 Dmitry Galinsky + +;; Authors: Dmitry Galinsky + +;; Keywords: ruby rails languages oop +;; $URL$ +;; $Id$ + +;;; License + +;; This program is free software; you can redistribute it and/or +;; modify it under the terms of the GNU General Public License +;; as published by the Free Software Foundation; either version 2 +;; of the License, or (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program; if not, write to the Free Software +;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. + +;;; Code: + +(define-minor-mode rails-migration-minor-mode + "Minor mode for RubyOnRails migrations." + :lighter " Migration" + :keymap (rails-model-layout:keymap :migration) + (setq rails-primary-switch-func nil) + (setq rails-secondary-switch-func 'rails-model-layout:menu)) + +(provide 'rails-migration-minor-mode) \ No newline at end of file diff --git a/emacs.d/rails/.svn/text-base/rails-model-layout.el.svn-base b/emacs.d/rails/.svn/text-base/rails-model-layout.el.svn-base new file mode 100644 index 0000000..4b44a01 --- /dev/null +++ b/emacs.d/rails/.svn/text-base/rails-model-layout.el.svn-base @@ -0,0 +1,131 @@ +;;; rails-model-layout.el --- + +;; Copyright (C) 2006 Dmitry Galinsky + +;; Authors: Dmitry Galinsky + +;; Keywords: ruby rails languages oop +;; $URL$ +;; $Id$ + +;;; License + +;; This program is free software; you can redistribute it and/or +;; modify it under the terms of the GNU General Public License +;; as published by the Free Software Foundation; either version 2 +;; of the License, or (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program; if not, write to the Free Software +;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. + +;;; Code: + +(defun rails-model-layout:keymap (type) + (let* ((name (capitalize (substring (symbol-name type) 1))) + (map (make-sparse-keymap)) + (menu (make-sparse-keymap))) + (when type + (define-keys menu + ([goto-model] '(menu-item "Go to Model" + rails-model-layout:switch-to-model + :enable (and (not (eq (rails-core:buffer-type) :model)) + (rails-core:model-exist-p (rails-core:current-model))))) + ([goto-utest] '(menu-item "Go to Unit Test" + rails-model-layout:switch-to-unit-test + :enable (and (not (eq (rails-core:buffer-type) :unit-test)) + (rails-core:unit-test-exist-p (or (rails-core:current-model) + (rails-core:current-mailer)))))) + ([goto-migration] '(menu-item "Go to Migration" + rails-model-layout:switch-to-migration + :enable (and (not (eq (rails-core:buffer-type) :migration)) + (rails-core:migration-file-by-model (rails-core:current-model))))) + ([goto-controller] '(menu-item "Go to Controller" + rails-model-layout:switch-to-controller + :enable (rails-core:controller-file-by-model (rails-core:current-model)))) + ([goto-fixture] '(menu-item "Go to Fixture" + rails-model-layout:switch-to-fixture + :enable (and (not (eq (rails-core:buffer-type) :fixture)) + (rails-core:fixture-exist-p (rails-core:current-model))))) + ([goto-mailer] '(menu-item "Go to Mailer" + rails-model-layout:switch-to-mailer + :enable (rails-core:mailer-exist-p (rails-core:current-mailer))))) + (define-keys map + ((rails-key "m") 'rails-model-layout:switch-to-model) + ((rails-key "u") 'rails-model-layout:switch-to-unit-test) + ((rails-key "g") 'rails-model-layout:switch-to-migration) + ((rails-key "c") 'rails-model-layout:switch-to-controller) + ((rails-key "x") 'rails-model-layout:switch-to-fixture) + ((rails-key "n") 'rails-model-layout:switch-to-mailer) + ([menu-bar rails-model-layout] (cons name menu)))) + map)) + +(defun rails-model-layout:switch-to (type) + (let* ((name (capitalize (substring (symbol-name type) 1))) + (model (rails-core:current-model)) + (controller (rails-core:current-controller)) + (mailer (rails-core:current-mailer)) + (item (if controller controller model)) + (item (case type + (:mailer (rails-core:mailer-file mailer)) + (:controller (rails-core:controller-file-by-model model)) + (:fixture (rails-core:fixture-file model)) + (:unit-test (rails-core:unit-test-file item)) + (:model (rails-core:model-file model)) + (:migration (rails-core:migration-file-by-model model))))) + (if item + (let ((file (rails-core:file item))) + (if (file-exists-p file) + (progn + (find-file file) + (message (format "%s: %s" (substring (symbol-name type) 1) item))) + (message "File %s not exists" file))) + (message "%s not found" name)))) + +(defun rails-model-layout:switch-to-mailer () (interactive) (rails-model-layout:switch-to :mailer)) +(defun rails-model-layout:switch-to-controller () (interactive) (rails-model-layout:switch-to :controller)) +(defun rails-model-layout:switch-to-fixture () (interactive) (rails-model-layout:switch-to :fixture)) +(defun rails-model-layout:switch-to-unit-test () (interactive) (rails-model-layout:switch-to :unit-test)) +(defun rails-model-layout:switch-to-model () (interactive) (rails-model-layout:switch-to :model)) +(defun rails-model-layout:switch-to-migration () (interactive) (rails-model-layout:switch-to :migration)) + +(defun rails-model-layout:menu () + (interactive) + (let* ((item (list)) + (type (rails-core:buffer-type)) + (title (capitalize (substring (symbol-name type) 1))) + (model (rails-core:current-model)) + (controller (pluralize-string model)) + (mailer (rails-core:current-mailer))) + (when model + (when (and (not (eq type :migration)) + (rails-core:migration-file-by-model model)) + (add-to-list 'item (cons "Migration" :migration))) + (unless (eq type :fixture) + (add-to-list 'item (cons "Fixture" :fixture))) + (when (rails-core:controller-exist-p controller) + (add-to-list 'item (cons "Controller" :controller))) + (unless (eq type :unit-test) + (add-to-list 'item (cons "Unit Test" :unit-test))) + (unless (eq type :model) + (add-to-list 'item (cons "Model" :model)))) + (when mailer + (setq item (rails-controller-layout:views-menu model)) + (add-to-list 'item (rails-core:menu-separator)) + (add-to-list 'item (cons "Mailer" :mailer))) + (when item + (setq item + (rails-core:menu + (list (concat title " " model) + (cons "Please select.." + item)))) + (typecase item + (symbol (rails-model-layout:switch-to item)) + (string (rails-core:find-file-if-exist item)))))) + +(provide 'rails-model-layout) \ No newline at end of file diff --git a/emacs.d/rails/.svn/text-base/rails-model-minor-mode.el.svn-base b/emacs.d/rails/.svn/text-base/rails-model-minor-mode.el.svn-base new file mode 100644 index 0000000..da94c83 --- /dev/null +++ b/emacs.d/rails/.svn/text-base/rails-model-minor-mode.el.svn-base @@ -0,0 +1,36 @@ +;;; rails-model-minor-mode.el --- minor mode for RubyOnRails models + +;; Copyright (C) 2006 Dmitry Galinsky + +;; Authors: Dmitry Galinsky + +;; Keywords: ruby rails languages oop +;; $URL$ +;; $Id$ + +;;; License + +;; This program is free software; you can redistribute it and/or +;; modify it under the terms of the GNU General Public License +;; as published by the Free Software Foundation; either version 2 +;; of the License, or (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program; if not, write to the Free Software +;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. + +;;; Code: + +(define-minor-mode rails-model-minor-mode + "Minor mode for RubyOnRails models." + :lighter " Model" + :keymap (rails-model-layout:keymap :model) + (setq rails-primary-switch-func 'rails-model-layout:switch-to-unit-test) + (setq rails-secondary-switch-func 'rails-model-layout:menu)) + +(provide 'rails-model-minor-mode) \ No newline at end of file diff --git a/emacs.d/rails/.svn/text-base/rails-navigation.el.svn-base b/emacs.d/rails/.svn/text-base/rails-navigation.el.svn-base new file mode 100644 index 0000000..baf6568 --- /dev/null +++ b/emacs.d/rails/.svn/text-base/rails-navigation.el.svn-base @@ -0,0 +1,282 @@ +;;; rails-navigation.el --- emacs-rails navigation functions + +;; Copyright (C) 2006 Dmitry Galinsky + +;; Authors: Dmitry Galinsky , +;; Rezikov Peter + +;; Keywords: ruby rails languages oop +;; $URL$ +;; $Id$ + +;;; License + +;; This program is free software; you can redistribute it and/or +;; modify it under the terms of the GNU General Public License +;; as published by the Free Software Foundation; either version 2 +;; of the License, or (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program; if not, write to the Free Software +;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. + +(defun rails-nav:create-goto-menu (items title &optional append-to-menu) + (when append-to-menu + (dolist (l append-to-menu items) + (add-to-list 'items l t))) + (let ((selected + (when items + (rails-core:menu + (list title (cons title items)))))) + (if selected selected (message "No files found")))) + +(defun rails-nav:goto-file-with-menu (dir title &optional ext no-inflector append-to-menu) + "Make a menu to choose files from and find-file it." + (let* (file + files + (ext (if ext ext "rb")) + (ext (concat "\\." ext "$")) + (dir (rails-core:file dir))) + (setq files (find-recursive-directory-relative-files dir "" ext)) + (setq files (sort files 'string<)) + (setq files (mapcar + #'(lambda(f) + (list + (if no-inflector f (rails-core:class-by-file f)) + f)) + files)) + (when-bind + (selected (rails-nav:create-goto-menu files title append-to-menu)) + (if (symbolp selected) + (apply selected (list)) + (rails-core:find-file-if-exist (concat dir selected)))))) + +(defun rails-nav:goto-file-with-menu-from-list (items title func &optional append-to-menu) + (when-bind + (selected (rails-nav:create-goto-menu (list->alist items) title append-to-menu)) + (when-bind + (file (apply func (list selected))) + (rails-core:find-file-if-exist file)))) + +(defun rails-nav:goto-controllers () + "Go to controllers." + (interactive) + (rails-nav:goto-file-with-menu-from-list + (rails-core:controllers t) + "Go to controller" + 'rails-core:controller-file)) + +(defun rails-nav:goto-models () + "Go to models." + (interactive) + (rails-nav:goto-file-with-menu-from-list + (rails-core:models) + "Go to model.." + 'rails-core:model-file)) + +(defun rails-nav:goto-functional-tests () + "Go to functional tests." + (interactive) + (rails-nav:goto-file-with-menu-from-list + (rails-core:functional-tests) + "Go to functional test." + 'rails-core:functional-test-file)) + +(defun rails-nav:goto-unit-tests () + "Go to functional tests." + (interactive) + (rails-nav:goto-file-with-menu-from-list + (rails-core:unit-tests) + "Go to unit test." + 'rails-core:unit-test-file)) + +(defun rails-nav:goto-observers () + "Go to observers." + (interactive) + (rails-nav:goto-file-with-menu-from-list + (rails-core:observers) + "Go to observer.." + 'rails-core:observer-file)) + +(defun rails-nav:goto-mailers () + "Go to mailers." + (interactive) + (rails-nav:goto-file-with-menu-from-list + (rails-core:mailers) + "Go to mailers.." + 'rails-core:mailer-file)) + +(defun rails-nav:goto-migrate () + "Go to migrations." + (interactive) + (rails-nav:goto-file-with-menu-from-list + (rails-core:migrations) + "Go to migrate.." + 'rails-core:migration-file)) + +(defun rails-nav:goto-helpers () + "Go to helpers." + (interactive) + (rails-nav:goto-file-with-menu-from-list + (rails-core:helpers) + "Go to helper.." + 'rails-core:helper-file)) + +(defun rails-nav:goto-plugins () + "Go to plugins." + (interactive) + (rails-nav:goto-file-with-menu-from-list + (rails-core:plugins) + "Go to plugin.." + (lambda (plugin) + (concat "vendor/plugins/" plugin "/init.rb")))) + +(defun rails-nav:create-new-layout (&optional name) + "Create a new layout." + (let ((name (or name (read-string "Layout name? ")))) + (when name + (rails-core:find-file (rails-core:layout-file name)) + (if (y-or-n-p "Insert initial template? ") + (insert rails-layout-template))))) + +(defun rails-nav:goto-layouts () + "Go to layouts." + (interactive) + (let ((items (list (cons "--" "--") + (cons "Create new layout" 'rails-nav:create-new-layout)))) + (rails-nav:goto-file-with-menu-from-list + (rails-core:layouts) + "Go to layout.." + (lambda (l) + (if (stringp l) + (rails-core:layout-file l) + (apply l (list)))) + items))) + +(defun rails-nav:goto-fixtures () + "Go to fixtures." + (interactive) + (rails-nav:goto-file-with-menu-from-list + (rails-core:fixtures) + "Go to fixture.." + 'rails-core:fixture-file)) + +(defun rails-nav:goto-stylesheets () + "Go to stylesheets." + (interactive) + (rails-nav:goto-file-with-menu "public/stylesheets/" "Go to stylesheet.." "css" t)) + +(defun rails-nav:goto-javascripts () + "Go to JavaScripts." + (interactive) + (rails-nav:goto-file-with-menu "public/javascripts/" "Go to stylesheet.." "js" t)) + +;;;;;;;;;; Goto file on current line ;;;;;;;;;; + +(defmacro* def-goto-line (name (&rest conditions) &rest body) + "Go to the file specified by the current line. Parses the +current line for a series of patterns." + (let ((line (gensym)) + (field (gensym)) + (prefix (gensym))) + `(progn + (defun ,name (,line ,prefix) + (block ,name + ,@(loop for (sexpr . map) in conditions + collect + `(when (string-match ,sexpr ,line) + (let ,(loop for var-acc in map collect + (if (listp var-acc) + `(,(first var-acc) (match-string ,(second var-acc) ,line)) + var-acc)) + (return-from ,name (progn ,@body)))))))))) + +(defun rails-goto-file-on-current-line (prefix) + "Analyze a string (or ERb block) and open some file related with it. +For example, on a line with \"render :partial\" runing this +function will open the partial file. The function works with +\"layout 'name'\", \"render/redirect-to [:action => 'name',] +[controller => 'n']\", stylesheet_link_tag and other common +patterns. + +Rules for actions/controllers: + If you are in a controller, the cursor will be placed on the controller action. + If you in view, the view file related to the action will be opened. + Use prefix before the command to change this navigation direction." + (interactive "P") + (rails-project:with-root + (root) + (save-match-data + (unless + (when-bind + (line (save-excursion + (if (rails-core:rhtml-buffer-p) + (rails-core:erb-block-string) + (current-line-string)))) + (loop for func in rails-on-current-line-gotos + until (when (funcall func line prefix) (return t)))) + (message "Can't switch to some file form this line."))))) + +(defvar rails-on-current-line-gotos + '(rails-line-->partial + rails-line-->action + rails-line-->controller+action + rails-line-->layout + rails-line-->stylesheet + rails-line-->js) + "Functions that will ne called to analyze the line when +rails-goto-file-on-current-line is run.") + +(def-goto-line rails-line-->stylesheet (("[ ]*stylesheet_link_tag[ ][\"']\\([^\"']*\\)[\"']" + (name 1))) + (rails-core:find-or-ask-to-create + (format "Stylesheet \"%s\" does not exist do you whant to create it? " name) + (rails-core:stylesheet-name name))) + +(def-goto-line rails-line-->partial (("\\([ ]*render\\|replace_html\\|insert_html\\).*:partial[ ]*=>[ ]*[\"']\\([^\"']*\\)[\"']" + (name 2))) + (rails-core:find-or-ask-to-create + (format "Partial \"%s\" does not exist do you whant to create it? " name) + (rails-core:partial-name name))) + +(def-goto-line rails-line-->action (("\\([ ]*render\\|replace_html\\|insert_html\\).*:action[ ]*=>[ ]*[\"'\:]\\([^\"']*\\)" + (name 2))) + (rails-core:find-or-ask-to-create + (format "View \"%s\" does not exist do you whant to create it? " name) + (rails-core:view-name name))) + +(def-goto-line rails-line-->layout (("^[ ]*layout[ ]*[\"']\\(.*\\)[\"']" (name 1))) + (let ((file-name (rails-core:layout-file name))) + (if (file-exists-p (rails-core:file file-name)) + (rails-core:find-file file-name) + (rails-nav:create-new-layout name)))) + +(def-goto-line rails-line-->js (("^[ ]*javascript_include_tag[ ]*[\"']\\(.*\\)[\"']" + (name 1))) + (rails-core:find-or-ask-to-create + (format "JavaScript file \"%s\" does not exist do you whant to create it? " name) + (rails-core:js-file name))) + +(defvar rails-line-to-controller/action-keywords + '("render" "redirect_to" "link_to" "form_tag" "start_form_tag" "render_component" + "form_remote_tag" "link_to_remote")) + +(defun rails-line-->controller+action (line prefix) + (when (loop for keyword in rails-line-to-controller/action-keywords + when (string-match (format "^[ ]*%s " keyword) line) do (return t)) + (let (action controller) + (when (string-match ":action[ ]*=>[ ]*[\"']\\([^\"']*\\)[\"']" line) + (setf action (match-string 1 line))) + (when (string-match ":controller[ ]*=>[ ]*[\"']\\([^\"']*\\)[\"']" line) + (setf controller (match-string 1 line))) + (rails-controller-layout:switch-to-action-in-controller + (if controller controller + (rails-core:current-controller)) + action)))) + +(provide 'rails-navigation) diff --git a/emacs.d/rails/.svn/text-base/rails-plugin-minor-mode.el.svn-base b/emacs.d/rails/.svn/text-base/rails-plugin-minor-mode.el.svn-base new file mode 100644 index 0000000..6872a2a --- /dev/null +++ b/emacs.d/rails/.svn/text-base/rails-plugin-minor-mode.el.svn-base @@ -0,0 +1,55 @@ +;;; rails-plugin-minor-mode.el --- minor mode for RubyOnRails plugins + +;; Copyright (C) 2006 Dmitry Galinsky + +;; Authors: Dmitry Galinsky + +;; Keywords: ruby rails languages oop +;; $URL$ +;; $Id$ + +;;; License + +;; This program is free software; you can redistribute it and/or +;; modify it under the terms of the GNU General Public License +;; as published by the Free Software Foundation; either version 2 +;; of the License, or (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program; if not, write to the Free Software +;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. + +;;; Code: + +(defun rails-plugin-minor-mode:switch-to-init () + (interactive) + (rails-core:find-file-if-exist + (rails-core:plugin-file (rails-core:current-plugin) "init.rb"))) + +(defun rails-plugin-minor-mode:switch-with-menu () + (interactive) + (let* ((item) + (plugin (rails-core:current-plugin)) + (menu (rails-core:plugin-files plugin))) + (setq item + (rails-core:menu + (list (concat "Plugin " plugin) + (cons "Please select.." (list->alist menu))))) + (when item + (rails-core:find-file-if-exist + (rails-core:plugin-file plugin item))))) + +(define-minor-mode rails-plugin-minor-mode + "Minor mode for RubyOnRails plugins." + nil + " plugin" + nil + (setq rails-primary-switch-func 'rails-plugin-minor-mode:switch-to-init) + (setq rails-secondary-switch-func 'rails-plugin-minor-mode:switch-with-menu)) + +(provide 'rails-plugin-minor-mode) \ No newline at end of file diff --git a/emacs.d/rails/.svn/text-base/rails-project.el.svn-base b/emacs.d/rails/.svn/text-base/rails-project.el.svn-base new file mode 100644 index 0000000..1015b36 --- /dev/null +++ b/emacs.d/rails/.svn/text-base/rails-project.el.svn-base @@ -0,0 +1,73 @@ +;;; rails-project.el --- + +;; Copyright (C) 2006 Dmitry Galinsky + +;; Authors: Dmitry Galinsky , + +;; Keywords: ruby rails languages oop +;; $URL: svn+ssh://rubyforge/var/svn/emacs-rails/trunk/rails.el $ +;; $Id: rails.el 149 2007-03-29 15:07:49Z dimaexe $ + +;;; License + +;; This program is free software; you can redistribute it and/or +;; modify it under the terms of the GNU General Public License +;; as published by the Free Software Foundation; either version 2 +;; of the License, or (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program; if not, write to the Free Software +;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. + +;;; Code: + +(defun rails-project:root () + "Return RAILS_ROOT if this file is a part of a Rails application, +else return nil" + (let ((curdir default-directory) + (max 10) + (found nil)) + (while (and (not found) (> max 0)) + (progn + (if (file-exists-p (concat curdir "config/environment.rb")) + (progn + (setq found t)) + (progn + (setq curdir (concat curdir "../")) + (setq max (- max 1)))))) + (if found (expand-file-name curdir)))) + +(defmacro* rails-project:with-root ((root) &body body) + "If you use `rails-project:root' or functions related on it +several times in a block of code, you can optimize your code by +using this macro. Also, blocks of code will be executed only if +rails-root exist. + (rails-project:with-root (root) + (foo root) + (bar (rails-core:file \"some/path\"))) + " + `(let ((,root (rails-project:root))) + (when ,root + (flet ((rails-project:root () ,root)) + ,@body)))) + +(defmacro rails-project:in-root (&rest body) + "Set the default directory to the Rails root directory while +BODY is executed." + (let ((root (gensym))) + `(rails-project:with-root + (,root) + (let ((default-dir ,root)) + ,@body)))) + +(defun rails-project:name () + "Return the name of current Rails project." + (replace-regexp-in-string "^.*/\\(.*\\)/$" "\\1" + (directory-name (rails-project:root)))) + +(provide 'rails-project) \ No newline at end of file diff --git a/emacs.d/rails/.svn/text-base/rails-rake.el.svn-base b/emacs.d/rails/.svn/text-base/rails-rake.el.svn-base new file mode 100644 index 0000000..555ba71 --- /dev/null +++ b/emacs.d/rails/.svn/text-base/rails-rake.el.svn-base @@ -0,0 +1,97 @@ +;;; rails-rake.el --- emacs-rails integraions with rake tasks. + +;; Copyright (C) 2006 Dmitry Galinsky + +;; Authors: Dmitry Galinsky , + +;; Keywords: ruby rails languages oop +;; $URL: svn+ssh://rubyforge/var/svn/emacs-rails/trunk/rails-scripts.el $ +;; $Id: rails-scripts.el 117 2007-03-25 23:37:37Z dimaexe $ + +;;; License + +;; This program is free software; you can redistribute it and/or +;; modify it under the terms of the GNU General Public License +;; as published by the Free Software Foundation; either version 2 +;; of the License, or (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program; if not, write to the Free Software +;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. + +(eval-when-compile + (require 'rails-scripts)) + +(defvar rails-rake:history (list)) + +(defvar rails-rake:tasks-regexp "^rake \\([^ ]*\\).*# \\(.*\\)" + "Regexp to match tasks list in `rake --tasks` output.") + +(defun rails-rake:create-tasks-cache (file-name) + "Create a cache file from rake --tasks output." + (let ((tasks (loop for str in (split-string (rails-cmd-proxy:shell-command-to-string "rake --tasks") "\n") + for task = (when (string-not-empty str) + (string=~ rails-rake:tasks-regexp str $1)) + when task collect task))) + (write-string-to-file file-name (prin1-to-string tasks)) + tasks)) + +(defun rails-rake:list-of-tasks () + "Return all available tasks and create tasks cache file." + (rails-project:in-root + (let* ((cache-file (rails-core:file "tmp/.tasks-cache"))) + (if (file-exists-p cache-file) + (read-from-file cache-file) + (rails-rake:create-tasks-cache cache-file))))) + +(defun rails-rake:list-of-tasks-without-tests () + "Return available tasks without test actions." + (when-bind + (tasks (rails-rake:list-of-tasks)) + (sort (delete* nil + (mapcar + #'(lambda (it) (if (string=~ "^test\\($\\|:\\)" it t) nil it)) + (rails-rake:list-of-tasks)) + :if 'null) + 'string<))) + +(defun rails-rake:task (task &optional major-mode) + "Run a Rake task in RAILS_ROOT with MAJOR-MODE." + (interactive (rails-completing-read "What task run" (rails-rake:list-of-tasks-without-tests) + 'rails-rake:history nil)) + (when task + (rails-script:run "rake" (list task) major-mode))) + +(defun rails-rake:migrate (&optional version) + "Run the db:migrate task" + (interactive) + (rails-rake:task + (concat + "db:migrate" + (typecase version + (integer (format " VERSION=%.3i" version)) + (string (format " VERSION=%s" version)))))) + +(defun rails-rake:migrate-to-version (version) + "Run migrate with VERSION." + (interactive (rails-completing-read "Version of migration" + (rails-core:migration-versions t) + nil + t)) + (when version + (rails-rake:migrate version))) + +(defun rails-rake:migrate-to-prev-version () + "Migrate to a previous version." + (interactive) + (let ((versions (rails-core:migration-versions t))) + (rails-rake:migrate + (when (< 2 (length versions)) + (nth 1 versions))))) + +(provide 'rails-rake) diff --git a/emacs.d/rails/.svn/text-base/rails-ruby.el.svn-base b/emacs.d/rails/.svn/text-base/rails-ruby.el.svn-base new file mode 100644 index 0000000..e99860b --- /dev/null +++ b/emacs.d/rails/.svn/text-base/rails-ruby.el.svn-base @@ -0,0 +1,163 @@ +;;; rails-ruby.el --- provide features for ruby-mode + +;; Copyright (C) 2006 Dmitry Galinsky + +;; Authors: Dmitry Galinsky + +;; Keywords: ruby rails languages oop +;; $URL$ +;; $Id$ + +;;; License + +;; This program is free software; you can redistribute it and/or +;; modify it under the terms of the GNU General Public License +;; as published by the Free Software Foundation; either version 2 +;; of the License, or (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program; if not, write to the Free Software +;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. + +;;; Code: + +(require 'inf-ruby) + +;; setup align for ruby-mode +(require 'align) + +(defconst align-ruby-modes '(ruby-mode) + "align-perl-modes is a variable defined in `align.el'.") + +(defconst ruby-align-rules-list + '((ruby-comma-delimiter + (regexp . ",\\(\\s-*\\)[^/ \t\n]") + (modes . align-ruby-modes) + (repeat . t)) + (ruby-symbol-after-func + (regexp . "^\\s-*\\w+\\(\\s-+\\):\\w+") + (modes . align-ruby-modes))) + "Alignment rules specific to the ruby mode. +See the variable `align-rules-list' for more details.") + +(add-to-list 'align-perl-modes 'ruby-mode) +(add-to-list 'align-dq-string-modes 'ruby-mode) +(add-to-list 'align-sq-string-modes 'ruby-mode) +(add-to-list 'align-open-comment-modes 'ruby-mode) +(dolist (it ruby-align-rules-list) + (add-to-list 'align-rules-list it)) + +;; other stuff + +(defun ruby-newline-and-indent () + (interactive) + (newline) + (ruby-indent-command)) + +(defun ruby-toggle-string<>simbol () + "Easy to switch between strings and symbols." + (interactive) + (let ((initial-pos (point))) + (save-excursion + (when (looking-at "[\"']") ;; skip beggining quote + (goto-char (+ (point) 1)) + (unless (looking-at "\\w") + (goto-char (- (point) 1)))) + (let* ((point (point)) + (start (skip-syntax-backward "w")) + (end (skip-syntax-forward "w")) + (end (+ point start end)) + (start (+ point start)) + (start-quote (- start 1)) + (end-quote (+ end 1)) + (quoted-str (buffer-substring-no-properties start-quote end-quote)) + (symbol-str (buffer-substring-no-properties start end))) + (cond + ((or (string-match "^\"\\w+\"$" quoted-str) + (string-match "^\'\\w+\'$" quoted-str)) + (setq quoted-str (substring quoted-str 1 (- (length quoted-str) 1))) + (kill-region start-quote end-quote) + (goto-char start-quote) + (insert (concat ":" quoted-str))) + ((string-match "^\:\\w+$" symbol-str) + (setq symbol-str (substring symbol-str 1)) + (kill-region start end) + (goto-char start) + (insert (format "'%s'" symbol-str)))))) + (goto-char initial-pos))) + +(defun run-ruby-in-buffer (cmd buf) + "Run CMD as a ruby process in BUF if BUF does not exist." + (let ((abuf (concat "*" buf "*"))) + (when (not (comint-check-proc abuf)) + (set-buffer (make-comint buf rails-ruby-command nil cmd))) + (inferior-ruby-mode) + (make-local-variable 'inferior-ruby-first-prompt-pattern) + (make-local-variable 'inferior-ruby-prompt-pattern) + (setq inferior-ruby-first-prompt-pattern "^>> " + inferior-ruby-prompt-pattern "^>> ") + (pop-to-buffer abuf))) + +(defun complete-ruby-method (prefix &optional maxnum) + (if (capital-word-p prefix) + (let* ((cmd "x = []; ObjectSpace.each_object(Class){|i| x << i.to_s}; x.map{|i| i.match(/^%s/) ? i.gsub(/^%s/, '') : nil }.compact.sort{|x,y| x.size <=> y.size}") + (cmd (if maxnum (concat cmd (format "[0...%s]" maxnum)) cmd))) + (el4r-ruby-eval (format cmd prefix prefix))) + (save-excursion + (goto-char (- (point) (+ 1 (length prefix)))) + (when (and (looking-at "\\.") + (capital-word-p (word-at-point)) + (el4r-ruby-eval (format "::%s rescue nil" (word-at-point)))) + (let* ((cmd "%s.public_methods.map{|i| i.match(/^%s/) ? i.gsub(/^%s/, '') : nil }.compact.sort{|x,y| x.size <=> y.size}") + (cmd (if maxnum (concat cmd (format "[0...%s]" maxnum)) cmd))) + (el4r-ruby-eval (format cmd (word-at-point) prefix prefix))))))) + +;; flymake ruby support + +(require 'flymake nil t) + +(defconst flymake-allowed-ruby-file-name-masks + '(("\\.rb\\'" flymake-ruby-init) + ("\\.rxml\\'" flymake-ruby-init) + ("\\.builder\\'" flymake-ruby-init) + ("\\.rjs\\'" flymake-ruby-init)) + "Filename extensions that switch on flymake-ruby mode syntax checks.") + +(defconst flymake-ruby-error-line-pattern-regexp + '("^\\([^:]+\\):\\([0-9]+\\): *\\([\n]+\\)" 1 2 nil 3) + "Regexp matching ruby error messages.") + +(defun flymake-ruby-init () + (condition-case er + (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 rails-ruby-command (list "-c" local-file))) + ('error ()))) + +(defun flymake-ruby-load () + (when (and (buffer-file-name) + (string-match + (format "\\(%s\\)" + (string-join + "\\|" + (mapcar 'car flymake-allowed-ruby-file-name-masks))) + (buffer-file-name))) + (setq flymake-allowed-file-name-masks + (append flymake-allowed-file-name-masks flymake-allowed-ruby-file-name-masks)) + (setq flymake-err-line-patterns + (cons flymake-ruby-error-line-pattern-regexp flymake-err-line-patterns)) + (flymake-mode t) + (local-set-key (rails-key "d") 'flymake-display-err-menu-for-current-line))) + +(when (featurep 'flymake) + (add-hook 'ruby-mode-hook 'flymake-ruby-load)) + +(provide 'rails-ruby) \ No newline at end of file diff --git a/emacs.d/rails/.svn/text-base/rails-scripts.el.svn-base b/emacs.d/rails/.svn/text-base/rails-scripts.el.svn-base new file mode 100644 index 0000000..6868335 --- /dev/null +++ b/emacs.d/rails/.svn/text-base/rails-scripts.el.svn-base @@ -0,0 +1,324 @@ +;;; rails-scripts.el --- emacs-rails integraions with rails script/* scripts + +;; Copyright (C) 2006 Dmitry Galinsky + +;; Authors: Dmitry Galinsky , +;; Rezikov Peter + +;; Keywords: ruby rails languages oop +;; $URL$ +;; $Id$ + +;;; License + +;; This program is free software; you can redistribute it and/or +;; modify it under the terms of the GNU General Public License +;; as published by the Free Software Foundation; either version 2 +;; of the License, or (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program; if not, write to the Free Software +;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. + +(eval-when-compile + (require 'inf-ruby) + (require 'ruby-mode)) + +(defvar rails-script:generators-list + '("controller" "model" "scaffold" "migration" "plugin" "mailer" "observer" "resource")) + +(defvar rails-script:destroy-list rails-script:generators-list) + +(defvar rails-script:generate-params-list + '("-f") + "Add parameters to script/generate. +For example -s to keep existing files and -c to add new files into svn.") + +(defvar rails-script:destroy-params-list + '("-f") + "Add parameters to script/destroy. +For example -c to remove files from svn.") + +(defvar rails-script:buffer-name "*ROutput*") + +(defvar rails-script:running-script-name nil + "Curently running the script name") + +(defvar rails-script:history (list)) +(defvar rails-script:history-of-generate (list)) +(defvar rails-script:history-of-destroy (list)) + +;; output-mode + +(defconst rails-script:font-lock-ketwords + (list + '("^\\(\(in [^\)]+\)\\)$" 1 font-lock-builtin-face) + '(" \\(rm\\|rmdir\\) " 1 font-lock-warning-face) + '(" \\(missing\\|notempty\\|exists\\) " 1 font-lock-warning-face) + '(" \\(create\\|dependency\\) " 1 font-lock-function-name-face))) + +(defconst rails-script:button-regexp + " \\(create\\) + \\([^ ]+\\.\\w+\\)") + +(defvar rails-script:output-mode-ret-value nil) +(defvar rails-script:run-after-stop-hook nil) +(defvar rails-script:show-buffer-hook nil) + +(defun rails-script:make-buttons (start end len) + (save-excursion + (let ((buffer-read-only nil)) + (goto-char start) + (while (re-search-forward rails-script:button-regexp end t) + (make-button (match-beginning 2) (match-end 2) + :type 'rails-button + :rails:file-name (match-string 2)))))) + +(defun rails-script:popup-buffer (&optional do-not-scroll-to-top) + "Popup output buffer." + (unless (buffer-visible-p rails-script:buffer-name) + (display-buffer rails-script:buffer-name t)) + (let ((win (get-buffer-window-list rails-script:buffer-name))) + (when win + (unless do-not-scroll-to-top + (mapcar #'(lambda(w) (set-window-point w 0)) win)) + (shrink-window-if-larger-than-buffer + (get-buffer-window rails-script:buffer-name)) + (run-hooks 'rails-script:show-buffer-hook)))) + +(defun rails-script:push-first-button () + (let (file-name) + (with-current-buffer (get-buffer rails-script:buffer-name) + (let ((button (next-button 1))) + (when button + (setq file-name (button-get button :rails:file-name))))) + (when file-name + (rails-core:find-file-if-exist file-name)))) + +(defun rails-script:toggle-output-window () + (interactive) + (let ((current (current-buffer)) + (buf (get-buffer rails-script:buffer-name))) + (if buf + (if (buffer-visible-p rails-script:buffer-name) + (delete-windows-on buf) + (progn + (pop-to-buffer rails-script:buffer-name t t) + (pop-to-buffer current t t) + (shrink-window-if-larger-than-buffer + (get-buffer-window rails-script:buffer-name)) + (run-hooks 'rails-script:show-buffer-hook))) + (message "No output window found. Try running a script or a rake task before.")))) + +(defun rails-script:setup-output-buffer () + "Setup default variables and values for the output buffer." + (set (make-local-variable 'font-lock-keywords-only) t) + (make-local-variable 'font-lock-defaults) + (set (make-local-variable 'scroll-margin) 0) + (set (make-local-variable 'scroll-preserve-screen-position) nil) + (make-local-hook 'rails-script:run-after-stop-hook) + (make-local-hook 'rails-script:show-buffer-hook) + (make-local-variable 'after-change-functions) + (rails-minor-mode t)) + +(define-derived-mode rails-script:output-mode fundamental-mode "ROutput" + "Major mode to Rails Script Output." + (rails-script:setup-output-buffer) + (setq font-lock-defaults '((rails-script:font-lock-ketwords) nil t)) + (buffer-disable-undo) + (setq buffer-read-only t) + (rails-script:make-buttons (point-min) (point-max) (point-max)) + (add-hook 'rails-script:run-after-stop-hook 'rails-script:popup-buffer t t) + (add-hook 'rails-script:run-after-stop-hook 'rails-script:push-first-button t t) + (add-hook 'after-change-functions 'rails-script:make-buttons nil t) + (run-hooks 'rails-script:output-mode-hook)) + +(defun rails-script:running-p () + (get-buffer-process rails-script:buffer-name)) + +(defun rails-script:sentinel-proc (proc msg) + (let* ((name rails-script:running-script-name) + (ret-val (process-exit-status proc)) + (buf (get-buffer rails-script:buffer-name)) + (ret-message (if (zerop ret-val) "successful" "failure"))) + (with-current-buffer buf + (set (make-local-variable 'rails-script:output-mode-ret-value) ret-val)) + (when (memq (process-status proc) '(exit signal)) + (setq rails-script:running-script-name nil + msg (format "%s was stopped (%s)." name ret-message))) + (message (replace-regexp-in-string "\n" "" msg)) + (with-current-buffer buf + (run-hooks 'rails-script:run-after-stop-hook)))) + +(defun rails-script:run (command parameters &optional buffer-major-mode) + "Run a Rails script COMMAND with PARAMETERS with +BUFFER-MAJOR-MODE and process-sentinel SENTINEL." + (unless (listp parameters) + (error "rails-script:run PARAMETERS must be the list")) + (rails-project:with-root + (root) + (save-some-buffers) + (let ((proc (rails-script:running-p))) + (if proc + (message "Only one instance rails-script allowed") + (let* ((default-directory root) + (proc (rails-cmd-proxy:start-process rails-script:buffer-name + rails-script:buffer-name + command + (strings-join " " parameters)))) + (with-current-buffer (get-buffer rails-script:buffer-name) + (let ((buffer-read-only nil) + (win (get-buffer-window-list rails-script:buffer-name))) + (kill-region (point-min) (point-max))) + (if buffer-major-mode + (apply buffer-major-mode (list)) + (rails-script:output-mode)) + (add-hook 'after-change-functions 'rails-cmd-proxy:convert-buffer-from-remote nil t)) + (set-process-coding-system proc 'utf-8-dos 'utf-8-dos) + (set-process-sentinel proc 'rails-script:sentinel-proc) + (setq rails-script:running-script-name + (if (= 1 (length parameters)) + (format "%s %s" command (first parameters)) + (format "%s %s" (first parameters) (first (cdr parameters))))) + (message "Starting %s." rails-script:running-script-name)))))) + +;;;;;;;;;; Destroy stuff ;;;;;;;;;; + +(defun rails-script:run-destroy (what &rest parameters) + "Run the destroy script using WHAT and PARAMETERS." + (rails-script:run rails-ruby-command + (append (list (format "script/destroy %s" what)) + parameters + rails-script:destroy-params-list))) + +(defun rails-script:destroy (what) + "Run destroy WHAT" + (interactive (rails-completing-read "What destroy" rails-script:destroy-list + 'rails-script:history-of-destroy nil)) + (let ((name (intern (concat "rails-script:destroy-" + (replace-regexp-in-string "_" "-" what))))) + (when (fboundp name) + (call-interactively name)))) + +(defmacro rails-script:gen-destroy-function (name &optional completion completion-arg) + (let ((func (intern (format "rails-script:destroy-%s" name))) + (param (intern (concat name "-name")))) + `(defun ,func (&optional ,param) + (interactive + (list (completing-read ,(concat "Destroy " + (replace-regexp-in-string "[^a-z0-9]" " " name) + ": ") + ,(if completion + `(list->alist + ,(if completion-arg + `(,completion ,completion-arg) + `(,completion))) + nil)))) + (when (string-not-empty ,param) + (rails-script:run-destroy ,(replace-regexp-in-string "-" "_" name) ,param))))) + +(rails-script:gen-destroy-function "controller" rails-core:controllers t) +(rails-script:gen-destroy-function "model" rails-core:models) +(rails-script:gen-destroy-function "scaffold") +(rails-script:gen-destroy-function "migration" rails-core:migrations t) +(rails-script:gen-destroy-function "mailer" rails-core:mailers) +(rails-script:gen-destroy-function "plugin" rails-core:plugins) +(rails-script:gen-destroy-function "observer" rails-core:observers) +(rails-script:gen-destroy-function "resource") + +;;;;;;;;;; Generators stuff ;;;;;;;;;; + +(defun rails-script:run-generate (what &rest parameters) + "Run the generate script using WHAT and PARAMETERS." + (rails-script:run rails-ruby-command + (append (list (format "script/generate %s" what)) + parameters + rails-script:generate-params-list))) + +(defun rails-script:generate (what) + "Run generate WHAT" + (interactive (rails-completing-read "What generate" rails-script:generators-list + 'rails-script:history-of-generate nil)) + (let ((name (intern (concat "rails-script:generate-" + (replace-regexp-in-string "_" "-" what))))) + (when (fboundp name) + (call-interactively name)))) + +(defmacro rails-script:gen-generate-function (name &optional completion completion-arg) + (let ((func (intern (format "rails-script:generate-%s" name))) + (param (intern (concat name "-name")))) + `(defun ,func (&optional ,param) + (interactive + (list (completing-read ,(concat "Generate " + (replace-regexp-in-string "[^a-z0-9]" " " name) + ": ") + ,(if completion + `(list->alist + ,(if completion-arg + `(,completion ,completion-arg) + `(,completion))) + nil)))) + (when (string-not-empty ,param) + (rails-script:run-generate ,(replace-regexp-in-string "-" "_" name) ,param))))) + +(defun rails-script:generate-controller (&optional controller-name actions) + "Generate a controller and open the controller file." + (interactive (list + (completing-read "Controller name (use autocomplete) : " + (list->alist (rails-core:controllers-ancestors))) + (read-string "Actions (or return to skip): "))) + (when (string-not-empty controller-name) + (rails-script:run-generate "controller" controller-name actions))) + +(defun rails-script:generate-scaffold (&optional model-name controller-name actions) + "Generate a scaffold and open the controller file." + (interactive + "MModel name: \nMController (or return to skip): \nMActions (or return to skip): ") + (when (string-not-empty model-name) + (if (string-not-empty controller-name) + (rails-script:run-generate "scaffold" model-name controller-name actions) + (rails-script:run-generate "scaffold" model-name)))) + +(rails-script:gen-generate-function "model" rails-core:models-ancestors) +(rails-script:gen-generate-function "migration") +(rails-script:gen-generate-function "plugin") +(rails-script:gen-generate-function "mailer") +(rails-script:gen-generate-function "observer") +(rails-script:gen-generate-function "resource") + +;;;;;;;;;; Rails create project ;;;;;;;;;; + +(defun rails-script:create-project (dir) + "Create a new project in a directory named DIR." + (interactive "FNew Rails project directory: ") + (make-directory dir t) + (let ((default-directory (concat (expand-file-name dir) "/"))) + (flet ((rails-project:root () default-directory)) + (rails-script:run "rails" (list "--skip" (rails-project:root)))))) + +;;;;;;;;;; Shells ;;;;;;;;;; + +(defun rails-script:run-interactive (name script) + "Run an interactive shell with SCRIPT in a buffer named +*rails--*." + (rails-project:with-root + (root) + (run-ruby-in-buffer (rails-core:file script) + (format "rails-%s-%s" (rails-project:name) name)) + (rails-minor-mode t))) + +(defun rails-script:console () + "Run script/console." + (interactive) + (rails-script:run-interactive "console" "script/console")) + +(defun rails-script:breakpointer () + "Run script/breakpointer." + (interactive) + (rails-script:run-interactive "breakpointer" "script/breakpointer")) + +(provide 'rails-scripts) \ No newline at end of file diff --git a/emacs.d/rails/.svn/text-base/rails-snippets-feature.el.svn-base b/emacs.d/rails/.svn/text-base/rails-snippets-feature.el.svn-base new file mode 100644 index 0000000..1a807c5 --- /dev/null +++ b/emacs.d/rails/.svn/text-base/rails-snippets-feature.el.svn-base @@ -0,0 +1,459 @@ +;;; rails-snippets-feature.el --- snippets for rails related modes + +;; Copyright (C) 2006 Dmitry Galinsky + +;; Authors: Dmitry Galinsky , + +;; Keywords: ruby rails languages oop +;; $URL: svn+ssh://rubyforge/var/svn/emacs-rails/trunk/rails-snippets.el $ +;; $Id: rails-snippets.el 155 2007-04-01 17:37:48Z dimaexe $ + +;;; License + +;; This program is free software; you can redistribute it and/or +;; modify it under the terms of the GNU General Public License +;; as published by the Free Software Foundation; either version 2 +;; of the License, or (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program; if not, write to the Free Software +;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. + +(require 'snippet) + +(defconst rails-snippets-feature:list + '((0 "ruby") + (1 "loops" ruby-mode-abbrev-table + ("while" "while $${condition}\n$>$.\nend$>" "while ... end") + ("when" "when $${condition}\n$>$." "when ...") + ("w" "attr_writer :$${attr_names}" "attr_writer ...") + ("upt" "upto($${0}) { |$${n}|$. }" "upto(1.0/0.0) { |n| ... }") + ("until" "until $${condition}\n$>$.\nend$>" "until ... end") + ("tim" "times { |$${n}|$. }" "times { |n| ... }") + ("ste" "step($${2}) { |$${n}|$. }" "step(2) { |e| ... }") + ("forin" "for $${element} in $${collection}\n$>$${element}.$.\nend$>" "for ... in ... end") + ("dow" "downto($${0}) { |$${n}|$. }" "downto(0) { |n| ... }")) ; loops + (1 "general" ruby-mode-abbrev-table + ("ha" "{ $>:$. }" "{ :key => 'value' }") + (":" ":$${key} => '$${value}'" ":key => 'value'") + ("yl" "File.open($${yaml}) { |$${file}| YAML.load($${file}) }" "YAML.load(file)") + ("yd" "File.open($${yaml}, \"w\") { |$${file}| YAML.dump($${obj}, $${file}) }" "YAML.dump(..., file)") + ("y" " :yields: $${arguments}" ":yields:") + ("verren" "verify :only => [:$${1}], :method => :post, :render => {:status => 500, :text => \"use HTTP-POST\"}\n" "verify -- render") + ("verred" "verify :only => [:$${1}], :session => :user, :params => :id, :redirect_to => {:action => '$${index}'}\n" "verify -- redirect") + ("tra" "transaction$${1} { $. }" "transaction( ... ) { ... }") + ("sub" "sub(/$${pattern}/) { |$${match}|$. }" "sub(/.../) { |match| ... }") + ("sca" "scan(/$${pattern}/) { |$${match}| $. }" "scan(/.../) { |match| ... }") + ("rep" "results.report(\"$${name}:\") { TESTS.times { $. } }" "results.report(...) { ... }") + ("rb" "#!/usr/bin/env ruby -w\n\n" "#!/usr/local/bin/ruby -w") + ("r" "attr_reader :$${attr_names}" "attr_reader ...") + ("pn" "PStore.new($${file_name})" "PStore.new( ... )") + ("patfh" "File.join(File.dirname(__FILE__), *%w[$${here}])" "path_from_here( ... )") + ("ope" "open($${pipe}) { |$${io}| $. }" "open(\"path/or/url\", \"w\") { |io| ... }") + ("ml" "File.open($${dump}) { |$${file}| Marshal.load($${file}) }" "Marshal.load(obj)") + ("min" "min { |a, b| $. }" "min { |a, b| ... }") + ("max" "max { |a, b| $. }" "max { |a, b| ... }") + ("md" "File.open($${dump}, \"w\") { |$${file}| Marshal.dump($${obj}, $${file}) }" "Marshal.dump(..., file)") + ("lam" "lambda { |$${args}|$. }" "lambda { |args| ... }") + ("gsu" "gsub(/$${pattern}/) { |$${match}|$. }" "gsub(/.../) { |match| ... }") + ("gre" "grep($${pattern}) { |$${match}| $. }" "grep(/pattern/) { |match| ... }") + ("fl" "flunk('$${message}')" "flunk(...)") + ("file" "File.foreach($${file}) { |$${line}| $. }" "File.foreach (\"...\") { |line| ... }") + ("dir" "Dir.glob($${glob}) { |$${file}| $. }" "Dir.glob(\"...\") { |file| ... }") + ("b" "=begin rdoc\n$>$.\n=end" "New Block") + ("begin" "begin\n$>$${paste}\nrescue $${Exception} => $${e}\n$>$.\nend$>\n" "begin ... rescue ... end") + ("bm" "TESTS = $${10_000}\nBenchmark.bmbm($${10}) do |results|\n $.\nend$>" "Benchmark.bmbm(...) do ... end") + ("am" "alias_method :$${new_name}, :$${old_name}" "alias_method ...") + ("amc" "alias_method_chain :$${first_method}, :$${second_method}" "alias_method_chain ...")) ; general + (1 "definitions" ruby-mode-abbrev-table + ("ts" "require \"test/unit\"\n\nrequire \"tc_$${test_case_file}\"\nrequire \"tc_$${test_case_file}\"\n" "require \"tc_...\" ...") + ("tc" "require \"test/unit\"\n\nrequire \"$${library_file_name}\"\n\nclass Test$${amp} < Test::Unit::TestCase\n$>def test_$${case_name}\n$>$>$.\nend$>\nend$>" "class ... < Test::Unit::TestCase ... end") + ("sin" "class << self; self end" "singleton_class()") + ("rw" "attr_accessor :$${attr_names}" "attr_accessor ...") + ("req" "require \"$.\"" "require \"...\"") + ("modf" "module $${ModuleName}\n$>module ClassMethods\n$>$>$.\nend$>\n$>\n$>extend ClassMethods\n$>\n$>def self.included(receiver)\n$>$>receiver.extend(ClassMethods)\nend$>\n$>\n$>\nend$>" "module ... ClassMethods ... end") + ("mods" "module $${ModuleName}\n$>$.\nend$>" "module ... end") + ("modu" "module $${ModuleName}\n$>module_function\n$>\n$>$.\nend$>" "module ... module_function ... end") + ("mm" "def method_missing(meth, *args, &block)\n$>$.\nend$>" "def method_missing ... end") + ("hash" "Hash.new { |$${hash}, $${key}| $${hash}[$${key}] = $. }" "Hash.new { |hash, key| hash[key] = ... }") + ("forw" "extend Forwardable" "extend Forwardable") + ("enum" "include Enumerable\n\ndef each(&block)\n$>$.\nend$>" "include Enumerable ...") + ("elsif" "elsif $${condition}\n$>$." "elsif ...") + ("doo" "do |$${object}|\n$>$.\nend$>" "Insert do |object| ... end") + ("do" "do\n$>$.\nend$>" "do ... end") + ("defd" "def_delegator :$${del_obj}, :$${del_meth}, :$${new_name}" "def_delegator ...") + ("defds" "def_delegators :$${del_obj}, :$${del_methods}" "def_delegators ...") + ("defs" "def self.$${class_method_name}\n$>$.\nend$>" "def self ... end") + ("deft" "def test_$${case_name}\n$>$.\nend$>" "def test_ ... end") + ("dee" "Marshal.load(Marshal.dump($${obj_to_copy}))" "deep_copy(...)") + ("comp" "include Comparable\n\ndef <=>(other)\n$>$.\nend$>" "include Comparable ...") + ("cladl" "class $${ClassName} < DelegateClass($${ParentClass})\n$>def initialize$${1}\n$>$>super($${del_obj})\n$>$>\n$>$>$.\nend$>\n$>\n$>\nend$>" "class ... < DelegateClass ... initialize ... end") + ("clapr" "class $${ClassName} < $${ParentClass}\n$>def initialize$${1}\n$>$>$.\nend$>\n$>\n$>\nend$>" "class ... < ParentClass ... initialize ... end") + ("clast" "class $${ClassName} < Struct.new(:$${attr_names})\n$>def initialize(*args)\n$>$>super\n$>$>\n$>$>$.\nend$>\n$>\n$>\nend$>" "class ... < Struct ... initialize ... end") + ("class" "class $${ClassName}\n$>$.\nend$>" "class ... end") + ("classi" "class $${ClassName}\n$>def initialize$${1}\n$>$>$.\nend$>\n$>\n$>\nend$>" "class ... initialize ... end") + ("clasf" "class << $${self}\n$>$.\nend$>" "class << self ... end")) ; definitions + (1 "collections" ruby-mode-abbrev-table + ("zip" "zip($${enums}) { |$${row}| $. }" "zip(enums) { |row| ... }") + ("sorb" "sort_by { |$${e}| $. }" "sort_by { |e| ... }") + ("sor" "sort { |a, b| $. }" "sort { |a, b| ... }") + ("select" "select { |$${element}| $${element}.$${2} }$." "select element") + ("sel" "select { |$${e}| $. }" "select { |e| ... }") + ("reve" "reverse_each { |$${e}| $. }" "reverse_each { |e| ... }") + ("reject" "reject { |$${element}| $${element}.$. }" "reject element") + ("rej" "reject { |$${e}| $. }" "reject { |e| ... }") + ("ran" "sort_by { rand }" "randomize()") + ("mapwi" "enum_with_index.map { |$${e}, $${i}| $. }" "map_with_index { |e, i| ... }") + ("map" "map { |$${e}| $. }" "map { |e| ... }") + ("inject" "inject($${object}) { |$${injection}, $${element}| $${4} }$." "inject object") + ("inj" "inject($${init}) { |$${mem}, $${var}| $. }" "inject(init) { |mem, var| ... }") + ("flao" "inject(Array.new) { |$${arr}, $${a}| $${arr}.push(*$${a}) }" "flatten_once()") + ("fina" "find_all { |$${e}| $. }" "find_all { |e| ... }") + ("fin" "find { |$${e}| $. }" "find { |e| ... }") + ("fil" "fill($${range}) { |$${i}|$. }" "fill(range) { |i| ... }") + ("fet" "fetch($${name}) { |$${key}|$. }" "fetch(name) { |key| ... }") + ("eawi" "each_with_index { |$${e}, $${i}| $. }" "each_with_index { |e, i| ... }") + ("eai" "each_index { |$${i}| $. }" "each_index { |i| ... }") + ("eak" "each_key { |$${key}| $. }" "each_key { |key| ... }") + ("eal" "each_line$${1} { |$${line}| $. }" "each_line { |line| ... }") + ("eap" "each_pair { |$${name}, $${val}| $. }" "each_pair { |name, val| ... }") + ("eas" "each_slice($${2}) { |$${group}| $. }" "each_slice(...) { |group| ... }") + ("eav" "each_value { |$${val}| $. }" "each_value { |val| ... }") + ("each" "each { |$${element}| $${element}.$. }" "each element") + ("eac" "each_cons($${2}) { |$${group}| $. }" "each_cons(...) { |group| ... }") + ("eab" "each_byte { |$${byte}| $. }" "each_byte { |byte| ... }") + ("ea" "each { |$${e}| $. }" "each { |e| ... }") + ("det" "detect { |$${e}| $. }" "detect { |e| ... }") + ("deli" "delete_if { |$${e}| $. }" "delete_if { |e| ... }") + ("collect" "collect { |$${element}| $${element}.$. }" "collect element") + ("col" "collect { |$${e}| $. }" "collect { |e| ... }") + ("cl" "classify { |$${e}| $. }" "classify { |e| ... }") + ("array" "Array.new($${10}) { |$${i}|$. }" "Array.new(10) { |i| ... }") + ("any" "any? { |$${e}| $. }" "any? { |e| ... }") + ("all" "all? { |$${e}| $. }" "all? { |e| ... }")) ; collections + (0 "erb" html-mode-abbrev-table html-helper-mode-abbrev-table nxml-mode-abbrev-table + ("title" "$${title}" "title") + ("textarea" "" "textarea") + ("table" "\n$>\n$>\n
$${Header}
$${Data}
" "table") + ("style" "" "style") + ("scriptsrc" "" "script with source") + ("script" "" "script") + ("movie" "\n$>\n$>\n$>\n$>$>width=\"$${320}\" height=\"$${240}\"\n$>$>controller=\"$${true}\" autoplay=\"$${true}\"\n$>$>scale=\"tofit\" cache=\"true\"\n$>$>pluginspage=\"http://www.apple.com/quicktime/download/\"\n$>/>\n" "quicktime") + ("meta" "" "meta") + ("mailto" "$${email}" "mailto") + ("link" "" "link") + ("licai" "<%= link_to \"$${text}\", :controller => \"$${items}\", :action => \"$${edit}\", :id => $${item} %>" "link_to (controller, action, id)") + ("lica" "<%= link_to \"$${text}\", :controller => \"$${items}\", :action => \"$${index}\" %>" "link_to (controller, action)") + ("lica" "<%= link_to \"$${text}\", :controller => \"$${items}\", :action => \"$${index}\" %>" "link_to (controller, action)") + ("liai" "<%= link_to \"$${text}\", :action => \"$${edit}\", :id => $${item} %>" "link_to (action, id)") + ("lic" "<%= link_to \"$${text}\", :controller => \"$${items}\" %>" "link_to (controller)") + ("lia" "<%= link_to \"$${text}\", :action => \"$${index}\" %>" "link_to (action)") + ("input" "" "input") + ("head" "\n$>\n$>$${title}\n$>$.\n" "head") + ("h" "

$${paste}

" "heading") + ("ft" "<%= form_tag :action => \"$${update}\" %>\n$.\n<%= end_form_tag %>" "form_tag") + ("ff" "<%= form_for :$${item}, :action => \"$${update}\" %>\n$.\n<% end %>" "form_for") + ("form" "
\n$>$.\n\n$>

\n
" "form") + ("dtht" "\"http://www.w3.org/TR/html4/strict.dtd\">\n" "HTML -- 4.01 Strict") + ("dchttr" "\"http://www.w3.org/TR/html4/loose.dtd\">\n" "HTML -- 4.01 Transitional") + ("dcxmlf" "\"http://www.w3.org/TR/xhtml1/DTD/xhtml1-frameset.dtd\">\n" "XHTML -- 1.0 Frameset") + ("dcxmls" "\"http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd\">\n" "XHTML -- 1.0 Strict") + ("dcxmlt" "\"http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd\">\n" "XHTML -- 1.0 Transitional") + ("dcxml1" "\"http://www.w3.org/TR/xhtml11/DTD/xhtml11.dtd\">\n" "XHTML -- 1.1") + ("body" "\n$>$.\n" "body") + ("div" "
\n$>$${paste}\n
" "div") + ("%h" "<%=h $${@item} %>" "<% h ... %>") + ("%if" "<% if $${cond} -%>\n$.\n<% end -%>" "<% if/end %>") + ("%ifel" "<% if $${cond} -%>\n$.\n<% else -%>\n<% end -%>" "<% if/else/end %>") + ("%unless" "<% unless $${cond} -%>\n$.\n<% end -%>" "<% unless/end %>") + ("%for" "<% for $${elem} in @$${list} %>\n$>$.\n<% end %>$>" "<% for/end %>") + ("%" "<% $. -%>" "<% ... %>") + ("%%" "<%= $. %>" "<%= ... %>")) ; erb + (0 "controller" rails-controller-minor-mode-abbrev-table + ("ru" "render :update do |page|\n$>$.\nend$>" "render :update ...") + ("bf" "before_filter :$${filter}" "refore_filter") + ("af" "after_filter :$${filter}" "after_filter") + ("arf" "around_filter :$${filter}" "around_filter")) ; controller + (0 "RESTful" rails-controller-minor-mode-abbrev-table + rails-view-minor-mode-abbrev-table + rails-helper-minor-mode-abbrev-table + rails-functional-test-minor-mode-abbrev-table + ("rest" "respond_to do |format|\n$>format.html$>$.\nend$>" "respond_to ..." rails-controller-minor-mode-abbrev-table) + ("rindex" "$${,rails-snippets-feature:rest-index}" "models_url") + ("rshow" "$${,rails-snippets-feature:rest-show}" "model_url(@model)") + ("rnew" "$${,rails-snippets-feature:rest-new}" "new_model_url") + ("redit" "$${,rails-snippets-feature:rest-edit}" "edit_model_url(@model)") + ("rcreate" "$${,rails-snippets-feature:rest-create}" "models_url") + ("rupdate" "$${,rails-snippets-feature:rest-update}" "model_url(@model)") + ("rdestroy" "$${,rails-snippets-feature:rest-destroy}" "model_url(@model)")) ; RESTFul + (0 "render" rails-controller-minor-mode-abbrev-table + rails-view-minor-mode-abbrev-table + rails-helper-minor-mode-abbrev-table + ("rps" "render :partial => '$${item}', :status => $${500}" "render (partial, status)") + ("rt" "render :text => '$${render}'" "render (text)") + ("rtl" "render :text => '$${render}', :layout => '$${layoutname}'" "render (text, layout)") + ("rtlt" "render :text => '$${render}', :layout => $${true}" "render (text, layout => true)") + ("rts" "render :text => '$${render}', :status => $${401}" "render (text, status)") + ("rf" "render :file => '$${filepath}'" "render (file)") + ("rfu" "render :file => '$${filepath}', :use_full_path => $${false}" "render (file, use_full_path)") + ("ri" "render :inline => '$${hello}'" "render (inline)") + ("ril" "render :inline => '$${hello}', :locals => { $${name} => '$${value}'$${4} }" "render (inline, locals)") + ("rit" "render :inline => '$${hello}', :type => $${rxml}" "render (inline, type)") + ("rl" "render :layout => '$${layoutname}'" "render (layout)") + ("rn" "render :nothing => $${true}" "render (nothing)") + ("rns" "render :nothing => $${true}, :status => $${401}" "render (nothing, status)") + ("rp" "render :partial => '$${item}'" "render (partial)") + ("rpc" "render :partial => '$${item}', :collection => $${items}" "render (partial, collection)") + ("rpl" "render :partial => '$${item}', :locals => { :$${name} => '$${value}'$${4} }" "render (partial, locals)") + ("rpo" "render :partial => '$${item}', :object => $${object}" "render (partial, object)") + ("rcea" "render_component :action => '$${index}'" "render_component (action)") + ("rcec" "render_component :controller => '$${items}'" "render_component (controller)") + ("rceca" "render_component :controller => '$${items}', :action => '$${index}'" "render_component (controller, action)") + ("ra" "render :action => '$${index}'" "render (action)") + ("ral" "render :action => '$${index}', :layout => '{default}'" "render (action, layout)")) ; render + (0 "redirect_to" rails-controller-minor-mode-abbrev-table + rails-view-minor-mode-abbrev-table + rails-helper-minor-mode-abbrev-table + ("rea" "redirect_to :action => '$${index}'" "redirect_to (action)") + ("reai" "redirect_to :action => '$${show}', :id => $${item}" "redirect_to (action, id)") + ("rec" "redirect_to :controller => '$${items}'" "redirect_to (controller)") + ("reca" "redirect_to :controller => '$${items}', :action => '$${list}'" "redirect_to (controller, action)") + ("recai" "redirect_to :controller => '$${items}', :action => '$${show}', :id => $${item}" "redirect_to (controller, action, id)")) ; redirecto_to + (0 "rails" ruby-mode-abbrev-table + ("rdl" "RAILS_DEFAULT_LOGGER.debug '$${message}'$." "RAILS_DEFAULT_LOGGER.debug") + ("nr" "@$${item}.new_record?" "item.new_record?")) ; rails + (0 "model" rails-model-minor-mode-abbrev-table + ("va" "validates_associated :$${attribute}" "validates_associated") + ("vc" "validates_confirmation_of :$${attribute}" "validates_confirmation_of") + ("ve" "validates_exclusion_of :$${attribute}" "validates_exclusion_of") + ("vu" "validates_uniqueness_of :$${attribute}" "validates_uniqueness_of") + ("vpif" "validates_presence_of :$${attribute}, :if => proc { |obj| $${condition} }" "validates_presence_of if") + ("vp" "validates_presence_of :$${attribute}" "validates_presence_of") + ("vl" "validates_length_of :$${attribute}, :within => $${20}" "validates_length_of") + ("bt" "belongs_to :$${model}" "belongs_to") + ("hm" "has_many :$${objects}" "has_many") + ("hmt" "has_many :$${objects}, :through => :$${,rails-snippets-feature:prev-has-many-table-name}" "has_many :through") + ("ho" "has_one :$${object}" "has_one") + ("habtm" "has_and_belongs_to_many :$${object}" "has_and_belongs_to_many")) ; model + (0 "migrations" rails-migration-minor-mode-abbrev-table + ("tcls" "t.column :$${title}, :$${string}\n$>tcls$." "create several columns") + ("tcl" "t.column :$${title}, :$${string}$." "create column") + ("tcln" "t.column :$${title}, :$${string}, :null => false$." "create column :null => false") + ("acl" "add_column :$${,rails-snippets-feature:migration-table-name}, :$${column}, :$${string}" "add column") + ("ai" "add_index :$${,rails-snippets-feature:migration-table-name}, $${column}" "add index") + ("aiu" "add_index :$${,rails-snippets-feature:migration-table-name}, $${column}, :unique => true" "add unique index") + ("rmcl" "remove_column :$${,rails-snippets-feature:migration-table-name}, :$${column}" "remove column") + ("recl" "rename_column :$${column}, :$${new_column}" "rename column") + ("dt" "drop_table :$${,rails-snippets-feature:migration-table-name}$." "drop table") + ("ct" "create_table :$${,rails-snippets-feature:migration-table-name} do |t|\n$>tcls$.\nend$>" "create_table") + ("ret" "rename_table :$${,rails-snippets-feature:migration-table-name}, :$${new_name}$." "rename table")) ; migrations + (0 "environment" ruby-mode-abbrev-table + ("logd" "logger.debug '$${message}'$." "logger.debug") + ("loge" "logger.error '$${message}'$." "logger.error") + ("logf" "logger.fatal '$${message}'$." "logger.fatal") + ("logi" "logger.info '$${message}'$." "logger.info") + ("logw" "logger.warn '$${message}'$." "logger.warn") + ("par" "params[:$${id}]" "params[...]") + ("session" "session[:$${User}]" "session[...]") + ("flash" "flash[:$${notice}] = '$${Successfully}'$." "flash[...]")) ; environment + (0 "tests" rails-functional-test-minor-mode-abbrev-table rails-unit-test-minor-mode-abbrev-table + ("fix" "$${,rails-snippets-feature:fixture}(:$${one})$." "models(:name)")) ; functional tests + (0 "assertions" rails-functional-test-minor-mode-abbrev-table rails-unit-test-minor-mode-abbrev-table + ("art" "assert_redirected_to :action => '$${index}'" "assert_redirected_to") + ("as" "assert $${test}" "assert(...)") + ("asa" "assert assigns(:$${,rails-snippets-feature:model-name})" "assert assigns(...)") + ("ase" "assert_equal $${expected}, $${actual}" "assert_equal(...)") + ("asid" "assert_in_delta $${expected_float}, $${actual_float}, $${20}" "assert_in_delta(...)") + ("asio" "assert_instance_of $${ExpectedClass}, $${actual_instance}" "assert_instance_of(...)") + ("asko" "assert_kind_of $${ExpectedKind}, $${actual_instance}" "assert_kind_of(...)") + ("asm" "assert_match(/$${expected_pattern}/, $${actual_string})" "assert_match(...)") + ("asn" "assert_nil $${instance}" "assert_nil(...)") + ("asne" "assert_not_equal $${unexpected}, $${actual}" "assert_not_equal(...)") + ("asnm" "assert_no_match(/$${unexpected_pattern}/, $${actual_string})" "assert_no_match(...)") + ("asnn" "assert_not_nil $${instance}" "assert_not_nil(...)") + ("asnr" "assert_nothing_raised $${Exception} { $. }" "assert_nothing_raised(...) { ... }") + ("asns" "assert_not_same $${unexpected}, $${actual}" "assert_not_same(...)") + ("asnt" "assert_nothing_thrown { $. }" "assert_nothing_thrown { ... }") + ("aso" "assert_operator $${left}, :$${operator}, $${right}" "assert_operator(...)") + ("asr" "assert_raise $${Exception} { $. }" "assert_raise(...) { ... }") + ("asre" "assert_response :$${success}" "assert_response") + ("asrt" "assert_respond_to $${object}, :$${method}" "assert_respond_to(...)") + ("ass" "assert_same $${expected}, $${actual}" "assert_same(...)") + ("assd" "assert_send [$${object}, :$${message}, $${args}]" "assert_send(...)") + ("ast" "assert_throws :$${expected} { $. }" "assert_throws(...) { ... }") + ("astm" "assert_template '$${index}'" "assert_template")))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; +;; Snippets functions +;; + +(defmacro rails-snippets-feature:create-lambda (str) + `(lambda () (interactive) (snippet-insert ,(symbol-value str)))) + +(defun rails-snippets-feature:create-keymap () + (let ((keymap (make-sparse-keymap "Snippets")) + ret level stack) + (dolist (line rails-snippets-feature:list) + (let ((cur-level (nth 0 line)) ; current the menu livel + (menu-item (nth 1 line)) ; current the menu item name + (line (cddr line)) ; skip level and menu name + (abbrev-tables)) + ;; fill stack + (cond + ((not level) + (setq level cur-level) + (setq stack (list menu-item))) + ((= cur-level level) + (setq stack (append (reverse (cdr (reverse stack))) (list menu-item)))) + ((> cur-level level) + (setq level cur-level) + (setq stack (append stack (list menu-item)))) + ((< cur-level level) + (setq stack (append (reverse (nthcdr (+ 1 (- level cur-level)) (reverse stack))) + (list menu-item))))) + (let ((cur-keymap (vconcat (mapcar #'make-symbol stack)))) + ;; make a menu entry for group of snippets + (define-key keymap cur-keymap + (cons menu-item (make-sparse-keymap menu-item))) + ;; scan abbrev tables + (while (not (listp (car line))) + (setq abbrev-tables (append abbrev-tables (list (car line)))) + (setq line (cdr line))) + (when abbrev-tables + ;; sort and scan snippets + (dolist (snip-line (sort line (lambda(x y) (not (string< (car x)(car y)))))) + (let* ((abbr (nth 0 snip-line)) + (snip (nth 1 snip-line)) + (desc (nth 2 snip-line)) + (loc-abbrev-table (nth 3 snip-line)) + (abbrev-tables (if loc-abbrev-table + (list loc-abbrev-table) + abbrev-tables)) + (compiled-snip (rails-snippets-feature:create-lambda snip))) + ;; create a menu entry for a snippet + (define-key keymap (vconcat cur-keymap (list (make-symbol abbr))) + (cons (format "%s \t%s" abbr desc) compiled-snip)) + ;; create abbrevs for a snippet + (dolist (table abbrev-tables) + (unless (boundp table) + (define-abbrev-table table ())) + (define-abbrev (symbol-value table) abbr "" compiled-snip)))))))) + keymap)) + +(defadvice snippet-insert (before snippet-insert-before-advice first (template) activate) + (let ((pos 0)) + (while (setq pos (string-match (snippet-field-regexp) template pos)) + (let ((match (match-string 2 template)) + (beg (match-beginning 2)) + (end (match-end 2)) + (repl)) + (setq pos end) + (when (= 44 (car (string-to-list match))) ;; 44 - [,] + (save-match-data + (setq repl (apply (intern (substring match 1)) (list))))) + (when repl + (setq template + (concat (substring template 0 beg) + repl + (substring template end (length template)))) + (setq pos (- pos + (- (length match) (length repl))))))))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; +;; Functions for dynamic snippets +;; + +(defun rails-snippets-feature:migration-table-name () + (let (str) + (string=~ "[0-9]+_create_\\([^\\.]+\\)\\.rb$" (buffer-name) + (setq str $1)) + (if str str "table"))) + +(defun rails-snippets-feature:prev-has-many-table-name () + (save-excursion + (if (search-backward-regexp "has_many :\\(\\w+\\)" nil t) + (match-string-no-properties 1) + "table"))) + +(defun rails-snippets-feature:fixture () + (let ((controller (rails-core:current-controller)) + (model (rails-core:current-model))) + (cond + (controller (downcase controller)) + (model (pluralize-string (downcase model))) + (t "fixture")))) + +(defun rails-snippets-feature:model-name () + (let ((controller (rails-core:current-controller))) + (if controller + (singularize-string (downcase controller)) + "model"))) + +(defun rails-snippets-feature:rest (action) + (when-bind + (controller (rails-core:current-controller)) + (let* ((plural (downcase (pluralize-string controller))) + (singular (downcase (singularize-string controller))) + (model (concat "@" singular))) + (case action + (:index + (tooltip-show (format "GET /%s" plural)) + (format "%s_url" plural)) + (:show + (tooltip-show (format "GET /%s/1" plural)) + (format "%s_url(%s)" singular model)) + (:new + (tooltip-show (format "GET /%s/new" plural)) + (format "new_%s_url" singular)) + (:edit + (tooltip-show (format "GET /%s/1;edit" plural)) + (format "edit_%s_url(%s)" singular model)) + (:create + (tooltip-show (format "POST /%s" plural)) + (format "%s_url" plural)) + (:update + (tooltip-show (format "PUT /%s/1" plural)) + (format "%s_url(%s)" singular model)) + (:destroy + (tooltip-show (format "DELETE /%s/1" plural)) + (format "%s_url(%s)" singular model)))))) + +(defun rails-snippets-feature:rest-index () + (rails-snippets-feature:rest :index)) + +(defun rails-snippets-feature:rest-show () + (rails-snippets-feature:rest :show)) + +(defun rails-snippets-feature:rest-new () + (rails-snippets-feature:rest :new)) + +(defun rails-snippets-feature:rest-edit () + (rails-snippets-feature:rest :edit)) + +(defun rails-snippets-feature:rest-create () + (rails-snippets-feature:rest :create)) + +(defun rails-snippets-feature:rest-update () + (rails-snippets-feature:rest :update)) + +(defun rails-snippets-feature:rest-destroy () + (rails-snippets-feature:rest :destroy)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; +;; Install function +;; + +(defun rails-snippets-feature:install () + (define-key rails-minor-mode-map + [menu-bar rails-snippets] + (cons "Snippets" (rails-snippets-feature:create-keymap)))) + +(provide 'rails-snippets-feature) diff --git a/emacs.d/rails/.svn/text-base/rails-speedbar-feature.el.svn-base b/emacs.d/rails/.svn/text-base/rails-speedbar-feature.el.svn-base new file mode 100644 index 0000000..94fc0d8 --- /dev/null +++ b/emacs.d/rails/.svn/text-base/rails-speedbar-feature.el.svn-base @@ -0,0 +1,168 @@ +(defvar rails-speedbar:roots + '(("Controllers" rails-core:controllers rails-core:controller-file) + ("Helpers" rails-core:helpers rails-core:helper-file) + ("Models" rails-core:models rails-core:model-file) + ("Observers" rails-core:observers rails-core:observer-file) + ("Mailers" rails-core:mailers rails-core:mailer-file) + ("Functional Tests" rails-core:functional-tests rails-core:functional-test-file) + ("Unit Tests" rails-core:unit-tests rails-core:unit-test-file) + ("Fixtures" rails-core:fixtures rails-core:fixture-file))) + +(defvar rails-speedbar:menu-items nil) +(defvar rails-speedbar:key-map + (let ((map (speedbar-make-specialized-keymap))) + (define-key map " " 'speedbar-toggle-line-expansion) + (define-key map "+" 'speedbar-expand-line) + (define-key map "=" 'speedbar-expand-line) + (define-key map "-" 'speedbar-contract-line) + (define-key map "e" 'speedbar-edit-line) + (define-key map "\C-m" 'speedbar-edit-line) + map)) + +(defun rails-speedbar:display (directory depth) + (setq speedbar-update-flag nil) + (speedbar-with-writable + (insert (rails-project:root) "\n")) + (dolist (i rails-speedbar:roots) + (speedbar-make-tag-line 'angle + ?+ + 'rails-speedbar:expand-group + (car i) + (car i) + nil + nil + nil + depth)) + (speedbar-make-tag-line 'angle + ?+ + 'rails-speedbar:expand-directory + (concat (rails-speedbar:root) "app/views") + "Views" + nil + nil + nil + depth)) + +(defun rails-speedbar:expand-directory (text token indent) + (cond + ((string-match "+" text) + (speedbar-change-expand-button-char ?-) + (let ((files (directory-files token nil "^[^.]"))) + (save-excursion + (end-of-line) (forward-char 1) + (speedbar-with-writable + (dolist (i files) + (if (file-directory-p (format "%s/%s" token i)) + (speedbar-make-tag-line 'curly + ?+ + 'rails-speedbar:expand-directory + (format "%s/%s" token i) + i + nil nil nil + (+ 1 indent)) + (speedbar-make-tag-line 'statictag + ?? + nil + nil + i + 'rails-speedbar:find-file + (format "%s/%s" token i) + nil + (+ 1 indent)))))))) + ((string-match "-" text) + (speedbar-change-expand-button-char ?+) + (speedbar-delete-subblock indent)))) + +(defun rails-speedbar:expand-group (text token indent) + (cond + ((string-match "+" text) + (speedbar-change-expand-button-char ?-) + (let* ((fn (find-if #'(lambda(i) (string= token (car i))) + rails-speedbar:roots)) + (lst (apply (nth 1 fn) (list))) + (find (nth 2 fn))) + (speedbar-with-writable + (save-excursion + (end-of-line) (forward-char 1) + (dolist (i lst) + (speedbar-make-tag-line 'bracket + ?+ + 'rails-speedbar:expand-tags + (rails-speedbar:in-root (rails-core:file (apply find (list i)))) + i + 'rails-speedbar:find-file + (rails-speedbar:in-root (rails-core:file (apply find (list i)))) + nil + (+ indent 1))))))) + ((string-match "-" text) + (speedbar-change-expand-button-char ?+) + (speedbar-delete-subblock indent)))) + +(defun rails-speedbar:expand-tags (text token indent) + (cond + ((string-match "+" text) + (let ((lst (speedbar-fetch-dynamic-tags token))) + (if (not lst) + (speedbar-change-expand-button-char ??) + (progn + (speedbar-change-expand-button-char ?-) + (speedbar-with-writable + (save-excursion + (end-of-line) (forward-char 1) + (speedbar-insert-generic-list indent + (cdr lst) + 'speedbar-tag-expand + 'speedbar-tag-find))))))) + ((string-match "-" text) + (speedbar-change-expand-button-char ?+) + (speedbar-delete-subblock indent)))) + +(defun rails-speedbar:line-directory (&optional depth) + (save-excursion + (end-of-line) + (let ((start (point))) + (when (search-backward "[-]" nil t) + (end-of-line) + (skip-syntax-backward "w") + (get-text-property (point) 'speedbar-token))))) + +(defun rails-speedbar:find-file (text token indent) + (typecase token + (string (speedbar-find-file-in-frame token)))) + +(defun rails-speedbar:root () + (save-excursion + (goto-char (point-min)) + (let* ((root (current-line-string)) + (root (if (file-directory-p root) + root + (rails-project:root)))) + root))) + +(defmacro rails-speedbar:in-root (&rest body) + `(flet ((rails-project:root () ,(rails-speedbar:root))) + ,@body)) + +(defun rails-speedbar:get-focus () + (interactive) + (speedbar-change-initial-expansion-list "Ruby On Rails") + (let ((default-directory (rails-project:root))) + (speedbar-get-focus))) + +(defun rails-speedbar-feature:install () + (speedbar-add-expansion-list + '("Ruby On Rails" + rails-speedbar:menu-items + rails-speedbar:key-map + rails-speedbar:display)) + (speedbar-add-mode-functions-list + '("Ruby On Rails" + (speedbar-line-directory . rails-speedbar:line-directory))) + + (define-key rails-minor-mode-map (kbd "") 'rails-speedbar:get-focus) + (define-key-after + (lookup-key rails-minor-mode-map [menu-bar rails]) + [speedbar] '("Toggle Speedbar" . rails-speedbar:get-focus) + 'svn-status)) + +(provide 'rails-speedbar-feature) \ No newline at end of file diff --git a/emacs.d/rails/.svn/text-base/rails-test.el.svn-base b/emacs.d/rails/.svn/text-base/rails-test.el.svn-base new file mode 100644 index 0000000..52a91de --- /dev/null +++ b/emacs.d/rails/.svn/text-base/rails-test.el.svn-base @@ -0,0 +1,167 @@ +;;; rails-test.el --- tests integration with the compile library + +;; Copyright (C) 2006 Dmitry Galinsky + +;; Authors: Dmitry Galinsky , + +;; Keywords: ruby rails languages oop +;; $URL: svn+ssh://rubyforge/var/svn/emacs-rails/trunk/rails-ws.el $ +;; $Id: rails-ws.el 140 2007-03-27 23:33:36Z dimaexe $ + +;;; License + +;; This program is free software; you can redistribute it and/or +;; modify it under the terms of the GNU General Public License +;; as published by the Free Software Foundation; either version 2 +;; of the License, or (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program; if not, write to the Free Software +;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. + +;;; Code: + +(defvar rails-test:history nil) + +(defconst rails-test:result-regexp + "\\([0-9]+ tests, [0-9]+ assertions, \\([0-9]+\\) failures, \\([0-9]+\\) errors\\)") + +(defconst rails-test:progress-regexp + "^[\\.EF]+$") + +(defun rails-test:file-ext-regexp () + (let ((rails-templates-list (append rails-templates-list (list "rb")))) + (substring (rails-core:regex-for-match-view) 0 -1))) + +(defun rails-test:line-regexp (&optional append prepend) + (concat + append + (format + "\\(#{RAILS_ROOT}\/\\)?\\(\\(\\.\\|[A-Za-z]:\\)?\\([a-z/_.]+%s\\)\\):\\([0-9]+\\)" + (rails-test:file-ext-regexp)) + prepend)) + +(defun rails-test:error-regexp-alist () + (list + (list 'rails-test-trace + (rails-test:line-regexp) 2 6 nil 0) + (list 'rails-test-failure + (rails-test:line-regexp "\\[" "\\]") 2 6 nil 2) + (list 'rails-test-error + (rails-test:line-regexp nil ".*\n$") 2 6 nil 2))) + +(defun rails-test:print-result () + (with-current-buffer (get-buffer rails-script:buffer-name) + (let ((msg (list)) + (failures 0) + (errors 0)) + (save-excursion + (goto-char (point-min)) + (while (re-search-forward rails-test:result-regexp (point-max) t) + (setq failures (+ failures (string-to-number (match-string-no-properties 2)))) + (setq errors (+ errors (string-to-number (match-string-no-properties 3)))) + (add-to-list 'msg (match-string-no-properties 1)))) + (unless (zerop (length msg)) + (message (strings-join " || " (reverse msg)))) + (when (and (or (not (zerop rails-script:output-mode-ret-value)) + (not (zerop errors)) + (not (zerop failures))) + (not (buffer-visible-p (current-buffer)))) + (rails-script:popup-buffer))))) + +(defun rails-test:print-progress (start end len) + (let (content) + (save-excursion + (goto-char (point-min)) + (while (re-search-forward "^Started" end t) + (line-move 1) + (save-match-data + (let ((progress (string=~ rails-test:progress-regexp + (current-line-string) $m))) + (when progress + (setq content (concat content progress))))))) + (when content + (message "Progress of %s: %s" rails-script:running-script-name content)))) + +(define-derived-mode rails-test:compilation-mode compilation-mode "RTest" + "Major mode for RoR tests." + (rails-script:setup-output-buffer) + (set (make-local-variable 'compilation-error-regexp-alist-alist) + (rails-test:error-regexp-alist)) + (set (make-local-variable 'compilation-error-regexp-alist) + '(rails-test-error + rails-test-failure + rails-test-trace)) + (add-hook 'after-change-functions 'rails-test:print-progress nil t) + (add-hook 'rails-script:run-after-stop-hook 'rails-test:print-result nil t) + (add-hook 'rails-script:show-buffer-hook + #'(lambda() + (let ((win (get-buffer-window (current-buffer)))) + (when (window-live-p win) + (set-window-point win 0) + (unless (buffer-visible-p (current-buffer)) + (compilation-set-window-height win))))) + t t)) + +(defun rails-test:list-of-tasks () + "Return a list contains test tasks." + (append (list "all") + (delete* nil + (mapcar + #'(lambda (task) (string=~ "^test\\:\\([^ ]+\\)" task $1)) + (rails-rake:list-of-tasks)) + :if 'null))) + +(defun rails-test:run (task) + "Run rake tests in RAILS_ROOT." + (interactive (rails-completing-read "What test run" + (rails-test:list-of-tasks) + 'rails-test:history t)) + (unless task + (setq task "all") + (add-to-list rails-test:history task)) + (let ((task-name + (if (string= "all" task) + "test" + (concat "test:" task)))) + (rails-rake:task task-name 'rails-test:compilation-mode))) + +(defun rails-test:run-single-file (file &optional param) + "Run test for single file FILE." + (let ((param (if param (append (list file) (list param)) + (list file)))) + (rails-script:run "ruby" param 'rails-test:compilation-mode))) + +(defun rails-test:run-current () + "Run a test for the current controller/model/mailer." + (interactive) + (let* ((model (rails-core:current-model)) + (controller (rails-core:current-controller)) + (func-test (rails-core:functional-test-file controller)) + (unit-test (rails-core:unit-test-file model)) + (mailer-test (rails-core:unit-test-file controller))) + (rails-test:run-single-file + (cond + ;; model + ((and model unit-test) unit-test) + ;; controller + ((and controller (not (rails-core:mailer-p controller)) func-test) + func-test) + ;; mailer + ((and controller (rails-core:mailer-p controller) unit-test) + unit-test))))) + +(defun rails-test:run-current-method () + "Run a test for the current method." + (interactive) + (let ((file (substring (buffer-file-name) (length (rails-project:root)))) + (method (rails-core:current-method-name))) + (when method + (rails-test:run-single-file file (format "--name=%s" method))))) + +(provide 'rails-test) \ No newline at end of file diff --git a/emacs.d/rails/.svn/text-base/rails-ui.el.svn-base b/emacs.d/rails/.svn/text-base/rails-ui.el.svn-base new file mode 100644 index 0000000..576c592 --- /dev/null +++ b/emacs.d/rails/.svn/text-base/rails-ui.el.svn-base @@ -0,0 +1,299 @@ +;;; rails-ui.el --- emacs-rails user interface + +;; Copyright (C) 2006 Dmitry Galinsky + +;; Authors: Dmitry Galinsky , +;; Rezikov Peter + +;; Keywords: ruby rails languages oop +;; $URL$ +;; $Id$ + +;;; License + +;; This program is free software; you can redistribute it and/or +;; modify it under the terms of the GNU General Public License +;; as published by the Free Software Foundation; either version 2 +;; of the License, or (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program; if not, write to the Free Software +;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. + + +;;;;;;;;;; Some init code ;;;;;;;;;; + +(defconst rails-minor-mode-log-menu-bar-map + (let ((map (make-sparse-keymap))) + (define-keys map + ([test] '("test.log" . rails-log:open-test)) + ([pro] '("production.log" . rails-log:open-production)) + ([dev] '("development.log" . rails-log:open-development)) + ([separator] '("---")) + ([open] '("Open Log File..." . rails-log:open))) + map)) + +(defconst rails-minor-mode-config-menu-bar-map + (let ((map (make-sparse-keymap))) + (define-keys map + ([routes] '("routes.rb" . + (lambda () (interactive) + (rails-core:find-file "config/routes.rb")))) + ([environment] '("environment.rb" . + (lambda() (interactive) + (rails-core:find-file "config/environment.rb")))) + ([database] '("database.yml" . + (lambda() (interactive) + (rails-core:find-file "config/database.yml")))) + ([boot] '("boot.rb" . + (lambda() (interactive) + (rails-core:find-file "config/boot.rb")))) + ([env] (cons "environments" (make-sparse-keymap "environments"))) + ([env test] '("test.rb" . + (lambda() (interactive) + (rails-core:find-file "config/environments/test.rb")))) + ([env production] '("production.rb" . + (lambda() (interactive) + (rails-core:find-file "config/environments/production.rb")))) + ([env development] '("development.rb" . + (lambda()(interactive) + (rails-core:find-file "config/environments/development.rb"))))) + map)) + +(defconst rails-minor-mode-nav-menu-bar-map + (let ((map (make-sparse-keymap))) + (define-keys map + ([goto-fixtures] '("Go to Fixtures" . rails-nav:goto-fixtures)) + ([goto-plugins] '("Go to Plugins" . rails-nav:goto-plugins)) + ([goto-migrate] '("Go to Migrations" . rails-nav:goto-migrate)) + ([goto-layouts] '("Go to Layouts" . rails-nav:goto-layouts)) + ([goto-stylesheets] '("Go to Stylesheets" . rails-nav:goto-stylesheets)) + ([goto-javascripts] '("Go to Javascripts" . rails-nav:goto-javascripts)) + ([goto-helpers] '("Go to Helpers" . rails-nav:goto-helpers)) + ([goto-mailers] '("Go to Mailers" . rails-nav:goto-mailers)) + ([goto-observers] '("Go to Observers" . rails-nav:goto-observers)) + ([goto-unit-tests] '("Go to Unit Tests" . rails-nav:goto-unit-tests)) + ([goto-func-tests] '("Go to Functional Tests" . rails-nav:goto-functional-tests)) + ([goto-models] '("Go to Models" . rails-nav:goto-models)) + ([goto-controllers] '("Go to Controllers" . rails-nav:goto-controllers))) + map)) + +(defconst rails-minor-mode-tests-menu-bar-map + (let ((map (make-sparse-keymap))) + (define-keys map + ([integration] '("Integration Tests" . (lambda() (interactive) (rails-test:run "integration")))) + ([unit] '("Unit Tests" . (lambda() (interactive) (rails-test:run "units")))) + ([functional] '("Functional Tests" . (lambda() (interactive) (rails-test:run "functionals")))) + ([recent] '("Recent Tests" . (lambda() (interactive) (rails-test:run "recent")))) + ([tests] '("All" . (lambda() (interactive) (rails-test:run "all")))) + ([separator] '("--")) + ([toggle] '(menu-item "Toggle Output Window" rails-script:toggle-output-window + :enable (get-buffer rails-script:buffer-name))) + ([run-current] '("Test Current Model/Controller/Mailer" . rails-test:run-current)) + ([run] '("Run Tests ..." . rails-test:run))) + map)) + +(defconst rails-minor-mode-db-menu-bar-map + (let ((map (make-sparse-keymap))) + (define-keys map + ([clone-db] '("Clone Development DB to Test DB" . (lambda() (interactive) (rails-rake:task "db:test:clone")))) + ([load-schema] '("Load schema.rb to DB" . (lambda() (interactive) (rails-rake:task "db:schema:load")))) + ([dump-schema] '("Dump DB to schema.rb" . (lambda() (interactive) (rails-rake:task "db:schema:dump")))) + ([sep] '("--")) + ([prev] '("Migrate to Previous Version" . rails-rake:migrate-to-prev-version)) + ([version] '("Migrate to Version ..." . rails-rake:migrate-to-version)) + ([migrate] '("Migrate" . rails-rake:migrate))) + map)) + +(define-keys rails-minor-mode-menu-bar-map + + ([rails] (cons "RoR" (make-sparse-keymap "RubyOnRails"))) + + ([rails rails-customize] '("Customize" . (lambda () (interactive) (customize-group 'rails)))) + ([rails separator0] '("--")) + ([rails svn-status] '("SVN Status" . rails-svn-status-into-root)) + ([rails api-doc] '("Rails API Doc at Point" . rails-browse-api-at-point)) + ([rails sql] '("SQL Rails Buffer" . rails-run-sql)) + ([rails tag] '("Update TAGS File" . rails-create-tags)) + ([rails ri] '("Search Documentation" . rails-search-doc)) + ([rails goto-file-by-line] '("Go to File by Line" . rails-goto-file-on-current-line)) + ([rails switch-file-menu] '("Switch file Menu..." . rails-lib:run-secondary-switch)) + ([rails switch-file] '("Switch File" . rails-lib:run-primary-switch)) + ([rails separator1] '("--")) + + ([rails scr] (cons "Scripts" (make-sparse-keymap "Scripts"))) + + ([rails scr gen] (cons "Generate" (make-sparse-keymap "Generate"))) + ([rails scr destr] (cons "Destroy" (make-sparse-keymap "Generators"))) + + ([rails scr destr resource] '("Resource" . rails-script:destroy-resource)) + ([rails scr destr observer] '("Observer" . rails-script:destroy-observer)) + ([rails scr destr mailer] '("Mailer" . rails-script:destroy-mailer)) + ([rails scr destr plugin] '("Plugin" . rails-script:destroy-plugin)) + ([rails scr destr migration] '("Migration" . rails-script:destroy-migration)) + ([rails scr destr scaffold] '("Scaffold" . rails-script:destroy-scaffold)) + ([rails scr destr model] '("Model" . rails-script:destroy-model)) + ([rails scr destr controller] '("Controller" . rails-script:destroy-controller)) + ([rails scr destr separator] '("--")) + ([rails scr destr run] '("Run Destroy ..." . rails-script:destroy)) + + ([rails scr gen resource] '("Resource" . rails-script:generate-resource)) + ([rails scr gen observer] '("Observer" . rails-script:generate-observer)) + ([rails scr gen mailer] '("Mailer" . rails-script:generate-mailer)) + ([rails scr gen plugin] '("Plugin" . rails-script:generate-plugin)) + ([rails scr gen migration] '("Migration" . rails-script:generate-migration)) + ([rails scr gen scaffold] '("Scaffold" . rails-script:generate-scaffold)) + ([rails scr gen model] '("Model" . rails-script:generate-model)) + ([rails scr gen controller] '("Controller" . rails-script:generate-controller)) + ([rails scr gen separator] '("--")) + ([rails scr gen run] '("Run Generate ..." . rails-script:generate)) + + ([rails scr break] '("Breakpointer" . rails-script:breakpointer)) + ([rails scr console] '("Console" . rails-script:console)) + ([rails scr rake] '("Rake..." . rails-rake:task)) + + ([rails nav] (cons "Navigation" rails-minor-mode-nav-menu-bar-map)) + ([rails config] (cons "Configuration" rails-minor-mode-config-menu-bar-map)) + ([rails log] (cons "Log Files" rails-minor-mode-log-menu-bar-map)) + + ([rails ws] (cons "WebServer" (make-sparse-keymap "WebServer"))) + + ([rails ws use-webrick] '(menu-item "Use WEBrick" (lambda() (interactive) + (rails-ws:switch-default-server-type "webrick")) + :button (:toggle . (rails-ws:default-server-type-p "webrick")))) + ([rails ws use-lighttpd] '(menu-item "Use Lighty" (lambda() (interactive) + (rails-ws:switch-default-server-type "lighttpd")) + :button (:toggle . (rails-ws:default-server-type-p "lighttpd")))) + ([rails ws use-mongrel] '(menu-item "Use Mongrel" (lambda() (interactive) + (rails-ws:switch-default-server-type "mongrel")) + :button (:toggle . (rails-ws:default-server-type-p "mongrel")))) + ([rails ws separator] '("--")) + + ([rails ws brows] '(menu-item "Open Browser..." rails-ws:open-browser-on-controller + :enable (rails-ws:running-p))) + ([rails ws auto-brows] '(menu-item "Open Browser on Current Action" rails-ws:auto-open-browser + :enable (rails-ws:running-p))) + ([rails ws url] '(menu-item "Open Browser" rails-ws:open-browser + :enable (rails-ws:running-p))) + ([rails ws separator2] '("--")) + + ([rails ws test] '(menu-item "Start Test" rails-ws:start-test + :enable (not (rails-ws:running-p)))) + ([rails ws production] '(menu-item "Start Production" rails-ws:start-production + :enable (not (rails-ws:running-p)))) + ([rails ws development] '(menu-item "Start Development" rails-ws:start-development + :enable (not (rails-ws:running-p)))) + ([rails ws separator3] '("--")) + + ([rails ws status] '(menu-item "Print Status" rails-ws:print-status)) + ([rails ws default] '(menu-item "Start/Stop Web Server (With Default Environment)" rails-ws:toggle-start-stop)) + ) + +(defcustom rails-minor-mode-prefix-key "\C-c" + "Key prefix for rails minor mode." + :group 'rails) + +(defmacro rails-key (key) + `(kbd ,(concat rails-minor-mode-prefix-key " " key))) + +(defconst rails-minor-mode-test-current-method-key (rails-key "\C-c ,")) + +(defvar rails-minor-mode-map + (let ((map (make-keymap))) + map)) + +(define-keys rails-minor-mode-map + ([menu-bar] rails-minor-mode-menu-bar-map) + ([menu-bar rails-tests] (cons "Tests" rails-minor-mode-tests-menu-bar-map)) + ([menu-bar rails-db] (cons "Database" rails-minor-mode-db-menu-bar-map)) + + ;; Goto + ((rails-key "\C-c g m") 'rails-nav:goto-models) + ((rails-key "\C-c g c") 'rails-nav:goto-controllers) + ((rails-key "\C-c g o") 'rails-nav:goto-observers) + ((rails-key "\C-c g n") 'rails-nav:goto-mailers) + ((rails-key "\C-c g h") 'rails-nav:goto-helpers) + ((rails-key "\C-c g l") 'rails-nav:goto-layouts) + ((rails-key "\C-c g s") 'rails-nav:goto-stylesheets) + ((rails-key "\C-c g j") 'rails-nav:goto-javascripts) + ((rails-key "\C-c g g") 'rails-nav:goto-migrate) + ((rails-key "\C-c g p") 'rails-nav:goto-plugins) + ((rails-key "\C-c g x") 'rails-nav:goto-fixtures) + ((rails-key "\C-c g f") 'rails-nav:goto-functional-tests) + ((rails-key "\C-c g u") 'rails-nav:goto-unit-tests) + + ;; Switch + ((kbd "") 'rails-lib:run-primary-switch) + ((kbd "") 'rails-lib:run-secondary-switch) + ((rails-key "") 'rails-lib:run-primary-switch) + ((rails-key "") 'rails-lib:run-secondary-switch) + ((kbd "") 'rails-goto-file-on-current-line) + + ;; Scripts & SQL + ((rails-key "\C-c e") 'rails-script:generate) + ((rails-key "\C-c x") 'rails-script:destroy) + ((rails-key "\C-c s c") 'rails-script:console) + ((rails-key "\C-c s b") 'rails-script:breakpointer) + ((rails-key "\C-c s s") 'rails-run-sql) + ((rails-key "\C-c w s") 'rails-ws:toggle-start-stop) + ((rails-key "\C-c w d") 'rails-ws:start-development) + ((rails-key "\C-c w p") 'rails-ws:start-production) + ((rails-key "\C-c w t") 'rails-ws:start-test) + ((rails-key "\C-c w i") 'rails-ws:print-status) + ((rails-key "\C-c w a") 'rails-ws:auto-open-browser) + + ;; Rails finds + ((rails-key "\C-c f m") 'rails-find:models) + ((rails-key "\C-c f c") 'rails-find:controller) + ((rails-key "\C-c f h") 'rails-find:helpers) + ((rails-key "\C-c f l") 'rails-find:layout) + ((rails-key "\C-c f s") 'rails-find:stylesheets) + ((rails-key "\C-c f j") 'rails-find:javascripts) + ((rails-key "\C-c f g") 'rails-find:migrate) + ((rails-key "\C-c f b") 'rails-find:lib) + ((rails-key "\C-c f t") 'rails-find:tasks) + ((rails-key "\C-c f v") 'rails-find:view) + ((rails-key "\C-c f d") 'rails-find:db) + ((rails-key "\C-c f p") 'rails-find:public) + ((rails-key "\C-c f f") 'rails-find:fixtures) + ((rails-key "\C-c f o") 'rails-find:config) + + ((rails-key "\C-c d m") 'rails-rake:migrate) + ((rails-key "\C-c d v") 'rails-rake:migrate-to-version) + ((rails-key "\C-c d p") 'rails-rake:migrate-to-prev-version) + + ;; Tests + ((rails-key "\C-c r") 'rails-rake:task) + ((rails-key "\C-c t") 'rails-test:run) + ((rails-key "\C-c .") 'rails-test:run-current) + + ;; Navigation + + ((rails-key "\C-c l") 'rails-log:open) + ;; Tags + ((rails-key "\C-c \C-t") 'rails-create-tags) + + ;; Documentation + ([f1] 'rails-search-doc) + ((kbd "") 'rails-browse-api-at-point) + ((rails-key "") 'rails-browse-api) + ((rails-key "/") 'rails-script:toggle-output-window) + + ([f9] 'rails-svn-status-into-root)) + +;; Global keys and menubar + +(global-set-key (rails-key "\C-c j") 'rails-script:create-project) + +(when-bind (map (lookup-key global-map [menu-bar file])) + (define-key-after + map + [create-rails-project] + '("Create Rails Project" . rails-script:create-project) 'insert-file)) + +(provide 'rails-ui) diff --git a/emacs.d/rails/.svn/text-base/rails-unit-test-minor-mode.el.svn-base b/emacs.d/rails/.svn/text-base/rails-unit-test-minor-mode.el.svn-base new file mode 100644 index 0000000..d558ae0 --- /dev/null +++ b/emacs.d/rails/.svn/text-base/rails-unit-test-minor-mode.el.svn-base @@ -0,0 +1,43 @@ +;;; rails-unit-test-minor-mode.el --- minor mode for RubyOnRails unit tests + +;; Copyright (C) 2006 Dmitry Galinsky + +;; Authors: Dmitry Galinsky + +;; Keywords: ruby rails languages oop +;; $URL$ +;; $Id$ + +;;; License + +;; This program is free software; you can redistribute it and/or +;; modify it under the terms of the GNU General Public License +;; as published by the Free Software Foundation; either version 2 +;; of the License, or (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program; if not, write to the Free Software +;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. + +;;; Code: + +(define-minor-mode rails-unit-test-minor-mode + "Minor mode for RubyOnRails unit tests." + :lighter " UTest" + :keymap (let ((map (rails-model-layout:keymap :unit-test))) + (define-key map rails-minor-mode-test-current-method-key 'rails-test:run-current-method) + (define-key map [menu-bar rails-model-layout run] '("Test current method" . rails-test:run-current-method)) + map) + (setq rails-primary-switch-func (lambda() + (interactive) + (if (rails-core:mailer-p (rails-core:current-model)) + (rails-model-layout:switch-to-mailer) + (rails-model-layout:switch-to-model)))) + (setq rails-secondary-switch-func 'rails-model-layout:menu)) + +(provide 'rails-unit-test-minor-mode) \ No newline at end of file diff --git a/emacs.d/rails/.svn/text-base/rails-view-minor-mode.el.svn-base b/emacs.d/rails/.svn/text-base/rails-view-minor-mode.el.svn-base new file mode 100644 index 0000000..3279168 --- /dev/null +++ b/emacs.d/rails/.svn/text-base/rails-view-minor-mode.el.svn-base @@ -0,0 +1,115 @@ +;;; rails-view-minor-mode.el --- minor mode for RubyOnRails views + +;; Copyright (C) 2006 Dmitry Galinsky + +;; Authors: Dmitry Galinsky + +;; Keywords: ruby rails languages oop +;; $URL$ +;; $Id$ + +;;; License + +;; This program is free software; you can redistribute it and/or +;; modify it under the terms of the GNU General Public License +;; as published by the Free Software Foundation; either version 2 +;; of the License, or (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program; if not, write to the Free Software +;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. + +;;; Code: + +(defun rails-view-minor-mode:create-partial-from-selection () + "Create a partial from current buffer selection." + (interactive) + (if mark-active + (save-excursion + (let ((name (read-string "Partial name (without _ and extension)? ")) + (content (buffer-substring-no-properties (region-beginning) (region-end))) + (modified (buffer-modified-p))) + (unless (string-not-empty name) + (progn + (message "Empty partial name") (return))) + (kill-region (region-beginning) (region-end)) + (insert (concat "<%= render :partial => \"" name "\" %>")) + (mmm-parse-region (line-beginning-position) (line-end-position)) + (insert "\n") + (split-window-vertically) + (other-window 1) + (find-file (concat "_" name ".rhtml")) + (goto-char (point-min)) + (erase-buffer) + (insert content) + (save-buffer) + (fit-window-to-buffer) + (other-window -1) + (unless modified (save-buffer)) + (message "type `C-x +` to balance windows"))))) + +(defun rails-view-minor-mode:create-helper-from-block (&optional helper-name) + "Create a helper function from current ERb block (<% .. %>)." + (interactive) + (let ((current-pos (point)) + (file buffer-file-name) + begin-pos + end-pos) + (save-excursion + (setq begin-pos (search-backward "<%" nil t)) + (setq end-pos (search-forward "%>" nil t))) + (if (and begin-pos + end-pos + (> current-pos begin-pos) + (< current-pos end-pos)) + (let* ((helper-file (concat (rails-project:root) (rails-core:helper-file (rails-core:current-controller)))) + (content (replace-regexp-in-string "\\(<%=?\\|-?%>\\)" "" + (buffer-substring-no-properties begin-pos end-pos))) + (helper-defination (if helper-name helper-name + (read-string "Type helper function defination (without `def` keyword): ")))) + (if (file-exists-p helper-file) + (let ((modified (buffer-modified-p)) + (helper-func-def (concat "def " helper-defination))) + (kill-region begin-pos end-pos) + (insert (concat "<%= " helper-defination " -%>" )) + (mmm-parse-region (line-beginning-position) (line-end-position)) + (insert "\n") + (split-window-vertically) + (other-window 1) + (find-file helper-file) + (goto-char (point-min)) + (search-forward-regexp "module +[a-zA-Z0-9:]+") + (end-of-line) + (newline) + (ruby-indent-command) + (save-excursion + (insert (concat helper-func-def "\n" content "\nend\n"))) + (ruby-indent-exp) + (fit-window-to-buffer) + (save-buffer) + (other-window -1) + (unless modified (save-buffer)) + (message "Type `C-x +` to balance windows")) + (message "helper not found"))) + (message "block not found")))) + +(define-minor-mode rails-view-minor-mode + "Minor mode for RubyOnRails views." + :lighter " View" + :keymap (rails-controller-layout:keymap :view) + (setq rails-primary-switch-func 'rails-controller-layout:toggle-action-view) + (setq rails-secondary-switch-func 'rails-controller-layout:menu) + (if (boundp 'mmm-mode-map) + (progn + (define-key mmm-mode-map (rails-key "p") 'rails-view-minor-mode:create-partial-from-selection) + (define-key mmm-mode-map (rails-key "b") 'rails-view-minor-mode:create-helper-from-block)) + (progn + (local-set-key (rails-key "p") 'rails-view-minor-mode:create-partial-from-selection) + (local-set-key (rails-key "b") 'rails-view-minor-mode:create-helper-from-block)))) + +(provide 'rails-view-minor-mode) \ No newline at end of file diff --git a/emacs.d/rails/.svn/text-base/rails-ws.el.svn-base b/emacs.d/rails/.svn/text-base/rails-ws.el.svn-base new file mode 100644 index 0000000..db4be8c --- /dev/null +++ b/emacs.d/rails/.svn/text-base/rails-ws.el.svn-base @@ -0,0 +1,191 @@ +;;; rails-ws.el --- functions for manadge application server + +;; Copyright (C) 2006 Dmitry Galinsky + +;; Authors: Dmitry Galinsky , +;; Rezikov Peter + +;; Keywords: ruby rails languages oop +;; $URL$ +;; $Id$ + +;;; License + +;; This program is free software; you can redistribute it and/or +;; modify it under the terms of the GNU General Public License +;; as published by the Free Software Foundation; either version 2 +;; of the License, or (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program; if not, write to the Free Software +;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. + +;;; Code: + +(defcustom rails-ws:port "3000" + "Default web server port" + :group 'rails + :type 'string + :tag "Rails Server Port") + +(defcustom rails-ws:server-name "http://localhost" + "Protocol and the hostname for web server or other rails server" + :group 'rails + :type 'string + :tag "Rails Server Default") + +(defcustom rails-ws:default-server-type "mongrel" + "Web server to run Rails application." + :group 'rails + :type 'string + :tag "Rails Server Type") + +(defvar rails-ws:available-servers-list (list "mongrel" "lighttpd" "webrick")) +(defvar rails-ws:buffer-name "*RWebServer*") +(defvar rails-ws:process-environment nil) + +(defun rails-ws:default-server-type-p (type) + (string= type rails-ws:default-server-type)) + +(defun rails-ws:switch-default-server-type (type) + "Switch default server type to run." + (interactive (list (completing-read "Server type (use autocomplete): " + rails-ws:available-servers-list + nil t + rails-ws:default-server-type))) + (setq rails-ws:default-server-type type) + (customize-save-variable 'rails-ws:default-server-type rails-ws:default-server-type) + (message (concat "Switching to " (upcase type) " as default server type"))) + +(defun rails-ws:running-p () + "Return t if a WebServer process is running." + (if (get-buffer-process rails-ws:buffer-name) t nil)) + +(defun rails-ws:sentinel-proc (proc msg) + (let ((env rails-ws:process-environment)) + (when (memq (process-status proc) '(exit signal)) + (setq rails-ws:process-environment nil) + (setq msg (format "stopped (%s)" msg))) + (message + (replace-regexp-in-string "\n" "" + (format "%s - %s" + (capitalize rails-ws:default-server-type) + msg))))) + +(defun rails-ws:start(&optional env) + "Start a server process with ENV environment if ENV is not set +using `rails-default-environment'." + (interactive (list (rails-read-enviroment-name))) + (rails-project:with-root + (root) + (let ((proc (get-buffer-process rails-ws:buffer-name))) + (if proc + (message "Only one instance rails-ws allowed") + (let* ((default-directory root) + (env (if env env rails-default-environment)) + (proc + (rails-cmd-proxy:start-process rails-ruby-command + rails-ws:buffer-name + rails-ruby-command + (format "script/server %s -p %s -e %s" + rails-ws:default-server-type + rails-ws:port env)))) + (set-process-sentinel proc 'rails-ws:sentinel-proc) + (setq rails-ws:process-environment env) + (message (format "%s (%s) starting with port %s" + (capitalize rails-ws:default-server-type) + env + rails-ws:port))))))) + +(defun rails-ws:stop () + "Stop the WebServer process." + (interactive) + (let ((proc (get-buffer-process rails-ws:buffer-name))) + (when proc (kill-process proc t)))) + + +(defun rails-ws:start-default () + "Start WebServer using the default environment defined in +`rails-default-environment'." + (interactive) + (rails-ws:start rails-default-environment)) + +(defun rails-ws:start-development () + (interactive) + (rails-ws:start "development")) + +(defun rails-ws:start-production () + (interactive) + (rails-ws:start "production")) + +(defun rails-ws:start-test () + (interactive) + (rails-ws:start "test")) + +(defun rails-ws:toggle-start-stop () + "Toggle Rails WebServer start/stop with default environment." + (interactive) + (if (rails-ws:running-p) + (rails-ws:stop) + (rails-ws:start-default))) + +(defun rails-ws:print-status () + (interactive) + (message + (concat rails-ws:default-server-type + " (" (if rails-ws:process-environment + rails-ws:process-environment + rails-default-environment) ")" + " is " + (if (rails-ws:running-p) + (concat "running on port " rails-ws:port) + "stopped")))) + +;;;;;;;;;; Open browser ;;;;;;;;;; + +(defun rails-ws:open-browser (&optional address) + "Open a browser on the main page of the current Rails project +server." + (interactive) + (let ((url (concat (concat rails-ws:server-name + ":" + rails-ws:port + "/" + address )))) + (message "Opening browser: %s" url) + (browse-url url))) + +(defun rails-ws:open-browser-on-controller (&optional controller action params) + "Open browser on the controller/action/id for the current +file." + (interactive + (list + (completing-read "Controller name: " + (list->alist (rails-core:controllers t))) + (read-from-minibuffer "Action name: ") + (read-from-minibuffer "Params: "))) + (when (string-not-empty controller) + (rails-ws:open-browser + (concat (rails-core:file-by-class controller t) "/" + (if (string-not-empty action) (concat action "/")) params)))) + +(defun rails-ws:auto-open-browser (ask-parameters?) + "Autodetect the current action and open browser on it with. +Prefix the command to ask parameters for action." + (interactive "P") + (rails-project:with-root + (root) + (if (find (rails-core:buffer-type) '(:view :controller)) + (when-bind (controller (rails-core:current-controller)) + (rails-ws:open-browser-on-controller + controller (rails-core:current-action) + (when ask-parameters? + (read-from-minibuffer "Parameters: ")))) + (message "You can auto-open browser only in view or controller")))) + +(provide 'rails-ws) \ No newline at end of file diff --git a/emacs.d/rails/.svn/text-base/rails.el.svn-base b/emacs.d/rails/.svn/text-base/rails.el.svn-base new file mode 100644 index 0000000..579267d --- /dev/null +++ b/emacs.d/rails/.svn/text-base/rails.el.svn-base @@ -0,0 +1,452 @@ +;;; rails.el --- minor mode for editing RubyOnRails code + +;; Copyright (C) 2006 Dmitry Galinsky + +;; Authors: Dmitry Galinsky , +;; Rezikov Peter + +;; Keywords: ruby rails languages oop +;; $URL$ +;; $Id$ + +;;; License + +;; This program is free software; you can redistribute it and/or +;; modify it under the terms of the GNU General Public License +;; as published by the Free Software Foundation; either version 2 +;; of the License, or (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program; if not, write to the Free Software +;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. + +;;; Code: + +(unless (<= 22 emacs-major-version) + (error + (format "emacs-rails require CVS version of Emacs (future Emacs 22), and not be running on your Emacs %s.%s" + emacs-major-version + emacs-minor-version))) + +(eval-when-compile + (require 'speedbar) + (require 'inf-ruby) + (require 'ruby-mode) + (require 'ruby-electric)) + +(require 'sql) +(require 'ansi-color) +(require 'etags) +(require 'find-recursive) + +(require 'untabify-file) +(require 'predictive-prog-mode) + +(require 'inflections) + +(require 'rails-compat) +(require 'rails-project) + +(require 'rails-core) +(require 'rails-ruby) +(require 'rails-lib) + +(require 'rails-cmd-proxy) +(require 'rails-navigation) +(require 'rails-find) +(require 'rails-scripts) +(require 'rails-rake) +(require 'rails-test) +(require 'rails-ws) +(require 'rails-log) +(require 'rails-ui) +(require 'rails-model-layout) +(require 'rails-controller-layout) +(require 'rails-features) + + +;;;;;;;;;; Variable definition ;;;;;;;;;; + +(defgroup rails nil + "Edit Rails projet with Emacs." + :group 'programming + :prefix "rails-") + +(defcustom rails-api-root nil + "*Root of Rails API html documentation. Must be a local directory." + :group 'rails + :type 'string) + +(defcustom rails-use-alternative-browse-url nil + "Indicates an alternative way of loading URLs on Windows. +Try using the normal method before. If URLs invoked by the +program don't end up in the right place, set this option to +true." + :group 'rails + :type 'boolean) + +(defcustom rails-browse-api-with-w3m nil + "Indicates that the user wants to browse the Rails API using +Emacs w3m browser." + :group 'rails + :type 'boolean) + +(defcustom rails-tags-command "ctags -e -a --Ruby-kinds=-f -o %s -R %s" + "Command used to generate TAGS in Rails root" + :group 'rails + :type 'string) + +(defcustom rails-ri-command "ri" + "Command used to invoke the ri utility." + :group 'rails + :type 'string) + +(defcustom rails-always-use-text-menus nil + "Force the use of text menus by default." + :group 'rails + :type 'boolean) + +(defcustom rails-ask-when-reload-tags nil + "Indicates whether the user should confirm reload a TAGS table or not." + :group 'rails + :type 'boolean) + +(defcustom rails-chm-file nil + "Path to CHM documentation file on Windows, or nil." + :group 'rails + :type 'string) + +(defcustom rails-ruby-command "ruby" + "Ruby preferred command line invocation." + :group 'rails + :type 'string) + +(defcustom rails-layout-template + " + + + + + <%= stylesheet_link_tag \"default\" %> + + + + <%= yield %> + +" + "Default html template for new rails layout" + :group 'rails + :type 'string) + +(defvar rails-version "0.5.99.1") +(defvar rails-templates-list '("erb" "rhtml" "rxml" "rjs" "haml" "liquid")) +(defvar rails-use-another-define-key nil) +(defvar rails-primary-switch-func nil) +(defvar rails-secondary-switch-func nil) + +(defvar rails-directory<-->types + '((:controller "app/controllers/") + (:layout "app/layouts/") + (:view "app/views/") + (:observer "app/models/" (lambda (file) (rails-core:observer-p file))) + (:mailer "app/models/" (lambda (file) (rails-core:mailer-p file))) + (:model "app/models/" (lambda (file) (and (not (rails-core:mailer-p file)) + (not (rails-core:observer-p file))))) + (:helper "app/helpers/") + (:plugin "vendor/plugins/") + (:unit-test "test/unit/") + (:functional-test "test/functional/") + (:fixture "test/fixtures/") + (:migration "db/migrate")) + "Rails file types -- rails directories map") + +(defvar rails-enviroments '("development" "production" "test")) +(defvar rails-default-environment (first rails-enviroments)) + +(defvar rails-adapters-alist + '(("mysql" . sql-mysql) + ("postgresql" . sql-postgres) + ("sqlite3" . sql-sqlite)) + "Sets emacs sql function for rails adapter names.") + +(defvar rails-tags-dirs '("app" "lib" "test" "db") + "List of directories from RAILS_ROOT where ctags works.") + +(defun rails-use-text-menu () + "If t use text menu, popup menu otherwise" + (or (null window-system) rails-always-use-text-menus)) + +;;;;;;;; hack ;;;; +(defun rails-svn-status-into-root () + (interactive) + (rails-project:with-root (root) + (svn-status root))) + +;; helper functions/macros +(defun rails-search-doc (&optional item) + (interactive) + (setq item (if item item (thing-at-point 'sexp))) + (unless item + (setq item (read-string "Search symbol: "))) + (if item + (if (and rails-chm-file + (file-exists-p rails-chm-file)) + (start-process "keyhh" "*keyhh*" "keyhh.exe" "-#klink" + (format "'%s'" item) rails-chm-file) + (let ((buf (buffer-name))) + (unless (string= buf "*ri*") + (switch-to-buffer-other-window "*ri*")) + (setq buffer-read-only nil) + (kill-region (point-min) (point-max)) + (message (concat "Please wait...")) + (call-process rails-ri-command nil "*ri*" t item) + (local-set-key [return] 'rails-search-doc) + (ansi-color-apply-on-region (point-min) (point-max)) + (setq buffer-read-only t) + (goto-char (point-min)))))) + +(defun rails-create-tags() + "Create tags file" + (interactive) + (rails-project:in-root + (message "Creating TAGS, please wait...") + (let ((tags-file-name (rails-core:file "TAGS"))) + (shell-command + (format rails-tags-command tags-file-name + (strings-join " " (mapcar #'rails-core:file rails-tags-dirs)))) + (flet ((yes-or-no-p (p) (if rails-ask-when-reload-tags + (y-or-n-p p) + t))) + (visit-tags-table tags-file-name))))) + +(defun rails-apply-for-buffer-type () + (let* ((type (rails-core:buffer-type)) + (name (substring (symbol-name type) 1)) + (minor-mode-name (format "rails-%s-minor-mode" name)) + (minor-mode-abbrev (concat minor-mode-name "-abbrev-table"))) + (when (require (intern minor-mode-name) nil t) ;; load new style minor mode rails-*-minor-mode + (when (fboundp (intern minor-mode-name)) + (apply (intern minor-mode-name) (list t)) + (when (boundp (intern minor-mode-abbrev)) + (merge-abbrev-tables + (symbol-value (intern minor-mode-abbrev)) + local-abbrev-table)))))) + +;;;;;;;;;; Database integration ;;;;;;;;;; + +(defstruct rails-db-conf adapter host database username password) + +(defun rails-db-parameters (env) + "Return database parameters for enviroment ENV" + (with-temp-buffer + (shell-command + (format "ruby -r yaml -r erb -e 'YAML.load(ERB.new(ARGF.read).result)[\"%s\"].to_yaml.display' %s" + env + (rails-core:file "config/database.yml")) + (current-buffer)) + (let ((answer + (make-rails-db-conf + :adapter (yml-value "adapter") + :host (yml-value "host") + :database (yml-value "database") + :username (yml-value "username") + :password (yml-value "password")))) + answer))) + +(defun rails-database-emacs-func (adapter) + "Return the Emacs function for ADAPTER that, when run, will ++invoke the appropriate database server console." + (cdr (assoc adapter rails-adapters-alist))) + +(defun rails-read-enviroment-name (&optional default) + "Read Rails enviroment with auto-completion." + (completing-read "Environment name: " (list->alist rails-enviroments) nil nil default)) + +(defun* rails-run-sql (&optional env) + "Run a SQL process for the current Rails project." + (interactive (list (rails-read-enviroment-name "development"))) + (rails-project:with-root (root) + (cd root) + (if (bufferp (sql-find-sqli-buffer)) + (switch-to-buffer-other-window (sql-find-sqli-buffer)) + (let ((conf (rails-db-parameters env))) + (let ((sql-database (rails-db-conf-database conf)) + (default-process-coding-system '(utf-8 . utf-8)) + (sql-server (rails-db-conf-host conf)) + (sql-user (rails-db-conf-username conf)) + (sql-password (rails-db-conf-password conf))) + ;; Reload localy sql-get-login to avoid asking of confirmation of DB login parameters + (flet ((sql-get-login (&rest pars) () t)) + (funcall (rails-database-emacs-func (rails-db-conf-adapter conf))))))))) + +(defun rails-has-api-root () + "Test whether `rails-api-root' is configured or not, and offer to configure +it in case it's still empty for the project." + (rails-project:with-root + (root) + (unless (or (file-exists-p (rails-core:file "doc/api/index.html")) + (not (yes-or-no-p (concat "This project has no API documentation. " + "Would you like to configure it now? ")))) + (let (clobber-gems) + (message "This may take a while. Please wait...") + (unless (file-exists-p (rails-core:file "vendor/rails")) + (setq clobber-gems t) + (message "Freezing gems...") + (shell-command-to-string "rake rails:freeze:gems")) + ;; Hack to allow generation of the documentation for Rails 1.0 and 1.1 + ;; See http://dev.rubyonrails.org/ticket/4459 + (unless (file-exists-p (rails-core:file "vendor/rails/activesupport/README")) + (write-string-to-file (rails-core:file "vendor/rails/activesupport/README") + "Placeholder")) + (message "Generating documentation...") + (shell-command-to-string "rake doc:rails") + (if clobber-gems + (progn + (message "Unfreezing gems...") + (shell-command-to-string "rake rails:unfreeze"))) + (message "Done..."))) + (if (file-exists-p (rails-core:file "doc/api/index.html")) + (setq rails-api-root (rails-core:file "doc/api"))))) + +(defun rails-browse-api () + "Browse Rails API on RAILS-API-ROOT." + (interactive) + (if (rails-has-api-root) + (rails-browse-api-url (concat rails-api-root "/index.html")) + (message "Please configure variable rails-api-root."))) + +(defun rails-get-api-entries (name file sexp get-file-func) + "Return all API entries named NAME in file FILE using SEXP to +find matches, and GET-FILE-FUNC to process the matches found." + (if (file-exists-p (concat rails-api-root "/" file)) + (save-current-buffer + (save-match-data + (find-file (concat rails-api-root "/" file)) + (let* ((result + (loop for line in (split-string (buffer-string) "\n") + when (string-match (format sexp (regexp-quote name)) line) + collect (cons (match-string-no-properties 2 line) + (match-string-no-properties 1 line))))) + (kill-buffer (current-buffer)) + (when-bind (api-file (funcall get-file-func result)) + (rails-browse-api-url (concat "file://" rails-api-root "/" api-file)))))) + (message "There are no API docs."))) + +(defun rails-browse-api-class (class) + "Browse the Rails API documentation for CLASS." + (rails-get-api-entries + class "fr_class_index.html" "%s<" + (lambda (entries) + (cond ((= 0 (length entries)) (progn (message "No API Rails doc for class %s." class) nil)) + ((= 1 (length entries)) (cdar entries)))))) + +(defun rails-browse-api-method (method) + "Browse the Rails API documentation for METHOD." + (rails-get-api-entries + method "fr_method_index.html" "%s[ ]+(\\(.*\\))" + (lambda (entries) + (cond ((= 0 (length entries)) (progn (message "No API Rails doc for %s" method) nil)) + ((= 1 (length entries)) (cdar entries)) + (t (cdr (assoc (completing-read (format "Method %s from what class? " method) entries) + entries))))))) + +(defun rails-browse-api-at-point () + "Open the Rails API documentation on the class or method at the current point. +The variable `rails-api-root' must be pointing to a local path +either in your project or elsewhere in the filesystem. The +function will also offer to build the documentation locally if +necessary." + (interactive) + (if (rails-has-api-root) + (let ((current-symbol (prog2 + (modify-syntax-entry ?: "w") + (thing-at-point 'sexp) + (modify-syntax-entry ?: ".")))) + (if current-symbol + (if (capital-word-p current-symbol) + (rails-browse-api-class current-symbol) + (rails-browse-api-method current-symbol)))) + (message "Please configure \"rails-api-root\"."))) + +;;; Rails minor mode + +(define-minor-mode rails-minor-mode + "RubyOnRails" + nil + " RoR" + rails-minor-mode-map + (abbrev-mode -1) + (make-local-variable 'tags-file-name) + (make-local-variable 'rails-primary-switch-func) + (make-local-variable 'rails-secondary-switch-func) + (rails-features:install)) + +;; hooks + +(add-hook 'ruby-mode-hook + (lambda() + (require 'rails-ruby) + (require 'ruby-electric) + (ruby-electric-mode t) + (imenu-add-to-menubar "IMENU") + (modify-syntax-entry ?! "w" (syntax-table)) + (modify-syntax-entry ?: "w" (syntax-table)) + (modify-syntax-entry ?_ "w" (syntax-table)) + (local-set-key (kbd "C-.") 'complete-tag) + (local-set-key (if rails-use-another-define-key + (kbd "TAB") (kbd "")) + 'indent-or-complete) + (local-set-key (rails-key "f") '(lambda() + (interactive) + (mouse-major-mode-menu (rails-core:menu-position)))) + (local-set-key (kbd "C-:") 'ruby-toggle-string<>simbol) + (local-set-key (if rails-use-another-define-key + (kbd "RET") (kbd "")) + 'ruby-newline-and-indent))) + +(add-hook 'speedbar-mode-hook + (lambda() + (speedbar-add-supported-extension "\\.rb"))) + +(add-hook 'find-file-hooks + (lambda() + (rails-project:with-root + (root) + (progn + (local-set-key (if rails-use-another-define-key + (kbd "TAB") (kbd "")) + 'indent-or-complete) + (rails-minor-mode t) + (rails-apply-for-buffer-type))))) + +;; Run rails-minor-mode in dired + +(add-hook 'dired-mode-hook + (lambda () + (if (rails-project:root) + (rails-minor-mode t)))) + + +(autoload 'haml-mode "haml-mode" "" t) + +(setq auto-mode-alist (cons '("\\.rb$" . ruby-mode) auto-mode-alist)) +(setq auto-mode-alist (cons '("\\.rake$" . ruby-mode) auto-mode-alist)) +(setq auto-mode-alist (cons '("Rakefile$" . ruby-mode) auto-mode-alist)) +(setq auto-mode-alist (cons '("\\.haml$" . haml-mode) auto-mode-alist)) +(setq auto-mode-alist (cons '("\\.rjs$" . ruby-mode) auto-mode-alist)) +(setq auto-mode-alist (cons '("\\.rxml$" . ruby-mode) auto-mode-alist)) +(setq auto-mode-alist (cons '("\\.rhtml$" . html-mode) auto-mode-alist)) + +(modify-coding-system-alist 'file "\\.rb$" 'utf-8) +(modify-coding-system-alist 'file "\\.rake$" 'utf-8) +(modify-coding-system-alist 'file "Rakefile$" 'utf-8) +(modify-coding-system-alist 'file (rails-core:regex-for-match-view) 'utf-8) + +(provide 'rails) diff --git a/emacs.d/rails/.svn/text-base/untabify-file.el.svn-base b/emacs.d/rails/.svn/text-base/untabify-file.el.svn-base new file mode 100644 index 0000000..c6eca13 --- /dev/null +++ b/emacs.d/rails/.svn/text-base/untabify-file.el.svn-base @@ -0,0 +1,56 @@ +;;; untabify-file.el --- automatic untabify files before save + +;; Copyright (C) 2006 Dmitry Galinsky + +;; Authors: Dmitry Galinsky , + +;; Keywords: ruby rails languages oop +;; $URL: svn+ssh://rubyforge/var/svn/emacs-rails/trunk/rails.el $ +;; $Id: rails.el 149 2007-03-29 15:07:49Z dimaexe $ + +;;; License + +;; This program is free software; you can redistribute it and/or +;; modify it under the terms of the GNU General Public License +;; as published by the Free Software Foundation; either version 2 +;; of the License, or (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program; if not, write to the Free Software +;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. + +;;; Code: + +(require 'cl) +(require 'custom) + +(defcustom untabify-exclude-list + '(makefile-mode + makefile-bsdmake-mode + change-log-mode + "Makefile$") + "List of regexp or modes to which is not applied untabify." + :group 'untabify) + +(defun untabify-before-write () + "Strip all trailing whitespaces and untabify buffer before +save." + (when (and (eq this-command 'save-buffer) + (not (find nil + untabify-exclude-list + :if #'(lambda (r) + (typecase r + (string (string-match r (buffer-name))) + (symbol (eq major-mode r))))))) + (save-excursion + (untabify (point-min) (point-max)) + (delete-trailing-whitespace)))) + +(add-hook 'write-file-hooks 'untabify-before-write) + +(provide 'untabify-file) diff --git a/emacs.d/rails/ChangeLog b/emacs.d/rails/ChangeLog new file mode 100644 index 0000000..0ddb440 --- /dev/null +++ b/emacs.d/rails/ChangeLog @@ -0,0 +1,1028 @@ +2007-05-23 Dmitry Galinsky + + * rails-test.el (rails-test:line-regexp): bug #10792: updated regexp + +2007-05-05 Dmitry Galinsky + + * rails.el: fixed #10613, wrong comparsion of emacs major-version + +2007-05-03 Dmitry Galinsky + + * rails-test.el (rails-test:line-regexp): patch #10532, allows '-' to occur in the errror filepath (thanks Peter Williams) + +2007-04-27 Dmitry Galinsky + + * rails.el: raise a error if emacs-rails run on old version of Emacs (less 22). + + * rails-ruby.el: check available flymake before setup ruby-flymake. + +2007-04-25 Dmitry Galinsky + + * rails-speedbar-feature.el (rails-speedbar:expand-directory) + (rails-speedbar:display): updated view mode of "views". + + * rails-compat.el (try-complete-abbrev): don't expand a snippet inside comments or strings. + +2007-04-20 Dmitry Galinsky + + * rails-core.el (rails-core:menu-letters-list) + (rails-core:prepare-menu): created, append a prefix to each label of menu-item from MENU. + +2007-04-19 Dmitry Galinsky + + * rails-speedbar-feature.el (rails-speedbar:expand-tags): append list of templates in controllers + (rails-speedbar:line-directory): created + + * rails-core.el (rails-core:helper-file): append the test/test_helper + (rails-core:views-dir): strip the "_controller" sufix + (rails-core:helpers): added the test/test_helper support + + * rails-speedbar-feature.el (rails-speedbar:line-directory) + (rails-speedbar:root, rails-speedbar:in-root): created + (rails-speedbar-feature:install): install speedbar-mode-line-functions + + * rails-ruby.el (completion-dynamic-syntax-alist): removed + + * rails-core.el (rails-core:class-by-file): updated + +2007-04-18 Dmitry Galinsky + + * rails.el (ruby-mode-hook): removed predictive-prog-mode, it will incorect work in latest CVS builds of Emacs + +2007-04-13 Dmitry Galinsky + + * rails-ruby.el (flymake-ruby-init): apply patch #10056, thanks Rémi Vanicat + + * rails-core.el (rails-core:class-by-file): handle first digit[s] in filename + + * rails-lib.el (capital-word-p): return nil if first char is not + + * inflections.el: rollback to using separate variables instead of structure + +2007-04-12 Dmitry Galinsky + + * rails-test.el: fixed #10053 bug, added rails-core:regexp-for-match-views to compilation-error-regexp + + * predictive-prog-mode.el (activate-predictive-inside-comments): toggle predictive mode using 'predictive-main-dict variable, looking at previous word + + * rails-core.el (rails-core:class-by-file): detect already capitalized words + +2007-04-10 Dmitry Galinsky + + * rails-snippets-feature.el (rails-snippets-feature:list): updated + + * rails-test.el (rails-test:error-regexp-alist): updated + +2007-04-09 Dmitry Galinsky + + * rails-ui.el (rails-minor-mode-prefix-key): created + (rails-key): created + + * predictive-prog-mode.el (predictive-prog-text-faces): fixed compilation warning + +2007-04-08 Dmitry Galinsky + + * rails-speedbar-feature.el (rails-speedbar:roots): created + +2007-04-06 Dmitry Galinsky + + * rails-lib.el (capital-word-p): better word comparsion + + * predictive-prog-mode.el, untabify-file.el: created separate minor-mode + + * rails-compat.el: removed predictive-prog-mode declaration + + * rails-features.el: created + + * rails-predictive-prog-mode-feature.el: created and place into it + predictive-program-mode + + * rails-snippets-feature.el: created + + * rails-ui.el (rails-minor-mode-map): removed snippets menu + + * rails-untabify-feature.el: created and place into it untabify + hook + + * rails.el (find-file-hooks): cleanup + +2007-04-05 Dmitry Galinsky + + * rails.el (auto-mode-alist): added Rakefile to auto-mode-alist + + * rails-ui.el (rails-minor-mode-test-current-method-key): created + + * rails-*-test-minor-mode (rails-unit-test-minor-mode rails-functional-test-minor-mode): + changed hotkey "C-c ." to "C-c C-c ,", the old conflicted with ECB + + * rails-ruby.el (flymake-ruby-load): apply flymake-mode only if + buffer-file-name matched flymake-allowed-file-name-masks + +2007-04-04 Dmitry Galinsky + + * rails-ruby.el (flymake-ruby-load): updated + + * rails-ui.el: reduced the menu length + +2007-04-03 Dmitry Galinsky + + * rails-ruby.el (flymake-ruby-load): updated + + * rails-controller-layout.el (rails-controller-layout:keymap): + created menu group for current minor-mode + + * rails-model-layout.el (rails-model-layout:keymap): created menu + group for current minor-mode + + * rails-core.el (rails-core:controller-file-by-model) + (rails-core:mailer-file, rails-core:mailer-exist-p) + (rails-core:migration-file-by-model) + (rails-core:model-by-migration-filename) + (rails-core:unit-test-exist-p, rails-core:fixture-exist-p) + (rails-core:current-mailer): created + + * rails-model-layout.el (rails-model-layout:keymap): removed mode specific menu + + * rails-controller-layout.el (rails-controller-layout:keymap): removed mode specific menu + + * rails-compat.el (predictive-prog-mode): don't start inside strings + + * rails-core.el: using completion-posn-at-point-as-event instead custom function + + * rails-ui.el (rails-minor-mode-db-menu-bar-map): updated + + * rails-model-layout.el (rails-model-layout:keymap): created + + * rails-core.el (rails-core:buffer-file-match): allow passing nil + + * rails-controller-layout.el (rails-controller-layout:keymap): created + + * rails-cmd-proxy.el (rails-cmd-proxy:convert-buffer-from-remote): fixed compilation warning + + * rails-ruby.el: added flymake support to on the fly syntax check in ruby-mode + + * rails-test.el (rails-test:error-regexp-alist): updated + +2007-04-02 Dmitry Galinsky + + * rails-lib.el (merge-abbrev-tables): mark abbrev as system + +2007-04-01 Dmitry Galinsky + + * rails-snippets.el: updated snippets + + * rails-ui.el (rails-minor-mode-nav-menu-bar-map): created separate menu entry for "Navigate", "Database", "Tests" + + * rails-test.el (rails-test:error-regexp-alist): updated regexp to match errors + + * rails-snippets.el (rails-snippets:list): new snippet group RESTful + + * rails-ruby.el (ruby-align-rules-list): updated regexp for align + + * rails-rake.el (rails-rake:migrate) + (rails-rake:migrate-with-version) + (rails-rake:migrate-to-prev-version): created + + * rails-lib.el: added alias string-join to strings-join + + * rails-core.el (rails-core:mailer-file): fixed bug #9721 + (rails-core:migration-versions): created + + * rails-compat.el (indent-or-complete): restored completion-ui support + +2007-03-30 Dmitry Galinsky + + * rails-test.el (rails-test:error-regexp-alist): updated + + * rails-scripts.el (rails-script:run): added + `rails-cmd-proxy:convert-buffer-from-remote' to + `after-change-functions' + + * rails-ruby.el: added `align' integration code + + * rails-lib.el (string-repeat): created + + * rails-cmd-proxy.el (rails-cmd-proxy:convert-buffer-from-remote): created + + * rails-project.el: created + + * rails-compat.el: created + +2007-03-29 Dmitry Galinsky + + * rails.el (indented-or-complete): added support completion-ui + (activate-predictive-inside-strings): created + (ruby-mode-hook): added pcomplete activation code + + * rails-test.el (rails-test:print-result): don't scroll on top + + * rails-navigation.el (rails-nav:goto-functional-tests): created + (rails-nav:goto-unit-tests): created + + * rails-core.el (rails-core:functional-tests): created + (rails-core:unit-tests): created + + * rails-cmd-proxy.el: updated + + * rails-scripts.el (rails-script:output-mode): updated + + * rails.el (indent-or-complete): updated + + * rails-test.el (rails-test:run): cleanup + + * rails-rake.el (rails-rake:list-of-tasks-without-tests): created + (rails-rake:list-of-tasks): renamed from rails-rake:tasks-list + + * rails-ui.el: created seperate menu group for tests + + * rails-test.el: created, Added tests integration with the compile library + + * rails-scripts.el: refactored + + * rails-rake.el: refactored + + * rails-lib.el (rails-completing-read): created + +2007-03-28 Dmitry Galinsky + + * rails-rake.el (rails-rake:task): removed rails-rake:output-mode + + * rails.el: added forward declaration of try-complete-abbrev, + index-or-complete and setup variable + hippie-expand-try-function-alist + + * rails-snippets.el (rails-snippets:list): updated + + * rails-core.el (rails-core:menu-position): fixed error at `window-live-p' + + * rails-ui.el (rails-minor-mode-menu-bar-map): added menu item for "test current method" + + * rails-ws.el (rails-ws:start): added missing parameter the + rails-ws:default-server-type to startup command + + * rails-scripts.el (rails-script:toggle-output-window): created + + * rails-ws.el (rails-ws:start): fixed bug [#9619], incorect setup of default directory + + * rails-snippets.el (rails-snippets-menu-list): removed + (rails-snippets:create-keymap, rails-snippets:create-lambda) + (rails-snippets:list): created + + * rails-lib.el (create-snippets-and-menumap-from-dsl): removed + +2007-03-27 Dmitry Galinsky + + * rails-snippets.el (rails-snippets-menu-list): updated snippets, + add the "assert_template" snippet + + * rails-rake.el (rails-rake:test-current): created + (rails-rake:run-test-file): created + (rails-rake:test-current-method): created + + * rails-unit-test-minor-mode.el (rails-unit-test-minor-mode): + added hotkey [C-c .] to run test of current method + + * rails-functional-test-minor-mode.el (rails-functional-test-minor-mode): + added hotkey [C-c .] to run test of current method + + * rails-core.el (rails-core:functional-test-file) + (rails-core:unit-test-file, rails-core:observer-p) + (rails-core:mailer-p): allow passing nil + (rails-core:current-method-name): renamed from rails-core:current-function-name + + * rails-scripts.el (rails-script:output-mode-popup-buffer, + rails-script:output-mode-push-first-button): created + (rails-script:output-mode): using hooks instead local-variables + + * rails-rake.el (rails-rake:output-mode): using hooks instead local-variables + + * rails-lib.el (buffer-visible-p): optimization, using `get-buffer-window' + + * rails-model-layout.el (rails-model-layout:switch-to): + display message if file not exists + + * rails-controller-layout.el (rails-controller-layout:switch-to): + display message if file not exists + + * rails-model-layout.el (rails-model-layout:switch-to) + (rails-model-layout:menu): added migrations support + + * rails-migration-minor-mode.el (rails-migration-minor-mode): popup menu entry + + * rails-core.el (rails-core:model-exist-p): return nil if observer + or mailer + (rails-core:migration-file): allow passing a migration name + without number (ex. "CreateUsers") + (rails-core:current-model): added migrations support + (rails-core:migration-file): renamed from migrate-file + + * rails-controller-layout.el (rails-controller-layout:switch-to): + added migration support + + * inflections.el (singularize-string, pluralize-string): allow passing nil + +2007-03-26 Dmitry Galinsky + + * rails-find.el (rails-find:gen): call ido-find-file if possible + + * rails-rake.el (rails-rake:report-result): prints results of all tests + + * rails-ruby.el: fixed compilation warnning + + * rails-rake.el, rails-scripts.el: updated, printed result of tests + + * rails-lib.el, rails.el: fix compilation error [#9547] + + * rails.el (rails-templates-list): added support "erb" and "liquid" + + * rails-lib.el: fixed compilation warnings + + * rails-rake.el: fixed compilation warnings + + * rails-ui.el: updated + + * rails-scripts.el: updated + (rails-script:rake-tests-alist): removed + + * rails-ruby.el (run-ruby-in-buffer): moved from rails-scripts.el + + * rails-rake.el: created + + * rails-core.el (rails-core:migrations): added optional parameter to stip numbers + + * rails-cmd-proxy.el (rails-cmd-proxy:start-process): created + + * rails-scripts.el (rails-script:sentinel-proc): updated + (rails-script:generation-buffer-name): removed + (rails-script:run): updated + (rails-script:create-project): updated + + * rails-lib.el (buffer-visible-p): created + + * rails-core.el (rails-core:file): return nil if FILE-NAME is nil + +2007-03-25 Dmitry Galinsky + + * rails-log.el (rails-log:buffer-name): renamed from rails-log:get-buffer-name + + * rails-core.el (rails-core:add-to-rails-menubar): removed + (rails-core:mailer-file): maked as alias + (rails-core:controller-name): renamed from rails-core:full-controller-name + (rails-core:regex-for-match-view): cleanup + (rails-core:button-action): created + + * rails-find.el: created + + * rails-navigation.el: moved rails-find-* to separate file rails-find.el + + * rails.el (rails-find-file-function): removed variable + + * rails-ui.el (rails-minor-mode-menu-bar-map): update indentation + + * rails-scripts.el: refactored code + +2007-03-24 Dmitry Galinsky + + * rails-unit-test-minor-mode.el (rails-unit-test-minor-mode): fixed + + * rails-navigation.el (rails-line-->controller+action): replace + call rails-core:open-controller+action to + rails-controller-layout:switch-to-action-in-controller + + * rails-snippets.el (snippet-insert): added advice + (rails-snippets-menu-list): updated snippets + + * rails-ws.el (rails-ws:sentinel-proc): change format of the message + (rails-ws:start): fixed + + * rails-navigation.el: removed old style goto-* functions + + * rails.el (ruby-mode-hook): bind ruby-toggle-string<>symbol to [C-:] in ruby mode + + * rails-ui.el (rails-minor-mode-map): added [M-S-up] & [M-S-down] hotkeys + + * rails-snippets.el (rails-snippets-menu-list): updated, split snippets to separate modes + + * rails-ruby.el (ruby-toggle-string<>simbol): created + + * rails-migration-minor-mode.el (rails-migration-minor-mode): created + +2007-03-23 Dmitry Galinsky + + * rails.el (ruby-mode-hook): added [C-:] hotkey to easy switch between strings and symbols + + * rails-ruby.el (ruby-toggle-string<>simbol): created + + * rails.el (ruby-mode-hook): added [C-c f] hotkey to popup `major-menu-mode` menu + + * rails-core.el (rails-core:menu-position): created variable + (rails-core:menu): using `rails-core:menu-position` + + * rails-snippets.el (rails-snippets-menu-list): splited snippets into separate modes + + * rails-navigation.el (rails-nav:goto-fixtures): created + + * rails-core.el (rails-core:fixtures): created + + * rails-view-minor-mode.el (rails-view-minor-mode): cleanup and switch to use + `rails-controller-layout`, added support mailers + + * rails-unit-test-minor-mode.el (rails-unit-test-minor-mode): added support mailers + + * rails-navigation.el (rails-nav:goto-mailers): created + + * rails-model-layout.el: added support mailers + + * rails-mailer-minor-mode.el: created + + * rails-helper-minor-mode.el: cleanup and switch to use `rails-controller-layout` + + * rails-functional-test-minor-mode.el: cleanup and switch to use + `rails-controller-layout`, added support mailers + + * rails-core.el: created functions: rails-core:model-exist-p, + rails-core:mailer-file, rails-core:mailer-p, rails-core:mailers, + rails-core:current-function-name. Cleanup unsed functions. + + * rails-controller-minor-mode.el: cleanup and switch to use `rails-controller-layout` + + * rails-controller-layout.el: created + + * rails.el (rails-directory<-->types): rename fixtures to fixture + + * rails-unit-test-minor-mode.el: using functions from `rails-model-layout` to navigate + + * rails-model-minor-mode.el: using functions from `rails-model-layout` to navigate + + * rails-model-layout.el: created + + * rails-lib.el (string=~): created, by Howard Yeh + + * rails-fixture-minor-mode.el: created + + * rails-core.el (rails-core:controller-exist-p): create + (rails-core:fixture-file): used `pluralize-string` to match fixture + (rails-core:current-model): used `pluralize-string` to match fixture + + * inflections.el: created, by Howard Yeh + + * rails-cmd-proxy.el: created + + * rails-ws.el (rails-ws:stop): stopped server with interrupt-process + (rails-ws:start): starting server useing rails-cmd-proxy:start-process-shell-command + + * rails.el (rails-apply-for-buffer-type): added support to load + new style submodes + + * rails-lib.el (merge-abbrev-tables): created this function + + * moved all rails-for-* to rails-*-minor-mode + + * rails-snippets.el (rails-snippets-menu-list): closed bug #9460, + incorect indentation in snippets + +2007-03-19 Dmitry Galinsky + + * rails-scripts.el (rails-rake): restore ask to save modified + buffers before run rake test:* + + * rails-core.el (rails-core:layout-file): support template types + on go to layout menu + + * rails-for-controller.el (rails-controller:create-view-for-action): create function + (rails-controller:switch-to-view): allow select template type on create + + * rails.el: add support haml template engine + +2007-03-15 Dmitry Galinsky + + * rails-scripts.el (rails-rake-tests): using `compile` + + * rails-ui.el (rails-minor-mode-menu-bar-map): add (interactive) + to lambda functions + +2007-03-13 Dmitry Galinsky + + * rails-for-model.el: create + + * rails-for-unit-test.el: create + + * rails-core.el (rails-core:buffer-type): support lambda + expression in rails-directory<-->types + + * rails-scripts.el (rails-rake): ask to save modified buffers + before run rake test:* + +2007-02-02 Dmitry Galinsky + + * rails-snippets.el (rails-snippets-menu-list): bug #8381 (bad + "ff" snippet) + +2007-01-30 Dmitry Galinsky + + * rails-snippets.el: create and place into it all snippets code + + * rails-ui.el: drop snippets declaration, make separate menu + "Snippets" + +2007-01-29 Dmitry Galinsky + + * rails-lib.el: create function compile-snippet and + create-snippets-and-menumap-from-dsl + + * rails-ui.el (ruby-mode-abbrev-table): add mai snippet (add_index + in migrations) + + * rails.el (rails-db-parameters): patch #8232 (by Ronaldo Ferraz) + Console is not starting because env is not quoted in the function + call, resulting in a Ruby error + + * rails-ws.el, rails-wi.el: patch #8233 (by Ronaldo Ferraz) Fixes + a couple of UI messages and allows web server selection auto-save + +2007-01-28 Dmitry Galinsky + + * *.el: fix bytecompile warnings + + * rails-core.el: remove dublicate of fucntion rails-core:helper-file + + * rails-navigation.el: patch #8228 + + * rails.el (ruby-mode-hook): remove variables tab-width and indent-tabs + + * rails-ws.el: make variable rails-ws:default-server-type are + customized (to fix #8223) + + * rails-lib.el: add cross declaration indent-or-complete (to fix #8221) + +2007-01-27 Dmitry Galinsky + + * rails-for-controller.el (rails-controller:switch-with-menu): + call rails-controller:switch-to-view for "Current view" + + * rails-log.el (rails-log:open-file): run rails-minor-mode in log buffer + + * rails-ui.el: update "Open log" menu + + * rails.el: relete function rails-open-log, and place all log + related fuction to rails-log.el + + * rails-log.el: create + + * rails-lib.el (apply-colorize-to-buffer): create + + * rails-ws.el: update rails-ws:*browser* functions + + * rails.el (rails-directory<-->types): add plugin directory + + * rails-for-view.el (rails-view:switch-with-menu): update menu title + + * rails-for-plugin.el: create + + * rails-for-helper.el (rails-helper:switch-with-menu): update menu + title + + * rails-for-functional-test.el (rails-for-functional-test:switch-with-menu): + update-menu-title + + * rails-for-controller.el (rails-controller:switch-with-menu): + update menu title + + * rails-core.el (rails-core:menu): fix menu position + add new functions rails-core:plugin-files, rails-core:plugin-file, + rails-core:current-plugin + +2007-01-26 Dmitry Galinsky + + * rails-ui.el (rails-minor-mode-menu-bar-map): rename menu item + WEBrick to Web Server. Update menu group Web Server + + * rails.el (rails-ws): add variable rails-default-environment + + * rails-ws.el: rename from rails-webrick, complete rewrite and + cleanup + + * rails-navigation.el (rails-nav:create-goto-menu): now support + nested lists in append-to-menu (ex. (list (cons) (cons))) + (rails-nav:create-new-layout): cleanup + (rails-nav:goto-layouts): cleanup + + * rails-core.el + (rails-core:plugins): fix invalid path passed into directory-files + (rails-core:layouts): new function + + * rails-for-view.el (rails-for-view): remove detect mmm-mode, + always apply hotkeys to mmm-mode-map (if exist) + + * rails.el: apply ruby-mode to *.rake files and setup utf8 encoding + + * rails-lib.el (list->alist): skip if LIST entry is list + +2007-01-25 Dmitry Galinsky + + * rails-navigation.el, rails-ui.el: add rails-nav:goto-plugins + + * rails-ruby.el: remove advice for ruby-indent-command + + * rails-lib.el (def-snips): fix indentation + + * rails-core.el: fix list ordered in rails-core:* add + rails-core:observer-p + + * rails.el (rails-open-log): fix path to log file + + * rails.el: cleanup initialization code + +2007-01-24 Dmitry Galinsky + + * rails-ui.el: create key bindings and menu items to latest + changes + + * rails-scripts.el: add more targets to generate and destroy + cleanup targets create variables: rails-generate-params-list, + rails-destroy-params-list + + * rails-navigation.el: create another implementation menu: + rails-nav:goto-file-with-menu-from-list, rewrite rails:nav:goto-* + to use this + + * rails-core.el: rewrite rails-core:(controllers,models,etc), add + more functions to lookup plugins, migrations, etc + +2007-01-23 Dmitry Galinsky + + * rails-scripts.el (rails-rake-tests): store selected value, set it to default + + * rails-webrick.el (rails-webrick:start): fix #8088 (Akira Ikeda) + + * rails-core.el: add rails-core to eval-when-compile + + * rails-ui.el (rails-minor-mode-map): rebind some hotkeys fix + snippents (bad indent after end ruby keyword) + + * rails-scripts.el: complete rewrite all script functions to using autocomplete + + * rails.el (rails-db-parameters): apply patch #8065 (thanks Akira Ikeda) + +2007-01-22 Dmitry Galinsky + + * rails-ui.el (ruby-mode-abbrev-table): fix indentation for `end' ruby keyword + +2007-01-21 Dmitry Galinsky + + rename rails-for-rhtml to rails-for-view add rails-for-helper + functionaly add *:switch-with-menu for helpers, functional-test + cleanup rails-for-controller, rails-for-view + + * rails.el: remove rails-for-alist using rails-directory<-->type + for match current type and apply specific mode + + * rails-scripts.el (rails-run-script): fix #8035 + + * rails-lib.el (yml-value): fix #8037 + +2007-01-13 Dmitry Galinsky + + * rails-core.el: apply patch #7342 + +2007-01-09 ronaldo + + * rails.el: added a host parameter to the rails-db-conf struct + fixed problems with YAML parameter parsing + in (rails-db-parameters) simplified (rails-db-parameters) to avoid + using database.yml directly + (rails-run-sql) now changes directory to the root for the benefit + of sqlite3 + + * rails-lib.el: changed yml-next-value to yml-value and added a + broader search scope + +2007-01-08 ronaldo + + * rails.el: added support for other ri utilities (fast-ri, for + example) added support for coloring on ri buffer + +2006-12-25 Dmitry Galinsky + + * rails-lib.el (yml-next-value): return nil if key not found + + * rails.el: add sqlite support + +2006-12-18 Dmitry Galinsky + + * rails-core.el (rails-core:class-by-file): fix lowercase letter after "::" + + * rails-for-rhtml.el: apply patch #7300 + + * rails-for-controller.el: apply patch #7300 + + * rails.el: apply patch #7301, #7295 + + * rails-lib.el (rails-lib:run-secondary-switch): apply patch #7314 + +2006-12-11 ronaldo + + * rails-scripts.el: fixed problems with prompt patterns in the + inferior ruby mode call + +2006-12-05 ronaldo + + * rails.el: added support for minimal helper switching + + * rails-for-helper.el: added support for minimal helper switching + +2006-12-03 ronaldo + + * rails.el: added a customization option to use Emacs w3m for API + browsing + + * rails-lib.el: added a function to aid in browsing the API with + Emacs w3m + +2006-12-03 Dmitry Galinsky + + * rails-ruby.el (ruby-indent-command): using around filter + + * rails.el (ruby-mode-hook): symbols _ and : interpreted as word + + * rails-core.el (rails-core:class-by-file): apply patch #6377 + + * rails-webrick.el: Apply patch from Ray Baxter: remove + rails-webrick:open-url and add rails-webrick:server-name + +2006-12-01 ronaldo + + * rails.el: fixed to load needed ruby inferior mode (inf-ruby) + added a couple of new customization options + + * rails-ui.el reordered the snippets menu alphabetically changed + the key sequences for the tests scripts to use a more intuitive + set + + * rails.el: refactored and renamed rails-configured-api-root to + rails-has-api-root added a minor customization to the default + layout template minor documentation fixes + + * rails-lib.el: add (rails-alternative-browse-url) + + * rails-scripts.el: added an indication of the task being run on + rake calls fixed the inferior-mode call in (run-ruby-in-buffer) to + work on w32 added an alternative way to browse API URLs on Windows + in case the primary way fails added messages to the test scripts + +2006-12-01 Dmitry Galinsky + + * rails-navigation.el: add "go to action" "go to partial" now + support insert_html|replace_html + + * rails-core.el: add rails-core:view-name + +2006-11-30 ronaldo + + * *.el: fixed documentation strings to better reflect Emacs + conventions + + * rails-ruby.el: changed ruby-indent-or-complete into an + advice (it works in text-only terminals now) * rails-ui.el: added + a bunch of new snippets refactored key sequences to follow proper + mode conventions added new menus (rake tests, customize, start + default webrick) changed switch menu to use a richer set of + options + + * rails-scripts.el: added rake tasks for tests (all, integration, + functional, unit and recent tests) + + * rails-core.el: added a check for the API docs, allowing the user + to generate them if needed added a check for the existence of the + API files to avoid unnecessary messages + + * rails.el: changed the default layout template and moved it to a + customization variable + +2006-11-29 ronaldo + + * rails-for-controller.el: fixed to use rails-core:menu + + * rails-core.el: added a way to automatically recognize if it's + running under a text-only terminal to avoid crashing Emacs when + using x-popup-menu + + * rails-for-rhtml: changed to use rails-core:menu instead of + x-popup-menu + +2006-11-28 ronaldo + + * rails-core.el: created a set of customization options + (customize-group 'rails) + + * rails-for-rhtml: fixed the partial creation functions to allow + both transient and non-transient markers + +2006-10-03 Dmitry Galinsky + + * rails.el: do not apply untabify in makefile-mode + + * rails-ruby.el: small fix in ruby-indent-or-complete + +2006-06-10 CrazyPit + + * rails-core.el: rails-quoted-file (needed to fix bug with space + in path) + + * rails-navigation.el: new rules to + rails-goto-file-on-current-line, rails-find for fixtures + + * rails.el: rails-browse-api + + * rails-lib.el: new helper functions write-string-to-file, + read-from-file + + * rails-webrick.el: fix bug with space in path + + * rails-scipts.el: add caching for rake tasks + +2006-04-19 CrazyPit + + * rails-navigation.el: rails-nav:create-new-layout updated, text + moved to variable rails-layout-template, name add. rails goto file + from string for layout now used rails-nav:create-new-layout if + layout with this name does not exist + + * rails.el: add modify syntax to ruby-mode-hook for "!" symbol, + add local modifying syntax for rails-browse-api-at-point + + +2006-04-17 Dmitry Galinsky + + * rails-ui.el: apply snippets to nxml-mode-abbrev-table + +2006-04-11 Dmitry Galinsky + + * rails-for-controller.el + (rails-controller:switch-to-view): using rais-core:menu + (rails-controller:switch-with-menu): using rails-core:menu + + * rails-navigation.el: new function rails-nav:create=new-layout + (rails-nav:goto-file-with-menu): add optional parameter + append-to-menu + + * rails-for-rhtml.el: drop + rails-for-rhtml:switch-to-controller-action + + * rails-for-controller.el: drop + rails-for-controller:switch-by-current-controller, + rails-for-controller:switch-to-functional-test, + rails-for-controller:switch-to-helper, + rails-for-controller:switch-to-view2, + rails-for-controller:switch-to-controller + rails-for-controller:switch-to-views + (rails-controller:switch-with-menu): mark partials, add separator + + * rails-lib.el (snippet-menu-line): add snippet abbrevation in + menu + + * rails-ui.el (rails-minor-mode-menu-bar-map): drop menu + items [webrick brows], [webrick auto-brows] + +2006-04-04 CrazyPit + + * rails-navigation.el, rails-lib.el, rails-ui.el: rails-lib:goto-* + renamed to rails-nav:goto-* and moved to rails-navigation.el + +2006-04-01 CrazyPit + + * rails-core.el: new function js-file, partial-name updated. + + * rails-navigation.el: new rule for switching line to + file (rails-line-->js) + + * rails-scipts.el: bugfix in run-ruby-in-buffer + + * rails-ui.el: new snippet %for + + * rails-webrick.el: rails-webrick:start now interactive, + auto-open-browser work only in controllers and views. + + * rails.el: bugfix in rails-create-tags + +2006-03-31 CrazyPit + + * rails-navigation.el: rails-goto-file-from-file change, now use + funcall instead rails-goto-menu-call, function + rails-goto-menu-call removed. + + * rails-for-controller.el: views-for-current-action now using lexical closures. + + * rails-lib.el: fix bug in snippet-menu-line + + * rails.el: fix bug in rails-get-api-entries + +2006-03-30 CrazyPit + + * rails.el: interface to Rails HTML API + documentaion. rails-browse-api-at-point, rails-browse-api-method, + rails-browse-api-class, rails-get-api-entries + + * rails-lib.el: new function capital-word-p + + * rails-scipts.el: Rake integration - new functions rails-rake and + rails-rake-tasks. Running ruby consoles and breakpointers in + separated buffers for each project: new functions + run-ruby-in-buffer, rails-run-interactive and rails-run-console, + rails-run-breakpointer updated + + * rails-core.el new macro in-root + + * rails.el: new variable rails-tags-command, rails-open-log now + interactive + cleanup, rails-create-tags cleanup, new hook for + dired mode + + * rails-navigation.el: new variable rails-find-file-function, 3 + new rails-finds. + + * rails-ui.el: cleanup, add many new hotkeys + +2006-03-28 CrazyPit + + * rails-ui.el: create rails-ui.el, move UI code from rails.el to + rails-ui.el + + * rails-navigation.el: rails-goto-controller-->view, + rails-goto-view-->controller rails-goto-all-->simple, + rails-goto-all-->helper, rails-goto-all-->functional-test, + rails-goto-all-->controller extracted to other files. Refactoring + of rails-goto-file-from-file-actions and rails-goto-file-from-file + now run-time generation and invisible, helper function + rails-goto-menu-call. menu items available. + + * rails-for-rhtml.el: switch-to-controller-action added + + * rails-for-controller.el: + views-for-current-action. switch-by-current-controller, + switch-to-functional-test, switch-to-helper, switch-to-view2, + switch-to-controller -- extracted with renaming from + rails-navigation.el. + + * rails-core.el: fix in functional-test-file, + + long-controller-name added, rails-core:menu upadte (posn-at-point + call added) + +2006-03-28 Dmitry Galinsky + + * rails-for-controller.el: new functions + rails-controller:get-current-controller-and-action, + rails-controller:switch-with-menu + (rails-for-controller): setup variables rails-primary-switch-func, + rails-secondary-switch-func + + * rails-core.el (rails-core:helper-file): fix invalid path + (rails-core:functional-test-file): fix invalid path + (rails-core:get-view-files): ACTION is optional parameter + + * rails-for-rhtml.el: new functions rails-rhtml:switch-with-menu, + rails-rhtml:switch-to-helper, + rails-rhtml:get-current-controller-and-action + (rails-for-rhtml): setup variables rails-primary-switch-func, + rails-secondary-switch-func + + * rails.el: add variables rails-primary-switch-func, + rails-secondary-switch-func + + * rails-lib.el: add interactive functions + rails-lib:run-primary-switch-func, + rails-lib:run-secondary-switch-func + +2006-03-28 CrazyPit + + * rails.el: rails-run-sql with stuff + + * rails-navigation.el: rails finds added + + * rails-scipts.el: generators/destroyers, shells and rails-create + project added from test branch + + * rails-navigation.el: rails-goto-file-on-current-line and + rails-goto-file-from-file function with stuff added from test + branch + +2006-03-27 CrazyPit + + * rails-lib.el: many helper functions from test branch added + + * rails-core.el: functions from test branch added, class-by-file + updated + new variable rails-core:class-dirs, get-model-view + updated + + * rails-webrick.el: open-browser updated, + open-browser-on-controller, auto-open-browser added + +2006-03-22 Dmitry Galinsky + + * rails-core.el: add macro rails-core:local-add-to-rails-menubar + +2006-03-21 Dmitry Galinsky + + * rails.el: split into two files + + * rails-core.el: move to this all helper function and macros + diff --git a/emacs.d/rails/History b/emacs.d/rails/History new file mode 100644 index 0000000..b1cfaeb --- /dev/null +++ b/emacs.d/rails/History @@ -0,0 +1,100 @@ +0.5.99.5 +* Fixed bug [#10613]: Wrong comparison of emacs-major-version +* Apply patch [#10532]: allows '-' to occur in the errror filepath (thanks Peter Williams) +* Fixed bug [#10417]: ruby-flymake had applying only if flymake is + available. +* Raise a error if emacs-rails run on old version of Emacs (less 22) +* Updated view mode of "views" +* Fixed bug [#10357]: code expansion shouldn't occur in comment lines. + +0.5.99.4 +* Added the test/test_helper in list of helpers. +* Added list of templates in speedbar. +* Fixed bug [#10056]: when one open file in a read only directory, + flymake try to open a new file and failed (thanks Rémi Vanicat). +* Fixed bug [#9991]: allow setup key prefix for rails-minor-mode. +* Fixed bug [#10053]: don't match rhtml/rxml/rjs files in test output (thanks Rémi Vanicat). + +0.5.99.3 +* Added speedbar integration, type [F11] to toogle speedbar. +* Fixed bug #9880: the hotkey "C-c ." conflicted with ECB, changed to "C-c C-c ,". +* New hotkeys, to easy switch without a popup menu between a + controller or a model related files. + In model layout: + - "C-c m" go to model + - "C-c u" go to unit test + - "C-c g" go to migration + - "C-c c" go to controller + - "C-c x" go to fixture + - "C-c n" go to mailer + In controller layout: + - "C-c g" go to migration + - "C-c m" go to model + - "C-c h" go to helper + - "C-c f" go to functional test + - "C-c c" go to controller + - "C-c u" go to unit test +* Fixed bug #9783 (remove-postfix: Wrong type argument: arrayp, nil). +* Updated the compilation output, for better highlight of error and warnings. +* Added the flymake support to on the fly syntax checked in the ruby-mode. + +0.5.99.2 +* Added new dynamic snippets for RESTful, + for instance: in controller UsersController type "rshow" + will be expand to "user_url(@user)" and display tooltip "GET /users/1". +* Added migration support - migrate, migrate to previous version, + migrate to version. +* Created separate menubar entries named "Navigate", "Database", "Tests". +* Fixed bug #9721: Emacs 21.4.x can't load rails-core.el with error "Wrong + number of arguments: #". +* Added support pcompletion in ruby-mode (if possible). +* Added new "Go to unit tests" and "Go to functional tests" hotkeys + and menu entries. +* Added tests integration with the compile library. +* New [C-c /] hotkey to toggle output window. + +0.5.99.1 +* Fixed bug #9619, script/server fails to start with [C-c C-c w s]. +* Added hotkeys for tests: + - [C-c C-c .] running a test for current model/controller (global) + - [C-c .] running a test for current method (in a functional/unit test) +* Prints total of tests, asertions, failures, errors after end of + tests running. +* Fixed recursive "require" error after compilation #9547. + +0.5.99 +* Improvement of tests and rails scripts output; run asynchronous, + colorize output, etc. +* New [C-:] hotkey to easy switch between strings and symbols at point + in ruby-mode. +* New [C-c f] hotkey to popup a menu with list of functions in + ruby-mode. + +0.5.4 +* Added mailers support. +* Added fixtures support. +* Fixed incorrect indentation in snippets [#9460]. +* Added support template types in layouts menu. +* Added support haml template engine. +* Use `compile` to run `rake tests`. +* Ask to save modified buffers before run rake. +* Added "quick switch" to support models and unit tests. + +0.5.3 +* Create separate menubar entry "Snippets". +* Allow web server selection auto-save. +* Corrected errors at work with sql. +* Fixed byte-compile warnings. + +0.5.2 +* Fixed bugs: #8221, #8223. +* Using system `tail` program for display log files. + +0.5.1 at 27.01.2007 +* Support plugin: quick menu "Go to plugins" and navigate inside + plugin. +* Update Web Server support, add Lighttd to list of supported servers. +* Automatic apply ruby-mode to *.rake files and setup utf-8 encoding. +* Add more targets to generate/destroy. +* Add autocomplete in generate/destroy/rake/test commands. +* Small fixes indentation in snippets. diff --git a/emacs.d/rails/README b/emacs.d/rails/README new file mode 100644 index 0000000..f292af8 --- /dev/null +++ b/emacs.d/rails/README @@ -0,0 +1,142 @@ +It is minor mode for editing "Ruby On Rails":ror code with +"Emacs":emacs. This minor mode makes your work much easier and user +friendly + + +== Instalation + +You need download last release from RubyForge page +"http://rubyforge.org/projects/emacs-rails" and and unpack +it to directory containing libraries of Emacs, by default it's +$HOME/.emacs.d/ + +You can also use SVN + + cd $HOME/.emacs.d/ + svn co svn://rubyforge/var/svn/emacs-rails/trunk emacs-rails + +Download and install required libraries + +* "http://www.kazmier.com/computer/snippet.el":snippets +* "http://www.webweavertech.com/ovidiu/emacs/find-recursive.txt":frecursive + +*Alert:* From 0.44 release emacs-rails will require the + "inf-ruby":inf-ruby. + +After that you must add this code in $HOME/.emacs + + (setq load-path (cons "~/.emacs.d/rails" load-path)) + (require 'rails) + +For Windows users: you can use your help in CHM format (the default +*ri*). This will require utility "KeyHH":keyhh. And add to a file +.emacs + + (setq rails-chm-file "full_path_to_rails_chm_manual") + +After that you can run Emacs. Almost all available actions are in the +menu [Ruby On Rails]. The snippets are in the menu [Ruby On +Rails-Snippets], for the convenience, they are divided into +categories. + +To change default setting, select [Ruby On Rails - Customize]. + +== First Acquaintance + +Go to directory with your rails application and open any file in Emacs: + + cd $HOME/project/simple_rails_application + emacs app/controllers/application.rb + +There must be "RoR" sign in the list of active minor-modes in status +bar. Thi means, that emacs-rails is enabled and ready to help you in +your not so easy work. + +Almoust all actions are in the "RubyOnRails" menu. You can check it +out and try some of them. Don't forget, that menu will help you only +first time. After that you better use hot keys for effective work, you +can find them in the brackets. + +== Features + +* TextMate-like snippets +* Display of colored log files +* Integration with script/generate and script/destroy (controller, + model, scaffold, migration, etc) +* Integration with script/console and script/breakpointer +* Run rake %(key)C-c C-c r% +* Quick start svn-status in RAILS_ROOT %(key)f9% +* Documentation search using *ri* or *chm* file and Rails API + reference in HTML %(key)f1% +* Quick access to the main configuration files +* Automatic TAGS generation in RAILS_ROOT directory + +=== Management of WEBrick/Mongrel + +* Your can select Webrick, Mongrel or Lighttpd +* Start/stop application server %(key)C-c C-c w s% +* Automatic browsing on current action (from view or controller) + %(key)C-c C-c w a% + +=== Navigation in RAILS_ROOT hierarchy + +* Quick switch stylesheets, javascripts, migrations, layouts, helpers, + controllers, models, observers, plugins +* In controller file: go to views, functional test, helper + %(key)C-down% +* Switch between action/view %(key)Ñ-up% +* Go to file in current line (example: cursor at line [redirect_to + controller => :home, :action => "show"], will be open action "show" + in "home" controller) %(key)C-RET% +* Quick access to the main configuration files using menu + +Other hot keys + +* %(key)C-c C-c g g% rails-nav:goto-migrate +* %(key)C-c C-c g j% rails-nav:goto-javascripts +* %(key)C-c C-c g s% rails-nav:goto-stylesheets +* %(key)C-c C-c g l% rails-nav:goto-layouts +* %(key)C-c C-c g h% rails-nav:goto-helpers +* %(key)C-c C-c g c% rails-nav:goto-controllers +* %(key)C-c C-c g m% rails-nav:goto-models +* %(key)C-c C-c g o% rails-nav:goto-observers +* %(key)C-c C-c g p% rails-nav:goto-plugins + +=== ERb refactoring + +* Create partial from selection %(key)C-c p% +* Create helper from block %(key)C-c b% + += Bugs + +emacs-rails designed for current CVS version of Emacs (future Emacs22) +more probably some functions will not work in older version, or will +work with errors, so if it is possible, try to update. I will not tell +you why you should use CVS version, just take my word. + +In some version from CVS some time ago, when you use emacs-rails, +sintax highlight in rhtml was not working, so just update to the +newest version from CVS. + +If you find error, place it description in "BugTrack":bugtrack. + += Links + +* "Emacs W32 (CVS version for Windows)":http://ourcomments.org/Emacs/EmacsW32.html +* "HowToUseEmacsWithRails":http://wiki.rubyonrails.org/rails/pages/HowToUseEmacsWithRails +* "http://scott.elitists.net/users/scott/posts/rails-on-emacs":http://scott.elitists.net/users/scott/posts/rails-on-emacs +* "http://www.emacswiki.org/cgi-bin/wiki/RubyMode":http://www.emacswiki.org/cgi-bin/wiki/RubyMode +* "Emacs screencast":screencast +* "Effective Emacs":effectiveemacs + +[bugtrack]http://rubyforge.org/tracker/?atid=5809&group_id=1484&func=browse +[effectiveemacs]http://steve.yegge.googlepages.com/effective-emacs +[screencast]http://emacsonrails.drozdov.net/ +[lisp]http://en.wikipedia.org/wiki/Lisp_programming_language +[frecursive]http://www.webweavertech.com/ovidiu/emacs/find-recursive.txt +[keyhh]http://www.keyworks.net/keyhh.htm +[snippets]http://www.kazmier.com/computer/snippet.el +[emacs]http://www.gnu.org/software/emacs/ +[ror]http://rubyonrails.org +[emacs-rails]http://rubyforge.org/projects/emacs-rails +[inf-ruby]http://svn.ruby-lang.org/cgi-bin/viewvc.cgi/trunk/misc/inf-ruby.el?view=co \ No newline at end of file diff --git a/emacs.d/rails/inflections.el b/emacs.d/rails/inflections.el new file mode 100644 index 0000000..f8764d9 --- /dev/null +++ b/emacs.d/rails/inflections.el @@ -0,0 +1,114 @@ +;;; inflections.el --- + +;; Copyright (C) 2006 Dmitry Galinsky + +;; Authors: Dmitry Galinsky , +;; Howard Yeh + +;; Keywords: ruby rails languages oop +;; $URL: svn://rubyforge.org/var/svn/emacs-rails/trunk/inflections.el $ +;; $Id: inflections.el 178 2007-04-12 20:58:56Z dimaexe $ + +;;; License + +;; This program is free software; you can redistribute it and/or +;; modify it under the terms of the GNU General Public License +;; as published by the Free Software Foundation; either version 2 +;; of the License, or (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program; if not, write to the Free Software +;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. + +;;; Code: + +(defvar inflection-singulars nil) +(defvar inflection-plurals nil) +(defvar inflection-irregulars nil) +(defvar inflection-uncountables nil) + +(defmacro define-inflectors (&rest specs) + (loop for (type . rest) in specs do + (case type + (:singular (push rest inflection-singulars)) + (:plural (push rest inflection-plurals)) + (:irregular (push rest inflection-irregulars)) + (:uncountable (setf inflection-uncountables + (append rest inflection-uncountables)))))) + +(define-inflectors + (:plural "$" "s") + (:plural "s$" "s") + (:plural "\\(ax\\|test\\)is$" "\\1es") + (:plural "octopus$" "octopi") + (:plural "\\(alias\\|status\\)$" "\\1es") + (:plural "\\(bu\\)s$" "\\1ses") + (:plural "tomato$" "tomatoes") + (:plural "\\([ti]\\)um$" "\\1a") + (:plural "sis$" "ses") + (:plural "\\(?:\\([^f]\\)fe\\|\\([lr]\\)f\\)$" "\\1\\2ves") + (:plural "\\(hive\\)$" "\\1s") + (:plural "\\([^aeiouy]\\|qu\\)y$" "\\1ies") + (:plural "\\(x\\|ch\\|ss\\|sh\\)$" "\\1es") + (:plural "\\(matr\\|vert\\|ind\\)ix\\|ex$" "\\1ices") + (:plural "\\([m\\|l]\\)ouse$" "\\1ice") + (:plural "^\\(ox\\)$" "\\1en") + (:plural "\\(quiz\\)$" "\\1zes") + + (:singular "s$" "") + (:singular "\\(n\\)ews$" "\\1ews") + (:singular "\\([ti]\\)a$" "\\1um") + (:singular "\\(\\(a\\)naly\\|\\(b\\)a\\|\\(d\\)iagno\\|\\(p\\)arenthe\\|\\(p\\)rogno\\|\\(s\\)ynop\\|\\(t\\)he\\)ses$" "\\1\\2sis") + (:singular "\\(^analy\\)ses$" "\\1sis") + (:singular "\\([^f]\\)ves$" "\\1fe") + (:singular "\\(hive\\)s$" "\\1") + (:singular "\\(tive\\)s$" "\\1") + (:singular "\\([lr]\\)ves$" "\\1f") + (:singular "\\([^aeiouy]\\|qu\\)ies$" "\\1y") + (:singular "\\(s\\)eries$" "\\1eries") + (:singular "\\(m\\)ovies$" "\\1ovie") + (:singular "\\(x\\|ch\\|ss\\|sh\\)es$" "\\1") + (:singular "\\([m\\|l]\\)ice$" "\\1ouse") + (:singular "\\(bus\\)es$" "\\1") + (:singular "\\(o\\)es$" "\\1") + (:singular "\\(shoe\\)s$" "\\1") + (:singular "\\(cris\\|ax\\|test\\)es$" "\\1is") + (:singular "octopi$" "octopus") + (:singular "\\(alias\\|status\\)es$" "\\1") + (:singular "^\\(ox\\)en" "\\1") + (:singular "\\(vert\\|ind\\)ices$" "\\1ex") + (:singular "\\(matr\\)ices$" "\\1ix") + (:singular "\\(quiz\\)zes$" "\\1") + + (:irregular "person" "people") + (:irregular "man" "men") + (:irregular "child" "children") + (:irregular "sex" "sexes") + (:irregular "move" "moves") + + (:uncountable "equipment" "information" "rice" "money" "species" "series" "fish" "sheep")) + +(defun singularize-string (str) + (when (stringp str) + (or (car (member str inflection-uncountables)) + (caar (member* str inflection-irregulars :key 'cadr :test 'equal)) + (loop for (from to) in inflection-singulars + for singular = (string=~ from str (sub to)) + when singular do (return singular)) + str))) + +(defun pluralize-string (str) + (when (stringp str) + (or (car (member str inflection-uncountables)) + (cadar (member* str inflection-irregulars :key 'car :test 'equal)) + (loop for (from to) in inflection-plurals + for plurals = (string=~ from str (sub to)) + when plurals do (return plurals)) + str))) + +(provide 'inflections) diff --git a/emacs.d/rails/predictive-prog-mode.el b/emacs.d/rails/predictive-prog-mode.el new file mode 100644 index 0000000..8bbb88c --- /dev/null +++ b/emacs.d/rails/predictive-prog-mode.el @@ -0,0 +1,69 @@ +;;; predictive-prog-mode.el --- + +;; Copyright (C) 2006 Dmitry Galinsky + +;; Authors: Dmitry Galinsky , + +;; Keywords: ruby rails languages oop +;; $URL: svn+ssh://rubyforge/var/svn/emacs-rails/trunk/rails.el $ +;; $Id: rails.el 149 2007-03-29 15:07:49Z dimaexe $ + +;;; License + +;; This program is free software; you can redistribute it and/or +;; modify it under the terms of the GNU General Public License +;; as published by the Free Software Foundation; either version 2 +;; of the License, or (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program; if not, write to the Free Software +;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. + +;;; Code: + +(eval-when-compile + (require 'predictive nil t) + (require 'completion-ui nil t)) + +(require 'flyspell) + +(defconst predictive-prog-text-faces + '(font-lock-comment-face font-lock-doc-face) + "Faces corresponding to text in programming-mode buffers.") + +(defvar predictive-prog-mode-main-dict nil) + +(defun activate-predictive-inside-comments (start end len) + "Looking at symbol at point and activate the `predictive-mode' +if there a string or a comment." + (save-excursion + (let ((p (get-text-property (- (point) 1) 'face)) + (f (get-text-property (point) 'face))) + (if (or (memq f predictive-prog-text-faces) + (memq p predictive-prog-text-faces)) + (setq predictive-main-dict predictive-prog-mode-main-dict) + (setq predictive-main-dict nil))))) + +(defun predictive-prog-mode () + "Enable the `predictive-mode' inside strings and comments +only, like `flyspell-prog-mode'." + (interactive) + (when (fboundp 'predictive-mode) + (set (make-local-variable 'predictive-main-dict) nil) + (set (make-local-variable 'predictive-prog-mode-main-dict) predictive-main-dict) + (if (find 'activate-predictive-inside-comments after-change-functions) + (progn + (remove-hook 'after-change-functions 'activate-predictive-inside-comments t) + (predictive-mode -1)) + (progn +; (set (make-local-variable 'predictive-use-auto-learn-cache) nil) + (set (make-local-variable 'predictive-dict-autosave-on-kill-buffer) nil) + (predictive-mode 1) + (add-hook 'after-change-functions 'activate-predictive-inside-comments nil t))))) + +(provide 'predictive-prog-mode) diff --git a/emacs.d/rails/rails-bytecompile.el b/emacs.d/rails/rails-bytecompile.el new file mode 100644 index 0000000..a4f29be --- /dev/null +++ b/emacs.d/rails/rails-bytecompile.el @@ -0,0 +1,5 @@ +(require 'rails) + +(mapcar + #'byte-compile-file + (directory-files "./" t "^[a-z]\\.el$")) \ No newline at end of file diff --git a/emacs.d/rails/rails-cmd-proxy.el b/emacs.d/rails/rails-cmd-proxy.el new file mode 100644 index 0000000..80f2990 --- /dev/null +++ b/emacs.d/rails/rails-cmd-proxy.el @@ -0,0 +1,120 @@ +;;; rails-cmd-proxy.el --- + +;; Copyright (C) 2006 Dmitry Galinsky + +;; Authors: Dmitry Galinsky + +;; Keywords: ruby rails languages oop +;; $URL: svn://rubyforge.org/var/svn/emacs-rails/trunk/rails-cmd-proxy.el $ +;; $Id: rails-cmd-proxy.el 158 2007-04-03 08:45:46Z dimaexe $ + +;;; License + +;; This program is free software; you can redistribute it and/or +;; modify it under the terms of the GNU General Public License +;; as published by the Free Software Foundation; either version 2 +;; of the License, or (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program; if not, write to the Free Software +;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. + +;;; Code: + +(defstruct rails-cmd-proxy:struct local remote args) + +(defvar rails-cmd-proxy:directories-list + '(("y:" "/mnt/www" "-t @server-cmd"))) + +(defvar rails-cmd-proxy:remote-cmd + "plink") + +(defun rails-cmd-proxy:lookup (root &optional lookup-local) + "Lookup ROOT using `rails-cmd-proxy:directories-list' and +return the `rails-cmd-proxy:struct'. If not found ROOT return +nil." + (loop for (local remote args) in rails-cmd-proxy:directories-list + when (string-match (concat "^" (if lookup-local remote local)) root) + do (return + (make-rails-cmd-proxy:struct + :local local + :remote remote + :args args)))) + +(defun rails-cmd-proxy:convert (proxy-struct path &optional reverse) + "Convert PATH from local to remote using PROXY-STRUCT, +otherwise if set REVERSE convert from remote to local." + (let* ((local (rails-cmd-proxy:struct-local proxy-struct)) + (remote (rails-cmd-proxy:struct-remote proxy-struct)) + (regexp (concat "^" (if reverse remote local))) + (replacement (if reverse local remote))) + (when (string-match regexp path) + (replace-regexp-in-string regexp replacement path)))) + +(defun rails-cmd-proxy:construct-remote-cmd (proxy-struct root command &optional command-args) + (let ((root (rails-cmd-proxy:convert proxy-struct root)) + (args (rails-cmd-proxy:struct-args proxy-struct))) + (if command-args + (format "%s \"cd %s && %s %s\"" args root command command-args) + (format "%s \"cd %s && %s\"" args root command)))) + +;; remote wrappers + +(defun rails-cmd-proxy:start-process (name buffer command command-args) + "" + (rails-project:with-root + (root) + (let ((proxy-struct (rails-cmd-proxy:lookup root)) + (command command) + (command-args command-args)) + (when proxy-struct + (setq command-args + (rails-cmd-proxy:construct-remote-cmd proxy-struct + root + command + command-args)) + (setq command rails-cmd-proxy:remote-cmd)) + (start-process-shell-command name + buffer + command + command-args)))) + +(defun rails-cmd-proxy:shell-command-to-string (command) + (rails-project:with-root + (root) + (let ((proxy-struct (rails-cmd-proxy:lookup root)) + (command command)) + (when proxy-struct + (setq command + (format "%s %s" + rails-cmd-proxy:remote-cmd + (rails-cmd-proxy:construct-remote-cmd proxy-struct + root + command)))) + (shell-command-to-string command)))) + +;; helper functions + +(defun rails-cmd-proxy:convert-buffer-from-remote (start end len) + (when-bind + (struct (rails-cmd-proxy:lookup default-directory)) + (save-excursion + (goto-char start) + (let* ((local (rails-cmd-proxy:struct-local struct)) + (remote (rails-cmd-proxy:struct-remote struct)) + (root default-directory) + (remote-with-root (concat remote (substring root (length local)))) + (buffer-read-only nil) + point) + (while (setq point (re-search-forward (format "^\\s-*\\(%s\\)" + remote-with-root) end t)) + (replace-match (format "%s " + (string-repeat " " (- (length (match-string 1)) 1))) + nil t nil 1)))))) + +(provide 'rails-cmd-proxy) diff --git a/emacs.d/rails/rails-compat.el b/emacs.d/rails/rails-compat.el new file mode 100644 index 0000000..695982b --- /dev/null +++ b/emacs.d/rails/rails-compat.el @@ -0,0 +1,88 @@ +;;; rails-compat.el --- + +;; Copyright (C) 2006 Dmitry Galinsky + +;; Authors: Dmitry Galinsky , + +;; Keywords: ruby rails languages oop +;; $URL: svn+ssh://rubyforge/var/svn/emacs-rails/trunk/rails.el $ +;; $Id: rails.el 149 2007-03-29 15:07:49Z dimaexe $ + +;;; License + +;; This program is free software; you can redistribute it and/or +;; modify it under the terms of the GNU General Public License +;; as published by the Free Software Foundation; either version 2 +;; of the License, or (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program; if not, write to the Free Software +;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. + +;;; Code: + +(eval-when-compile + (require 'snippet nil t) + (require 'completion-ui nil t)) + +(when (fboundp 'indent-or-complete) + (message "WARNNING: the `indent-or-complete' already defined.")) + +(defun indent-or-complete () + "Complete if point is at end of left a leave word, otherwise indent line." + (interactive) + (cond + ;; snippet + ((and (boundp 'snippet) + snippet) + (snippet-next-field)) + + ;; completion-ui + ((and (fboundp 'completion-overlay-at-point) + (completion-overlay-at-point)) + (let* ((ov (completion-overlay-at-point)) + (end (overlay-end ov)) + ;; setup as last command + (last-input-event 32) + (last-command-event 32)) + ;; skip message output + (flet ((message (format-string &rest args) nil)) + (completion-self-insert)))) + + ;; hippie-expand + ((looking-at "\\_>") + ;; skip message output + (flet ((message (format-string &rest args) nil)) + (hippie-expand nil))) + + ;; run default indent command + (t (indent-for-tab-command)))) + +(when (fboundp 'try-complete-abbrev) + (message "WARNING: the function `try-complete-abbrev' is already defined")) + +(defun try-complete-abbrev (old) + (let ((point-end (point)) + (point-start (point)) + distance) + (save-excursion + (while (not (zerop (setq distance (skip-syntax-backward "w")))) + (setq point-start (+ point-start distance)))) + (when (and (not (= point-start point-end)) + (not (memq + (get-text-property (- point-end 1) 'face) + '(font-lock-string-face font-lock-comment-face font-lock-doc-face)))) + (let ((abbr (buffer-substring-no-properties point-start point-end))) + (when (and (abbrev-symbol abbr) + (expand-abbrev)) + t))))) + +(unless (find 'try-complete-abbrev hippie-expand-try-functions-list) + (add-to-list 'hippie-expand-try-functions-list 'try-complete-abbrev)) + +(provide 'rails-compat) diff --git a/emacs.d/rails/rails-controller-layout.el b/emacs.d/rails/rails-controller-layout.el new file mode 100644 index 0000000..b6acd0e --- /dev/null +++ b/emacs.d/rails/rails-controller-layout.el @@ -0,0 +1,216 @@ +;;; rails-controller-layout.el --- + +;; Copyright (C) 2006 Dmitry Galinsky + +;; Authors: Dmitry Galinsky + +;; Keywords: ruby rails languages oop +;; $URL: svn://rubyforge.org/var/svn/emacs-rails/trunk/rails-controller-layout.el $ +;; $Id: rails-controller-layout.el 173 2007-04-09 15:15:02Z dimaexe $ + +;;; License + +;; This program is free software; you can redistribute it and/or +;; modify it under the terms of the GNU General Public License +;; as published by the Free Software Foundation; either version 2 +;; of the License, or (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program; if not, write to the Free Software +;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. + +;;; Code: + +(defvar rails-controller-layout:recent-template-type nil) + +(defun rails-controller-layout:switch-to-action-in-controller (controller-name action-name) + "Open CONTROLLER-NAME and go to ACTION-NAME." + (if (or (rails-core:find-file-if-exist (rails-core:controller-file controller-name)) + (rails-core:find-file-if-exist (rails-core:mailer-file controller-name))) + (progn + (goto-char (point-min)) + (when action-name + (if (search-forward-regexp (concat "^[ ]*def[ ]*" action-name) nil t) + (recenter)) + (message (format "%s: %s" (substring (symbol-name (rails-core:buffer-type)) 1) controller-name)))))) + +(defun rails-controller-layout:switch-to-view (controller-name action-name) + "Open the ACTION-NAME file for CONTROLLER-NAME in the views directory." + (when action-name + (let ((views (rails-controller-layout:view-files controller-name action-name)) + (title (substring (symbol-name (rails-core:buffer-type)) 1))) + (cond + ((= (length views) 1) + (find-file (first views)) + (message "%s: %s#%s" title controller-name action-name)) + ((= (length views) 0) + (rails-controller-layout:create-view-for-action controller-name action-name)))))) + +(defun rails-controller-layout:toggle-action-view () + (interactive) + (let ((controller-name (rails-core:current-controller)) + (action-name (rails-core:current-action))) + (case (rails-core:buffer-type) + (:view + (rails-controller-layout:switch-to-action-in-controller controller-name action-name)) + (:mailer + (rails-controller-layout:switch-to-view controller-name action-name)) + (:controller + (if action-name + (rails-controller-layout:switch-to-view controller-name action-name) + (rails-controller-layout:switch-to :functional-test)))))) + +(defun rails-controller-layout:create-view-for-action (controller-name action-name) + (let ((type + (if rails-controller-layout:recent-template-type + rails-controller-layout:recent-template-type + (car rails-templates-list)))) + (setq type + (completing-read (format "View for %s#%s not found, create %s.[%s]? " + controller-name action-name action-name type) + rails-templates-list + nil t type)) + (setq rails-controller-layout:recent-template-type type) + (let ((file (rails-core:file (concat "app/views/" + (replace-regexp-in-string "_controller" "" + (rails-core:file-by-class controller-name t)))))) + (make-directory file t) + (find-file (format "%s/%s.%s" file action-name type))))) + +(defun rails-controller-layout:view-files (controller-name &optional action) + "Retun a list containing the view file for CONTROLLER-NAME#ACTION. +If the action is nil, return all views for the controller." + (rails-project:with-root + (root) + (directory-files + (rails-core:file + (rails-core:views-dir + (rails-core:short-controller-name controller-name))) t + (if action + (concat "^" action (rails-core:regex-for-match-view)) + (rails-core:regex-for-match-view))))) + +(defun rails-controller-layout:views-menu (controller-name) + "Make a menu of views for CONTROLLER-NAME." + (let (menu) + (setq menu + (mapcar (lambda(i) + (list (concat (if (string-match "^_" (file-name-nondirectory i)) "Partial" "View") + ": " + (file-name-nondirectory i)) + i)) + (rails-controller-layout:view-files controller-name nil))) + (when (zerop (length menu)) + (setq menu (list))) + menu)) + +(defun rails-controller-layout:keymap (type) + (let* ((name (capitalize (substring (symbol-name type) 1))) + (map (make-sparse-keymap)) + (menu (make-sparse-keymap))) + (when type + (define-keys menu + ([goto-migration] '(menu-item "Go to Migration" + rails-controller-layout:switch-to-migration + :enable (and (not (rails-core:current-mailer)) + (rails-core:migration-file-by-model + (singularize-string (rails-core:current-controller)))))) + ([goto-model] '(menu-item "Go to Model" + rails-controller-layout:switch-to-model + :enable (and (not (rails-core:current-mailer)) + (rails-core:model-exist-p + (singularize-string (rails-core:current-controller)))))) + ([goto-helper] '(menu-item "Go to Helper" + rails-controller-layout:switch-to-helper + :enable (and (not (rails-core:current-mailer)) + (not (eq (rails-core:buffer-type) :helper))))) + ([goto-ftest] '(menu-item "Go to Functional Test" + rails-controller-layout:switch-to-functional-test + :enable (and (not (rails-core:current-mailer)) + (not (eq (rails-core:buffer-type) :functional-test))))) + ([goto-controller] '(menu-item "Go to Controller" + rails-controller-layout:switch-to-controller + :enable (and (not (rails-core:current-mailer)) + (not (eq (rails-core:buffer-type) :controller))))) + ([goto-utest] '(menu-item "Go to Unit Test" + rails-controller-layout:switch-to-unit-test + :enable (rails-core:current-mailer)))) + (define-keys map + ((rails-key "g") 'rails-controller-layout:switch-to-migration) + ((rails-key "m") 'rails-controller-layout:switch-to-model) + ((rails-key "h") 'rails-controller-layout:switch-to-helper) + ((rails-key "f") 'rails-controller-layout:switch-to-functional-test) + ((rails-key "c") 'rails-controller-layout:switch-to-controller) + ((rails-key "u") 'rails-controller-layout:switch-to-unit-test) + ([menu-bar rails-controller-layout] (cons name menu)))) + map)) + +(defun rails-controller-layout:switch-to (type) + (let* ((name (capitalize (substring (symbol-name type) 1))) + (controller (rails-core:current-controller)) + (model (singularize-string controller)) + (mailer (rails-core:current-mailer)) + (item (case type + (:helper (rails-core:helper-file controller)) + (:functional-test (rails-core:functional-test-file controller)) + (:controller (rails-core:controller-file controller)) + (:model (rails-core:model-file model)) + (:unit-test (rails-core:unit-test-file mailer)) + (:migration (rails-core:migration-file-by-model model))))) + (if item + (let ((file (rails-core:file item))) + (if (file-exists-p file) + (progn + (find-file file) + (message (format "%s: %s" (substring (symbol-name type) 1) item))) + (message "File %s does not exist" file))) + (message "%s not found" name)))) + +(defun rails-controller-layout:switch-to-helper () (interactive) (rails-controller-layout:switch-to :helper)) +(defun rails-controller-layout:switch-to-functional-test () (interactive) (rails-controller-layout:switch-to :functional-test)) +(defun rails-controller-layout:switch-to-controller () (interactive) (rails-controller-layout:switch-to :controller)) +(defun rails-controller-layout:switch-to-model () (interactive) (rails-controller-layout:switch-to :model)) +(defun rails-controller-layout:switch-to-migration () (interactive) (rails-controller-layout:switch-to :migration)) +(defun rails-controller-layout:switch-to-unit-test () (interactive) (rails-controller-layout:switch-to :unit-test)) + +(defun rails-controller-layout:menu () + (interactive) + (let* ((type (rails-core:buffer-type)) + (title (capitalize (substring (symbol-name type) 1))) + (controller (rails-core:current-controller)) + (action (rails-core:current-action)) + (model (singularize-string controller)) + (mailer (rails-core:current-mailer)) + (item (rails-controller-layout:views-menu (or controller mailer)))) + (add-to-list 'item (rails-core:menu-separator)) + (when controller + (when (rails-core:model-exist-p model) + (when (rails-core:migration-file-by-model model) + (add-to-list 'item (cons "Migration" :migration))) + (add-to-list 'item (cons "Model" :model))) + (unless (eq type :helper) + (add-to-list 'item (cons "Helper" :helper))) + (unless (eq type :functional-test) + (add-to-list 'item (cons "Functional Test" :functional-test))) + (unless (eq type :controller) + (add-to-list 'item (cons "Controller" :controller)))) + (when mailer + (add-to-list 'item (cons "Unit Test" (rails-core:unit-test-file mailer))) + (when (eq type :view) + (add-to-list 'item (cons "Mailer" (rails-core:mailer-file mailer))))) + (setq item + (rails-core:menu + (list (concat title " " controller + (when action (format " (%s)" action))) + (cons "Please select..." + item)))) + (typecase item + (symbol (rails-controller-layout:switch-to item)) + (string (rails-core:find-file-if-exist item))))) + +(provide 'rails-controller-layout) diff --git a/emacs.d/rails/rails-controller-minor-mode.el b/emacs.d/rails/rails-controller-minor-mode.el new file mode 100644 index 0000000..c082c8b --- /dev/null +++ b/emacs.d/rails/rails-controller-minor-mode.el @@ -0,0 +1,37 @@ +;;; rails-controller-minor-mode.el --- minor mode for RubyOnRails controllers + +;; Copyright (C) 2006-2007 Dmitry Galinsky + +;; Authors: Dmitry Galinsky , +;; Rezikov Peter + +;; Keywords: ruby rails languages oop +;; $URL: svn://rubyforge.org/var/svn/emacs-rails/trunk/rails-controller-minor-mode.el $ +;; $Id: rails-controller-minor-mode.el 158 2007-04-03 08:45:46Z dimaexe $ + +;;; License + +;; This program is free software; you can redistribute it and/or +;; modify it under the terms of the GNU General Public License +;; as published by the Free Software Foundation; either version 2 +;; of the License, or (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program; if not, write to the Free Software +;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. + +;;; Code: + +(define-minor-mode rails-controller-minor-mode + "Minor mode for RubyOnRails controllers." + :lighter " Controller" + :keymap (rails-controller-layout:keymap :controller) + (setq rails-secondary-switch-func 'rails-controller-layout:menu) + (setq rails-primary-switch-func 'rails-controller-layout:toggle-action-view)) + +(provide 'rails-controller-minor-mode) diff --git a/emacs.d/rails/rails-core.el b/emacs.d/rails/rails-core.el new file mode 100644 index 0000000..a69484c --- /dev/null +++ b/emacs.d/rails/rails-core.el @@ -0,0 +1,635 @@ +;;; rails-core.el --- core helper functions and macros for emacs-rails + +;; Copyright (C) 2006 Dmitry Galinsky + +;; Authors: Dmitry Galinsky , +;; Rezikov Peter + +;; Keywords: ruby rails languages oop +;; $URL: svn://rubyforge.org/var/svn/emacs-rails/trunk/rails-core.el $ +;; $Id: rails-core.el 186 2007-04-20 15:34:51Z dimaexe $ + +;;; License + +;; This program is free software; you can redistribute it and/or +;; modify it under the terms of the GNU General Public License +;; as published by the Free Software Foundation; either version 2 +;; of the License, or (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program; if not, write to the Free Software +;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. + +(eval-when-compile + (require 'rails-lib)) + +(defvar rails-core:class-dirs + '("app/controllers" + "app/views" + "app/models" + "app/helpers" + "test/unit" + "test/functional" + "test/fixtures") + "Directories with Rails classes") + +(defun rails-core:class-by-file (filename) + "Return the class associated with FILENAME. + /(app/models|app/controllers|app/helpers|test/unit|test/functional)/foo/bar_baz + --> Foo::BarBaz" + (let* ((case-fold-search nil) + (path (replace-regexp-in-string + (format + "\\(.*\\(%s\\)/\\)?\\([^\.]+\\)\\(.*\\)?" + (strings-join "\\|" rails-core:class-dirs)) "\\3" filename)) + (path (replace-regexp-in-string "/" " " path)) + (path (replace-regexp-in-string "_" " " path))) + (replace-regexp-in-string + " " "" + (replace-regexp-in-string + " " "::" + (if (string-match "^ *\\([0-9]+ *\\)?[A-Z]" path) + path + (capitalize path)))))) + +(defun rails-core:file-by-class (classname &optional do-not-append-ext) + "Return the filename associated with CLASSNAME. +If the optional parameter DO-NOT-APPEND-EXT is set this function +will not append \".rb\" to result." + (let* ((case-fold-search nil) + (path (replace-regexp-in-string "::" "/" classname)) + (path (replace-regexp-in-string "\\([A-Z]+\\)\\([A-Z][a-z]\\)" "\\1_\\2" path)) + (path (replace-regexp-in-string "\\([a-z\\d]\\)\\([A-Z]\\)" "\\1_\\2" path))) + (concat (downcase path) + (unless do-not-append-ext ".rb")))) + +;;;;;;;;;; Files ;;;;;;;;;; + +(defun rails-core:file (file-name) + "Return the full path for FILE-NAME in a Rails directory." + (when file-name + (if (file-name-absolute-p file-name) + file-name + (rails-project:with-root + (root) + (concat root file-name))))) + +(defun rails-core:quoted-file (file-name) + "Return the quoted full path for FILE-NAME in a Rails directory." + (concat "\"" (rails-core:file file-name) "\"")) + +(defun rails-core:find-file (file-name) + "Open the file named FILE_NAME in a Rails directory." + (when-bind (file (rails-core:file file-name)) + (find-file file))) + +(defun rails-core:find-file-if-exist (file-name) + "Open the file named FILE-NAME in a Rails directory only if the file exists." + (let ((file-name (rails-core:file file-name))) + (when (file-exists-p file-name) + (find-file file-name)))) + +(defun rails-core:find-or-ask-to-create (question file) + "Open the file named FILE in a Rails directory if it exists. If +it does not exist, ask to create it using QUESTION as a prompt." + (find-or-ask-to-create question (rails-core:file file))) + +;; Funtions, that retrun Rails objects full pathes + +(defun rails-core:model-file (model-name) + "Return the model file from the model name." + (when model-name + (concat "app/models/" (rails-core:file-by-class model-name)))) + +(defun rails-core:model-exist-p (model-name) + "Return t if controller CONTROLLER-NAME exists." + (when model-name + (and (file-exists-p + (rails-core:file + (rails-core:model-file model-name))) + (not (rails-core:observer-p model-name)) + (not (rails-core:mailer-p model-name))))) + +(defun rails-core:controller-file (controller-name) + "Return the path to the controller CONTROLLER-NAME." + (when controller-name + (concat "app/controllers/" + (rails-core:file-by-class + (rails-core:short-controller-name controller-name) t) + (unless (string-equal controller-name "Application") "_controller") + ".rb"))) + +(defun rails-core:controller-exist-p (controller-name) + "Return t if controller CONTROLLER-NAME exist." + (when controller-name + (file-exists-p + (rails-core:file + (rails-core:controller-file controller-name))))) + +(defun rails-core:controller-file-by-model (model) + (when model + (let ((controller (pluralize-string model))) + (when (rails-core:controller-exist-p controller) + (rails-core:controller-file controller))))) + +(defun rails-core:observer-file (observer-name) + "Return the path to the observer OBSERVER-NAME." + (when observer-name + (rails-core:model-file (concat observer-name "Observer")))) + +(defun rails-core:mailer-file (mailer) + (when (and mailer + (rails-core:mailer-p mailer)) + (rails-core:model-file mailer))) + +(defun rails-core:mailer-exist-p (mailer) + (when mailer + (file-exists-p (rails-core:file (rails-core:mailer-file mailer))))) + +(defun rails-core:migration-file (migration-name) + "Return the model file from the MIGRATION-NAME." + (when migration-name + (let ((dir "db/migrate/") + (name (replace-regexp-in-string + " " "_" + (rails-core:file-by-class migration-name)))) + (when (string-match "^[^0-9]+[^_]" name) ; try search when the name without migration number + (let ((files (directory-files (rails-core:file dir) + nil + (concat "[0-9]+_" name "$")))) + (setq name (if files + (car files) + nil)))) + (when name + (concat dir name))))) + +(defun rails-core:migration-file-by-model (model) + (when model + (rails-core:migration-file + (concat "Create" (rails-core:class-by-file (pluralize-string model)))))) + +(defun rails-core:model-by-migration-filename (migration-filename) + (when migration-filename + (let ((model-name (singularize-string + (string=~ "[0-9]+_create_\\(\\w+\\)\.rb" (buffer-name) $1)))) + (when (and model-name + (rails-core:model-exist-p model-name)) + model-name)))) + +(defun rails-core:plugin-file (plugin file) + "Return the path to the FILE in Rails PLUGIN." + (concat "vendor/plugins/" plugin "/" file)) + +(defun rails-core:layout-file (layout) + "Return the path to the layout file named LAYOUT." + (let ((its rails-templates-list) + filename) + (while (and (car its) + (not filename)) + (when (file-exists-p (format "%sapp/views/layouts/%s.%s" (rails-project:root) layout (car its))) + (setq filename (format "app/views/layouts/%s.%s" layout (car its)))) + (setq its (cdr its))) + filename)) + +(defun rails-core:js-file (js) + "Return the path to the JavaScript file named JS." + (concat "public/javascripts/" js ".js")) + +(defun rails-core:partial-name (name) + "Return the file name of partial NAME." + (if (string-match "/" name) + (concat "app/views/" + (replace-regexp-in-string "\\([^/]*\\)$" "_\\1.rhtml" name)) + (concat (rails-core:views-dir (rails-core:current-controller)) + "_" name ".rhtml"))) + +(defun rails-core:view-name (name) + "Return the file name of view NAME." + (concat (rails-core:views-dir (rails-core:current-controller)) + name ".rhtml")) ;; BUG: will fix it + +(defun rails-core:helper-file (controller) + "Return the helper file name for the controller named +CONTROLLER." + (if (string= "Test/TestHelper" controller) + (rails-core:file (rails-core:file-by-class "Test/TestHelper")) + (when controller + (format "app/helpers/%s_helper.rb" + (replace-regexp-in-string "_controller" "" + (rails-core:file-by-class controller t)))))) + +(defun rails-core:functional-test-file (controller) + "Return the functional test file name for the controller named +CONTROLLER." + (when controller + (format "test/functional/%s_test.rb" + (rails-core:file-by-class (rails-core:long-controller-name controller) t)))) + +(defun rails-core:unit-test-file (model) + "Return the unit test file name for the model named MODEL." + (when model + (format "test/unit/%s_test.rb" (rails-core:file-by-class model t)))) + +(defun rails-core:unit-test-exist-p (model) + "Return the unit test file name for the model named MODEL." + (let ((test (rails-core:unit-test-file model))) + (when test + (file-exists-p (rails-core:file test))))) + +(defun rails-core:fixture-file (model) + "Return the fixtures file name for the model named MODEL." + (when model + (format "test/fixtures/%s.yml" (pluralize-string (rails-core:file-by-class model t))))) + +(defun rails-core:fixture-exist-p (model) + (when model + (file-exists-p + (rails-core:file (rails-core:fixture-file model))))) + +(defun rails-core:views-dir (controller) + "Return the view directory name for the controller named CONTROLLER." + (format "app/views/%s/" (replace-regexp-in-string "_controller" "" (rails-core:file-by-class controller t)))) + +(defun rails-core:stylesheet-name (name) + "Return the file name of the stylesheet named NAME." + (concat "public/stylesheets/" name ".css")) + +(defun rails-core:controller-name (controller-file) + "Return the class name of the controller named CONTROLLER. + Bar in Foo dir -> Foo::Bar" + (rails-core:class-by-file + (if (eq (elt controller-file 0) 47) ;;; 47 == '/' + (subseq controller-file 1) + (let ((current-controller (rails-core:current-controller))) + (if (string-match ":" current-controller) + (concat (replace-regexp-in-string "[^:]*$" "" current-controller) + controller-file) + controller-file))))) + +(defun rails-core:short-controller-name (controller) + "Convert FooController -> Foo." + (remove-postfix controller "Controller" )) + +(defun rails-core:long-controller-name (controller) + "Convert Foo/FooController -> FooController." + (if (string-match "Controller$" controller) + controller + (concat controller "Controller"))) + +;;;;;;;;;; Functions that return collection of Rails objects ;;;;;;;;;; +(defun rails-core:observer-p (name) + (when name + (if (string-match "\\(Observer\\|_observer\\(\\.rb\\)?\\)$" name) + t nil))) + +(defun rails-core:mailer-p (name) + (when name + (if (string-match "\\(Mailer\\|Notifier\\|_mailer\\|_notifier\\(\\.rb\\)?\\)$" name) + t nil))) + +(defun rails-core:controllers (&optional cut-contoller-suffix) + "Return a list of Rails controllers. Remove the '_controller' +suffix if CUT-CONTOLLER-SUFFIX is non nil." + (mapcar + #'(lambda (controller) + (rails-core:class-by-file + (if cut-contoller-suffix + (replace-regexp-in-string "_controller\\." "." controller) + controller))) + (delete-if-not + #'(lambda (controller) + (string-match "\\(application\\|[a-z0-9_]+_controller\\)\\.rb$" + controller)) + (find-recursive-files "\\.rb$" (rails-core:file "app/controllers/"))))) + +(defun rails-core:functional-tests () + "Return a list of Rails functional tests." + (mapcar + #'(lambda(it) + (remove-postfix (rails-core:class-by-file it) + "ControllerTest")) + (find-recursive-files "\\.rb$" (rails-core:file "test/functional/")))) + +(defun rails-core:models () + "Return a list of Rails models." + (mapcar + #'rails-core:class-by-file + (delete-if + #'(lambda (file) (or (rails-core:observer-p file) + (rails-core:mailer-p file))) + (find-recursive-files "\\.rb$" (rails-core:file "app/models/"))))) + +(defun rails-core:unit-tests () + "Return a list of Rails functional tests." + (mapcar + #'(lambda(it) + (remove-postfix (rails-core:class-by-file it) + "Test")) + (find-recursive-files "\\.rb$" (rails-core:file "test/unit/")))) + +(defun rails-core:observers () + "Return a list of Rails observers." + (mapcar + #'(lambda (observer) (replace-regexp-in-string "Observer$" "" observer)) + (mapcar + #'rails-core:class-by-file + (find-recursive-files "\\(_observer\\)\\.rb$" (rails-core:file "app/models/"))))) + +(defun rails-core:mailers () + "Return a list of Rails mailers." + (mapcar + #'rails-core:class-by-file + (find-recursive-files "\\(_mailer\\|_notifier\\)\\.rb$" (rails-core:file "app/models/")))) + +(defun rails-core:helpers () + "Return a list of Rails helpers." + (append + (mapcar + #'(lambda (helper) (replace-regexp-in-string "Helper$" "" helper)) + (mapcar + #'rails-core:class-by-file + (find-recursive-files "_helper\\.rb$" (rails-core:file "app/helpers/")))) + (list "Test/TestHelper"))) + +(defun rails-core:migrations (&optional strip-numbers) + "Return a list of Rails migrations." + (let (migrations) + (setq + migrations + (reverse + (mapcar + #'(lambda (migration) + (replace-regexp-in-string "^\\([0-9]+\\)" "\\1 " migration)) + (mapcar + #'rails-core:class-by-file + (find-recursive-files "^[0-9]+_.*\\.rb$" (rails-core:file "db/migrate/")))))) + (if strip-numbers + (mapcar #'(lambda(i) (car (last (split-string i " ")))) + migrations) + migrations))) + +(defun rails-core:migration-versions (&optional with-zero) + "Return a list of migtaion versions as the list of strings. If +second argument WITH-ZERO is present, append the \"000\" version +of migration." + (let ((ver (mapcar + #'(lambda(it) (car (split-string it " "))) + (rails-core:migrations)))) + (if with-zero + (append ver '("000")) + ver))) + +(defun rails-core:plugins () + "Return a list of Rails plugins." + (mapcar + #'file-name-nondirectory + (delete-if-not + #'file-directory-p + (directory-files (rails-core:file "vendor/plugins") t "^[^\\.]")))) + +(defun rails-core:plugin-files (plugin) + "Return a list of files in specific Rails plugin." + (find-recursive-files "^[^.]" (rails-core:file (concat "vendor/plugins/" plugin)))) + +(defun rails-core:layouts () + "Return a list of Rails layouts." + (mapcar + #'(lambda (l) + (replace-regexp-in-string "\\.[^.]+$" "" l)) + (find-recursive-files (rails-core:regex-for-match-view) (rails-core:file "app/views/layouts")))) + +(defun rails-core:fixtures () + "Return a list of Rails fixtures." + (mapcar + #'(lambda (l) + (replace-regexp-in-string "\\.[^.]+$" "" l)) + (find-recursive-files "\\.yml$" (rails-core:file "test/fixtures/")))) + +(defun rails-core:regex-for-match-view () + "Return a regex to match Rails view templates. +The file extensions used for views are defined in `rails-templates-list'." + (format "\\.\\(%s\\)$" (strings-join "\\|" rails-templates-list))) + +(defun rails-core:get-view-files (controller-class &optional action) + "Retun a list containing the view file for CONTROLLER-CLASS#ACTION. +If the action is nil, return all views for the controller." + (rails-project:with-root + (root) + (directory-files + (rails-core:file + (rails-core:views-dir + (rails-core:short-controller-name controller-class))) t + (if action + (concat "^" action (rails-core:regex-for-match-view)) + (rails-core:regex-for-match-view))))) + +(defun rails-core:extract-ancestors (classes) + "Return the parent classes from a list of classes named CLASSES." + (delete "" + (uniq-list + (mapcar (lambda (class) + (replace-regexp-in-string + "::[^:]*$" "::" + (replace-regexp-in-string "^[^:]*$" "" class))) + classes)))) + +(defun rails-core:models-ancestors () + "Return the parent classes of models." + (rails-core:extract-ancestors (rails-core:models))) + +(defun rails-core:controllers-ancestors () + "Return the parent classes of controllers." + (rails-core:extract-ancestors (rails-core:controllers))) + +;;;;;;;;;; Getting Controllers/Model/Action from current buffer ;;;;;;;;;; + +(defun rails-core:current-controller () + "Return the current Rails controller." + (let* ((file-class (rails-core:class-by-file (buffer-file-name)))) + (unless (rails-core:mailer-p file-class) + (case (rails-core:buffer-type) + (:controller (rails-core:short-controller-name file-class)) + (:view (rails-core:class-by-file + (directory-file-name (directory-of-file (buffer-file-name))))) + (:helper (remove-postfix file-class "Helper")) + (:functional-test (remove-postfix file-class "ControllerTest")))))) + +(defun rails-core:current-model () + "Return the current Rails model." + (let* ((file-class (rails-core:class-by-file (buffer-file-name)))) + (unless (rails-core:mailer-p file-class) + (case (rails-core:buffer-type) + (:migration (rails-core:model-by-migration-filename (buffer-name))) + (:model file-class) + (:unit-test (remove-postfix file-class "Test")) + (:fixture (singularize-string file-class)))))) + +(defun rails-core:current-mailer () + "Return the current Rails Mailer, else return nil." + (let* ((file-class (rails-core:class-by-file (buffer-file-name))) + (test (remove-postfix file-class "Test"))) + (when (or (rails-core:mailer-p file-class) + (rails-core:mailer-p test)) + (case (rails-core:buffer-type) + (:mailer file-class) + (:unit-test test) + (:view (rails-core:class-by-file + (directory-file-name (directory-of-file (buffer-file-name))))))))) + +(defun rails-core:current-action () + "Return the current action in the current Rails controller." + (case (rails-core:buffer-type) + (:controller (rails-core:current-method-name)) + (:mailer (rails-core:current-method-name)) + (:view (string-match "/\\([a-z0-9_]+\\)\.[a-z]+$" (buffer-file-name)) + (match-string 1 (buffer-file-name))))) + +(defun rails-core:current-helper () + "Return the current helper" + (rails-core:current-controller)) + +(defun rails-core:current-plugin () + "Return the current plugin name." + (let ((name (buffer-file-name))) + (when (string-match "vendor\\/plugins\\/\\([^\\/]+\\)" name) + (match-string 1 name)))) + +(defun rails-core:current-method-name () + (save-excursion + (when (search-backward-regexp "^[ ]*def \\([a-z0-9_]+\\)" nil t) + (match-string-no-properties 1)))) + +;;;;;;;;;; Determination of buffer type ;;;;;;;;;; + +(defun rails-core:buffer-file-match (regexp) + "Match the current buffer file name to RAILS_ROOT + REGEXP." + (when-bind (file (rails-core:file regexp)) + (string-match file + (buffer-file-name (current-buffer))))) + +(defun rails-core:buffer-type () + "Return the type of the current Rails file or nil if the type +cannot be determinated." + (loop for (type dir func) in rails-directory<-->types + when (and (rails-core:buffer-file-match dir) + (if func + (apply func (list (buffer-file-name (current-buffer)))) + t)) + do (return type))) + + +;;;;;;;;;; Rails minor mode Buttons ;;;;;;;;;; + +(define-button-type 'rails-button + 'follow-link t + 'action #'rails-core:button-action) + +(defun rails-core:button-action (button) + (let* ((file-name (button-get button :rails:file-name)) + (line-number (button-get button :rails:line-number)) + (file (rails-core:file file-name))) + (when (and file + (file-exists-p file)) + (find-file-other-window file) + (when line-number + (goto-line line-number))))) + + +;;;;;;;;;; Rails minor mode logs ;;;;;;;;;; + +(defun rails-log-add (message) + "Add MESSAGE to the Rails minor mode log in RAILS_ROOT." + (rails-project:with-root + (root) + (append-string-to-file (rails-core:file "log/rails-minor-mode.log") + (format "%s: %s\n" + (format-time-string "%Y/%m/%d %H:%M:%S") message)))) + +(defun rails-logged-shell-command (command buffer) + "Execute a shell command in the buffer and write the results to +the Rails minor mode log." + (shell-command (format "%s %s" rails-ruby-command command) buffer) + (rails-log-add + (format "\n%s> %s\n%s" (rails-project:name) + command (buffer-string-by-name buffer)))) + +;;;;;;;;;; Rails menu ;;;;;;;;;; + +(defun rails-core:menu-separator () + (unless (rails-use-text-menu) 'menu (list "--" "--"))) + +(if (fboundp 'completion-posn-at-point-as-event) + (defun rails-core:menu-position () + (completion-posn-at-point-as-event nil nil nil (+ (frame-char-height) 2))) + (defun rails-core:menu-position () + (list '(300 50) (get-buffer-window (current-buffer))))) + +(defun rails-core:menu (menu) + "Show a menu." + (let ((result + (if (rails-use-text-menu) + (tmm-prompt menu) + (x-popup-menu (rails-core:menu-position) + (rails-core:prepare-menu menu))))) + (if (listp result) + (first result) + result))) + +(defvar rails-core:menu-letters-list + (let ((res '())) + (loop for i from (string-to-char "1") upto (string-to-char "9") + do (add-to-list 'res (char-to-string i) t)) + (loop for i from (string-to-char "a") upto (string-to-char "z") + do (add-to-list 'res (char-to-string i) t)) + res) + "List contains 0-9a-z letter") + +(defun rails-core:prepare-menu (menu) + "Append a prefix to each label of menu-item from MENU." + (let ((title (car menu)) + (menu (cdr menu)) + (result '()) + (result-line '()) + (letter 0)) + (dolist (line menu) + (setq result-line '()) + (dolist (it line) + (typecase it + (cons + (rails-core:menu-separator) + (if (and (string= (car (rails-core:menu-separator)) (car it)) + (string= (cadr (rails-core:menu-separator)) (cadr it))) + (add-to-list 'result-line it t) + (progn + (add-to-list 'result-line (cons (format "%s) %s" (nth letter rails-core:menu-letters-list) (car it)) + (cdr it)) t) + (setq letter (+ 1 letter))))) + (t + (add-to-list 'result-line it t)))) + (add-to-list 'result result-line t)) + (cons title result))) + +;;;;;;;;;; Misc ;;;;;;;;;; + +(defun rails-core:erb-block-string () + "Return the contents of the current ERb block." + (save-excursion + (save-match-data + (let ((start (point))) + (search-backward-regexp "<%[=]?") + (let ((from (match-end 0))) + (search-forward "%>") + (let ((to (match-beginning 0))) + (when (>= to start) + (buffer-substring-no-properties from to)))))))) + +(defun rails-core:rhtml-buffer-p () + "Return non nil if the current buffer is rhtml file." + (string-match "\\.rhtml$" (buffer-file-name))) + +(provide 'rails-core) diff --git a/emacs.d/rails/rails-features.el b/emacs.d/rails/rails-features.el new file mode 100644 index 0000000..14c4d1a --- /dev/null +++ b/emacs.d/rails/rails-features.el @@ -0,0 +1,45 @@ +;;; rails-features.el --- + +;; Copyright (C) 2006 Dmitry Galinsky + +;; Authors: Dmitry Galinsky + +;; Keywords: ruby rails languages oop +;; $URL: svn+ssh://rubyforge/var/svn/emacs-rails/trunk/rails-ruby.el $ +;; $Id: rails-ruby.el 166 2007-04-05 17:44:57Z dimaexe $ + +;;; License + +;; This program is free software; you can redistribute it and/or +;; modify it under the terms of the GNU General Public License +;; as published by the Free Software Foundation; either version 2 +;; of the License, or (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program; if not, write to the Free Software +;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. + +;;; Code: + +(defvar rails-features:list + '(rails-snippets-feature + rails-speedbar-feature) + "List of features") + +(defvar rails-features:installed-p nil) + +(defun rails-features:install () + (unless rails-features:installed-p + (dolist (feature rails-features:list) + (when (require feature nil t) + (apply + (intern (concat (symbol-name feature) ":install")) + (list)))) + (setq rails-features:installed-p t))) + +(provide 'rails-features) \ No newline at end of file diff --git a/emacs.d/rails/rails-find.el b/emacs.d/rails/rails-find.el new file mode 100644 index 0000000..f06ad62 --- /dev/null +++ b/emacs.d/rails/rails-find.el @@ -0,0 +1,54 @@ +;;; rails-find.el --- + +;; Copyright (C) 2006 Dmitry Galinsky + +;; Authors: Dmitry Galinsky , +;; Rezikov Peter + +;; Keywords: ruby rails languages oop +;; $URL: svn+ssh://rubyforge/var/svn/emacs-rails/trunk/rails-navigation.el $ +;; $Id: rails-navigation.el 111 2007-03-24 22:28:12Z dimaexe $ + +;;; License + +;; This program is free software; you can redistribute it and/or +;; modify it under the terms of the GNU General Public License +;; as published by the Free Software Foundation; either version 2 +;; of the License, or (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program; if not, write to the Free Software +;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. + +(defmacro rails-find:gen (name dir) + "Define new rails-find function" + (let ((dir (concat dir "/"))) + `(defun ,(intern (concat "rails-find:" name)) () + ,(format "Run find-file in Rails \"%s\" dir" dir) + (interactive) + (let ((default-directory (rails-core:file ,dir))) + (call-interactively ',(if (fboundp 'ido-find-file) + 'ido-find-file + 'find-file)))))) + +(rails-find:gen "controller" "app/controllers") +(rails-find:gen "view" "app/views") +(rails-find:gen "layout" "app/views/layouts") +(rails-find:gen "db" "db") +(rails-find:gen "public" "public") +(rails-find:gen "helpers" "app/helpers") +(rails-find:gen "models" "app/models") +(rails-find:gen "config" "config") +(rails-find:gen "lib" "lib") +(rails-find:gen "tasks" "lib/tasks") +(rails-find:gen "stylesheets" "public/stylesheets") +(rails-find:gen "javascripts" "public/javascripts") +(rails-find:gen "migrate" "db/migrate") +(rails-find:gen "fixtures" "test/fixtures") + +(provide 'rails-find) \ No newline at end of file diff --git a/emacs.d/rails/rails-fixture-minor-mode.el b/emacs.d/rails/rails-fixture-minor-mode.el new file mode 100644 index 0000000..0a9cffb --- /dev/null +++ b/emacs.d/rails/rails-fixture-minor-mode.el @@ -0,0 +1,36 @@ +;;; rails-fixture-minor-mode.el --- minor mode for RubyOnRails fixtures + +;; Copyright (C) 2006 Dmitry Galinsky + +;; Authors: Dmitry Galinsky + +;; Keywords: ruby rails languages oop +;; $URL: svn://rubyforge.org/var/svn/emacs-rails/trunk/rails-fixture-minor-mode.el $ +;; $Id: rails-fixture-minor-mode.el 158 2007-04-03 08:45:46Z dimaexe $ + +;;; License + +;; This program is free software; you can redistribute it and/or +;; modify it under the terms of the GNU General Public License +;; as published by the Free Software Foundation; either version 2 +;; of the License, or (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program; if not, write to the Free Software +;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. + +;;; Code: + +(define-minor-mode rails-fixture-minor-mode + "Minor mode for RubyOnRails fixtures." + :lighter " Fixture" + :keymap (rails-model-layout:keymap :fixture) + (setq rails-primary-switch-func 'rails-model-layout:switch-to-unit-test) + (setq rails-secondary-switch-func 'rails-model-layout:menu)) + +(provide 'rails-fixture-minor-mode) \ No newline at end of file diff --git a/emacs.d/rails/rails-functional-test-minor-mode.el b/emacs.d/rails/rails-functional-test-minor-mode.el new file mode 100644 index 0000000..00021ab --- /dev/null +++ b/emacs.d/rails/rails-functional-test-minor-mode.el @@ -0,0 +1,39 @@ +;;; rails-functional-test-minor-mode.el --- minor mode for RubyOnRails functional tests + +;; Copyright (C) 2006 Dmitry Galinsky + +;; Authors: Dmitry Galinsky + +;; Keywords: ruby rails languages oop +;; $URL: svn://rubyforge.org/var/svn/emacs-rails/trunk/rails-functional-test-minor-mode.el $ +;; $Id: rails-functional-test-minor-mode.el 166 2007-04-05 17:44:57Z dimaexe $ + +;;; License + +;; This program is free software; you can redistribute it and/or +;; modify it under the terms of the GNU General Public License +;; as published by the Free Software Foundation; either version 2 +;; of the License, or (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program; if not, write to the Free Software +;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. + +;;; Code: + +(define-minor-mode rails-functional-test-minor-mode + "Minor mode for RubyOnRails functional tests." + :lighter " Functional Test" + :keymap (let ((map (rails-controller-layout:keymap :functional-test))) + (define-key map rails-minor-mode-test-current-method-key 'rails-test:run-current-method) + (define-key map [menu-bar rails-controller-layout run] '("Test current method" . rails-test:run-current-method)) + map) + (setq rails-primary-switch-func 'rails-controller-layout:switch-to-controller) + (setq rails-secondary-switch-func 'rails-controller-layout:menu)) + +(provide 'rails-functional-test-minor-mode) \ No newline at end of file diff --git a/emacs.d/rails/rails-helper-minor-mode.el b/emacs.d/rails/rails-helper-minor-mode.el new file mode 100644 index 0000000..4fffc01 --- /dev/null +++ b/emacs.d/rails/rails-helper-minor-mode.el @@ -0,0 +1,36 @@ +;;; rails-helper-minor-mode.el --- minor mode for RubyOnRails helpers + +;; Copyright (C) 2006 Dmitry Galinsky + +;; Authors: Dmitry Galinsky + +;; Keywords: ruby rails languages oop +;; $URL: svn://rubyforge.org/var/svn/emacs-rails/trunk/rails-helper-minor-mode.el $ +;; $Id: rails-helper-minor-mode.el 158 2007-04-03 08:45:46Z dimaexe $ + +;;; License + +;; This program is free software; you can redistribute it and/or +;; modify it under the terms of the GNU General Public License +;; as published by the Free Software Foundation; either version 2 +;; of the License, or (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program; if not, write to the Free Software +;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. + +;;; Code: + +(define-minor-mode rails-helper-minor-mode + "Minor mode for RubyOnRails helpers." + :lighter " Helper" + :keymap (rails-controller-layout:keymap :helper) + (setq rails-primary-switch-func 'rails-controller-layout:switch-to-controller) + (setq rails-secondary-switch-func 'rails-controller-layout:menu)) + +(provide 'rails-helper-minor-mode) \ No newline at end of file diff --git a/emacs.d/rails/rails-layout-minor-mode.el b/emacs.d/rails/rails-layout-minor-mode.el new file mode 100644 index 0000000..103e3b0 --- /dev/null +++ b/emacs.d/rails/rails-layout-minor-mode.el @@ -0,0 +1,35 @@ +;;; rails-layout-minor-mode.el --- minor mode for RubyOnRails layouts + +;; Copyright (C) 2006 Dmitry Galinsky + +;; Authors: Dmitry Galinsky + +;; Keywords: ruby rails languages oop +;; $URL: svn://rubyforge.org/var/svn/emacs-rails/trunk/rails-layout-minor-mode.el $ +;; $Id: rails-layout-minor-mode.el 112 2007-03-24 22:34:38Z dimaexe $ + +;;; License + +;; This program is free software; you can redistribute it and/or +;; modify it under the terms of the GNU General Public License +;; as published by the Free Software Foundation; either version 2 +;; of the License, or (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program; if not, write to the Free Software +;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. + +;;; Code: + +(define-minor-mode rails-layout-minor-mode + "Minor mode for RubyOnRails layouts." + nil + " layout" + nil) + +(provide 'rails-layout-minor-mode) diff --git a/emacs.d/rails/rails-lib.el b/emacs.d/rails/rails-lib.el new file mode 100644 index 0000000..d2ae456 --- /dev/null +++ b/emacs.d/rails/rails-lib.el @@ -0,0 +1,407 @@ +;;; rails-lib.el --- + +;; Copyright (C) 2006 Dmitry Galinsky + +;; Authors: Dmitry Galinsky , +;; Rezikov Peter +;; Howard Yeh + +;; Keywords: ruby rails languages oop +;; $URL: svn://rubyforge.org/var/svn/emacs-rails/trunk/rails-lib.el $ +;; $Id: rails-lib.el 168 2007-04-06 19:10:55Z dimaexe $ + +;;; License + +;; This program is free software; you can redistribute it and/or +;; modify it under the terms of the GNU General Public License +;; as published by the Free Software Foundation; either version 2 +;; of the License, or (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program; if not, write to the Free Software +;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. + +;;; Code: + +(defun rails-lib:run-primary-switch () + "Run the primary switch function." + (interactive) + (if rails-primary-switch-func + (apply rails-primary-switch-func nil))) + +(defun rails-lib:run-secondary-switch () + "Run the secondary switch function." + (interactive) + (if rails-secondary-switch-func + (apply rails-secondary-switch-func nil))) + +;;;;; Non Rails realted helper functions ;;;;; + +;; Syntax macro + +(defmacro* when-bind ((var expr) &rest body) + "Binds VAR to the result of EXPR. +If EXPR is not nil exeutes BODY. + + (when-bind (var (func foo)) + (do-somth (with var)))." + `(let ((,var ,expr)) + (when ,var + ,@body))) + +;; Lists + +(defun list->alist (list) + "Convert ((a . b) c d) to ((a . b) (c . c) (d . d))." + (mapcar + #'(lambda (el) + (if (listp el) el(cons el el))) + list)) + +(defun uniq-list (list) + "Return a list of unique elements." + (let ((result '())) + (dolist (elem list) + (when (not (member elem result)) + (push elem result))) + (nreverse result))) + +;; Strings + +(defun string-repeat (char num) + (let ((len num) + (str "")) + (while (not (zerop len)) + (setq len (- len 1)) + (setq str (concat char str))) + str)) + + +(defmacro string=~ (regex string &rest body) + "regex matching similar to the =~ operator found in other languages." + (let ((str (gensym))) + `(lexical-let ((,str ,string)) + ;; Use lexical-let to make closures (in flet). + (when (string-match ,regex ,str) + (symbol-macrolet ,(loop for i to 9 collect + (let ((sym (intern (concat "$" (number-to-string i))))) + `(,sym (match-string ,i ,str)))) + (flet (($ (i) (match-string i ,str)) + (sub (replacement &optional (i 0) &key fixedcase literal-string) + (replace-match replacement fixedcase literal-string ,str i))) + (symbol-macrolet ( ;;before + ($b (substring ,str 0 (match-beginning 0))) + ;;match + ($m (match-string 0 ,str)) + ;;after + ($a (substring ,str (match-end 0) (length ,str)))) + ,@body))))))) + +(defun string-not-empty (str) ;(+) + "Return t if string STR is not empty." + (and (stringp str) (not (or (string-equal "" str) + (string-match "^ +$" str))))) + +(defun yml-value (name) + "Return the value of the parameter named NAME in the current +buffer or an empty string." + (save-excursion + (goto-char (point-min)) + (if (search-forward-regexp (format "%s:[ ]*\\(.*\\)[ ]*$" name) nil t) + (match-string 1) + ""))) + +(defun current-line-string () + "Return the string value of the current line." + (buffer-substring-no-properties + (progn (beginning-of-line) (point)) + (progn (end-of-line) (point)))) + +(defun remove-prefix (word prefix) + "Remove the PREFIX string in WORD if it exists. +PrefixBla -> Bla." + (replace-regexp-in-string (format "^%s" prefix) "" word)) + +(defun remove-postfix (word postfix) + "Remove the POSTFIX string in WORD if it exists. +BlaPostfix -> Bla." + (replace-regexp-in-string (format "%s$" postfix) "" word)) + +(defun strings-join (separator strings) + "Join all STRINGS using a SEPARATOR." + (mapconcat 'identity strings separator)) + +(defalias 'string-join 'strings-join) + +(defun capital-word-p (word) + "Return t if first letter of WORD is uppercased." + (= (elt word 0) + (elt (capitalize word) 0))) + +;;;;;;;; def-snips stuff ;;;; + +(defun snippet-abbrev-function-name (abbrev-table abbrev-name) + "Return the name of the snippet abbreviation function in the +ABBREV-TABLE for the abbreviation ABBREV-NAME." + (intern (concat "snippet-abbrev-" + (snippet-strip-abbrev-table-suffix + (symbol-name abbrev-table)) + "-" + abbrev-name))) + +(defun snippet-menu-description-variable (table name) + "Return a variable for the menu description of the snippet ABBREV-NAME in ABBREV-TABLE." + (intern + (concat + (symbol-name (snippet-abbrev-function-name table name)) + "-menu-description"))) + +(defmacro* def-snips ((&rest abbrev-tables) &rest snips) + "Generate snippets with menu documentaion in several ABBREV-TABLES. + + (def-snip (some-mode-abbrev-table other-mode-abbrev-table) + (\"abbr\" \"some snip $${foo}\" \"menu documentation\") + (\"anabr\" \"other snip $${bar}\" \"menu documentation\") +" + `(progn + ,@(loop for table in abbrev-tables + collect + `(snippet-with-abbrev-table ',table + ,@(loop for (name template desc) in snips collect + `(,name . ,template))) + append + (loop for (name template desc) in snips collect + `(setf ,(snippet-menu-description-variable table name) + ,desc))))) + +(defun snippet-menu-description (abbrev-table name) + "Return the menu descripton for the snippet named NAME in +ABBREV-TABLE." + (symbol-value (snippet-menu-description-variable abbrev-table name))) + +(defun snippet-menu-line (abbrev-table name) + "Generate a menu line for the snippet NAME in ABBREV-TABLE." + (cons + (concat name "\t" (snippet-menu-description abbrev-table name)) + (lexical-let ((func-name (snippet-abbrev-function-name abbrev-table name))) + (lambda () (interactive) (funcall func-name))))) + +;;; Define keys + +(defmacro define-keys (key-map &rest key-funcs) + "Define key bindings for KEY-MAP (create KEY-MAP, if it does +not exist." + `(progn + (unless (boundp ',key-map) + (setf ,key-map (make-keymap))) + ,@(mapcar + #'(lambda (key-func) + `(define-key ,key-map ,(first key-func) ,(second key-func))) + key-funcs))) + +;; Files + +(defun append-string-to-file (file string) + "Append a string to end of a file." + (write-region string nil file t)) + +(defun write-string-to-file (file string) + "Write a string to a file (erasing the previous content)." + (write-region string nil file)) + +(defun read-from-file (file-name) + "Read sexpr from a file named FILE-NAME." + (with-temp-buffer + (insert-file-contents file-name) + (read (current-buffer)))) + +;; File hierarchy functions + +(defun find-recursive-files (file-regexp directory) + "Return a list of files, found in DIRECTORY and match them to FILE-REGEXP." + (find-recursive-filter-out + find-recursive-exclude-files + (find-recursive-directory-relative-files directory "" file-regexp))) + +(defun directory-name (path) + "Return the name of a directory with a given path. +For example, (path \"/foo/bar/baz/../\") returns bar." + ;; Rewrite me + (let ((old-path default-directory)) + (cd path) + (let ((dir (pwd))) + (cd old-path) + (replace-regexp-in-string "^Directory[ ]*" "" dir)))) + +(defun find-or-ask-to-create (question file) + "Open file if it exists. If it does not exist, ask to create +it." + (if (file-exists-p file) + (find-file file) + (when (y-or-n-p question) + (when (string-match "\\(.*\\)/[^/]+$" file) + (make-directory (match-string 1 file) t)) + (find-file file)))) + +(defun directory-of-file (file-name) + "Return the parent directory of a file named FILE-NAME." + (replace-regexp-in-string "[^/]*$" "" file-name)) + +;; Buffers + +(defun buffer-string-by-name (buffer-name) + "Return the content of buffer named BUFFER-NAME as a string." + (interactive) + (save-excursion + (set-buffer buffer-name) + (buffer-string))) + +(defun buffer-visible-p (buffer-name) + (if (get-buffer-window buffer-name) t nil)) + +;; Misc + +(defun rails-browse-api-url (url) + "Browse preferentially with Emacs w3m browser." + (if rails-browse-api-with-w3m + (when (fboundp 'w3m-find-file) + (w3m-find-file (remove-prefix url "file://"))) + (rails-alternative-browse-url url))) + +(defun rails-alternative-browse-url (url &rest args) + "Fix a problem with Internet Explorer not being able to load +URLs with anchors via ShellExecute. It will only be invoked it +the user explicit sets `rails-use-alternative-browse-url'." + (if (and (eq system-type 'windows-nt) rails-use-alternative-browse-url) + (w32-shell-execute "open" "iexplore" url) + (browse-url url args))) + +;; abbrev +;; from http://www.opensource.apple.com/darwinsource/Current/emacs-59/emacs/lisp/derived.el +(defun merge-abbrev-tables (old new) + "Merge an old abbrev table into a new one. +This function requires internal knowledge of how abbrev tables work, +presuming that they are obarrays with the abbrev as the symbol, the expansion +as the value of the symbol, and the hook as the function definition." + (when old + (mapatoms + (lambda(it) + (or (intern-soft (symbol-name it) new) + (define-abbrev new + (symbol-name it) + (symbol-value it) + (symbol-function it) + nil + t))) + old))) + +;; Colorize + +(defun apply-colorize-to-buffer (name) + (let ((buffer (current-buffer))) + (set-buffer name) + (make-local-variable 'after-change-functions) + (add-hook 'after-change-functions + '(lambda (start end len) + (ansi-color-apply-on-region start end))) + (set-buffer buffer))) + +;; completion-read +(defun rails-completing-read (prompt table history require-match) + (let ((history-value (symbol-value history))) + (list (completing-read + (format "%s?%s: " + prompt + (if (car history-value) + (format " (%s)" (car history-value)) + "")) + (list->alist table) ; table + nil ; predicate + require-match ; require-match + nil ; initial input + history ; hist + (car history-value))))) ;def + +;; MMM + +;; (defvar mmm-indent-sandbox-finish-position nil) + +;; (defun mmm-run-indent-with-sandbox (indent-func) +;; (interactive) +;; (let* ((fragment-name "*mmm-indent-sandbox*") +;; (ovl (mmm-overlay-at (point))) +;; (current (when ovl (overlay-buffer ovl))) +;; (start (when ovl (overlay-start ovl))) +;; (end (when ovl (overlay-end ovl))) +;; (current-pos (when ovl (point))) +;; (ovl-line-start (when start +;; (progn (goto-char start) +;; (line-beginning-position)))) +;; (current-line-start (when current-pos +;; (progn (goto-char current-pos) +;; (line-beginning-position)))) +;; (fragment-pos (when (and start end) (- (point) (- start 1)))) +;; (ovl-offset (when ovl (- (progn +;; (goto-char start) +;; (while (not (looking-at "<")) +;; (goto-char (- (point) 1))) +;; (point)) +;; ovl-line-start))) +;; (content (when (and start end) (buffer-substring-no-properties start end))) +;; (fragment (when content (get-buffer-create fragment-name)))) +;; (when fragment +;; (setq mmm-indent-sandbox-finish-position nil) +;; (save-excursion +;; (set-buffer fragment-name) +;; (beginning-of-buffer) +;; (insert content) +;; (goto-char fragment-pos) +;; (funcall indent-func t) +;; (let ((start-line) +;; (end-line) +;; (kill-after-start) +;; (finish-pos (- (+ start (point)) 1)) +;; (indented (buffer-substring-no-properties (line-beginning-position) (line-end-position)))) +;; (set-buffer current) +;; (kill-buffer fragment-name) +;; (princ ovl-offset) +;; (goto-char current-pos) +;; (setq start-line (line-beginning-position)) +;; (setq end-line (line-end-position)) +;; (when (> start start-line) +;; (setq start-line (+ start 1)) +;; (setq kill-after-start t)) +;; (when (> end-line end) +;; (setq end-line end)) +;; (kill-region start-line end-line) +;; (goto-char start-line) +;; (unless (= ovl-line-start current-line-start) +;; (dotimes (i ovl-offset) +;; (setq indented (concat " " indented)))) +;; ;; (insert-char (string-to-char " ") ovl-offset)) +;; (insert indented) +;; (when kill-after-start +;; (goto-char (+ start 1)) +;; (backward-delete-char 1)) +;; ;; (setq mmm-indent-sandbox-finish-position finish-pos))) +;; (if (= ovl-line-start current-line-start) +;; (setq mmm-indent-sandbox-finish-position finish-pos) +;; (setq mmm-indent-sandbox-finish-position (+ finish-pos ovl-offset))))) +;; (goto-char mmm-indent-sandbox-finish-position)))) + +;; (defadvice ruby-indent-line (around mmm-sandbox-ruby-indent-line) +;; (if (and (fboundp 'mmm-overlay-at) +;; (mmm-overlay-at (point))) +;; (mmm-run-indent-with-sandbox 'ruby-indent-line) +;; ad-do-it)) +;; (ad-activate 'ruby-indent-line) + + +;; Cross define functions from my rc files + +(provide 'rails-lib) \ No newline at end of file diff --git a/emacs.d/rails/rails-log.el b/emacs.d/rails/rails-log.el new file mode 100644 index 0000000..57bee5e --- /dev/null +++ b/emacs.d/rails/rails-log.el @@ -0,0 +1,79 @@ +;;; rails-log.el --- provide features for Rails log files + +;; Copyright (C) 2006 Dmitry Galinsky + +;; Authors: Dmitry Galinsky + +;; Keywords: ruby rails languages oop +;; $URL: svn://rubyforge.org/var/svn/emacs-rails/trunk/rails-log.el $ +;; $Id: rails-log.el 114 2007-03-25 18:15:35Z dimaexe $ + +;;; License + +;; This program is free software; you can redistribute it and/or +;; modify it under the terms of the GNU General Public License +;; as published by the Free Software Foundation; either version 2 +;; of the License, or (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program; if not, write to the Free Software +;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. + +;;; Code: + +(defvar rails-log:last-log nil) + +(defun rails-log:files () + (directory-files (rails-core:file "log") nil "\\.log$")) + +(defun rails-log:buffer-name (log-file) + (concat "*" log-file "*")) + +(defun rails-log:open-file (log-file) + (let ((buffer (rails-log:buffer-name log-file)) + (current (buffer-name))) + (unless (get-buffer buffer) + (get-buffer-create buffer) + (set-buffer buffer) + (setq auto-window-vscroll t) + (rails-minor-mode t) + (setq buffer-read-only t) + (set-buffer current) + (apply-colorize-to-buffer buffer)) + (start-process "tail" + buffer + "tail" + "-f" (rails-core:file (concat "log/" log-file))))) + +(defun rails-log:open (log-file) + (interactive + (list (completing-read "Select log (with autocomplete): " + (list->alist (rails-log:files)) + nil + t + rails-log:last-log))) + (setq rails-log:last-log log-file) + (let ((name (rails-log:buffer-name log-file))) + (unless (get-buffer name) + (rails-log:open-file log-file)) + (switch-to-buffer name) + (recenter t))) + +(defun rails-log:open-production () + (interactive) + (rails-log:open "production.log")) + +(defun rails-log:open-development () + (interactive) + (rails-log:open "development.log")) + +(defun rails-log:open-test () + (interactive) + (rails-log:open "test.log")) + +(provide 'rails-log) \ No newline at end of file diff --git a/emacs.d/rails/rails-mailer-minor-mode.el b/emacs.d/rails/rails-mailer-minor-mode.el new file mode 100644 index 0000000..5ba3178 --- /dev/null +++ b/emacs.d/rails/rails-mailer-minor-mode.el @@ -0,0 +1,37 @@ +;;; rails-mailer-minor-mode.el --- minor mode for RubyOnRails mailers + +;; Copyright (C) 2006-2007 Dmitry Galinsky + +;; Authors: Dmitry Galinsky , +;; Rezikov Peter + +;; Keywords: ruby rails languages oop +;; $URL: svn://rubyforge.org/var/svn/emacs-rails/trunk/rails-mailer-minor-mode.el $ +;; $Id: rails-mailer-minor-mode.el 158 2007-04-03 08:45:46Z dimaexe $ + +;;; License + +;; This program is free software; you can redistribute it and/or +;; modify it under the terms of the GNU General Public License +;; as published by the Free Software Foundation; either version 2 +;; of the License, or (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program; if not, write to the Free Software +;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. + +;;; Code: + +(define-minor-mode rails-mailer-minor-mode + "Minor mode for RubyOnRails mailers." + :lighter " Mailer" + :keymap (rails-controller-layout:keymap :mailer) + (setq rails-secondary-switch-func 'rails-controller-layout:menu) + (setq rails-primary-switch-func 'rails-controller-layout:toggle-action-view)) + +(provide 'rails-mailer-minor-mode) diff --git a/emacs.d/rails/rails-migration-minor-mode.el b/emacs.d/rails/rails-migration-minor-mode.el new file mode 100644 index 0000000..728b748 --- /dev/null +++ b/emacs.d/rails/rails-migration-minor-mode.el @@ -0,0 +1,36 @@ +;;; rails-migration-minor-mode.el --- minor mode for RubyOnRails migration + +;; Copyright (C) 2006 Dmitry Galinsky + +;; Authors: Dmitry Galinsky + +;; Keywords: ruby rails languages oop +;; $URL: svn://rubyforge.org/var/svn/emacs-rails/trunk/rails-migration-minor-mode.el $ +;; $Id: rails-migration-minor-mode.el 158 2007-04-03 08:45:46Z dimaexe $ + +;;; License + +;; This program is free software; you can redistribute it and/or +;; modify it under the terms of the GNU General Public License +;; as published by the Free Software Foundation; either version 2 +;; of the License, or (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program; if not, write to the Free Software +;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. + +;;; Code: + +(define-minor-mode rails-migration-minor-mode + "Minor mode for RubyOnRails migrations." + :lighter " Migration" + :keymap (rails-model-layout:keymap :migration) + (setq rails-primary-switch-func nil) + (setq rails-secondary-switch-func 'rails-model-layout:menu)) + +(provide 'rails-migration-minor-mode) \ No newline at end of file diff --git a/emacs.d/rails/rails-model-layout.el b/emacs.d/rails/rails-model-layout.el new file mode 100644 index 0000000..070dbbd --- /dev/null +++ b/emacs.d/rails/rails-model-layout.el @@ -0,0 +1,131 @@ +;;; rails-model-layout.el --- + +;; Copyright (C) 2006 Dmitry Galinsky + +;; Authors: Dmitry Galinsky + +;; Keywords: ruby rails languages oop +;; $URL: svn://rubyforge.org/var/svn/emacs-rails/trunk/rails-model-layout.el $ +;; $Id: rails-model-layout.el 173 2007-04-09 15:15:02Z dimaexe $ + +;;; License + +;; This program is free software; you can redistribute it and/or +;; modify it under the terms of the GNU General Public License +;; as published by the Free Software Foundation; either version 2 +;; of the License, or (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program; if not, write to the Free Software +;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. + +;;; Code: + +(defun rails-model-layout:keymap (type) + (let* ((name (capitalize (substring (symbol-name type) 1))) + (map (make-sparse-keymap)) + (menu (make-sparse-keymap))) + (when type + (define-keys menu + ([goto-model] '(menu-item "Go to Model" + rails-model-layout:switch-to-model + :enable (and (not (eq (rails-core:buffer-type) :model)) + (rails-core:model-exist-p (rails-core:current-model))))) + ([goto-utest] '(menu-item "Go to Unit Test" + rails-model-layout:switch-to-unit-test + :enable (and (not (eq (rails-core:buffer-type) :unit-test)) + (rails-core:unit-test-exist-p (or (rails-core:current-model) + (rails-core:current-mailer)))))) + ([goto-migration] '(menu-item "Go to Migration" + rails-model-layout:switch-to-migration + :enable (and (not (eq (rails-core:buffer-type) :migration)) + (rails-core:migration-file-by-model (rails-core:current-model))))) + ([goto-controller] '(menu-item "Go to Controller" + rails-model-layout:switch-to-controller + :enable (rails-core:controller-file-by-model (rails-core:current-model)))) + ([goto-fixture] '(menu-item "Go to Fixture" + rails-model-layout:switch-to-fixture + :enable (and (not (eq (rails-core:buffer-type) :fixture)) + (rails-core:fixture-exist-p (rails-core:current-model))))) + ([goto-mailer] '(menu-item "Go to Mailer" + rails-model-layout:switch-to-mailer + :enable (rails-core:mailer-exist-p (rails-core:current-mailer))))) + (define-keys map + ((rails-key "m") 'rails-model-layout:switch-to-model) + ((rails-key "u") 'rails-model-layout:switch-to-unit-test) + ((rails-key "g") 'rails-model-layout:switch-to-migration) + ((rails-key "c") 'rails-model-layout:switch-to-controller) + ((rails-key "x") 'rails-model-layout:switch-to-fixture) + ((rails-key "n") 'rails-model-layout:switch-to-mailer) + ([menu-bar rails-model-layout] (cons name menu)))) + map)) + +(defun rails-model-layout:switch-to (type) + (let* ((name (capitalize (substring (symbol-name type) 1))) + (model (rails-core:current-model)) + (controller (rails-core:current-controller)) + (mailer (rails-core:current-mailer)) + (item (if controller controller model)) + (item (case type + (:mailer (rails-core:mailer-file mailer)) + (:controller (rails-core:controller-file-by-model model)) + (:fixture (rails-core:fixture-file model)) + (:unit-test (rails-core:unit-test-file item)) + (:model (rails-core:model-file model)) + (:migration (rails-core:migration-file-by-model model))))) + (if item + (let ((file (rails-core:file item))) + (if (file-exists-p file) + (progn + (find-file file) + (message (format "%s: %s" (substring (symbol-name type) 1) item))) + (message "File %s not exists" file))) + (message "%s not found" name)))) + +(defun rails-model-layout:switch-to-mailer () (interactive) (rails-model-layout:switch-to :mailer)) +(defun rails-model-layout:switch-to-controller () (interactive) (rails-model-layout:switch-to :controller)) +(defun rails-model-layout:switch-to-fixture () (interactive) (rails-model-layout:switch-to :fixture)) +(defun rails-model-layout:switch-to-unit-test () (interactive) (rails-model-layout:switch-to :unit-test)) +(defun rails-model-layout:switch-to-model () (interactive) (rails-model-layout:switch-to :model)) +(defun rails-model-layout:switch-to-migration () (interactive) (rails-model-layout:switch-to :migration)) + +(defun rails-model-layout:menu () + (interactive) + (let* ((item (list)) + (type (rails-core:buffer-type)) + (title (capitalize (substring (symbol-name type) 1))) + (model (rails-core:current-model)) + (controller (pluralize-string model)) + (mailer (rails-core:current-mailer))) + (when model + (when (and (not (eq type :migration)) + (rails-core:migration-file-by-model model)) + (add-to-list 'item (cons "Migration" :migration))) + (unless (eq type :fixture) + (add-to-list 'item (cons "Fixture" :fixture))) + (when (rails-core:controller-exist-p controller) + (add-to-list 'item (cons "Controller" :controller))) + (unless (eq type :unit-test) + (add-to-list 'item (cons "Unit Test" :unit-test))) + (unless (eq type :model) + (add-to-list 'item (cons "Model" :model)))) + (when mailer + (setq item (rails-controller-layout:views-menu model)) + (add-to-list 'item (rails-core:menu-separator)) + (add-to-list 'item (cons "Mailer" :mailer))) + (when item + (setq item + (rails-core:menu + (list (concat title " " model) + (cons "Please select.." + item)))) + (typecase item + (symbol (rails-model-layout:switch-to item)) + (string (rails-core:find-file-if-exist item)))))) + +(provide 'rails-model-layout) \ No newline at end of file diff --git a/emacs.d/rails/rails-model-minor-mode.el b/emacs.d/rails/rails-model-minor-mode.el new file mode 100644 index 0000000..002cb02 --- /dev/null +++ b/emacs.d/rails/rails-model-minor-mode.el @@ -0,0 +1,36 @@ +;;; rails-model-minor-mode.el --- minor mode for RubyOnRails models + +;; Copyright (C) 2006 Dmitry Galinsky + +;; Authors: Dmitry Galinsky + +;; Keywords: ruby rails languages oop +;; $URL: svn://rubyforge.org/var/svn/emacs-rails/trunk/rails-model-minor-mode.el $ +;; $Id: rails-model-minor-mode.el 158 2007-04-03 08:45:46Z dimaexe $ + +;;; License + +;; This program is free software; you can redistribute it and/or +;; modify it under the terms of the GNU General Public License +;; as published by the Free Software Foundation; either version 2 +;; of the License, or (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program; if not, write to the Free Software +;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. + +;;; Code: + +(define-minor-mode rails-model-minor-mode + "Minor mode for RubyOnRails models." + :lighter " Model" + :keymap (rails-model-layout:keymap :model) + (setq rails-primary-switch-func 'rails-model-layout:switch-to-unit-test) + (setq rails-secondary-switch-func 'rails-model-layout:menu)) + +(provide 'rails-model-minor-mode) \ No newline at end of file diff --git a/emacs.d/rails/rails-navigation.el b/emacs.d/rails/rails-navigation.el new file mode 100644 index 0000000..e33cf33 --- /dev/null +++ b/emacs.d/rails/rails-navigation.el @@ -0,0 +1,282 @@ +;;; rails-navigation.el --- emacs-rails navigation functions + +;; Copyright (C) 2006 Dmitry Galinsky + +;; Authors: Dmitry Galinsky , +;; Rezikov Peter + +;; Keywords: ruby rails languages oop +;; $URL: svn://rubyforge.org/var/svn/emacs-rails/trunk/rails-navigation.el $ +;; $Id: rails-navigation.el 150 2007-03-29 20:48:17Z dimaexe $ + +;;; License + +;; This program is free software; you can redistribute it and/or +;; modify it under the terms of the GNU General Public License +;; as published by the Free Software Foundation; either version 2 +;; of the License, or (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program; if not, write to the Free Software +;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. + +(defun rails-nav:create-goto-menu (items title &optional append-to-menu) + (when append-to-menu + (dolist (l append-to-menu items) + (add-to-list 'items l t))) + (let ((selected + (when items + (rails-core:menu + (list title (cons title items)))))) + (if selected selected (message "No files found")))) + +(defun rails-nav:goto-file-with-menu (dir title &optional ext no-inflector append-to-menu) + "Make a menu to choose files from and find-file it." + (let* (file + files + (ext (if ext ext "rb")) + (ext (concat "\\." ext "$")) + (dir (rails-core:file dir))) + (setq files (find-recursive-directory-relative-files dir "" ext)) + (setq files (sort files 'string<)) + (setq files (mapcar + #'(lambda(f) + (list + (if no-inflector f (rails-core:class-by-file f)) + f)) + files)) + (when-bind + (selected (rails-nav:create-goto-menu files title append-to-menu)) + (if (symbolp selected) + (apply selected (list)) + (rails-core:find-file-if-exist (concat dir selected)))))) + +(defun rails-nav:goto-file-with-menu-from-list (items title func &optional append-to-menu) + (when-bind + (selected (rails-nav:create-goto-menu (list->alist items) title append-to-menu)) + (when-bind + (file (apply func (list selected))) + (rails-core:find-file-if-exist file)))) + +(defun rails-nav:goto-controllers () + "Go to controllers." + (interactive) + (rails-nav:goto-file-with-menu-from-list + (rails-core:controllers t) + "Go to controller" + 'rails-core:controller-file)) + +(defun rails-nav:goto-models () + "Go to models." + (interactive) + (rails-nav:goto-file-with-menu-from-list + (rails-core:models) + "Go to model.." + 'rails-core:model-file)) + +(defun rails-nav:goto-functional-tests () + "Go to functional tests." + (interactive) + (rails-nav:goto-file-with-menu-from-list + (rails-core:functional-tests) + "Go to functional test." + 'rails-core:functional-test-file)) + +(defun rails-nav:goto-unit-tests () + "Go to functional tests." + (interactive) + (rails-nav:goto-file-with-menu-from-list + (rails-core:unit-tests) + "Go to unit test." + 'rails-core:unit-test-file)) + +(defun rails-nav:goto-observers () + "Go to observers." + (interactive) + (rails-nav:goto-file-with-menu-from-list + (rails-core:observers) + "Go to observer.." + 'rails-core:observer-file)) + +(defun rails-nav:goto-mailers () + "Go to mailers." + (interactive) + (rails-nav:goto-file-with-menu-from-list + (rails-core:mailers) + "Go to mailers.." + 'rails-core:mailer-file)) + +(defun rails-nav:goto-migrate () + "Go to migrations." + (interactive) + (rails-nav:goto-file-with-menu-from-list + (rails-core:migrations) + "Go to migrate.." + 'rails-core:migration-file)) + +(defun rails-nav:goto-helpers () + "Go to helpers." + (interactive) + (rails-nav:goto-file-with-menu-from-list + (rails-core:helpers) + "Go to helper.." + 'rails-core:helper-file)) + +(defun rails-nav:goto-plugins () + "Go to plugins." + (interactive) + (rails-nav:goto-file-with-menu-from-list + (rails-core:plugins) + "Go to plugin.." + (lambda (plugin) + (concat "vendor/plugins/" plugin "/init.rb")))) + +(defun rails-nav:create-new-layout (&optional name) + "Create a new layout." + (let ((name (or name (read-string "Layout name? ")))) + (when name + (rails-core:find-file (rails-core:layout-file name)) + (if (y-or-n-p "Insert initial template? ") + (insert rails-layout-template))))) + +(defun rails-nav:goto-layouts () + "Go to layouts." + (interactive) + (let ((items (list (cons "--" "--") + (cons "Create new layout" 'rails-nav:create-new-layout)))) + (rails-nav:goto-file-with-menu-from-list + (rails-core:layouts) + "Go to layout.." + (lambda (l) + (if (stringp l) + (rails-core:layout-file l) + (apply l (list)))) + items))) + +(defun rails-nav:goto-fixtures () + "Go to fixtures." + (interactive) + (rails-nav:goto-file-with-menu-from-list + (rails-core:fixtures) + "Go to fixture.." + 'rails-core:fixture-file)) + +(defun rails-nav:goto-stylesheets () + "Go to stylesheets." + (interactive) + (rails-nav:goto-file-with-menu "public/stylesheets/" "Go to stylesheet.." "css" t)) + +(defun rails-nav:goto-javascripts () + "Go to JavaScripts." + (interactive) + (rails-nav:goto-file-with-menu "public/javascripts/" "Go to stylesheet.." "js" t)) + +;;;;;;;;;; Goto file on current line ;;;;;;;;;; + +(defmacro* def-goto-line (name (&rest conditions) &rest body) + "Go to the file specified by the current line. Parses the +current line for a series of patterns." + (let ((line (gensym)) + (field (gensym)) + (prefix (gensym))) + `(progn + (defun ,name (,line ,prefix) + (block ,name + ,@(loop for (sexpr . map) in conditions + collect + `(when (string-match ,sexpr ,line) + (let ,(loop for var-acc in map collect + (if (listp var-acc) + `(,(first var-acc) (match-string ,(second var-acc) ,line)) + var-acc)) + (return-from ,name (progn ,@body)))))))))) + +(defun rails-goto-file-on-current-line (prefix) + "Analyze a string (or ERb block) and open some file related with it. +For example, on a line with \"render :partial\" runing this +function will open the partial file. The function works with +\"layout 'name'\", \"render/redirect-to [:action => 'name',] +[controller => 'n']\", stylesheet_link_tag and other common +patterns. + +Rules for actions/controllers: + If you are in a controller, the cursor will be placed on the controller action. + If you in view, the view file related to the action will be opened. + Use prefix before the command to change this navigation direction." + (interactive "P") + (rails-project:with-root + (root) + (save-match-data + (unless + (when-bind + (line (save-excursion + (if (rails-core:rhtml-buffer-p) + (rails-core:erb-block-string) + (current-line-string)))) + (loop for func in rails-on-current-line-gotos + until (when (funcall func line prefix) (return t)))) + (message "Can't switch to some file form this line."))))) + +(defvar rails-on-current-line-gotos + '(rails-line-->partial + rails-line-->action + rails-line-->controller+action + rails-line-->layout + rails-line-->stylesheet + rails-line-->js) + "Functions that will ne called to analyze the line when +rails-goto-file-on-current-line is run.") + +(def-goto-line rails-line-->stylesheet (("[ ]*stylesheet_link_tag[ ][\"']\\([^\"']*\\)[\"']" + (name 1))) + (rails-core:find-or-ask-to-create + (format "Stylesheet \"%s\" does not exist do you whant to create it? " name) + (rails-core:stylesheet-name name))) + +(def-goto-line rails-line-->partial (("\\([ ]*render\\|replace_html\\|insert_html\\).*:partial[ ]*=>[ ]*[\"']\\([^\"']*\\)[\"']" + (name 2))) + (rails-core:find-or-ask-to-create + (format "Partial \"%s\" does not exist do you whant to create it? " name) + (rails-core:partial-name name))) + +(def-goto-line rails-line-->action (("\\([ ]*render\\|replace_html\\|insert_html\\).*:action[ ]*=>[ ]*[\"'\:]\\([^\"']*\\)" + (name 2))) + (rails-core:find-or-ask-to-create + (format "View \"%s\" does not exist do you whant to create it? " name) + (rails-core:view-name name))) + +(def-goto-line rails-line-->layout (("^[ ]*layout[ ]*[\"']\\(.*\\)[\"']" (name 1))) + (let ((file-name (rails-core:layout-file name))) + (if (file-exists-p (rails-core:file file-name)) + (rails-core:find-file file-name) + (rails-nav:create-new-layout name)))) + +(def-goto-line rails-line-->js (("^[ ]*javascript_include_tag[ ]*[\"']\\(.*\\)[\"']" + (name 1))) + (rails-core:find-or-ask-to-create + (format "JavaScript file \"%s\" does not exist do you whant to create it? " name) + (rails-core:js-file name))) + +(defvar rails-line-to-controller/action-keywords + '("render" "redirect_to" "link_to" "form_tag" "start_form_tag" "render_component" + "form_remote_tag" "link_to_remote")) + +(defun rails-line-->controller+action (line prefix) + (when (loop for keyword in rails-line-to-controller/action-keywords + when (string-match (format "^[ ]*%s " keyword) line) do (return t)) + (let (action controller) + (when (string-match ":action[ ]*=>[ ]*[\"']\\([^\"']*\\)[\"']" line) + (setf action (match-string 1 line))) + (when (string-match ":controller[ ]*=>[ ]*[\"']\\([^\"']*\\)[\"']" line) + (setf controller (match-string 1 line))) + (rails-controller-layout:switch-to-action-in-controller + (if controller controller + (rails-core:current-controller)) + action)))) + +(provide 'rails-navigation) diff --git a/emacs.d/rails/rails-plugin-minor-mode.el b/emacs.d/rails/rails-plugin-minor-mode.el new file mode 100644 index 0000000..c9eaafa --- /dev/null +++ b/emacs.d/rails/rails-plugin-minor-mode.el @@ -0,0 +1,55 @@ +;;; rails-plugin-minor-mode.el --- minor mode for RubyOnRails plugins + +;; Copyright (C) 2006 Dmitry Galinsky + +;; Authors: Dmitry Galinsky + +;; Keywords: ruby rails languages oop +;; $URL: svn://rubyforge.org/var/svn/emacs-rails/trunk/rails-plugin-minor-mode.el $ +;; $Id: rails-plugin-minor-mode.el 112 2007-03-24 22:34:38Z dimaexe $ + +;;; License + +;; This program is free software; you can redistribute it and/or +;; modify it under the terms of the GNU General Public License +;; as published by the Free Software Foundation; either version 2 +;; of the License, or (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program; if not, write to the Free Software +;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. + +;;; Code: + +(defun rails-plugin-minor-mode:switch-to-init () + (interactive) + (rails-core:find-file-if-exist + (rails-core:plugin-file (rails-core:current-plugin) "init.rb"))) + +(defun rails-plugin-minor-mode:switch-with-menu () + (interactive) + (let* ((item) + (plugin (rails-core:current-plugin)) + (menu (rails-core:plugin-files plugin))) + (setq item + (rails-core:menu + (list (concat "Plugin " plugin) + (cons "Please select.." (list->alist menu))))) + (when item + (rails-core:find-file-if-exist + (rails-core:plugin-file plugin item))))) + +(define-minor-mode rails-plugin-minor-mode + "Minor mode for RubyOnRails plugins." + nil + " plugin" + nil + (setq rails-primary-switch-func 'rails-plugin-minor-mode:switch-to-init) + (setq rails-secondary-switch-func 'rails-plugin-minor-mode:switch-with-menu)) + +(provide 'rails-plugin-minor-mode) \ No newline at end of file diff --git a/emacs.d/rails/rails-project.el b/emacs.d/rails/rails-project.el new file mode 100644 index 0000000..1015b36 --- /dev/null +++ b/emacs.d/rails/rails-project.el @@ -0,0 +1,73 @@ +;;; rails-project.el --- + +;; Copyright (C) 2006 Dmitry Galinsky + +;; Authors: Dmitry Galinsky , + +;; Keywords: ruby rails languages oop +;; $URL: svn+ssh://rubyforge/var/svn/emacs-rails/trunk/rails.el $ +;; $Id: rails.el 149 2007-03-29 15:07:49Z dimaexe $ + +;;; License + +;; This program is free software; you can redistribute it and/or +;; modify it under the terms of the GNU General Public License +;; as published by the Free Software Foundation; either version 2 +;; of the License, or (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program; if not, write to the Free Software +;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. + +;;; Code: + +(defun rails-project:root () + "Return RAILS_ROOT if this file is a part of a Rails application, +else return nil" + (let ((curdir default-directory) + (max 10) + (found nil)) + (while (and (not found) (> max 0)) + (progn + (if (file-exists-p (concat curdir "config/environment.rb")) + (progn + (setq found t)) + (progn + (setq curdir (concat curdir "../")) + (setq max (- max 1)))))) + (if found (expand-file-name curdir)))) + +(defmacro* rails-project:with-root ((root) &body body) + "If you use `rails-project:root' or functions related on it +several times in a block of code, you can optimize your code by +using this macro. Also, blocks of code will be executed only if +rails-root exist. + (rails-project:with-root (root) + (foo root) + (bar (rails-core:file \"some/path\"))) + " + `(let ((,root (rails-project:root))) + (when ,root + (flet ((rails-project:root () ,root)) + ,@body)))) + +(defmacro rails-project:in-root (&rest body) + "Set the default directory to the Rails root directory while +BODY is executed." + (let ((root (gensym))) + `(rails-project:with-root + (,root) + (let ((default-dir ,root)) + ,@body)))) + +(defun rails-project:name () + "Return the name of current Rails project." + (replace-regexp-in-string "^.*/\\(.*\\)/$" "\\1" + (directory-name (rails-project:root)))) + +(provide 'rails-project) \ No newline at end of file diff --git a/emacs.d/rails/rails-rake.el b/emacs.d/rails/rails-rake.el new file mode 100644 index 0000000..555ba71 --- /dev/null +++ b/emacs.d/rails/rails-rake.el @@ -0,0 +1,97 @@ +;;; rails-rake.el --- emacs-rails integraions with rake tasks. + +;; Copyright (C) 2006 Dmitry Galinsky + +;; Authors: Dmitry Galinsky , + +;; Keywords: ruby rails languages oop +;; $URL: svn+ssh://rubyforge/var/svn/emacs-rails/trunk/rails-scripts.el $ +;; $Id: rails-scripts.el 117 2007-03-25 23:37:37Z dimaexe $ + +;;; License + +;; This program is free software; you can redistribute it and/or +;; modify it under the terms of the GNU General Public License +;; as published by the Free Software Foundation; either version 2 +;; of the License, or (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program; if not, write to the Free Software +;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. + +(eval-when-compile + (require 'rails-scripts)) + +(defvar rails-rake:history (list)) + +(defvar rails-rake:tasks-regexp "^rake \\([^ ]*\\).*# \\(.*\\)" + "Regexp to match tasks list in `rake --tasks` output.") + +(defun rails-rake:create-tasks-cache (file-name) + "Create a cache file from rake --tasks output." + (let ((tasks (loop for str in (split-string (rails-cmd-proxy:shell-command-to-string "rake --tasks") "\n") + for task = (when (string-not-empty str) + (string=~ rails-rake:tasks-regexp str $1)) + when task collect task))) + (write-string-to-file file-name (prin1-to-string tasks)) + tasks)) + +(defun rails-rake:list-of-tasks () + "Return all available tasks and create tasks cache file." + (rails-project:in-root + (let* ((cache-file (rails-core:file "tmp/.tasks-cache"))) + (if (file-exists-p cache-file) + (read-from-file cache-file) + (rails-rake:create-tasks-cache cache-file))))) + +(defun rails-rake:list-of-tasks-without-tests () + "Return available tasks without test actions." + (when-bind + (tasks (rails-rake:list-of-tasks)) + (sort (delete* nil + (mapcar + #'(lambda (it) (if (string=~ "^test\\($\\|:\\)" it t) nil it)) + (rails-rake:list-of-tasks)) + :if 'null) + 'string<))) + +(defun rails-rake:task (task &optional major-mode) + "Run a Rake task in RAILS_ROOT with MAJOR-MODE." + (interactive (rails-completing-read "What task run" (rails-rake:list-of-tasks-without-tests) + 'rails-rake:history nil)) + (when task + (rails-script:run "rake" (list task) major-mode))) + +(defun rails-rake:migrate (&optional version) + "Run the db:migrate task" + (interactive) + (rails-rake:task + (concat + "db:migrate" + (typecase version + (integer (format " VERSION=%.3i" version)) + (string (format " VERSION=%s" version)))))) + +(defun rails-rake:migrate-to-version (version) + "Run migrate with VERSION." + (interactive (rails-completing-read "Version of migration" + (rails-core:migration-versions t) + nil + t)) + (when version + (rails-rake:migrate version))) + +(defun rails-rake:migrate-to-prev-version () + "Migrate to a previous version." + (interactive) + (let ((versions (rails-core:migration-versions t))) + (rails-rake:migrate + (when (< 2 (length versions)) + (nth 1 versions))))) + +(provide 'rails-rake) diff --git a/emacs.d/rails/rails-ruby.el b/emacs.d/rails/rails-ruby.el new file mode 100644 index 0000000..c21c6be --- /dev/null +++ b/emacs.d/rails/rails-ruby.el @@ -0,0 +1,163 @@ +;;; rails-ruby.el --- provide features for ruby-mode + +;; Copyright (C) 2006 Dmitry Galinsky + +;; Authors: Dmitry Galinsky + +;; Keywords: ruby rails languages oop +;; $URL: svn://rubyforge.org/var/svn/emacs-rails/trunk/rails-ruby.el $ +;; $Id: rails-ruby.el 190 2007-04-27 19:04:46Z dimaexe $ + +;;; License + +;; This program is free software; you can redistribute it and/or +;; modify it under the terms of the GNU General Public License +;; as published by the Free Software Foundation; either version 2 +;; of the License, or (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program; if not, write to the Free Software +;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. + +;;; Code: + +(require 'inf-ruby) + +;; setup align for ruby-mode +(require 'align) + +(defconst align-ruby-modes '(ruby-mode) + "align-perl-modes is a variable defined in `align.el'.") + +(defconst ruby-align-rules-list + '((ruby-comma-delimiter + (regexp . ",\\(\\s-*\\)[^/ \t\n]") + (modes . align-ruby-modes) + (repeat . t)) + (ruby-symbol-after-func + (regexp . "^\\s-*\\w+\\(\\s-+\\):\\w+") + (modes . align-ruby-modes))) + "Alignment rules specific to the ruby mode. +See the variable `align-rules-list' for more details.") + +(add-to-list 'align-perl-modes 'ruby-mode) +(add-to-list 'align-dq-string-modes 'ruby-mode) +(add-to-list 'align-sq-string-modes 'ruby-mode) +(add-to-list 'align-open-comment-modes 'ruby-mode) +(dolist (it ruby-align-rules-list) + (add-to-list 'align-rules-list it)) + +;; other stuff + +(defun ruby-newline-and-indent () + (interactive) + (newline) + (ruby-indent-command)) + +(defun ruby-toggle-string<>simbol () + "Easy to switch between strings and symbols." + (interactive) + (let ((initial-pos (point))) + (save-excursion + (when (looking-at "[\"']") ;; skip beggining quote + (goto-char (+ (point) 1)) + (unless (looking-at "\\w") + (goto-char (- (point) 1)))) + (let* ((point (point)) + (start (skip-syntax-backward "w")) + (end (skip-syntax-forward "w")) + (end (+ point start end)) + (start (+ point start)) + (start-quote (- start 1)) + (end-quote (+ end 1)) + (quoted-str (buffer-substring-no-properties start-quote end-quote)) + (symbol-str (buffer-substring-no-properties start end))) + (cond + ((or (string-match "^\"\\w+\"$" quoted-str) + (string-match "^\'\\w+\'$" quoted-str)) + (setq quoted-str (substring quoted-str 1 (- (length quoted-str) 1))) + (kill-region start-quote end-quote) + (goto-char start-quote) + (insert (concat ":" quoted-str))) + ((string-match "^\:\\w+$" symbol-str) + (setq symbol-str (substring symbol-str 1)) + (kill-region start end) + (goto-char start) + (insert (format "'%s'" symbol-str)))))) + (goto-char initial-pos))) + +(defun run-ruby-in-buffer (cmd buf) + "Run CMD as a ruby process in BUF if BUF does not exist." + (let ((abuf (concat "*" buf "*"))) + (when (not (comint-check-proc abuf)) + (set-buffer (make-comint buf rails-ruby-command nil cmd))) + (inferior-ruby-mode) + (make-local-variable 'inferior-ruby-first-prompt-pattern) + (make-local-variable 'inferior-ruby-prompt-pattern) + (setq inferior-ruby-first-prompt-pattern "^>> " + inferior-ruby-prompt-pattern "^>> ") + (pop-to-buffer abuf))) + +(defun complete-ruby-method (prefix &optional maxnum) + (if (capital-word-p prefix) + (let* ((cmd "x = []; ObjectSpace.each_object(Class){|i| x << i.to_s}; x.map{|i| i.match(/^%s/) ? i.gsub(/^%s/, '') : nil }.compact.sort{|x,y| x.size <=> y.size}") + (cmd (if maxnum (concat cmd (format "[0...%s]" maxnum)) cmd))) + (el4r-ruby-eval (format cmd prefix prefix))) + (save-excursion + (goto-char (- (point) (+ 1 (length prefix)))) + (when (and (looking-at "\\.") + (capital-word-p (word-at-point)) + (el4r-ruby-eval (format "::%s rescue nil" (word-at-point)))) + (let* ((cmd "%s.public_methods.map{|i| i.match(/^%s/) ? i.gsub(/^%s/, '') : nil }.compact.sort{|x,y| x.size <=> y.size}") + (cmd (if maxnum (concat cmd (format "[0...%s]" maxnum)) cmd))) + (el4r-ruby-eval (format cmd (word-at-point) prefix prefix))))))) + +;; flymake ruby support + +(require 'flymake nil t) + +(defconst flymake-allowed-ruby-file-name-masks + '(("\\.rb\\'" flymake-ruby-init) + ("\\.rxml\\'" flymake-ruby-init) + ("\\.builder\\'" flymake-ruby-init) + ("\\.rjs\\'" flymake-ruby-init)) + "Filename extensions that switch on flymake-ruby mode syntax checks.") + +(defconst flymake-ruby-error-line-pattern-regexp + '("^\\([^:]+\\):\\([0-9]+\\): *\\([\n]+\\)" 1 2 nil 3) + "Regexp matching ruby error messages.") + +(defun flymake-ruby-init () + (condition-case er + (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 rails-ruby-command (list "-c" local-file))) + ('error ()))) + +(defun flymake-ruby-load () + (when (and (buffer-file-name) + (string-match + (format "\\(%s\\)" + (string-join + "\\|" + (mapcar 'car flymake-allowed-ruby-file-name-masks))) + (buffer-file-name))) + (setq flymake-allowed-file-name-masks + (append flymake-allowed-file-name-masks flymake-allowed-ruby-file-name-masks)) + (setq flymake-err-line-patterns + (cons flymake-ruby-error-line-pattern-regexp flymake-err-line-patterns)) + (flymake-mode t) + (local-set-key (rails-key "d") 'flymake-display-err-menu-for-current-line))) + +(when (featurep 'flymake) + (add-hook 'ruby-mode-hook 'flymake-ruby-load)) + +(provide 'rails-ruby) \ No newline at end of file diff --git a/emacs.d/rails/rails-scripts.el b/emacs.d/rails/rails-scripts.el new file mode 100644 index 0000000..50efe12 --- /dev/null +++ b/emacs.d/rails/rails-scripts.el @@ -0,0 +1,324 @@ +;;; rails-scripts.el --- emacs-rails integraions with rails script/* scripts + +;; Copyright (C) 2006 Dmitry Galinsky + +;; Authors: Dmitry Galinsky , +;; Rezikov Peter + +;; Keywords: ruby rails languages oop +;; $URL: svn://rubyforge.org/var/svn/emacs-rails/trunk/rails-scripts.el $ +;; $Id: rails-scripts.el 192 2007-05-03 11:54:30Z dimaexe $ + +;;; License + +;; This program is free software; you can redistribute it and/or +;; modify it under the terms of the GNU General Public License +;; as published by the Free Software Foundation; either version 2 +;; of the License, or (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program; if not, write to the Free Software +;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. + +(eval-when-compile + (require 'inf-ruby) + (require 'ruby-mode)) + +(defvar rails-script:generators-list + '("controller" "model" "scaffold" "migration" "plugin" "mailer" "observer" "resource")) + +(defvar rails-script:destroy-list rails-script:generators-list) + +(defvar rails-script:generate-params-list + '("-f") + "Add parameters to script/generate. +For example -s to keep existing files and -c to add new files into svn.") + +(defvar rails-script:destroy-params-list + '("-f") + "Add parameters to script/destroy. +For example -c to remove files from svn.") + +(defvar rails-script:buffer-name "*ROutput*") + +(defvar rails-script:running-script-name nil + "Curently running the script name") + +(defvar rails-script:history (list)) +(defvar rails-script:history-of-generate (list)) +(defvar rails-script:history-of-destroy (list)) + +;; output-mode + +(defconst rails-script:font-lock-ketwords + (list + '("^\\(\(in [^\)]+\)\\)$" 1 font-lock-builtin-face) + '(" \\(rm\\|rmdir\\) " 1 font-lock-warning-face) + '(" \\(missing\\|notempty\\|exists\\) " 1 font-lock-warning-face) + '(" \\(create\\|dependency\\) " 1 font-lock-function-name-face))) + +(defconst rails-script:button-regexp + " \\(create\\) + \\([^ ]+\\.\\w+\\)") + +(defvar rails-script:output-mode-ret-value nil) +(defvar rails-script:run-after-stop-hook nil) +(defvar rails-script:show-buffer-hook nil) + +(defun rails-script:make-buttons (start end len) + (save-excursion + (let ((buffer-read-only nil)) + (goto-char start) + (while (re-search-forward rails-script:button-regexp end t) + (make-button (match-beginning 2) (match-end 2) + :type 'rails-button + :rails:file-name (match-string 2)))))) + +(defun rails-script:popup-buffer (&optional do-not-scroll-to-top) + "Popup output buffer." + (unless (buffer-visible-p rails-script:buffer-name) + (display-buffer rails-script:buffer-name t)) + (let ((win (get-buffer-window-list rails-script:buffer-name))) + (when win + (unless do-not-scroll-to-top + (mapcar #'(lambda(w) (set-window-point w 0)) win)) + (shrink-window-if-larger-than-buffer + (get-buffer-window rails-script:buffer-name)) + (run-hooks 'rails-script:show-buffer-hook)))) + +(defun rails-script:push-first-button () + (let (file-name) + (with-current-buffer (get-buffer rails-script:buffer-name) + (let ((button (next-button 1))) + (when button + (setq file-name (button-get button :rails:file-name))))) + (when file-name + (rails-core:find-file-if-exist file-name)))) + +(defun rails-script:toggle-output-window () + (interactive) + (let ((current (current-buffer)) + (buf (get-buffer rails-script:buffer-name))) + (if buf + (if (buffer-visible-p rails-script:buffer-name) + (delete-windows-on buf) + (progn + (pop-to-buffer rails-script:buffer-name t t) + (pop-to-buffer current t t) + (shrink-window-if-larger-than-buffer + (get-buffer-window rails-script:buffer-name)) + (run-hooks 'rails-script:show-buffer-hook))) + (message "No output window found. Try running a script or a rake task before.")))) + +(defun rails-script:setup-output-buffer () + "Setup default variables and values for the output buffer." + (set (make-local-variable 'font-lock-keywords-only) t) + (make-local-variable 'font-lock-defaults) + (set (make-local-variable 'scroll-margin) 0) + (set (make-local-variable 'scroll-preserve-screen-position) nil) + (make-local-hook 'rails-script:run-after-stop-hook) + (make-local-hook 'rails-script:show-buffer-hook) + (make-local-variable 'after-change-functions) + (rails-minor-mode t)) + +(define-derived-mode rails-script:output-mode fundamental-mode "ROutput" + "Major mode to Rails Script Output." + (rails-script:setup-output-buffer) + (setq font-lock-defaults '((rails-script:font-lock-ketwords) nil t)) + (buffer-disable-undo) + (setq buffer-read-only t) + (rails-script:make-buttons (point-min) (point-max) (point-max)) + (add-hook 'rails-script:run-after-stop-hook 'rails-script:popup-buffer t t) + (add-hook 'rails-script:run-after-stop-hook 'rails-script:push-first-button t t) + (add-hook 'after-change-functions 'rails-script:make-buttons nil t) + (run-hooks 'rails-script:output-mode-hook)) + +(defun rails-script:running-p () + (get-buffer-process rails-script:buffer-name)) + +(defun rails-script:sentinel-proc (proc msg) + (let* ((name rails-script:running-script-name) + (ret-val (process-exit-status proc)) + (buf (get-buffer rails-script:buffer-name)) + (ret-message (if (zerop ret-val) "successful" "failure"))) + (with-current-buffer buf + (set (make-local-variable 'rails-script:output-mode-ret-value) ret-val)) + (when (memq (process-status proc) '(exit signal)) + (setq rails-script:running-script-name nil + msg (format "%s was stopped (%s)." name ret-message))) + (message (replace-regexp-in-string "\n" "" msg)) + (with-current-buffer buf + (run-hooks 'rails-script:run-after-stop-hook)))) + +(defun rails-script:run (command parameters &optional buffer-major-mode) + "Run a Rails script COMMAND with PARAMETERS with +BUFFER-MAJOR-MODE and process-sentinel SENTINEL." + (unless (listp parameters) + (error "rails-script:run PARAMETERS must be the list")) + (rails-project:with-root + (root) + (save-some-buffers) + (let ((proc (rails-script:running-p))) + (if proc + (message "Only one instance rails-script allowed") + (let* ((default-directory root) + (proc (rails-cmd-proxy:start-process rails-script:buffer-name + rails-script:buffer-name + command + (strings-join " " parameters)))) + (with-current-buffer (get-buffer rails-script:buffer-name) + (let ((buffer-read-only nil) + (win (get-buffer-window-list rails-script:buffer-name))) + (kill-region (point-min) (point-max))) + (if buffer-major-mode + (apply buffer-major-mode (list)) + (rails-script:output-mode)) + (add-hook 'after-change-functions 'rails-cmd-proxy:convert-buffer-from-remote nil t)) + (set-process-coding-system proc 'utf-8-dos 'utf-8-dos) + (set-process-sentinel proc 'rails-script:sentinel-proc) + (setq rails-script:running-script-name + (if (= 1 (length parameters)) + (format "%s %s" command (first parameters)) + (format "%s %s" (first parameters) (first (cdr parameters))))) + (message "Starting %s." rails-script:running-script-name)))))) + +;;;;;;;;;; Destroy stuff ;;;;;;;;;; + +(defun rails-script:run-destroy (what &rest parameters) + "Run the destroy script using WHAT and PARAMETERS." + (rails-script:run rails-ruby-command + (append (list (format "script/destroy %s" what)) + parameters + rails-script:destroy-params-list))) + +(defun rails-script:destroy (what) + "Run destroy WHAT" + (interactive (rails-completing-read "What destroy" rails-script:destroy-list + 'rails-script:history-of-destroy nil)) + (let ((name (intern (concat "rails-script:destroy-" + (replace-regexp-in-string "_" "-" what))))) + (when (fboundp name) + (call-interactively name)))) + +(defmacro rails-script:gen-destroy-function (name &optional completion completion-arg) + (let ((func (intern (format "rails-script:destroy-%s" name))) + (param (intern (concat name "-name")))) + `(defun ,func (&optional ,param) + (interactive + (list (completing-read ,(concat "Destroy " + (replace-regexp-in-string "[^a-z0-9]" " " name) + ": ") + ,(if completion + `(list->alist + ,(if completion-arg + `(,completion ,completion-arg) + `(,completion))) + nil)))) + (when (string-not-empty ,param) + (rails-script:run-destroy ,(replace-regexp-in-string "-" "_" name) ,param))))) + +(rails-script:gen-destroy-function "controller" rails-core:controllers t) +(rails-script:gen-destroy-function "model" rails-core:models) +(rails-script:gen-destroy-function "scaffold") +(rails-script:gen-destroy-function "migration" rails-core:migrations t) +(rails-script:gen-destroy-function "mailer" rails-core:mailers) +(rails-script:gen-destroy-function "plugin" rails-core:plugins) +(rails-script:gen-destroy-function "observer" rails-core:observers) +(rails-script:gen-destroy-function "resource") + +;;;;;;;;;; Generators stuff ;;;;;;;;;; + +(defun rails-script:run-generate (what &rest parameters) + "Run the generate script using WHAT and PARAMETERS." + (rails-script:run rails-ruby-command + (append (list (format "script/generate %s" what)) + parameters + rails-script:generate-params-list))) + +(defun rails-script:generate (what) + "Run generate WHAT" + (interactive (rails-completing-read "What generate" rails-script:generators-list + 'rails-script:history-of-generate nil)) + (let ((name (intern (concat "rails-script:generate-" + (replace-regexp-in-string "_" "-" what))))) + (when (fboundp name) + (call-interactively name)))) + +(defmacro rails-script:gen-generate-function (name &optional completion completion-arg) + (let ((func (intern (format "rails-script:generate-%s" name))) + (param (intern (concat name "-name")))) + `(defun ,func (&optional ,param) + (interactive + (list (completing-read ,(concat "Generate " + (replace-regexp-in-string "[^a-z0-9]" " " name) + ": ") + ,(if completion + `(list->alist + ,(if completion-arg + `(,completion ,completion-arg) + `(,completion))) + nil)))) + (when (string-not-empty ,param) + (rails-script:run-generate ,(replace-regexp-in-string "-" "_" name) ,param))))) + +(defun rails-script:generate-controller (&optional controller-name actions) + "Generate a controller and open the controller file." + (interactive (list + (completing-read "Controller name (use autocomplete) : " + (list->alist (rails-core:controllers-ancestors))) + (read-string "Actions (or return to skip): "))) + (when (string-not-empty controller-name) + (rails-script:run-generate "controller" controller-name actions))) + +(defun rails-script:generate-scaffold (&optional model-name controller-name actions) + "Generate a scaffold and open the controller file." + (interactive + "MModel name: \nMController (or return to skip): \nMActions (or return to skip): ") + (when (string-not-empty model-name) + (if (string-not-empty controller-name) + (rails-script:run-generate "scaffold" model-name controller-name actions) + (rails-script:run-generate "scaffold" model-name)))) + +(rails-script:gen-generate-function "model" rails-core:models-ancestors) +(rails-script:gen-generate-function "migration") +(rails-script:gen-generate-function "plugin") +(rails-script:gen-generate-function "mailer") +(rails-script:gen-generate-function "observer") +(rails-script:gen-generate-function "resource") + +;;;;;;;;;; Rails create project ;;;;;;;;;; + +(defun rails-script:create-project (dir) + "Create a new project in a directory named DIR." + (interactive "FNew Rails project directory: ") + (make-directory dir t) + (let ((default-directory (concat (expand-file-name dir) "/"))) + (flet ((rails-project:root () default-directory)) + (rails-script:run "rails" (list "--skip" (rails-project:root)))))) + +;;;;;;;;;; Shells ;;;;;;;;;; + +(defun rails-script:run-interactive (name script) + "Run an interactive shell with SCRIPT in a buffer named +*rails--*." + (rails-project:with-root + (root) + (run-ruby-in-buffer (rails-core:file script) + (format "rails-%s-%s" (rails-project:name) name)) + (rails-minor-mode t))) + +(defun rails-script:console () + "Run script/console." + (interactive) + (rails-script:run-interactive "console" "script/console")) + +(defun rails-script:breakpointer () + "Run script/breakpointer." + (interactive) + (rails-script:run-interactive "breakpointer" "script/breakpointer")) + +(provide 'rails-scripts) \ No newline at end of file diff --git a/emacs.d/rails/rails-snippets-feature.el b/emacs.d/rails/rails-snippets-feature.el new file mode 100644 index 0000000..1a807c5 --- /dev/null +++ b/emacs.d/rails/rails-snippets-feature.el @@ -0,0 +1,459 @@ +;;; rails-snippets-feature.el --- snippets for rails related modes + +;; Copyright (C) 2006 Dmitry Galinsky + +;; Authors: Dmitry Galinsky , + +;; Keywords: ruby rails languages oop +;; $URL: svn+ssh://rubyforge/var/svn/emacs-rails/trunk/rails-snippets.el $ +;; $Id: rails-snippets.el 155 2007-04-01 17:37:48Z dimaexe $ + +;;; License + +;; This program is free software; you can redistribute it and/or +;; modify it under the terms of the GNU General Public License +;; as published by the Free Software Foundation; either version 2 +;; of the License, or (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program; if not, write to the Free Software +;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. + +(require 'snippet) + +(defconst rails-snippets-feature:list + '((0 "ruby") + (1 "loops" ruby-mode-abbrev-table + ("while" "while $${condition}\n$>$.\nend$>" "while ... end") + ("when" "when $${condition}\n$>$." "when ...") + ("w" "attr_writer :$${attr_names}" "attr_writer ...") + ("upt" "upto($${0}) { |$${n}|$. }" "upto(1.0/0.0) { |n| ... }") + ("until" "until $${condition}\n$>$.\nend$>" "until ... end") + ("tim" "times { |$${n}|$. }" "times { |n| ... }") + ("ste" "step($${2}) { |$${n}|$. }" "step(2) { |e| ... }") + ("forin" "for $${element} in $${collection}\n$>$${element}.$.\nend$>" "for ... in ... end") + ("dow" "downto($${0}) { |$${n}|$. }" "downto(0) { |n| ... }")) ; loops + (1 "general" ruby-mode-abbrev-table + ("ha" "{ $>:$. }" "{ :key => 'value' }") + (":" ":$${key} => '$${value}'" ":key => 'value'") + ("yl" "File.open($${yaml}) { |$${file}| YAML.load($${file}) }" "YAML.load(file)") + ("yd" "File.open($${yaml}, \"w\") { |$${file}| YAML.dump($${obj}, $${file}) }" "YAML.dump(..., file)") + ("y" " :yields: $${arguments}" ":yields:") + ("verren" "verify :only => [:$${1}], :method => :post, :render => {:status => 500, :text => \"use HTTP-POST\"}\n" "verify -- render") + ("verred" "verify :only => [:$${1}], :session => :user, :params => :id, :redirect_to => {:action => '$${index}'}\n" "verify -- redirect") + ("tra" "transaction$${1} { $. }" "transaction( ... ) { ... }") + ("sub" "sub(/$${pattern}/) { |$${match}|$. }" "sub(/.../) { |match| ... }") + ("sca" "scan(/$${pattern}/) { |$${match}| $. }" "scan(/.../) { |match| ... }") + ("rep" "results.report(\"$${name}:\") { TESTS.times { $. } }" "results.report(...) { ... }") + ("rb" "#!/usr/bin/env ruby -w\n\n" "#!/usr/local/bin/ruby -w") + ("r" "attr_reader :$${attr_names}" "attr_reader ...") + ("pn" "PStore.new($${file_name})" "PStore.new( ... )") + ("patfh" "File.join(File.dirname(__FILE__), *%w[$${here}])" "path_from_here( ... )") + ("ope" "open($${pipe}) { |$${io}| $. }" "open(\"path/or/url\", \"w\") { |io| ... }") + ("ml" "File.open($${dump}) { |$${file}| Marshal.load($${file}) }" "Marshal.load(obj)") + ("min" "min { |a, b| $. }" "min { |a, b| ... }") + ("max" "max { |a, b| $. }" "max { |a, b| ... }") + ("md" "File.open($${dump}, \"w\") { |$${file}| Marshal.dump($${obj}, $${file}) }" "Marshal.dump(..., file)") + ("lam" "lambda { |$${args}|$. }" "lambda { |args| ... }") + ("gsu" "gsub(/$${pattern}/) { |$${match}|$. }" "gsub(/.../) { |match| ... }") + ("gre" "grep($${pattern}) { |$${match}| $. }" "grep(/pattern/) { |match| ... }") + ("fl" "flunk('$${message}')" "flunk(...)") + ("file" "File.foreach($${file}) { |$${line}| $. }" "File.foreach (\"...\") { |line| ... }") + ("dir" "Dir.glob($${glob}) { |$${file}| $. }" "Dir.glob(\"...\") { |file| ... }") + ("b" "=begin rdoc\n$>$.\n=end" "New Block") + ("begin" "begin\n$>$${paste}\nrescue $${Exception} => $${e}\n$>$.\nend$>\n" "begin ... rescue ... end") + ("bm" "TESTS = $${10_000}\nBenchmark.bmbm($${10}) do |results|\n $.\nend$>" "Benchmark.bmbm(...) do ... end") + ("am" "alias_method :$${new_name}, :$${old_name}" "alias_method ...") + ("amc" "alias_method_chain :$${first_method}, :$${second_method}" "alias_method_chain ...")) ; general + (1 "definitions" ruby-mode-abbrev-table + ("ts" "require \"test/unit\"\n\nrequire \"tc_$${test_case_file}\"\nrequire \"tc_$${test_case_file}\"\n" "require \"tc_...\" ...") + ("tc" "require \"test/unit\"\n\nrequire \"$${library_file_name}\"\n\nclass Test$${amp} < Test::Unit::TestCase\n$>def test_$${case_name}\n$>$>$.\nend$>\nend$>" "class ... < Test::Unit::TestCase ... end") + ("sin" "class << self; self end" "singleton_class()") + ("rw" "attr_accessor :$${attr_names}" "attr_accessor ...") + ("req" "require \"$.\"" "require \"...\"") + ("modf" "module $${ModuleName}\n$>module ClassMethods\n$>$>$.\nend$>\n$>\n$>extend ClassMethods\n$>\n$>def self.included(receiver)\n$>$>receiver.extend(ClassMethods)\nend$>\n$>\n$>\nend$>" "module ... ClassMethods ... end") + ("mods" "module $${ModuleName}\n$>$.\nend$>" "module ... end") + ("modu" "module $${ModuleName}\n$>module_function\n$>\n$>$.\nend$>" "module ... module_function ... end") + ("mm" "def method_missing(meth, *args, &block)\n$>$.\nend$>" "def method_missing ... end") + ("hash" "Hash.new { |$${hash}, $${key}| $${hash}[$${key}] = $. }" "Hash.new { |hash, key| hash[key] = ... }") + ("forw" "extend Forwardable" "extend Forwardable") + ("enum" "include Enumerable\n\ndef each(&block)\n$>$.\nend$>" "include Enumerable ...") + ("elsif" "elsif $${condition}\n$>$." "elsif ...") + ("doo" "do |$${object}|\n$>$.\nend$>" "Insert do |object| ... end") + ("do" "do\n$>$.\nend$>" "do ... end") + ("defd" "def_delegator :$${del_obj}, :$${del_meth}, :$${new_name}" "def_delegator ...") + ("defds" "def_delegators :$${del_obj}, :$${del_methods}" "def_delegators ...") + ("defs" "def self.$${class_method_name}\n$>$.\nend$>" "def self ... end") + ("deft" "def test_$${case_name}\n$>$.\nend$>" "def test_ ... end") + ("dee" "Marshal.load(Marshal.dump($${obj_to_copy}))" "deep_copy(...)") + ("comp" "include Comparable\n\ndef <=>(other)\n$>$.\nend$>" "include Comparable ...") + ("cladl" "class $${ClassName} < DelegateClass($${ParentClass})\n$>def initialize$${1}\n$>$>super($${del_obj})\n$>$>\n$>$>$.\nend$>\n$>\n$>\nend$>" "class ... < DelegateClass ... initialize ... end") + ("clapr" "class $${ClassName} < $${ParentClass}\n$>def initialize$${1}\n$>$>$.\nend$>\n$>\n$>\nend$>" "class ... < ParentClass ... initialize ... end") + ("clast" "class $${ClassName} < Struct.new(:$${attr_names})\n$>def initialize(*args)\n$>$>super\n$>$>\n$>$>$.\nend$>\n$>\n$>\nend$>" "class ... < Struct ... initialize ... end") + ("class" "class $${ClassName}\n$>$.\nend$>" "class ... end") + ("classi" "class $${ClassName}\n$>def initialize$${1}\n$>$>$.\nend$>\n$>\n$>\nend$>" "class ... initialize ... end") + ("clasf" "class << $${self}\n$>$.\nend$>" "class << self ... end")) ; definitions + (1 "collections" ruby-mode-abbrev-table + ("zip" "zip($${enums}) { |$${row}| $. }" "zip(enums) { |row| ... }") + ("sorb" "sort_by { |$${e}| $. }" "sort_by { |e| ... }") + ("sor" "sort { |a, b| $. }" "sort { |a, b| ... }") + ("select" "select { |$${element}| $${element}.$${2} }$." "select element") + ("sel" "select { |$${e}| $. }" "select { |e| ... }") + ("reve" "reverse_each { |$${e}| $. }" "reverse_each { |e| ... }") + ("reject" "reject { |$${element}| $${element}.$. }" "reject element") + ("rej" "reject { |$${e}| $. }" "reject { |e| ... }") + ("ran" "sort_by { rand }" "randomize()") + ("mapwi" "enum_with_index.map { |$${e}, $${i}| $. }" "map_with_index { |e, i| ... }") + ("map" "map { |$${e}| $. }" "map { |e| ... }") + ("inject" "inject($${object}) { |$${injection}, $${element}| $${4} }$." "inject object") + ("inj" "inject($${init}) { |$${mem}, $${var}| $. }" "inject(init) { |mem, var| ... }") + ("flao" "inject(Array.new) { |$${arr}, $${a}| $${arr}.push(*$${a}) }" "flatten_once()") + ("fina" "find_all { |$${e}| $. }" "find_all { |e| ... }") + ("fin" "find { |$${e}| $. }" "find { |e| ... }") + ("fil" "fill($${range}) { |$${i}|$. }" "fill(range) { |i| ... }") + ("fet" "fetch($${name}) { |$${key}|$. }" "fetch(name) { |key| ... }") + ("eawi" "each_with_index { |$${e}, $${i}| $. }" "each_with_index { |e, i| ... }") + ("eai" "each_index { |$${i}| $. }" "each_index { |i| ... }") + ("eak" "each_key { |$${key}| $. }" "each_key { |key| ... }") + ("eal" "each_line$${1} { |$${line}| $. }" "each_line { |line| ... }") + ("eap" "each_pair { |$${name}, $${val}| $. }" "each_pair { |name, val| ... }") + ("eas" "each_slice($${2}) { |$${group}| $. }" "each_slice(...) { |group| ... }") + ("eav" "each_value { |$${val}| $. }" "each_value { |val| ... }") + ("each" "each { |$${element}| $${element}.$. }" "each element") + ("eac" "each_cons($${2}) { |$${group}| $. }" "each_cons(...) { |group| ... }") + ("eab" "each_byte { |$${byte}| $. }" "each_byte { |byte| ... }") + ("ea" "each { |$${e}| $. }" "each { |e| ... }") + ("det" "detect { |$${e}| $. }" "detect { |e| ... }") + ("deli" "delete_if { |$${e}| $. }" "delete_if { |e| ... }") + ("collect" "collect { |$${element}| $${element}.$. }" "collect element") + ("col" "collect { |$${e}| $. }" "collect { |e| ... }") + ("cl" "classify { |$${e}| $. }" "classify { |e| ... }") + ("array" "Array.new($${10}) { |$${i}|$. }" "Array.new(10) { |i| ... }") + ("any" "any? { |$${e}| $. }" "any? { |e| ... }") + ("all" "all? { |$${e}| $. }" "all? { |e| ... }")) ; collections + (0 "erb" html-mode-abbrev-table html-helper-mode-abbrev-table nxml-mode-abbrev-table + ("title" "$${title}" "title") + ("textarea" "" "textarea") + ("table" "\n$>\n$>\n
$${Header}
$${Data}
" "table") + ("style" "" "style") + ("scriptsrc" "" "script with source") + ("script" "" "script") + ("movie" "\n$>\n$>\n$>\n$>$>width=\"$${320}\" height=\"$${240}\"\n$>$>controller=\"$${true}\" autoplay=\"$${true}\"\n$>$>scale=\"tofit\" cache=\"true\"\n$>$>pluginspage=\"http://www.apple.com/quicktime/download/\"\n$>/>\n" "quicktime") + ("meta" "" "meta") + ("mailto" "$${email}" "mailto") + ("link" "" "link") + ("licai" "<%= link_to \"$${text}\", :controller => \"$${items}\", :action => \"$${edit}\", :id => $${item} %>" "link_to (controller, action, id)") + ("lica" "<%= link_to \"$${text}\", :controller => \"$${items}\", :action => \"$${index}\" %>" "link_to (controller, action)") + ("lica" "<%= link_to \"$${text}\", :controller => \"$${items}\", :action => \"$${index}\" %>" "link_to (controller, action)") + ("liai" "<%= link_to \"$${text}\", :action => \"$${edit}\", :id => $${item} %>" "link_to (action, id)") + ("lic" "<%= link_to \"$${text}\", :controller => \"$${items}\" %>" "link_to (controller)") + ("lia" "<%= link_to \"$${text}\", :action => \"$${index}\" %>" "link_to (action)") + ("input" "" "input") + ("head" "\n$>\n$>$${title}\n$>$.\n" "head") + ("h" "

$${paste}

" "heading") + ("ft" "<%= form_tag :action => \"$${update}\" %>\n$.\n<%= end_form_tag %>" "form_tag") + ("ff" "<%= form_for :$${item}, :action => \"$${update}\" %>\n$.\n<% end %>" "form_for") + ("form" "
\n$>$.\n\n$>

\n
" "form") + ("dtht" "\"http://www.w3.org/TR/html4/strict.dtd\">\n" "HTML -- 4.01 Strict") + ("dchttr" "\"http://www.w3.org/TR/html4/loose.dtd\">\n" "HTML -- 4.01 Transitional") + ("dcxmlf" "\"http://www.w3.org/TR/xhtml1/DTD/xhtml1-frameset.dtd\">\n" "XHTML -- 1.0 Frameset") + ("dcxmls" "\"http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd\">\n" "XHTML -- 1.0 Strict") + ("dcxmlt" "\"http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd\">\n" "XHTML -- 1.0 Transitional") + ("dcxml1" "\"http://www.w3.org/TR/xhtml11/DTD/xhtml11.dtd\">\n" "XHTML -- 1.1") + ("body" "\n$>$.\n" "body") + ("div" "
\n$>$${paste}\n
" "div") + ("%h" "<%=h $${@item} %>" "<% h ... %>") + ("%if" "<% if $${cond} -%>\n$.\n<% end -%>" "<% if/end %>") + ("%ifel" "<% if $${cond} -%>\n$.\n<% else -%>\n<% end -%>" "<% if/else/end %>") + ("%unless" "<% unless $${cond} -%>\n$.\n<% end -%>" "<% unless/end %>") + ("%for" "<% for $${elem} in @$${list} %>\n$>$.\n<% end %>$>" "<% for/end %>") + ("%" "<% $. -%>" "<% ... %>") + ("%%" "<%= $. %>" "<%= ... %>")) ; erb + (0 "controller" rails-controller-minor-mode-abbrev-table + ("ru" "render :update do |page|\n$>$.\nend$>" "render :update ...") + ("bf" "before_filter :$${filter}" "refore_filter") + ("af" "after_filter :$${filter}" "after_filter") + ("arf" "around_filter :$${filter}" "around_filter")) ; controller + (0 "RESTful" rails-controller-minor-mode-abbrev-table + rails-view-minor-mode-abbrev-table + rails-helper-minor-mode-abbrev-table + rails-functional-test-minor-mode-abbrev-table + ("rest" "respond_to do |format|\n$>format.html$>$.\nend$>" "respond_to ..." rails-controller-minor-mode-abbrev-table) + ("rindex" "$${,rails-snippets-feature:rest-index}" "models_url") + ("rshow" "$${,rails-snippets-feature:rest-show}" "model_url(@model)") + ("rnew" "$${,rails-snippets-feature:rest-new}" "new_model_url") + ("redit" "$${,rails-snippets-feature:rest-edit}" "edit_model_url(@model)") + ("rcreate" "$${,rails-snippets-feature:rest-create}" "models_url") + ("rupdate" "$${,rails-snippets-feature:rest-update}" "model_url(@model)") + ("rdestroy" "$${,rails-snippets-feature:rest-destroy}" "model_url(@model)")) ; RESTFul + (0 "render" rails-controller-minor-mode-abbrev-table + rails-view-minor-mode-abbrev-table + rails-helper-minor-mode-abbrev-table + ("rps" "render :partial => '$${item}', :status => $${500}" "render (partial, status)") + ("rt" "render :text => '$${render}'" "render (text)") + ("rtl" "render :text => '$${render}', :layout => '$${layoutname}'" "render (text, layout)") + ("rtlt" "render :text => '$${render}', :layout => $${true}" "render (text, layout => true)") + ("rts" "render :text => '$${render}', :status => $${401}" "render (text, status)") + ("rf" "render :file => '$${filepath}'" "render (file)") + ("rfu" "render :file => '$${filepath}', :use_full_path => $${false}" "render (file, use_full_path)") + ("ri" "render :inline => '$${hello}'" "render (inline)") + ("ril" "render :inline => '$${hello}', :locals => { $${name} => '$${value}'$${4} }" "render (inline, locals)") + ("rit" "render :inline => '$${hello}', :type => $${rxml}" "render (inline, type)") + ("rl" "render :layout => '$${layoutname}'" "render (layout)") + ("rn" "render :nothing => $${true}" "render (nothing)") + ("rns" "render :nothing => $${true}, :status => $${401}" "render (nothing, status)") + ("rp" "render :partial => '$${item}'" "render (partial)") + ("rpc" "render :partial => '$${item}', :collection => $${items}" "render (partial, collection)") + ("rpl" "render :partial => '$${item}', :locals => { :$${name} => '$${value}'$${4} }" "render (partial, locals)") + ("rpo" "render :partial => '$${item}', :object => $${object}" "render (partial, object)") + ("rcea" "render_component :action => '$${index}'" "render_component (action)") + ("rcec" "render_component :controller => '$${items}'" "render_component (controller)") + ("rceca" "render_component :controller => '$${items}', :action => '$${index}'" "render_component (controller, action)") + ("ra" "render :action => '$${index}'" "render (action)") + ("ral" "render :action => '$${index}', :layout => '{default}'" "render (action, layout)")) ; render + (0 "redirect_to" rails-controller-minor-mode-abbrev-table + rails-view-minor-mode-abbrev-table + rails-helper-minor-mode-abbrev-table + ("rea" "redirect_to :action => '$${index}'" "redirect_to (action)") + ("reai" "redirect_to :action => '$${show}', :id => $${item}" "redirect_to (action, id)") + ("rec" "redirect_to :controller => '$${items}'" "redirect_to (controller)") + ("reca" "redirect_to :controller => '$${items}', :action => '$${list}'" "redirect_to (controller, action)") + ("recai" "redirect_to :controller => '$${items}', :action => '$${show}', :id => $${item}" "redirect_to (controller, action, id)")) ; redirecto_to + (0 "rails" ruby-mode-abbrev-table + ("rdl" "RAILS_DEFAULT_LOGGER.debug '$${message}'$." "RAILS_DEFAULT_LOGGER.debug") + ("nr" "@$${item}.new_record?" "item.new_record?")) ; rails + (0 "model" rails-model-minor-mode-abbrev-table + ("va" "validates_associated :$${attribute}" "validates_associated") + ("vc" "validates_confirmation_of :$${attribute}" "validates_confirmation_of") + ("ve" "validates_exclusion_of :$${attribute}" "validates_exclusion_of") + ("vu" "validates_uniqueness_of :$${attribute}" "validates_uniqueness_of") + ("vpif" "validates_presence_of :$${attribute}, :if => proc { |obj| $${condition} }" "validates_presence_of if") + ("vp" "validates_presence_of :$${attribute}" "validates_presence_of") + ("vl" "validates_length_of :$${attribute}, :within => $${20}" "validates_length_of") + ("bt" "belongs_to :$${model}" "belongs_to") + ("hm" "has_many :$${objects}" "has_many") + ("hmt" "has_many :$${objects}, :through => :$${,rails-snippets-feature:prev-has-many-table-name}" "has_many :through") + ("ho" "has_one :$${object}" "has_one") + ("habtm" "has_and_belongs_to_many :$${object}" "has_and_belongs_to_many")) ; model + (0 "migrations" rails-migration-minor-mode-abbrev-table + ("tcls" "t.column :$${title}, :$${string}\n$>tcls$." "create several columns") + ("tcl" "t.column :$${title}, :$${string}$." "create column") + ("tcln" "t.column :$${title}, :$${string}, :null => false$." "create column :null => false") + ("acl" "add_column :$${,rails-snippets-feature:migration-table-name}, :$${column}, :$${string}" "add column") + ("ai" "add_index :$${,rails-snippets-feature:migration-table-name}, $${column}" "add index") + ("aiu" "add_index :$${,rails-snippets-feature:migration-table-name}, $${column}, :unique => true" "add unique index") + ("rmcl" "remove_column :$${,rails-snippets-feature:migration-table-name}, :$${column}" "remove column") + ("recl" "rename_column :$${column}, :$${new_column}" "rename column") + ("dt" "drop_table :$${,rails-snippets-feature:migration-table-name}$." "drop table") + ("ct" "create_table :$${,rails-snippets-feature:migration-table-name} do |t|\n$>tcls$.\nend$>" "create_table") + ("ret" "rename_table :$${,rails-snippets-feature:migration-table-name}, :$${new_name}$." "rename table")) ; migrations + (0 "environment" ruby-mode-abbrev-table + ("logd" "logger.debug '$${message}'$." "logger.debug") + ("loge" "logger.error '$${message}'$." "logger.error") + ("logf" "logger.fatal '$${message}'$." "logger.fatal") + ("logi" "logger.info '$${message}'$." "logger.info") + ("logw" "logger.warn '$${message}'$." "logger.warn") + ("par" "params[:$${id}]" "params[...]") + ("session" "session[:$${User}]" "session[...]") + ("flash" "flash[:$${notice}] = '$${Successfully}'$." "flash[...]")) ; environment + (0 "tests" rails-functional-test-minor-mode-abbrev-table rails-unit-test-minor-mode-abbrev-table + ("fix" "$${,rails-snippets-feature:fixture}(:$${one})$." "models(:name)")) ; functional tests + (0 "assertions" rails-functional-test-minor-mode-abbrev-table rails-unit-test-minor-mode-abbrev-table + ("art" "assert_redirected_to :action => '$${index}'" "assert_redirected_to") + ("as" "assert $${test}" "assert(...)") + ("asa" "assert assigns(:$${,rails-snippets-feature:model-name})" "assert assigns(...)") + ("ase" "assert_equal $${expected}, $${actual}" "assert_equal(...)") + ("asid" "assert_in_delta $${expected_float}, $${actual_float}, $${20}" "assert_in_delta(...)") + ("asio" "assert_instance_of $${ExpectedClass}, $${actual_instance}" "assert_instance_of(...)") + ("asko" "assert_kind_of $${ExpectedKind}, $${actual_instance}" "assert_kind_of(...)") + ("asm" "assert_match(/$${expected_pattern}/, $${actual_string})" "assert_match(...)") + ("asn" "assert_nil $${instance}" "assert_nil(...)") + ("asne" "assert_not_equal $${unexpected}, $${actual}" "assert_not_equal(...)") + ("asnm" "assert_no_match(/$${unexpected_pattern}/, $${actual_string})" "assert_no_match(...)") + ("asnn" "assert_not_nil $${instance}" "assert_not_nil(...)") + ("asnr" "assert_nothing_raised $${Exception} { $. }" "assert_nothing_raised(...) { ... }") + ("asns" "assert_not_same $${unexpected}, $${actual}" "assert_not_same(...)") + ("asnt" "assert_nothing_thrown { $. }" "assert_nothing_thrown { ... }") + ("aso" "assert_operator $${left}, :$${operator}, $${right}" "assert_operator(...)") + ("asr" "assert_raise $${Exception} { $. }" "assert_raise(...) { ... }") + ("asre" "assert_response :$${success}" "assert_response") + ("asrt" "assert_respond_to $${object}, :$${method}" "assert_respond_to(...)") + ("ass" "assert_same $${expected}, $${actual}" "assert_same(...)") + ("assd" "assert_send [$${object}, :$${message}, $${args}]" "assert_send(...)") + ("ast" "assert_throws :$${expected} { $. }" "assert_throws(...) { ... }") + ("astm" "assert_template '$${index}'" "assert_template")))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; +;; Snippets functions +;; + +(defmacro rails-snippets-feature:create-lambda (str) + `(lambda () (interactive) (snippet-insert ,(symbol-value str)))) + +(defun rails-snippets-feature:create-keymap () + (let ((keymap (make-sparse-keymap "Snippets")) + ret level stack) + (dolist (line rails-snippets-feature:list) + (let ((cur-level (nth 0 line)) ; current the menu livel + (menu-item (nth 1 line)) ; current the menu item name + (line (cddr line)) ; skip level and menu name + (abbrev-tables)) + ;; fill stack + (cond + ((not level) + (setq level cur-level) + (setq stack (list menu-item))) + ((= cur-level level) + (setq stack (append (reverse (cdr (reverse stack))) (list menu-item)))) + ((> cur-level level) + (setq level cur-level) + (setq stack (append stack (list menu-item)))) + ((< cur-level level) + (setq stack (append (reverse (nthcdr (+ 1 (- level cur-level)) (reverse stack))) + (list menu-item))))) + (let ((cur-keymap (vconcat (mapcar #'make-symbol stack)))) + ;; make a menu entry for group of snippets + (define-key keymap cur-keymap + (cons menu-item (make-sparse-keymap menu-item))) + ;; scan abbrev tables + (while (not (listp (car line))) + (setq abbrev-tables (append abbrev-tables (list (car line)))) + (setq line (cdr line))) + (when abbrev-tables + ;; sort and scan snippets + (dolist (snip-line (sort line (lambda(x y) (not (string< (car x)(car y)))))) + (let* ((abbr (nth 0 snip-line)) + (snip (nth 1 snip-line)) + (desc (nth 2 snip-line)) + (loc-abbrev-table (nth 3 snip-line)) + (abbrev-tables (if loc-abbrev-table + (list loc-abbrev-table) + abbrev-tables)) + (compiled-snip (rails-snippets-feature:create-lambda snip))) + ;; create a menu entry for a snippet + (define-key keymap (vconcat cur-keymap (list (make-symbol abbr))) + (cons (format "%s \t%s" abbr desc) compiled-snip)) + ;; create abbrevs for a snippet + (dolist (table abbrev-tables) + (unless (boundp table) + (define-abbrev-table table ())) + (define-abbrev (symbol-value table) abbr "" compiled-snip)))))))) + keymap)) + +(defadvice snippet-insert (before snippet-insert-before-advice first (template) activate) + (let ((pos 0)) + (while (setq pos (string-match (snippet-field-regexp) template pos)) + (let ((match (match-string 2 template)) + (beg (match-beginning 2)) + (end (match-end 2)) + (repl)) + (setq pos end) + (when (= 44 (car (string-to-list match))) ;; 44 - [,] + (save-match-data + (setq repl (apply (intern (substring match 1)) (list))))) + (when repl + (setq template + (concat (substring template 0 beg) + repl + (substring template end (length template)))) + (setq pos (- pos + (- (length match) (length repl))))))))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; +;; Functions for dynamic snippets +;; + +(defun rails-snippets-feature:migration-table-name () + (let (str) + (string=~ "[0-9]+_create_\\([^\\.]+\\)\\.rb$" (buffer-name) + (setq str $1)) + (if str str "table"))) + +(defun rails-snippets-feature:prev-has-many-table-name () + (save-excursion + (if (search-backward-regexp "has_many :\\(\\w+\\)" nil t) + (match-string-no-properties 1) + "table"))) + +(defun rails-snippets-feature:fixture () + (let ((controller (rails-core:current-controller)) + (model (rails-core:current-model))) + (cond + (controller (downcase controller)) + (model (pluralize-string (downcase model))) + (t "fixture")))) + +(defun rails-snippets-feature:model-name () + (let ((controller (rails-core:current-controller))) + (if controller + (singularize-string (downcase controller)) + "model"))) + +(defun rails-snippets-feature:rest (action) + (when-bind + (controller (rails-core:current-controller)) + (let* ((plural (downcase (pluralize-string controller))) + (singular (downcase (singularize-string controller))) + (model (concat "@" singular))) + (case action + (:index + (tooltip-show (format "GET /%s" plural)) + (format "%s_url" plural)) + (:show + (tooltip-show (format "GET /%s/1" plural)) + (format "%s_url(%s)" singular model)) + (:new + (tooltip-show (format "GET /%s/new" plural)) + (format "new_%s_url" singular)) + (:edit + (tooltip-show (format "GET /%s/1;edit" plural)) + (format "edit_%s_url(%s)" singular model)) + (:create + (tooltip-show (format "POST /%s" plural)) + (format "%s_url" plural)) + (:update + (tooltip-show (format "PUT /%s/1" plural)) + (format "%s_url(%s)" singular model)) + (:destroy + (tooltip-show (format "DELETE /%s/1" plural)) + (format "%s_url(%s)" singular model)))))) + +(defun rails-snippets-feature:rest-index () + (rails-snippets-feature:rest :index)) + +(defun rails-snippets-feature:rest-show () + (rails-snippets-feature:rest :show)) + +(defun rails-snippets-feature:rest-new () + (rails-snippets-feature:rest :new)) + +(defun rails-snippets-feature:rest-edit () + (rails-snippets-feature:rest :edit)) + +(defun rails-snippets-feature:rest-create () + (rails-snippets-feature:rest :create)) + +(defun rails-snippets-feature:rest-update () + (rails-snippets-feature:rest :update)) + +(defun rails-snippets-feature:rest-destroy () + (rails-snippets-feature:rest :destroy)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; +;; Install function +;; + +(defun rails-snippets-feature:install () + (define-key rails-minor-mode-map + [menu-bar rails-snippets] + (cons "Snippets" (rails-snippets-feature:create-keymap)))) + +(provide 'rails-snippets-feature) diff --git a/emacs.d/rails/rails-speedbar-feature.el b/emacs.d/rails/rails-speedbar-feature.el new file mode 100644 index 0000000..94fc0d8 --- /dev/null +++ b/emacs.d/rails/rails-speedbar-feature.el @@ -0,0 +1,168 @@ +(defvar rails-speedbar:roots + '(("Controllers" rails-core:controllers rails-core:controller-file) + ("Helpers" rails-core:helpers rails-core:helper-file) + ("Models" rails-core:models rails-core:model-file) + ("Observers" rails-core:observers rails-core:observer-file) + ("Mailers" rails-core:mailers rails-core:mailer-file) + ("Functional Tests" rails-core:functional-tests rails-core:functional-test-file) + ("Unit Tests" rails-core:unit-tests rails-core:unit-test-file) + ("Fixtures" rails-core:fixtures rails-core:fixture-file))) + +(defvar rails-speedbar:menu-items nil) +(defvar rails-speedbar:key-map + (let ((map (speedbar-make-specialized-keymap))) + (define-key map " " 'speedbar-toggle-line-expansion) + (define-key map "+" 'speedbar-expand-line) + (define-key map "=" 'speedbar-expand-line) + (define-key map "-" 'speedbar-contract-line) + (define-key map "e" 'speedbar-edit-line) + (define-key map "\C-m" 'speedbar-edit-line) + map)) + +(defun rails-speedbar:display (directory depth) + (setq speedbar-update-flag nil) + (speedbar-with-writable + (insert (rails-project:root) "\n")) + (dolist (i rails-speedbar:roots) + (speedbar-make-tag-line 'angle + ?+ + 'rails-speedbar:expand-group + (car i) + (car i) + nil + nil + nil + depth)) + (speedbar-make-tag-line 'angle + ?+ + 'rails-speedbar:expand-directory + (concat (rails-speedbar:root) "app/views") + "Views" + nil + nil + nil + depth)) + +(defun rails-speedbar:expand-directory (text token indent) + (cond + ((string-match "+" text) + (speedbar-change-expand-button-char ?-) + (let ((files (directory-files token nil "^[^.]"))) + (save-excursion + (end-of-line) (forward-char 1) + (speedbar-with-writable + (dolist (i files) + (if (file-directory-p (format "%s/%s" token i)) + (speedbar-make-tag-line 'curly + ?+ + 'rails-speedbar:expand-directory + (format "%s/%s" token i) + i + nil nil nil + (+ 1 indent)) + (speedbar-make-tag-line 'statictag + ?? + nil + nil + i + 'rails-speedbar:find-file + (format "%s/%s" token i) + nil + (+ 1 indent)))))))) + ((string-match "-" text) + (speedbar-change-expand-button-char ?+) + (speedbar-delete-subblock indent)))) + +(defun rails-speedbar:expand-group (text token indent) + (cond + ((string-match "+" text) + (speedbar-change-expand-button-char ?-) + (let* ((fn (find-if #'(lambda(i) (string= token (car i))) + rails-speedbar:roots)) + (lst (apply (nth 1 fn) (list))) + (find (nth 2 fn))) + (speedbar-with-writable + (save-excursion + (end-of-line) (forward-char 1) + (dolist (i lst) + (speedbar-make-tag-line 'bracket + ?+ + 'rails-speedbar:expand-tags + (rails-speedbar:in-root (rails-core:file (apply find (list i)))) + i + 'rails-speedbar:find-file + (rails-speedbar:in-root (rails-core:file (apply find (list i)))) + nil + (+ indent 1))))))) + ((string-match "-" text) + (speedbar-change-expand-button-char ?+) + (speedbar-delete-subblock indent)))) + +(defun rails-speedbar:expand-tags (text token indent) + (cond + ((string-match "+" text) + (let ((lst (speedbar-fetch-dynamic-tags token))) + (if (not lst) + (speedbar-change-expand-button-char ??) + (progn + (speedbar-change-expand-button-char ?-) + (speedbar-with-writable + (save-excursion + (end-of-line) (forward-char 1) + (speedbar-insert-generic-list indent + (cdr lst) + 'speedbar-tag-expand + 'speedbar-tag-find))))))) + ((string-match "-" text) + (speedbar-change-expand-button-char ?+) + (speedbar-delete-subblock indent)))) + +(defun rails-speedbar:line-directory (&optional depth) + (save-excursion + (end-of-line) + (let ((start (point))) + (when (search-backward "[-]" nil t) + (end-of-line) + (skip-syntax-backward "w") + (get-text-property (point) 'speedbar-token))))) + +(defun rails-speedbar:find-file (text token indent) + (typecase token + (string (speedbar-find-file-in-frame token)))) + +(defun rails-speedbar:root () + (save-excursion + (goto-char (point-min)) + (let* ((root (current-line-string)) + (root (if (file-directory-p root) + root + (rails-project:root)))) + root))) + +(defmacro rails-speedbar:in-root (&rest body) + `(flet ((rails-project:root () ,(rails-speedbar:root))) + ,@body)) + +(defun rails-speedbar:get-focus () + (interactive) + (speedbar-change-initial-expansion-list "Ruby On Rails") + (let ((default-directory (rails-project:root))) + (speedbar-get-focus))) + +(defun rails-speedbar-feature:install () + (speedbar-add-expansion-list + '("Ruby On Rails" + rails-speedbar:menu-items + rails-speedbar:key-map + rails-speedbar:display)) + (speedbar-add-mode-functions-list + '("Ruby On Rails" + (speedbar-line-directory . rails-speedbar:line-directory))) + + (define-key rails-minor-mode-map (kbd "") 'rails-speedbar:get-focus) + (define-key-after + (lookup-key rails-minor-mode-map [menu-bar rails]) + [speedbar] '("Toggle Speedbar" . rails-speedbar:get-focus) + 'svn-status)) + +(provide 'rails-speedbar-feature) \ No newline at end of file diff --git a/emacs.d/rails/rails-test.el b/emacs.d/rails/rails-test.el new file mode 100644 index 0000000..52a91de --- /dev/null +++ b/emacs.d/rails/rails-test.el @@ -0,0 +1,167 @@ +;;; rails-test.el --- tests integration with the compile library + +;; Copyright (C) 2006 Dmitry Galinsky + +;; Authors: Dmitry Galinsky , + +;; Keywords: ruby rails languages oop +;; $URL: svn+ssh://rubyforge/var/svn/emacs-rails/trunk/rails-ws.el $ +;; $Id: rails-ws.el 140 2007-03-27 23:33:36Z dimaexe $ + +;;; License + +;; This program is free software; you can redistribute it and/or +;; modify it under the terms of the GNU General Public License +;; as published by the Free Software Foundation; either version 2 +;; of the License, or (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program; if not, write to the Free Software +;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. + +;;; Code: + +(defvar rails-test:history nil) + +(defconst rails-test:result-regexp + "\\([0-9]+ tests, [0-9]+ assertions, \\([0-9]+\\) failures, \\([0-9]+\\) errors\\)") + +(defconst rails-test:progress-regexp + "^[\\.EF]+$") + +(defun rails-test:file-ext-regexp () + (let ((rails-templates-list (append rails-templates-list (list "rb")))) + (substring (rails-core:regex-for-match-view) 0 -1))) + +(defun rails-test:line-regexp (&optional append prepend) + (concat + append + (format + "\\(#{RAILS_ROOT}\/\\)?\\(\\(\\.\\|[A-Za-z]:\\)?\\([a-z/_.]+%s\\)\\):\\([0-9]+\\)" + (rails-test:file-ext-regexp)) + prepend)) + +(defun rails-test:error-regexp-alist () + (list + (list 'rails-test-trace + (rails-test:line-regexp) 2 6 nil 0) + (list 'rails-test-failure + (rails-test:line-regexp "\\[" "\\]") 2 6 nil 2) + (list 'rails-test-error + (rails-test:line-regexp nil ".*\n$") 2 6 nil 2))) + +(defun rails-test:print-result () + (with-current-buffer (get-buffer rails-script:buffer-name) + (let ((msg (list)) + (failures 0) + (errors 0)) + (save-excursion + (goto-char (point-min)) + (while (re-search-forward rails-test:result-regexp (point-max) t) + (setq failures (+ failures (string-to-number (match-string-no-properties 2)))) + (setq errors (+ errors (string-to-number (match-string-no-properties 3)))) + (add-to-list 'msg (match-string-no-properties 1)))) + (unless (zerop (length msg)) + (message (strings-join " || " (reverse msg)))) + (when (and (or (not (zerop rails-script:output-mode-ret-value)) + (not (zerop errors)) + (not (zerop failures))) + (not (buffer-visible-p (current-buffer)))) + (rails-script:popup-buffer))))) + +(defun rails-test:print-progress (start end len) + (let (content) + (save-excursion + (goto-char (point-min)) + (while (re-search-forward "^Started" end t) + (line-move 1) + (save-match-data + (let ((progress (string=~ rails-test:progress-regexp + (current-line-string) $m))) + (when progress + (setq content (concat content progress))))))) + (when content + (message "Progress of %s: %s" rails-script:running-script-name content)))) + +(define-derived-mode rails-test:compilation-mode compilation-mode "RTest" + "Major mode for RoR tests." + (rails-script:setup-output-buffer) + (set (make-local-variable 'compilation-error-regexp-alist-alist) + (rails-test:error-regexp-alist)) + (set (make-local-variable 'compilation-error-regexp-alist) + '(rails-test-error + rails-test-failure + rails-test-trace)) + (add-hook 'after-change-functions 'rails-test:print-progress nil t) + (add-hook 'rails-script:run-after-stop-hook 'rails-test:print-result nil t) + (add-hook 'rails-script:show-buffer-hook + #'(lambda() + (let ((win (get-buffer-window (current-buffer)))) + (when (window-live-p win) + (set-window-point win 0) + (unless (buffer-visible-p (current-buffer)) + (compilation-set-window-height win))))) + t t)) + +(defun rails-test:list-of-tasks () + "Return a list contains test tasks." + (append (list "all") + (delete* nil + (mapcar + #'(lambda (task) (string=~ "^test\\:\\([^ ]+\\)" task $1)) + (rails-rake:list-of-tasks)) + :if 'null))) + +(defun rails-test:run (task) + "Run rake tests in RAILS_ROOT." + (interactive (rails-completing-read "What test run" + (rails-test:list-of-tasks) + 'rails-test:history t)) + (unless task + (setq task "all") + (add-to-list rails-test:history task)) + (let ((task-name + (if (string= "all" task) + "test" + (concat "test:" task)))) + (rails-rake:task task-name 'rails-test:compilation-mode))) + +(defun rails-test:run-single-file (file &optional param) + "Run test for single file FILE." + (let ((param (if param (append (list file) (list param)) + (list file)))) + (rails-script:run "ruby" param 'rails-test:compilation-mode))) + +(defun rails-test:run-current () + "Run a test for the current controller/model/mailer." + (interactive) + (let* ((model (rails-core:current-model)) + (controller (rails-core:current-controller)) + (func-test (rails-core:functional-test-file controller)) + (unit-test (rails-core:unit-test-file model)) + (mailer-test (rails-core:unit-test-file controller))) + (rails-test:run-single-file + (cond + ;; model + ((and model unit-test) unit-test) + ;; controller + ((and controller (not (rails-core:mailer-p controller)) func-test) + func-test) + ;; mailer + ((and controller (rails-core:mailer-p controller) unit-test) + unit-test))))) + +(defun rails-test:run-current-method () + "Run a test for the current method." + (interactive) + (let ((file (substring (buffer-file-name) (length (rails-project:root)))) + (method (rails-core:current-method-name))) + (when method + (rails-test:run-single-file file (format "--name=%s" method))))) + +(provide 'rails-test) \ No newline at end of file diff --git a/emacs.d/rails/rails-ui.el b/emacs.d/rails/rails-ui.el new file mode 100644 index 0000000..1464f96 --- /dev/null +++ b/emacs.d/rails/rails-ui.el @@ -0,0 +1,299 @@ +;;; rails-ui.el --- emacs-rails user interface + +;; Copyright (C) 2006 Dmitry Galinsky + +;; Authors: Dmitry Galinsky , +;; Rezikov Peter + +;; Keywords: ruby rails languages oop +;; $URL: svn://rubyforge.org/var/svn/emacs-rails/trunk/rails-ui.el $ +;; $Id: rails-ui.el 173 2007-04-09 15:15:02Z dimaexe $ + +;;; License + +;; This program is free software; you can redistribute it and/or +;; modify it under the terms of the GNU General Public License +;; as published by the Free Software Foundation; either version 2 +;; of the License, or (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program; if not, write to the Free Software +;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. + + +;;;;;;;;;; Some init code ;;;;;;;;;; + +(defconst rails-minor-mode-log-menu-bar-map + (let ((map (make-sparse-keymap))) + (define-keys map + ([test] '("test.log" . rails-log:open-test)) + ([pro] '("production.log" . rails-log:open-production)) + ([dev] '("development.log" . rails-log:open-development)) + ([separator] '("---")) + ([open] '("Open Log File..." . rails-log:open))) + map)) + +(defconst rails-minor-mode-config-menu-bar-map + (let ((map (make-sparse-keymap))) + (define-keys map + ([routes] '("routes.rb" . + (lambda () (interactive) + (rails-core:find-file "config/routes.rb")))) + ([environment] '("environment.rb" . + (lambda() (interactive) + (rails-core:find-file "config/environment.rb")))) + ([database] '("database.yml" . + (lambda() (interactive) + (rails-core:find-file "config/database.yml")))) + ([boot] '("boot.rb" . + (lambda() (interactive) + (rails-core:find-file "config/boot.rb")))) + ([env] (cons "environments" (make-sparse-keymap "environments"))) + ([env test] '("test.rb" . + (lambda() (interactive) + (rails-core:find-file "config/environments/test.rb")))) + ([env production] '("production.rb" . + (lambda() (interactive) + (rails-core:find-file "config/environments/production.rb")))) + ([env development] '("development.rb" . + (lambda()(interactive) + (rails-core:find-file "config/environments/development.rb"))))) + map)) + +(defconst rails-minor-mode-nav-menu-bar-map + (let ((map (make-sparse-keymap))) + (define-keys map + ([goto-fixtures] '("Go to Fixtures" . rails-nav:goto-fixtures)) + ([goto-plugins] '("Go to Plugins" . rails-nav:goto-plugins)) + ([goto-migrate] '("Go to Migrations" . rails-nav:goto-migrate)) + ([goto-layouts] '("Go to Layouts" . rails-nav:goto-layouts)) + ([goto-stylesheets] '("Go to Stylesheets" . rails-nav:goto-stylesheets)) + ([goto-javascripts] '("Go to Javascripts" . rails-nav:goto-javascripts)) + ([goto-helpers] '("Go to Helpers" . rails-nav:goto-helpers)) + ([goto-mailers] '("Go to Mailers" . rails-nav:goto-mailers)) + ([goto-observers] '("Go to Observers" . rails-nav:goto-observers)) + ([goto-unit-tests] '("Go to Unit Tests" . rails-nav:goto-unit-tests)) + ([goto-func-tests] '("Go to Functional Tests" . rails-nav:goto-functional-tests)) + ([goto-models] '("Go to Models" . rails-nav:goto-models)) + ([goto-controllers] '("Go to Controllers" . rails-nav:goto-controllers))) + map)) + +(defconst rails-minor-mode-tests-menu-bar-map + (let ((map (make-sparse-keymap))) + (define-keys map + ([integration] '("Integration Tests" . (lambda() (interactive) (rails-test:run "integration")))) + ([unit] '("Unit Tests" . (lambda() (interactive) (rails-test:run "units")))) + ([functional] '("Functional Tests" . (lambda() (interactive) (rails-test:run "functionals")))) + ([recent] '("Recent Tests" . (lambda() (interactive) (rails-test:run "recent")))) + ([tests] '("All" . (lambda() (interactive) (rails-test:run "all")))) + ([separator] '("--")) + ([toggle] '(menu-item "Toggle Output Window" rails-script:toggle-output-window + :enable (get-buffer rails-script:buffer-name))) + ([run-current] '("Test Current Model/Controller/Mailer" . rails-test:run-current)) + ([run] '("Run Tests ..." . rails-test:run))) + map)) + +(defconst rails-minor-mode-db-menu-bar-map + (let ((map (make-sparse-keymap))) + (define-keys map + ([clone-db] '("Clone Development DB to Test DB" . (lambda() (interactive) (rails-rake:task "db:test:clone")))) + ([load-schema] '("Load schema.rb to DB" . (lambda() (interactive) (rails-rake:task "db:schema:load")))) + ([dump-schema] '("Dump DB to schema.rb" . (lambda() (interactive) (rails-rake:task "db:schema:dump")))) + ([sep] '("--")) + ([prev] '("Migrate to Previous Version" . rails-rake:migrate-to-prev-version)) + ([version] '("Migrate to Version ..." . rails-rake:migrate-to-version)) + ([migrate] '("Migrate" . rails-rake:migrate))) + map)) + +(define-keys rails-minor-mode-menu-bar-map + + ([rails] (cons "RoR" (make-sparse-keymap "RubyOnRails"))) + + ([rails rails-customize] '("Customize" . (lambda () (interactive) (customize-group 'rails)))) + ([rails separator0] '("--")) + ([rails svn-status] '("SVN Status" . rails-svn-status-into-root)) + ([rails api-doc] '("Rails API Doc at Point" . rails-browse-api-at-point)) + ([rails sql] '("SQL Rails Buffer" . rails-run-sql)) + ([rails tag] '("Update TAGS File" . rails-create-tags)) + ([rails ri] '("Search Documentation" . rails-search-doc)) + ([rails goto-file-by-line] '("Go to File by Line" . rails-goto-file-on-current-line)) + ([rails switch-file-menu] '("Switch file Menu..." . rails-lib:run-secondary-switch)) + ([rails switch-file] '("Switch File" . rails-lib:run-primary-switch)) + ([rails separator1] '("--")) + + ([rails scr] (cons "Scripts" (make-sparse-keymap "Scripts"))) + + ([rails scr gen] (cons "Generate" (make-sparse-keymap "Generate"))) + ([rails scr destr] (cons "Destroy" (make-sparse-keymap "Generators"))) + + ([rails scr destr resource] '("Resource" . rails-script:destroy-resource)) + ([rails scr destr observer] '("Observer" . rails-script:destroy-observer)) + ([rails scr destr mailer] '("Mailer" . rails-script:destroy-mailer)) + ([rails scr destr plugin] '("Plugin" . rails-script:destroy-plugin)) + ([rails scr destr migration] '("Migration" . rails-script:destroy-migration)) + ([rails scr destr scaffold] '("Scaffold" . rails-script:destroy-scaffold)) + ([rails scr destr model] '("Model" . rails-script:destroy-model)) + ([rails scr destr controller] '("Controller" . rails-script:destroy-controller)) + ([rails scr destr separator] '("--")) + ([rails scr destr run] '("Run Destroy ..." . rails-script:destroy)) + + ([rails scr gen resource] '("Resource" . rails-script:generate-resource)) + ([rails scr gen observer] '("Observer" . rails-script:generate-observer)) + ([rails scr gen mailer] '("Mailer" . rails-script:generate-mailer)) + ([rails scr gen plugin] '("Plugin" . rails-script:generate-plugin)) + ([rails scr gen migration] '("Migration" . rails-script:generate-migration)) + ([rails scr gen scaffold] '("Scaffold" . rails-script:generate-scaffold)) + ([rails scr gen model] '("Model" . rails-script:generate-model)) + ([rails scr gen controller] '("Controller" . rails-script:generate-controller)) + ([rails scr gen separator] '("--")) + ([rails scr gen run] '("Run Generate ..." . rails-script:generate)) + + ([rails scr break] '("Breakpointer" . rails-script:breakpointer)) + ([rails scr console] '("Console" . rails-script:console)) + ([rails scr rake] '("Rake..." . rails-rake:task)) + + ([rails nav] (cons "Navigation" rails-minor-mode-nav-menu-bar-map)) + ([rails config] (cons "Configuration" rails-minor-mode-config-menu-bar-map)) + ([rails log] (cons "Log Files" rails-minor-mode-log-menu-bar-map)) + + ([rails ws] (cons "WebServer" (make-sparse-keymap "WebServer"))) + + ([rails ws use-webrick] '(menu-item "Use WEBrick" (lambda() (interactive) + (rails-ws:switch-default-server-type "webrick")) + :button (:toggle . (rails-ws:default-server-type-p "webrick")))) + ([rails ws use-lighttpd] '(menu-item "Use Lighty" (lambda() (interactive) + (rails-ws:switch-default-server-type "lighttpd")) + :button (:toggle . (rails-ws:default-server-type-p "lighttpd")))) + ([rails ws use-mongrel] '(menu-item "Use Mongrel" (lambda() (interactive) + (rails-ws:switch-default-server-type "mongrel")) + :button (:toggle . (rails-ws:default-server-type-p "mongrel")))) + ([rails ws separator] '("--")) + + ([rails ws brows] '(menu-item "Open Browser..." rails-ws:open-browser-on-controller + :enable (rails-ws:running-p))) + ([rails ws auto-brows] '(menu-item "Open Browser on Current Action" rails-ws:auto-open-browser + :enable (rails-ws:running-p))) + ([rails ws url] '(menu-item "Open Browser" rails-ws:open-browser + :enable (rails-ws:running-p))) + ([rails ws separator2] '("--")) + + ([rails ws test] '(menu-item "Start Test" rails-ws:start-test + :enable (not (rails-ws:running-p)))) + ([rails ws production] '(menu-item "Start Production" rails-ws:start-production + :enable (not (rails-ws:running-p)))) + ([rails ws development] '(menu-item "Start Development" rails-ws:start-development + :enable (not (rails-ws:running-p)))) + ([rails ws separator3] '("--")) + + ([rails ws status] '(menu-item "Print Status" rails-ws:print-status)) + ([rails ws default] '(menu-item "Start/Stop Web Server (With Default Environment)" rails-ws:toggle-start-stop)) + ) + +(defcustom rails-minor-mode-prefix-key "\C-c" + "Key prefix for rails minor mode." + :group 'rails) + +(defmacro rails-key (key) + `(kbd ,(concat rails-minor-mode-prefix-key " " key))) + +(defconst rails-minor-mode-test-current-method-key (rails-key "\C-c ,")) + +(defvar rails-minor-mode-map + (let ((map (make-keymap))) + map)) + +(define-keys rails-minor-mode-map + ([menu-bar] rails-minor-mode-menu-bar-map) + ([menu-bar rails-tests] (cons "Tests" rails-minor-mode-tests-menu-bar-map)) + ([menu-bar rails-db] (cons "Database" rails-minor-mode-db-menu-bar-map)) + + ;; Goto + ((rails-key "\C-c g m") 'rails-nav:goto-models) + ((rails-key "\C-c g c") 'rails-nav:goto-controllers) + ((rails-key "\C-c g o") 'rails-nav:goto-observers) + ((rails-key "\C-c g n") 'rails-nav:goto-mailers) + ((rails-key "\C-c g h") 'rails-nav:goto-helpers) + ((rails-key "\C-c g l") 'rails-nav:goto-layouts) + ((rails-key "\C-c g s") 'rails-nav:goto-stylesheets) + ((rails-key "\C-c g j") 'rails-nav:goto-javascripts) + ((rails-key "\C-c g g") 'rails-nav:goto-migrate) + ((rails-key "\C-c g p") 'rails-nav:goto-plugins) + ((rails-key "\C-c g x") 'rails-nav:goto-fixtures) + ((rails-key "\C-c g f") 'rails-nav:goto-functional-tests) + ((rails-key "\C-c g u") 'rails-nav:goto-unit-tests) + + ;; Switch + ((kbd "") 'rails-lib:run-primary-switch) + ((kbd "") 'rails-lib:run-secondary-switch) + ((rails-key "") 'rails-lib:run-primary-switch) + ((rails-key "") 'rails-lib:run-secondary-switch) + ((kbd "") 'rails-goto-file-on-current-line) + + ;; Scripts & SQL + ((rails-key "\C-c e") 'rails-script:generate) + ((rails-key "\C-c x") 'rails-script:destroy) + ((rails-key "\C-c s c") 'rails-script:console) + ((rails-key "\C-c s b") 'rails-script:breakpointer) + ((rails-key "\C-c s s") 'rails-run-sql) + ((rails-key "\C-c w s") 'rails-ws:toggle-start-stop) + ((rails-key "\C-c w d") 'rails-ws:start-development) + ((rails-key "\C-c w p") 'rails-ws:start-production) + ((rails-key "\C-c w t") 'rails-ws:start-test) + ((rails-key "\C-c w i") 'rails-ws:print-status) + ((rails-key "\C-c w a") 'rails-ws:auto-open-browser) + + ;; Rails finds + ((rails-key "\C-c f m") 'rails-find:models) + ((rails-key "\C-c f c") 'rails-find:controller) + ((rails-key "\C-c f h") 'rails-find:helpers) + ((rails-key "\C-c f l") 'rails-find:layout) + ((rails-key "\C-c f s") 'rails-find:stylesheets) + ((rails-key "\C-c f j") 'rails-find:javascripts) + ((rails-key "\C-c f g") 'rails-find:migrate) + ((rails-key "\C-c f b") 'rails-find:lib) + ((rails-key "\C-c f t") 'rails-find:tasks) + ((rails-key "\C-c f v") 'rails-find:view) + ((rails-key "\C-c f d") 'rails-find:db) + ((rails-key "\C-c f p") 'rails-find:public) + ((rails-key "\C-c f f") 'rails-find:fixtures) + ((rails-key "\C-c f o") 'rails-find:config) + + ((rails-key "\C-c d m") 'rails-rake:migrate) + ((rails-key "\C-c d v") 'rails-rake:migrate-to-version) + ((rails-key "\C-c d p") 'rails-rake:migrate-to-prev-version) + + ;; Tests + ((rails-key "\C-c r") 'rails-rake:task) + ((rails-key "\C-c t") 'rails-test:run) + ((rails-key "\C-c .") 'rails-test:run-current) + + ;; Navigation + + ((rails-key "\C-c l") 'rails-log:open) + ;; Tags + ((rails-key "\C-c \C-t") 'rails-create-tags) + + ;; Documentation + ([f1] 'rails-search-doc) + ((kbd "") 'rails-browse-api-at-point) + ((rails-key "") 'rails-browse-api) + ((rails-key "/") 'rails-script:toggle-output-window) + + ([f9] 'rails-svn-status-into-root)) + +;; Global keys and menubar + +(global-set-key (rails-key "\C-c j") 'rails-script:create-project) + +(when-bind (map (lookup-key global-map [menu-bar file])) + (define-key-after + map + [create-rails-project] + '("Create Rails Project" . rails-script:create-project) 'insert-file)) + +(provide 'rails-ui) diff --git a/emacs.d/rails/rails-unit-test-minor-mode.el b/emacs.d/rails/rails-unit-test-minor-mode.el new file mode 100644 index 0000000..913f3d4 --- /dev/null +++ b/emacs.d/rails/rails-unit-test-minor-mode.el @@ -0,0 +1,43 @@ +;;; rails-unit-test-minor-mode.el --- minor mode for RubyOnRails unit tests + +;; Copyright (C) 2006 Dmitry Galinsky + +;; Authors: Dmitry Galinsky + +;; Keywords: ruby rails languages oop +;; $URL: svn://rubyforge.org/var/svn/emacs-rails/trunk/rails-unit-test-minor-mode.el $ +;; $Id: rails-unit-test-minor-mode.el 166 2007-04-05 17:44:57Z dimaexe $ + +;;; License + +;; This program is free software; you can redistribute it and/or +;; modify it under the terms of the GNU General Public License +;; as published by the Free Software Foundation; either version 2 +;; of the License, or (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program; if not, write to the Free Software +;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. + +;;; Code: + +(define-minor-mode rails-unit-test-minor-mode + "Minor mode for RubyOnRails unit tests." + :lighter " UTest" + :keymap (let ((map (rails-model-layout:keymap :unit-test))) + (define-key map rails-minor-mode-test-current-method-key 'rails-test:run-current-method) + (define-key map [menu-bar rails-model-layout run] '("Test current method" . rails-test:run-current-method)) + map) + (setq rails-primary-switch-func (lambda() + (interactive) + (if (rails-core:mailer-p (rails-core:current-model)) + (rails-model-layout:switch-to-mailer) + (rails-model-layout:switch-to-model)))) + (setq rails-secondary-switch-func 'rails-model-layout:menu)) + +(provide 'rails-unit-test-minor-mode) \ No newline at end of file diff --git a/emacs.d/rails/rails-view-minor-mode.el b/emacs.d/rails/rails-view-minor-mode.el new file mode 100644 index 0000000..e1ca971 --- /dev/null +++ b/emacs.d/rails/rails-view-minor-mode.el @@ -0,0 +1,115 @@ +;;; rails-view-minor-mode.el --- minor mode for RubyOnRails views + +;; Copyright (C) 2006 Dmitry Galinsky + +;; Authors: Dmitry Galinsky + +;; Keywords: ruby rails languages oop +;; $URL: svn://rubyforge.org/var/svn/emacs-rails/trunk/rails-view-minor-mode.el $ +;; $Id: rails-view-minor-mode.el 173 2007-04-09 15:15:02Z dimaexe $ + +;;; License + +;; This program is free software; you can redistribute it and/or +;; modify it under the terms of the GNU General Public License +;; as published by the Free Software Foundation; either version 2 +;; of the License, or (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program; if not, write to the Free Software +;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. + +;;; Code: + +(defun rails-view-minor-mode:create-partial-from-selection () + "Create a partial from current buffer selection." + (interactive) + (if mark-active + (save-excursion + (let ((name (read-string "Partial name (without _ and extension)? ")) + (content (buffer-substring-no-properties (region-beginning) (region-end))) + (modified (buffer-modified-p))) + (unless (string-not-empty name) + (progn + (message "Empty partial name") (return))) + (kill-region (region-beginning) (region-end)) + (insert (concat "<%= render :partial => \"" name "\" %>")) + (mmm-parse-region (line-beginning-position) (line-end-position)) + (insert "\n") + (split-window-vertically) + (other-window 1) + (find-file (concat "_" name ".rhtml")) + (goto-char (point-min)) + (erase-buffer) + (insert content) + (save-buffer) + (fit-window-to-buffer) + (other-window -1) + (unless modified (save-buffer)) + (message "type `C-x +` to balance windows"))))) + +(defun rails-view-minor-mode:create-helper-from-block (&optional helper-name) + "Create a helper function from current ERb block (<% .. %>)." + (interactive) + (let ((current-pos (point)) + (file buffer-file-name) + begin-pos + end-pos) + (save-excursion + (setq begin-pos (search-backward "<%" nil t)) + (setq end-pos (search-forward "%>" nil t))) + (if (and begin-pos + end-pos + (> current-pos begin-pos) + (< current-pos end-pos)) + (let* ((helper-file (concat (rails-project:root) (rails-core:helper-file (rails-core:current-controller)))) + (content (replace-regexp-in-string "\\(<%=?\\|-?%>\\)" "" + (buffer-substring-no-properties begin-pos end-pos))) + (helper-defination (if helper-name helper-name + (read-string "Type helper function defination (without `def` keyword): ")))) + (if (file-exists-p helper-file) + (let ((modified (buffer-modified-p)) + (helper-func-def (concat "def " helper-defination))) + (kill-region begin-pos end-pos) + (insert (concat "<%= " helper-defination " -%>" )) + (mmm-parse-region (line-beginning-position) (line-end-position)) + (insert "\n") + (split-window-vertically) + (other-window 1) + (find-file helper-file) + (goto-char (point-min)) + (search-forward-regexp "module +[a-zA-Z0-9:]+") + (end-of-line) + (newline) + (ruby-indent-command) + (save-excursion + (insert (concat helper-func-def "\n" content "\nend\n"))) + (ruby-indent-exp) + (fit-window-to-buffer) + (save-buffer) + (other-window -1) + (unless modified (save-buffer)) + (message "Type `C-x +` to balance windows")) + (message "helper not found"))) + (message "block not found")))) + +(define-minor-mode rails-view-minor-mode + "Minor mode for RubyOnRails views." + :lighter " View" + :keymap (rails-controller-layout:keymap :view) + (setq rails-primary-switch-func 'rails-controller-layout:toggle-action-view) + (setq rails-secondary-switch-func 'rails-controller-layout:menu) + (if (boundp 'mmm-mode-map) + (progn + (define-key mmm-mode-map (rails-key "p") 'rails-view-minor-mode:create-partial-from-selection) + (define-key mmm-mode-map (rails-key "b") 'rails-view-minor-mode:create-helper-from-block)) + (progn + (local-set-key (rails-key "p") 'rails-view-minor-mode:create-partial-from-selection) + (local-set-key (rails-key "b") 'rails-view-minor-mode:create-helper-from-block)))) + +(provide 'rails-view-minor-mode) \ No newline at end of file diff --git a/emacs.d/rails/rails-ws.el b/emacs.d/rails/rails-ws.el new file mode 100644 index 0000000..87aaf39 --- /dev/null +++ b/emacs.d/rails/rails-ws.el @@ -0,0 +1,191 @@ +;;; rails-ws.el --- functions for manadge application server + +;; Copyright (C) 2006 Dmitry Galinsky + +;; Authors: Dmitry Galinsky , +;; Rezikov Peter + +;; Keywords: ruby rails languages oop +;; $URL: svn://rubyforge.org/var/svn/emacs-rails/trunk/rails-ws.el $ +;; $Id: rails-ws.el 150 2007-03-29 20:48:17Z dimaexe $ + +;;; License + +;; This program is free software; you can redistribute it and/or +;; modify it under the terms of the GNU General Public License +;; as published by the Free Software Foundation; either version 2 +;; of the License, or (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program; if not, write to the Free Software +;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. + +;;; Code: + +(defcustom rails-ws:port "3000" + "Default web server port" + :group 'rails + :type 'string + :tag "Rails Server Port") + +(defcustom rails-ws:server-name "http://localhost" + "Protocol and the hostname for web server or other rails server" + :group 'rails + :type 'string + :tag "Rails Server Default") + +(defcustom rails-ws:default-server-type "mongrel" + "Web server to run Rails application." + :group 'rails + :type 'string + :tag "Rails Server Type") + +(defvar rails-ws:available-servers-list (list "mongrel" "lighttpd" "webrick")) +(defvar rails-ws:buffer-name "*RWebServer*") +(defvar rails-ws:process-environment nil) + +(defun rails-ws:default-server-type-p (type) + (string= type rails-ws:default-server-type)) + +(defun rails-ws:switch-default-server-type (type) + "Switch default server type to run." + (interactive (list (completing-read "Server type (use autocomplete): " + rails-ws:available-servers-list + nil t + rails-ws:default-server-type))) + (setq rails-ws:default-server-type type) + (customize-save-variable 'rails-ws:default-server-type rails-ws:default-server-type) + (message (concat "Switching to " (upcase type) " as default server type"))) + +(defun rails-ws:running-p () + "Return t if a WebServer process is running." + (if (get-buffer-process rails-ws:buffer-name) t nil)) + +(defun rails-ws:sentinel-proc (proc msg) + (let ((env rails-ws:process-environment)) + (when (memq (process-status proc) '(exit signal)) + (setq rails-ws:process-environment nil) + (setq msg (format "stopped (%s)" msg))) + (message + (replace-regexp-in-string "\n" "" + (format "%s - %s" + (capitalize rails-ws:default-server-type) + msg))))) + +(defun rails-ws:start(&optional env) + "Start a server process with ENV environment if ENV is not set +using `rails-default-environment'." + (interactive (list (rails-read-enviroment-name))) + (rails-project:with-root + (root) + (let ((proc (get-buffer-process rails-ws:buffer-name))) + (if proc + (message "Only one instance rails-ws allowed") + (let* ((default-directory root) + (env (if env env rails-default-environment)) + (proc + (rails-cmd-proxy:start-process rails-ruby-command + rails-ws:buffer-name + rails-ruby-command + (format "script/server %s -p %s -e %s" + rails-ws:default-server-type + rails-ws:port env)))) + (set-process-sentinel proc 'rails-ws:sentinel-proc) + (setq rails-ws:process-environment env) + (message (format "%s (%s) starting with port %s" + (capitalize rails-ws:default-server-type) + env + rails-ws:port))))))) + +(defun rails-ws:stop () + "Stop the WebServer process." + (interactive) + (let ((proc (get-buffer-process rails-ws:buffer-name))) + (when proc (kill-process proc t)))) + + +(defun rails-ws:start-default () + "Start WebServer using the default environment defined in +`rails-default-environment'." + (interactive) + (rails-ws:start rails-default-environment)) + +(defun rails-ws:start-development () + (interactive) + (rails-ws:start "development")) + +(defun rails-ws:start-production () + (interactive) + (rails-ws:start "production")) + +(defun rails-ws:start-test () + (interactive) + (rails-ws:start "test")) + +(defun rails-ws:toggle-start-stop () + "Toggle Rails WebServer start/stop with default environment." + (interactive) + (if (rails-ws:running-p) + (rails-ws:stop) + (rails-ws:start-default))) + +(defun rails-ws:print-status () + (interactive) + (message + (concat rails-ws:default-server-type + " (" (if rails-ws:process-environment + rails-ws:process-environment + rails-default-environment) ")" + " is " + (if (rails-ws:running-p) + (concat "running on port " rails-ws:port) + "stopped")))) + +;;;;;;;;;; Open browser ;;;;;;;;;; + +(defun rails-ws:open-browser (&optional address) + "Open a browser on the main page of the current Rails project +server." + (interactive) + (let ((url (concat (concat rails-ws:server-name + ":" + rails-ws:port + "/" + address )))) + (message "Opening browser: %s" url) + (browse-url url))) + +(defun rails-ws:open-browser-on-controller (&optional controller action params) + "Open browser on the controller/action/id for the current +file." + (interactive + (list + (completing-read "Controller name: " + (list->alist (rails-core:controllers t))) + (read-from-minibuffer "Action name: ") + (read-from-minibuffer "Params: "))) + (when (string-not-empty controller) + (rails-ws:open-browser + (concat (rails-core:file-by-class controller t) "/" + (if (string-not-empty action) (concat action "/")) params)))) + +(defun rails-ws:auto-open-browser (ask-parameters?) + "Autodetect the current action and open browser on it with. +Prefix the command to ask parameters for action." + (interactive "P") + (rails-project:with-root + (root) + (if (find (rails-core:buffer-type) '(:view :controller)) + (when-bind (controller (rails-core:current-controller)) + (rails-ws:open-browser-on-controller + controller (rails-core:current-action) + (when ask-parameters? + (read-from-minibuffer "Parameters: ")))) + (message "You can auto-open browser only in view or controller")))) + +(provide 'rails-ws) \ No newline at end of file diff --git a/emacs.d/rails/rails.el b/emacs.d/rails/rails.el new file mode 100644 index 0000000..be30e27 --- /dev/null +++ b/emacs.d/rails/rails.el @@ -0,0 +1,452 @@ +;;; rails.el --- minor mode for editing RubyOnRails code + +;; Copyright (C) 2006 Dmitry Galinsky + +;; Authors: Dmitry Galinsky , +;; Rezikov Peter + +;; Keywords: ruby rails languages oop +;; $URL: svn://rubyforge.org/var/svn/emacs-rails/trunk/rails.el $ +;; $Id: rails.el 193 2007-05-05 18:37:00Z dimaexe $ + +;;; License + +;; This program is free software; you can redistribute it and/or +;; modify it under the terms of the GNU General Public License +;; as published by the Free Software Foundation; either version 2 +;; of the License, or (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program; if not, write to the Free Software +;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. + +;;; Code: + +(unless (<= 22 emacs-major-version) + (error + (format "emacs-rails require CVS version of Emacs (future Emacs 22), and not be running on your Emacs %s.%s" + emacs-major-version + emacs-minor-version))) + +(eval-when-compile + (require 'speedbar) + (require 'inf-ruby) + (require 'ruby-mode) + (require 'ruby-electric)) + +(require 'sql) +(require 'ansi-color) +(require 'etags) +(require 'find-recursive) + +(require 'untabify-file) +(require 'predictive-prog-mode) + +(require 'inflections) + +(require 'rails-compat) +(require 'rails-project) + +(require 'rails-core) +(require 'rails-ruby) +(require 'rails-lib) + +(require 'rails-cmd-proxy) +(require 'rails-navigation) +(require 'rails-find) +(require 'rails-scripts) +(require 'rails-rake) +(require 'rails-test) +(require 'rails-ws) +(require 'rails-log) +(require 'rails-ui) +(require 'rails-model-layout) +(require 'rails-controller-layout) +(require 'rails-features) + + +;;;;;;;;;; Variable definition ;;;;;;;;;; + +(defgroup rails nil + "Edit Rails projects with Emacs." + :group 'programming + :prefix "rails-") + +(defcustom rails-api-root nil + "*Root of Rails API html documentation. Must be a local directory." + :group 'rails + :type 'string) + +(defcustom rails-use-alternative-browse-url nil + "Indicates an alternative way of loading URLs on Windows. +Try using the normal method before. If URLs invoked by the +program don't end up in the right place, set this option to +true." + :group 'rails + :type 'boolean) + +(defcustom rails-browse-api-with-w3m nil + "Indicates that the user wants to browse the Rails API using +Emacs w3m browser." + :group 'rails + :type 'boolean) + +(defcustom rails-tags-command "ctags -e -a --Ruby-kinds=-f -o %s -R %s" + "Command used to generate TAGS in Rails root" + :group 'rails + :type 'string) + +(defcustom rails-ri-command "ri" + "Command used to invoke the ri utility." + :group 'rails + :type 'string) + +(defcustom rails-always-use-text-menus nil + "Force the use of text menus by default." + :group 'rails + :type 'boolean) + +(defcustom rails-ask-when-reload-tags nil + "Indicates whether the user should confirm reload a TAGS table or not." + :group 'rails + :type 'boolean) + +(defcustom rails-chm-file nil + "Path to CHM documentation file on Windows, or nil." + :group 'rails + :type 'string) + +(defcustom rails-ruby-command "ruby" + "Ruby preferred command line invocation." + :group 'rails + :type 'string) + +(defcustom rails-layout-template + " + + + + + <%= stylesheet_link_tag \"default\" %> + + + + <%= yield %> + +" + "Default html template for new rails layout" + :group 'rails + :type 'string) + +(defvar rails-version "0.5.99.1") +(defvar rails-templates-list '("erb" "rhtml" "rxml" "rjs" "haml" "liquid")) +(defvar rails-use-another-define-key nil) +(defvar rails-primary-switch-func nil) +(defvar rails-secondary-switch-func nil) + +(defvar rails-directory<-->types + '((:controller "app/controllers/") + (:layout "app/layouts/") + (:view "app/views/") + (:observer "app/models/" (lambda (file) (rails-core:observer-p file))) + (:mailer "app/models/" (lambda (file) (rails-core:mailer-p file))) + (:model "app/models/" (lambda (file) (and (not (rails-core:mailer-p file)) + (not (rails-core:observer-p file))))) + (:helper "app/helpers/") + (:plugin "vendor/plugins/") + (:unit-test "test/unit/") + (:functional-test "test/functional/") + (:fixture "test/fixtures/") + (:migration "db/migrate")) + "Rails file types -- rails directories map") + +(defvar rails-enviroments '("development" "production" "test")) +(defvar rails-default-environment (first rails-enviroments)) + +(defvar rails-adapters-alist + '(("mysql" . sql-mysql) + ("postgresql" . sql-postgres) + ("sqlite3" . sql-sqlite)) + "Sets emacs sql function for rails adapter names.") + +(defvar rails-tags-dirs '("app" "lib" "test" "db") + "List of directories from RAILS_ROOT where ctags works.") + +(defun rails-use-text-menu () + "If t use text menu, popup menu otherwise" + (or (null window-system) rails-always-use-text-menus)) + +;;;;;;;; hack ;;;; +(defun rails-svn-status-into-root () + (interactive) + (rails-project:with-root (root) + (svn-status root))) + +;; helper functions/macros +(defun rails-search-doc (&optional item) + (interactive) + (setq item (if item item (thing-at-point 'sexp))) + (unless item + (setq item (read-string "Search symbol: "))) + (if item + (if (and rails-chm-file + (file-exists-p rails-chm-file)) + (start-process "keyhh" "*keyhh*" "keyhh.exe" "-#klink" + (format "'%s'" item) rails-chm-file) + (let ((buf (buffer-name))) + (unless (string= buf "*ri*") + (switch-to-buffer-other-window "*ri*")) + (setq buffer-read-only nil) + (kill-region (point-min) (point-max)) + (message (concat "Please wait...")) + (call-process rails-ri-command nil "*ri*" t item) + (local-set-key [return] 'rails-search-doc) + (ansi-color-apply-on-region (point-min) (point-max)) + (setq buffer-read-only t) + (goto-char (point-min)))))) + +(defun rails-create-tags() + "Create tags file" + (interactive) + (rails-project:in-root + (message "Creating TAGS, please wait...") + (let ((tags-file-name (rails-core:file "TAGS"))) + (shell-command + (format rails-tags-command tags-file-name + (strings-join " " (mapcar #'rails-core:file rails-tags-dirs)))) + (flet ((yes-or-no-p (p) (if rails-ask-when-reload-tags + (y-or-n-p p) + t))) + (visit-tags-table tags-file-name))))) + +(defun rails-apply-for-buffer-type () + (let* ((type (rails-core:buffer-type)) + (name (substring (symbol-name type) 1)) + (minor-mode-name (format "rails-%s-minor-mode" name)) + (minor-mode-abbrev (concat minor-mode-name "-abbrev-table"))) + (when (require (intern minor-mode-name) nil t) ;; load new style minor mode rails-*-minor-mode + (when (fboundp (intern minor-mode-name)) + (apply (intern minor-mode-name) (list t)) + (when (boundp (intern minor-mode-abbrev)) + (merge-abbrev-tables + (symbol-value (intern minor-mode-abbrev)) + local-abbrev-table)))))) + +;;;;;;;;;; Database integration ;;;;;;;;;; + +(defstruct rails-db-conf adapter host database username password) + +(defun rails-db-parameters (env) + "Return database parameters for enviroment ENV" + (with-temp-buffer + (shell-command + (format "ruby -r yaml -r erb -e 'YAML.load(ERB.new(ARGF.read).result)[\"%s\"].to_yaml.display' %s" + env + (rails-core:file "config/database.yml")) + (current-buffer)) + (let ((answer + (make-rails-db-conf + :adapter (yml-value "adapter") + :host (yml-value "host") + :database (yml-value "database") + :username (yml-value "username") + :password (yml-value "password")))) + answer))) + +(defun rails-database-emacs-func (adapter) + "Return the Emacs function for ADAPTER that, when run, will ++invoke the appropriate database server console." + (cdr (assoc adapter rails-adapters-alist))) + +(defun rails-read-enviroment-name (&optional default) + "Read Rails enviroment with auto-completion." + (completing-read "Environment name: " (list->alist rails-enviroments) nil nil default)) + +(defun* rails-run-sql (&optional env) + "Run a SQL process for the current Rails project." + (interactive (list (rails-read-enviroment-name "development"))) + (rails-project:with-root (root) + (cd root) + (if (bufferp (sql-find-sqli-buffer)) + (switch-to-buffer-other-window (sql-find-sqli-buffer)) + (let ((conf (rails-db-parameters env))) + (let ((sql-database (rails-db-conf-database conf)) + (default-process-coding-system '(utf-8 . utf-8)) + (sql-server (rails-db-conf-host conf)) + (sql-user (rails-db-conf-username conf)) + (sql-password (rails-db-conf-password conf))) + ;; Reload localy sql-get-login to avoid asking of confirmation of DB login parameters + (flet ((sql-get-login (&rest pars) () t)) + (funcall (rails-database-emacs-func (rails-db-conf-adapter conf))))))))) + +(defun rails-has-api-root () + "Test whether `rails-api-root' is configured or not, and offer to configure +it in case it's still empty for the project." + (rails-project:with-root + (root) + (unless (or (file-exists-p (rails-core:file "doc/api/index.html")) + (not (yes-or-no-p (concat "This project has no API documentation. " + "Would you like to configure it now? ")))) + (let (clobber-gems) + (message "This may take a while. Please wait...") + (unless (file-exists-p (rails-core:file "vendor/rails")) + (setq clobber-gems t) + (message "Freezing gems...") + (shell-command-to-string "rake rails:freeze:gems")) + ;; Hack to allow generation of the documentation for Rails 1.0 and 1.1 + ;; See http://dev.rubyonrails.org/ticket/4459 + (unless (file-exists-p (rails-core:file "vendor/rails/activesupport/README")) + (write-string-to-file (rails-core:file "vendor/rails/activesupport/README") + "Placeholder")) + (message "Generating documentation...") + (shell-command-to-string "rake doc:rails") + (if clobber-gems + (progn + (message "Unfreezing gems...") + (shell-command-to-string "rake rails:unfreeze"))) + (message "Done."))) + (if (file-exists-p (rails-core:file "doc/api/index.html")) + (setq rails-api-root (rails-core:file "doc/api"))))) + +(defun rails-browse-api () + "Browse Rails API on RAILS-API-ROOT." + (interactive) + (if (rails-has-api-root) + (rails-browse-api-url (concat rails-api-root "/index.html")) + (message "Please configure variable rails-api-root."))) + +(defun rails-get-api-entries (name file sexp get-file-func) + "Return all API entries named NAME in file FILE using SEXP to +find matches, and GET-FILE-FUNC to process the matches found." + (if (file-exists-p (concat rails-api-root "/" file)) + (save-current-buffer + (save-match-data + (find-file (concat rails-api-root "/" file)) + (let* ((result + (loop for line in (split-string (buffer-string) "\n") + when (string-match (format sexp (regexp-quote name)) line) + collect (cons (match-string-no-properties 2 line) + (match-string-no-properties 1 line))))) + (kill-buffer (current-buffer)) + (when-bind (api-file (funcall get-file-func result)) + (rails-browse-api-url (concat "file://" rails-api-root "/" api-file)))))) + (message "There are no API docs."))) + +(defun rails-browse-api-class (class) + "Browse the Rails API documentation for CLASS." + (rails-get-api-entries + class "fr_class_index.html" "%s<" + (lambda (entries) + (cond ((= 0 (length entries)) (progn (message "No API Rails doc for class %s." class) nil)) + ((= 1 (length entries)) (cdar entries)))))) + +(defun rails-browse-api-method (method) + "Browse the Rails API documentation for METHOD." + (rails-get-api-entries + method "fr_method_index.html" "%s[ ]+(\\(.*\\))" + (lambda (entries) + (cond ((= 0 (length entries)) (progn (message "No API Rails doc for %s" method) nil)) + ((= 1 (length entries)) (cdar entries)) + (t (cdr (assoc (completing-read (format "Method %s from what class? " method) entries) + entries))))))) + +(defun rails-browse-api-at-point () + "Open the Rails API documentation on the class or method at the current point. +The variable `rails-api-root' must be pointing to a local path +either in your project or elsewhere in the filesystem. The +function will also offer to build the documentation locally if +necessary." + (interactive) + (if (rails-has-api-root) + (let ((current-symbol (prog2 + (modify-syntax-entry ?: "w") + (thing-at-point 'sexp) + (modify-syntax-entry ?: ".")))) + (if current-symbol + (if (capital-word-p current-symbol) + (rails-browse-api-class current-symbol) + (rails-browse-api-method current-symbol)))) + (message "Please configure \"rails-api-root\"."))) + +;;; Rails minor mode + +(define-minor-mode rails-minor-mode + "RubyOnRails" + nil + " Rails" + rails-minor-mode-map + (abbrev-mode -1) + (make-local-variable 'tags-file-name) + (make-local-variable 'rails-primary-switch-func) + (make-local-variable 'rails-secondary-switch-func) + (rails-features:install)) + +;; hooks + +(add-hook 'ruby-mode-hook + (lambda() + (require 'rails-ruby) + (require 'ruby-electric) + (ruby-electric-mode t) + (imenu-add-to-menubar "IMENU") + (modify-syntax-entry ?! "w" (syntax-table)) + (modify-syntax-entry ?: "w" (syntax-table)) + (modify-syntax-entry ?_ "w" (syntax-table)) + (local-set-key (kbd "C-.") 'complete-tag) + (local-set-key (if rails-use-another-define-key + (kbd "TAB") (kbd "")) + 'indent-or-complete) + (local-set-key (rails-key "f") '(lambda() + (interactive) + (mouse-major-mode-menu (rails-core:menu-position)))) + (local-set-key (kbd "C-:") 'ruby-toggle-string<>simbol) + (local-set-key (if rails-use-another-define-key + (kbd "RET") (kbd "")) + 'ruby-newline-and-indent))) + +(add-hook 'speedbar-mode-hook + (lambda() + (speedbar-add-supported-extension "\\.rb"))) + +(add-hook 'find-file-hooks + (lambda() + (rails-project:with-root + (root) + (progn + (local-set-key (if rails-use-another-define-key + (kbd "TAB") (kbd "")) + 'indent-or-complete) + (rails-minor-mode t) + (rails-apply-for-buffer-type))))) + +;; Run rails-minor-mode in dired + +(add-hook 'dired-mode-hook + (lambda () + (if (rails-project:root) + (rails-minor-mode t)))) + + +(autoload 'haml-mode "haml-mode" "" t) + +(setq auto-mode-alist (cons '("\\.rb$" . ruby-mode) auto-mode-alist)) +(setq auto-mode-alist (cons '("\\.rake$" . ruby-mode) auto-mode-alist)) +(setq auto-mode-alist (cons '("Rakefile$" . ruby-mode) auto-mode-alist)) +(setq auto-mode-alist (cons '("\\.haml$" . haml-mode) auto-mode-alist)) +(setq auto-mode-alist (cons '("\\.rjs$" . ruby-mode) auto-mode-alist)) +(setq auto-mode-alist (cons '("\\.rxml$" . ruby-mode) auto-mode-alist)) +(setq auto-mode-alist (cons '("\\.rhtml$" . html-mode) auto-mode-alist)) + +(modify-coding-system-alist 'file "\\.rb$" 'utf-8) +(modify-coding-system-alist 'file "\\.rake$" 'utf-8) +(modify-coding-system-alist 'file "Rakefile$" 'utf-8) +(modify-coding-system-alist 'file (rails-core:regex-for-match-view) 'utf-8) + +(provide 'rails) diff --git a/emacs.d/rails/untabify-file.el b/emacs.d/rails/untabify-file.el new file mode 100644 index 0000000..f84bb84 --- /dev/null +++ b/emacs.d/rails/untabify-file.el @@ -0,0 +1,56 @@ +;;; untabify-file.el --- automatic untabify files before save + +;; Copyright (C) 2006 Dmitry Galinsky + +;; Authors: Dmitry Galinsky , + +;; Keywords: ruby rails languages oop +;; $URL: svn+ssh://rubyforge/var/svn/emacs-rails/trunk/rails.el $ +;; $Id: rails.el 149 2007-03-29 15:07:49Z dimaexe $ + +;;; License + +;; This program is free software; you can redistribute it and/or +;; modify it under the terms of the GNU General Public License +;; as published by the Free Software Foundation; either version 2 +;; of the License, or (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program; if not, write to the Free Software +;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. + +;;; Code: + +(require 'cl) +(require 'custom) + +(defcustom untabify-exclude-list + '(makefile-mode + makefile-bsdmake-mode + change-log-mode + "Makefile$") + "List of regexp or modes to which is not applied untabify." + :group 'untabify) + +(defun untabify-before-write () + "Strip all trailing whitespaces and untabify buffer before +save." + (when (and (eq this-command 'save-buffer) + (not (find nil + untabify-exclude-list + :if #'(lambda (r) + (typecase r + (string (string-match r (buffer-name))) + (symbol (eq major-mode r))))))) + (save-excursion + (untabify (point-min) (point-max)) + (delete-trailing-whitespace)))) + +;(add-hook 'write-file-hooks 'untabify-before-write) + +(provide 'untabify-file) diff --git a/emacs.d/rails/untabify-file.el~ b/emacs.d/rails/untabify-file.el~ new file mode 100644 index 0000000..c6eca13 --- /dev/null +++ b/emacs.d/rails/untabify-file.el~ @@ -0,0 +1,56 @@ +;;; untabify-file.el --- automatic untabify files before save + +;; Copyright (C) 2006 Dmitry Galinsky + +;; Authors: Dmitry Galinsky , + +;; Keywords: ruby rails languages oop +;; $URL: svn+ssh://rubyforge/var/svn/emacs-rails/trunk/rails.el $ +;; $Id: rails.el 149 2007-03-29 15:07:49Z dimaexe $ + +;;; License + +;; This program is free software; you can redistribute it and/or +;; modify it under the terms of the GNU General Public License +;; as published by the Free Software Foundation; either version 2 +;; of the License, or (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program; if not, write to the Free Software +;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. + +;;; Code: + +(require 'cl) +(require 'custom) + +(defcustom untabify-exclude-list + '(makefile-mode + makefile-bsdmake-mode + change-log-mode + "Makefile$") + "List of regexp or modes to which is not applied untabify." + :group 'untabify) + +(defun untabify-before-write () + "Strip all trailing whitespaces and untabify buffer before +save." + (when (and (eq this-command 'save-buffer) + (not (find nil + untabify-exclude-list + :if #'(lambda (r) + (typecase r + (string (string-match r (buffer-name))) + (symbol (eq major-mode r))))))) + (save-excursion + (untabify (point-min) (point-max)) + (delete-trailing-whitespace)))) + +(add-hook 'write-file-hooks 'untabify-before-write) + +(provide 'untabify-file) diff --git a/emacs.d/rdebug.el b/emacs.d/rdebug.el new file mode 100644 index 0000000..81ab007 --- /dev/null +++ b/emacs.d/rdebug.el @@ -0,0 +1,136 @@ +;; This file adds support for ruby-debug (rdebug) in Emacs. +;; Copyright (C) 2007 Martin Nordholts +;; +;; This file is based on 'rubydb3x.el' that comes with Ruby which is +;; Copyright (C) Yukihiro Matsumoto aka Matz +;; +;; Installation: +;; ------------- +;; +;; 1. Make sure you have ruby-debug on your system (test by running +;; the commmand 'rdebug -v' in a shell). +;; +;; 2. Copy this file into e.g. ~/.elisp and make sure this is in +;; your ~/.emacs: +;; +;; (add-to-list 'load-path "~/.elisp") +;; (load-library "rdebug") +;; +;; you can then start the debugger with M-x rdebug +;; +;; 3. Setup convenient keybindings etc. This is what I have: +;; +;; (global-set-key [f9] 'gud-step) +;; (global-set-key [f10] 'gud-next) +;; (global-set-key [f11] 'gud-cont) +;; +;; (global-set-key "\C-c\C-d" 'rdebug) +;; +;; 4. Debug like crazy! +;; +;; Bugs: +;; ----- +;; +;; Basic functionality works fine, though there might be a bug hiding somewhere. + +(require 'gud) +(provide 'rdebug) + +;; ====================================================================== +;; rdebug functions + +;;; History of argument lists passed to rdebug. +(defvar gud-rdebug-history nil) + +(if (fboundp 'gud-overload-functions) + (defun gud-rdebug-massage-args (file args) + (cons file args)) + (defun gud-rdebug-massage-args (file args) + args)) + +;; There's no guarantee that Emacs will hand the filter the entire +;; marker at once; it could be broken up across several strings. We +;; might even receive a big chunk with several markers in it. If we +;; receive a chunk of text which looks like it might contain the +;; beginning of a marker, we save it here between calls to the +;; filter. +(defvar gud-rdebug-marker-acc "") +(make-variable-buffer-local 'gud-rdebug-marker-acc) + +(defun gud-rdebug-marker-filter (string) + (setq gud-rdebug-marker-acc (concat gud-rdebug-marker-acc string)) + (let ((output "")) + + ;; Process all the complete markers in this chunk. + (while (string-match "\\([^:\n]*\\):\\([0-9]+\\):.*\n" + gud-rdebug-marker-acc) + (setq + + ;; Extract the frame position from the marker. + gud-last-frame + (cons (substring gud-rdebug-marker-acc (match-beginning 1) (match-end 1)) + (string-to-int (substring gud-rdebug-marker-acc + (match-beginning 2) + (match-end 2)))) + + + ;; Append any text before the marker to the output we're going + ;; to return - we don't include the marker in this text. + output (concat output + (substring gud-rdebug-marker-acc 0 (match-beginning 0))) + + ;; Set the accumulator to the remaining text. + gud-rdebug-marker-acc (substring gud-rdebug-marker-acc (match-end 0)))) + + (setq output (concat output gud-rdebug-marker-acc) + gud-rdebug-marker-acc "") + + output)) + +(defun gud-rdebug-find-file (f) + (save-excursion + (let ((buf (find-file-noselect f))) + (set-buffer buf) +;; (gud-make-debug-menu) + buf))) + +(defvar rdebug-command-name "rdebug" + "File name for executing rdebug.") + +;;;###autoload +(defun rdebug (command-line) + "Run rdebug on program FILE in buffer *gud-FILE*. +The directory containing FILE becomes the initial working directory +and source-file directory for your debugger." + (interactive + (list (read-from-minibuffer "Run rdebug (like this): " + (if (consp gud-rdebug-history) + (car gud-rdebug-history) + (concat rdebug-command-name " ")) + nil nil + '(gud-rdebug-history . 1)))) + + (if (not (fboundp 'gud-overload-functions)) + (gud-common-init command-line 'gud-rdebug-massage-args + 'gud-rdebug-marker-filter 'gud-rdebug-find-file) + (gud-overload-functions '((gud-massage-args . gud-rdebug-massage-args) + (gud-marker-filter . gud-rdebug-marker-filter) + (gud-find-file . gud-rdebug-find-file))) + (gud-common-init command-line rdebug-command-name)) + + (gud-def gud-break "break %d%f:%l" "\C-b" "Set breakpoint at current line in current file.") +; (gud-def gud-remove "delete %d%f:%l" "\C-d" "Remove breakpoint at current line in current file.") + (gud-def gud-step "step" "\C-s" "Step one source line with display.") + (gud-def gud-next "next" "\C-n" "Step one line (skip functions).") + (gud-def gud-cont "cont" "\C-r" "Continue with display.") + (gud-def gud-finish "finish" "\C-f" "Finish executing current function.") + (gud-def gud-up "up %p" "<" "Up N stack frames (numeric arg).") + (gud-def gud-down "down %p" ">" "Down N stack frames (numeric arg).") + (gud-def gud-print "p %e" "\C-p" "Evaluate ruby expression at point.") + + (setq comint-prompt-regexp "^(rdb:-) ") + (if (boundp 'comint-last-output-start) + (set-marker comint-last-output-start (point))) + (set (make-local-variable 'paragraph-start) comint-prompt-regexp) + (run-hooks 'rdebug-mode-hook) + ) diff --git a/emacs.d/ruby-electric.el b/emacs.d/ruby-electric.el new file mode 100644 index 0000000..c469bef --- /dev/null +++ b/emacs.d/ruby-electric.el @@ -0,0 +1,200 @@ +;; -*-Emacs-Lisp-*- +;; +;; ruby-electric.el --- electric editing commands for ruby files +;; +;; Copyright (C) 2005 by Dee Zsombor . +;; Released under same license terms as Ruby. +;; +;; Due credit: this work was inspired by a code snippet posted by +;; Frederick Ros at http://rubygarden.org/ruby?EmacsExtensions. +;; +;; Following improvements where added: +;; +;; - handling of strings of type 'here document' +;; - more keywords, with special handling for 'do' +;; - packaged into a minor mode +;; +;; Usage: +;; +;; 0) copy ruby-electric.el into directory where emacs can find it. +;; +;; 1) modify your startup file (.emacs or whatever) by adding +;; following line: +;; +;; (require 'ruby-electric) +;; +;; note that you need to have font lock enabled beforehand. +;; +;; 2) toggle Ruby Electric Mode on/off with ruby-electric-mode. +;; +;; Changelog: +;; +;; 2005/Jan/14: inserts matching pair delimiters like {, [, (, ', ", +;; ' and | . +;; +;; 2005/Jan/14: added basic Custom support for configuring keywords +;; with electric closing. +;; +;; 2005/Jan/18: more Custom support for configuring characters for +;; which matching expansion should occur. +;; +;; 2005/Jan/18: no longer uses 'looking-back' or regexp character +;; classes like [:space:] since they are not implemented on XEmacs. +;; +;; 2005/Feb/01: explicitly provide default argument of 1 to +;; 'backward-word' as it requires it on Emacs 21.3 +;; +;; 2005/Mar/06: now stored inside ruby CVS; customize pages now have +;; ruby as parent; cosmetic fixes. + + +(require 'ruby-mode) + +(defgroup ruby-electric nil + "Minor mode providing electric editing commands for ruby files" + :group 'ruby) + +(defconst ruby-electric-expandable-do-re + "do\\s-$") + +(defconst ruby-electric-expandable-bar + "\\s-\\(do\\|{\\)\\s-+|") + +(defvar ruby-electric-matching-delimeter-alist + '((?\[ . ?\]) + (?\( . ?\)) + (?\' . ?\') + (?\` . ?\`) + (?\" . ?\"))) + +(defcustom ruby-electric-simple-keywords-re + "\\(def\\|if\\|class\\|module\\|unless\\|case\\|while\\|do\\|until\\|for\\|begin\\)" + "*Regular expresion matching keywords for which closing 'end' +is to be inserted." + :type 'regexp :group 'ruby-electric) + +(defcustom ruby-electric-expand-delimiters-list '(all) + "*List of contexts where matching delimiter should be +inserted. The word 'all' will do all insertions." + :type '(set :extra-offset 8 + (const :tag "Everything" all ) + (const :tag "Curly brace" ?\{ ) + (const :tag "Square brace" ?\[ ) + (const :tag "Round brace" ?\( ) + (const :tag "Quote" ?\' ) + (const :tag "Double quote" ?\" ) + (const :tag "Back quote" ?\` ) + (const :tag "Vertical bar" ?\| )) + :group 'ruby-electric) + +(defcustom ruby-electric-newline-before-closing-bracket nil + "*Controls whether a newline should be inserted before the +closing bracket or not." + :type 'boolean :group 'ruby-electric) + +(define-minor-mode ruby-electric-mode + "Toggle Ruby Electric minor mode. +With no argument, this command toggles the mode. Non-null prefix +argument turns on the mode. Null prefix argument turns off the +mode. + +When Ruby Electric mode is enabled, an indented 'end' is +heuristicaly inserted whenever typing a word like 'module', +'class', 'def', 'if', 'unless', 'case', 'until', 'for', 'begin', +'do'. Simple, double and back quotes as well as braces are paired +auto-magically. Expansion does not occur inside comments and +strings. Note that you must have Font Lock enabled." + ;; initial value. + nil + ;;indicator for the mode line. + " REl" + ;;keymap + ruby-mode-map + (ruby-electric-setup-keymap)) + +(defun ruby-electric-setup-keymap() + (define-key ruby-mode-map " " 'ruby-electric-space) +;; (define-key ruby-mode-map "{" 'ruby-electric-curlies) +;; (define-key ruby-mode-map "(" 'ruby-electric-matching-char) +;; (define-key ruby-mode-map "[" 'ruby-electric-matching-char) +;; (define-key ruby-mode-map "\"" 'ruby-electric-matching-char) +;; (define-key ruby-mode-map "\'" 'ruby-electric-matching-char) + (define-key ruby-mode-map "|" 'ruby-electric-bar)) + +(defun ruby-electric-space (arg) + (interactive "P") + (self-insert-command (prefix-numeric-value arg)) + (if (ruby-electric-space-can-be-expanded-p) + (save-excursion + (ruby-indent-line t) + (newline) + (ruby-insert-end)))) + +(defun ruby-electric-code-at-point-p() + (and ruby-electric-mode + (let* ((properties (text-properties-at (point)))) + (and (null (memq 'font-lock-string-face properties)) + (null (memq 'font-lock-comment-face properties)))))) + +(defun ruby-electric-string-at-point-p() + (and ruby-electric-mode + (consp (memq 'font-lock-string-face (text-properties-at (point)))))) + +(defun ruby-electric-is-last-command-char-expandable-punct-p() + (or (memq 'all ruby-electric-expand-delimiters-list) + (memq last-command-char ruby-electric-expand-delimiters-list))) + +(defun ruby-electric-space-can-be-expanded-p() + (if (ruby-electric-code-at-point-p) + (let* ((ruby-electric-keywords-re + (concat ruby-electric-simple-keywords-re "\\s-$")) + (ruby-electric-single-keyword-in-line-re + (concat "\\s-*" ruby-electric-keywords-re))) + (save-excursion + (backward-word 1) + (or (looking-at ruby-electric-expandable-do-re) + (and (looking-at ruby-electric-keywords-re) + (not (string= "do" (match-string 1))) + (progn + (beginning-of-line) + (looking-at ruby-electric-single-keyword-in-line-re)))))))) + + +(defun ruby-electric-curlies(arg) + (interactive "P") + (self-insert-command (prefix-numeric-value arg)) + (if (ruby-electric-is-last-command-char-expandable-punct-p) + (cond ((ruby-electric-code-at-point-p) + (insert " ") + (save-excursion + (if ruby-electric-newline-before-closing-bracket + (newline)) + (insert "}"))) + ((ruby-electric-string-at-point-p) + (save-excursion + (backward-char 1) + (when (char-equal ?\# (preceding-char)) + (forward-char 1) + (insert "}"))))))) + +(defun ruby-electric-matching-char(arg) + (interactive "P") + (self-insert-command (prefix-numeric-value arg)) + (and (ruby-electric-is-last-command-char-expandable-punct-p) + (ruby-electric-code-at-point-p) + (save-excursion + (insert (cdr (assoc last-command-char + ruby-electric-matching-delimeter-alist)))))) + +(defun ruby-electric-bar(arg) + (interactive "P") + (self-insert-command (prefix-numeric-value arg)) + (and (ruby-electric-is-last-command-char-expandable-punct-p) + (ruby-electric-code-at-point-p) + (and (save-excursion (re-search-backward ruby-electric-expandable-bar nil t)) + (= (point) (match-end 0))) ;looking-back is missing on XEmacs + (save-excursion + (insert "|")))) + + +(provide 'ruby-electric) diff --git a/emacs.d/ruby-electric.el~ b/emacs.d/ruby-electric.el~ new file mode 100644 index 0000000..c361089 --- /dev/null +++ b/emacs.d/ruby-electric.el~ @@ -0,0 +1,200 @@ +;; -*-Emacs-Lisp-*- +;; +;; ruby-electric.el --- electric editing commands for ruby files +;; +;; Copyright (C) 2005 by Dee Zsombor . +;; Released under same license terms as Ruby. +;; +;; Due credit: this work was inspired by a code snippet posted by +;; Frederick Ros at http://rubygarden.org/ruby?EmacsExtensions. +;; +;; Following improvements where added: +;; +;; - handling of strings of type 'here document' +;; - more keywords, with special handling for 'do' +;; - packaged into a minor mode +;; +;; Usage: +;; +;; 0) copy ruby-electric.el into directory where emacs can find it. +;; +;; 1) modify your startup file (.emacs or whatever) by adding +;; following line: +;; +;; (require 'ruby-electric) +;; +;; note that you need to have font lock enabled beforehand. +;; +;; 2) toggle Ruby Electric Mode on/off with ruby-electric-mode. +;; +;; Changelog: +;; +;; 2005/Jan/14: inserts matching pair delimiters like {, [, (, ', ", +;; ' and | . +;; +;; 2005/Jan/14: added basic Custom support for configuring keywords +;; with electric closing. +;; +;; 2005/Jan/18: more Custom support for configuring characters for +;; which matching expansion should occur. +;; +;; 2005/Jan/18: no longer uses 'looking-back' or regexp character +;; classes like [:space:] since they are not implemented on XEmacs. +;; +;; 2005/Feb/01: explicitly provide default argument of 1 to +;; 'backward-word' as it requires it on Emacs 21.3 +;; +;; 2005/Mar/06: now stored inside ruby CVS; customize pages now have +;; ruby as parent; cosmetic fixes. + + +(require 'ruby-mode) + +(defgroup ruby-electric nil + "Minor mode providing electric editing commands for ruby files" + :group 'ruby) + +(defconst ruby-electric-expandable-do-re + "do\\s-$") + +(defconst ruby-electric-expandable-bar + "\\s-\\(do\\|{\\)\\s-+|") + +(defvar ruby-electric-matching-delimeter-alist + '((?\[ . ?\]) + (?\( . ?\)) + (?\' . ?\') + (?\` . ?\`) + (?\" . ?\"))) + +(defcustom ruby-electric-simple-keywords-re + "\\(def\\|if\\|class\\|module\\|unless\\|case\\|while\\|do\\|until\\|for\\|begin\\)" + "*Regular expresion matching keywords for which closing 'end' +is to be inserted." + :type 'regexp :group 'ruby-electric) + +(defcustom ruby-electric-expand-delimiters-list '(all) + "*List of contexts where matching delimiter should be +inserted. The word 'all' will do all insertions." + :type '(set :extra-offset 8 + (const :tag "Everything" all ) + (const :tag "Curly brace" ?\{ ) + (const :tag "Square brace" ?\[ ) + (const :tag "Round brace" ?\( ) + (const :tag "Quote" ?\' ) + (const :tag "Double quote" ?\" ) + (const :tag "Back quote" ?\` ) + (const :tag "Vertical bar" ?\| )) + :group 'ruby-electric) + +(defcustom ruby-electric-newline-before-closing-bracket nil + "*Controls whether a newline should be inserted before the +closing bracket or not." + :type 'boolean :group 'ruby-electric) + +(define-minor-mode ruby-electric-mode + "Toggle Ruby Electric minor mode. +With no argument, this command toggles the mode. Non-null prefix +argument turns on the mode. Null prefix argument turns off the +mode. + +When Ruby Electric mode is enabled, an indented 'end' is +heuristicaly inserted whenever typing a word like 'module', +'class', 'def', 'if', 'unless', 'case', 'until', 'for', 'begin', +'do'. Simple, double and back quotes as well as braces are paired +auto-magically. Expansion does not occur inside comments and +strings. Note that you must have Font Lock enabled." + ;; initial value. + nil + ;;indicator for the mode line. + " REl" + ;;keymap + ruby-mode-map + (ruby-electric-setup-keymap)) + +(defun ruby-electric-setup-keymap() + (define-key ruby-mode-map " " 'ruby-electric-space) + (define-key ruby-mode-map "{" 'ruby-electric-curlies) + (define-key ruby-mode-map "(" 'ruby-electric-matching-char) + (define-key ruby-mode-map "[" 'ruby-electric-matching-char) + (define-key ruby-mode-map "\"" 'ruby-electric-matching-char) + (define-key ruby-mode-map "\'" 'ruby-electric-matching-char) + (define-key ruby-mode-map "|" 'ruby-electric-bar)) + +(defun ruby-electric-space (arg) + (interactive "P") + (self-insert-command (prefix-numeric-value arg)) + (if (ruby-electric-space-can-be-expanded-p) + (save-excursion + (ruby-indent-line t) + (newline) + (ruby-insert-end)))) + +(defun ruby-electric-code-at-point-p() + (and ruby-electric-mode + (let* ((properties (text-properties-at (point)))) + (and (null (memq 'font-lock-string-face properties)) + (null (memq 'font-lock-comment-face properties)))))) + +(defun ruby-electric-string-at-point-p() + (and ruby-electric-mode + (consp (memq 'font-lock-string-face (text-properties-at (point)))))) + +(defun ruby-electric-is-last-command-char-expandable-punct-p() + (or (memq 'all ruby-electric-expand-delimiters-list) + (memq last-command-char ruby-electric-expand-delimiters-list))) + +(defun ruby-electric-space-can-be-expanded-p() + (if (ruby-electric-code-at-point-p) + (let* ((ruby-electric-keywords-re + (concat ruby-electric-simple-keywords-re "\\s-$")) + (ruby-electric-single-keyword-in-line-re + (concat "\\s-*" ruby-electric-keywords-re))) + (save-excursion + (backward-word 1) + (or (looking-at ruby-electric-expandable-do-re) + (and (looking-at ruby-electric-keywords-re) + (not (string= "do" (match-string 1))) + (progn + (beginning-of-line) + (looking-at ruby-electric-single-keyword-in-line-re)))))))) + + +(defun ruby-electric-curlies(arg) + (interactive "P") + (self-insert-command (prefix-numeric-value arg)) + (if (ruby-electric-is-last-command-char-expandable-punct-p) + (cond ((ruby-electric-code-at-point-p) + (insert " ") + (save-excursion + (if ruby-electric-newline-before-closing-bracket + (newline)) + (insert "}"))) + ((ruby-electric-string-at-point-p) + (save-excursion + (backward-char 1) + (when (char-equal ?\# (preceding-char)) + (forward-char 1) + (insert "}"))))))) + +(defun ruby-electric-matching-char(arg) + (interactive "P") + (self-insert-command (prefix-numeric-value arg)) + (and (ruby-electric-is-last-command-char-expandable-punct-p) + (ruby-electric-code-at-point-p) + (save-excursion + (insert (cdr (assoc last-command-char + ruby-electric-matching-delimeter-alist)))))) + +(defun ruby-electric-bar(arg) + (interactive "P") + (self-insert-command (prefix-numeric-value arg)) + (and (ruby-electric-is-last-command-char-expandable-punct-p) + (ruby-electric-code-at-point-p) + (and (save-excursion (re-search-backward ruby-electric-expandable-bar nil t)) + (= (point) (match-end 0))) ;looking-back is missing on XEmacs + (save-excursion + (insert "|")))) + + +(provide 'ruby-electric) diff --git a/emacs.d/ruby-mode.el b/emacs.d/ruby-mode.el new file mode 100644 index 0000000..328a271 --- /dev/null +++ b/emacs.d/ruby-mode.el @@ -0,0 +1,1207 @@ +;;; +;;; ruby-mode.el - +;;; +;;; $Author$ +;;; $Date$ +;;; created at: Fri Feb 4 14:49:13 JST 1994 +;;; + +(defconst ruby-mode-revision "12575") + +(defconst ruby-mode-version + (progn + (string-match "[0-9.]+" ruby-mode-revision) + (substring ruby-mode-revision (match-beginning 0) (match-end 0)))) + +(defconst ruby-block-beg-re + "class\\|module\\|def\\|if\\|unless\\|case\\|while\\|until\\|for\\|begin\\|do" + ) + +(defconst ruby-non-block-do-re + "\\(while\\|until\\|for\\|rescue\\)\\>[^_]" + ) + +(defconst ruby-indent-beg-re + "\\(\\s *\\(class\\|module\\|def\\)\\)\\|if\\|unless\\|case\\|while\\|until\\|for\\|begin" + ) + +(defconst ruby-modifier-beg-re + "if\\|unless\\|while\\|until" + ) + +(defconst ruby-modifier-re + (concat ruby-modifier-beg-re "\\|rescue") + ) + +(defconst ruby-block-mid-re + "then\\|else\\|elsif\\|when\\|rescue\\|ensure" + ) + +(defconst ruby-block-op-re + "and\\|or\\|not" + ) + +(defconst ruby-block-hanging-re + (concat ruby-modifier-beg-re "\\|" ruby-block-op-re) + ) + +(defconst ruby-block-end-re "\\") + +(defconst ruby-here-doc-beg-re + "<<\\(-\\)?\\(\\([a-zA-Z0-9_]+\\)\\|[\"]\\([^\"]+\\)[\"]\\|[']\\([^']+\\)[']\\)") + +(defun ruby-here-doc-end-match () + (concat "^" + (if (match-string 1) "[ \t]*" nil) + (regexp-quote + (or (match-string 3) + (match-string 4) + (match-string 5))))) + +(defconst ruby-delimiter + (concat "[?$/%(){}#\"'`.:]\\|<<\\|\\[\\|\\]\\|\\<\\(" + ruby-block-beg-re + "\\)\\>\\|" ruby-block-end-re + "\\|^=begin\\|" ruby-here-doc-beg-re) + ) + +(defconst ruby-negative + (concat "^[ \t]*\\(\\(" ruby-block-mid-re "\\)\\>\\|" + ruby-block-end-re "\\|}\\|\\]\\)") + ) + +(defconst ruby-operator-chars "-,.+*/%&|^~=<>:") +(defconst ruby-operator-re (concat "[" ruby-operator-chars "]")) + +(defconst ruby-symbol-chars "a-zA-Z0-9_") +(defconst ruby-symbol-re (concat "[" ruby-symbol-chars "]")) + +(defvar ruby-mode-abbrev-table nil + "Abbrev table in use in ruby-mode buffers.") + +(define-abbrev-table 'ruby-mode-abbrev-table ()) + +(defvar ruby-mode-map nil "Keymap used in ruby mode.") + +(if ruby-mode-map + nil + (setq ruby-mode-map (make-sparse-keymap)) + (define-key ruby-mode-map "{" 'ruby-electric-brace) + (define-key ruby-mode-map "}" 'ruby-electric-brace) + (define-key ruby-mode-map "\e\C-a" 'ruby-beginning-of-defun) + (define-key ruby-mode-map "\e\C-e" 'ruby-end-of-defun) + (define-key ruby-mode-map "\e\C-b" 'ruby-backward-sexp) + (define-key ruby-mode-map "\e\C-f" 'ruby-forward-sexp) + (define-key ruby-mode-map "\e\C-p" 'ruby-beginning-of-block) + (define-key ruby-mode-map "\e\C-n" 'ruby-end-of-block) + (define-key ruby-mode-map "\e\C-h" 'ruby-mark-defun) + (define-key ruby-mode-map "\e\C-q" 'ruby-indent-exp) + (define-key ruby-mode-map "\t" 'ruby-indent-command) + (define-key ruby-mode-map "\C-c\C-e" 'ruby-insert-end) + (define-key ruby-mode-map "\C-j" 'ruby-reindent-then-newline-and-indent) + (define-key ruby-mode-map "\C-m" 'newline)) + +(defvar ruby-mode-syntax-table nil + "Syntax table in use in ruby-mode buffers.") + +(if ruby-mode-syntax-table + () + (setq ruby-mode-syntax-table (make-syntax-table)) + (modify-syntax-entry ?\' "\"" ruby-mode-syntax-table) + (modify-syntax-entry ?\" "\"" ruby-mode-syntax-table) + (modify-syntax-entry ?\` "\"" ruby-mode-syntax-table) + (modify-syntax-entry ?# "<" ruby-mode-syntax-table) + (modify-syntax-entry ?\n ">" ruby-mode-syntax-table) + (modify-syntax-entry ?\\ "\\" ruby-mode-syntax-table) + (modify-syntax-entry ?$ "." ruby-mode-syntax-table) + (modify-syntax-entry ?? "_" ruby-mode-syntax-table) + (modify-syntax-entry ?_ "_" ruby-mode-syntax-table) + (modify-syntax-entry ?< "." ruby-mode-syntax-table) + (modify-syntax-entry ?> "." ruby-mode-syntax-table) + (modify-syntax-entry ?& "." ruby-mode-syntax-table) + (modify-syntax-entry ?| "." ruby-mode-syntax-table) + (modify-syntax-entry ?% "." ruby-mode-syntax-table) + (modify-syntax-entry ?= "." ruby-mode-syntax-table) + (modify-syntax-entry ?/ "." ruby-mode-syntax-table) + (modify-syntax-entry ?+ "." ruby-mode-syntax-table) + (modify-syntax-entry ?* "." ruby-mode-syntax-table) + (modify-syntax-entry ?- "." ruby-mode-syntax-table) + (modify-syntax-entry ?\; "." ruby-mode-syntax-table) + (modify-syntax-entry ?\( "()" ruby-mode-syntax-table) + (modify-syntax-entry ?\) ")(" ruby-mode-syntax-table) + (modify-syntax-entry ?\{ "(}" ruby-mode-syntax-table) + (modify-syntax-entry ?\} "){" ruby-mode-syntax-table) + (modify-syntax-entry ?\[ "(]" ruby-mode-syntax-table) + (modify-syntax-entry ?\] ")[" ruby-mode-syntax-table) + ) + +(defcustom ruby-indent-tabs-mode nil + "*Indentation can insert tabs in ruby mode if this is non-nil." + :type 'boolean :group 'ruby) + +(defcustom ruby-indent-level 2 + "*Indentation of ruby statements." + :type 'integer :group 'ruby) + +(defcustom ruby-comment-column 32 + "*Indentation column of comments." + :type 'integer :group 'ruby) + +(defcustom ruby-deep-arglist t + "*Deep indent lists in parenthesis when non-nil. +Also ignores spaces after parenthesis when 'space." + :group 'ruby) + +(defcustom ruby-deep-indent-paren '(?\( ?\[ ?\] t) + "*Deep indent lists in parenthesis when non-nil. t means continuous line. +Also ignores spaces after parenthesis when 'space." + :group 'ruby) + +(defcustom ruby-deep-indent-paren-style 'space + "Default deep indent style." + :options '(t nil space) :group 'ruby) + +(eval-when-compile (require 'cl)) +(defun ruby-imenu-create-index-in-block (prefix beg end) + (let ((index-alist '()) (case-fold-search nil) + name next pos decl sing) + (goto-char beg) + (while (re-search-forward "^\\s *\\(\\(class\\>\\(\\s *<<\\)?\\|module\\>\\)\\s *\\([^\(<\n ]+\\)\\|\\(def\\|alias\\)\\>\\s *\\([^\(\n ]+\\)\\)" end t) + (setq sing (match-beginning 3)) + (setq decl (match-string 5)) + (setq next (match-end 0)) + (setq name (or (match-string 4) (match-string 6))) + (setq pos (match-beginning 0)) + (cond + ((string= "alias" decl) + (if prefix (setq name (concat prefix name))) + (push (cons name pos) index-alist)) + ((string= "def" decl) + (if prefix + (setq name + (cond + ((string-match "^self\." name) + (concat (substring prefix 0 -1) (substring name 4))) + (t (concat prefix name))))) + (push (cons name pos) index-alist) + (ruby-accurate-end-of-block end)) + (t + (if (string= "self" name) + (if prefix (setq name (substring prefix 0 -1))) + (if prefix (setq name (concat (substring prefix 0 -1) "::" name))) + (push (cons name pos) index-alist)) + (ruby-accurate-end-of-block end) + (setq beg (point)) + (setq index-alist + (nconc (ruby-imenu-create-index-in-block + (concat name (if sing "." "#")) + next beg) index-alist)) + (goto-char beg)))) + index-alist)) + +(defun ruby-imenu-create-index () + (nreverse (ruby-imenu-create-index-in-block nil (point-min) nil))) + +(defun ruby-accurate-end-of-block (&optional end) + (let (state) + (or end (setq end (point-max))) + (while (and (setq state (apply 'ruby-parse-partial end state)) + (>= (nth 2 state) 0) (< (point) end))))) + +(defun ruby-mode-variables () + (set-syntax-table ruby-mode-syntax-table) + (setq local-abbrev-table ruby-mode-abbrev-table) + (make-local-variable 'indent-line-function) + (setq indent-line-function 'ruby-indent-line) + (make-local-variable 'require-final-newline) + (setq require-final-newline t) + (make-variable-buffer-local 'comment-start) + (setq comment-start "# ") + (make-variable-buffer-local 'comment-end) + (setq comment-end "") + (make-variable-buffer-local 'comment-column) + (setq comment-column ruby-comment-column) + (make-variable-buffer-local 'comment-start-skip) + (setq comment-start-skip "#+ *") + (setq indent-tabs-mode ruby-indent-tabs-mode) + (make-local-variable 'parse-sexp-ignore-comments) + (setq parse-sexp-ignore-comments t) + (make-local-variable 'paragraph-start) + (setq paragraph-start (concat "$\\|" page-delimiter)) + (make-local-variable 'paragraph-separate) + (setq paragraph-separate paragraph-start) + (make-local-variable 'paragraph-ignore-fill-prefix) + (setq paragraph-ignore-fill-prefix t)) + +;;;###autoload +(defun ruby-mode () + "Major mode for editing ruby scripts. +\\[ruby-indent-command] properly indents subexpressions of multi-line +class, module, def, if, while, for, do, and case statements, taking +nesting into account. + +The variable ruby-indent-level controls the amount of indentation. +\\{ruby-mode-map}" + (interactive) + (kill-all-local-variables) + (use-local-map ruby-mode-map) + (setq mode-name "Ruby") + (setq major-mode 'ruby-mode) + (ruby-mode-variables) + + (make-local-variable 'imenu-create-index-function) + (setq imenu-create-index-function 'ruby-imenu-create-index) + + (make-local-variable 'add-log-current-defun-function) + (setq add-log-current-defun-function 'ruby-add-log-current-method) + + (run-hooks 'ruby-mode-hook)) + +(defun ruby-current-indentation () + (save-excursion + (beginning-of-line) + (back-to-indentation) + (current-column))) + +(defun ruby-indent-line (&optional flag) + "Correct indentation of the current ruby line." + (ruby-indent-to (ruby-calculate-indent))) + +(defun ruby-indent-command () + (interactive) + (ruby-indent-line t)) + +(defun ruby-indent-to (x) + (if x + (let (shift top beg) + (and (< x 0) (error "invalid nest")) + (setq shift (current-column)) + (beginning-of-line) + (setq beg (point)) + (back-to-indentation) + (setq top (current-column)) + (skip-chars-backward " \t") + (if (>= shift top) (setq shift (- shift top)) + (setq shift 0)) + (if (and (bolp) + (= x top)) + (move-to-column (+ x shift)) + (move-to-column top) + (delete-region beg (point)) + (beginning-of-line) + (indent-to x) + (move-to-column (+ x shift)))))) + +(defun ruby-special-char-p (&optional pnt) + (setq pnt (or pnt (point))) + (let ((c (char-before pnt)) (b (and (< (point-min) pnt) (char-before (1- pnt))))) + (cond ((or (eq c ??) (eq c ?$))) + ((and (eq c ?:) (or (not b) (eq (char-syntax b) ? )))) + ((eq c ?\\) (eq b ??))))) + +(defun ruby-expr-beg (&optional option) + (save-excursion + (store-match-data nil) + (let ((space (skip-chars-backward " \t")) + (start (point))) + (cond + ((bolp) t) + ((progn + (forward-char -1) + (and (looking-at "\\?") + (or (eq (char-syntax (char-before (point))) ?w) + (ruby-special-char-p)))) + nil) + ((and (eq option 'heredoc) (< space 0)) t) + ((or (looking-at ruby-operator-re) + (looking-at "[\\[({,;]") + (and (looking-at "[!?]") + (or (not (eq option 'modifier)) + (bolp) + (save-excursion (forward-char -1) (looking-at "\\Sw$")))) + (and (looking-at ruby-symbol-re) + (skip-chars-backward ruby-symbol-chars) + (cond + ((or (looking-at (concat "\\<\\(" ruby-block-beg-re + "|" ruby-block-op-re + "|" ruby-block-mid-re "\\)\\>"))) + (goto-char (match-end 0)) + (not (looking-at "\\s_"))) + ((eq option 'expr-qstr) + (looking-at "[a-zA-Z][a-zA-z0-9_]* +%[^ \t]")) + ((eq option 'expr-re) + (looking-at "[a-zA-Z][a-zA-z0-9_]* +/[^ \t]")) + (t nil))))))))) + +(defun ruby-forward-string (term &optional end no-error expand) + (let ((n 1) (c (string-to-char term)) + (re (if expand + (concat "[^\\]\\(\\\\\\\\\\)*\\([" term "]\\|\\(#{\\)\\)") + (concat "[^\\]\\(\\\\\\\\\\)*[" term "]")))) + (while (and (re-search-forward re end no-error) + (if (match-beginning 3) + (ruby-forward-string "}{" end no-error nil) + (> (setq n (if (eq (char-before (point)) c) + (1- n) (1+ n))) 0))) + (forward-char -1)) + (cond ((zerop n)) + (no-error nil) + ((error "unterminated string"))))) + +(defun ruby-deep-indent-paren-p (c) + (cond ((listp ruby-deep-indent-paren) + (let ((deep (assoc c ruby-deep-indent-paren))) + (cond (deep + (or (cdr deep) ruby-deep-indent-paren-style)) + ((memq c ruby-deep-indent-paren) + ruby-deep-indent-paren-style)))) + ((eq c ruby-deep-indent-paren) ruby-deep-indent-paren-style) + ((eq c ?\( ) ruby-deep-arglist))) + +(defun ruby-parse-partial (&optional end in-string nest depth pcol indent) + (or depth (setq depth 0)) + (or indent (setq indent 0)) + (when (re-search-forward ruby-delimiter end 'move) + (let ((pnt (point)) w re expand) + (goto-char (match-beginning 0)) + (cond + ((and (memq (char-before) '(?@ ?$)) (looking-at "\\sw")) + (goto-char pnt)) + ((looking-at "[\"`]") ;skip string + (cond + ((and (not (eobp)) + (ruby-forward-string (buffer-substring (point) (1+ (point))) end t t)) + nil) + (t + (setq in-string (point)) + (goto-char end)))) + ((looking-at "'") + (cond + ((and (not (eobp)) + (re-search-forward "[^\\]\\(\\\\\\\\\\)*'" end t)) + nil) + (t + (setq in-string (point)) + (goto-char end)))) + ((looking-at "/=") + (goto-char pnt)) + ((looking-at "/") + (cond + ((and (not (eobp)) (ruby-expr-beg 'expr-re)) + (if (ruby-forward-string "/" end t t) + nil + (setq in-string (point)) + (goto-char end))) + (t + (goto-char pnt)))) + ((looking-at "%") + (cond + ((and (not (eobp)) + (ruby-expr-beg 'expr-qstr) + (not (looking-at "%=")) + (looking-at "%[QqrxWw]?\\([^a-zA-Z0-9 \t\n]\\)")) + (goto-char (match-beginning 1)) + (setq expand (not (memq (char-before) '(?q ?w)))) + (setq w (match-string 1)) + (cond + ((string= w "[") (setq re "][")) + ((string= w "{") (setq re "}{")) + ((string= w "(") (setq re ")(")) + ((string= w "<") (setq re "><")) + ((and expand (string= w "\\")) + (setq w (concat "\\" w)))) + (unless (cond (re (ruby-forward-string re end t expand)) + (expand (ruby-forward-string w end t t)) + (t (re-search-forward + (if (string= w "\\") + "\\\\[^\\]*\\\\" + (concat "[^\\]\\(\\\\\\\\\\)*" w)) + end t))) + (setq in-string (point)) + (goto-char end))) + (t + (goto-char pnt)))) + ((looking-at "\\?") ;skip ?char + (cond + ((and (ruby-expr-beg) + (looking-at "?\\(\\\\C-\\|\\\\M-\\)*\\\\?.")) + (goto-char (match-end 0))) + (t + (goto-char pnt)))) + ((looking-at "\\$") ;skip $char + (goto-char pnt) + (forward-char 1)) + ((looking-at "#") ;skip comment + (forward-line 1) + (goto-char (point)) + ) + ((looking-at "[\\[{(]") + (let ((deep (ruby-deep-indent-paren-p (char-after)))) + (if (and deep (or (not (eq (char-after) ?\{)) (ruby-expr-beg))) + (progn + (and (eq deep 'space) (looking-at ".\\s +[^# \t\n]") + (setq pnt (1- (match-end 0)))) + (setq nest (cons (cons (char-after (point)) pnt) nest)) + (setq pcol (cons (cons pnt depth) pcol)) + (setq depth 0)) + (setq nest (cons (cons (char-after (point)) pnt) nest)) + (setq depth (1+ depth)))) + (goto-char pnt) + ) + ((looking-at "[])}]") + (if (ruby-deep-indent-paren-p (matching-paren (char-after))) + (setq depth (cdr (car pcol)) pcol (cdr pcol)) + (setq depth (1- depth))) + (setq nest (cdr nest)) + (goto-char pnt)) + ((looking-at ruby-block-end-re) + (if (or (and (not (bolp)) + (progn + (forward-char -1) + (setq w (char-after (point))) + (or (eq ?_ w) + (eq ?. w)))) + (progn + (goto-char pnt) + (setq w (char-after (point))) + (or (eq ?_ w) + (eq ?! w) + (eq ?? w)))) + nil + (setq nest (cdr nest)) + (setq depth (1- depth))) + (goto-char pnt)) + ((looking-at "def\\s +[^(\n;]*") + (if (or (bolp) + (progn + (forward-char -1) + (not (eq ?_ (char-after (point)))))) + (progn + (setq nest (cons (cons nil pnt) nest)) + (setq depth (1+ depth)))) + (goto-char (match-end 0))) + ((looking-at (concat "\\<\\(" ruby-block-beg-re "\\)\\>")) + (and + (save-match-data + (or (not (looking-at "do\\>[^_]")) + (save-excursion + (back-to-indentation) + (not (looking-at ruby-non-block-do-re))))) + (or (bolp) + (progn + (forward-char -1) + (setq w (char-after (point))) + (not (or (eq ?_ w) + (eq ?. w))))) + (goto-char pnt) + (setq w (char-after (point))) + (not (eq ?_ w)) + (not (eq ?! w)) + (not (eq ?? w)) + (skip-chars-forward " \t") + (goto-char (match-beginning 0)) + (or (not (looking-at ruby-modifier-re)) + (ruby-expr-beg 'modifier)) + (goto-char pnt) + (setq nest (cons (cons nil pnt) nest)) + (setq depth (1+ depth))) + (goto-char pnt)) + ((looking-at ":\\(['\"]\\)\\(\\\\.\\|[^\\\\]\\)*\\1") + (goto-char (match-end 0))) + ((looking-at ":\\([-,.+*/%&|^~<>]=?\\|===?\\|<=>\\)") + (goto-char (match-end 0))) + ((looking-at ":\\([a-zA-Z_][a-zA-Z_0-9]*[!?=]?\\)?") + (goto-char (match-end 0))) + ((or (looking-at "\\.\\.\\.?") + (looking-at "\\.[0-9]+") + (looking-at "\\.[a-zA-Z_0-9]+") + (looking-at "\\.")) + (goto-char (match-end 0))) + ((looking-at "^=begin") + (if (re-search-forward "^=end" end t) + (forward-line 1) + (setq in-string (match-end 0)) + (goto-char end))) + ((looking-at "<<") + (cond + ((and (ruby-expr-beg 'heredoc) + (looking-at "<<\\(-\\)?\\(\\([\"'`]\\)\\([^\n]+?\\)\\3\\|\\(?:\\sw\\|\\s_\\)+\\)")) + (setq re (regexp-quote (or (match-string 4) (match-string 2)))) + (if (match-beginning 1) (setq re (concat "\\s *" re))) + (let* ((id-end (goto-char (match-end 0))) + (line-end-position (save-excursion (end-of-line) (point))) + (state (list in-string nest depth pcol indent))) + ;; parse the rest of the line + (while (and (> line-end-position (point)) + (setq state (apply 'ruby-parse-partial + line-end-position state)))) + (setq in-string (car state) + nest (nth 1 state) + depth (nth 2 state) + pcol (nth 3 state) + indent (nth 4 state)) + ;; skip heredoc section + (if (re-search-forward (concat "^" re "$") end 'move) + (forward-line 1) + (setq in-string id-end) + (goto-char end)))) + (t + (goto-char pnt)))) + ((looking-at "^__END__$") + (goto-char pnt)) + ((looking-at ruby-here-doc-beg-re) + (if (re-search-forward (ruby-here-doc-end-match) + indent-point t) + (forward-line 1) + (setq in-string (match-end 0)) + (goto-char indent-point))) + (t + (error (format "bad string %s" + (buffer-substring (point) pnt) + )))))) + (list in-string nest depth pcol)) + +(defun ruby-parse-region (start end) + (let (state) + (save-excursion + (if start + (goto-char start) + (ruby-beginning-of-indent)) + (save-restriction + (narrow-to-region (point) end) + (while (and (> end (point)) + (setq state (apply 'ruby-parse-partial end state)))))) + (list (nth 0 state) ; in-string + (car (nth 1 state)) ; nest + (nth 2 state) ; depth + (car (car (nth 3 state))) ; pcol + ;(car (nth 5 state)) ; indent + ))) + +(defun ruby-indent-size (pos nest) + (+ pos (* (or nest 1) ruby-indent-level))) + +(defun ruby-calculate-indent (&optional parse-start) + (save-excursion + (beginning-of-line) + (let ((indent-point (point)) + (case-fold-search nil) + state bol eol begin op-end + (paren (progn (skip-syntax-forward " ") + (and (char-after) (matching-paren (char-after))))) + (indent 0)) + (if parse-start + (goto-char parse-start) + (ruby-beginning-of-indent) + (setq parse-start (point))) + (back-to-indentation) + (setq indent (current-column)) + (setq state (ruby-parse-region parse-start indent-point)) + (cond + ((nth 0 state) ; within string + (setq indent nil)) ; do nothing + ((car (nth 1 state)) ; in paren + (goto-char (setq begin (cdr (nth 1 state)))) + (let ((deep (ruby-deep-indent-paren-p (car (nth 1 state))))) + (if deep + (cond ((and (eq deep t) (eq (car (nth 1 state)) paren)) + (skip-syntax-backward " ") + (setq indent (1- (current-column)))) + ((let ((s (ruby-parse-region (point) indent-point))) + (and (nth 2 s) (> (nth 2 s) 0) + (or (goto-char (cdr (nth 1 s))) t))) + (forward-word -1) + (setq indent (ruby-indent-size (current-column) (nth 2 state)))) + (t + (setq indent (current-column)) + (cond ((eq deep 'space)) + (paren (setq indent (1- indent))) + (t (setq indent (ruby-indent-size (1- indent) 1)))))) + (if (nth 3 state) (goto-char (nth 3 state)) + (goto-char parse-start) (back-to-indentation)) + (setq indent (ruby-indent-size (current-column) (nth 2 state)))) + (and (eq (car (nth 1 state)) paren) + (ruby-deep-indent-paren-p (matching-paren paren)) + (search-backward (char-to-string paren)) + (setq indent (current-column))))) + ((and (nth 2 state) (> (nth 2 state) 0)) ; in nest + (if (null (cdr (nth 1 state))) + (error "invalid nest")) + (goto-char (cdr (nth 1 state))) + (forward-word -1) ; skip back a keyword + (setq begin (point)) + (cond + ((looking-at "do\\>[^_]") ; iter block is a special case + (if (nth 3 state) (goto-char (nth 3 state)) + (goto-char parse-start) (back-to-indentation)) + (setq indent (ruby-indent-size (current-column) (nth 2 state)))) + (t + (setq indent (+ (current-column) ruby-indent-level))))) + + ((and (nth 2 state) (< (nth 2 state) 0)) ; in negative nest + (setq indent (ruby-indent-size (current-column) (nth 2 state))))) + (when indent + (goto-char indent-point) + (end-of-line) + (setq eol (point)) + (beginning-of-line) + (cond + ((and (not (ruby-deep-indent-paren-p paren)) + (re-search-forward ruby-negative eol t)) + (and (not (eq ?_ (char-after (match-end 0)))) + (setq indent (- indent ruby-indent-level)))) + ((and + (save-excursion + (beginning-of-line) + (not (bobp))) + (or (ruby-deep-indent-paren-p t) + (null (car (nth 1 state))))) + ;; goto beginning of non-empty no-comment line + (let (end done) + (while (not done) + (skip-chars-backward " \t\n") + (setq end (point)) + (beginning-of-line) + (if (re-search-forward "^\\s *#" end t) + (beginning-of-line) + (setq done t)))) + (setq bol (point)) + (end-of-line) + ;; skip the comment at the end + (skip-chars-backward " \t") + (let (end (pos (point))) + (beginning-of-line) + (while (and (re-search-forward "#" pos t) + (setq end (1- (point))) + (or (ruby-special-char-p end) + (and (setq state (ruby-parse-region parse-start end)) + (nth 0 state)))) + (setq end nil)) + (goto-char (or end pos)) + (skip-chars-backward " \t") + (setq begin (if (nth 0 state) pos (cdr (nth 1 state)))) + (setq state (ruby-parse-region parse-start (point)))) + (or (bobp) (forward-char -1)) + (and + (or (and (looking-at ruby-symbol-re) + (skip-chars-backward ruby-symbol-chars) + (looking-at (concat "\\<\\(" ruby-block-hanging-re "\\)\\>")) + (not (eq (point) (nth 3 state))) + (save-excursion + (goto-char (match-end 0)) + (not (looking-at "[a-z_]")))) + (and (looking-at ruby-operator-re) + (not (ruby-special-char-p)) + ;; operator at the end of line + (let ((c (char-after (point)))) + (and +;; (or (null begin) +;; (save-excursion +;; (goto-char begin) +;; (skip-chars-forward " \t") +;; (not (or (eolp) (looking-at "#") +;; (and (eq (car (nth 1 state)) ?{) +;; (looking-at "|")))))) + (or (not (eq ?/ c)) + (null (nth 0 (ruby-parse-region (or begin parse-start) (point))))) + (or (not (eq ?| (char-after (point)))) + (save-excursion + (or (eolp) (forward-char -1)) + (cond + ((search-backward "|" nil t) + (skip-chars-backward " \t\n") + (and (not (eolp)) + (progn + (forward-char -1) + (not (looking-at "{"))) + (progn + (forward-word -1) + (not (looking-at "do\\>[^_]"))))) + (t t)))) + (not (eq ?, c)) + (setq op-end t))))) + (setq indent + (cond + ((and + (null op-end) + (not (looking-at (concat "\\<\\(" ruby-block-hanging-re "\\)\\>"))) + (eq (ruby-deep-indent-paren-p t) 'space) + (not (bobp))) + (save-excursion + (widen) + (goto-char (or begin parse-start)) + (skip-syntax-forward " ") + (current-column))) + ((car (nth 1 state)) indent) + (t + (+ indent ruby-indent-level)))))))) + indent))) + +(defun ruby-electric-brace (arg) + (interactive "P") + (insert-char last-command-char 1) + (ruby-indent-line t) + (delete-char -1) + (self-insert-command (prefix-numeric-value arg))) + +(eval-when-compile + (defmacro defun-region-command (func args &rest body) + (let ((intr (car body))) + (when (featurep 'xemacs) + (if (stringp intr) (setq intr (cadr body))) + (and (eq (car intr) 'interactive) + (setq intr (cdr intr)) + (setcar intr (concat "_" (car intr))))) + (cons 'defun (cons func (cons args body)))))) + +(defun-region-command ruby-beginning-of-defun (&optional arg) + "Move backward to next beginning-of-defun. +With argument, do this that many times. +Returns t unless search stops due to end of buffer." + (interactive "p") + (and (re-search-backward (concat "^\\(" ruby-block-beg-re "\\)\\b") + nil 'move (or arg 1)) + (progn (beginning-of-line) t))) + +(defun ruby-beginning-of-indent () + (and (re-search-backward (concat "^\\(" ruby-indent-beg-re "\\)\\b") + nil 'move) + (progn + (beginning-of-line) + t))) + +(defun-region-command ruby-end-of-defun (&optional arg) + "Move forward to next end of defun. +An end of a defun is found by moving forward from the beginning of one." + (interactive "p") + (and (re-search-forward (concat "^\\(" ruby-block-end-re "\\)\\($\\|\\b[^_]\\)") + nil 'move (or arg 1)) + (progn (beginning-of-line) t)) + (forward-line 1)) + +(defun ruby-move-to-block (n) + (let (start pos done down) + (setq start (ruby-calculate-indent)) + (setq down (looking-at (if (< n 0) ruby-block-end-re + (concat "\\<\\(" ruby-block-beg-re "\\)\\>")))) + (while (and (not done) (not (if (< n 0) (bobp) (eobp)))) + (forward-line n) + (cond + ((looking-at "^\\s *$")) + ((looking-at "^\\s *#")) + ((and (> n 0) (looking-at "^=begin\\>")) + (re-search-forward "^=end\\>")) + ((and (< n 0) (looking-at "^=end\\>")) + (re-search-backward "^=begin\\>")) + (t + (setq pos (current-indentation)) + (cond + ((< start pos) + (setq down t)) + ((and down (= pos start)) + (setq done t)) + ((> start pos) + (setq done t))))) + (if done + (save-excursion + (back-to-indentation) + (if (looking-at (concat "\\<\\(" ruby-block-mid-re "\\)\\>")) + (setq done nil)))))) + (back-to-indentation)) + +(defun-region-command ruby-beginning-of-block (&optional arg) + "Move backward to next beginning-of-block" + (interactive "p") + (ruby-move-to-block (- (or arg 1)))) + +(defun-region-command ruby-end-of-block (&optional arg) + "Move forward to next beginning-of-block" + (interactive "p") + (ruby-move-to-block (or arg 1))) + +(defun-region-command ruby-forward-sexp (&optional cnt) + (interactive "p") + (if (and (numberp cnt) (< cnt 0)) + (ruby-backward-sexp (- cnt)) + (let ((i (or cnt 1))) + (condition-case nil + (while (> i 0) + (skip-syntax-forward " ") + (cond ((looking-at "\\?\\(\\\\[CM]-\\)*\\\\?\\S ") + (goto-char (match-end 0))) + ((progn + (skip-chars-forward ",.:;|&^~=!?\\+\\-\\*") + (looking-at "\\s(")) + (goto-char (scan-sexps (point) 1))) + ((and (looking-at (concat "\\<\\(" ruby-block-beg-re "\\)\\>")) + (not (eq (char-before (point)) ?.)) + (not (eq (char-before (point)) ?:))) + (ruby-end-of-block) + (forward-word 1)) + ((looking-at "\\(\\$\\|@@?\\)?\\sw") + (while (progn + (while (progn (forward-word 1) (looking-at "_"))) + (cond ((looking-at "::") (forward-char 2) t) + ((> (skip-chars-forward ".") 0)) + ((looking-at "\\?\\|!\\(=[~=>]\\|[^~=]\\)") + (forward-char 1) nil))))) + ((let (state expr) + (while + (progn + (setq expr (or expr (ruby-expr-beg) + (looking-at "%\\sw?\\Sw\\|[\"'`/]"))) + (nth 1 (setq state (apply 'ruby-parse-partial nil state)))) + (setq expr t) + (skip-chars-forward "<")) + (not expr)))) + (setq i (1- i))) + ((error) (forward-word 1))) + i))) + +(defun-region-command ruby-backward-sexp (&optional cnt) + (interactive "p") + (if (and (numberp cnt) (< cnt 0)) + (ruby-forward-sexp (- cnt)) + (let ((i (or cnt 1))) + (condition-case nil + (while (> i 0) + (skip-chars-backward " \t\n,.:;|&^~=!?\\+\\-\\*") + (forward-char -1) + (cond ((looking-at "\\s)") + (goto-char (scan-sexps (1+ (point)) -1)) + (case (char-before) + (?% (forward-char -1)) + ('(?q ?Q ?w ?W ?r ?x) + (if (eq (char-before (1- (point))) ?%) (forward-char -2)))) + nil) + ((looking-at "\\s\"\\|\\\\\\S_") + (let ((c (char-to-string (char-before (match-end 0))))) + (while (and (search-backward c) + (oddp (skip-chars-backward "\\"))))) + nil) + ((looking-at "\\s.\\|\\s\\") + (if (ruby-special-char-p) (forward-char -1))) + ((looking-at "\\s(") nil) + (t + (forward-char 1) + (while (progn (forward-word -1) + (case (char-before) + (?_ t) + (?. (forward-char -1) t) + ((?$ ?@) + (forward-char -1) + (and (eq (char-before) (char-after)) (forward-char -1))) + (?: + (forward-char -1) + (eq (char-before) :))))) + (if (looking-at ruby-block-end-re) + (ruby-beginning-of-block)) + nil)) + (setq i (1- i))) + ((error))) + i))) + +(defun ruby-reindent-then-newline-and-indent () + (interactive "*") + (newline) + (save-excursion + (end-of-line 0) + (indent-according-to-mode) + (delete-region (point) (progn (skip-chars-backward " \t") (point)))) + (indent-according-to-mode)) + +(fset 'ruby-encomment-region (symbol-function 'comment-region)) + +(defun ruby-decomment-region (beg end) + (interactive "r") + (save-excursion + (goto-char beg) + (while (re-search-forward "^\\([ \t]*\\)#" end t) + (replace-match "\\1" nil nil) + (save-excursion + (ruby-indent-line))))) + +(defun ruby-insert-end () + (interactive) + (insert "end") + (ruby-indent-line t) + (end-of-line)) + +(defun ruby-mark-defun () + "Put mark at end of this Ruby function, point at beginning." + (interactive) + (push-mark (point)) + (ruby-end-of-defun) + (push-mark (point) nil t) + (ruby-beginning-of-defun) + (re-search-backward "^\n" (- (point) 1) t)) + +(defun ruby-indent-exp (&optional shutup-p) + "Indent each line in the balanced expression following point syntactically. +If optional SHUTUP-P is non-nil, no errors are signalled if no +balanced expression is found." + (interactive "*P") + (let ((here (point-marker)) start top column (nest t)) + (set-marker-insertion-type here t) + (unwind-protect + (progn + (beginning-of-line) + (setq start (point) top (current-indentation)) + (while (and (not (eobp)) + (progn + (setq column (ruby-calculate-indent start)) + (cond ((> column top) + (setq nest t)) + ((and (= column top) nest) + (setq nest nil) t)))) + (ruby-indent-to column) + (beginning-of-line 2))) + (goto-char here) + (set-marker here nil)))) + +(defun ruby-add-log-current-method () + "Return current method string." + (condition-case nil + (save-excursion + (let ((mlist nil) (indent 0)) + ;; get current method (or class/module) + (if (re-search-backward + (concat "^[ \t]*\\(def\\|class\\|module\\)[ \t]+" + "\\(" + ;; \\. for class method + "\\(" ruby-symbol-re "\\|\\." "\\)" + "+\\)") + nil t) + (progn + (setq mlist (list (match-string 2))) + (goto-char (match-beginning 1)) + (setq indent (current-column)) + (beginning-of-line))) + ;; nest class/module + (while (and (> indent 0) + (re-search-backward + (concat + "^[ \t]*\\(class\\|module\\)[ \t]+" + "\\([A-Z]" ruby-symbol-re "+\\)") + nil t)) + (goto-char (match-beginning 1)) + (if (< (current-column) indent) + (progn + (setq mlist (cons (match-string 2) mlist)) + (setq indent (current-column)) + (beginning-of-line)))) + ;; generate string + (if (consp mlist) + (mapconcat (function identity) mlist "::") + nil))))) + +(cond + ((featurep 'font-lock) + (or (boundp 'font-lock-variable-name-face) + (setq font-lock-variable-name-face font-lock-type-face)) + + (setq ruby-font-lock-syntactic-keywords + '( + ;; #{ }, #$hoge, #@foo are not comments + ("\\(#\\)[{$@]" 1 (1 . nil)) + ;; the last $', $", $` in the respective string is not variable + ;; the last ?', ?", ?` in the respective string is not ascii code + ("\\(^\\|[\[ \t\n<+\(,=]\\)\\(['\"`]\\)\\(\\\\.\\|\\2\\|[^'\"`\n\\\\]\\)*?\\\\?[?$]\\(\\2\\)" + (2 (7 . nil)) + (4 (7 . nil))) + ;; $' $" $` .... are variables + ;; ?' ?" ?` are ascii codes + ("\\(^\\|[^\\\\]\\)\\(\\\\\\\\\\)*[?$]\\([#\"'`]\\)" 3 (1 . nil)) + ;; regexps + ("\\(^\\|[=(,~?:;<>]\\|\\(^\\|\\s \\)\\(if\\|elsif\\|unless\\|while\\|until\\|when\\|and\\|or\\|&&\\|||\\)\\|g?sub!?\\|scan\\|split!?\\)\\s *\\(/\\)[^/\n\\\\]*\\(\\\\.[^/\n\\\\]*\\)*\\(/\\)" + (4 (7 . ?/)) + (6 (7 . ?/))) + ("^\\(=\\)begin\\(\\s \\|$\\)" 1 (7 . nil)) + ("^\\(=\\)end\\(\\s \\|$\\)" 1 (7 . nil)))) + + (cond ((featurep 'xemacs) + (put 'ruby-mode 'font-lock-defaults + '((ruby-font-lock-keywords) + nil nil nil + beginning-of-line + (font-lock-syntactic-keywords + . ruby-font-lock-syntactic-keywords)))) + (t + (add-hook 'ruby-mode-hook + '(lambda () + (make-local-variable 'font-lock-defaults) + (make-local-variable 'font-lock-keywords) + (make-local-variable 'font-lock-syntax-table) + (make-local-variable 'font-lock-syntactic-keywords) + (setq font-lock-defaults '((ruby-font-lock-keywords) nil nil)) + (setq font-lock-keywords ruby-font-lock-keywords) + (setq font-lock-syntax-table ruby-font-lock-syntax-table) + (setq font-lock-syntactic-keywords ruby-font-lock-syntactic-keywords))))) + + (defun ruby-font-lock-docs (limit) + (if (re-search-forward "^=begin\\(\\s \\|$\\)" limit t) + (let (beg) + (beginning-of-line) + (setq beg (point)) + (forward-line 1) + (if (re-search-forward "^=end\\(\\s \\|$\\)" limit t) + (progn + (set-match-data (list beg (point))) + t))))) + + (defun ruby-font-lock-maybe-docs (limit) + (let (beg) + (save-excursion + (if (and (re-search-backward "^=\\(begin\\|end\\)\\(\\s \\|$\\)" nil t) + (string= (match-string 1) "begin")) + (progn + (beginning-of-line) + (setq beg (point))))) + (if (and beg (and (re-search-forward "^=\\(begin\\|end\\)\\(\\s \\|$\\)" nil t) + (string= (match-string 1) "end"))) + (progn + (set-match-data (list beg (point))) + t) + nil))) + + (defvar ruby-font-lock-syntax-table + (let* ((tbl (copy-syntax-table ruby-mode-syntax-table))) + (modify-syntax-entry ?_ "w" tbl) + tbl)) + + (defun ruby-font-lock-here-docs (limit) + (if (re-search-forward ruby-here-doc-beg-re limit t) + (let (beg) + (beginning-of-line) + (forward-line) + (setq beg (point)) + (if (re-search-forward (ruby-here-doc-end-match) nil t) + (progn + (set-match-data (list beg (point))) + t))))) + + (defun ruby-font-lock-maybe-here-docs (limit) + (let (beg) + (save-excursion + (if (re-search-backward ruby-here-doc-beg-re nil t) + (progn + (beginning-of-line) + (forward-line) + (setq beg (point))))) + (if (and beg + (let ((end-match (ruby-here-doc-end-match))) + (and (not (re-search-backward end-match beg t)) + (re-search-forward end-match nil t)))) + (progn + (set-match-data (list beg (point))) + t) + nil))) + + (defvar ruby-font-lock-keywords + (list + ;; functions + '("^\\s *def\\s +\\([^( \t\n]+\\)" + 1 font-lock-function-name-face) + ;; keywords + (cons (concat + "\\(^\\|[^_:.@$]\\|\\.\\.\\)\\b\\(defined\\?\\|\\(" + (mapconcat + 'identity + '("alias" + "and" + "begin" + "break" + "case" + "catch" + "class" + "def" + "do" + "elsif" + "else" + "fail" + "ensure" + "for" + "end" + "if" + "in" + "module" + "next" + "not" + "or" + "raise" + "redo" + "rescue" + "retry" + "return" + "then" + "throw" + "super" + "unless" + "undef" + "until" + "when" + "while" + "yield" + ) + "\\|") + "\\)\\>\\)") + 2) + ;; variables + '("\\(^\\|[^_:.@$]\\|\\.\\.\\)\\b\\(nil\\|self\\|true\\|false\\)\\>" + 2 font-lock-variable-name-face) + ;; variables + '("\\(\\$\\([^a-zA-Z0-9 \n]\\|[0-9]\\)\\)\\W" + 1 font-lock-variable-name-face) + '("\\(\\$\\|@\\|@@\\)\\(\\w\\|_\\)+" + 0 font-lock-variable-name-face) + ;; embedded document + '(ruby-font-lock-docs + 0 font-lock-comment-face t) + '(ruby-font-lock-maybe-docs + 0 font-lock-comment-face t) + ;; "here" document + '(ruby-font-lock-here-docs + 0 font-lock-string-face t) + '(ruby-font-lock-maybe-here-docs + 0 font-lock-string-face t) + `(,ruby-here-doc-beg-re + 0 font-lock-string-face t) + ;; general delimited string + '("\\(^\\|[[ \t\n<+(,=]\\)\\(%[xrqQwW]?\\([^<[{(a-zA-Z0-9 \n]\\)[^\n\\\\]*\\(\\\\.[^\n\\\\]*\\)*\\(\\3\\)\\)" + (2 font-lock-string-face)) + ;; constants + '("\\(^\\|[^_]\\)\\b\\([A-Z]+\\(\\w\\|_\\)*\\)" + 2 font-lock-type-face) + ;; symbols + '("\\(^\\|[^:]\\)\\(:\\([-+~]@?\\|[/%&|^`]\\|\\*\\*?\\|<\\(<\\|=>?\\)?\\|>[>=]?\\|===?\\|=~\\|\\[\\]=?\\|\\(\\w\\|_\\)+\\([!?=]\\|\\b_*\\)\\|#{[^}\n\\\\]*\\(\\\\.[^}\n\\\\]*\\)*}\\)\\)" + 2 font-lock-reference-face) + ;; expression expansion + '("#\\({[^}\n\\\\]*\\(\\\\.[^}\n\\\\]*\\)*}\\|\\(\\$\\|@\\|@@\\)\\(\\w\\|_\\)+\\)" + 0 font-lock-variable-name-face t) + ;; warn lower camel case + ;'("\\<[a-z]+[a-z0-9]*[A-Z][A-Za-z0-9]*\\([!?]?\\|\\>\\)" + ; 0 font-lock-warning-face) + ) + "*Additional expressions to highlight in ruby mode.")) + + ((featurep 'hilit19) + (hilit-set-mode-patterns + 'ruby-mode + '(("[^$\\?]\\(\"[^\\\"]*\\(\\\\\\(.\\|\n\\)[^\\\"]*\\)*\"\\)" 1 string) + ("[^$\\?]\\('[^\\']*\\(\\\\\\(.\\|\n\\)[^\\']*\\)*'\\)" 1 string) + ("[^$\\?]\\(`[^\\`]*\\(\\\\\\(.\\|\n\\)[^\\`]*\\)*`\\)" 1 string) + ("^\\s *#.*$" nil comment) + ("[^$@?\\]\\(#[^$@{\n].*$\\)" 1 comment) + ("[^a-zA-Z_]\\(\\?\\(\\\\[CM]-\\)*.\\)" 1 string) + ("^\\s *\\(require\\|load\\).*$" nil include) + ("^\\s *\\(include\\|alias\\|undef\\).*$" nil decl) + ("^\\s *\\<\\(class\\|def\\|module\\)\\>" "[)\n;]" defun) + ("[^_]\\<\\(begin\\|case\\|else\\|elsif\\|end\\|ensure\\|for\\|if\\|unless\\|rescue\\|then\\|when\\|while\\|until\\|do\\|yield\\)\\>\\([^_]\\|$\\)" 1 defun) + ("[^_]\\<\\(and\\|break\\|next\\|raise\\|fail\\|in\\|not\\|or\\|redo\\|retry\\|return\\|super\\|yield\\|catch\\|throw\\|self\\|nil\\)\\>\\([^_]\\|$\\)" 1 keyword) + ("\\$\\(.\\|\\sw+\\)" nil type) + ("[$@].[a-zA-Z_0-9]*" nil struct) + ("^__END__" nil label)))) + ) + + +(provide 'ruby-mode) diff --git a/emacs.d/ruby-mode.el~ b/emacs.d/ruby-mode.el~ new file mode 100644 index 0000000..25c6b30 --- /dev/null +++ b/emacs.d/ruby-mode.el~ @@ -0,0 +1,1207 @@ +;;; +;;; ruby-mode.el - +;;; +;;; $Author$ +;;; $Date$ +;;; created at: Fri Feb 4 14:49:13 JST 1994 +;;; + +(defconst ruby-mode-revision "$Revision$") + +(defconst ruby-mode-version + (progn + (string-match "[0-9.]+" ruby-mode-revision) + (substring ruby-mode-revision (match-beginning 0) (match-end 0)))) + +(defconst ruby-block-beg-re + "class\\|module\\|def\\|if\\|unless\\|case\\|while\\|until\\|for\\|begin\\|do" + ) + +(defconst ruby-non-block-do-re + "\\(while\\|until\\|for\\|rescue\\)\\>[^_]" + ) + +(defconst ruby-indent-beg-re + "\\(\\s *\\(class\\|module\\|def\\)\\)\\|if\\|unless\\|case\\|while\\|until\\|for\\|begin" + ) + +(defconst ruby-modifier-beg-re + "if\\|unless\\|while\\|until" + ) + +(defconst ruby-modifier-re + (concat ruby-modifier-beg-re "\\|rescue") + ) + +(defconst ruby-block-mid-re + "then\\|else\\|elsif\\|when\\|rescue\\|ensure" + ) + +(defconst ruby-block-op-re + "and\\|or\\|not" + ) + +(defconst ruby-block-hanging-re + (concat ruby-modifier-beg-re "\\|" ruby-block-op-re) + ) + +(defconst ruby-block-end-re "\\") + +(defconst ruby-here-doc-beg-re + "<<\\(-\\)?\\(\\([a-zA-Z0-9_]+\\)\\|[\"]\\([^\"]+\\)[\"]\\|[']\\([^']+\\)[']\\)") + +(defun ruby-here-doc-end-match () + (concat "^" + (if (match-string 1) "[ \t]*" nil) + (regexp-quote + (or (match-string 3) + (match-string 4) + (match-string 5))))) + +(defconst ruby-delimiter + (concat "[?$/%(){}#\"'`.:]\\|<<\\|\\[\\|\\]\\|\\<\\(" + ruby-block-beg-re + "\\)\\>\\|" ruby-block-end-re + "\\|^=begin\\|" ruby-here-doc-beg-re) + ) + +(defconst ruby-negative + (concat "^[ \t]*\\(\\(" ruby-block-mid-re "\\)\\>\\|" + ruby-block-end-re "\\|}\\|\\]\\)") + ) + +(defconst ruby-operator-chars "-,.+*/%&|^~=<>:") +(defconst ruby-operator-re (concat "[" ruby-operator-chars "]")) + +(defconst ruby-symbol-chars "a-zA-Z0-9_") +(defconst ruby-symbol-re (concat "[" ruby-symbol-chars "]")) + +(defvar ruby-mode-abbrev-table nil + "Abbrev table in use in ruby-mode buffers.") + +(define-abbrev-table 'ruby-mode-abbrev-table ()) + +(defvar ruby-mode-map nil "Keymap used in ruby mode.") + +(if ruby-mode-map + nil + (setq ruby-mode-map (make-sparse-keymap)) + (define-key ruby-mode-map "{" 'ruby-electric-brace) + (define-key ruby-mode-map "}" 'ruby-electric-brace) + (define-key ruby-mode-map "\e\C-a" 'ruby-beginning-of-defun) + (define-key ruby-mode-map "\e\C-e" 'ruby-end-of-defun) + (define-key ruby-mode-map "\e\C-b" 'ruby-backward-sexp) + (define-key ruby-mode-map "\e\C-f" 'ruby-forward-sexp) + (define-key ruby-mode-map "\e\C-p" 'ruby-beginning-of-block) + (define-key ruby-mode-map "\e\C-n" 'ruby-end-of-block) + (define-key ruby-mode-map "\e\C-h" 'ruby-mark-defun) + (define-key ruby-mode-map "\e\C-q" 'ruby-indent-exp) + (define-key ruby-mode-map "\t" 'ruby-indent-command) + (define-key ruby-mode-map "\C-c\C-e" 'ruby-insert-end) + (define-key ruby-mode-map "\C-j" 'ruby-reindent-then-newline-and-indent) + (define-key ruby-mode-map "\C-m" 'newline)) + +(defvar ruby-mode-syntax-table nil + "Syntax table in use in ruby-mode buffers.") + +(if ruby-mode-syntax-table + () + (setq ruby-mode-syntax-table (make-syntax-table)) + (modify-syntax-entry ?\' "\"" ruby-mode-syntax-table) + (modify-syntax-entry ?\" "\"" ruby-mode-syntax-table) + (modify-syntax-entry ?\` "\"" ruby-mode-syntax-table) + (modify-syntax-entry ?# "<" ruby-mode-syntax-table) + (modify-syntax-entry ?\n ">" ruby-mode-syntax-table) + (modify-syntax-entry ?\\ "\\" ruby-mode-syntax-table) + (modify-syntax-entry ?$ "." ruby-mode-syntax-table) + (modify-syntax-entry ?? "_" ruby-mode-syntax-table) + (modify-syntax-entry ?_ "_" ruby-mode-syntax-table) + (modify-syntax-entry ?< "." ruby-mode-syntax-table) + (modify-syntax-entry ?> "." ruby-mode-syntax-table) + (modify-syntax-entry ?& "." ruby-mode-syntax-table) + (modify-syntax-entry ?| "." ruby-mode-syntax-table) + (modify-syntax-entry ?% "." ruby-mode-syntax-table) + (modify-syntax-entry ?= "." ruby-mode-syntax-table) + (modify-syntax-entry ?/ "." ruby-mode-syntax-table) + (modify-syntax-entry ?+ "." ruby-mode-syntax-table) + (modify-syntax-entry ?* "." ruby-mode-syntax-table) + (modify-syntax-entry ?- "." ruby-mode-syntax-table) + (modify-syntax-entry ?\; "." ruby-mode-syntax-table) + (modify-syntax-entry ?\( "()" ruby-mode-syntax-table) + (modify-syntax-entry ?\) ")(" ruby-mode-syntax-table) + (modify-syntax-entry ?\{ "(}" ruby-mode-syntax-table) + (modify-syntax-entry ?\} "){" ruby-mode-syntax-table) + (modify-syntax-entry ?\[ "(]" ruby-mode-syntax-table) + (modify-syntax-entry ?\] ")[" ruby-mode-syntax-table) + ) + +(defcustom ruby-indent-tabs-mode nil + "*Indentation can insert tabs in ruby mode if this is non-nil." + :type 'boolean :group 'ruby) + +(defcustom ruby-indent-level 2 + "*Indentation of ruby statements." + :type 'integer :group 'ruby) + +(defcustom ruby-comment-column 32 + "*Indentation column of comments." + :type 'integer :group 'ruby) + +(defcustom ruby-deep-arglist t + "*Deep indent lists in parenthesis when non-nil. +Also ignores spaces after parenthesis when 'space." + :group 'ruby) + +(defcustom ruby-deep-indent-paren '(?\( ?\[ ?\] t) + "*Deep indent lists in parenthesis when non-nil. t means continuous line. +Also ignores spaces after parenthesis when 'space." + :group 'ruby) + +(defcustom ruby-deep-indent-paren-style 'space + "Default deep indent style." + :options '(t nil space) :group 'ruby) + +(eval-when-compile (require 'cl)) +(defun ruby-imenu-create-index-in-block (prefix beg end) + (let ((index-alist '()) (case-fold-search nil) + name next pos decl sing) + (goto-char beg) + (while (re-search-forward "^\\s *\\(\\(class\\>\\(\\s *<<\\)?\\|module\\>\\)\\s *\\([^\(<\n ]+\\)\\|\\(def\\|alias\\)\\>\\s *\\([^\(\n ]+\\)\\)" end t) + (setq sing (match-beginning 3)) + (setq decl (match-string 5)) + (setq next (match-end 0)) + (setq name (or (match-string 4) (match-string 6))) + (setq pos (match-beginning 0)) + (cond + ((string= "alias" decl) + (if prefix (setq name (concat prefix name))) + (push (cons name pos) index-alist)) + ((string= "def" decl) + (if prefix + (setq name + (cond + ((string-match "^self\." name) + (concat (substring prefix 0 -1) (substring name 4))) + (t (concat prefix name))))) + (push (cons name pos) index-alist) + (ruby-accurate-end-of-block end)) + (t + (if (string= "self" name) + (if prefix (setq name (substring prefix 0 -1))) + (if prefix (setq name (concat (substring prefix 0 -1) "::" name))) + (push (cons name pos) index-alist)) + (ruby-accurate-end-of-block end) + (setq beg (point)) + (setq index-alist + (nconc (ruby-imenu-create-index-in-block + (concat name (if sing "." "#")) + next beg) index-alist)) + (goto-char beg)))) + index-alist)) + +(defun ruby-imenu-create-index () + (nreverse (ruby-imenu-create-index-in-block nil (point-min) nil))) + +(defun ruby-accurate-end-of-block (&optional end) + (let (state) + (or end (setq end (point-max))) + (while (and (setq state (apply 'ruby-parse-partial end state)) + (>= (nth 2 state) 0) (< (point) end))))) + +(defun ruby-mode-variables () + (set-syntax-table ruby-mode-syntax-table) + (setq local-abbrev-table ruby-mode-abbrev-table) + (make-local-variable 'indent-line-function) + (setq indent-line-function 'ruby-indent-line) + (make-local-variable 'require-final-newline) + (setq require-final-newline t) + (make-variable-buffer-local 'comment-start) + (setq comment-start "# ") + (make-variable-buffer-local 'comment-end) + (setq comment-end "") + (make-variable-buffer-local 'comment-column) + (setq comment-column ruby-comment-column) + (make-variable-buffer-local 'comment-start-skip) + (setq comment-start-skip "#+ *") + (setq indent-tabs-mode ruby-indent-tabs-mode) + (make-local-variable 'parse-sexp-ignore-comments) + (setq parse-sexp-ignore-comments t) + (make-local-variable 'paragraph-start) + (setq paragraph-start (concat "$\\|" page-delimiter)) + (make-local-variable 'paragraph-separate) + (setq paragraph-separate paragraph-start) + (make-local-variable 'paragraph-ignore-fill-prefix) + (setq paragraph-ignore-fill-prefix t)) + +;;;###autoload +(defun ruby-mode () + "Major mode for editing ruby scripts. +\\[ruby-indent-command] properly indents subexpressions of multi-line +class, module, def, if, while, for, do, and case statements, taking +nesting into account. + +The variable ruby-indent-level controls the amount of indentation. +\\{ruby-mode-map}" + (interactive) + (kill-all-local-variables) + (use-local-map ruby-mode-map) + (setq mode-name "Ruby") + (setq major-mode 'ruby-mode) + (ruby-mode-variables) + + (make-local-variable 'imenu-create-index-function) + (setq imenu-create-index-function 'ruby-imenu-create-index) + + (make-local-variable 'add-log-current-defun-function) + (setq add-log-current-defun-function 'ruby-add-log-current-method) + + (run-hooks 'ruby-mode-hook)) + +(defun ruby-current-indentation () + (save-excursion + (beginning-of-line) + (back-to-indentation) + (current-column))) + +(defun ruby-indent-line (&optional flag) + "Correct indentation of the current ruby line." + (ruby-indent-to (ruby-calculate-indent))) + +(defun ruby-indent-command () + (interactive) + (ruby-indent-line t)) + +(defun ruby-indent-to (x) + (if x + (let (shift top beg) + (and (< x 0) (error "invalid nest")) + (setq shift (current-column)) + (beginning-of-line) + (setq beg (point)) + (back-to-indentation) + (setq top (current-column)) + (skip-chars-backward " \t") + (if (>= shift top) (setq shift (- shift top)) + (setq shift 0)) + (if (and (bolp) + (= x top)) + (move-to-column (+ x shift)) + (move-to-column top) + (delete-region beg (point)) + (beginning-of-line) + (indent-to x) + (move-to-column (+ x shift)))))) + +(defun ruby-special-char-p (&optional pnt) + (setq pnt (or pnt (point))) + (let ((c (char-before pnt)) (b (and (< (point-min) pnt) (char-before (1- pnt))))) + (cond ((or (eq c ??) (eq c ?$))) + ((and (eq c ?:) (or (not b) (eq (char-syntax b) ? )))) + ((eq c ?\\) (eq b ??))))) + +(defun ruby-expr-beg (&optional option) + (save-excursion + (store-match-data nil) + (let ((space (skip-chars-backward " \t")) + (start (point))) + (cond + ((bolp) t) + ((progn + (forward-char -1) + (and (looking-at "\\?") + (or (eq (char-syntax (char-before (point))) ?w) + (ruby-special-char-p)))) + nil) + ((and (eq option 'heredoc) (< space 0)) t) + ((or (looking-at ruby-operator-re) + (looking-at "[\\[({,;]") + (and (looking-at "[!?]") + (or (not (eq option 'modifier)) + (bolp) + (save-excursion (forward-char -1) (looking-at "\\Sw$")))) + (and (looking-at ruby-symbol-re) + (skip-chars-backward ruby-symbol-chars) + (cond + ((or (looking-at (concat "\\<\\(" ruby-block-beg-re + "|" ruby-block-op-re + "|" ruby-block-mid-re "\\)\\>"))) + (goto-char (match-end 0)) + (not (looking-at "\\s_"))) + ((eq option 'expr-qstr) + (looking-at "[a-zA-Z][a-zA-z0-9_]* +%[^ \t]")) + ((eq option 'expr-re) + (looking-at "[a-zA-Z][a-zA-z0-9_]* +/[^ \t]")) + (t nil))))))))) + +(defun ruby-forward-string (term &optional end no-error expand) + (let ((n 1) (c (string-to-char term)) + (re (if expand + (concat "[^\\]\\(\\\\\\\\\\)*\\([" term "]\\|\\(#{\\)\\)") + (concat "[^\\]\\(\\\\\\\\\\)*[" term "]")))) + (while (and (re-search-forward re end no-error) + (if (match-beginning 3) + (ruby-forward-string "}{" end no-error nil) + (> (setq n (if (eq (char-before (point)) c) + (1- n) (1+ n))) 0))) + (forward-char -1)) + (cond ((zerop n)) + (no-error nil) + ((error "unterminated string"))))) + +(defun ruby-deep-indent-paren-p (c) + (cond ((listp ruby-deep-indent-paren) + (let ((deep (assoc c ruby-deep-indent-paren))) + (cond (deep + (or (cdr deep) ruby-deep-indent-paren-style)) + ((memq c ruby-deep-indent-paren) + ruby-deep-indent-paren-style)))) + ((eq c ruby-deep-indent-paren) ruby-deep-indent-paren-style) + ((eq c ?\( ) ruby-deep-arglist))) + +(defun ruby-parse-partial (&optional end in-string nest depth pcol indent) + (or depth (setq depth 0)) + (or indent (setq indent 0)) + (when (re-search-forward ruby-delimiter end 'move) + (let ((pnt (point)) w re expand) + (goto-char (match-beginning 0)) + (cond + ((and (memq (char-before) '(?@ ?$)) (looking-at "\\sw")) + (goto-char pnt)) + ((looking-at "[\"`]") ;skip string + (cond + ((and (not (eobp)) + (ruby-forward-string (buffer-substring (point) (1+ (point))) end t t)) + nil) + (t + (setq in-string (point)) + (goto-char end)))) + ((looking-at "'") + (cond + ((and (not (eobp)) + (re-search-forward "[^\\]\\(\\\\\\\\\\)*'" end t)) + nil) + (t + (setq in-string (point)) + (goto-char end)))) + ((looking-at "/=") + (goto-char pnt)) + ((looking-at "/") + (cond + ((and (not (eobp)) (ruby-expr-beg 'expr-re)) + (if (ruby-forward-string "/" end t t) + nil + (setq in-string (point)) + (goto-char end))) + (t + (goto-char pnt)))) + ((looking-at "%") + (cond + ((and (not (eobp)) + (ruby-expr-beg 'expr-qstr) + (not (looking-at "%=")) + (looking-at "%[QqrxWw]?\\([^a-zA-Z0-9 \t\n]\\)")) + (goto-char (match-beginning 1)) + (setq expand (not (memq (char-before) '(?q ?w)))) + (setq w (match-string 1)) + (cond + ((string= w "[") (setq re "][")) + ((string= w "{") (setq re "}{")) + ((string= w "(") (setq re ")(")) + ((string= w "<") (setq re "><")) + ((and expand (string= w "\\")) + (setq w (concat "\\" w)))) + (unless (cond (re (ruby-forward-string re end t expand)) + (expand (ruby-forward-string w end t t)) + (t (re-search-forward + (if (string= w "\\") + "\\\\[^\\]*\\\\" + (concat "[^\\]\\(\\\\\\\\\\)*" w)) + end t))) + (setq in-string (point)) + (goto-char end))) + (t + (goto-char pnt)))) + ((looking-at "\\?") ;skip ?char + (cond + ((and (ruby-expr-beg) + (looking-at "?\\(\\\\C-\\|\\\\M-\\)*\\\\?.")) + (goto-char (match-end 0))) + (t + (goto-char pnt)))) + ((looking-at "\\$") ;skip $char + (goto-char pnt) + (forward-char 1)) + ((looking-at "#") ;skip comment + (forward-line 1) + (goto-char (point)) + ) + ((looking-at "[\\[{(]") + (let ((deep (ruby-deep-indent-paren-p (char-after)))) + (if (and deep (or (not (eq (char-after) ?\{)) (ruby-expr-beg))) + (progn + (and (eq deep 'space) (looking-at ".\\s +[^# \t\n]") + (setq pnt (1- (match-end 0)))) + (setq nest (cons (cons (char-after (point)) pnt) nest)) + (setq pcol (cons (cons pnt depth) pcol)) + (setq depth 0)) + (setq nest (cons (cons (char-after (point)) pnt) nest)) + (setq depth (1+ depth)))) + (goto-char pnt) + ) + ((looking-at "[])}]") + (if (ruby-deep-indent-paren-p (matching-paren (char-after))) + (setq depth (cdr (car pcol)) pcol (cdr pcol)) + (setq depth (1- depth))) + (setq nest (cdr nest)) + (goto-char pnt)) + ((looking-at ruby-block-end-re) + (if (or (and (not (bolp)) + (progn + (forward-char -1) + (setq w (char-after (point))) + (or (eq ?_ w) + (eq ?. w)))) + (progn + (goto-char pnt) + (setq w (char-after (point))) + (or (eq ?_ w) + (eq ?! w) + (eq ?? w)))) + nil + (setq nest (cdr nest)) + (setq depth (1- depth))) + (goto-char pnt)) + ((looking-at "def\\s +[^(\n;]*") + (if (or (bolp) + (progn + (forward-char -1) + (not (eq ?_ (char-after (point)))))) + (progn + (setq nest (cons (cons nil pnt) nest)) + (setq depth (1+ depth)))) + (goto-char (match-end 0))) + ((looking-at (concat "\\<\\(" ruby-block-beg-re "\\)\\>")) + (and + (save-match-data + (or (not (looking-at "do\\>[^_]")) + (save-excursion + (back-to-indentation) + (not (looking-at ruby-non-block-do-re))))) + (or (bolp) + (progn + (forward-char -1) + (setq w (char-after (point))) + (not (or (eq ?_ w) + (eq ?. w))))) + (goto-char pnt) + (setq w (char-after (point))) + (not (eq ?_ w)) + (not (eq ?! w)) + (not (eq ?? w)) + (skip-chars-forward " \t") + (goto-char (match-beginning 0)) + (or (not (looking-at ruby-modifier-re)) + (ruby-expr-beg 'modifier)) + (goto-char pnt) + (setq nest (cons (cons nil pnt) nest)) + (setq depth (1+ depth))) + (goto-char pnt)) + ((looking-at ":\\(['\"]\\)\\(\\\\.\\|[^\\\\]\\)*\\1") + (goto-char (match-end 0))) + ((looking-at ":\\([-,.+*/%&|^~<>]=?\\|===?\\|<=>\\)") + (goto-char (match-end 0))) + ((looking-at ":\\([a-zA-Z_][a-zA-Z_0-9]*[!?=]?\\)?") + (goto-char (match-end 0))) + ((or (looking-at "\\.\\.\\.?") + (looking-at "\\.[0-9]+") + (looking-at "\\.[a-zA-Z_0-9]+") + (looking-at "\\.")) + (goto-char (match-end 0))) + ((looking-at "^=begin") + (if (re-search-forward "^=end" end t) + (forward-line 1) + (setq in-string (match-end 0)) + (goto-char end))) + ((looking-at "<<") + (cond + ((and (ruby-expr-beg 'heredoc) + (looking-at "<<\\(-\\)?\\(\\([\"'`]\\)\\([^\n]+?\\)\\3\\|\\(?:\\sw\\|\\s_\\)+\\)")) + (setq re (regexp-quote (or (match-string 4) (match-string 2)))) + (if (match-beginning 1) (setq re (concat "\\s *" re))) + (let* ((id-end (goto-char (match-end 0))) + (line-end-position (save-excursion (end-of-line) (point))) + (state (list in-string nest depth pcol indent))) + ;; parse the rest of the line + (while (and (> line-end-position (point)) + (setq state (apply 'ruby-parse-partial + line-end-position state)))) + (setq in-string (car state) + nest (nth 1 state) + depth (nth 2 state) + pcol (nth 3 state) + indent (nth 4 state)) + ;; skip heredoc section + (if (re-search-forward (concat "^" re "$") end 'move) + (forward-line 1) + (setq in-string id-end) + (goto-char end)))) + (t + (goto-char pnt)))) + ((looking-at "^__END__$") + (goto-char pnt)) + ((looking-at ruby-here-doc-beg-re) + (if (re-search-forward (ruby-here-doc-end-match) + indent-point t) + (forward-line 1) + (setq in-string (match-end 0)) + (goto-char indent-point))) + (t + (error (format "bad string %s" + (buffer-substring (point) pnt) + )))))) + (list in-string nest depth pcol)) + +(defun ruby-parse-region (start end) + (let (state) + (save-excursion + (if start + (goto-char start) + (ruby-beginning-of-indent)) + (save-restriction + (narrow-to-region (point) end) + (while (and (> end (point)) + (setq state (apply 'ruby-parse-partial end state)))))) + (list (nth 0 state) ; in-string + (car (nth 1 state)) ; nest + (nth 2 state) ; depth + (car (car (nth 3 state))) ; pcol + ;(car (nth 5 state)) ; indent + ))) + +(defun ruby-indent-size (pos nest) + (+ pos (* (or nest 1) ruby-indent-level))) + +(defun ruby-calculate-indent (&optional parse-start) + (save-excursion + (beginning-of-line) + (let ((indent-point (point)) + (case-fold-search nil) + state bol eol begin op-end + (paren (progn (skip-syntax-forward " ") + (and (char-after) (matching-paren (char-after))))) + (indent 0)) + (if parse-start + (goto-char parse-start) + (ruby-beginning-of-indent) + (setq parse-start (point))) + (back-to-indentation) + (setq indent (current-column)) + (setq state (ruby-parse-region parse-start indent-point)) + (cond + ((nth 0 state) ; within string + (setq indent nil)) ; do nothing + ((car (nth 1 state)) ; in paren + (goto-char (setq begin (cdr (nth 1 state)))) + (let ((deep (ruby-deep-indent-paren-p (car (nth 1 state))))) + (if deep + (cond ((and (eq deep t) (eq (car (nth 1 state)) paren)) + (skip-syntax-backward " ") + (setq indent (1- (current-column)))) + ((let ((s (ruby-parse-region (point) indent-point))) + (and (nth 2 s) (> (nth 2 s) 0) + (or (goto-char (cdr (nth 1 s))) t))) + (forward-word -1) + (setq indent (ruby-indent-size (current-column) (nth 2 state)))) + (t + (setq indent (current-column)) + (cond ((eq deep 'space)) + (paren (setq indent (1- indent))) + (t (setq indent (ruby-indent-size (1- indent) 1)))))) + (if (nth 3 state) (goto-char (nth 3 state)) + (goto-char parse-start) (back-to-indentation)) + (setq indent (ruby-indent-size (current-column) (nth 2 state)))) + (and (eq (car (nth 1 state)) paren) + (ruby-deep-indent-paren-p (matching-paren paren)) + (search-backward (char-to-string paren)) + (setq indent (current-column))))) + ((and (nth 2 state) (> (nth 2 state) 0)) ; in nest + (if (null (cdr (nth 1 state))) + (error "invalid nest")) + (goto-char (cdr (nth 1 state))) + (forward-word -1) ; skip back a keyword + (setq begin (point)) + (cond + ((looking-at "do\\>[^_]") ; iter block is a special case + (if (nth 3 state) (goto-char (nth 3 state)) + (goto-char parse-start) (back-to-indentation)) + (setq indent (ruby-indent-size (current-column) (nth 2 state)))) + (t + (setq indent (+ (current-column) ruby-indent-level))))) + + ((and (nth 2 state) (< (nth 2 state) 0)) ; in negative nest + (setq indent (ruby-indent-size (current-column) (nth 2 state))))) + (when indent + (goto-char indent-point) + (end-of-line) + (setq eol (point)) + (beginning-of-line) + (cond + ((and (not (ruby-deep-indent-paren-p paren)) + (re-search-forward ruby-negative eol t)) + (and (not (eq ?_ (char-after (match-end 0)))) + (setq indent (- indent ruby-indent-level)))) + ((and + (save-excursion + (beginning-of-line) + (not (bobp))) + (or (ruby-deep-indent-paren-p t) + (null (car (nth 1 state))))) + ;; goto beginning of non-empty no-comment line + (let (end done) + (while (not done) + (skip-chars-backward " \t\n") + (setq end (point)) + (beginning-of-line) + (if (re-search-forward "^\\s *#" end t) + (beginning-of-line) + (setq done t)))) + (setq bol (point)) + (end-of-line) + ;; skip the comment at the end + (skip-chars-backward " \t") + (let (end (pos (point))) + (beginning-of-line) + (while (and (re-search-forward "#" pos t) + (setq end (1- (point))) + (or (ruby-special-char-p end) + (and (setq state (ruby-parse-region parse-start end)) + (nth 0 state)))) + (setq end nil)) + (goto-char (or end pos)) + (skip-chars-backward " \t") + (setq begin (if (nth 0 state) pos (cdr (nth 1 state)))) + (setq state (ruby-parse-region parse-start (point)))) + (or (bobp) (forward-char -1)) + (and + (or (and (looking-at ruby-symbol-re) + (skip-chars-backward ruby-symbol-chars) + (looking-at (concat "\\<\\(" ruby-block-hanging-re "\\)\\>")) + (not (eq (point) (nth 3 state))) + (save-excursion + (goto-char (match-end 0)) + (not (looking-at "[a-z_]")))) + (and (looking-at ruby-operator-re) + (not (ruby-special-char-p)) + ;; operator at the end of line + (let ((c (char-after (point)))) + (and +;; (or (null begin) +;; (save-excursion +;; (goto-char begin) +;; (skip-chars-forward " \t") +;; (not (or (eolp) (looking-at "#") +;; (and (eq (car (nth 1 state)) ?{) +;; (looking-at "|")))))) + (or (not (eq ?/ c)) + (null (nth 0 (ruby-parse-region (or begin parse-start) (point))))) + (or (not (eq ?| (char-after (point)))) + (save-excursion + (or (eolp) (forward-char -1)) + (cond + ((search-backward "|" nil t) + (skip-chars-backward " \t\n") + (and (not (eolp)) + (progn + (forward-char -1) + (not (looking-at "{"))) + (progn + (forward-word -1) + (not (looking-at "do\\>[^_]"))))) + (t t)))) + (not (eq ?, c)) + (setq op-end t))))) + (setq indent + (cond + ((and + (null op-end) + (not (looking-at (concat "\\<\\(" ruby-block-hanging-re "\\)\\>"))) + (eq (ruby-deep-indent-paren-p t) 'space) + (not (bobp))) + (save-excursion + (widen) + (goto-char (or begin parse-start)) + (skip-syntax-forward " ") + (current-column))) + ((car (nth 1 state)) indent) + (t + (+ indent ruby-indent-level)))))))) + indent))) + +(defun ruby-electric-brace (arg) + (interactive "P") + (insert-char last-command-char 1) + (ruby-indent-line t) + (delete-char -1) + (self-insert-command (prefix-numeric-value arg))) + +(eval-when-compile + (defmacro defun-region-command (func args &rest body) + (let ((intr (car body))) + (when (featurep 'xemacs) + (if (stringp intr) (setq intr (cadr body))) + (and (eq (car intr) 'interactive) + (setq intr (cdr intr)) + (setcar intr (concat "_" (car intr))))) + (cons 'defun (cons func (cons args body)))))) + +(defun-region-command ruby-beginning-of-defun (&optional arg) + "Move backward to next beginning-of-defun. +With argument, do this that many times. +Returns t unless search stops due to end of buffer." + (interactive "p") + (and (re-search-backward (concat "^\\(" ruby-block-beg-re "\\)\\b") + nil 'move (or arg 1)) + (progn (beginning-of-line) t))) + +(defun ruby-beginning-of-indent () + (and (re-search-backward (concat "^\\(" ruby-indent-beg-re "\\)\\b") + nil 'move) + (progn + (beginning-of-line) + t))) + +(defun-region-command ruby-end-of-defun (&optional arg) + "Move forward to next end of defun. +An end of a defun is found by moving forward from the beginning of one." + (interactive "p") + (and (re-search-forward (concat "^\\(" ruby-block-end-re "\\)\\($\\|\\b[^_]\\)") + nil 'move (or arg 1)) + (progn (beginning-of-line) t)) + (forward-line 1)) + +(defun ruby-move-to-block (n) + (let (start pos done down) + (setq start (ruby-calculate-indent)) + (setq down (looking-at (if (< n 0) ruby-block-end-re + (concat "\\<\\(" ruby-block-beg-re "\\)\\>")))) + (while (and (not done) (not (if (< n 0) (bobp) (eobp)))) + (forward-line n) + (cond + ((looking-at "^\\s *$")) + ((looking-at "^\\s *#")) + ((and (> n 0) (looking-at "^=begin\\>")) + (re-search-forward "^=end\\>")) + ((and (< n 0) (looking-at "^=end\\>")) + (re-search-backward "^=begin\\>")) + (t + (setq pos (current-indentation)) + (cond + ((< start pos) + (setq down t)) + ((and down (= pos start)) + (setq done t)) + ((> start pos) + (setq done t))))) + (if done + (save-excursion + (back-to-indentation) + (if (looking-at (concat "\\<\\(" ruby-block-mid-re "\\)\\>")) + (setq done nil)))))) + (back-to-indentation)) + +(defun-region-command ruby-beginning-of-block (&optional arg) + "Move backward to next beginning-of-block" + (interactive "p") + (ruby-move-to-block (- (or arg 1)))) + +(defun-region-command ruby-end-of-block (&optional arg) + "Move forward to next beginning-of-block" + (interactive "p") + (ruby-move-to-block (or arg 1))) + +(defun-region-command ruby-forward-sexp (&optional cnt) + (interactive "p") + (if (and (numberp cnt) (< cnt 0)) + (ruby-backward-sexp (- cnt)) + (let ((i (or cnt 1))) + (condition-case nil + (while (> i 0) + (skip-syntax-forward " ") + (cond ((looking-at "\\?\\(\\\\[CM]-\\)*\\\\?\\S ") + (goto-char (match-end 0))) + ((progn + (skip-chars-forward ",.:;|&^~=!?\\+\\-\\*") + (looking-at "\\s(")) + (goto-char (scan-sexps (point) 1))) + ((and (looking-at (concat "\\<\\(" ruby-block-beg-re "\\)\\>")) + (not (eq (char-before (point)) ?.)) + (not (eq (char-before (point)) ?:))) + (ruby-end-of-block) + (forward-word 1)) + ((looking-at "\\(\\$\\|@@?\\)?\\sw") + (while (progn + (while (progn (forward-word 1) (looking-at "_"))) + (cond ((looking-at "::") (forward-char 2) t) + ((> (skip-chars-forward ".") 0)) + ((looking-at "\\?\\|!\\(=[~=>]\\|[^~=]\\)") + (forward-char 1) nil))))) + ((let (state expr) + (while + (progn + (setq expr (or expr (ruby-expr-beg) + (looking-at "%\\sw?\\Sw\\|[\"'`/]"))) + (nth 1 (setq state (apply 'ruby-parse-partial nil state)))) + (setq expr t) + (skip-chars-forward "<")) + (not expr)))) + (setq i (1- i))) + ((error) (forward-word 1))) + i))) + +(defun-region-command ruby-backward-sexp (&optional cnt) + (interactive "p") + (if (and (numberp cnt) (< cnt 0)) + (ruby-forward-sexp (- cnt)) + (let ((i (or cnt 1))) + (condition-case nil + (while (> i 0) + (skip-chars-backward " \t\n,.:;|&^~=!?\\+\\-\\*") + (forward-char -1) + (cond ((looking-at "\\s)") + (goto-char (scan-sexps (1+ (point)) -1)) + (case (char-before) + (?% (forward-char -1)) + ('(?q ?Q ?w ?W ?r ?x) + (if (eq (char-before (1- (point))) ?%) (forward-char -2)))) + nil) + ((looking-at "\\s\"\\|\\\\\\S_") + (let ((c (char-to-string (char-before (match-end 0))))) + (while (and (search-backward c) + (oddp (skip-chars-backward "\\"))))) + nil) + ((looking-at "\\s.\\|\\s\\") + (if (ruby-special-char-p) (forward-char -1))) + ((looking-at "\\s(") nil) + (t + (forward-char 1) + (while (progn (forward-word -1) + (case (char-before) + (?_ t) + (?. (forward-char -1) t) + ((?$ ?@) + (forward-char -1) + (and (eq (char-before) (char-after)) (forward-char -1))) + (?: + (forward-char -1) + (eq (char-before) :))))) + (if (looking-at ruby-block-end-re) + (ruby-beginning-of-block)) + nil)) + (setq i (1- i))) + ((error))) + i))) + +(defun ruby-reindent-then-newline-and-indent () + (interactive "*") + (newline) + (save-excursion + (end-of-line 0) + (indent-according-to-mode) + (delete-region (point) (progn (skip-chars-backward " \t") (point)))) + (indent-according-to-mode)) + +(fset 'ruby-encomment-region (symbol-function 'comment-region)) + +(defun ruby-decomment-region (beg end) + (interactive "r") + (save-excursion + (goto-char beg) + (while (re-search-forward "^\\([ \t]*\\)#" end t) + (replace-match "\\1" nil nil) + (save-excursion + (ruby-indent-line))))) + +(defun ruby-insert-end () + (interactive) + (insert "end") + (ruby-indent-line t) + (end-of-line)) + +(defun ruby-mark-defun () + "Put mark at end of this Ruby function, point at beginning." + (interactive) + (push-mark (point)) + (ruby-end-of-defun) + (push-mark (point) nil t) + (ruby-beginning-of-defun) + (re-search-backward "^\n" (- (point) 1) t)) + +(defun ruby-indent-exp (&optional shutup-p) + "Indent each line in the balanced expression following point syntactically. +If optional SHUTUP-P is non-nil, no errors are signalled if no +balanced expression is found." + (interactive "*P") + (let ((here (point-marker)) start top column (nest t)) + (set-marker-insertion-type here t) + (unwind-protect + (progn + (beginning-of-line) + (setq start (point) top (current-indentation)) + (while (and (not (eobp)) + (progn + (setq column (ruby-calculate-indent start)) + (cond ((> column top) + (setq nest t)) + ((and (= column top) nest) + (setq nest nil) t)))) + (ruby-indent-to column) + (beginning-of-line 2))) + (goto-char here) + (set-marker here nil)))) + +(defun ruby-add-log-current-method () + "Return current method string." + (condition-case nil + (save-excursion + (let ((mlist nil) (indent 0)) + ;; get current method (or class/module) + (if (re-search-backward + (concat "^[ \t]*\\(def\\|class\\|module\\)[ \t]+" + "\\(" + ;; \\. for class method + "\\(" ruby-symbol-re "\\|\\." "\\)" + "+\\)") + nil t) + (progn + (setq mlist (list (match-string 2))) + (goto-char (match-beginning 1)) + (setq indent (current-column)) + (beginning-of-line))) + ;; nest class/module + (while (and (> indent 0) + (re-search-backward + (concat + "^[ \t]*\\(class\\|module\\)[ \t]+" + "\\([A-Z]" ruby-symbol-re "+\\)") + nil t)) + (goto-char (match-beginning 1)) + (if (< (current-column) indent) + (progn + (setq mlist (cons (match-string 2) mlist)) + (setq indent (current-column)) + (beginning-of-line)))) + ;; generate string + (if (consp mlist) + (mapconcat (function identity) mlist "::") + nil))))) + +(cond + ((featurep 'font-lock) + (or (boundp 'font-lock-variable-name-face) + (setq font-lock-variable-name-face font-lock-type-face)) + + (setq ruby-font-lock-syntactic-keywords + '( + ;; #{ }, #$hoge, #@foo are not comments + ("\\(#\\)[{$@]" 1 (1 . nil)) + ;; the last $', $", $` in the respective string is not variable + ;; the last ?', ?", ?` in the respective string is not ascii code + ("\\(^\\|[\[ \t\n<+\(,=]\\)\\(['\"`]\\)\\(\\\\.\\|\\2\\|[^'\"`\n\\\\]\\)*?\\\\?[?$]\\(\\2\\)" + (2 (7 . nil)) + (4 (7 . nil))) + ;; $' $" $` .... are variables + ;; ?' ?" ?` are ascii codes + ("\\(^\\|[^\\\\]\\)\\(\\\\\\\\\\)*[?$]\\([#\"'`]\\)" 3 (1 . nil)) + ;; regexps + ("\\(^\\|[=(,~?:;<>]\\|\\(^\\|\\s \\)\\(if\\|elsif\\|unless\\|while\\|until\\|when\\|and\\|or\\|&&\\|||\\)\\|g?sub!?\\|scan\\|split!?\\)\\s *\\(/\\)[^/\n\\\\]*\\(\\\\.[^/\n\\\\]*\\)*\\(/\\)" + (4 (7 . ?/)) + (6 (7 . ?/))) + ("^\\(=\\)begin\\(\\s \\|$\\)" 1 (7 . nil)) + ("^\\(=\\)end\\(\\s \\|$\\)" 1 (7 . nil)))) + + (cond ((featurep 'xemacs) + (put 'ruby-mode 'font-lock-defaults + '((ruby-font-lock-keywords) + nil nil nil + beginning-of-line + (font-lock-syntactic-keywords + . ruby-font-lock-syntactic-keywords)))) + (t + (add-hook 'ruby-mode-hook + '(lambda () + (make-local-variable 'font-lock-defaults) + (make-local-variable 'font-lock-keywords) + (make-local-variable 'font-lock-syntax-table) + (make-local-variable 'font-lock-syntactic-keywords) + (setq font-lock-defaults '((ruby-font-lock-keywords) nil nil)) + (setq font-lock-keywords ruby-font-lock-keywords) + (setq font-lock-syntax-table ruby-font-lock-syntax-table) + (setq font-lock-syntactic-keywords ruby-font-lock-syntactic-keywords))))) + + (defun ruby-font-lock-docs (limit) + (if (re-search-forward "^=begin\\(\\s \\|$\\)" limit t) + (let (beg) + (beginning-of-line) + (setq beg (point)) + (forward-line 1) + (if (re-search-forward "^=end\\(\\s \\|$\\)" limit t) + (progn + (set-match-data (list beg (point))) + t))))) + + (defun ruby-font-lock-maybe-docs (limit) + (let (beg) + (save-excursion + (if (and (re-search-backward "^=\\(begin\\|end\\)\\(\\s \\|$\\)" nil t) + (string= (match-string 1) "begin")) + (progn + (beginning-of-line) + (setq beg (point))))) + (if (and beg (and (re-search-forward "^=\\(begin\\|end\\)\\(\\s \\|$\\)" nil t) + (string= (match-string 1) "end"))) + (progn + (set-match-data (list beg (point))) + t) + nil))) + + (defvar ruby-font-lock-syntax-table + (let* ((tbl (copy-syntax-table ruby-mode-syntax-table))) + (modify-syntax-entry ?_ "w" tbl) + tbl)) + + (defun ruby-font-lock-here-docs (limit) + (if (re-search-forward ruby-here-doc-beg-re limit t) + (let (beg) + (beginning-of-line) + (forward-line) + (setq beg (point)) + (if (re-search-forward (ruby-here-doc-end-match) nil t) + (progn + (set-match-data (list beg (point))) + t))))) + + (defun ruby-font-lock-maybe-here-docs (limit) + (let (beg) + (save-excursion + (if (re-search-backward ruby-here-doc-beg-re nil t) + (progn + (beginning-of-line) + (forward-line) + (setq beg (point))))) + (if (and beg + (let ((end-match (ruby-here-doc-end-match))) + (and (not (re-search-backward end-match beg t)) + (re-search-forward end-match nil t)))) + (progn + (set-match-data (list beg (point))) + t) + nil))) + + (defvar ruby-font-lock-keywords + (list + ;; functions + '("^\\s *def\\s +\\([^( \t\n]+\\)" + 1 font-lock-function-name-face) + ;; keywords + (cons (concat + "\\(^\\|[^_:.@$]\\|\\.\\.\\)\\b\\(defined\\?\\|\\(" + (mapconcat + 'identity + '("alias" + "and" + "begin" + "break" + "case" + "catch" + "class" + "def" + "do" + "elsif" + "else" + "fail" + "ensure" + "for" + "end" + "if" + "in" + "module" + "next" + "not" + "or" + "raise" + "redo" + "rescue" + "retry" + "return" + "then" + "throw" + "super" + "unless" + "undef" + "until" + "when" + "while" + "yield" + ) + "\\|") + "\\)\\>\\)") + 2) + ;; variables + '("\\(^\\|[^_:.@$]\\|\\.\\.\\)\\b\\(nil\\|self\\|true\\|false\\)\\>" + 2 font-lock-variable-name-face) + ;; variables + '("\\(\\$\\([^a-zA-Z0-9 \n]\\|[0-9]\\)\\)\\W" + 1 font-lock-variable-name-face) + '("\\(\\$\\|@\\|@@\\)\\(\\w\\|_\\)+" + 0 font-lock-variable-name-face) + ;; embedded document + '(ruby-font-lock-docs + 0 font-lock-comment-face t) + '(ruby-font-lock-maybe-docs + 0 font-lock-comment-face t) + ;; "here" document + '(ruby-font-lock-here-docs + 0 font-lock-string-face t) + '(ruby-font-lock-maybe-here-docs + 0 font-lock-string-face t) + `(,ruby-here-doc-beg-re + 0 font-lock-string-face t) + ;; general delimited string + '("\\(^\\|[[ \t\n<+(,=]\\)\\(%[xrqQwW]?\\([^<[{(a-zA-Z0-9 \n]\\)[^\n\\\\]*\\(\\\\.[^\n\\\\]*\\)*\\(\\3\\)\\)" + (2 font-lock-string-face)) + ;; constants + '("\\(^\\|[^_]\\)\\b\\([A-Z]+\\(\\w\\|_\\)*\\)" + 2 font-lock-type-face) + ;; symbols + '("\\(^\\|[^:]\\)\\(:\\([-+~]@?\\|[/%&|^`]\\|\\*\\*?\\|<\\(<\\|=>?\\)?\\|>[>=]?\\|===?\\|=~\\|\\[\\]=?\\|\\(\\w\\|_\\)+\\([!?=]\\|\\b_*\\)\\|#{[^}\n\\\\]*\\(\\\\.[^}\n\\\\]*\\)*}\\)\\)" + 2 font-lock-reference-face) + ;; expression expansion + '("#\\({[^}\n\\\\]*\\(\\\\.[^}\n\\\\]*\\)*}\\|\\(\\$\\|@\\|@@\\)\\(\\w\\|_\\)+\\)" + 0 font-lock-variable-name-face t) + ;; warn lower camel case + ;'("\\<[a-z]+[a-z0-9]*[A-Z][A-Za-z0-9]*\\([!?]?\\|\\>\\)" + ; 0 font-lock-warning-face) + ) + "*Additional expressions to highlight in ruby mode.")) + + ((featurep 'hilit19) + (hilit-set-mode-patterns + 'ruby-mode + '(("[^$\\?]\\(\"[^\\\"]*\\(\\\\\\(.\\|\n\\)[^\\\"]*\\)*\"\\)" 1 string) + ("[^$\\?]\\('[^\\']*\\(\\\\\\(.\\|\n\\)[^\\']*\\)*'\\)" 1 string) + ("[^$\\?]\\(`[^\\`]*\\(\\\\\\(.\\|\n\\)[^\\`]*\\)*`\\)" 1 string) + ("^\\s *#.*$" nil comment) + ("[^$@?\\]\\(#[^$@{\n].*$\\)" 1 comment) + ("[^a-zA-Z_]\\(\\?\\(\\\\[CM]-\\)*.\\)" 1 string) + ("^\\s *\\(require\\|load\\).*$" nil include) + ("^\\s *\\(include\\|alias\\|undef\\).*$" nil decl) + ("^\\s *\\<\\(class\\|def\\|module\\)\\>" "[)\n;]" defun) + ("[^_]\\<\\(begin\\|case\\|else\\|elsif\\|end\\|ensure\\|for\\|if\\|unless\\|rescue\\|then\\|when\\|while\\|until\\|do\\|yield\\)\\>\\([^_]\\|$\\)" 1 defun) + ("[^_]\\<\\(and\\|break\\|next\\|raise\\|fail\\|in\\|not\\|or\\|redo\\|retry\\|return\\|super\\|yield\\|catch\\|throw\\|self\\|nil\\)\\>\\([^_]\\|$\\)" 1 keyword) + ("\\$\\(.\\|\\sw+\\)" nil type) + ("[$@].[a-zA-Z_0-9]*" nil struct) + ("^__END__" nil label)))) + ) + + +(provide 'ruby-mode) diff --git a/emacs.d/ruby-style.el b/emacs.d/ruby-style.el new file mode 100644 index 0000000..e0ed41f --- /dev/null +++ b/emacs.d/ruby-style.el @@ -0,0 +1,43 @@ +;;; -*- emacs-lisp -*- +;;; C/C++ mode style for Ruby. + +(defun ruby-style-case-indent (x) + (save-excursion + (goto-char (cdr x)) + (if (looking-at "\\") '*))) + +(defun ruby-style-label-indent (x) + (save-excursion + (goto-char (cdr x)) + (backward-up-list) + (backward-sexp 2) + (if (looking-at "\\") '/))) + +(require 'cc-styles) +(c-add-style + "ruby" + '("bsd" + (c-basic-offset . 4) + (tab-width . 8) + (indent-tabs-mode . t) + (c-offsets-alist + (case-label . *) + (label . (ruby-style-label-indent *)) + (statement-case-intro . *) + (statement-case-open . *) + (statement-block-intro . (ruby-style-case-indent +)) + (access-label /) + ))) + +(defun ruby-style-c-mode () + (interactive) + (if (or (string-match "/ruby\\>" (buffer-file-name)) + (save-excursion + (goto-char (point-min)) + (let ((head (progn (forward-line 100) (point))) + (case-fold-search nil)) + (goto-char (point-min)) + (re-search-forward "Copyright (C) .* Yukihiro Matsumoto" head t)))) + (setq c-file-style "ruby"))) + +(provide 'ruby-style) diff --git a/emacs.d/rubydb2x.el b/emacs.d/rubydb2x.el new file mode 100644 index 0000000..a74265f --- /dev/null +++ b/emacs.d/rubydb2x.el @@ -0,0 +1,104 @@ +(require 'gud) +(provide 'rubydb) + +;; ====================================================================== +;; rubydb functions + +;;; History of argument lists passed to rubydb. +(defvar gud-rubydb-history nil) + +(defun gud-rubydb-massage-args (file args) + (cons "-I" (cons "." (cons "-r" (cons "debug" (cons file args)))))) + +;; There's no guarantee that Emacs will hand the filter the entire +;; marker at once; it could be broken up across several strings. We +;; might even receive a big chunk with several markers in it. If we +;; receive a chunk of text which looks like it might contain the +;; beginning of a marker, we save it here between calls to the +;; filter. +(defvar gud-rubydb-marker-acc "") + +(defun gud-rubydb-marker-filter (string) + (save-match-data + (setq gud-marker-acc (concat gud-marker-acc string)) + (let ((output "")) + + ;; Process all the complete markers in this chunk. + (while (string-match "\032\032\\([^:\n]*\\):\\([0-9]*\\):.*\n" + gud-marker-acc) + (setq + + ;; Extract the frame position from the marker. + gud-last-frame + (cons (substring gud-marker-acc (match-beginning 1) (match-end 1)) + (string-to-int (substring gud-marker-acc + (match-beginning 2) + (match-end 2)))) + + ;; Append any text before the marker to the output we're going + ;; to return - we don't include the marker in this text. + output (concat output + (substring gud-marker-acc 0 (match-beginning 0))) + + ;; Set the accumulator to the remaining text. + gud-marker-acc (substring gud-marker-acc (match-end 0)))) + + ;; Does the remaining text look like it might end with the + ;; beginning of another marker? If it does, then keep it in + ;; gud-marker-acc until we receive the rest of it. Since we + ;; know the full marker regexp above failed, it's pretty simple to + ;; test for marker starts. + (if (string-match "\032.*\\'" gud-marker-acc) + (progn + ;; Everything before the potential marker start can be output. + (setq output (concat output (substring gud-marker-acc + 0 (match-beginning 0)))) + + ;; Everything after, we save, to combine with later input. + (setq gud-marker-acc + (substring gud-marker-acc (match-beginning 0)))) + + (setq output (concat output gud-marker-acc) + gud-marker-acc "")) + + output))) + +(defun gud-rubydb-find-file (f) + (find-file-noselect f)) + +(defvar rubydb-command-name "ruby" + "File name for executing ruby.") + +;;;###autoload +(defun rubydb (command-line) + "Run rubydb on program FILE in buffer *gud-FILE*. +The directory containing FILE becomes the initial working directory +and source-file directory for your debugger." + (interactive + (list (read-from-minibuffer "Run rubydb (like this): " + (if (consp gud-rubydb-history) + (car gud-rubydb-history) + (concat rubydb-command-name " ")) + nil nil + '(gud-rubydb-history . 1)))) + + (gud-overload-functions '((gud-massage-args . gud-rubydb-massage-args) + (gud-marker-filter . gud-rubydb-marker-filter) + (gud-find-file . gud-rubydb-find-file) + )) + (gud-common-init command-line) + + (gud-def gud-break "b %l" "\C-b" "Set breakpoint at current line.") +; (gud-def gud-remove "clear %l" "\C-d" "Remove breakpoint at current line") + (gud-def gud-step "s" "\C-s" "Step one source line with display.") + (gud-def gud-next "n" "\C-n" "Step one line (skip functions).") + (gud-def gud-cont "c" "\C-r" "Continue with display.") + (gud-def gud-finish "finish" "\C-f" "Finish executing current function.") + (gud-def gud-up "up %p" "<" "Up N stack frames (numeric arg).") + (gud-def gud-down "down %p" ">" "Down N stack frames (numeric arg).") + (gud-def gud-print "p %e" "\C-p" "Evaluate ruby expression at point.") + + (setq comint-prompt-regexp "^(rdb:-) ") + (setq paragraph-start comint-prompt-regexp) + (run-hooks 'rubydb-mode-hook) + ) diff --git a/emacs.d/rubydb3x.el b/emacs.d/rubydb3x.el new file mode 100644 index 0000000..98ce1a1 --- /dev/null +++ b/emacs.d/rubydb3x.el @@ -0,0 +1,115 @@ +(require 'gud) +(provide 'rubydb) + +;; ====================================================================== +;; rubydb functions + +;;; History of argument lists passed to rubydb. +(defvar gud-rubydb-history nil) + +(if (fboundp 'gud-overload-functions) + (defun gud-rubydb-massage-args (file args) + (cons "-r" (cons "debug" (cons file args)))) + (defun gud-rubydb-massage-args (file args) + (cons "-r" (cons "debug" args)))) + +;; There's no guarantee that Emacs will hand the filter the entire +;; marker at once; it could be broken up across several strings. We +;; might even receive a big chunk with several markers in it. If we +;; receive a chunk of text which looks like it might contain the +;; beginning of a marker, we save it here between calls to the +;; filter. +(defvar gud-rubydb-marker-acc "") +(make-variable-buffer-local 'gud-rubydb-marker-acc) + +(defun gud-rubydb-marker-filter (string) + (setq gud-rubydb-marker-acc (concat gud-rubydb-marker-acc string)) + (let ((output "")) + + ;; Process all the complete markers in this chunk. + (while (string-match "\032\032\\([^:\n]*\\):\\([0-9]*\\):.*\n" + gud-rubydb-marker-acc) + (setq + + ;; Extract the frame position from the marker. + gud-last-frame + (cons (substring gud-rubydb-marker-acc (match-beginning 1) (match-end 1)) + (string-to-int (substring gud-rubydb-marker-acc + (match-beginning 2) + (match-end 2)))) + + ;; Append any text before the marker to the output we're going + ;; to return - we don't include the marker in this text. + output (concat output + (substring gud-rubydb-marker-acc 0 (match-beginning 0))) + + ;; Set the accumulator to the remaining text. + gud-rubydb-marker-acc (substring gud-rubydb-marker-acc (match-end 0)))) + + ;; Does the remaining text look like it might end with the + ;; beginning of another marker? If it does, then keep it in + ;; gud-rubydb-marker-acc until we receive the rest of it. Since we + ;; know the full marker regexp above failed, it's pretty simple to + ;; test for marker starts. + (if (string-match "\032.*\\'" gud-rubydb-marker-acc) + (progn + ;; Everything before the potential marker start can be output. + (setq output (concat output (substring gud-rubydb-marker-acc + 0 (match-beginning 0)))) + + ;; Everything after, we save, to combine with later input. + (setq gud-rubydb-marker-acc + (substring gud-rubydb-marker-acc (match-beginning 0)))) + + (setq output (concat output gud-rubydb-marker-acc) + gud-rubydb-marker-acc "")) + + output)) + +(defun gud-rubydb-find-file (f) + (save-excursion + (let ((buf (find-file-noselect f))) + (set-buffer buf) +;; (gud-make-debug-menu) + buf))) + +(defvar rubydb-command-name "ruby" + "File name for executing ruby.") + +;;;###autoload +(defun rubydb (command-line) + "Run rubydb on program FILE in buffer *gud-FILE*. +The directory containing FILE becomes the initial working directory +and source-file directory for your debugger." + (interactive + (list (read-from-minibuffer "Run rubydb (like this): " + (if (consp gud-rubydb-history) + (car gud-rubydb-history) + (concat rubydb-command-name " ")) + nil nil + '(gud-rubydb-history . 1)))) + + (if (not (fboundp 'gud-overload-functions)) + (gud-common-init command-line 'gud-rubydb-massage-args + 'gud-rubydb-marker-filter 'gud-rubydb-find-file) + (gud-overload-functions '((gud-massage-args . gud-rubydb-massage-args) + (gud-marker-filter . gud-rubydb-marker-filter) + (gud-find-file . gud-rubydb-find-file))) + (gud-common-init command-line rubydb-command-name)) + + (gud-def gud-break "b %l" "\C-b" "Set breakpoint at current line.") +; (gud-def gud-remove "clear %l" "\C-d" "Remove breakpoint at current line") + (gud-def gud-step "s" "\C-s" "Step one source line with display.") + (gud-def gud-next "n" "\C-n" "Step one line (skip functions).") + (gud-def gud-cont "c" "\C-r" "Continue with display.") + (gud-def gud-finish "finish" "\C-f" "Finish executing current function.") + (gud-def gud-up "up %p" "<" "Up N stack frames (numeric arg).") + (gud-def gud-down "down %p" ">" "Down N stack frames (numeric arg).") + (gud-def gud-print "p %e" "\C-p" "Evaluate ruby expression at point.") + + (setq comint-prompt-regexp "^(rdb:-) ") + (if (boundp 'comint-last-output-start) + (set-marker comint-last-output-start (point))) + (set (make-local-variable 'paragraph-start) comint-prompt-regexp) + (run-hooks 'rubydb-mode-hook) + ) diff --git a/emacs.d/shift_mark.el b/emacs.d/shift_mark.el new file mode 100644 index 0000000..97bd67d --- /dev/null +++ b/emacs.d/shift_mark.el @@ -0,0 +1,86 @@ +; emacs "shift-mark" functionality +; +; Allows you to mark a region by holding down the Shift modifier key +; and moving the cursor. +; Source: http://www.cs.ucsb.edu/~matz/study/EmacsShiftMark.html +; +; written by matz"a"cs.ucsb.edu, March 10th, 1998 + +(defun shift-mark (cmd) + "Expands marked region to the point (position of cursor) after executing +command 'cmd'. If no region is marked, we mark one first." + (interactive "_a") + (if (not (region-active-p)) + (progn (set-mark-command nil) + (command-execute cmd)) + (command-execute cmd) +)) + +(defun shift-mark-forward-char () + (interactive) + (shift-mark 'forward-char) +) + +(defun shift-mark-backward-char () + (interactive) + (shift-mark 'backward-char) +) + +(defun shift-mark-forward-word () + (interactive) + (shift-mark 'forward-word) +) + +(defun shift-mark-backward-word () + (interactive) + (shift-mark 'backward-word) +) + +(defun shift-mark-forward-paragraph () + (interactive) + (shift-mark 'forward-paragraph) +) + +(defun shift-mark-backward-paragraph () + (interactive) + (shift-mark 'backward-paragraph) +) + +(defun shift-mark-previous-line () + (interactive) + (shift-mark 'previous-line) +) + +(defun shift-mark-next-line () + (interactive) + (shift-mark 'next-line) +) + +(defun backspace-delete-marked-region () + (interactive) + ; (zmacs-region-stays t) + (if (region-active-p) + (kill-region (mark) (point)) + (delete-backward-char 1) + ) +) + +(global-set-key '(shift right) 'shift-mark-forward-char) +(global-set-key '(shift left) 'shift-mark-backward-char) +(global-set-key '(shift up) 'shift-mark-previous-line) +(global-set-key '(shift down) 'shift-mark-next-line) +(global-set-key '(shift control right) 'shift-mark-forward-word) +(global-set-key '(shift control left) 'shift-mark-backward-word) +(global-set-key '(shift control up) 'shift-mark-backward-paragraph) +(global-set-key '(shift control down) 'shift-mark-forward-paragraph) +(global-set-key '(shift backspace) 'backspace-delete-marked-region) +(global-set-key '(control backspace) 'backspace-delete-marked-region) +(global-set-key '(shift control backspace) 'backspace-delete-marked-region) +(global-set-key '(del) 'backspace-delete-marked-region) + +(global-set-key '(control left) 'backward-word) +(global-set-key '(control right) 'forward-word) +(global-set-key '(control up) 'backward-paragraph) +(global-set-key '(control down) 'forward-paragraph) +(global-set-key '(f27) 'beginning-of-line) ;HOME +(global-set-key '(f33) 'end-of-line) ;END diff --git a/emacs.d/snippet.el b/emacs.d/snippet.el new file mode 100644 index 0000000..0e44236 --- /dev/null +++ b/emacs.d/snippet.el @@ -0,0 +1,633 @@ +;;; snippet.el -- insert snippets of text into a buffer + +;; Copyright (C) 2005 Pete Kazmier + +;; Version: 0.2 +;; Author: Pete Kazmier + +;; This file is not part of GNU Emacs, but it is distributed under +;; the same terms as GNU Emacs. + +;; GNU Emacs is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published +;; by the Free Software Foundation; either version 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, Inc., 59 Temple Place - Suite 330, +;; Boston, MA 02111-1307, USA. + +;;; Description: + +;; A quick stab at providing a simple template facility like the one +;; present in TextMate (an OSX editor). The general idea is that a +;; snippet of text (called a template) is inserted into a buffer +;; (perhaps triggered by an abbrev), and while the point is within the +;; snippet, a special keymap is active to permit the user to cycle the +;; point to any of the defined fields (placeholders) within the +;; template via `snippet-next-field' and `snippet-prev-field'. + +;; For example, the following template might be a useful while editing +;; HTML: + +;; $$ + +;; This template might be useful for python developers. In this +;; example, reasonable defaults have been supplied: + +;; for $${element} in $${sequence}: +;; match = $${regexp}.search($${element}) + +;; When a template is inserted into a buffer (could be triggered by an +;; abbrev expansion, or simply bound to some key), point is moved to +;; the first field denoted by the "$$" characters (configurable via +;; `snippet-field-identifier'). The optional default for a field is +;; specified by the "{default}" (the delimiters are configurable via +;; `snippet-field-default-beg-char' and `snippet-field-defaul-end-char'. + +;; If present, the default will be inserted and highlighted. The user +;; then has the option of accepting the default by simply tabbing over +;; to the next field (any other key bound to `snippet-next-field' in +;; `snippet-map' can be used). Alternatively, the user can start +;; typing their own value for the field which will cause the default +;; to be immediately replaced with the user's own input. If two or +;; more fields have the same default value, they are linked together +;; (changing one will change the other dynamically as you type). + +;; `snippet-next-field' (bound to by default) moves the point to +;; the next field. `snippet-prev-field' (bound to by default) +;; moves the point to the previous field. When the snippet has been +;; completed, the user simply tabs past the last field which causes +;; the snippet to revert to plain text in a buffer. The idea is that +;; snippets should get out of a user's way as soon as they have been +;; filled and completed. + +;; After tabbing past all of the fields, point is moved to the end of +;; the snippet, unless the user has specified a place within the +;; template with the `snippet-exit-identifier' ("$." by default). For +;; example: + +;; if ($${test} { +;; $. +;; } + +;; Indentation can be controlled on a per line basis by including the +;; `snippet-indent' string within the template. Most often one would +;; include this at the beginning of a line; however, there are times +;; when indentation is better performed in other parts of the line. +;; The following shows how to use the functionality: + +;; if ($${test}) { +;; $>this line would be indented +;; this line will be indented after being inserted$> +;; } + +;;; Usage: + +;; Snippets are inserted with the `snippet-insert' function. This +;; function inserts the snippet into the current buffer. It expects a +;; single argument which is the template that is to be inserted. For +;; example: + +;; (snippet-insert "for $${element} in $${sequence}:") + +;; `snippet-insert' can be called interactively in which case the user +;; is prompted for the template to insert. This is hardly useful at +;; all unless you are testing the functionality of this code. + +;; Snippets are much more effective when they are bound to expansions +;; for abbreviations. When binding a snippet to an abbreviation, it +;; is important that you disable the insertion of the character that +;; triggered the expansion (typically some form of whitespace). For +;; example, this is what you should NOT do: + +;; (define-abbrev python-mode-abbrev-table ; abbrev table +;; "for" ; name +;; "" ; expansion +;; '(lambda () ; expansion hook +;; (snippet-insert +;; "for $${element} in $${sequence}:"))) + +;; The above example does not work as expected because after the +;; expansion hook is called, the snippet is inserted, and the point is +;; moved to the first field. The problem occurs because when the user +;; typed "f o r ", the "" character is inserted after the +;; snippet has been inserted. The point happens to be located at the +;; first field and thus the "" will delete any field default that +;; was present. + +;; Fortunately, this is easy to fix. According to the documentation +;; for `define-abbrev', if the hook function is a symbol whose +;; `no-self-insert' property is non-nil, then hook can control whether +;; or not the insertion of the character that triggered the abbrev +;; expansion is inserted. `insert-snippet' returns non-nil and thus +;; the proper way of defining the abbrev is as follows: + +;; (defun python-foo-expansion () +;; (snippet-insert "for $${element} in $${sequence}:")) + +;; (put 'python-foo-expansion 'no-self-insert t) + +;; (define-abbrev python-mode-abbrev-table ; abbrev table +;; "for" ; name +;; "" ; expansion +;; 'python-foo-expansion) ; expansion hook + +;; Unfortunately, this is a lot of work to define what should be a +;; simple abbrev. For convenience, this package provides a macro +;; `snippet-abbrev' that can be used with much less effort: + +;; (snippet-abbrev 'python-mode-abbrev-table ; table +;; "for" ; name +;; "for $${element} in $${sequence}:") ; template + +;; For even more convevience, when defining a lot of abbrevs in a +;; particular abbrev table, the package provides another macro +;; `snippet-with-abbrev-table': + +;; (snippet-with-abbrev-table 'python-mode-abbrev-table +;; ("for" . "for $${element} in $${sequence}:") +;; ("im" . "import $$") +;; ("if" . "if $${True}:") +;; ("wh" . "while $${True}:")) + +;; Be sure that the appropriate abbrev-table is loaded before using +;; the above otherwise you'll get an error. I use the above in my +;; python-mode-hook. + +;; Finally, for those running a recent version of Emacs, you can +;; disable snippet expansion in various parts of the buffer. I use +;; this to disable the above "for" expansion while typing comments in +;; my python code. Add the following line to your python-mode hook: + +;; (add-hook 'pre-abbrev-expand-hook +;; (lambda () +;; (setq local-abbrev-table +;; (if (inside-comment-p) +;; text-mode-abbrev-table +;; python-mode-abbrev-table))) +;; nil t))) + +;;; Implementation Notes: + +;; This is my first significant chunk of elisp code. I have very +;; little experience coding with elisp; however, I have tried to +;; document the code for anyone trying to follow along. Here are some +;; brief notes on the implementation. + +;; When a snippet is inserted, the entire template of text has an +;; overlay applied. This overlay is referred to as the "bound" +;; overlay in the code. It is used to bold-face the snippet as well +;; as provide the keymap that is used while the point is located +;; within the snippet (so users can tab between fields). This overlay +;; is actually one character longer than the template. The reason is +;; to make sure that our local keymap is still in effect when a user +;; is typing in a field that happens to be at the end of the +;; template. + +;; In addition, for each field (denoted by snippet-field-identifier), +;; an overlay is created. These overlays are used to provide the +;; highlighting of the field values, the location of where the point +;; should move when tab is pressed (the start of the overlay is used +;; for this purpose), as well as the hooks to delete the default value +;; if a user starts to type their own value (the modification hooks of +;; the overlay are used for this purpose). + +;; Once the user has tabbed out of the snippet, all overlays are +;; deleted and the snippet then becomes normal text. Moving the +;; cursor back into the snippet has no affect (the snippet is not +;; activated again). The idea is that the snippet concept should get +;; out of the users way as quickly as possible. + +;;; Comparisons to Other Packages + +;; tempo.el +;; - Template definition is very lispy (although powerful). In +;; contrast, snippets are simple strings with minimal syntax. +;; - Template parameters can be prompted via minibuffer. In +;; contrast, snippets use overlays to visually cue the user for +;; parameters. +;; + Templates can be wrapped around regions of text. +;; + +;;; Known Limitations: + +;; - When one uses something like `dabbrev-expand', when the text is +;; inserted, it blows away a lot of the snippet. Not sure why yet. +;; - Using 'indent-according-to-mode' does not seem to behave well +;; with Python mode. I have no idea why, the overlays end up +;; getting shifted around incorrectly. + +;;; Code: + +(require 'cl) + +(defgroup snippet nil + "Insert a template with fields that con contain optional defaults." + :prefix "snippet-" + :group 'abbrev + :group 'convenience) + +(defcustom snippet-bound-face 'bold + "*Face used for the body of the snippet." + :type 'face + :group 'snippet) + +(defcustom snippet-field-face 'highlight + "*Face used for the fields' default values." + :type 'face + :group 'snippet) + +(defcustom snippet-field-identifier "$$" + "*String used to identify field placeholders." + :type 'string + :group 'snippet) + +(defcustom snippet-exit-identifier "$." + "*String used to identify the exit point of the snippet." + :type 'string + :group 'snippet) + +(defcustom snippet-field-default-beg-char ?{ + "*Character used to identify the start of a field's default value." + :type 'character + :group 'snippet) + +(defcustom snippet-field-default-end-char ?} + "*Character used to identify the stop of a field's default value." + :type 'character + :group 'snippet) + +(defcustom snippet-indent "$>" + "*String used to indicate that a line is to be indented." + :type 'character + :group 'snippet) + +(defcustom snippet-line-terminator "\n" + "*String used to indicate the end of line in a snippet template." + :type 'string + :group 'snippet) + +(defvar snippet-map (make-sparse-keymap) + "Keymap used while the point is located within a snippet.") + +;; Default key bindings +(define-key snippet-map (kbd "TAB") 'snippet-next-field) +(define-key snippet-map (kbd "") 'snippet-prev-field) +(define-key snippet-map (kbd "") 'snippet-prev-field) + +(defstruct snippet + "Structure containing the overlays used to display a snippet. + +The BOUND slot contains an overlay to bound the entire text of the +template. This overlay is used to provide a different face +configurable via `snippet-bound-face' as well as the keymap that +enables tabbing between fields. + +The FIELDS slot contains a list of overlays used to indicate the +position of each field. In addition, if a field has a default, the +field overlay is used to provide a different face configurable via +`snippet-field-face'. + +The EXIT-MARKER slot contains a marker where point should be placed +after the user has cycled through all available fields." + bound fields exit-marker) + +(defvar snippet nil + "Snippet in the current buffer. +There is no more than one snippet per buffer. This variable is buffer +local.") + +(make-variable-buffer-local 'snippet) + +(defun snippet-make-bound-overlay () + "Create an overlay to bound a snippet. +Add the appropriate properties for the overlay to provide: a face used +to display the snippet, the keymap to use while within the snippet, +and the modification hooks to clean up the overlay in the event it is +deleted." + (let ((bound (make-overlay (point) (point) (current-buffer) nil nil))) + (overlay-put bound 'keymap snippet-map) + (overlay-put bound 'face snippet-bound-face) + (overlay-put bound 'modification-hooks '(snippet-bound-modified)) + bound)) + +(defun snippet-make-field-overlay (&optional name) + "Create an overlay for a field in a snippet. +Add the appropriate properties for the overlay to provide: a face used +to display a field's default value, and modification hooks to remove +the default text if the user starts typing." + (let ((field (make-overlay (point) (point) (current-buffer) nil t))) + (overlay-put field 'face snippet-field-face) + (overlay-put field 'insert-in-front-hooks '(snippet-field-insert + snippet-field-update)) + (overlay-put field 'insert-behind-hooks '(snippet-field-modified + snippet-field-update)) + (overlay-put field 'modification-hooks '(snippet-field-modified + snippet-field-update)) + (overlay-put field 'name (when name (intern name))) + field)) + +(defun snippet-fields-with-name (name) + "Return a list of fields whose name property is equal to NAME." + (loop for field in (snippet-fields snippet) + when (eq name (overlay-get field 'name)) + collect field)) + +(defun snippet-bound-modified (bound after beg end &optional change) + "Ensure the overlay that bounds a snippet is cleaned up. +This modification hook is triggered when the overlay that bounds the +snippet is modified. It runs after the change has been made and +ensures that if the snippet has been deleted by the user, the +appropriate cleanup occurs." + (when (and after (> 2 (- (overlay-end bound) (overlay-start bound)))) + (snippet-cleanup))) + +(defun snippet-field-insert (field after beg end &optional change) + "Delete the default field value. +This insertion hook is triggered when a user starts to type when the +point is positioned at the beginning of a field (this occurs when the +user chooses to replace the field default). In this case, the hook +deletes the field default." + (let ((inhibit-modification-hooks t)) + (when (not after) + (delete-region (overlay-start field) (overlay-end field))))) + +(defun snippet-field-modified (field after beg end &optional change) + "Shrink the field overlay. +This modification hook is triggered when a user starts to type when +the point is positioned in the middle or at the end of a field (this +occurs when the user chooses to edit the field default). It is used +to ensure that the bound overlay always covers the entirety of all +field overlays, if not, its extends the bound overlay appropriately." + (let ((bound (snippet-bound snippet))) + (when (and after bound (> (overlay-end field) (overlay-end bound))) + (move-overlay bound (overlay-start bound) (overlay-end field))))) + +(defun snippet-field-update (field after beg end &optional change) + "Update all fields that have the same name. +This modificition hook is triggered when a user edits any field and is +responsible for updating all other fields that share a common name." + (let ((name (overlay-get field 'name)) + (value (buffer-substring (overlay-start field) (overlay-end field))) + (inhibit-modification-hooks t)) + (when (and name after) + (save-excursion + (dolist (like-field (set-difference (snippet-fields-with-name name) + (list field))) + (goto-char (overlay-start like-field)) + (delete-region (overlay-start like-field) + (overlay-end like-field)) + (insert value)))))) + +(defun snippet-exit-snippet () + "Move point to `snippet-exit-identifier' or end of bound. +If the snippet has defined `snippet-exit-identifier' in the template, +move the point to that location. Otherwise, move it to the end of the +snippet." + (goto-char (snippet-exit-marker snippet)) + (snippet-cleanup)) + +(defun snippet-next-field () + "Move point forward to the next field in the `snippet'. +If there are no more fields in the snippet, point is moved to the end +of the snippet or the location specified by `snippet-exit-identifier', +and the snippet reverts to normal text." + (interactive) + (let* ((bound (snippet-bound snippet)) + (fields (snippet-fields snippet)) + (exit (snippet-exit-marker snippet)) + (next-pos (loop for field in fields + for start = (overlay-start field) + when (< (point) start) return start))) + (if (not (null next-pos)) + (goto-char next-pos) + (goto-char exit) + (snippet-cleanup)))) + +(defun snippet-prev-field () + "Move point backward to the previous field in the `snippet'. +If there are no more fields in the snippet, point is moved to the end +of the snippet or the location specified by `snippet-exit-identifier', +and the snippet reverts to normal text." + (interactive) + (let* ((bound (snippet-bound snippet)) + (fields (snippet-fields snippet)) + (exit (snippet-exit-marker snippet)) + (prev-pos (loop for field in (reverse fields) + for start = (overlay-start field) + when (> (point) start) return start))) + (if (not (null prev-pos)) + (goto-char prev-pos) + (goto-char exit) + (snippet-cleanup)))) + +(defun snippet-cleanup () + "Delete all overlays associated with `snippet'. +This effectively reverts the snippet to normal text in the buffer." + (when snippet + (when (snippet-bound snippet) + (delete-overlay (snippet-bound snippet))) + (dolist (field (snippet-fields snippet)) + (delete-overlay field)) + (setq snippet nil))) + +(defun snippet-field-regexp () + "Return a regexp that is used to search for fields within a template." + (let ((beg (char-to-string snippet-field-default-beg-char)) + (end (char-to-string snippet-field-default-end-char))) + (concat (regexp-quote snippet-field-identifier) + "\\(" + (regexp-quote beg) + "\\([^" + (regexp-quote end) + "]+\\)" + (regexp-quote end) + "\\)?"))) + +(defun snippet-split-string (string &optional separators include-separators-p) + "Split STRING into substrings and separators at SEPARATORS. +Return a list of substrings and optional include the separators in the +list if INCLUDE-SEPARATORS-P is non-nil." + (let ((start 0) (list '())) + (while (string-match (or separators snippet-line-terminator) string start) + (when (< start (match-beginning 0)) + (push (substring string start (match-beginning 0)) list)) + (when include-separators-p + (push (substring string (match-beginning 0) (match-end 0)) list)) + (setq start (match-end 0))) + (when (< start (length string)) + (push (substring string start) list)) + (nreverse list))) + +(defun snippet-split-regexp () + "Return a regexp to split the template into component parts." + (concat (regexp-quote snippet-line-terminator) + "\\|" + (regexp-quote snippet-indent))) + +(defun snippet-insert (template) + "Insert a snippet into the current buffer at point. +TEMPLATE is a string that may optionally contain fields which are +specified by `snippet-field-identifier'. Fields may optionally also +include default values delimited by `snippet-field-default-beg-char' +and `snippet-field-default-end-char'. + +For example, the following template specifies two fields which have +the default values of \"element\" and \"sequence\": + + \"for $${element} in $${sequence}:\" + +In the next example, only one field is specified and no default has +been provided: + + \"import $$\" + +This function may be called interactively, in which case, the TEMPLATE +is prompted for. However, users do not typically invoke this function +interactively, rather it is most often called as part of an abbrev +expansion. See `snippet-abbrev' and `snippet-with-abbrev-table' for +more information." + (interactive "sSnippet template: ") + + ;; Step 1: Ensure only one snippet exists at a time + (snippet-cleanup) + + ;; Step 2: Create a new snippet and add the overlay to bound the + ;; template body. It should be noted that the bounded overlay is + ;; sized to be one character larger than the template body text. + ;; This enables our keymap to be active when a field happens to be + ;; the last item in a template. We disable abbrev mode to prevent + ;; our template from triggering another abbrev expansion (I do not + ;; know if the use of `insert' will actually trigger abbrevs). + (let ((abbrev-mode nil)) + (setq snippet (make-snippet :bound (snippet-make-bound-overlay))) + (let ((start (point)) + (count 0)) + (dolist (line (snippet-split-string template (snippet-split-regexp) t)) + (cond ((string-equal snippet-line-terminator line) + (insert "\n")) + ((string-equal snippet-indent line) + (indent-according-to-mode)) + (t + (insert line)))) + (move-overlay (snippet-bound snippet) start (1+ (point)))) + + + ;; Step 3: Insert the exit marker so we know where to move point + ;; to when user is done with snippet. If they did not specify + ;; where point should land, set the exit marker to the end of the + ;; snippet. + (goto-char (overlay-start (snippet-bound snippet))) + (while (re-search-forward (regexp-quote snippet-exit-identifier) + (overlay-end (snippet-bound snippet)) + t) + (replace-match "") + (setf (snippet-exit-marker snippet) (point-marker))) + + (unless (snippet-exit-marker snippet) + (let ((end (overlay-end (snippet-bound snippet)))) + (goto-char (if (= end (point-max)) end (1- end)))) + (setf (snippet-exit-marker snippet) (point-marker))) + + (set-marker-insertion-type (snippet-exit-marker snippet) t) + + ;; Step 4: Create field overlays for each field and insert any + ;; default values for the field. + (goto-char (overlay-start (snippet-bound snippet))) + (while (re-search-forward (snippet-field-regexp) + (overlay-end (snippet-bound snippet)) + t) + (let ((field (snippet-make-field-overlay (match-string 2))) + (start (match-beginning 0))) + (push field (snippet-fields snippet)) + (replace-match (if (match-beginning 2) "\\2" "")) + (move-overlay field start (point)))) + + ;; These are reversed so they are in order of how they appeared in + ;; the template as we index into this list when cycling field to + ;; field. + (setf (snippet-fields snippet) (reverse (snippet-fields snippet)))) + + ;; Step 5: Position the point at the first field or the end of the + ;; template body if no fields are present. We need to take into + ;; consideration the special case where the first field is at the + ;; start of the snippet (otherwise the call to snippet-next-field + ;; will go past it). + (let ((bound (snippet-bound snippet)) + (first (car (snippet-fields snippet)))) + (if (and first (= (overlay-start bound) (overlay-start first))) + (goto-char (overlay-start first)) + (goto-char (overlay-start (snippet-bound snippet))) + (snippet-next-field)))) + +(defun snippet-strip-abbrev-table-suffix (str) + "Strip a suffix of \"-abbrev-table\" if one is present." + (if (string-match "^\\(.*\\)-abbrev-table$" str) + (match-string 1 str) + str)) + +(defun snippet-make-abbrev-expansion-hook (abbrev-table abbrev-name template) + "Define a function with the `no-self-insert' property set non-nil. +The function name is composed of \"snippet-abbrev-\", the abbrev table +name, and the name of the abbrev. If the abbrev table name ends in +\"-abbrev-table\", it is stripped." + (let ((abbrev-expansion (intern + (concat "snippet-abbrev-" + (snippet-strip-abbrev-table-suffix + (symbol-name abbrev-table)) + "-" + abbrev-name)))) + (fset abbrev-expansion + `(lambda () + ,(format (concat "Abbrev expansion hook for \"%s\".\n" + "Expands to the following snippet:\n\n%s") + abbrev-name + template) + (snippet-insert ,template))) + (put abbrev-expansion 'no-self-insert t) + abbrev-expansion)) + +(defmacro snippet-abbrev (abbrev-table abbrev-name template) + "Establish an abbrev for a snippet template. +Set up an abbreviation called ABBREV-NAME in the ABBREV-TABLE (note +that ABBREV-TABLE must be quoted) that expands into a snippet using +the specified TEMPLATE string. + +This macro facilitates the creation of a function for the expansion +hook to be used in `define-abbrev'. In addition, it also sets the +`no-self-insert' property on the function to prevent `abbrev-mode' +from inserting the character that triggered the expansion (typically +whitespace) which would otherwise interfere with the first field of a +snippet." + (let ((name (gensym)) + (table (gensym))) + `(let ((,name ,abbrev-name) + (,table ,abbrev-table)) + (define-abbrev (symbol-value ,table) ,name "" + (snippet-make-abbrev-expansion-hook ,table ,name ,template))))) + +(defmacro snippet-with-abbrev-table (abbrev-table &rest snippet-alist) + "Establish a set of abbrevs for snippet templates. +Set up a series of snippet abbreviations in the ABBREV-TABLE (note +that ABBREV-TABLE must be quoted. The abbrevs are specified in +SNIPPET-ALIST. For example: + + (snippet-with-abbrev-table 'python-mode-abbrev-table + (\"for\" . \"for $${element} in $${sequence}:\") + (\"im\" . \"import $$\")) + +See also `snippet-abbrev." + (let ((table (gensym))) + `(let ((,table ,abbrev-table)) + (progn + ,@(loop for (name . template) in snippet-alist + collect (list 'snippet-abbrev table name template)))))) + +(provide 'snippet) diff --git a/emacs.d/tagify.el b/emacs.d/tagify.el new file mode 100644 index 0000000..1344b5f --- /dev/null +++ b/emacs.d/tagify.el @@ -0,0 +1,35 @@ +(defun wrap-region (left right) + "Wrap the region in arbitrary text, LEFT goes to the left and RIGHT goes to the right." + (interactive) + (let* ((left-pos (region-beginning)) + (right-pos (+ (region-end) (length left))) + (end-pos (+ right-pos (length right)))) + (goto-char left-pos) + (insert left) + (goto-char right-pos) + (insert right) + (goto-char end-pos))) + +(defun tagify-region-or-insert-self (arg) + "If there is a visible region, call `tagify-region-or-insert', otherwise +call `self-insert-command' passing it any prefix arg given." + (interactive "*P") + (if (and mark-active transient-mark-mode) + (call-interactively 'tagify-region-or-insert-tag) + (self-insert-command (prefix-numeric-value arg)))) + +(defun tagify-region-or-insert-tag (tag) + "If there is a visible region, wrap it in the given HTML/XML tag using +`wrap-region'. If any attributes are specified then they are only included +in the opening tag. + +Otherwise insert the opening and closing tags and position point between the two." + (interactive "*sTag (including attributes): \n") + (let* ((open (concat "<" tag ">")) + (close (concat ""))) + (if (and mark-active transient-mark-mode) + (wrap-region open close) + (insert (concat open close)) + (backward-char (length close))))) + +(provide 'tagify) \ No newline at end of file diff --git a/emacs.d/tagify.el~ b/emacs.d/tagify.el~ new file mode 100644 index 0000000..624128e --- /dev/null +++ b/emacs.d/tagify.el~ @@ -0,0 +1,34 @@ +(defun wrap-region (left right) + "Wrap the region in arbitrary text, LEFT goes to the left and RIGHT goes to the right." + (interactive) + (let ((beg (region-beginning)) + (end (region-end))) + (goto-char beg) + (insert left) + (goto-char (+ end (length left))) + (insert right) + (goto-char (+ end (length left) (length right))))) + +(defun tagify-region-or-insert-self (arg) + "If there is a visible region, call `tagify-region-or-insert', otherwise +call `self-insert-command' passing it any prefix arg given." + (interactive "*P") + (if (and mark-active transient-mark-mode) + (call-interactively 'tagify-region-or-insert-tag) + (self-insert-command (prefix-numeric-value arg)))) + +(defun tagify-region-or-insert-tag (tag) + "If there is a visible region, wrap it in the given HTML/XML tag using +`wrap-region'. If any attributes are specified then they are only included +in the opening tag. + +Otherwise insert the opening and closing tags and position point between the two." + (interactive "*sTag (including attributes): \n") + (let* ((open (concat "<" tag ">")) + (close (concat ""))) + (if (and mark-active transient-mark-mode) + (wrap-region open close) + (insert (concat open close)) + (backward-char (length close))))) + +(provide 'tagify) \ No newline at end of file diff --git a/emacs.d/textile-mode.el b/emacs.d/textile-mode.el new file mode 100644 index 0000000..d794c09 --- /dev/null +++ b/emacs.d/textile-mode.el @@ -0,0 +1,402 @@ +;;; textile-mode.el --- Textile markup editing major mode + +;; Copyright (C) 2006 Free Software Foundation, Inc. + +;; Author: Julien Barnier +;; $Id: textile-mode.el 6 2006-03-30 22:37:08Z juba $ + +;; This file is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 2, or (at your option) +;; any later version. + +;; This file is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs; see the file COPYING. If not, write to +;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330, +;; Boston, MA 02111-1307, USA. + +;;; Commentary: + +;; + + +;; Known bugs or limitations: + +;; - if several {style}, [lang] or (class) attributes are given for +;; the same block, only the first one of each type will be +;; highlighted. +;; +;; - some complex imbrications of inline markup and attributes are +;; not well-rendered (for example, *strong *{something}notstrong*) +;; + + + +;;; Code: + + + +(defvar textile-mode-map + (let ((map (make-sparse-keymap))) + (define-key map [foo] 'textile-do-foo) + map) + "Keymap for `textile-mode'.") + + +(defun textile-re-concat (l) + "Concatenate the elements of a list with a \\| separator and +non-matching parentheses" + (concat + "\\(?:" + (mapconcat 'identity l "\\|") + "\\)")) + + +(setq textile-attributes + '("{[^}]*}" "([^)]*)" "\\[[^]]*\\]")) + +(setq textile-blocks + '("^h1" "^h2" "^h3" "^h4" "^h5" "^h6" "^p" "^bq" "^fn[0-9]+" "^#+ " "^\\*+ " "^table")) + +(setq textile-inline-markup + '("\\*" "\\*\\*" "_" "__" "\\?\\?" "@" "-" "\\+" "^" "~" "%")) + +(setq textile-alignments + '( "<>" "<" ">" "=" "(+" ")+")) + +(setq textile-table-alignments + '( "<>" "<" ">" "=" "_" "\\^" "~" "\\\\[0-9]+" "/[0-9]+")) + +; from gnus-button-url-regexp +(setq textile-url-regexp "\\b\\(\\(www\\.\\|\\(s?https?\\|ftp\\|file\\|gopher\\|nntp\\|news\\|telnet\\|wais\\|mailto\\|info\\):\\)\\(//[-a-z0-9_.]+:[0-9]*\\)?[-a-z0-9_=!?#$@~%&*+\\/:;.,[:word:]]+[-a-z0-9_=#$@~%&*+\\/[:word:]]\\)") + + +(defun textile-block-matcher (bloc) + "Return the matcher regexp for a block element" + (concat + "^" + bloc + (textile-re-concat textile-alignments) "?" + (textile-re-concat textile-attributes) "*" + "\\. " + "\\(\\(?:.\\|\n\\)*?\\)\n\n")) + +(defun textile-attribute-matcher (attr-start attr-end) + "Return the matcher regexp for an attribute" + (concat + (textile-re-concat (append textile-blocks textile-inline-markup)) + (textile-re-concat textile-alignments) "*" + (textile-re-concat textile-attributes) "*" + "\\(" attr-start "[^" + (if (string-equal attr-end "\\]") "]" attr-end) + "]*" attr-end "\\)")) + +(defun textile-inline-markup-matcher (markup) + "Return the matcher regexp for an inline markup" + (concat + "\\W\\(" + markup + "\\(?:\\w\\|\\w.*?\\w\\|[[{(].*?\\w\\)" + markup + "\\)\\W")) + +(defun textile-list-bullet-matcher (bullet) + "Return the matcher regexp for a list bullet" + (concat + "^\\(" bullet "\\)" + (textile-re-concat textile-alignments) "*" + (textile-re-concat textile-attributes) "*")) + +(defun textile-alignments-matcher () + "Return the matcher regexp for an alignments or indentation" + (concat + "\\(?:" (textile-re-concat textile-blocks) "\\|" "!" "\\)" + "\\(" (textile-re-concat textile-alignments) "+" "\\)")) + +(defun textile-table-matcher () + "Return the matcher regexp for a table row or header" + (concat + "\\(?:" + "^table" (textile-re-concat textile-table-alignments) "*" (textile-re-concat textile-attributes) "*" "\\. *$" + "\\|" + "^" (textile-re-concat textile-table-alignments) "*" (textile-re-concat textile-attributes) "*" "\\(?:\\. *|\\)" + "\\|" + "|" (textile-re-concat textile-table-alignments) "*" (textile-re-concat textile-attributes) "*" "\\(?:\\. \\)?" + "\\|" + "| *$" + "\\)")) + +(defun textile-link-matcher () + "Return the matcher regexp for a link" + (concat + "\\(?:" + "\\(?:" "\".*?\"" "\\|" "\\[.*?\\]" "\\)?" + textile-url-regexp + "\\|" + "\".*?\":[^ \n\t]+" + "\\)")) + +(defun textile-image-matcher () + "Return the matcher regexp for an image link" + (concat + "!" + (textile-re-concat textile-alignments) "*" + "/?\\w[^ \n\t]*?\\(?: *(.*?)\\|\\w\\)" + "!:?")) + +(defun textile-acronym-matcher () + "Return the matcher regexp for an acronym" + (concat + "\\w+" "(.*?)")) + +(defvar textile-font-lock-keywords + (list + ;; headers + `(,(textile-block-matcher "h1") 1 'textile-h1-face t t) + `(,(textile-block-matcher "h2") 1 'textile-h2-face t t) + `(,(textile-block-matcher "h3") 1 'textile-h3-face t t) + `(,(textile-block-matcher "h4") 1 'textile-h4-face t t) + `(,(textile-block-matcher "h5") 1 'textile-h5-face t t) + `(,(textile-block-matcher "h6") 1 'textile-h6-face t t) + ;; blockquotes + `(,(textile-block-matcher "bq") 1 'textile-blockquote-face t t) + ;; footnotes + `(,(textile-block-matcher "fn[0-9]+") 1 'textile-footnote-face t t) + ;; footnote marks + '("\\w\\([[0-9]+]\\)" 1 'textile-footnotemark-face prepend t) + ;; acronyms + `(,(textile-acronym-matcher) 0 'textile-acronym-face t t) + + ;; emphasis + `(,(textile-inline-markup-matcher "__") 1 'textile-emph-face prepend t) + `(,(textile-inline-markup-matcher "_") 1 'textile-emph-face prepend t) + '("\\(.\\|\n\\)*?" 0 'textile-emph-face prepend t) + ;; strength + `(,(textile-inline-markup-matcher "\\*\\*") 1 'textile-strong-face prepend t) + `(,(textile-inline-markup-matcher "\\*") 1 'textile-strong-face prepend t) + '("\\(.\\|\n\\)*?" 0 'textile-strong-face prepend t) + ;; citation + `(,(textile-inline-markup-matcher "\\?\\?") 1 'textile-citation-face prepend t) + ;; code + `(,(textile-inline-markup-matcher "@") 1 'textile-code-face prepend t) + ;; deletion + `(,(textile-inline-markup-matcher "-") 1 'textile-deleted-face prepend t) + ;; insertion + `(,(textile-inline-markup-matcher "\\+") 1 'textile-inserted-face prepend t) + ;; superscript + `(,(textile-inline-markup-matcher "\\^") 1 'textile-superscript-face prepend t) + ;; subscript + `(,(textile-inline-markup-matcher "~") 1 'textile-subscript-face prepend t) + ;; span + `(,(textile-inline-markup-matcher "%") 1 'textile-span-face prepend t) + + ;; image link + `(,(textile-image-matcher) 0 'textile-image-face t t) + + ;; ordered list bullet + `(,(textile-list-bullet-matcher "#+") 1 'textile-ol-bullet-face) + ;; unordered list bullet + `(,(textile-list-bullet-matcher "\\*+") 1 'textile-ul-bullet-face) + + ;; style + `(,(textile-attribute-matcher "{" "}") 1 'textile-style-face t t) + ;; class + `(,(textile-attribute-matcher "(" ")") 1 'textile-class-face t t) + ;; lang + `(,(textile-attribute-matcher "\\[" "\\]") 1 'textile-lang-face t t) + + ;; alignments and indentation + `(,(textile-alignments-matcher) 1 'textile-alignments-face t t) + + ;; tables + `(,(textile-table-matcher) 0 'textile-table-face t t) + + ;; links + `(,(textile-link-matcher) 0 'textile-link-face t t) + + ;; 
 blocks
+       '("
\\(.\\|\n\\)*?
" 0 'textile-pre-face t t) 
+       ;;  blocks
+       '("\\(.\\|\n\\)*?" 0 'textile-code-face t t))
+      "Keywords/Regexp for fontlocking of textile-mode")
+
+
+;; (defvar textile-imenu-generic-expression
+;; ...)
+
+;; (defvar textile-outline-regexp
+;;   ...)
+
+
+(define-derived-mode textile-mode text-mode "Textile"
+  "A major mode for editing textile files."
+  (set (make-local-variable 'font-lock-defaults) '(textile-font-lock-keywords t))
+  (set (make-local-variable 'font-lock-multiline) 'undecided))
+
+
+
+
+;; FACES
+
+(defgroup textile-faces nil
+  "Faces used by textile-mode for syntax highlighting"
+  :group 'faces)
+
+(defface textile-h1-face
+  '((t (:height 2.0 :weight bold)))
+  "Face used to highlight h1 headers."
+  :group 'textile-faces)
+
+(defface textile-h2-face
+  '((t (:height 1.75 :weight bold)))
+  "Face used to highlight h2 headers."
+  :group 'textile-faces)
+
+(defface textile-h3-face
+  '((t (:height 1.6 :weight bold)))
+  "Face used to highlight h3 headers."
+  :group 'textile-faces)
+
+(defface textile-h4-face
+  '((t (:height 1.35 :weight bold)))
+  "Face used to highlight h4 headers."
+  :group 'textile-faces)
+
+(defface textile-h5-face
+  '((t (:height 1.2 :weight bold)))
+  "Face used to highlight h5 headers."
+  :group 'textile-faces)
+
+(defface textile-h6-face
+  '((t (:height 1.0 :weight bold)))
+  "Face used to highlight h6 headers."
+  :group 'textile-faces)
+
+(defface textile-blockquote-face
+  '((t (:foreground "ivory4")))
+  "Face used to highlight bq blocks."
+  :group 'textile-faces)
+
+(defface textile-footnote-face
+  '((t (:foreground "orange red")))
+  "Face used to highlight footnote blocks."
+  :group 'textile-faces)
+
+(defface textile-footnotemark-face
+  '((t (:foreground "orange red")))
+  "Face used to highlight footnote marks."
+  :group 'textile-faces)
+
+(defface textile-style-face
+  '((t (:foreground "sandy brown")))
+  "Face used to highlight style parameters."
+  :group 'textile-faces)
+
+(defface textile-class-face
+  '((t (:foreground "yellow green")))
+  "Face used to highlight class and id parameters."
+  :group 'textile-faces)
+
+(defface textile-lang-face
+  '((t (:foreground "sky blue")))
+  "Face used to highlight lang parameters."
+  :group 'textile-faces)
+
+(defface textile-emph-face
+  '((t (:slant italic)))
+  "Face used to highlight emphasized words."
+  :group 'textile-faces)
+
+(defface textile-strong-face
+  '((t (:weight bold)))
+  "Face used to highlight strong words."
+  :group 'textile-faces)
+
+(defface textile-code-face
+  '((t (:foreground "ivory3")))
+  "Face used to highlight inline code."
+  :group 'textile-faces)
+
+(defface textile-citation-face
+  '((t (:slant italic)))
+  "Face used to highlight citations."
+  :group 'textile-faces)
+
+(defface textile-deleted-face
+  '((t (:strike-through t)))
+  "Face used to highlight deleted words."
+  :group 'textile-faces)
+
+(defface textile-inserted-face
+  '((t (:underline t)))
+  "Face used to highlight inserted words."
+  :group 'textile-faces)
+
+(defface textile-superscript-face
+  '((t (:height 1.1)))
+  "Face used to highlight superscript words."
+  :group 'textile-faces)
+
+(defface textile-subscript-face
+  '((t (:height 0.8)))
+  "Face used to highlight subscript words."
+  :group 'textile-faces)
+
+(defface textile-span-face
+  '((t (:foreground "pink")))
+  "Face used to highlight span words."
+  :group 'textile-faces)
+
+(defface textile-alignments-face
+  '((t (:foreground "cyan")))
+  "Face used to highlight alignments."
+  :group 'textile-faces)
+
+(defface textile-ol-bullet-face
+  '((t (:foreground "red")))
+  "Face used to highlight ordered lists bullets."
+  :group 'textile-faces)
+
+(defface textile-ul-bullet-face
+  '((t (:foreground "blue")))
+  "Face used to highlight unordered list bullets."
+  :group 'textile-faces)
+
+(defface textile-pre-face
+  '((t (:foreground "green")))
+  "Face used to highlight 
 blocks."
+  :group 'textile-faces)
+
+(defface textile-code-face
+  '((t (:foreground "yellow")))
+  "Face used to highlight  blocks."
+  :group 'textile-faces)
+
+(defface textile-table-face
+  '((t (:foreground "red")))
+  "Face used to highlight tables."
+  :group 'textile-faces)
+
+(defface textile-link-face
+  '((t (:foreground "blue")))
+  "Face used to highlight links."
+  :group 'textile-faces)
+
+(defface textile-image-face
+  '((t (:foreground "pink")))
+  "Face used to highlight image links."
+  :group 'textile-faces)
+
+(defface textile-acronym-face
+  '((t (:foreground "cyan")))
+  "Face used to highlight acronyms links."
+  :group 'textile-faces)
+
+
+(provide 'textile-mode)
+ ;;; textile-mode.el ends here
\ No newline at end of file
diff --git a/emacs.d/yaml-mode.el b/emacs.d/yaml-mode.el
new file mode 100644
index 0000000..9232965
--- /dev/null
+++ b/emacs.d/yaml-mode.el
@@ -0,0 +1,392 @@
+;;; yaml-mode.el --- Major mode for editing YAML files
+
+;; Copyright (C) 2006  Yoshiki Kurihara
+
+;; Author: Yoshiki Kurihara 
+;;         Marshall T. Vandegrift 
+;; Keywords: data yaml
+;; Version: 0.0.3
+
+;; This file is not part of Emacs
+
+;; This file is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, or (at your option)
+;; any later version.
+
+;; This file is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING.  If not, write to
+;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Commentary:
+
+;; This is a major mode for editing files in the YAML data
+;; serialization format.  It was initially developed by Yoshiki
+;; Kurihara and many features were added by Marshall Vandegrift.  As
+;; YAML and Python share the fact that indentation determines
+;; structure, this mode provides indentation and indentation command
+;; behavior very similar to that of python-mode.
+
+;;; Installation:
+
+;; To install, just drop this file into a directory in your
+;; `load-path' and (optionally) byte-compile it.  To automatically
+;; handle files ending in '.yml', add something like:
+;;
+;;    (require 'yaml-mode)
+;;    (add-to-list 'auto-mode-alist '("\\.yml$" . yaml-mode))
+;;
+;; to your .emacs file.
+;;
+;; Unlike python-mode, this mode follows the Emacs convention of not
+;; binding the ENTER key to `newline-and-indent'.  To get this
+;; behavior, add the key definition to `yaml-mode-hook':
+;;
+;;    (add-hook 'yaml-mode-hook
+;;     '(lambda ()
+;;        (define-key yaml-mode-map "\C-m" 'newline-and-indent)))
+
+;;; Known Bugs:
+
+;; YAML is easy to write but complex to parse, and this mode doesn't
+;; even really try.  Indentation and highlighting will break on
+;; abnormally complicated structures.
+
+;;; Code:
+
+
+;; User definable variables
+
+(defgroup yaml nil
+  "Support for the YAML serialization format"
+  :group 'languages
+  :prefix "yaml-")
+
+(defcustom yaml-mode-hook nil
+  "*Hook run by `yaml-mode'."
+  :type 'hook
+  :group 'yaml)
+
+(defcustom yaml-indent-offset 2
+  "*Amount of offset per level of indentation."
+  :type 'integer
+  :group 'yaml)
+
+(defcustom yaml-backspace-function 'backward-delete-char-untabify
+  "*Function called by `yaml-electric-backspace' when deleting backwards."
+  :type 'function
+  :group 'yaml)
+
+(defcustom yaml-block-literal-search-lines 100
+  "*Maximum number of lines to search for start of block literals."
+  :type 'integer
+  :group 'yaml)
+
+(defcustom yaml-block-literal-electric-alist
+  '((?| . "") (?> . "-"))
+  "*Characters for which to provide electric behavior.
+The association list key should be a key code and the associated value
+should be a string containing additional characters to insert when
+that key is pressed to begin a block literal."
+  :type 'alist
+  :group 'yaml)
+
+(defface yaml-tab-face
+   '((((class color)) (:background "red" :foreground "red" :bold t))
+     (t (:reverse-video t)))
+  "Face to use for highlighting tabs in YAML files."
+  :group 'faces
+  :group 'yaml)
+
+
+;; Constants
+
+(defconst yaml-mode-version "0.0.3" "Version of `yaml-mode.'")
+
+(defconst yaml-blank-line-re "^ *$"
+  "Regexp matching a line containing only (valid) whitespace.")
+
+(defconst yaml-comment-re "\\(#*.*\\)"
+  "Regexp matching a line containing a YAML comment or delimiter.")
+
+(defconst yaml-directive-re "^\\(?:--- \\)? *%\\(\\w+\\)"
+  "Regexp matching a line contatining a YAML directive.")
+
+(defconst yaml-document-delimiter-re "^ *\\(?:---\\|[.][.][.]\\)"
+  "Rexexp matching a YAML document delimiter line.")
+
+(defconst yaml-node-anchor-alias-re "[&*]\\w+"
+  "Regexp matching a YAML node anchor or alias.")
+
+(defconst yaml-tag-re "!!?[^ \n]+"
+  "Rexexp matching a YAML tag.")
+
+(defconst yaml-bare-scalar-re
+  "\\(?:[^-:,#!\n{\\[ ]\\|[^#!\n{\\[ ]\\S-\\)[^#\n]*?"
+  "Rexexp matching a YAML bare scalar.")
+
+(defconst yaml-hash-key-re
+  (concat "\\(?:^\\(?:--- \\)?\\|{\\|\\(?:[-,] +\\)+\\) *"
+          "\\(?:" yaml-tag-re " +\\)?"
+          "\\(" yaml-bare-scalar-re "\\) *:"
+          "\\(?: +\\|$\\)")
+  "Regexp matching a single YAML hash key.")
+
+(defconst yaml-scalar-context-re
+  (concat "\\(?:^\\(?:--- \\)?\\|{\\|\\(?:[-,] +\\)+\\) *"
+          "\\(?:" yaml-bare-scalar-re " *: \\)?")
+  "Regexp indicating the begininng of a scalar context.")
+
+(defconst yaml-nested-map-re
+  (concat ".*: *\\(?:&.*\\|{ *\\|" yaml-tag-re " *\\)?$")
+  "Regexp matching a line beginning a YAML nested structure.")
+
+(defconst yaml-block-literal-base-re " *[>|][-+0-9]* *\\(?:\n\\|\\'\\)"
+  "Regexp matching the substring start of a block literal.")
+
+(defconst yaml-block-literal-re
+  (concat yaml-scalar-context-re
+          "\\(?:" yaml-tag-re "\\)?"
+          yaml-block-literal-base-re)
+  "Regexp matching a line beginning a YAML block literal")
+
+(defconst yaml-nested-sequence-re
+  (concat "^\\(?: *- +\\)+"
+          "\\(?:" yaml-bare-scalar-re " *:\\(?: +.*\\)?\\)?$")
+  "Regexp matching a line containing one or more nested YAML sequences")
+
+(defconst yaml-constant-scalars-re
+  (concat "\\(?:^\\|\\(?::\\|-\\|,\\|{\\|\\[\\) +\\) *"
+          (regexp-opt
+           '("~" "null" "Null" "NULL"
+             ".nan" ".NaN" ".NAN"
+             ".inf" ".Inf" ".INF"
+             "-.inf" "-.Inf" "-.INF"
+             "y" "Y" "yes" "Yes" "YES" "n" "N" "no" "No" "NO"
+             "true" "True" "TRUE" "false" "False" "FALSE"
+             "on" "On" "ON" "off" "Off" "OFF") t)
+          " *$")
+  "Regexp matching certain scalar constants in scalar context")
+
+
+;; Mode setup
+
+(defvar yaml-mode-map ()
+  "Keymap used in `yaml-mode' buffers.")
+(if yaml-mode-map
+    nil
+  (setq yaml-mode-map (make-sparse-keymap))
+  (define-key yaml-mode-map "|" 'yaml-electric-bar-and-angle)
+  (define-key yaml-mode-map ">" 'yaml-electric-bar-and-angle)
+  (define-key yaml-mode-map "-" 'yaml-electric-dash-and-dot)
+  (define-key yaml-mode-map "." 'yaml-electric-dash-and-dot)
+  (define-key yaml-mode-map [backspace] 'yaml-electric-backspace)
+  (define-key yaml-mode-map "\C-j" 'newline-and-indent))
+
+(defvar yaml-mode-syntax-table nil
+  "Syntax table in use in yaml-mode buffers.")
+(if yaml-mode-syntax-table
+    nil
+  (setq yaml-mode-syntax-table (make-syntax-table))
+  (modify-syntax-entry ?\' "\"" yaml-mode-syntax-table)
+  (modify-syntax-entry ?\" "\"" yaml-mode-syntax-table)
+  (modify-syntax-entry ?# "<" yaml-mode-syntax-table)
+  (modify-syntax-entry ?\n ">" yaml-mode-syntax-table)
+  (modify-syntax-entry ?\\ "\\" yaml-mode-syntax-table)
+  (modify-syntax-entry ?- "." yaml-mode-syntax-table)
+  (modify-syntax-entry ?_ "_" yaml-mode-syntax-table)
+  (modify-syntax-entry ?\( "." yaml-mode-syntax-table)
+  (modify-syntax-entry ?\) "." yaml-mode-syntax-table)
+  (modify-syntax-entry ?\{ "(}" yaml-mode-syntax-table)
+  (modify-syntax-entry ?\} "){" yaml-mode-syntax-table)
+  (modify-syntax-entry ?\[ "(]" yaml-mode-syntax-table)
+  (modify-syntax-entry ?\] ")[" yaml-mode-syntax-table))
+
+(define-derived-mode yaml-mode fundamental-mode "YAML"
+  "Simple mode to edit YAML.
+
+\\{yaml-mode-map}"
+  (set (make-local-variable 'comment-start) "# ")
+  (set (make-local-variable 'comment-start-skip) "#+ *")
+  (set (make-local-variable 'indent-line-function) 'yaml-indent-line)
+  (set (make-local-variable 'font-lock-defaults)
+       '(yaml-font-lock-keywords
+         nil nil nil nil
+         (font-lock-syntactic-keywords . yaml-font-lock-syntactic-keywords))))
+
+
+;; Font-lock support
+
+(defvar yaml-font-lock-keywords
+   (list
+    (cons yaml-comment-re '(1 font-lock-comment-face))
+    (cons yaml-constant-scalars-re '(1 font-lock-constant-face))
+    (cons yaml-tag-re '(0 font-lock-type-face))
+    (cons yaml-node-anchor-alias-re '(0 font-lock-function-name-face t))
+    (cons yaml-hash-key-re '(1 font-lock-variable-name-face t))
+    (cons yaml-document-delimiter-re '(0 font-lock-comment-face))
+    (cons yaml-directive-re '(1 font-lock-builtin-face))
+    '(yaml-font-lock-block-literals 0 font-lock-string-face t)
+    '("^[\t]+" 0 'yaml-tab-face t))
+   "Additional expressions to highlight in YAML mode.")
+
+(defvar yaml-font-lock-syntactic-keywords
+  (list '(yaml-syntactic-block-literals 0 "." t))
+  "Additional syntax features to highlight in YAML mode.")
+
+
+(defun yaml-font-lock-block-literals (bound)
+  "Find lines within block literals.
+Find the next line of the first (if any) block literal after point and
+prior to BOUND.  Returns the beginning and end of the block literal
+line in the match data, as consumed by `font-lock-keywords' matcher
+functions.  The function begins by searching backwards to determine
+whether or not the current line is within a block literal.  This could
+be time-consuming in large buffers, so the number of lines searched is
+artificially limitted to the value of
+`yaml-block-literal-search-lines'."
+  (if (eolp) (goto-char (1+ (point))))
+  (unless (or (eobp) (>= (point) bound))
+    (let ((begin (point))
+          (end (min (1+ (point-at-eol)) bound)))
+      (goto-char (point-at-bol))
+      (while (and (looking-at yaml-blank-line-re) (not (bobp)))
+        (forward-line -1))
+      (let ((nlines yaml-block-literal-search-lines) 
+            (min-level (current-indentation))) 
+      (forward-line -1) 
+      (while (and (/= nlines 0) 
+                  (/= min-level 0) 
+                  (not (looking-at yaml-block-literal-re)) 
+                  (not (bobp))) 
+        (set 'nlines (1- nlines)) 
+        (unless (looking-at yaml-blank-line-re) 
+          (set 'min-level (min min-level (current-indentation)))) 
+        (forward-line -1)) 
+      (cond
+       ((and (< (current-indentation) min-level)
+             (looking-at yaml-block-literal-re))
+          (goto-char end) (set-match-data (list begin end)) t)
+         ((progn 
+            (goto-char begin)
+            (re-search-forward (concat yaml-block-literal-re
+                                       " *\\(.*\\)\n")
+                               bound t))
+          (set-match-data (nthcdr 2 (match-data))) t))))))
+
+(defun yaml-syntactic-block-literals (bound)
+  "Find quote characters within block literals.
+Finds the first quote character within a block literal (if any) after
+point and prior to BOUND.  Returns the position of the quote character
+in the match data, as consumed by matcher functions in
+`font-lock-syntactic-keywords'.  This allows the mode to treat ['\"]
+characters in block literals as punctuation syntax instead of string
+syntax, preventing unmatched quotes in block literals from painting
+the entire buffer in `font-lock-string-face'."
+  (let ((found nil))
+    (while (and (not found)
+                (/= (point) bound)
+                (yaml-font-lock-block-literals bound))
+      (let ((begin (match-beginning 0)) (end (match-end 0)))
+        (goto-char begin)
+        (cond
+         ((re-search-forward "['\"]" end t) (setq found t))
+         ((goto-char end)))))
+    found))
+
+
+;; Indentation and electric keys
+
+(defun yaml-compute-indentation ()
+  "Calculate the maximum sensible indentation for the current line."
+  (save-excursion
+    (beginning-of-line)
+    (if (looking-at yaml-document-delimiter-re) 0
+      (forward-line -1)
+      (while (and (looking-at yaml-blank-line-re)
+                  (> (point) (point-min)))
+        (forward-line -1))
+      (+ (current-indentation)
+         (if (looking-at yaml-nested-map-re) yaml-indent-offset 0)
+         (if (looking-at yaml-nested-sequence-re) yaml-indent-offset 0)
+         (if (looking-at yaml-block-literal-re) yaml-indent-offset 0)))))
+
+(defun yaml-indent-line ()
+  "Indent the current line.
+The first time this command is used, the line will be indented to the
+maximum sensible indentation.  Each immediately subsequent usage will
+back-dent the line by `yaml-indent-offset' spaces.  On reaching column
+0, it will cycle back to the maximum sensible indentation."
+  (interactive "*")
+  (let ((ci (current-indentation))
+        (cc (current-column))
+        (need (yaml-compute-indentation)))
+    (save-excursion
+      (beginning-of-line)
+      (delete-horizontal-space)
+      (if (and (equal last-command this-command) (/= ci 0))
+          (indent-to (* (/ (- ci 1) yaml-indent-offset) yaml-indent-offset))
+        (indent-to need)))
+      (if (< (current-column) (current-indentation))
+          (forward-to-indentation 0))))
+
+(defun yaml-electric-backspace (arg)
+  "Delete characters or back-dent the current line.
+If invoked following only whitespace on a line, will back-dent to the
+immediately previous multiple of `yaml-indent-offset' spaces."
+  (interactive "*p")
+  (if (or (/= (current-indentation) (current-column)) (bolp))
+      (funcall yaml-backspace-function arg)
+    (let ((ci (current-column)))
+      (beginning-of-line)
+      (delete-horizontal-space)
+      (indent-to (* (/ (- ci (* arg yaml-indent-offset))
+                       yaml-indent-offset)
+                    yaml-indent-offset)))))
+  
+(defun yaml-electric-bar-and-angle (arg)
+  "Insert the bound key and possibly begin a block literal.
+Inserts the bound key.  If inserting the bound key causes the current
+line to match the initial line of a block literal, then inserts the
+matching string from `yaml-block-literal-electric-alist', a newline,
+and indents appropriately."
+  (interactive "*P")
+  (self-insert-command (prefix-numeric-value arg))
+  (let ((extra-chars
+         (assoc last-command-char
+                yaml-block-literal-electric-alist)))
+    (cond
+     ((and extra-chars (not arg) (eolp)
+           (save-excursion
+             (beginning-of-line)
+             (looking-at yaml-block-literal-re)))
+      (insert (cdr extra-chars))
+      (newline-and-indent)))))
+
+(defun yaml-electric-dash-and-dot (arg)
+  "Insert the bound key and possibly de-dent line.
+Inserts the bound key.  If inserting the bound key causes the current
+line to match a document delimiter, de-dent the line to the left
+margin."
+  (interactive "*P")
+  (self-insert-command (prefix-numeric-value arg))
+  (save-excursion
+    (beginning-of-line)
+    (if (and (not arg) (looking-at yaml-document-delimiter-re))
+        (delete-horizontal-space))))
+
+(defun yaml-mode-version ()
+  "Diplay version of `yaml-mode'."
+  (interactive)
+  (message "yaml-mode %s" yaml-mode-version)
+  yaml-mode-version)
+
+(provide 'yaml-mode)
+
+;;; yaml-mode.el ends here