Mercurial > emacs
changeset 91373:924fe8b4e375
Merge from emacs--devo--0
Revision: emacs@sv.gnu.org/emacs--unicode--0--patch-329
author | Miles Bader <miles@gnu.org> |
---|---|
date | Fri, 01 Feb 2008 03:01:11 +0000 |
parents | f38e85dfd4e3 (current diff) 44fd682c485a (diff) |
children | 33d1c8d91e5e |
files | etc/ChangeLog lisp/ChangeLog lisp/blank-mode.el lisp/mail/rmail.el lisp/net/rcompile.el lisp/obsolete/whitespace.el lisp/progmodes/grep.el lisp/w32-fns.el src/ChangeLog |
diffstat | 15 files changed, 2895 insertions(+), 2714 deletions(-) [+] |
line wrap: on
line diff
--- a/admin/nt/README.W32 Thu Jan 31 13:49:17 2008 +0000 +++ b/admin/nt/README.W32 Fri Feb 01 03:01:11 2008 +0000 @@ -68,11 +68,56 @@ (non-windowed) mode of operation is most useful if you have a telnet server on your machine, allowing you to run Emacs remotely. +* EXE files included + + Emacs comes with the following executable files in the bin directory. + + + emacs.exe - The main Emacs executable. As this is designed to run + as both a text-mode application (emacs -nw) and as a GUI application, + it will pop up a command prompt window if run directly from Explorer. + + + runemacs.exe - A wrapper for running Emacs as a GUI application + without popping up a command prompt window. + + + emacsclient.exe - A command-line client program that can + communicate with a running Emacs process. See the `Emacs Server' + node of the Emacs manul. + + + emacsclientw.exe - A version of emacsclient that does not open + a command-line window. + + + addpm.exe - A basic installer that creates Start Menu icons for Emacs. + Running this is optional. + + + cmdproxy.exe - Used internally by Emacs to work around problems with + the native shells in various versions of Windows. + + + ctags.exe, etags.exe - Tools for generating tag files. See the + `Tags' node of the Emacs manual. + + + ebrowse.exe - A tool for generating C++ browse information. See the + `Ebrowse' manual. + + + ddeclient.exe - A tool for interacting with DDE servers. + + + hexl.exe - A tool for converting files to hex dumps. See the + `Editing Binary Files' node of the Emacs manual. + + + movemail.exe - A helper application for safely moving mail from + a mail spool or POP server to a local user mailbox. See the + `Movemail' node of the Emacs manual. + + + digest-doc.exe, sorted-doc.exe - Tools for rebuilding the + built-in documentation. + * Image support Emacs has built in support for XBM and PPM/PGM/PBM images, and the libXpm library is bundled, providing XPM support (required for color - toolbar icons and splash screen). + toolbar icons and splash screen). Source for libXpm should be available + on the same place as you got this binary distribution from. The version + of libXpm bundled with this version of Emacs is 3.5.7, based on x.org's + libXpm library from X11R7.3. Emacs can also support some other image formats with appropriate libraries. These libraries are all available as part of GTK, or from
--- a/etc/ChangeLog Thu Jan 31 13:49:17 2008 +0000 +++ b/etc/ChangeLog Fri Feb 01 03:01:11 2008 +0000 @@ -1,3 +1,7 @@ +2008-01-31 Alex Ott <alexott@gmail.com> + + * tutorials/TUTORIAL.ru: Update tutorial. + 2008-01-25 Michael Olson <mwolson@gnu.org> * ERC-NEWS: Update for ERC 5.3 release candidate.
--- a/etc/tutorials/TUTORIAL.ru Thu Jan 31 13:49:17 2008 +0000 +++ b/etc/tutorials/TUTORIAL.ru Fri Feb 01 03:01:11 2008 +0000 @@ -15,14 +15,29 @@ Важное замечание: для завершения сеанса Emacs, наберите C-x C-c (два символа). Символы ">>" с левой стороны указывают, что вам нужно делать, чтобы применить команду. Например: -<<Пустые строки вокруг вставлены командой help-with-tutorial>> + + + + + + + + [Середина страницы оставлена пустой в учебных целях. Текст продолжается ниже] + + + + + + + + >> Теперь нажмите C-v (просмотр следующего экрана) для перемещения на следующий экран. (выполните эту команду удерживая клавишу CONTROL и нажимая v). Теперь вы должны это сделать еще раз, когда закончите читать экран. -Обратите внимание на то, что, при переходе с экрана на экран перекрываются +Обратите внимание на то, что при переходе с экрана на экран перекрываются две строчки -- это обеспечивает некоторую непрерывность восприятия, так что вы можете продолжать читать текст не теряя нити повествования. @@ -42,9 +57,9 @@ C-v Перейти на один экран вперед M-v Перейти на один экран назад C-l Очистить экран и отобразить все заново, разместив текст, находящийся - возле курсора, в центре экрана. (это CONTROL-L, а не CONTROL-1.) + возле курсора, в центре экрана. (это CONTROL-L, а не CONTROL-1.) ->> Найдите курсор, и запомните текст возле него. Потом нажмите C-l. +>> Найдите курсор и запомните текст возле него. Потом нажмите C-l. Найдите курсор снова и убедитесь, что возле него все тот же текст. Вы также можете использовать клавиши PageUp и PageDn для перемещения между @@ -73,17 +88,17 @@ Следующая строка, C-n >> Переместите курсор на строку рядом с диаграммой, используя сочетания - клавиш C-n или C-p. Потом, нажмите C-l и посмотрите как диаграмма + клавиш C-n или C-p. Потом нажмите C-l и посмотрите как диаграмма переместится в центр экрана. Вам будет несложно запомнить эти команды по первым буквам соответствующих слов -- B-назад (backward) и F-вперед (forward). Это основные команды -позиционирования курсора, которыми Вы будете пользоваться ВСЕГДА, так что +позиционирования курсора, которыми вы будете пользоваться ВСЕГДА, так что будет неплохо их выучить. >> Нажмите несколько раз C-n, чтобы опустить курсор вниз на эту строку. ->> Переместитесь по строке, используя C-f и потом поднимитесь вверх с +>> Переместитесь по строке, используя C-f, и потом поднимитесь вверх с помощью C-p. Посмотрите, как изменилось положение курсора при нажатии С-р, если он находился в середине строки. @@ -98,7 +113,7 @@ C-f может перемещать курсор через символ перевода строки так же, как и C-b. ->> Попробуйте несколько раз применить C-b так, чтобы Вы увидели, как +>> Попробуйте несколько раз применить C-b так, чтобы вы увидели, как движется курсор. Далее используйте сочетание клавиш C-f чтобы вернуться на конец строки. Нажмите C-f еще раз, чтобы перейти к началу следующей строки. @@ -111,7 +126,7 @@ >> Попробуйте переместить курсор за нижнюю границу экрана, используя C-n, и посмотрите, что произойдет. -Если посимвольное перемещение слишком медленно, Вы можете двигаться по +Если посимвольное перемещение слишком медленно, вы можете двигаться по словам. M-f (META-f) перемещает вперед на слово, а M-b назад на слово. >> Нажмите несколько раз M-f и M-b. @@ -120,14 +135,14 @@ Если курсор находится между словами, M-f переместит его в конец следующего слова. M-b работает точно так же, но в противоположном направлении. ->> Нажмите M-f и M-b несколько раз, перемежая их с C-f и C-b -- так вы +>> Нажмите M-f и M-b несколько раз, перемежая их с C-f и C-b, -- так вы сможете заметить действия M-f и M-b из разных позиций в словах и между ними. Отметьте параллель между C-f и C-b с одной стороны, и M-f и M-b с другой. Очень часто Meta-символы используются для соответствующих операций над единицами, определенными в языке (слова, предложения, абзацы), тогда как -Control-символы работают с основными единицами, независимо от того, что Вы +Control-символы работают с основными единицами, независимо от того, что вы редактируете (символы, строки, и т.д.). Эта параллель существует между строками и предложениями: C-a и C-e @@ -187,7 +202,7 @@ получив практику использования Emacs, вы поймете, что использовать CTRL-символы удобнее и быстрее, чем кнопки со стрелочками (потому что вы не убираете руки с обычного их положения при печати). В-третьих, как только вы -привыкните использовать CTRL-символы, вы сможете так же легко выучить и +привыкнете использовать CTRL-символы, вы сможете так же легко выучить и использовать другие, расширенные команды перемещения курсора. Большинство команд Emacs допускают задание цифрового аргумента; для @@ -226,18 +241,18 @@ с левой стороны окна Emacs. Вы можете прокручивать текст, используя манипулятор мышь. ->> Попробуйте перемещать мышь при нажатой средней кнопке мыши. Вы увидите +>> Попробуйте перемещать мышь при нажатой средней кнопке мыши. Вы увидите, как текст прокручивается вверх и вниз. * УПРАВЛЕНИЕ КУРСОРОМ НА X-ТЕРМИНАЛЕ ------------------------------------ -Если у вас X-терминал, то для управления курсором, вам вероятно покажется +Если у вас X-терминал, то для управления курсором, вам вероятно, покажется более легким использование клавиш курсора на цифровой клавиатуре (справа). Стрелки влево, вправо, вверх и вниз передвигают курсор в соответствующем направлении -- они работают точно также как C-b, C-f, C-p и -C-n, но легче в наборе и запоминании. Вы так же можете использовать +C-n, но легче в наборе и запоминании. Вы также можете использовать сочетания C-left и C-right для передвижения по словам, и C-up и C-down для передвижения по блокам (т.е. параграфам, если вы редактируете текст). Если у вас есть кнопки помеченные HOME (или BEGIN) и/или END, то они будут @@ -249,7 +264,7 @@ Все эти команды могут использовать цифровой аргумент, так, как об этом рассказано выше. Вы можете использовать ускоренный способ ввода этого аргумента: просто нажмите CONTROL или META и наберите число. Например, для -перемещения на 12 слов вправо, наберите C-1 C-2 C-right. Запомните что так +перемещения на 12 слов вправо, наберите C-1 C-2 C-right. Запомните, что так очень легко набирать, потому что вы не отпускаете кнопку CONTROL между нажатиями. @@ -257,7 +272,7 @@ * ЕСЛИ EMACS ЗАВИС ------------------ -Если Emacs перестал реагировать на ваши команды, то вы можете избежать этого +Если Emacs перестал реагировать на ваши команды, то вы можете избежать этого, просто нажав C-g. Вы можете использовать C-g, чтобы остановить выполнение команд, которые слишком долго выполняются. @@ -278,7 +293,7 @@ Некоторые команды Emacs "запрещены", поскольку начинающие пользователи могут случайно использовать их для совершения опасных действий. -Если вы набрали одну из запрещенных команд, то Emacs покажет сообщение +Если вы набрали одну из запрещенных команд, то Emacs покажет сообщение, говорящее о том, какая команда вызывается, и запросит у вас, хотите ли вы продолжать работу и выполнять данную команду. @@ -324,12 +339,12 @@ Если вы хотите вставить текст, то просто набирайте его. Символы, которые вы можете видеть, такие как A, 7, *, и пр. понимаются Emacs'ом как текст и -вставляются немедленно. Нажмите <Return> (кнопка перевода каретки) чтобы +вставляются немедленно. Нажмите <Return> (клавиша перевода каретки), чтобы вставить символ новой строки. -Вы можете удалить набранный символ нажимая клавишу <Delback>. <Delback> -- +Вы можете удалить набранный символ, нажимая клавишу <Delback>. <Delback> -- это клавиша на клавиатуре, которую вы используете и вне Emacs для удаления -последнего набранного символа. Обычно, это большая клавиша, расположенная +последнего набранного символа. Обычно это большая клавиша, расположенная на несколько строк выше клавиши <Return>; обычно она помечена как "Delete", "Del" или "Backspace". @@ -349,12 +364,12 @@ "продолжается" на следующей строке экрана. Символ "обратный слэш" ("\") (или если вы используете оконную систему, то это будет значок в виде маленькой изогнутой стрелки) с правой границы показывает, что строка будет -продолжается с предыдущей строки. +продолжаться с предыдущей строки. >> Вводите текст, пока он не достигнет правой границы, и продолжайте вставку символов. Вы увидите, как появится символ продолжения строки. ->> Используйте <Delback> для удаления текста, до тех пор, пока строка не +>> Используйте <Delback> для удаления текста до тех пор, пока строка не поместится в экран снова. Символ продолжения строки исчезнет с экрана. Символ новой строки можно удалять точно так же, как и любой другой символ. @@ -380,23 +395,23 @@ удаления: <Delback> удалить символ перед курсором - C-d удалить символ следующий за (над) курсором + C-d удалить символ следующий за (над) курсором - M-<Delback> Убить строку непосредственно перед курсором - M-d Убить слово следующее за курсором + M-<Delback> убить слово, стоящее перед курсором + M-d убить слово, следующее за курсором - C-k Убить все от курсора до конца строки - M-k Убить все до конца предложения + C-k убить все от курсора до конца строки + M-k убить все до конца предложения Заметьте, что <Delback> и C-d, вместе с M-<Delback> и M-d расширяют параллель, начатую C-f и M-f (да, <Delback> -- это не настоящий управляющий символ, но не нужно об этом волноваться). C-k и M-k, как и C-e и M-e, проводят параллель между строками и предложениями. -Вы можете удалить любую часть буфера одним методом. Переместитесь на один +Вы можете убить любую часть буфера одним методом. Переместитесь на один из концов выбранной области и нажмите C-@ или C-<SPC> (одно из этих сочетаний). Здесь <SPC> обозначает клавишу пробела. Переместитесь на другой -конец области и нажмите C-w. Эта операция удалит весь текст между двумя +конец области и нажмите C-w. Эта операция убьет весь текст между двумя указанными позициями. >> Переместите курсор к букве В в начале предыдущего параграфа. @@ -430,9 +445,9 @@ двухразовое выполнение C-k не сделает этого. Возврат убитого ранее текста называется "восстановление (yanking)". (Думайте -об этом, как о восстановлении или помещении назад, некоторого взятого -текста). Вы можете восстановить удаленный текст в месте удаления, или в -любой другой точке редактируемого текста, или даже в другом файле. Вы +об этом, как о восстановлении или помещении назад некоторого взятого +текста). Вы можете восстановить убитый текст в месте удаления или в +любой другой точке редактируемого текста или даже в другом файле. Вы можете восстановить текст несколько раз и получить несколько копий данного текста. @@ -443,7 +458,7 @@ назад. Помните, что если вы использовали несколько команд C-k в одной строке, то -все убитые строки будут сохранены вместе, так, что C-y также восстановит их +все убитые строки будут сохранены вместе так, что C-y также восстановит их вместе. >> Попробуйте выполнить это сейчас -- нажмите C-k несколько раз. @@ -451,22 +466,22 @@ Теперь вернем убитый текст: >> Нажмите C-y. Теперь переместите курсор на несколько строк вниз, и снова - нажмите C-y. Сейчас вы видите как можно скопировать некоторый текст. + нажмите C-y. Сейчас вы видите, как можно скопировать некоторый текст. Что делать, если есть некоторый текст, который вы хотите вернуть назад, а потом убить что-то еще? Одно нажатие C-y вернет только последний удаленный текст. Но предыдущий текст не будет потерян -- вы сможете его вернуть -назад, используя команду M-y. После того, как вы вернули последний -удаленный текст, нажмите M-y, и замените этот восстановленный текст тем, +назад, используя команду M-y. После того как вы вернули последний +удаленный текст, нажмите M-y и замените этот восстановленный текст тем, который был убит ранее. Нажимая M-y снова и снова, вы будете возвращать -ранее убитые части текста. Когда вы достигните искомого текста, то вам не -нужно делать ничего чтобы сохранить его. Просто продолжайте работать, +ранее убитые части текста. Когда вы достигнете искомого текста, то вам не +нужно делать ничего, чтобы сохранить его. Просто продолжайте работать, оставив восстановленный текст там, где он есть. Нажимая M-y достаточное число раз, вы можете вернуться в начальную точку (наиболее раннее удаление). ->> Убейте строку, переместите курсор, и удалите еще одну строку. Затем +>> Убейте строку, переместите курсор и убейте еще одну строку. Затем используйте C-y для восстановления второй убитой строки, а затем нажмите M-y, и она будет заменена первой убитой строкой. Нажмите M-y еще несколько раз, чтобы увидеть полученный результат. Продолжайте выполнять @@ -486,18 +501,18 @@ C-x u несколько раз подряд, то каждый раз будет отменяться еще одна команда. Но есть два исключения -- команды не изменяющие текст, не учитываются (сюда -включается команды перемещения курсора и прокрутки), и команды вставки +включаются команды перемещения курсора и прокрутки), и команды вставки символов обрабатываются группами до 20 символов. (Это уменьшает число -нажатий C-x u которые вам нужно будет набрать для отмены ввода текста). +нажатий C-x u, которые вам нужно будет набрать для отмены ввода текста). ->> Убейте эту строку с помощью C-k, а затем наберите C-x u и строка должна +>> Убейте эту строку с помощью C-k, а затем наберите C-x u, и строка должна вернуться назад. -C-_ -- это еще команда отмены; она работает точно также как и C-x u, но +C-_ -- это еще команда отмены; она работает точно так же, как и C-x u, но легче в использовании, если вам нужно выполнить ее несколько раз подряд. Неудобное положение C-_ на некоторых клавиатурах делает не очевидным способ ее набора. Поэтому мы предлагаем использовать C-x u. На некоторых -терминалах, вы можете набирать C-_, нажимая / и удерживая клавишу CONTROL. +терминалах вы можете набирать C-_, нажимая / и удерживая клавишу CONTROL. Числовой аргумент для C-_ или C-x u используется как счетчик повторений. @@ -510,19 +525,19 @@ ------- Чтобы созданный текст можно было редактировать позже, вы должны поместить -его в файл. Иначе, он исчезнет, когда вы покинете Emacs. Вы помещаете ваш +его в файл. Иначе он исчезнет, когда вы покинете Emacs. Вы помещаете ваш текст в файл, "открывая" файл (Эту операцию также называют "посетить" файл). -Открыть файл означает посмотреть его содержимое, с помощью Emacs. Во многих -случаях, это происходит тогда, когда вы редактируете файл сами. Однако ваши -изменения, сделанные с использованием Emacs не будут зафиксированы, пока вы +Открыть файл означает посмотреть его содержимое с помощью Emacs. Во многих +случаях это происходит тогда, когда вы редактируете файл сами. Однако ваши +изменения, сделанные с использованием Emacs, не будут зафиксированы, пока вы не сохраните файл. Вы можете не оставлять частично измененный файл в системе, если вы не хотите его сохранять. Даже когда вы сохраняете файл, то Emacs оставляет оригинальный файл, но с другим именем, так что вы позже можете отменить ваши изменения, вернувшись к предыдущей версии файла. Если вы посмотрите в нижнюю часть экрана, то вы увидите строку, которая -начинается с тире и ее начало выглядит примерно так "--:-- TUTORIAL.ru". Эта +начинается с тире, и ее начало выглядит примерно так "--:-- TUTORIAL.ru". Эта часть экрана всегда показывает имя открытого вами файла. Итак, сейчас вы открыли файл с именем "TUTORIAL.ru", который является вашей персональной копией учебника Emacs. Для любого файла, который вы откроете, его имя будет @@ -530,7 +545,7 @@ Одной из вещей, которые вам нужно знать о команде открытия файла -- это то, что вы должны ввести имя файла, который нужно открыть. Такие команды мы -называем командами "читающими аргумент с терминала" (в нашем случае, +называем командами, "читающими аргумент с терминала" (в нашем случае аргументом является имя файла). После ввода команды C-x C-f Открыть (найти) файл @@ -569,12 +584,12 @@ >> Наберите C-x C-s, сохраните вашу копию учебника. В нижней строке экрана должна появиться надпись "Wrote ...TUTORIAL.ru". -ЗАМЕЧАНИЕ: На некоторых системах, ввод C-x C-s заблокирует экран, так что вы +ЗАМЕЧАНИЕ: На некоторых системах ввод C-x C-s заблокирует экран, так что вы не увидите последующего вывода Emacs`а. Такое поведение означает, что операционная система имеет "особенность", именуемую "flow control", перехватывающую сочетание C-s и не пропускающую этот символ к Emacs`у. Для -снятия блокировки экрана, нажмите C-q. Обратитесь к разделу "Spontaneous -Entry to Incremental Search" руководства Emacs, чтобы узнать о том, как +снятия блокировки экрана нажмите C-q. Обратитесь к разделу "Spontaneous +Entry to Incremental Search" руководства Emacs чтобы узнать о том, как бороться с этой "особенностью". Вы можете открыть существующий файл для просмотра или редактирования. Вы @@ -588,14 +603,14 @@ * БУФЕРА -------- -Если вы открываете второй файл используя команду C-x C-f, то первый файл +Если вы открываете второй файл, используя команду C-x C-f, то первый файл остается внутри Emacs. Вы можете переключиться назад, открыв его снова с помощью C-x C-f. Таким образом вы можете загрузить несколько файлов в Emacs. >> Создайте файл с именем "foo", набрав C-x C-f foo <Return>. Вставьте какой-нибудь текст, измените его, и сохраните файл "foo", набрав C-x C-s. - Наконец, наберите C-x C-f TUTORIAL.ru <Return>, для того, чтобы вернуться + Наконец, наберите C-x C-f TUTORIAL.ru <Return> для того, чтобы вернуться назад к учебнику. Emacs хранит текст каждого файла внутри в объекте, называемом "буфер" @@ -606,8 +621,8 @@ >> Попробуйте выполнить C-x C-b прямо сейчас. -Мы видим, что каждый буфер имеет имя, и может иметь связанное с ним имя -файла, содержимое которого в хранится в данном буфере. ЛЮБОЙ текст, который +Мы видим, что каждый буфер имеет имя и может иметь связанное с ним имя +файла, содержимое которого хранится в данном буфере. ЛЮБОЙ текст, который вы видите в окне Emacs, всегда является частью какого-либо буфера. >> Наберите C-x 1, чтобы избавиться от списка буферов. @@ -626,14 +641,14 @@ Чаще всего имя буфера совпадает с именем файла (только без имени каталогов). Однако это не всегда является правдой. Список буферов, который вы создаете -с помощью команды C-x C-b всегда показывает вам имена всех буферов. +с помощью команды C-x C-b, всегда показывает вам имена всех буферов. ЛЮБОЙ текст, который вы видите в окне Emacs, всегда является частью какого-либо буфера. Некоторые буфера не соответствуют файлам. Например, буфер с именем "*Buffer List*" не связан ни с каким файлом. Это буфер, -который содержит список буферов, который вы создали используя C-x C-b. +который содержит список буферов, который вы создали, используя C-x C-b. Буфер с именем "*Messages*" также не связан ни с каким файлом; он содержит -сообщения, которые отображаются в самой нижней строке окна Emacs в течении +сообщения, которые отображаются в самой нижней строке окна Emacs в течение текущей сессии работы с редактором. >> Наберите C-x b *Messages* <Return> для просмотра содержимого буфера @@ -651,7 +666,7 @@ C-x s Сохранить некоторые буфера. (Save some buffers) C-x s запрашивает у вас подтверждение о сохранении для каждого буфера, -который содержит не сохраненные изменения. Для каждого такого буфера у вас +который содержит несохраненные изменения. Для каждого такого буфера у вас запросят: сохранять или не сохранять изменения. >> Вставьте строку текста, потом наберите C-x s. @@ -666,7 +681,7 @@ meta- символы. Emacs обходит это, используя X-команду (eXtend). Есть две возможности: - C-x Расширение с помощью ввода префикса. За ним следуем один символ. + C-x Расширение с помощью ввода префикса. За ним следует один символ. M-x Расширение набора команд с помощью их наименования. За ним следует имя команды. @@ -693,10 +708,10 @@ Чтобы покинуть Emacs используйте команду C-x C-c. Обычно это нужно тогда, когда вы хотите закончить сеанс работы с компьютером. Это сочетание также -используется, чтобы выйти из Emacs, вызванного из почтовой программы, или +используется, чтобы выйти из Emacs, вызванного из почтовой программы или другой утилиты, которая может не знать, как справиться с приостановленным Emacs. Обычно, если вы не собираетесь выходить из системы, то лучше -приостановить Emacs, используя C-z вместо того, чтобы покидать его совсем. +приостановить Emacs, используя C-z, вместо того, чтобы покидать его совсем. Существует очень много команд, использующих префикс C-x. Вы уже изучили следующие команды: @@ -714,7 +729,7 @@ используются только в определенных режимах. В качестве примера можно привести команду замены строки, которая заменяет одну строку на другую во всем тексте. Когда вы наберете M-x, Emacs предложит вам ввести имя команды; -в нашем случае, это команда "replace-string". Наберите лишь "repl s<TAB>", +в нашем случае это команда "replace-string". Наберите лишь "repl s<TAB>", и Emacs дополнит имя. (<TAB> -- это клавиша табуляции, обычно находящаяся выше клавиш CapsLock или Shift в левой части клавиатуры). Завершите имя нажатием <Return>. @@ -741,7 +756,7 @@ сохраненный файл будет называться "#hello.c#". Когда вы сохраните файл обычным способом, Emacs удалит автоматически сохраненный файл. -Если система зависла, то вы можете восстановить ваши изменения, который были +Если система зависла, то вы можете восстановить ваши изменения, которые были сохранены автоматически, путем открытия нужного файла (файла, который вы редактировали, не сохраненного), и затем набрав M-x recover-file<return>. Когда у вас запросят подтверждение, наберите yes<return>, чтобы @@ -779,10 +794,10 @@ строки в которой находится курсор. Звездочки в начале строки означают, что вы изменяли текст. При открытии или -сохранении файла, эта часть строки будет содержать не звездочки, а тире. +сохранении файла эта часть строки будет содержать не звездочки, а тире. Часть строки статуса внутри скобок сообщает вам о режиме редактирования, -которым вы сейчас используете. Стандартный режим -- Fundamental, он +который вы сейчас используете. Стандартный режим -- Fundamental, он используется и данном документе. Это пример "основного режима" ("major mode"). @@ -792,8 +807,8 @@ времени действует только один основной режим, и его название вы можете найти в скобках -- там, где сейчас находится слово "Fundamental" (базовый). -Каждый основной режим заставляет некоторые команды вести себя немного по -другому. Например, это команды создания комментариев в программе, и +Каждый основной режим заставляет некоторые команды вести себя немного +по-другому. Например, это команды создания комментариев в программе, и поскольку в каждом языке программирования комментарии записываются по-своему, то и каждый основной режим вставляет их по-разному. Каждый основной режим имеет именованную команду, которая включает его. Например, @@ -801,7 +816,7 @@ режим. Если вы редактируете текст на естественном языке, например, как этот файл, -то вы вероятно должны переключиться в Text-режим. +то вы, вероятно должны переключиться в режим Text. >> Наберите M-x text mode<Return>. @@ -825,13 +840,13 @@ дополнительные (minor) режимы. Дополнительные режимы не являются альтернативами основным, они только немного изменяют их поведение. Каждый дополнительный режим включается/выключается независимо от других -дополнительных режимов, и независимо от вашего основного режима. Вы можете +дополнительных режимов и независимо от вашего основного режима. Вы можете использовать основной режим без дополнительных, или с любой их комбинацией. Один из дополнительных режимов очень полезен, особенно для редактирования текста -- это режим автозаполнения (Auto Fill mode). Когда этот режим -включен, то Emacs разрывает строки между словами автоматически, в тех -случаях когда вы вставляете текст и делаете строки слишком длинными. +включен, то Emacs разрывает строки между словами автоматически в тех +случаях, когда вы вставляете текст и делаете строки слишком длинными. Вы можете включить режим автозаполнения, набрав M-x auto fill mode<Return>. Когда этот режим включен, его можно выключить с помощью той же команды -- @@ -849,12 +864,12 @@ аргумента для этой команды. >> Введите C-x f с аргументом 20 (C-u 2 0 C-x f). Затем введите какой-нибудь - текст, и посмотрите как Emacs заполняет строки по 20 символов в каждой. + текст и посмотрите как Emacs заполняет строки по 20 символов в каждой. Верните значение границы равное 70 назад, используя команду C-x f. Если вы сделали изменения в середине параграфа, то автозаполнение не переформатирует текст автоматически. Чтобы переформатировать параграф, -наберите M-q (META-q) когда курсор находится внутри параграфа. +наберите M-q (META-q), когда курсор находится внутри параграфа. >> Переместите курсор в предыдущий параграф, и нажмите M-q. @@ -868,7 +883,7 @@ Команда поиска Emacs отличается от аналогичных команд большинства других редакторов тем, что она инкрементальная. Это означает, что поиск происходит -по мере, того как вы набираете искомую строку. +по мере того, как вы набираете искомую строку. Команда, начинающая поиск вперед -- C-s, а C-r ищет назад. ПОДОЖДИТЕ! Не нужно пробовать прямо сейчас. @@ -878,7 +893,7 @@ <Return> завершает поиск. >> Теперь нажмите C-s для начала поиска. Медленно, по одной букве, набирайте - слово 'курсор', останавливаясь после каждой введенной буквы и замечая что + слово 'курсор', останавливаясь после каждой введенной буквы и замечая, что происходит с курсором. Сейчас вы нашли первое вхождение слова "курсор". >> Нажмите C-s снова, чтобы найти следующее вхождение слова "курсор". @@ -887,16 +902,16 @@ Вы заметили, что происходило? Emacs в режиме инкрементального поиска пытался переходить к строкам, совпадающим с набираемой вами строкой, подсвечивая их. -Чтобы перейти к следующему вхождения слова 'курсор' просто нажмите C-s -снова. Если больше нет вхождений, то Emacs издаст звуковой сигнал, и +Чтобы перейти к следующему вхождения слова 'курсор', просто нажмите C-s +снова. Если больше нет вхождений, то Emacs издаст звуковой сигнал и сообщит, что ваш поиск не удался ("failing"), C-g также может отменить поиск. -ЗАМЕЧАНИЕ: На некоторых системах, ввод C-x C-s заблокирует экран, так что вы +ЗАМЕЧАНИЕ: На некоторых системах ввод C-x C-s заблокирует экран, так что вы не увидите последующего вывода Emacs`а. Такое поведение означает, что операционная система имеет "особенность", именуемую "flow control", перехватывающую сочетание C-s и не пропускающую этот символ к Emacs`у. Для -снятия блокировки экрана, нажмите C-q. Обратитесь к разделу "Spontaneous +снятия блокировки экрана нажмите C-q. Обратитесь к разделу "Spontaneous Entry to Incremental Search" руководства Emacs, чтобы узнать о том, как бороться с этой "особенностью". @@ -920,10 +935,10 @@ * МНОЖЕСТВО ОКОН (MULTIPLE WINDOWS) ----------------------------------- -Одна из приятных особенностей Emacs является то, что вы можете одновременно +Одной из приятных особенностей Emacs является то, что вы можете одновременно отображать на экране несколько окон. ->> Переместите курсор на эту строку, и наберите C-u 0 C-l (это CONTROL-L, а +>> Переместите курсор на эту строку и наберите C-u 0 C-l (это CONTROL-L, а не CONTROL-1). >> Теперь наберите C-x 2, что разделит экран на два окна. @@ -972,7 +987,7 @@ Есть другой путь использовать два окна, отображающих разные файлы: ->> Наберите C-x 4 C-f, и введите имя одного и ваших файлов. Завершите ввод +>> Наберите C-x 4 C-f, и введите имя одного из ваших файлов. Завершите ввод нажатием <Return>. Заметьте, что выбранный файл появился в нижнем окне. Курсор перешел туда же. @@ -989,13 +1004,13 @@ увидите [(Fundamental)] вместо (Fundamental). Чтобы выйти из рекурсивных уровней редактирования, нажмите <ESC> <ESC> -<ESC>. Это многоцелевая команда "выход". Вы также можете использовать ее, +<ESC>. Это многоцелевая команда "выход". Вы также можете использовать ее как для уничтожения лишних окон, так и для выхода из мини-буфера. >> Нажмите M-x, чтобы попасть в мини-буфер, а затем нажмите <ESC> <ESC> <ESC>, чтобы покинуть его. -Вы не можете использовать C-g, для выхода из рекурсивных уровней +Вы не можете использовать C-g для выхода из рекурсивных уровней редактирования. Это потому, что C-g используется для отмены команды и аргументов БЕЗ рекурсивных уровней редактирования. @@ -1005,13 +1020,13 @@ В этом учебнике мы попытались снабдить вас только той информацией, которая поможет вам начать пользоваться Emacs. Очень много информации доступно в -Emacs, и невозможно всю ее представить здесь. Однако, вы можете выучить +Emacs и невозможно всю ее представить здесь. Однако, вы можете выучить больше возможностей Emacs и узнать другие полезные особенности. Emacs предоставляет команды для чтения документации о командах Emacs. Эти команды "справки" ("help") все начинаются с символа CONTROL-h, который является "символом помощи". -Чтобы использовать возможности справки, нажмите C-h, и затем символ, который +Чтобы использовать возможности справки, нажмите C-h, и затем -- символ, который расскажет, какой именно вид справки вы хотите получить. Если вы ДЕЙСТВИТЕЛЬНО растерялись, наберите C-h ?, и Emacs расскажет вам о том, какую справку он может вам предоставить. Если вы нажали C-h и передумали @@ -1022,9 +1037,9 @@ если C-h не вызывает сообщение помощи внизу экрана, то попробуйте вместо этого нажать клавишу F1 или набрать M-x help RET). -Одна из самых главных функций справки -- C-h c. Нажмите C-h, затем c, и -символ команды или последовательность, и Emacs отобразит краткое набранной -описание команды. +Одна из самых главных функций справки -- C-h c. Нажмите C-h, а затем c, и +символ команды или последовательность, и Emacs отобразит краткое описание +набранной команды. >> Нажмите C-h c C-p. @@ -1039,7 +1054,7 @@ информации легче запомнить уже выученные команды. Многосимвольные сочетания клавиш, такие как C-x C-s и (если у вас нет кнопки -META или EDIT или ALT) <ESC>v также будут доступны для получения справки с +META или EDIT или ALT) <ESC> v также будут доступны для получения справки с помощью C-h c. Вы можете получить больше информации о команде используя C-h k вместо C-h c. @@ -1070,9 +1085,9 @@ >> Наберите C-h a file<Return>. -Это отобразит в другом окне список всех команд M-x у которых в именах -содержится слово "file". Также в списке кроме команд таких, как find-file, -вы увидите соответствующие символьные команды такие, как C-x C-f. +Это отобразит в другом окне список всех команд M-x, у которых в именах +содержится слово "file". Также в списке кроме таких команд, как find-file, +вы увидите соответствующие символьные команды, такие как C-x C-f. >> Наберите C-M-v для прокрутки окна справки. Выполните это несколько раз. @@ -1091,7 +1106,7 @@ * ДОПОЛНИТЕЛЬНЫЕ ВОЗМОЖНОСТИ ---------------------------- -Вы можете узнать больше о Emacs читая его руководство, книги или +Вы можете узнать больше о Emacs, читая его руководство, книги или интерактивный справочник (используйте меню Help или наберите F10 h r). Вам особенно понравятся две функции -- дополнение, которое сокращает количество нажимаемых клавиш, и dired, который облегчает работу с файлами. @@ -1113,7 +1128,7 @@ * ЗАКЛЮЧЕНИЕ ------------ -Запомните, что для того чтобы совсем выйти из Emacs, используется сочетание +Запомните, что для того, чтобы совсем выйти из Emacs, используется сочетание клавиш C-x C-c. А чтобы временно выйти в оболочку (shell) и потом вернуться обратно, используйте C-z. @@ -1128,11 +1143,11 @@ написанного Stuart Cracraft для оригинального Emacs. Эта версия учебника, как и GNU Emacs, защищена правами копирования -(copyrighted), и приходит с ограничениями распространения копий со +(copyrighted) и приходит с ограничениями распространения копий со следующими соглашениями: Copyright (C) 1985, 1996, 1998, 2001, 2002, 2003, 2004, - 2005, 2006, 2007, 2008 Free Software Foundation, Inc. + 2005, 2006, 2007 Free Software Foundation, Inc. Permission is granted to anyone to make or distribute verbatim copies of this document as received, in any medium, provided that the @@ -1151,7 +1166,7 @@ обеспечения ("владение"), используя, создавая и распространяя свободное программное обеспечение! -// замечания, исправления ошибок с жду по адресу alexott@gmail.com. +// замечания, исправления ошибок я жду по адресу alexott@gmail.com. // Alex Ott. ;;; Local Variables:
--- a/lisp/ChangeLog Thu Jan 31 13:49:17 2008 +0000 +++ b/lisp/ChangeLog Fri Feb 01 03:01:11 2008 +0000 @@ -1,17 +1,48 @@ +2008-02-01 Jason Rumney <jasonr@gnu.org> + + * w32-fns.el: Partially revert 2007-11-10 change. + +2008-02-01 Martin Rudalics <rudalics@gmx.at> + + * mail/rmail.el (rmail-highlight): Fix specification. + Reported by: pod <pod@herald.ox.ac.uk>. + +2008-02-01 Stefan Monnier <monnier@iro.umontreal.ca> + + * image-mode.el (image-mode-current-vscroll) + (image-mode-current-hscroll): Make buffer-local. + (image-set-window-vscroll, image-set-window-hscroll): Simplify. + (image-reset-current-vhscroll): Use the latest setting when displaying + for the first time in a window. Apply to all windows in the frame. + (image-mode): Don't make image-mode-current-[vh]scroll buffer-local. + + * progmodes/grep.el (grep-compute-defaults): + Don't mix up defaults for different connections to the same host. + +2008-01-31 Vinicius Jose Latorre <viniciusjl@ig.com.br> + + * blank-mode.el: Renamed to whitespace.el. + + * obsolete/whitespace.el: Renamed to obsolete/old-whitespace.el. + +2008-01-31 Stefan Monnier <monnier@iro.umontreal.ca> + + * net/rcompile.el (remote-compile): Remove broken code. + 2008-01-31 Jason Rumney <jasonr@gnu.org> * term/w32-win.el (image-library-alist): Prefer libxpm.dll. +2008-01-31 Juanma Barranquero <lekktu@gmail.com> + + * linum.el (linum-unload-function): New function. + 2008-01-30 Nick Roberts <nickrob@snap.net.nz> * progmodes/gdb-ui.el (gdb-var-set-format-regexp): New constant. (gdb-var-set-format-handler): New function. (gdb-var-set-format): Use it. -2008-01-31 Juanma Barranquero <lekktu@gmail.com> - - * linum.el (linum-unload-function): New function. - 2008-01-30 Juanma Barranquero <lekktu@gmail.com> * emacs-lisp/check-declare.el (check-declare-directory): @@ -54,22 +85,23 @@ * progmodes/cc-langs.el (c-specifier-key): Exclude "template" from this regexp; part of same fix as next change to cc-engine.el. - * progmodes/cc-engine.el (c-guess-basic-syntax, CASE 5A.5): Anchor - the "{" of a template function correctly on "template", not the + * progmodes/cc-engine.el (c-guess-basic-syntax, CASE 5A.5): + Anchor the "{" of a template function correctly on "template", not the following "<". * progmodes/cc-defs.el (c-version): Increase to 5.31.5. 2008-01-29 Tassilo Horn <tassilo@member.fsf.org> - * doc-view.el (doc-view-mode): Adapt to i-m-current-[vh]scroll - being an alist now. + * doc-view.el (doc-view-mode): Adapt to image-mode-current-vscroll + and image-mode-current-hscroll being alists now. * image-mode.el (image-mode-current-vscroll) (image-mode-current-hscroll): Add doc strings. (image-set-window-vscroll, image-set-window-hscroll) (image-reset-current-vhscroll, image-mode): Adapt to - i-m-current-[vh]scroll being an alist now. + image-mode-current-vscroll and image-mode-current-hscroll being + alists now. 2008-01-29 Martin Rudalics <rudalics@gmx.at>
--- a/lisp/blank-mode.el Thu Jan 31 13:49:17 2008 +0000 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,1726 +0,0 @@ -;;; blank-mode.el --- minor mode to visualize TAB, (HARD) SPACE, NEWLINE - -;; Copyright (C) 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008 -;; Free Software Foundation, Inc. - -;; Author: Vinicius Jose Latorre <viniciusjl@ig.com.br> -;; Maintainer: Vinicius Jose Latorre <viniciusjl@ig.com.br> -;; Keywords: data, wp -;; Version: 9.2 -;; X-URL: http://www.emacswiki.org/cgi-bin/wiki/ViniciusJoseLatorre - -;; 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 3, 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. - -;;; Commentary: - -;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; -;; Introduction -;; ------------ -;; -;; This package is a minor mode to visualize blanks (TAB, (HARD) SPACE -;; and NEWLINE). -;; -;; blank-mode uses two ways to visualize blanks: faces and display -;; table. -;; -;; * Faces are used to highlight the background with a color. -;; blank-mode uses font-lock to highlight blank characters. -;; -;; * Display table changes the way a character is displayed, that is, -;; it provides a visual mark for characters, for example, at the end -;; of line (?\xB6), at SPACEs (?\xB7) and at TABs (?\xBB). -;; -;; The `blank-style' and `blank-chars' variables are used to select -;; which way should be used to visualize blanks. -;; -;; Note that when blank-mode is turned on, blank-mode saves the -;; font-lock state, that is, if font-lock is on or off. And -;; blank-mode restores the font-lock state when it is turned off. So, -;; if blank-mode is turned on and font-lock is off, blank-mode also -;; turns on the font-lock to highlight blanks, but the font-lock will -;; be turned off when blank-mode is turned off. Thus, turn on -;; font-lock before blank-mode is on, if you want that font-lock -;; continues on after blank-mode is turned off. -;; -;; When blank-mode is on, it takes care of highlighting some special -;; characters over the default mechanism of `nobreak-char-display' -;; (which see) and `show-trailing-whitespace' (which see). -;; -;; There are two ways of using blank-mode: local and global. -;; -;; * Local blank-mode affects only the current buffer. -;; -;; * Global blank-mode affects all current and future buffers. That -;; is, if you turn on global blank-mode and then create a new -;; buffer, the new buffer will also have blank-mode on. The -;; `blank-global-modes' variable controls which major-mode will be -;; automagically turned on. -;; -;; You can mix the local and global usage without any conflict. But -;; local blank-mode has priority over global blank-mode. Blank mode -;; is active in a buffer if you have enabled it in that buffer or if -;; you have enabled it globally. -;; -;; When global and local blank-mode are on: -;; -;; * if local blank-mode is turned off, blank-mode is turned off for -;; the current buffer only. -;; -;; * if global blank-mode is turned off, blank-mode continues on only -;; in the buffers in which local blank-mode is on. -;; -;; To use blank-mode, insert in your ~/.emacs: -;; -;; (require 'blank-mode) -;; -;; Or autoload at least one of the commands`blank-mode', -;; `blank-toggle-options', `global-blank-mode' or -;; `global-blank-toggle-options'. For example: -;; -;; (autoload 'blank-mode "blank-mode" -;; "Toggle blank visualization." t) -;; (autoload 'blank-toggle-options "blank-mode" -;; "Toggle local `blank-mode' options." t) -;; -;; blank-mode was inspired by: -;; -;; whitespace.el Rajesh Vaidheeswarran <rv@gnu.org> -;; Warn about and clean bogus whitespaces in the file -;; (inspired the idea to warn and clean some blanks) -;; -;; show-whitespace-mode.el Aurelien Tisne <aurelien.tisne@free.fr> -;; Simple mode to highlight whitespaces -;; (inspired the idea to use font-lock) -;; -;; whitespace-mode.el Lawrence Mitchell <wence@gmx.li> -;; Major mode for editing Whitespace -;; (inspired the idea to use display table) -;; -;; visws.el Miles Bader <miles@gnu.org> -;; Make whitespace visible -;; (handle display table, his code was modified, but the main -;; idea was kept) -;; -;; -;; Using blank-mode -;; ---------------- -;; -;; There is no problem if you mix local and global minor mode usage. -;; -;; * LOCAL blank-mode: -;; + To toggle blank-mode options locally, type: -;; -;; M-x blank-toggle-options RET -;; -;; + To activate blank-mode locally, type: -;; -;; C-u 1 M-x blank-mode RET -;; -;; + To deactivate blank-mode locally, type: -;; -;; C-u 0 M-x blank-mode RET -;; -;; + To toggle blank-mode locally, type: -;; -;; M-x blank-mode RET -;; -;; * GLOBAL blank-mode: -;; + To toggle blank-mode options globally, type: -;; -;; M-x global-blank-toggle-options RET -;; -;; + To activate blank-mode globally, type: -;; -;; C-u 1 M-x global-blank-mode RET -;; -;; + To deactivate blank-mode globally, type: -;; -;; C-u 0 M-x global-blank-mode RET -;; -;; + To toggle blank-mode globally, type: -;; -;; M-x global-blank-mode RET -;; -;; There are also the following useful commands: -;; -;; `blank-cleanup' -;; Cleanup some blank problems in all buffer or at region. -;; -;; `blank-cleanup-region' -;; Cleanup some blank problems at region. -;; -;; The problems, which are cleaned up, are: -;; -;; 1. empty lines at beginning of buffer. -;; 2. empty lines at end of buffer. -;; If `blank-chars' has `empty' as an element, remove all empty -;; lines at beginning and/or end of buffer. -;; -;; 3. 8 or more SPACEs at beginning of line. -;; If `blank-chars' has `indentation' as an element, replace 8 or -;; more SPACEs at beginning of line by TABs. -;; -;; 4. SPACEs before TAB. -;; If `blank-chars' has `space-before-tab' as an element, replace -;; SPACEs by TABs. -;; -;; 5. SPACEs or TABs at end of line. -;; If `blank-chars' has `trailing' as an element, remove all -;; SPACEs or TABs at end of line." -;; -;; 6. 8 or more SPACEs after TAB. -;; If `blank-chars' has `space-after-tab' as an element, replace -;; SPACEs by TABs. -;; -;; -;; Hooks -;; ----- -;; -;; blank-mode has the following hook variables: -;; -;; `blank-mode-hook' -;; It is evaluated always when blank-mode is turned on locally. -;; -;; `global-blank-mode-hook' -;; It is evaluated always when blank-mode is turned on globally. -;; -;; `blank-load-hook' -;; It is evaluated after blank-mode package is loaded. -;; -;; -;; Options -;; ------- -;; -;; Below it's shown a brief description of blank-mode options, please, -;; see the options declaration in the code for a long documentation. -;; -;; `blank-style' Specify the visualization style. -;; -;; `blank-chars' Specify which kind of blank is -;; visualized. -;; -;; `blank-space' Face used to visualize SPACE. -;; -;; `blank-hspace' Face used to visualize HARD SPACE. -;; -;; `blank-tab' Face used to visualize TAB. -;; -;; `blank-newline' Face used to visualize NEWLINE char -;; mapping. -;; -;; `blank-trailing' Face used to visualize trailing -;; blanks. -;; -;; `blank-line' Face used to visualize "long" lines. -;; -;; `blank-space-before-tab' Face used to visualize SPACEs before -;; TAB. -;; -;; `blank-indentation' Face used to visualize 8 or more -;; SPACEs at beginning of line. -;; -;; `blank-empty' Face used to visualize empty lines at -;; beginning and/or end of buffer. -;; -;; `blank-space-after-tab' Face used to visualize 8 or more -;; SPACEs after TAB. -;; -;; `blank-space-regexp' Specify SPACE characters regexp. -;; -;; `blank-hspace-regexp' Specify HARD SPACE characters regexp. -;; -;; `blank-tab-regexp' Specify TAB characters regexp. -;; -;; `blank-trailing-regexp' Specify trailing characters regexp. -;; -;; `blank-space-before-tab-regexp' Specify SPACEs before TAB -;; regexp. -;; -;; `blank-indentation-regexp' Specify regexp for 8 or more SPACEs at -;; beginning of line. -;; -;; `blank-empty-at-bob-regexp' Specify regexp for empty lines at -;; beginning of buffer. -;; -;; `blank-empty-at-eob-regexp' Specify regexp for empty lines at end -;; of buffer. -;; -;; `blank-space-after-tab-regexp' Specify regexp for 8 or more -;; SPACEs after TAB. -;; -;; `blank-line-column' Specify column beyond which the line -;; is highlighted. -;; -;; `blank-display-mappings' Specify an alist of mappings for -;; displaying characters. -;; -;; `blank-global-modes' Modes for which global `blank-mode' is -;; automagically turned on. -;; -;; -;; Acknowledgements -;; ---------------- -;; -;; Thanks to nschum (EmacsWiki) for the idea about highlight "long" -;; lines tail. See EightyColumnRule (EmacsWiki). -;; -;; Thanks to Juri Linkov <juri@jurta.org> for suggesting: -;; * `define-minor-mode'. -;; * `global-blank-*' name for global commands. -;; -;; Thanks to Robert J. Chassell <bob@gnu.org> for doc fix and testing. -;; -;; Thanks to Drew Adams <drew.adams@oracle.com> for toggle commands -;; suggestion. -;; -;; Thanks to Antti Kaihola <antti.kaihola@linux-aktivaattori.org> for -;; helping to fix `find-file-hooks' reference. -;; -;; Thanks to Andreas Roehler <andreas.roehler@easy-emacs.de> for -;; indicating defface byte-compilation warnings. -;; -;; Thanks to TimOCallaghan (EmacsWiki) for the idea about highlight -;; "long" lines. See EightyColumnRule (EmacsWiki). -;; -;; Thanks to Yanghui Bian <yanghuibian@gmail.com> for indicating a new -;; newline character mapping. -;; -;; Thanks to Pete Forman <pete.forman@westgeo.com> for indicating -;; whitespace-mode on XEmacs. -;; -;; Thanks to Miles Bader <miles@gnu.org> for handling display table via -;; visws.el (his code was modified, but the main idea was kept). -;; -;; Thanks to: -;; Rajesh Vaidheeswarran <rv@gnu.org> whitespace.el -;; Aurelien Tisne <aurelien.tisne@free.fr> show-whitespace-mode.el -;; Lawrence Mitchell <wence@gmx.li> whitespace-mode.el -;; Miles Bader <miles@gnu.org> visws.el -;; And to all people who contributed with them. -;; -;; -;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -;;; code: - - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;;; User Variables: - - -;;; Interface to the command system - - -(defgroup blank nil - "Visualize blanks (TAB, (HARD) SPACE and NEWLINE)." - :link '(emacs-library-link :tag "Source Lisp File" "blank-mode.el") - :version "22.2" - :group 'wp - :group 'data) - - -(defcustom blank-style '(mark color) - "*Specify the visualization style. - -It's a list which element value can be: - - mark display mappings are visualized. - - color faces are visualized. - -Any other value is ignored. - -If nil, don't visualize TABs, (HARD) SPACEs and NEWLINEs. - -See also `blank-display-mappings' for documentation." - :type '(repeat :tag "Style of Blank" - (choice :tag "Style of Blank" - (const :tag "Display Table" mark) - (const :tag "Faces" color))) - :group 'blank) - - -(defcustom blank-chars - '(tabs spaces trailing lines space-before-tab newline - indentation empty space-after-tab) - "*Specify which kind of blank is visualized. - -It's a list which element value can be: - - trailing trailing blanks are visualized. - - tabs TABs are visualized. - - spaces SPACEs and HARD SPACEs are visualized. - - lines lines whose have columns beyond - `blank-line-column' are highlighted. - Whole line is highlighted. - It has precedence over - `lines-tail' (see below). - - lines-tail lines whose have columns beyond - `blank-line-column' are highlighted. - But only the part of line which goes - beyond `blank-line-column' column. - It has effect only if `lines' (see above) - is not present in `blank-chars'. - - space-before-tab SPACEs before TAB are visualized. - - newline NEWLINEs are visualized. - - indentation 8 or more SPACEs at beginning of line are - visualized. - - empty empty lines at beginning and/or end of buffer - are visualized. - - space-after-tab 8 or more SPACEs after a TAB are visualized. - -Any other value is ignored. - -If nil, don't visualize TABs, (HARD) SPACEs and NEWLINEs. - -Used when `blank-style' has `color' as an element. -If `blank-chars' has `newline' as an element, used when `blank-style' -has `mark' as an element." - :type '(repeat :tag "Kind of Blank" - (choice :tag "Kind of Blank" - (const :tag "Trailing TABs, SPACEs and HARD SPACEs" - trailing) - (const :tag "SPACEs and HARD SPACEs" spaces) - (const :tag "TABs" tabs) - (const :tag "Lines" lines) - (const :tag "SPACEs before TAB" - space-before-tab) - (const :tag "NEWLINEs" newline) - (const :tag "Indentation SPACEs" indentation) - (const :tag "Empty Lines At BOB And/Or EOB" - empty) - (const :tag "SPACEs after TAB" - space-after-tab))) - :group 'blank) - - -(defcustom blank-space 'blank-space - "*Symbol face used to visualize SPACE. - -Used when `blank-style' has `color' as an element." - :type 'face - :group 'blank) - - -(defface blank-space - '((((class color) (background dark)) - (:background "grey20" :foreground "aquamarine3")) - (((class color) (background light)) - (:background "LightYellow" :foreground "aquamarine3")) - (t (:inverse-video t))) - "Face used to visualize SPACE." - :group 'blank) - - -(defcustom blank-hspace 'blank-hspace - "*Symbol face used to visualize HARD SPACE. - -Used when `blank-style' has `color' as an element." - :type 'face - :group 'blank) - - -(defface blank-hspace ; 'nobreak-space - '((((class color) (background dark)) - (:background "grey24" :foreground "aquamarine3")) - (((class color) (background light)) - (:background "LemonChiffon3" :foreground "aquamarine3")) - (t (:inverse-video t))) - "Face used to visualize HARD SPACE." - :group 'blank) - - -(defcustom blank-tab 'blank-tab - "*Symbol face used to visualize TAB. - -Used when `blank-style' has `color' as an element." - :type 'face - :group 'blank) - - -(defface blank-tab - '((((class color) (background dark)) - (:background "grey22" :foreground "aquamarine3")) - (((class color) (background light)) - (:background "beige" :foreground "aquamarine3")) - (t (:inverse-video t))) - "Face used to visualize TAB." - :group 'blank) - - -(defcustom blank-newline 'blank-newline - "*Symbol face used to visualize NEWLINE char mapping. - -See `blank-display-mappings'. - -Used when `blank-style' has `mark' and `color' as elements -and `blank-chars' has `newline' as an element." - :type 'face - :group 'blank) - - -(defface blank-newline - '((((class color) (background dark)) - (:background "grey26" :foreground "aquamarine3" :bold t)) - (((class color) (background light)) - (:background "linen" :foreground "aquamarine3" :bold t)) - (t (:bold t :underline t))) - "Face used to visualize NEWLINE char mapping. - -See `blank-display-mappings'." - :group 'blank) - - -(defcustom blank-trailing 'blank-trailing - "*Symbol face used to visualize traling blanks. - -Used when `blank-style' has `color' as an element." - :type 'face - :group 'blank) - - -(defface blank-trailing ; 'trailing-whitespace - '((((class mono)) (:inverse-video t :bold t :underline t)) - (t (:background "red1" :foreground "yellow" :bold t))) - "Face used to visualize trailing blanks." - :group 'blank) - - -(defcustom blank-line 'blank-line - "*Symbol face used to visualize \"long\" lines. - -See `blank-line-column'. - -Used when `blank-style' has `color' as an element." - :type 'face - :group 'blank) - - -(defface blank-line - '((((class mono)) (:inverse-video t :bold t :underline t)) - (t (:background "gray20" :foreground "violet"))) - "Face used to visualize \"long\" lines. - -See `blank-line-column'." - :group 'blank) - - -(defcustom blank-space-before-tab 'blank-space-before-tab - "*Symbol face used to visualize SPACEs before TAB. - -Used when `blank-style' has `color' as an element." - :type 'face - :group 'blank) - - -(defface blank-space-before-tab - '((((class mono)) (:inverse-video t :bold t :underline t)) - (t (:background "DarkOrange" :foreground "firebrick"))) - "Face used to visualize SPACEs before TAB." - :group 'blank) - - -(defcustom blank-indentation 'blank-indentation - "*Symbol face used to visualize 8 or more SPACEs at beginning of line. - -Used when `blank-style' has `color' as an element." - :type 'face - :group 'blank) - - -(defface blank-indentation - '((((class mono)) (:inverse-video t :bold t :underline t)) - (t (:background "yellow" :foreground "firebrick"))) - "Face used to visualize 8 or more SPACEs at beginning of line." - :group 'blank) - - -(defcustom blank-empty 'blank-empty - "*Symbol face used to visualize empty lines at beginning and/or end of buffer. - -Used when `blank-style' has `color' as an element." - :type 'face - :group 'blank) - - -(defface blank-empty - '((((class mono)) (:inverse-video t :bold t :underline t)) - (t (:background "yellow" :foreground "firebrick"))) - "Face used to visualize empty lines at beginning and/or end of buffer." - :group 'blank) - - -(defcustom blank-space-after-tab 'blank-space-after-tab - "*Symbol face used to visualize 8 or more SPACEs after TAB. - -Used when `blank-style' has `color' as an element." - :type 'face - :group 'blank) - - -(defface blank-space-after-tab - '((((class mono)) (:inverse-video t :bold t :underline t)) - (t (:background "yellow" :foreground "firebrick"))) - "Face used to visualize 8 or more SPACEs after TAB." - :group 'blank) - - -(defcustom blank-hspace-regexp - "\\(\\(\xA0\\|\x8A0\\|\x920\\|\xE20\\|\xF20\\)+\\)" - "*Specify HARD SPACE characters regexp. - -If you're using `mule' package, it may exist other characters besides: - - \"\\xA0\" \"\\x8A0\" \"\\x920\" \"\\xE20\" \"\\xF20\" - -that should be considered HARD SPACE. - -Here are some examples: - - \"\\\\(^\\xA0+\\\\)\" \ -visualize only leading HARD SPACEs. - \"\\\\(\\xA0+$\\\\)\" \ -visualize only trailing HARD SPACEs. - \"\\\\(^\\xA0+\\\\|\\xA0+$\\\\)\" \ -visualize leading and/or trailing HARD SPACEs. - \"\\t\\\\(\\xA0+\\\\)\\t\" \ -visualize only HARD SPACEs between TABs. - -NOTE: Enclose always by \\\\( and \\\\) the elements to highlight. - Use exactly one pair of enclosing \\\\( and \\\\). - -Used when `blank-style' has `color' as an element, and -`blank-chars' has `spaces' as an element." - :type '(regexp :tag "HARD SPACE Chars") - :group 'blank) - - -(defcustom blank-space-regexp "\\( +\\)" - "*Specify SPACE characters regexp. - -If you're using `mule' package, it may exist other characters -besides \" \" that should be considered SPACE. - -Here are some examples: - - \"\\\\(^ +\\\\)\" visualize only leading SPACEs. - \"\\\\( +$\\\\)\" visualize only trailing SPACEs. - \"\\\\(^ +\\\\| +$\\\\)\" \ -visualize leading and/or trailing SPACEs. - \"\\t\\\\( +\\\\)\\t\" visualize only SPACEs between TABs. - -NOTE: Enclose always by \\\\( and \\\\) the elements to highlight. - Use exactly one pair of enclosing \\\\( and \\\\). - -Used when `blank-style' has `color' as an element, and -`blank-chars' has `spaces' as an element." - :type '(regexp :tag "SPACE Chars") - :group 'blank) - - -(defcustom blank-tab-regexp "\\(\t+\\)" - "*Specify TAB characters regexp. - -If you're using `mule' package, it may exist other characters -besides \"\\t\" that should be considered TAB. - -Here are some examples: - - \"\\\\(^\\t+\\\\)\" visualize only leading TABs. - \"\\\\(\\t+$\\\\)\" visualize only trailing TABs. - \"\\\\(^\\t+\\\\|\\t+$\\\\)\" \ -visualize leading and/or trailing TABs. - \" \\\\(\\t+\\\\) \" visualize only TABs between SPACEs. - -NOTE: Enclose always by \\\\( and \\\\) the elements to highlight. - Use exactly one pair of enclosing \\\\( and \\\\). - -Used when `blank-style' has `color' as an element, and -`blank-chars' has `tabs' as an element." - :type '(regexp :tag "TAB Chars") - :group 'blank) - - -(defcustom blank-trailing-regexp - "\t\\| \\|\xA0\\|\x8A0\\|\x920\\|\xE20\\|\xF20" - "*Specify trailing characters regexp. - -If you're using `mule' package, it may exist other characters besides: - - \" \" \"\\t\" \"\\xA0\" \"\\x8A0\" \"\\x920\" \"\\xE20\" \ -\"\\xF20\" - -that should be considered blank. - -NOTE: DO NOT enclose by \\\\( and \\\\) the elements to highlight. - `blank-mode' surrounds this regexp by \"\\\\(\\\\(\" and - \"\\\\)+\\\\)$\". - -Used when `blank-style' has `color' as an element, and -`blank-chars' has `trailing' as an element." - :type '(regexp :tag "Trailing Chars") - :group 'blank) - - -(defcustom blank-space-before-tab-regexp "\\( +\\)\t" - "*Specify SPACEs before TAB regexp. - -If you're using `mule' package, it may exist other characters besides: - - \" \" \"\\t\" \"\\xA0\" \"\\x8A0\" \"\\x920\" \"\\xE20\" \ -\"\\xF20\" - -that should be considered blank. - -Used when `blank-style' has `color' as an element, and -`blank-chars' has `space-before-tab' as an element." - :type '(regexp :tag "SPACEs Before TAB") - :group 'blank) - - -(defcustom blank-indentation-regexp "^\t*\\(\\( \\{8\\}\\)+\\)[^\n\t]" - "*Specify regexp for 8 or more SPACEs at beginning of line. - -If you're using `mule' package, it may exist other characters besides: - - \" \" \"\\t\" \"\\xA0\" \"\\x8A0\" \"\\x920\" \"\\xE20\" \ -\"\\xF20\" - -that should be considered blank. - -Used when `blank-style' has `color' as an element, and -`blank-chars' has `indentation' as an element." - :type '(regexp :tag "Indentation SPACEs") - :group 'blank) - - -(defcustom blank-empty-at-bob-regexp "\\`\\(\\([ \t]*\n\\)+\\)" - "*Specify regexp for empty lines at beginning of buffer. - -If you're using `mule' package, it may exist other characters besides: - - \" \" \"\\t\" \"\\xA0\" \"\\x8A0\" \"\\x920\" \"\\xE20\" \ -\"\\xF20\" - -that should be considered blank. - -Used when `blank-style' has `color' as an element, and -`blank-chars' has `empty' as an element." - :type '(regexp :tag "Empty Lines At Beginning Of Buffer") - :group 'blank) - - -(defcustom blank-empty-at-eob-regexp "^\\([ \t\n]+\\)\\'" - "*Specify regexp for empty lines at end of buffer. - -If you're using `mule' package, it may exist other characters besides: - - \" \" \"\\t\" \"\\xA0\" \"\\x8A0\" \"\\x920\" \"\\xE20\" \ -\"\\xF20\" - -that should be considered blank. - -Used when `blank-style' has `color' as an element, and -`blank-chars' has `empty' as an element." - :type '(regexp :tag "Empty Lines At End Of Buffer") - :group 'blank) - - -(defcustom blank-space-after-tab-regexp "\t\\(\\( \\{8\\}\\)+\\)" - "*Specify regexp for 8 or more SPACEs after TAB. - -If you're using `mule' package, it may exist other characters besides: - - \" \" \"\\t\" \"\\xA0\" \"\\x8A0\" \"\\x920\" \"\\xE20\" \ -\"\\xF20\" - -that should be considered blank. - -Used when `blank-style' has `color' as an element, and -`blank-chars' has `space-after-tab' as an element." - :type '(regexp :tag "SPACEs After TAB") - :group 'blank) - - -(defcustom blank-line-column 80 - "*Specify column beyond which the line is highlighted. - -Used when `blank-style' has `color' as an element, and -`blank-chars' has `lines' or `lines-tail' as an element." - :type '(integer :tag "Line Length") - :group 'blank) - - -;; Hacked from `visible-whitespace-mappings' in visws.el -(defcustom blank-display-mappings - ;; Due to limitations of glyph representation, the char code can not - ;; be above ?\x1FFFF. Probably, this will be fixed after Emacs - ;; unicode merging. - '( - (?\ [?\xB7] [?.]) ; space - centered dot - (?\xA0 [?\xA4] [?_]) ; hard space - currency - (?\x8A0 [?\x8A4] [?_]) ; hard space - currency - (?\x920 [?\x924] [?_]) ; hard space - currency - (?\xE20 [?\xE24] [?_]) ; hard space - currency - (?\xF20 [?\xF24] [?_]) ; hard space - currency - ;; NEWLINE is displayed using the face `blank-newline' - (?\n [?$ ?\n]) ; end-of-line - dollar sign - ;; (?\n [?\u21B5 ?\n] [?$ ?\n]) ; end-of-line - downwards arrow - ;; (?\n [?\xB6 ?\n] [?$ ?\n]) ; end-of-line - pilcrow - ;; (?\n [?\x8AF ?\n] [?$ ?\n]) ; end-of-line - overscore - ;; (?\n [?\x8AC ?\n] [?$ ?\n]) ; end-of-line - negation - ;; (?\n [?\x8B0 ?\n] [?$ ?\n]) ; end-of-line - grade - ;; - ;; WARNING: the mapping below has a problem. - ;; When a TAB occupies exactly one column, it will display the - ;; character ?\xBB at that column followed by a TAB which goes to - ;; the next TAB column. - ;; If this is a problem for you, please, comment the line below. - (?\t [?\xBB ?\t] [?\\ ?\t]) ; tab - left quote mark - ) - "*Specify an alist of mappings for displaying characters. - -Each element has the following form: - - (CHAR VECTOR...) - -Where: - -CHAR is the character to be mapped. - -VECTOR is a vector of characters to be displayed in place of CHAR. - The first display vector that can be displayed is used; - if no display vector for a mapping can be displayed, then - that character is displayed unmodified. - -The NEWLINE character is displayed using the face given by -`blank-newline' variable. The characters in the vector to be -displayed will not have this face applied if the character code -is above #x1FFFF. - -Used when `blank-style' has `mark' as an element." - :type '(repeat - (list :tag "Character Mapping" - (character :tag "Char") - (repeat :inline t :tag "Vector List" - (vector :tag "" - (repeat :inline t - :tag "Vector Characters" - (character :tag "Char")))))) - :group 'blank) - - -(defcustom blank-global-modes t - "*Modes for which global `blank-mode' is automagically turned on. - -Global `blank-mode' is controlled by the command `global-blank-mode'. - -If nil, means no modes have `blank-mode' automatically turned on. -If t, all modes that support `blank-mode' have it automatically -turned on. -Else it should be a list of `major-mode' symbol names for -which `blank-mode' should be automatically turned on. The sense -of the list is negated if it begins with `not'. For example: - - (c-mode c++-mode) - -means that `blank-mode' is turned on for buffers in C and C++ -modes only." - :type '(choice (const :tag "None" nil) - (const :tag "All" t) - (set :menu-tag "Mode Specific" :tag "Modes" - :value (not) - (const :tag "Except" not) - (repeat :inline t - (symbol :tag "Mode")))) - :group 'blank) - - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;;; User commands - Local mode - - -;;;###autoload -(define-minor-mode blank-mode - "Toggle blank minor mode visualization (\"bl\" on modeline). - -If ARG is null, toggle blank visualization. -If ARG is a number greater than zero, turn on visualization; -otherwise, turn off visualization. -Only useful with a windowing system." - :lighter " bl" - :init-value nil - :global nil - :group 'blank - (cond - (noninteractive ; running a batch job - (setq blank-mode nil)) - (blank-mode ; blank-mode on - (blank-turn-on)) - (t ; blank-mode off - (blank-turn-off)))) - - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;;; User commands - Global mode - - -(define-minor-mode global-blank-mode - "Toggle blank global minor mode visualization (\"BL\" on modeline). - -If ARG is null, toggle blank visualization. -If ARG is a number greater than zero, turn on visualization; -otherwise, turn off visualization. -Only useful with a windowing system." - :lighter " BL" - :init-value nil - :global t - :group 'blank - (cond - (noninteractive ; running a batch job - (setq global-blank-mode nil)) - (global-blank-mode ; global-blank-mode on - (save-excursion - (if (boundp 'find-file-hook) - (add-hook 'find-file-hook 'blank-turn-on-if-enabled t) - (add-hook 'find-file-hooks 'blank-turn-on-if-enabled t)) - (dolist (buffer (buffer-list)) ; adjust all local mode - (set-buffer buffer) - (unless blank-mode - (blank-turn-on-if-enabled))))) - (t ; global-blank-mode off - (save-excursion - (if (boundp 'find-file-hook) - (remove-hook 'find-file-hook 'blank-turn-on-if-enabled) - (remove-hook 'find-file-hooks 'blank-turn-on-if-enabled)) - (dolist (buffer (buffer-list)) ; adjust all local mode - (set-buffer buffer) - (unless blank-mode - (blank-turn-off))))))) - - -(defun blank-turn-on-if-enabled () - (when (cond - ((eq blank-global-modes t)) - ((listp blank-global-modes) - (if (eq (car-safe blank-global-modes) 'not) - (not (memq major-mode (cdr blank-global-modes))) - (memq major-mode blank-global-modes))) - (t nil)) - (let (inhibit-quit) - ;; Don't turn on blank mode if... - (or - ;; ...we don't have a display (we're running a batch job) - noninteractive - ;; ...or if the buffer is invisible (name starts with a space) - (eq (aref (buffer-name) 0) ?\ ) - ;; ...or if the buffer is temporary (name starts with *) - (and (eq (aref (buffer-name) 0) ?*) - ;; except the scratch buffer. - (not (string= (buffer-name) "*scratch*"))) - ;; Otherwise, turn on blank mode. - (blank-turn-on))))) - - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;;; User commands - Toggle - - -(defconst blank-chars-value-list - '(tabs - spaces - trailing - space-before-tab - lines - lines-tail - newline - indentation - empty - space-after-tab - ) - "List of valid `blank-chars' values.") - - -(defconst blank-style-value-list - '(color - mark - ) - "List of valid `blank-style' values.") - - -(defconst blank-toggle-option-alist - '((?t . tabs) - (?s . spaces) - (?r . trailing) - (?b . space-before-tab) - (?l . lines) - (?L . lines-tail) - (?n . newline) - (?i . indentation) - (?e . empty) - (?a . space-after-tab) - (?c . color) - (?m . mark) - (?x . blank-chars) - (?z . blank-style) - ) - "Alist of toggle options. - -Each element has the form: - - (CHAR . SYMBOL) - -Where: - -CHAR is a char which the user will have to type. - -SYMBOL is a valid symbol associated with CHAR. - See `blank-chars-value-list' and `blank-style-value-list'.") - - -(defvar blank-active-chars nil - "Used to save locally `blank-chars' value.") -(make-variable-buffer-local 'blank-active-chars) - -(defvar blank-active-style nil - "Used to save locally `blank-style' value.") -(make-variable-buffer-local 'blank-active-style) - - -;;;###autoload -(defun blank-toggle-options (arg) - "Toggle local `blank-mode' options. - -If local blank-mode is off, toggle the option given by ARG and -turn on local blank-mode. - -If local blank-mode is on, toggle the option given by ARG and -restart local blank-mode. - -Interactively, it reads one of the following chars: - - CHAR MEANING - t toggle TAB visualization - s toggle SPACE and HARD SPACE visualization - r toggle trailing blanks visualization - b toggle SPACEs before TAB visualization - l toggle \"long lines\" visualization - L toggle \"long lines\" tail visualization - n toggle NEWLINE visualization - i toggle indentation SPACEs visualization - e toggle empty line at bob and/or eob visualization - a toggle SPACEs after TAB visualization - c toggle color faces - m toggle visual mark - x restore `blank-chars' value - z restore `blank-style' value - ? display brief help - -Non-interactively, ARG should be a symbol or a list of symbols. -The valid symbols are: - - tabs toggle TAB visualization - spaces toggle SPACE and HARD SPACE visualization - trailing toggle trailing blanks visualization - space-before-tab toggle SPACEs before TAB visualization - lines toggle \"long lines\" visualization - lines-tail toggle \"long lines\" tail visualization - newline toggle NEWLINE visualization - indentation toggle indentation SPACEs visualization - empty toggle empty line at bob and/or eob visualization - space-after-tab toggle SPACEs after TAB visualization - color toggle color faces - mark toggle visual mark - blank-chars restore `blank-chars' value - blank-style restore `blank-style' value - -Only useful with a windowing system." - (interactive (blank-interactive-char t)) - (let ((blank-chars - (blank-toggle-list t arg blank-active-chars blank-chars - 'blank-chars blank-chars-value-list)) - (blank-style - (blank-toggle-list t arg blank-active-style blank-style - 'blank-style blank-style-value-list))) - (blank-mode 0) - (blank-mode 1))) - - -(defvar blank-toggle-chars nil - "Used to toggle the global `blank-chars' value.") -(defvar blank-toggle-style nil - "Used to toggle the global `blank-style' value.") - - -;;;###autoload -(defun global-blank-toggle-options (arg) - "Toggle global `blank-mode' options. - -If global blank-mode is off, toggle the option given by ARG and -turn on global blank-mode. - -If global blank-mode is on, toggle the option given by ARG and -restart global blank-mode. - -Interactively, it reads one of the following chars: - - CHAR MEANING - t toggle TAB visualization - s toggle SPACE and HARD SPACE visualization - r toggle trailing blanks visualization - b toggle SPACEs before TAB visualization - l toggle \"long lines\" visualization - L toggle \"long lines\" tail visualization - n toggle NEWLINE visualization - i toggle indentation SPACEs visualization - e toggle empty line at bob and/or eob visualization - a toggle SPACEs after TAB visualization - c toggle color faces - m toggle visual mark - x restore `blank-chars' value - z restore `blank-style' value - ? display brief help - -Non-interactively, ARG should be a symbol or a list of symbols. -The valid symbols are: - - tabs toggle TAB visualization - spaces toggle SPACE and HARD SPACE visualization - trailing toggle trailing blanks visualization - space-before-tab toggle SPACEs before TAB visualization - lines toggle \"long lines\" visualization - lines-tail toggle \"long lines\" tail visualization - newline toggle NEWLINE visualization - indentation toggle indentation SPACEs visualization - empty toggle empty line at bob and/or eob visualization - space-after-tab toggle SPACEs after TAB visualization - color toggle color faces - mark toggle visual mark - blank-chars restore `blank-chars' value - blank-style restore `blank-style' value - -Only useful with a windowing system." - (interactive (blank-interactive-char nil)) - (let ((blank-chars - (blank-toggle-list nil arg blank-toggle-chars blank-chars - 'blank-chars blank-chars-value-list)) - (blank-style - (blank-toggle-list nil arg blank-toggle-style blank-style - 'blank-style blank-style-value-list))) - (setq blank-toggle-chars blank-chars - blank-toggle-style blank-style) - (global-blank-mode 0) - (global-blank-mode 1))) - - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;;; User commands - Cleanup - - -;;;###autoload -(defun blank-cleanup () - "Cleanup some blank problems in all buffer or at region. - -It usually applies to the whole buffer, but in transient mark -mode when the mark is active, it applies to the region. It also -applies to the region when it is not in transiente mark mode, the -mark is active and it was pressed `C-u' just before calling -`blank-cleanup' interactively. - -See also `blank-cleanup-region'. - -The problems, which are cleaned up, are: - -1. empty lines at beginning of buffer. -2. empty lines at end of buffer. - If `blank-chars' has `empty' as an element, remove all empty - lines at beginning and/or end of buffer. - -3. 8 or more SPACEs at beginning of line. - If `blank-chars' has `indentation' as an element, replace 8 or - more SPACEs at beginning of line by TABs. - -4. SPACEs before TAB. - If `blank-chars' has `space-before-tab' as an element, replace - SPACEs by TABs. - -5. SPACEs or TABs at end of line. - If `blank-chars' has `trailing' as an element, remove all - SPACEs or TABs at end of line. - -6. 8 or more SPACEs after TAB. - If `blank-chars' has `space-after-tab' as an element, replace - SPACEs by TABs." - (interactive "@*") - (if (and (or transient-mark-mode - current-prefix-arg) - mark-active) - ;; region active - ;; problems 1 and 2 are not handled in region - ;; problem 3: 8 or more SPACEs at bol - ;; problem 4: SPACEs before TAB - ;; problem 5: SPACEs or TABs at eol - ;; problem 6: 8 or more SPACEs after TAB - (blank-cleanup-region (region-beginning) (region-end)) - ;; whole buffer - (save-excursion - (save-match-data - ;; problem 1: empty lines at bob - ;; problem 2: empty lines at eob - ;; action: remove all empty lines at bob and/or eob - (when (memq 'empty blank-chars) - (let (overwrite-mode) ; enforce no overwrite - (goto-char (point-min)) - (when (re-search-forward blank-empty-at-bob-regexp nil t) - (delete-region (match-beginning 1) (match-end 1))) - (when (re-search-forward blank-empty-at-eob-regexp nil t) - (delete-region (match-beginning 1) (match-end 1))))))) - ;; problem 3: 8 or more SPACEs at bol - ;; problem 4: SPACEs before TAB - ;; problem 5: SPACEs or TABs at eol - ;; problem 6: 8 or more SPACEs after TAB - (blank-cleanup-region (point-min) (point-max)))) - - -;;;###autoload -(defun blank-cleanup-region (start end) - "Cleanup some blank problems at region. - -The problems, which are cleaned up, are: - -1. 8 or more SPACEs at beginning of line. - If `blank-chars' has `indentation' as an element, replace 8 or - more SPACEs at beginning of line by TABs. - -2. SPACEs before TAB. - If `blank-chars' has `space-before-tab' as an element, replace - SPACEs by TABs. - -3. SPACEs or TABs at end of line. - If `blank-chars' has `trailing' as an element, remove all - SPACEs or TABs at end of line. - -4. 8 or more SPACEs after TAB. - If `blank-chars' has `space-after-tab' as an element, replace - SPACEs by TABs." - (interactive "@*r") - (let ((rstart (min start end)) - (rend (copy-marker (max start end))) - (tab-width 8) ; assure TAB width - (indent-tabs-mode t) ; always insert TABs - overwrite-mode ; enforce no overwrite - tmp) - (save-excursion - (save-match-data - ;; problem 1: 8 or more SPACEs at bol - ;; action: replace 8 or more SPACEs at bol by TABs - (when (memq 'indentation blank-chars) - (goto-char rstart) - (while (re-search-forward blank-indentation-regexp rend t) - (setq tmp (current-indentation)) - (delete-horizontal-space) - (unless (eolp) - (indent-to tmp)))) - ;; problem 3: SPACEs or TABs at eol - ;; action: remove all SPACEs or TABs at eol - (when (memq 'trailing blank-chars) - (let ((regexp (concat "\\(\\(" blank-trailing-regexp - "\\)+\\)$"))) - (goto-char rstart) - (while (re-search-forward regexp rend t) - (delete-region (match-beginning 1) (match-end 1))))) - ;; problem 4: 8 or more SPACEs after TAB - ;; action: replace 8 or more SPACEs by TABs - (when (memq 'space-after-tab blank-chars) - (blank-replace-spaces-by-tabs - rstart rend blank-space-after-tab-regexp)) - ;; problem 2: SPACEs before TAB - ;; action: replace SPACEs before TAB by TABs - (when (memq 'space-before-tab blank-chars) - (blank-replace-spaces-by-tabs - rstart rend blank-space-before-tab-regexp)))) - (set-marker rend nil))) ; point marker to nowhere - - -(defun blank-replace-spaces-by-tabs (rstart rend regexp) - "Replace all SPACEs by TABs matched by REGEXP between RSTART and REND." - (goto-char rstart) - (while (re-search-forward regexp rend t) - (goto-char (match-beginning 1)) - (let* ((scol (current-column)) - (ecol (save-excursion - (goto-char (match-end 1)) - (current-column)))) - (delete-region (match-beginning 1) (match-end 1)) - (insert-char ?\t - (/ (- (- ecol (% ecol 8)) ; prev end col - (- scol (% scol 8))) ; prev start col - 8))))) - - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;;; Internal functions - - -(defvar blank-font-lock-mode nil - "Used to remember whether a buffer had font lock mode on or not.") -(make-variable-buffer-local 'blank-font-lock-mode) - -(defvar blank-font-lock nil - "Used to remember whether a buffer initially had font lock on or not.") -(make-variable-buffer-local 'blank-font-lock) - -(defvar blank-font-lock-keywords nil - "Used to save locally `font-lock-keywords' value.") -(make-variable-buffer-local 'blank-font-lock-keywords) - - -(defconst blank-help-text - "\ - blank-mode toggle options: - - [] t - toggle TAB visualization - [] s - toggle SPACE and HARD SPACE visualization - [] r - toggle trailing blanks visualization - [] b - toggle SPACEs before TAB visualization - [] l - toggle \"long lines\" visualization - [] L - toggle \"long lines\" tail visualization - [] n - toggle NEWLINE visualization - [] i - toggle indentation SPACEs visualization - [] e - toggle empty line at bob and/or eob visualization - [] a - toggle SPACEs after TAB visualization - - [] c - toggle color faces - [] m - toggle visual mark - - x - restore `blank-chars' value - z - restore `blank-style' value - - ? - display this text\n\n" - "Text for blank toggle options.") - - -(defconst blank-help-buffer-name "*Blank Toggle Options*" - "The buffer name for blank toggle options.") - - -(defun blank-insert-option-mark (the-list the-value) - "Insert the option mark ('X' or ' ') in toggle options buffer." - (forward-line 1) - (dolist (sym the-list) - (forward-line 1) - (forward-char 2) - (insert (if (memq sym the-value) "X" " ")))) - - -(defun blank-help-on (chars style) - "Display the blank toggle options." - (unless (get-buffer blank-help-buffer-name) - (delete-other-windows) - (let ((buffer (get-buffer-create blank-help-buffer-name))) - (save-excursion - (set-buffer buffer) - (erase-buffer) - (insert blank-help-text) - (goto-char (point-min)) - (blank-insert-option-mark blank-chars-value-list chars) - (blank-insert-option-mark blank-style-value-list style) - (goto-char (point-min)) - (set-buffer-modified-p nil) - (let ((size (- (window-height) - (max window-min-height - (1+ (count-lines (point-min) (point-max))))))) - (when (<= size 0) - (kill-buffer buffer) - (error "Frame height is too small; \ -can't split window to display blank toggle options")) - (set-window-buffer (split-window nil size) buffer)))))) - - -(defun blank-help-off () - "Remove the buffer and window of the blank toggle options." - (let ((buffer (get-buffer blank-help-buffer-name))) - (when buffer - (delete-windows-on buffer) - (kill-buffer buffer)))) - - -(defun blank-interactive-char (local-p) - "Interactive function to read a char and return a symbol. - -If LOCAL-P is non-nil, it uses a local context; otherwise, it -uses a global context. - -It reads one of the following chars: - - CHAR MEANING - t toggle TAB visualization - s toggle SPACE and HARD SPACE visualization - r toggle trailing blanks visualization - b toggle SPACEs before TAB visualization - l toggle \"long lines\" visualization - L toggle \"long lines\" tail visualization - n toggle NEWLINE visualization - i toggle indentation SPACEs visualization - e toggle empty line at bob and/or eob visualization - a toggle SPACEs after TAB visualization - c toggle color faces - m toggle visual mark - x restore `blank-chars' value - z restore `blank-style' value - ? display brief help - -See also `blank-toggle-option-alist'." - (let* ((is-off (not (if local-p blank-mode global-blank-mode))) - (chars (cond (is-off blank-chars) ; use default value - (local-p blank-active-chars) - (t blank-toggle-chars))) - (style (cond (is-off blank-style) ; use default value - (local-p blank-active-style) - (t blank-toggle-style))) - (prompt - (format "Blank Toggle %s (type ? for further options)-" - (if local-p "Local" "Global"))) - ch sym) - ;; read a valid option and get the corresponding symbol - (save-window-excursion - (condition-case data - (progn - (while - ;; while condition - (progn - (setq ch (read-char prompt)) - (not - (setq sym - (cdr (assq ch blank-toggle-option-alist))))) - ;; while body - (if (eq ch ?\?) - (blank-help-on chars style) - (ding))) - (blank-help-off) - (message " ")) ; clean echo area - ;; handler - ((quit error) - (blank-help-off) - (error (error-message-string data))))) - (list sym))) ; return the apropriate symbol - - -(defun blank-toggle-list (local-p arg the-list default-list - sym-restore sym-list) - "Toggle options in THE-LIST based on list ARG. - -If LOCAL-P is non-nil, it uses a local context; otherwise, it -uses a global context. - -ARG is a list of options to be toggled. - -THE-LIST is a list of options. This list will be toggled and the -resultant list will be returned. - -DEFAULT-LIST is the default list of options. It is used to -restore the options in THE-LIST. - -SYM-RESTORE is the symbol which indicates to restore the options -in THE-LIST. - -SYM-LIST is a list of valid options, used to check if the ARG's -options are valid." - (unless (if local-p blank-mode global-blank-mode) - (setq the-list default-list)) - (setq the-list (copy-sequence the-list)) ; keep original list - (dolist (sym (if (listp arg) arg (list arg))) - (cond - ;; restore default values - ((eq sym sym-restore) - (setq the-list default-list)) - ;; toggle valid values - ((memq sym sym-list) - (setq the-list (if (memq sym the-list) - (delq sym the-list) - (cons sym the-list)))))) - the-list) - - -(defun blank-turn-on () - "Turn on blank visualization." - (setq blank-active-style (if (listp blank-style) - blank-style - (list blank-style))) - (setq blank-active-chars (if (listp blank-chars) - blank-chars - (list blank-chars))) - (when (memq 'color blank-active-style) - (blank-color-on)) - (when (memq 'mark blank-active-style) - (blank-display-char-on))) - - -(defun blank-turn-off () - "Turn off blank visualization." - (when (memq 'color blank-active-style) - (blank-color-off)) - (when (memq 'mark blank-active-style) - (blank-display-char-off))) - - -(defun blank-color-on () - "Turn on color visualization." - (when blank-active-chars - (unless blank-font-lock - (setq blank-font-lock t - blank-font-lock-keywords - (copy-sequence font-lock-keywords))) - ;; turn off font lock - (setq blank-font-lock-mode font-lock-mode) - (font-lock-mode 0) - ;; add blank-mode color into font lock - (when (memq 'spaces blank-active-chars) - (font-lock-add-keywords - nil - (list - ;; Show SPACEs - (list blank-space-regexp 1 blank-space t) - ;; Show HARD SPACEs - (list blank-hspace-regexp 1 blank-hspace t)) - t)) - (when (memq 'tabs blank-active-chars) - (font-lock-add-keywords - nil - (list - ;; Show TABs - (list blank-tab-regexp 1 blank-tab t)) - t)) - (when (memq 'trailing blank-active-chars) - (font-lock-add-keywords - nil - (list - ;; Show trailing blanks - (list (concat "\\(\\(" blank-trailing-regexp "\\)+\\)$") - 1 blank-trailing t)) - t)) - (when (or (memq 'lines blank-active-chars) - (memq 'lines-tail blank-active-chars)) - (font-lock-add-keywords - nil - (list - ;; Show "long" lines - (list - (format - "^\\([^\t\n]\\{%s\\}\\|[^\t\n]\\{0,%s\\}\t\\)\\{%d\\}%s\\(.+\\)$" - tab-width (1- tab-width) - (/ blank-line-column tab-width) - (let ((rem (% blank-line-column tab-width))) - (if (zerop rem) - "" - (format ".\\{%d\\}" rem)))) - (if (memq 'lines blank-active-chars) - 0 ; whole line - 2) ; line tail - blank-line t)) - t)) - (when (memq 'space-before-tab blank-active-chars) - (font-lock-add-keywords - nil - (list - ;; Show SPACEs before TAB - (list blank-space-before-tab-regexp - 1 blank-space-before-tab t)) - t)) - (when (memq 'indentation blank-active-chars) - (font-lock-add-keywords - nil - (list - ;; Show indentation SPACEs - (list blank-indentation-regexp - 1 blank-indentation t)) - t)) - (when (memq 'empty blank-active-chars) - (font-lock-add-keywords - nil - (list - ;; Show empty lines at beginning of buffer - (list blank-empty-at-bob-regexp - 1 blank-empty t)) - t) - (font-lock-add-keywords - nil - (list - ;; Show empty lines at end of buffer - (list blank-empty-at-eob-regexp - 1 blank-empty t)) - t)) - (when (memq 'space-after-tab blank-active-chars) - (font-lock-add-keywords - nil - (list - ;; Show SPACEs after TAB - (list blank-space-after-tab-regexp - 1 blank-space-after-tab t)) - t)) - ;; now turn on font lock and highlight blanks - (font-lock-mode 1))) - - -(defun blank-color-off () - "Turn off color visualization." - (when blank-active-chars - ;; turn off font lock - (font-lock-mode 0) - (when blank-font-lock - (setq blank-font-lock nil - font-lock-keywords blank-font-lock-keywords)) - ;; restore original font lock state - (font-lock-mode blank-font-lock-mode))) - - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;;; Hacked from visws.el (Miles Bader <miles@gnu.org>) - - -(defvar blank-display-table nil - "Used to save a local display table.") -(make-variable-buffer-local 'blank-display-table) - -(defvar blank-display-table-was-local nil - "Used to remember whether a buffer initially had a local display table or not.") -(make-variable-buffer-local 'blank-display-table-was-local) - - -(defsubst blank-char-valid-p (char) - ;; This check should be improved!!! - (or (< char 256) - (char-valid-p char))) - - -(defun blank-legal-display-vector-p (vec) - "Return true if every character in vector VEC can be displayed." - (let ((i (length vec))) - (when (> i 0) - (while (and (>= (setq i (1- i)) 0) - (blank-char-valid-p (aref vec i)))) - (< i 0)))) - - -(defun blank-display-char-on () - "Turn on character display mapping." - (when blank-display-mappings - (let (vecs vec) - ;; Remember whether a buffer has a local display table. - (unless blank-display-table-was-local - (setq blank-display-table-was-local t - blank-display-table - (copy-sequence buffer-display-table))) - (unless buffer-display-table - (setq buffer-display-table (make-display-table))) - (dolist (entry blank-display-mappings) - (setq vecs (cdr entry)) - ;; Get a displayable mapping. - (while (and vecs - (not (blank-legal-display-vector-p (car vecs)))) - (setq vecs (cdr vecs))) - ;; Display a valid mapping. - (when vecs - (setq vec (copy-sequence (car vecs))) - (cond - ;; Any char except newline - ((not (eq (car entry) ?\n)) - (aset buffer-display-table (car entry) vec)) - ;; Newline char - display it - ((memq 'newline blank-active-chars) - ;; Only insert face bits on NEWLINE char mapping to avoid - ;; obstruction of other faces like TABs and (HARD) SPACEs - ;; faces, font-lock faces, etc. - (when (memq 'color blank-active-style) - (dotimes (i (length vec)) - ;; Due to limitations of glyph representation, the char - ;; code can not be above ?\x1FFFF. Probably, this will - ;; be fixed after Emacs unicode merging. - (or (eq (aref vec i) ?\n) - (> (aref vec i) #x1FFFF) - (aset vec i (make-glyph-code (aref vec i) - blank-newline))))) - ;; Display mapping - (aset buffer-display-table (car entry) vec)) - ;; Newline char - don't display it - (t - ;; Do nothing - ))))))) - - -(defun blank-display-char-off () - "Turn off character display mapping." - (and blank-display-mappings - blank-display-table-was-local - (setq blank-display-table-was-local nil - buffer-display-table blank-display-table))) - - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;;; Aliases for whitespace compatibility - - -;;;###autoload -(defun whitespace-buffer () - (interactive) - (blank-mode 0) ; assure is off - ;; keep original values - (let ((blank-style (copy-sequence blank-style)) - (blank-chars (copy-sequence blank-chars))) - ;; adjust options for whitespace bogus blanks - (add-to-list 'blank-style 'color) - (mapc #'(lambda (option) - (add-to-list 'blank-chars option)) - '(trailing - indentation - space-before-tab - empty - space-after-tab)) - (blank-mode 1))) - -;;;###autoload -(defalias 'whitespace-region 'whitespace-buffer) ; there is no `blank-region' - -;;;###autoload -(defalias 'whitespace-cleanup 'blank-cleanup) - -;;;###autoload -(defalias 'whitespace-cleanup-region 'blank-cleanup-region) - - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - - -(provide 'blank-mode) - - -(run-hooks 'blank-load-hook) - - -;; arch-tag: 1b1e2500-dbd4-4a26-8f7a-5a5edfd3c97e -;;; blank-mode.el ends here
--- a/lisp/image-mode.el Thu Jan 31 13:49:17 2008 +0000 +++ b/lisp/image-mode.el Fri Feb 01 03:01:11 2008 +0000 @@ -52,30 +52,41 @@ (defvar image-mode-current-vscroll nil "An alist with elements (WINDOW . VSCROLL).") +(make-variable-buffer-local 'image-mode-current-vscroll) (defvar image-mode-current-hscroll nil "An alist with elements (WINDOW . HSCROLL).") +(make-variable-buffer-local 'image-mode-current-hscroll) (defun image-set-window-vscroll (window vscroll &optional pixels-p) (setq image-mode-current-vscroll - (append (list (cons window vscroll)) - (delete (assoc window image-mode-current-vscroll) - image-mode-current-vscroll))) + (cons (cons window vscroll) + (delq (assq window image-mode-current-vscroll) + image-mode-current-vscroll))) (set-window-vscroll window vscroll pixels-p)) (defun image-set-window-hscroll (window ncol) (setq image-mode-current-hscroll - (append (list (cons window ncol)) - (delete (assoc window image-mode-current-hscroll) - image-mode-current-hscroll))) + (cons (cons window ncol) + (delq (assq window image-mode-current-hscroll) + image-mode-current-hscroll))) (set-window-hscroll window ncol)) (defun image-reset-current-vhscroll () - (let ((win (selected-window))) - (when (assoc win image-mode-current-hscroll) - (set-window-hscroll win (cdr (assoc win image-mode-current-hscroll)))) - (when (assoc win image-mode-current-vscroll) - (set-window-vscroll win (cdr (assoc win image-mode-current-vscroll)))))) + (walk-windows + (lambda (win) + (with-current-buffer (window-buffer win) + ;; When set-window-buffer, set hscroll and vscroll to what they were + ;; last time the image was displayed in this window. If it's the first + ;; time it's displayed in this window, use the most recent setting. + (when image-mode-current-hscroll + (set-window-hscroll win (cdr (or (assoc win image-mode-current-hscroll) + (car image-mode-current-hscroll))))) + (when image-mode-current-vscroll + (set-window-vscroll win (cdr (or (assoc win image-mode-current-vscroll) + (car image-mode-current-vscroll))))))) + 'nomini + (selected-frame))) (defun image-forward-hscroll (&optional n) "Scroll image in current window to the left by N character widths. @@ -145,7 +156,7 @@ (t (image-next-line (prefix-numeric-value n))))) (defun image-scroll-down (&optional n) - "Scroll image in current window downward by N lines + "Scroll image in current window downward by N lines. Stop if the top edge of the image is reached. If ARG is omitted or nil, scroll downward by a near full screen. A near full screen is `next-screen-context-lines' less than a full screen. @@ -253,8 +264,6 @@ 'image-bookmark-make-cell) ;; Keep track of [vh]scroll when switching buffers - (make-local-variable 'image-mode-current-hscroll) - (make-local-variable 'image-mode-current-vscroll) (image-set-window-hscroll (selected-window) (window-hscroll)) (image-set-window-vscroll (selected-window) (window-vscroll)) (add-hook 'window-configuration-change-hook
--- a/lisp/mail/rmail.el Thu Jan 31 13:49:17 2008 +0000 +++ b/lisp/mail/rmail.el Fri Feb 01 03:01:11 2008 +0000 @@ -332,7 +332,7 @@ :group 'rmail-headers) (defface rmail-highlight - '((t :default highlight)) + '((t (:inherit highlight))) "Face to use for highlighting the most important header fields." :group 'rmail-headers :version "22.1")
--- a/lisp/net/rcompile.el Thu Jan 31 13:49:17 2008 +0000 +++ b/lisp/net/rcompile.el Fri Feb 01 03:01:11 2008 +0000 @@ -115,43 +115,35 @@ ;;;; entry point -;; We use the Tramp internal functions `with-parsed-tramp-file-name' -;; and `tramp-make-tramp-file-name'. Better would be, if there are -;; functions to provide user, host and localname of a remote filename, -;; independent of Tramp's implementation. The function calls are -;; wrapped by `funcall' in order to pacify the byte compiler. -;; ange-ftp check removed, because it is handled also by Tramp. +;; We use the Tramp internal function`tramp-make-tramp-file-name'. +;; Better would be, if there are functions to provide user, host and +;; localname of a remote filename, independent of Tramp's implementation. +;; The function calls are wrapped by `funcall' in order to pacify the byte +;; compiler. ange-ftp check removed, because it is handled also by Tramp. ;;;###autoload (defun remote-compile (host user command) "Compile the current buffer's directory on HOST. Log in as USER. See \\[compile]." (interactive - (let ((parsed (and (featurep 'tramp) - (file-remote-p default-directory))) - host user command prompt l l-host l-user) - (if parsed - (funcall (symbol-function 'with-parsed-tramp-file-name) - default-directory l - (setq host l-host - user l-user)) - (setq prompt (if (stringp remote-compile-host) - (format "Compile on host (default %s): " - remote-compile-host) - "Compile on host: ") - host (if (or remote-compile-prompt-for-host - (null remote-compile-host)) - (read-from-minibuffer prompt - "" nil nil - 'remote-compile-host-history) - remote-compile-host) - user (if remote-compile-prompt-for-user - (read-from-minibuffer (format - "Compile by user (default %s): " - (or remote-compile-user - (user-login-name))) - "" nil nil - 'remote-compile-user-history) - remote-compile-user))) + (let (host user command prompt l l-host l-user) + (setq prompt (if (stringp remote-compile-host) + (format "Compile on host (default %s): " + remote-compile-host) + "Compile on host: ") + host (if (or remote-compile-prompt-for-host + (null remote-compile-host)) + (read-from-minibuffer prompt + "" nil nil + 'remote-compile-host-history) + remote-compile-host) + user (if remote-compile-prompt-for-user + (read-from-minibuffer (format + "Compile by user (default %s): " + (or remote-compile-user + (user-login-name))) + "" nil nil + 'remote-compile-user-history) + remote-compile-user)) (setq command (read-from-minibuffer "Compile command: " compile-command nil nil '(compile-history . 1))) @@ -164,8 +156,6 @@ ((null remote-compile-user) (setq remote-compile-user (user-login-name)))) (let* (localname ;; Pacify byte-compiler. - (parsed (and (featurep 'tramp) - (file-remote-p default-directory))) (compile-command (format "%s %s -l %s \"(%scd %s; %s)\"" remote-shell-program @@ -174,10 +164,7 @@ (if remote-compile-run-before (concat remote-compile-run-before "; ") "") - (if parsed - (funcall (symbol-function 'with-parsed-tramp-file-name) - default-directory nil localname) - "") + "" compile-command))) (setq remote-compile-host host) (save-some-buffers nil nil) @@ -185,13 +172,13 @@ ;; Set comint-file-name-prefix in the compilation buffer so ;; compilation-parse-errors will find referenced files by Tramp. (with-current-buffer compilation-last-buffer - (when (featurep 'tramp) + (when (fboundp 'tramp-make-tramp-file-name) (set (make-local-variable 'comint-file-name-prefix) - (funcall (symbol-function 'tramp-make-tramp-file-name) + (tramp-make-tramp-file-name nil ;; method. remote-compile-user remote-compile-host "")))))) -;;; arch-tag: 2866a132-ece4-4ce9-9f91-ec147f803f73 +;; arch-tag: 2866a132-ece4-4ce9-9f91-ec147f803f73 ;;; rcompile.el ends here
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/lisp/obsolete/old-whitespace.el Fri Feb 01 03:01:11 2008 +0000 @@ -0,0 +1,814 @@ +;;; whitespace.el --- warn about and clean bogus whitespaces in the file + +;; Copyright (C) 1999, 2000, 2001, 2002, 2003, 2004, +;; 2005, 2006, 2007, 2008 Free Software Foundation, Inc. + +;; Author: Rajesh Vaidheeswarran <rv@gnu.org> +;; Keywords: convenience + +;; 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 3, 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. + +;;; Commentary: +;; +;; URL: http://www.dsmit.com/lisp/ +;; +;; The whitespace library is intended to find and help fix five different types +;; of whitespace problems that commonly exist in source code. +;; +;; 1. Leading space (empty lines at the top of a file). +;; 2. Trailing space (empty lines at the end of a file). +;; 3. Indentation space (8 or more spaces at beginning of line, that should be +;; replaced with TABS). +;; 4. Spaces followed by a TAB. (Almost always, we never want that). +;; 5. Spaces or TABS at the end of a line. +;; +;; Whitespace errors are reported in a buffer, and on the modeline. +;; +;; Modeline will show a W:<x>!<y> to denote a particular type of whitespace, +;; where `x' and `y' can be one (or more) of: +;; +;; e - End-of-Line whitespace. +;; i - Indentation whitespace. +;; l - Leading whitespace. +;; s - Space followed by Tab. +;; t - Trailing whitespace. +;; +;; If any of the whitespace checks is turned off, the modeline will display a +;; !<y>. +;; +;; (since (3) is the most controversial one, here is the rationale: Most +;; terminal drivers and printer drivers have TAB configured or even +;; hardcoded to be 8 spaces. (Some of them allow configuration, but almost +;; always they default to 8.) +;; +;; Changing `tab-width' to other than 8 and editing will cause your code to +;; look different from within Emacs, and say, if you cat it or more it, or +;; even print it. +;; +;; Almost all the popular programming modes let you define an offset (like +;; c-basic-offset or perl-indent-level) to configure the offset, so you +;; should never have to set your `tab-width' to be other than 8 in all +;; these modes. In fact, with an indent level of say, 4, 2 TABS will cause +;; Emacs to replace your 8 spaces with one \t (try it). If vi users in +;; your office complain, tell them to use vim, which distinguishes between +;; tabstop and shiftwidth (vi equivalent of our offsets), and also ask them +;; to set smarttab.) +;; +;; All the above have caused (and will cause) unwanted codeline integration and +;; merge problems. +;; +;; whitespace.el will complain if it detects whitespaces on opening a file, and +;; warn you on closing a file also (in case you had inserted any +;; whitespaces during the process of your editing). +;; +;; Exported functions: +;; +;; `whitespace-buffer' - To check the current buffer for whitespace problems. +;; `whitespace-cleanup' - To cleanup all whitespaces in the current buffer. +;; `whitespace-region' - To check between point and mark for whitespace +;; problems. +;; `whitespace-cleanup-region' - To cleanup all whitespaces between point +;; and mark in the current buffer. + +;;; Code: + +(defvar whitespace-version "3.5" "Version of the whitespace library.") + +(defvar whitespace-all-buffer-files nil + "An associated list of buffers and files checked for whitespace cleanliness. + +This is to enable periodic checking of whitespace cleanliness in the files +visited by the buffers.") + +(defvar whitespace-rescan-timer nil + "Timer object used to rescan the files in buffers that have been modified.") + +;; Tell Emacs about this new kind of minor mode +(defvar whitespace-mode nil + "Non-nil when Whitespace mode (a minor mode) is enabled.") +(make-variable-buffer-local 'whitespace-mode) + +(defvar whitespace-mode-line nil + "String to display in the mode line for Whitespace mode.") +(make-variable-buffer-local 'whitespace-mode-line) + +(defvar whitespace-check-buffer-leading nil + "Test leading whitespace for file in current buffer if t.") +(make-variable-buffer-local 'whitespace-check-buffer-leading) +;;;###autoload(put 'whitespace-check-buffer-leading 'safe-local-variable 'booleanp) + +(defvar whitespace-check-buffer-trailing nil + "Test trailing whitespace for file in current buffer if t.") +(make-variable-buffer-local 'whitespace-check-buffer-trailing) +;;;###autoload(put 'whitespace-check-buffer-trailing 'safe-local-variable 'booleanp) + +(defvar whitespace-check-buffer-indent nil + "Test indentation whitespace for file in current buffer if t.") +(make-variable-buffer-local 'whitespace-check-buffer-indent) +;;;###autoload(put 'whitespace-check-buffer-indent 'safe-local-variable 'booleanp) + +(defvar whitespace-check-buffer-spacetab nil + "Test Space-followed-by-TABS whitespace for file in current buffer if t.") +(make-variable-buffer-local 'whitespace-check-buffer-spacetab) +;;;###autoload(put 'whitespace-check-buffer-spacetab 'safe-local-variable 'booleanp) + +(defvar whitespace-check-buffer-ateol nil + "Test end-of-line whitespace for file in current buffer if t.") +(make-variable-buffer-local 'whitespace-check-buffer-ateol) +;;;###autoload(put 'whitespace-check-buffer-ateol 'safe-local-variable 'booleanp) + +(defvar whitespace-highlighted-space nil + "The variable to store the extent to highlight.") +(make-variable-buffer-local 'whitespace-highlighted-space) + +(defalias 'whitespace-make-overlay + (if (featurep 'xemacs) 'make-extent 'make-overlay)) +(defalias 'whitespace-overlay-put + (if (featurep 'xemacs) 'set-extent-property 'overlay-put)) +(defalias 'whitespace-delete-overlay + (if (featurep 'xemacs) 'delete-extent 'delete-overlay)) +(defalias 'whitespace-overlay-start + (if (featurep 'xemacs) 'extent-start 'overlay-start)) +(defalias 'whitespace-overlay-end + (if (featurep 'xemacs) 'extent-end 'overlay-end)) +(defalias 'whitespace-mode-line-update + (if (featurep 'xemacs) 'redraw-modeline 'force-mode-line-update)) + +(defgroup whitespace nil + "Check for and fix five different types of whitespaces in source code." + :version "21.1" + :link '(emacs-commentary-link "whitespace.el") + ;; Since XEmacs doesn't have a 'convenience group, use the next best group + ;; which is 'editing? + :group (if (featurep 'xemacs) 'editing 'convenience)) + +(defcustom whitespace-check-leading-whitespace t + "Flag to check leading whitespace. This is the global for the system. +It can be overridden by setting a buffer local variable +`whitespace-check-buffer-leading'." + :type 'boolean + :group 'whitespace) + +(defcustom whitespace-check-trailing-whitespace t + "Flag to check trailing whitespace. This is the global for the system. +It can be overridden by setting a buffer local variable +`whitespace-check-buffer-trailing'." + :type 'boolean + :group 'whitespace) + +(defcustom whitespace-check-spacetab-whitespace t + "Flag to check space followed by a TAB. This is the global for the system. +It can be overridden by setting a buffer local variable +`whitespace-check-buffer-spacetab'." + :type 'boolean + :group 'whitespace) + +(defcustom whitespace-spacetab-regexp "[ ]+\t" + "Regexp to match one or more spaces followed by a TAB." + :type 'regexp + :group 'whitespace) + +(defcustom whitespace-check-indent-whitespace indent-tabs-mode + "Flag to check indentation whitespace. This is the global for the system. +It can be overridden by setting a buffer local variable +`whitespace-check-buffer-indent'." + :type 'boolean + :group 'whitespace) + +(defcustom whitespace-indent-regexp "^\t*\\( \\)+" + "Regexp to match multiples of eight spaces near line beginnings. +The default value ignores leading TABs." + :type 'regexp + :group 'whitespace) + +(defcustom whitespace-check-ateol-whitespace t + "Flag to check end-of-line whitespace. This is the global for the system. +It can be overridden by setting a buffer local variable +`whitespace-check-buffer-ateol'." + :type 'boolean + :group 'whitespace) + +(defcustom whitespace-ateol-regexp "[ \t]+$" + "Regexp to match one or more TABs or spaces at line ends." + :type 'regexp + :group 'whitespace) + +(defcustom whitespace-errbuf "*Whitespace Errors*" + "The name of the buffer where whitespace related messages will be logged." + :type 'string + :group 'whitespace) + +(defcustom whitespace-clean-msg "clean." + "If non-nil, this message will be displayed after a whitespace check +determines a file to be clean." + :type 'string + :group 'whitespace) + +(defcustom whitespace-abort-on-error nil + "While writing a file, abort if the file is unclean. +If `whitespace-auto-cleanup' is set, that takes precedence over +this variable." + :type 'boolean + :group 'whitespace) + +(defcustom whitespace-auto-cleanup nil + "Cleanup a buffer automatically on finding it whitespace unclean." + :type 'boolean + :group 'whitespace) + +(defcustom whitespace-silent nil + "All whitespace errors will be shown only in the modeline when t. + +Note that setting this may cause all whitespaces introduced in a file to go +unnoticed when the buffer is killed, unless the user visits the `*Whitespace +Errors*' buffer before opening (or closing) another file." + :type 'boolean + :group 'whitespace) + +(defcustom whitespace-modes '(ada-mode asm-mode autoconf-mode awk-mode + c-mode c++-mode cc-mode + change-log-mode cperl-mode + electric-nroff-mode emacs-lisp-mode + f90-mode fortran-mode html-mode + html3-mode java-mode jde-mode + ksh-mode latex-mode LaTeX-mode + lisp-mode m4-mode makefile-mode + modula-2-mode nroff-mode objc-mode + pascal-mode perl-mode prolog-mode + python-mode scheme-mode sgml-mode + sh-mode shell-script-mode simula-mode + tcl-mode tex-mode texinfo-mode + vrml-mode xml-mode) + + "Major modes in which we turn on whitespace checking. + +These are mostly programming and documentation modes. But you may add other +modes that you want whitespaces checked in by adding something like the +following to your `.emacs': + +\(setq whitespace-modes (cons 'my-mode (cons 'my-other-mode + whitespace-modes))\) + +Or, alternately, you can use the Emacs `customize' command to set this." + :type '(repeat symbol) + :group 'whitespace) + +(defcustom whitespace-rescan-timer-time 600 + "Period in seconds to rescan modified buffers for whitespace creep. + +This is the period after which the timer will fire causing +`whitespace-rescan-files-in-buffers' to check for whitespace creep in +modified buffers. + +To disable timer scans, set this to zero." + :type 'integer + :group 'whitespace) + +(defcustom whitespace-display-in-modeline t + "Display whitespace errors on the modeline." + :type 'boolean + :group 'whitespace) + +(defcustom whitespace-display-spaces-in-color t + "Display the bogus whitespaces by coloring them with the face +`whitespace-highlight'." + :type 'boolean + :group 'whitespace) + +(defgroup whitespace-faces nil + "Faces used in whitespace." + :prefix "whitespace-" + :group 'whitespace + :group 'faces) + +(defface whitespace-highlight '((((class color) (background light)) + (:background "green1")) + (((class color) (background dark)) + (:background "sea green")) + (((class grayscale mono) + (background light)) + (:background "black")) + (((class grayscale mono) + (background dark)) + (:background "white"))) + "Face used for highlighting the bogus whitespaces that exist in the buffer." + :group 'whitespace-faces) +;; backward-compatibility alias +(put 'whitespace-highlight-face 'face-alias 'whitespace-highlight) + +(if (not (assoc 'whitespace-mode minor-mode-alist)) + (setq minor-mode-alist (cons '(whitespace-mode whitespace-mode-line) + minor-mode-alist))) + +(set-default 'whitespace-check-buffer-leading + whitespace-check-leading-whitespace) +(set-default 'whitespace-check-buffer-trailing + whitespace-check-trailing-whitespace) +(set-default 'whitespace-check-buffer-indent + whitespace-check-indent-whitespace) +(set-default 'whitespace-check-buffer-spacetab + whitespace-check-spacetab-whitespace) +(set-default 'whitespace-check-buffer-ateol + whitespace-check-ateol-whitespace) + +(defun whitespace-check-whitespace-mode (&optional arg) + "Test and set the whitespace-mode in qualifying buffers." + (if (null whitespace-mode) + (setq whitespace-mode + (if (or arg (member major-mode whitespace-modes)) + t + nil)))) + +;;;###autoload +(defun whitespace-toggle-leading-check () + "Toggle the check for leading space in the local buffer." + (interactive) + (let ((current-val whitespace-check-buffer-leading)) + (setq whitespace-check-buffer-leading (not current-val)) + (message "Will%s check for leading space in buffer." + (if whitespace-check-buffer-leading "" " not")) + (if whitespace-check-buffer-leading (whitespace-buffer-leading)))) + +;;;###autoload +(defun whitespace-toggle-trailing-check () + "Toggle the check for trailing space in the local buffer." + (interactive) + (let ((current-val whitespace-check-buffer-trailing)) + (setq whitespace-check-buffer-trailing (not current-val)) + (message "Will%s check for trailing space in buffer." + (if whitespace-check-buffer-trailing "" " not")) + (if whitespace-check-buffer-trailing (whitespace-buffer-trailing)))) + +;;;###autoload +(defun whitespace-toggle-indent-check () + "Toggle the check for indentation space in the local buffer." + (interactive) + (let ((current-val whitespace-check-buffer-indent)) + (setq whitespace-check-buffer-indent (not current-val)) + (message "Will%s check for indentation space in buffer." + (if whitespace-check-buffer-indent "" " not")) + (if whitespace-check-buffer-indent + (whitespace-buffer-search whitespace-indent-regexp)))) + +;;;###autoload +(defun whitespace-toggle-spacetab-check () + "Toggle the check for space-followed-by-TABs in the local buffer." + (interactive) + (let ((current-val whitespace-check-buffer-spacetab)) + (setq whitespace-check-buffer-spacetab (not current-val)) + (message "Will%s check for space-followed-by-TABs in buffer." + (if whitespace-check-buffer-spacetab "" " not")) + (if whitespace-check-buffer-spacetab + (whitespace-buffer-search whitespace-spacetab-regexp)))) + + +;;;###autoload +(defun whitespace-toggle-ateol-check () + "Toggle the check for end-of-line space in the local buffer." + (interactive) + (let ((current-val whitespace-check-buffer-ateol)) + (setq whitespace-check-buffer-ateol (not current-val)) + (message "Will%s check for end-of-line space in buffer." + (if whitespace-check-buffer-ateol "" " not")) + (if whitespace-check-buffer-ateol + (whitespace-buffer-search whitespace-ateol-regexp)))) + + +;;;###autoload +(defun whitespace-buffer (&optional quiet) + "Find five different types of white spaces in buffer. +These are: +1. Leading space \(empty lines at the top of a file\). +2. Trailing space \(empty lines at the end of a file\). +3. Indentation space \(8 or more spaces, that should be replaced with TABS\). +4. Spaces followed by a TAB. \(Almost always, we never want that\). +5. Spaces or TABS at the end of a line. + +Check for whitespace only if this buffer really contains a non-empty file +and: +1. the major mode is one of the whitespace-modes, or +2. `whitespace-buffer' was explicitly called with a prefix argument." + (interactive) + (let ((whitespace-error nil)) + (whitespace-check-whitespace-mode current-prefix-arg) + (if (and buffer-file-name (> (buffer-size) 0) whitespace-mode) + (progn + (whitespace-check-buffer-list (buffer-name) buffer-file-name) + (whitespace-tickle-timer) + (overlay-recenter (point-max)) + (remove-overlays nil nil 'face 'whitespace-highlight) + (if whitespace-auto-cleanup + (if buffer-read-only + (if (not quiet) + (message "Can't cleanup: %s is read-only" (buffer-name))) + (whitespace-cleanup-internal)) + (let ((whitespace-leading (if whitespace-check-buffer-leading + (whitespace-buffer-leading) + nil)) + (whitespace-trailing (if whitespace-check-buffer-trailing + (whitespace-buffer-trailing) + nil)) + (whitespace-indent (if whitespace-check-buffer-indent + (whitespace-buffer-search + whitespace-indent-regexp) + nil)) + (whitespace-spacetab (if whitespace-check-buffer-spacetab + (whitespace-buffer-search + whitespace-spacetab-regexp) + nil)) + (whitespace-ateol (if whitespace-check-buffer-ateol + (whitespace-buffer-search + whitespace-ateol-regexp) + nil)) + (whitespace-errmsg nil) + (whitespace-filename buffer-file-name) + (whitespace-this-modeline "")) + + ;; Now let's complain if we found any of the above. + (setq whitespace-error (or whitespace-leading whitespace-indent + whitespace-spacetab whitespace-ateol + whitespace-trailing)) + + (if whitespace-error + (progn + (setq whitespace-errmsg + (concat whitespace-filename " contains:\n" + (if whitespace-leading + "Leading whitespace\n") + (if whitespace-indent + (concat "Indentation whitespace" + whitespace-indent "\n")) + (if whitespace-spacetab + (concat "Space followed by Tab" + whitespace-spacetab "\n")) + (if whitespace-ateol + (concat "End-of-line whitespace" + whitespace-ateol "\n")) + (if whitespace-trailing + "Trailing whitespace\n") + "\ntype `M-x whitespace-cleanup' to " + "cleanup the file.")) + (setq whitespace-this-modeline + (concat (if whitespace-ateol "e") + (if whitespace-indent "i") + (if whitespace-leading "l") + (if whitespace-spacetab "s") + (if whitespace-trailing "t"))))) + (whitespace-update-modeline whitespace-this-modeline) + (if (get-buffer whitespace-errbuf) + (kill-buffer whitespace-errbuf)) + (with-current-buffer (get-buffer-create whitespace-errbuf) + (if whitespace-errmsg + (progn + (insert whitespace-errmsg) + (if (not (or quiet whitespace-silent)) + (display-buffer (current-buffer) t)) + (if (not quiet) + (message "Whitespaces: [%s%s] in %s" + whitespace-this-modeline + (let ((whitespace-unchecked + (whitespace-unchecked-whitespaces))) + (if whitespace-unchecked + (concat "!" whitespace-unchecked) + "")) + whitespace-filename))) + (if (and (not quiet) (not (equal whitespace-clean-msg ""))) + (message "%s %s" whitespace-filename + whitespace-clean-msg)))))))) + whitespace-error)) + +;;;###autoload +(defun whitespace-region (s e) + "Check the region for whitespace errors." + (interactive "r") + (save-excursion + (save-restriction + (narrow-to-region s e) + (whitespace-buffer)))) + +;;;###autoload +(defun whitespace-cleanup () + "Cleanup the five different kinds of whitespace problems. +It normally applies to the whole buffer, but in Transient Mark mode +when the mark is active it applies to the region. +See `whitespace-buffer' docstring for a summary of the problems." + (interactive) + (if (and transient-mark-mode mark-active) + (whitespace-cleanup-region (region-beginning) (region-end)) + (whitespace-cleanup-internal))) + +(defun whitespace-cleanup-internal (&optional region-only) + ;; If this buffer really contains a file, then run, else quit. + (whitespace-check-whitespace-mode current-prefix-arg) + (if (and buffer-file-name whitespace-mode) + (let ((whitespace-any nil) + (whitespace-tabwith 8) + (whitespace-tabwith-saved tab-width)) + + ;; since all printable TABS should be 8, irrespective of how + ;; they are displayed. + (setq tab-width whitespace-tabwith) + + (if (and whitespace-check-buffer-leading + (whitespace-buffer-leading)) + (progn + (whitespace-buffer-leading-cleanup) + (setq whitespace-any t))) + + (if (and whitespace-check-buffer-trailing + (whitespace-buffer-trailing)) + (progn + (whitespace-buffer-trailing-cleanup) + (setq whitespace-any t))) + + (if (and whitespace-check-buffer-indent + (whitespace-buffer-search whitespace-indent-regexp)) + (progn + (whitespace-indent-cleanup) + (setq whitespace-any t))) + + (if (and whitespace-check-buffer-spacetab + (whitespace-buffer-search whitespace-spacetab-regexp)) + (progn + (whitespace-buffer-cleanup whitespace-spacetab-regexp "\t") + (setq whitespace-any t))) + + (if (and whitespace-check-buffer-ateol + (whitespace-buffer-search whitespace-ateol-regexp)) + (progn + (whitespace-buffer-cleanup whitespace-ateol-regexp "") + (setq whitespace-any t))) + + ;; Call this recursively till everything is taken care of + (if whitespace-any + (whitespace-cleanup-internal region-only) + ;; if we are done, talk to the user + (progn + (unless whitespace-silent + (if region-only + (message "The region is now clean") + (message "%s is now clean" buffer-file-name))) + (whitespace-update-modeline))) + (setq tab-width whitespace-tabwith-saved)))) + +;;;###autoload +(defun whitespace-cleanup-region (s e) + "Whitespace cleanup on the region." + (interactive "r") + (save-excursion + (save-restriction + (narrow-to-region s e) + (whitespace-cleanup-internal t)) + (whitespace-buffer t))) + +(defun whitespace-buffer-leading () + "Return t if the current buffer has leading newline characters. +If highlighting is enabled, highlight these characters." + (save-excursion + (goto-char (point-min)) + (skip-chars-forward "\n") + (unless (bobp) + (whitespace-highlight-the-space (point-min) (point)) + t))) + +(defun whitespace-buffer-leading-cleanup () + "Remove any leading newline characters from current buffer." + (save-excursion + (goto-char (point-min)) + (skip-chars-forward "\n") + (delete-region (point-min) (point)))) + +(defun whitespace-buffer-trailing () + "Return t if the current buffer has extra trailing newline characters. +If highlighting is enabled, highlight these characters." + (save-excursion + (goto-char (point-max)) + (skip-chars-backward "\n") + (forward-line) + (unless (eobp) + (whitespace-highlight-the-space (point) (point-max)) + t))) + +(defun whitespace-buffer-trailing-cleanup () + "Remove extra trailing newline characters from current buffer." + (save-excursion + (goto-char (point-max)) + (skip-chars-backward "\n") + (unless (eobp) + (forward-line) + (delete-region (point) (point-max))))) + +(defun whitespace-buffer-search (regexp) + "Search for any given whitespace REGEXP." + (with-local-quit + (let (whitespace-retval) + (save-excursion + (goto-char (point-min)) + (while (re-search-forward regexp nil t) + (whitespace-highlight-the-space (match-beginning 0) (match-end 0)) + (push (match-beginning 0) whitespace-retval))) + (when whitespace-retval + (format " %s" (nreverse whitespace-retval)))))) + +(defun whitespace-buffer-cleanup (regexp newregexp) + "Search for any given whitespace REGEXP and replace it with the NEWREGEXP." + (save-excursion + (goto-char (point-min)) + (while (re-search-forward regexp nil t) + (replace-match newregexp)))) + +(defun whitespace-indent-cleanup () + "Search for 8/more spaces at the start of a line and replace it with tabs." + (save-excursion + (goto-char (point-min)) + (while (re-search-forward whitespace-indent-regexp nil t) + (let ((column (current-column)) + (indent-tabs-mode t)) + (delete-region (match-beginning 0) (point)) + (indent-to column))))) + +(defun whitespace-unchecked-whitespaces () + "Return the list of whitespaces whose testing has been suppressed." + (let ((unchecked-spaces + (concat (if (not whitespace-check-buffer-ateol) "e") + (if (not whitespace-check-buffer-indent) "i") + (if (not whitespace-check-buffer-leading) "l") + (if (not whitespace-check-buffer-spacetab) "s") + (if (not whitespace-check-buffer-trailing) "t")))) + (if (not (equal unchecked-spaces "")) + unchecked-spaces + nil))) + +(defun whitespace-update-modeline (&optional whitespace-err) + "Update modeline with whitespace errors. +Also with whitespaces whose testing has been turned off." + (if whitespace-display-in-modeline + (progn + (setq whitespace-mode-line nil) + ;; Whitespace errors + (if (and whitespace-err (not (equal whitespace-err ""))) + (setq whitespace-mode-line whitespace-err)) + ;; Whitespace suppressed errors + (let ((whitespace-unchecked (whitespace-unchecked-whitespaces))) + (if whitespace-unchecked + (setq whitespace-mode-line + (concat whitespace-mode-line "!" whitespace-unchecked)))) + ;; Add the whitespace modeline prefix + (setq whitespace-mode-line (if whitespace-mode-line + (concat " W:" whitespace-mode-line) + nil)) + (whitespace-mode-line-update)))) + +(defun whitespace-highlight-the-space (b e) + "Highlight the current line, unhighlighting a previously jumped to line." + (if whitespace-display-spaces-in-color + (let ((ol (whitespace-make-overlay b e))) + (whitespace-overlay-put ol 'face 'whitespace-highlight)))) + +(defun whitespace-unhighlight-the-space() + "Unhighlight the currently highlight line." + (if (and whitespace-display-spaces-in-color whitespace-highlighted-space) + (progn + (mapc 'whitespace-delete-overlay whitespace-highlighted-space) + (setq whitespace-highlighted-space nil)))) + +(defun whitespace-check-buffer-list (buf-name buf-file) + "Add a buffer and its file to the whitespace monitor list. + +The buffer named BUF-NAME and its associated file BUF-FILE are now monitored +periodically for whitespace." + (if (and whitespace-mode (not (member (list buf-file buf-name) + whitespace-all-buffer-files))) + (add-to-list 'whitespace-all-buffer-files (list buf-file buf-name)))) + +(defun whitespace-tickle-timer () + "Tickle timer to periodically to scan qualifying files for whitespace creep. + +If timer is not set, then set it to scan the files in +`whitespace-all-buffer-files' periodically (defined by +`whitespace-rescan-timer-time') for whitespace creep." + (if (and whitespace-rescan-timer-time + (/= whitespace-rescan-timer-time 0) + (not whitespace-rescan-timer)) + (setq whitespace-rescan-timer + (add-timeout whitespace-rescan-timer-time + 'whitespace-rescan-files-in-buffers nil + whitespace-rescan-timer-time)))) + +(defun whitespace-rescan-files-in-buffers (&optional arg) + "Check monitored files for whitespace creep since last scan." + (let ((whitespace-all-my-files whitespace-all-buffer-files) + buffile bufname thiselt buf) + (if (not whitespace-all-my-files) + (progn + (disable-timeout whitespace-rescan-timer) + (setq whitespace-rescan-timer nil)) + (while whitespace-all-my-files + (setq thiselt (car whitespace-all-my-files)) + (setq whitespace-all-my-files (cdr whitespace-all-my-files)) + (setq buffile (car thiselt)) + (setq bufname (cadr thiselt)) + (setq buf (get-buffer bufname)) + (if (buffer-live-p buf) + (save-excursion + ;;(message "buffer %s live" bufname) + (set-buffer bufname) + (if whitespace-mode + (progn + ;;(message "checking for whitespace in %s" bufname) + (if whitespace-auto-cleanup + (progn + ;;(message "cleaning up whitespace in %s" bufname) + (whitespace-cleanup-internal)) + (progn + ;;(message "whitespace-buffer %s." (buffer-name)) + (whitespace-buffer t)))) + ;;(message "Removing %s from refresh list" bufname) + (whitespace-refresh-rescan-list buffile bufname))) + ;;(message "Removing %s from refresh list" bufname) + (whitespace-refresh-rescan-list buffile bufname)))))) + +(defun whitespace-refresh-rescan-list (buffile bufname) + "Refresh the list of files to be rescanned for whitespace creep." + (if whitespace-all-buffer-files + (setq whitespace-all-buffer-files + (delete (list buffile bufname) whitespace-all-buffer-files)) + (when whitespace-rescan-timer + (disable-timeout whitespace-rescan-timer) + (setq whitespace-rescan-timer nil)))) + +;;;###autoload +(defalias 'global-whitespace-mode 'whitespace-global-mode) + +;;;###autoload +(define-minor-mode whitespace-global-mode + "Toggle using Whitespace mode in new buffers. +With ARG, turn the mode on if ARG is positive, otherwise turn it off. + +When this mode is active, `whitespace-buffer' is added to +`find-file-hook' and `kill-buffer-hook'." + :global t + :group 'whitespace + (if whitespace-global-mode + (progn + (add-hook 'find-file-hook 'whitespace-buffer) + (add-hook 'write-file-functions 'whitespace-write-file-hook nil t) + (add-hook 'kill-buffer-hook 'whitespace-buffer)) + (remove-hook 'find-file-hook 'whitespace-buffer) + (remove-hook 'write-file-functions 'whitespace-write-file-hook t) + (remove-hook 'kill-buffer-hook 'whitespace-buffer))) + +;;;###autoload +(defun whitespace-write-file-hook () + "Hook function to be called on the buffer when whitespace check is enabled. +This is meant to be added buffer-locally to `write-file-functions'." + (let ((werr nil)) + (if whitespace-auto-cleanup + (whitespace-cleanup-internal) + (setq werr (whitespace-buffer))) + (if (and whitespace-abort-on-error werr) + (error "Abort write due to whitespaces in %s" + buffer-file-name))) + nil) + +(defun whitespace-unload-function () + "Unload the whitespace library." + (if (unintern "whitespace-unload-hook") + ;; if whitespace-unload-hook is defined, let's get rid of it + ;; and recursively call `unload-feature' + (progn (unload-feature 'whitespace) t) + ;; this only happens in the recursive call + (whitespace-global-mode -1) + (save-current-buffer + (dolist (buf (buffer-list)) + (set-buffer buf) + (remove-hook 'write-file-functions 'whitespace-write-file-hook t))) + ;; continue standard unloading + nil)) + +(defun whitespace-unload-hook () + (remove-hook 'find-file-hook 'whitespace-buffer) + (remove-hook 'write-file-functions 'whitespace-write-file-hook t) + (remove-hook 'kill-buffer-hook 'whitespace-buffer)) + +(add-hook 'whitespace-unload-hook 'whitespace-unload-hook) + +(provide 'whitespace) + +;; arch-tag: 4ff44e87-b63c-402d-95a6-15e51e58bd0c +;;; whitespace.el ends here
--- a/lisp/obsolete/whitespace.el Thu Jan 31 13:49:17 2008 +0000 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,814 +0,0 @@ -;;; whitespace.el --- warn about and clean bogus whitespaces in the file - -;; Copyright (C) 1999, 2000, 2001, 2002, 2003, 2004, -;; 2005, 2006, 2007, 2008 Free Software Foundation, Inc. - -;; Author: Rajesh Vaidheeswarran <rv@gnu.org> -;; Keywords: convenience - -;; 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 3, 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. - -;;; Commentary: -;; -;; URL: http://www.dsmit.com/lisp/ -;; -;; The whitespace library is intended to find and help fix five different types -;; of whitespace problems that commonly exist in source code. -;; -;; 1. Leading space (empty lines at the top of a file). -;; 2. Trailing space (empty lines at the end of a file). -;; 3. Indentation space (8 or more spaces at beginning of line, that should be -;; replaced with TABS). -;; 4. Spaces followed by a TAB. (Almost always, we never want that). -;; 5. Spaces or TABS at the end of a line. -;; -;; Whitespace errors are reported in a buffer, and on the modeline. -;; -;; Modeline will show a W:<x>!<y> to denote a particular type of whitespace, -;; where `x' and `y' can be one (or more) of: -;; -;; e - End-of-Line whitespace. -;; i - Indentation whitespace. -;; l - Leading whitespace. -;; s - Space followed by Tab. -;; t - Trailing whitespace. -;; -;; If any of the whitespace checks is turned off, the modeline will display a -;; !<y>. -;; -;; (since (3) is the most controversial one, here is the rationale: Most -;; terminal drivers and printer drivers have TAB configured or even -;; hardcoded to be 8 spaces. (Some of them allow configuration, but almost -;; always they default to 8.) -;; -;; Changing `tab-width' to other than 8 and editing will cause your code to -;; look different from within Emacs, and say, if you cat it or more it, or -;; even print it. -;; -;; Almost all the popular programming modes let you define an offset (like -;; c-basic-offset or perl-indent-level) to configure the offset, so you -;; should never have to set your `tab-width' to be other than 8 in all -;; these modes. In fact, with an indent level of say, 4, 2 TABS will cause -;; Emacs to replace your 8 spaces with one \t (try it). If vi users in -;; your office complain, tell them to use vim, which distinguishes between -;; tabstop and shiftwidth (vi equivalent of our offsets), and also ask them -;; to set smarttab.) -;; -;; All the above have caused (and will cause) unwanted codeline integration and -;; merge problems. -;; -;; whitespace.el will complain if it detects whitespaces on opening a file, and -;; warn you on closing a file also (in case you had inserted any -;; whitespaces during the process of your editing). -;; -;; Exported functions: -;; -;; `whitespace-buffer' - To check the current buffer for whitespace problems. -;; `whitespace-cleanup' - To cleanup all whitespaces in the current buffer. -;; `whitespace-region' - To check between point and mark for whitespace -;; problems. -;; `whitespace-cleanup-region' - To cleanup all whitespaces between point -;; and mark in the current buffer. - -;;; Code: - -(defvar whitespace-version "3.5" "Version of the whitespace library.") - -(defvar whitespace-all-buffer-files nil - "An associated list of buffers and files checked for whitespace cleanliness. - -This is to enable periodic checking of whitespace cleanliness in the files -visited by the buffers.") - -(defvar whitespace-rescan-timer nil - "Timer object used to rescan the files in buffers that have been modified.") - -;; Tell Emacs about this new kind of minor mode -(defvar whitespace-mode nil - "Non-nil when Whitespace mode (a minor mode) is enabled.") -(make-variable-buffer-local 'whitespace-mode) - -(defvar whitespace-mode-line nil - "String to display in the mode line for Whitespace mode.") -(make-variable-buffer-local 'whitespace-mode-line) - -(defvar whitespace-check-buffer-leading nil - "Test leading whitespace for file in current buffer if t.") -(make-variable-buffer-local 'whitespace-check-buffer-leading) -;;;###autoload(put 'whitespace-check-buffer-leading 'safe-local-variable 'booleanp) - -(defvar whitespace-check-buffer-trailing nil - "Test trailing whitespace for file in current buffer if t.") -(make-variable-buffer-local 'whitespace-check-buffer-trailing) -;;;###autoload(put 'whitespace-check-buffer-trailing 'safe-local-variable 'booleanp) - -(defvar whitespace-check-buffer-indent nil - "Test indentation whitespace for file in current buffer if t.") -(make-variable-buffer-local 'whitespace-check-buffer-indent) -;;;###autoload(put 'whitespace-check-buffer-indent 'safe-local-variable 'booleanp) - -(defvar whitespace-check-buffer-spacetab nil - "Test Space-followed-by-TABS whitespace for file in current buffer if t.") -(make-variable-buffer-local 'whitespace-check-buffer-spacetab) -;;;###autoload(put 'whitespace-check-buffer-spacetab 'safe-local-variable 'booleanp) - -(defvar whitespace-check-buffer-ateol nil - "Test end-of-line whitespace for file in current buffer if t.") -(make-variable-buffer-local 'whitespace-check-buffer-ateol) -;;;###autoload(put 'whitespace-check-buffer-ateol 'safe-local-variable 'booleanp) - -(defvar whitespace-highlighted-space nil - "The variable to store the extent to highlight.") -(make-variable-buffer-local 'whitespace-highlighted-space) - -(defalias 'whitespace-make-overlay - (if (featurep 'xemacs) 'make-extent 'make-overlay)) -(defalias 'whitespace-overlay-put - (if (featurep 'xemacs) 'set-extent-property 'overlay-put)) -(defalias 'whitespace-delete-overlay - (if (featurep 'xemacs) 'delete-extent 'delete-overlay)) -(defalias 'whitespace-overlay-start - (if (featurep 'xemacs) 'extent-start 'overlay-start)) -(defalias 'whitespace-overlay-end - (if (featurep 'xemacs) 'extent-end 'overlay-end)) -(defalias 'whitespace-mode-line-update - (if (featurep 'xemacs) 'redraw-modeline 'force-mode-line-update)) - -(defgroup whitespace nil - "Check for and fix five different types of whitespaces in source code." - :version "21.1" - :link '(emacs-commentary-link "whitespace.el") - ;; Since XEmacs doesn't have a 'convenience group, use the next best group - ;; which is 'editing? - :group (if (featurep 'xemacs) 'editing 'convenience)) - -(defcustom whitespace-check-leading-whitespace t - "Flag to check leading whitespace. This is the global for the system. -It can be overridden by setting a buffer local variable -`whitespace-check-buffer-leading'." - :type 'boolean - :group 'whitespace) - -(defcustom whitespace-check-trailing-whitespace t - "Flag to check trailing whitespace. This is the global for the system. -It can be overridden by setting a buffer local variable -`whitespace-check-buffer-trailing'." - :type 'boolean - :group 'whitespace) - -(defcustom whitespace-check-spacetab-whitespace t - "Flag to check space followed by a TAB. This is the global for the system. -It can be overridden by setting a buffer local variable -`whitespace-check-buffer-spacetab'." - :type 'boolean - :group 'whitespace) - -(defcustom whitespace-spacetab-regexp "[ ]+\t" - "Regexp to match one or more spaces followed by a TAB." - :type 'regexp - :group 'whitespace) - -(defcustom whitespace-check-indent-whitespace indent-tabs-mode - "Flag to check indentation whitespace. This is the global for the system. -It can be overridden by setting a buffer local variable -`whitespace-check-buffer-indent'." - :type 'boolean - :group 'whitespace) - -(defcustom whitespace-indent-regexp "^\t*\\( \\)+" - "Regexp to match multiples of eight spaces near line beginnings. -The default value ignores leading TABs." - :type 'regexp - :group 'whitespace) - -(defcustom whitespace-check-ateol-whitespace t - "Flag to check end-of-line whitespace. This is the global for the system. -It can be overridden by setting a buffer local variable -`whitespace-check-buffer-ateol'." - :type 'boolean - :group 'whitespace) - -(defcustom whitespace-ateol-regexp "[ \t]+$" - "Regexp to match one or more TABs or spaces at line ends." - :type 'regexp - :group 'whitespace) - -(defcustom whitespace-errbuf "*Whitespace Errors*" - "The name of the buffer where whitespace related messages will be logged." - :type 'string - :group 'whitespace) - -(defcustom whitespace-clean-msg "clean." - "If non-nil, this message will be displayed after a whitespace check -determines a file to be clean." - :type 'string - :group 'whitespace) - -(defcustom whitespace-abort-on-error nil - "While writing a file, abort if the file is unclean. -If `whitespace-auto-cleanup' is set, that takes precedence over -this variable." - :type 'boolean - :group 'whitespace) - -(defcustom whitespace-auto-cleanup nil - "Cleanup a buffer automatically on finding it whitespace unclean." - :type 'boolean - :group 'whitespace) - -(defcustom whitespace-silent nil - "All whitespace errors will be shown only in the modeline when t. - -Note that setting this may cause all whitespaces introduced in a file to go -unnoticed when the buffer is killed, unless the user visits the `*Whitespace -Errors*' buffer before opening (or closing) another file." - :type 'boolean - :group 'whitespace) - -(defcustom whitespace-modes '(ada-mode asm-mode autoconf-mode awk-mode - c-mode c++-mode cc-mode - change-log-mode cperl-mode - electric-nroff-mode emacs-lisp-mode - f90-mode fortran-mode html-mode - html3-mode java-mode jde-mode - ksh-mode latex-mode LaTeX-mode - lisp-mode m4-mode makefile-mode - modula-2-mode nroff-mode objc-mode - pascal-mode perl-mode prolog-mode - python-mode scheme-mode sgml-mode - sh-mode shell-script-mode simula-mode - tcl-mode tex-mode texinfo-mode - vrml-mode xml-mode) - - "Major modes in which we turn on whitespace checking. - -These are mostly programming and documentation modes. But you may add other -modes that you want whitespaces checked in by adding something like the -following to your `.emacs': - -\(setq whitespace-modes (cons 'my-mode (cons 'my-other-mode - whitespace-modes))\) - -Or, alternately, you can use the Emacs `customize' command to set this." - :type '(repeat symbol) - :group 'whitespace) - -(defcustom whitespace-rescan-timer-time 600 - "Period in seconds to rescan modified buffers for whitespace creep. - -This is the period after which the timer will fire causing -`whitespace-rescan-files-in-buffers' to check for whitespace creep in -modified buffers. - -To disable timer scans, set this to zero." - :type 'integer - :group 'whitespace) - -(defcustom whitespace-display-in-modeline t - "Display whitespace errors on the modeline." - :type 'boolean - :group 'whitespace) - -(defcustom whitespace-display-spaces-in-color t - "Display the bogus whitespaces by coloring them with the face -`whitespace-highlight'." - :type 'boolean - :group 'whitespace) - -(defgroup whitespace-faces nil - "Faces used in whitespace." - :prefix "whitespace-" - :group 'whitespace - :group 'faces) - -(defface whitespace-highlight '((((class color) (background light)) - (:background "green1")) - (((class color) (background dark)) - (:background "sea green")) - (((class grayscale mono) - (background light)) - (:background "black")) - (((class grayscale mono) - (background dark)) - (:background "white"))) - "Face used for highlighting the bogus whitespaces that exist in the buffer." - :group 'whitespace-faces) -;; backward-compatibility alias -(put 'whitespace-highlight-face 'face-alias 'whitespace-highlight) - -(if (not (assoc 'whitespace-mode minor-mode-alist)) - (setq minor-mode-alist (cons '(whitespace-mode whitespace-mode-line) - minor-mode-alist))) - -(set-default 'whitespace-check-buffer-leading - whitespace-check-leading-whitespace) -(set-default 'whitespace-check-buffer-trailing - whitespace-check-trailing-whitespace) -(set-default 'whitespace-check-buffer-indent - whitespace-check-indent-whitespace) -(set-default 'whitespace-check-buffer-spacetab - whitespace-check-spacetab-whitespace) -(set-default 'whitespace-check-buffer-ateol - whitespace-check-ateol-whitespace) - -(defun whitespace-check-whitespace-mode (&optional arg) - "Test and set the whitespace-mode in qualifying buffers." - (if (null whitespace-mode) - (setq whitespace-mode - (if (or arg (member major-mode whitespace-modes)) - t - nil)))) - -;;;###autoload -(defun whitespace-toggle-leading-check () - "Toggle the check for leading space in the local buffer." - (interactive) - (let ((current-val whitespace-check-buffer-leading)) - (setq whitespace-check-buffer-leading (not current-val)) - (message "Will%s check for leading space in buffer." - (if whitespace-check-buffer-leading "" " not")) - (if whitespace-check-buffer-leading (whitespace-buffer-leading)))) - -;;;###autoload -(defun whitespace-toggle-trailing-check () - "Toggle the check for trailing space in the local buffer." - (interactive) - (let ((current-val whitespace-check-buffer-trailing)) - (setq whitespace-check-buffer-trailing (not current-val)) - (message "Will%s check for trailing space in buffer." - (if whitespace-check-buffer-trailing "" " not")) - (if whitespace-check-buffer-trailing (whitespace-buffer-trailing)))) - -;;;###autoload -(defun whitespace-toggle-indent-check () - "Toggle the check for indentation space in the local buffer." - (interactive) - (let ((current-val whitespace-check-buffer-indent)) - (setq whitespace-check-buffer-indent (not current-val)) - (message "Will%s check for indentation space in buffer." - (if whitespace-check-buffer-indent "" " not")) - (if whitespace-check-buffer-indent - (whitespace-buffer-search whitespace-indent-regexp)))) - -;;;###autoload -(defun whitespace-toggle-spacetab-check () - "Toggle the check for space-followed-by-TABs in the local buffer." - (interactive) - (let ((current-val whitespace-check-buffer-spacetab)) - (setq whitespace-check-buffer-spacetab (not current-val)) - (message "Will%s check for space-followed-by-TABs in buffer." - (if whitespace-check-buffer-spacetab "" " not")) - (if whitespace-check-buffer-spacetab - (whitespace-buffer-search whitespace-spacetab-regexp)))) - - -;;;###autoload -(defun whitespace-toggle-ateol-check () - "Toggle the check for end-of-line space in the local buffer." - (interactive) - (let ((current-val whitespace-check-buffer-ateol)) - (setq whitespace-check-buffer-ateol (not current-val)) - (message "Will%s check for end-of-line space in buffer." - (if whitespace-check-buffer-ateol "" " not")) - (if whitespace-check-buffer-ateol - (whitespace-buffer-search whitespace-ateol-regexp)))) - - -;;;###autoload -(defun whitespace-buffer (&optional quiet) - "Find five different types of white spaces in buffer. -These are: -1. Leading space \(empty lines at the top of a file\). -2. Trailing space \(empty lines at the end of a file\). -3. Indentation space \(8 or more spaces, that should be replaced with TABS\). -4. Spaces followed by a TAB. \(Almost always, we never want that\). -5. Spaces or TABS at the end of a line. - -Check for whitespace only if this buffer really contains a non-empty file -and: -1. the major mode is one of the whitespace-modes, or -2. `whitespace-buffer' was explicitly called with a prefix argument." - (interactive) - (let ((whitespace-error nil)) - (whitespace-check-whitespace-mode current-prefix-arg) - (if (and buffer-file-name (> (buffer-size) 0) whitespace-mode) - (progn - (whitespace-check-buffer-list (buffer-name) buffer-file-name) - (whitespace-tickle-timer) - (overlay-recenter (point-max)) - (remove-overlays nil nil 'face 'whitespace-highlight) - (if whitespace-auto-cleanup - (if buffer-read-only - (if (not quiet) - (message "Can't cleanup: %s is read-only" (buffer-name))) - (whitespace-cleanup-internal)) - (let ((whitespace-leading (if whitespace-check-buffer-leading - (whitespace-buffer-leading) - nil)) - (whitespace-trailing (if whitespace-check-buffer-trailing - (whitespace-buffer-trailing) - nil)) - (whitespace-indent (if whitespace-check-buffer-indent - (whitespace-buffer-search - whitespace-indent-regexp) - nil)) - (whitespace-spacetab (if whitespace-check-buffer-spacetab - (whitespace-buffer-search - whitespace-spacetab-regexp) - nil)) - (whitespace-ateol (if whitespace-check-buffer-ateol - (whitespace-buffer-search - whitespace-ateol-regexp) - nil)) - (whitespace-errmsg nil) - (whitespace-filename buffer-file-name) - (whitespace-this-modeline "")) - - ;; Now let's complain if we found any of the above. - (setq whitespace-error (or whitespace-leading whitespace-indent - whitespace-spacetab whitespace-ateol - whitespace-trailing)) - - (if whitespace-error - (progn - (setq whitespace-errmsg - (concat whitespace-filename " contains:\n" - (if whitespace-leading - "Leading whitespace\n") - (if whitespace-indent - (concat "Indentation whitespace" - whitespace-indent "\n")) - (if whitespace-spacetab - (concat "Space followed by Tab" - whitespace-spacetab "\n")) - (if whitespace-ateol - (concat "End-of-line whitespace" - whitespace-ateol "\n")) - (if whitespace-trailing - "Trailing whitespace\n") - "\ntype `M-x whitespace-cleanup' to " - "cleanup the file.")) - (setq whitespace-this-modeline - (concat (if whitespace-ateol "e") - (if whitespace-indent "i") - (if whitespace-leading "l") - (if whitespace-spacetab "s") - (if whitespace-trailing "t"))))) - (whitespace-update-modeline whitespace-this-modeline) - (if (get-buffer whitespace-errbuf) - (kill-buffer whitespace-errbuf)) - (with-current-buffer (get-buffer-create whitespace-errbuf) - (if whitespace-errmsg - (progn - (insert whitespace-errmsg) - (if (not (or quiet whitespace-silent)) - (display-buffer (current-buffer) t)) - (if (not quiet) - (message "Whitespaces: [%s%s] in %s" - whitespace-this-modeline - (let ((whitespace-unchecked - (whitespace-unchecked-whitespaces))) - (if whitespace-unchecked - (concat "!" whitespace-unchecked) - "")) - whitespace-filename))) - (if (and (not quiet) (not (equal whitespace-clean-msg ""))) - (message "%s %s" whitespace-filename - whitespace-clean-msg)))))))) - whitespace-error)) - -;;;###autoload -(defun whitespace-region (s e) - "Check the region for whitespace errors." - (interactive "r") - (save-excursion - (save-restriction - (narrow-to-region s e) - (whitespace-buffer)))) - -;;;###autoload -(defun whitespace-cleanup () - "Cleanup the five different kinds of whitespace problems. -It normally applies to the whole buffer, but in Transient Mark mode -when the mark is active it applies to the region. -See `whitespace-buffer' docstring for a summary of the problems." - (interactive) - (if (and transient-mark-mode mark-active) - (whitespace-cleanup-region (region-beginning) (region-end)) - (whitespace-cleanup-internal))) - -(defun whitespace-cleanup-internal (&optional region-only) - ;; If this buffer really contains a file, then run, else quit. - (whitespace-check-whitespace-mode current-prefix-arg) - (if (and buffer-file-name whitespace-mode) - (let ((whitespace-any nil) - (whitespace-tabwith 8) - (whitespace-tabwith-saved tab-width)) - - ;; since all printable TABS should be 8, irrespective of how - ;; they are displayed. - (setq tab-width whitespace-tabwith) - - (if (and whitespace-check-buffer-leading - (whitespace-buffer-leading)) - (progn - (whitespace-buffer-leading-cleanup) - (setq whitespace-any t))) - - (if (and whitespace-check-buffer-trailing - (whitespace-buffer-trailing)) - (progn - (whitespace-buffer-trailing-cleanup) - (setq whitespace-any t))) - - (if (and whitespace-check-buffer-indent - (whitespace-buffer-search whitespace-indent-regexp)) - (progn - (whitespace-indent-cleanup) - (setq whitespace-any t))) - - (if (and whitespace-check-buffer-spacetab - (whitespace-buffer-search whitespace-spacetab-regexp)) - (progn - (whitespace-buffer-cleanup whitespace-spacetab-regexp "\t") - (setq whitespace-any t))) - - (if (and whitespace-check-buffer-ateol - (whitespace-buffer-search whitespace-ateol-regexp)) - (progn - (whitespace-buffer-cleanup whitespace-ateol-regexp "") - (setq whitespace-any t))) - - ;; Call this recursively till everything is taken care of - (if whitespace-any - (whitespace-cleanup-internal region-only) - ;; if we are done, talk to the user - (progn - (unless whitespace-silent - (if region-only - (message "The region is now clean") - (message "%s is now clean" buffer-file-name))) - (whitespace-update-modeline))) - (setq tab-width whitespace-tabwith-saved)))) - -;;;###autoload -(defun whitespace-cleanup-region (s e) - "Whitespace cleanup on the region." - (interactive "r") - (save-excursion - (save-restriction - (narrow-to-region s e) - (whitespace-cleanup-internal t)) - (whitespace-buffer t))) - -(defun whitespace-buffer-leading () - "Return t if the current buffer has leading newline characters. -If highlighting is enabled, highlight these characters." - (save-excursion - (goto-char (point-min)) - (skip-chars-forward "\n") - (unless (bobp) - (whitespace-highlight-the-space (point-min) (point)) - t))) - -(defun whitespace-buffer-leading-cleanup () - "Remove any leading newline characters from current buffer." - (save-excursion - (goto-char (point-min)) - (skip-chars-forward "\n") - (delete-region (point-min) (point)))) - -(defun whitespace-buffer-trailing () - "Return t if the current buffer has extra trailing newline characters. -If highlighting is enabled, highlight these characters." - (save-excursion - (goto-char (point-max)) - (skip-chars-backward "\n") - (forward-line) - (unless (eobp) - (whitespace-highlight-the-space (point) (point-max)) - t))) - -(defun whitespace-buffer-trailing-cleanup () - "Remove extra trailing newline characters from current buffer." - (save-excursion - (goto-char (point-max)) - (skip-chars-backward "\n") - (unless (eobp) - (forward-line) - (delete-region (point) (point-max))))) - -(defun whitespace-buffer-search (regexp) - "Search for any given whitespace REGEXP." - (with-local-quit - (let (whitespace-retval) - (save-excursion - (goto-char (point-min)) - (while (re-search-forward regexp nil t) - (whitespace-highlight-the-space (match-beginning 0) (match-end 0)) - (push (match-beginning 0) whitespace-retval))) - (when whitespace-retval - (format " %s" (nreverse whitespace-retval)))))) - -(defun whitespace-buffer-cleanup (regexp newregexp) - "Search for any given whitespace REGEXP and replace it with the NEWREGEXP." - (save-excursion - (goto-char (point-min)) - (while (re-search-forward regexp nil t) - (replace-match newregexp)))) - -(defun whitespace-indent-cleanup () - "Search for 8/more spaces at the start of a line and replace it with tabs." - (save-excursion - (goto-char (point-min)) - (while (re-search-forward whitespace-indent-regexp nil t) - (let ((column (current-column)) - (indent-tabs-mode t)) - (delete-region (match-beginning 0) (point)) - (indent-to column))))) - -(defun whitespace-unchecked-whitespaces () - "Return the list of whitespaces whose testing has been suppressed." - (let ((unchecked-spaces - (concat (if (not whitespace-check-buffer-ateol) "e") - (if (not whitespace-check-buffer-indent) "i") - (if (not whitespace-check-buffer-leading) "l") - (if (not whitespace-check-buffer-spacetab) "s") - (if (not whitespace-check-buffer-trailing) "t")))) - (if (not (equal unchecked-spaces "")) - unchecked-spaces - nil))) - -(defun whitespace-update-modeline (&optional whitespace-err) - "Update modeline with whitespace errors. -Also with whitespaces whose testing has been turned off." - (if whitespace-display-in-modeline - (progn - (setq whitespace-mode-line nil) - ;; Whitespace errors - (if (and whitespace-err (not (equal whitespace-err ""))) - (setq whitespace-mode-line whitespace-err)) - ;; Whitespace suppressed errors - (let ((whitespace-unchecked (whitespace-unchecked-whitespaces))) - (if whitespace-unchecked - (setq whitespace-mode-line - (concat whitespace-mode-line "!" whitespace-unchecked)))) - ;; Add the whitespace modeline prefix - (setq whitespace-mode-line (if whitespace-mode-line - (concat " W:" whitespace-mode-line) - nil)) - (whitespace-mode-line-update)))) - -(defun whitespace-highlight-the-space (b e) - "Highlight the current line, unhighlighting a previously jumped to line." - (if whitespace-display-spaces-in-color - (let ((ol (whitespace-make-overlay b e))) - (whitespace-overlay-put ol 'face 'whitespace-highlight)))) - -(defun whitespace-unhighlight-the-space() - "Unhighlight the currently highlight line." - (if (and whitespace-display-spaces-in-color whitespace-highlighted-space) - (progn - (mapc 'whitespace-delete-overlay whitespace-highlighted-space) - (setq whitespace-highlighted-space nil)))) - -(defun whitespace-check-buffer-list (buf-name buf-file) - "Add a buffer and its file to the whitespace monitor list. - -The buffer named BUF-NAME and its associated file BUF-FILE are now monitored -periodically for whitespace." - (if (and whitespace-mode (not (member (list buf-file buf-name) - whitespace-all-buffer-files))) - (add-to-list 'whitespace-all-buffer-files (list buf-file buf-name)))) - -(defun whitespace-tickle-timer () - "Tickle timer to periodically to scan qualifying files for whitespace creep. - -If timer is not set, then set it to scan the files in -`whitespace-all-buffer-files' periodically (defined by -`whitespace-rescan-timer-time') for whitespace creep." - (if (and whitespace-rescan-timer-time - (/= whitespace-rescan-timer-time 0) - (not whitespace-rescan-timer)) - (setq whitespace-rescan-timer - (add-timeout whitespace-rescan-timer-time - 'whitespace-rescan-files-in-buffers nil - whitespace-rescan-timer-time)))) - -(defun whitespace-rescan-files-in-buffers (&optional arg) - "Check monitored files for whitespace creep since last scan." - (let ((whitespace-all-my-files whitespace-all-buffer-files) - buffile bufname thiselt buf) - (if (not whitespace-all-my-files) - (progn - (disable-timeout whitespace-rescan-timer) - (setq whitespace-rescan-timer nil)) - (while whitespace-all-my-files - (setq thiselt (car whitespace-all-my-files)) - (setq whitespace-all-my-files (cdr whitespace-all-my-files)) - (setq buffile (car thiselt)) - (setq bufname (cadr thiselt)) - (setq buf (get-buffer bufname)) - (if (buffer-live-p buf) - (save-excursion - ;;(message "buffer %s live" bufname) - (set-buffer bufname) - (if whitespace-mode - (progn - ;;(message "checking for whitespace in %s" bufname) - (if whitespace-auto-cleanup - (progn - ;;(message "cleaning up whitespace in %s" bufname) - (whitespace-cleanup-internal)) - (progn - ;;(message "whitespace-buffer %s." (buffer-name)) - (whitespace-buffer t)))) - ;;(message "Removing %s from refresh list" bufname) - (whitespace-refresh-rescan-list buffile bufname))) - ;;(message "Removing %s from refresh list" bufname) - (whitespace-refresh-rescan-list buffile bufname)))))) - -(defun whitespace-refresh-rescan-list (buffile bufname) - "Refresh the list of files to be rescanned for whitespace creep." - (if whitespace-all-buffer-files - (setq whitespace-all-buffer-files - (delete (list buffile bufname) whitespace-all-buffer-files)) - (when whitespace-rescan-timer - (disable-timeout whitespace-rescan-timer) - (setq whitespace-rescan-timer nil)))) - -;;;###autoload -(defalias 'global-whitespace-mode 'whitespace-global-mode) - -;;;###autoload -(define-minor-mode whitespace-global-mode - "Toggle using Whitespace mode in new buffers. -With ARG, turn the mode on if ARG is positive, otherwise turn it off. - -When this mode is active, `whitespace-buffer' is added to -`find-file-hook' and `kill-buffer-hook'." - :global t - :group 'whitespace - (if whitespace-global-mode - (progn - (add-hook 'find-file-hook 'whitespace-buffer) - (add-hook 'write-file-functions 'whitespace-write-file-hook nil t) - (add-hook 'kill-buffer-hook 'whitespace-buffer)) - (remove-hook 'find-file-hook 'whitespace-buffer) - (remove-hook 'write-file-functions 'whitespace-write-file-hook t) - (remove-hook 'kill-buffer-hook 'whitespace-buffer))) - -;;;###autoload -(defun whitespace-write-file-hook () - "Hook function to be called on the buffer when whitespace check is enabled. -This is meant to be added buffer-locally to `write-file-functions'." - (let ((werr nil)) - (if whitespace-auto-cleanup - (whitespace-cleanup-internal) - (setq werr (whitespace-buffer))) - (if (and whitespace-abort-on-error werr) - (error "Abort write due to whitespaces in %s" - buffer-file-name))) - nil) - -(defun whitespace-unload-function () - "Unload the whitespace library." - (if (unintern "whitespace-unload-hook") - ;; if whitespace-unload-hook is defined, let's get rid of it - ;; and recursively call `unload-feature' - (progn (unload-feature 'whitespace) t) - ;; this only happens in the recursive call - (whitespace-global-mode -1) - (save-current-buffer - (dolist (buf (buffer-list)) - (set-buffer buf) - (remove-hook 'write-file-functions 'whitespace-write-file-hook t))) - ;; continue standard unloading - nil)) - -(defun whitespace-unload-hook () - (remove-hook 'find-file-hook 'whitespace-buffer) - (remove-hook 'write-file-functions 'whitespace-write-file-hook t) - (remove-hook 'kill-buffer-hook 'whitespace-buffer)) - -(add-hook 'whitespace-unload-hook 'whitespace-unload-hook) - -(provide 'whitespace) - -;; arch-tag: 4ff44e87-b63c-402d-95a6-15e51e58bd0c -;;; whitespace.el ends here
--- a/lisp/progmodes/grep.el Thu Jan 31 13:49:17 2008 +0000 +++ b/lisp/progmodes/grep.el Fri Feb 01 03:01:11 2008 +0000 @@ -408,7 +408,7 @@ (grep-find-use-xargs ,grep-find-use-xargs) (grep-highlight-matches ,grep-highlight-matches))))) (let* ((host-id - (intern (or (file-remote-p default-directory 'host) "localhost"))) + (intern (or (file-remote-p default-directory) "localhost"))) (host-defaults (assq host-id grep-host-defaults-alist)) (defaults (assq nil grep-host-defaults-alist))) ;; There are different defaults on different hosts. They must be
--- a/lisp/w32-fns.el Thu Jan 31 13:49:17 2008 +0000 +++ b/lisp/w32-fns.el Fri Feb 01 03:01:11 2008 +0000 @@ -379,9 +379,9 @@ (w32-add-charset-info "jisx0208" 'w32-charset-shiftjis 932) (w32-add-charset-info "jisx0201-latin" 'w32-charset-shiftjis 932) (w32-add-charset-info "jisx0201-katakana" 'w32-charset-shiftjis 932) -(w32-add-charset-info "ksc5601.1989-1" 'w32-charset-hangeul 949) -(w32-add-charset-info "big5-1" 'w32-charset-chinesebig5 950) -(w32-add-charset-info "gb2312.1980-1" 'w32-charset-gb2312 936) +(w32-add-charset-info "ksc5601.1989" 'w32-charset-hangeul 949) +(w32-add-charset-info "big5" 'w32-charset-chinesebig5 950) +(w32-add-charset-info "gb2312.1980" 'w32-charset-gb2312 936) (w32-add-charset-info "ms-symbol" 'w32-charset-symbol nil) (w32-add-charset-info "ms-oem" 'w32-charset-oem 437) (w32-add-charset-info "ms-oemlatin" 'w32-charset-oem 850) @@ -397,8 +397,8 @@ (w32-add-charset-info "iso8859-13" 'w32-charset-baltic 1257) (w32-add-charset-info "koi8-r" 'w32-charset-russian 20866) (w32-add-charset-info "iso8859-5" 'w32-charset-russian 28595) - (w32-add-charset-info "tis620-1" 'w32-charset-thai 874) - (w32-add-charset-info "ksc5601.1992-1" 'w32-charset-johab 1361) + (w32-add-charset-info "tis620" 'w32-charset-thai 874) + (w32-add-charset-info "ksc5601.1992" 'w32-charset-johab 1361) (w32-add-charset-info "mac-roman" 'w32-charset-mac 10000))) (if (boundp 'w32-unicode-charset-defined) (progn
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/lisp/whitespace.el Fri Feb 01 03:01:11 2008 +0000 @@ -0,0 +1,1767 @@ +;;; whitespace.el --- minor mode to visualize TAB, (HARD) SPACE, NEWLINE + +;; Copyright (C) 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008 +;; Free Software Foundation, Inc. + +;; Author: Vinicius Jose Latorre <viniciusjl@ig.com.br> +;; Maintainer: Vinicius Jose Latorre <viniciusjl@ig.com.br> +;; Keywords: data, wp +;; Version: 9.2 +;; X-URL: http://www.emacswiki.org/cgi-bin/wiki/ViniciusJoseLatorre + +;; 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 3, 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. + +;;; Commentary: + +;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; +;; Introduction +;; ------------ +;; +;; This package is a minor mode to visualize blanks (TAB, (HARD) SPACE +;; and NEWLINE). +;; +;; whitespace uses two ways to visualize blanks: faces and display +;; table. +;; +;; * Faces are used to highlight the background with a color. +;; whitespace uses font-lock to highlight blank characters. +;; +;; * Display table changes the way a character is displayed, that is, +;; it provides a visual mark for characters, for example, at the end +;; of line (?\xB6), at SPACEs (?\xB7) and at TABs (?\xBB). +;; +;; The `whitespace-style' and `whitespace-chars' variables are used to +;; select which way should be used to visualize blanks. +;; +;; Note that when whitespace is turned on, whitespace saves the +;; font-lock state, that is, if font-lock is on or off. And +;; whitespace restores the font-lock state when it is turned off. So, +;; if whitespace is turned on and font-lock is off, whitespace also +;; turns on the font-lock to highlight blanks, but the font-lock will +;; be turned off when whitespace is turned off. Thus, turn on +;; font-lock before whitespace is on, if you want that font-lock +;; continues on after whitespace is turned off. +;; +;; When whitespace is on, it takes care of highlighting some special +;; characters over the default mechanism of `nobreak-char-display' +;; (which see) and `show-trailing-whitespace' (which see). +;; +;; There are two ways of using whitespace: local and global. +;; +;; * Local whitespace affects only the current buffer. +;; +;; * Global whitespace affects all current and future buffers. That +;; is, if you turn on global whitespace and then create a new +;; buffer, the new buffer will also have whitespace on. The +;; `whitespace-global-modes' variable controls which major-mode will +;; be automagically turned on. +;; +;; You can mix the local and global usage without any conflict. But +;; local whitespace has priority over global whitespace. Whitespace +;; mode is active in a buffer if you have enabled it in that buffer or +;; if you have enabled it globally. +;; +;; When global and local whitespace are on: +;; +;; * if local whitespace is turned off, whitespace is turned off for +;; the current buffer only. +;; +;; * if global whitespace is turned off, whitespace continues on only +;; in the buffers in which local whitespace is on. +;; +;; To use whitespace, insert in your ~/.emacs: +;; +;; (require 'whitespace-mode) +;; +;; Or autoload at least one of the commands`whitespace-mode', +;; `whitespace-toggle-options', `global-whitespace-mode' or +;; `global-whitespace-toggle-options'. For example: +;; +;; (autoload 'whitespace-mode "whitespace" +;; "Toggle whitespace visualization." t) +;; (autoload 'whitespace-toggle-options "whitespace" +;; "Toggle local `whitespace-mode' options." t) +;; +;; whitespace was inspired by: +;; +;; whitespace.el Rajesh Vaidheeswarran <rv@gnu.org> +;; Warn about and clean bogus whitespaces in the file +;; (inspired the idea to warn and clean some blanks) +;; This was the original `whitespace.el' which was replaced by +;; `blank-mode.el'. And later `blank-mode.el' was renamed to +;; `whitespace.el'. +;; +;; show-whitespace-mode.el Aurelien Tisne <aurelien.tisne@free.fr> +;; Simple mode to highlight whitespaces +;; (inspired the idea to use font-lock) +;; +;; whitespace-mode.el Lawrence Mitchell <wence@gmx.li> +;; Major mode for editing Whitespace +;; (inspired the idea to use display table) +;; +;; visws.el Miles Bader <miles@gnu.org> +;; Make whitespace visible +;; (handle display table, his code was modified, but the main +;; idea was kept) +;; +;; +;; Using whitespace +;; ---------------- +;; +;; There is no problem if you mix local and global minor mode usage. +;; +;; * LOCAL whitespace: +;; + To toggle whitespace options locally, type: +;; +;; M-x whitespace-toggle-options RET +;; +;; + To activate whitespace locally, type: +;; +;; C-u 1 M-x whitespace-mode RET +;; +;; + To deactivate whitespace locally, type: +;; +;; C-u 0 M-x whitespace-mode RET +;; +;; + To toggle whitespace locally, type: +;; +;; M-x whitespace-mode RET +;; +;; * GLOBAL whitespace: +;; + To toggle whitespace options globally, type: +;; +;; M-x global-whitespace-toggle-options RET +;; +;; + To activate whitespace globally, type: +;; +;; C-u 1 M-x global-whitespace-mode RET +;; +;; + To deactivate whitespace globally, type: +;; +;; C-u 0 M-x global-whitespace-mode RET +;; +;; + To toggle whitespace globally, type: +;; +;; M-x global-whitespace-mode RET +;; +;; There are also the following useful commands: +;; +;; `whitespace-cleanup' +;; Cleanup some blank problems in all buffer or at region. +;; +;; `whitespace-cleanup-region' +;; Cleanup some blank problems at region. +;; +;; `whitespace-buffer' +;; Turn on `whitespace-mode' forcing some settings. +;; +;; The problems, which are cleaned up, are: +;; +;; 1. empty lines at beginning of buffer. +;; 2. empty lines at end of buffer. +;; If `whitespace-chars' has `empty' as an element, remove all +;; empty lines at beginning and/or end of buffer. +;; +;; 3. 8 or more SPACEs at beginning of line. +;; If `whitespace-chars' has `indentation' as an element, replace 8 +;; or more SPACEs at beginning of line by TABs. +;; +;; 4. SPACEs before TAB. +;; If `whitespace-chars' has `space-before-tab' as an element, +;; replace SPACEs by TABs. +;; +;; 5. SPACEs or TABs at end of line. +;; If `whitespace-chars' has `trailing' as an element, remove all +;; SPACEs or TABs at end of line." +;; +;; 6. 8 or more SPACEs after TAB. +;; If `whitespace-chars' has `space-after-tab' as an element, +;; replace SPACEs by TABs. +;; +;; +;; Hooks +;; ----- +;; +;; whitespace has the following hook variables: +;; +;; `whitespace-mode-hook' +;; It is evaluated always when whitespace is turned on locally. +;; +;; `global-whitespace-mode-hook' +;; It is evaluated always when whitespace is turned on globally. +;; +;; `whitespace-load-hook' +;; It is evaluated after whitespace package is loaded. +;; +;; +;; Options +;; ------- +;; +;; Below it's shown a brief description of whitespace options, please, +;; see the options declaration in the code for a long documentation. +;; +;; `whitespace-style' Specify the visualization style. +;; +;; `whitespace-chars' Specify which kind of blank is +;; visualized. +;; +;; `whitespace-space' Face used to visualize SPACE. +;; +;; `whitespace-hspace' Face used to visualize HARD SPACE. +;; +;; `whitespace-tab' Face used to visualize TAB. +;; +;; `whitespace-newline' Face used to visualize NEWLINE char +;; mapping. +;; +;; `whitespace-trailing' Face used to visualize trailing +;; blanks. +;; +;; `whitespace-line' Face used to visualize "long" lines. +;; +;; `whitespace-space-before-tab' Face used to visualize SPACEs +;; before TAB. +;; +;; `whitespace-indentation' Face used to visualize 8 or more +;; SPACEs at beginning of line. +;; +;; `whitespace-empty' Face used to visualize empty lines at +;; beginning and/or end of buffer. +;; +;; `whitespace-space-after-tab' Face used to visualize 8 or more +;; SPACEs after TAB. +;; +;; `whitespace-space-regexp' Specify SPACE characters regexp. +;; +;; `whitespace-hspace-regexp' Specify HARD SPACE characters regexp. +;; +;; `whitespace-tab-regexp' Specify TAB characters regexp. +;; +;; `whitespace-trailing-regexp' Specify trailing characters regexp. +;; +;; `whitespace-space-before-tab-regexp' Specify SPACEs before TAB +;; regexp. +;; +;; `whitespace-indentation-regexp' Specify regexp for 8 or more +;; SPACEs at beginning of line. +;; +;; `whitespace-empty-at-bob-regexp' Specify regexp for empty lines +;; at beginning of buffer. +;; +;; `whitespace-empty-at-eob-regexp' Specify regexp for empty lines +;; at end of buffer. +;; +;; `whitespace-space-after-tab-regexp' Specify regexp for 8 or more +;; SPACEs after TAB. +;; +;; `whitespace-line-column' Specify column beyond which the line +;; is highlighted. +;; +;; `whitespace-display-mappings' Specify an alist of mappings +;; for displaying characters. +;; +;; `whitespace-global-modes' Modes for which global `whitespace-mode' is +;; automagically turned on. +;; +;; +;; Acknowledgements +;; ---------------- +;; +;; Thanks to nschum (EmacsWiki) for the idea about highlight "long" +;; lines tail. See EightyColumnRule (EmacsWiki). +;; +;; Thanks to Juri Linkov <juri@jurta.org> for suggesting: +;; * `define-minor-mode'. +;; * `global-whitespace-*' name for global commands. +;; +;; Thanks to Robert J. Chassell <bob@gnu.org> for doc fix and testing. +;; +;; Thanks to Drew Adams <drew.adams@oracle.com> for toggle commands +;; suggestion. +;; +;; Thanks to Antti Kaihola <antti.kaihola@linux-aktivaattori.org> for +;; helping to fix `find-file-hooks' reference. +;; +;; Thanks to Andreas Roehler <andreas.roehler@easy-emacs.de> for +;; indicating defface byte-compilation warnings. +;; +;; Thanks to TimOCallaghan (EmacsWiki) for the idea about highlight +;; "long" lines. See EightyColumnRule (EmacsWiki). +;; +;; Thanks to Yanghui Bian <yanghuibian@gmail.com> for indicating a new +;; newline character mapping. +;; +;; Thanks to Pete Forman <pete.forman@westgeo.com> for indicating +;; whitespace-mode.el on XEmacs. +;; +;; Thanks to Miles Bader <miles@gnu.org> for handling display table via +;; visws.el (his code was modified, but the main idea was kept). +;; +;; Thanks to: +;; Rajesh Vaidheeswarran <rv@gnu.org> (original) whitespace.el +;; Aurelien Tisne <aurelien.tisne@free.fr> show-whitespace-mode.el +;; Lawrence Mitchell <wence@gmx.li> whitespace-mode.el +;; Miles Bader <miles@gnu.org> visws.el +;; And to all people who contributed with them. +;; +;; +;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +;;; code: + + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;;; User Variables: + + +;;; Interface to the command system + + +(defgroup whitespace nil + "Visualize blanks (TAB, (HARD) SPACE and NEWLINE)." + :link '(emacs-library-link :tag "Source Lisp File" "whitespace.el") + :version "22.2" + :group 'wp + :group 'data) + + +(defcustom whitespace-style '(mark color) + "*Specify the visualization style. + +It's a list which element value can be: + + mark display mappings are visualized. + + color faces are visualized. + +Any other value is ignored. + +If nil, don't visualize TABs, (HARD) SPACEs and NEWLINEs. + +See also `whitespace-display-mappings' for documentation." + :type '(repeat :tag "Style of Blank" + (choice :tag "Style of Blank" + (const :tag "Display Table" mark) + (const :tag "Faces" color))) + :group 'whitespace) + + +(defcustom whitespace-chars + '(tabs spaces trailing lines space-before-tab newline + indentation empty space-after-tab) + "*Specify which kind of blank is visualized. + +It's a list which element value can be: + + trailing trailing blanks are visualized. + + tabs TABs are visualized. + + spaces SPACEs and HARD SPACEs are visualized. + + lines lines whose have columns beyond + `whitespace-line-column' are highlighted. + Whole line is highlighted. + It has precedence over + `lines-tail' (see below). + + lines-tail lines whose have columns beyond + `whitespace-line-column' are highlighted. + But only the part of line which goes + beyond `whitespace-line-column' column. + It has effect only if `lines' (see above) + is not present in `whitespace-chars'. + + space-before-tab SPACEs before TAB are visualized. + + newline NEWLINEs are visualized. + + indentation 8 or more SPACEs at beginning of line are + visualized. + + empty empty lines at beginning and/or end of buffer + are visualized. + + space-after-tab 8 or more SPACEs after a TAB are visualized. + +Any other value is ignored. + +If nil, don't visualize TABs, (HARD) SPACEs and NEWLINEs. + +Used when `whitespace-style' has `color' as an element. +Used also when `whitespace-chars' has `newline' as an element and +`whitespace-style' has `mark' as an element." + :type '(repeat :tag "Kind of Blank" + (choice :tag "Kind of Blank" + (const :tag "Trailing TABs, SPACEs and HARD SPACEs" + trailing) + (const :tag "SPACEs and HARD SPACEs" spaces) + (const :tag "TABs" tabs) + (const :tag "Lines" lines) + (const :tag "SPACEs before TAB" + space-before-tab) + (const :tag "NEWLINEs" newline) + (const :tag "Indentation SPACEs" indentation) + (const :tag "Empty Lines At BOB And/Or EOB" + empty) + (const :tag "SPACEs after TAB" + space-after-tab))) + :group 'whitespace) + + +(defcustom whitespace-space 'whitespace-space + "*Symbol face used to visualize SPACE. + +Used when `whitespace-style' has `color' as an element." + :type 'face + :group 'whitespace) + + +(defface whitespace-space + '((((class color) (background dark)) + (:background "grey20" :foreground "aquamarine3")) + (((class color) (background light)) + (:background "LightYellow" :foreground "aquamarine3")) + (t (:inverse-video t))) + "Face used to visualize SPACE." + :group 'whitespace) + + +(defcustom whitespace-hspace 'whitespace-hspace + "*Symbol face used to visualize HARD SPACE. + +Used when `whitespace-style' has `color' as an element." + :type 'face + :group 'whitespace) + + +(defface whitespace-hspace ; 'nobreak-space + '((((class color) (background dark)) + (:background "grey24" :foreground "aquamarine3")) + (((class color) (background light)) + (:background "LemonChiffon3" :foreground "aquamarine3")) + (t (:inverse-video t))) + "Face used to visualize HARD SPACE." + :group 'whitespace) + + +(defcustom whitespace-tab 'whitespace-tab + "*Symbol face used to visualize TAB. + +Used when `whitespace-style' has `color' as an element." + :type 'face + :group 'whitespace) + + +(defface whitespace-tab + '((((class color) (background dark)) + (:background "grey22" :foreground "aquamarine3")) + (((class color) (background light)) + (:background "beige" :foreground "aquamarine3")) + (t (:inverse-video t))) + "Face used to visualize TAB." + :group 'whitespace) + + +(defcustom whitespace-newline 'whitespace-newline + "*Symbol face used to visualize NEWLINE char mapping. + +See `whitespace-display-mappings'. + +Used when `whitespace-style' has `mark' and `color' as elements +and `whitespace-chars' has `newline' as an element." + :type 'face + :group 'whitespace) + + +(defface whitespace-newline + '((((class color) (background dark)) + (:background "grey26" :foreground "aquamarine3" :bold t)) + (((class color) (background light)) + (:background "linen" :foreground "aquamarine3" :bold t)) + (t (:bold t :underline t))) + "Face used to visualize NEWLINE char mapping. + +See `whitespace-display-mappings'." + :group 'whitespace) + + +(defcustom whitespace-trailing 'whitespace-trailing + "*Symbol face used to visualize traling blanks. + +Used when `whitespace-style' has `color' as an element." + :type 'face + :group 'whitespace) + + +(defface whitespace-trailing ; 'trailing-whitespace + '((((class mono)) (:inverse-video t :bold t :underline t)) + (t (:background "red1" :foreground "yellow" :bold t))) + "Face used to visualize trailing blanks." + :group 'whitespace) + + +(defcustom whitespace-line 'whitespace-line + "*Symbol face used to visualize \"long\" lines. + +See `whitespace-line-column'. + +Used when `whitespace-style' has `color' as an element." + :type 'face + :group 'whitespace) + + +(defface whitespace-line + '((((class mono)) (:inverse-video t :bold t :underline t)) + (t (:background "gray20" :foreground "violet"))) + "Face used to visualize \"long\" lines. + +See `whitespace-line-column'." + :group 'whitespace) + + +(defcustom whitespace-space-before-tab 'whitespace-space-before-tab + "*Symbol face used to visualize SPACEs before TAB. + +Used when `whitespace-style' has `color' as an element." + :type 'face + :group 'whitespace) + + +(defface whitespace-space-before-tab + '((((class mono)) (:inverse-video t :bold t :underline t)) + (t (:background "DarkOrange" :foreground "firebrick"))) + "Face used to visualize SPACEs before TAB." + :group 'whitespace) + + +(defcustom whitespace-indentation 'whitespace-indentation + "*Symbol face used to visualize 8 or more SPACEs at beginning of line. + +Used when `whitespace-style' has `color' as an element." + :type 'face + :group 'whitespace) + + +(defface whitespace-indentation + '((((class mono)) (:inverse-video t :bold t :underline t)) + (t (:background "yellow" :foreground "firebrick"))) + "Face used to visualize 8 or more SPACEs at beginning of line." + :group 'whitespace) + + +(defcustom whitespace-empty 'whitespace-empty + "*Symbol face used to visualize empty lines at beginning and/or end of buffer. + +Used when `whitespace-style' has `color' as an element." + :type 'face + :group 'whitespace) + + +(defface whitespace-empty + '((((class mono)) (:inverse-video t :bold t :underline t)) + (t (:background "yellow" :foreground "firebrick"))) + "Face used to visualize empty lines at beginning and/or end of buffer." + :group 'whitespace) + + +(defcustom whitespace-space-after-tab 'whitespace-space-after-tab + "*Symbol face used to visualize 8 or more SPACEs after TAB. + +Used when `whitespace-style' has `color' as an element." + :type 'face + :group 'whitespace) + + +(defface whitespace-space-after-tab + '((((class mono)) (:inverse-video t :bold t :underline t)) + (t (:background "yellow" :foreground "firebrick"))) + "Face used to visualize 8 or more SPACEs after TAB." + :group 'whitespace) + + +(defcustom whitespace-hspace-regexp + "\\(\\(\xA0\\|\x8A0\\|\x920\\|\xE20\\|\xF20\\)+\\)" + "*Specify HARD SPACE characters regexp. + +If you're using `mule' package, it may exist other characters besides: + + \"\\xA0\" \"\\x8A0\" \"\\x920\" \"\\xE20\" \"\\xF20\" + +that should be considered HARD SPACE. + +Here are some examples: + + \"\\\\(^\\xA0+\\\\)\" \ +visualize only leading HARD SPACEs. + \"\\\\(\\xA0+$\\\\)\" \ +visualize only trailing HARD SPACEs. + \"\\\\(^\\xA0+\\\\|\\xA0+$\\\\)\" \ +visualize leading and/or trailing HARD SPACEs. + \"\\t\\\\(\\xA0+\\\\)\\t\" \ +visualize only HARD SPACEs between TABs. + +NOTE: Enclose always by \\\\( and \\\\) the elements to highlight. + Use exactly one pair of enclosing \\\\( and \\\\). + +Used when `whitespace-style' has `color' as an element, and +`whitespace-chars' has `spaces' as an element." + :type '(regexp :tag "HARD SPACE Chars") + :group 'whitespace) + + +(defcustom whitespace-space-regexp "\\( +\\)" + "*Specify SPACE characters regexp. + +If you're using `mule' package, it may exist other characters +besides \" \" that should be considered SPACE. + +Here are some examples: + + \"\\\\(^ +\\\\)\" visualize only leading SPACEs. + \"\\\\( +$\\\\)\" visualize only trailing SPACEs. + \"\\\\(^ +\\\\| +$\\\\)\" \ +visualize leading and/or trailing SPACEs. + \"\\t\\\\( +\\\\)\\t\" visualize only SPACEs between TABs. + +NOTE: Enclose always by \\\\( and \\\\) the elements to highlight. + Use exactly one pair of enclosing \\\\( and \\\\). + +Used when `whitespace-style' has `color' as an element, and +`whitespace-chars' has `spaces' as an element." + :type '(regexp :tag "SPACE Chars") + :group 'whitespace) + + +(defcustom whitespace-tab-regexp "\\(\t+\\)" + "*Specify TAB characters regexp. + +If you're using `mule' package, it may exist other characters +besides \"\\t\" that should be considered TAB. + +Here are some examples: + + \"\\\\(^\\t+\\\\)\" visualize only leading TABs. + \"\\\\(\\t+$\\\\)\" visualize only trailing TABs. + \"\\\\(^\\t+\\\\|\\t+$\\\\)\" \ +visualize leading and/or trailing TABs. + \" \\\\(\\t+\\\\) \" visualize only TABs between SPACEs. + +NOTE: Enclose always by \\\\( and \\\\) the elements to highlight. + Use exactly one pair of enclosing \\\\( and \\\\). + +Used when `whitespace-style' has `color' as an element, and +`whitespace-chars' has `tabs' as an element." + :type '(regexp :tag "TAB Chars") + :group 'whitespace) + + +(defcustom whitespace-trailing-regexp + "\t\\| \\|\xA0\\|\x8A0\\|\x920\\|\xE20\\|\xF20" + "*Specify trailing characters regexp. + +If you're using `mule' package, it may exist other characters besides: + + \" \" \"\\t\" \"\\xA0\" \"\\x8A0\" \"\\x920\" \"\\xE20\" \ +\"\\xF20\" + +that should be considered blank. + +NOTE: DO NOT enclose by \\\\( and \\\\) the elements to highlight. + `whitespace-mode' surrounds this regexp by \"\\\\(\\\\(\" and + \"\\\\)+\\\\)$\". + +Used when `whitespace-style' has `color' as an element, and +`whitespace-chars' has `trailing' as an element." + :type '(regexp :tag "Trailing Chars") + :group 'whitespace) + + +(defcustom whitespace-space-before-tab-regexp "\\( +\\)\t" + "*Specify SPACEs before TAB regexp. + +If you're using `mule' package, it may exist other characters besides: + + \" \" \"\\t\" \"\\xA0\" \"\\x8A0\" \"\\x920\" \"\\xE20\" \ +\"\\xF20\" + +that should be considered blank. + +Used when `whitespace-style' has `color' as an element, and +`whitespace-chars' has `space-before-tab' as an element." + :type '(regexp :tag "SPACEs Before TAB") + :group 'whitespace) + + +(defcustom whitespace-indentation-regexp + "^\t*\\(\\( \\{8\\}\\)+\\)[^\n\t]" + "*Specify regexp for 8 or more SPACEs at beginning of line. + +If you're using `mule' package, it may exist other characters besides: + + \" \" \"\\t\" \"\\xA0\" \"\\x8A0\" \"\\x920\" \"\\xE20\" \ +\"\\xF20\" + +that should be considered blank. + +Used when `whitespace-style' has `color' as an element, and +`whitespace-chars' has `indentation' as an element." + :type '(regexp :tag "Indentation SPACEs") + :group 'whitespace) + + +(defcustom whitespace-empty-at-bob-regexp "\\`\\(\\([ \t]*\n\\)+\\)" + "*Specify regexp for empty lines at beginning of buffer. + +If you're using `mule' package, it may exist other characters besides: + + \" \" \"\\t\" \"\\xA0\" \"\\x8A0\" \"\\x920\" \"\\xE20\" \ +\"\\xF20\" + +that should be considered blank. + +Used when `whitespace-style' has `color' as an element, and +`whitespace-chars' has `empty' as an element." + :type '(regexp :tag "Empty Lines At Beginning Of Buffer") + :group 'whitespace) + + +(defcustom whitespace-empty-at-eob-regexp "^\\([ \t\n]+\\)\\'" + "*Specify regexp for empty lines at end of buffer. + +If you're using `mule' package, it may exist other characters besides: + + \" \" \"\\t\" \"\\xA0\" \"\\x8A0\" \"\\x920\" \"\\xE20\" \ +\"\\xF20\" + +that should be considered blank. + +Used when `whitespace-style' has `color' as an element, and +`whitespace-chars' has `empty' as an element." + :type '(regexp :tag "Empty Lines At End Of Buffer") + :group 'whitespace) + + +(defcustom whitespace-space-after-tab-regexp "\t\\(\\( \\{8\\}\\)+\\)" + "*Specify regexp for 8 or more SPACEs after TAB. + +If you're using `mule' package, it may exist other characters besides: + + \" \" \"\\t\" \"\\xA0\" \"\\x8A0\" \"\\x920\" \"\\xE20\" \ +\"\\xF20\" + +that should be considered blank. + +Used when `whitespace-style' has `color' as an element, and +`whitespace-chars' has `space-after-tab' as an element." + :type '(regexp :tag "SPACEs After TAB") + :group 'whitespace) + + +(defcustom whitespace-line-column 80 + "*Specify column beyond which the line is highlighted. + +Used when `whitespace-style' has `color' as an element, and +`whitespace-chars' has `lines' or `lines-tail' as an element." + :type '(integer :tag "Line Length") + :group 'whitespace) + + +;; Hacked from `visible-whitespace-mappings' in visws.el +(defcustom whitespace-display-mappings + ;; Due to limitations of glyph representation, the char code can not + ;; be above ?\x1FFFF. Probably, this will be fixed after Emacs + ;; unicode merging. + '( + (?\ [?\xB7] [?.]) ; space - centered dot + (?\xA0 [?\xA4] [?_]) ; hard space - currency + (?\x8A0 [?\x8A4] [?_]) ; hard space - currency + (?\x920 [?\x924] [?_]) ; hard space - currency + (?\xE20 [?\xE24] [?_]) ; hard space - currency + (?\xF20 [?\xF24] [?_]) ; hard space - currency + ;; NEWLINE is displayed using the face `whitespace-newline' + (?\n [?$ ?\n]) ; end-of-line - dollar sign + ;; (?\n [?\u21B5 ?\n] [?$ ?\n]) ; end-of-line - downwards arrow + ;; (?\n [?\xB6 ?\n] [?$ ?\n]) ; end-of-line - pilcrow + ;; (?\n [?\x8AF ?\n] [?$ ?\n]) ; end-of-line - overscore + ;; (?\n [?\x8AC ?\n] [?$ ?\n]) ; end-of-line - negation + ;; (?\n [?\x8B0 ?\n] [?$ ?\n]) ; end-of-line - grade + ;; + ;; WARNING: the mapping below has a problem. + ;; When a TAB occupies exactly one column, it will display the + ;; character ?\xBB at that column followed by a TAB which goes to + ;; the next TAB column. + ;; If this is a problem for you, please, comment the line below. + (?\t [?\xBB ?\t] [?\\ ?\t]) ; tab - left quote mark + ) + "*Specify an alist of mappings for displaying characters. + +Each element has the following form: + + (CHAR VECTOR...) + +Where: + +CHAR is the character to be mapped. + +VECTOR is a vector of characters to be displayed in place of CHAR. + The first display vector that can be displayed is used; + if no display vector for a mapping can be displayed, then + that character is displayed unmodified. + +The NEWLINE character is displayed using the face given by +`whitespace-newline' variable. The characters in the vector to +be displayed will not have this face applied if the character +code is above #x1FFFF. + +Used when `whitespace-style' has `mark' as an element." + :type '(repeat + (list :tag "Character Mapping" + (character :tag "Char") + (repeat :inline t :tag "Vector List" + (vector :tag "" + (repeat :inline t + :tag "Vector Characters" + (character :tag "Char")))))) + :group 'whitespace) + + +(defcustom whitespace-global-modes t + "*Modes for which global `whitespace-mode' is automagically turned on. + +Global `whitespace-mode' is controlled by the command +`global-whitespace-mode'. + +If nil, means no modes have `whitespace-mode' automatically +turned on. + +If t, all modes that support `whitespace-mode' have it +automatically turned on. + +Else it should be a list of `major-mode' symbol names for which +`whitespace-mode' should be automatically turned on. The sense +of the list is negated if it begins with `not'. For example: + + (c-mode c++-mode) + +means that `whitespace-mode' is turned on for buffers in C and +C++ modes only." + :type '(choice (const :tag "None" nil) + (const :tag "All" t) + (set :menu-tag "Mode Specific" :tag "Modes" + :value (not) + (const :tag "Except" not) + (repeat :inline t + (symbol :tag "Mode")))) + :group 'whitespace) + + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;;; User commands - Local mode + + +;;;###autoload +(define-minor-mode whitespace-mode + "Toggle whitespace minor mode visualization (\"ws\" on modeline). + +If ARG is null, toggle whitespace visualization. +If ARG is a number greater than zero, turn on visualization; +otherwise, turn off visualization. +Only useful with a windowing system." + :lighter " ws" + :init-value nil + :global nil + :group 'whitespace + (cond + (noninteractive ; running a batch job + (setq whitespace-mode nil)) + (whitespace-mode ; whitespace-mode on + (whitespace-turn-on)) + (t ; whitespace-mode off + (whitespace-turn-off)))) + + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;;; User commands - Global mode + + +(define-minor-mode global-whitespace-mode + "Toggle whitespace global minor mode visualization (\"WS\" on modeline). + +If ARG is null, toggle whitespace visualization. +If ARG is a number greater than zero, turn on visualization; +otherwise, turn off visualization. +Only useful with a windowing system." + :lighter " BL" + :init-value nil + :global t + :group 'whitespace + (cond + (noninteractive ; running a batch job + (setq global-whitespace-mode nil)) + (global-whitespace-mode ; global-whitespace-mode on + (save-excursion + (if (boundp 'find-file-hook) + (add-hook 'find-file-hook 'whitespace-turn-on-if-enabled t) + (add-hook 'find-file-hooks 'whitespace-turn-on-if-enabled t)) + (dolist (buffer (buffer-list)) ; adjust all local mode + (set-buffer buffer) + (unless whitespace-mode + (whitespace-turn-on-if-enabled))))) + (t ; global-whitespace-mode off + (save-excursion + (if (boundp 'find-file-hook) + (remove-hook 'find-file-hook 'whitespace-turn-on-if-enabled) + (remove-hook 'find-file-hooks 'whitespace-turn-on-if-enabled)) + (dolist (buffer (buffer-list)) ; adjust all local mode + (set-buffer buffer) + (unless whitespace-mode + (whitespace-turn-off))))))) + + +(defun whitespace-turn-on-if-enabled () + (when (cond + ((eq whitespace-global-modes t)) + ((listp whitespace-global-modes) + (if (eq (car-safe whitespace-global-modes) 'not) + (not (memq major-mode (cdr whitespace-global-modes))) + (memq major-mode whitespace-global-modes))) + (t nil)) + (let (inhibit-quit) + ;; Don't turn on whitespace mode if... + (or + ;; ...we don't have a display (we're running a batch job) + noninteractive + ;; ...or if the buffer is invisible (name starts with a space) + (eq (aref (buffer-name) 0) ?\ ) + ;; ...or if the buffer is temporary (name starts with *) + (and (eq (aref (buffer-name) 0) ?*) + ;; except the scratch buffer. + (not (string= (buffer-name) "*scratch*"))) + ;; Otherwise, turn on whitespace mode. + (whitespace-turn-on))))) + + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;;; User commands - Toggle + + +(defconst whitespace-chars-value-list + '(tabs + spaces + trailing + space-before-tab + lines + lines-tail + newline + indentation + empty + space-after-tab + ) + "List of valid `whitespace-chars' values.") + + +(defconst whitespace-style-value-list + '(color + mark + ) + "List of valid `whitespace-style' values.") + + +(defconst whitespace-toggle-option-alist + '((?t . tabs) + (?s . spaces) + (?r . trailing) + (?b . space-before-tab) + (?l . lines) + (?L . lines-tail) + (?n . newline) + (?i . indentation) + (?e . empty) + (?a . space-after-tab) + (?c . color) + (?m . mark) + (?x . whitespace-chars) + (?z . whitespace-style) + ) + "Alist of toggle options. + +Each element has the form: + + (CHAR . SYMBOL) + +Where: + +CHAR is a char which the user will have to type. + +SYMBOL is a valid symbol associated with CHAR. + See `whitespace-chars-value-list' and + `whitespace-style-value-list'.") + + +(defvar whitespace-active-chars nil + "Used to save locally `whitespace-chars' value.") +(make-variable-buffer-local 'whitespace-active-chars) + +(defvar whitespace-active-style nil + "Used to save locally `whitespace-style' value.") +(make-variable-buffer-local 'whitespace-active-style) + + +;;;###autoload +(defun whitespace-toggle-options (arg) + "Toggle local `whitespace-mode' options. + +If local whitespace-mode is off, toggle the option given by ARG +and turn on local whitespace-mode. + +If local whitespace-mode is on, toggle the option given by ARG +and restart local whitespace-mode. + +Interactively, it reads one of the following chars: + + CHAR MEANING + t toggle TAB visualization + s toggle SPACE and HARD SPACE visualization + r toggle trailing blanks visualization + b toggle SPACEs before TAB visualization + l toggle \"long lines\" visualization + L toggle \"long lines\" tail visualization + n toggle NEWLINE visualization + i toggle indentation SPACEs visualization + e toggle empty line at bob and/or eob visualization + a toggle SPACEs after TAB visualization + c toggle color faces + m toggle visual mark + x restore `whitespace-chars' value + z restore `whitespace-style' value + ? display brief help + +Non-interactively, ARG should be a symbol or a list of symbols. +The valid symbols are: + + tabs toggle TAB visualization + spaces toggle SPACE and HARD SPACE visualization + trailing toggle trailing blanks visualization + space-before-tab toggle SPACEs before TAB visualization + lines toggle \"long lines\" visualization + lines-tail toggle \"long lines\" tail visualization + newline toggle NEWLINE visualization + indentation toggle indentation SPACEs visualization + empty toggle empty line at bob and/or eob visualization + space-after-tab toggle SPACEs after TAB visualization + color toggle color faces + mark toggle visual mark + whitespace-chars restore `whitespace-chars' value + whitespace-style restore `whitespace-style' value + +Only useful with a windowing system." + (interactive (whitespace-interactive-char t)) + (let ((whitespace-chars + (whitespace-toggle-list + t arg whitespace-active-chars whitespace-chars + 'whitespace-chars whitespace-chars-value-list)) + (whitespace-style + (whitespace-toggle-list + t arg whitespace-active-style whitespace-style + 'whitespace-style whitespace-style-value-list))) + (whitespace-mode 0) + (whitespace-mode 1))) + + +(defvar whitespace-toggle-chars nil + "Used to toggle the global `whitespace-chars' value.") +(defvar whitespace-toggle-style nil + "Used to toggle the global `whitespace-style' value.") + + +;;;###autoload +(defun global-whitespace-toggle-options (arg) + "Toggle global `whitespace-mode' options. + +If global whitespace-mode is off, toggle the option given by ARG +and turn on global whitespace-mode. + +If global whitespace-mode is on, toggle the option given by ARG +and restart global whitespace-mode. + +Interactively, it reads one of the following chars: + + CHAR MEANING + t toggle TAB visualization + s toggle SPACE and HARD SPACE visualization + r toggle trailing blanks visualization + b toggle SPACEs before TAB visualization + l toggle \"long lines\" visualization + L toggle \"long lines\" tail visualization + n toggle NEWLINE visualization + i toggle indentation SPACEs visualization + e toggle empty line at bob and/or eob visualization + a toggle SPACEs after TAB visualization + c toggle color faces + m toggle visual mark + x restore `whitespace-chars' value + z restore `whitespace-style' value + ? display brief help + +Non-interactively, ARG should be a symbol or a list of symbols. +The valid symbols are: + + tabs toggle TAB visualization + spaces toggle SPACE and HARD SPACE visualization + trailing toggle trailing blanks visualization + space-before-tab toggle SPACEs before TAB visualization + lines toggle \"long lines\" visualization + lines-tail toggle \"long lines\" tail visualization + newline toggle NEWLINE visualization + indentation toggle indentation SPACEs visualization + empty toggle empty line at bob and/or eob visualization + space-after-tab toggle SPACEs after TAB visualization + color toggle color faces + mark toggle visual mark + whitespace-chars restore `whitespace-chars' value + whitespace-style restore `whitespace-style' value + +Only useful with a windowing system." + (interactive (whitespace-interactive-char nil)) + (let ((whitespace-chars + (whitespace-toggle-list + nil arg whitespace-toggle-chars whitespace-chars + 'whitespace-chars whitespace-chars-value-list)) + (whitespace-style + (whitespace-toggle-list + nil arg whitespace-toggle-style whitespace-style + 'whitespace-style whitespace-style-value-list))) + (setq whitespace-toggle-chars whitespace-chars + whitespace-toggle-style whitespace-style) + (global-whitespace-mode 0) + (global-whitespace-mode 1))) + + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;;; User commands - Cleanup + + +;;;###autoload +(defun whitespace-cleanup () + "Cleanup some blank problems in all buffer or at region. + +It usually applies to the whole buffer, but in transient mark +mode when the mark is active, it applies to the region. It also +applies to the region when it is not in transiente mark mode, the +mark is active and it was pressed `C-u' just before calling +`whitespace-cleanup' interactively. + +See also `whitespace-cleanup-region'. + +The problems, which are cleaned up, are: + +1. empty lines at beginning of buffer. +2. empty lines at end of buffer. + If `whitespace-chars' has `empty' as an element, remove all + empty lines at beginning and/or end of buffer. + +3. 8 or more SPACEs at beginning of line. + If `whitespace-chars' has `indentation' as an element, replace + 8 or more SPACEs at beginning of line by TABs. + +4. SPACEs before TAB. + If `whitespace-chars' has `space-before-tab' as an element, + replace SPACEs by TABs. + +5. SPACEs or TABs at end of line. + If `whitespace-chars' has `trailing' as an element, remove all + SPACEs or TABs at end of line. + +6. 8 or more SPACEs after TAB. + If `whitespace-chars' has `space-after-tab' as an element, + replace SPACEs by TABs." + (interactive "@*") + (if (and (or transient-mark-mode + current-prefix-arg) + mark-active) + ;; region active + ;; problems 1 and 2 are not handled in region + ;; problem 3: 8 or more SPACEs at bol + ;; problem 4: SPACEs before TAB + ;; problem 5: SPACEs or TABs at eol + ;; problem 6: 8 or more SPACEs after TAB + (whitespace-cleanup-region (region-beginning) (region-end)) + ;; whole buffer + (save-excursion + (save-match-data + ;; problem 1: empty lines at bob + ;; problem 2: empty lines at eob + ;; action: remove all empty lines at bob and/or eob + (when (memq 'empty whitespace-chars) + (let (overwrite-mode) ; enforce no overwrite + (goto-char (point-min)) + (when (re-search-forward + whitespace-empty-at-bob-regexp nil t) + (delete-region (match-beginning 1) (match-end 1))) + (when (re-search-forward + whitespace-empty-at-eob-regexp nil t) + (delete-region (match-beginning 1) (match-end 1))))))) + ;; problem 3: 8 or more SPACEs at bol + ;; problem 4: SPACEs before TAB + ;; problem 5: SPACEs or TABs at eol + ;; problem 6: 8 or more SPACEs after TAB + (whitespace-cleanup-region (point-min) (point-max)))) + + +;;;###autoload +(defun whitespace-cleanup-region (start end) + "Cleanup some blank problems at region. + +The problems, which are cleaned up, are: + +1. 8 or more SPACEs at beginning of line. + If `whitespace-chars' has `indentation' as an element, replace + 8 or more SPACEs at beginning of line by TABs. + +2. SPACEs before TAB. + If `whitespace-chars' has `space-before-tab' as an element, + replace SPACEs by TABs. + +3. SPACEs or TABs at end of line. + If `whitespace-chars' has `trailing' as an element, remove all + SPACEs or TABs at end of line. + +4. 8 or more SPACEs after TAB. + If `whitespace-chars' has `space-after-tab' as an element, + replace SPACEs by TABs." + (interactive "@*r") + (let ((rstart (min start end)) + (rend (copy-marker (max start end))) + (tab-width 8) ; assure TAB width + (indent-tabs-mode t) ; always insert TABs + overwrite-mode ; enforce no overwrite + tmp) + (save-excursion + (save-match-data + ;; problem 1: 8 or more SPACEs at bol + ;; action: replace 8 or more SPACEs at bol by TABs + (when (memq 'indentation whitespace-chars) + (goto-char rstart) + (while (re-search-forward + whitespace-indentation-regexp rend t) + (setq tmp (current-indentation)) + (delete-horizontal-space) + (unless (eolp) + (indent-to tmp)))) + ;; problem 3: SPACEs or TABs at eol + ;; action: remove all SPACEs or TABs at eol + (when (memq 'trailing whitespace-chars) + (let ((regexp (concat "\\(\\(" whitespace-trailing-regexp + "\\)+\\)$"))) + (goto-char rstart) + (while (re-search-forward regexp rend t) + (delete-region (match-beginning 1) (match-end 1))))) + ;; problem 4: 8 or more SPACEs after TAB + ;; action: replace 8 or more SPACEs by TABs + (when (memq 'space-after-tab whitespace-chars) + (whitespace-replace-spaces-by-tabs + rstart rend whitespace-space-after-tab-regexp)) + ;; problem 2: SPACEs before TAB + ;; action: replace SPACEs before TAB by TABs + (when (memq 'space-before-tab whitespace-chars) + (whitespace-replace-spaces-by-tabs + rstart rend whitespace-space-before-tab-regexp)))) + (set-marker rend nil))) ; point marker to nowhere + + +(defun whitespace-replace-spaces-by-tabs (rstart rend regexp) + "Replace all SPACEs by TABs matched by REGEXP between RSTART and REND." + (goto-char rstart) + (while (re-search-forward regexp rend t) + (goto-char (match-beginning 1)) + (let* ((scol (current-column)) + (ecol (save-excursion + (goto-char (match-end 1)) + (current-column)))) + (delete-region (match-beginning 1) (match-end 1)) + (insert-char ?\t + (/ (- (- ecol (% ecol 8)) ; prev end col + (- scol (% scol 8))) ; prev start col + 8))))) + + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;;; User command - old whitespace compatibility + + +;;;###autoload +(defun whitespace-buffer () + "Turn on `whitespace-mode' forcing some settings. + +It forces `whitespace-style' to have `color'. + +It also forces `whitespace-chars' to have: + + trailing + indentation + space-before-tab + empty + space-after-tab + +So, it is possible to visualize the following problems: + + empty 1. empty lines at beginning of buffer. + empty 2. empty lines at end of buffer. + indentation 3. 8 or more SPACEs at beginning of line. + space-before-tab 4. SPACEs before TAB. + trailing 5. SPACEs or TABs at end of line. + space-after-tab 6. 8 or more SPACEs after TAB. + +See `whitespace-chars' and `whitespace-style' for documentation. +See also `whitespace-cleanup' and `whitespace-cleanup-region' for +cleaning up these problems." + (interactive) + (whitespace-mode 0) ; assure is off + ;; keep original values + (let ((whitespace-style (copy-sequence whitespace-style)) + (whitespace-chars (copy-sequence whitespace-chars))) + ;; adjust options for whitespace bogus blanks + (add-to-list 'whitespace-style 'color) + (mapc #'(lambda (option) + (add-to-list 'whitespace-chars option)) + '(trailing + indentation + space-before-tab + empty + space-after-tab)) + (whitespace-mode 1))) ; turn on + + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;;; Internal functions + + +(defvar whitespace-font-lock-mode nil + "Used to remember whether a buffer had font lock mode on or not.") +(make-variable-buffer-local 'whitespace-font-lock-mode) + +(defvar whitespace-font-lock nil + "Used to remember whether a buffer initially had font lock on or not.") +(make-variable-buffer-local 'whitespace-font-lock) + +(defvar whitespace-font-lock-keywords nil + "Used to save locally `font-lock-keywords' value.") +(make-variable-buffer-local 'whitespace-font-lock-keywords) + + +(defconst whitespace-help-text + "\ + whitespace-mode toggle options: + + [] t - toggle TAB visualization + [] s - toggle SPACE and HARD SPACE visualization + [] r - toggle trailing blanks visualization + [] b - toggle SPACEs before TAB visualization + [] l - toggle \"long lines\" visualization + [] L - toggle \"long lines\" tail visualization + [] n - toggle NEWLINE visualization + [] i - toggle indentation SPACEs visualization + [] e - toggle empty line at bob and/or eob visualization + [] a - toggle SPACEs after TAB visualization + + [] c - toggle color faces + [] m - toggle visual mark + + x - restore `whitespace-chars' value + z - restore `whitespace-style' value + + ? - display this text\n\n" + "Text for whitespace toggle options.") + + +(defconst whitespace-help-buffer-name "*Whitespace Toggle Options*" + "The buffer name for whitespace toggle options.") + + +(defun whitespace-insert-option-mark (the-list the-value) + "Insert the option mark ('X' or ' ') in toggle options buffer." + (forward-line 1) + (dolist (sym the-list) + (forward-line 1) + (forward-char 2) + (insert (if (memq sym the-value) "X" " ")))) + + +(defun whitespace-help-on (chars style) + "Display the whitespace toggle options." + (unless (get-buffer whitespace-help-buffer-name) + (delete-other-windows) + (let ((buffer (get-buffer-create whitespace-help-buffer-name))) + (save-excursion + (set-buffer buffer) + (erase-buffer) + (insert whitespace-help-text) + (goto-char (point-min)) + (whitespace-insert-option-mark + whitespace-chars-value-list chars) + (whitespace-insert-option-mark + whitespace-style-value-list style) + (goto-char (point-min)) + (set-buffer-modified-p nil) + (let ((size (- (window-height) + (max window-min-height + (1+ (count-lines (point-min) + (point-max))))))) + (when (<= size 0) + (kill-buffer buffer) + (error "Frame height is too small; \ +can't split window to display whitespace toggle options")) + (set-window-buffer (split-window nil size) buffer)))))) + + +(defun whitespace-help-off () + "Remove the buffer and window of the whitespace toggle options." + (let ((buffer (get-buffer whitespace-help-buffer-name))) + (when buffer + (delete-windows-on buffer) + (kill-buffer buffer)))) + + +(defun whitespace-interactive-char (local-p) + "Interactive function to read a char and return a symbol. + +If LOCAL-P is non-nil, it uses a local context; otherwise, it +uses a global context. + +It reads one of the following chars: + + CHAR MEANING + t toggle TAB visualization + s toggle SPACE and HARD SPACE visualization + r toggle trailing blanks visualization + b toggle SPACEs before TAB visualization + l toggle \"long lines\" visualization + L toggle \"long lines\" tail visualization + n toggle NEWLINE visualization + i toggle indentation SPACEs visualization + e toggle empty line at bob and/or eob visualization + a toggle SPACEs after TAB visualization + c toggle color faces + m toggle visual mark + x restore `whitespace-chars' value + z restore `whitespace-style' value + ? display brief help + +See also `whitespace-toggle-option-alist'." + (let* ((is-off (not (if local-p + whitespace-mode + global-whitespace-mode))) + (chars (cond (is-off whitespace-chars) ; use default value + (local-p whitespace-active-chars) + (t whitespace-toggle-chars))) + (style (cond (is-off whitespace-style) ; use default value + (local-p whitespace-active-style) + (t whitespace-toggle-style))) + (prompt + (format "Whitespace Toggle %s (type ? for further options)-" + (if local-p "Local" "Global"))) + ch sym) + ;; read a valid option and get the corresponding symbol + (save-window-excursion + (condition-case data + (progn + (while + ;; while condition + (progn + (setq ch (read-char prompt)) + (not + (setq sym + (cdr + (assq ch whitespace-toggle-option-alist))))) + ;; while body + (if (eq ch ?\?) + (whitespace-help-on chars style) + (ding))) + (whitespace-help-off) + (message " ")) ; clean echo area + ;; handler + ((quit error) + (whitespace-help-off) + (error (error-message-string data))))) + (list sym))) ; return the apropriate symbol + + +(defun whitespace-toggle-list (local-p arg the-list default-list + sym-restore sym-list) + "Toggle options in THE-LIST based on list ARG. + +If LOCAL-P is non-nil, it uses a local context; otherwise, it +uses a global context. + +ARG is a list of options to be toggled. + +THE-LIST is a list of options. This list will be toggled and the +resultant list will be returned. + +DEFAULT-LIST is the default list of options. It is used to +restore the options in THE-LIST. + +SYM-RESTORE is the symbol which indicates to restore the options +in THE-LIST. + +SYM-LIST is a list of valid options, used to check if the ARG's +options are valid." + (unless (if local-p whitespace-mode global-whitespace-mode) + (setq the-list default-list)) + (setq the-list (copy-sequence the-list)) ; keep original list + (dolist (sym (if (listp arg) arg (list arg))) + (cond + ;; restore default values + ((eq sym sym-restore) + (setq the-list default-list)) + ;; toggle valid values + ((memq sym sym-list) + (setq the-list (if (memq sym the-list) + (delq sym the-list) + (cons sym the-list)))))) + the-list) + + +(defun whitespace-turn-on () + "Turn on whitespace visualization." + (setq whitespace-active-style (if (listp whitespace-style) + whitespace-style + (list whitespace-style))) + (setq whitespace-active-chars (if (listp whitespace-chars) + whitespace-chars + (list whitespace-chars))) + (when (memq 'color whitespace-active-style) + (whitespace-color-on)) + (when (memq 'mark whitespace-active-style) + (whitespace-display-char-on))) + + +(defun whitespace-turn-off () + "Turn off whitesapce visualization." + (when (memq 'color whitespace-active-style) + (whitespace-color-off)) + (when (memq 'mark whitespace-active-style) + (whitespace-display-char-off))) + + +(defun whitespace-color-on () + "Turn on color visualization." + (when whitespace-active-chars + (unless whitespace-font-lock + (setq whitespace-font-lock t + whitespace-font-lock-keywords + (copy-sequence font-lock-keywords))) + ;; turn off font lock + (setq whitespace-font-lock-mode font-lock-mode) + (font-lock-mode 0) + ;; add whitespace-mode color into font lock + (when (memq 'spaces whitespace-active-chars) + (font-lock-add-keywords + nil + (list + ;; Show SPACEs + (list whitespace-space-regexp 1 whitespace-space t) + ;; Show HARD SPACEs + (list whitespace-hspace-regexp 1 whitespace-hspace t)) + t)) + (when (memq 'tabs whitespace-active-chars) + (font-lock-add-keywords + nil + (list + ;; Show TABs + (list whitespace-tab-regexp 1 whitespace-tab t)) + t)) + (when (memq 'trailing whitespace-active-chars) + (font-lock-add-keywords + nil + (list + ;; Show trailing blanks + (list (concat "\\(\\(" whitespace-trailing-regexp "\\)+\\)$") + 1 whitespace-trailing t)) + t)) + (when (or (memq 'lines whitespace-active-chars) + (memq 'lines-tail whitespace-active-chars)) + (font-lock-add-keywords + nil + (list + ;; Show "long" lines + (list + (format + "^\\([^\t\n]\\{%s\\}\\|[^\t\n]\\{0,%s\\}\t\\)\\{%d\\}%s\\(.+\\)$" + tab-width (1- tab-width) + (/ whitespace-line-column tab-width) + (let ((rem (% whitespace-line-column tab-width))) + (if (zerop rem) + "" + (format ".\\{%d\\}" rem)))) + (if (memq 'lines whitespace-active-chars) + 0 ; whole line + 2) ; line tail + whitespace-line t)) + t)) + (when (memq 'space-before-tab whitespace-active-chars) + (font-lock-add-keywords + nil + (list + ;; Show SPACEs before TAB + (list whitespace-space-before-tab-regexp + 1 whitespace-space-before-tab t)) + t)) + (when (memq 'indentation whitespace-active-chars) + (font-lock-add-keywords + nil + (list + ;; Show indentation SPACEs + (list whitespace-indentation-regexp + 1 whitespace-indentation t)) + t)) + (when (memq 'empty whitespace-active-chars) + (font-lock-add-keywords + nil + (list + ;; Show empty lines at beginning of buffer + (list whitespace-empty-at-bob-regexp + 1 whitespace-empty t)) + t) + (font-lock-add-keywords + nil + (list + ;; Show empty lines at end of buffer + (list whitespace-empty-at-eob-regexp + 1 whitespace-empty t)) + t)) + (when (memq 'space-after-tab whitespace-active-chars) + (font-lock-add-keywords + nil + (list + ;; Show SPACEs after TAB + (list whitespace-space-after-tab-regexp + 1 whitespace-space-after-tab t)) + t)) + ;; now turn on font lock and highlight blanks + (font-lock-mode 1))) + + +(defun whitespace-color-off () + "Turn off color visualization." + (when whitespace-active-chars + ;; turn off font lock + (font-lock-mode 0) + (when whitespace-font-lock + (setq whitespace-font-lock nil + font-lock-keywords whitespace-font-lock-keywords)) + ;; restore original font lock state + (font-lock-mode whitespace-font-lock-mode))) + + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;;; Hacked from visws.el (Miles Bader <miles@gnu.org>) + + +(defvar whitespace-display-table nil + "Used to save a local display table.") +(make-variable-buffer-local 'whitespace-display-table) + +(defvar whitespace-display-table-was-local nil + "Used to remember whether a buffer initially had a local display table.") +(make-variable-buffer-local 'whitespace-display-table-was-local) + + +(defsubst whitespace-char-valid-p (char) + ;; This check should be improved!!! + (or (< char 256) + (char-valid-p char))) + + +(defun whitespace-display-vector-p (vec) + "Return true if every character in vector VEC can be displayed." + (let ((i (length vec))) + (when (> i 0) + (while (and (>= (setq i (1- i)) 0) + (whitespace-char-valid-p (aref vec i)))) + (< i 0)))) + + +(defun whitespace-display-char-on () + "Turn on character display mapping." + (when whitespace-display-mappings + (let (vecs vec) + ;; Remember whether a buffer has a local display table. + (unless whitespace-display-table-was-local + (setq whitespace-display-table-was-local t + whitespace-display-table + (copy-sequence buffer-display-table))) + (unless buffer-display-table + (setq buffer-display-table (make-display-table))) + (dolist (entry whitespace-display-mappings) + (setq vecs (cdr entry)) + ;; Get a displayable mapping. + (while (and vecs + (not (whitespace-display-vector-p (car vecs)))) + (setq vecs (cdr vecs))) + ;; Display a valid mapping. + (when vecs + (setq vec (copy-sequence (car vecs))) + (cond + ;; Any char except newline + ((not (eq (car entry) ?\n)) + (aset buffer-display-table (car entry) vec)) + ;; Newline char - display it + ((memq 'newline whitespace-active-chars) + ;; Only insert face bits on NEWLINE char mapping to avoid + ;; obstruction of other faces like TABs and (HARD) SPACEs + ;; faces, font-lock faces, etc. + (when (memq 'color whitespace-active-style) + (dotimes (i (length vec)) + ;; Due to limitations of glyph representation, the char + ;; code can not be above ?\x1FFFF. Probably, this will + ;; be fixed after Emacs unicode merging. + (or (eq (aref vec i) ?\n) + (> (aref vec i) #x1FFFF) + (aset vec i + (make-glyph-code (aref vec i) + whitespace-newline))))) + ;; Display mapping + (aset buffer-display-table (car entry) vec)) + ;; Newline char - don't display it + (t + ;; Do nothing + ))))))) + + +(defun whitespace-display-char-off () + "Turn off character display mapping." + (and whitespace-display-mappings + whitespace-display-table-was-local + (setq whitespace-display-table-was-local nil + buffer-display-table whitespace-display-table))) + + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + + +(provide 'whitespace) + + +(run-hooks 'whitespace-load-hook) + + +;; arch-tag: 1b1e2500-dbd4-4a26-8f7a-5a5edfd3c97e +;;; whitespace.el ends here
--- a/nt/README Thu Jan 31 13:49:17 2008 +0000 +++ b/nt/README Fri Feb 01 03:01:11 2008 +0000 @@ -21,6 +21,49 @@ See the INSTALL file in this directory for detailed instructions on building and installing Emacs on your system. +* EXE files produced + + Building and installing Emacs will produce the following executable + files in the bin directory. + + + emacs.exe - The main Emacs executable. As this is designed to run + as both a text-mode application (emacs -nw) and as a GUI application, + it will pop up a command prompt window if run directly from Explorer. + + + runemacs.exe - A wrapper for running Emacs as a GUI application + without popping up a command prompt window. + + + emacsclient.exe - A command-line client program that can + communicate with a running Emacs process. See the `Emacs Server' + node of the Emacs manul. + + + emacsclientw.exe - A version of emacsclient that does not open + a command-line window. + + + addpm.exe - A basic installer that creates Start Menu icons for Emacs. + Running this is optional. + + + cmdproxy.exe - Used internally by Emacs to work around problems with + the native shells in various versions of Windows. + + + ctags.exe, etags.exe - Tools for generating tag files. See the + `Tags' node of the Emacs manual. + + + ebrowse.exe - A tool for generating C++ browse information. See the + `Ebrowse' manual. + + + ddeclient.exe - A tool for interacting with DDE servers. + + + hexl.exe - A tool for converting files to hex dumps. See the + `Editing Binary Files' node of the Emacs manual. + + + movemail.exe - A helper application for safely moving mail from + a mail spool or POP server to a local user mailbox. See the + `Movemail' node of the Emacs manual. + + + digest-doc.exe, sorted-doc.exe - Tools for rebuilding the + built-in documentation. + * Further information There is a web page that serves as a FAQ for the Windows port of
--- a/src/ChangeLog Thu Jan 31 13:49:17 2008 +0000 +++ b/src/ChangeLog Fri Feb 01 03:01:11 2008 +0000 @@ -1,3 +1,8 @@ +2008-02-01 Kenichi Handa <handa@ni.aist.go.jp> + + * ccl.c (CCL_WRITE_CHAR): Fix overflow checking. + (CCL_WRITE_MULTIBYTE_CHAR): Likewise. + 2008-01-31 Kenichi Handa <handa@ni.aist.go.jp> * keyboard.c (make_ctrl_char): If C is a multibyte character, just