diff options
Diffstat (limited to '')
| -rw-r--r-- | .gitignore | 3 | ||||
| -rw-r--r-- | cache/.gitignore | 2 | ||||
| -rw-r--r-- | init.d/.gitignore | 1 | ||||
| -rw-r--r-- | init.d/main.org | 2715 | ||||
| -rw-r--r-- | init.el | 5 | ||||
| -rw-r--r-- | lisp/filladapt.el | 981 | ||||
| -rw-r--r-- | lisp/promela-mode.el | 985 | ||||
| -rw-r--r-- | lisp/template.el | 2609 | ||||
| -rw-r--r-- | lisp/themes/color-themes-alex.el | 48 | ||||
| -rw-r--r-- | lisp/themes/color-themes-monokai-alex.el | 33 | ||||
| -rw-r--r-- | lisp/winring.el | 597 | ||||
| -rw-r--r-- | templates/TEMPLATE.py.tpl | 3 |
12 files changed, 7982 insertions, 0 deletions
diff --git a/.gitignore b/.gitignore new file mode 100644 index 0000000..e8ad6bb --- /dev/null +++ b/.gitignore @@ -0,0 +1,3 @@ +*.elc +#*# +emacs-custom.el diff --git a/cache/.gitignore b/cache/.gitignore new file mode 100644 index 0000000..d6b7ef3 --- /dev/null +++ b/cache/.gitignore @@ -0,0 +1,2 @@ +* +!.gitignore diff --git a/init.d/.gitignore b/init.d/.gitignore new file mode 100644 index 0000000..abf136d --- /dev/null +++ b/init.d/.gitignore @@ -0,0 +1 @@ +*.el diff --git a/init.d/main.org b/init.d/main.org new file mode 100644 index 0000000..db999ab --- /dev/null +++ b/init.d/main.org @@ -0,0 +1,2715 @@ +#+PROPERTY: header-args :comments link :tangle yes :noweb no-export :results silent +#+STARTUP: overview + +* About this file + +This is my main emacs init file. It can be loaded by the init.el with +org-babel or can be tangled and compiled to =main.elc= and loaded +directly. + +If you're viewing this file in an org-mode buffer, you can open source +code blocks (those are the ones in begin_src) in a separate buffer by +moving your point inside them and typing C-c ' +(org-edit-special). This opens another buffer in emacs-lisp-mode, so +you can use M-x eval-buffer to load the changes. + +* Personal information + +#+begin_src emacs-lisp + (setq user-full-name "Alexander Sulfrian" + user-mail-address "alexander@sulfrian.net") +#+end_src + +* Initialization +** packages + +Add some more package repositories. + +#+begin_src emacs-lisp + (nconc package-archives + '(("melpa-stable" . "http://stable.melpa.org/packages/") + ("melpa" . "http://melpa.org/packages/") + ("org" . "http://orgmode.org/elpa/") + ("marmalade" . "http://marmalade-repo.org/packages/"))) +#+end_src + +By default the package system is initialized after evaluating the +user-init-file (this file) and I could not customize packages in this +file. So I initialize the package system right here and disable the +automatic initialization. + +#+begin_src emacs-lisp + (setq package-enable-at-startup nil + package-user-dir (locate-user-emacs-file "cache/elpa/")) + (package-initialize nil) +#+end_src + +** use-package + +I require use-package to simplify the configuration. This is a +requirement for this configuration, so I install it here. + +#+begin_src emacs-lisp + (eval-when-compile + (unless (package-installed-p 'use-package) + (package-install 'use-package)) + (setq use-package-verbose t) + (require 'use-package)) +#+end_src + +** auto-compile + +For faster start-up times, this init file should be compiled into +byte code. I use auto-compile mode for this. It will recompile files +on load if the byte compiled file exists but is outdated. + +#+begin_src emacs-lisp + (use-package auto-compile + :ensure t + :config (auto-compile-on-load-mode)) +#+end_src + +For safety reasons emacs should prefer the newer file, if the =*.el= +and =*.elc= file exists. + +#+begin_src emacs-lisp + (setq load-prefer-newer t) +#+end_src + +** dash + +#+begin_src emacs-lisp +(use-package dash + :demand t + :ensure t) +#+end_src emacs-lisp + +* General Setup +** Encoding + +Set all the encoding stuff to utf-8 (but to latin-1 on ZEDAT hosts). + +#+begin_src emacs-lisp + (let ((encoding + (if (string-match "\\.zedat.fu-berlin.de\\'" system-name) + 'latin-1 + 'utf-8))) + (setq locale-coding-system encoding) + (set-terminal-coding-system encoding) + (set-keyboard-coding-system encoding) + (set-selection-coding-system encoding) + (prefer-coding-system encoding)) +#+end_src + +** Customizing + +Emacs should not edit the init.el file when saving stuff from +customize. So I set a separate custom-file and load it. + +#+begin_src emacs-lisp + (setq custom-file "~/.emacs.d/emacs-custom.el") + (load custom-file) +#+end_src + +** Helper for configuration + +I need some functions to simplify the configuration below. They are +defined here. + +*** Get buffers with specific minor-mode + +Simply get a list of all buffers, where the specified minor-mode is +active. + +#+begin_src emacs-lisp + (defun alex/get-buffers-with (mode) + "Get a list of buffers where the given MODE is active. It is done by + evaluating the given symbol in all buffers and return a list with + all buffers where it evaluates to t. So actually MODE could be any + buffer-local variable." + (let ((state (mapcar (lambda (buf) + (with-current-buffer buf + (when (and (boundp mode) + (symbol-value mode)) + buf))) + (buffer-list)))) + (delq nil state))) +#+end_src + +*** Ignore errors of a function + +This macro first tries to execute the given fun and evaluate the body +afterwards, even if fun raised an error. After evaluation of body the +original return value (or error) of fun is returned. + +This is useful for around advices, that should be reset something +after calling the adviced function, even if it raises an error. + +#+begin_src emacs-lisp + (defmacro alex/safe-call (fun &rest body) + "Evaluate FUN and catch all errors, evaluates BODY afterwards + (regardless whether an error was raised or not) and finally returns + the result of FUN captured earlier or re-throw the error." + `(let* ((tmp (condition-case err + (list (,@fun) nil) + (error (list nil err)))) + (err (cadr tmp)) + (result (car tmp))) + ,@body + (when err + (signal (car err) (cdr err))) + result)) +#+end_src + +*** Get next element from list + +This lisp function returns the next element from a list. It is useful +if you want to switch a setting between multiple values. + +#+begin_src emacs-lisp + (defun alex/get-next (old list) + "Returns the element after OLD in LIST or the first element if OLD + is the last element or is not in LIST." + (let ((index (or (cl-position old list) -1)) + (len (length list))) + (nth (% (+ 1 index) len) list))) +#+end_src + +*** Exclude list for globalized minor-modes + +I want to define some global-minor-modes, but keep them disabled in +certain modes, buffers or in the minibuffer. So I declare some helper +to define exclude lists for custom global-minor-modes. + +#+begin_src emacs-lisp + (defun alex/parse-exclude-list (exclude-list) + "Convert a free from exlude list (with multiple keywords) in a + propper assoc list with the keywords as key and the values in + between as values." + (let ((keyword nil) + (res '()) + (args '())) + (dolist (elem exclude-list) + (if (keywordp elem) + (progn + (when keyword (setq res (nconc res (list keyword (or args 'empty))))) + (setq keyword elem + args '())) + (setq args (nconc args (list elem))))) + (nconc res (list keyword (or args 'empty))))) + + (defmacro alex/check-list (list var &rest body) + "Simple macro to check if body returns non-nil for any element in + the list." + `(if (eq ,list 'empty) + nil + (delq nil (mapcar + (lambda (,var) + ,@body) + ,list)))) + + (defun alex/safe-get-value (var) + "Get the value of the variable of nil if the given variable does not exists." + (if (boundp var) + (symbol-value var) + nil)) + + (defun alex/minor-mode-exclude (mode) + "Check the exclude list for the given mode. Returns t if the mode + should be excluded, else nil." + (let* ((exclude-list (intern (concat (symbol-name mode) "-exclude-list"))) + (excludes (alex/parse-exclude-list (symbol-value exclude-list)))) + (cond + ((and (plist-get excludes :minibuffer) (minibufferp)) + t) + ((alex/check-list (plist-get excludes :mode) mode + (cond ((derived-mode-p mode) t) + ((alex/safe-get-value mode) t))) + t) + ((alex/check-list (plist-get excludes :buffer) buf + (cond + ((and (symbolp buf) (eq (current-buffer) + (alex/safe-get-value buf))) + t) + ((and buf (eq (current-buffer) buf)) + t))) + t) + (t nil)))) +#+end_src + +Last I define a macro for defining a globalized minor-mode with the +exclude list feature. + +#+begin_src emacs-lisp + (defmacro alex/global-excluding-minor-mode (global mode &rest body) + "Define a global-minor-mode that can be disabled on some modes or + buffers. BODY is executed each time when the mode should be + activated (it passed the exclude list at this position). If BODY + is empty the mode will be simply activated." + (if `(not ,body) + `(define-globalized-minor-mode ,global ,mode + (lambda () + (unless (alex/minor-mode-exclude ',mode) + (,mode 1)))) + `(define-globalized-minor-mode ,global ,mode + (lambda () + (unless (alex/minor-mode-exclude ',mode) + ,@body))))) + + (defmacro alex/minor-mode-exclude-list (mode) + `(defvar ,(intern (concat (symbol-name mode) "-exclude-list")) + () + (concat "Exclude list for " (symbol-name ',mode) ". " + "Can contain :minibuffer, :modeq and :buffer."))) + + (defun alex/build-global-name (mode) + "Build the symbol for the global mode by inserting 'global-' after + 'alex/' or prepending 'alex/gloabl-' if MODE does not start with the + personal prefix." + (let ((name (symbol-name mode))) + (intern + (if (string-match "^alex/" name) + (replace-regexp-in-string "^alex/" "\\&global-" name) + (concat "alex/global-" name))))) + + (defun alex/define-global-excluding-minor-mode (mode &rest body) + (let ((global (alex/build-global-name mode))) + (eval `(alex/global-excluding-minor-mode ,global ,mode ,body)) + (eval `(alex/minor-mode-exclude-list ,mode)))) +#+end_src + +** Cache directory + +I want to keep all the changing files in one place, so I create +=~/.emacs.d/cache/= for this purpose. + +#+begin_src emacs-lisp + (let ((cache (locate-user-emacs-file "cache/"))) + (unless (file-directory-p cache) + (make-directory cache))) +#+end_src + +Additionally I define a helper function to create a file name inside +this cache directory. + +#+begin_src emacs-lisp + (defun alex/cache-file (filename) + (locate-user-emacs-file (concat "cache/" filename))) +#+end_src + +*** recentf + +Save the history of the last 1000 visited files. + +#+begin_src emacs-lisp + (setq recentf-save-file (alex/cache-file "recentf") + recentf-max-saved-items 1000) + (recentf-mode 1) +#+end_src + +*** save-place + +Save the last position in a file and raise the limit to 10k elements. + +#+begin_src emacs-lisp + (use-package saveplace + :config + (setq save-place-file (alex/cache-file "saveplace") + save-place-limit 10000) + (setq-default save-place t)) +#+end_src + +*** savehist + +Save a lot of history between emacs restarts. Save everything, but do +not keep duplicates. + +#+begin_src emacs-lisp + (setq savehist-file (alex/cache-file "savehist") + + history-length t + history-delete-duplicates t + + savehist-save-minibuffer-history t + savehist-additional-variables '(kill-ring + search-ring + regexp-search-ring)) +#+end_src + +Enable the =savehist-mode=. This has to be below the configuration, +because the history is loaded when this mode is activated the first +time. So the =savehist-file= has to be configured when activating. + +#+begin_src emacs-lisp + (savehist-mode 1) +#+end_src + +*** bookmarks + +Bookmarks are great to remember various positions in files. Save the +bookmark file every time I make a modification (so that I do not loose +a change, even if emacs or my laptop crashes). + +#+begin_src emacs-lisp + (setq bookmark-default-file (alex/cache-file "bookmarks") + bookmark-save-flag 1) +#+end_src + +*** backups + +Do not save backup files into the directory of the original file. + +#+begin_src emacs-lisp + (setq backup-directory-alist '(("." . "~/.emacs.d/backups"))) +#+end_src + +Do not delete old backup files. + +#+begin_src emacs-lisp + (setq delete-old-versions -1 + version-control t) +#+end_src + +Make backups even for files under version control. + +#+begin_src emacs-lisp + (setq vc-make-backup-files t) +#+end_src + +*** auto-save + +Do not save auto-save files into the directory of the original +file (especially important for editing files via tramp). + +#+begin_src emacs-lisp + (setq auto-save-file-name-transforms + `((".*" ,(alex/cache-file "auto-save-list/") t))) +#+end_src + +** Remove some annoyances +*** No startup message + +#+begin_src emacs-lisp + (setq inhibit-startup-message t) +#+end_src + +*** Newline at end of file + +Require a newline at end of file, but do not insert newlines +automatically just by moving the cursor down. + +#+begin_src emacs-lisp + (setq require-final-newline t + next-line-add-newlines nil) +#+end_src + +*** Yes or No + +I do not want to have to type =yes= and =no=. =y= or =n= should be +sufficient. + +#+begin_src emacs-lisp + (fset 'yes-or-no-p 'y-or-n-p) +#+end_src + +*** Symbolic links and version control + +Visit the real file (without question), if editing a symbolic links +that points to a file under version control. + +#+begin_src emacs-lisp + (setq vc-follow-symlinks t) +#+end_src + +** Visual +*** Window configuration + +Clean up the UI. No toolbar, but use scrollbars and tooltips to keep +the minibuffer clean. + +#+begin_src emacs-lisp + (tool-bar-mode -1) + (tooltip-mode 1) + (scroll-bar-mode 1) +#+end_src + +Use extremely small scroll-bars on the right. + +#+begin_src emacs-lisp + (set-scroll-bar-mode 'right) + (set-frame-parameter nil 'scroll-bar-width 10) + (nconc default-frame-alist '((scroll-bar-width . 10))) +#+end_src + +The menu-bar is helpful in the terminal (under X you can get a menu on +demand with <F10>). So I enable the menu-bar if no window-system is +available. To show the menu also in an emacsclient in the terminal, I +have to add a hook in the =after-make-frame-function=. + +#+begin_src emacs-lisp + (defun alex/update-menu-bar (&optional frame) + "This displays the menu bar if the given FRAME (default: selected + frame) is in a terminal" + (let ((status (if (display-graphic-p frame) 0 1))) + (set-frame-parameter frame 'menu-bar-lines status))) + + (alex/update-menu-bar) + (add-hook 'after-make-frame-functions 'alex/update-menu-bar) +#+end_src + +*** Color-theme + +Use own color theme and switch it depending whether the frame is on +terminal or under X11. + +#+begin_src emacs-lisp + (use-package color-theme + :demand t + :config + (setq color-theme-directory "~/.emacs.d/lisp/themes/" + color-theme-load-all-themes nil) + + (color-theme-initialize) + (color-theme-monokai-alex) + + (defun alex/update-color-theme (&optional frame) + (let ((color-theme-is-global nil)) + (if (display-graphic-p frame) + (color-theme-monokai-alex) + (color-theme-alex-console)))) + (add-hook 'after-make-frame-functions 'alex/update-color-theme)) +#+end_src + +I always want to have as much as possible syntax highlighting. + +#+begin_src emacs-lisp + (global-font-lock-mode t) + (setq font-lock-maximum-decoration t) +#+end_src + +*** Cleanup minor-modes in modeline + +I want to hide some minor-modes, if they are activated in nearly all +buffers or it is irrelevant if they are activated. + +To be compatible with powerline I use rich-minority, but I add some +custom stuff to fake the interface of diminish so that I can use the +diminish feature of use-package. + +I can use :diminish in use-package with either a mode name or e regexp +to hide matching modes. + +#+begin_src emacs-lisp + (use-package rich-minority + :ensure t + :config + (defvar alex/minor-mode-blacklist () + "List of regexp that is matched against the lighter of all + minor-modes. All matching minor-modes are hidden in the mode line.") + + (defun alex/rm-add-blacklist (regexp) + "Add the given REGEXP to alex/minor-modes-blacklist and updates the + combined regexp in rm-blacklist afterwards." + (unless (member regexp alex/minor-mode-blacklist) + (setq alex/minor-mode-blacklist + (nconc alex/minor-mode-blacklist (list regexp))) + (alex/update-rm-blacklist)) + alex/minor-mode-blacklist) + + (defun alex/update-rm-blacklist () + "Update rm-blacklist and build a regexp from the multiple values in + alex/minor-modes-blacklist." + (setq rm-blacklist + (format "^\\(%s\\)$" + (mapconcat #'identity alex/minor-mode-blacklist "\\|")))) + + (defun alex/get-lighter (mode) + "Get the lighter for the given minor-mode." + (let ((value (assoc mode minor-mode-alist))) + (if value + (let ((lighter (cadr value))) + (if (symbolp lighter) + (when (boundp lighter) + (eval lighter)) + lighter)) + nil))) + + (defun diminish (mode &optional regexp) + "This is a fake diminish with rich-minority-mode. It accepts uses + either the MODE or if given the REGEXP to hide the mode." + (if (and regexp (> (length regexp) 0)) + (alex/rm-add-blacklist regexp) + (let ((lighter (alex/get-lighter mode))) + (when lighter + (alex/rm-add-blacklist lighter))))) + + (rich-minority-mode 1)) +#+end_src + +*** Trailing whitespaces + +I generally want to show trailing whitespaces, but there are several +exceptions. Per default there is only a buffer local variable to +control this feature. I create a simple minor-mode, so that I could +simply activate or deactivate this feature. + +#+begin_src emacs-lisp + (define-minor-mode alex/tw-mode + "trailing-whitespace-mode" + :lighter " TW" + (setq show-trailing-whitespace alex/tw-mode)) + + (alex/define-global-excluding-minor-mode 'alex/tw-mode) +#+end_src + +I want to disable trailing whitespaces in the minibuffer, in weechat, +helm and term-mode and in the which-key buffer. So I define here the +exclude list. + +#+begin_src emacs-lisp + (setq alex/tw-mode-exclude-list + '(:minibuffer + :mode + helm--remap-mouse-mode + weechat-mode + term-mode + Custom-mode + :buffer + which-key--buffer)) +#+end_src + +And now activate the new global mode and hide it from the mode line. + +#+begin_src emacs-lisp + (alex/global-tw-mode t) + (diminish 'alex/tw-mode) +#+end_src + +*** Visual-wrap-column + +Sometimes I want to force =visual-line-wrap= at a specific column (in +contrast to the window width). This is especially useful for emails, +that are badly formatted with long lines. =visual-line-wrap= will +split long lines at the word-break before the specified column. + +#+begin_src emacs-lisp + (defvar alex/visual-wrap-column nil + "Column to force visual line wrap. Use `alex/set-visual-wrap-column' + to change the value.") + + (defun alex/set-visual-wrap-column (new-wrap-column &optional buffer) + "Force visual line wrap at NEW-WRAP-COLUMN in BUFFER (defaults to + current buffer) by setting the right-hand margin on every window that + displays BUFFER. A value of NIL or 0 for NEW-WRAP-COLUMN disables this + behavior." + (interactive (list (read-number "New visual wrap column, 0 to disable: " + (or alex/visual-wrap-column fill-column 0)))) + (when (and (numberp new-wrap-column) + (zerop new-wrap-column)) + (setq new-wrap-column nil)) + + (with-current-buffer (or buffer (current-buffer)) + (visual-line-mode t) + (set (make-local-variable 'alex/visual-wrap-column) new-wrap-column) + (add-hook 'window-configuration-change-hook + 'alex/update-visual-wrap-column nil t) + + (let ((windows (get-buffer-window-list))) + (dolist (win windows) + (when (window-live-p win) + (with-selected-window win + (alex/update-visual-wrap-column))))))) + + (defun alex/update-visual-wrap-column () + "Update the right margin of the current window, to match the + available space to `alex/visual-wrap-column'." + (if (not alex/visual-wrap-column) + (set-window-margins nil nil) + (let* ((current-margins (window-margins)) + (right-margin (or (cdr current-margins) 0)) + (current-width (window-width)) + (current-available (+ current-width right-margin))) + (if (<= current-available alex/visual-wrap-column) + (set-window-margins nil (car current-margins)) + (set-window-margins nil (car current-margins) + (- current-available alex/visual-wrap-column)))))) +#+end_src + +** Localization + +I want to use german names for month and weekdays. + +#+begin_src emacs-lisp + (setq calendar-week-start-day 1 + calendar-day-name-array ["Sonntag" "Montag" "Dienstag" "Mittwoch" + "Donnerstag" "Freitag" "Samstag"] + calendar-month-name-array ["Januar" "Februar" "März" "April" "Mai" + "Juni" "Juli" "August" "September" + "Oktober" "November" "Dezember"]) +#+end_src + +** Browser + +I have a simple wrapper script to be able to easily switch to a +different browser. So I only have to configure to use this wrapper +script. + +#+begin_src emacs-lisp + (setq browse-url-browser-function 'browse-url-generic + browse-url-generic-program "browser") +#+end_src + +** Movement + +The defaults for the cursor movement and scrolling are not very good, +so I need to customize the settings to match the expectations. + +*** Scrolling + +If I move the cursor out of screen, I do not want to jump to recenter +the cursor, but scroll just as far to display the cursor again. + +#+begin_src emacs-lisp + (setq scroll-conservatively 10000 + auto-window-vscroll nil) +#+end_src + +Do not accelerate mouse scrolling. + +#+begin_src emacs-lisp + (setq mouse-wheel-progressive-speed nil) +#+end_src + +Automatic scroll the compilation output to the bottom (or the first +error). + +#+begin_src emacs-lisp + (setq compilation-scroll-output t) +#+end_src + +*** Automatic indentation + +Automatic indent new lines. + +#+begin_src emacs-lisp + (bind-key "RET" 'newline-and-indent) +#+end_src + +But clean whitespaces, if the indentation is abandoned. + +#+begin_src emacs-lisp + (use-package clean-aindent-mode + :config + (clean-aindent-mode t)) +#+end_src + +*** Back to indentation + +I want to have a better handling for the =<home>= key. Per default I +want to move the cursor to the end of the indentation (first +non-whitespace character). Only if the cursor is already at that +position, I want to move to the beginning of the line. + +#+begin_src emacs-lisp + (defun alex/back-to-indentation-or-beginning () + "Move the point to the first non-whitespace character on the line, + of if it is already there, to the beginning of the line." + (interactive) + (if (= (point) (save-excursion (back-to-indentation) (point))) + (beginning-of-line) + (back-to-indentation))) + + (bind-key "<home>" 'alex/back-to-indentation-or-beginning) +#+end_src + +*** Ungreedy kill-word + +The default =kill-word= (and =backward-kill-word=) is a bit greedy. I +want to replace =forward-word= in the original definition with +=forward-same-syntax=. + +This could not be done with an advice because =forward-word= is a byte +code primitive and could not be replaced with =flet= or something like +that. So I have to copy the original definition of kill-word here and +simple do the replacement in the source. + +#+begin_src emacs-lisp + (defun kill-word (arg) + "Kill characters forward until encountering the end of a word. + With argument ARG, do this that many times." + (interactive "p") + (kill-region (point) (progn (forward-same-syntax arg) (point)))) +#+end_src + +** Selection + +The selection is the region between the mark and the point. But I want +to see the active region, so I want to ensure, that +transient-mark-mode is enabled globally. + +#+begin_src emacs-lisp +(transient-mark-mode 1) +#+end_src + +Additionally I have some enhancements to the default behaviour of some +commands. + +*** Kill or copy whole line + +If no region is active, I want to kill/copy the current line. + +#+begin_src emacs-lisp + (defun alex/whole-line (func beg end &rest region) + (interactive (if mark-active + (list (region-beginning) (region-end)) + (list (line-beginning-position) + (line-beginning-position 2)))) + (apply func beg end region)) + + (advice-add 'kill-ring-save :around #'alex/whole-line) + (advice-add 'kill-region :around #'alex/whole-line) +#+end_src + +*** Rectangle selection + +The rectangle selection of cua mode works very well, but I only want +the rectangle selection mode and not the C-z/C-x/C-c/C-v bindings. + +#+begin_src emacs-lisp + (setq cua-rectangle-mark-key (kbd "M-SPC") + cua-delete-selection nil) + (cua-selection-mode t) +#+end_src + +*** X11 clipboard + +Use the X11 clipboard in addition to the primary selection, because +some other X11 apps can only use the X11 clipboard. + +#+begin_src emacs-lisp + (setq x-select-enable-clipboard t) + (setq interprogram-paste-function 'x-selection-value) +#+end_src + +** Custom commands + +Here I define some global custom commands. These commands are bind +in the =global-map= and are not associated with any other package. + +*** Open terminal + +Open an external terminal in the default directory of the current +buffer. In most cases this is the directory containing the file of the +current buffer. + +#+begin_src emacs-lisp + (defun alex/open-buffer-shell () + "Open a terminal in the default directory of the current buffer." + (interactive) + (if default-directory + (start-process-shell-command + "urxvt" + nil + (concat "DIR=" default-directory " urxvt")) + (message "Buffer does not contain a file."))) + + (bind-key "<f12>" 'alex/open-buffer-shell) +#+end_src + +** Bug fixes + +A few workarounds about some strange emacs behaviour. + +*** Key mapping + +Some versions of urxvt send some strange key codes for some key +combinations. The following table contains the mappings from the +key codes send by urxvt and the real keys. + +#+tblname: key-mappings +| Keycode | Key | +|-------------+-------------| +| M-[ Z | <S-tab> | +| <select> | <S-up> | +| M-[ b | <S-down> | +| M-[ c | <S-right> | +| M-[ d | <S-left> | +| M-O a | <C-up> | +| M-O b | <C-down> | +| M-O c | <C-right> | +| M-O d | <C-left> | +| ESC M-O a | <C-M-up> | +| ESC M-O b | <C-M-down> | +| ESC M-O c | <C-M-right> | +| ESC M-O d | <C-M-left> | +| ESC M-O A | <M-up> | +| ESC M-O B | <M-down> | +| ESC M-O C | <M-right> | +| ESC M-O D | <M-left> | +| ESC M-[ a | <M-S-up> | +| ESC M-[ b | <M-S-down> | +| ESC M-[ c | <M-S-right> | +| ESC M-[ d | <M-S-left> | +| <clearline> | <C-end> | + +The tables is converted into the real key mappings with the following +function. It uses the org-babel stuff to convert the org-table into an +emacs-lisp variable. + +#+begin_src emacs-lisp :var mappings=key-mappings + (if (not window-system) + (mapc (lambda (row) + (define-key function-key-map + (read-kbd-macro (car row)) + (read-kbd-macro (cadr row)))) + mappings)) +#+end_src + +*** Scroll speed + +The scroll speed of emacs (at least 24.1) was very slow (esp. in +wanderlust summary buffers). The problem was, that for each line the +paragraph direction was checked. Because I do not use right-to-left +languages, I disable the auto detection + +#+begin_src emacs-lisp + (when (boundp 'bidi-paragraph-direction) + (setq-default bidi-paragraph-direction 'left-to-right)) +#+end_src + +*** Sit-for + +=sit-for= seems to modify the current-buffer and causes error message +during find-file (if a backup file exists). This fixes the problem +providing =sit-for= with a temporary buffer, that is destroyed +afterwards. + +#+begin_src emacs-lisp + (defun alex/save-current-buffer (orig-fun &rest args) + "Do not allow the advised function to change the current-buffer." + (with-temp-buffer + (apply orig-fun args))) + (advice-add 'sit-for :around #'alex/save-current-buffer) +#+end_src +* Modes +** Core modes + +These modes are part of the core and the auto-mode-alist is set up +automatically. So the mode should not be required. + +*** cc-mode + +Here I only add a hook for the configuration and a key-binding for the +mode key-map. + +#+begin_src emacs-lisp + (defun alex/c-mode-setup () + ;; auto fill at column 80 + (setq fill-column 80) + (turn-on-auto-fill) + + ;; semantic as for auto-complete + (add-to-list 'ac-sources ac-source-semantic) + + ;; now '_' is not considered a word-delimiter + (modify-syntax-entry ?_ "w") + + ;; indentation style + (c-set-style "linux") + (setq indent-tabs-mode t + c-basic-offset 4 + tab-width 4) + + (bind-key "C-c o" 'ff-find-other-file 'c-mode-map)) + + (add-hook 'c-mode-common-hook 'alex/c-mode-setup) +#+end_src + +*** text-mode + +I only activate =auto-fill-mode= for =text-mode= here. Additionally I +activate =text-mode= automatically for all files called only with +capital letters and without extension (like README or INSTALL). + +#+begin_src emacs-lisp +(setq text-mode-hook 'turn-on-auto-fill) +(add-to-list 'auto-mode-alist '("\\`[A-Z]+\\'" . text-mode)) +#+end_src + +** Additional modes + +Some additional modes for editing of special files types. Most of +them do not requires special configuration only =:mode= or +=:interpreter= from use-package to enable auto loading. + +*** apache-mode + +#+begin_src emacs-lisp + (use-package apache-mode + :mode ("\.htaccess$" "htpd\\.conf$" "srm\\.conf$" "access\\.conf$" + "apache[12]\?\\.conf$" "commonapache[12]\?\\.conf$" + "\/sites-enabled\/.*\.conf$")) +#+end_src + +*** arduino-mode + +#+begin_src emacs-lisp + (use-package arduino-mode + :mode "\\.pde\\'") +#+end_src + +*** auctex + +#+begin_src emacs-lisp + (use-package auctex + :mode ("\\.tex\\'" . latex-mode) + :commands (latex-mode LaTeX-mode plain-tex-mode) + :config + (setq TeX-view-program-list '(("Zathura" "zathura %o")) + TeX-view-program-selection '((output-pdf "Zathura")))) +#+end_src + +*** autoconf-mode + +#+begin_src emacs-lisp + (use-package autoconf-mode + :mode ("\\.ac\\'" "configure\\.in\\'" + ("\\.at\\'" . autotest-mode))) +#+end_src + +*** bibtex + +#+begin_src emacs-lisp + (use-package bibtex + :mode ("\\.bib" . bibtex-mode)) +#+end_src + +*** crontab-mode + +#+begin_src emacs-lisp + (use-package crontab-mode + :commands (crontab-mode)) +#+end_src + +*** css-mode + +The css-mode requires a few adjustments for the indentation style. + +#+begin_src emacs-lisp + (use-package css-mode + :mode "\\.css\\'" + :functions (cssm-c-style-indenter) + :config + (setq cssm-indent-level 4 + cssm-newline-before-closing-bracket t + cssm-indent-function #'cssm-c-style-indenter)) +#+end_src + +*** csv-mode + +#+begin_src emacs-lisp + (use-package csv-mode + :mode "\\.[Cc][Ss][Vv]\\'") +#+end_src + +*** ebuild-mode + +#+begin_src emacs-lisp + (use-package ebuild-mode + :mode ("\\.ebuild\\'" "\\.eclass\\'" "\\.eblit\\'" + ("/[0-9]\\{4\\}-[01][0-9]-[0-3][0-9]-.+\\.[a-z]\\{2\\}\\.txt\\'" + . gentoo-newsitem-mode)) + :interpreter ("runscript" . sh-mode)) +#+end_src + +*** eselect-mode + +#+begin_src emacs-lisp + (use-package eselct-mode + :mode "\\.eselect\\'") +#+end_src + +*** graphviz-dot-mode + +#+begin_src emacs-lisp + (use-package graphviz-dot-mode + :mode ("\\.dot\\'" "\\.gv\\'")) +#+end_src + +*** haskell-mode + +I need haskell-mode and it is required to initialize the indentation +scheme on activation (else a pop-up will ask you to do so, if you press +=<TAB>= inside a haskell buffer). + +#+begin_src emacs-lisp + (use-package haskell-mode + :mode ("\\.hs\\'" "\\.gs\\'" "\\.hi\\'" + ("\\.l[gh]s\\'" . literate-haskell-mode) + ("\\.cabal\\'" . haskell-cabal-mode)) + :interpreter ("runghc" "runhaskell") + :config + (add-hook 'haskell-mode-hook 'turn-on-haskell-indentation)) +#+end_src + +*** javascript + +#+begin_src emacs-lisp + (use-package javascript + :mode ("\\.js\\'" . javascript-mode)) +#+end_src + +*** lua-mode + +#+begin_src emacs-lisp + (use-package lua-mode + :mode "\\.lua\\'") +#+end_src + +*** php-mode + +#+begin_src emacs-lisp + (use-package php-mode + :mode ("\\.php[s34]?\\'" "\\.phtml\\'" "\\.inc\\'")) +#+end_src + +*** po-mode + +#+begin_src emacs-lisp + (use-package po-mode + :mode "\\.po\\'\\|\\.po\\.") +#+end_src + +*** promela-mode + +Simple mode for promela files. The file extension is not standardized, +so I add a few different extensions. + +#+begin_src emacs-lisp + (use-package promela-mode + :mode ("\\.promela\\'" "\\.spin\\'" "\\.pml\\'" "\\.prm\\'" "\\.porm\\'") + :config + (setq promela-block-indent 2 + promela-selection-indent 0 + promela-selection-option-indent 3)) +#+end_src + +*** protobuf-mode + +#+begin_src emacs-lisp + (use-package protobuf-mode + :mode "\\.proto\\'") +#+end_src + +*** python + +#+begin_src emacs-lisp + (use-package python + :mode ("\\.py\\'" . python-mode) + :interpreter ("python" . python-mode) + :functions (python-continuation-line-p) + :config + <<python>>) +#+end_src + +**** Fix indentation of closing brackets + +This fixes the indentation of the closing brackets for line +continuations in python. The opening and closing brackets should be +lined up in the same column. + +#+begin_src emacs-lisp :noweb-ref python :tangle no + (defun alex/python-indent-closing-brackets (func &rest args) + "Handle lines beginning with a closing bracket and indent them so that + they line up with the line containing the corresponding opening bracket." + (save-excursion + (beginning-of-line) + (let ((syntax (syntax-ppss))) + (if (and (not (eq 'string (syntax-ppss-context syntax))) + (python-continuation-line-p) + (cadr syntax) + (skip-syntax-forward "-") + (looking-at "\\s)")) + (progn + (forward-char 1) + (ignore-errors (backward-sexp)) + (current-indentation)) + (apply func args))))) + + (advice-add 'python-calculate-indentation :around + #'alex/python-indent-closing-brackets) +#+end_src + +*** xrdb-mode + +#+begin_src emacs-lisp + (use-package xrdb-mode + :mode ("\\.Xdefaults\\'" "\\.Xenvironment\\'" "\\.Xresources\'" + "\\.Xdefaults.d/")) +#+end_src + +* Packages +** ace-window + +ace-window is a replacement for =C-x o= that let you switch to a +specific window. It displays a marker in all windows and switch to the +select one. It is also possible execute some actions on the window +(swap, split or delete) by pressing a dispatch key before selecting +the window. It is not optimal, because it does not display the +possibility. Maybe I will replace it with a custom hydra. + +#+begin_src emacs-lisp + (use-package ace-window + :bind (("C-x o" . ace-window) + ("C-x C-o" . aw-flip-window)) + :config + (setq aw-scope 'frame + aw-dispatch-always t + aw-dispatch-alist '((?x aw-delete-window " Ace - Delete Window") + (?m aw-swap-window " Ace - Swap Window") + (?n aw-flip-window) + (?v aw-split-window-vert " Ace - Split Vert Window") + (?h aw-split-window-horz " Ace - Split Horz Window") + (?i delete-other-windows " Ace - Maximize Window") + (?o delete-other-windows)))) +#+end_src + +** auto-complete + +auto-complete uses a popup to display possible completions of the +input. The popup is displayed automatically after some idle time or +when pressing the shortcut (but the auto-complete-mode has to be +enabled before). + +#+begin_src emacs-lisp + (use-package auto-complete + :bind ("M-<tab>" . auto-complete) + :demand t + :diminish auto-complete-mode + :config + (require 'auto-complete-config) + (ac-config-default) + + (setq ac-comphist-file (alex/cache-file "ac-comphist.dat") + ac-quick-help-delay 1.0) + + (global-auto-complete-mode t)) +#+end_src + +** TODO company-mode + +Should be better than auto-complete-mode and the code should be more +modern. + +** cursor-chg + +I want to change the cursor if the buffer is readonly or if I enabled +overwrite. =cursor-chg= can change the shape of the cursor. The color +of the cursor could not be changed, because the cursor-color is a +frame parameter and could be set for a single buffer. + +#+begin_src emacs-lisp + (use-package cursor-chg + :config + (toggle-cursor-type-when-idle 1) + (change-cursor-mode 1)) +#+end_src + +** deft + +#+begin_src emacs-lisp + (use-package deft + :bind ("<f9>" . deft) + :config + (setq deft-extension "org" + deft-directory "~/.org/deft/" + deft-text-mode 'org-mode)) +#+end_src + +** dired-x + +I use dired-x mostly for the features for omitting files. I customize +the arguments for the listing to add a trailing slash for directories +(that way I can omit files like =*.d= but keep directories matching +the same regexp). I enable =dired-omit-mode= per default in all dired +buffers. + +#+begin_src emacs-lisp + (use-package dired-x + :config + (setq dired-omit-files "^\\.?#\\|~$\\|^\\.svn/$\\|^\\.git\$" + dired-omit-extensions (append completion-ignored-extensions + dired-latex-unclean-extensions + dired-bibtex-unclean-extensions + dired-texinfo-unclean-extensions) + dired-listing-switches "-pal --group-directories-first") + + (add-hook 'dired-mode-hook (lambda () (dired-omit-mode 1)))) +#+end_src +** doxymacs + +Currently I use doxymacs only to add font-lock for doxymacs tags. + +#+begin_src emacs-lisp + (defun alex/doxymacs-font-lock () + (when (member major-mode '(c-mode c++-mode)) + (when (not (fboundp 'doxymacs-font-lock)) + (use-package doxymacs + :load-path "/usr/share/emacs/site-lisp/doxymacs/") + (when (not (fboundp 'doxymacs-font-lock)) + (fset 'doxymacs-font-lock 'ignore))) + (doxymacs-font-lock))) + + (add-hook 'font-lock-mode-hook 'alex/doxymacs-font-lock) +#+end_src + +** edit-server + +Allow to exit text areas from a browser with emacs. Open the buffers +in a new frame in org-mode. + +#+begin_src emacs-lisp + (use-package edit-server + :config + (setq edit-server-new-frame t + edit-server-default-major-mode 'org-mode + edit-server-new-frame-alist '((name . "EDIT with Emacs"))) + + (edit-server-start)) +#+end_src + +** expand-region + +This will create a region around semantic elements and let you expand +and contract it around larger/smaller semantic units. + +#+begin_src emacs-lisp + (use-package expand-region + :bind (("C-<return>" . er/expand-region) + ("M-<return>" . er/contract-region))) +#+end_src + +** filladapt + +Indent a filled line (manual or with auto-fill-mode) according to some +heuristics with spaces, comments or citation marks. This is not +available on ELPA so we need to load it from the local =lisp/= folder +in the =user-emacs-directory=. + +#+begin_src emacs-lisp + (use-package filladapt + :load-path "lisp/" + :diminish filladapt-mode + :config + (setq-default filladapt-mode t) + (add-hook 'org-mode-hook #'turn-off-filladapt-mode) + (add-hook 'compilation-mode-hook #'turn-off-filladapt-mode)) +#+end_src +** flymake-jshint + +When entering a javascript buffer, try to load flymake-jshint and +activate flymake-mode when it could be loaded successfully. This is a +possibility to defer the loading of the flymake-jshint library until +it is really required. + +#+begin_src emacs-lisp + (defun alex/jshint-init () + "Try to load `flymake-jshint' if not already loaded and activate + flymake-mode if it could be loaded successfully." + (if (fboundp 'flymake-jshint-init) + (flymake-mode 1) + (use-package flymake-jshint) + (when (fboundp 'flymake-jshint-init) + (flymake-mode 1)))) + + (add-hook 'js-mode-hook 'alex/jshint-init) +#+end_src + +** git-gutter-fringe + +If running under X11 I want to have little git marker on the right +side in the fringe. Therefore I use git-gutter-fringe and I override +the modification function from =fringe-helper= because it does +something strange with the beg and end parameters. + +To make space for the git-gutter signs, I extend the width of the +right fringe a bit (left side is kept at the default width). + +#+begin_src emacs-lisp + (use-package git-gutter-fringe + :if window-system + :config + (setq git-gutter-fr:side 'right-fringe) + (fringe-mode '(nil . 15)) + (global-git-gutter-mode +1) + + ;; fix the helper function (does something strange with beg and end) + (defun fringe-helper-modification-func (ov after-p beg end &optional len) + ;; Sometimes this hook is called with a deleted overlay. + (when (overlay-start ov) + (let ((ov-beg (overlay-start ov)) + (ov-end (overlay-end ov))) + (if after-p + (if (eq beg end) + ;; evaporate overlay + (delete-overlay ov) + ;; if new lines are inserted, add new bitmaps + (let ((before-string (overlay-get ov 'before-string)) + fringe-ov) + (save-excursion + (goto-char ov-beg) + (while (search-forward "\n" ov-end t) + (setq fringe-ov (make-overlay (point) (point))) + (overlay-put fringe-ov 'before-string before-string) + (overlay-put fringe-ov 'fringe-helper-parent ov))))) + ;; if a \n is removed, remove the fringe overlay + (save-excursion + (goto-char ov-beg) + (while (search-forward "\n" ov-end t) + (let ((overlays (overlays-in (point) (1+ (point))))) + (while overlays + (when (eq (overlay-get (car overlays) 'fringe-helper-parent) ov) + (delete-overlay (car overlays)) + (setq overlays nil)) + (pop overlays))))))))) + :diminish + git-gutter-mode) +#+end_src +** helm + +I use helm completion everywhere and I do /not/ autoload helm, because +it would slow down the first completions and I am sure I will use helm +every time I start emacs. + +#+begin_src emacs-lisp + (use-package helm + :bind (("M-x" . helm-M-x) + ("M-X" . execute-extended-command) + ("C-x f" . helm-mini) + ("C-x b" . helm-buffers-list) + ("C-x C-b" . helm-buffers-list) + ("M-y" . helm-show-kill-ring)) + :demand t + :ensure t + :diminish helm-mode + :config + <<helm-config>> + (helm-mode 1)) +#+end_src + +The basic configuration for helm is provided by helm-config. + +#+begin_src emacs-lisp :noweb-ref helm-config :tangle no + (use-package helm-config) +#+end_src + +Customize the prefix key and setup =<tab>= as convenient execute the +persistent-action without quitting helm. + +#+begin_src emacs-lisp :noweb-ref helm-config :tangle no + (bind-key "<tab>" 'helm-execute-persistent-action helm-map) + (setq helm-command-prefix-key "C-c h") +#+end_src + +*** configuration + +Now I customize the helm configuration: + +**** visual + +I want to split the current window to display the helm completion +window and want to cycle through the results. + +#+begin_src emacs-lisp :noweb-ref helm-config :tangle no + (setq helm-split-window-in-side-p t + helm-move-to-line-cycle-in-source t) +#+end_src + +**** scroll other window + +I do not want to scroll the other window by pages, but by 10 +lines. This is useful, if I preview a file or a buffer with the +persistent action and want to scoll around a bit. + +#+begin_src emacs-lisp :noweb-ref helm-config :tangle no + (setq helm-scroll-amount 10) +#+end_src + +**** history + +I want to use =recentf-list= instead of the normal =file-name-history=, +because it is more configurable and more complete. + +I /always/ want to save the history for executed commands, even if the +command has failed. + +#+begin_src emacs-lisp :noweb-ref helm-config :tangle no + (setq helm-ff-file-name-history-use-recentf t + helm-M-x-always-save-history t) +#+end_src + +**** fuzzy matching + +Enable fuzzy matching on some helm modes. There is also +=helm-mode-fuzzy-match= that would enable fuzzy match in every helm +mode, that would also modify sorting. + +#+begin_src emacs-lisp :noweb-ref helm-config :tangle no + (setq helm-apropos-fuzzy-match t + helm-buffers-fuzzy-matching t + helm-ff-fuzzy-matching t + helm-projectile-fuzzy-match t + helm-recentf-fuzzy-match t + helm-M-x-fuzzy-match t) +#+end_src + +**** recursive minibuffers + +Recursive minibuffers allow to execute a minibuffer command while +currently in the minibuffer. With this enabled, I could use the +/completion at point/ from the minibuffer (maybe from +=eval-expression=). + +#+begin_src emacs-lisp :noweb-ref helm-config :tangle no + (setq enable-recursive-minibuffers t) +#+end_src + +*** helm-projectile + +Enable helm support for projectile and replace many projectile +commands with helm completion. + +#+begin_src emacs-lisp + (use-package helm-projectile + :ensure t + :after (helm) + :init + ; This needs to be set before loading helm-projectile + (setq helm-projectile-fuzzy-match t) + :config + (helm-projectile-on)) +#+end_src +** hydra + +With hydra I can build easy groups of commands that (maybe) can +repeated and share a common prefix. The advantage over other +mechanisms is, that hydra will show a overview of the available keys +after pressing the prefix. It is very flexible and maybe I should +create more hydras. + +#+begin_src emacs-lisp + (use-package hydra + :bind (("C-M-s" . alex/hydra-splitter/body) + ("<f2>" . alex/hydra-zoom/body) + ("C-t" . alex/hydra-toggle/body)) + :config + <<helm>>) +#+end_src + +*** move splitter + +With this hydra I can move the splitter between frames using the +cursor keys. + +#+begin_src emacs-lisp :noweb-ref helm :tangle no + (require 'hydra-examples) + (defhydra alex/hydra-splitter () + "Move window spitter" + ("<left>" hydra-move-splitter-left) + ("<right>" hydra-move-splitter-right) + ("<up>" hydra-move-splitter-up) + ("<down>" hydra-move-splitter-down)) +#+end_src + +*** zoom + +With this hydra I can change font site on demand, by repeatedly +pressing + or - until the desired font-size is reached. + +#+begin_src emacs-lisp :noweb-ref helm :tangle no + (defhydra alex/hydra-zoom () + "Change font size" + ("+" text-scale-increase "zoom in") + ("-" text-scale-decrease "zoom out")) +#+end_src + +*** toggle + +With this hydra I can toggle various common settings (or minor-modes) +using some shortcuts. + +Because the keys are already documented in the docstring, hydra should +not show all the keys again in the mode line and we globally set the +hint to nil. + +#+begin_src emacs-lisp :noweb-ref helm :tangle no + (defhydra alex/hydra-toggle (:hint nil) + " + + Toggle common settings/minor-modes: + + \[_d_\] debug-on-error: %`debug-on-error + \[_f_\] auto-fill-mode: %`auto-fill-function + \[_l_\] truncate-lines: %`truncate-lines + \[_w_\] whitespace-mode: %`whitespace-mode + \[_t_\] trailing-whitespaces: %`alex/tw-mode + \[_s_\] flyspell-mode: %`flyspell-mode + + \[_q_\] quit + " + ("d" toggle-debug-on-error) + ("f" auto-fill-mode) + ("l" toggle-truncate-lines) + ("w" whitespace-mode) + ("t" alex/tw-mode) + ("s" flyspell-mode) + ("q" nil)) +#+end_src + +** imenu + +=imenu= is part of core and does not need to be required. + +#+begin_src emacs-lisp + (bind-key [mouse-3] 'imenu) +#+end_src + +** ispell + +I want to use aspell to check the spelling. It correctly supports +Unicode and can have a very good quality of the suggestions. + +#+begin_src emacs-lisp + (setq ispell-program-name "aspell" + ispell-extra-args '("--sug-mode=slow")) +#+end_src + +Normally I do not want to enable flyspell-mode automatically. I only +want to enable it, if I specify a dictionary with =flyspell-dict= as +file-local variable. + +Here I define a buffer-local variable and allow the setting of all +strings as local variable without question. + +#+begin_src emacs-lisp + (defvar flyspell-dict nil + "Dictionary name, that should be set during `find-file' for + `flyspell-mode'. Set this as file-local or dir-local variable to + enable `flyspell-mode' automaticaly.") + (make-variable-buffer-local 'flyspell-dict) + (put 'flyspell-dict 'safe-local-variable #'stringp) +#+end_src + +Enable ispell (if available) and iterate with =F8= over the list of +preferred dictionaries. + +#+begin_src emacs-lisp + (use-package ispell + :config + (defvar alex/dictionaries '("english" "german") + "List of available dictionaries for ispell.") + + (defun alex/switch-dictionary() + (interactive) + (let ((new (alex/get-next ispell-current-dictionary alex/dictionaries))) + (ispell-change-dictionary new) + (message "Dictionary switched to %s" new))) + (global-set-key (kbd "<f8>") 'switch-dictionary) + + (use-package flyspell + :config + <<flyspell-config>>)) +#+end_src + +Update the flyspell status on various changes to the spell checking +(selecting a different dictionary or adding a word to the personal +dictionary). + +#+begin_src emacs-lisp :noweb-ref flyspell-config :tangle no + (defun alex/flyspell-update (&rest args) + (when flyspell-mode + (flyspell-buffer))) + + (add-hook 'flyspell-mode-hook 'alex/flyspell-update) + (advice-add 'ispell-change-dictionary :after #'alex/flyspell-update) + (advice-add 'ispell-pdict-save :after #'alex/flyspell-update) +#+end_src + +If =flyspell-dict= is set for the current buffer, set the value as +current ispell dictionary and enable flyspell-mode. =flyspell-dict= +should be set as local variable (file-local or dir-local). + +#+begin_src emacs-lisp :noweb-ref flyspell-config :tangle no + (defun alex/auto-flyspell-mode () + "Automatically set `flyspell-dict' as dictionary for ispell and + enable `flyspell-mode'." + (when flyspell-dict + (ispell-change-dictionary flyspell-dict) + (flyspell-mode 1))) + (add-hook 'find-file-hook 'alex/auto-flyspell-mode) +#+end_src + +This ignores all incorrect words in lines starting with +=#include=. =flyspell-prog-mode= only checks strings and comments, but +the include files could look like strings. + +#+begin_src emacs-lisp :noweb-ref flyspell-config :tangle no + (defun alex/flyspell-ignore-include (start end sug) + "Ignores all spelling errors in lines starting with #include." + (save-excursion + (goto-char start) + (beginning-of-line) + (if (looking-at "#include") + t + nil))) + + (add-hook 'flyspell-incorrect-hook 'alex/flyspell-ignore-include) +#+end_src + +** magit + +magit is a great mode for managing git repositories. I generally use +=magit-status= as entry point for viewing repository status, staging +and committing. For writing good commit messages, I activate +=flyspell-mode= in the =magit-log-edit-mode=. + +#+begin_src emacs-lisp + (use-package magit + :bind ("<f5>" . magit-status) + :config + (add-hook 'magit-log-edit-mode-hook (lambda () (flyspell-mode 1)))) +#+end_src +** multi-term + +multi-term supports much more terminal applications than similar modes +and can automatically toggle a dedicated window. The only disadvantage +is, that it does not work in combination with tramp. + +#+begin_src emacs-lisp + (use-package multi-term + :bind (("C-c t" . multi-term-dedicated-toggle) + ("C-c T" . multi-term)) + :config + ;;(setq multi-term-dedicated-select-after-open-p t) + ) +#+end_src +** neotree + +I rarely use a files browser in parallel to the main window. Usually I +simply use =find-file= or a dired buffer. But if I really need it, +neotree is a nice replacement for speedbar and simply work out of the +box. I only added projectile support, so that the neotree open per +default the project root (aka. the root of the git repository). + +#+begin_src emacs-lisp + (use-package neotree + :commands (neotree-dir neotree-find neotree-show) + :bind ("C-<tab>" . neotree-project-dir) + :init + (defun alex/neotree-find-file (dir file) + (neotree-dir dir) + (if file + (neotree-find (file-relative-name file dir)))) + + (defun neotree-project-dir () + "Open NeoTree using the git root." + (interactive) + (if (and (fboundp 'neo-global--window-exists-p) + (neo-global--window-exists-p)) + (neotree-hide) + (if (fboundp 'projectile-project-root) + (let ((projectile-require-project-root nil)) + (let ((project-dir (projectile-project-root)) + (file-name (projectile-file-truename (buffer-file-name)))) + (if project-dir + (alex/neotree-find-file project-dir file-name))))) + (neotree-show)))) +#+end_src + +** nlinum + +I generally want to have line numbers. nlinum works best with folding, +so I use that. + +#+begin_src emacs-lisp + (use-package nlinum + :config + <<nlinum-config>>) +#+end_src + +*** global mode + +I use my global-excluding-minor-mode stuff an define some exceptions, +where I do not want to have line numbers. + +#+begin_src emacs-lisp :noweb-ref nlinum-config :tangle no + (alex/define-global-excluding-minor-mode 'nlinum-mode) + + (setq nlinum-mode-exclude-list + '(:minibuffer + :mode + Custom-mode + Man-mode + compilation-mode + dired-mode + doc-view-mode + eshell-mode + helm--mode + helm--remap-mouse-mode + image-mode + magit-mode + magit-status-mode + neotree-mode + term-mode + text-mode + weechat-mode + wl-folder-mode + wl-summary-mode)) + + (alex/global-nlinum-mode t) +#+end_src + +*** number format + +I want to have some spacing around the numbers and calculate the +width, so that the width does not change during scrolling. + +#+begin_src emacs-lisp :noweb-ref nlinum-config :tangle no + (setq nlinum-format " %d ") + + (defun alex/nlinum-max-width () + "Calculate maximum width of line numbers" + (setq nlinum--width + (length (format nlinum-format + (count-lines (point-min) (point-max))))) + (nlinum--flush)) + (add-hook 'nlinum-mode-hook 'alex/nlinum-max-width) +#+end_src + +*** fix make-frame + +linum/nlinum currently triggers a bug in emacs: [[https://lists.gnu.org/archive/html/emacs-devel/2014-09/msg00022.html][Trunk emacs infelicity +with linum mode]] that make it impossible to create a new frame while +linum mode is active in at least on buffer. To fix this I +around-advice =make-frame= and deactivate nlinum before and reactivate +it again after creating the frame. + +#+begin_src emacs-lisp :noweb-ref nlinum-config :tangle no + (defun alex/deactivate-nlinum (buffer) + "Deactivates nlinum in the given BUFFER" + (with-current-buffer buffer + (nlinum-mode 0))) + + (defun alex/activate-nlinum (buffer) + "Activates nlinum in the given BUFFER" + (with-current-buffer buffer + (let ((res (nlinum-mode 1))) + (nlinum--flush) + res))) + + (defun alex/fix-nlinum (func &rest args) + "nlinum currently (emacs-24) triggers a bug, that makes it + impossible to create new frames because the linum face is not + defined. This is a fix, that deactivates nlinum in all buffers and + activate it again after creating the new frame." + (let ((nlinum-buffers (alex/get-buffers-with 'nlinum-mode))) + (mapc 'alex/deactivate-nlinum nlinum-buffers) + (alex/safe-call + (apply func args) + (mapc 'alex/activate-nlinum nlinum-buffers)))) + (advice-add 'make-frame :around #'alex/fix-nlinum) +#+end_src + +** org + +I use org-mode for my emacs config, taking notes, scheduling tasks and +maybe more. + +#+begin_src emacs-lisp + (use-package org + :mode ("\\.org\\'" . org-mode) + :demand t + :config + <<org>>) +#+end_src + +*** visual + +I want to have a nice display. + +On opening a org file, I want to see the outline but not the content +of all nodes. This is useful to get an overview. + +The nested org nodes should be intended, so that it is easy to see the +level, but I do not want to see the repeated stars in front of the +nodes. (The nodes may even got more fancy, if org-bullets is +available. See below.) + +If some parts are hidden, I want to prevent editing. If an edit action +is started the hidden region will be unfolded and the action has to be +confirmed. + +#+begin_src emacs-lisp :noweb-ref org :tangle no + (setq org-startup-folded 'content + org-startup-indented t + org-catch-invisible-edits t) +#+end_src + +Hide =org-indent-mode= from modeline. + +#+begin_src emacs-lisp + (alex/rm-add-blacklist " Ind") +#+end_src + +*** modules + +Setup some default modules to load. Some other modules might get +loaded on demand (see below). + +#+begin_src emacs-lisp :noweb-ref org :tangle no + (setq org-modules '(org-annotate-file org-bbdb + org-checklist org-collector org-eval org-expiry + org-habit org-info org-man org-mouse org-protocol + org-toc org-wl)) + + (org-load-modules-maybe t) +#+end_src + +*** todo keywords + +Define some default TODO keywords and corresponding faces, that match +my theme with a dark background. + +#+begin_src emacs-lisp :noweb-ref org :tangle no + (setq org-todo-keywords + '((sequence "TODO" "STARTED(s)" "WAITING(w)" "DELEGATED(l)" "|" + "DONE(d)" "DEFERRED(f)" "CANCELLED(x)")) + + org-todo-keyword-faces + '(("TODO" . (:inherit org-warning)) + ("STARTED" . (:foreground "yellow" :weight bold)) + ("DELEGATED" . (:foreground "darkred" :weight bold)) + ("DEFERRED" . (:foreground "gray" :weight bold)) + ("CANCELLED" . (:foreground "gray" :weight normal)) + ("DONE" . (:foreground "cyan" :weight bold)))) +#+end_src + +*** bullets + +Automatically use org-bullets-mode if available and add the +possibility to disable it on a per-file basis with +=#+STARTUP: nobullets=. + +#+begin_src emacs-lisp :noweb-ref org :tangle no + (defvar alex/org-startup-with-bullets t + "Not-nil means entering Org-mode will enable org-bullets. This can + also be configured on a per-file basis adding on of the following + lines anywhere in the buffer: + + ,#+STARTUP: bullets + ,#+STARTUP: nobullets") + + (defun alex/org-bullets-setup () + "Enable org-bullets if `alex/org-startup-with-bullets' is not-nil." + (when alex/org-startup-with-bullets + (org-bullets-mode 1))) + (add-hook 'org-mode-hook 'alex/org-bullets-setup) + + (setq org-startup-options + (append org-startup-options + '(("bullets" org-startup-with-bullets t) + ("nobullets" org-startup-with-bullets nil)))) + + (use-package org-bullets + :commands (org-bullets-mode)) +#+end_src + +*** agenda + +The agenda view should be generated only from the =todo.org= file. +This file is the central place where I manage all TODO entries used +for the agenda view and the daily schedule. The agenda view should +always display 7 days from today, even if there are no scheduled tasks +for a day. + +#+begin_src emacs-lisp :noweb-ref org :tangle no + (use-package org-agenda + :bind ("C-c a" . org-agenda) + :config + (setq org-agenda-files '("~/doc/org/todo.org") + org-agenda-span 'week + org-deadline-warning-days 14 + org-agenda-show-all-dates t + org-agenda-skip-deadline-if-done t + org-agenda-skip-scheduled-if-done t + org-agenda-start-on-weekday nil + org-reverse-note-order t + org-fast-tag-selection-single-key 'expert)) +#+end_src + +*** capture + +Org-capture can quickly create notes or todo entries. It can also used +in combination with org-protocol to receive information from other +programs (like a web browser). + +#+begin_src emacs-lisp :noweb-ref org :tangle no + (use-package org-capture + :commands (org-capture) + :bind ("C-c o" . org-capture) + :config + (setq org-default-notes-file "~/doc/org/notes.org" + org-capture-templates + '(("t" "Tasks" entry + (file "~/doc/org/todo.org") + "* TODO %?\n%u") + ("n" "Notes" entry + (file+headline "~/doc/org/notes.org" "Notes") + "* %u %?") + ("c" "Capture" entry + (file+headline "~/doc/org/notes.org" "Links") + "* %^{Title}\n\nSource: %u, %c\n\n%i")))) +#+end_src + +*** protocol + +Set default org-capture-template for org-protocol. + +#+begin_src emacs-lisp :noweb-ref org :tangle no + (setq org-protocol-default-template-key "c") +#+end_src + +When I start an org-capture in an org-protocol popup, I want to show +only the org-capture buffer (default behaviour would be to split the +current buffer) and I want to close the popup after finishing the +capture. + +When using org-capture with placeholders, we need to delete the other +windows just before starting to filling out the placeholders. The +advice after org-capture is too late, it would delete the other +windows after filling the placeholders. + +#+begin_src emacs-lisp :noweb-ref org :tangle no + (defun alex/org-capture-single-window (&rest args) + "Make the org-capture the only window when used as a popup" + (when (equal "emacs-capture" (frame-parameter nil 'name)) + (delete-other-windows))) + (advice-add 'org-capture :after #'alex/org-capture-single-window) + (advice-add 'org-completing-read-no-i :before #'alex/org-capture-single-window) + + (defun alex/org-capture-delete-frame (&rest args) + "Close the frame after finishing the capture, when used org-capture + as a popup" + (when (equal "emacs-capture" (frame-parameter nil 'name)) + (delete-frame))) + (advice-add 'org-capture-finalize :after #'alex/org-capture-delete-frame) +#+end_src + +*** journal + +#+begin_src emacs-lisp :noweb org-config :tangle no + (use-package org-journal + :bind ("C-c C-j" . org-journal-new-entry) + :config + (setq org-journal-dir "~/doc/org/journal/" + org-agenda-file-regexp "\\`\\([^.].*\\.org\\|[0-9]+\\)\\'")) +#+end_src + +*** org without helm + +org has a function, that requests input without ido completion. For +this function I disable helm. + +#+begin_src emacs-lisp :noweb-ref org :tangle no + (defun alex/run-without-helm (orig-func &rest args) + "Run a function without helm completion." + (if (boundp 'helm-mode) + (let ((orig-helm-mode helm-mode)) + (helm-mode 0) + (alex/safe-call + (apply orig-func args) + (when orig-helm-mode + (helm-mode 1)))) + (apply orig-func args))) + + (advice-add 'org-completing-read-no-i :around #'alex/run-without-helm) +#+end_src +** origami + +Sometimes I want to fold some code sections. There are several mode +available, but only origami supports insertion of new regions without +reopening or parsing the whole buffer. But I do not want to use the +semantic expression feature of origami and my markers should support a +title in the first line after the marker. + +I define my own parser for origami and modify the behaviour for my +needs. + +#+begin_src emacs-lisp + (use-package origami + :demand t + :bind (("C-c C-f" . origami-toggle-node) + ("C-c M-f" . origami-close-all-nodes) + ("C-c f" . origami-open-all-nodes)) + + :config + <<origami-config>>) +#+end_src + +*** custom format for folded display + +Per default origami is used to fold semantic expressions and only +shows the marker at the front and end of the region. I want to use +explicit marker inside comments and want to add a description (title) +for the region after the opening marker. So I want to keep the whole +first line visible while the region is folded. + +#+begin_src emacs-lisp :noweb-ref origami-config :tangle no + (defun alex/origami-build-pair-tree (create open close positions) + "This is like `origami-build-pair-tree' and now keeps the whole + first line visible while folded." + (cl-labels ((build (positions) + ;; this is so horrible, but fast + (let (acc beg (should-continue t)) + (while (and should-continue positions) + (cond ((equal (caar positions) open) + (if beg ;go down a level + (let* ((res (build positions)) + (new-pos (car res)) + (children (cdr res)) + (beg-end (save-excursion + (goto-char beg) + (line-end-position))) + (end (cdar new-pos))) + (setq positions (cdr new-pos)) + (setq acc (cons (funcall create beg (+ end (length close)) (- beg-end beg) children) + acc)) + (setq beg nil)) + ;; begin a new pair + (setq beg (cdar positions)) + (setq positions (cdr positions)))) + ((equal (caar positions) close) + (if beg + (let ((beg-end (save-excursion + (goto-char beg) + (line-end-position))) + (end (cdar positions))) + (if (< beg-end end) + ;;close with no children + (setq acc (cons (funcall create beg (+ end (length close)) (- beg-end beg) nil) + acc))) + (setq positions (cdr positions)) + (setq beg nil)) + (setq should-continue nil))))) + (cons positions (reverse acc))))) + (cdr (build positions)))) +#+end_src + +*** respect derived modes + +I manually specify the parser for the origami markers. For more +flexibility I want to support derived modes (f.e. if I assign a value +for emacs-list-mode, this parser should also support the +lisp-interaction-mode). + +Therefore I advice the =origami-get-parser= function and temporarily +overwrite the =origami-parser-alist= and change all definitions with a +compatible mode to the exact major mode of the requested buffer. + +#+begin_src emacs-lisp :noweb-ref origami-config :tangle no + (defun alex/origami-is-derived-mode (buffer parser-elem) + "Helper for `alex/origami-parser-derived-modes' to check if the + current major-mdoe in BUFFER is a dreived mode of the mode part of + an element from the `origami-parser-alist'." + (let ((mode (car parser-elem)) + (parser (cdr parser-elem))) + (with-current-buffer buffer + (if (derived-mode-p mode) + (cons major-mode parser) + nil)))) + + (defun alex/origami-parser-derived-modes (func buffer &rest args) + "Modify the origami-parser-alist on demand to respect the derived + major-modes of the defined modes." + (let* ((check (apply-partially 'alex/origami-is-derived-mode buffer)) + (origami-parser-alist (delq nil (mapcar check origami-parser-alist)))) + (apply func buffer args))) + + (advice-add 'origami-get-parser :around #'alex/origami-parser-derived-modes) +#+end_src + +*** define simple marker for different modes + +#+begin_src emacs-lisp :noweb-ref origami-config :tangle no + (defun alex/origami-markers-parser (begin end create) + "Create a origami parser for regions between BEGIN and END + markers. The folded region will show the complete first line after the + marker but not the END marker." + (lexical-let ((create-tmp create) + (begin-tmp begin) + (end-tmp end) + (regexp (rx-to-string `(or ,begin ,end)))) + (lambda (content) + (let ((positions (origami-get-positions content regexp))) + (alex/origami-build-pair-tree create-tmp begin-tmp end-tmp positions))))) + + (defun alex/origami-marker (mode start end) + "Define a cons with MODE and the marker-parser for origmai, that + could be used directly as element for `origami-parser-alist'." + `(,mode . ,(apply-partially 'alex/origami-markers-parser start end))) + + (setq origami-parser-alist + `(,(alex/origami-marker 'emacs-lisp-mode ";;{{{" ";;}}}") + ,(alex/origami-marker 'lisp-mode ";;{{{" ";;}}}") + ,(alex/origami-marker 'sh-mode "#{{{" "#}}}") + ,(alex/origami-marker 'php-mode "//{{{" "//}}}") + ,(alex/origami-marker 'haskell-mode "--{{{" "--}}}"))) +#+end_src + +*** global-minor-mode + +I want to use origami-mode everywhere, so I create a global minor-mode +and activate it. + +#+begin_src emacs-lisp :noweb-ref origami-config :tangle no + (alex/define-global-excluding-minor-mode 'origami-mode) + (alex/global-origami-mode t) +#+end_src +** powerline + +I use powerline to get a nicer modeline, but I change some aspects to +enhance it even more. + +#+begin_src emacs-lisp + (use-package powerline + :config + <<powerline-config>>) +#+end_src + +*** display utf8 glyphs + +Currently powerline only displays the nice utf-8 glyphs (f.e. for git +branches) if =window-system= is nil. So we simply wrap =powerline-vc= +and temporarily unset =window-system=. + +#+begin_src emacs-lisp :noweb-ref powerline-config :tangle no + (defun alex/fix-powerline-vc (orig-fun &rest args) + "Fix utf8 glyphs display." + (let ((window-system nil)) + (apply orig-fun args))) + (advice-add 'powerline-vc :around #'alex/fix-powerline-vc) +#+end_src + +*** smart-mode-line + +I only use smart-mode-line for the file paths feature. I need to call +=sml/setup=, but I do not want to load a theme because it is +incompatible with powerline. So I simply overwrite =sml/-setup-theme= +with =ignore=. + +#+begin_src emacs-lisp :noweb-ref powerline-config :tangle no + (use-package smart-mode-line + :config + (advice-add 'sml/-setup-theme :around #'ignore) + (sml/setup)) +#+end_src + +*** rich-minority + +I use rich-minority-mode, that has no support for powerline out of the +box. So I advice the =powerline-minor-modes= function and let +rich-minority temporarily overwrite the minor-mode-alist. + +#+begin_src emacs-lisp :noweb-ref powerline-config :tangle no + (defun alex/powerline-rm-setup () + (defun alex/powerline-rm (orig-fun &rest args) + "Applies the rich-minority-mode on the powerline display of the + minor-modes." + (let ((minor-mode-alist (if rich-minority-mode + (rm--mode-list-as-string-list) + minor-mode-alist))) + (apply orig-fun args))) + (advice-add 'powerline-minor-modes :around #'alex/powerline-rm)) + + (eval-after-load 'rich-minority #'alex/powerline-rm-setup) +#+end_src + +*** powerline theme + +Setup the powerline theme. Currently I only change the separator and +make it a little bit higher. + +#+begin_src emacs-lisp :noweb-ref powerline-config :tangle no + (setq powerline-default-separator 'wave + powerline-height 25) + + (powerline-default-theme) +#+end_src + +** projectile + +Projectile allows fast search for files in project directories. I want +to use it everywhere but do not want to see the minor-mode. It +automatically recognize git repositories as projects. + +#+begin_src emacs-lisp + (use-package projectile + :diminish " Projectile.*" + :config + (projectile-global-mode) + (setq projectile-enable-caching t + projectile-cache-file (alex/cache-file "projectile") + projectile-known-projects-file (alex/cache-file "projectile-bookmarks"))) +#+end_src + +** semantic + +semantic is an emacs mode, that parses the source code of the current +buffer. It has support for many languages out of the box (C/C++, +Python, elisp, Erlang...). I want to enable it in all buffers. The +only disadvantage is, that opening a file could trigger the parsing +and will block emacs for a while (depending on how many files are in +the including hierarchy). + +#+begin_src emacs-lisp + (use-package semantic + :config + (use-package semantic/ia) + (setq semanticdb-default-save-directory (alex/cache-file "semantic")) + + (semantic-mode 1) + (global-semantic-idle-summary-mode 1)) +#+end_src + +** server + +Start server (if not running) to edit files with emacsclient and +rebind =C-x k= in server buffers to close it. + +#+begin_src emacs-lisp + (use-package server + :config + (when (and (fboundp 'server-running-p) + (not (server-running-p))) + (server-start)) + + (defun alex/server-swtich-hook () + (when (current-local-map) + (use-local-map (copy-keymap (current-local-map)))) + (when server-buffer-clients + (local-set-key (kbd "C-x k") 'server-edit))) + + (add-hook 'server-switch-hook 'alex/server-swtich-hook)) + +#+end_src + +** smartparens + +smartparens-mode has various features. I only want to have the +highlighting of matching parens and the automatic wrapping of the +region, but I do not want that it inserts, deletes or skips some +parens. + +#+begin_src emacs-lisp + (use-package smartparens-config + :config + (setq-default sp-autoinsert-pair nil + sp-autodelete-pair nil + sp-autodelete-opening-pair nil + sp-autodelete-closing-pair nil + sp-autoskip-closing-pair nil) + + (smartparens-global-mode t) + (show-smartparens-global-mode t) + :diminish + " SP") +#+end_src + +** template + +I want to insert template automatically in new empty files with the +correct extension. But I only want to search for global templates by +default and not in a sub directory of the new file. I also do not want +to update the content of a file after saving (f.e. when saving under a +different name). + +#+begin_src emacs-lisp + (use-package template + :config + (setq template-auto-insert t + template-auto-update nil + template-confirm-insecure nil + + template-date-format "%Y-%m-%d" + template-time-format "%T" + + template-subdirectories nil + template-default-directories (list (concat user-emacs-directory + "templates/"))) + (template-initialize)) +#+end_src +** tramp + +I usually have very heavy shell customization on remote hosts. I do +not want to depend, that tramp can parse my custom prompt format. So I +set =sshx= as default tramp method, that explicit invoke =/bin/sh= as +shell on the remote host. + +#+begin_src emacs-lisp + (use-package tramp + :config + (setq tramp-default-method "sshx" + tramp-persistency-file-name (alex/cache-file "tramp"))) +#+end_src + +*** dir-locals + +Support dir-locals also via tramp. This leads to a additional delay +while opening a file via tramp (because it has to check for the +dir-locals file over ssh) but usually I do not want to clutter single +files with file-local variables. + +#+begin_src emacs-lisp + (setq enable-remote-dir-locals t) +#+end_src +** uniquify + +Use a better approach to make unique buffer names. The default +algorithm just adds a count after the filename if you opened two files +with the same name. =uniquify= adds the path to the buffer name, so +that the right buffer is easier to identify. + +#+begin_src emacs-lisp + (use-package uniquify + :config + (setq uniquify-buffer-name-style 'reverse)) +#+end_src + +** uptimes + +I want to measure the uptime of emacs. This should not be deferred +loaded, because it captures the start time of in the moment it gets +loaded. + +#+begin_src emacs-lisp + (use-package uptimes + :demand t + :config + (setq uptimes-database (alex/cache-file "uptimes"))) +#+end_src + +** weechat + +#+begin_src emacs-lisp + (use-package weechat + :commands (weechat-connect) + :functions (weechat-channel-names + weechat-monitor-buffer + weechat--find-buffer + weechat-buffer-hash) + + :init + (defun weechat () + "Start weechat with `weechat-connect' and automatically switch to + the first buffer in `weechat-auto-monitor-buffers'." + (interactive) + (weechat-connect) + (when weechat-auto-monitor-buffers + (switch-to-buffer + (car weechat-auto-monitor-buffers)))) + + :config + <<weechat-config>>) +#+end_src + +*** config + +I connect to weechat running on the host called =island= via ssh +tunneling, monitor only a few buffers by default and close the buffers +on disconnect. + +#+begin_src emacs-lisp :noweb-ref weechat-config :tangle no + (setq weechat-buffer-kill-buffers-on-disconnect t + + weechat-host-default "is.zedat.fu-berlin.de" + weechat-port-default 58224 + weechat-mode-default "ssh -W localhost:%p %h" + + weechat-text-column 25 + weechat-header-line-format "%c/%s: %t" + + weechat-auto-monitor-buffers '("freenode.#spline" + "ircnet.&ZEDAT-IS" + "oftc.#vserver")) + + (defun alex/weechat-mode-hook () + "Activate `visual-line-mode'." + (visual-line-mode 1)) + (add-hook 'weechat-mode-hook 'alex/weechat-mode-hook) +#+end_src + +*** helm support + +#+begin_src emacs-lisp :noweb-ref weechat-config :tangle no + (defun alex/helm-weechat-support () + + (defun alex/weechat-new-buffers () + (let ((current (weechat-channel-names t)) + (all (weechat-channel-names nil))) + (mapc (lambda (cur) (setq all (delete cur all))) current) + (sort all 'string-lessp))) + + (defun alex/weechat-add-buffer (name) + (weechat-monitor-buffer (weechat--find-buffer name) t)) + + (defun alex/weechat-get-count (channel type) + (let ((hash (gethash type channel))) + (if (not (not hash)) + (gethash :count hash) + 0))) + + (defun alex/weechat-show-topic (channels) + (mapcar + (lambda (channel) + (let* ((hash (weechat-buffer-hash (weechat--find-buffer channel))) + (hlight (alex/weechat-get-count hash :background-highlight)) + (message (alex/weechat-get-count hash :background-message)) + (chan-name (if (> (string-width channel) helm-buffer-max-length) + (helm-substring-by-width + channel helm-buffer-max-length) + (concat channel (make-string + (- (+ helm-buffer-max-length 3) + (string-width channel)) ? )))) + (chan (cond + ((> hlight 0) + (propertize chan-name 'face 'helm-buffer-saved-out)) + ((> message 0) + (propertize chan-name 'face 'helm-buffer-not-saved)) + (t chan-name))) + (hlight-count (if (> hlight 0) + (propertize (format "%-3d" hlight) + 'face 'helm-buffer-saved-out) + " ")) + (message-count (if (> message 0) + (format "%3d" message) " ")) + (count-sep (if (and (> message 0) (> hlight 0)) + "," " ")) + (topic (propertize + (gethash "title" hash) + 'face 'helm-ff-symlink))) + (cons (format "%s\t%s%s%s\t%s" chan message-count count-sep + hlight-count topic) + channel))) + channels)) + + (defun alex/weechat-ignore-buffer (channels) + (delq nil + (mapcar + (lambda (channel) + (let* ((hash (weechat-buffer-hash (weechat--find-buffer channel))) + (plugin (cdr (assoc "plugin" (gethash "local_variables" hash)))) + (type (cdr (assoc "type" (gethash "local_variables" hash))))) + (when (and (string= "irc" plugin) (string= "channel" type)) + channel))) + channels))) + + (defun alex/helm-weechat-buffer-toggle-ignore () + (interactive) + (with-helm-alive-p + (let ((filter-attrs (helm-attr 'candidate-transformer + alex/weechat-new-buffers-source))) + (if (memq 'alex/weechat-ignore-buffer filter-attrs) + (helm-attrset 'candidate-transformer + (remove 'alex/weechat-ignore-buffer + filter-attrs) + alex/weechat-new-buffers-source t) + (helm-attrset 'candidate-transformer + (cons 'alex/weechat-ignore-buffer + filter-attrs) + alex/weechat-new-buffers-source t)) + (helm-force-update)))) + + (setq alex/helm-weechat-buffer-map (copy-keymap helm-map)) + (bind-key "C-c C-c" 'alex/helm-weechat-buffer-toggle-ignore + alex/helm-weechat-buffer-map) + + (setq alex/weechat-new-buffers-source nil) + (defun alex/helm-weechat-buffer () + (interactive) + (setq alex/weechat-new-buffers-source + (helm-build-sync-source "Available channel" + :candidates (alex/weechat-new-buffers) + :action '(("Monitor channel" . alex/weechat-add-buffer)) + :candidate-transformer '(alex/weechat-ignore-buffer + alex/weechat-show-topic))) + (let ((helm-truncate-lines t)) + (helm + :sources (list + (helm-build-sync-source "Buffers" + :candidates (weechat-channel-names t) + :action '(("Open buffer" . switch-to-buffer)) + :candidate-transformer '(alex/weechat-show-topic)) + alex/weechat-new-buffers-source) + :buffer "*weechat*" + :keymap alex/helm-weechat-buffer-map))) + + (bind-key "C-c C-b" 'alex/helm-weechat-buffer weechat-mode-map) + + (defun alex/mark-read () + "Mark buffer as read up to current line." + (interactive) + (let ((inhibit-read-only t)) + (put-text-property + (point-min) (line-beginning-position) + 'face 'font-lock-comment-face))) + (bind-key "<escape>" 'alex/mark-read weechat-mode-map)) + + (eval-after-load 'helm #'alex/helm-weechat-support) +#+end_src +** which-key + +I cannot remember all the key combinations. which-key will show a +hint for possible completions, if I start a key combo and wait longer +than 1s before continue with the next key. + +#+begin_src emacs-lisp + (use-package which-key + :config + (setq which-key-idle-delay 1.0) + (which-key-mode t) + :diminish + which-key-mode) +#+end_src + +** winner + +I use winner to quickly restore a previous window configuration after +it was changed by something. I demand it here, because winner mode +need to be active to keep track of the changes and helm will notice it +and will insert the helm buffer names into =winner-boring-buffers=. + +#+begin_src emacs-lisp + (use-package winner + :bind (("C-c <left>" . winner-undo) + ("C-c <right>" . winner-redo)) + :demand t + :config + (winner-mode 1)) +#+end_src + +** winring + +With winring it is possible to manage different window configurations +and switching between. This could be useful if working with +specialized window configurations (f.e. for debugging) and activating +it when needed. + +#+begin_src emacs-lisp + (use-package winring + :bind (("C-x j" . winring-jump-to-configuration) + ("C-x n" . winring-new-configuration) + ("C-x K" . winring-delete-configuration)) + :functions (winring-initialize) + :config + (winring-initialize) + + (defun alex/confirm-winring-deletion (&rest args) + (y-or-n-p (format "Delete winring configuration %s? " winring-name))) + + (advice-add 'winring-delete-configuration + :before-while + #'alex/confirm-winring-deletion)) +#+end_src + +** wl + +Here are only the functions for auto-loading. I customize wanderlust, +to load the profile from the org-babel file =init.d/wl.org= during +start-up of wanderlust. + +I use a separate frame for wanderlust with a custom name, so that +XMonad can shift it to a different desktop. Additionally I create +a function, that should be called with emacsclient to compose a new +message from a mailto link. This function also creates a new frame +with a custom name and closes it after sending the mail. + +#+begin_src emacs-lisp + (use-package wl + :commands (wl-other-frame wl-draft) + :init + (defun wl-start () + "Start wanderlust in a seperate frame and set the name of the new + frame to `wanderlust'." + (interactive) + (let ((default-frame-alist + (cons '(name . "wanderlust") default-frame-alist))) + (wl-other-frame))) + + (defun alex/wl-mailto-compose-new-frame (mailto-url) + "Compose a new mail from a mailto link with wanderlust in a new + frame and customize the name of the new frame to + `wanderlust-draft'." + (let ((default-frame-alist + (cons '(name . "wanderlust-draft") default-frame-alist)) + (wl-draft-use-frame t)) + (alex/wl-mailto-compose mailto-url) + (set-window-dedicated-p (selected-window) t) + + (make-local-variable 'wl-draft-force-delete-frame) + (setq wl-draft-force-delete-frame t) + (run-hooks 'wl-mail-setup-hook))) + + (require 'rfc2368) + (defun alex/wl-mailto-compose (mailto-url) + "Parse a rfc2368 mailto links and call `wl-draft' with the + information for the headers and the body." + (when (and (stringp mailto-url) (string-match "\\`mailto:" mailto-url)) + (let* ((headers (mapcar (lambda (h) (cons (intern (car h)) (cdr h))) + (rfc2368-parse-mailto-url mailto-url))) + (good-headers (assq-delete-all 'Body (copy-alist headers))) + (body (cdr (assoc 'Body headers)))) + (wl-draft good-headers nil nil body)))) + + (defvar wl-draft-force-delete-frame nil + "If this variable is t `alex/wl-draft-force-hide' always delete + the frame after closing the draft. You may want to make this + variable buffer-local whenever you use it. This variable is used by + `alex/wl-mailto-compose-new-frame' to close the created frame after + composing the mail.") + + (defun alex/wl-draft-force-hide (func &rest args) + "This advice removes the draft-frame even if no other frame is + visible if `alex/wl-draft-force-delete-frame' is non-nil." + (let ((force-delete (and (boundp 'wl-draft-force-delete-frame) + wl-draft-force-delete-frame))) + (apply func args) + (if force-delete + (delete-frame)))) + (advice-add 'wl-draft-hide :around #'alex/wl-draft-force-hide) + + :config + (defun alex/wl-babel-load-profile () + "Load `wl-init-file' with `org-babel-load-file'." + (org-babel-load-file wl-init-file)) + + (setq wl-init-file (locate-user-emacs-file "init.d/wl.org") + wl-load-profile-function 'alex/wl-babel-load-profile)) +#+end_src + +** yasnippet + +I want to use yasnippets everywhere, so I enable the global mode. In +addition to the default snippets I have some in my personal dir. It +does not load the all snippets during startup, but only if the first +buffer switches to the corresponding mode (only the directories are +searched during activation of the global mode). + +#+begin_src emacs-lisp + (use-package yasnippet + :config + (setq yas-snippet-dirs `("~/.emacs.d/snippets/" + ,yas-installed-snippets-dir)) + (yas-global-mode 1) + :diminish yas-minor-mode) +#+end_src + @@ -0,0 +1,5 @@ +(let ((file-name-handler-alist nil)) + (package-initialize nil) + (setq package-enable-at-startup nil) + + (org-babel-load-file "~/.emacs.d/init.d/main.org")) diff --git a/lisp/filladapt.el b/lisp/filladapt.el new file mode 100644 index 0000000..4ae63ab --- /dev/null +++ b/lisp/filladapt.el @@ -0,0 +1,981 @@ +;;; Adaptive fill +;;; Copyright (C) 1989, 1995-1998 Kyle E. Jones +;;; +;;; This program is free software; you can redistribute it and/or modify +;;; it under the terms of the GNU General Public License as published by +;;; the Free Software Foundation; either version 2, or (at your option) +;;; any later version. +;;; +;;; This program is distributed in the hope that it will be useful, +;;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;;; GNU General Public License for more details. +;;; +;;; A copy of the GNU General Public License can be obtained from this +;;; program's author (send electronic mail to kyle@uunet.uu.net) or from +;;; the Free Software Foundation, Inc., 675 Mass Ave, Cambridge, MA +;;; 02139, USA. +;;; +;;; Send bug reports to kyle_jones@wonderworks.com + +;; LCD Archive Entry: +;; filladapt|Kyle Jones|kyle_jones@wonderworks.com| +;; Minor mode to adaptively set fill-prefix and overload filling functions| +;; 28-February-1998|2.12|~/packages/filladapt.el| + +;; These functions enhance the default behavior of Emacs' Auto Fill +;; mode and the commands fill-paragraph, lisp-fill-paragraph, +;; fill-region-as-paragraph and fill-region. +;; +;; The chief improvement is that the beginning of a line to be +;; filled is examined and, based on information gathered, an +;; appropriate value for fill-prefix is constructed. Also the +;; boundaries of the current paragraph are located. This occurs +;; only if the fill prefix is not already non-nil. +;; +;; The net result of this is that blurbs of text that are offset +;; from left margin by asterisks, dashes, and/or spaces, numbered +;; examples, included text from USENET news articles, etc. are +;; generally filled correctly with no fuss. +;; +;; Since this package replaces existing Emacs functions, it cannot +;; be autoloaded. Save this in a file named filladapt.el in a +;; Lisp directory that Emacs knows about, byte-compile it and put +;; (require 'filladapt) +;; in your .emacs file. +;; +;; Note that in this release Filladapt mode is a minor mode and it is +;; _off_ by default. If you want it to be on by default, use +;; (setq-default filladapt-mode t) +;; +;; M-x filladapt-mode toggles Filladapt mode on/off in the current +;; buffer. +;; +;; Use +;; (add-hook 'text-mode-hook 'turn-on-filladapt-mode) +;; to have Filladapt always enabled in Text mode. +;; +;; Use +;; (add-hook 'c-mode-hook 'turn-off-filladapt-mode) +;; to have Filladapt always disabled in C mode. +;; +;; In many cases, you can extend Filladapt by adding appropriate +;; entries to the following three `defvar's. See `postscript-comment' +;; or `texinfo-comment' as a sample of what needs to be done. +;; +;; filladapt-token-table +;; filladapt-token-match-table +;; filladapt-token-conversion-table + +(and (featurep 'filladapt) + (error "filladapt cannot be loaded twice in the same Emacs session.")) + +(provide 'filladapt) + +(defvar filladapt-version "2.12" + "Version string for filladapt.") + +;; BLOB to make custom stuff work even without customize +(eval-and-compile + (condition-case () + (require 'custom) + (error nil)) + (if (and (featurep 'custom) (fboundp 'custom-declare-variable)) + nil ;; We've got what we needed + ;; We have the old custom-library, hack around it! + (defmacro defgroup (&rest args) + nil) + (defmacro defcustom (var value doc &rest args) + (` (defvar (, var) (, value) (, doc)))))) + +(defgroup filladapt nil + "Enhanced filling" + :group 'fill) + +(defvar filladapt-mode nil + "Non-nil means that Filladapt minor mode is enabled. +Use the filladapt-mode command to toggle the mode on/off.") +(make-variable-buffer-local 'filladapt-mode) + +(defcustom filladapt-mode-line-string " Filladapt" + "*String to display in the modeline when Filladapt mode is active. +Set this to nil if you don't want a modeline indicator for Filladapt." + :type 'string + :group 'filladapt) + +(defcustom filladapt-fill-column-tolerance nil + "*Tolerate filled paragraph lines ending this far from the fill column. +If any lines other than the last paragraph line end at a column +less than fill-column - filladapt-fill-column-tolerance, fill-column will +be adjusted using the filladapt-fill-column-*-fuzz variables and +the paragraph will be re-filled until the tolerance is achieved +or filladapt runs out of fuzz values to try. + +A nil value means behave normally, that is, don't try refilling +paragraphs to make filled line lengths fit within any particular +range." + :type '(choice (const nil) + integer) + :group 'filladapt) + +(defcustom filladapt-fill-column-forward-fuzz 5 + "*Try values from fill-column to fill-column plus this variable +when trying to make filled paragraph lines fall with the tolerance +range specified by filladapt-fill-column-tolerance." + :type 'integer + :group 'filladapt) + +(defcustom filladapt-fill-column-backward-fuzz 5 + "*Try values from fill-column to fill-column minus this variable +when trying to make filled paragraph lines fall with the tolerance +range specified by filladapt-fill-column-tolerance." + :type 'integer + :group 'filladapt) + +;; install on minor-mode-alist +(or (assq 'filladapt-mode minor-mode-alist) + (setq minor-mode-alist (cons (list 'filladapt-mode + 'filladapt-mode-line-string) + minor-mode-alist))) + +(defcustom filladapt-token-table + '( + ;; this must be first + ("^" beginning-of-line) + ;; Included text in news or mail replies + (">+" citation->) + ;; Included text generated by SUPERCITE. We can't hope to match all + ;; the possible variations, your mileage may vary. + ("\\(\\w\\|[0-9]\\)[^'`\"< \t\n]*>[ \t]*" supercite-citation) + ;; Lisp comments + (";+" lisp-comment) + ;; UNIX shell comments + ("#+" sh-comment) + ;; Postscript comments + ("%+" postscript-comment) + ;; C++ comments + ("///*" c++-comment) + ;; Texinfo comments + ("@c[ \t]" texinfo-comment) + ("@comment[ \t]" texinfo-comment) + ;; Bullet types. + ;; + ;; LaTex \item + ;; + ("\\\\item[ \t]" bullet) + ;; + ;; 1. xxxxx + ;; xxxxx + ;; + ("[0-9]+\\.[ \t]" bullet) + ;; + ;; 2.1.3 xxxxx xx x xx x + ;; xxx + ;; + ("[0-9]+\\(\\.[0-9]+\\)+[ \t]" bullet) + ;; + ;; a. xxxxxx xx + ;; xxx xxx + ;; + ("[A-Za-z]\\.[ \t]" bullet) + ;; + ;; 1) xxxx x xx x xx or (1) xx xx x x xx xx + ;; xx xx xxxx xxx xx x x xx x + ;; + ("(?[0-9]+)[ \t]" bullet) + ;; + ;; a) xxxx x xx x xx or (a) xx xx x x xx xx + ;; xx xx xxxx xxx xx x x xx x + ;; + ("(?[A-Za-z])[ \t]" bullet) + ;; + ;; 2a. xx x xxx x x xxx + ;; xxx xx x xx x + ;; + ("[0-9]+[A-Za-z]\\.[ \t]" bullet) + ;; + ;; 1a) xxxx x xx x xx or (1a) xx xx x x xx xx + ;; xx xx xxxx xxx xx x x xx x + ;; + ("(?[0-9]+[A-Za-z])[ \t]" bullet) + ;; + ;; - xx xxx xxxx or * xx xx x xxx xxx + ;; xxx xx xx x xxx x xx x x x + ;; + ("[-~*+]+[ \t]" bullet) + ;; + ;; o xx xxx xxxx xx x xx xxx x xxx xx x xxx + ;; xxx xx xx + ;; + ("o[ \t]" bullet) + ;; don't touch + ("[ \t]+" space) + ("$" end-of-line) + ) + "Table of tokens filladapt knows about. +Format is + + ((REGEXP SYM) ...) + +filladapt uses this table to build a tokenized representation of +the beginning of the current line. Each REGEXP is matched +against the beginning of the line until a match is found. +Matching is done case-sensitively. The corresponding SYM is +added to the list, point is moved to (match-end 0) and the +process is repeated. The process ends when there is no REGEXP in +the table that matches what is at point." + :type '(repeat (list regexp symbol)) + :group 'filladapt) + +(defcustom filladapt-not-token-table + '( + "[Ee]\\.g\\.[ \t,]" + "[Ii]\\.e\\.[ \t,]" + ;; end-of-line isn't a token if whole line is empty + "^$" + ) + "List of regexps that can never be a token. +Before trying the regular expressions in filladapt-token-table, +the regexps in this list are tried. If any regexp in this list +matches what is at point then the token generator gives up and +doesn't try any of the regexps in filladapt-token-table. + +Regexp matching is done case-sensitively." + :type '(repeat regexp) + :group 'filladapt) + +(defcustom filladapt-token-match-table + '( + (citation-> citation->) + (supercite-citation supercite-citation) + (lisp-comment lisp-comment) + (sh-comment sh-comment) + (postscript-comment postscript-comment) + (c++-comment c++-comment) + (texinfo-comment texinfo-comment) + (bullet) + (space bullet space) + (beginning-of-line beginning-of-line) + ) + "Table describing what tokens a certain token will match. + +To decide whether a line belongs in the current paragraph, +filladapt creates a token list for the fill prefix of both lines. +Tokens and the columns where tokens end are compared. This table +specifies what a certain token will match. + +Table format is + + (SYM [SYM1 [SYM2 ...]]) + +The first symbol SYM is the token, subsequent symbols are the +tokens that SYM will match." + :type '(repeat (repeat symbol)) + :group 'filladapt) + +(defcustom filladapt-token-match-many-table + '( + space + ) + "List of tokens that can match multiple tokens. +If one of these tokens appears in a token list, it will eat all +matching tokens in a token list being matched against it until it +encounters a token that doesn't match or a token that ends on +a greater column number." + :type '(repeat symbol) + :group 'filladapt) + +(defcustom filladapt-token-paragraph-start-table + '( + bullet + ) + "List of tokens that indicate the start of a paragraph. +If parsing a line generates a token list containing one of +these tokens, then the line is considered to be the start of a +paragraph." + :type '(repeat symbol) + :group 'filladapt) + +(defcustom filladapt-token-conversion-table + '( + (citation-> . exact) + (supercite-citation . exact) + (lisp-comment . exact) + (sh-comment . exact) + (postscript-comment . exact) + (c++-comment . exact) + (texinfo-comment . exact) + (bullet . spaces) + (space . exact) + (end-of-line . exact) + ) + "Table that specifies how to convert a token into a fill prefix. +Table format is + + ((SYM . HOWTO) ...) + +SYM is the symbol naming the token to be converted. +HOWTO specifies how to do the conversion. + `exact' means copy the token's string directly into the fill prefix. + `spaces' means convert all characters in the token string that are + not a TAB or a space into spaces and copy the resulting string into + the fill prefix." + :type '(repeat (cons symbol (choice (const exact) + (const spaces)))) + :group 'filladapt) + +(defvar filladapt-function-table + (let ((assoc-list + (list (cons 'fill-paragraph (symbol-function 'fill-paragraph)) + (cons 'fill-region (symbol-function 'fill-region)) + (cons 'fill-region-as-paragraph + (symbol-function 'fill-region-as-paragraph)) + (cons 'do-auto-fill (symbol-function 'do-auto-fill))))) + ;; v18 Emacs doesn't have lisp-fill-paragraph + (if (fboundp 'lisp-fill-paragraph) + (nconc assoc-list + (list (cons 'lisp-fill-paragraph + (symbol-function 'lisp-fill-paragraph))))) + assoc-list ) + "Table containing the old function definitions that filladapt usurps.") + +(defcustom filladapt-fill-paragraph-post-hook nil + "Hooks run after filladapt runs fill-paragraph." + :type 'hook + :group 'filladapt) + +(defvar filladapt-inside-filladapt nil + "Non-nil if the filladapt version of a fill function executing. +Currently this is only checked by the filladapt version of +fill-region-as-paragraph to avoid this infinite recursion: + + fill-region-as-paragraph -> fill-paragraph -> fill-region-as-paragraph ...") + +(defcustom filladapt-debug nil + "Non-nil means filladapt debugging is enabled. +Use the filladapt-debug command to turn on debugging. + +With debugging enabled, filladapt will + + a. display the proposed indentation with the tokens highlighted + using filladapt-debug-indentation-face-1 and + filladapt-debug-indentation-face-2. + b. display the current paragraph using the face specified by + filladapt-debug-paragraph-face." + :type 'boolean + :group 'filladapt) + +(if filladapt-debug + (add-hook 'post-command-hook 'filladapt-display-debug-info-maybe)) + +(defvar filladapt-debug-indentation-face-1 'highlight + "Face used to display the indentation when debugging is enabled.") + +(defvar filladapt-debug-indentation-face-2 'secondary-selection + "Another face used to display the indentation when debugging is enabled.") + +(defvar filladapt-debug-paragraph-face 'bold + "Face used to display the current paragraph when debugging is enabled.") + +(defvar filladapt-debug-indentation-extents nil) +(make-variable-buffer-local 'filladapt-debug-indentation-extents) +(defvar filladapt-debug-paragraph-extent nil) +(make-variable-buffer-local 'filladapt-debug-paragraph-extent) + +;; kludge city, see references in code. +(defvar filladapt-old-line-prefix) + +(defun do-auto-fill () + (catch 'done + (if (and filladapt-mode (null fill-prefix)) + (save-restriction + (let ((paragraph-ignore-fill-prefix nil) + ;; if the user wanted this stuff, they probably + ;; wouldn't be using filladapt-mode. + (adaptive-fill-mode nil) + (adaptive-fill-regexp nil) + ;; need this or Emacs 19 ignores fill-prefix when + ;; inside a comment. + (comment-multi-line t) + (filladapt-inside-filladapt t) + fill-prefix retval) + (if (filladapt-adapt nil nil) + (progn + (setq retval (filladapt-funcall 'do-auto-fill)) + (throw 'done retval)))))) + (filladapt-funcall 'do-auto-fill))) + +(defun filladapt-fill-paragraph (function arg) + (catch 'done + (if (and filladapt-mode (null fill-prefix)) + (save-restriction + (let ((paragraph-ignore-fill-prefix nil) + ;; if the user wanted this stuff, they probably + ;; wouldn't be using filladapt-mode. + (adaptive-fill-mode nil) + (adaptive-fill-regexp nil) + ;; need this or Emacs 19 ignores fill-prefix when + ;; inside a comment. + (comment-multi-line t) + fill-prefix retval) + (if (filladapt-adapt t nil) + (progn + (if filladapt-fill-column-tolerance + (let* ((low (- fill-column + filladapt-fill-column-backward-fuzz)) + (high (+ fill-column + filladapt-fill-column-forward-fuzz)) + (old-fill-column fill-column) + (fill-column fill-column) + (lim (- high low)) + (done nil) + (sign 1) + (delta 0)) + (while (not done) + (setq retval (filladapt-funcall function arg)) + (if (filladapt-paragraph-within-fill-tolerance) + (setq done 'success) + (setq delta (1+ delta) + sign (* sign -1) + fill-column (+ fill-column (* delta sign))) + (while (and (<= delta lim) + (or (< fill-column low) + (> fill-column high))) + (setq delta (1+ delta) + sign (* sign -1) + fill-column (+ fill-column + (* delta sign)))) + (setq done (> delta lim)))) + ;; if the paragraph lines never fell + ;; within the tolerances, refill using + ;; the old fill-column. + (if (not (eq done 'success)) + (let ((fill-column old-fill-column)) + (setq retval (filladapt-funcall function arg))))) + (setq retval (filladapt-funcall function arg))) + (run-hooks 'filladapt-fill-paragraph-post-hook) + (throw 'done retval)))))) + ;; filladapt-adapt failed, so do fill-paragraph normally. + (filladapt-funcall function arg))) + +(defun fill-paragraph (arg) + "Fill paragraph at or after point. Prefix arg means justify as well. + +(This function has been overloaded with the `filladapt' version.) + +If `sentence-end-double-space' is non-nil, then period followed by one +space does not end a sentence, so don't break a line there. + +If `fill-paragraph-function' is non-nil, we call it (passing our +argument to it), and if it returns non-nil, we simply return its value." + (interactive "*P") + (let ((filladapt-inside-filladapt t)) + (filladapt-fill-paragraph 'fill-paragraph arg))) + +(defun lisp-fill-paragraph (&optional arg) + "Like \\[fill-paragraph], but handle Emacs Lisp comments. + +(This function has been overloaded with the `filladapt' version.) + +If any of the current line is a comment, fill the comment or the +paragraph of it that point is in, preserving the comment's indentation +and initial semicolons." + (interactive "*P") + (let ((filladapt-inside-filladapt t)) + (filladapt-fill-paragraph 'lisp-fill-paragraph arg))) + +(defun fill-region-as-paragraph (beg end &optional justify + nosqueeze squeeze-after) + "Fill the region as one paragraph. + +(This function has been overloaded with the `filladapt' version.) + +It removes any paragraph breaks in the region and extra newlines at the end, +indents and fills lines between the margins given by the +`current-left-margin' and `current-fill-column' functions. +It leaves point at the beginning of the line following the paragraph. + +Normally performs justification according to the `current-justification' +function, but with a prefix arg, does full justification instead. + +From a program, optional third arg JUSTIFY can specify any type of +justification. Fourth arg NOSQUEEZE non-nil means not to make spaces +between words canonical before filling. Fifth arg SQUEEZE-AFTER, if non-nil, +means don't canonicalize spaces before that position. + +If `sentence-end-double-space' is non-nil, then period followed by one +space does not end a sentence, so don't break a line there." + (interactive "*r\nP") + (if (and filladapt-mode (not filladapt-inside-filladapt)) + (save-restriction + (narrow-to-region beg end) + (let ((filladapt-inside-filladapt t) + line-start last-token) + (goto-char beg) + (while (equal (char-after (point)) ?\n) + (delete-char 1)) + (end-of-line) + (while (zerop (forward-line)) + (if (setq last-token + (car (filladapt-tail (filladapt-parse-prefixes)))) + (progn + (setq line-start (point)) + (move-to-column (nth 1 last-token)) + (delete-region line-start (point)))) + ;; Dance... + ;; + ;; Do this instead of (delete-char -1) to keep + ;; markers on the correct side of the whitespace. + (goto-char (1- (point))) + (insert " ") + (delete-char 1) + + (end-of-line)) + (goto-char beg) + (fill-paragraph justify)) + ;; In XEmacs 19.12 and Emacs 18.59 fill-region relies on + ;; fill-region-as-paragraph to do this. If we don't do + ;; it, fill-region will spin in an endless loop. + (goto-char (point-max))) + (condition-case nil + ;; five args for Emacs 19.31 + (filladapt-funcall 'fill-region-as-paragraph beg end + justify nosqueeze squeeze-after) + (wrong-number-of-arguments + (condition-case nil + ;; four args for Emacs 19.29 + (filladapt-funcall 'fill-region-as-paragraph beg end + justify nosqueeze) + ;; three args for the rest of the world. + (wrong-number-of-arguments + (filladapt-funcall 'fill-region-as-paragraph beg end justify))))))) + +(defun fill-region (beg end &optional justify nosqueeze to-eop) + "Fill each of the paragraphs in the region. + +(This function has been overloaded with the `filladapt' version.) + +Prefix arg (non-nil third arg, if called from program) means justify as well. + +Noninteractively, fourth arg NOSQUEEZE non-nil means to leave +whitespace other than line breaks untouched, and fifth arg TO-EOP +non-nil means to keep filling to the end of the paragraph (or next +hard newline, if `use-hard-newlines' is on). + +If `sentence-end-double-space' is non-nil, then period followed by one +space does not end a sentence, so don't break a line there." + (interactive "*r\nP") + (if (and filladapt-mode (not filladapt-inside-filladapt)) + (save-restriction + (narrow-to-region beg end) + (let ((filladapt-inside-filladapt t) + start) + (goto-char beg) + (while (not (eobp)) + (setq start (point)) + (while (and (not (eobp)) (not (filladapt-parse-prefixes))) + (forward-line 1)) + (if (not (equal start (point))) + (progn + (save-restriction + (narrow-to-region start (point)) + (fill-region start (point) justify nosqueeze to-eop) + (goto-char (point-max))) + (if (and (not (bolp)) (not (eobp))) + (forward-line 1)))) + (if (filladapt-parse-prefixes) + (progn + (save-restriction + ;; for the clipping region + (filladapt-adapt t t) + (fill-paragraph justify) + (goto-char (point-max))) + (if (and (not (bolp)) (not (eobp))) + (forward-line 1))))))) + (condition-case nil + (filladapt-funcall 'fill-region beg end justify nosqueeze to-eop) + (wrong-number-of-arguments + (condition-case nil + (filladapt-funcall 'fill-region beg end justify nosqueeze) + (wrong-number-of-arguments + (filladapt-funcall 'fill-region beg end justify))))))) + +(defvar zmacs-region-stays) ; for XEmacs + +(defun filladapt-mode (&optional arg) + "Toggle Filladapt minor mode. +With arg, turn Filladapt mode on iff arg is positive. When +Filladapt mode is enabled, auto-fill-mode and the fill-paragraph +command are both smarter about guessing a proper fill-prefix and +finding paragraph boundaries when bulleted and indented lines and +paragraphs are used." + (interactive "P") + ;; don't deactivate the region. + (setq zmacs-region-stays t) + (setq filladapt-mode (or (and arg (> (prefix-numeric-value arg) 0)) + (and (null arg) (null filladapt-mode)))) + (if (fboundp 'force-mode-line-update) + (force-mode-line-update) + (set-buffer-modified-p (buffer-modified-p)))) + +(defun turn-on-filladapt-mode () + "Unconditionally turn on Filladapt mode in the current buffer." + (filladapt-mode 1)) + +(defun turn-off-filladapt-mode () + "Unconditionally turn off Filladapt mode in the current buffer." + (filladapt-mode -1)) + +(defun filladapt-funcall (function &rest args) + "Call the old definition of a function that filladapt has usurped." + (apply (cdr (assoc function filladapt-function-table)) args)) + +(defun filladapt-paragraph-start (list) + "Returns non-nil if LIST contains a paragraph starting token. +LIST should be a token list as returned by filladapt-parse-prefixes." + (catch 'done + (while list + (if (memq (car (car list)) filladapt-token-paragraph-start-table) + (throw 'done t)) + (setq list (cdr list))))) + +(defun filladapt-parse-prefixes () + "Parse all the tokens after point and return a list of them. +The tokens regular expressions are specified in +filladapt-token-table. The list returned is of this form + + ((SYM COL STRING) ...) + +SYM is a token symbol as found in filladapt-token-table. +COL is the column at which the token ended. +STRING is the token's text." + (save-excursion + (let ((token-list nil) + (done nil) + (old-point (point)) + (case-fold-search nil) + token-table not-token-table moved) + (catch 'done + (while (not done) + (setq not-token-table filladapt-not-token-table) + (while not-token-table + (if (looking-at (car not-token-table)) + (throw 'done t)) + (setq not-token-table (cdr not-token-table))) + (setq token-table filladapt-token-table + done t) + (while token-table + (if (null (looking-at (car (car token-table)))) + (setq token-table (cdr token-table)) + (goto-char (match-end 0)) + (setq token-list (cons (list (nth 1 (car token-table)) + (current-column) + (buffer-substring + (match-beginning 0) + (match-end 0))) + token-list) + moved (not (eq (point) old-point)) + token-table (if moved nil (cdr token-table)) + done (not moved) + old-point (point)))))) + (nreverse token-list)))) + +(defun filladapt-tokens-match-p (list1 list2) + "Compare two token lists and return non-nil if they match, nil otherwise. +The lists are walked through in lockstep, comparing tokens. + +When two tokens A and B are compared, they are considered to +match if + + 1. A appears in B's list of matching tokens or + B appears in A's list of matching tokens +and + 2. A and B both end at the same column + or + A can match multiple tokens and ends at a column > than B + or + B can match multiple tokens and ends at a column > than A + +In the case where the end columns differ the list pointer for the +token with the greater end column is not moved forward, which +allows its current token to be matched against the next token in +the other list in the next iteration of the matching loop. + +All tokens must be matched in order for the lists to be considered +matching." + (let ((matched t) + (done nil)) + (while (and (not done) list1 list2) + (let* ((token1 (car (car list1))) + (token1-matches-many-p + (memq token1 filladapt-token-match-many-table)) + (token1-matches (cdr (assq token1 filladapt-token-match-table))) + (token1-endcol (nth 1 (car list1))) + (token2 (car (car list2))) + (token2-matches-many-p + (memq token2 filladapt-token-match-many-table)) + (token2-matches (cdr (assq token2 filladapt-token-match-table))) + (token2-endcol (nth 1 (car list2))) + (tokens-match (or (memq token1 token2-matches) + (memq token2 token1-matches)))) + (cond ((not tokens-match) + (setq matched nil + done t)) + ((and token1-matches-many-p token2-matches-many-p) + (cond ((= token1-endcol token2-endcol) + (setq list1 (cdr list1) + list2 (cdr list2))) + ((< token1-endcol token2-endcol) + (setq list1 (cdr list1))) + (t + (setq list2 (cdr list2))))) + (token1-matches-many-p + (cond ((= token1-endcol token2-endcol) + (setq list1 (cdr list1) + list2 (cdr list2))) + ((< token1-endcol token2-endcol) + (setq matched nil + done t)) + (t + (setq list2 (cdr list2))))) + (token2-matches-many-p + (cond ((= token1-endcol token2-endcol) + (setq list1 (cdr list1) + list2 (cdr list2))) + ((< token2-endcol token1-endcol) + (setq matched nil + done t)) + (t + (setq list1 (cdr list1))))) + ((= token1-endcol token2-endcol) + (setq list1 (cdr list1) + list2 (cdr list2))) + (t + (setq matched nil + done t))))) + (and matched (null list1) (null list2)) )) + +(defun filladapt-make-fill-prefix (list) + "Build a fill-prefix for a token LIST. +filladapt-token-conversion-table specifies how this is done." + (let ((prefix-list nil) + (conversion-spec nil)) + (while list + (setq conversion-spec (cdr (assq (car (car list)) + filladapt-token-conversion-table))) + (cond ((eq conversion-spec 'spaces) + (setq prefix-list + (cons + (filladapt-convert-to-spaces (nth 2 (car list))) + prefix-list))) + ((eq conversion-spec 'exact) + (setq prefix-list + (cons + (nth 2 (car list)) + prefix-list)))) + (setq list (cdr list))) + (apply (function concat) (nreverse prefix-list)) )) + +(defun filladapt-paragraph-within-fill-tolerance () + (catch 'done + (save-excursion + (let ((low (- fill-column filladapt-fill-column-tolerance)) + (shortline nil)) + (goto-char (point-min)) + (while (not (eobp)) + (if shortline + (throw 'done nil) + (end-of-line) + (setq shortline (< (current-column) low)) + (forward-line 1))) + t )))) + +(defun filladapt-convert-to-spaces (string) + "Return a copy of STRING, with all non-tabs and non-space changed to spaces." + (let ((i 0) + (space-list '(?\ ?\t)) + (space ?\ ) + (lim (length string))) + (setq string (copy-sequence string)) + (while (< i lim) + (if (not (memq (aref string i) space-list)) + (aset string i space)) + (setq i (1+ i))) + string )) + +(defun filladapt-adapt (paragraph debugging) + "Set fill-prefix based on the contents of the current line. + +If the first arg PARAGRAPH is non-nil, also set a clipping region +around the current paragraph. + +If the second arg DEBUGGING is non-nil, don't do the kludge that's +necessary to make certain paragraph fills work properly." + (save-excursion + (beginning-of-line) + (let ((token-list (filladapt-parse-prefixes)) + curr-list done) + (if (null token-list) + nil + (setq fill-prefix (filladapt-make-fill-prefix token-list)) + (if paragraph + (let (beg end) + (if (filladapt-paragraph-start token-list) + (setq beg (point)) + (save-excursion + (setq done nil) + (while (not done) + (cond ((not (= 0 (forward-line -1))) + (setq done t + beg (point))) + ((not (filladapt-tokens-match-p + token-list + (setq curr-list (filladapt-parse-prefixes)))) + (forward-line 1) + (setq done t + beg (point))) + ((filladapt-paragraph-start curr-list) + (setq done t + beg (point))))))) + (save-excursion + (setq done nil) + (while (not done) + (cond ((not (= 0 (progn (end-of-line) (forward-line 1)))) + (setq done t + end (point))) + ((not (filladapt-tokens-match-p + token-list + (setq curr-list (filladapt-parse-prefixes)))) + (setq done t + end (point))) + ((filladapt-paragraph-start curr-list) + (setq done t + end (point)))))) + (narrow-to-region beg end) + ;; Multiple spaces after the bullet at the start of + ;; a hanging list paragraph get squashed by + ;; fill-paragraph. We kludge around this by + ;; replacing the line prefix with the fill-prefix + ;; used by the rest of the lines in the paragraph. + ;; fill-paragraph will not alter the fill prefix so + ;; we win. The post hook restores the old line prefix + ;; after fill-paragraph has been called. + (if (and paragraph (not debugging)) + (let (col) + (setq col (nth 1 (car (filladapt-tail token-list)))) + (goto-char (point-min)) + (move-to-column col) + (setq filladapt-old-line-prefix + (buffer-substring (point-min) (point))) + (delete-region (point-min) (point)) + (insert fill-prefix) + (add-hook 'filladapt-fill-paragraph-post-hook + 'filladapt-cleanup-kludge-at-point-min))))) + t )))) + +(defun filladapt-cleanup-kludge-at-point-min () + "Cleanup the paragraph fill kludge. +See filladapt-adapt." + (save-excursion + (goto-char (point-min)) + (insert filladapt-old-line-prefix) + (delete-char (length fill-prefix)) + (remove-hook 'filladapt-fill-paragraph-post-hook + 'filladapt-cleanup-kludge-at-point-min))) + +(defun filladapt-tail (list) + "Returns the last cons in LIST." + (if (null list) + nil + (while (consp (cdr list)) + (setq list (cdr list))) + list )) + +(defun filladapt-delete-extent (e) + (if (fboundp 'delete-extent) + (delete-extent e) + (delete-overlay e))) + +(defun filladapt-make-extent (beg end) + (if (fboundp 'make-extent) + (make-extent beg end) + (make-overlay beg end))) + +(defun filladapt-set-extent-endpoints (e beg end) + (if (fboundp 'set-extent-endpoints) + (set-extent-endpoints e beg end) + (move-overlay e beg end))) + +(defun filladapt-set-extent-property (e prop val) + (if (fboundp 'set-extent-property) + (set-extent-property e prop val) + (overlay-put e prop val))) + +(defun filladapt-debug () + "Toggle filladapt debugging on/off in the current buffer." +;; (interactive) + (make-local-variable 'filladapt-debug) + (setq filladapt-debug (not filladapt-debug)) + (if (null filladapt-debug) + (progn + (mapcar (function (lambda (e) (filladapt-set-extent-endpoints e 1 1))) + filladapt-debug-indentation-extents) + (if filladapt-debug-paragraph-extent + (progn + (filladapt-delete-extent filladapt-debug-paragraph-extent) + (setq filladapt-debug-paragraph-extent nil))))) + (add-hook 'post-command-hook 'filladapt-display-debug-info-maybe)) + +(defun filladapt-display-debug-info-maybe () + (cond ((null filladapt-debug) nil) + (fill-prefix nil) + (t + (if (null filladapt-debug-paragraph-extent) + (let ((e (filladapt-make-extent 1 1))) + (filladapt-set-extent-property e 'detachable nil) + (filladapt-set-extent-property e 'evaporate nil) + (filladapt-set-extent-property e 'face + filladapt-debug-paragraph-face) + (setq filladapt-debug-paragraph-extent e))) + (save-excursion + (save-restriction + (let ((ei-list filladapt-debug-indentation-extents) + (ep filladapt-debug-paragraph-extent) + (face filladapt-debug-indentation-face-1) + fill-prefix token-list) + (if (null (filladapt-adapt t t)) + (progn + (filladapt-set-extent-endpoints ep 1 1) + (while ei-list + (filladapt-set-extent-endpoints (car ei-list) 1 1) + (setq ei-list (cdr ei-list)))) + (filladapt-set-extent-endpoints ep (point-min) (point-max)) + (beginning-of-line) + (setq token-list (filladapt-parse-prefixes)) + (message "(%s)" (mapconcat (function + (lambda (q) (symbol-name (car q)))) + token-list + " ")) + (while token-list + (if ei-list + (setq e (car ei-list) + ei-list (cdr ei-list)) + (setq e (filladapt-make-extent 1 1)) + (filladapt-set-extent-property e 'detachable nil) + (filladapt-set-extent-property e 'evaporate nil) + (setq filladapt-debug-indentation-extents + (cons e filladapt-debug-indentation-extents))) + (filladapt-set-extent-property e 'face face) + (filladapt-set-extent-endpoints e (point) + (progn + (move-to-column + (nth 1 + (car token-list))) + (point))) + (if (eq face filladapt-debug-indentation-face-1) + (setq face filladapt-debug-indentation-face-2) + (setq face filladapt-debug-indentation-face-1)) + (setq token-list (cdr token-list))) + (while ei-list + (filladapt-set-extent-endpoints (car ei-list) 1 1) + (setq ei-list (cdr ei-list)))))))))) diff --git a/lisp/promela-mode.el b/lisp/promela-mode.el new file mode 100644 index 0000000..3ab4da7 --- /dev/null +++ b/lisp/promela-mode.el @@ -0,0 +1,985 @@ +;; promela-mode.el --- major mode for editing PROMELA program files +;; $Revision: 1.11 $ $Date: 2001/07/09 18:36:45 $ $Author: engstrom $ + +;; Author: Eric Engstrom <eric.engstrom@honeywell.com> +;; Maintainer: Eric Engstrom +;; Keywords: spin, promela, tools + +;; Copyright (C) 1998-2003 Eric Engstrom / Honeywell Laboratories + +;; ... Possibly insert GPL here someday ... + +;;; Commentary: + +;; This file contains code for a GNU Emacs major mode for editing +;; PROMELA (SPIN) program files. + +;; Type "C-h m" in Emacs (while in a buffer in promela-mode) for +;; information on how to configure indentation and fontification, +;; or look at the configuration variables below. + +;; To use, place promela-mode.el in a directory in your load-path. +;; Then, put the following lines into your .emacs and promela-mode +;; will be automatically loaded when editing a PROMELA program. + +;; (autoload 'promela-mode "promela-mode" "PROMELA mode" nil t) +;; (setq auto-mode-alist +;; (append +;; (list (cons "\\.promela$" 'promela-mode) +;; (cons "\\.spin$" 'promela-mode) +;; (cons "\\.pml$" 'promela-mode) +;; ;; (cons "\\.other-extensions$" 'promela-mode) +;; ) +;; auto-mode-alist)) + +;; If you wish for promela-mode to be used for files with other +;; extensions you add your own patterned after the code above. + +;; Note that promela-mode adhears to the font-lock "standards" and +;; defines several "levels" of fontification or colorization. The +;; default is fairly gaudy, so I can imagine that some folks would +;; like a bit less. FMI: see `font-lock-maximum-decoration' + +;; This mode is known to work under the following versions of emacs: +;; - XEmacs: 19.16, 20.x, 21.x +;; - FSF/GNU Emacs: 19.34 +;; - NTEmacs (FSF): 20.[67] +;; That is not to say there are no bugs specific to one of those versions :-) + +;; Please send any comments, bugs, patches or other requests to +;; Eric Engstrom at engstrom@htc.honeywell.com + +;; To-Do: +;; - compile/syntax-check/verify? (suggested by R.Goldman) +;; - indentation - splitting lines at logical operators (M. Rangarajan) +;; [ This might "devolve" to indentation after "->" or ";" +;; being as is, but anything else indent even more? ] +;; :: SomeReallyLongArrayRef[this].typedefField != SomeReallyLongConstant -> /* some-comment */ +;; [ Suggestion would be to break the first line after the !=, therefore: ] +;; :: SomeReallyLongArrayRef[this].typedefField +;; != SomeReallyLongConstant -> /* some-comment */ +;; [ at this point I'm not so sure about this change... EE: 2001/05/19 ] + +;;; ------------------------------------------------------------------------- +;;; Code: + +;; NOTE: same as CVS revision: +(defconst promela-mode-version "$Revision: 1.11 $" + "Promela-mode version number.") + +;; ------------------------------------------------------------------------- +;; The following constant values can be modified by the user in a .emacs file + +(defconst promela-block-indent 2 + "*Controls indentation of lines within a block (`{') construct") + +(defconst promela-selection-indent 2 + "*Controls indentation of options within a selection (`if') +or iteration (`do') construct") + +(defconst promela-selection-option-indent 3 + "*Controls indentation of lines after options within selection or +iteration construct (`::')") + +(defconst promela-comment-col 32 + "*Defines the desired comment column for comments to the right of text.") + +(defconst promela-tab-always-indent t + "*Non-nil means TAB in Promela mode should always reindent the current line, +regardless of where in the line point is when the TAB command is used.") + +(defconst promela-auto-match-delimiter t + "*Non-nil means typing an open-delimiter (i.e. parentheses, brace, quote, etc) +should also insert the matching closing delmiter character.") + +;; That should be about it for most users... +;; unless you wanna hack elisp, the rest of this is probably uninteresting + + +;; ------------------------------------------------------------------------- +;; help determine what emacs we have here... + +(defconst promela-xemacsp (string-match "XEmacs" (emacs-version)) + "Non-nil if we are running in the XEmacs environment.") + +;;;(defconst promela-xemacs20p (and promela-xemacsp (>= emacs-major-version 20)) +;; "Non-nil if we are running in an XEmacs environment version 20 or greater.") + +;; ------------------------------------------------------------------------- +;; promela-mode font faces/definitions + +;; make use of font-lock stuff, so say that explicitly +(require 'font-lock) + +;; BLECH! YUCK! I just wish these guys could agree to something.... +;; Faces available in: ntemacs emacs xemacs xemacs xemacs +;; font-lock- xxx -face 20.6 19.34 19.16 20.x 21.x +;; -builtin- X +;; -constant- X +;; -comment- X X X X X +;; -doc-string- X X X +;; -function-name- X X X X X +;; -keyword- X X X X X +;; -preprocessor- X X X +;; -reference- X X X X +;; -signal-name- X X!20.0 +;; -string- X X X X X +;; -type- X X X X X +;; -variable-name- X X X X X +;; -warning- X X + +;;; Compatibility on faces between versions of emacs-en +(unless promela-xemacsp + + (defvar font-lock-preprocessor-face 'font-lock-preprocessor-face + "Face name to use for preprocessor statements.") + ;; For consistency try to define the preprocessor face == builtin face + (condition-case nil + (copy-face 'font-lock-builtin-face 'font-lock-preprocessor-face) + (error + (defface font-lock-preprocessor-face + '((t (:foreground "blue" :italic nil :underline t))) + "Face Lock mode face used to highlight preprocessor statements." + :group 'font-lock-highlighting-faces))) + + (defvar font-lock-reference-face 'font-lock-reference-face + "Face name to use for constants and reference and label names.") + ;; For consistency try to define the reference face == constant face + (condition-case nil + (copy-face 'font-lock-constant-face 'font-lock-reference-face) + (error + (defface font-lock-reference-face + '((((class grayscale) (background light)) + (:foreground "LightGray" :bold t :underline t)) + (((class grayscale) (background dark)) + (:foreground "Gray50" :bold t :underline t)) + (((class color) (background light)) (:foreground "CadetBlue")) + (((class color) (background dark)) (:foreground "Aquamarine")) + (t (:bold t :underline t))) + "Font Lock mode face used to highlight constancs, references and labels." + :group 'font-lock-highlighting-faces))) + + ) + +;; send-poll "symbol" face is custom to promela-mode +;; but check for existence to allow someone to override it +(defvar promela-fl-send-poll-face 'promela-fl-send-poll-face + "Face name to use for Promela Send or Poll symbols: `!' or `?'") +(copy-face (if promela-xemacsp 'modeline 'region) + 'promela-fl-send-poll-face) + +;; some emacs-en don't define or have regexp-opt available. +(unless (functionp 'regexp-opt) + (defmacro regexp-opt (strings) + "Cheap imitation of `regexp-opt' since it's not availble in this emacs" + `(mapconcat 'identity ,strings "\\|"))) + + +;; ------------------------------------------------------------------------- +;; promela-mode font lock specifications/regular-expressions +;; - for help, look at definition of variable 'font-lock-keywords +;; - some fontification ideas from -- [engstrom:20010309.1435CST] +;; Pat Tullman (tullmann@cs.utah.edu) and +;; Ny Aina Razermera Mamy (ainarazr@cs.uoregon.edu) +;; both had promela-mode's that I discovered after starting this one... +;; (but neither did any sort of indentation ;-) + +(defconst promela-font-lock-keywords-1 nil + "Subdued level highlighting for Promela mode.") + +(defconst promela-font-lock-keywords-2 nil + "Medium level highlighting for Promela mode.") + +(defconst promela-font-lock-keywords-3 nil + "Gaudy level highlighting for Promela mode.") + +;; set each of those three variables now.. +(let ((promela-keywords + (eval-when-compile + (regexp-opt + '("active" "assert" "atomic" "break" "d_step" + "do" "dproctype" "else" "empty" "enabled" + "eval" "fi" "full" "goto" "hidden" "if" "init" + "inline" "len" "local" "mtype" "nempty" "never" + "nfull" "od" "of" "pcvalue" "printf" "priority" + "proctype" "provided" "run" "show" "skip" + "timeout" "trace" "typedef" "unless" "xr" "xs")))) + (promela-types + (eval-when-compile + (regexp-opt '("bit" "bool" "byte" "short" + "int" "unsigned" "chan"))))) + + ;; really simple fontification (strings and comments come for "free") + (setq promela-font-lock-keywords-1 + (list + ;; Keywords: + (cons (concat "\\<\\(" promela-keywords "\\)\\>") + 'font-lock-keyword-face) + ;; Types: + (cons (concat "\\<\\(" promela-types "\\)\\>") + 'font-lock-type-face) + ;; Special constants: + '("\\<_\\(np\\|pid\\|last\\)\\>" . font-lock-reference-face))) + + ;; more complex fontification + ;; add function (proctype) names, lables and goto statements + ;; also add send/receive/poll fontification + (setq promela-font-lock-keywords-2 + (append promela-font-lock-keywords-1 + (list + ;; ANY Pre-Processor directive (lazy method: any line beginning with "#[a-z]+") + '("^\\(#[ \t]*[a-z]+\\)" 1 'font-lock-preprocessor-face t) + + ;; "Functions" (proctype-s and inline-s) + (list (concat "\\<\\(" + (eval-when-compile + (regexp-opt '("run" "dproctype" "proctype" "inline"))) + "\\)\\>[ \t]*\\(\\sw+\\)?") + ;;'(1 'font-lock-keyword-face nil) + '(2 'font-lock-function-name-face nil t)) + + ;; Labels and GOTO labels + '("^\\(\\sw+\\):" 1 'font-lock-reference-face) + '("\\<\\(goto\\)\\>[ \t]+\\(\\sw+\\)" + ;;(1 'font-lock-keyword-face nil) + (2 'font-lock-reference-face nil t)) + + ;; Send, Receive and Poll + '("\\(\\sw+\\)\\(\\[[^\\?!]+\\]\\)?\\(\\??\\?\\|!?!\\)\\(\\sw+\\)" + (1 'font-lock-variable-name-face nil t) + (3 'promela-fl-send-poll-face nil t) + (4 'font-lock-reference-face nil t) + ) + ))) + + ;; most complex fontification + ;; add pre-processor directives, typed variables and hidden/typedef decls. + (setq promela-font-lock-keywords-3 + (append promela-font-lock-keywords-2 + (list + ;; ANY Pre-Processor directive (lazy method: any line beginning with "#[a-z]+") + ;;'("^\\(#[ \t]*[a-z]+\\)" 1 'font-lock-preprocessor-face t) + ;; "defined" in an #if or #elif and associated macro names + '("^#[ \t]*\\(el\\)?if\\>" + ("\\<\\(defined\\)\\>[ \t]*(?\\(\\sw+\\)" nil nil + (1 'font-lock-preprocessor-face nil t) + (2 'font-lock-reference-face nil t))) + '("^#[ \t]*ifn?def\\>" + ("[ \t]*\\(\\sw+\\)" nil nil + (1 'font-lock-reference-face nil t))) + ;; Filenames in #include <...> directives + '("^#[ \t]*include[ \t]+<\\([^>\"\n]+\\)>" 1 'font-lock-string-face nil t) + ;; Defined functions and constants/types (non-functions) + '("^#[ \t]*define[ \t]+" + ("\\(\\sw+\\)(" nil nil (1 'font-lock-function-name-face nil t)) + ("\\(\\sw+\\)[ \t]+\\(\\sw+\\)" nil nil (1 'font-lock-variable-name-face) + (2 'font-lock-reference-face nil t)) + ("\\(\\sw+\\)[^(]?" nil nil (1 'font-lock-reference-face nil t))) + + ;; Types AND variables + ;; - room for improvement: (i.e. don't currently): + ;; highlight user-defined types and asociated variable declarations + (list (concat "\\<\\(" promela-types "\\)\\>") + ;;'(1 'font-lock-type-face) + ;; now match the variables after the type definition, if any + '(promela-match-variable-or-declaration + nil nil + (1 'font-lock-variable-name-face) ;; nil t) + (2 font-lock-reference-face nil t))) + + ;; Typedef/hidden types and declarations + '("\\<\\(typedef\\|hidden\\)\\>[ \t]*\\(\\sw+\\)?" + ;;(1 'font-lock-keyword-face nil) + (2 'font-lock-type-face nil t) + ;; now match the variables after the type definition, if any + (promela-match-variable-or-declaration + nil nil + (1 'font-lock-variable-name-face nil t) + (2 'font-lock-reference-face nil t))) + ))) + ) + +(defvar promela-font-lock-keywords promela-font-lock-keywords-1 + "Default expressions to highlight in Promela mode.") + +;; Font-lock matcher functions: +(defun promela-match-variable-or-declaration (limit) + "Match, and move over, any declaration/definition item after point. +Matches after point, but ignores leading whitespace characters. +Does not move further than LIMIT. + +The expected syntax of a declaration/definition item is `word' (preceded +by optional whitespace) optionally followed by a `= value' (preceded and +followed by more optional whitespace) + +Thus the regexp matches after point: word [ = value ] + ^^^^ ^^^^^ +Where the match subexpressions are: 1 2 + +The item is delimited by (match-beginning 1) and (match-end 1). +If (match-beginning 2) is non-nil, the item is followed by a `value'." + (when (looking-at "[ \t]*\\(\\sw+\\)[ \t]*=?[ \t]*\\(\\sw+\\)?[ \t]*,?") + (goto-char (min limit (match-end 0))))) + + +;; ------------------------------------------------------------------------- +;; "install" promela-mode font lock specifications + +;; FMI: look up 'font-lock-defaults +(defconst promela-font-lock-defaults + '( + (promela-font-lock-keywords + promela-font-lock-keywords-1 + promela-font-lock-keywords-2 + promela-font-lock-keywords-3) ;; font-lock stuff (keywords) + nil ;; keywords-only flag + nil ;; case-fold keyword searching + ;;((?_ . "w") (?$ . ".")) ;; mods to syntax table + nil ;; mods to syntax table (see below) + nil ;; syntax-begin + (font-lock-mark-block-function . mark-defun)) +) + +;; "install" the font-lock-defaults based upon version of emacs we have +(cond (promela-xemacsp + (put 'promela-mode 'font-lock-defaults promela-font-lock-defaults)) + ((not (assq 'promela-mode font-lock-defaults-alist)) + (setq font-lock-defaults-alist + (cons + (cons 'promela-mode promela-font-lock-defaults) + font-lock-defaults-alist)))) + + +;; ------------------------------------------------------------------------- +;; other promela-mode specific definitions + +(defconst promela-defun-prompt-regexp + "^[ \t]*\\(\\(active \\)?d?proctype\\|init\\|inline\\|never\\|trace\\|typedef\\|mtype\\s-+=\\)[ \t][^{]*" + "Regexp describing the beginning of a Promela top-level definition.") + +(defvar promela-mode-syntax-table nil + "Syntax table in use in PROMELA-mode buffers.") +(if promela-mode-syntax-table + () + (setq promela-mode-syntax-table (make-syntax-table)) + (modify-syntax-entry ?\\ "\\" promela-mode-syntax-table) + (modify-syntax-entry ?/ ". 14" promela-mode-syntax-table) + (modify-syntax-entry ?* ". 23" promela-mode-syntax-table) + (modify-syntax-entry ?+ "." promela-mode-syntax-table) + (modify-syntax-entry ?- "." promela-mode-syntax-table) + (modify-syntax-entry ?= "." promela-mode-syntax-table) + (modify-syntax-entry ?% "." promela-mode-syntax-table) + (modify-syntax-entry ?< "." promela-mode-syntax-table) + (modify-syntax-entry ?> "." promela-mode-syntax-table) + (modify-syntax-entry ?& "." promela-mode-syntax-table) + (modify-syntax-entry ?| "." promela-mode-syntax-table) + (modify-syntax-entry ?. "_" promela-mode-syntax-table) + (modify-syntax-entry ?_ "w" promela-mode-syntax-table) + (modify-syntax-entry ?\' "\"" promela-mode-syntax-table) + ) + +(defvar promela-mode-abbrev-table nil + "*Abbrev table in use in promela-mode buffers.") +(if promela-mode-abbrev-table + nil + (define-abbrev-table 'promela-mode-abbrev-table + '( +;; Commented out for now - need to think about what abbrevs make sense +;; ("assert" "ASSERT" promela-check-expansion 0) +;; ("d_step" "D_STEP" promela-check-expansion 0) +;; ("break" "BREAK" promela-check-expansion 0) +;; ("do" "DO" promela-check-expansion 0) +;; ("proctype" "PROCTYPE" promela-check-expansion 0) + ))) + +(defvar promela-mode-map nil + "Keymap for promela-mode.") +(if promela-mode-map + nil + (setq promela-mode-map (make-sparse-keymap)) + (define-key promela-mode-map "\t" 'promela-indent-command) + (define-key promela-mode-map "\C-m" 'promela-newline-and-indent) + ;(define-key promela-mode-map 'backspace 'backward-delete-char-untabify) + (define-key promela-mode-map "\C-c\C-p" 'promela-beginning-of-block) + ;(define-key promela-mode-map "\C-c\C-n" 'promela-end-of-block) + (define-key promela-mode-map "\M-\C-a" 'promela-beginning-of-defun) + ;(define-key promela-mode-map "\M-\C-e" 'promela-end-of-defun) + (define-key promela-mode-map "\C-c(" 'promela-toggle-auto-match-delimiter) + (define-key promela-mode-map "{" 'promela-open-delimiter) + (define-key promela-mode-map "}" 'promela-close-delimiter) + (define-key promela-mode-map "(" 'promela-open-delimiter) + (define-key promela-mode-map ")" 'promela-close-delimiter) + (define-key promela-mode-map "[" 'promela-open-delimiter) + (define-key promela-mode-map "]" 'promela-close-delimiter) + (define-key promela-mode-map ";" 'promela-insert-and-indent) + (define-key promela-mode-map ":" 'promela-insert-and-indent) + ;; + ;; this is preliminary at best - use at your own risk: + (define-key promela-mode-map "\C-c\C-s" 'promela-syntax-check) + ;; + ;;(define-key promela-mode-map "\C-c\C-d" 'promela-mode-toggle-debug) + ;;(define-key promela-mode-map "\C-c\C-r" 'promela-mode-revert-buffer) + ) + +(defvar promela-matching-delimiter-alist + '( (?( . ?)) + (?[ . ?]) + (?{ . "\n}") + ;(?< . ?>) + (?\' . ?\') + (?\` . ?\`) + (?\" . ?\") ) + "List of pairs of matching open/close delimiters - for auto-insert") + + +;; ------------------------------------------------------------------------- +;; Promela-mode itself + +(defun promela-mode () + "Major mode for editing PROMELA code. +\\{promela-mode-map} + +Variables controlling indentation style: + promela-block-indent + Relative offset of lines within a block (`{') construct. + + promela-selection-indent + Relative offset of option lines within a selection (`if') + or iteration (`do') construct. + + promela-selection-option-indent + Relative offset of lines after/within options (`::') within + selection or iteration constructs. + + promela-comment-col + Defines the desired comment column for comments to the right of text. + + promela-tab-always-indent + Non-nil means TAB in PROMELA mode should always reindent the current + line, regardless of where in the line the point is when the TAB + command is used. + + promela-auto-match-delimiter + Non-nil means typing an open-delimiter (i.e. parentheses, brace, + quote, etc) should also insert the matching closing delmiter + character. + +Turning on PROMELA mode calls the value of the variable promela-mode-hook with +no args, if that value is non-nil. + +For example: ' + (setq promela-mode-hook '(lambda () + (setq promela-block-indent 2) + (setq promela-selection-indent 0) + (setq promela-selection-option-indent 2) + (local-set-key \"\\C-m\" 'promela-indent-newline-indent) + ))' + +will indent block two steps, will make selection options aligned with DO/IF +and sub-option lines indent to a column after the `::'. Also, lines will +be reindented when you hit RETURN. + +Note that promela-mode adhears to the font-lock \"standards\" and +defines several \"levels\" of fontification or colorization. The +default is fairly gaudy, so if you would prefer a bit less, please see +the documentation for the variable: `font-lock-maximum-decoration'. +" + (interactive) + (kill-all-local-variables) + (setq mode-name "Promela") + (setq major-mode 'promela-mode) + (use-local-map promela-mode-map) + (set-syntax-table promela-mode-syntax-table) + (setq local-abbrev-table promela-mode-abbrev-table) + + ;; Make local variables + (make-local-variable 'case-fold-search) + (make-local-variable 'paragraph-start) + (make-local-variable 'paragraph-separate) + (make-local-variable 'paragraph-ignore-fill-prefix) + (make-local-variable 'indent-line-function) + (make-local-variable 'indent-region-function) + (make-local-variable 'parse-sexp-ignore-comments) + (make-local-variable 'comment-start) + (make-local-variable 'comment-end) + (make-local-variable 'comment-column) + (make-local-variable 'comment-start-skip) + (make-local-variable 'comment-indent-hook) + (make-local-variable 'defun-prompt-regexp) + (make-local-variable 'compile-command) + ;; Now set their values + (setq case-fold-search t + paragraph-start (concat "^$\\|" page-delimiter) + paragraph-separate paragraph-start + paragraph-ignore-fill-prefix t + indent-line-function 'promela-indent-command + ;;indent-region-function 'promela-indent-region + parse-sexp-ignore-comments t + comment-start "/* " + comment-end " */" + comment-column 32 + comment-start-skip "/\\*+ *" + ;;comment-start-skip "/\\*+ *\\|// *" + ;;comment-indent-hook 'promela-comment-indent + defun-prompt-regexp promela-defun-prompt-regexp + ) + + ;; Turn on font-lock mode + ;; (and promela-font-lock-mode (font-lock-mode)) + (font-lock-mode) + + ;; Finally, run the hooks and be done. + (run-hooks 'promela-mode-hook)) + + +;; ------------------------------------------------------------------------- +;; Interactive functions +;; + +(defun promela-mode-version () + "Print the current version of promela-mode in the minibuffer" + (interactive) + (message (concat "Promela-Mode: " promela-mode-version))) + +(defun promela-beginning-of-block () + "Move backward to start of containing block. +Containing block may be `{', `do' or `if' construct, or comment." + (interactive) + (goto-char (promela-find-start-of-containing-block-or-comment))) + +(defun promela-beginning-of-defun (&optional arg) + "Move backward to the beginning of a defun. +With argument, do it that many times. +Negative arg -N means move forward to Nth following beginning of defun. +Returns t unless search stops due to beginning or end of buffer. + +See also 'beginning-of-defun. + +This is a Promela-mode specific version since default (in xemacs 19.16 and +NT-Emacs 20) don't seem to skip comments - they will stop inside them. + +Also, this makes sure that the beginning of the defun is actually the +line which starts the proctype/init/etc., not just the open-brace." + (interactive "p") + (beginning-of-defun arg) + (if (not (looking-at promela-defun-prompt-regexp)) + (re-search-backward promela-defun-prompt-regexp nil t)) + (if (promela-inside-comment-p) + (goto-char (promela-find-start-of-containing-comment)))) + +(defun promela-indent-command () + "Indent the current line as PROMELA code." + (interactive) + (if (and (not promela-tab-always-indent) + (save-excursion + (skip-chars-backward " \t") + (not (bolp)))) + (tab-to-tab-stop) + (promela-indent-line))) + +(defun promela-newline-and-indent () + "Promela-mode specific newline-and-indent which expands abbrevs before +running a regular newline-and-indent." + (interactive) + (if abbrev-mode + (expand-abbrev)) + (newline-and-indent)) + +(defun promela-indent-newline-indent () + "Promela-mode specific newline-and-indent which expands abbrevs and +indents the current line before running a regular newline-and-indent." + (interactive) + (save-excursion (promela-indent-command)) + (if abbrev-mode + (expand-abbrev)) + (newline-and-indent)) + +(defun promela-insert-and-indent () + "Insert the last character typed and re-indent the current line" + (interactive) + (insert last-command-char) + (save-excursion (promela-indent-command))) + +(defun promela-open-delimiter () + "Inserts the open and matching close delimiters, indenting as appropriate." + (interactive) + (insert last-command-char) + (if (and promela-auto-match-delimiter (not (promela-inside-comment-p))) + (save-excursion + (insert (cdr (assq last-command-char promela-matching-delimiter-alist))) + (promela-indent-command)))) + +(defun promela-close-delimiter () + "Inserts and indents a close delimiter." + (interactive) + (insert last-command-char) + (if (not (promela-inside-comment-p)) + (save-excursion (promela-indent-command)))) + +(defun promela-toggle-auto-match-delimiter () + "Toggle auto-insertion of parens and other delimiters. +See variable `promela-auto-insert-matching-delimiter'" + (interactive) + (setq promela-auto-match-delimiter + (not promela-auto-match-delimiter)) + (message (concat "Promela auto-insert matching delimiters " + (if promela-auto-match-delimiter + "enabled" "disabled")))) + + +;; ------------------------------------------------------------------------- +;; Compilation/Verification functions + +;; all of this is in serious "beta" mode - don't trust it ;-) +(setq + promela-compile-command "spin " + promela-syntax-check-args "-a -v " +) + +;;(setq compilation-error-regexp-alist +;; (append compilation-error-regexp-alist +;; '(("spin: +line +\\([0-9]+\\) +\"\\([^\"]+\\)\"" 2 1)))) + +(defun promela-syntax-check () + (interactive) + (compile (concat promela-compile-command + promela-syntax-check-args + (buffer-name)))) + + +;; ------------------------------------------------------------------------- +;; Indentation support functions + +(defun promela-indent-around-label () + "Indent the current line as PROMELA code, +but make sure to consider the label at the beginning of the line." + (beginning-of-line) + (delete-horizontal-space) ; delete any leading whitespace + (if (not (looking-at "\\sw+:\\([ \t]*\\)")) + (error "promela-indent-around-label: no label on this line") + (goto-char (match-beginning 1)) + (let* ((space (length (match-string 1))) + (indent (promela-calc-indent)) + (wanted (max 0 (- indent (current-column))))) + (if (>= space wanted) + (delete-region (point) (+ (point) (- space wanted))) + (goto-char (+ (point) space)) + (indent-to-column indent))))) + +;; Note that indentation is based ENTIRELY upon the indentation of the +;; previous line(s), esp. the previous non-blank line and the line +;; starting the current containgng block... +(defun promela-indent-line () + "Indent the current line as PROMELA code. +Return the amount the by which the indentation changed." + (beginning-of-line) + (if (looking-at "[ \t]*\\sw+:") + (promela-indent-around-label) + (let ((indent (promela-calc-indent)) + beg + shift-amt + (pos (- (point-max) (point)))) + (setq beg (point)) + (skip-chars-forward " \t") + (setq shift-amt (- indent (current-column))) + (if (zerop shift-amt) + (if (> (- (point-max) pos) (point)) + (goto-char (- (point-max) pos))) + (delete-region beg (point)) + (indent-to indent) + (if (> (- (point-max) pos) (point)) + (goto-char (- (point-max) pos)))) + shift-amt))) + +(defun promela-calc-indent () + "Return the appropriate indentation for this line as an int." + (save-excursion + (beginning-of-line) + (let* ((orig-point (point)) + (state (promela-parse-partial-sexp)) + (paren-depth (nth 0 state)) + (paren-point (or (nth 1 state) 1)) + (paren-char (char-after paren-point))) + ;;(what-cursor-position) + (cond + ;; Indent not-at-all - inside a string + ((nth 3 state) + (current-indentation)) + ;; Indent inside a comment + ((nth 4 state) + (promela-calc-indent-within-comment)) + ;; looking at a pre-processor directive - indent=0 + ((looking-at "[ \t]*#\\(define\\|if\\(n?def\\)?\\|else\\|endif\\)") + 0) + ;; If we're not inside a "true" block (i.e. "{}"), then indent=0 + ;; I think this is fair, since no (indentable) code in promela + ;; exists outside of a proctype or similar "{ .. }" structure. + ((zerop paren-depth) + 0) + ;; Indent relative to non curly-brace "paren" + ;; [ NOTE: I'm saving this, but don't use it any more. + ;; Now, we let parens be indented like curly braces + ;;((and (>= paren-depth 1) (not (char-equal ?\{ paren-char))) + ;; (goto-char paren-point) + ;; (1+ (current-column))) + ;; + ;; Last option: indent relative to contaning block(s) + (t + (goto-char orig-point) + (promela-calc-indent-within-block paren-point)))))) + +(defun promela-calc-indent-within-block (&optional limit) + "Return the appropriate indentation for this line, assume within block. +with optional arg, limit search back to `limit'" + (save-excursion + (let* ((stop (or limit 1)) + (block-point (promela-find-start-of-containing-block stop)) + (block-type (promela-block-type-after block-point)) + (indent-point (point)) + (indent-type (promela-block-type-after indent-point))) + (if (not block-type) 0 + ;;(message "paren: %d (%d); block: %s (%d); indent: %s (%d); stop: %d" + ;; paren-depth paren-point block-type block-point + ;; indent-type indent-point stop) + (goto-char block-point) + (cond + ;; Indent (options) inside "if" or "do" + ((memq block-type '(selection iteration)) + (if (re-search-forward "\\(do\\|if\\)[ \t]*::" indent-point t) + (- (current-column) 2) + (+ (current-column) promela-selection-indent))) + ;; indent (generic code) inside "::" option + ((eq 'option block-type) + (if (and (not indent-type) + (re-search-forward "::.*->[ \t]*\\sw" + (save-excursion (end-of-line) (point)) + t)) + (1- (current-column)) + (+ (current-column) promela-selection-option-indent)) + ) + ;; indent code inside "{" + ((eq 'block block-type) + (cond + ;; if we are indenting the end of a block, + ;; use indentation of start-of-block + ((equal 'block-end indent-type) + (current-indentation)) + ;; if the start of the code inside the block is not at eol + ;; then indent to the same column as the block start +some + ;; [ but ignore comments after "{" ] + ((and (not (promela-effective-eolp (1+ (point)))) + (not (looking-at "{[ \t]*/\\*"))) + (forward-char) ; skip block-start + (skip-chars-forward "{ \t") ; skip whitespace, if any + (current-column)) + ;; anything else we indent +promela-block-indent from + ;; the indentation of the start of block (where we are now) + (t + (+ (current-indentation) + promela-block-indent)))) + ;; dunno what kind of block this is - sound an error + (t + (error "promela-calc-indent-within-block: unknown block type: %s" block-type) + (current-indentation))))))) + +(defun promela-calc-indent-within-comment () + "Return the indentation amount for line, assuming that the +current line is to be regarded as part of a block comment." + (save-excursion + (beginning-of-line) + (skip-chars-forward " \t") + (let ((indenting-end-of-comment (looking-at "\\*/")) + (indenting-blank-line (eolp))) + ;; if line is NOT blank and next char is NOT a "*' + (if (not (or indenting-blank-line (= (following-char) ?\*))) + ;; leave indent alone + (current-column) + ;; otherwise look back for _PREVIOUS_ possible nested comment start + (let ((comment-start (save-excursion + (re-search-backward comment-start-skip)))) + ;; and see if there is an appropriate middle-comment "*" + (if (re-search-backward "^[ \t]+\\*" comment-start t) + (current-indentation) + ;; guess not, so indent relative to comment start + (goto-char comment-start) + (if indenting-end-of-comment + (current-column) + (1+ (current-column))))))))) + + +;; ------------------------------------------------------------------------- +;; Misc other support functions + +(defun promela-parse-partial-sexp (&optional start limit) + "Return the partial parse state of current defun or from optional start +to end limit" + (save-excursion + (let ((end (or limit (point)))) + (if start + (goto-char start) + (promela-beginning-of-defun)) + (parse-partial-sexp (point) end)))) + +;;(defun promela-at-end-of-block-p () +;; "Return t if cursor is at the end of a promela block" +;; (save-excursion +;; (let ((eol (progn (end-of-line) (point)))) +;; (beginning-of-line) +;; (skip-chars-forward " \t") +;; ;;(re-search-forward "\\(}\\|\\b\\(od\\|fi\\)\\b\\)" eol t)))) +;; (looking-at "[ \t]*\\(od\\|fi\\)\\b")))) + +(defun promela-inside-comment-p () + "Check if the point is inside a comment block." + (save-excursion + (let ((origpoint (point)) + state) + (goto-char 1) + (while (> origpoint (point)) + (setq state (parse-partial-sexp (point) origpoint 0))) + (nth 4 state)))) + +(defun promela-inside-comment-or-string-p () + "Check if the point is inside a comment or a string." + (save-excursion + (let ((origpoint (point)) + state) + (goto-char 1) + (while (> origpoint (point)) + (setq state (parse-partial-sexp (point) origpoint 0))) + (or (nth 3 state) (nth 4 state))))) + + +(defun promela-effective-eolp (&optional point) + "Check if we are at the effective end-of-line, ignoring whitespace" + (save-excursion + (if point (goto-char point)) + (skip-chars-forward " \t") + (eolp))) + +(defun promela-check-expansion () + "If abbrev was made within a comment or a string, de-abbrev!" + (if promela-inside-comment-or-string-p + (unexpand-abbrev))) + +(defun promela-block-type-after (&optional point) + "Return the type of block after current point or parameter as a symbol. +Return one of 'iteration `do', 'selection `if', 'option `::', +'block `{' or `}' or nil if none of the above match." + (save-excursion + (goto-char (or point (point))) + (skip-chars-forward " \t") + (cond + ((looking-at "do\\b") 'iteration) + ;;((looking-at "od\\b") 'iteration-end) + ((looking-at "if\\b") 'selection) + ;;((looking-at "fi\\b") 'selection-end) + ((looking-at "::") 'option) + ((looking-at "[{(]") 'block) + ((looking-at "[})]") 'block-end) + (t nil)))) + +(defun promela-find-start-of-containing-comment (&optional limit) + "Return the start point of the containing comment block. +Stop at `limit' or beginning of buffer." + (let ((stop (or limit 1))) + (save-excursion + (while (and (>= (point) stop) + (nth 4 (promela-parse-partial-sexp))) + (re-search-backward comment-start-skip stop t)) + (point)))) + +(defun promela-find-start-of-containing-block (&optional limit) + "Return the start point of the containing `do', `if', `::' or +`{' block or containing comment. +Stop at `limit' or beginning of buffer." + (save-excursion + (skip-chars-forward " \t") + (let* ((type (promela-block-type-after)) + (stop (or limit + (save-excursion (promela-beginning-of-defun) (point)))) + (state (promela-parse-partial-sexp stop)) + (level (if (looking-at "\\(od\\|fi\\)\\b") + 2 + (if (zerop (nth 0 state)) 0 1)))) + ;;(message "find-start-of-containing-block: type: %s; level %d; stop %d" + ;; type level stop) + (while (and (> (point) stop) (not (zerop level))) + (re-search-backward + "\\({\\|}\\|::\\|\\b\\(do\\|od\\|if\\|fi\\)\\b\\)" + stop 'move) + ;;(message "looking from %d back-to %d" (point) stop) + (setq state (promela-parse-partial-sexp stop)) + (setq level (+ level + (cond ((or (nth 3 state) (nth 4 state)) 0) + ((and (= 1 level) (looking-at "::") + (not (equal type 'option))) -1) + ((looking-at "\\({\\|\\(do\\|if\\)\\b\\)") -1) + ((looking-at "\\(}\\|\\(od\\|fi\\)\\b\\)") +1) + (t 0))))) + (point)))) + +(defun promela-find-start-of-containing-block-or-comment (&optional limit) + "Return the start point of the containing comment or +the start of the containing `do', `if', `::' or `{' block. +Stop at limit or beginning of buffer." + (if (promela-inside-comment-p) + (promela-find-start-of-containing-comment limit) + (promela-find-start-of-containing-block limit))) + +;; ------------------------------------------------------------------------- +;; Debugging/testing + +;; (defun promela-mode-toggle-debug () +;; (interactive) +;; (make-local-variable 'debug-on-error) +;; (setq debug-on-error (not debug-on-error))) + +;;(defun promela-mode-revert-buffer () +;; (interactive) +;; (revert-buffer t t)) + +;; ------------------------------------------------------------------------- +;;###autoload + +(provide 'promela-mode) + + +;;---------------------------------------------------------------------- +;; Change History: +;; +;; $Log: promela-mode.el,v $ +;; Revision 1.11 2001/07/09 18:36:45 engstrom +;; - added comments on use of font-lock-maximum-decoration +;; - moved basic preprocess directive fontification to "level 2" +;; +;; Revision 1.10 2001/05/22 16:29:59 engstrom +;; - fixed error introduced in fontification levels stuff (xemacs only) +;; +;; Revision 1.9 2001/05/22 16:21:29 engstrom +;; - commented out the compilation / syntax check stuff for now +;; +;; Revision 1.8 2001/05/22 16:18:49 engstrom +;; - Munched history in preparation for first non-Honeywell release +;; - Added "levels" of fontification to be controlled by the std. variable: +;; 'font-lock-maximum-decoration' +;; +;; Revision 1.7 2001/04/20 01:41:46 engstrom +;; Revision 1.6 2001/04/06 23:57:18 engstrom +;; Revision 1.5 2001/04/04 20:04:15 engstrom +;; Revision 1.4 2001/03/15 02:22:18 engstrom +;; Revision 1.3 2001/03/09 19:39:51 engstrom +;; Revision 1.2 2001/03/01 18:07:47 engstrom +;; Revision 1.1 2001/02/01 xx:xx:xx engstrom +;; migrated to CVS versioning... +;; Pre-CVS-History: +;; 99-10-04 V0.4 EDE Fixed bug in end-of-block indentation +;; Simplified indentation code significantly +;; 99-09-2x V0.3 EDE Hacked on indentation more while at FM'99 +;; 99-09-16 V0.2 EDE Hacked, hacked, hacked on indentation +;; 99-04-01 V0.1 EDE Introduced (less-than) half-baked indentation +;; 98-11-05 V0.0 EDE Created - much code stolen from rexx-mode.el +;; Mostly just a fontification mode - +;; (indentation is HARD ;-) +;; +;; EOF promela-mode.el diff --git a/lisp/template.el b/lisp/template.el new file mode 100644 index 0000000..ea36c4b --- /dev/null +++ b/lisp/template.el @@ -0,0 +1,2609 @@ +;;; template.el --- use templates, decorate comments, auto-update buffers + +;; Copyright (C) 1995-2003 Free Software Foundation, Inc. +;; +;; Author: Christoph Wedler <wedler@users.sourceforge.net> +;; Version: (see `template-version' below) +;; Keywords: template, comment decoration, auto-updating, data, tools +;; X-URL: http://emacs-template.sourceforge.net/ + +;; This program is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 2, or (at your option) +;; any later version. +;; +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. +;; +;; You should have received a copy of the GNU General Public License +;; along with this program; if not, write to the Free Software +;; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. + +;;; Commentary: + +;; When you create a new file with Emacs, package Template supplies an initial +;; buffer content via a template: a file with normal text and expansion +;; forms. There is a menu to easily create such templates. You can also use new +;; commands to decorate comments and update the buffer contents. + +;; The main difference between Template and other similar packages is that you +;; can define very flexible templates without having to learn Lisp or changing +;; your Emacs init file. This package does not help Lisp programmers to define +;; complex macros. + +;; For details, check <http://emacs-template.sourceforge.net/> or, if you +;; prefer the manual style, the documentation of the following commands and +;; variables: +;; +;; * for templates: \\[template-new-file], `template-auto-insert', +;; `template-derivation-alist', `template-default-expansion-alist' and +;; `template-definition-start', +;; * for comment decoration: \\[template-single-comment] and +;; \\[template-block-comment], `template-comment-specification-alist' +;; * for updating: \\[template-update-buffer], `template-auto-update', +;; `template-update-buffer-alist' and `template-header-regexp-alist'. + +;; Bug fixes, bug reports, improvements, and suggestions for the newest version +;; are strongly appreciated. + +;;; Installation: + +;; This file requires Emacs-20.2, XEmacs-20.2 or higher. + +;; Put this file into your load-path and the following into your ~/.emacs: +;; (require 'template) +;; (template-initialize) + +;; You might want to add another item to the "File" menu by (in XEmacs): +;; (add-menu-button '("File") +;; ["Insert and Expand Template..." +;; template-expand-template +;; :active (not buffer-read-only)] +;; "Insert File...") + +;; To customize, use `M-x customize-group RET template RET' or the customize +;; entry in menu Options. + +;;; Code: + +(provide 'template) +(require 'custom) + +;; General Emacs/XEmacs-compatibility compile-time macros +(eval-when-compile + (require 'cl) + (defmacro cond-emacs-xemacs (&rest args) + (cond-emacs-xemacs-macfn + args "`cond-emacs-xemacs' must return exactly one element")) + (defun cond-emacs-xemacs-macfn (args &optional msg) + (if (atom args) args + (and (eq (car args) :@) (null msg) ; (:@ ...spliced...) + (setq args (cdr args) + msg "(:@ ....) must return exactly one element")) + (let ((ignore (if (string-match "XEmacs" emacs-version) :EMACS :XEMACS)) + (mode :BOTH) code) + (while (consp args) + (if (memq (car args) '(:EMACS :XEMACS :BOTH)) (setq mode (pop args))) + (if (atom args) + (or args (error "Used selector %s without elements" mode)) + (or (eq ignore mode) + (push (cond-emacs-xemacs-macfn (car args)) code)) + (pop args))) + (cond (msg (if (or args (cdr code)) (error msg) (car code))) + ((or (null args) (eq ignore mode)) (nreverse code)) + (t (nconc (nreverse code) args)))))) + ;; Emacs/XEmacs-compatibility `defun': remove interactive "_" for Emacs, use + ;; existing functions when they are `fboundp', provide shortcuts if they are + ;; known to be defined in a specific Emacs branch (for short .elc) + (defmacro defunx (name arglist &rest definition) + (let ((xemacsp (string-match "XEmacs" emacs-version)) reuses first) + (while (memq (setq first (car definition)) + '(:try :emacs-and-try :xemacs-and-try + :emacs-only :xemacs-only)) + (if (memq first (if xemacsp + '(:xemacs-and-try :xemacs-only) + '(:emacs-and-try :emacs-only))) + (setq reuses (cadr definition) + definition nil) + (unless (memq first '(:emacs-only :xemacs-only)) + (push (cadr definition) reuses))) + (setq definition (cddr definition))) + (if (and reuses (symbolp reuses)) + `(defalias ',name ',reuses) + (let* ((docstring (if (stringp (car definition)) (pop definition))) + (spec (and (not xemacsp) + (eq (car-safe (car definition)) 'interactive) + (null (cddar definition)) + (cadar definition)))) + (if (and (stringp spec) + (not (string-equal spec "")) + (eq (aref spec 0) ?_)) + (setq definition + (cons (if (string-equal spec "_") + '(interactive) + `(interactive ,(substring spec 1))) + (cdr definition)))) + (if (null reuses) + `(defun ,name ,arglist ,docstring + ,@(cond-emacs-xemacs-macfn definition)) + ;; no dynamic docstring in this case + `(eval-and-compile ; no warnings in Emacs + (defalias ',name + (cond ,@(mapcar (lambda (func) `((fboundp ',func) ',func)) + (nreverse reuses)) + (t ,(if definition + `(lambda ,arglist ,docstring + ,@(cond-emacs-xemacs-macfn definition)) + 'ignore))))))))))) + +(eval-when-compile + (require 'cl) + (defvar init-file-loaded) ; would be useful in Emacs, too... + (defvar file-name-buffer-file-type-alist)) + + + +;;;;########################################################################## +;;;; User Options, Variables +;;;;########################################################################## + + +(defconst template-version "3.1c" + "Current version of package template. +Check <http://emacs-template.sourceforge.net/> for the newest.") + + +;;;=========================================================================== +;;; Customization and initialization +;;;=========================================================================== + +(defgroup template nil + "Use templates, decorate comments, auto-update buffers." + :group 'data + :link '(emacs-commentary-link "template.el") + :link '(url-link "http://emacs-template.sourceforge.net/") + :prefix "template-") + +(defgroup template-comments nil + "Comment decorations in package template." + :group 'template + :prefix "template-") + +(defgroup template-updating nil + "Updating with package template." + :group 'template + :prefix "template-") + +(defgroup template-derivation nil + "Deriving templates for new files." + :group 'template + :prefix "template-") + +(defgroup template-expansion nil + "Expanding the expansion forms in templates." + :group 'template + :prefix "template-") + +(defgroup template-miscellaneous nil + "Miscellaneous configurations of package template." + :group 'template + :prefix "template-") + +;; I could imagine that a future version of package custom could make this +;; `PACKAGE-initialize' stuff easier +(defcustom template-use-package nil + "Pseudo variable. Used to initialize template in custom buffer. +Put `(template-initialize)' into your ~/.emacs to initialize package +template in future sessions. See variable `template-initialize'." + :group 'template + :type '(boolean :format "%{%t%}: %[(template-initialize)%], %v\n" + :on "in use" :off "not yet initialized" + :help-echo "Initialize package Template." + :action template-initialize)) + +(defcustom template-initialize t + "Whether/what to initialize with `template-initialize'. +If t, do full initialization. Otherwise, the value should be a list +with elements. To enable, include + + * `auto' to enable `template-auto-update' and `template-auto-insert', + * `ffap' to make sure that `auto' works with `find-file-at-point', + * `cc-mode' to enable correct C/C++/Java/Antlr comment filling, i.e., + to add `template-c-init-fill-function' to `c-mode-common-hook', + * `de-html-helper' to disable `html-helper's template and time-stamps, + * `keys' to setup the default key bindings, + * `menus' to setup the menus." + :group 'template-miscellaneous + :type '(choice (const :tag "All" t) + (set :value (auto cc-mode keys menus) + (const :tag "Auto Updating/Inserting" auto) + (const :tag "Correct Auto Inserting with Ffap" ffap) + (const :tag "Correct C Comment Filling" cc-mode) + (const :tag "Deactivate html-helper" de-html-helper) + (const :tag "Setup Key Bindings" keys) + (const :tag "Setup Menus" menus)))) + + +;;;=========================================================================== +;;; Menu +;;;=========================================================================== + +(defvar template-comment-menu + '("Comment" + ["Decorate Comment Line" template-single-comment + :active (and (not buffer-read-only) + (memq (template-comment-at-point) + '(none delimited single cont)))] + ["Decorate Comment Block" template-block-comment + :active (and (not buffer-read-only) + (memq (template-comment-at-point) + '(single block)))] + "---" + ["Indent for Comment" indent-for-comment + :active (and comment-start (not buffer-read-only))] + ["Continue Comment" indent-new-comment-line + :active (and comment-start (not buffer-read-only))] + ["Comment Region" comment-region + :active (and comment-start (not buffer-read-only) (mark))] + ["Comment Region 2" (comment-region 2) + :active (and comment-start (not buffer-read-only) (mark))] + ["Comment Region 3" (comment-region 3) + :active (and comment-start (not buffer-read-only) (mark))] + "---" + ["Update Buffer" template-update-buffer + :active (and template-update-buffer-alist (not buffer-read-only))]) + "Menu for comment functions.") + +(defvar template-creation-menu + '("Template Creation" + :filter template-menu-filter + ["Open Template" template-open-template + :active (null (template-buffer-template-p))] + "--" + ["Define User Input" template-define-prompt t] + ["Define Text Register" template-define-register t] + ["Define Message" template-define-message t] + "---" + ["Insert Expansion Form" template-insert-form t]) + "Menu for template creation.") + + +;;;=========================================================================== +;;; Commenting +;;;=========================================================================== + +(defcustom template-max-column -1 + "*Width of the separator line, to use with an empty `comment-end'. +If the value is zero or negative, it is added to `fill-column'. See +also `template-max-column-with-end'." + :group 'template-comments + :type 'integer) + +(defcustom template-max-column-with-end 0 + "*Width of the separator line including a non-empty `comment-end'. +If the value is zero or negative, it is added to `fill-column'. See +also `template-max-column'." + :group 'template-comments + :type 'integer) + +(defcustom template-alt-comment-syntax-alist + '((t "/* " " */")) + "Alternative comment syntax for languages with \"mixed\" comments. +Used by function `template-comment-syntax'. Elements look like + (MODES-OR-REGEXP COMMENT-START COMMENT-END) + +If the current `major-mode' has a empty `comment-end' and a commenting +command does not work at `point' with the usual `comment-start', we +search for the first matching alternative comment syntax in this alist. + +Each element must \"pass\" MODES-OR-REGEXP. If this is a list, it must +include the current major-mode, if this is a regexp, it must match the +`buffer-file-name' without version, otherwise it must be non-nil. + +Then, COMMENT-START and COMMENT-END is used as the alternative comment +syntax if `comment-start-skip' matches COMMENT-START." + :group 'template-comments + :type '(repeat (group (choice (repeat :tag "In major modes" :value nil + function) + (regexp :tag "Buffer matching" :value "") + (sexp :tag "Always" :value t)) + (string :tag "Alt comment start" :value "/* ") + (string :tag "Alt comment end" :value " */")))) + +(defcustom template-comment-indent t + "Non-nil means, indent single-line/block comments. +Commands \\[template-single-comment] and \\[template-block-comment] +indent the comment lines if this value is non-nil and the current major +mode is not a member of `template-indent-mode-disable-list' or if this +value is nil and the current major mode is a member of +`template-indent-mode-enable-list'." + :group 'template-comments + :type 'boolean) + +(defcustom template-indent-mode-disable-list '(sh-mode makefile-mode) + "Major modes not having indented single-line/block comments. +Used if `template-comment-indent' is non-nil. Major modes in which +pressing TAB twice is different from pressing TAB once are good +candidates for this list." + :group 'template-comments + :type '(repeat (function :tag "Major mode"))) + +(defcustom template-indent-mode-enable-list nil + "Major modes having indented single-line/block comments. +Used if `template-comment-indent' is nil." + :group 'template-comments + :type '(repeat (function :tag "Major mode"))) + +(defcustom template-comment-specification-alist + '(("-" "" "" 0) + ("-" "" "" 0) + ("=" "\n\n" "\n" 1) + ("#" "\n\n\f\n" "\n\n" 2)) + "List of specifications for comment functions. +Each specification at LEVEL, starting at 1, is a list + (SEPARATOR BEFORE-BLOCK AFTER-BLOCK DELETE-LINES) + +SEPARATOR is the string which is inserted repeatedly by commands +\\[template-single-comment] and \\[template-block-comment] up to +`template-max-column'. + +After that, \\[template-block-comment] deletes DELETE-LINES after the +comment block and inserts string AFTER-BLOCK at the end of the block and +BEFORE-BLOCK at the front of the block. + +The specification LEVEL to use is determined by: + (1) If the prefix argument is non-nil and its numeric value is > 0, + this value is the LEVEL. + (2) If the prefix argument is nil, and there is an old comment style, + use old comment style. + (3) If `template-comment-specification-special' is a function or the + current major mode has a property with this name and its value is a + function, this function returns the specification. + (4) If `comment-end' is empty and `comment-start' is a string of length + 1: LEVEL is number of repetitions of `comment-start' at the + beginning of the line. Otherwise, if the correctly indented line + starts at the beginning of the line, LEVEL=3, else LEVEL=2." + :group 'template-comments + :type '(repeat (group (string :tag "Separator" :value "-") + (string :tag "Before block" :value "") + (string :tag "After block" :value "") + (integer :tag "Delete lines" :value 0)))) + +(defcustom template-comment-specification-special nil + "Function used for special commenting styles or nil. +See `template-comment-specification-alist' for details." + :group 'template-comments + :type '(choice (const nil) function)) + + +;;;=========================================================================== +;;; Auto updating +;;;=========================================================================== + +(defcustom template-auto-update 'query + "*Whether to update parts of the file when saving the buffer. +When non-nil and `template-auto-update-disable-regexp' does not match +the file name, automatically updates parts of the buffer, see +`template-update-buffer-alist'. With value t or if the entry in the +alist has no prompt, do not ask for confirmation. + +You should have called `template-initialize' to enable this feature." + :group 'template-updating + :type '(radio (const :tag "No" nil) + (const :tag "Without confirmation" t) + (sexp :tag "With confirmation" :format "%t" :value query))) + +(defcustom template-auto-update-disable-regexp nil + "*Regexp matching files not to automatically update. +Value nil matches no file. See `template-auto-update'." + :group 'template-updating + :type '(choice (const :tag "none" nil) regexp)) + +(defcustom template-update-buffer-alist + '((t "Update header in %s? " + (template-update-header t) + (file-name-sans-versions (file-name-nondirectory buffer-file-name))) + ((html-mode) "Update date inside <address> in %s? " + (-2000 + "\\([0-9]+[ \t]+[A-Za-z][A-Za-z][A-Za-z][ \t]+[0-9]+\\)[ \t\n]*</address>" + 1) + (format-time-string "%d %b %Y"))) + "Alist used how to update parts of the buffer. +Used by function `template-update-buffer'. Elements look like + (MODES-OR-REGEXP PROMPT TEST NEW REPLACEMENT-FUN) + +Each element must \"pass\" MODES-OR-REGEXP. If this is a list, it must +include the current major-mode, if this is a regexp, it must match the +`buffer-file-name' without version, otherwise it must be non-nil. + +Then, TEST is `eval'd and must return the region = (BEG . END) to be +replaced or nil if nothing should be updated according to the current +element. If TEST is a list and the `car' of TEST is not a function, +`template-update-buffer-region' is used as the default function, i.e., +REPLACEMENT-FUN looks like (LIMIT REGEXP GROUP). Then, check first/last +LIMIT characters in buffer and return region according to GROUP's regexp +group in REGEXP. + +Then, NEW is `eval'd. If it is a string, it is considered as +replacement for the region, otherwise REPLACE-FUN must be non-nil. + +Then, ask user for confirmation with PROMPT where %s is substituted by +the buffer name if PROMPT is a string and `template-auto-update' is not +t. + +Finally, REPLACEMENT-FUN is called the `eval'd NEW and the beginning and +the end of the region returned by TEST. If REPLACEMENT-FUN is nil, just +replace the region by the `eval'd NEW." + :group 'template-updating + :type '(repeat (group (choice (repeat :tag "In major modes" :value nil + function) + (regexp :tag "Buffer matching" :value "") + (sexp :tag "Always" :value t)) + (string :tag "Prompt" :value "Update in %s? ") + (choice (list :tag "Default test" + (choice (const :tag "No limit" nil) + (integer :tag "Limit" -1000)) + regexp + (integer :tag "Regexp group" :value 0)) + (sexp :tag "Eval sexp")) + (sexp :tag "Eval New string") + (option (function :tag "Replacement function"))))) + +(defcustom template-header-lines 3 + "*Last line number which is checked by \\[template-update-header]." + :group 'template-updating + :type 'integer) + +(put 'template-header-lines 'template-secure-value #'integerp) + +(defcustom template-header-regexp-alist + '(("@(#)\\([^ \t\n]+\\)" . 1) + ("^%s[ \t]*\\([^ \t\n%s][^ \t\n]*\\)[ \t]+--" . 1)) + "Alist of regexps matching the file name in the header. +The `car' of each element is the REGEXP with %s, if present, substituted +by the comment start. A second %s, if present, is substitud by a single +letter non-alpha comment start, or the empty string otherwise. + +The `cdr' is the regexp group to be replaced. Used by +\\[template-update-header]. + +The comment start is evaluated from `comment-start', the first character +in the buffer or \"#\". It is assumed that a non-alpha single character +comment start may be repeated. For example, the substituted regexp in +`emacs-lisp-mode' is \"\;+\", in `c++-mode' \"//\"." + :group 'template-updating + :type '(repeat (cons :format "%v" + regexp + (integer :tag "Regexp group" :value 0)))) + + +;;;=========================================================================== +;;; Templates: finding templates +;;;=========================================================================== + +(defcustom template-auto-insert 'query + "*Whether to automatically use template files for new files. +Used if the user gave a non-existent file as argument to a command in +`template-find-file-commands'. When non-nil and a matching template +file can be found, use a template like in `template-new-file'. File +name refinement is never performed, see `template-derivation-alist'. + +With value t, do not ask for confirmation. + +You should have called `template-initialize' to enable this feature." + :group 'template-derivation + :type '(radio (const :tag "No" nil) + (const :tag "Without confirmation" t) + (sexp :tag "With confirmation" :format "%t" :value query))) + +(defcustom template-find-file-commands + '(find-file find-file-other-frame find-file-other-screen + find-file-other-window find-file-at-point ffap nil) + "*Commands which use templates as last resort, see `template-auto-insert'. +See also `template-file-select-commands'. + +Include nil if you want to use templates for non-existing files as +command line arguments when starting Emacs." + :group 'template-derivation + :type '(repeat (function :tag "Command"))) + +(defcustom template-file-select-commands + '(exit-minibuffer minibuffer-complete-and-exit + list-mode-item-mouse-selected + list-mode-item-keyboard-selected) + "*Commands which select the file name via minibuffer/completions. +Checked with commands in `template-find-file-commands'." + :group 'template-derivation + :type '(repeat (function :tag "Command"))) + +(defface template-message-face + '((((class color) (background light)) (:background "pink")) + (t (:bold t))) + "Face for temporary message at point. This only works with XEmacs." + :group 'template-miscellaneous) + +(defcustom template-extension ".tpl" + "*Extension used for template files." + :group 'template-derivation + :type 'string) + +(defcustom template-subdirectories '("./" "Templates/") + "*List of subdirectories for template files. +See `template-derivation-alist' for details." + :group 'template-derivation + :type '(repeat directory)) + +(defcustom template-stop-derivation + (cond ((fboundp 'file-remote-p) 'file-remote-p) + ((fboundp 'efs-ftp-path) 'efs-ftp-path) + ((fboundp 'ange-ftp-ftp-path) 'ange-ftp-ftp-path)) + "If non-nil, function used to determine whether to stop derivation. +If non-nil, function is called with argument DIR. If it returns t, +`template-derivation' stops to search for more project specific +templates, i\.e\., just searches in `template-default-directories'." + :group 'template-derivation + :type '(choice (const :tag "Never" nil) + function)) + +(defcustom template-default-directories + (cons (if (and (not (file-directory-p "~/.templates/")) + (file-directory-p "~/lib/templates")) + (expand-file-name "~/lib/templates/") + (expand-file-name "~/.templates/")) + (and (fboundp 'locate-data-directory) + (let ((dir (locate-data-directory "template"))) + (and dir (list dir))))) + "*List of default directories for template files. +See `template-derivation-alist' for details." + :group 'template-derivation + :type '(repeat directory)) + +(defcustom template-derivation-alist + '(;;(("00readme" "" ".txt" "\\`00") . ("00readme" "" ".txt")) + ((t "" t)) + ((t nil null) . (nil nil t 1)) + (("TEMPLATE" "" t))) + "Alist for template file name derivation and file name refinement. +Template derivation searches for the most specific readable template +file. By default, files with the same RAW part as the name of the new +file are considered to be more specific than files with just the same +EXT part. Also files in the same directory are considered to be more +specific than files in their parent directory or any default template +directory. This behavior can be changed by this alist. + +Each FORM in this alist has the form (TEMPLATE . REFINEMENT). If +TEMPLATE matches, we have found a valid template file and the +corresponding REFINEMENT is used for the file name refinement. + +Before the derivation, the given file name is split into the directory +part DIR, the file name without directory FILE, and the raw part RAW of +FILE, the numbering NUM and the extension EXT. The result is stored in +`template-file'. + +TEMPLATE can have the form (FUNCTION ARG...). If TEMPLATE matches, +FUNCTION, called with arguments ARGs, should return the split template +file name, see `template-split-filename'. + +TEMPLATE can also have the form (T-RAW T-NUM T-EXT F-REGEXP) where all +elements are optional, i.e., have value nil as default. For TEMPLATE to +match, all conditions T-RAW, T-NUM and T-EXT must be met and F-REGEXP, +if non-nil, should match FILE, the non-directory part of the given file +name. If a condition is a string, the corresponding part of the +template file must be equal to it. If t, the part must be equal to +RAW/NUM/EXT of the given file name. If nil, any value will do it. Any +other value acts like t when the part of the given file name is +non-empty, as nil otherwise. + +REFINEMENT can have the form (FUNCTION ARG...). FUNCTION, called with +the list of the split template filename and ARGs as arguments, should +set `template-file' if the file name should be refined. + +REFINEMENT can also have the form (F-RAW F-NUM F-EXT AUTO-NUM) where all +elements are optional, i.e., have value nil as default. If F-RAW, F-NUM +and F-EXT are non-nil, they change RAW/NUM/EXT of `template-file'. A +string will be used as the new part. If t, the corresponding part of +the template name will be used. + +We will use auto numbering in the following two cases: if NUM is +non-empty and the file exists already, or if NUM is empty and AUTO-NUM +is non-nil. Auto numbering looks at the file names in DIR to generate +the next unique number which is at least as high as NUM in the first +case and AUTO-NUM in the second. + +Let us use parts of the default value as examples: + +Use a template with the same RAW part of the given file name and the +same EXT part if provided, e.g., for \"exercise2\" use template +\"exercise.tex.tpl\". Refine file name to use the extension of the +template file, also use auto numbering, e.g., if files \"exercise2.tex\" +and \"exercise3.tex\" exist, refine name to \"exercise4.tex\": + ((t nil null) \. (nil nil t 1)) + +For a file with extension EXT, use TEMPLATE.EXT: + ((\"TEMPLATE\" \"\" t)) + +We could define: If the given file name starts with \"00\", use template +\"00readme.txt.tpl\". Refine file name to \"00readme.txt\": + ((\"00readme\" \"\" \".txt\" \"\\\\`00\") \. (\"00readme\" \"\" \".txt\")) + +Since more than one template file could meet this conditions, the +template derivation searches for first readable file with extension +`template-extension' which is found by the following algorithm: + + forall FORMs in `template-derivation-alist' do + for directory BASE from DIR + while not stopped according to `template-stop-derivation' do + forall subdirectories DIRs in `template-subdirectories' + relative to BASE do + forall TEMPLATEs in DIR do + if check_form (FORM, FULL, TEMPLATE) return TEMPLATE + forall directories DIRs in `template-default-directories' do + forall TEMPLATEs in DIR do + if check_form (FORM, FULL, TEMPLATE) return TEMPLATE + if not used via `template-auto-insert' + forall TEMPLATEs in `template-default-directories' + where name_nondir (TEMPLATE) = \"DEFAULT.tpl\" do + if readable (TEMPLATE) return TEMPLATE + return TEMPLATE in first (`template-default-directories') + where name_nondir (TEMPLATE) = \"DEFAULT.tpl\"" + :group 'template-derivation + :type '(repeat (cons :format "%v" + (sexp :tag "Derivation" :value ("TEMPLATE" nil t)) + (sexp :tag "Refinement" :value nil)))) + + +;;;=========================================================================== +;;; Templates: expanding templates +;;;=========================================================================== + +(defcustom template-confirm-insecure t + "*Non-nil means, ask whether to use insecure template expansions. +Only set this to nil if you ALWAYS check template files before using +it!" + :group 'template-expansion + :type 'boolean) + +(put 'template-confirm-insecure 'risky-local-variable t) + +(defcustom template-message-buffer "*Template Message*" + "If non-nil, name of buffer where messages are shown. +The following messages will be displayed in definition sequence before +the expansion has taken place: + - :before messages, see `template-definition-start', + - user defined prompts if `template-message-prompt-format' is non-nil, + - user defined registers when there has been a :before message before, + see `template-message-register-format'. + +The following messages will be displayed in definition sequence after +the expansion has taken place: + - :after messages, see `template-definition-start', + - user defined registers, display them at point if the value of this + variable is nil, see `template-message-register-format'." + :group 'template-miscellaneous + :type '(choice (const :tag "None" nil) + (string :tag "Buffer Name"))) + +(defcustom template-message-prompt-intro + "Template expansion will ask for input with the following prompts:" + "Default intro message used before listing user defined prompts. +Used with :before messages, see `template-message-prompt-format'." + :group 'template-miscellaneous + :type '(choice (const :tag "None" nil) + (string :tag "Intro text"))) + +(defcustom template-message-prompt-format " %s" + "If non-nil, format string for user defined prompts. +If non-nil and `template-message-buffer' is non-nil, user defined +prompts will be listed before starting the expansions. Prompts can be +defined as specified in the docstring of `template-definition-start'. +For each PROMPT, this format string will be used with substitution +PROMPT/%s. + +If no :before message has been defined before, use, if non-nil, +`template-message-prompt-intro' as the first :before message." + :group 'template-miscellaneous + :type '(choice (const :tag "No prompt" nil) + (string :tag "Format string"))) + +(defcustom template-message-register-intro + "Template has defined the following registers:" + "Default intro message used before listing user defined prompts. +Used with :after messages, see `template-message-register-format'." + :group 'template-miscellaneous + :type '(choice (const :tag "None" nil) + (string :tag "Intro text"))) + +(defcustom template-message-register-format " %c:\t\"%s\"\t%s" + "If non-nil, format string for user defined registers. +If non-nil, user defined text registers will be listed. Registers can +be defined as specified in the docstring of `template-definition-start'. +For each register CHAR with contents CONTENTS and optional comment +COMMENT, this format string will be used with substitution CHAR/%c, +CONTENT/%s and \(COMMENT/%s or \"\"/%s). + +The list of register definitions will be displayed: + - at point if `template-message-buffer' is nil, + - with :before messages if there has been at least one :before message + defined before and if `template-message-buffer' is non-nil, + - with :after messages if `template-message-buffer' is non-nil. + If no :after message has been defined before, use, if non-nil, + `template-message-register-intro' as the first :after message." + :group 'template-miscellaneous + :type '(choice (const :tag "No register content" nil) + (string :tag "Format string"))) + +(defcustom template-message-timeout 600 + "*Maximum duration the temporary message will be displayed at point. +Any user event will also make the temporary message disappear. The +temporary message uses face in `template-message-face'." + :group 'template-miscellaneous + :type 'integer) + +(put 'template-message-timeout 'template-secure-value #'integerp) + +(defcustom template-date-format "%d %b %Y" + "*Date/time format used with the expansion form (>>>DATE<<<). +See `template-default-expansion-alist' and `format-time-string'. See +also `template-time-format'." + :group 'template-expansion + :type 'string) + +(put 'template-date-format 'template-secure-value #'stringp) + +(defcustom template-time-format "%T" + "*Date/time format used with the expansion form (>>>TIME<<<). +See `template-default-expansion-alist' and `format-time-string'. See +also `template-date-format'." + :group 'template-expansion + :type 'string) + +(put 'template-time-format 'template-secure-value #'stringp) + +(defcustom template-string-default "%0.0S" + "*Format string used for non-string variable extensions. +If SYMBOL in (\"KEY\" \. SYMBOL) is not a string, use string with +substitution SYMBOL/%S. Default value \"%0.0S\" causes to print +nothing. See `template-definition-start'." + :group 'template-expansion + :type 'string) + +(put 'template-string-default 'template-secure-value #'stringp) + +(defcustom template-expansion-format "(>>>%s<<<)" + "Format string for expansion forms. +Is a expansion form with substitution KEY/%s. The value should +correspond with `template-expansion-regexp'. Used by +`template-insert-form'." + :group 'template-expansion + :type 'string) + +(put 'template-expansion-format 'template-secure-value #'stringp) + +(defcustom template-expansion-regexp "(>>>\\([-A-Za-z0-9_]+\\)<<<)" + "Regexp matching strings which are replaced by their expansions. +The first regexp group contains the KEY used by the per-template +expansion, see `template-definition-start' and the global expansions in +`template-expansion-alist' and `template-default-expansion-alist'. The +value should correspond with `template-expansion-alist'. + +If there is no defined expansion for the key, ask the user for a +replacement, see `template-read'. If the key is matched by +`template-register-regexp', store buffer position in register, see +`template-register', . + +If you want to use a text literally which is matched by this regexp, use +the zero expansion form (>>>ZERO_FORM<<<)." + :group 'template-expansion + :type 'regexp) + +(put 'template-expansion-regexp 'template-secure-value #'stringp) + +(defcustom template-literal-environment '("LITERAL" . "/LITERAL") + "Environment for literal text in template. +Looks like (OPEN . CLOSE). Text between expansion forms with keys OPEN +and CLOSE is not expanded. If you change OPEN, you should change key +\"LITERAL\" in `template-default-expansion-alist' accordingly." + :group 'template-expansion + :type '(cons (string :tag "Open tag") (string :tag "Close tag"))) + +(defcustom template-register-regexp "\\`[0-9]\\'" + "*Regexp matching keys for storing point positions in registers. +These keys use `template-register' as the default expansion instead of +`template-read'. See `template-expansion-regexp'. If a register is used +twice, it is marked by a \"*\" in the echo area after the expansion." + :group 'template-expansion + :type 'regexp) + +(put 'template-register-regexp 'template-secure-value #'stringp) + +(defcustom template-expansion-alist nil + "User defined expansions forms. +Predefined expansion forms for `template-expansion-regexp'. Each entry +has the form (KEY . SEXP). These expansion forms shadow those in +`template-default-expansion-alist' and are shadowed by those in the +per-template definition section. See `template-definition-start'." + :group 'template-expansion + :type '(repeat (cons :format "%v" + (string :tag "Key" :value "") + (repeat :tag "Evaluate all" sexp)))) + +(put 'template-expansion-alist 'risky-local-variable t) + +(defvar template-default-expansion-alist + '(("POINT" (setq template-point (point-marker))) ; point + ("MARK" (setq template-mark (point-marker))) ; mark + ("DIR" (insert (car template-file))) ; directory + ("FILE" (insert (cadr template-file))) ; file name without directory + ("FILE_SANS" (insert (nth 2 template-file) + (nth 3 template-file))) + ("FILE_RAW" (insert (nth 2 template-file))) ; raw file name without number + ("FILE_NUM" (insert (nth 3 template-file))) ; number + ("FILE_UPCASE" (insert (upcase (nth 2 template-file)) + (nth 3 template-file))) + ("FILE_EXT" (or (string= (nth 4 template-file) "") ; extension + (insert (substring (nth 4 template-file) 1)))) + ("DATE" (template-insert-time template-date-format)) + ("TIME" (template-insert-time template-time-format)) + ("VC_DATE" (set-time-zone-rule "UTC") + (template-insert-time "%Y/%m/%d %T" "0000/00/00 00:00:00") + ;; using saved `current-time-zone' doesn't work, but nil does + (set-time-zone-rule nil)) + ("YEAR" (template-insert-time "%Y" "0000")) + ("ISO_DATE" (template-insert-time "%Y-%m-%d" "0000-00-00")) + ("COMMENT" (template-read "Initial comment: ")) ; comment + ("AUTHOR" (insert (or user-mail-address ; author + (and (fboundp 'user-mail-address) + (user-mail-address)) + (concat (user-login-name) "@" (system-name))))) + ("USER_NAME" (insert (or (and (boundp 'user-full-name) ; user name + user-full-name) + (user-full-name)))) + ("LOGIN_NAME" (insert (user-login-name))) ; login name + ("HOST_ADDR" (insert (or (and (boundp 'mail-host-address) ; host address + (stringp mail-host-address) + mail-host-address) + (system-name)))) + ("LITERAL" (if (search-forward (format template-expansion-format + (cdr template-literal-environment)) + nil 'limit) + (delete-region (match-beginning 0) (match-end 0)))) + ("ZERO_FORM")) ; zero form + "Predefined default expansions forms. +Predefined expansion forms for `template-expansion-regexp'. Each entry +has the form (KEY . SEXP). These expansion forms are shadowed by those +in `template-expansion-alist' and by those in the per-template +definition section. See `template-definition-start'. + +The default predefined expansion forms are --default is inserting--: + (>>>POINT<<<) set point + (>>>MARK<<<) set mark, jump to it with \\[exchange-point-and-mark] + (>>>DIR<<<) directory: /home/clstaff/wedler/lib/ + (>>>FILE<<<) file w/o directory: text1.txt + (>>>FILE_SANS<<<) file name w/o extension: text1 + (>>>FILE_RAW<<<) raw file name: text + (>>>FILE_NUM<<<) number in name: 1 + (>>>FILE_EXT<<<) extension: txt + (>>>FILE_UPCASE<<<) upcase file name w/o extension: TEXT1 + (>>>DATE<<<) date using `template-date-format': 11 Jan 1999 + (>>>TIME<<<) time using `template-time-format': 11:58:49 + (>>>YEAR<<<) the year: 1999 + (>>>ISO_DATE<<<) ISO 8601 date: 1999-01-11 + (>>>VC_DATE<<<) UTC date/time for vc: 1999/01/11 10:58:49 + (>>>COMMENT<<<) ask user for initial comment + (>>>AUTHOR<<<) author, i.e., `user-mail-address' + (>>>USER_NAME<<<) user name: Christoph Wedler + (>>>LOGIN_NAME<<<) login name: wedler + (>>>HOST_ADDR<<<) Host address: fmi.uni-passau.de + (>>>LITERAL<<<) literal text up to (>>>/LITERAL<<<) + (>>>ZERO_FORM<<<) zero form, i.e., insert nothing. Useful to insert + a text part matched by `template-expansion-regexp' literally. + +There are aliases with one-letter keys, see `template-key-alias-alist'. + +It is useful to follow the following conventions: upper case keys for +predefined extensions, lower case and digits for per-template and the +following default expansions: + (>>>0<<<) to (>>>9<<<) set registers 0 to 9, jump to it with + \\[jump-to-register] 0 etc., see `template-register-regexp' + (>>>x<<<) where x is any unused letter sequence: ask user.") + +(put 'template-default-expansion-alist 'risky-local-variable t) + +(defvar template-key-alias-alist + '(("P" . "POINT") + ("M" . "MARK") + ("D" . "DIR") + ("F" . "FILE") + ("R" . "FILE_RAW") + ("N" . "FILE_NUM") + ("B" . "FILE_UPCASE") + ("E" . "FILE_EXT") + ("T" . "DATE") + ("V" . "VC_DATE") + ("Y" . "YEAR") + ("I" . "ISO_DATE") + ("C" . "COMMENT") + ("A" . "AUTHOR") + ("U" . "USER_NAME") + ("L" . "LOGIN_NAME") + ("H" . "HOST_ADDR") + ("Z" . "ZERO_FORM")) + "Alist to support the old one-letter predefined expansion forms. +Used for `template-expansion-alist' and +`template-default-expansion-alist'.") + +(defcustom template-definition-start + ">>>TEMPLATE-DEFINITION-SECTION<<<" + "Header for the per-template definition section. +The region following the the first match of this regexp defines the +per-template definition section. The region will be deleted before the +actual expansion, see `template-new-file'. If you use the \"Local +Variables:\" section, define it before this region. + +The definition section defines expansion forms for strings KEYs matched +by `template-expansion-regexp' which might shadow those in +`template-expansion-alist' and `template-default-expansion-alist': + + (\"KEY\"): zero form, same as (>>>ZERO_FORM<<<) in default value of +`template-default-expansion-alist', useful for inserting text matched by +`template-expansion-regexp' literally. + + (\"KEY\". CHAR): CHAR is the register where the current buffer +position is stored, see `template-register-regexp'. + + (\"KEY\" \"PROMPT\" \"PREFIX\" \"SUFFIX\" \"DEFAULT\" AGAIN-P) where +the last four arguments are optional: ask user with PROMPT for a STRING. +If STRING is not \"\", insert PREFIX STRING SUFFIX, otherwise DEFAULT. +For AGAIN-P, see `template-read'. To define, use +\\[template-define-prompt]. + + (\"KEY\" \"PROMPT\" (\"ANSWER\" \. \"TEXT\")...): ask user with PROMPT +for an input with completion over all ANSWERs and insert corresponding +TEXT. Expansion forms in TEXT will be expanded. + + (\"KEY\" \"PROMPT\" (t \. \"TEXT-y\") (nil \. \"TEXT-n\")): ask user +with PROMPT a \"y or n\" question with `y-or-n-p' and insert TEXT-y or +TEXT-n, correspondingly. Expansion forms in TEXT-X will be expanded. +The y-case and the n-case are optional and can be exchanged. + + (\"KEY\" \. SYMBOL): insert value of SYMBOL; if value is no string at +the time of the replacement, use `template-string-default' as format +string for SYMBOL. + + (\"KEY\" COMMAND \. PREFIX): COMMAND is a symbol or a vector and is +called with `command-execute' after setting `prefix-arg' to PREFIX, not +evaluated. If COMMANDs symbol property `template-secure-command' is +nil, the form is insecure. If that symbol property is a function, it is +called with PREFIX to check whether COMMAND could be called directly +with PREFIX as remaining arguments. + + (\"KEY\" SEXPR...): evaluate SEXPR during the expansion, see +`template-expansion-alist' for examples. This form is insecure. + +There are other per-template definitions: + + \"MESSAGE\": additional line displayed at point until first user event +or after `template-message-timeout' seconds. The lines are displayed +with face in `template-message-face'. With active form selector +:before, define a message which is displayed in +`template-message-buffer' before the exansion has started. With active +form selector :after, define a message which is displayed in +`template-message-buffer' after the exansion has taken place. To +define interactively, use \\[template-define-message]. + + (CHAR \. \"CONTENTS\"): Set register CHAR to have contents CONTENTS. +CONTENTS can then be inserted into a buffer with \\[insert-register] CHAR. + + (CHAR \"CONTENTS\" COMMENT) where COMMENT is optional: Set register +CHAR to have contents CONTENTS. CONTENTS can then be inserted into a +buffer with \\[insert-register] CHAR. Also display an additional line +at point to show the contents with COMMENT. To define, use +\\[template-define-register]. + +The following forms depend on the active form selector which is the last +of the following expansion forms: + - :before: \"MESSAGE\" will be displayed before the expansion + - :after: \"MESSAGE\" will be displayed after the expansion + - :eval-before: execute COMMAND and SEXPR before expansion + - :eval-after: execute COMMAND and SEXPR after expansion + - nil, deprecated: with the first form, the active form selector is + :eval-before, with the second, it is :eval-after. + + (VARIABLE . VALUE): set SYMBOL's local value to VALUE, not evaluated. +This form is only secure if VARIABLE has a symbol property +`template-secure-value' which returns non-nil when applied to VALUE, not +evaluated. This form is useful for variables which determine the +expansion, like `template-time-format' and `template-date-format'. For +local variables in your new file, use the normal way via the \"Local +Variables:\" section. The active form selector must not be :eval-before +or :eval-after. + + COMMAND: COMMAND is a symbol or a vector and is called with +`command-execute' before the expansion with form selector :eval-before, +and after the expansion with form selector :eval-after. If COMMANDs +symbol property `template-secure-command' is nil, the form is insecure. +You should use the safe command `normal-mode' in the pre-expansion forms +if the expansion forms depend on the correct major mode. + + SEXPR: evaluate SEXPR before the expansion with form selector +:eval-before, and after the expansion with form selector :eval-after. +This form is insecure. + +If any insecure forms have been used, the user of the template will be +asked whether to use the template, see `template-confirm-insecure'." + :group 'template-expansion + :type 'string) + + + +;;;;########################################################################## +;;;; Commenting +;;;;########################################################################## + + +(defunx template-point-at-bol (&optional count) + :emacs-only line-beginning-position + :xemacs-only point-at-bol) + +(defunx template-point-at-eol (&optional count) + :emacs-only line-end-position + :xemacs-only point-at-eol) + +(defunx template-char-or-char-int-p (object) + :emacs-only integerp + :xemacs-only char-or-char-int-p) + +(defunx template-char-or-int-to-char (object) + :emacs-only identity + "Convert character or integer OBJECT into the equivalent character." + (if (characterp object) object (int-to-char object))) + + +;;;=========================================================================== +;;; Main functions +;;;=========================================================================== + +;;;###autoload +(defun template-single-comment (&optional arg) + "Decorate the comment in the current line with dashes and alike. +The line must be a comment-only line or must contain a comment ending by +eol. That is, jump to the end of the current line and insert the dashes +and the final comment end-string up-to the fill position. Prefix +argument ARG and `template-comment-specification' determines the comment +style to use. The length of the resulting line is determined by +`template-max-column' and `template-max-column-with-end'." + (interactive "*P") + (let* ((orig (point-marker)) + (syntax0 (and comment-start comment-start-skip + (condition-case nil + (template-comment-syntax orig 'boc) + (error nil)))) + (syntax (cond ((cdr syntax0) + (template-comment-syntax orig)) + (syntax0 + (condition-case nil + (template-comment-syntax (point-marker)) + (error syntax0))) + (t + (back-to-indentation) + nil))) + (sep (template-comment-separator-regexp syntax)) + (end (template-point-at-eol)) + old) + (save-excursion + (cond ((re-search-forward sep end t) + ;; with sep in current line + (setq old (buffer-substring (match-beginning 1) (match-end 1))) + (delete-region (match-beginning 0) (match-end 0))) + ((cdr syntax) ; with start-end comment + (if (looking-at (concat "[ \t]*\\(.+\\)?" + (regexp-quote (cadr syntax)) + "[ \t]*\\(.+\\)?$")) + (if (or (match-beginning 1) (match-beginning 2)) + (error "This line contains non-separator chars and %S" + (cadr syntax)) + ;; Delete comment-end. Don't delete its first char if it is + ;; the same as the second of comment-start. + (delete-region (if (and (= (length (car syntax)) 2) + (= (length (cadr syntax)) 2) + (eq (aref (car syntax) 1) + (aref (cadr syntax) 0))) + (1+ (match-beginning 0)) + (match-beginning 0)) + (match-end 0)))) + (goto-char (cddr syntax)) + (if (re-search-forward sep end t) + ;; sep in line between comment-start and point-at-eol + (setq old (buffer-substring (match-beginning 1) + (match-end 1))))))) + (template-insert-separator + (car (template-comment-specification arg old syntax)) + nil syntax))) +(put 'template-single-comment 'template-secure-command t) + +;;;###autoload +(defun template-block-comment (&optional arg) + "Decorate the current block of comment-only lines with dashes and alike. +That is, surround the the contiguous comment-only lines around point +with extra lines containing dashes and alike and to put the correct +number of newlines around the block. + +Barf if the comment syntax at point has a non-empty `comment-end' or if +point is not in a comment-only line. + +A block comment consists of all neighboring lines which start with +spaces and `comment-start'. If `comment-start' is a string of length 1, +the number of repetitions of `comment-start' must be the same or larger +than in the line where the command is invoked from, too. + +Prefix argument ARG and `template-comment-specification' determines the +comment style to use. The length of the separator line is determined by +`template-max-column'. + +This command can also be used with point in an empty line after a block +comment. A second invocation of this command directly after a +successful invocation deletes the remaining empty lines from the current +line on." + (interactive "*P") + (let* ((orig (point-marker)) + (syntax (progn + (end-of-line) + (skip-chars-backward " \t\n\f") + (template-comment-syntax orig)))) + (when (cdr syntax) + (goto-char orig) + (error "Command only works with comments terminated by end-of-line")) + + (if (and (eq last-command 'template-block-comment-success) + (looking-at "[ \t]*$")) + (template-insert-newline "" nil (1- (template-point-at-bol))) + (let* ((prefix (concat "[ \t]*" (regexp-quote (car syntax)))) + (sepline (concat prefix "[ \t]*" + (template-comment-separator-regexp syntax))) + old block-beg block-end def) + ;; go to the first line with same comment prefix --------------------- + (beginning-of-line) + (while (and (not (bobp)) (looking-at prefix)) + (beginning-of-line 0)) + (or (looking-at prefix) (beginning-of-line 2)) + (while (looking-at sepline) + (setq old (buffer-substring (1- (match-end 0)) (match-end 0))) + (kill-line 1)) + (setq block-beg (point-marker)) + ;; go to the last line with same comment prefix ---------------------- + (while (looking-at prefix) + (template-indent-according-to-mode) + (beginning-of-line 2)) + (if (eobp) (newline)) + (setq block-end (copy-marker (point) t)) + (while (progn (forward-line -1) (looking-at sepline)) + (setq old (buffer-substring (1- (match-end 0)) (match-end 0))) + (kill-line 1)) + ;; insert separator lines -------------------------------------------- + (goto-char block-beg) + (set-marker block-beg nil) + (back-to-indentation) + (setq def (template-comment-specification arg old syntax)) + (beginning-of-line) + (template-insert-newline (cadr def)) + (template-insert-separator (car def) (car syntax) syntax) + (goto-char block-end) + (set-marker block-end nil) + (template-insert-separator (car def) (car syntax) syntax) + (template-insert-newline (caddr def) + (and (cadddr def) + (save-excursion + (forward-line (cadddr def)) + (point)))) + (setq this-command 'template-block-comment-success))) + (template-indent-according-to-mode) + (back-to-indentation))) +(put 'template-block-comment 'template-secure-command t) + + +;;;=========================================================================== +;;; Check comment start, return specification +;;;=========================================================================== + +(defun template-indent-according-to-mode () + "Indent line according to `template-comment-indent'." + (if (if template-comment-indent + (not (memq major-mode template-indent-mode-disable-list)) + (memq major-mode template-indent-mode-enable-list)) + (indent-according-to-mode))) + +(defun template-default-comment () + "Return default comment according to current position." + (if comment-start + (substring comment-start 0 (string-match "[ \t]\\'" comment-start)) + (if (eolp) "#" + (let ((default (buffer-substring (point) (1+ (point))))) + (if (string-match "[A-Za-z]" default) "#" default))))) + +(defun template-comment-at-point () + "Return the comment syntax at the current position. +Return nil, if no commenting command can be used, i.e., if point is not +in a comment-only line. Return `none' if the `major-mode' doesn't +define a comment syntax. Return `delimited' if point is between +`comment-start' and a non-empty `comment-end'. Return `single' if point +is in a comment line where the comment syntax has a empty `comment-end', +return `block' if point is in an empty line after such a comment line." + (if (and comment-start comment-start-skip) + (save-excursion + (let ((orig (point))) + (condition-case nil + (progn + (end-of-line) + (skip-chars-backward " \t\n\f") + (if (cdr (template-comment-syntax orig t)) 'delimited + (if (< (template-point-at-eol) orig) 'block 'single))) + (error + (condition-case nil + (progn + (goto-char orig) + (beginning-of-line) + (when (re-search-forward comment-start-skip + (template-point-at-eol) t) + (goto-char (or (match-end 1) (match-beginning 0))) + (unless (or (cdr (template-comment-syntax orig 'boc)) + (< (template-point-at-eol) orig)) + 'cont))) + (error nil)))))) + 'none)) + +(defun template-comment-syntax (orig &optional no-indent) + "Return the comment syntax at ORIG. Signal error if not in comment. +Return (COMMENT-START) if the comment syntax has an empty `comment-end'. +Return (COMMENT-START COMMENT-END . START-POS) if the comment syntax has +a non-empty `comment-end' where START-POS is the position of the first +character inside the comment. Move point to first character after the +comment start or the first non-whitespace character on this line. + +ORIG should be the same as `point' or in a empty line after `point'. + +If optional argument NO-INDENT is nil, indents the current line +according to `template-comment-indent' and `indent-according-to-mode'. +If NO-INDENT is `boc', move point to the beginning of the comment. + +COMMENT-START is stripped off its final spaces, COMMENT-END off its +initial spaces." + (unless (and comment-start comment-start-skip) + (error "No comment syntax has been defined for %s" major-mode)) + (if (eq no-indent 'boc) + (progn + (beginning-of-line) + (if (re-search-forward comment-start-skip (template-point-at-eol) t) + (goto-char (or (match-end 1) (match-beginning 0))))) + (or no-indent (template-indent-according-to-mode)) + (back-to-indentation)) + (let* ((string (template-default-comment))) + (if (string= comment-end "") + (if (looking-at (concat (regexp-quote string) + (and (= (length string) 1) + (not (eq no-indent 'boc)) + "+"))) + (progn + (goto-char (match-end 0)) + (list (buffer-substring (match-beginning 0) (point)))) + (let ((alist template-alt-comment-syntax-alist) + elem c-start c-end) + (while alist + (setq elem (pop alist)) + (and (template-match-modes-or-regexp (car elem)) + (string-match comment-start-skip (cadr elem)) + (setq c-start (cadr elem) + c-end (caddr elem) + alist nil))) + (template-comment-syntax-0 orig c-start c-end string))) + (template-comment-syntax-0 orig comment-start comment-end)))) + +(defun template-comment-syntax-0 (orig c-start c-end &optional single) + ;; checkdoc-params: (orig c-start c-end single) + "Internal function for `template-comment-syntax'." + (unless (and (stringp c-start) (stringp c-end) (not (string= c-end ""))) + (goto-char orig) + (error "Line does not start with %S" + (or single (template-default-comment)))) + (setq c-start (substring c-start 0 (string-match "[ \t]\\'" c-start)) + c-end (if (string-match "\\`[ \t]+" c-end) + (substring c-end (match-end 0)) + c-end)) + (cond ((looking-at (regexp-quote c-start)) + (goto-char (match-end 0)) + (cons c-start (cons c-end (point)))) + ((save-excursion + (when (re-search-backward (concat "^[ \t]*" (regexp-quote c-start)) + nil t) + (goto-char (match-end 0)) + (let ((match (point))) + (unless (when (search-forward c-end orig t) + (skip-chars-forward " \t") + (< (point) orig)) + (cons c-start (cons c-end match))))))) + (t + (goto-char orig) + (if single + (error "Not inside a comment (%S or %S-%S) starting in new line" + single c-start c-end) + (error "Not inside a comment (%S-%S) starting in new line" + c-start c-end))))) + + +;;;=========================================================================== +;;; Comment specification +;;;=========================================================================== + +;; A simple `mapconcat' is likely to slow down Emacs' regexp search algorithm +;; considerably (backtracking => near-infloop). +(defun template-comment-separator-regexp (syntax) + "Return regexp matching separator comment lines. +The regexp also matches if the lines ends with parts of COMMENT-END in +argument SYNTAX, see `template-comment-syntax'." + (let ((estring (cadr syntax)) + (alist template-comment-specification-alist) + (chars nil) + str i c) + (while alist + (setq str (car (pop alist))) + (when str + (setq i (length str)) + (while (>= (decf i) 0) + ;; (pushnew (aref str i) chars), but requires cl at runtime: + (or (memq (setq c (aref str i)) chars) (push c chars))))) + (concat "\\(" + (mapconcat (lambda (c) (regexp-quote (char-to-string c))) + (or chars "#") + "\\|") + (if estring + (concat "\\)+[ \t]*" + (mapconcat (lambda (c) + (regexp-quote (char-to-string c))) + estring + "?") + "?[ \t]*$") + "\\)+[ \t]*$")))) + +(defun template-comment-specification (arg old syntax) + "Return the comment specification to use. +See `template-comment-specification-alist' for details. ARG is the +prefix argument, OLD the SEPARATOR of the old comment style and SYNTAX +is the comment syntax returned by `template-comment-syntax'." + (and arg (setq arg (prefix-numeric-value arg))) + ;; assumes point-at-indentation + (or (and arg (> arg 0) + (if (< (length template-comment-specification-alist) arg) + (car (last template-comment-specification-alist)) + (nth (1- arg) template-comment-specification-alist))) + (and (null arg) old + (assoc old template-comment-specification-alist)) + (and (functionp template-comment-specification-special) + (funcall template-comment-specification-special)) + (and (functionp (get major-mode 'template-comment-specification-special)) + (funcall (get major-mode 'template-comment-specification-special))) + (and syntax + (template-comment-specification + (if (or (cdr syntax) (> (length comment-start) 1)) + (save-excursion + (if (cddr syntax) (goto-char (cddr syntax))) + (beginning-of-line) + (if (looking-at "[ \t]") 2 3)) + (length (car syntax))) + nil nil)) + '("-" "" "" 0))) + + +;;;=========================================================================== +;;; Inserting +;;;=========================================================================== + +(defun template-insert-newline (string &optional limit start-limit) + "Deletes blank lines around point and insert STRING. +After optional LIMIT and before optional START-LIMIT, no character will +be deleted." + (let ((start (save-excursion + (skip-chars-backward " \t\n\f" start-limit) + (or (bobp) (forward-line 1)) + (point))) + (end (save-excursion + (skip-chars-forward " \t\n\f" limit) + (beginning-of-line) + (point)))) + (if (> end start) (delete-region start end))) + (or (bobp) (insert string))) + +(defun template-insert-separator (separator &optional cstring syntax) + "Insert separator line at point. +If CSTRING is not nil, insert in special line which starts with CSTRING. +Insert SEPARATOR repeatedly. End the line with COMMENT-END as specified +in `template-comment-syntax'." + (when separator + (when cstring + (open-line 1) + (insert cstring) + (template-indent-according-to-mode)) + (end-of-line) + (let* ((estring (cadr syntax)) + (max-column (if estring + template-max-column-with-end + template-max-column)) + (max (- (if (> max-column 0) max-column (+ fill-column max-column)) + (length separator) + (length estring)))) + (while (<= (current-column) max) (insert separator)) + (if (>= (length separator) (- (current-column) max)) + (insert (substring separator 0 (- max (current-column))))) + (if estring (insert estring)) + (if cstring (forward-line 1))))) + + +;;;=========================================================================== +;;; Adaptations: cc-mode +;;;=========================================================================== + +;; There isn't really anything I can do against the filling of "/**" in C, C++ +;; and Antlr mode (it is correct in Java), it should be done in the cc-mode +;; package. Similar for filling "*/" with the previous line... + +(defun template-c-fill-paragraph (&optional arg) + ;; checkdoc-params: (arg) + "Like \\[c-fill-paragraph] but handles comment separator lines." + (let* ((regexp (concat "\\|[ \t]*\\(/[*/]\\|\\*\\)[ \t]*" + (template-comment-separator-regexp '("/*" "*/")))) + (paragraph-start (concat paragraph-start regexp)) ;#dynamic + (paragraph-separate (concat paragraph-separate regexp))) + (c-fill-paragraph arg))) + +(defun template-c-init-fill-function () + "Set `fill-paragraph-function' to use `template-c-fill-paragraph'." + (when (boundp 'fill-paragraph-function) + (make-local-variable 'fill-paragraph-function) + (setq fill-paragraph-function 'template-c-fill-paragraph))) + + + +;;;;########################################################################## +;;;; Updating (File Name in Header) +;;;;########################################################################## + + +;;;=========================================================================== +;;; General updating +;;;=========================================================================== + +(defun template-update-buffer-region (limit regexp group) + "Return region = (BEG . END) in buffer to be updated. +If LIMIT is positive, check first LIMIT characters in buffer, otherwise +check last -LIMIT characters in buffer for a text to be matched by +REGEXP. Return region according to GROUP's regexp group in REGEXP." + (let ((case-fold-search nil)) + (goto-char (if limit + (if (natnump limit) (point-min) (+ (point-max) limit)) + (point-min))) + (when (re-search-forward regexp + (if (natnump limit) + (+ (point-min) limit) + (point-max)) + t) + (cons (match-beginning group) (match-end group))))) + +(defun template-match-modes-or-regexp (modes-or-regexp) + "Return non-nil, if the current buffer passes MODES-OR-REGEXP. +If MODES-OR-REGEXP is a list, it must include the current `major-mode', +if it is a regexp, it must match the `buffer-file-name' without version, +otherwise it must be non-nil." + (if (stringp modes-or-regexp) + (and buffer-file-name + (string-match modes-or-regexp + (file-name-sans-versions buffer-file-name))) + (or (nlistp modes-or-regexp) (memq major-mode modes-or-regexp)))) + +(defun template-update-buffer (&optional arg) + "Update buffer according to `template-update-buffer-alist'. +Do not do anything if `template-auto-update-disable-regexp' matches the +file name or if `template-auto-update' is nil. When optional ARG is +non-nil, i.e., if called interactively *without* prefix arg, always +update." + (interactive (list (null current-prefix-arg))) + (when (or arg + (and template-auto-update buffer-file-name + (null (and template-auto-update-disable-regexp + (string-match template-auto-update-disable-regexp + buffer-file-name))))) + (save-excursion + (save-restriction + (widen) + (let ((alist template-update-buffer-alist) + (case-fold-search (memq system-type '(vax-vms ms-dos windows-nt))) + stamp prompt region new) + (while alist + (setq stamp (pop alist)) + (condition-case nil + (and (template-match-modes-or-regexp (pop stamp)) + ;; Run TEST --------------------------------------------- + (setq prompt (pop stamp) + region (pop stamp) ; TEST + region (eval (if (or (atom region) + (functionp (car region))) + region + (cons 'template-update-buffer-region + region)))) + (if (stringp (setq new (eval (pop stamp)))) + (null (string= (buffer-substring (car region) + (cdr region)) + new)) + (car stamp)) + ;; user confirmation, replacement ----------------------- + (or (null prompt) + arg + (eq template-auto-update t) + (y-or-n-p (format prompt (buffer-name)))) + (progn + (goto-char (car region)) + (if (car stamp) + (funcall (car stamp) new (car region) (cdr region)) + (delete-region (car region) (cdr region)) + (insert new)))) + (error nil)))))))) + + +;;;=========================================================================== +;;; Update header +;;;=========================================================================== + +;;;###autoload +(defun template-update-header (&optional show) + "Replace old file name in header with current file name. +If SHOW is t, just return region of the filename or nil. Otherwise, +replace filename if possible and signal an error if SHOW is nil and +there is no filename in the header. See `template-header-lines' and +`template-header-regexp-alist'." + (interactive "*P") + (if buffer-file-name + (save-excursion + (goto-char (point-min)) + (let ((case-fold-search nil) + (comment-regexp (template-default-comment)) ; at `point-min'! + (end (progn (forward-line template-header-lines) (point))) + (alist template-header-regexp-alist) + (disallowed "") + group) + (if (string-match "[A-Za-z]\\|.." comment-regexp) + (setq comment-regexp (regexp-quote comment-regexp) + disallowed "") + (or (eq comment-regexp '(?\])) + (setq disallowed comment-regexp)) + (setq comment-regexp (concat (regexp-quote comment-regexp) "+"))) + (while alist + (goto-char (point-min)) + (if (re-search-forward (format (caar alist) + comment-regexp disallowed) + end t) + (setq group (cdar alist) + alist nil) + (setq alist (cdr alist)))) + (if (and group (match-beginning group)) + (if (eq show t) + (cons (match-beginning group) (match-end group)) + (goto-char (match-beginning group)) + (delete-region (point) (match-end group)) + (insert (file-name-sans-versions + (file-name-nondirectory buffer-file-name))) + t) + (if show nil (error "No file name in header"))))) + (if show nil (error "Buffer is not visiting a file")))) + + + +;;;;########################################################################## +;;;; Templates +;;;;########################################################################## + + +(defvar template-history nil + "History, used by `template-read'.") + +(defvar template-choice-history nil + "History, used by `template-choice'.") + +(put 'normal-mode 'template-secure-command t) + +(defvar template-all-templates nil + "Internal variable. Template files used for template derivation.") +(defvar template-file nil + "Partitioned name of new file: (DIR FILE RAW NUMBER EXT). +Internal variable. DIR is the directory part, FILE the file name +without directory part. FILE consists of its extension EXT, RAW and a +numbering NUMBER just in front of the extension. It is used by the +expansions DIR, FILE, FILE_SANS, FILE_EXT and others in +`template-expansion-alist'. Also useful for user defined functions in +`template-derivation-alist' and the per-template definition section.") + +(defvar template-modified nil + "Internal variable. Whether user is asked during the expansion process.") +(defvar template-secure t + "Internal variable. Whether all per-template definitions are secure.") +(defvar template-point-messages nil + "Internal variable. List of lines for temporary message at point.") +(defvar template-before-messages nil + "Internal variable. List of lines for temporary message before expansion.") +(defvar template-after-messages nil + "Internal variable. List of lines for temporary message after expansion.") + +(defvar template-point nil + "Internal variable. Position of point. Set with expansion form P.") +(defvar template-mark nil + "Internal variable. Position of mark. Set with expansion form M.") + +(defvar template-current nil + "Internal variable. Current key of expansion form.") +(defvar template-string-alist nil + "Internal variable. Alist of user inputs for `template-read'.") +(defvar template-register-alist nil + "Internal variable. Alist of used registers.") +(defvar template-local-alist nil + "Internal variable. Alist of per-template defined expansions.") + +(defvar template-ffap-file-finder nil + "Value used inside `template-ffap-find-file'. +If nil, initialize it to the value of `ffap-file-finder', i.e., this +variable holds the original value of that variable which will be set to +`template-ffap-find-file' in `template-initialize'.") + + +;;;=========================================================================== +;;; Functions: `find-file'/`insert-file-contents', hooking into `find-file' +;;;=========================================================================== + +(defun template-find-template (filename &optional replace) + "Switch to a buffer visiting template file FILENAME. +If optional REPLACE is non-nil, replace the current buffer contents with +the contents of file FILENAME. + +This function always considers template files as text files." + (let ((file-name-buffer-file-type-alist nil)) ; Emacs on DOS/NT + (if replace + (insert-file-contents filename nil nil nil + ;; 5th arg not t with empty accessible part + ;; (XEmacs bug workaround: would infloop) + (> (point-max) (point-min))) + (let ((template-auto-insert nil)) + (switch-to-buffer (find-file-noselect filename)))))) + +(defun template-not-found-function () + "Use a template when visiting a non-existent file. +See `template-auto-insert' and `template-find-file-commands'. Function +in `find-file-not-found-hooks'." + (and template-auto-insert (not buffer-read-only) (bobp) (eobp) + (or (memq this-command template-find-file-commands) + (and (memq this-command template-file-select-commands) + ;; thanks to Dave Love <d.love@dl.ac.uk>: + (memq (car-safe (car command-history)) + ;; To always include `find-file-at-point', use ffap + ;; initialization (see `template-ffap-find-file') + template-find-file-commands))) + (let ((template (cdr (template-derivation buffer-file-name t t)))) + (and template + (file-readable-p template) + (or (eq template-auto-insert t) + (y-or-n-p + (format "Use template %s? " + (cond-emacs-xemacs + (abbreviate-file-name template :XEMACS t))))) + (progn + (template-new-file nil template) + (setq this-command 'session-disable) + t))))) + +(defun template-ffap-find-file (filename) + "Function to use in `ffap-file-finder'. +Add an entry to `command-history' if necessary and call function in +`template-ffap-file-finder' with argument FILENAME." + (or (memq (car-safe (car command-history)) + '(ffap find-file-at-point)) + (setq command-history + (cons (list 'find-file-at-point filename) command-history))) + (if (eq template-ffap-file-finder 'template-ffap-find-file) + (find-file filename) + (funcall template-ffap-file-finder filename))) + + +;;;=========================================================================== +;;; Main function +;;;=========================================================================== + +(defun template-expand-template-interactive () + (let* ((use (template-derivation (expand-file-name + (or buffer-file-name "NONE")) + t)) + (tpl (read-file-name "Insert and expand template: " + (file-name-directory (cdr use)) + (file-name-nondirectory (cdr use)) + t + (file-name-nondirectory (cdr use))))) + (if (string= tpl "") + (error "No template file provided")) + (list (expand-file-name tpl (file-name-directory (cdr use)))))) + +;;;###autoload +(defun template-expand-template (template) + "Expand template file TEMPLATE and insert result in current buffer. +Using a template for inserting some text consists of: + 1. Template derivation: suggest a reasonable template file to the user + according to `buffer-file-name', see `template-derivation-alist'. + 2. Template insertion: insert the template file at point into the + current buffer. + 3.. as steps 6.. of `template-new-file'." + (interactive (template-expand-template-interactive)) + (save-restriction + (narrow-to-region (point) (point)) + (template-new-file nil template t))) + +(defun template-new-file-interactive () + "Interactive specification for `template-new-file'. +Return \(FILE TEMPLATE)." + (let* ((inp (read-file-name (if current-prefix-arg + "New file (+template, no name change): " + "New file (+template): ") + nil "")) + (use (cond ((equal inp "") + (error "Empty/no input")) + ((file-directory-p inp) + (error "%S is a directory" inp)) + (t (template-derivation (expand-file-name inp) + current-prefix-arg)))) + (tpl (read-file-name (format "File %s uses template: " + (file-name-nondirectory (car use))) + (file-name-directory (cdr use)) + (file-name-nondirectory (cdr use)) + t + (file-name-nondirectory (cdr use))))) + (list (car use) + (if (string= tpl "") + nil + (expand-file-name tpl (file-name-directory (cdr use))))))) + +;;;###autoload +(defun template-new-file (file template &optional with-undo) + "Open a new file FILE by using a TEMPLATE. +Using a template for creating a new file consists of, steps 1 to 3 are +only executed when called interactively: + 1. Prompt for the name of the new file. + 2. Template derivation: suggest a reasonable template file to the user + see `template-derivation-alist'. + 3. File name refinement: e.g., if the given file name is \"exercise\" + and there are two files \"exercise1.tex\" and \"exercise2.tex\" in + the same directory and if we have a template \"exercise.tex.tpl\", + the file name is refined to \"exercise3.tex\". This is turned off + when \\[template-new-file] is called with a prefix argument. + 4. Template insertion: insert the template file into the empty buffer. + 5. Read per-template expansion definition section starting at + `template-definition-start' and delete it. + 6. Display :before message in `template-message-buffer'. + 7. Execute pre-expansion commands defined in the definition section. + 8. Set local variables defined in the definition section. + 9. Expansion: expand the expansion forms (text matched by + `template-expansion-regexp') They are defined in the definition + section, in `template-expansion-alist', or provided by default, see + `template-expansion-regexp' and `template-register-regexp'. + 10. Execute post-expansion commands defined in the definition section. + 11. Run `normal-mode' and functions in `find-file-hooks'. + 12. Update header according to `template-update-header' with argument + `if-exists'. + 13. Display :after message in `template-message-buffer'. + 14. Report: display a temporary message at point defined in the + definition section and an automatically generated message in the + minibuffer area, see `template-message-timeout'. + +If optional WITH-UNDO is non-nil, store corresponding changes in +`buffer-undo-list'. If FILE is nil, the buffer for FILE has already +been created and the accessible part will be replaced by the expanded +template. If TEMPLATE is nil (empty input when called interactively), +do not use a template." + (interactive (template-new-file-interactive)) + ;; check template and file name -------------------------------------------- + (if template + (if (file-readable-p template) + (if (file-directory-p template) + (error "Template %s is a directory" template)) + (if (null (yes-or-no-p (format "Template %s does not exist. Create? " + template))) + (error "No template file to use") + (template-make-directory (file-name-directory template)) + (template-find-template template) + (error "You should create this template first")))) + (if (not file) + (switch-to-buffer (current-buffer)) + (and (or (get-file-buffer file) (file-exists-p file)) + (null (yes-or-no-p (format "File %s exists. Delete contents? " file))) + (error "Cannot use templates for existing files")) + (let ((auto-mode-alist nil) + (enable-local-variables nil) + (find-file-not-found-hooks nil) + (enable-local-eval nil)) + (switch-to-buffer (find-file-noselect file)))) + (when template + (or with-undo (setq buffer-undo-list t)) + (template-find-template template t) + (template-new-file-0 with-undo))) + +(defun template-new-file-0 (with-undo) + "Perform template replacements in current buffer. +If WITH-UNDO is non-nil, store corresponding changes in +`buffer-undo-list'." + ;; start replacement ------------------------------------------------------- + (or with-undo (set-buffer-modified-p nil)) + (goto-char (point-min)) + (setq template-secure t + template-point nil + template-mark nil + template-modified nil + template-point-messages nil + template-before-messages nil + template-after-messages nil + template-local-alist nil + template-register-alist nil + template-string-alist nil) + (let ((form-selector nil) + (pre-command-list nil) + (post-command-list nil) + (local-variable-list nil) + val) + ;; read per-template definition section ---------------------------------- + (goto-char (point-min)) + (when (re-search-forward + (concat "^[ \t]*" template-definition-start "[ \t]*$") nil t) + (condition-case () + (while t + (setq val (read (current-buffer))) + (cond (;; ("KEY" . xxx): ask user -------------------------------- + (and (consp val) (stringp (car val))) + (let* ((def (cdr val)) ; expansion forms + (msg (cond ((null template-message-prompt-format) + nil) + ((stringp def) def) + ((and (consp def) (stringp (car def))) + (car def))))) + (when msg ; list prompts in before-messages + (or template-before-messages + (null template-message-prompt-intro) + (push template-message-prompt-intro + template-before-messages)) + (push (format template-message-prompt-format msg) + template-before-messages)) + (push (cons (car val) (template-translate-definition def)) + template-local-alist))) + ;; :before, :after, :eval-before, :eval-after -------------- + ((null val) ; nil is deprecated + (setq form-selector + (cond ((null form-selector) :old-before) + ((eq form-selector :old-before) :old-after) + ((eq form-selector :old-after) + (error "More than two (obsolete) nil forms")) + (t + (error "Used obsolete nil form with new form selectors"))))) + ((memq val '(:before :after :eval-before :eval-after)) + (setq form-selector val)) + ;; "MESSAGE" ----------------------------------------------- + ((stringp val) + (cond ((eq form-selector :before) + (push val template-before-messages)) + ((eq form-selector :after) + (push val template-after-messages)) + (t + (push val template-point-messages)))) + ;; (CHAR . xxx): set register ------------------------------ + ((and (consp val) (template-char-or-char-int-p (car val))) + (let ((reg (template-char-or-int-to-char (car val)))) + (if (atom (cdr val)) + (set-register reg (cdr val)) + (set-register reg (cadr val)) + (when template-message-register-format + (let ((msg (format template-message-register-format + reg (cadr val) + (or (caddr val) "")))) + (if template-message-buffer + (progn + (if template-before-messages + (push msg template-before-messages)) + (or template-after-messages + (null template-message-register-intro) + (push template-message-register-intro + template-after-messages)) + (push msg template-after-messages)) + (push msg template-point-messages))))))) + ;; set var, execute command and sexpr ---------------------- + ((and (memq form-selector '(nil :before :after)) + (consp val) + (symbolp (car val))) + (or (and (functionp (get (car val) 'template-secure-value)) + (funcall (get (car val) 'template-secure-value) + (cdr val))) + (setq template-secure nil)) + (push val local-variable-list)) + ((memq form-selector '(:eval-before :old-before)) + (push (template-elisp-in-definition val) + pre-command-list)) + ((memq form-selector '(:eval-after :old-after)) + (push (template-elisp-in-definition val) + post-command-list)) + (t + (error "Illegal form")))) + (error nil)) + (skip-chars-forward " \t\n\f") + (or (eobp) + (error "Invalid definition in line %d (pos %d) of the template file" + (count-lines 1 (point)) (point))) + (or template-secure + (null (default-value template-confirm-insecure)) + (y-or-n-p "Have you checked the template functions? ") + (error "Failed security check")) + (delete-region (match-beginning 0) (point-max))) + ;; expand ---------------------------------------------------------------- + (template-display-messages template-before-messages) + (eval (cons 'progn (nreverse pre-command-list))) + (while local-variable-list + (make-local-variable (caar local-variable-list)) + (set (caar local-variable-list) (cdar local-variable-list)) + (setq local-variable-list (cdr local-variable-list))) + (goto-char (point-min)) + (while (re-search-forward template-expansion-regexp nil t) + (setq template-current (buffer-substring (match-beginning 1) + (match-end 1)) + val (assoc template-current template-local-alist)) + (unless val + (if (setq val (assoc template-current template-key-alias-alist)) + (setq template-current (cdr val))) + (setq val (or (assoc template-current template-expansion-alist) + (assoc template-current + template-default-expansion-alist)))) + (delete-region (match-beginning 0) (match-end 0)) + (cond (val + (eval (cons 'progn (cdr val)))) + ((string-match template-register-regexp template-current) + (template-register)) + (t + (template-read (format "Replacement for `%s': " + template-current))))) + (eval (cons 'progn (nreverse post-command-list))) + (save-restriction + (widen) + (normal-mode t) + (or with-undo (template-update-header 'if-exists)) + (run-hooks 'find-file-hooks)) + ;; message --------------------------------------------------------------- + (template-display-messages template-after-messages) + (cond ((null template-register-alist) + (message "%s, no buffer location in register" + (if template-mark "Mark set" "No mark"))) + (t (message "%s, buffer location in register: %s" + (if template-mark "Mark set" "No mark") + (mapconcat (function + (lambda (x) + (if (cdr x) + (concat (char-to-string (car x)) "*") + (char-to-string (car x))))) + (nreverse template-register-alist) + ", ")))) + (or with-undo (set-buffer-modified-p template-modified)) + (goto-char (point-min)) + (when template-point + (goto-char template-point) + (set-marker template-point nil)) + (when template-mark + (push-mark template-mark) + (set-marker template-mark nil) + (if (fboundp 'zmacs-activate-region) (zmacs-activate-region))) + (when (and template-point-messages + (or (cdr template-point-messages) + (not (string-equal (car template-point-messages) "")))) + (let ((beg (point)) + end) + (if (cdr template-point-messages) + (insert (mapconcat 'identity + (nreverse template-point-messages) + "\n") + "\n") + (insert (car template-point-messages))) + (setq end (point)) + (goto-char beg) + (and (fboundp 'make-extent) (fboundp 'set-extent-face) + (set-extent-face (make-extent beg end) 'template-message-face)) + (recenter) + (sit-for template-message-timeout) + (delete-region beg end)))) + (recenter) + (unless with-undo + (setq buffer-undo-list nil) + (set-buffer-modified-p template-modified))) + +(defun template-display-messages (messages) + (when (and messages template-message-buffer) + (setq messages (nreverse messages)) + (with-output-to-temp-buffer template-message-buffer + (while messages + (princ (pop messages)) + (if messages (princ "\n")))))) + + +;;;=========================================================================== +;;; Determine name of the new file and the template +;;;=========================================================================== + +(defun template-derivation (full arg &optional no-default) + "Derive template file name and do file name refinement. +Return (REFINED . TEMPLATE) where REFINED is the refined version of FULL +and TEMPLATE and template file name, see `template-derivation-alist'. +FULL is the initial file name given by the user. File name refinement +is turned off when ARG is non-nil. If optional argument NO-DEFAULT is +non-nil, return nil instead (FULL \. \"~/.templates/DEFAULT.tpl\") if no +matching entry can be found in `template-derivation-alist'." + ;; Get all templates ------------------------------------------------------- + (setq template-all-templates nil) + (let* ((dir (file-name-directory full)) + (len (length dir)) + (case-fold-search (memq system-type '(vax-vms ms-dos windows-nt)))) + (while (and dir + (not (and template-stop-derivation + (fboundp template-stop-derivation) + (funcall template-stop-derivation dir)))) + (template-all-templates template-subdirectories dir) + (setq dir (file-name-directory (directory-file-name dir))) + (or (> len (setq len (length dir))) + (setq dir nil))) + (template-all-templates template-default-directories) + (setq template-all-templates (nreverse template-all-templates))) + ;; Get template file ------------------------------------------------------- + (if (string= (file-name-nondirectory full) "") + (error "You cannot use templates for directories")) + (setq template-file (template-split-filename full)) + (let ((tests template-derivation-alist) + test template file) + (while tests + (setq test (caar tests) + file (cdar tests)) + (if (setq template + (if (functionp (car test)) + (apply (car test) (cdr test)) + (apply 'template-default-template test))) + (setq tests nil) + (setq tests (cdr tests)))) + (if template + (or arg + (if (functionp (car file)) + (apply (car file) template (cdr file)) + (apply 'template-unique-file template file))) + (or no-default + (setq template (template-split-filename + "DEFAULT" + (template-default-directory))))) + (if template + (cons (expand-file-name (cadr template-file) (car template-file)) + (expand-file-name (concat (cadr template) template-extension) + (car template)))))) + +(defun template-default-directory () + "Return directory of file \"DEFAULT.tpl\"." + (let ((dirs template-default-directories) + (name (concat "DEFAULT" template-extension)) + dir) + (while dirs + (setq dir (pop dirs)) + (if (file-readable-p (expand-file-name name dir)) + (setq dirs nil) + (setq dir nil))) + (or dir + (car template-default-directories) + (expand-file-name "~/.templates/")))) + + +;;;=========================================================================== +;;; Small functions +;;;=========================================================================== + +(defun template-make-directory (dir) + "Create DIR if it does not exists yet." + (cond ((file-exists-p dir)) + ((yes-or-no-p (format "The directory %s does not exist. Create? " dir)) + (make-directory dir t)) + (t (error "You should create a directory \"%s\"" dir))) + dir) + +(defun template-split-filename (file &optional dir) + "Split file name into its parts. +If DIR is nil, FILE is a fully expanded file name, otherwise FILE is a +file name without its directory part DIR. See `template-file'." + (or dir (setq dir (template-make-directory (file-name-directory file)) + file (file-name-nondirectory file))) + (let* ((ext (string-match "\\.[^.]*\\'" file)) + (raw (substring file 0 ext)) + (num (string-match "[^0-9][0-9]+\\'" raw))) + (if num + (list dir file + (substring raw 0 (1+ num)) + (substring raw (1+ num)) + (if ext (substring file ext) "")) + (list dir file raw "" (if ext (substring file ext) ""))))) + +(defun template-translate-definition (def) + "Translate DEF of expansion and set `template-secure' accordingly." + (cond ((null def) ; zero form + nil) + ((template-char-or-char-int-p def) + `((template-register ,def))) + ((stringp def) + `((template-read ,def nil nil nil t))) + ((symbolp def) + `((insert (if (stringp ,def) ,def template-string-default)))) + ((and (consp def) (stringp (car def))) + (if (consp (car-safe (cdr def))) + `((template-choice ,(car def) (quote ,(cdr def)))) + `((apply (quote template-read) (quote ,def))))) + ((consp (car-safe def)) + (setq template-secure nil) + def) + (t + (list (template-elisp-in-definition (car def) (cdr def)))))) + +(defun template-elisp-in-definition (def &optional prefix) + "Return valid elisp definition and set `template-secure' accordingly. +DEF is the elisp form, PREFIX would be the prefix argument if DEF is a +command." + (cond ((consp def) + (setq template-secure nil) + def) + ((or (symbolp def) (vectorp def)) + (or (and (symbolp def) (get def 'template-secure-command)) + (setq template-secure nil)) + (if (and (symbolp def) + (functionp (get def 'template-secure-command)) + (listp prefix) + (funcall (get def 'template-secure-command) prefix)) + `(apply (quote ,def) (quote ,prefix)) + `(progn (setq prefix-arg (quote ,prefix)) + (command-execute (quote ,def))))) + (t + (error "Illegal form")))) + + +;;;=========================================================================== +;;; Compute template name +;;;=========================================================================== + +(defun template-all-templates (dirs &optional base) + "Read names of template files in DIRS relatively to BASE. +Insert the names to internal variable `template-all-templates'." + (let ((regexp (concat (regexp-quote template-extension) "\\'")) + (endpos (- (length template-extension))) + dir templates) + (while dirs + (setq dir (expand-file-name (car dirs) base) + dirs (cdr dirs)) + (cond-emacs-xemacs + (and (file-accessible-directory-p dir) + (file-readable-p dir) + (setq templates (directory-files dir t regexp :XEMACS nil t)) + (while templates + (and :EMACS + (not (file-directory-p (car templates))) + :BOTH + (file-readable-p (car templates)) + (push (template-split-filename (substring (car templates) + 0 + endpos)) + template-all-templates)) + (setq templates (cdr templates)))))))) + +(defun template-set-template-part (part file-part) + "Set template part according to definition PART and FILE-PART. +See `template-derivation-alist' for details." + (when part + (cond ((stringp part) part) + ((eq part t) file-part) + ((null (string= file-part "")) file-part)))) + +(defun template-default-template (&optional raw num ext regexp) + "Return template according to RAW, NUM, EXT and REGEXP. +See `template-derivation-alist' for details." + (if (or (null regexp) (string-match regexp (cadr template-file))) + (let ((templates template-all-templates) + (file-rne (cddr template-file)) + result template-rne) + (setq raw (template-set-template-part raw (car file-rne)) + num (template-set-template-part num (cadr file-rne)) + ext (template-set-template-part ext (caddr file-rne))) + (while templates + (setq template-rne (cddar templates)) + (if (and (or (null raw) (string= (car template-rne) raw)) + (or (null num) (string= (cadr template-rne) num)) + (or (null ext) (string= (caddr template-rne) ext))) + (setq result (car templates) + templates nil) + (setq templates (cdr templates)))) + result))) + + +;;;=========================================================================== +;;; File name refinement +;;;=========================================================================== + +(defun template-default-file (template &optional raw num ext) + "Refine file name according to TEMPLATE, RAW, NUM and EXT. +The result is in `template-file'. See `template-derivation-alist'." + (let ((template-rne (cddr template)) + (file-rne (cddr template-file))) + (if raw + (if (eq raw t) (setq raw (car template-rne))) + (setq raw (car file-rne))) + (if num + (if (eq num t) (setq num (cadr template-rne))) + (setq num (cadr file-rne))) + (if ext + (if (eq ext t) (setq ext (caddr template-rne))) + (setq ext (caddr file-rne))) + (setcdr template-file (list (concat raw num ext) raw num ext)))) + +(defunx template-unique-file (template &optional raw num ext auto-num) + "Refine file name according to TEMPLATE, RAW, NUM, EXT and AUTO-NUM. +Use auto numbering if NUM is not \"\" or AUTO-NUM is non-nil. The +result is in `template-file'. See `template-derivation-alist'." + (template-default-file template raw num ext) + (let* ((dir (car template-file)) + (full (expand-file-name (cadr template-file) dir))) + (when (if (string= (fourth template-file) "") + auto-num + (setq auto-num + (and (or (get-file-buffer full) + (file-readable-p full)) + (string-to-int (fourth template-file))))) + (setq auto-num (1- auto-num) + raw (third template-file) + ext (fifth template-file)) + (let ((list (buffer-list)) + file1 dir1) + (while list + (and (setq file1 (buffer-file-name (car list))) + (setq dir1 (file-name-directory file1)) + (string= dir1 dir) + (setq auto-num + (max (template-filename-number + (cddr (template-split-filename + (file-name-nondirectory file1) + dir1)) + raw ext) + auto-num))) + (setq list (cdr list))) + (setq list (directory-files dir nil nil t :XEMACS t)) + (while list + (unless (:EMACS file-directory-p (car list)) + (setq auto-num + (max (template-filename-number + (cddr (template-split-filename (car list) dir)) + raw ext) + auto-num) + list (cdr list)))) + (template-default-file template raw + (int-to-string (1+ auto-num)) + ext))))) + +(defun template-filename-number (file-rne raw ext) + "Return numbering in FILE-RNE if the RAW and EXT parts are equal." + (or (and (string= (car file-rne) raw) + (string= (caddr file-rne) ext) + (string-to-int (cadr file-rne))) + 0)) + + +;;;=========================================================================== +;;; Safe commands for per-template expansions +;;;=========================================================================== + +(defun template-insert-time (&optional format default) + "Insert time into current buffer using time format FORMAT. +If FORMAT is not a string, it uses DEFAULT or `current-time-string'." + (interactive) + (insert (if (and (stringp format) (fboundp 'format-time-string)) + (format-time-string format (current-time)) + (or default (current-time-string))))) +(put 'template-insert-time 'template-secure-command + (lambda (args) + (or (null args) (and (stringp (car args)) (null (cdr args)))))) + + +;;;=========================================================================== +;;; Functions for the predefined expansions +;;;=========================================================================== + +(defun template-register (&optional register) + "Set current location in register REGISTER. +That is, \\[jump-to-register] REGISTER jumps to the current position. +If REGISTER is nil, use register corresponding to the last character in +`template-current'." + (let* ((char (if register + (template-char-or-int-to-char register) + (aref template-current (1- (length template-current))))) + (elem (assoc char template-register-alist))) + (point-to-register char) + (if elem + (setcdr elem t) + (push (list char) template-register-alist)))) + +(defun template-read (prompt &optional prefix suffix default again-p) + "Ask user with PROMPT for a STRING to be inserted. +If STRING is not \"\", insert PREFIX STRING SUFFIX, otherwise DEFAULT. +If AGAIN-P is nil, do not ask if `template-current' appears another time +as key in a expansion form. If AGAIN-P is `expand', the inserted region +is searched for expansion forms where STRING is marked as a literal +environment, see `template-literal-environment'." + (setq template-modified t) + (let ((pos (point)) + (elem (and (null again-p) + (assoc template-current template-string-alist)))) + (if elem + (setq elem (cdr elem)) + (setq elem (read-from-minibuffer prompt nil nil nil + 'template-history) + elem (cond ((string= elem "") (or default "")) + ((eq again-p 'expand) + (concat prefix + (format template-expansion-format + (car template-literal-environment)) + elem + (format template-expansion-format + (cdr template-literal-environment)) + suffix + (format template-expansion-format + (car template-literal-environment)) + (format template-expansion-format + (cdr template-literal-environment)))) + (t + (concat prefix elem suffix)))) + (or again-p (push (cons template-current elem) template-string-alist))) + (insert elem) + (if (eq again-p 'expand) (goto-char pos)))) + +(defun template-choice (prompt table) + "Ask user with PROMPT for a choice and insert it. +Each element in TABLE looks like (ANSWER . TEXT). Ask for an input with +completion over all ANSWERs and insert corresponding TEXT if ANSWER is a +string, otherwise ask a \"y or n\" question and use the result of +`y-or-n-p' as ANSWER. Expansion forms in TEXT will be expanded." + (setq template-modified t) + (let ((pos (point))) + (insert (or (cdr (assoc (if (stringp (caar table)) + (completing-read prompt table nil t nil + 'template-choice-history) + (y-or-n-p prompt)) + table)) + "") + (format template-expansion-format + (car template-literal-environment)) + (format template-expansion-format + (cdr template-literal-environment))) + (goto-char pos))) + + +;;;=========================================================================== +;;; Menu filter +;;;=========================================================================== + +(defun template-menu-filter (menu-items) + ;; checkdoc-params: (menu-items) + "Menu filter for `template-creation-menu'." + (let ((alist (append template-expansion-alist + template-default-expansion-alist)) + menu used key) + (while alist + (unless (member (setq key (car (pop alist))) used) + (push key used) + (push (vector (concat "Insert " key) + (list 'template-insert-form current-prefix-arg key) + t) + menu))) + (append menu-items (nreverse menu)))) + + +;;;=========================================================================== +;;; Insert and define forms +;;;=========================================================================== + +(defun template-buffer-template-p () + "Return non-nil, if current buffer is likely to be a template file." + (and buffer-file-name + (string-match (concat (regexp-quote template-extension) "\\'") + (file-name-sans-versions buffer-file-name)))) + +(defun template-open-template () + "If current buffer is no template file, open a new one." + (interactive) + (if (template-buffer-template-p) + (barf-if-buffer-read-only) + (let (name + (dir (and (car template-subdirectories) + (expand-file-name (car template-subdirectories))))) + (if (null buffer-file-name) + (setq name (concat "TEMPLATE" template-extension)) + (setq name (file-name-sans-versions + (file-name-nondirectory buffer-file-name))) + (if (string-match ".\\.[^.]*\\'" name) + (setq name (concat "TEMPLATE" + (substring name (1+ (match-beginning 0))) + template-extension)) + (setq name (concat name template-extension) + ;; dot file => template not specific for directory + dir (car template-default-directories)))) + (setq name (read-file-name "Open template file (empty=none): " + dir nil nil name)) + (or (string= name "") + (template-find-template name))))) + +(defun template-insert-form (arg key) + "Insert an expansion form according to KEY into template. +When called interactively, allow completion over all keys in +`template-expansion-alist' and `template-default-expansion-alist'. +If prefix ARG is nil, run `template-open-template' first." + (interactive + (list current-prefix-arg + (completing-read "Insert key (0-9 for register position): " + (append template-expansion-alist + template-default-expansion-alist)))) + (or arg (template-open-template)) + (insert (format template-expansion-format key)) + (if (equal key (car template-literal-environment)) + (let ((pos (point))) + (insert (format template-expansion-format + (cdr template-literal-environment))) + (goto-char pos)))) + +(defun template-define-start (arg &rest args) + "Insert a definition section and definition into template. +See `template-definition-start'. If ARGS is non-nil, pass ARGS to +`format' for a new definition. If prefix ARG is nil, run +`template-open-template' first." + (interactive "P") + (or arg (template-open-template)) + (save-excursion + (goto-char (point-min)) + (unless (re-search-forward (concat "^[ \t]*" + template-definition-start + "[ \t]*$") nil t) + (goto-char (point-max)) + (or (bolp) (insert "\n")) + (insert template-definition-start)) + (goto-char (point-max)) + (or (bolp) (insert "\n")) + (if args (insert (apply 'format args) "\n"))) + (message "Put definition at the end of the template")) + +(defun template-define-message (arg message) + "Insert a temporary message MESSAGE definition into template. +For ARG, see `template-define-start'." + (interactive "P\nsTemporary message: ") + (template-define-start arg "%S" message)) + +(defun template-define-prompt (arg key prompt &optional prefix suffix default) + "Insert a definition for KEY as PROMPT into template. +For ARG, see `template-define-start'." + (interactive "P\nsExpansion key: \nsExpansion prompt: \nsPrefix for non-empty input: \nsSuffix for non-empty input: \nsDefault for empty input: ") + (template-define-start arg "(%S %S %S %S %S)" + key prompt prefix suffix default)) + +(defun template-define-register (arg register) + "Insert a setting of REGISTER into template. +For ARG, see `template-define-start'." + (interactive "P\ncDefine register: ") + (let* ((old (get-register register)) + (contents (read-from-minibuffer "Register contents: " + (and (stringp old) + (not (string-match "\n" old)) + old))) + (comment (read-from-minibuffer "Comment (empty=none): "))) + (if (string= comment "") + (template-define-start arg "(%S %S)" register contents) + (template-define-start arg "(%S %S %S)" register contents comment)))) + + +;;;=========================================================================== +;;; Initialization +;;;=========================================================================== + +;; easymenu.el is for top-level menus only... +(defunx template-add-submenu (menu &optional where) + "Add the submenu MENU to the end of a menu in WHERE in the menubar. +WHERE is a list of menus tried to add MENU to. If no such menu exist, +no menu is added. When using Emacs, always add to the \"Edit\" menu. +See `easy-menu-define' for the format of MENU." + (and menu + :EMACS + (>= emacs-major-version 21) + (boundp 'menu-bar-edit-menu) + (let ((keymap (easy-menu-create-menu (car menu) (cdr menu)))) + ;; `easy-menu-get-map' doesn't get the right one => use hard-coded + (define-key-after menu-bar-edit-menu (vector (intern (car menu))) + (cons 'menu-item + (cons (car menu) + (if (not (symbolp keymap)) + (list keymap) + (cons (symbol-function keymap) + (get keymap 'menu-prop))))))) + :XEMACS + (featurep 'menubar) + (let ((current-menubar default-menubar) path) + (while where + (setq path (list (pop where))) + (if (find-menu-item default-menubar path) + (setq where nil) + (setq path nil))) + (when path (add-submenu path menu))))) + +;;;###autoload +(defunx template-initialize (&rest dummies) + ;; checkdoc-params: (dummies) + "Initialized package template. See variable `template-initialize'." + (interactive) + (setq template-use-package t) + (let ((regexp (concat (regexp-quote template-extension) "\\'"))) + (or (assoc regexp auto-mode-alist) + (push (list regexp nil 'template-new-file) auto-mode-alist))) + (when (or (eq template-initialize t) + (memq 'cc-mode template-initialize)) + (add-hook 'c-mode-common-hook 'template-c-init-fill-function) + (add-hook 'antlr-mode-hook 'template-c-init-fill-function)) + (when (or (eq template-initialize t) + (memq 'de-html-helper template-initialize)) + (setq html-helper-build-new-buffer nil) + (setq html-helper-do-write-file-hooks nil)) + (when (or (eq template-initialize t) + (memq 'keys template-initialize)) + (condition-case nil ; older Emacses don't understand all + (progn + (define-key ctl-x-map "t" 'template-new-file) + (define-key ctl-x-map [(control =)] 'template-single-comment) + (define-key ctl-x-map [(control ?\;)] 'template-block-comment)) + (error nil))) + (when (or (eq template-initialize t) + (memq 'menus template-initialize)) + (template-add-submenu template-comment-menu :XEMACS '("Edit")) + (template-add-submenu template-creation-menu :XEMACS '("Cmds" "Edit")) + :EMACS + (and (boundp 'menu-bar-files-menu) + (define-key-after menu-bar-files-menu [template-new-file] + '(menu-item "New File Using Template..." template-new-file + :enable (not (window-minibuffer-p + (frame-selected-window + menu-updating-frame))) + :help "Create a new file, using a template") + 'dired)) + :XEMACS + (and (featurep 'menubar) + (find-menu-item default-menubar '("File")) + (let ((current-menubar default-menubar)) + ;; XEmacs-20.4 `add-submenu' does not have 4th arg IN-MENU + (add-menu-button '("File") + ["New File Using Template..." template-new-file + :active t] + "Insert File...")))) + (if (and (boundp 'init-file-loaded) init-file-loaded) + ;; doesn't exist in Emacs + (template-after-init) + (add-hook 'after-init-hook 'template-after-init t))) + +(defun template-after-init () + "Late initialization for package template. +See function and variable `template-initialize'." + (when (or (eq template-initialize t) + (memq 'auto template-initialize)) + (add-hook 'write-file-hooks 'template-update-buffer) + (add-hook 'find-file-not-found-hooks 'template-not-found-function t)) + (when (or (eq template-initialize t) + (memq 'ffap template-initialize)) + (or template-ffap-file-finder + (setq template-ffap-file-finder + (if (boundp 'ffap-file-finder) + ffap-file-finder + (or (get 'ffap-file-finder 'saved-value) 'find-file)))) + (setq ffap-file-finder 'template-ffap-find-file))) + +;;; Local IspellPersDict: .ispell_template +;;; template.el ends here diff --git a/lisp/themes/color-themes-alex.el b/lisp/themes/color-themes-alex.el new file mode 100644 index 0000000..3f3795b --- /dev/null +++ b/lisp/themes/color-themes-alex.el @@ -0,0 +1,48 @@ +;; -*- self-compile-mode: t -*- + +(eval-when-compile + (require 'color-theme)) + +(defun color-theme-alex () + "Color theme by Alexander Sulfrian, created 2012-03-14." + (interactive) + (color-theme-install + '(color-theme-alex + ((foreground-color . "grey90") + (background-color . "black") + (background-mode . dark)) + (border ((t (:background "gray50")))) + (diff-removed ((t (:inherit diff-changed :foreground "red3")))) + (diff-added ((t (:inherit diff-changed :foreground "Lime green")))) + (diff-header ((t (:weight bold :background nil)))) + (fixed-pitch ((t (:family "terminus")))) + (font-lock-comment-face ((nil (:foreground "green3")))) + (font-lock-constant-face ((nil (:weight bold)))) + (font-lock-negation-char-face ((t (:foreground "red" :weight bold)))) + (font-lock-preprocessor-face ((t (:inherit font-lock-builtin-face :foreground "magenta")))) + (font-lock-string-face ((nil (:foreground "red2")))) + (font-lock-warning-face ((t (:foreground "Red" :weight bold)))) + (fringe ((t (:background "gray10")))) + (highlight ((nil (:background "grey10")))) + (linum ((t (:background "gray10" :foreground "gray50" :height 0.8)))) + (magit-item-highlight ((t (:background "gray10")))) + (mode-line ((t (:box (:line-width 1 :color "grey75"))))) + (mode-line-highlight ((((class color) (min-colors 88)) (:box (:line-width 2 :color "grey40" :style released-button))))) + (mode-line-inactive ((default (:inherit mode-line :foreground "gray60")) (nil nil))) + (region ((((class color) (min-colors 88) (background dark)) (:inverse-video t)))) + (scroll-bar ((t (:background "black" :foreground "gray25"))))))) + +(defun color-theme-alex-console () + "Color theme by Alexander Sulfrian for console, created 2012-03-14." + (interactive) + (color-theme-alex) + (color-theme-install + '(color-theme-alex-console + () + (default ((t (:background nil :foreground "white")))) + (linum ((t (:background nil :foreground "white" :box nil + :strike-through nil :overline nil :underline nil + :slant normal :weight normal)))) + (region ((nil (:inverse-video t))))))) + +(provide 'color-themes-alex) diff --git a/lisp/themes/color-themes-monokai-alex.el b/lisp/themes/color-themes-monokai-alex.el new file mode 100644 index 0000000..21bc4c3 --- /dev/null +++ b/lisp/themes/color-themes-monokai-alex.el @@ -0,0 +1,33 @@ +;; -*- self-compile-mode: t -*- + +(eval-when-compile + (require 'color-theme)) + +(defun color-theme-monokai-alex () + "Color theme by Alexander Sulfrian base on monokai" + (interactive) + (color-theme-monokai) + (let ((color-theme-is-cumulative t)) + (color-theme-install + '(color-theme-monokai-alex + ((background-color . "black") + (background-mode . dark)) + (font-lock-keyword-face ((t (:foreground "#66D9EF")))) + (font-lock-type-face ((t (:weight bold :slant italic :foreground "#66D9EF")))) + (linum ((t (:height 0.8 :inherit (default))))) + (scroll-bar ((t (:foreground "gray20" :background "black")))) + + (mode-line ((((class color) (min-colors 88)) + (:foreground "black" :background "grey75") + (t (:inverse-video t))))) + (mode-line-inactive (((default + (:inherit (mode-line))) + (((class color) (min-colors 88) + (background light)) + (:background "grey90" :foreground "grey20")) + (((class color) (min-colors 88) + (background dark)) + (:background "grey30" :foreground "grey80"))))) + )))) + +(provide 'color-themes-monokai-alex) diff --git a/lisp/winring.el b/lisp/winring.el new file mode 100644 index 0000000..baac31f --- /dev/null +++ b/lisp/winring.el @@ -0,0 +1,597 @@ +;;; winring.el --- Window configuration rings + +;; Copyright (C) 1998 Free Software Foundation, Inc. + +;; Author: 1997-1998 Barry A. Warsaw +;; Maintainer: bwarsaw@python.org +;; Created: March 1997 +;; Keywords: frames tools + +(defconst winring-version "3.5" + "winring version number.") + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 2, or (at your option) +;; any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs; see the file COPYING. If not, write to the +;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, +;; Boston, MA 02111-1307, USA. + +;;; Commentary: +;; +;; This package provides lightweight support for circular rings of +;; window configurations. A window configuration is the layout of +;; windows and associated buffers within a frame. There is always at +;; least one configuration on the ring, the current configuration. +;; You can create new configurations and cycle through the layouts in +;; either direction. You can also delete configurations from the ring +;; (except the last one of course!). Window configurations are named, +;; and you can jump to and delete named configurations. Display of +;; the current window configuration name in the mode line is only +;; supported as of Emacs 20.3 and XEmacs 21.0. +;; +;; Window configuration rings are frame specific. That is, each frame +;; has its own ring which can be cycled through independently of other +;; frames. This is the way I like it. +;; +;; You are always looking at the current window configuration for each +;; frame, which consists of the windows in the frame, the buffers in +;; those windows, and point in the current buffer. As you run +;; commands such as "C-x 4 b", "C-x 2", and "C-x 0" you are modifying +;; the current window configuration. When you jump to a new +;; configuration, the layout that existed before the jump is captured, +;; and the ring is rotated to the selected configuration. Window +;; configurations are captured with `current-window-configuration', +;; however winring also saves point for the current buffer. + +;; To use, make sure this file is on your `load-path' and put the +;; following in your .emacs file: +;; +;; (require 'winring) +;; (winring-initialize) +;; +;; Note that by default, this binds the winring keymap to the C-x 7 +;; prefix, but you can change this by setting the value of +;; `winring-keymap-prefix', before you call `winring-initialize'. +;; Note that this is a change from previous versions of winring; the +;; prefix used to be M-o but was changed on the suggestion of RMS. + +;; The following commands are defined: +;; +;; C-x 7 n -- Create a new window configuration. The new +;; configuration will contain a single buffer, the one +;; named in the variable `winring-new-config-buffer-name' +;; +;; With C-u, winring prompts for the name of the new +;; configuration. If you don't use C-u the function in +;; `winring-name-generator' will be called to get the +;; new configuration's name. +;; +;; C-x 7 2 -- Create a duplicate of the current window +;; configuration. C-u has the same semantics as with +;; "C-x 7 c". +;; +;; C-x 7 j -- Jump to a named configuration (prompts for the name). +;; +;; C-x 7 0 -- Kill the current window configuration and rotate to the +;; previous layout on the ring. You cannot delete the +;; last configuration in the ring. With C-u, prompts +;; for the name of the configuration to kill. +;; +;; C-x 7 o -- Go to the next configuration on the ring. +;; +;; C-x 7 p -- Go to the previous configuration on the ring. +;; +;; Note that the sequence `C-x 7 o C-x 7 p' is a no-op; +;; it leaves you in the same configuration you were in +;; before the sequence. +;; +;; C-x 7 r -- Rename the current window configuration. +;; +;; C-x 7 b -- Submit a bug report on winring. +;; +;; C-x 7 v -- Echo the winring version. + +;; As mentioned, window configuration names can be displayed in the +;; modeline, but this feature only works with Emacs 20.3 and XEmacs +;; 21.0. A patch for XEmacs 20.4 to support this feature is available +;; at the URL below. Note that the default value of +;; `winring-show-names' is currently nil by default because if your +;; X/Emacs doesn't have the necessary support, ugly things can happen +;; (no you won't crash your X/Emacs -- it just won't do what you +;; want). +;; +;; If your X/Emacs has the necessary support, you can turn on display +;; of window configuration names by setting `winring-show-names' to +;; t. If you don't like the position in the modeline where winring +;; names are shown, you can change this by passing in your own +;; modeline hacker function to `winring-initialize'. + +;;; Winring on the Web: +;; +;; The winring Web page (including the aforementioned XEmacs 20.4 +;; patch) is +;; +;; http://www.python.org/emacs/winring/ + +;;; History: +;; +;; A long long time ago there was a package called `wicos' written by +;; Heikki Suopanki, which was based on yet another earlier package +;; called `screens' also written by Suopanki. This in turn was based +;; on the Unix tty session manager `screen' (unrelated to Emacs) by +;; Oliver Laumann, Juergen Weigert, and Michael Schroeder. +;; +;; Wicos essentially provided fancy handling for window +;; configurations. I liked the basic ideas, but wicos broke with +;; later versions of Emacs and XEmacs. I re-implemented just the +;; functionality I wanted, simplifying things in the process, and +;; porting the code to run with XEmacs 19 and 20, and Emacs 20 (I +;; don't know if winring works in Emacs 19.34). +;; +;; Wicos used the M-o prefix which I've recently changed to C-x 7 as +;; the default, by suggestion of RMS. Wicos also had some support for +;; multiple frames, and saving configurations on all visible frames, +;; but it didn't work too well, and I like frame independent rings +;; better. +;; +;; I know of a few other related packages: +;; +;; - `escreen' by Noah Friedman. A much more ambitious package +;; that does Emacs window session management. Very cool, but I +;; wanted something more lightweight. +;; +;; - `wconfig' by Bob Weiner as part of Hyperbole. I think wconfig +;; is similar in spirit to winring; it seems to have also have +;; named window configurations, but not frame-specific window +;; rings. +;; +;; - `winner' by Ivar Rummelhoff. This package comes with Emacs +;; 20, and appears to differ from winring by providing undo/redo +;; semantics to window configuration changes. winner is a minor +;; mode and does seem to support frame-specific window rings. +;; +;; - `window-xemacs' by the XEmacs Development Team. It appears +;; that this package, which is specific to XEmacs (and perhaps +;; just XEmacs 20) implements stacks of window configurations +;; which are frame independent. + +;; Please feel free to email me if my rendition of history, or my +;; explanation of the related packages, is inaccurate. + +;;; Code: + +(require 'ring) + + +(defgroup winring nil + "Window configuration rings" + :prefix "winring-" + :group 'frames) + +(defcustom winring-ring-size 7 + "*Size of the window configuration ring." + :type 'integer + :group 'winring) + +(defcustom winring-prompt-on-create 'usually + "*When true, prompt for new configuration name on creation. +If not t and not nil, prompt for configuration name on creation, +except when creating the initial configuration on a new frame." + :type '(radio + (const :tag "Never prompt for configuration name" nil) + (const :tag "Always prompt for configuration name" t) + (const :tag "Prompt for all but initial configuration name" + usually) + ) + :group 'winring) + +(defcustom winring-new-config-buffer-name "*scratch*" + "*Name of the buffer to switch to when a new configuration is created." + :type 'string + :group 'winring) + +(defcustom winring-show-names nil + "*If non-nil, window configuration names are shown in the modeline. +If nil, the name is echoed in the minibuffer when switching window +configurations." + :type 'boolean + :group 'winring) + +(defcustom winring-name-generator 'winring-next-name + "*Function that generates new automatic window configuration names. +When a new window configuration is created with `winring-new-configuration', +and the user did not specify an explicit name, this function is called with +no arguments to get the new name. It must return a string." + :type 'function + :group 'winring) + +;; Not yet customized +(defvar winring-keymap-prefix "\C-x7" + "*Prefix key that the `winring-map' is placed on in the global keymap. +If you change this, you must do it before calling `winring-initialize'.") + + +;; Set up keymap +(defvar winring-map nil + "Keymap used for winring, window configuration rings.") +(if winring-map + nil + (setq winring-map (make-sparse-keymap)) + (define-key winring-map "b" 'winring-submit-bug-report) + (define-key winring-map "n" 'winring-new-configuration) + (define-key winring-map "2" 'winring-duplicate-configuration) + (define-key winring-map "j" 'winring-jump-to-configuration) + (define-key winring-map "0" 'winring-delete-configuration) + (define-key winring-map "o" 'winring-next-configuration) + (define-key winring-map "p" 'winring-prev-configuration) + (define-key winring-map "r" 'winring-rename-configuration) + (define-key winring-map "v" 'winring-version) + ) + + + +;; Winring names +(defvar winring-name nil + "The name of the currently displayed window configuration.") + +(defvar winring-name-index 1 + "Index used as a sequence number for new unnamed window configurations.") + +(defvar winring-name-history nil + "History variable for window configuration name prompts.") + +(defun winring-next-name () + (let ((name (format "%03d" winring-name-index))) + (setq winring-name-index (1+ winring-name-index)) + name)) + + + +;; Compatibility +(defun winring-set-frame-ring (frame ring) + (cond + ;; XEmacs + ((fboundp 'set-frame-property) + (set-frame-property frame 'winring-ring ring)) + ;; Emacs + ((fboundp 'modify-frame-parameters) + (modify-frame-parameters frame (list (cons 'winring-ring ring)))) + ;; Not supported + (t (error "This version of Emacs is not supported by winring")))) + +(defun winring-get-frame-ring (frame) + (cond + ;; XEmacs + ((fboundp 'frame-property) + (frame-property frame 'winring-ring)) + ;; Emacs 20 + ((fboundp 'frame-parameter) + (frame-parameter frame 'winring-ring)) + ;; Emacs 19.34 + ((fboundp 'frame-parameters) + (cdr (assq 'winring-ring (frame-parameters frame)))) + ;; Unsupported + (t (error "This version of Emacs is not supported by winring")))) + +(defun winring-create-frame-hook (frame) + ;; generate the name, but specify the newly created frame + (winring-set-name (and (eq winring-prompt-on-create t) + (read-string "Initial window configuration name? " + nil 'winring-name-history)) + frame)) + + +;; Utilities +(defun winring-set-name (&optional name frame) + "Set the window configuration name. +Optional NAME is the name to use; if not given, then +`winring-name-generator' is `funcall'd with no arguments to get the +generated name. Optional FRAME is the frame to set the name for; if +not given then the currently selected frame is used." + (let ((name (or name (funcall winring-name-generator))) + (frame (or frame (selected-frame)))) + (if (fboundp 'add-spec-to-specifier) + ;; The XEmacs way. Only supported in hacked 20.4 or 21.0 + (add-spec-to-specifier winring-name name frame) + ;; the Emacs way. Only supported in Emacs 20.3 + (setq winring-name name) + (modify-frame-parameters frame (list (cons 'winring-name name))) + )) + (if (not winring-show-names) + (message "Switching to window configuration: %s" name))) + +(defun winring-get-ring () + (let* ((frame (selected-frame)) + (ring (winring-get-frame-ring frame))) + (when (not ring) + (setq ring (make-ring winring-ring-size)) + (winring-set-frame-ring frame ring)) + ring)) + +(defsubst winring-name-of (config) + (car config)) + +(defsubst winring-conf-of (config) + (car (cdr config))) + +(defsubst winring-point-of (config) + (nth 2 config)) + +(defsubst winring-name-of-current () + (if (fboundp 'specifier-instance) + ;; In XEmacs, this variable holds a specifier which + ;; must be instanced to get the current + ;; configuration name. + (specifier-instance winring-name) + ;; In Emacs, just use the variable's string value + ;; directly, since the `displayed' value is kept as a + ;; frame parameter + winring-name)) + +(defun winring-save-current-configuration (&optional at-front) + (let* ((ring (winring-get-ring)) + (name (winring-name-of-current)) + (here (point)) + (conf (list name (current-window-configuration) here))) + (if at-front + (ring-insert-at-beginning ring conf) + (ring-insert ring conf)))) + +(defun winring-restore-configuration (item) + (let ((conf (winring-conf-of item)) + (name (winring-name-of item)) + (here (winring-point-of item))) + (set-window-configuration conf) + ;; current-window-configuration does not save point in current + ;; window. That sucks! + (goto-char here) + (winring-set-name name)) + (force-mode-line-update)) + +(defun winring-complete-name () + (let* ((ring (winring-get-ring)) + (n (1- (ring-length ring))) + (current (winring-name-of-current)) + (table (list (cons current -1))) + name) + ;; populate the completion table + (while (<= 0 n) + (setq table (cons (cons (winring-name-of (ring-ref ring n)) n) table) + n (1- n))) + (setq name (completing-read + (format "Window configuration name (%s): " current) + table nil 'must nil 'winring-name-history)) + (if (string-equal name "") + (setq name current)) + (cdr (assoc name table)))) + +(defun winring-read-name (prompt) + (let* ((ring (winring-get-ring)) + (n (1- (ring-length ring))) + (table (list (winring-name-of-current))) + name) + ;; get the list of all the names in the ring + (while (<= 0 n) + (setq table (cons (winring-name-of (ring-ref ring n)) table) + n (1- n))) + (setq name (read-string prompt nil 'winring-name-history)) + (if (member name table) + (error "Window configuration name already in use: %s" name)) + name)) + + +;; Commands + +;;;###autoload +(defun winring-new-configuration (&optional arg) + "Save the current window configuration and create an empty new one. +The buffer shown in the new empty configuration is defined by +`winring-new-config-buffer-name'. + +With \\[universal-argument] prompt for the new configuration's name. +Otherwise, the function in `winring-name-generator' will be called to +get the new configuration's name." + (interactive "P") + (let ((name (and (or arg winring-prompt-on-create) + (winring-read-name "New window configuration name? ")))) + ;; Empty string is not allowed + (if (string-equal name "") + (setq name (funcall winring-name-generator))) + (winring-save-current-configuration) + (delete-other-windows) + (switch-to-buffer winring-new-config-buffer-name) + (winring-set-name name))) + +;;;###autoload +(defun winring-duplicate-configuration (&optional arg) + "Push the current window configuration on the ring, and duplicate it. + +With \\[universal-argument] prompt for the new configuration's name. +Otherwise, the function in `winring-name-generator' will be called to +get the new configuration's name." + (interactive "P") + (let ((name (and (or arg winring-prompt-on-create) + (winring-read-name "New window configuration name? ")))) + ;; Empty string is not allowed + (if (string-equal name "") + (setq name (funcall winring-name-generator))) + (winring-save-current-configuration) + (winring-set-name name))) + +;;;###autoload +(defun winring-next-configuration () + "Switch to the next window configuration for this frame." + (interactive) + (let ((next (ring-remove (winring-get-ring)))) + (winring-save-current-configuration) + (winring-restore-configuration next))) + +;;;###autoload +(defun winring-prev-configuration () + "Switch to the previous window configuration for this frame." + (interactive) + (let ((prev (ring-remove (winring-get-ring) 0))) + (winring-save-current-configuration 'at-front) + (winring-restore-configuration prev))) + +;;;###autoload +(defun winring-jump-to-configuration () + "Go to the named window configuration." + (interactive) + (let* ((ring (winring-get-ring)) + (index (winring-complete-name)) + item) + ;; if the current configuration was chosen, winring-complete-name + ;; returns -1 + (when (<= 0 index) + (setq item (ring-remove ring index)) + (winring-save-current-configuration) + (winring-restore-configuration item)) + )) + +;;;###autoload +(defun winring-delete-configuration (&optional arg) + "Delete the current configuration and switch to the next one. +With \\[universal-argument] prompt for named configuration to delete." + (interactive "P") + (let ((ring (winring-get-ring)) + index) + (if (or (not arg) + (> 0 (setq index (winring-complete-name)))) + ;; remove the current one, so install the next one + (winring-restore-configuration (ring-remove ring)) + ;; otherwise, remove the named one but don't change the current config + (ring-remove ring index) + ))) + +;;;###autoload +(defun winring-rename-configuration (name) + "Rename the current configuration to NAME." + (interactive "sNew window configuration name? ") + (winring-set-name name)) + + + +(defconst winring-help-address "bwarsaw@python.org" + "Address accepting bug report submissions.") + +(defun winring-version () + "Echo the current version of winring in the minibuffer." + (interactive) + (message "Using winring version %s" winring-version) + ;;(setq zmacs-region-stays t) + ) + +(defun winring-submit-bug-report (comment-p) + "Submit via mail a bug report on winring. +With \\[universal-argument] just send any type of comment." + (interactive + (list (not (y-or-n-p + "Is this a bug report? (hit `n' to send other comments) ")))) + (let ((reporter-prompt-for-summary-p (if comment-p + "(Very) brief summary: " + t))) + (require 'reporter) + (reporter-submit-bug-report + winring-help-address ;address + (concat "winring " winring-version) ;pkgname + ;; varlist + (if comment-p nil + '(winring-ring-size + winring-new-config-buffer-name + winring-show-names + winring-name-generator + winring-keymap-prefix)) + nil ;pre-hooks + nil ;post-hooks + "Dear Barry,") ;salutation + (if comment-p nil + (set-mark (point)) + (insert +"Please replace this text with a description of your problem.\n\ +The more accurately and succinctly you can describe the\n\ +problem you are encountering, the more likely I can fix it\n\ +in a timely way.\n\n") + (exchange-point-and-mark) + ;;(setq zmacs-region-stays t) + ))) + + + +;; Initialization. This is completely different b/w Emacs and XEmacs. +;; The Emacs 20.3 way is to create a frame-local variable (this is a +;; new feature with Emacs 20.3), and save the config name as a frame +;; property. +;; +;; In XEmacs 21.0 (a.k.a. 20.5), you create a generic specifier, and +;; save the config name as an instantiator over the current frame +;; locale. + +;; Be sure to do this only once +(defvar winring-initialized nil) + +(defun winring-initialize (&optional hack-modeline-function) + (unless winring-initialized + ;; + ;; Create the variable that holds the window configuration name + ;; + (cond + ;; The Emacs 20.3 way: frame-local variables + ((fboundp 'make-variable-frame-local) + (make-variable-frame-local 'winring-name)) + ;; The XEmacs 21 way: specifiers + ((fboundp 'make-specifier) + (setq winring-name (make-specifier 'generic))) + ;; Not supported in older X/Emacsen + (t nil)) + ;; + ;; Glom the configuration name into the mode-line. I've + ;; experimented with a couple of different locations, including + ;; for Emacs 20.3 mode-line-frame-identification, and for XEmacs, + ;; just splicing it before the modeline-buffer-identification. + ;; Sticking it on the very left side of the modeline, even before + ;; mode-line-modified seems like the most useful and + ;; cross-compatible place. + ;; + ;; Note that you can override the default hacking of the modeline + ;; by passing in your own `hack-modeline-function'. + ;; + (if hack-modeline-function + (funcall hack-modeline-function) + ;; Else, default insertion hackery + (let ((format (list 'winring-show-names + '("<" winring-name "> "))) + (splice (cdr mode-line-format))) + (setcar splice (list format (car splice))))) + ;; + ;; We need to add a hook so that all newly created frames get + ;; initialized properly. Again, different for Emacs and XEmacs. + ;; + (if (boundp 'create-frame-hook) + ;; XEmacs + (add-hook 'create-frame-hook 'winring-create-frame-hook) + ;; better be Emacs! + (add-hook 'after-make-frame-functions 'winring-create-frame-hook)) + ;; + ;; Now set the initial configuration name on the initial frame... + (winring-create-frame-hook (selected-frame)) + ;; ...the keymap... + (global-set-key winring-keymap-prefix winring-map) + ;; ...and the init fence + (setq winring-initialized t))) + + + +(provide 'winring) +;;; winring.el ends here diff --git a/templates/TEMPLATE.py.tpl b/templates/TEMPLATE.py.tpl new file mode 100644 index 0000000..aa033a1 --- /dev/null +++ b/templates/TEMPLATE.py.tpl @@ -0,0 +1,3 @@ +# -*- coding: utf-8 -*- + +(>>>POINT<<<) |