diff options
| -rw-r--r-- | lib/bufhist.el | 66 | ||||
| -rw-r--r-- | lib/holes.el | 42 | ||||
| -rw-r--r-- | lib/local-vars-list.el | 39 | ||||
| -rw-r--r-- | lib/maths-menu.el | 8 | ||||
| -rw-r--r-- | lib/pg-dev.el | 28 | ||||
| -rw-r--r-- | lib/pg-fontsets.el | 18 | ||||
| -rw-r--r-- | lib/proof-compat.el | 26 | ||||
| -rw-r--r-- | lib/scomint.el | 124 | ||||
| -rw-r--r-- | lib/span.el | 14 | ||||
| -rw-r--r-- | lib/texi-docstring-magic.el | 46 | ||||
| -rw-r--r-- | lib/unicode-chars.el | 4 | ||||
| -rw-r--r-- | mmm/mmm-auto.el | 10 | ||||
| -rw-r--r-- | mmm/mmm-class.el | 162 | ||||
| -rw-r--r-- | mmm/mmm-cmds.el | 222 | ||||
| -rw-r--r-- | mmm/mmm-compat.el | 14 | ||||
| -rw-r--r-- | mmm/mmm-mason.el | 50 | ||||
| -rw-r--r-- | mmm/mmm-mode.el | 26 | ||||
| -rw-r--r-- | mmm/mmm-noweb.el | 2 | ||||
| -rw-r--r-- | mmm/mmm-region.el | 350 | ||||
| -rw-r--r-- | mmm/mmm-sample.el | 130 | ||||
| -rw-r--r-- | mmm/mmm-univ.el | 8 | ||||
| -rw-r--r-- | mmm/mmm-utils.el | 36 | ||||
| -rw-r--r-- | mmm/mmm-vars.el | 206 | ||||
| -rw-r--r-- | phox/phox-extraction.el | 28 | ||||
| -rw-r--r-- | phox/phox-font.el | 16 | ||||
| -rw-r--r-- | phox/phox-fun.el | 100 | ||||
| -rw-r--r-- | phox/phox-lang.el | 13 | ||||
| -rw-r--r-- | phox/phox-outline.el | 22 | ||||
| -rw-r--r-- | phox/phox-pbrpm.el | 78 | ||||
| -rw-r--r-- | phox/phox-sym-lock.el | 28 | ||||
| -rw-r--r-- | phox/phox-tags.el | 11 |
31 files changed, 960 insertions, 967 deletions
diff --git a/lib/bufhist.el b/lib/bufhist.el index 8864c425..a593de5f 100644 --- a/lib/bufhist.el +++ b/lib/bufhist.el @@ -6,14 +6,14 @@ ;; License: GPL (GNU GENERAL PUBLIC LICENSE) ;; Keywords: tools ;; -;; $Id$ +;; $Id$ ;; ;; This file is distributed under the terms of the GNU General Public ;; License, Version 2. Find a copy of the GPL with your version of ;; GNU Emacs or Texinfo. -;; +;; ;; This library implements a minor mode for which keeps a ring history of -;; buffer contents. Intended to be used for small buffers which are +;; buffer contents. Intended to be used for small buffers which are ;; intermittently updated (e.g. status panels/displays), for which history ;; browsing is useful. ;; @@ -23,7 +23,7 @@ ;; copying strings in and out. That way we can use cloned (indirect) ;; buffers which allow independent browsing of the history. ;; -;; FIXMEs: autoloading this doesn't work too well. +;; FIXMEs: autoloading this doesn't work too well. ;; advice on erase-buffer doesn't work ;; duplicated first item in ring after clear (& on startup). @@ -71,7 +71,7 @@ (desc (format "History %d of %d; mouse-1 previous; mouse-3 next" histpos histsize)) (indicator (format "[%d/%d]" histpos histsize))) - (propertize + (propertize indicator 'help-echo desc 'keymap (eval-when-compile @@ -84,11 +84,11 @@ ;; (define-key map [mode-line control mouse-3] 'bufhist-last) map)) 'mouse-face 'mode-line-highlight)))) - + ;simple: -; '(" [hist:" +; '(" [hist:" ; (:eval (int-to-string (- (ring-length bufhist-) -; bufhist-ring-pos))) "/" +; bufhist-ring-pos))) "/" ; (:eval (int-to-string (ring-length bufhist-ring))) "]")) (make-variable-buffer-local 'bufhist-ring) @@ -100,7 +100,7 @@ "Return the stored representation of the current buffer contents." ;; First: make all extents in the buffer duplicable to recreate them (if (fboundp 'mapcar-extents) - (mapcar-extents (lambda (ext) + (mapcar-extents (lambda (ext) (set-extent-property ext 'duplicable t)))) (cons (point) (buffer-substring (point-max) (point-min)))) @@ -126,7 +126,7 @@ ;; We could provide advice for erase-buffer, but instead make this part of API. (defun bufhist-erase-buffer () "Erase buffer contents, maybe running bufhist-before-change-function first." - (if (and + (if (and bufhist-mode (memq 'bufhist-before-change-function before-change-functions)) (let ((before-change-functions nil) @@ -143,7 +143,7 @@ (defun bufhist-switch-to-index (n &optional nosave browsing) "Switch to position N in buffer history, maybe updating history. If optional NOSAVE is non-nil, do not try to save current contents." - (unless (equal n bufhist-ring-pos) + (unless (equal n bufhist-ring-pos) ;; we're moving to different position (let ((tick (buffer-modified-tick))) ;; Save changes back to history for most recent contents or for @@ -153,7 +153,7 @@ If optional NOSAVE is non-nil, do not try to save current contents." (equal tick bufhist-lastswitch-modified-tick)) ;; If we're browsing away from position 0, checkpoint instead ;; of updating. - ;; NB: logic here should ideally keep flag to say whether + ;; NB: logic here should ideally keep flag to say whether ;; changes are "during" a browse or not. This is going ;; to result in too many checkpoints if we have manual ;; editing. @@ -162,19 +162,19 @@ If optional NOSAVE is non-nil, do not try to save current contents." (bufhist-checkpoint) ; (setq n (1+ n))) ;; Otherwise update in-position - (bufhist-ring-update bufhist-ring bufhist-ring-pos + (bufhist-ring-update bufhist-ring bufhist-ring-pos (bufhist-get-buffer-contents)))) (setq bufhist-lastswitch-modified-tick tick) (let ((before-change-functions nil) (buffer-read-only nil)) (bufhist-restore-buffer-contents (ring-ref bufhist-ring n))) (if bufhist-read-only-history - (setq buffer-read-only + (setq buffer-read-only (if (eq n 0) bufhist-normal-read-only t))) (setq bufhist-ring-pos n) (force-mode-line-update) (if browsing - (message "History position %d of %d in %s" + (message "History position %d of %d in %s" (- (ring-length bufhist-ring) n) (ring-length bufhist-ring) (buffer-name)))))) @@ -188,7 +188,7 @@ If optional NOSAVE is non-nil, do not try to save current contents." "Switch to last (most recent; current) buffer contents." (interactive) (bufhist-switch-to-index 0 nil 'browsing)) - + (defun bufhist-prev (&optional n) "Browse backward in the history of buffer contents." (interactive "p") @@ -212,13 +212,13 @@ If optional NOSAVE is non-nil, do not try to save current contents." ;; FIXME: glitch here: we get duplicated first item after clear. ;; Bit like on startup: we always get empty buffer/current contents -;; twice. Reason is because of invariant of non-empty ring; -;; when we checkpoint we always add to ring. +;; twice. Reason is because of invariant of non-empty ring; +;; when we checkpoint we always add to ring. (defun bufhist-clear () "Clear history." (interactive) (message "Buffer history in %s cleared." (buffer-name)) - (bufhist-switch-to-index 0 'nosave) + (bufhist-switch-to-index 0 'nosave) (setq bufhist-ring (make-ring (ring-size bufhist-ring))) (setq bufhist-ring-pos 0) (bufhist-checkpoint) @@ -241,12 +241,12 @@ The size defaults to `bufhist-ring-size'." (setq bufhist-ring-pos 0) (setq bufhist-saved-mode-line-format mode-line-format) (bufhist-checkpoint) - (setq mode-line-format - (cons '(bufhist-mode + (setq mode-line-format + (cons '(bufhist-mode (:eval (bufhist-mode-line-format-entry))) ;; surely it's always a list, but in case not - (if (listp mode-line-format) - mode-line-format + (if (listp mode-line-format) + mode-line-format (list mode-line-format)))) (force-mode-line-update) (make-local-variable 'before-change-functions) @@ -289,21 +289,21 @@ The size defaults to `bufhist-ring-size'." ; (bufhist-last))) ; (ad-activate-on 'erase-buffer))) -;;; Buttons +;;; Buttons (defun bufhist-make-buttons () (widget-create 'push-button - :notify (lambda (&rest ignore) + :notify (lambda (&rest ignore) (bufhist-prev)) - "Prev") + "Prev") (widget-create 'push-button - :notify (lambda (&rest ignore) + :notify (lambda (&rest ignore) (bufhist-next)) - "Next") + "Next") (widget-setup)) -;;; Minor mode +;;; Minor mode (defconst bufhist-minor-mode-map (let ((map (make-sparse-keymap))) @@ -322,8 +322,8 @@ The size defaults to `bufhist-ring-size'." "Minor mode retaining an in-memory history of the buffer contents. Commands:\\<bufhist-minor-mode-map> -\\[bufhist-prev] bufhist-prev go back in history -\\[bufhist-next] bufhist-next go forward in history +\\[bufhist-prev] bufhist-prev go back in history +\\[bufhist-next] bufhist-next go forward in history \\[bufhist-first] bufhist-first go to first item in history \\[bufhist-last] bufhist-last go to last (current) item in history. \\[bufhist-clear] bufhist-clear clear history. @@ -333,13 +333,13 @@ Commands:\\<bufhist-minor-mode-map> ; For newer versions of define-minor-mode we can use extra ; args above instead of hook function below: ; :group 'bufhist -; (if bufhist-mode +; (if bufhist-mode ; (bufhist-init) ; (bufhist-exit))) ; This doesn't work, e.g. with XEmacs 21.4.15. (defun bufhist-toggle-fn () - (if bufhist-mode + (if bufhist-mode (bufhist-init) (bufhist-exit))) diff --git a/lib/holes.el b/lib/holes.el index 492502b0..0865cd4c 100644 --- a/lib/holes.el +++ b/lib/holes.el @@ -6,18 +6,18 @@ ;; ;; This file uses spans, an interface for extent (XEmacs) and overlays ;; (emacs), by Healfdene Goguen for the proofgeneral mode. -;; +;; ;; Credits also to Stefan Monnier for great help in making this file ;; cleaner. -;; +;; ;; This software is free software; you can redistribute it and/or ;; modify it under the terms of the GNU General Public ;; License version 2, as published by the Free Software Foundation. -;; +;; ;; This software 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 version 2 for more details ;; (enclosed in the file GPL). ;; @@ -28,7 +28,7 @@ ;; See documentation in variable holes-doc. ;;; History: -;; +;; (eval-when-compile (require 'span)) (require 'cl) @@ -41,7 +41,7 @@ It is useful to build complicated expressions by copy pasting several peaces of text from different parts of a buffer (or even from different buffers). - HOLES + HOLES A hole is a piece of (highlighted) text that may be replaced by another part of text later. There is no information stored on the @@ -49,7 +49,7 @@ file for holes, so you can save and modify files containing holes with no harm... You can even insert or delete characters inside holes like any other characters. - USE + USE At any time only one particular hole, called \"active\", can be \"filled\". Holes can be in several buffers but there is always one or @@ -112,9 +112,9 @@ COMBINING HOLES AND SKELETONS `holes' minor mode is made to work with minor mode `skeleton' minor mode. For the moment only Emacs version of `skeleton' is compatible with `holes', not XEmacs's. When you insert a skeleton, each -interesting position will be replaced by a hole. +interesting position will be replaced by a hole. - KNOWN BUGS + KNOWN BUGS o Don't try to make overlapping holes, it doesn't work. (what would it mean anyway?) @@ -126,7 +126,7 @@ holes highlighted as the active one (whereas only one of them really is), which is annoying. ") - + ;;; Code: ;;; initialization @@ -254,7 +254,7 @@ active hole doesn't exist (the marker is set to nothing)." "Return the position of the start of the active hole. See `active-hole-buffer' to get its buffer. Returns an error if active hole doesn't exist (the marker is set to nothing)." - + (assert (holes-active-hole-exist-p) t "holes-active-hole-end-position: no active hole") (holes-hole-end-position holes-active-hole) @@ -273,10 +273,10 @@ active hole is empty." ) (defun holes-goto-active-hole () - + "Set point to active hole. Raises an error if active-hole is not set." - + (interactive) (assert (holes-active-hole-exist-p) t "holes-goto-active-hole: no active hole") @@ -327,7 +327,7 @@ the active hole is already disable." "Set active hole to HOLE. Error if HOLE is not a hole." - + (assert (holes-is-hole-p HOLE) t "holes-set-active-hole: %s is not a hole") (if (holes-active-hole-exist-p) (holes-highlight-hole holes-active-hole)) @@ -374,7 +374,7 @@ Error if HOLE is not a hole." If no arg default hole after point. If only one arg: error. Return the span." (interactive) - + (let* ((rstart (or start (holes-region-beginning-or-nil) (point))) (rend (or end (holes-region-end-or-nil) (point)))) (if (eq rstart rend) @@ -394,7 +394,7 @@ the span." "Internal." (assert (holes-is-hole-p HOLE) t "holes-clear-hole: %s is not a hole") - + (if (and (holes-active-hole-exist-p) (eq holes-active-hole HOLE)) (holes-disable-active-hole) ) @@ -456,7 +456,7 @@ Default pos = point and buffer = current." (interactive) (let ((nxthole (holes-next (or pos (point)) (or buffer (current-buffer))))) - (if nxthole + (if nxthole (holes-set-active-hole nxthole) (holes-disable-active-hole) ) @@ -588,12 +588,12 @@ Sets `holes-active-hole' to the next hole if it exists." ;; Emacs-21's mouse-drag-region has a bug that makes it behave more or ;; less like we want it as long as transient-mark-mode is active. (let ((transient-mark-mode nil)) - (mouse-drag-region event))) + (mouse-drag-region event))) (defsubst holes-track-mouse-clicks () "see `mouse-selection-click-count'" (+ mouse-selection-click-count 1))) (t - (unless noninteractive + (unless noninteractive ;; da: ^^^^ avoid error in "make doc" (mouse functions undefined?) (error "Your (X)Emacs version is not compatible with holes (too old or @@ -777,7 +777,7 @@ created. Return the number of holes created." (holes-make-hole (match-beginning 0) (match-end 0)) (holes-make-hole (match-beginning 1) (match-end 1)) ;; delete end first to avoid shifting of marks - (delete-region (match-end 1) (match-end 0)) + (delete-region (match-end 1) (match-end 0)) (delete-region (match-beginning 0) (match-beginning 1))) (holes-set-active-hole-next))) n)) @@ -791,7 +791,7 @@ created. Return the number of holes created." (dolist (pos skeleton-positions) ;; put holes here (holes-set-make-active-hole pos pos))))) -(defconst holes-jump-doc +(defconst holes-jump-doc (concat "Hit \\[holes-set-point-next-hole-destroy] to jump " "to active hole. C-h v holes-doc to see holes doc.") "Shortcut reminder string for jumping to active hole.") diff --git a/lib/local-vars-list.el b/lib/local-vars-list.el index c55cee44..0310f73f 100644 --- a/lib/local-vars-list.el +++ b/lib/local-vars-list.el @@ -9,11 +9,11 @@ ;; This software is free software; you can redistribute it and/or ;; modify it under the terms of the GNU General Public ;; License version 2, as published by the Free Software Foundation. -;; +;; ;; This software 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 version 2 for more details ;; (enclosed in the file GPL). @@ -21,7 +21,7 @@ ;; See documentation in variable local-var-list-doc ;;; History: -;; +;; ;;; Help: @@ -30,7 +30,7 @@ A file can contain a \"local variables list\", which specifies the values to use for certain Emacs variables when that file is edited. See info node \"(emacs)File -Variables\". +Variables\". local-vars-list provides two useful functions: @@ -47,17 +47,17 @@ Indents the zone according to mode after insertion." (save-excursion (goto-char (point-max)) (let ((pt (point))) - (cond + (cond ((not comment-start) - (insert + (insert " *** Local Variables: *** *** End: *** -" +" )) ((string-equal comment-end "") - (insert + (insert (format " %s** Local Variables: *** @@ -66,7 +66,7 @@ Indents the zone according to mode after insertion." comment-start comment-start))) (t - (insert + (insert (format " %s @@ -80,13 +80,13 @@ Indents the zone according to mode after insertion." (defun local-vars-list-find () - "Find the local variable definition paragraph. + "Find the local variable definition paragraph. Return a list containing the prefix and the suffix of its first line, or throw 'notfound if not found. Sets the point at the beginning of the second line of the paragraph." (goto-char (point-max)) (catch 'notfound - (if (not (re-search-backward "Local Variables:" nil t)) (throw 'notfound nil)) + (if (not (re-search-backward "Local Variables:" nil t)) (throw 'notfound nil)) (let ((bol (save-excursion (beginning-of-line) (point))) (eol (save-excursion (end-of-line) (point))) (lpattern) @@ -94,17 +94,17 @@ the second line of the paragraph." (setq lpattern (buffer-substring bol (point))) (re-search-forward "Local Variables:" eol t) (setq rpattern (buffer-substring (point) eol)) - (forward-line 1) + (forward-line 1) (beginning-of-line) (cons lpattern (cons rpattern nil))))) (defun local-vars-list-goto-var (symb lpat rpat) - "Search a line defining local variable symb at current line and below. + "Search a line defining local variable symb at current line and below. If successful set point to the beginning of the *value* and return t. Otherwise set point to the beginning of the last line of the local variables list (the one containing \"End:\"), and return nil. -lpat and rpat are the suffix and prefix of the local variable list. +lpat and rpat are the suffix and prefix of the local variable list. Note: this function must be called when at the beginning of a local variable definition (or at the \"End:\" line)." @@ -116,7 +116,7 @@ variable definition (or at the \"End:\" line)." (search-forward lpat eol) (re-search-forward "\\([^ :]+\\):" eol) (let ((varname (match-string 1))) - (cond + (cond ((string-equal varname "End") (setq endreached t) (beginning-of-line)) ((string-equal varname symbname) (setq found t)) (t (forward-line 1) (beginning-of-line))))) @@ -164,7 +164,7 @@ variable definition (or at the \"End:\" line)." (kill-region boexp (point)) (insert (format " %S " val)) ) - ) + ) ) @@ -172,7 +172,7 @@ variable definition (or at the \"End:\" line)." "Return the value written in the local variable list for variable symb. Raises an error if symb is not in the list." (save-excursion - (let* + (let* ((lrpat (local-vars-list-find)) (dummy (if lrpat t (error "local variables zone not found. "))) (lpat (car lrpat)) @@ -180,7 +180,7 @@ Raises an error if symb is not in the list." ) (beginning-of-line) (if (local-vars-list-goto-var symb lpat rpat) - t + t (error "variable %s not found" symb)) (beginning-of-line) (local-vars-list-get-current lpat rpat)))) @@ -220,6 +220,3 @@ of the buffer first." ;;; fill-column: 85 *** ;;; indent-tabs-mode: nil *** ;;; End: *** - - - diff --git a/lib/maths-menu.el b/lib/maths-menu.el index 1a114c86..d02ff02e 100644 --- a/lib/maths-menu.el +++ b/lib/maths-menu.el @@ -58,7 +58,7 @@ (defvar maths-menu-tokenise-insert '(lambda (char) (insert char)) "Function used to insert possibly formatted or escaped character.") - + (defun maths-menu-build-menu (spec) (let ((map (make-sparse-keymap "Characters"))) (dolist (pane spec) @@ -67,10 +67,10 @@ (define-key-after map (vector (intern name)) (cons name pane-map)) (dolist (elt pane) (let ((fname (intern - (concat "maths-menu-insert-" + (concat "maths-menu-insert-" (replace-regexp-in-string " " "-" (cadr elt)))))) - (fset fname - `(lambda () + (fset fname + `(lambda () (interactive) (funcall maths-menu-tokenise-insert ,(car elt)))) (define-key-after pane-map diff --git a/lib/pg-dev.el b/lib/pg-dev.el index 6ac24bce..22aba6e5 100644 --- a/lib/pg-dev.el +++ b/lib/pg-dev.el @@ -7,20 +7,23 @@ ;; $Id$ ;; ;;; Commentary: -;; +;; ;; Some configuration of Emacs Lisp mode for developing PG, not needed ;; for ordinary users. ;; -;; Use checkdoc, eldoc, Flyspell: - ;;; Code: -(add-hook 'emacs-lisp-mode-hook - '(lambda () (checkdoc-minor-mode 1))) -(add-hook 'emacs-lisp-mode-hook 'turn-on-eldoc-mode) +;; Use checkdoc, eldoc, Flyspell, whitespace cleanup: -(add-hook 'emacs-lisp-mode-hook 'flyspell-prog-mode) +(add-hook 'emacs-lisp-mode-hook + '(lambda () + (checkdoc-minor-mode 1) + (turn-on-eldoc-mode) + (flyspell-prog-mode) + (customize-set-variable 'whitespace-action '(cleanup)) + (add-hook 'write-file-functions + 'whitespace-write-file-hook nil t))) ;; Configure indentation for our macros @@ -77,11 +80,11 @@ '(proof-splash pg-assoc pg-xml proof-depends proof-indent proof-site proof-shell proof-menu pg-pbrpm pg-pgip proof-script proof-autoloads pg-response pg-goals proof-toolbar - proof-easy-config proof-config proof-mmm proof + proof-easy-config proof-config proof-mmm proof proof-utils proof-syntax pg-user pg-custom proof-maths-menu proof-unicode-tokens pg-thymodes pg-autotest - ;; + ;; isar-syntax isar-find-theorems isar-unicode-tokens isar-autotest interface-setup isabelle-system isar isar-mmm isar-keywords @@ -89,7 +92,7 @@ coq-abbrev coq-db coq-unicode-tokens coq-local-vars coq coq-syntax coq-indent coq-autotest))) - + ;; ;; Proling interesting packages @@ -112,9 +115,9 @@ (defun pg-bug-references () (interactive) (bug-reference-mode 1) - (setq bug-reference-bug-regexp + (setq bug-reference-bug-regexp "\\(?:[Tt]rac ?#\\)\\([0-9]+\\)" - bug-reference-url-format + bug-reference-url-format "http://proofgeneral.inf.ed.ac.uk/trac/ticket/%s")) (add-hook 'emacs-lisp-mode-hook 'pg-bug-references) @@ -127,4 +130,3 @@ (provide 'pg-dev) ;;; pg-dev.el ends here - diff --git a/lib/pg-fontsets.el b/lib/pg-fontsets.el index 29fd38f8..cf170621 100644 --- a/lib/pg-fontsets.el +++ b/lib/pg-fontsets.el @@ -7,11 +7,11 @@ ;; $Id$ ;; ;;; Commentary: -;; +;; ;; Define some fontsets to try to select fonts that display many symbols. ;; ;; Select one of these fontsets via the menu Options -> Set Font/Fontset -;; or, with M-x set-default-font +;; or, with M-x set-default-font ;; ;; Recommended & free fonts to install on your system are: ;; @@ -37,11 +37,11 @@ (dolist (size '(10 12 14 18 22)) (add-to-list 'pg-fontsets-names (create-fontset-from-fontset-spec - (replace-regexp-in-string + (replace-regexp-in-string "%T" (car (split-string basefont)) - (replace-regexp-in-string + (replace-regexp-in-string "%S" (int-to-string size) - (replace-regexp-in-string + (replace-regexp-in-string "%F" basefont "-*-%F-*-*-*--%S-*-*-*-*-*-fontset-PG%T, gnu-unifont:-*-%F-*-*-*--%S-*-*-*-*-*-iso10646-1" @@ -52,17 +52,17 @@ gnu-unifont:-*-%F-*-*-*--%S-*-*-*-*-*-iso10646-1" ;mule-unicode-e000-ffff:-*-%F-medium-r-normal--%S--*-*-*-*-*-iso10646-1" ))))))) -(defconst pg-fontsets-base-fonts +(defconst pg-fontsets-base-fonts '("dejavu lgc sans mono" - "liberation mono" + "liberation mono" "stixregular" "lucidasanstypewriter")) (defun pg-fontsets-make-fontsets () (setq pg-fontsets-names nil) - (mapcar 'pg-fontsets-make-fontsetsizes + (mapcar 'pg-fontsets-make-fontsetsizes pg-fontsets-base-fonts)) -; (custom-initialize-default 'pg-fontsets-default-fontset +; (custom-initialize-default 'pg-fontsets-default-fontset ; (nth 2 pg-fontsets-names)) ; (setq pg-fontsets-default-fontset (nth 2 pg-fontsets-names)) ; (set-default-font pg-fontsets-default-fontset)) diff --git a/lib/proof-compat.el b/lib/proof-compat.el index a37ddab9..3f84481a 100644 --- a/lib/proof-compat.el +++ b/lib/proof-compat.el @@ -1,6 +1,6 @@ ;; proof-compat.el Operating system and Emacs version compatibility ;; -;; Copyright (C) 2000-2009 LFCS Edinburgh. +;; Copyright (C) 2000-2009 LFCS Edinburgh. ;; Author: David Aspinall <David.Aspinall@ed.ac.uk> and others ;; License: GPL (GNU GENERAL PUBLIC LICENSE) ;; @@ -11,7 +11,7 @@ ;; track of them. ;; ;; The development policy for Proof General (since v3.7) is for the -;; main codebase to be written for the latest stable version of +;; main codebase to be written for the latest stable version of ;; GNU Emacs, following GNU Emacs advice on obsolete function calls. ;; ;; Since Proof General 4.0, XEmacs is not supported at all. @@ -34,7 +34,7 @@ ;; Workaround a small bug in Carbon Emacs Winter 2008 (at least) -;; Menu presses query this variable, but it's not bound unless +;; Menu presses query this variable, but it's not bound unless ;; mode engaged. Not noticeable in normal use, but it is as soon ;; as debug-on-error is engaged. (if (and (boundp 'carbon-emacs-package-version) @@ -53,9 +53,9 @@ "Remove a custom setting SYMBOL. Done by `makunbound' and removing all properties mentioned by custom library." (mapcar (lambda (prop) (remprop symbol prop)) - '(default - standard-value - force-value + '(default + standard-value + force-value variable-comment saved-variable-comment variable-documentation @@ -87,8 +87,8 @@ The value returned is the value of the last form in BODY." (let ((old-frame (gensym "ssf"))) `(let ((,old-frame (selected-frame))) (unwind-protect - (progn ,@body) - (select-frame ,old-frame)))))) + (progn ,@body) + (select-frame ,old-frame)))))) ;; An implemenation of buffer-syntactic-context for GNU Emacs (defun proof-buffer-syntactic-context-emulate (&optional buffer) @@ -114,7 +114,7 @@ The returned value is one of the following symbols: ;; These functions are used in the intricate logic around -;; shrink-to-fit. +;; shrink-to-fit. ;; window-leftmost-p, window-rightmost-p: my implementations (or (fboundp 'window-leftmost-p) @@ -142,7 +142,7 @@ The returned value is one of the following symbols: ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; -;;; A naughty hack to completion.el +;;; A naughty hack to completion.el ;;; ;;; At the moment IMO completion too eagerly adds stuff to ;;; its database: the completion-before-command function @@ -152,16 +152,16 @@ The returned value is one of the following symbols: '(defun completion-before-command () (if (and (symbolp this-command) (get this-command 'completion-function)) (funcall (get this-command 'completion-function))))) - + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; ;;; General Emacs version compatibility ;;; -(defalias 'proof-buffer-syntactic-context +(defalias 'proof-buffer-syntactic-context 'proof-buffer-syntactic-context-emulate) - + ;; End of proof-compat.el (provide 'proof-compat) diff --git a/lib/scomint.el b/lib/scomint.el index f185ffb1..a8e0a300 100644 --- a/lib/scomint.el +++ b/lib/scomint.el @@ -7,13 +7,13 @@ ;; $Id$ ;;; Commentary: -;; +;; ;; This is a heavily simplified comint for Proof General. ;; Much of the code is taken from comint.el. ;; ;; The reason to provide this is to remove some of -;; the interactive features which are otherwise -;; hard to disentangle. +;; the interactive features which are otherwise +;; hard to disentangle. ;; (defface scomint-highlight-input '((t (:weight bold))) @@ -186,9 +186,9 @@ buffer. The hook `scomint-exec-hook' is run after each exec." ;; If the command has slashes, make sure we ;; first look relative to the current directory. (cons default-directory exec-path) exec-path))) - (setq proc (apply (if (fboundp 'start-file-process) + (setq proc (apply (if (fboundp 'start-file-process) ;; da: start-file-process is Emacs23 only - 'start-file-process 'start-process) + 'start-file-process 'start-process) name buffer command switches))) ;; Some file name handler cannot start a process, fe ange-ftp. (unless (processp proc) (error "No process started")) @@ -218,7 +218,7 @@ buffer. The hook `scomint-exec-hook' is run after each exec." (defun scomint-send-input (&optional no-newline artificial) "Send input to process. After the process output mark, sends all text from the process mark to -point as input to the process. +point as input to the process. This command also sends and inserts a final newline, unless NO-NEWLINE is non-nil." @@ -228,34 +228,34 @@ NO-NEWLINE is non-nil." (if (not proc) (error "Current buffer has no process") (widen) (let* ((pmark (process-mark proc)) - (input (if (>= (point) (marker-position pmark)) + (input (if (>= (point) (marker-position pmark)) (buffer-substring pmark (point))))) - - (unless no-newline - (insert ?\n)) - - (let ((beg (marker-position pmark)) - (end (if no-newline (point) (1- (point)))) - (inhibit-modification-hooks t)) - ;; (when (> end beg) - ;; (add-text-properties beg end - ;; '(front-sticky t - ;; font-lock-face scomint-highlight-input)) - - ;; (unless no-newline - ;; ;; Cover the terminating newline - ;; (add-text-properties end (1+ end) - ;; '(rear-nonsticky t - ;; field boundary - ;; inhibit-line-move-field-capture t)))) - - ;; Update the markers before we send the input - ;; in case we get output amidst sending the input. - (set-marker scomint-last-input-start pmark) - (set-marker scomint-last-input-end (point)) - (set-marker (process-mark proc) (point)) - (scomint-send-string - proc + + (unless no-newline + (insert ?\n)) + + (let ((beg (marker-position pmark)) + (end (if no-newline (point) (1- (point)))) + (inhibit-modification-hooks t)) + ;; (when (> end beg) + ;; (add-text-properties beg end + ;; '(front-sticky t + ;; font-lock-face scomint-highlight-input)) + + ;; (unless no-newline + ;; ;; Cover the terminating newline + ;; (add-text-properties end (1+ end) + ;; '(rear-nonsticky t + ;; field boundary + ;; inhibit-line-move-field-capture t)))) + + ;; Update the markers before we send the input + ;; in case we get output amidst sending the input. + (set-marker scomint-last-input-start pmark) + (set-marker scomint-last-input-end (point)) + (set-marker (process-mark proc) (point)) + (scomint-send-string + proc (concat input (unless no-newline "\n")))))))) @@ -270,7 +270,7 @@ NO-NEWLINE is non-nil." (if (> (point-max) scomint-buffer-maximum-size) (let ((inhibit-read-only t)) (delete-region (point-min) - (- (point-max) + (- (point-max) scomint-buffer-maximum-size)))))))) (defun scomint-strip-ctrl-m (&optional string) @@ -295,7 +295,7 @@ NO-NEWLINE is non-nil." (with-current-buffer oprocbuf ;; Insert STRING (let ((inhibit-read-only t) - ;; The point should float after any insertion we do. + ;; The point should float after any insertion we do. (saved-point (copy-marker (point) t))) ;; We temporarly remove any buffer narrowing, in case the @@ -324,40 +324,40 @@ NO-NEWLINE is non-nil." (goto-char (process-mark process)) ; in case a filter moved it ;; (let ((inhibit-read-only t) - ;; (inhibit-modification-hooks t)) + ;; (inhibit-modification-hooks t)) ;; (add-text-properties scomint-last-output-start (point) - ;; '(front-sticky - ;; (field inhibit-line-move-field-capture) - ;; rear-nonsticky t - ;; field output - ;; inhibit-line-move-field-capture t))) + ;; '(front-sticky + ;; (field inhibit-line-move-field-capture) + ;; rear-nonsticky t + ;; field output + ;; inhibit-line-move-field-capture t))) ;; Highlight the prompt, where we define `prompt' to mean ;; the most recent output that doesn't end with a newline. ;; (let ((prompt-start (save-excursion (forward-line 0) (point))) ;; (inhibit-read-only t) ;; (inhibit-modification-hooks t)) -;; (when comint-prompt-read-only -;; (or (= (point-min) prompt-start) -;; (get-text-property (1- prompt-start) 'read-only) -;; (put-text-property -;; (1- prompt-start) prompt-start 'read-only 'fence)) -;; (add-text-properties -;; prompt-start (point) -;; '(read-only t rear-nonsticky t front-sticky (read-only)))) -;; (unless (and (bolp) (null comint-last-prompt-overlay)) -;; ;; Need to create or move the prompt overlay (in the case -;; ;; where there is no prompt ((bolp) == t), we still do -;; ;; this if there's already an existing overlay). -;; (if comint-last-prompt-overlay -;; ;; Just move an existing overlay -;; (move-overlay comint-last-prompt-overlay -;; prompt-start (point)) -;; ;; Need to create the overlay -;; (setq comint-last-prompt-overlay -;; (make-overlay prompt-start (point))) -;; (overlay-put comint-last-prompt-overlay -;; 'font-lock-face 'scomint-highlight-prompt)))) +;; (when comint-prompt-read-only +;; (or (= (point-min) prompt-start) +;; (get-text-property (1- prompt-start) 'read-only) +;; (put-text-property +;; (1- prompt-start) prompt-start 'read-only 'fence)) +;; (add-text-properties +;; prompt-start (point) +;; '(read-only t rear-nonsticky t front-sticky (read-only)))) +;; (unless (and (bolp) (null comint-last-prompt-overlay)) +;; ;; Need to create or move the prompt overlay (in the case +;; ;; where there is no prompt ((bolp) == t), we still do +;; ;; this if there's already an existing overlay). +;; (if comint-last-prompt-overlay +;; ;; Just move an existing overlay +;; (move-overlay comint-last-prompt-overlay +;; prompt-start (point)) +;; ;; Need to create the overlay +;; (setq comint-last-prompt-overlay +;; (make-overlay prompt-start (point))) +;; (overlay-put comint-last-prompt-overlay +;; 'font-lock-face 'scomint-highlight-prompt)))) (goto-char saved-point))))))) diff --git a/lib/span.el b/lib/span.el index 5f87e015..aa1cf9a6 100644 --- a/lib/span.el +++ b/lib/span.el @@ -8,9 +8,9 @@ ;; $Id$ ;; ;;; Commentary: -;; +;; ;; Spans are our abstraction of extents/overlays. Nowadays -;; we implement them directly with overlays. +;; we implement them directly with overlays. ;; ;; In future this module should be used to implement the abstraction ;; for script buffers (only) more directly. @@ -56,7 +56,7 @@ Optional argument FUN is used in place of `span-give-warning'." (unless fun (setq fun 'span-give-warning)) (lexical-let ((fun fun)) (let ((funs (list (lambda (span afterp beg end &rest args) - (if (not afterp) (funcall fun beg end)))))) + (if (not afterp) (funcall fun beg end)))))) (span-set-property span 'modification-hooks funs) (span-set-property span 'insert-in-front-hooks funs)))) @@ -116,13 +116,13 @@ A span is before PT if it begins before the character before PT." ;; "Get the smallest". I have no idea what that means, so I just do ;; something somewhat random but vaguely meaningful. -Stef (car (last (sort ols 'span-lt))))) - + (defun prev-span (span prop) "Return span before SPAN with property PROP." (span-at-before (span-start span) prop)) ; overlays are [start, end) - + (defun next-span (span prop) "Return span after SPAN with property PROP." ;; Presuming the span-extents.el is the reference, its code does the same @@ -202,7 +202,7 @@ A span is before PT if it begins before the character before PT." ;; ;; Generic functions built on low-level concrete ones. -;; +;; (defsubst span-delete-spans (start end prop) "Delete all spans between START and END with property PROP set." @@ -211,7 +211,7 @@ A span is before PT if it begins before the character before PT." (defsubst span-property-safe (span name) "Like span-property, but return nil if SPAN is nil." (and span (span-property span name))) - + (defsubst span-set-start (span value) "Set the start point of SPAN to VALUE." (span-set-endpoints span value (span-end span))) diff --git a/lib/texi-docstring-magic.el b/lib/texi-docstring-magic.el index 5cb383b9..d95f12fc 100644 --- a/lib/texi-docstring-magic.el +++ b/lib/texi-docstring-magic.el @@ -10,7 +10,7 @@ ;; This file is distributed under the terms of the GNU General Public ;; License, Version 2. Find a copy of the GPL with your version of ;; GNU Emacs or Texinfo. -;; +;; ;; ;; This package generates Texinfo source fragments from Emacs ;; docstrings. This avoids documenting functions and variables in @@ -25,7 +25,7 @@ ;; * Arguments to functions should be written in upper case: ARG1..ARGN ;; * User options (variables users may want to set) should have docstrings ;; beginning with an asterisk. -;; +;; ;; Usage: ;; ;; Write comments of the form: @@ -38,7 +38,7 @@ ;; ;; This will insert @defopt, @deffn and the like underneath the ;; magic comment strings. -;; +;; ;; The default value for user options will be printed. ;; ;; Symbols are recognized if they are defined for faces, functions, @@ -47,7 +47,7 @@ ;; Automatic markup rules: ;; ;; 1. Indented lines are gathered into a @lisp environment. -;; 2. Pieces of text `stuff' or surrounded in quotes marked up with @samp. +;; 2. Pieces of text `stuff' or surrounded in quotes marked up with @samp. ;; 3. Words *emphasized* are made @strong{emphasized} ;; 4. Words sym-bol which are symbols become @code{sym-bol}. ;; 5. Upper cased words ARG corresponding to arguments become @var{arg}. @@ -67,7 +67,7 @@ ;; Useful enhancements to do: ;; ;; * Tweak replacement: at the moment it skips blank lines -;; under magic comment. +;; under magic comment. ;; * Use customize properties (e.g. group, simple types) ;; * Look for a "texi-docstring" property for symbols ;; so TeXInfo can be defined directly in case automatic markup @@ -80,7 +80,7 @@ ;; ;; Thanks to: Christoph Conrad for an Emacs compatibility fix. ;; -;; +;; (eval-when-compile (require 'cl)) @@ -174,17 +174,17 @@ ("\\(\\(^\\s-*$\\)\n@end lisp\\)" t "@end lisp") ;; 9. Hack to remove @samp{@var{...}} sequences. ;; Changed to just @samp of uppercase. - ("\\(@samp{@var{\\([^}]+\\)}}\\)" + ("\\(@samp{@var{\\([^}]+\\)}}\\)" t (concat "@samp{" (upcase (match-string 2 docstring)) "}"))) "Table of regexp matches and replacements used to markup docstrings. Format of table is a list of elements of the form (regexp predicate replacement-form) If regexp matches and predicate holds, then replacement-form is -evaluated to get the replacement for the match. +evaluated to get the replacement for the match. predicate and replacement-form can use variables arg, and forms such as (match-string 1 docstring) -Match string 1 is assumed to determine the +Match string 1 is assumed to determine the length of the matched item, hence where parsing restarts from. The replacement must cover the whole match (match string 0), including any whitespace included to delimit matches.") @@ -210,7 +210,7 @@ including any whitespace included to delimit matches.") (replace (nth 2 test)) (i 0) in-quoted-region) - + (while (and (< i (length docstring)) (string-match regexp docstring i)) @@ -228,14 +228,14 @@ including any whitespace included to delimit matches.") ;; if not already a new paragraph. (let* ((pos (string-match "\n" docstring)) - (needscr (and pos - (not (string= "\n" - (substring docstring - (1+ pos) + (needscr (and pos + (not (string= "\n" + (substring docstring + (1+ pos) (+ pos 2))))))) (if (and pos needscr) (concat (substring docstring 0 pos) - "@*\n" + "@*\n" (substring docstring (1+ pos))) docstring))) @@ -258,7 +258,7 @@ Markup as @code{stuff} or @lisp stuff @end lisp." ;; NB: might be nice to use a 'default-value-description ;; property here, in case the default value is computed. (let ((text (format "%S" default))) - (concat + (concat "\nThe default value is " (if (string-match "\n" text) ;; Carriage return will break @code, use @lisp @@ -266,7 +266,7 @@ Markup as @code{stuff} or @lisp stuff @end lisp." (concat "the string: \n@lisp\n" default "\n@end lisp\n") (concat "the value: \n@lisp\n" text "\n@end lisp\n")) (concat "@code{" text "}.\n"))))) - + (defun texi-docstring-magic-texi-for (symbol &optional noerror) (cond @@ -320,7 +320,7 @@ Markup as @code{stuff} or @lisp stuff @end lisp." (texi-docstring-magic-texi "fn" "Macro" name docstring args)) (t (texi-docstring-magic-texi "un" nil name docstring args))))) - (noerror + (noerror (message "Warning: symbol `%s' not defined" (symbol-name symbol)) "") (t @@ -360,7 +360,7 @@ With prefix arg, no errors on unknown symbols. (This results in (forward-line) (delete-region p (point)) (setq deleted t))) - (insert + (insert (texi-docstring-magic-texi-for symbol noerror)) (unless deleted ;; Follow newly inserted @def with a single blank. @@ -382,17 +382,17 @@ With prefix arg, no errors on unknown symbols. (This results in (set-syntax-table stab))))) (defun texi-docstring-magic-insert-magic (symbol) - (interactive + (interactive (let* ((v (or (variable-at-point) (and (fboundp 'function-at-point) (function-at-point)) (and (fboundp 'function-called-at-point) (function-called-at-point)) (texi-docstring-magic-face-at-point))) (val (let ((enable-recursive-minibuffers t)) - (completing-read + (completing-read (if v (format "Magic docstring for symbol (default %s): " v) "Magic docstring for symbol: ") - obarray '(lambda (sym) + obarray '(lambda (sym) (or (boundp sym) (fboundp sym) (texi-docstring-magic-find-face sym))) @@ -400,5 +400,5 @@ With prefix arg, no errors on unknown symbols. (This results in (list (if (equal val "") v (intern val))))) (insert "\n" texi-docstring-magic-comment " " (symbol-name symbol))) - + (provide 'texi-docstring-magic) diff --git a/lib/unicode-chars.el b/lib/unicode-chars.el index dfab97c9..5b566fb3 100644 --- a/lib/unicode-chars.el +++ b/lib/unicode-chars.el @@ -1,4 +1,4 @@ -;; unicode-chars.el --- table of Unicode characters +;; unicode-chars.el --- table of Unicode characters ;; ;; Author: David Aspinall ;; $Id$ @@ -5048,7 +5048,7 @@ ;; Modified a bit by me to use its own help-style buffer (defun unicode-chars-list-chars () - "Insert each Unicode character into a buffer. + "Insert each Unicode character into a buffer. Lets you see which characters are available for literal display in your emacs font." (interactive) diff --git a/mmm/mmm-auto.el b/mmm/mmm-auto.el index a994eb4f..8fd59580 100644 --- a/mmm/mmm-auto.el +++ b/mmm/mmm-auto.el @@ -94,7 +94,7 @@ invoked by a public class in the same file." ;; Don't autoload already defined classes (unless (assq class mmm-classes-alist) (add-to-list 'mmm-autoloaded-classes - (list class file private)))) + (list class file private)))) ;;}}} ;;{{{ Autoload Functions @@ -148,8 +148,8 @@ everything in `mmm-major-mode-hook' will be run." (dolist (buffer mmm-changed-buffers-list) (when (buffer-live-p buffer) (save-excursion - (set-buffer buffer) - (mmm-run-major-mode-hook)))) + (set-buffer buffer) + (mmm-run-major-mode-hook)))) (setq mmm-changed-buffers-list '())) (defun mmm-mode-on-maybe () @@ -157,8 +157,8 @@ everything in `mmm-major-mode-hook' will be run." Turn on MMM Mode if `global-mmm-mode' is non-nil and there are classes to apply, or always if `global-mmm-mode' is t." (cond ((eq mmm-global-mode t) (mmm-mode-on)) - ((not mmm-global-mode)) - ((mmm-get-all-classes nil) (mmm-mode-on))) + ((not mmm-global-mode)) + ((mmm-get-all-classes nil) (mmm-mode-on))) (when mmm-mode (mmm-update-font-lock-buffer))) diff --git a/mmm/mmm-class.el b/mmm/mmm-class.el index d79cdbbf..f1078883 100644 --- a/mmm/mmm-class.el +++ b/mmm/mmm-class.el @@ -44,14 +44,14 @@ CLASS can be either a symbol to look up in `mmm-classes-alist' or a class specifier itself." (cond ((symbolp class) ; A symbol must be looked up - (or (cdr (assq class mmm-classes-alist)) - (and (cadr (assq class mmm-autoloaded-classes)) - (load (cadr (assq class mmm-autoloaded-classes))) - (cdr (assq class mmm-classes-alist))) - (signal 'mmm-invalid-submode-class (list class)))) - ((listp class) ; A list must be a class spec - class) - (t (signal 'mmm-invalid-submode-class (list class))))) + (or (cdr (assq class mmm-classes-alist)) + (and (cadr (assq class mmm-autoloaded-classes)) + (load (cadr (assq class mmm-autoloaded-classes))) + (cdr (assq class mmm-classes-alist))) + (signal 'mmm-invalid-submode-class (list class)))) + ((listp class) ; A list must be a class spec + class) + (t (signal 'mmm-invalid-submode-class (list class))))) ;;}}} ;;{{{ Get and Set Class Parameters @@ -64,9 +64,9 @@ class specifier itself." "Set the value of the parameter PARAM for CLASS to VALUE. Creates a new parameter if one is not present." (let* ((spec (mmm-get-class-spec class)) - (current (member param spec))) + (current (member param spec))) (if current - (setcar (cdr current) value) + (setcar (cdr current) value) (nconc spec (list param value))))) ;;}}} @@ -81,8 +81,8 @@ none is specified by CLASS." ;; MMM Mode without applying any classes. (unless (eq class t) (apply #'mmm-ify :start start :stop stop - (append (mmm-get-class-spec class) - (list :face face))) + (append (mmm-get-class-spec class) + (list :face face))) (mmm-run-class-hook class) ;; Hack in case class hook sets mmm-buffer-mode-display-name etc. (mmm-set-mode-line))) @@ -96,11 +96,11 @@ error once all classes have been applied." (let (invalid-classes) (dolist (class classes) (condition-case err - (mmm-apply-class class start stop face) - (mmm-invalid-submode-class - ;; Save the name of the invalid class, so we can report them - ;; all together at the end. - (add-to-list 'invalid-classes (second err))))) + (mmm-apply-class class start stop face) + (mmm-invalid-submode-class + ;; Save the name of the invalid class, so we can report them + ;; all together at the end. + (add-to-list 'invalid-classes (second err))))) (when invalid-classes (signal 'mmm-invalid-submode-class invalid-classes)))) @@ -124,33 +124,33 @@ and interactive history." (defun* mmm-ify (&rest all &key classes handler submode match-submode - (start (point-min)) (stop (point-max)) - front back save-matches (case-fold-search t) - (beg-sticky (not (number-or-marker-p front))) - (end-sticky (not (number-or-marker-p back))) - include-front include-back - (front-offset 0) (back-offset 0) + (start (point-min)) (stop (point-max)) + front back save-matches (case-fold-search t) + (beg-sticky (not (number-or-marker-p front))) + (end-sticky (not (number-or-marker-p back))) + include-front include-back + (front-offset 0) (back-offset 0) (front-delim nil) (back-delim nil) (delimiter-mode mmm-delimiter-mode) front-face back-face - front-verify back-verify - front-form back-form + front-verify back-verify + front-form back-form creation-hook - face match-face + face match-face save-name match-name (front-match 0) (back-match 0) end-not-begin - ;insert private - &allow-other-keys - ) + ;insert private + &allow-other-keys + ) "Create submode regions from START to STOP according to arguments. If CLASSES is supplied, it must be a list of valid CLASSes. Otherwise, the rest of the arguments are for an actual class being applied. See `mmm-classes-alist' for information on what they all mean." ;; Make sure we get the default values in the `all' list. (setq all (append - all - (list :start start :stop stop + all + (list :start start :stop stop :beg-sticky beg-sticky :end-sticky end-sticky :front-offset front-offset :back-offset back-offset :front-delim front-delim :back-delim back-delim @@ -171,15 +171,15 @@ the rest of the arguments are for an actual class being applied. See (mmm-save-all (goto-char start) (loop for (beg end front-pos back-pos matched-front matched-back - matched-submode matched-face matched-name - invalid-resume ok-resume) = - (apply #'mmm-match-region :start (point) all) - while beg - if end ; match-submode, if present, succeeded. - do - (condition-case nil - (progn - (mmm-make-region + matched-submode matched-face matched-name + invalid-resume ok-resume) = + (apply #'mmm-match-region :start (point) all) + while beg + if end ; match-submode, if present, succeeded. + do + (condition-case nil + (progn + (mmm-make-region (or matched-submode submode) beg end :face (or matched-face face) :front front-pos :back back-pos @@ -192,24 +192,24 @@ the rest of the arguments are for an actual class being applied. See :creation-hook creation-hook ) (goto-char ok-resume)) - ;; If our region is invalid, go back to the end of the - ;; front match and continue on. - (mmm-error (goto-char invalid-resume))) - ;; If match-submode was unable to find a match, go back to - ;; the end of the front match and continue on. - else do (goto-char invalid-resume) - ))))) + ;; If our region is invalid, go back to the end of the + ;; front match and continue on. + (mmm-error (goto-char invalid-resume))) + ;; If match-submode was unable to find a match, go back to + ;; the end of the front match and continue on. + else do (goto-char invalid-resume) + ))))) ;;}}} ;;{{{ Match Regions (defun* mmm-match-region (&key start stop front back front-verify back-verify - include-front include-back front-offset back-offset - front-form back-form save-matches match-submode match-face + include-front include-back front-offset back-offset + front-form back-form save-matches match-submode match-face front-match back-match end-not-begin save-name match-name - &allow-other-keys) + &allow-other-keys) "Find the first valid region between point and STOP. Return \(BEG END FRONT-POS BACK-POS FRONT-FORM BACK-FORM SUBMODE FACE NAME INVALID-RESUME OK-RESUME) specifying the region. See @@ -223,46 +223,46 @@ and OK-RESUME if the region is valid." (front-pos (if front-delim (mmm-match->point t front-delim front-match) nil)) - (invalid-resume (match-end front-match)) - (front-form (mmm-get-form front-form))) + (invalid-resume (match-end front-match)) + (front-form (mmm-get-form front-form))) (let ((submode (if match-submode - (condition-case nil - (mmm-save-all - (funcall match-submode front-form)) - (mmm-no-matching-submode - (return-from - mmm-match-region - (values beg nil nil nil nil nil nil nil nil - invalid-resume nil)))) - nil)) + (condition-case nil + (mmm-save-all + (funcall match-submode front-form)) + (mmm-no-matching-submode + (return-from + mmm-match-region + (values beg nil nil nil nil nil nil nil nil + invalid-resume nil)))) + nil)) (name (cond ((functionp match-name) (mmm-save-all (funcall match-name front-form))) ((stringp match-name) (if save-name (mmm-format-matches match-name) match-name)))) - (face (cond ((functionp match-face) - (mmm-save-all - (funcall match-face front-form))) - (match-face - (cdr (assoc front-form match-face)))))) - (when (mmm-match-and-verify - (if save-matches - (mmm-format-matches back) - back) - beg stop back-verify) - (let* ((end (mmm-match->point (not include-back) + (face (cond ((functionp match-face) + (mmm-save-all + (funcall match-face front-form))) + (match-face + (cdr (assoc front-form match-face)))))) + (when (mmm-match-and-verify + (if save-matches + (mmm-format-matches back) + back) + beg stop back-verify) + (let* ((end (mmm-match->point (not include-back) back-offset back-match)) (back-pos (if back-delim (mmm-match->point nil back-delim back-match) nil)) (back-form (mmm-get-form back-form)) - (ok-resume (if end-not-begin + (ok-resume (if end-not-begin (match-end back-match) end))) - (values beg end front-pos back-pos front-form back-form + (values beg end front-pos back-pos front-form back-form submode face name - invalid-resume ok-resume))))))) + invalid-resume ok-resume))))))) (defun mmm-match->point (beginp offset match) "Find a point of starting or stopping from the match data. If @@ -274,8 +274,8 @@ and move OFFSET. Handles all values of OFFSET--see `mmm-classes-alist'." (match-end back-match))) (dolist (spec (if (listp offset) offset (list offset))) (if (numberp spec) - (forward-char (or spec 0)) - (funcall spec))) + (forward-char (or spec 0)) + (funcall spec))) (point))) (defun mmm-match-and-verify (pos start stop &optional verify) @@ -296,7 +296,7 @@ unless POS is a regexp." ;; Strings are searched for as regexps. ((stringp pos) (loop always (re-search-forward pos stop 'limit) - until (or (not verify) (mmm-save-all (funcall verify))))) + until (or (not verify) (mmm-save-all (funcall verify))))) ;; Otherwise it must be a function. ((functionp pos) (funcall pos stop)))) @@ -311,9 +311,9 @@ return it. If FORM is a function, call it. If FORM is a list, return its `car' \(usually in this case, FORM is a one-element list containing a function to be used as the delimiter form." (cond ((stringp form) form) - ((not form) (mmm-default-get-form)) - ((functionp form) (mmm-save-all (funcall form))) - ((listp form) (car form)))) + ((not form) (mmm-default-get-form)) + ((functionp form) (mmm-save-all (funcall form))) + ((listp form) (car form)))) (defun mmm-default-get-form () (regexp-quote (match-string 0))) diff --git a/mmm/mmm-cmds.el b/mmm/mmm-cmds.el index c564fe89..f39da066 100644 --- a/mmm/mmm-cmds.el +++ b/mmm/mmm-cmds.el @@ -42,16 +42,16 @@ "Add submode regions according to an existing submode class." (interactive (list (intern - (completing-read - "Submode Class: " - (remove-duplicates - (mapcar #'(lambda (spec) (list (symbol-name (car spec)))) - (append - (remove-if #'(lambda (spec) (plist-get (cdr spec) :private)) - mmm-classes-alist) - (remove-if #'caddr mmm-autoloaded-classes))) - :test #'equal) - nil t)))) + (completing-read + "Submode Class: " + (remove-duplicates + (mapcar #'(lambda (spec) (list (symbol-name (car spec)))) + (append + (remove-if #'(lambda (spec) (plist-get (cdr spec) :private)) + mmm-classes-alist) + (remove-if #'caddr mmm-autoloaded-classes))) + :test #'equal) + nil t)))) (unless (eq class (intern "")) (mmm-apply-class class) (mmm-add-to-history class) @@ -65,7 +65,7 @@ (interactive "aSubmode: \nr") (mmm-ify :submode submode :front front :back back) (setq front (mmm-make-marker front t nil) - back (mmm-make-marker back nil nil)) + back (mmm-make-marker back nil nil)) (mmm-add-to-history `(:submode ,submode :front ,front :back ,back)) (mmm-enable-font-lock submode)) @@ -77,14 +77,14 @@ "Add SUBMODE regions to the buffer delimited by FRONT and BACK. With prefix argument, prompts for all additional keywords arguments. See `mmm-classes-alist'." - (interactive "aSubmode: -sFront Regexp: -nOffset from Front Regexp: -sBack Regexp: -nOffset from Back Regexp: + (interactive "aSubmode: +sFront Regexp: +nOffset from Front Regexp: +sBack Regexp: +nOffset from Back Regexp: nNumber of matched substrings to save: ") (let ((args (mmm-save-keywords submode front back front-offset - back-offset save-matches))) + back-offset save-matches))) (apply #'mmm-ify args) (mmm-add-to-history args)) (mmm-enable-font-lock submode)) @@ -132,13 +132,13 @@ delimiter auto-insertion that MMM Mode provides. See, for example, (defun mmm-get-block (lines) (let ((inhibit-point-motion-hooks t)) (list (save-excursion - (forward-line (- lines)) - (beginning-of-line) - (point)) - (save-excursion - (forward-line lines) - (end-of-line) - (point))))) + (forward-line (- lines)) + (beginning-of-line) + (point)) + (save-excursion + (forward-line lines) + (end-of-line) + (point))))) ;;}}} ;;{{{ Reparse Current Region @@ -150,14 +150,14 @@ Use this command if a submode region's boundaries have become wrong." (let ((ovl (mmm-overlay-at (point) 'all))) (when ovl (let ((beg (save-excursion - (goto-char (mmm-front-start ovl)) - (forward-line -1) - (point))) - (end (save-excursion - (goto-char (mmm-back-end ovl)) - (forward-line 1) - (point)))) - (mmm-parse-region beg end))))) + (goto-char (mmm-front-start ovl)) + (forward-line -1) + (point))) + (end (save-excursion + (goto-char (mmm-back-end ovl)) + (forward-line 1) + (point)))) + (mmm-parse-region beg end))))) ;;}}} ;;{{{ Clear Submode Regions @@ -197,22 +197,22 @@ entire job of this function." (let ((ovl (mmm-overlay-at))) (when ovl (combine-after-change-calls - (save-match-data - (save-excursion - (when (mmm-match-back ovl) - (if arg - (replace-match "") - (return-from mmm-end-current-region))))) - (let ((back (overlay-get ovl 'back))) - (cond ((stringp back) - (save-excursion - (unless arg (goto-char (overlay-end ovl))) - (save-excursion (insert back)) - (move-overlay ovl (overlay-start ovl) (point)))) - ((functionp back) - (funcall back ovl (if arg 'middle t)))))) + (save-match-data + (save-excursion + (when (mmm-match-back ovl) + (if arg + (replace-match "") + (return-from mmm-end-current-region))))) + (let ((back (overlay-get ovl 'back))) + (cond ((stringp back) + (save-excursion + (unless arg (goto-char (overlay-end ovl))) + (save-excursion (insert back)) + (move-overlay ovl (overlay-start ovl) (point)))) + ((functionp back) + (funcall back ovl (if arg 'middle t)))))) (mmm-refontify-maybe (save-excursion (forward-line -1) (point)) - (save-excursion (forward-line 1) (point)))))) + (save-excursion (forward-line 1) (point)))))) ;;}}} ;;{{{ Narrow to Region @@ -246,14 +246,14 @@ find an insert skeleton. For example, in Mason, `p' \(with appropriate prefix and modifiers) will insert a <%perl>...</%perl> region." (interactive "P") (let* ((seq (this-command-keys)) - (event (aref seq (1- (length seq)))) - (mods (event-modifiers event)) - (key (mmm-event-key event))) + (event (aref seq (1- (length seq)))) + (mods (event-modifiers event)) + (key (mmm-event-key event))) (if (subsetp mmm-insert-modifiers mods) - (mmm-insert-by-key - (append (set-difference mods mmm-insert-modifiers) - key) - arg)))) + (mmm-insert-by-key + (append (set-difference mods mmm-insert-modifiers) + key) + arg)))) (defun mmm-insert-by-key (key &optional arg) "Insert a submode region based on event KEY. @@ -268,18 +268,18 @@ MODIFIERS, the dotted list becomes simply BASIC-KEY." (multiple-value-bind (class skel str) (mmm-get-insertion-spec key) (when skel (let ((after-change-functions nil) - (old-undo buffer-undo-list) undo + (old-undo buffer-undo-list) undo ;; da: Proof General patch for compatibility with holes.el, ;; bind this variable to prevent inserting holes here. mmm-inside-insert-by-key) - ;; XEmacs' skeleton doesn't manage positions by itself, so we - ;; have to do it. - (if mmm-xemacs (setq skeleton-positions nil)) - (skeleton-proxy-new skel str arg) - (destructuring-bind (back end beg front) skeleton-positions - ;; TODO: Find a way to trap invalid-parent signals from - ;; make-region and undo the skeleton insertion. - (let ((match-submode (plist-get class :match-submode)) + ;; XEmacs' skeleton doesn't manage positions by itself, so we + ;; have to do it. + (if mmm-xemacs (setq skeleton-positions nil)) + (skeleton-proxy-new skel str arg) + (destructuring-bind (back end beg front) skeleton-positions + ;; TODO: Find a way to trap invalid-parent signals from + ;; make-region and undo the skeleton insertion. + (let ((match-submode (plist-get class :match-submode)) (match-face (plist-get class :match-face)) (match-name (plist-get class :match-name)) (front-form (regexp-quote (buffer-substring front beg))) @@ -291,13 +291,13 @@ MODIFIERS, the dotted list becomes simply BASIC-KEY." (mmm-save-all (funcall match-submode front-form)) (plist-get class :submode)))) (setq face - (cond ((functionp match-face) - (mmm-save-all - (funcall match-face front-form))) - (match-face - (cdr (assoc front-form match-face))) - (t - (plist-get class :face)))) + (cond ((functionp match-face) + (mmm-save-all + (funcall match-face front-form))) + (match-face + (cdr (assoc front-form match-face))) + (t + (plist-get class :face)))) (setq name (cond ((plist-get class :skel-name) ;; Optimize the name to the user-supplied str @@ -318,8 +318,8 @@ MODIFIERS, the dotted list becomes simply BASIC-KEY." (t ;; No, just use it as-is match-name))) - (mmm-make-region - submode beg end + (mmm-make-region + submode beg end :face face :name name :front front :back back @@ -327,17 +327,17 @@ MODIFIERS, the dotted list becomes simply BASIC-KEY." :evaporation 'front ;;; :beg-sticky (plist-get class :beg-sticky) ;;; :end-sticky (plist-get class :end-sticky) - :beg-sticky t :end-sticky t - :creation-hook (plist-get class :creation-hook)) - (mmm-enable-font-lock submode))) - ;; Now get rid of intermediate undo boundaries, so that the entire - ;; insertion can be undone as one action. This should really be - ;; skeleton's job, but it doesn't do it. - (setq undo buffer-undo-list) - (while (not (eq (cdr undo) old-undo)) - (when (eq (cadr undo) nil) - (setcdr undo (cddr undo))) - (setq undo (cdr undo))))))) + :beg-sticky t :end-sticky t + :creation-hook (plist-get class :creation-hook)) + (mmm-enable-font-lock submode))) + ;; Now get rid of intermediate undo boundaries, so that the entire + ;; insertion can be undone as one action. This should really be + ;; skeleton's job, but it doesn't do it. + (setq undo buffer-undo-list) + (while (not (eq (cdr undo) old-undo)) + (when (eq (cadr undo) nil) + (setcdr undo (cddr undo))) + (setq undo (cdr undo))))))) (defun mmm-get-insertion-spec (key &optional classlist) "Get the insertion info for KEY from all classes in CLASSLIST. @@ -346,22 +346,22 @@ found in, SKEL is the skeleton to insert, and STR is the argument. CLASSLIST defaults to the return value of `mmm-get-all-classes', including global classes." (loop for classname in (or classlist (mmm-get-all-classes t)) - for class = (mmm-get-class-spec classname) - for inserts = (plist-get class :insert) - for skel = (cddr (assoc key inserts)) - with str - ;; If SKEL is a dotted pair, it means call another key's - ;; insertion spec with an argument. - unless (consp (cdr skel)) - do (setq str (cdr skel) - skel (cddr (assoc (car skel) inserts))) - if skel return (list class skel str) - ;; If we have a group class, recurse. - if (plist-get class :classes) - if (mmm-get-insertion-spec key it) - return it - else - return nil)) + for class = (mmm-get-class-spec classname) + for inserts = (plist-get class :insert) + for skel = (cddr (assoc key inserts)) + with str + ;; If SKEL is a dotted pair, it means call another key's + ;; insertion spec with an argument. + unless (consp (cdr skel)) + do (setq str (cdr skel) + skel (cddr (assoc (car skel) inserts))) + if skel return (list class skel str) + ;; If we have a group class, recurse. + if (plist-get class :classes) + if (mmm-get-insertion-spec key it) + return it + else + return nil)) ;;}}} ;;{{{ Help on Insertion @@ -374,20 +374,20 @@ including global classes." (princ "Key Inserts\n") (princ "--- -------\n\n") (mapcar #'mmm-display-insertion-key - (mmm-get-all-insertion-keys)))) + (mmm-get-all-insertion-keys)))) (defun mmm-display-insertion-key (spec) "Print an insertion binding to standard output. SPEC should be \(KEY NAME ...) where KEY is an insertion key and NAME is a symbol naming the insertion." (let* ((str (make-string 16 ?\ )) - ;; This gets us a dotted list, because of the way insertion - ;; keys are specified. - (key (append mmm-insert-modifiers (car spec))) - (lastkey (nthcdr (max (1- (safe-length key)) 0) key))) + ;; This gets us a dotted list, because of the way insertion + ;; keys are specified. + (key (append mmm-insert-modifiers (car spec))) + (lastkey (nthcdr (max (1- (safe-length key)) 0) key))) ;; Now we make it a true list (if (consp key) - (setcdr lastkey (list (cdr lastkey))) + (setcdr lastkey (list (cdr lastkey))) (setq key (list key))) ;; Get the spacing right (store-substring str 0 @@ -404,12 +404,12 @@ Elements look like \(KEY NAME ...) where KEY is an insertion key and NAME is a symbol naming the insertion." (remove-duplicates (loop for classname in (or classlist (mmm-get-all-classes t)) - for class = (mmm-get-class-spec classname) - append (plist-get class :insert) into keys - ;; If we have a group class, recurse. - if (plist-get class :classes) - do (setq keys (append keys (mmm-get-all-insertion-keys it))) - finally return keys) + for class = (mmm-get-class-spec classname) + append (plist-get class :insert) into keys + ;; If we have a group class, recurse. + if (plist-get class :classes) + do (setq keys (append keys (mmm-get-all-insertion-keys it))) + finally return keys) :test #'equal :key #'(lambda (x) (cons (car x) (cadr x))) :from-end t)) diff --git a/mmm/mmm-compat.el b/mmm/mmm-compat.el index bb22446b..096233c6 100644 --- a/mmm/mmm-compat.el +++ b/mmm/mmm-compat.el @@ -54,20 +54,20 @@ (set keyword keyword)) ;;}}} -;;{{{ Customization (Emacs 19) +;;{{{ Customization (Emacs 19) (condition-case () (require 'custom) (error nil)) (unless (and (featurep 'custom) - (fboundp 'custom-declare-variable)) + (fboundp 'custom-declare-variable)) (defmacro defgroup (&rest args) nil) ;; da: backquote syntax updated, so not Emacs <19.29 compatible (defmacro defface (var values doc &rest args) `(make-face (quote ,var))) - (defmacro defcustom (var value doc &rest args) + (defmacro defcustom (var value doc &rest args) `(defvar ,var ,value ,doc))) ;;}}} @@ -78,12 +78,12 @@ (error nil)) (unless (and (featurep 'regexp-opt) - (fboundp 'regexp-opt)) + (fboundp 'regexp-opt)) ;; No regexp-opt; create one (defun regexp-opt (strings &optional paren) (concat (if paren "\\(" "") - (mapconcat 'regexp-quote strings "\\|") - (if paren "\\)" "")))) + (mapconcat 'regexp-quote strings "\\|") + (if paren "\\)" "")))) ;;}}} ;;{{{ Regexp-Opt (XEmacs) @@ -151,7 +151,7 @@ This makes `@' in skeletons act approximately like it does in FSF." (defvar skeleton-further-elements ()) (not (assoc '@ skeleton-further-elements)) (add-to-list 'skeleton-further-elements - '(@ ''(push (point) skeleton-positions))))) + '(@ ''(push (point) skeleton-positions))))) ;;}}} ;;{{{ Make Temp Buffers (XEmacs) diff --git a/mmm/mmm-mason.el b/mmm/mmm-mason.el index a0f57387..62f0642a 100644 --- a/mmm/mmm-mason.el +++ b/mmm/mmm-mason.el @@ -76,7 +76,7 @@ Saves the name of the tag matched.") :front "<%text>" :back "</%text>" :insert ((?t mason-<%text> nil @ "<%text>" @ "\n" - _ "\n" @ "</%text>" @))) + _ "\n" @ "</%text>" @))) (mason-doc :submode text-mode :face mmm-comment-submode-face @@ -84,29 +84,29 @@ Saves the name of the tag matched.") :back "</%doc>" :face nil :insert ((?d mason-<%doc> nil @ "<%doc>" @ "\n" - _ "\n" @ "</%doc>" @))) + _ "\n" @ "</%doc>" @))) (mason-perl :submode perl :match-face (("<%perl>" . mmm-code-submode-face) - ("<%init>" . mmm-init-submode-face) - ("<%cleanup>" . mmm-cleanup-submode-face) - ("<%once>" . mmm-init-submode-face) - ("<%filter>" . mmm-special-submode-face) - ("<%shared>" . mmm-init-submode-face)) + ("<%init>" . mmm-init-submode-face) + ("<%cleanup>" . mmm-cleanup-submode-face) + ("<%once>" . mmm-init-submode-face) + ("<%filter>" . mmm-special-submode-face) + ("<%shared>" . mmm-init-submode-face)) :front ,mmm-mason-perl-tags-regexp :back "</%~1>" :save-matches 1 :match-name "~1" :save-name 1 :insert ((?, mason-<%TAG> "Perl section: " @ "<%" str ">" @ - ";\n" _ "\n" @ "</%" str ">" @) - (?< mason-<%TAG> ?, . nil) - (?p mason-<%perl> ?, . "perl") - (?i mason-<%init> ?, . "init") - (?c mason-<%cleanup> ?, . "cleanup") - (?o mason-<%once> ?, . "once") - (?l mason-<%filter> ?, . "filter") - (?s mason-<%shared> ?, . "shared"))) + ";\n" _ "\n" @ "</%" str ">" @) + (?< mason-<%TAG> ?, . nil) + (?p mason-<%perl> ?, . "perl") + (?i mason-<%init> ?, . "init") + (?c mason-<%cleanup> ?, . "cleanup") + (?o mason-<%once> ?, . "once") + (?l mason-<%filter> ?, . "filter") + (?s mason-<%shared> ?, . "shared"))) (mason-pseudo-perl :submode perl :face mmm-declaration-submode-face @@ -114,11 +114,11 @@ Saves the name of the tag matched.") :back "</%~1>" :save-matches 1 :insert ((?. mason-pseudo-<%TAG> "Pseudo-perl section: " @ "<%" str ">" @ - "\n" _ "\n" @ "</%" str ">" @) - (?> mason-pseudo-<%TAG> ?, . nil) - (?a mason-<%args> ?. . "args") - (?f mason-<%flags> ?. . "flags") - (?r mason-<%attr> ?. . "attr"))) + "\n" _ "\n" @ "</%" str ">" @) + (?> mason-pseudo-<%TAG> ?, . nil) + (?a mason-<%args> ?. . "args") + (?f mason-<%flags> ?. . "flags") + (?r mason-<%attr> ?. . "attr"))) (mason-inline :submode perl :face mmm-output-submode-face @@ -126,29 +126,29 @@ Saves the name of the tag matched.") :front-verify mmm-mason-verify-inline :back "%>" :insert ((?% mason-<%-%> nil @ "<%" @ " " _ " " @ "%>" @) - (?5 mason-<%-%> ?% . nil))) + (?5 mason-<%-%> ?% . nil))) (mason-call :submode perl :face mmm-special-submode-face :front "<&" :back "&>" :insert ((?& mason-<&-&> nil @ "<&" @ " " _ " " @ "&>" @) - (?7 mason-<&-&> ?% . nil))) + (?7 mason-<&-&> ?% . nil))) (mason-one-line-comment :submode text-mode :face mmm-comment-submode-face :front "^%#" :back "\n" :insert ((?# mason-%-comment nil (mmm-mason-start-line) - @ "%" @ "# " _ @ '(mmm-mason-end-line) "\n" @) - (?3 mason-%-comment ?# . nil))) + @ "%" @ "# " _ @ '(mmm-mason-end-line) "\n" @) + (?3 mason-%-comment ?# . nil))) (mason-one-line :submode perl :face mmm-code-submode-face :front "^%" :back "\n" :insert ((return mason-%-line nil (mmm-mason-start-line) - @ "%" @ " " _ @ '(mmm-mason-end-line) "\n" @))))) + @ "%" @ " " _ @ '(mmm-mason-end-line) "\n" @))))) ;;}}} ;;{{{ One-line Sections diff --git a/mmm/mmm-mode.el b/mmm/mmm-mode.el index d133b831..cce9b7e2 100644 --- a/mmm/mmm-mode.el +++ b/mmm/mmm-mode.el @@ -151,9 +151,9 @@ available through M-x customize under Programming | Tools | Mmm." (c-make-styles-buffer-local t)) (mmm-update-mode-info major-mode) (setq mmm-region-saved-locals-for-dominant - (list* (list 'font-lock-cache-state nil) - (list 'font-lock-cache-position (make-marker)) - (copy-tree (cdr (assq major-mode mmm-region-saved-locals-defaults))))) + (list* (list 'font-lock-cache-state nil) + (list 'font-lock-cache-position (make-marker)) + (copy-tree (cdr (assq major-mode mmm-region-saved-locals-defaults))))) ;; Without the next line, the (make-marker) above gets replaced ;; with the starting value of nil, and all comes to naught. (mmm-set-local-variables major-mode) @@ -162,16 +162,16 @@ available through M-x customize under Programming | Tools | Mmm." (make-local-variable 'font-lock-fontify-region-function) (make-local-variable 'font-lock-beginning-of-syntax-function) (setq font-lock-fontify-region-function 'mmm-fontify-region - font-lock-beginning-of-syntax-function 'mmm-beginning-of-syntax) + font-lock-beginning-of-syntax-function 'mmm-beginning-of-syntax) (setq mmm-mode t) (condition-case err - (mmm-apply-all) + (mmm-apply-all) (mmm-error - ;; Complain, but don't die, since we want files to go ahead - ;; and be opened anyway, and the mode to go ahead and be - ;; turned on. Should we delete all previously made submode - ;; regions when we find an invalid one? - (message "%s" (error-message-string err)))) + ;; Complain, but don't die, since we want files to go ahead + ;; and be opened anyway, and the mode to go ahead and be + ;; turned on. Should we delete all previously made submode + ;; regions when we find an invalid one? + (message "%s" (error-message-string err)))) (run-hooks 'mmm-mode-hook) (mmm-run-major-hook)))) @@ -189,9 +189,9 @@ available through M-x customize under Programming | Tools | Mmm." (mmm-clear-local-variables) (mmm-update-submode-region) (setq font-lock-fontify-region-function - (get mmm-primary-mode 'mmm-fontify-region-function) - font-lock-beginning-of-syntax-function - (get mmm-primary-mode 'mmm-beginning-of-syntax-function)) + (get mmm-primary-mode 'mmm-fontify-region-function) + font-lock-beginning-of-syntax-function + (get mmm-primary-mode 'mmm-beginning-of-syntax-function)) (mmm-update-font-lock-buffer) (mmm-refontify-maybe) (setq mmm-mode nil) diff --git a/mmm/mmm-noweb.el b/mmm/mmm-noweb.el index ec0e5d3e..ce8cb611 100644 --- a/mmm/mmm-noweb.el +++ b/mmm/mmm-noweb.el @@ -7,7 +7,7 @@ ;; noweb-mode.el - edit noweb files with GNU Emacs ;; Copyright 1995 by Thorsten.Ohl @ Physik.TH-Darmstadt.de ;; with a little help from Norman Ramsey <norman@bellcore.com> -;; +;; ;;{{{ GPL diff --git a/mmm/mmm-region.el b/mmm/mmm-region.el index d1622a52..15b71886 100644 --- a/mmm/mmm-region.el +++ b/mmm/mmm-region.el @@ -149,8 +149,8 @@ attention is paid to stickiness." (defun mmm-sort-overlays (overlays) "Sort OVERLAYS in order of decreasing priority." (sort (copy-list overlays) - #'(lambda (x y) (> (or (overlay-get x 'priority) 0) - (or (overlay-get y 'priority) 0))))) + #'(lambda (x y) (> (or (overlay-get x 'priority) 0) + (or (overlay-get y 'priority) 0))))) ;;}}} ;;{{{ Current Submode @@ -188,11 +188,11 @@ have disappeared." (mmm-overlays-at pos))) (let ((ovl (mmm-overlay-at pos))) (if (eq ovl mmm-current-overlay) - nil + nil (setq mmm-previous-overlay mmm-current-overlay - mmm-previous-submode mmm-current-submode) + mmm-previous-submode mmm-current-submode) (setq mmm-current-overlay ovl - mmm-current-submode (if ovl (overlay-get ovl 'mmm-mode))) + mmm-current-submode (if ovl (overlay-get ovl 'mmm-mode))) t))) ;; This function is, I think, mostly for hacking font-lock. @@ -200,12 +200,12 @@ have disappeared." "Set the current submode to MODE and the current region to whatever region of that mode is present at POS, or nil if none." (setq mmm-previous-overlay mmm-current-overlay - mmm-previous-submode mmm-current-submode) + mmm-previous-submode mmm-current-submode) (setq mmm-current-submode mode - mmm-current-overlay - (find-if #'(lambda (ovl) - (eq (overlay-get ovl 'mmm-mode) mode)) - (mmm-overlays-at (or pos (point)) 'all)))) + mmm-current-overlay + (find-if #'(lambda (ovl) + (eq (overlay-get ovl 'mmm-mode) mode)) + (mmm-overlays-at (or pos (point)) 'all)))) (defun mmm-submode-at (&optional pos type) "Return the submode at POS \(or point), or NIL if none. @@ -308,9 +308,9 @@ Signals errors, returns `t' if no error." delimiter-mode front-face back-face display-name (match-front "") (match-back "") - (beg-sticky t) (end-sticky t) + (beg-sticky t) (end-sticky t) name creation-hook - ) + ) "Make a submode region from BEG to END of SUBMODE. BEG and END are buffer positions or markers with BEG <= END \(although @@ -424,7 +424,7 @@ with point at the start of the new region." (funcall creation-hook)) (mmm-save-changed-local-variables region-ovl submode)) (setq mmm-previous-submode submode - mmm-previous-overlay region-ovl) + mmm-previous-overlay region-ovl) (mmm-update-submode-region) region-ovl)) @@ -470,7 +470,7 @@ Does not handle delimiters. Use `mmm-make-region'." (defun mmm-clear-overlays (&optional start stop strict) "Clears all MMM overlays overlapping START and STOP. If STRICT, only clear those entirely included in that region." - (mapcar #'delete-overlay + (mapc #'delete-overlay (if strict (mmm-overlays-contained-in (or start (point-min)) (or stop (point-max))) @@ -492,78 +492,79 @@ variables are initialized from `mmm-region-saved-locals-defaults', which is set here as well. See `mmm-save-local-variables'. If FORCE is non-nil, don't quit if the info is already there." (let ((buffer-entry (assq mode mmm-buffer-saved-locals)) - (region-entry (assq mode mmm-region-saved-locals-defaults)) - global-vars buffer-vars region-vars - ;; kludge for XEmacs 20 - (html-helper-build-new-buffer nil)) + (region-entry (assq mode mmm-region-saved-locals-defaults)) + global-vars buffer-vars region-vars + ;; kludge for XEmacs 20 + (html-helper-build-new-buffer nil)) (unless (and (not force) - (get mode 'mmm-local-variables) - buffer-entry - region-entry) + (get mode 'mmm-local-variables) + buffer-entry + region-entry) (save-excursion - (let ((filename (buffer-file-name))) - ;; On errors, the temporary buffers don't get deleted, so here - ;; we get rid of any old ones that may be hanging around. - (when (buffer-live-p (get-buffer mmm-temp-buffer-name)) - (save-excursion - (set-buffer (get-buffer mmm-temp-buffer-name)) - (set-buffer-modified-p nil) - (kill-buffer (current-buffer)))) - ;; Now make a new temporary buffer. - (set-buffer (mmm-make-temp-buffer (current-buffer) - mmm-temp-buffer-name)) + (let ((filename (buffer-file-name))) + ;; On errors, the temporary buffers don't get deleted, so here + ;; we get rid of any old ones that may be hanging around. + (when (buffer-live-p (get-buffer mmm-temp-buffer-name)) + (save-excursion + (set-buffer (get-buffer mmm-temp-buffer-name)) + (set-buffer-modified-p nil) + (kill-buffer (current-buffer)))) + ;; Now make a new temporary buffer. + (set-buffer (mmm-make-temp-buffer (current-buffer) + mmm-temp-buffer-name)) ;; Handle stupid modes that need the file name set - (if (memq mode mmm-set-file-name-for-modes) - (setq buffer-file-name filename))) - (funcall mode) - (when (featurep 'font-lock) - ;; XEmacs doesn't have global-font-lock-mode (or rather, it - ;; has nothing but global-font-lock-mode). - (when (or mmm-xemacs - ;; Code copied from font-lock.el to detect when font-lock - ;; should be on via global-font-lock-mode. - (and (or font-lock-defaults - (assq major-mode font-lock-defaults-alist) - (assq major-mode font-lock-keywords-alist)) - (or (eq font-lock-global-modes t) - (if (eq (car-safe font-lock-global-modes) 'not) - (not (memq major-mode - (cdr font-lock-global-modes))) - (memq major-mode font-lock-global-modes))))) - ;; Don't actually fontify in the temp buffer, but note - ;; that we should fontify when we use this mode. - (put mode 'mmm-font-lock-mode t)) - ;; Get the font-lock variables - (when mmm-font-lock-available-p - ;; To fool `font-lock-add-keywords' - (let ((font-lock-mode t)) - (mmm-set-font-lock-defaults))) - ;; These can't be in the local variables list, because we - ;; replace their actual values, but we want to use their - ;; original values elsewhere. - (unless (and mmm-xemacs (= emacs-major-version 20)) - ;; XEmacs 20 doesn't have this variable. This effectively - ;; prevents the MMM font-lock support from working, but we - ;; just ignore it and go on, to prevent an error message. - (put mode 'mmm-fontify-region-function - font-lock-fontify-region-function)) - (put mode 'mmm-beginning-of-syntax-function - font-lock-beginning-of-syntax-function)) - ;; Get variables - (setq global-vars (mmm-get-locals 'global) - buffer-vars (mmm-get-locals 'buffer) - region-vars (mmm-get-locals 'region)) - (put mode 'mmm-mode-name mode-name) - (set-buffer-modified-p nil) - (kill-buffer (current-buffer))) + (if (memq mode mmm-set-file-name-for-modes) + (setq buffer-file-name filename))) + (funcall mode) + (when (featurep 'font-lock) + ;; XEmacs doesn't have global-font-lock-mode (or rather, it + ;; has nothing but global-font-lock-mode). + (when (or mmm-xemacs + ;; Code copied from font-lock.el to detect when font-lock + ;; should be on via global-font-lock-mode. + (and (or font-lock-defaults + (with-no-warnings + (assq major-mode font-lock-defaults-alist)) + (assq major-mode font-lock-keywords-alist)) + (or (eq font-lock-global-modes t) + (if (eq (car-safe font-lock-global-modes) 'not) + (not (memq major-mode + (cdr font-lock-global-modes))) + (memq major-mode font-lock-global-modes))))) + ;; Don't actually fontify in the temp buffer, but note + ;; that we should fontify when we use this mode. + (put mode 'mmm-font-lock-mode t)) + ;; Get the font-lock variables + (when mmm-font-lock-available-p + ;; To fool `font-lock-add-keywords' + (let ((font-lock-mode t)) + (mmm-set-font-lock-defaults))) + ;; These can't be in the local variables list, because we + ;; replace their actual values, but we want to use their + ;; original values elsewhere. + (unless (and mmm-xemacs (= emacs-major-version 20)) + ;; XEmacs 20 doesn't have this variable. This effectively + ;; prevents the MMM font-lock support from working, but we + ;; just ignore it and go on, to prevent an error message. + (put mode 'mmm-fontify-region-function + font-lock-fontify-region-function)) + (put mode 'mmm-beginning-of-syntax-function + font-lock-beginning-of-syntax-function)) + ;; Get variables + (setq global-vars (mmm-get-locals 'global) + buffer-vars (mmm-get-locals 'buffer) + region-vars (mmm-get-locals 'region)) + (put mode 'mmm-mode-name mode-name) + (set-buffer-modified-p nil) + (kill-buffer (current-buffer))) (put mode 'mmm-local-variables global-vars) (if buffer-entry - (setcdr buffer-entry buffer-vars) - (push (cons mode buffer-vars) mmm-buffer-saved-locals)) + (setcdr buffer-entry buffer-vars) + (push (cons mode buffer-vars) mmm-buffer-saved-locals)) (if region-entry - (setcdr region-entry region-vars) - (push (cons mode region-vars) - mmm-region-saved-locals-defaults))))) + (setcdr region-entry region-vars) + (push (cons mode region-vars) + mmm-region-saved-locals-defaults))))) ;;}}} ;;{{{ Updating Hooks @@ -574,7 +575,7 @@ This function and those it calls do the actual work of setting the different keymaps, syntax tables, local variables, etc. for submodes." (when (mmm-update-current-submode) (mmm-save-changed-local-variables mmm-previous-overlay - mmm-previous-submode) + mmm-previous-submode) (let ((mode (or mmm-current-submode mmm-primary-mode))) (mmm-update-mode-info mode) (mmm-set-local-variables mode) @@ -586,8 +587,7 @@ different keymaps, syntax tables, local variables, etc. for submodes." (ignore-errors (funcall func))))) (defun mmm-add-hooks () - (make-local-hook 'post-command-hook) - (add-hook 'post-command-hook 'mmm-update-submode-region nil 'local)) + (add-hook 'post-command-hook 'mmm-update-submode-region nil 'local)) (defun mmm-remove-hooks () (remove-hook 'post-command-hook 'mmm-update-submode-region 'local)) @@ -600,33 +600,33 @@ different keymaps, syntax tables, local variables, etc. for submodes." Return a list \(VAR ...). In some cases, VAR will be a cons cell \(GETTER . SETTER) -- see `mmm-save-local-variables'." (mapcan #'(lambda (element) - (and (if (and (consp element) - (cdr element) - (cadr element)) - (eq (cadr element) type) - (eq type 'global)) - (if (and (consp element) - (cddr element) - (not (eq (caddr element) t))) - (if (functionp (caddr element)) - (funcall (caddr element)) - (member mode (caddr element))) - t) - (list (if (consp element) (car element) element)))) - mmm-save-local-variables)) + (and (if (and (consp element) + (cdr element) + (cadr element)) + (eq (cadr element) type) + (eq type 'global)) + (if (and (consp element) + (cddr element) + (not (eq (caddr element) t))) + (if (functionp (caddr element)) + (funcall (caddr element)) + (member mode (caddr element))) + t) + (list (if (consp element) (car element) element)))) + mmm-save-local-variables)) (defun mmm-get-locals (type) "Get the local variables and values for TYPE from this buffer. Return \((VAR VALUE) ...). In some cases, VAR will be of the form \(GETTER . SETTER) -- see `mmm-save-local-variables'." (mapcan #'(lambda (var) - (if (consp var) - `((,var ,(funcall (car var)))) - (and (boundp var) - ;; This seems logical, but screws things up. - ;;(local-variable-p var) - `((,var ,(symbol-value var)))))) - (mmm-get-local-variables-list type major-mode))) + (if (consp var) + `((,var ,(funcall (car var)))) + (and (boundp var) + ;; This seems logical, but screws things up. + ;;(local-variable-p var) + `((,var ,(symbol-value var)))))) + (mmm-get-local-variables-list type major-mode))) (defun mmm-get-saved-local (mode var) "Get the value of the local variable VAR saved for MODE, if any." @@ -636,45 +636,45 @@ Return \((VAR VALUE) ...). In some cases, VAR will be of the form "Set all the local variables saved for MODE. Looks up both global, buffer, and region saves." (mapcar #'(lambda (var) - ;; (car VAR) may be (GETTER . SETTER) - (if (consp (car var)) - (funcall (cdar var) (cadr var)) - (make-local-variable (car var)) - (set (car var) (cadr var)))) - (mmm-get-saved-local-variables mode))) + ;; (car VAR) may be (GETTER . SETTER) + (if (consp (car var)) + (funcall (cdar var) (cadr var)) + (make-local-variable (car var)) + (set (car var) (cadr var)))) + (mmm-get-saved-local-variables mode))) (defun mmm-get-saved-local-variables (mode) (append (get mode 'mmm-local-variables) - (cdr (assq mode mmm-buffer-saved-locals)) - (let ((ovl (mmm-overlay-at (point)))) - (if ovl - (overlay-get ovl 'mmm-local-variables) - mmm-region-saved-locals-for-dominant)))) + (cdr (assq mode mmm-buffer-saved-locals)) + (let ((ovl (mmm-overlay-at (point)))) + (if ovl + (overlay-get ovl 'mmm-local-variables) + mmm-region-saved-locals-for-dominant)))) (defun mmm-save-changed-local-variables (ovl mode) "Save by-buffer and by-region variables for OVL and MODE. Called when we move to a new submode region, with OVL and MODE the region and mode for the previous position." (let ((buffer-vars (cdr (assq (or mode mmm-primary-mode) - mmm-buffer-saved-locals))) - (region-vars (if ovl - (overlay-get ovl 'mmm-local-variables) - mmm-region-saved-locals-for-dominant)) - (set-local-value - #'(lambda (var) - (setcar (cdr var) - ;; (car VAR) may be (GETTER . SETTER) - (if (consp (car var)) - (funcall (caar var)) - (symbol-value (car var))))))) + mmm-buffer-saved-locals))) + (region-vars (if ovl + (overlay-get ovl 'mmm-local-variables) + mmm-region-saved-locals-for-dominant)) + (set-local-value + #'(lambda (var) + (setcar (cdr var) + ;; (car VAR) may be (GETTER . SETTER) + (if (consp (car var)) + (funcall (caar var)) + (symbol-value (car var))))))) (mapc set-local-value buffer-vars) (mapc set-local-value region-vars))) (defun mmm-clear-local-variables () "Clear all buffer- and region-saved variables for current buffer." (setq mmm-buffer-saved-locals () - mmm-region-saved-locals-defaults () - mmm-region-saved-locals-for-dominant ())) + mmm-region-saved-locals-defaults () + mmm-region-saved-locals-for-dominant ())) ;;}}} @@ -693,22 +693,22 @@ region and mode for the previous position." "Turn on font lock iff any mode in the buffer enables it." (when mmm-font-lock-available-p (if (some #'(lambda (mode) - (get mode 'mmm-font-lock-mode)) + (get mode 'mmm-font-lock-mode)) (cons mmm-primary-mode (mapcar #'(lambda (ovl) (overlay-get ovl 'mmm-mode)) (mmm-overlays-overlapping (point-min) (point-max))))) - (font-lock-mode 1) + (font-lock-mode 1) (font-lock-mode 0)))) (defun mmm-refontify-maybe (&optional start stop) "Re-fontify from START to STOP, or entire buffer, if enabled." (and font-lock-mode (if (or start stop) - (font-lock-fontify-region (or start (point-min)) - (or stop (point-max))) - (font-lock-fontify-buffer)))) + (font-lock-fontify-region (or start (point-min)) + (or stop (point-max))) + (font-lock-fontify-buffer)))) ;;}}} ;;{{{ Get Submode Regions @@ -721,23 +721,23 @@ region and mode for the previous position." "Return a list of all submode-change positions from START to STOP. The list is sorted in order of increasing buffer position." (sort (remove-duplicates - (list* start stop - (mapcan #'(lambda (ovl) - `(,(overlay-start ovl) - ,(overlay-end ovl))) - (mmm-overlays-overlapping start stop)))) - #'<)) - -(defun mmm-regions-in (start stop) + (list* start stop + (mapcan #'(lambda (ovl) + `(,(overlay-start ovl) + ,(overlay-end ovl))) + (mmm-overlays-overlapping start stop)))) + #'<)) + +(defun mmm-regions-in (start stop &optional flag delim) "Return a list of regions of the form (MODE BEG END) whose disjoint union covers the region from START to STOP, including delimiters." - (let ((regions - (maplist #'(lambda (pos-list) - (if (cdr pos-list) - (list (or (mmm-submode-at (car pos-list) 'beg) - mmm-primary-mode) - (car pos-list) (cadr pos-list)))) - (mmm-submode-changes-in start stop)))) + (let ((regions + (maplist #'(lambda (pos-list) + (if (cdr pos-list) + (list (or (mmm-submode-at (car pos-list) 'beg) + mmm-primary-mode) + (car pos-list) (cadr pos-list)))) + (mmm-submode-changes-in start stop)))) (setcdr (last regions 2) nil) regions)) @@ -748,13 +748,13 @@ is a list of elements of the form \(BEG END). The disjoint union all of the REGIONS covers START to STOP." (let ((regions (mmm-regions-in start stop))) (mapcar #'(lambda (mode) - (cons mode - (mapcan #'(lambda (region) - (if (eq mode (car region)) - (list (cdr region)))) - regions))) - ;; All the modes - (remove-duplicates (mapcar #'car regions))))) + (cons mode + (mapcan #'(lambda (region) + (if (eq mode (car region)) + (list (cdr region)))) + regions))) + ;; All the modes + (remove-duplicates (mapcar #'car regions))))) ;;}}} ;;{{{ Fontify Regions @@ -771,9 +771,9 @@ of the REGIONS covers START to STOP." ;; I don't know why it does this, but let's undo it here. (let ((font-lock-beginning-of-syntax-function 'mmm-beginning-of-syntax)) (mapc #'(lambda (elt) - (when (get (car elt) 'mmm-font-lock-mode) - (mmm-fontify-region-list (car elt) (cdr elt)))) - (mmm-regions-alist start stop))) + (when (get (car elt) 'mmm-font-lock-mode) + (mmm-fontify-region-list (car elt) (cdr elt)))) + (mmm-regions-alist start stop))) ;; With jit-lock, this causes blips in the mode line and menus. ;; Shouldn't be necessary here, since it's in post-command-hook too. ;;(mmm-update-submode-region) @@ -783,20 +783,20 @@ of the REGIONS covers START to STOP." "Fontify REGIONS, each like \(BEG END), in mode MODE." (save-excursion (let (;(major-mode mode) - (func (get mode 'mmm-fontify-region-function))) + (func (get mode 'mmm-fontify-region-function))) (mapc #'(lambda (reg) - (goto-char (car reg)) - ;; Here we do the same sort of thing that - ;; `mmm-update-submode-region' does, but we force it - ;; to use a specific mode, and don't save anything, - ;; fontify, or change the mode line. - (mmm-set-current-submode mode) - (mmm-set-local-variables mode) - (funcall func (car reg) (cadr reg) nil) - ;; Catch changes in font-lock cache. - (mmm-save-changed-local-variables - mmm-current-overlay mmm-current-submode)) - regions)))) + (goto-char (car reg)) + ;; Here we do the same sort of thing that + ;; `mmm-update-submode-region' does, but we force it + ;; to use a specific mode, and don't save anything, + ;; fontify, or change the mode line. + (mmm-set-current-submode mode) + (mmm-set-local-variables mode) + (funcall func (car reg) (cadr reg) nil) + ;; Catch changes in font-lock cache. + (mmm-save-changed-local-variables + mmm-current-overlay mmm-current-submode)) + regions)))) ;;}}} ;;{{{ Beginning of Syntax @@ -804,11 +804,11 @@ of the REGIONS covers START to STOP." (defun mmm-beginning-of-syntax () (goto-char (let ((ovl (mmm-overlay-at (point))) - (func (get (or mmm-current-submode mmm-primary-mode) - 'mmm-beginning-of-syntax-function))) + (func (get (or mmm-current-submode mmm-primary-mode) + 'mmm-beginning-of-syntax-function))) (max (if ovl (overlay-start ovl) (point-min)) - (if func (progn (funcall func) (point)) (point-min)) - (point-min))))) + (if func (progn (funcall func) (point)) (point-min)) + (point-min))))) ;;}}} diff --git a/mmm/mmm-sample.el b/mmm/mmm-sample.el index fe327c95..daf663c4 100644 --- a/mmm/mmm-sample.el +++ b/mmm/mmm-sample.el @@ -61,7 +61,7 @@ :front "<script\[^>\]*\\(language=\"javascript\\([0-9.]*\\)\"\\|type=\"text/javascript\"\\)\[^>\]*>" :back"</script>" :insert ((?j js-tag nil @ "<script language=\"JavaScript\">" - @ "\n" _ "\n" @ "</script>" @)) + @ "\n" _ "\n" @ "</script>" @)) ) (js-inline :submode javascript @@ -96,35 +96,35 @@ and MODE is a major mode function symbol.") (or (mmm-ensure-modename ;; First try the user override variable. (some #'(lambda (pair) - (if (string-match (car pair) string) (cdr pair) nil)) - mmm-here-doc-mode-alist)) + (if (string-match (car pair) string) (cdr pair) nil)) + mmm-here-doc-mode-alist)) (let ((words (split-string (downcase string) "[_-]+"))) - (or (mmm-ensure-modename - ;; Try the whole name, stopping at "mode" if present. - (intern - (mapconcat #'identity - (nconc (ldiff words (member "mode" words)) - (list "mode")) - "-"))) - ;; Try each word by itself (preference list) - (some #'(lambda (word) - (mmm-ensure-modename (intern word))) - words) - ;; Try each word with -mode tacked on - (some #'(lambda (word) - (mmm-ensure-modename - (intern (concat word "-mode")))) - words) - ;; Try each pair of words with -mode tacked on - (loop for (one two) on words - if (mmm-ensure-modename - (intern (concat one two "-mode"))) - return it) - ;; I'm unaware of any modes whose names, minus `-mode', - ;; are more than two words long, and if the entire mode - ;; name (perhaps minus `-mode') doesn't occur in the - ;; here-document name, we can give up. - (signal 'mmm-no-matching-submode nil))))) + (or (mmm-ensure-modename + ;; Try the whole name, stopping at "mode" if present. + (intern + (mapconcat #'identity + (nconc (ldiff words (member "mode" words)) + (list "mode")) + "-"))) + ;; Try each word by itself (preference list) + (some #'(lambda (word) + (mmm-ensure-modename (intern word))) + words) + ;; Try each word with -mode tacked on + (some #'(lambda (word) + (mmm-ensure-modename + (intern (concat word "-mode")))) + words) + ;; Try each pair of words with -mode tacked on + (loop for (one two) on words + if (mmm-ensure-modename + (intern (concat one two "-mode"))) + return it) + ;; I'm unaware of any modes whose names, minus `-mode', + ;; are more than two words long, and if the entire mode + ;; name (perhaps minus `-mode') doesn't occur in the + ;; here-document name, we can give up. + (signal 'mmm-no-matching-submode nil))))) (mmm-add-classes '((here-doc @@ -135,7 +135,7 @@ and MODE is a major mode function symbol.") :delimiter-mode nil :match-submode mmm-here-doc-get-mode :insert ((?d here-doc "Here-document Name: " @ "<<" str _ "\n" - @ "\n" @ str "\n" @)) + @ "\n" @ str "\n" @)) ))) ;;}}} @@ -150,18 +150,18 @@ and MODE is a major mode function symbol.") :save-matches 1 :match-name "embperl" :match-face (("[+" . mmm-output-submode-face) - ("[-" . mmm-code-submode-face) - ("[!" . mmm-init-submode-face) - ("[*" . mmm-code-submode-face) - ("[$" . mmm-special-submode-face)) + ("[-" . mmm-code-submode-face) + ("[!" . mmm-init-submode-face) + ("[*" . mmm-code-submode-face) + ("[$" . mmm-special-submode-face)) :insert ((?p embperl "Region Type (Character): " @ "[" str - @ " " _ " " @ str "]" @) - (?+ embperl+ ?p . "+") - (?- embperl- ?p . "-") - (?! embperl! ?p . "!") - (?* embperl* ?p . "*") - (?$ embperl$ ?p . "$") - ) + @ " " _ " " @ str "]" @) + (?+ embperl+ ?p . "+") + (?- embperl- ?p . "-") + (?! embperl! ?p . "!") + (?* embperl* ?p . "*") + (?$ embperl$ ?p . "$") + ) ) (embperl-comment :submode text-mode @@ -189,8 +189,8 @@ and MODE is a major mode function symbol.") :back "_?:>" :match-name "eperl" :insert ((?p eperl-code nil @ "<:" @ " " _ " " @ ":>" @) - (?: eperl-code ?p . nil) - (?_ eperl-code_ nil @ "<:" @ " " _ " " @ "_:>" @))) + (?: eperl-code ?p . nil) + (?_ eperl-code_ nil @ "<:" @ " " _ " " @ "_:>" @))) (eperl-comment :submode text :face mmm-comment-submode-face @@ -210,24 +210,24 @@ and MODE is a major mode function symbol.") ;; buffer-local variable with markers for positions, but the trick ;; is knowing when to expire the cache. (let ((bounds - (save-excursion - (save-match-data - (goto-char (point-max)) - (backward-page) - (and (re-search-forward "^\\(.*\\)Local Variables:" nil t) - (list (match-string 1) - (progn (end-of-line) (point)) - (and (search-forward - (format "%sEnd:" (match-string 1)) - nil t) - (progn (beginning-of-line) - (point))))))))) + (save-excursion + (save-match-data + (goto-char (point-max)) + (backward-page) + (and (re-search-forward "^\\(.*\\)Local Variables:" nil t) + (list (match-string 1) + (progn (end-of-line) (point)) + (and (search-forward + (format "%sEnd:" (match-string 1)) + nil t) + (progn (beginning-of-line) + (point))))))))) (and bounds (caddr bounds) - (save-match-data - (string-match (format "^%s" (regexp-quote (car bounds))) - (match-string 0))) - (> (match-beginning 0) (cadr bounds)) - (< (match-end 0) (caddr bounds))))) + (save-match-data + (string-match (format "^%s" (regexp-quote (car bounds))) + (match-string 0))) + (> (match-beginning 0) (cadr bounds)) + (< (match-end 0) (caddr bounds))))) (defun mmm-file-variables-find-back (bound) (forward-sexp) @@ -258,14 +258,14 @@ and MODE is a major mode function symbol.") (jsp-code :submode java :match-face (("<%!" . mmm-declaration-submode-face) - ("<%=" . mmm-output-submode-face) - ("<%" . mmm-code-submode-face)) + ("<%=" . mmm-output-submode-face) + ("<%" . mmm-code-submode-face)) :front "<%[!=]?" :back "%>" :match-name "jsp" :insert ((?% jsp-code nil @ "<%" @ " " _ " " @ "%>" @) - (?! jsp-declaration nil @ "<%!" @ " " _ " " @ "%>" @) - (?= jsp-expression nil @ "<%=" @ " " _ " " @ "%>" @)) + (?! jsp-declaration nil @ "<%!" @ " " _ " " @ "%>" @) + (?= jsp-expression nil @ "<%=" @ " " _ " " @ "%>" @)) ) (jsp-directive :submode text-mode @@ -321,7 +321,7 @@ and MODE is a major mode function symbol.") :front "<\\?\\(php\\)?" :back "\\?>" :insert ((?p php-section nil @ "<?php" @ " " _ " " @ "?>" @) - (?b php-block nil @ "<?php" @ "\n" _ "\n" @ "?>" @)) + (?b php-block nil @ "<?php" @ "\n" _ "\n" @ "?>" @)) ))) ;;}}} diff --git a/mmm/mmm-univ.el b/mmm/mmm-univ.el index 7c16df20..02504383 100644 --- a/mmm/mmm-univ.el +++ b/mmm/mmm-univ.el @@ -39,17 +39,17 @@ (string-match "[a-zA-Z-]+" string) (setq string (match-string 0 string)) (let ((modestr (intern (if (string-match "mode\\'" string) - string - (concat string "-mode"))))) + string + (concat string "-mode"))))) (or (mmm-ensure-modename modestr) - (signal 'mmm-no-matching-submode nil)))) + (signal 'mmm-no-matching-submode nil)))) (mmm-add-classes `((universal :front "{%\\([a-zA-Z-]+\\)%}" :back "{%/~1%}" :insert ((?/ universal "Submode: " @ "{%" str "%}" @ "\n" _ "\n" - @ "{%/" str "%}" @)) + @ "{%/" str "%}" @)) :match-submode mmm-univ-get-mode :save-matches 1 ))) diff --git a/mmm/mmm-utils.el b/mmm/mmm-utils.el index b61e8806..bdb9704f 100644 --- a/mmm/mmm-utils.el +++ b/mmm/mmm-utils.el @@ -44,12 +44,12 @@ means not hidden, not a minibuffer, not in batch mode, and not in of `mmm-never-modes'." `(unless (or (eq (aref (buffer-name) 0) ?\ ) - (window-minibuffer-p (selected-window)) - (memq major-mode mmm-never-modes) - noninteractive - ;; Unnecessary as now hidden + (window-minibuffer-p (selected-window)) + (memq major-mode mmm-never-modes) + noninteractive + ;; Unnecessary as now hidden ;;; (equal (buffer-name) mmm-temp-buffer-name) - ) + ) ,@body)) ;;;(def-edebug-spec mmm-valid-buffer t) @@ -64,7 +64,7 @@ restrictions, and match data." `(save-excursion (save-restriction (save-match-data - ,@body)))) + ,@body)))) ;;;(def-edebug-spec mmm-save-all t) @@ -78,8 +78,8 @@ substituted for the corresponding REGEXP wherever it matches." (let ((case-fold-search nil)) (save-match-data (dolist (pair arg-pairs) - (while (string-match (car pair) string) - (setq string (replace-match (cdr pair) t t string)))))) + (while (string-match (car pair) string) + (setq string (replace-match (cdr pair) t t string)))))) string) (defun mmm-format-matches (string &optional on-string) @@ -91,11 +91,11 @@ ON-STRING, if supplied, means to use the match data from a `string-match' on that string, rather than the global match data." (when (stringp string) (let ((old-data (match-data)) - subexp) + subexp) (save-match-data - (while (string-match "~\\([0-9]\\)" string) - (setq subexp (string-to-number (match-string-no-properties 1 string)) - string (replace-match + (while (string-match "~\\([0-9]\\)" string) + (setq subexp (string-to-number (match-string-no-properties 1 string)) + string (replace-match (save-match-data (set-match-data old-data) (match-string-no-properties subexp on-string)) @@ -120,8 +120,8 @@ Use of this macro can make code more readable when there are a lot of PARAMS, but less readable when there are only a few. Also best used only when it is important that nil values disappear." `(append ,@(mapcar #'(lambda (param) - (macroexpand `(mmm-save-keyword ,param))) - params))) + (macroexpand `(mmm-save-keyword ,param))) + params))) ;;}}} ;;{{{ Looking Back At @@ -134,10 +134,10 @@ back that that many characters before point. Otherwise, it defaults to string." (eq (point) (save-excursion - (and (re-search-backward regexp - (- (point) (or bound (length regexp))) - t) - (match-end 0))))) + (and (re-search-backward regexp + (- (point) (or bound (length regexp))) + t) + (match-end 0))))) ;;}}} ;;{{{ Markers diff --git a/mmm/mmm-vars.el b/mmm/mmm-vars.el index 7130e58b..80e92ef2 100644 --- a/mmm/mmm-vars.el +++ b/mmm/mmm-vars.el @@ -107,7 +107,7 @@ '(c-mode c++-mode objc-mode pike-mode java-mode jde-mode javascript-mode php-mode)) -(defvar mmm-save-local-variables +(defvar mmm-save-local-variables `(;; Don't use `function' (#') here!! We're already inside `quote'! major-mode comment-start @@ -119,9 +119,9 @@ comment-line-break-function sentence-end ,@(when mmm-xemacs - '(mode-popup-menu - (((lambda () current-menubar) . set-buffer-menubar)) - )) + '(mode-popup-menu + (((lambda () current-menubar) . set-buffer-menubar)) + )) font-lock-keywords font-lock-keywords-only font-lock-keywords-case-fold-search @@ -145,12 +145,12 @@ ,@(mapcar #'(lambda (var) (list var nil mmm-c-derived-modes)) '(c++-template-syntax-table - c-<-op-cont-regexp - c->-op-cont-regexp + c-<-op-cont-regexp + c->-op-cont-regexp c-after-suffixed-type-decl-key c-after-suffixed-type-maybe-decl-key c-any-class-key - c-any-class-key + c-any-class-key c-asm-stmt-kwds c-assignment-op-regexp c-backslash-column @@ -159,27 +159,27 @@ c-block-comment-prefix c-block-decls-with-vars c-block-stmt-1-key - c-block-stmt-1-key + c-block-stmt-1-key c-block-stmt-1-kwds c-block-stmt-2-key - c-block-stmt-2-key + c-block-stmt-2-key c-block-stmt-2-kwds - c-brace-list-key - c-cast-parens + c-brace-list-key + c-cast-parens + c-class-key c-class-key - c-class-key c-class-kwds c-cleanup-list - c-colon-type-list-re + c-colon-type-list-re c-comment-only-line-offset c-comment-prefix-regexp c-comment-start-regexp - c-comment-start-regexp + c-comment-start-regexp c-cpp-defined-fns c-current-comment-prefix c-decl-block-key - c-decl-block-key - c-decl-prefix-re + c-decl-block-key + c-decl-prefix-re c-decl-spec-kwds c-doc-comment-start-regexp c-expr-kwds @@ -190,9 +190,9 @@ c-hanging-comment-ender-p c-hanging-comment-starter-p c-hanging-semi\&comma-criteria - c-identifier-key + c-identifier-key c-identifier-last-sym-match - c-identifier-start + c-identifier-start c-identifier-syntax-modifications c-identifier-syntax-table c-in-comment-lc-prefix @@ -204,89 +204,89 @@ c-keywords c-keywords-obarray c-keywords-regexp - c-keywords-regexp + c-keywords-regexp c-known-type-key c-label-key - c-label-key + c-label-key c-label-kwds c-label-kwds-regexp - c-label-kwds-regexp + c-label-kwds-regexp c-label-minimum-indentation c-lambda-kwds - c-literal-start-regexp - c-nonsymbol-chars + c-literal-start-regexp + c-nonsymbol-chars c-nonsymbol-token-regexp c-not-decl-init-keywords c-offsets-alist - c-opt-<>-arglist-start + c-opt-<>-arglist-start c-opt-<>-arglist-start-in-paren - c-opt-<>-sexp-key + c-opt-<>-sexp-key c-opt-access-key - c-opt-access-key + c-opt-access-key + c-opt-asm-stmt-key c-opt-asm-stmt-key - c-opt-asm-stmt-key c-opt-bitfield-key - c-opt-bitfield-key + c-opt-bitfield-key c-opt-block-decls-with-vars-key c-opt-block-stmt-key - c-opt-block-stmt-key - c-opt-cpp-prefix - c-opt-cpp-start + c-opt-block-stmt-key + c-opt-cpp-prefix + c-opt-cpp-start c-opt-decl-spec-key c-opt-friend-key - c-opt-friend-key + c-opt-friend-key c-opt-identifier-concat-key c-opt-inexpr-block-key - c-opt-inexpr-block-key + c-opt-inexpr-block-key c-opt-inexpr-brace-list-key c-opt-inexpr-class-key - c-opt-inexpr-class-key + c-opt-inexpr-class-key + c-opt-lambda-key c-opt-lambda-key - c-opt-lambda-key c-opt-method-key - c-opt-method-key + c-opt-method-key c-opt-postfix-decl-spec-key c-opt-type-component-key - c-opt-type-concat-key - c-opt-type-modifier-key - c-opt-type-suffix-key + c-opt-type-concat-key + c-opt-type-modifier-key + c-opt-type-suffix-key + c-other-decl-block-key c-other-decl-block-key - c-other-decl-block-key c-other-decl-block-kwds c-other-decl-kwds c-overloadable-operators-regexp - c-paragraph-separate - c-paragraph-start - c-paren-stmt-key - c-primary-expr-regexp - c-primitive-type-key + c-paragraph-separate + c-paragraph-start + c-paren-stmt-key + c-primary-expr-regexp + c-primitive-type-key c-primitive-type-kwds c-protection-kwds - c-recognize-<>-arglists + c-recognize-<>-arglists + c-recognize-knr-p c-recognize-knr-p - c-recognize-knr-p - c-recognize-paren-inits + c-recognize-paren-inits c-recognize-typeless-decls c-regular-keywords-regexp - c-simple-stmt-key + c-simple-stmt-key c-simple-stmt-kwds c-special-brace-lists - c-special-brace-lists - c-specifier-key + c-special-brace-lists + c-specifier-key c-specifier-kwds - c-stmt-delim-chars + c-stmt-delim-chars c-stmt-delim-chars-with-comma c-symbol-key - c-symbol-key - c-symbol-start + c-symbol-key + c-symbol-start c-syntactic-eol - c-syntactic-ws-end - c-syntactic-ws-start - c-type-decl-prefix-key - c-type-decl-suffix-key - c-type-prefix-key - comment-end - comment-start + c-syntactic-ws-end + c-syntactic-ws-start + c-type-decl-prefix-key + c-type-decl-suffix-key + c-type-prefix-key + comment-end + comment-start comment-start-skip)) ;; Skeleton insertion skeleton-transformation @@ -375,8 +375,8 @@ of coloring respectively. specify a face." :group 'mmm-faces :type '(choice (const :tag "None" 0) - (const :tag "Low" 1) - (const :tag "High" 2))) + (const :tag "Low" 1) + (const :tag "High" 2))) (defface mmm-init-submode-face '((t (:background "Pink"))) "Face used for submodes containing initialization code." @@ -503,8 +503,8 @@ and EXT, but no classes are activated. See `mmm-global-mode'." :group 'mmm :type '(repeat (list (symbol :tag "Major Mode") - (string :tag "Filename Regexp") - (symbol :tag "Class"))) + (string :tag "Filename Regexp") + (symbol :tag "Class"))) :require 'mmm-mode) (defun mmm-add-mode-ext-class (mode ext class) @@ -530,9 +530,9 @@ for submodes of LANGUAGE. The last element of MODES should be a mode which will always be available." :group 'mmm :type '(repeat (cons symbol - (repeat - (restricted-sexp :match-alternatives - (fboundp)))))) + (repeat + (restricted-sexp :match-alternatives + (fboundp)))))) (defun mmm-add-to-major-mode-preferences (language mode &optional default) "Set the preferred major mode for LANGUAGE to MODE. @@ -543,10 +543,10 @@ may be used by packages to ensure that some mode is present, but not override any user-specified mode." (let ((pair (assq language mmm-major-mode-preferences))) (if pair - ;; Existing mode preferences - (if default - (setcdr pair (cons mode (cdr pair))) - (setcdr pair (append (cdr pair) (list mode)))) + ;; Existing mode preferences + (if default + (setcdr pair (cons mode (cdr pair))) + (setcdr pair (append (cdr pair) (list mode)))) ;; No existing mode preference (add-to-list 'mmm-major-mode-preferences (list language mode))))) @@ -555,7 +555,7 @@ override any user-specified mode." Valid submode names are either `fboundp' or present as the `car' of an element in `mmm-major-mode-preferences'." (if (or (fboundp symbol) - (assq symbol mmm-major-mode-preferences)) + (assq symbol mmm-major-mode-preferences)) symbol nil)) @@ -567,8 +567,8 @@ first `fboundp' element of the `cdr' is returned, or nil if none." (if (fboundp mode) mode (car (remove-if-not - #'fboundp - (cdr (assq mode mmm-major-mode-preferences)))))) + #'fboundp + (cdr (assq mode mmm-major-mode-preferences)))))) ;;}}} ;;{{{ Delimiter Regions @@ -630,7 +630,7 @@ to. This variable must be set before MMM Mode is loaded." (defun mmm-use-old-command-keys () "Use the old command keys \(no control modifer) in MMM Mode." (setq mmm-command-modifiers '() - mmm-insert-modifiers '(control))) + mmm-insert-modifiers '(control))) ;;}}} ;;{{{ MMM Hooks @@ -659,8 +659,8 @@ applied in a buffer." "Run the hook named `mmm-<BODY>-<SUFFIX>-hook', if it exists. If SUFFIX is nil or unsupplied, run `mmm-<BODY>-hook' instead." (let ((hook (intern-soft (if suffix - (format "mmm-%s-%s-hook" body suffix) - (format "mmm-%s-hook" body))))) + (format "mmm-%s-%s-hook" body suffix) + (format "mmm-%s-hook" body))))) (if hook (run-hooks hook)))) (defun mmm-run-major-hook () @@ -731,8 +731,8 @@ an existing buffer." `mmm-mode-ext-classes-alist' for more information." :group 'mmm :type '(choice (const :tag "Always" t) - (const :tag "Never" nil) - (other :tag "Maybe" maybe)) + (const :tag "Never" nil) + (other :tag "Maybe" maybe)) :require 'mmm-mode) ;; These are not traditional editing modes, so mmm makes no sense, and @@ -949,19 +949,19 @@ and is not for the user to see.") "Add CLASSES and a \"grouping class\" named GROUP which calls them all. The CLASSES are all made private, i.e. non-user-visible." (mmm-add-classes (mapcar #'(lambda (class) - (append class - '(:private t))) - classes)) + (append class + '(:private t))) + classes)) (add-to-list 'mmm-classes-alist - (list group :classes (mapcar #'first classes)))) + (list group :classes (mapcar #'first classes)))) (defun mmm-add-to-group (group classes) "Add CLASSES to the \"grouping class\" named GROUP. The CLASSES are all made private, i.e. non-user-visible." (mmm-add-classes (mapcar #'(lambda (class) - (append class - '(:private t))) - classes)) + (append class + '(:private t))) + classes)) (mmm-set-class-parameter group :classes (append (mmm-get-class-parameter group :classes) (mapcar #'first classes)))) @@ -1012,9 +1012,9 @@ Set automatically from `mmm-mode-ext-classes-alist'.") Uses `mmm-mode-ext-classes-alist' to find submode classes." (or mmm-mode-ext-classes (setq mmm-mode-ext-classes - (mapcar #'third - (remove-if-not #'mmm-mode-ext-applies - mmm-mode-ext-classes-alist))))) + (mapcar #'third + (remove-if-not #'mmm-mode-ext-applies + mmm-mode-ext-classes-alist))))) (defun mmm-clear-mode-ext-classes () "Clear classes added by major mode and filename." @@ -1023,25 +1023,25 @@ Uses `mmm-mode-ext-classes-alist' to find submode classes." (defun mmm-mode-ext-applies (element) (destructuring-bind (mode ext class) element (and (if mode - (eq mode - ;; If MMM is on in this buffer, use the primary mode, - ;; otherwise use the normal indicator. - (or mmm-primary-mode major-mode)) - t) - (if ext - (and (buffer-file-name) - (save-match-data - (string-match ext (buffer-file-name)))) - t)))) + (eq mode + ;; If MMM is on in this buffer, use the primary mode, + ;; otherwise use the normal indicator. + (or mmm-primary-mode major-mode)) + t) + (if ext + (and (buffer-file-name) + (save-match-data + (string-match ext (buffer-file-name)))) + t)))) (defun mmm-get-all-classes (global) "Return a list of all classes applicable to the current buffer. These come from mode/ext associations, `mmm-classes', and interactive history, as well as `mmm-global-classes' if GLOBAL is non-nil." (append mmm-interactive-history - (if (listp mmm-classes) mmm-classes (list mmm-classes)) - (if global mmm-global-classes ()) - (mmm-get-mode-ext-classes))) + (if (listp mmm-classes) mmm-classes (list mmm-classes)) + (if global mmm-global-classes ()) + (mmm-get-mode-ext-classes))) ;;}}} diff --git a/phox/phox-extraction.el b/phox/phox-extraction.el index b488d43e..d81acde1 100644 --- a/phox/phox-extraction.el +++ b/phox/phox-extraction.el @@ -1,4 +1,4 @@ -;; $State$ $Date$ $Revision$ +;; $State$ $Date$ $Revision$ ;;--------------------------------------------------------------------------;; ;;--------------------------------------------------------------------------;; ;; program extraction. @@ -13,11 +13,11 @@ (defun phox-prog-flags-modify(option) "ask for a string that are options to pass to phox binary" (interactive "soption :") -; pas d'analyse de la réponse, +; pas d'analyse de la réponse, (let ((process)) (if (and phox-prog-name (progn (string-match " \\|$" phox-prog-name) - (setq process + (setq process (substring phox-prog-name 0 (match-beginning 0)) ) ) @@ -27,7 +27,7 @@ ) (if (string-match "^ *$" option) (progn - (message + (message "no option other than default ones will be passed to phox binary.") (setq phox-prog-name phox-prog-orig)) (progn @@ -46,7 +46,7 @@ compile theorem_name. output." (interactive) (phox-prog-flags-modify "-f") -(message +(message "WARNING : program extraction is experimental and can disturb the prover !") ) @@ -71,13 +71,13 @@ output." ; compilation (defun phox-compile-theorem(name) - "Interactive function : + "Interactive function : ask for the name of a theorem and send a compile command to PhoX for it." (interactive "stheorem : ") (proof-shell-invisible-command (concat "compile " name))) (defun phox-compile-theorem-on-cursor() -"Interactive function : +"Interactive function : send a compile command to PhoX for the theorem which name is under the cursor." (interactive) (let (start end) @@ -94,8 +94,8 @@ send a compile command to PhoX for the theorem which name is under the cursor." (defun phox-output () -"Interactive function : -send output command to phox in order to obtain programs +"Interactive function : +send output command to phox in order to obtain programs extracted from proofs of all compiled theorems." @@ -103,19 +103,19 @@ extracted from proofs of all compiled theorems." (proof-shell-invisible-command "output")) (defun phox-output-theorem (name) -"Interactive function : +"Interactive function : ask for the name of a theorem and send an output command to PhoX for it in order to obtain a programm extracted from the known proof of this theorem." (interactive "stheorem : ") (proof-shell-invisible-command (concat "output " name))) (defun phox-output-theorem-on-cursor() -"Interactive function : +"Interactive function : send an output command to PhoX for the theorem which name is under the cursor in order to obtain a programm extracted from the known proof of this theorem." (interactive) - (let (start - end + (let (start + end ; (syntax (char-to-string (char-syntax ?\.))) ) (save-excursion @@ -142,7 +142,7 @@ in order to obtain a programm extracted from the known proof of this theorem." ] ["------------------------------" nil nil ] - ["Compile theorem on cursor" phox-compile-theorem-on-cursor + ["Compile theorem on cursor" phox-compile-theorem-on-cursor :active(string-match "\-f$" phox-prog-name) ] ["Extraction for theorem on cursor" phox-output-theorem-on-cursor diff --git a/phox/phox-font.el b/phox/phox-font.el index 37a6a910..2eca2c5a 100644 --- a/phox/phox-font.el +++ b/phox/phox-font.el @@ -48,8 +48,8 @@ "prove\\|" "r\\(e\\(write\\(_hyp\\)?\\|name\\)\\|mh\\)\\|" "s\\(elect\\|how\\|lh\\)\\|" - "t\\(hen\\|rivial\\)\\|" - "u\\(se\\|n\\(do\\|fold\\(_hyp\\)?\\|lock\\)\\)\\|" + "t\\(hen\\|rivial\\)\\|" + "u\\(se\\|n\\(do\\|fold\\(_hyp\\)?\\|lock\\)\\)\\|" "with" "\\)[ \t.]") '(0 'font-lock-type-face t)))) @@ -86,12 +86,12 @@ ; "If non nil: Overrides default Phox-Sym-Lock patterns for PhoX.") (defun phox-sym-lock-start () - (if (and (featurep 'phox-sym-lock) phox-sym-lock-enabled) - (progn - (setq phox-sym-lock-color - (face-foreground 'font-lock-function-name-face)) - (if (not phox-sym-lock-keywords) - (phox-sym-lock phox-sym-lock-keywords-table))))) + (if (and (featurep 'phox-sym-lock) phox-sym-lock-enabled) + (progn + (setq phox-sym-lock-color + (face-foreground 'font-lock-function-name-face)) + (if (not phox-sym-lock-keywords) + (phox-sym-lock phox-sym-lock-keywords-table))))) (provide 'phox-font) diff --git a/phox/phox-fun.el b/phox/phox-fun.el index 82531470..ded13ed0 100644 --- a/phox/phox-fun.el +++ b/phox/phox-fun.el @@ -1,5 +1,4 @@ - -;; $State$ $Date$ $Revision$ +;; $State$ $Date$ $Revision$ ;; syntax (setq @@ -16,28 +15,28 @@ phox-ident-regexp "\\(\\([^() \n\t\r=\\[.]\\|\\(\\.[^() \n\t\r]\\)\\)+\\)" phox-inductive-option "\\(\\[[^]]*]\\)?" phox-spaces-regexp "[ \n\t\r]*" - phox-sy-definition-regexp (concat + phox-sy-definition-regexp (concat "\\(Cst\\|\\(def\\(rec\\)?\\)\\)" phox-comments-regexp - "\\(\\(rInfix\\|lInfix\\|Infix\\|Prefix\\|Postfix\\)[^\"]+\"\\([^\"]+\\)\\)") - phox-sy-inductive-regexp (concat + "\\(\\(rInfix\\|lInfix\\|Infix\\|Prefix\\|Postfix\\)[^\"]+\"\\([^\"]+\\)\\)") + phox-sy-inductive-regexp (concat "Inductive" phox-comments-regexp phox-inductive-option phox-comments-regexp - "\\(\\(rInfix\\|lInfix\\|Infix\\|Prefix\\|Postfix\\)[^\"]+\"\\([^\"]+\\)\\)") - phox-inductive-regexp (concat + "\\(\\(rInfix\\|lInfix\\|Infix\\|Prefix\\|Postfix\\)[^\"]+\"\\([^\"]+\\)\\)") + phox-inductive-regexp (concat "Inductive" phox-comments-regexp phox-inductive-option phox-comments-regexp - phox-ident-regexp) - phox-data-regexp (concat + phox-ident-regexp) + phox-data-regexp (concat "\\(Data\\|type\\)" phox-comments-regexp phox-inductive-option phox-comments-regexp - phox-ident-regexp) + phox-ident-regexp) phox-definition-regexp (concat "\\(Cst\\|def\\(_thlist\\|rec\\)?\\|claim\\|Sort\\)" phox-comments-regexp @@ -66,7 +65,7 @@ (defun phox-init-syntax-table (&optional TABLE) - "Set appropriate values for syntax table in current buffer, + "Set appropriate values for syntax table in current buffer, or for optional argument TABLE." ;; useful for using forward-word (modify-syntax-entry ?_ "w" TABLE) @@ -172,72 +171,72 @@ or for optional argument TABLE." (defun phox-find-and-forget (span) (let (str ans tmp (lsp -1) name sname) ;; da: added name,sname. are tmp/lsp not used? - (while span + (while span (setq str (span-property span 'cmd)) (cond - ((eq (span-property span 'type) 'comment)) + ((eq (span-property span 'type) 'comment)) ((eq (span-property span 'type) 'proverproc)) ((eq (span-property span 'type) 'goalsave) (if (proof-string-match phox-prove-claim-regexp str) - (setq ans (concat (format phox-forget-proof-command + (setq ans (concat (format phox-forget-proof-command (match-string 4 str)) ans)) (setq ans (concat (format phox-forget-id-command (span-property span 'name)) ans)))) ((proof-string-match phox-new-elim-regexp str) - (setq ans - (concat (format phox-forget-new-elim-command + (setq ans + (concat (format phox-forget-new-elim-command (match-string 3 str)) ans))) ((proof-string-match phox-new-intro-regexp str) - (setq ans - (concat (format phox-forget-new-intro-command + (setq ans + (concat (format phox-forget-new-intro-command (match-string 3 str)) ans))) ((proof-string-match phox-new-rewrite-regexp str) ; deprecated - (setq ans - (concat (format phox-forget-new-equation-command + (setq ans + (concat (format phox-forget-new-equation-command (match-string 3 str)) ans))) ((proof-string-match phox-new-equation-regexp str) - (setq ans - (concat (format phox-forget-new-equation-command + (setq ans + (concat (format phox-forget-new-equation-command (match-string 3 str)) ans))) ((proof-string-match phox-close-def-regexp str) - (setq ans - (concat (format phox-forget-close-def-command + (setq ans + (concat (format phox-forget-close-def-command (match-string 4 str)) ans))) ((proof-string-match phox-sy-definition-regexp str) - (setq ans - (concat (format phox-forget-id-command + (setq ans + (concat (format phox-forget-id-command (concat "$" (match-string 7 str))) ans))) ((proof-string-match phox-sy-inductive-regexp str) - (setq ans - (concat (format phox-forget-id-command + (setq ans + (concat (format phox-forget-id-command (concat "$" (match-string 10 str))) ans))) ((proof-string-match phox-inductive-regexp str) - (setq ans - (concat (format phox-forget-id-command + (setq ans + (concat (format phox-forget-id-command (match-string 8 str)) ans))) ((proof-string-match phox-data-regexp str) (setq name (match-string 8 str) - sname (concat (downcase (substring name 0 1)) + sname (concat (downcase (substring name 0 1)) (substring name 1 nil)) - ans (concat (format phox-forget-id-command + ans (concat (format phox-forget-id-command sname) ans))) ((proof-string-match phox-definition-regexp str) - (setq ans (concat (format phox-forget-id-command + (setq ans (concat (format phox-forget-id-command (match-string 6 str)) ans)))) (setq lsp (span-start span)) @@ -268,7 +267,7 @@ If inside a comment, just process until the start of the comment." ;; function, and appear in the submenu "State" [pr]. (defun phox-depend-theorem(theorem) - "Interactive function : + "Interactive function : ask for a string and and send a depend command to PhoX for it. Gives the list of all axioms which have been used to prove the theorem." @@ -277,8 +276,8 @@ Gives the list of all axioms which have been used to prove the theorem." (proof-shell-invisible-command (concat "depend " theorem))) (defun phox-eshow-extlist(extlist) - "Interactive function : -ask for a string and send an eshow command to PhoX for it. + "Interactive function : +ask for a string and send an eshow command to PhoX for it. Shows the given extension-list. Possible extension lists are : equation (the list of equations added to unification introduced by the new_equation @@ -291,7 +290,7 @@ introduced by the new_elim and new_intro {-t} commands), closed (proof-shell-invisible-command (concat "eshow " extlist))) (defun phox-flag-name(name) -"Interactive function : +"Interactive function : ask for a string and send a flag command to PhoX for it. Print the value of an internal flag of the @@ -302,7 +301,7 @@ ask for a string and send a flag command to PhoX for it. (defun phox-path() -"Interactive function : +"Interactive function : send a path command to PhoX. Prints the list of all paths. This path list is used to find @@ -313,20 +312,20 @@ ask for a string and send a flag command to PhoX for it. (proof-shell-invisible-command "path")) (defun phox-print-expression(expr) -"Interactive function : +"Interactive function : ask for a string and send a print command to PhoX for it. In case argument expr is a closed expression of the language in use, prints it and gives its sort, gives an (occasionally) informative error message otherwise. In - case expr is a defined expression (constant, theorem ...) + case expr is a defined expression (constant, theorem ...) gives the definition." (interactive "sexpr: ") (proof-shell-invisible-command (concat "print " expr))) (defun phox-print-sort-expression(expr) -"Interactive function : +"Interactive function : ask for a string and send a print_sort command to PhoX for it. Similar to print, but gives more information on sorts of bounded @@ -337,7 +336,7 @@ ask for a string and send a print_sort command to PhoX for it. (defun phox-priority-symbols-list(symblist) -"Interactive function : +"Interactive function : ask for a string and send a priority command to PhoX for it. Print the priority of the given symbols. If no symbol are @@ -349,22 +348,22 @@ ask for a string and send a priority command to PhoX for it. (defun phox-search-string(string type) - "Interactive function: + "Interactive function: ask for a string and possibly a type and send a search command to PhoX for it. Prints the list of all loaded symbols which have type and whose name contains the string. If no type is given, it prints all symbols whose name contains string." -(interactive -"sstring : +(interactive +"sstring : stype (nothing for any type, 'a as type parameter) :") (proof-shell-invisible-command (concat "search \"" string "\" " type))) ;; The followings are proof commands (doc in cmd_proof.tex) : (defun phox-constraints() -"Interactive function : +"Interactive function : send a constraints command to PhoX. Prints the constraints which should be fulfilled by unification variables, @@ -375,7 +374,7 @@ stype (nothing for any type, 'a as type parameter) :") (proof-shell-invisible-command "constraints")) (defun phox-goals() -"Interactive function : +"Interactive function : send a goals command to PhoX. Prints the list of all remaining goals, only works in proofs." @@ -412,13 +411,13 @@ stype (nothing for any type, 'a as type parameter) :") ;; obsolète probablement, sinon à modifier pour en étendre la portée. (defun phox-delete-symbol(symbol) - "Interactive function : + "Interactive function : ask for a symbol and send a delete command to PhoX for it." (interactive "ssymbol : ") (proof-shell-invisible-command (concat "del " symbol))) (defun phox-delete-symbol-on-cursor() -"Interactive function : +"Interactive function : send a delete command to PhoX for the symbol whose name is under the cursor." (interactive) (let (start end) @@ -434,6 +433,3 @@ send a delete command to PhoX for the symbol whose name is under the cursor." ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (provide 'phox-fun) - - - diff --git a/phox/phox-lang.el b/phox/phox-lang.el index a67941e4..a83328b8 100644 --- a/phox/phox-lang.el +++ b/phox/phox-lang.el @@ -1,9 +1,10 @@ -;; $State$ $Date$ $Revision$ +;; $State$ $Date$ $Revision$ ;;--------------------------------------------------------------------------;; ;;--------------------------------------------------------------------------;; ;; messages in various languages (provide 'phox-lang) +(require 'cl) ; for case (defvar phox-lang (let* ((s1 (getenv "LANG")) (s2 (getenv "LC_LANG")) (s (substring (if s1 s1 (if s2 s2 "en")) 0 2))) @@ -12,9 +13,9 @@ ((string= s "fr") 'fr) (t 'en)))) - + (defun phox-lang-absurd () - (case phox-lang + (case phox-lang (en "By absurd") (fr "Par l'absurde"))) @@ -24,7 +25,7 @@ (fr (concat "Supprimer l'hypothèse " s " (si elle est devenue inutile)")))) (defun phox-lang-opendef () - (case phox-lang + (case phox-lang (en "Expand the definition: ") (fr "Ouvre la définition : "))) @@ -49,11 +50,11 @@ (fr (concat "Dévérouille la variable " s)))) (defun phox-lang-prove (s) - (case phox-lang + (case phox-lang (en (concat "Let us prove \\[" s "\\]")) (fr (concat "Prouvons \\[" s "\\]")))) (defun phox-lang-let (s) - (case phox-lang + (case phox-lang (en (concat "Let \\[ \\] = \\[" s "\\]")) (fr (concat "Définissons \\[ \\] = \\[" s "\\]")))) diff --git a/phox/phox-outline.el b/phox/phox-outline.el index 766bddb3..329e2421 100644 --- a/phox/phox-outline.el +++ b/phox/phox-outline.el @@ -7,20 +7,20 @@ (setq phox-outline-title-regexp "\\((\\*[ \t\n]*title =\\)") (setq phox-outline-section-regexp "\\((\\*\\*+\\)") (setq phox-outline-save-regexp "\\((\\*#\\)") -(setq - phox-outline-theo-regexp +(setq + phox-outline-theo-regexp "\\((\\*lem\\)\\|\\((\\*prop\\)\\|\\((\\*fact\\)\\|\\((\\*theo\\)\\|\\((\\*def\\)\\|\\((\\*cst\\)") -(setq - phox-outline-theo2-regexp +(setq + phox-outline-theo2-regexp "\\(lem\\)\\|\\(prop\\)\\|\\(fact\\)\\|\\(theo\\)\\|\\(def\\)\\|\\(cst\\)\\|\\(claim\\)\\|\\(new_\\)") -(setq - phox-outline-regexp - (concat - phox-outline-title-regexp "\\|" - phox-outline-section-regexp "\\|" - phox-outline-save-regexp "\\|" - phox-outline-theo-regexp "\\|" +(setq + phox-outline-regexp + (concat + phox-outline-title-regexp "\\|" + phox-outline-section-regexp "\\|" + phox-outline-save-regexp "\\|" + phox-outline-theo-regexp "\\|" phox-outline-theo2-regexp)) (setq phox-outline-heading-end-regexp "\\(\\*)[ \t]*\n\\)\\|\\(\\.[ \t]*\n\\)") diff --git a/phox/phox-pbrpm.el b/phox/phox-pbrpm.el index 9c7411f3..5e831938 100644 --- a/phox/phox-pbrpm.el +++ b/phox/phox-pbrpm.el @@ -1,4 +1,4 @@ -;; $State$ $Date$ $Revision$ +;; $State$ $Date$ $Revision$ ;;--------------------------------------------------------------------------;; ;;--------------------------------------------------------------------------;; ;; the proof by rules popup menu part @@ -43,15 +43,15 @@ "build a menu from a string send by phox" (setq str (proof-shell-invisible-cmd-get-result str)) (if (string= str "") nil - (mapcar - (lambda (s) (append (list order) (split-string s "\\\\-") + (mapcar + (lambda (s) (append (list order) (split-string s "\\\\-") (list 'phox-pbrpm-rename-in-cmd))) (split-string str "\\\\\\\\")))) (defun phox-pbrpm-rename-in-cmd (cmd spans) (let ((modified nil) (prev 0)) - (mapc (lambda (span) - (if (not (string= (span-property span 'original-text) + (mapc (lambda (span) + (if (not (string= (span-property span 'original-text) (span-string span))) (setq modified (cons span modified)))) spans) (setq modified (reverse modified)) @@ -61,8 +61,8 @@ (progn (while (and modified (= 0 (span-property (car modified) 'goalnum))) (let ((span (pop modified))) - (setq cmd (concat cmd ";; rename " - (span-property span 'original-text) " " + (setq cmd (concat cmd ";; rename " + (span-property span 'original-text) " " (span-string span))))) (if modified (setq cmd (concat "(" cmd ")"))))) (if modified (setq cmd (concat cmd ";; "))) @@ -72,7 +72,7 @@ (while (< (+ prev 1) goalnum) (setq cmd (concat cmd "idt @+@ ")) (setq prev (+ prev 1))) - (setq cmd (concat cmd "(rename " (span-property span 'original-text) " " + (setq cmd (concat cmd "(rename " (span-property span 'original-text) " " (span-string span))) (setq prev goalnum) (if (or (not modified) (< goalnum (span-property (car modified) 'goalnum))) @@ -80,7 +80,7 @@ (setq cmd (concat cmd ";; "))))) (if (> prev 0) (setq cmd (concat cmd "idt")))))) cmd) - + (defun phox-pbrpm-get-region-name (region-info) (if (= (nth 0 region-info) 1) (nth 1 region-info) (nth 2 region-info))) @@ -96,11 +96,11 @@ (let ((pbrpm-rules-list nil) (goal-prefix - (if (= (nth 0 click-infos) 1) "" + (if (= (nth 0 click-infos) 1) "" (concat "[" (int-to-string (nth 0 click-infos)) "] ")))) - + ; the first goal is the selected one by default, so we prefer not to display it. @@ -123,13 +123,13 @@ ; if clicking a conclusion with a selection (if (and (string= (nth 1 click-infos) "none") region-infos) (setq pbrpm-rules-list - (append pbrpm-rules-list + (append pbrpm-rules-list (phox-pbrpm-menu-from-string 0 (concat "menu_intro " - (int-to-string (nth 0 click-infos)) + (int-to-string (nth 0 click-infos)) (let ((tmp "")) (mapc (lambda (region-info) - (setq tmp + (setq tmp (concat tmp " " (phox-pbrpm-escape-string (nth 2 region-info))))) region-infos) tmp))) @@ -138,7 +138,7 @@ (int-to-string (nth 0 click-infos)) " " (let ((tmp "")) (mapc (lambda (region-info) - (setq tmp + (setq tmp (concat tmp " " (phox-pbrpm-escape-string (phox-pbrpm-get-region-name region-info))))) region-infos) tmp)))))) @@ -158,7 +158,7 @@ (if (char= (string-to-char r) ?t) (list (list 9 (phox-lang-suppress (nth 1 click-infos)) - (concat "[" (int-to-string (nth 0 click-infos)) "] " + (concat "[" (int-to-string (nth 0 click-infos)) "] " "rmh " (nth 1 click-infos)))) nil) (phox-pbrpm-menu-from-string 1 @@ -176,19 +176,19 @@ (nth 1 click-infos))))))) ; if clicking on an hypothesis with a selection - (if (and + (if (and (not (or (string= (nth 1 click-infos) "none") (string= (nth 1 click-infos) "whole"))) region-infos) (setq pbrpm-rules-list - (append pbrpm-rules-list + (append pbrpm-rules-list (phox-pbrpm-menu-from-string 1 (concat "menu_apply " (int-to-string (nth 0 click-infos)) " " (nth 1 click-infos) (let ((tmp "")) (mapc (lambda (region-info) - (setq tmp + (setq tmp (concat tmp " " (phox-pbrpm-escape-string (nth 2 region-info))))) region-infos) tmp))) @@ -198,7 +198,7 @@ (nth 1 click-infos) (let ((tmp "")) (mapc (lambda (region-info) - (setq tmp + (setq tmp (concat tmp " " (phox-pbrpm-escape-string (phox-pbrpm-get-region-name region-info))))) region-infos) tmp)))))) @@ -207,12 +207,12 @@ region-infos (not (cdr region-infos))) (setq pbrpm-rules-list (append pbrpm-rules-list - (list (list 0 (concat + (list (list 0 (concat (phox-lang-instance (nth 2 click-infos)) (nth 2 (car region-infos))) - (concat + (concat "instance " - (nth 2 click-infos) + (nth 2 click-infos) " " (nth 2 (car region-infos)))))))) @@ -220,13 +220,13 @@ (not region-infos)) (setq pbrpm-rules-list (append pbrpm-rules-list - (list (list 0 (concat + (list (list 0 (concat (phox-lang-open-instance (nth 2 click-infos))) - (concat + (concat "instance " - (nth 2 click-infos) + (nth 2 click-infos) " ") - (lambda (cmd spans) + (lambda (cmd spans) (let ((span (pop spans))) (concat cmd " " (span-string span))))))))) @@ -234,8 +234,8 @@ (if (and (not region-infos) (not (string= (nth 2 click-infos) ""))) (let ((r (proof-shell-invisible-cmd-get-result (concat "is_definition " (int-to-string (nth 0 click-infos)) - " " - (phox-pbrpm-escape-string (nth 2 click-infos))))) + " " + (phox-pbrpm-escape-string (nth 2 click-infos))))) (ri (proof-shell-invisible-cmd-get-result (concat "is_definition " (int-to-string (nth 0 click-infos)) " " @@ -243,14 +243,14 @@ (if (or (char= (string-to-char r) ?t) (char= (string-to-char ri) ?t)) (setq pbrpm-rules-list (append pbrpm-rules-list - (list (list 1 (concat + (list (list 1 (concat (phox-lang-opendef) (nth 2 click-infos)) - (concat + (concat goal-prefix - (if (or (string= (nth 1 click-infos) "none") + (if (or (string= (nth 1 click-infos) "none") (string= (nth 1 click-infos) "whole")) - "unfold -ortho " + "unfold -ortho " (concat "unfold_hyp " (nth 1 click-infos) " -ortho ")) "$" (nth 2 click-infos)))))) @@ -261,14 +261,14 @@ (setq pbrpm-rules-list (append pbrpm-rules-list (list (list 0 (phox-lang-unlock (nth 2 click-infos)) - (concat + (concat goal-prefix "unlock " (nth 2 click-infos)))))) (setq pbrpm-rules-list (append pbrpm-rules-list (list (list 0 (phox-lang-lock (nth 2 click-infos)) - (concat + (concat goal-prefix "lock " (nth 2 click-infos)))))))))))) @@ -278,12 +278,12 @@ (append pbrpm-rules-list (list (list 10 "Trivial ?" (concat goal-prefix "trivial")) - (list 10 (phox-lang-prove arg) (concat goal-prefix "prove") - (lambda (cmd spans) + (list 10 (phox-lang-prove arg) (concat goal-prefix "prove") + (lambda (cmd spans) (let ((span (pop spans))) (concat cmd " " (span-string span))))) - (list 10 (phox-lang-let arg) (concat goal-prefix "local") - (lambda (cmd spans) + (list 10 (phox-lang-let arg) (concat goal-prefix "local") + (lambda (cmd spans) (let ((span1 (pop spans)) (span2 (pop spans))) (concat cmd " " (span-string span1) " = "(span-string span2))))))))) diff --git a/phox/phox-sym-lock.el b/phox/phox-sym-lock.el index e13f56a8..38d93441 100644 --- a/phox/phox-sym-lock.el +++ b/phox/phox-sym-lock.el @@ -16,14 +16,14 @@ ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; History -;; +;; ;; first prototype by wg <wg@cs.tu-berlin.de> 5-96 ;; tweaked by Steve Dunham <dunham@gdl.msu.edu> 5-96 ;; rewritten and enhanced by Albert Cohen <Albert.Cohen@prism.uvsq.fr> 3-97 ;; new symbol-face format and ergonomy improvement by Albert Cohen 2-98 ;; major step towards portability and customization by Albert Cohen 5-98 ;; removed bug with multiple appends in hook by Albert Cohen 3-99 -;; removed phox-sym-lock-face&atom which where not working by C Raffalli 4-2000 +;; removed phox-sym-lock-face&atom which where not working by C Raffalli 4-2000 ;; more about symbol font ? check out: xfd -fn '-adobe-symbol-*--12-*' @@ -76,14 +76,14 @@ "Generate a new internal symbol." ;; where is the standard function to do this ? (setq phox-sym-lock-sym-count (+ phox-sym-lock-sym-count 1)) - (intern (concat "phox-sym-lock-gen-" (or prefix "") + (intern (concat "phox-sym-lock-gen-" (or prefix "") (int-to-string phox-sym-lock-sym-count)))) (defun phox-sym-lock-make-symbols-atomic (&optional begin end) "Function to make symbol faces atomic." (if phox-sym-lock-enabled - (map-extents + (map-extents (lambda (extent maparg) (let ((face (extent-face extent)) (ext)) (if (and face (setq ext (face-property face 'phox-sym-lock-remap))) @@ -128,7 +128,7 @@ (lf (and (fboundp 'list-fonts) ; da: what is this function? not defined (list-fonts font-pat)))) (while (and lf maxsize) - (if + (if (string-match font-reg (car lf)) (let ((str-size (substring (car lf) (match-beginning 1) @@ -171,8 +171,8 @@ ;; 'final 53 ;; DA PG 3.7: above line doesn't work on XEmacs 21.5b28, gives ;; Character set already defined for this DIMENSION/CHARS/FINAL/DIRECTION combo (indian-is13194) -;; DA: Will 55 work? - 'final 55 +;; DA: Will 55 work? + 'final 55 'graphic 0)) (make-charset 'phox-sym-lock-cset-right "Char set for symbol font" (list 'registry "adobe-fontspecific" @@ -180,10 +180,10 @@ 'chars 94 'final 54 'graphic 1)) - (set-face-property 'phox-sym-lock-adobe-symbol-face + (set-face-property 'phox-sym-lock-adobe-symbol-face 'font phox-sym-lock-font-name nil ;; DA: removed next line, it breaks "make magic" in doc - ;; '(mule-fonts) 'prepend, + ;; '(mule-fonts) 'prepend, )) (set-face-font 'phox-sym-lock-adobe-symbol-face phox-sym-lock-font-name 'global)) @@ -243,7 +243,7 @@ the empty string. OBJ may either be a string or a character." (fillarray table "") (set-face-property tface 'display-table table) (set-face-property tface 'phox-sym-lock-remap 1) ; mark it - tface + tface ;; return face value and not face name ;; the temporary face would be otherwise GCed )) @@ -259,7 +259,7 @@ face's extent will become atomic." (defun phox-sym-lock-rec (fl) (let ((f (car fl))) - (if f + (if f (cons (apply 'phox-sym-lock-atom-face f) (phox-sym-lock-rec (cdr fl)))))) @@ -333,7 +333,7 @@ OBJ under `phox-sym-lock-adobe-symbol-face'. The face extent will become atomic. ["Phox-Sym-Lock" (if phox-sym-lock-enabled (phox-sym-lock-disable) (phox-sym-lock-enable)) :style toggle :selected phox-sym-lock-enabled - :active phox-sym-lock-keywords] "Automatic") + :active phox-sym-lock-keywords] "Automatic") (if (and (featurep 'phox-sym-lock) phox-sym-lock-enabled font-lock-defaults (boundp 'phox-sym-lock-keywords)) (progn @@ -345,8 +345,8 @@ OBJ under `phox-sym-lock-adobe-symbol-face'. The face extent will become atomic. (and (featurep 'font-lock) (if font-lock-auto-fontify - (not (memq major-mode font-lock-mode-disable-list)) - (memq major-mode font-lock-mode-enable-list)) + (not (memq major-mode font-lock-mode-disable-list)) + (memq major-mode font-lock-mode-enable-list)) (font-lock-set-defaults-1 explicit-defaults) (phox-sym-lock-patch-keywords)) (turn-on-font-lock))) diff --git a/phox/phox-tags.el b/phox/phox-tags.el index 70a4fb2a..8ff2848d 100644 --- a/phox/phox-tags.el +++ b/phox/phox-tags.el @@ -1,4 +1,4 @@ -;; $State$ $Date$ $Revision$ +;; $State$ $Date$ $Revision$ ;;--------------------------------------------------------------------------;; ;;--------------------------------------------------------------------------;; ;; gestion des TAGS @@ -43,7 +43,7 @@ (interactive) (phox-tags-add-table (concat phox-lib-dir "/TAGS")) ) - + (defun phox-tags-add-local-table() "Add the tags table created with function phox-create-local-table." (interactive) @@ -53,8 +53,8 @@ (defun phox-tags-create-local-table() "create table on local buffer" (interactive) - (shell-command (concat phox-etags - " -o " + (shell-command (concat phox-etags + " -o " (file-name-nondirectory (buffer-file-name)) "TAGS " (file-name-nondirectory (buffer-file-name)))) @@ -85,6 +85,3 @@ ) (provide 'phox-tags) - - - |