diff options
Diffstat (limited to 'lisp/progmodes')
53 files changed, 3410 insertions, 2246 deletions
diff --git a/lisp/progmodes/ada-mode.el b/lisp/progmodes/ada-mode.el index d8f4ffffea5..2c3acdda176 100644 --- a/lisp/progmodes/ada-mode.el +++ b/lisp/progmodes/ada-mode.el @@ -1145,7 +1145,7 @@ If you use ada-xref.el: (interactive) (kill-all-local-variables) - + (set-syntax-table ada-mode-syntax-table) (set (make-local-variable 'require-final-newline) mode-require-final-newline) @@ -1396,13 +1396,11 @@ If you use ada-xref.el: (progn (goto-char (symbol-value 'beg)) (forward-word -1) (point)) (goto-char aa-end))))) -;; transient-mark-mode and mark-active are not defined in XEmacs (defun ada-region-selected () - "Return t if a region has been selected by the user and is still active." - (if (featurep 'xemacs) - (region-active-p) - (and transient-mark-mode mark-active))) - + "Should we operate on an active region?" + (if (fboundp 'use-region-p) + (use-region-p) + (region-active-p))) ;;----------------------------------------------------------------- ;; auto-casing @@ -1423,12 +1421,12 @@ If you use ada-xref.el: Casing exception lists are `ada-case-exception' and `ada-case-exception-substring'." (find-file (expand-file-name file-name)) (erase-buffer) - (mapcar (lambda (x) (insert (car x) "\n")) - (sort (copy-sequence ada-case-exception) - (lambda(a b) (string< (car a) (car b))))) - (mapcar (lambda (x) (insert "*" (car x) "\n")) - (sort (copy-sequence ada-case-exception-substring) - (lambda(a b) (string< (car a) (car b))))) + (mapc (lambda (x) (insert (car x) "\n")) + (sort (copy-sequence ada-case-exception) + (lambda(a b) (string< (car a) (car b))))) + (mapc (lambda (x) (insert "*" (car x) "\n")) + (sort (copy-sequence ada-case-exception-substring) + (lambda(a b) (string< (car a) (car b))))) (save-buffer) (kill-buffer nil) ) @@ -4583,7 +4581,7 @@ Moves to 'begin' if in a declarative part." ;; The following keys are bound to functions defined in ada-xref.el or ;; ada-prj,el., However, RMS rightly thinks that the code should be shared, ;; and activated only if the right compiler is used - + (define-key ada-mode-map (if (featurep 'xemacs) '(shift button3) [S-mouse-3]) 'ada-point-and-xref) (define-key ada-mode-map [(control tab)] 'ada-complete-identifier) @@ -4813,10 +4811,9 @@ Moves to 'begin' if in a declarative part." ;; ------------------------------------------------------- (defadvice comment-region (before ada-uncomment-anywhere disable) - (if (and arg - (listp arg) ;; a prefix with \C-u is of the form '(4), whereas + (if (and (consp arg) ;; a prefix with \C-u is of the form '(4), whereas ;; \C-u 2 sets arg to '2' (fixed by S.Leake) - (string= mode-name "Ada")) + (derived-mode-p 'ada-mode)) (save-excursion (let ((cs (concat "^[ \t]*" (regexp-quote comment-start)))) (goto-char beg) diff --git a/lisp/progmodes/ada-prj.el b/lisp/progmodes/ada-prj.el index 5b801364f8d..be2d320351d 100644 --- a/lisp/progmodes/ada-prj.el +++ b/lisp/progmodes/ada-prj.el @@ -254,8 +254,8 @@ The current buffer must be the project editing buffer." (progn (setq widget-field-new nil widget-field-list nil) - (mapcar (lambda (x) (delete-overlay x)) (car (overlay-lists))) - (mapcar (lambda (x) (delete-overlay x)) (cdr (overlay-lists))))) + (mapc (lambda (x) (delete-overlay x)) (car (overlay-lists))) + (mapc (lambda (x) (delete-overlay x)) (cdr (overlay-lists))))) ;; Display the tabs diff --git a/lisp/progmodes/ada-xref.el b/lisp/progmodes/ada-xref.el index 77d4213a6db..f9b5c026a4e 100644 --- a/lisp/progmodes/ada-xref.el +++ b/lisp/progmodes/ada-xref.el @@ -564,7 +564,7 @@ Completion is available." (let ((file (ada-find-src-file-in-dir filename))) (if file (find-file file) - (error (concat filename " not found in src_dir"))))) + (error "%s not found in src_dir" filename)))) ;; ----- Utilities ------------------------------------------------- @@ -648,8 +648,8 @@ is non-nil, prompt the user to select one. If none are found, return (let (selected) - (if (or (not (string= mode-name "Ada")) - (not (buffer-file-name))) + (if (not (and (derived-mode-p 'ada-mode) + buffer-file-name)) ;; Not in an Ada buffer, or current buffer not associated ;; with a file (for instance an emerge buffer) @@ -1706,7 +1706,7 @@ Information is extracted from the ali file." (beginning-of-line) ;; while we have a continuation line, go up one line (while (looking-at "^\\.") - (previous-line 1) + (forward-line -1) (beginning-of-line)) (unless (looking-at (concat "[0-9]+.[0-9]+[ *]" (ada-name-of identlist) "[ <{=\(\[]")) @@ -1722,8 +1722,8 @@ Information is extracted from the ali file." ;; No more idea to find the declaration. Give up (progn (kill-buffer ali-buffer) - (error (concat "No declaration of " (ada-name-of identlist) - " found.")) + + (error "No declaration of %s found." (ada-name-of identlist)) ))) ) @@ -1735,11 +1735,11 @@ Information is extracted from the ali file." (let ((current-line (buffer-substring (point) (save-excursion (end-of-line) (point))))) (save-excursion - (next-line 1) + (forward-line 1) (beginning-of-line) (while (looking-at "^\\.\\(.*\\)") (set 'current-line (concat current-line (match-string 1))) - (next-line 1)) + (forward-line 1)) ) (if (re-search-backward "^X [0-9]+ \\([a-zA-Z0-9_.-]+\\)" nil t) @@ -1808,10 +1808,8 @@ This function is disabled for operators, and only works for identifiers." ;; none => error ((= len 0) (kill-buffer (current-buffer)) - (error (concat "No declaration of " - (ada-name-of identlist) - " recorded in .ali file"))) - + (error "No declaration of %s recorded in .ali file" + (ada-name-of identlist))) ;; one => should be the right one ((= len 1) (goto-line (caar declist))) @@ -2011,7 +2009,7 @@ the declaration and documentation of the subprograms one is using." (string-to-number (nth 2 (car list))) identlist other-frame) - (error (concat (caar list) " not found in src_dir"))) + (error "%s not found in src_dir" (caar list))) (message "This is only a (good) guess at the cross-reference.") ) @@ -2312,5 +2310,5 @@ For instance, it creates the gnat-specific menus, sets some hooks for (provide 'ada-xref) -;;; arch-tag: 415a39fe-577b-4676-b3b1-6ff6db7ca24e +;; arch-tag: 415a39fe-577b-4676-b3b1-6ff6db7ca24e ;;; ada-xref.el ends here diff --git a/lisp/progmodes/antlr-mode.el b/lisp/progmodes/antlr-mode.el index 976b4d37f4f..969ad7d667f 100644 --- a/lisp/progmodes/antlr-mode.el +++ b/lisp/progmodes/antlr-mode.el @@ -85,12 +85,17 @@ ;;; Code: -(provide 'antlr-mode) +(eval-when-compile + (require 'cl)) + (require 'easymenu) +;; Just to get the rid of the byte compiler warning. The code for +;; this function and its friends are too complex for their own good. +(declare-function cond-emacs-xemacs-macfn "antlr-mode" (args &optional msg)) + ;; General Emacs/XEmacs-compatibility compile-time macros -(eval-when-compile - (require 'cl) +(eval-when-compile (defmacro cond-emacs-xemacs (&rest args) (cond-emacs-xemacs-macfn args "`cond-emacs-xemacs' must return exactly one element")) @@ -99,7 +104,7 @@ (and (eq (car args) :@) (null msg) ; (:@ ...spliced...) (setq args (cdr args) msg "(:@ ....) must return exactly one element")) - (let ((ignore (if (string-match "XEmacs" emacs-version) :EMACS :XEMACS)) + (let ((ignore (if (featurep 'xemacs) :EMACS :XEMACS)) (mode :BOTH) code) (while (consp args) (if (memq (car args) '(:EMACS :XEMACS :BOTH)) (setq mode (pop args))) @@ -115,7 +120,7 @@ ;; existing functions when they are `fboundp', provide shortcuts if they are ;; known to be defined in a specific Emacs branch (for short .elc) (defmacro defunx (name arglist &rest definition) - (let ((xemacsp (string-match "XEmacs" emacs-version)) reuses) + (let ((xemacsp (featurep 'xemacs)) reuses) (while (memq (car definition) '(:try :emacs-and-try :xemacs-and-try)) (if (eq (pop definition) (if xemacsp :xemacs-and-try :emacs-and-try)) @@ -152,7 +157,7 @@ (defmacro ignore-errors-x (&rest body) (let ((specials '((scan-sexps . 4) (scan-lists . 5))) spec nils) - (if (and (string-match "XEmacs" emacs-version) + (if (and (featurep 'xemacs) (null (cdr body)) (consp (car body)) (setq spec (assq (caar body) specials)) (>= (setq nils (- (cdr spec) (length (car body)))) 0)) @@ -166,7 +171,7 @@ `(let ((,modified (buffer-modified-p))) (unwind-protect (let ((buffer-undo-list t) (inhibit-read-only t) - ,@(unless (string-match "XEmacs" emacs-version) + ,@(unless (featurep 'xemacs) '((inhibit-point-motion-hooks t) deactivate-mark)) before-change-functions after-change-functions buffer-file-name buffer-file-truename) @@ -176,15 +181,12 @@ (put 'save-buffer-state-x 'lisp-indent-function 0) ;; get rid of byte-compile warnings -(eval-when-compile ; required and optional libraries - (require 'cc-mode) - (ignore-errors (require 'font-lock)) - (ignore-errors (require 'compile)) - ;;(ignore-errors (defun c-init-language-vars))) dangerous on Emacs! - ;;(ignore-errors (defun c-init-c-language-vars))) dangerous on Emacs! - ;;(ignore-errors (defun c-basic-common-init)) dangerous on Emacs! - (defvar outline-level) (defvar imenu-use-markers) - (defvar imenu-create-index-function)) +(eval-when-compile + (require 'cc-mode)) + +(defvar outline-level) +(defvar imenu-use-markers) +(defvar imenu-create-index-function) ;; We cannot use `c-forward-syntactic-ws' directly since it is a macro since ;; cc-mode-5.30 => antlr-mode compiled with older cc-mode would fail (macro @@ -840,7 +842,8 @@ Do not change." (defface antlr-keyword (cond-emacs-xemacs '((((class color) (background light)) - (:foreground "black" :EMACS :weight bold :XEMACS :bold t)))) + (:foreground "black" :EMACS :weight bold :XEMACS :bold t)) + (t :inherit font-lock-keyword-face))) "ANTLR keywords." :group 'antlr) ;; backward-compatibility alias @@ -850,7 +853,8 @@ Do not change." (defface antlr-syntax (cond-emacs-xemacs '((((class color) (background light)) - (:foreground "black" :EMACS :weight bold :XEMACS :bold t)))) + (:foreground "black" :EMACS :weight bold :XEMACS :bold t)) + (t :inherit font-lock-constant-face))) "ANTLR syntax symbols like :, |, (, ), ...." :group 'antlr) ;; backward-compatibility alias @@ -860,7 +864,8 @@ Do not change." (defface antlr-ruledef (cond-emacs-xemacs '((((class color) (background light)) - (:foreground "blue" :EMACS :weight bold :XEMACS :bold t)))) + (:foreground "blue" :EMACS :weight bold :XEMACS :bold t)) + (t :inherit font-lock-function-name-face))) "ANTLR rule references (definition)." :group 'antlr) ;; backward-compatibility alias @@ -870,7 +875,8 @@ Do not change." (defface antlr-tokendef (cond-emacs-xemacs '((((class color) (background light)) - (:foreground "blue" :EMACS :weight bold :XEMACS :bold t)))) + (:foreground "blue" :EMACS :weight bold :XEMACS :bold t)) + (t :inherit font-lock-function-name-face))) "ANTLR token references (definition)." :group 'antlr) ;; backward-compatibility alias @@ -878,7 +884,8 @@ Do not change." (defvar antlr-ruleref-face 'antlr-ruleref) (defface antlr-ruleref - '((((class color) (background light)) (:foreground "blue4"))) + '((((class color) (background light)) (:foreground "blue4")) + (t :inherit font-lock-type-face)) "ANTLR rule references (usage)." :group 'antlr) ;; backward-compatibility alias @@ -886,7 +893,8 @@ Do not change." (defvar antlr-tokenref-face 'antlr-tokenref) (defface antlr-tokenref - '((((class color) (background light)) (:foreground "orange4"))) + '((((class color) (background light)) (:foreground "orange4")) + (t :inherit font-lock-type-face)) "ANTLR token references (usage)." :group 'antlr) ;; backward-compatibility alias @@ -896,7 +904,8 @@ Do not change." (defface antlr-literal (cond-emacs-xemacs '((((class color) (background light)) - (:foreground "brown4" :EMACS :weight bold :XEMACS :bold t)))) + (:foreground "brown4" :EMACS :weight bold :XEMACS :bold t)) + (t :inherit font-lock-string-face))) "ANTLR special literal tokens. It is used to highlight strings matched by the first regexp group of `antlr-font-lock-literal-regexp'." @@ -1868,7 +1877,7 @@ cell where the two values determine the area inside the braces." (read initial) initial)) (cdr value)))) - (message (cadr value)) + (message "%s" (or (cadr value) "")) (setq value nil))) ;; insert value ---------------------------------------------------------- (if (consp old) @@ -2662,6 +2671,8 @@ Used in `antlr-mode'. Also a useful function in `java-mode-hook'." indent-tabs-mode (cadddr elem) alist nil)))))) +(provide 'antlr-mode) + ;;; Local IspellPersDict: .ispell_antlr ;;; arch-tag: 5de2be79-3d13-4560-8fbc-f7d0234dcb5c diff --git a/lisp/progmodes/autoconf.el b/lisp/progmodes/autoconf.el index 4e8e3b76597..def9f05072d 100644 --- a/lisp/progmodes/autoconf.el +++ b/lisp/progmodes/autoconf.el @@ -49,7 +49,7 @@ '(("\\<dnl\\>" 0 '(11)))) (defconst autoconf-definition-regexp - "AC_\\(SUBST\\|DEFINE\\(_UNQUOTED\\)?\\)(\\(\\sw+\\)") + "AC_\\(SUBST\\|DEFINE\\(_UNQUOTED\\)?\\)(\\[*\\(\\sw+\\)\\]*") (defvar autoconf-font-lock-keywords `(("\\_<A[CHMS]_\\sw+" . font-lock-keyword-face) diff --git a/lisp/progmodes/cc-bytecomp.el b/lisp/progmodes/cc-bytecomp.el index bdf1906e6dd..4ac6091798c 100644 --- a/lisp/progmodes/cc-bytecomp.el +++ b/lisp/progmodes/cc-bytecomp.el @@ -395,8 +395,8 @@ Don't use within `eval-when-compile'." (defun cc-bytecomp-ignore-obsolete (form) ;; Wraps a call to `byte-compile-obsolete' that suppresses the warning. - (let ((byte-compile-warnings - (delq 'obsolete (append byte-compile-warnings nil)))) + (let ((byte-compile-warnings byte-compile-warnings)) + (byte-compile-disable-warning 'obsolete) (byte-compile-obsolete form))) (defmacro cc-bytecomp-obsolete-fun (symbol) diff --git a/lisp/progmodes/cc-cmds.el b/lisp/progmodes/cc-cmds.el index e2bc7d55dc9..8d3facb08b6 100644 --- a/lisp/progmodes/cc-cmds.el +++ b/lisp/progmodes/cc-cmds.el @@ -2595,7 +2595,7 @@ sentence motion in or near comments and multiline strings." ;; set up electric character functions to work with pending-del, ;; (a.k.a. delsel) mode. All symbols get the t value except ;; the functions which delete, which gets 'supersede. -(mapcar +(mapc (function (lambda (sym) (put sym 'delete-selection t) ; for delsel (Emacs) @@ -3069,15 +3069,17 @@ non-nil." ;; compiled, e.g. in the menus. (c-region-is-active-p)) -(defun c-indent-line-or-region () - "When the region is active, indent it syntactically. Otherwise -indent the current line syntactically." - ;; Emacs has a variable called mark-active, XEmacs uses region-active-p - (interactive) - (if (c-region-is-active-p) +(defun c-indent-line-or-region (&optional arg region) + "Indent active region, current line, or block starting on this line. +In Transient Mark mode, when the region is active, reindent the region. +Othewise, with a prefix argument, rigidly reindent the expression +starting on the current line. +Otherwise reindent just the current line." + (interactive + (list current-prefix-arg (use-region-p))) + (if region (c-indent-region (region-beginning) (region-end)) - (c-indent-line))) - + (c-indent-command arg))) ;; for progress reporting (defvar c-progress-info nil) @@ -3863,7 +3865,12 @@ command to conveniently insert and align the necessary backslashes." (save-excursion (goto-char (cdr c-lit-limits)) (beginning-of-line) - (and (search-forward-regexp + ;; The following conjunct was added to avoid an + ;; "Invalid search bound (wrong side of point)" + ;; error in the subsequent re-search. Maybe + ;; another fix would be needed (2007-12-08). + (and (> (- (cdr c-lit-limits) 2) (point)) + (search-forward-regexp (concat "\\=[ \t]*\\(" c-current-comment-prefix "\\)") (- (cdr c-lit-limits) 2) t) (not (search-forward-regexp diff --git a/lisp/progmodes/cc-defs.el b/lisp/progmodes/cc-defs.el index 9dbd5161a84..288aca687aa 100644 --- a/lisp/progmodes/cc-defs.el +++ b/lisp/progmodes/cc-defs.el @@ -73,9 +73,9 @@ ; (eval-after-load "font-lock" ; 2006-07-09. font-lock is now preloaded ; ' -(if (and (not (featurep 'cc-fix)) ; only load the file once. - (featurep 'xemacs) ; There is now (2005/12) code in GNU Emacs CVS +(if (and (featurep 'xemacs) ; There is now (2005/12) code in GNU Emacs CVS ; to make the call to f-l-c-k throw an error. + (not (featurep 'cc-fix)) ; only load the file once. (let (font-lock-keywords) (font-lock-compile-keywords '("\\<\\>")) font-lock-keywords)) ; did the previous call foul this up? @@ -84,8 +84,8 @@ ;; The above takes care of the delayed loading, but this is necessary ;; to ensure correct byte compilation. (eval-when-compile - (if (and (not (featurep 'cc-fix)) - (featurep 'xemacs) + (if (and (featurep 'xemacs) + (not (featurep 'cc-fix)) (progn (require 'font-lock) (let (font-lock-keywords) @@ -337,11 +337,11 @@ to it is returned. This function does not modify the point or the mark." (defmacro c-region-is-active-p () ;; Return t when the region is active. The determination of region ;; activeness is different in both Emacs and XEmacs. - (if (cc-bytecomp-fboundp 'region-active-p) - ;; XEmacs. - '(region-active-p) - ;; Emacs. - 'mark-active)) + (if (cc-bytecomp-boundp 'mark-active) + ;; Emacs. + 'mark-active + ;; XEmacs. + '(region-active-p))) (defmacro c-set-region-active (activate) ;; Activate the region if ACTIVE is non-nil, deactivate it diff --git a/lisp/progmodes/cc-engine.el b/lisp/progmodes/cc-engine.el index 3f86e931d34..7cac158166e 100644 --- a/lisp/progmodes/cc-engine.el +++ b/lisp/progmodes/cc-engine.el @@ -4035,6 +4035,9 @@ comment at the start of cc-engine.el for more info." c-found-types) (sort type-list 'string-lessp))) +;; Shut up the byte compiler. +(defvar c-maybe-stale-found-type) + (defun c-trim-found-types (beg end old-len) ;; An after change function which, in conjunction with the info in ;; c-maybe-stale-found-type (set in c-before-change), removes a type diff --git a/lisp/progmodes/cc-fonts.el b/lisp/progmodes/cc-fonts.el index 087e71a1f11..69774b6ce9c 100644 --- a/lisp/progmodes/cc-fonts.el +++ b/lisp/progmodes/cc-fonts.el @@ -2146,7 +2146,7 @@ need for `pike-font-lock-extra-types'.") 0 ,c-doc-markup-face-name prepend nil) (,(concat header "\\(" "@" symbol "\\):") 1 ,c-doc-markup-face-name prepend nil) - (,(concat "[#%]" symbol) + (,(concat "[#%@]" symbol) 0 ,c-doc-markup-face-name prepend nil)) )) diff --git a/lisp/progmodes/cc-langs.el b/lisp/progmodes/cc-langs.el index 9e8dd282e11..ea527730620 100644 --- a/lisp/progmodes/cc-langs.el +++ b/lisp/progmodes/cc-langs.el @@ -1970,6 +1970,7 @@ identifiers that follows the type in a normal declaration." "Statement keywords followed directly by a substatement." t '("do" "else") c++ '("do" "else" "try") + objc '("do" "else" "@finally" "@try") java '("do" "else" "finally" "try") idl nil) @@ -1983,6 +1984,7 @@ identifiers that follows the type in a normal declaration." "Statement keywords followed by a paren sexp and then by a substatement." t '("for" "if" "switch" "while") c++ '("for" "if" "switch" "while" "catch") + objc '("for" "if" "switch" "while" "@catch" "@synchronized") java '("for" "if" "switch" "while" "catch" "synchronized") idl nil pike '("for" "if" "switch" "while" "foreach") @@ -2014,6 +2016,7 @@ identifiers that follows the type in a normal declaration." (c-lang-defconst c-simple-stmt-kwds "Statement keywords followed by an expression or nothing." t '("break" "continue" "goto" "return") + objc '("break" "continue" "goto" "return" "@throw") ;; Note: `goto' is not valid in Java, but the keyword is still reserved. java '("break" "continue" "goto" "return" "throw") idl nil diff --git a/lisp/progmodes/cc-mode.el b/lisp/progmodes/cc-mode.el index 24e2023ba5d..09ca49fe447 100644 --- a/lisp/progmodes/cc-mode.el +++ b/lisp/progmodes/cc-mode.el @@ -190,7 +190,8 @@ control). See \"cc-mode.el\" for more info." (run-hooks 'c-initialization-hook) ;; Fix obsolete variables. (if (boundp 'c-comment-continuation-stars) - (setq c-block-comment-prefix c-comment-continuation-stars)) + (setq c-block-comment-prefix + (symbol-value 'c-comment-continuation-stars))) (add-hook 'change-major-mode-hook 'c-leave-cc-mode-mode) (setq c-initialization-ok t)) ;; Will try initialization hooks again if they failed. @@ -269,7 +270,9 @@ control). See \"cc-mode.el\" for more info." 'c-indent-new-comment-line c-mode-base-map global-map) (substitute-key-definition 'indent-for-tab-command - 'c-indent-command + ;; XXX Is this the right thing to do + ;; here? + 'c-indent-line-or-region c-mode-base-map global-map) (when (fboundp 'comment-indent-new-line) ;; indent-new-comment-line has changed name to @@ -839,7 +842,7 @@ Note that the style variables are always made local to the buffer." (and c-file-style (c-set-style c-file-style)) (and c-file-offsets - (mapcar + (mapc (lambda (langentry) (let ((langelem (car langentry)) (offset (cdr langentry))) @@ -1428,15 +1431,15 @@ Key bindings: adaptive-fill-mode adaptive-fill-regexp) nil))) - (mapcar (lambda (var) (unless (boundp var) - (setq vars (delq var vars)))) - '(signal-error-on-buffer-boundary - filladapt-mode - defun-prompt-regexp - font-lock-mode - font-lock-maximum-decoration - parse-sexp-lookup-properties - lookup-syntax-properties)) + (mapc (lambda (var) (unless (boundp var) + (setq vars (delq var vars)))) + '(signal-error-on-buffer-boundary + filladapt-mode + defun-prompt-regexp + font-lock-mode + font-lock-maximum-decoration + parse-sexp-lookup-properties + lookup-syntax-properties)) vars) (lambda () (run-hooks 'c-prepare-bug-report-hooks) diff --git a/lisp/progmodes/cc-styles.el b/lisp/progmodes/cc-styles.el index 7c80f66e277..41f1836c0a4 100644 --- a/lisp/progmodes/cc-styles.el +++ b/lisp/progmodes/cc-styles.el @@ -381,11 +381,11 @@ a null operation." ;; fallback entry. (setq c-special-indent-hook (default-value 'c-special-indent-hook))) - (mapcar (lambda (elem) - (c-set-style-1 elem dont-override)) - ;; Need to go through the variables backwards when we - ;; don't override any settings. - (if (eq dont-override t) (nreverse vars) vars))) + (mapc (lambda (elem) + (c-set-style-1 elem dont-override)) + ;; Need to go through the variables backwards when we + ;; don't override any settings. + (if (eq dont-override t) (nreverse vars) vars))) (setq c-indentation-style stylename) (c-keep-region-active)) @@ -636,7 +636,7 @@ any reason to call this function directly." 'make-variable-buffer-local)) (varsyms (cons 'c-indentation-style (copy-alist c-style-variables)))) (delq 'c-special-indent-hook varsyms) - (mapcar func varsyms) + (mapc func varsyms) ;; Hooks must be handled specially (if this-buf-only-p (make-local-hook 'c-special-indent-hook) diff --git a/lisp/progmodes/cc-subword.el b/lisp/progmodes/cc-subword.el index 8f6ea8775f8..65e529be8b6 100644 --- a/lisp/progmodes/cc-subword.el +++ b/lisp/progmodes/cc-subword.el @@ -88,43 +88,27 @@ (cc-require 'cc-defs) (cc-require 'cc-cmds) -;; Don't complain about the `define-minor-mode' form if it isn't defined. -(cc-bytecomp-defvar c-subword-mode) - -;; Autoload directives must be on the top level, so we construct an -;; autoload form instead. -;;;###autoload (autoload 'c-subword-mode "cc-subword" "Mode enabling subword movement and editing keys." t) - -(if (not (fboundp 'define-minor-mode)) - (defun c-subword-mode () - "(Missing) mode enabling subword movement and editing keys. -This mode is not (yet) available in this version of (X)Emacs. Sorry! If -you really want it, please send a request to <bug-gnu-emacs@gnu.org>, -telling us which (X)Emacs version you're using." - (interactive) - (error - "c-subword-mode is not (yet) available in this version of (X)Emacs. Sorry!")) - - (defvar c-subword-mode-map - (let ((map (make-sparse-keymap))) - (dolist (cmd '(forward-word backward-word mark-word - kill-word backward-kill-word - transpose-words - capitalize-word upcase-word downcase-word)) - (let ((othercmd (let ((name (symbol-name cmd))) - (string-match "\\(.*-\\)\\(word.*\\)" name) - (intern (concat "c-" - (match-string 1 name) - "sub" - (match-string 2 name)))))) - (if (fboundp 'command-remapping) - (define-key map (vector 'remap cmd) othercmd) - (substitute-key-definition cmd othercmd map global-map)))) - map) - "Keymap used in command `c-subword-mode' minor mode.") - - (define-minor-mode c-subword-mode - "Mode enabling subword movement and editing keys. +(defvar c-subword-mode-map + (let ((map (make-sparse-keymap))) + (dolist (cmd '(forward-word backward-word mark-word + kill-word backward-kill-word + transpose-words + capitalize-word upcase-word downcase-word)) + (let ((othercmd (let ((name (symbol-name cmd))) + (string-match "\\(.*-\\)\\(word.*\\)" name) + (intern (concat "c-" + (match-string 1 name) + "sub" + (match-string 2 name)))))) + (if (fboundp 'command-remapping) + (define-key map (vector 'remap cmd) othercmd) + (substitute-key-definition cmd othercmd map global-map)))) + map) + "Keymap used in command `c-subword-mode' minor mode.") + +;;;###autoload +(define-minor-mode c-subword-mode + "Mode enabling subword movement and editing keys. In spite of GNU Coding Standards, it is popular to name a symbol by mixing uppercase and lowercase letters, e.g. \"GtkWidget\", \"EmacsFrameClass\", \"NSGraphicsContext\", etc. Here we call these @@ -148,8 +132,6 @@ as words. c-subword-mode-map (c-update-modeline)) - ) - (defun c-forward-subword (&optional arg) "Do the same as `forward-word' but on subwords. See the command `c-subword-mode' for a description of subwords. diff --git a/lisp/progmodes/cc-vars.el b/lisp/progmodes/cc-vars.el index af7175e4c7a..25adb2be01b 100644 --- a/lisp/progmodes/cc-vars.el +++ b/lisp/progmodes/cc-vars.el @@ -156,34 +156,44 @@ Useful as last item in a `choice' widget." (setq c-fallback-style (cons (cons name val) c-fallback-style))) (defmacro defcustom-c-stylevar (name val doc &rest args) - "Defines a style variable." - `(let ((-value- ,val)) - (c-set-stylevar-fallback ',name -value-) - (custom-declare-variable - ',name ''set-from-style - ,(concat doc " + "Define a style variable NAME with VAL and DOC. +More precisely, convert the given `:type FOO', mined out of ARGS, +to an aggregate `:type (radio STYLE (PREAMBLE FOO))', append some +some boilerplate documentation to DOC, arrange for the fallback +value of NAME to be VAL, and call `custom-declare-variable' to +do the rest of the work. + +STYLE stands for the choice where the value is taken from some +style setting. PREAMBLE is optionally prepended to FOO; that is, +if FOO contains :tag or :value, the respective two-element list +component is ignored." + (declare (debug (symbolp form stringp &rest))) + (let* ((expanded-doc (concat doc " This is a style variable. Apart from the valid values described -above, it can be set to the symbol `set-from-style'. In that case, it -takes its value from the style system (see `c-default-style' and +above, it can be set to the symbol `set-from-style'. In that case, +it takes its value from the style system (see `c-default-style' and `c-style-alist') when a CC Mode buffer is initialized. Otherwise, the value set here overrides the style system (there is a variable -`c-old-style-variable-behavior' that changes this, though).") - ,@(plist-put - args ':type - `(` (radio - (const :tag "Use style settings" - set-from-style) - ,(, (let ((type (eval (plist-get args ':type)))) - (unless (consp type) - (setq type (list type))) - (unless (c-safe (plist-get (cdr type) ':value)) - (setcdr type (append '(:value (, -value-)) - (cdr type)))) - (unless (c-safe (plist-get (cdr type) ':tag)) - (setcdr type (append '(:tag "Override style settings") - (cdr type)))) - (bq-process type))))))))) +`c-old-style-variable-behavior' that changes this, though).")) + (typ (eval (plist-get args :type))) + (type (if (consp typ) typ (list typ))) + (head (car type)) + (tail (cdr type)) + (newt (append (unless (plist-get tail :tag) + '(:tag "Override style settings")) + (unless (plist-get tail :value) + `(:value ,(eval val))) + tail)) + (aggregate `'(radio + (const :tag "Use style settings" set-from-style) + ,(cons head newt)))) + `(progn + (c-set-stylevar-fallback ',name ,val) + (custom-declare-variable + ',name ''set-from-style + ,expanded-doc + ,@(plist-put args :type aggregate))))) (defun c-valid-offset (offset) "Return non-nil if OFFSET is a valid offset for a syntactic symbol. @@ -430,12 +440,13 @@ comment-only lines." ;; Although c-comment-continuation-stars is obsolete, we look at it in ;; some places in CC Mode anyway, so make the compiler ignore it ;; during our compilation. -(cc-bytecomp-obsolete-var c-comment-continuation-stars) -(cc-bytecomp-defvar c-comment-continuation-stars) +;; [This is unclean; better to use `symbol-value'. --ttn] +;;(cc-bytecomp-obsolete-var c-comment-continuation-stars) +;;(cc-bytecomp-defvar c-comment-continuation-stars) (defcustom-c-stylevar c-block-comment-prefix (if (boundp 'c-comment-continuation-stars) - c-comment-continuation-stars + (symbol-value 'c-comment-continuation-stars) "* ") "*Specifies the line prefix of continued C-style block comments. You should set this variable to the literal string that gets inserted diff --git a/lisp/progmodes/compile.el b/lisp/progmodes/compile.el index 1fd0074dd41..772d35f94f0 100644 --- a/lisp/progmodes/compile.el +++ b/lisp/progmodes/compile.el @@ -1,7 +1,8 @@ ;;; compile.el --- run compiler as inferior of Emacs, parse error messages ;; Copyright (C) 1985, 1986, 1987, 1993, 1994, 1995, 1996, 1997, 1998, 1999, -;; 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008 Free Software Foundation, Inc. +;; 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008 +;; Free Software Foundation, Inc. ;; Authors: Roland McGrath <roland@gnu.org>, ;; Daniel Pfeiffer <occitan@esperanto.org> @@ -38,11 +39,14 @@ ;; LINE will be nil for a message that doesn't contain them. Then the ;; location refers to a indented beginning of line or beginning of file. ;; Once any location in some file has been jumped to, the list is extended to -;; (COLUMN LINE FILE-STRUCTURE MARKER . VISITED) for all LOCs pertaining to -;; that file. +;; (COLUMN LINE FILE-STRUCTURE MARKER TIMESTAMP . VISITED) +;; for all LOCs pertaining to that file. ;; MARKER initially points to LINE and COLUMN in a buffer visiting that file. ;; Being a marker it sticks to some text, when the buffer grows or shrinks ;; before that point. VISITED is t if we have jumped there, else nil. +;; TIMESTAMP is necessary because of "incremental compilation": `omake -P' +;; polls filesystem for changes and recompiles when a file is modified +;; using the same *compilation* buffer. this necessitates re-parsing markers. ;; FILE-STRUCTURE is a list of ;; ((FILENAME . DIRECTORY) FORMATS (LINE LOC ...) ...) @@ -84,13 +88,13 @@ ;;;###autoload (defcustom compilation-mode-hook nil - "*List of hook functions run by `compilation-mode' (see `run-mode-hooks')." + "List of hook functions run by `compilation-mode' (see `run-mode-hooks')." :type 'hook :group 'compilation) ;;;###autoload (defcustom compilation-window-height nil - "*Number of lines in a compilation window. If nil, use Emacs default." + "Number of lines in a compilation window. If nil, use Emacs default." :type '(choice (const :tag "Default" nil) integer) :group 'compilation) @@ -164,6 +168,10 @@ of[ \t]+\"?\\([a-zA-Z]?:?[^\":\n]+\\)\"?:" 3 2 nil (1)) "^[ \t]*\\[[^] \n]+\\][ \t]*\\([^: \n]+\\):\\([0-9]+\\):\\(?:\\([0-9]+\\):[0-9]+:[0-9]+:\\)?\ \\( warning\\)?" 1 2 3 (4)) + (maven + ;; Maven is a popular build tool for Java. Maven is Free Software. + "\\(.*?\\):\\[\\([0-9]+\\),\\([0-9]+\\)\\]" 1 2 3) + (bash "^\\([^: \n\t]+\\): line \\([0-9]+\\):" 1 2) @@ -336,6 +344,68 @@ File = \\(.+\\), Line = \\([0-9]+\\)\\(?:, Column = \\([0-9]+\\)\\)?" nil 2 nil 2 nil (0 'default t) (1 compilation-error-face prepend) (2 compilation-line-face prepend)) + + (compilation-perl--Pod::Checker + ;; podchecker error messages, per Pod::Checker. + ;; The style is from the Pod::Checker::poderror() function, eg. + ;; *** ERROR: Spurious text after =cut at line 193 in file foo.pm + ;; + ;; Plus end_pod() can give "at line EOF" instead of a + ;; number, so for that match "on line N" which is the + ;; originating spot, eg. + ;; *** ERROR: =over on line 37 without closing =back at line EOF in file bar.pm + ;; + ;; Plus command() can give both "on line N" and "at line N"; + ;; the latter is desired and is matched because the .* is + ;; greedy. + ;; *** ERROR: =over on line 1 without closing =back (at head1) at line 3 in file x.pod + ;; + "^\\*\\*\\* \\(?:ERROR\\|\\(WARNING\\)\\).* \\(?:at\\|on\\) line \ +\\([0-9]+\\) \\(?:.* \\)?in file \\([^ \t\n]+\\)" + 3 2 nil (1)) + (compilation-perl--Test + ;; perl Test module error messages. + ;; Style per the ok() function "$context", eg. + ;; # Failed test 1 in foo.t at line 6 + ;; + "^# Failed test [0-9]+ in \\([^ \t\r\n]+\\) at line \\([0-9]+\\)" + 1 2) + (compilation-perl--Test2 + ;; Or when comparing got/want values, + ;; # Test 2 got: "xx" (t-compilation-perl-2.t at line 10) + ;; + ;; And under Test::Harness they're preceded by progress stuff with + ;; \r and "NOK", + ;; ... NOK 1# Test 1 got: "1234" (t/foo.t at line 46) + ;; + "^\\(.*NOK.*\\)?# Test [0-9]+ got:.* (\\([^ \t\r\n]+\\) at line \ +\\([0-9]+\\))" + 2 3) + (compilation-perl--Test::Harness + ;; perl Test::Harness output, eg. + ;; NOK 1# Test 1 got: "1234" (t/foo.t at line 46) + ;; + ;; Test::Harness is slightly designed for tty output, since + ;; it prints CRs to overwrite progress messages, but if you + ;; run it in with M-x compile this pattern can at least step + ;; through the failures. + ;; + "^.*NOK.* \\([^ \t\r\n]+\\) at line \\([0-9]+\\)" + 1 2) + (compilation-weblint + ;; The style comes from HTML::Lint::Error::as_string(), eg. + ;; index.html (13:1) Unknown element <fdjsk> + ;; + ;; The pattern only matches filenames without spaces, since that + ;; should be usual and should help reduce the chance of a false + ;; match of a message from some unrelated program. + ;; + ;; This message style is quite close to the "ibm" entry which is + ;; for IBM C, though that ibm bit doesn't put a space after the + ;; filename. + ;; + "^\\([^ \t\r\n(]+\\) (\\([0-9]+\\):\\([0-9]+\\)) " + 1 2 3) ) "Alist of values for `compilation-error-regexp-alist'.") @@ -443,7 +513,7 @@ Highlight entire line if t; don't highlight source lines if nil.") "Overlay used to temporarily highlight compilation matches.") (defcustom compilation-error-screen-columns t - "*If non-nil, column numbers in error messages are screen columns. + "If non-nil, column numbers in error messages are screen columns. Otherwise they are interpreted as character positions, with each character occupying one column. The default is to use screen columns, which requires that the compilation @@ -454,21 +524,21 @@ especially the TAB character." :version "20.4") (defcustom compilation-read-command t - "*Non-nil means \\[compile] reads the compilation command to use. + "Non-nil means \\[compile] reads the compilation command to use. Otherwise, \\[compile] just uses the value of `compile-command'." :type 'boolean :group 'compilation) ;;;###autoload (defcustom compilation-ask-about-save t - "*Non-nil means \\[compile] asks which buffers to save before compiling. + "Non-nil means \\[compile] asks which buffers to save before compiling. Otherwise, it saves all modified buffers without asking." :type 'boolean :group 'compilation) ;;;###autoload (defcustom compilation-search-path '(nil) - "*List of directories to search for source files named in error messages. + "List of directories to search for source files named in error messages. Elements should be directory names, not file names of directories. The value nil as an element means to try the default directory." :type '(repeat (choice (const :tag "Default" nil) @@ -477,7 +547,7 @@ The value nil as an element means to try the default directory." ;;;###autoload (defcustom compile-command "make -k " - "*Last shell command used to do a compilation; default for next compilation. + "Last shell command used to do a compilation; default for next compilation. Sometimes it is useful for files to supply local values for this variable. You might also use mode hooks to specify it in certain modes, like this: @@ -495,7 +565,7 @@ You might also use mode hooks to specify it in certain modes, like this: ;;;###autoload (defcustom compilation-disable-input nil - "*If non-nil, send end-of-file as compilation process input. + "If non-nil, send end-of-file as compilation process input. This only affects platforms that support asynchronous processes (see `start-process'); synchronous compilation processes never accept input." :type 'boolean @@ -606,6 +676,41 @@ Faces `compilation-error-face', `compilation-warning-face', (defvar compilation-error-list nil) (defvar compilation-old-error-list nil) +(defcustom compilation-auto-jump-to-first-error nil + "If non-nil, automatically jump to the first error after `compile'." + :type 'boolean + :group 'compilation + :version "23.1") + +(defvar compilation-auto-jump-to-next nil + "If non-nil, automatically jump to the next error encountered.") +(make-variable-buffer-local 'compilation-auto-jump-to-next) + + +(defvar compilation-skip-to-next-location t + "*If non-nil, skip multiple error messages for the same source location.") + +(defcustom compilation-skip-threshold 1 + "Compilation motion commands skip less important messages. +The value can be either 2 -- skip anything less than error, 1 -- +skip anything less than warning or 0 -- don't skip any messages. +Note that all messages not positively identified as warning or +info, are considered errors." + :type '(choice (const :tag "Warnings and info" 2) + (const :tag "Info" 1) + (const :tag "None" 0)) + :group 'compilation + :version "22.1") + +(defcustom compilation-skip-visited nil + "Compilation motion commands skip visited messages if this is t. +Visited messages are ones for which the file, line and column have been jumped +to from the current content in the current compilation buffer, even if it was +from a different message." + :type 'boolean + :group 'compilation + :version "22.1") + (defun compilation-face (type) (or (and (car type) (match-end (car type)) compilation-warning-face) (and (cdr type) (match-end (cdr type)) compilation-info-face) @@ -653,13 +758,18 @@ Faces `compilation-error-face', `compilation-warning-face', l2 (setcdr l1 (cons (list ,key) l2))))))) +(defun compilation-auto-jump (buffer pos) + (with-current-buffer buffer + (goto-char pos) + (compile-goto-error))) ;; This function is the central driver, called when font-locking to gather ;; all information needed to later jump to corresponding source code. ;; Return a property list with all meta information on this error location. (defun compilation-error-properties (file line end-line col end-col type fmt) - (unless (< (next-single-property-change (match-beginning 0) 'directory nil (point)) + (unless (< (next-single-property-change (match-beginning 0) + 'directory nil (point)) (point)) (if file (if (functionp file) @@ -711,6 +821,13 @@ Faces `compilation-error-face', `compilation-warning-face', (setq type (or (and (car type) (match-end (car type)) 1) (and (cdr type) (match-end (cdr type)) 0) 2))) + + (when (and compilation-auto-jump-to-next + (>= type compilation-skip-threshold)) + (kill-local-variable 'compilation-auto-jump-to-next) + (run-with-timer 0 nil 'compilation-auto-jump + (current-buffer) (match-beginning 0))) + (compilation-internal-error-properties file line end-line col end-col type fmt))) (defun compilation-move-to-column (col screen) @@ -917,7 +1034,7 @@ to a function that generates a unique name." (unless (equal command (eval compile-command)) (setq compile-command command)) (save-some-buffers (not compilation-ask-about-save) nil) - (setq compilation-directory default-directory) + (setq-default compilation-directory default-directory) (compilation-start command comint)) ;; run compile with the default command line @@ -927,15 +1044,12 @@ If this is run in a Compilation mode buffer, re-use the arguments from the original use. Otherwise, recompile using `compile-command'." (interactive) (save-some-buffers (not compilation-ask-about-save) nil) - (let ((default-directory - (or (and (not (eq major-mode (nth 1 compilation-arguments))) - compilation-directory) - default-directory))) + (let ((default-directory (or compilation-directory default-directory))) (apply 'compilation-start (or compilation-arguments `(,(eval compile-command)))))) (defcustom compilation-scroll-output nil - "*Non-nil to scroll the *compilation* buffer window as output appears. + "Non-nil to scroll the *compilation* buffer window as output appears. Setting it causes the Compilation mode commands to put point at the end of their output window so that the end of the output is always @@ -957,8 +1071,7 @@ Otherwise, construct a buffer name from MODE-NAME." (funcall name-function mode-name)) (compilation-buffer-name-function (funcall compilation-buffer-name-function mode-name)) - ((and (eq mode-command major-mode) - (eq major-mode (nth 1 compilation-arguments))) + ((eq mode-command major-mode) (buffer-name)) (t (concat "*" (downcase mode-name) "*")))) @@ -1010,7 +1123,7 @@ Returns the compilation buffer created." (with-current-buffer (setq outbuf (get-buffer-create - (compilation-buffer-name name-of-mode mode name-function))) + (compilation-buffer-name name-of-mode mode name-function))) (let ((comp-proc (get-buffer-process (current-buffer)))) (if comp-proc (if (or (not (eq (process-status comp-proc) 'run)) @@ -1028,12 +1141,17 @@ Returns the compilation buffer created." (buffer-disable-undo (current-buffer)) ;; first transfer directory from where M-x compile was called (setq default-directory thisdir) + ;; Remember the original dir, so we can use it when we recompile. + ;; default-directory' can't be used reliably for that because it may be + ;; affected by the special handling of "cd ...;". + (set (make-local-variable 'compilation-directory) thisdir) ;; Make compilation buffer read-only. The filter can still write it. ;; Clear out the compilation buffer. (let ((inhibit-read-only t) (default-directory thisdir)) - ;; Then evaluate a cd command if any, but don't perform it yet, else start-command - ;; would do it again through the shell: (cd "..") AND sh -c "cd ..; make" + ;; Then evaluate a cd command if any, but don't perform it yet, else + ;; start-command would do it again through the shell: (cd "..") AND + ;; sh -c "cd ..; make" (cd (if (string-match "^\\s *cd\\(?:\\s +\\(\\S +?\\)\\)?\\s *[;&\n]" command) (if (match-end 1) (substitute-env-vars (match-string 1 command)) @@ -1049,6 +1167,8 @@ Returns the compilation buffer created." (if highlight-regexp (set (make-local-variable 'compilation-highlight-regexp) highlight-regexp)) + (if compilation-auto-jump-to-first-error + (set (make-local-variable 'compilation-auto-jump-to-next) t)) ;; Output a mode setter, for saving and later reloading this buffer. (insert "-*- mode: " name-of-mode "; default-directory: " (prin1-to-string default-directory) @@ -1060,7 +1180,8 @@ Returns the compilation buffer created." (setq thisdir default-directory)) (set-buffer-modified-p nil)) ;; Pop up the compilation buffer. - (setq outwin (display-buffer outbuf nil t)) + ;; http://lists.gnu.org/archive/html/emacs-devel/2007-11/msg01638.html + (setq outwin (display-buffer outbuf)) (with-current-buffer outbuf (let ((process-environment (append @@ -1101,60 +1222,34 @@ Returns the compilation buffer created." (funcall compilation-process-setup-function)) (compilation-set-window-height outwin) ;; Start the compilation. - (if (fboundp 'start-process) - (let ((proc (if (eq mode t) - (get-buffer-process - (with-no-warnings - (comint-exec outbuf (downcase mode-name) - shell-file-name nil `("-c" ,command)))) - (start-process-shell-command (downcase mode-name) - outbuf command)))) - ;; Make the buffer's mode line show process state. - (setq mode-line-process '(":%s")) - (set-process-sentinel proc 'compilation-sentinel) - (set-process-filter proc 'compilation-filter) - ;; Use (point-max) here so that output comes in - ;; after the initial text, - ;; regardless of where the user sees point. - (set-marker (process-mark proc) (point-max) outbuf) - (when compilation-disable-input - (condition-case nil - (process-send-eof proc) - ;; The process may have exited already. - (error nil))) - (setq compilation-in-progress - (cons proc compilation-in-progress))) - ;; No asynchronous processes available. - (message "Executing `%s'..." command) - ;; Fake modeline display as if `start-process' were run. - (setq mode-line-process ":run") - (force-mode-line-update) - (sit-for 0) ; Force redisplay - (save-excursion - ;; Insert the output at the end, after the initial text, - ;; regardless of where the user sees point. - (goto-char (point-max)) - (let* ((buffer-read-only nil) ; call-process needs to modify outbuf - (status (call-process shell-file-name nil outbuf nil "-c" - command))) - (cond ((numberp status) - (compilation-handle-exit 'exit status - (if (zerop status) - "finished\n" - (format "\ -exited abnormally with code %d\n" - status)))) - ((stringp status) - (compilation-handle-exit 'signal status - (concat status "\n"))) - (t - (compilation-handle-exit 'bizarre status status))))) - ;; Without async subprocesses, the buffer is not yet - ;; fontified, so fontify it now. - (let ((font-lock-verbose nil)) ; shut up font-lock messages - (font-lock-fontify-buffer)) - (set-buffer-modified-p nil) - (message "Executing `%s'...done" command))) + (let ((proc + (if (eq mode t) + ;; comint uses `start-file-process'. + (get-buffer-process + (with-no-warnings + (comint-exec + outbuf (downcase mode-name) + (if (file-remote-p default-directory) + "/bin/sh" + shell-file-name) + nil `("-c" ,command)))) + (start-file-process-shell-command (downcase mode-name) + outbuf command)))) + ;; Make the buffer's mode line show process state. + (setq mode-line-process '(":%s")) + (set-process-sentinel proc 'compilation-sentinel) + (set-process-filter proc 'compilation-filter) + ;; Use (point-max) here so that output comes in + ;; after the initial text, + ;; regardless of where the user sees point. + (set-marker (process-mark proc) (point-max) outbuf) + (when compilation-disable-input + (condition-case nil + (process-send-eof proc) + ;; The process may have exited already. + (error nil))) + (setq compilation-in-progress + (cons proc compilation-in-progress)))) ;; Now finally cd to where the shell started make/grep/... (setq default-directory thisdir)) (if (buffer-local-value 'compilation-scroll-output outbuf) @@ -1271,30 +1366,6 @@ exited abnormally with code %d\n" (put 'compilation-mode 'mode-class 'special) -(defvar compilation-skip-to-next-location t - "*If non-nil, skip multiple error messages for the same source location.") - -(defcustom compilation-skip-threshold 1 - "*Compilation motion commands skip less important messages. -The value can be either 2 -- skip anything less than error, 1 -- -skip anything less than warning or 0 -- don't skip any messages. -Note that all messages not positively identified as warning or -info, are considered errors." - :type '(choice (const :tag "Warnings and info" 2) - (const :tag "Info" 1) - (const :tag "None" 0)) - :group 'compilation - :version "22.1") - -(defcustom compilation-skip-visited nil - "*Compilation motion commands skip visited messages if this is t. -Visited messages are ones for which the file, line and column have been jumped -to from the current content in the current compilation buffer, even if it was -from a different message." - :type 'boolean - :group 'compilation - :version "22.1") - ;;;###autoload (defun compilation-mode (&optional name-of-mode) "Major mode for compilation log buffers. @@ -1388,6 +1459,8 @@ Optional argument MINOR indicates this is called from ;; with the next-error function in simple.el, and it's only ;; coincidentally named similarly to compilation-next-error. (setq next-error-function 'compilation-next-error-function) + (set (make-local-variable 'comint-file-name-prefix) + (or (file-remote-p default-directory) "")) (set (make-local-variable 'font-lock-extra-managed-props) '(directory message help-echo mouse-face debug)) (set (make-local-variable 'compilation-locs) @@ -1536,7 +1609,7 @@ Just inserts the text, but uses `insert-before-markers'." (eq (prog1 last (setq last (nth 2 (car msg)))) last)) (if compilation-skip-visited - (nthcdr 4 (car msg))) + (nthcdr 5 (car msg))) (if compilation-skip-to-next-location (eq (car msg) loc)) ;; count this message only if none of the above are true @@ -1641,7 +1714,7 @@ This is the value of `next-error-function' in Compilation buffers." (when reset (setq compilation-current-error nil)) (let* ((columns compilation-error-screen-columns) ; buffer's local value - (last 1) + (last 1) timestamp (loc (compilation-next-error (or n 1) nil (or compilation-current-error compilation-messages-start @@ -1654,10 +1727,22 @@ This is the value of `next-error-function' in Compilation buffers." compilation-current-error (copy-marker (line-beginning-position))) loc (car loc)) - ;; If loc contains no marker, no error in that file has been visited. If - ;; the marker is invalid the buffer has been killed. So, recalculate all - ;; markers for that file. - (unless (and (nth 3 loc) (marker-buffer (nth 3 loc))) + ;; If loc contains no marker, no error in that file has been visited. + ;; If the marker is invalid the buffer has been killed. + ;; If the file is newer than the timestamp, it has been modified + ;; (`omake -P' polls filesystem for changes and recompiles when needed + ;; in the same process and buffer). + ;; So, recalculate all markers for that file. + (unless (and (nth 3 loc) (marker-buffer (nth 3 loc)) + ;; There may be no timestamp info if the loc is a `fake-loc'. + ;; So we skip the time-check here, although we should maybe + ;; change `compilation-fake-loc' to add timestamp info. + (or (null (nth 4 loc)) + (equal (nth 4 loc) + (setq timestamp + (with-current-buffer + (marker-buffer (nth 3 loc)) + (visited-file-modtime)))))) (with-current-buffer (compilation-find-file marker (caar (nth 2 loc)) (cadr (car (nth 2 loc)))) (save-restriction @@ -1680,7 +1765,8 @@ This is the value of `next-error-function' in Compilation buffers." (set-marker (nth 3 col) (point)) (setcdr (nthcdr 2 col) `(,(point-marker))))))))) (compilation-goto-locus marker (nth 3 loc) (nth 3 end-loc)) - (setcdr (nthcdr 3 loc) t))) ; Set this one as visited. + (setcdr (nthcdr 3 loc) (list timestamp)) + (setcdr (nthcdr 4 loc) t))) ; Set this one as visited. (defvar compilation-gcpro nil "Internal variable used to keep some values from being GC'd.") @@ -1706,7 +1792,7 @@ region and the first line of the next region." (or (consp file) (setq file (list file))) (setq file (compilation-get-file-structure file)) ;; Between the current call to compilation-fake-loc and the first occurrence - ;; of an error message referring to `file', the data is only kept is the + ;; of an error message referring to `file', the data is only kept in the ;; weak hash-table compilation-locs, so we need to prevent this entry ;; in compilation-locs from being GC'd away. --Stef (push file compilation-gcpro) @@ -1883,7 +1969,24 @@ Pop up the buffer containing MARKER and scroll to MARKER if we ask the user." (let* ((name (read-file-name (format "Find this %s in (default %s): " compilation-error filename) - spec-dir filename t nil)) + spec-dir filename t nil + ;; The predicate below is fine when called from + ;; minibuffer-complete-and-exit, but it's too + ;; restrictive otherwise, since it also prevents the + ;; user from completing "fo" to "foo/" when she + ;; wants to enter "foo/bar". + ;; + ;; Try to make sure the user can only select + ;; a valid answer. This predicate may be ignored, + ;; tho, so we still have to double-check afterwards. + ;; TODO: We should probably fix read-file-name so + ;; that it never ignores this predicate, even when + ;; using popup dialog boxes. + ;; (lambda (name) + ;; (if (file-directory-p name) + ;; (setq name (expand-file-name filename name))) + ;; (file-exists-p name)) + )) (origname name)) (cond ((not (file-exists-p name)) @@ -2037,9 +2140,9 @@ The file-structure looks like this: ;; compilation-error-list) to point-min, but that was only meaningful for ;; the internal uses of compilation-forget-errors: all calls from external ;; packages seem to be followed by a move of compilation-parsing-end to - ;; something equivalent to point-max. So we speculatively move + ;; something equivalent to point-max. So we heuristically move ;; compilation-current-error to point-max (since the external package - ;; won't know that it should do it). --stef + ;; won't know that it should do it). --Stef (setq compilation-current-error nil) (let* ((proc (get-buffer-process (current-buffer))) (mark (if proc (process-mark proc))) @@ -2050,7 +2153,12 @@ The file-structure looks like this: ;; we need to put ours just before the insertion point rather ;; than at the insertion point. If that's not possible, then ;; don't use a marker. --Stef - (if (> pos (point-min)) (copy-marker (1- pos)) pos)))) + (if (> pos (point-min)) (copy-marker (1- pos)) pos))) + ;; Again, since this command is used in buffers that contain several + ;; compilations, to set the beginning of "this compilation", it's a good + ;; place to reset compilation-auto-jump-to-next. + (set (make-local-variable 'compilation-auto-jump-to-next) + compilation-auto-jump-to-first-error)) ;;;###autoload (add-to-list 'auto-mode-alist '("\\.gcov\\'" . compilation-mode)) diff --git a/lisp/progmodes/cperl-mode.el b/lisp/progmodes/cperl-mode.el index bb45f74dea1..6bdf79d16e7 100644 --- a/lisp/progmodes/cperl-mode.el +++ b/lisp/progmodes/cperl-mode.el @@ -78,9 +78,8 @@ (condition-case nil (require 'man) (error nil)) - (defconst cperl-xemacs-p (string-match "XEmacs\\|Lucid" emacs-version)) (defvar cperl-can-font-lock - (or cperl-xemacs-p + (or (featurep 'xemacs) (and (boundp 'emacs-major-version) (or window-system (> emacs-major-version 20))))) @@ -131,14 +130,14 @@ (cperl-make-face ,arg ,descr)) (or (boundp (quote ,arg)) ; We use unquoted variants too (defvar ,arg (quote ,arg) ,descr)))) - (if cperl-xemacs-p + (if (featurep 'xemacs) (defmacro cperl-etags-snarf-tag (file line) `(progn (beginning-of-line 2) (list ,file ,line))) (defmacro cperl-etags-snarf-tag (file line) `(etags-snarf-tag))) - (if cperl-xemacs-p + (if (featurep 'xemacs) (defmacro cperl-etags-goto-tag-location (elt) ;;(progn ;; (switch-to-buffer (get-file-buffer (elt ,elt 0))) @@ -151,10 +150,8 @@ (defmacro cperl-etags-goto-tag-location (elt) `(etags-goto-tag-location ,elt)))) -(defconst cperl-xemacs-p (string-match "XEmacs\\|Lucid" emacs-version)) - (defvar cperl-can-font-lock - (or cperl-xemacs-p + (or (featurep 'xemacs) (and (boundp 'emacs-major-version) (or window-system (> emacs-major-version 20))))) @@ -464,7 +461,7 @@ Font for POD headers." :group 'cperl-faces) ;;; Some double-evaluation happened with font-locks... Needed with 21.2... -(defvar cperl-singly-quote-face cperl-xemacs-p) +(defvar cperl-singly-quote-face (featurep 'xemacs)) (defcustom cperl-invalid-face 'underline "*Face for highlighting trailing whitespace." @@ -1017,7 +1014,7 @@ In regular expressions (except character classes): (defmacro cperl-define-key (emacs-key definition &optional xemacs-key) `(define-key cperl-mode-map ,(if xemacs-key - `(if cperl-xemacs-p ,xemacs-key ,emacs-key) + `(if (featurep 'xemacs) ,xemacs-key ,emacs-key) emacs-key) ,definition)) @@ -1030,7 +1027,7 @@ In regular expressions (except character classes): (setq cperl-del-back-ch (aref cperl-del-back-ch 0))) (defun cperl-mark-active () (mark)) ; Avoid undefined warning -(if cperl-xemacs-p +(if (featurep 'xemacs) (progn ;; "Active regions" are on: use region only if active ;; "Active regions" are off: use region unconditionally @@ -1046,7 +1043,7 @@ In regular expressions (except character classes): (defun cperl-putback-char (c) ; Emacs 19 (set 'unread-command-events (list c))) ; Avoid undefined warning -(if cperl-xemacs-p +(if (featurep 'xemacs) (defun cperl-putback-char (c) ; XEmacs >= 19.12 (setq unread-command-events (list (eval '(character-to-event c)))))) @@ -1113,11 +1110,11 @@ versions of Emacs." ;;; (setq interpreter-mode-alist (append interpreter-mode-alist ;;; '(("miniperl" . perl-mode)))))) (eval-when-compile - (mapcar (lambda (p) - (condition-case nil - (require p) - (error nil))) - '(imenu easymenu etags timer man info)) + (mapc (lambda (p) + (condition-case nil + (require p) + (error nil))) + '(imenu easymenu etags timer man info)) (if (fboundp 'ps-extend-face-list) (defmacro cperl-ps-extend-face-list (arg) `(ps-extend-face-list ,arg)) @@ -1198,7 +1195,7 @@ versions of Emacs." ;;(concat (char-to-string help-char) "v") ; does not work 'cperl-get-help [(control c) (control h) v])) - (if (and cperl-xemacs-p + (if (and (featurep 'xemacs) (<= emacs-minor-version 11) (<= emacs-major-version 19)) (progn ;; substitute-key-definition is usefulness-deenhanced... @@ -1519,6 +1516,8 @@ the last)." 2 3)) "Alist that specifies how to match errors in perl output.") +(defvar compilation-error-regexp-alist) + ;;;###autoload (defun cperl-mode () "Major mode for editing Perl code. @@ -1750,7 +1749,7 @@ or as help on variables `cperl-tips', `cperl-problems', (setq paragraph-separate paragraph-start) (make-local-variable 'paragraph-ignore-fill-prefix) (setq paragraph-ignore-fill-prefix t) - (if cperl-xemacs-p + (if (featurep 'xemacs) (progn (make-local-variable 'paren-backwards-message) (set 'paren-backwards-message t))) @@ -1799,9 +1798,11 @@ or as help on variables `cperl-tips', `cperl-problems', (set 'vc-sccs-header cperl-vc-sccs-header) ;; This one is obsolete... (make-local-variable 'vc-header-alist) - (set 'vc-header-alist (or cperl-vc-header-alist ; Avoid warning - `((SCCS ,(car cperl-vc-sccs-header)) - (RCS ,(car cperl-vc-rcs-header))))) + (with-no-warnings + (set 'vc-header-alist (or cperl-vc-header-alist ; Avoid warning + `((SCCS ,(car cperl-vc-sccs-header)) + (RCS ,(car cperl-vc-rcs-header))))) + ) (cond ((boundp 'compilation-error-regexp-alist-alist);; xemacs 20.x (make-local-variable 'compilation-error-regexp-alist-alist) (set 'compilation-error-regexp-alist-alist @@ -1841,7 +1842,7 @@ or as help on variables `cperl-tips', `cperl-problems', (or (boundp 'font-lock-unfontify-region-function) (set 'font-lock-unfontify-region-function 'font-lock-default-unfontify-region)) - (unless cperl-xemacs-p ; Our: just a plug for wrong font-lock + (unless (featurep 'xemacs) ; Our: just a plug for wrong font-lock (make-local-variable 'font-lock-unfontify-region-function) (set 'font-lock-unfontify-region-function ; not present with old Emacs 'cperl-font-lock-unfontify-region-function)) @@ -4586,7 +4587,7 @@ the sections using `cperl-pod-head-face', `cperl-pod-face', (setq qtag "Can't find })"))) (progn (goto-char (1- e)) - (message qtag)) + (message "%s" qtag)) (cperl-postpone-fontification (1- tag) (1- (point)) 'face font-lock-variable-name-face) @@ -5391,15 +5392,15 @@ indentation and initial hashes. Behaves usually outside of comment." (t (or name (setq name "+++BACK+++")) - (mapcar (lambda (elt) - (if (and (listp elt) (listp (cdr elt))) - (progn - ;; In the other order it goes up - ;; one level only ;-( - (setcdr elt (cons (cons name lst) - (cdr elt))) - (cperl-imenu-addback (cdr elt) t name)))) - (if isback (cdr lst) lst)) + (mapc (lambda (elt) + (if (and (listp elt) (listp (cdr elt))) + (progn + ;; In the other order it goes up + ;; one level only ;-( + (setcdr elt (cons (cons name lst) + (cdr elt))) + (cperl-imenu-addback (cdr elt) t name)))) + (if isback (cdr lst) lst)) lst))) (defun cperl-imenu--create-perl-index (&optional regexp) @@ -5860,7 +5861,7 @@ indentation and initial hashes. Behaves usually outside of comment." (and (fboundp 'turn-on-font-lock) ; Check for newer font-lock ;; not yet as of XEmacs 19.12, works with 21.1.11 (or - (not cperl-xemacs-p) + (not (featurep 'xemacs)) (string< "21.1.9" emacs-version) (and (string< "21.1.10" emacs-version) (string< emacs-version "21.1.2"))) @@ -6021,7 +6022,7 @@ indentation and initial hashes. Behaves usually outside of comment." ;; (defconst cperl-nonoverridable-face ;; 'cperl-nonoverridable-face ;; "Face to use for data types from another group.")) - ;;(if (not cperl-xemacs-p) nil + ;;(if (not (featurep 'xemacs)) nil ;; (or (boundp 'font-lock-comment-face) ;; (defconst font-lock-comment-face ;; 'font-lock-comment-face @@ -6970,7 +6971,7 @@ Use as (save-excursion (cond (inbuffer nil) ; Already there ((file-exists-p tags-file-name) - (if cperl-xemacs-p + (if (featurep 'xemacs) (visit-tags-table-buffer) (visit-tags-table-buffer tags-file-name))) (t (set-buffer (find-file-noselect tags-file-name)))) @@ -6992,17 +6993,17 @@ Use as (setq cperl-unreadable-ok t tm nil) ; Return empty list (error "Aborting: unreadable directory %s" file))))))) - (mapcar (function - (lambda (file) - (cond - ((string-match cperl-noscan-files-regexp file) - nil) - ((not (file-directory-p file)) - (if (string-match cperl-scan-files-regexp file) - (cperl-write-tags file erase recurse nil t noxs topdir))) - ((not recurse) nil) - (t (cperl-write-tags file erase recurse t t noxs topdir))))) - files))) + (mapc (function + (lambda (file) + (cond + ((string-match cperl-noscan-files-regexp file) + nil) + ((not (file-directory-p file)) + (if (string-match cperl-scan-files-regexp file) + (cperl-write-tags file erase recurse nil t noxs topdir))) + ((not recurse) nil) + (t (cperl-write-tags file erase recurse t t noxs topdir))))) + files))) (t (setq xs (string-match "\\.xs$" file)) (if (not (and xs noxs)) @@ -7106,7 +7107,7 @@ One may build such TAGS files from CPerl mode menu." pack name cons1 to l1 l2 l3 l4 b) ;; (setq cperl-hierarchy '(() () ())) ; Would write into '() later! (setq cperl-hierarchy (list l1 l2 l3)) - (if cperl-xemacs-p ; Not checked + (if (featurep 'xemacs) ; Not checked (progn (or tags-file-name ;; Does this work in XEmacs? @@ -7116,16 +7117,16 @@ One may build such TAGS files from CPerl mode menu." (cperl-tags-hier-fill)) (or tags-table-list (call-interactively 'visit-tags-table)) - (mapcar + (mapc (function (lambda (tagsfile) (message "Updating list of classes... %s" tagsfile) (set-buffer (get-file-buffer tagsfile)) (cperl-tags-hier-fill))) - tags-table-list) + tags-table-list) (message "Updating list of classes... postprocessing...")) - (mapcar remover (car cperl-hierarchy)) - (mapcar remover (nth 1 cperl-hierarchy)) + (mapc remover (car cperl-hierarchy)) + (mapc remover (nth 1 cperl-hierarchy)) (setq to (list nil (cons "Packages: " (nth 1 cperl-hierarchy)) (cons "Methods: " (car cperl-hierarchy)))) (cperl-tags-treeify to 1) @@ -7189,40 +7190,40 @@ One may build such TAGS files from CPerl mode menu." (setcdr to l1) ; Init to dynamic space (setq writeto to) (setq ord 1) - (mapcar move-deeper packages) + (mapc move-deeper packages) (setq ord 2) - (mapcar move-deeper methods) + (mapc move-deeper methods) (if recurse - (mapcar (function (lambda (elt) + (mapc (function (lambda (elt) (cperl-tags-treeify elt (1+ level)))) - (cdr to))) + (cdr to))) ;;Now clean up leaders with one child only - (mapcar (function (lambda (elt) - (if (not (and (listp (cdr elt)) - (eq (length elt) 2))) nil - (setcar elt (car (nth 1 elt))) - (setcdr elt (cdr (nth 1 elt)))))) - (cdr to)) + (mapc (function (lambda (elt) + (if (not (and (listp (cdr elt)) + (eq (length elt) 2))) nil + (setcar elt (car (nth 1 elt))) + (setcdr elt (cdr (nth 1 elt)))))) + (cdr to)) ;; Sort the roots of subtrees (if (default-value 'imenu-sort-function) (setcdr to (sort (cdr to) (default-value 'imenu-sort-function)))) ;; Now add back functions removed from display - (mapcar (function (lambda (elt) - (setcdr to (cons elt (cdr to))))) - (if (default-value 'imenu-sort-function) - (nreverse - (sort root-functions (default-value 'imenu-sort-function))) - root-functions)) + (mapc (function (lambda (elt) + (setcdr to (cons elt (cdr to))))) + (if (default-value 'imenu-sort-function) + (nreverse + (sort root-functions (default-value 'imenu-sort-function))) + root-functions)) ;; Now add back packages removed from display - (mapcar (function (lambda (elt) - (setcdr to (cons (cons (concat "package " (car elt)) - (cdr elt)) - (cdr to))))) - (if (default-value 'imenu-sort-function) - (nreverse - (sort root-packages (default-value 'imenu-sort-function))) - root-packages)))) + (mapc (function (lambda (elt) + (setcdr to (cons (cons (concat "package " (car elt)) + (cdr elt)) + (cdr to))))) + (if (default-value 'imenu-sort-function) + (nreverse + (sort root-packages (default-value 'imenu-sort-function))) + root-packages)))) ;;;(x-popup-menu t ;;; '(keymap "Name1" @@ -8457,7 +8458,7 @@ the appropriate statement modifier." 'variable-documentation)))) (manual-program (if is-func "perldoc -f" "perldoc"))) (cond - (cperl-xemacs-p + ((featurep 'xemacs) (let ((Manual-program "perldoc") (Manual-switches (if is-func (list "-f")))) (manual-entry word))) @@ -8499,7 +8500,7 @@ the appropriate statement modifier." (interactive) (require 'man) (cond - (cperl-xemacs-p + ((featurep 'xemacs) (let ((Manual-program "perldoc")) (manual-entry buffer-file-name))) (t @@ -8695,6 +8696,8 @@ start with default arguments, then refine the slowdown regions." (message "to %s:%6s,%7s" l delta tot)) tot)) +(defvar font-lock-cache-position) + (defun cperl-emulate-lazy-lock (&optional window-size) "Emulate `lazy-lock' without `condition-case', so `debug-on-error' works. Start fontifying the buffer from the start (or end) using the given diff --git a/lisp/progmodes/dcl-mode.el b/lisp/progmodes/dcl-mode.el index f815524e58c..0f19ea3327c 100644 --- a/lisp/progmodes/dcl-mode.el +++ b/lisp/progmodes/dcl-mode.el @@ -73,7 +73,6 @@ (require 'tempo) - ;;; *** Customization ***************************************************** @@ -2202,6 +2201,7 @@ otherwise return nil." () (equal start (match-end 0)))))) +(declare-function imenu-default-create-index-function "imenu" ()) ;;;------------------------------------------------------------------------- (defun dcl-imenu-create-index-function () diff --git a/lisp/progmodes/delphi.el b/lisp/progmodes/delphi.el index 86a157a8d0a..d98bb62c0ba 100644 --- a/lisp/progmodes/delphi.el +++ b/lisp/progmodes/delphi.el @@ -66,29 +66,6 @@ (provide 'delphi) -(eval-and-compile - ;; Allow execution on pre Emacs 20 versions. - (or (fboundp 'when) - (defmacro when (test &rest body) - `(if ,test (progn ,@body)))) - (or (fboundp 'unless) - (defmacro unless (test &rest body) - `(if (not ,test) (progn ,@body)))) - (or (fboundp 'defgroup) - (defmacro defgroup (group val docs &rest group-attributes) - `(defvar ,group ,val ,docs))) - (or (fboundp 'defcustom) - (defmacro defcustom (val-name val docs &rest custom-attributes) - `(defvar ,val-name ,val ,docs))) - (or (fboundp 'cadr) - (defmacro cadr (list) `(car (cdr ,list)))) - (or (fboundp 'cddr) - (defmacro cddr (list) `(cdr (cdr ,list)))) - (or (fboundp 'with-current-buffer) - (defmacro with-current-buffer (buf &rest forms) - `(save-excursion (set-buffer ,buf) ,@forms))) - ) - (defgroup delphi nil "Major mode for editing Delphi source in Emacs." :version "21.1" @@ -1642,7 +1619,7 @@ before the indent, the point is moved to the indent." (when delphi-newline-always-indents ;; Indent both the (now) previous and current line first. (save-excursion - (previous-line 1) + (forward-line -1) (delphi-indent-line)) (delphi-indent-line))) @@ -1677,21 +1654,21 @@ before the indent, the point is moved to the indent." (unit-file (downcase unit))) (catch 'done ;; Search for the file. - (mapcar #'(lambda (file) - (let ((path (concat dir "/" file))) - (if (and (string= unit-file (downcase file)) - (delphi-is-file path)) - (throw 'done path)))) - files) + (mapc #'(lambda (file) + (let ((path (concat dir "/" file))) + (if (and (string= unit-file (downcase file)) + (delphi-is-file path)) + (throw 'done path)))) + files) ;; Not found. Search subdirectories. (when recurse - (mapcar #'(lambda (subdir) - (unless (member subdir '("." "..")) - (let ((path (delphi-search-directory - unit (concat dir "/" subdir) recurse))) - (if path (throw 'done path))))) - files)) + (mapc #'(lambda (subdir) + (unless (member subdir '("." "..")) + (let ((path (delphi-search-directory + unit (concat dir "/" subdir) recurse))) + (if path (throw 'done path))))) + files)) ;; Not found. nil)))) @@ -1721,7 +1698,7 @@ before the indent, the point is moved to the indent." ((stringp delphi-search-path) (delphi-find-unit-in-directory unit delphi-search-path)) - ((mapcar + ((mapc #'(lambda (dir) (let ((file (delphi-find-unit-in-directory unit dir))) (if file (throw 'done file)))) @@ -1888,39 +1865,39 @@ comment block. If not in a // comment, just does a normal newline." (defvar delphi-debug-mode-map (let ((kmap (make-sparse-keymap))) - (mapcar #'(lambda (binding) (define-key kmap (car binding) (cadr binding))) - '(("n" delphi-debug-goto-next-token) - ("p" delphi-debug-goto-previous-token) - ("t" delphi-debug-show-current-token) - ("T" delphi-debug-tokenize-buffer) - ("W" delphi-debug-tokenize-window) - ("g" delphi-debug-goto-point) - ("s" delphi-debug-show-current-string) - ("a" delphi-debug-parse-buffer) - ("w" delphi-debug-parse-window) - ("f" delphi-debug-fontify-window) - ("F" delphi-debug-fontify-buffer) - ("r" delphi-debug-parse-region) - ("c" delphi-debug-unparse-buffer) - ("x" delphi-debug-show-is-stable) - )) + (mapc #'(lambda (binding) (define-key kmap (car binding) (cadr binding))) + '(("n" delphi-debug-goto-next-token) + ("p" delphi-debug-goto-previous-token) + ("t" delphi-debug-show-current-token) + ("T" delphi-debug-tokenize-buffer) + ("W" delphi-debug-tokenize-window) + ("g" delphi-debug-goto-point) + ("s" delphi-debug-show-current-string) + ("a" delphi-debug-parse-buffer) + ("w" delphi-debug-parse-window) + ("f" delphi-debug-fontify-window) + ("F" delphi-debug-fontify-buffer) + ("r" delphi-debug-parse-region) + ("c" delphi-debug-unparse-buffer) + ("x" delphi-debug-show-is-stable) + )) kmap) "Keystrokes for delphi-mode debug commands.") (defvar delphi-mode-map (let ((kmap (make-sparse-keymap))) - (mapcar #'(lambda (binding) (define-key kmap (car binding) (cadr binding))) - (list '("\r" delphi-newline) - '("\t" delphi-tab) - '("\177" backward-delete-char-untabify) -;; '("\C-cd" delphi-find-current-def) -;; '("\C-cx" delphi-find-current-xdef) -;; '("\C-cb" delphi-find-current-body) - '("\C-cu" delphi-find-unit) - '("\M-q" delphi-fill-comment) - '("\M-j" delphi-new-comment-line) - ;; Debug bindings: - (list "\C-c\C-d" delphi-debug-mode-map))) + (mapc #'(lambda (binding) (define-key kmap (car binding) (cadr binding))) + (list '("\r" delphi-newline) + '("\t" delphi-tab) + '("\177" backward-delete-char-untabify) +;; '("\C-cd" delphi-find-current-def) +;; '("\C-cx" delphi-find-current-xdef) +;; '("\C-cb" delphi-find-current-body) + '("\C-cu" delphi-find-unit) + '("\M-q" delphi-fill-comment) + '("\M-j" delphi-new-comment-line) + ;; Debug bindings: + (list "\C-c\C-d" delphi-debug-mode-map))) kmap) "Keymap used in Delphi mode.") @@ -1981,17 +1958,17 @@ no args, if that value is non-nil." (set-syntax-table delphi-mode-syntax-table) ;; Buffer locals: - (mapcar #'(lambda (var) - (let ((var-symb (car var)) - (var-val (cadr var))) - (make-local-variable var-symb) - (set var-symb var-val))) - (list '(indent-line-function delphi-indent-line) - '(comment-indent-function delphi-indent-line) - '(case-fold-search t) - '(delphi-progress-last-reported-point nil) - '(delphi-ignore-changes nil) - (list 'font-lock-defaults delphi-font-lock-defaults))) + (mapc #'(lambda (var) + (let ((var-symb (car var)) + (var-val (cadr var))) + (make-local-variable var-symb) + (set var-symb var-val))) + (list '(indent-line-function delphi-indent-line) + '(comment-indent-function delphi-indent-line) + '(case-fold-search t) + '(delphi-progress-last-reported-point nil) + '(delphi-ignore-changes nil) + (list 'font-lock-defaults delphi-font-lock-defaults))) ;; We need to keep track of changes to the buffer to determine if we need ;; to retokenize changed text. diff --git a/lisp/progmodes/ebnf-abn.el b/lisp/progmodes/ebnf-abn.el index c8c9cd3596c..f2d8271be01 100644 --- a/lisp/progmodes/ebnf-abn.el +++ b/lisp/progmodes/ebnf-abn.el @@ -6,7 +6,7 @@ ;; Author: Vinicius Jose Latorre <viniciusjl@ig.com.br> ;; Maintainer: Vinicius Jose Latorre <viniciusjl@ig.com.br> ;; Keywords: wp, ebnf, PostScript -;; Version: 1.1 +;; Version: 1.2 ;; This file is part of GNU Emacs. @@ -589,6 +589,12 @@ See documentation for variable `ebnf-abn-lex'." ;; close EPS file ((and ebnf-eps-executing (= (following-char) ?\])) (ebnf-eps-remove-context (ebnf-abn-eps-filename))) + ;; EPS header + ((and ebnf-eps-executing (= (following-char) ?H)) + (ebnf-eps-header-comment (ebnf-abn-eps-filename))) + ;; EPS footer + ((and ebnf-eps-executing (= (following-char) ?F)) + (ebnf-eps-footer-comment (ebnf-abn-eps-filename))) ;; any other action in comment (t (setq ebnf-action (aref ebnf-comment-table (following-char))) diff --git a/lisp/progmodes/ebnf-bnf.el b/lisp/progmodes/ebnf-bnf.el index 3c71165e9e0..d9db3c2a6c3 100644 --- a/lisp/progmodes/ebnf-bnf.el +++ b/lisp/progmodes/ebnf-bnf.el @@ -6,7 +6,7 @@ ;; Author: Vinicius Jose Latorre <viniciusjl@ig.com.br> ;; Maintainer: Vinicius Jose Latorre <viniciusjl@ig.com.br> ;; Keywords: wp, ebnf, PostScript -;; Version: 1.9 +;; Version: 1.10 ;; This file is part of GNU Emacs. @@ -537,6 +537,12 @@ See documentation for variable `ebnf-bnf-lex'." ;; close EPS file ((and ebnf-eps-executing (= (following-char) ?\])) (ebnf-eps-remove-context (ebnf-bnf-eps-filename))) + ;; EPS header + ((and ebnf-eps-executing (= (following-char) ?H)) + (ebnf-eps-header-comment (ebnf-bnf-eps-filename))) + ;; EPS footer + ((and ebnf-eps-executing (= (following-char) ?F)) + (ebnf-eps-footer-comment (ebnf-bnf-eps-filename))) ;; any other action in comment (t (setq ebnf-action (aref ebnf-comment-table (following-char))) diff --git a/lisp/progmodes/ebnf-dtd.el b/lisp/progmodes/ebnf-dtd.el index 2428171bfc8..2f651a70a76 100644 --- a/lisp/progmodes/ebnf-dtd.el +++ b/lisp/progmodes/ebnf-dtd.el @@ -6,7 +6,7 @@ ;; Author: Vinicius Jose Latorre <viniciusjl@ig.com.br> ;; Maintainer: Vinicius Jose Latorre <viniciusjl@ig.com.br> ;; Keywords: wp, ebnf, PostScript -;; Version: 1.0 +;; Version: 1.1 ;; This file is part of GNU Emacs. @@ -1306,6 +1306,12 @@ See documentation for variable `ebnf-dtd-lex'." ;; close EPS file ((and ebnf-eps-executing (= (following-char) ?\])) (ebnf-eps-remove-context (ebnf-dtd-eps-filename))) + ;; EPS header + ((and ebnf-eps-executing (= (following-char) ?H)) + (ebnf-eps-header-comment (ebnf-dtd-eps-filename))) + ;; EPS footer + ((and ebnf-eps-executing (= (following-char) ?F)) + (ebnf-eps-footer-comment (ebnf-dtd-eps-filename))) ;; any other action in comment (t (setq ebnf-action (aref ebnf-comment-table (following-char)))) diff --git a/lisp/progmodes/ebnf-ebx.el b/lisp/progmodes/ebnf-ebx.el index c1210acd023..8d94c2de1e8 100644 --- a/lisp/progmodes/ebnf-ebx.el +++ b/lisp/progmodes/ebnf-ebx.el @@ -6,7 +6,7 @@ ;; Author: Vinicius Jose Latorre <viniciusjl@ig.com.br> ;; Maintainer: Vinicius Jose Latorre <viniciusjl@ig.com.br> ;; Keywords: wp, ebnf, PostScript -;; Version: 1.1 +;; Version: 1.2 ;; This file is part of GNU Emacs. @@ -539,6 +539,12 @@ See documentation for variable `ebnf-ebx-lex'." ;; close EPS file ((and ebnf-eps-executing (= (following-char) ?\])) (ebnf-eps-remove-context (ebnf-ebx-eps-filename))) + ;; EPS header + ((and ebnf-eps-executing (= (following-char) ?H)) + (ebnf-eps-header-comment (ebnf-ebx-eps-filename))) + ;; EPS footer + ((and ebnf-eps-executing (= (following-char) ?F)) + (ebnf-eps-footer-comment (ebnf-ebx-eps-filename))) ;; any other action in comment (t (setq ebnf-action (aref ebnf-comment-table (following-char)))) diff --git a/lisp/progmodes/ebnf-iso.el b/lisp/progmodes/ebnf-iso.el index db802739a66..4beb198e24a 100644 --- a/lisp/progmodes/ebnf-iso.el +++ b/lisp/progmodes/ebnf-iso.el @@ -1,12 +1,12 @@ ;;; ebnf-iso.el --- parser for ISO EBNF ;; Copyright (C) 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008 -;; Free Software Foundation, Inc. +;; Free Software Foundation, Inc. ;; Author: Vinicius Jose Latorre <viniciusjl@ig.com.br> ;; Maintainer: Vinicius Jose Latorre <viniciusjl@ig.com.br> ;; Keywords: wp, ebnf, PostScript -;; Version: 1.8 +;; Version: 1.9 ;; This file is part of GNU Emacs. @@ -504,6 +504,12 @@ See documentation for variable `ebnf-iso-lex'." ;; close EPS file ((and ebnf-eps-executing (= (following-char) ?\])) (ebnf-eps-remove-context (ebnf-iso-eps-filename))) + ;; EPS header + ((and ebnf-eps-executing (= (following-char) ?H)) + (ebnf-eps-header-comment (ebnf-iso-eps-filename))) + ;; EPS footer + ((and ebnf-eps-executing (= (following-char) ?F)) + (ebnf-eps-footer-comment (ebnf-iso-eps-filename))) ;; any other action in comment (t (setq ebnf-action (aref ebnf-comment-table (following-char)))) diff --git a/lisp/progmodes/ebnf-yac.el b/lisp/progmodes/ebnf-yac.el index 06aade6249d..d78d944a76a 100644 --- a/lisp/progmodes/ebnf-yac.el +++ b/lisp/progmodes/ebnf-yac.el @@ -6,7 +6,7 @@ ;; Author: Vinicius Jose Latorre <viniciusjl@ig.com.br> ;; Maintainer: Vinicius Jose Latorre <viniciusjl@ig.com.br> ;; Keywords: wp, ebnf, PostScript -;; Version: 1.3 +;; Version: 1.4 ;; This file is part of GNU Emacs. @@ -273,12 +273,12 @@ ;; control character & 8-bit character are set to `error' (let ((table (make-vector 256 'error))) ;; upper & lower case letters: - (mapcar + (mapc #'(lambda (char) (aset table char 'non-terminal)) "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz") ;; printable characters: - (mapcar + (mapc #'(lambda (char) (aset table char 'character)) "!#$&()*+-.0123456789=?@[\\]^_`~") @@ -459,6 +459,12 @@ See documentation for variable `ebnf-yac-lex'." ;; close EPS file ((and ebnf-eps-executing (= (following-char) ?\])) (ebnf-eps-remove-context (ebnf-yac-eps-filename))) + ;; EPS header + ((and ebnf-eps-executing (= (following-char) ?H)) + (ebnf-eps-header-comment (ebnf-yac-eps-filename))) + ;; EPS footer + ((and ebnf-eps-executing (= (following-char) ?F)) + (ebnf-eps-footer-comment (ebnf-yac-eps-filename))) ;; any other action in comment (t (setq ebnf-action (aref ebnf-comment-table (following-char)))) diff --git a/lisp/progmodes/ebnf2ps.el b/lisp/progmodes/ebnf2ps.el index b56def58c75..27eaeb187f4 100644 --- a/lisp/progmodes/ebnf2ps.el +++ b/lisp/progmodes/ebnf2ps.el @@ -1,12 +1,12 @@ ;;; ebnf2ps.el --- translate an EBNF to a syntactic chart on PostScript ;; Copyright (C) 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008 -;; Free Software Foundation, Inc. +;; Free Software Foundation, Inc. ;; Author: Vinicius Jose Latorre <viniciusjl@ig.com.br> ;; Maintainer: Vinicius Jose Latorre <viniciusjl@ig.com.br> ;; Keywords: wp, ebnf, PostScript -;; Version: 4.3 +;; Version: 4.4 ;; X-URL: http://www.emacswiki.org/cgi-bin/wiki/ViniciusJoseLatorre ;; This file is part of GNU Emacs. @@ -26,8 +26,8 @@ ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ;; Boston, MA 02110-1301, USA. -(defconst ebnf-version "4.3" - "ebnf2ps.el, v 4.3 <2006/09/26 vinicius> +(defconst ebnf-version "4.4" + "ebnf2ps.el, v 4.4 <2007/02/12 vinicius> Vinicius's last change version. When reporting bugs, please also report the version of Emacs, if any, that ebnf2ps was running with. @@ -448,6 +448,24 @@ Please send all bug fixes and enhancements to ;; `ebnf-eps-region' execution. ;; It's an error to try to close a not opened EPS file. ;; +;; ;Hheader generate a header in current EPS file. The header string can +;; have the following formats: +;; +;; %% prints a % character. +;; +;; %H prints the `ebnf-eps-header' (which see) value. +;; +;; %F prints the `ebnf-eps-footer' (which see) value. +;; +;; Any other format is ignored, that is, if, for example, it's +;; used %s then %s characters are stripped out from the header. +;; If header is an empty string, no header is generated until a +;; non-empty header is specified or `ebnf-eps-header' has a +;; non-empty string value. +;; +;; ;Ffooter generate a footer in current EPS file. Similar to ;H action +;; comment. +;; ;; So if you have: ;; ;; (setq ebnf-horizontal-orientation nil) @@ -546,6 +564,16 @@ Please send all bug fixes and enhancements to ;; The production A is generated in both files ebnf--AA.eps and ebnf--BB.eps. ;; ;; +;; Log Messages +;; ------------ +;; +;; The buffer *Ebnf2ps Log* is where the ebnf2ps log messages are inserted. +;; These messages are intended to help debugging ebnf2ps. +;; +;; The log messages are enabled by `ebnf-log' option (which see). The default +;; value is nil, that is, no log messages are generated. +;; +;; ;; Utilities ;; --------- ;; @@ -723,6 +751,14 @@ Please send all bug fixes and enhancements to ;; ;; `ebnf-eps-prefix' Specify EPS prefix file name. ;; +;; `ebnf-eps-header-font' Specify EPS header font. +;; +;; `ebnf-eps-header' Specify EPS header. +;; +;; `ebnf-eps-footer-font' Specify EPS footer font. +;; +;; `ebnf-eps-footer' Specify EPS footer. +;; ;; `ebnf-use-float-format' Non-nil means use `%f' float format. ;; ;; `ebnf-stop-on-error' Non-nil means signal error and stop. @@ -735,6 +771,8 @@ Please send all bug fixes and enhancements to ;; `ebnf-optimize' Non-nil means optimize syntactic chart ;; of rules. ;; +;; `ebnf-log' Non-nil means generate log messages. +;; ;; To set the above options you may: ;; ;; a) insert the code in your ~/.emacs, like: @@ -787,6 +825,9 @@ Please send all bug fixes and enhancements to ;; To help to handle this situation, ebnf2ps has the following commands to ;; handle styles: ;; +;; `ebnf-find-style' Return style definition if NAME is already defined; +;; otherwise, return nil. +;; ;; `ebnf-insert-style' Insert a new style NAME with inheritance INHERITS and ;; values VALUES. ;; @@ -1879,6 +1920,126 @@ See `ebnf-eps-buffer' and `ebnf-eps-region' commands." :group 'ebnf2ps) +(defcustom ebnf-eps-header-font '(11 Helvetica "Black" "White" bold) + "*Specify EPS header font. + +See documentation for `ebnf-production-font'. + +See `ebnf-eps-buffer' and `ebnf-eps-region' commands." + :type '(list :tag "EPS Header Font" + (number :tag "Font Size") + (symbol :tag "Font Name") + (choice :tag "Foreground Color" + (string :tag "Name") + (other :tag "Default" nil)) + (choice :tag "Background Color" + (string :tag "Name") + (other :tag "Default" nil)) + (repeat :tag "Font Attributes" :inline t + (choice (const bold) (const italic) + (const underline) (const strikeout) + (const overline) (const shadow) + (const box) (const outline)))) + :version "22" + :group 'ebnf2ps) + + +(defcustom ebnf-eps-header nil + "*Specify EPS header. + +The value should be a string, a symbol or nil. + +String is inserted unchanged. + +For symbol bounded to a function, the function is called and should return a +string. For symbol bounded to a value, the value should be a string. + +If symbol is unbounded, it is silently ignored. + +Empty string or nil mean that no header will be generated. + +Note that when the header action comment (;H in EBNF syntax) is specified, the +string in the header action comment is processed and, if it returns a non-empty +string, it's used to generate the header. The header action comment accepts +the following formats: + + %% prints a % character. + + %H prints the `ebnf-eps-header' value. + + %F prints the `ebnf-eps-footer' (which see) value. + +Any other format is ignored, that is, if, for example, it's used %s then %s +characters are stripped out from the header. If header action comment is an +empty string, no header is generated until a non-empty header is specified or +`ebnf-eps-header' has a non-empty string value." + :type '(repeat (choice :menu-tag "EPS Header" + :tag "EPS Header" + string symbol (const :tag "No Header" nil ))) + :version "22" + :group 'ebnf2ps) + + +(defcustom ebnf-eps-footer-font '(7 Helvetica "Black" "White" bold) + "*Specify EPS footer font. + +See documentation for `ebnf-production-font'. + +See `ebnf-eps-buffer' and `ebnf-eps-region' commands." + :type '(list :tag "EPS Footer Font" + (number :tag "Font Size") + (symbol :tag "Font Name") + (choice :tag "Foreground Color" + (string :tag "Name") + (other :tag "Default" nil)) + (choice :tag "Background Color" + (string :tag "Name") + (other :tag "Default" nil)) + (repeat :tag "Font Attributes" :inline t + (choice (const bold) (const italic) + (const underline) (const strikeout) + (const overline) (const shadow) + (const box) (const outline)))) + :version "22" + :group 'ebnf2ps) + + +(defcustom ebnf-eps-footer nil + "*Specify EPS footer. + +The value should be a string, a symbol or nil. + +String is inserted unchanged. + +For symbol bounded to a function, the function is called and should return a +string. For symbol bounded to a value, the value should be a string. + +If symbol is unbounded, it is silently ignored. + +Empty string or nil mean that no footer will be generated. + +Note that when the footer action comment (;F in EBNF syntax) is specified, the +string in the footer action comment is processed and, if it returns a non-empty +string, it's used to generate the footer. The footer action comment accepts +the following formats: + + %% prints a % character. + + %H prints the `ebnf-eps-header' (which see) value. + + %F prints the `ebnf-eps-footer' value. + +Any other format is ignored, that is, if, for example, it's used %s then %s +characters are stripped out from the footer. If footer action comment is an +empty string, no footer is generated until a non-empty footer is specified or +`ebnf-eps-footer' has a non-empty string value." + :type '(repeat (choice :menu-tag "EPS Footer" + :tag "EPS Footer" + string symbol (const :tag "No Footer" nil ))) + :version "22" + :group 'ebnf2ps) + + (defcustom ebnf-entry-percentage 0.5 ; middle "*Specify entry height on alternatives. @@ -2019,6 +2180,16 @@ The above optimizations are specially useful when `ebnf-syntax' is `yacc'." :version "20" :group 'ebnf-optimization) + +(defcustom ebnf-log nil + "*Non-nil means generate log messages. + +The log messages are generated into the buffer *Ebnf2ps Log*. +These messages are intended to help debugging ebnf2ps." + :type 'boolean + :version "22" + :group 'ebnf2ps) + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; To make this file smaller, some commands go in a separate file. @@ -2063,6 +2234,7 @@ See also `ebnf-print-buffer'." (interactive (list (read-file-name "Directory containing EBNF files (print): " nil default-directory))) + (ebnf-log-header "(ebnf-print-directory %S)" directory) (ebnf-directory 'ebnf-print-buffer directory)) @@ -2075,6 +2247,7 @@ killed after process termination. See also `ebnf-print-buffer'." (interactive "fEBNF file to generate PostScript and print from: ") + (ebnf-log-header "(ebnf-print-file %S %S)" file do-not-kill-buffer-when-done) (ebnf-file 'ebnf-print-buffer file do-not-kill-buffer-when-done)) @@ -2091,6 +2264,7 @@ is nil, send the image to the printer. If FILENAME is a string, save the PostScript image in a file with that name. If FILENAME is a number, prompt the user for the name of the file to save in." (interactive (list (ps-print-preprint current-prefix-arg))) + (ebnf-log-header "(ebnf-print-buffer %S)" filename) (ebnf-print-region (point-min) (point-max) filename)) @@ -2099,6 +2273,7 @@ number, prompt the user for the name of the file to save in." "Generate and print a PostScript syntactic chart image of the region. Like `ebnf-print-buffer', but prints just the current region." (interactive (list (point) (mark) (ps-print-preprint current-prefix-arg))) + (ebnf-log-header "(ebnf-print-region %S %S %S)" from to filename) (run-hooks 'ebnf-hook) (or (ebnf-spool-region from to) (ps-do-despool filename))) @@ -2117,6 +2292,7 @@ See also `ebnf-spool-buffer'." (interactive (list (read-file-name "Directory containing EBNF files (spool): " nil default-directory))) + (ebnf-log-header "(ebnf-spool-directory %S)" directory) (ebnf-directory 'ebnf-spool-buffer directory)) @@ -2129,6 +2305,7 @@ killed after process termination. See also `ebnf-spool-buffer'." (interactive "fEBNF file to generate PostScript and spool from: ") + (ebnf-log-header "(ebnf-spool-file %S %S)" file do-not-kill-buffer-when-done) (ebnf-file 'ebnf-spool-buffer file do-not-kill-buffer-when-done)) @@ -2140,6 +2317,7 @@ local buffer to be sent to the printer later. Use the command `ebnf-despool' to send the spooled images to the printer." (interactive) + (ebnf-log-header "(ebnf-spool-buffer)") (ebnf-spool-region (point-min) (point-max))) @@ -2150,6 +2328,7 @@ Like `ebnf-spool-buffer', but spools just the current region. Use the command `ebnf-despool' to send the spooled images to the printer." (interactive "r") + (ebnf-log-header "(ebnf-spool-region %S)" from to) (ebnf-generate-region from to 'ebnf-generate)) @@ -2166,6 +2345,7 @@ See also `ebnf-eps-buffer'." (interactive (list (read-file-name "Directory containing EBNF files (EPS): " nil default-directory))) + (ebnf-log-header "(ebnf-eps-directory %S)" directory) (ebnf-directory 'ebnf-eps-buffer directory)) @@ -2178,6 +2358,7 @@ killed after EPS generation. See also `ebnf-eps-buffer'." (interactive "fEBNF file to generate EPS file from: ") + (ebnf-log-header "(ebnf-eps-file %S %S)" file do-not-kill-buffer-when-done) (ebnf-file 'ebnf-eps-buffer file do-not-kill-buffer-when-done)) @@ -2200,8 +2381,9 @@ The EPS file name has the following form: file name used in this case will be \"ebnf--A_B_+_C.eps\". WARNING: This function does *NOT* ask any confirmation to override existing - files." + files." (interactive) + (ebnf-log-header "(ebnf-eps-buffer)") (ebnf-eps-region (point-min) (point-max))) @@ -2224,8 +2406,9 @@ The EPS file name has the following form: file name used in this case will be \"ebnf--A_B_+_C.eps\". WARNING: This function does *NOT* ask any confirmation to override existing - files." + files." (interactive "r") + (ebnf-log-header "(ebnf-eps-region %S %S)" from to) (let ((ebnf-eps-executing t)) (ebnf-generate-region from to 'ebnf-generate-eps))) @@ -2247,6 +2430,7 @@ See also `ebnf-syntax-buffer'." (interactive (list (read-file-name "Directory containing EBNF files (syntax): " nil default-directory))) + (ebnf-log-header "(ebnf-syntax-directory %S)" directory) (ebnf-directory 'ebnf-syntax-buffer directory)) @@ -2259,6 +2443,7 @@ killed after syntax checking. See also `ebnf-syntax-buffer'." (interactive "fEBNF file to check syntax: ") + (ebnf-log-header "(ebnf-syntax-file %S %S)" file do-not-kill-buffer-when-done) (ebnf-file 'ebnf-syntax-buffer file do-not-kill-buffer-when-done)) @@ -2266,13 +2451,15 @@ See also `ebnf-syntax-buffer'." (defun ebnf-syntax-buffer () "Do a syntactic analysis of the current buffer." (interactive) + (ebnf-log-header "(ebnf-syntax-buffer)") (ebnf-syntax-region (point-min) (point-max))) ;;;###autoload (defun ebnf-syntax-region (from to) - "Do a syntactic analysis of region." + "Do a syntactic analysis of a region." (interactive "r") + (ebnf-log-header "(ebnf-syntax-region %S %S)" from to) (ebnf-generate-region from to nil)) @@ -2287,6 +2474,8 @@ See also `ebnf-syntax-buffer'." " ;;; ebnf2ps.el version %s +;;; Emacs version %S + \(setq ebnf-special-show-delimiter %S ebnf-special-font %s ebnf-special-shape %s @@ -2333,20 +2522,28 @@ See also `ebnf-syntax-buffer'." ebnf-iso-normalize-p %S ebnf-file-suffix-regexp %S ebnf-eps-prefix %S + ebnf-eps-header-font %s + ebnf-eps-header %s + ebnf-eps-footer-font %s + ebnf-eps-footer %s ebnf-entry-percentage %S ebnf-color-p %S ebnf-line-width %S ebnf-line-color %S + ebnf-arrow-extra-width %S + ebnf-arrow-scale %S ebnf-debug-ps %S ebnf-use-float-format %S ebnf-stop-on-error %S ebnf-yac-ignore-error-recovery %S ebnf-ignore-empty-rule %S - ebnf-optimize %S) + ebnf-optimize %S + ebnf-log %S) ;;; ebnf2ps.el - end of settings " ebnf-version + emacs-version ebnf-special-show-delimiter (ps-print-quote ebnf-special-font) (ps-print-quote ebnf-special-shape) @@ -2393,16 +2590,23 @@ See also `ebnf-syntax-buffer'." ebnf-iso-normalize-p ebnf-file-suffix-regexp ebnf-eps-prefix + (ps-print-quote ebnf-eps-header-font) + (ps-print-quote ebnf-eps-header) + (ps-print-quote ebnf-eps-footer-font) + (ps-print-quote ebnf-eps-footer) ebnf-entry-percentage ebnf-color-p ebnf-line-width ebnf-line-color + ebnf-arrow-extra-width + ebnf-arrow-scale ebnf-debug-ps ebnf-use-float-format ebnf-stop-on-error ebnf-yac-ignore-error-recovery ebnf-ignore-empty-rule - ebnf-optimize)) + ebnf-optimize + ebnf-log)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -2465,6 +2669,10 @@ See also `ebnf-syntax-buffer'." ebnf-iso-normalize-p ebnf-file-suffix-regexp ebnf-eps-prefix + ebnf-eps-header-font + ebnf-eps-header + ebnf-eps-footer-font + ebnf-eps-footer ebnf-entry-percentage ebnf-color-p ebnf-line-width @@ -2528,6 +2736,10 @@ See also `ebnf-syntax-buffer'." (ebnf-iso-normalize-p . nil) (ebnf-file-suffix-regexp . "\.[Bb][Nn][Ff]$") (ebnf-eps-prefix . "ebnf--") + (ebnf-eps-header-font . '(11 Helvetica "Black" "White" bold)) + (ebnf-eps-header . nil) + (ebnf-eps-footer-font . '(7 Helvetica "Black" "White" bold)) + (ebnf-eps-footer . nil) (ebnf-entry-percentage . 0.5) (ebnf-color-p . (or (fboundp 'x-color-values) ; Emacs (fboundp 'color-instance-rgb-components))) ; XEmacs @@ -2601,6 +2813,15 @@ Don't use this variable directly. Use functions `ebnf-insert-style', ;;;###autoload +(defun ebnf-find-style (name) + "Return style definition if NAME is already defined; otherwise, return nil. + +See `ebnf-style-database' documentation." + (interactive "SStyle name: ") + (assoc name ebnf-style-database)) + + +;;;###autoload (defun ebnf-insert-style (name inherits &rest values) "Insert a new style NAME with inheritance INHERITS and values VALUES. @@ -2735,18 +2956,20 @@ See `ebnf-style-database' documentation." ;; Internal variables -(defvar ebnf-eps-buffer-name " *EPS*") -(defvar ebnf-parser-func nil) -(defvar ebnf-eps-executing nil) -(defvar ebnf-eps-upper-x 0.0) +(defvar ebnf-eps-buffer-name " *EPS*") +(defvar ebnf-parser-func nil) +(defvar ebnf-eps-executing nil) +(defvar ebnf-eps-header-comment nil) +(defvar ebnf-eps-footer-comment nil) +(defvar ebnf-eps-upper-x 0.0) (make-variable-buffer-local 'ebnf-eps-upper-x) -(defvar ebnf-eps-upper-y 0.0) +(defvar ebnf-eps-upper-y 0.0) (make-variable-buffer-local 'ebnf-eps-upper-y) -(defvar ebnf-eps-prod-width 0.0) +(defvar ebnf-eps-prod-width 0.0) (make-variable-buffer-local 'ebnf-eps-prod-width) -(defvar ebnf-eps-max-height 0.0) +(defvar ebnf-eps-max-height 0.0) (make-variable-buffer-local 'ebnf-eps-max-height) -(defvar ebnf-eps-max-width 0.0) +(defvar ebnf-eps-max-width 0.0) (make-variable-buffer-local 'ebnf-eps-max-width) @@ -2756,6 +2979,23 @@ See `ebnf-style-database' documentation." See section \"Actions in Comments\" in ebnf2ps documentation.") +(defvar ebnf-eps-file-alist nil +"Alist associating file name with EPS header and footer. + +Each element has the following form: + + (EPS-FILENAME HEADER FOOTER) + +EPS-FILENAME is the EPS file name. +HEADER is the header string or nil. +FOOTER is the footer string or nil. + +It's generated during parsing and used during EPS generation. + +See `ebnf-eps-context' and section \"Actions in Comments\" in ebnf2ps +documentation.") + + (defvar ebnf-eps-production-list nil "Alist associating production name with EPS file name list. @@ -2800,41 +3040,43 @@ See documentation for `ebnf-terminal-shape', `ebnf-non-terminal-shape' and `ebnf-chart-shape'.") -(defvar ebnf-limit nil) -(defvar ebnf-action nil) -(defvar ebnf-action-list nil) +(defvar ebnf-limit nil) +(defvar ebnf-action nil) +(defvar ebnf-action-list nil) -(defvar ebnf-default-p nil) +(defvar ebnf-default-p nil) -(defvar ebnf-font-height-P 0) -(defvar ebnf-font-height-T 0) -(defvar ebnf-font-height-NT 0) -(defvar ebnf-font-height-S 0) -(defvar ebnf-font-height-E 0) -(defvar ebnf-font-height-R 0) -(defvar ebnf-font-width-P 0) -(defvar ebnf-font-width-T 0) -(defvar ebnf-font-width-NT 0) -(defvar ebnf-font-width-S 0) -(defvar ebnf-font-width-E 0) -(defvar ebnf-font-width-R 0) -(defvar ebnf-space-T 0) -(defvar ebnf-space-NT 0) -(defvar ebnf-space-S 0) -(defvar ebnf-space-E 0) -(defvar ebnf-space-R 0) +(defvar ebnf-font-height-P 0) +(defvar ebnf-font-height-T 0) +(defvar ebnf-font-height-NT 0) +(defvar ebnf-font-height-S 0) +(defvar ebnf-font-height-E 0) +(defvar ebnf-font-height-R 0) +(defvar ebnf-font-width-P 0) +(defvar ebnf-font-width-T 0) +(defvar ebnf-font-width-NT 0) +(defvar ebnf-font-width-S 0) +(defvar ebnf-font-width-E 0) +(defvar ebnf-font-width-R 0) +(defvar ebnf-space-T 0) +(defvar ebnf-space-NT 0) +(defvar ebnf-space-S 0) +(defvar ebnf-space-E 0) +(defvar ebnf-space-R 0) -(defvar ebnf-basic-width 0) -(defvar ebnf-basic-height 0) -(defvar ebnf-vertical-space 0) -(defvar ebnf-horizontal-space 0) +(defvar ebnf-basic-width-extra 0) +(defvar ebnf-basic-width 0) +(defvar ebnf-basic-height 0) +(defvar ebnf-basic-empty-height 0) +(defvar ebnf-vertical-space 0) +(defvar ebnf-horizontal-space 0) -(defvar ebnf-settings nil) -(defvar ebnf-fonts-required nil) +(defvar ebnf-settings nil) +(defvar ebnf-fonts-required nil) (defconst ebnf-debug @@ -3179,8 +3421,8 @@ See documentation for `ebnf-terminal-shape', `ebnf-non-terminal-shape' and % --- Flow Stuff -% height prepare_height |- line_height corner_height corner_height -/prepare_height +% height prepare-height |- line_height corner_height corner_height +/prepare-height {dup 0 gt {T sub hT} {T add hT neg}ifelse @@ -3206,7 +3448,7 @@ See documentation for `ebnf-terminal-shape', `ebnf-non-terminal-shape' and {0.5 mul dup 1 corner_RA 0 corner_RD} - {prepare_height + {prepare-height 1 corner_RA exch 0 exch rlineto 0 corner_RD @@ -3227,7 +3469,7 @@ See documentation for `ebnf-terminal-shape', `ebnf-non-terminal-shape' and % \\ % - /LLoop -{prepare_height +{prepare-height 3 corner_LA exch 0 exch rlineto 0 corner_RD @@ -3252,7 +3494,7 @@ See documentation for `ebnf-terminal-shape', `ebnf-non-terminal-shape' and {0.5 mul dup 1 corner_LA 0 corner_LD} - {prepare_height + {prepare-height 1 corner_LA exch 0 exch rlineto 0 corner_LD @@ -3273,7 +3515,7 @@ See documentation for `ebnf-terminal-shape', `ebnf-non-terminal-shape' and % / % - /RLoop -{prepare_height +{prepare-height 1 corner_RA exch 0 exch rlineto 0 corner_LD @@ -4064,6 +4306,113 @@ end ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Header & Footer + + +(defun ebnf-eps-header-footer (value) + ;; evaluate header/footer value + ;; return a string or nil + (let ((tmp (if (symbolp value) + (cond ((fboundp value) (funcall value)) + ((boundp value) (symbol-value value)) + (t nil)) + value))) + (and (stringp tmp) tmp))) + + +(defun ebnf-eps-header () + ;; evaluate header value + (ebnf-eps-header-footer ebnf-eps-header)) + + +(defun ebnf-eps-footer () + ;; evaluate footer value + (ebnf-eps-header-footer ebnf-eps-footer)) + + +;; hacked fom `ps-output-string-prim' (ps-print.el) +(defun ebnf-eps-string (string) + (let* ((str (string-as-unibyte string)) + (len (length str)) + (index 0) + (new "(") ; insert start-string delimiter + start special) + ;; Find and quote special characters as necessary for PS + ;; This skips everything except control chars, non-ASCII chars, (, ) and \. + (while (setq start (string-match "[^]-~ -'*-[]" str index)) + (setq special (aref str start) + new (concat new + (substring str index start) + (if (and (<= 0 special) (<= special 255)) + (aref ps-string-escape-codes special) + ;; insert hexadecimal representation if character + ;; code is out of range + (format "\\%04X" special))) + index (1+ start))) + (concat new + (and (< index len) + (substring str index len)) + ")"))) ; insert end-string delimiter + + +(defun ebnf-eps-header-footer-comment (str) + ;; parse header/footer comment string + (let ((len (1- (length str))) + (index 0) + new start fmt) + (while (setq start (string-match "%" str index)) + (setq fmt (if (< start len) (aref str (1+ start)) ?\?) + new (concat new + (substring str index start) + (cond ((= fmt ?%) "%") + ((= fmt ?H) (ebnf-eps-header)) + ((= fmt ?F) (ebnf-eps-footer)) + (t nil) + )) + index (+ start 2))) + (ebnf-eps-string (concat new + (and (<= index len) + (substring str index (1+ len))))))) + + +(defun ebnf-eps-header-footer-p (value) + ;; return t if value is non-nil and is not an empty string + (not (or (null value) + (and (stringp value) (string= value ""))))) + + +(defun ebnf-eps-header-comment (str) + ;; set header comment if header is on + (when (ebnf-eps-header-footer-p ebnf-eps-header) + (setq ebnf-eps-header-comment (ebnf-eps-header-footer-comment str)))) + + +(defun ebnf-eps-footer-comment (str) + ;; set footer comment if footer is on + (when (ebnf-eps-header-footer-p ebnf-eps-footer) + (setq ebnf-eps-footer-comment (ebnf-eps-header-footer-comment str)))) + + +(defun ebnf-eps-header-footer-file (filename) + ;; associate header and footer with a filename + (let ((filehf (assoc filename ebnf-eps-file-alist)) + (header (or ebnf-eps-header-comment (ebnf-eps-header))) + (footer (or ebnf-eps-footer-comment (ebnf-eps-footer)))) + (if (null filehf) + (setq ebnf-eps-file-alist (cons (list filename header footer) + ebnf-eps-file-alist)) + (setcar (nthcdr 1 filehf) header) + (setcar (nthcdr 2 filehf) footer)))) + + +(defun ebnf-eps-header-footer-set (filename) + ;; set header and footer from a filename + (let ((header-footer (assoc filename ebnf-eps-file-alist))) + (setq ebnf-eps-header-comment (nth 1 header-footer) + ebnf-eps-footer-comment (nth 2 header-footer)))) + + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Formatting @@ -4513,7 +4862,9 @@ end (if sep (let ((ebnf-direction "L")) (ebnf-node-generation sep)) - (ebnf-empty-alternative (- width ebnf-horizontal-space)))) + (ebnf-empty-alternative (- width + ebnf-horizontal-space + ebnf-basic-width-extra)))) (ps-output "EOS\n")) @@ -4528,7 +4879,7 @@ end (if node-sep (- (ebnf-node-height node-sep) (ebnf-node-entry node-sep)) - 0)))) + ebnf-basic-empty-height)))) (ps-output (ebnf-format-float entry (+ (- (ebnf-node-height node-list) list-entry) @@ -4540,7 +4891,9 @@ end (if (ebnf-node-separator zero-or-more) (let ((ebnf-direction "L")) (ebnf-node-generation (ebnf-node-separator zero-or-more))) - (ebnf-empty-alternative (- width ebnf-horizontal-space)))) + (ebnf-empty-alternative (- width + ebnf-horizontal-space + ebnf-basic-width-extra)))) (ps-output "EOS\n")) @@ -4651,18 +5004,20 @@ killed after process termination." (defvar ebnf-map-name (let ((map (make-vector 256 ?\_))) - (mapcar #'(lambda (char) - (aset map char char)) - (concat "#$%&+-.0123456789=?@~" - "ABCDEFGHIJKLMNOPQRSTUVWXYZ" - "abcdefghijklmnopqrstuvwxyz")) + (mapc #'(lambda (char) + (aset map char char)) + (concat "#$%&+-.0123456789=?@~" + "ABCDEFGHIJKLMNOPQRSTUVWXYZ" + "abcdefghijklmnopqrstuvwxyz")) map)) (defun ebnf-eps-filename (str) (let* ((len (length str)) (stri 0) - (new (make-string len ?\s))) + ;; to keep compatibility with Emacs 20 & 21: + ;; DO NOT REPLACE `?\ ' BY `?\s' + (new (make-string len ?\ ))) (while (< stri len) (aset new stri (aref ebnf-map-name (aref str stri))) (setq stri (1+ stri))) @@ -4723,6 +5078,7 @@ killed after process termination." (defun ebnf-parse-and-sort (start) + (ebnf-log "(ebnf-parse-and-sort %S)" start) (ebnf-begin-job) (let ((tree (funcall ebnf-parser-func start))) (if ebnf-sort-production @@ -4861,7 +5217,10 @@ killed after process termination." ebnf-action nil ebnf-default-p nil ebnf-eps-context nil + ebnf-eps-file-alist nil ebnf-eps-production-list nil + ebnf-eps-header-comment nil + ebnf-eps-footer-comment nil ebnf-eps-upper-x 0.0 ebnf-eps-upper-y 0.0 ebnf-font-height-P (ebnf-font-height ebnf-production-font) @@ -4882,10 +5241,14 @@ killed after process termination." ebnf-space-E (* ebnf-font-height-E 0.5) ebnf-space-R (* ebnf-font-height-R 0.5)) (let ((basic (+ ebnf-font-height-T ebnf-font-height-NT))) - (setq ebnf-basic-width (* basic 0.5) - ebnf-horizontal-space (+ basic basic) - ebnf-basic-height ebnf-basic-width - ebnf-vertical-space ebnf-basic-width) + (setq ebnf-basic-width (* basic 0.5) + ebnf-horizontal-space (+ basic basic) + ebnf-basic-empty-height (* ebnf-basic-width 0.5) + ebnf-basic-height ebnf-basic-width + ebnf-vertical-space ebnf-basic-width + ebnf-basic-width-extra (- ebnf-basic-width + ebnf-arrow-extra-width + 0.1)) ; error factor ;; ensures value is greater than zero (or (and (numberp ebnf-production-horizontal-space) (> ebnf-production-horizontal-space 0.0)) @@ -4893,7 +5256,18 @@ killed after process termination." ;; ensures value is greater than zero (or (and (numberp ebnf-production-vertical-space) (> ebnf-production-vertical-space 0.0)) - (setq ebnf-production-vertical-space basic)))) + (setq ebnf-production-vertical-space basic))) + (ebnf-log "(ebnf-begin-job)") + (ebnf-log " ebnf-arrow-extra-width ............ : %7.3f" ebnf-arrow-extra-width) + (ebnf-log " ebnf-arrow-scale .................. : %7.3f" ebnf-arrow-scale) + (ebnf-log " ebnf-basic-width-extra ............ : %7.3f" ebnf-basic-width-extra) + (ebnf-log " ebnf-basic-width .................. : %7.3f (T)" ebnf-basic-width) + (ebnf-log " ebnf-horizontal-space ............. : %7.3f (4T)" ebnf-horizontal-space) + (ebnf-log " ebnf-basic-empty-height ........... : %7.3f (hT)" ebnf-basic-empty-height) + (ebnf-log " ebnf-basic-height ................. : %7.3f (T)" ebnf-basic-height) + (ebnf-log " ebnf-vertical-space ............... : %7.3f (T)" ebnf-vertical-space) + (ebnf-log " ebnf-production-horizontal-space .. : %7.3f (2T)" ebnf-production-horizontal-space) + (ebnf-log " ebnf-production-vertical-space .... : %7.3f (2T)" ebnf-production-vertical-space)) (defsubst ebnf-shape-value (sym alist) @@ -4916,6 +5290,7 @@ killed after process termination." (progn ;; adjust creator comment (end-of-line) + ;; (backward-char) (insert " & ebnf2ps v" ebnf-version) ;; insert ebnf settings & engine (goto-char (point-max)) @@ -4928,6 +5303,7 @@ killed after process termination." (when (buffer-modified-p buffer) (save-excursion (set-buffer buffer) + (ebnf-eps-header-footer-set filename) (setq ebnf-eps-upper-x (max ebnf-eps-upper-x ebnf-eps-max-width) ebnf-eps-upper-y (if (zerop ebnf-eps-upper-y) ebnf-eps-max-height @@ -4954,7 +5330,9 @@ killed after process termination." ebnf-non-terminal-font ebnf-special-font ebnf-except-font - ebnf-repeat-font))) + ebnf-repeat-font + ebnf-eps-header-font + ebnf-eps-footer-font))) "\n%%+ font "))) "\n%%Pages: 0\n%%EndComments\n\n%%BeginProlog\n" ebnf-eps-prologue) @@ -4980,6 +5358,42 @@ killed after process termination." (setq ebnf-settings (concat "\n\n% === begin EBNF settings\n\n" + (format "/Header %s def\n" + (or ebnf-eps-header-comment "()")) + (format "/Footer %s def\n" + (or ebnf-eps-footer-comment "()")) + ;; header + (format "/ShowHeader %s def\n" + (ebnf-boolean + (ebnf-eps-header-footer-p ebnf-eps-header))) + (format "/fH %s /%s DefFont\n" + (ebnf-format-float + (ebnf-font-size ebnf-eps-header-font)) + (ebnf-font-name-select ebnf-eps-header-font)) + (ebnf-format-color "/ForegroundH %s def %% %s\n" + (ebnf-font-foreground ebnf-eps-header-font) + "Black") + (ebnf-format-color "/BackgroundH %s def %% %s\n" + (ebnf-font-background ebnf-eps-header-font) + "White") + (format "/EffectH %d def\n" + (ebnf-font-attributes ebnf-eps-header-font)) + ;; footer + (format "/ShowFooter %s def\n" + (ebnf-boolean + (ebnf-eps-header-footer-p ebnf-eps-footer))) + (format "/fF %s /%s DefFont\n" + (ebnf-format-float + (ebnf-font-size ebnf-eps-footer-font)) + (ebnf-font-name-select ebnf-eps-footer-font)) + (ebnf-format-color "/ForegroundF %s def %% %s\n" + (ebnf-font-foreground ebnf-eps-footer-font) + "Black") + (ebnf-format-color "/BackgroundF %s def %% %s\n" + (ebnf-font-background ebnf-eps-footer-font) + "White") + (format "/EffectF %d def\n" + (ebnf-font-attributes ebnf-eps-footer-font)) ;; production (format "/fP %s /%s DefFont\n" (ebnf-format-float (ebnf-font-size ebnf-production-font)) @@ -5136,9 +5550,10 @@ killed after process termination." (defun ebnf-dimensions (tree) + (ebnf-log "(ebnf-dimensions tree)") (let ((ebnf-total (length tree)) (ebnf-nprod 0)) - (mapcar 'ebnf-production-dimension tree)) + (mapc 'ebnf-production-dimension tree)) tree) @@ -5149,6 +5564,7 @@ killed after process termination." ;; [production width-fun dim-fun entry height width name production action] (defun ebnf-production-dimension (production) + (ebnf-log "(ebnf-production-dimension production)") (ebnf-message-info "Calculating dimensions") (ebnf-node-dimension-func (ebnf-node-production production)) (let* ((prod (ebnf-node-production production)) @@ -5162,11 +5578,17 @@ killed after process termination." (ebnf-node-height production height) (ebnf-node-width production (+ (ebnf-node-width prod) ebnf-line-width - ebnf-horizontal-space)))) + ebnf-horizontal-space + ebnf-basic-width-extra))) + (ebnf-log " production name : %S" (ebnf-node-name production)) + (ebnf-log " production entry : %7.3f" (ebnf-node-entry production)) + (ebnf-log " production height : %7.3f" (ebnf-node-height production)) + (ebnf-log " production width : %7.3f" (ebnf-node-width production))) ;; [terminal width-fun dim-fun entry height width name] (defun ebnf-terminal-dimension (terminal) + (ebnf-log "(ebnf-terminal-dimension terminal)") (ebnf-terminal-dimension1 terminal ebnf-font-height-T ebnf-font-width-T @@ -5175,6 +5597,7 @@ killed after process termination." ;; [non-terminal width-fun dim-fun entry height width name] (defun ebnf-non-terminal-dimension (non-terminal) + (ebnf-log "(ebnf-non-terminal-dimension non-terminal)") (ebnf-terminal-dimension1 non-terminal ebnf-font-height-NT ebnf-font-width-NT @@ -5183,6 +5606,7 @@ killed after process termination." ;; [special width-fun dim-fun entry height width name] (defun ebnf-special-dimension (special) + (ebnf-log "(ebnf-special-dimension special)") (ebnf-terminal-dimension1 special ebnf-font-height-S ebnf-font-width-S @@ -5194,9 +5618,16 @@ killed after process termination." (len (length (ebnf-node-name node)))) (ebnf-node-entry node (* height 0.5)) (ebnf-node-height node height) - (ebnf-node-width node (+ ebnf-basic-width ebnf-arrow-extra-width space + (ebnf-node-width node (+ ebnf-basic-width + ebnf-arrow-extra-width + space (* len font-width) - space ebnf-basic-width)))) + space + ebnf-basic-width))) + (ebnf-log " name : %S" (ebnf-node-name node)) + (ebnf-log " entry : %7.3f" (ebnf-node-entry node)) + (ebnf-log " height : %7.3f" (ebnf-node-height node)) + (ebnf-log " width : %7.3f" (ebnf-node-width node))) (defconst ebnf-null-vector (vector t t t 0.0 0.0 0.0)) @@ -5204,6 +5635,7 @@ killed after process termination." ;; [repeat width-fun dim-fun entry height width times element] (defun ebnf-repeat-dimension (repeat) + (ebnf-log "(ebnf-repeat-dimension repeat)") (let ((times (ebnf-node-name repeat)) (element (ebnf-node-separator repeat))) (if element @@ -5218,11 +5650,15 @@ killed after process termination." ebnf-arrow-extra-width ebnf-space-R ebnf-space-R ebnf-space-R ebnf-horizontal-space - (* (length times) ebnf-font-width-R))))) + (* (length times) ebnf-font-width-R)))) + (ebnf-log " repeat entry : %7.3f" (ebnf-node-entry repeat)) + (ebnf-log " repeat height : %7.3f" (ebnf-node-height repeat)) + (ebnf-log " repeat width : %7.3f" (ebnf-node-width repeat))) ;; [except width-fun dim-fun entry height width element element] (defun ebnf-except-dimension (except) + (ebnf-log "(ebnf-except-dimension except)") (let ((factor (ebnf-node-list except)) (element (ebnf-node-separator except))) (ebnf-node-dimension-func factor) @@ -5241,11 +5677,15 @@ killed after process termination." ebnf-space-E ebnf-space-E ebnf-space-E ebnf-space-E ebnf-font-width-E - ebnf-horizontal-space)))) + ebnf-horizontal-space))) + (ebnf-log " except entry : %7.3f" (ebnf-node-entry except)) + (ebnf-log " except height : %7.3f" (ebnf-node-height except)) + (ebnf-log " except width : %7.3f" (ebnf-node-width except))) ;; [alternative width-fun dim-fun entry height width list] (defun ebnf-alternative-dimension (alternative) + (ebnf-log "(ebnf-alternative-dimension alternative)") (let ((body (ebnf-node-list alternative)) (lis (ebnf-node-list alternative))) (while lis @@ -5270,23 +5710,33 @@ killed after process termination." (- (ebnf-node-height tail) (ebnf-node-entry tail)))))) (ebnf-node-height alternative height) - (ebnf-node-width alternative (+ width ebnf-horizontal-space)) - (ebnf-node-list alternative body)))) + (ebnf-node-width alternative (+ width + ebnf-horizontal-space + ebnf-basic-width-extra)) + (ebnf-node-list alternative body))) + (ebnf-log " alternative entry : %7.3f" (ebnf-node-entry alternative)) + (ebnf-log " alternative height : %7.3f" (ebnf-node-height alternative)) + (ebnf-log " alternative width : %7.3f" (ebnf-node-width alternative))) ;; [optional width-fun dim-fun entry height width element] (defun ebnf-optional-dimension (optional) + (ebnf-log "(ebnf-optional-dimension optional)") (let ((body (ebnf-node-list optional))) (ebnf-node-dimension-func body) (ebnf-node-entry optional (ebnf-node-entry body)) (ebnf-node-height optional (+ (ebnf-node-height body) ebnf-vertical-space)) (ebnf-node-width optional (+ (ebnf-node-width body) - ebnf-horizontal-space)))) + ebnf-horizontal-space))) + (ebnf-log " optional entry : %7.3f" (ebnf-node-entry optional)) + (ebnf-log " optional height : %7.3f" (ebnf-node-height optional)) + (ebnf-log " optional width : %7.3f" (ebnf-node-width optional))) ;; [one-or-more width-fun dim-fun entry height width element separator] (defun ebnf-one-or-more-dimension (or-more) + (ebnf-log "(ebnf-one-or-more-dimension or-more)") (let ((list-part (ebnf-node-list or-more)) (sep-part (ebnf-node-separator or-more))) (ebnf-node-dimension-func list-part) @@ -5294,7 +5744,7 @@ killed after process termination." (ebnf-node-dimension-func sep-part)) (let ((height (+ (if sep-part (ebnf-node-height sep-part) - 0.0) + ebnf-basic-empty-height) ebnf-vertical-space (ebnf-node-height list-part))) (width (max (if sep-part @@ -5304,14 +5754,21 @@ killed after process termination." (when sep-part (ebnf-adjust-width list-part width) (ebnf-adjust-width sep-part width)) - (ebnf-node-entry or-more (+ (- height (ebnf-node-height list-part)) + (ebnf-node-entry or-more (+ (- height + (ebnf-node-height list-part)) (ebnf-node-entry list-part))) (ebnf-node-height or-more height) - (ebnf-node-width or-more (+ width ebnf-horizontal-space))))) + (ebnf-node-width or-more (+ width + ebnf-horizontal-space + ebnf-basic-width-extra)))) + (ebnf-log " one-or-more entry : %7.3f" (ebnf-node-entry or-more)) + (ebnf-log " one-or-more height : %7.3f" (ebnf-node-height or-more)) + (ebnf-log " one-or-more width : %7.3f" (ebnf-node-width or-more))) ;; [zero-or-more width-fun dim-fun entry height width element separator] (defun ebnf-zero-or-more-dimension (or-more) + (ebnf-log "(ebnf-zero-or-more-dimension or-more)") (let ((list-part (ebnf-node-list or-more)) (sep-part (ebnf-node-separator or-more))) (ebnf-node-dimension-func list-part) @@ -5319,7 +5776,7 @@ killed after process termination." (ebnf-node-dimension-func sep-part)) (let ((height (+ (if sep-part (ebnf-node-height sep-part) - 0.0) + ebnf-basic-empty-height) ebnf-vertical-space (ebnf-node-height list-part) ebnf-vertical-space)) @@ -5332,11 +5789,17 @@ killed after process termination." (ebnf-adjust-width sep-part width)) (ebnf-node-entry or-more height) (ebnf-node-height or-more height) - (ebnf-node-width or-more (+ width ebnf-horizontal-space))))) + (ebnf-node-width or-more (+ width + ebnf-horizontal-space + ebnf-basic-width-extra)))) + (ebnf-log " zero-or-more entry : %7.3f" (ebnf-node-entry or-more)) + (ebnf-log " zero-or-more height : %7.3f" (ebnf-node-height or-more)) + (ebnf-log " zero-or-more width : %7.3f" (ebnf-node-width or-more))) ;; [sequence width-fun dim-fun entry height width list] (defun ebnf-sequence-dimension (sequence) + (ebnf-log "(ebnf-sequence-dimension sequence)") (let ((above 0.0) (below 0.0) (width 0.0) @@ -5352,7 +5815,10 @@ killed after process termination." width (+ width (ebnf-node-width node)))) (ebnf-node-entry sequence above) (ebnf-node-height sequence (+ above below)) - (ebnf-node-width sequence width))) + (ebnf-node-width sequence width)) + (ebnf-log " sequence entry : %7.3f" (ebnf-node-entry sequence)) + (ebnf-log " sequence height : %7.3f" (ebnf-node-height sequence)) + (ebnf-log " sequence width : %7.3f" (ebnf-node-width sequence))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -5494,7 +5960,8 @@ killed after process termination." (let ((filename (ebnf-eps-filename name))) (if (member filename ebnf-eps-context) (error "Try to open an already opened EPS file: %s" filename) - (setq ebnf-eps-context (cons filename ebnf-eps-context))))) + (setq ebnf-eps-context (cons filename ebnf-eps-context))) + (ebnf-eps-header-footer-file filename))) (defun ebnf-eps-remove-context (name) @@ -5505,14 +5972,16 @@ killed after process termination." (defun ebnf-eps-add-production (header) - (and ebnf-eps-executing - ebnf-eps-context - (let ((prod (assoc header ebnf-eps-production-list))) - (if prod - (setcdr prod (append ebnf-eps-context (cdr prod))) - (setq ebnf-eps-production-list - (cons (cons header (ebnf-dup-list ebnf-eps-context)) - ebnf-eps-production-list)))))) + (when ebnf-eps-executing + (if ebnf-eps-context + (let ((prod (assoc header ebnf-eps-production-list))) + (if prod + (setcdr prod (ebnf-dup-list + (append ebnf-eps-context (cdr prod)))) + (setq ebnf-eps-production-list + (cons (cons header (ebnf-dup-list ebnf-eps-context)) + ebnf-eps-production-list)))) + (ebnf-eps-header-footer-file (ebnf-eps-filename header))))) (defun ebnf-dup-list (old) @@ -5567,7 +6036,9 @@ killed after process termination." (defun ebnf-trim-right (str) (let* ((len (1- (length str))) (index len)) - (while (and (> index 0) (= (aref str index) ?\s)) + ;; to keep compatibility with Emacs 20 & 21: + ;; DO NOT REPLACE `?\ ' BY `?\s' + (while (and (> index 0) (= (aref str index) ?\ )) (setq index (1- index))) (if (= index len) str @@ -5579,12 +6050,12 @@ killed after process termination." (defun ebnf-make-empty (&optional width) - (vector 'ebnf-generate-empty - 'ignore - 'ignore - 0.0 - 0.0 - (or width ebnf-horizontal-space))) + (vector 'ebnf-generate-empty ; 0 generator + 'ignore ; 1 width fun + 'ignore ; 2 dimension fun + 0.0 ; 3 entry + 0.0 ; 4 height + (or width ebnf-horizontal-space))) ; 5 width (defun ebnf-make-terminal (name) @@ -5606,19 +6077,19 @@ killed after process termination." (defun ebnf-make-terminal1 (name gen-func dim-func) - (vector gen-func - 'ignore - dim-func - 0.0 - 0.0 - 0.0 - (let ((len (length name))) + (vector gen-func ; 0 generatore + 'ignore ; 1 width fun + dim-func ; 2 dimension fun + 0.0 ; 3 entry + 0.0 ; 4 height + 0.0 ; 5 width + (let ((len (length name))) ; 6 name (cond ((> len 3) name) ((= len 3) (concat name " ")) ((= len 2) (concat " " name " ")) ((= len 1) (concat " " name " ")) (t " "))) - ebnf-default-p)) + ebnf-default-p)) ; 7 is default? (defun ebnf-make-one-or-more (list-part &optional sep-part) @@ -5636,70 +6107,71 @@ killed after process termination." (defun ebnf-make-or-more1 (gen-func dim-func list-part sep-part) - (vector gen-func - 'ebnf-element-width - dim-func - 0.0 - 0.0 - 0.0 - (if (listp list-part) + (vector gen-func ; 0 generator + 'ebnf-element-width ; 1 width fun + dim-func ; 2 dimension fun + 0.0 ; 3 entry + 0.0 ; 4 height + 0.0 ; 5 width + (if (listp list-part) ; 6 element (ebnf-make-sequence list-part) list-part) - (if (and sep-part (listp sep-part)) + (if (and sep-part (listp sep-part)) ; 7 separator (ebnf-make-sequence sep-part) sep-part))) (defun ebnf-make-production (name prod action) - (vector 'ebnf-generate-production - 'ignore - 'ebnf-production-dimension - 0.0 - 0.0 - 0.0 - name - prod - action)) + (vector 'ebnf-generate-production ; 0 generator + 'ignore ; 1 width fun + 'ebnf-production-dimension ; 2 dimension fun + 0.0 ; 3 entry + 0.0 ; 4 height + 0.0 ; 5 width + name ; 6 production name + prod ; 7 production body + action)) ; 8 production action (defun ebnf-make-alternative (body) - (vector 'ebnf-generate-alternative - 'ebnf-alternative-width - 'ebnf-alternative-dimension - 0.0 - 0.0 - 0.0 - body)) + (vector 'ebnf-generate-alternative ; 0 generator + 'ebnf-alternative-width ; 1 width fun + 'ebnf-alternative-dimension ; 2 dimension fun + 0.0 ; 3 entry + 0.0 ; 4 height + 0.0 ; 5 width + body)) ; 6 alternative list (defun ebnf-make-optional (body) - (vector 'ebnf-generate-optional - 'ebnf-alternative-width - 'ebnf-optional-dimension - 0.0 - 0.0 - 0.0 - body)) + (vector 'ebnf-generate-optional ; 0 generator + 'ebnf-alternative-width ; 1 width fun + 'ebnf-optional-dimension ; 2 dimension fun + 0.0 ; 3 entry + 0.0 ; 4 height + 0.0 ; 5 width + body)) ; 6 optional element (defun ebnf-make-except (factor exception) - (vector 'ebnf-generate-except - 'ignore - 'ebnf-except-dimension - 0.0 - 0.0 - 0.0 - factor - exception)) + (vector 'ebnf-generate-except ; 0 generator + 'ignore ; 1 width fun + 'ebnf-except-dimension ; 2 dimension fun + 0.0 ; 3 entry + 0.0 ; 4 height + 0.0 ; 5 width + factor ; 6 base element + exception)) ; 7 exception element (defun ebnf-make-repeat (times primary &optional upper) - (vector 'ebnf-generate-repeat - 'ignore - 'ebnf-repeat-dimension - 0.0 - 0.0 - 0.0 + (vector 'ebnf-generate-repeat ; 0 generator + 'ignore ; 1 width fun + 'ebnf-repeat-dimension ; 2 dimension fun + 0.0 ; 3 entry + 0.0 ; 4 height + 0.0 ; 5 width + ; 6 times (cond ((and times upper) ; L * U, L * L (if (string= times upper) (if (string= times "") @@ -5712,27 +6184,27 @@ killed after process termination." (concat "* " upper)) (t ; * " * ")) - primary)) + primary)) ; 7 element (defun ebnf-make-sequence (seq) - (vector 'ebnf-generate-sequence - 'ebnf-sequence-width - 'ebnf-sequence-dimension - 0.0 - 0.0 - 0.0 - seq)) + (vector 'ebnf-generate-sequence ; 0 generator + 'ebnf-sequence-width ; 1 width fun + 'ebnf-sequence-dimension ; 2 dimension fun + 0.0 ; 3 entry + 0.0 ; 4 height + 0.0 ; 5 width + seq)) ; 6 sequence (defun ebnf-make-dup-sequence (node seq) - (vector 'ebnf-generate-sequence - 'ebnf-sequence-width - 'ebnf-sequence-dimension - (ebnf-node-entry node) - (ebnf-node-height node) - (ebnf-node-width node) - seq)) + (vector 'ebnf-generate-sequence ; 0 generator + 'ebnf-sequence-width ; 1 width fun + 'ebnf-sequence-dimension ; 2 dimension fun + (ebnf-node-entry node) ; 3 entry + (ebnf-node-height node) ; 4 height + (ebnf-node-width node) ; 5 width + seq)) ; 6 sequence ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -5819,13 +6291,17 @@ killed after process termination." (defun ebnf-token-alternative (body sequence) (if (null body) (if (cdr sequence) + ;; no alternative sequence - (cons (car sequence) + ;; empty element + (cons (car sequence) ; token (ebnf-make-empty))) - (cons (car sequence) + (cons (car sequence) ; token (let ((seq (cdr sequence))) (if (and (= (length body) 1) (null seq)) + ;; alternative with one element (car body) + ;; a real alternative (ebnf-make-alternative (nreverse (if seq (cons seq body) body)))))))) @@ -5860,6 +6336,28 @@ killed after process termination." ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Log message + + +(defun ebnf-log-header (format-str &rest args) + (when ebnf-log + (apply + 'ebnf-log + (concat + "\n\n===============================================================\n\n" + format-str) + args))) + + +(defun ebnf-log (format-str &rest args) + (when ebnf-log + (save-excursion + (set-buffer (get-buffer-create "*Ebnf2ps Log*")) + (goto-char (point-max)) + (insert (apply 'format format-str args) "\n")))) + + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; To make this file smaller, some commands go in a separate file. ;; But autoload them here to make the separation invisible. diff --git a/lisp/progmodes/ebrowse.el b/lisp/progmodes/ebrowse.el index 8099656827e..6bd7e8c780c 100644 --- a/lisp/progmodes/ebrowse.el +++ b/lisp/progmodes/ebrowse.el @@ -896,10 +896,10 @@ this is the first progress message displayed." (let (message-log-max) (when start (setq ebrowse-n-boxes 0)) (setq ebrowse-n-boxes (mod (1+ ebrowse-n-boxes) ebrowse-max-boxes)) - (message (concat title ": " - (propertize (make-string ebrowse-n-boxes - (if (display-color-p) ?\ ?+)) - 'face 'ebrowse-progress))))) + (message "%s: %s" title + (propertize (make-string ebrowse-n-boxes + (if (display-color-p) ?\ ?+)) + 'face 'ebrowse-progress)))) ;;; Reading a tree from disk @@ -1139,6 +1139,7 @@ Tree mode key bindings: (kill-all-local-variables) (use-local-map ebrowse-tree-mode-map) + (buffer-disable-undo) (unless (zerop (buffer-size)) (goto-char (point-min)) @@ -1148,15 +1149,15 @@ Tree mode key bindings: (erase-buffer) (message nil)) - (mapcar 'make-local-variable - '(ebrowse--tags-file-name - ebrowse--indentation - ebrowse--tree - ebrowse--header - ebrowse--show-file-names-flag - ebrowse--frozen-flag - ebrowse--tree-obarray - revert-buffer-function)) + (mapc 'make-local-variable + '(ebrowse--tags-file-name + ebrowse--indentation + ebrowse--tree + ebrowse--header + ebrowse--show-file-names-flag + ebrowse--frozen-flag + ebrowse--tree-obarray + revert-buffer-function)) (setf ebrowse--show-file-names-flag nil ebrowse--tree-obarray (make-vector 127 0) @@ -1638,10 +1639,10 @@ and possibly kill the viewed buffer." (setq original-frame-configuration ebrowse--frame-configuration exit-action ebrowse--view-exit-action)) ;; Delete the frame in which we viewed. - (mapcar 'delete-frame - (loop for frame in (frame-list) - when (not (assq frame original-frame-configuration)) - collect frame)) + (mapc 'delete-frame + (loop for frame in (frame-list) + when (not (assq frame original-frame-configuration)) + collect frame)) (when exit-action (funcall exit-action buffer)))) @@ -2004,7 +2005,7 @@ COLLAPSE non-nil means collapse the branch." (fillarray (car (cdr map)) 'ebrowse-electric-list-undefined) (fillarray (car (cdr submap)) 'ebrowse-electric-list-undefined) (define-key map "\e" submap) - (define-key map "\C-z" 'suspend-emacs) + (define-key map "\C-z" 'suspend-frame) (define-key map "\C-h" 'Helper-help) (define-key map "?" 'Helper-describe-bindings) (define-key map "\C-c" nil) @@ -2256,28 +2257,28 @@ See 'Electric-command-loop' for a description of STATE and CONDITION." (kill-all-local-variables) (use-local-map ebrowse-member-mode-map) (setq major-mode 'ebrowse-member-mode) - (mapcar 'make-local-variable - '(ebrowse--decl-column ;display column - ebrowse--n-columns ;number of short columns - ebrowse--column-width ;width of columns above - ebrowse--show-inherited-flag ;include inherited members? - ebrowse--filters ;public, protected, private - ebrowse--accessor ;vars, functions, friends - ebrowse--displayed-class ;class displayed - ebrowse--long-display-flag ;display with regexps? - ebrowse--source-regexp-flag ;show source regexp? - ebrowse--attributes-flag ;show `virtual' and `inline' - ebrowse--member-list ;list of members displayed - ebrowse--tree ;the class tree - ebrowse--member-mode-strings ;part of mode line - ebrowse--tags-file-name ; - ebrowse--header - ebrowse--tree-obarray - ebrowse--virtual-display-flag - ebrowse--inline-display-flag - ebrowse--const-display-flag - ebrowse--pure-display-flag - ebrowse--frozen-flag)) ;buffer not automagically reused + (mapc 'make-local-variable + '(ebrowse--decl-column ;display column + ebrowse--n-columns ;number of short columns + ebrowse--column-width ;width of columns above + ebrowse--show-inherited-flag ;include inherited members? + ebrowse--filters ;public, protected, private + ebrowse--accessor ;vars, functions, friends + ebrowse--displayed-class ;class displayed + ebrowse--long-display-flag ;display with regexps? + ebrowse--source-regexp-flag ;show source regexp? + ebrowse--attributes-flag ;show `virtual' and `inline' + ebrowse--member-list ;list of members displayed + ebrowse--tree ;the class tree + ebrowse--member-mode-strings ;part of mode line + ebrowse--tags-file-name ; + ebrowse--header + ebrowse--tree-obarray + ebrowse--virtual-display-flag + ebrowse--inline-display-flag + ebrowse--const-display-flag + ebrowse--pure-display-flag + ebrowse--frozen-flag)) ;buffer not automagically reused (setq mode-name "Ebrowse-Members" mode-line-buffer-identification (propertized-buffer-identification "C++ Members") @@ -3964,7 +3965,7 @@ Prefix arg ARG says how much." (fillarray (car (cdr map)) 'ebrowse-electric-position-undefined) (fillarray (car (cdr submap)) 'ebrowse-electric-position-undefined) (define-key map "\e" submap) - (define-key map "\C-z" 'suspend-emacs) + (define-key map "\C-z" 'suspend-frame) (define-key map "\C-h" 'Helper-help) (define-key map "?" 'Helper-describe-bindings) (define-key map "\C-c" nil) @@ -4148,7 +4149,7 @@ Otherwise, FILE-NAME specifies the file to save the tree in." (erase-buffer) (setf (ebrowse-hs-member-table header) nil) (insert (prin1-to-string header) " ") - (mapcar 'ebrowse-save-class tree) + (mapc 'ebrowse-save-class tree) (write-file file-name) (message "Tree written to file `%s'" file-name)) (kill-buffer temp-buffer) @@ -4163,7 +4164,7 @@ Otherwise, FILE-NAME specifies the file to save the tree in." (insert "[ebrowse-ts ") (prin1 (ebrowse-ts-class class)) ;class name (insert "(") ;list of subclasses - (mapcar 'ebrowse-save-class (ebrowse-ts-subclasses class)) + (mapc 'ebrowse-save-class (ebrowse-ts-subclasses class)) (insert ")") (dolist (func ebrowse-member-list-accessors) (prin1 (funcall func class)) diff --git a/lisp/progmodes/etags.el b/lisp/progmodes/etags.el index edff63acb3f..21a5593c659 100644 --- a/lisp/progmodes/etags.el +++ b/lisp/progmodes/etags.el @@ -1131,7 +1131,7 @@ where they were found." (if (memq (car order) '(tag-exact-file-name-match-p tag-file-name-match-p tag-partial-file-name-match-p)) - (save-excursion (next-line 1) + (save-excursion (forward-line 1) (file-of-tag)) (file-of-tag))) tag-info (funcall snarf-tag-function)) @@ -1455,10 +1455,10 @@ where they were found." (tag-info (save-excursion (funcall snarf-tag-function))) (tag (if (eq t (car tag-info)) nil (car tag-info))) (file-path (save-excursion (if tag (file-of-tag) - (save-excursion (next-line 1) + (save-excursion (forward-line 1) (file-of-tag))))) (file-label (if tag (file-of-tag t) - (save-excursion (next-line 1) + (save-excursion (forward-line 1) (file-of-tag t)))) (pt (with-current-buffer standard-output (point)))) (if tag @@ -1885,7 +1885,7 @@ directory specification." (funcall tags-apropos-function regexp)))) (etags-tags-apropos-additional regexp)) (with-current-buffer "*Tags List*" - (require 'apropos) + (eval-and-compile (require 'apropos)) (apropos-mode) ;; apropos-mode is derived from fundamental-mode and it kills ;; all local variables. diff --git a/lisp/progmodes/f90.el b/lisp/progmodes/f90.el index 2f40e00135f..df10b5ecd30 100644 --- a/lisp/progmodes/f90.el +++ b/lisp/progmodes/f90.el @@ -28,6 +28,7 @@ ;; Major mode for editing F90 programs in FREE FORMAT. ;; The minor language revision F95 is also supported (with font-locking). +;; Some/many (?) aspects of F2003 are supported. ;; Knows about continuation lines, named structured statements, and other ;; features in F90 including HPF (High Performance Fortran) structures. @@ -105,7 +106,7 @@ ;; (f90-add-imenu-menu) ; extra menu with functions etc. ;; (if f90-auto-keyword-case ; change case of all keywords on startup ;; (f90-change-keywords f90-auto-keyword-case)) -;; )) +;; )) ;; ;; in your .emacs file. You can also customize the lists ;; f90-font-lock-keywords, etc. @@ -154,8 +155,16 @@ ;;; Code: ;; TODO -;; Support for align. -;; OpenMP, preprocessor highlighting. +;; 1. Any missing F2003 syntax? +;; 2. Have "f90-mode" just recognize F90 syntax, then derived modes +;; "f95-mode", "f2003-mode" for the language revisions. +;; 3. Support for align. +;; Font-locking: +;; 1. OpenMP, OpenMPI?, preprocessor highlighting. +;; 2. interface blah - Highlight "blah" in function-name face? +;; Need to avoid "interface operator (+)" etc. +;; 3. integer_name = 1 +;; 4. Labels for "else" statements (F2003)? (defvar comment-auto-fill-only-comments) (defvar font-lock-keywords) @@ -174,61 +183,68 @@ (defcustom f90-do-indent 3 - "*Extra indentation applied to DO blocks." + "Extra indentation applied to DO blocks." :type 'integer :group 'f90-indent) (put 'f90-do-indent 'safe-local-variable 'integerp) (defcustom f90-if-indent 3 - "*Extra indentation applied to IF, SELECT CASE, WHERE and FORALL blocks." + "Extra indentation applied to IF, SELECT CASE, WHERE and FORALL blocks." :type 'integer :group 'f90-indent) (put 'f90-if-indent 'safe-local-variable 'integerp) (defcustom f90-type-indent 3 - "*Extra indentation applied to TYPE, INTERFACE and BLOCK DATA blocks." + "Extra indentation applied to TYPE, ENUM, INTERFACE and BLOCK DATA blocks." :type 'integer :group 'f90-indent) (put 'f90-type-indent 'safe-local-variable 'integerp) (defcustom f90-program-indent 2 - "*Extra indentation applied to PROGRAM, MODULE, SUBROUTINE, FUNCTION blocks." + "Extra indentation applied to PROGRAM, MODULE, SUBROUTINE, FUNCTION blocks." :type 'integer :group 'f90-indent) (put 'f90-program-indent 'safe-local-variable 'integerp) +(defcustom f90-associate-indent 2 + "Extra indentation applied to ASSOCIATE blocks." + :type 'integer + :group 'f90-indent + :version "23.1") +(put 'f90-associate-indent 'safe-local-variable 'integerp) + (defcustom f90-continuation-indent 5 - "*Extra indentation applied to continuation lines." + "Extra indentation applied to continuation lines." :type 'integer :group 'f90-indent) (put 'f90-continuation-indent 'safe-local-variable 'integerp) (defcustom f90-comment-region "!!$" - "*String inserted by \\[f90-comment-region] at start of each line in region." + "String inserted by \\[f90-comment-region] at start of each line in region." :type 'string :group 'f90-indent) (put 'f90-comment-region 'safe-local-variable 'stringp) (defcustom f90-indented-comment-re "!" - "*Regexp matching comments to indent as code." + "Regexp matching comments to indent as code." :type 'regexp :group 'f90-indent) (put 'f90-indented-comment-re 'safe-local-variable 'stringp) (defcustom f90-directive-comment-re "!hpf\\$" - "*Regexp of comment-like directive like \"!HPF\\\\$\", not to be indented." + "Regexp of comment-like directive like \"!HPF\\\\$\", not to be indented." :type 'regexp :group 'f90-indent) (put 'f90-directive-comment-re 'safe-local-variable 'stringp) (defcustom f90-beginning-ampersand t - "*Non-nil gives automatic insertion of \& at start of continuation line." + "Non-nil gives automatic insertion of \& at start of continuation line." :type 'boolean :group 'f90) (put 'f90-beginning-ampersand 'safe-local-variable 'booleanp) (defcustom f90-smart-end 'blink - "*Qualification of END statements according to the matching block start. + "Qualification of END statements according to the matching block start. For example, the END that closes an IF block is changed to END IF. If the block has a label, this is added as well. Allowed values are 'blink, 'no-blink, and nil. If nil, nothing is done. @@ -240,7 +256,7 @@ additionally blinks the cursor to the start of the block." (lambda (value) (memq value '(blink no-blink nil)))) (defcustom f90-break-delimiters "[-+\\*/><=,% \t]" - "*Regexp matching delimiter characters at which lines may be broken. + "Regexp matching delimiter characters at which lines may be broken. There are certain tokens comprised entirely of characters matching this regexp that should not be split, and these are specified by the constant `f90-no-break-re'." @@ -249,13 +265,13 @@ specified by the constant `f90-no-break-re'." (put 'f90-break-delimiters 'safe-local-variable 'stringp) (defcustom f90-break-before-delimiters t - "*Non-nil causes `f90-do-auto-fill' to break lines before delimiters." + "Non-nil causes `f90-do-auto-fill' to break lines before delimiters." :type 'boolean :group 'f90) (put 'f90-break-before-delimiters 'safe-local-variable 'booleanp) (defcustom f90-auto-keyword-case nil - "*Automatic case conversion of keywords. + "Automatic case conversion of keywords. The options are 'downcase-word, 'upcase-word, 'capitalize-word and nil." :type '(choice (const downcase-word) (const upcase-word) (const capitalize-word) (const nil)) @@ -265,7 +281,7 @@ The options are 'downcase-word, 'upcase-word, 'capitalize-word and nil." capitalize-word upcase-word nil)))) (defcustom f90-leave-line-no nil - "*If non-nil, line numbers are not left justified." + "If non-nil, line numbers are not left justified." :type 'boolean :group 'f90) (put 'f90-leave-line-no 'safe-local-variable 'booleanp) @@ -282,20 +298,26 @@ The options are 'downcase-word, 'upcase-word, 'capitalize-word and nil." (defconst f90-keywords-re (regexp-opt '("allocatable" "allocate" "assign" "assignment" "backspace" - "block" "call" "case" "character" "close" "common" "complex" - "contains" "continue" "cycle" "data" "deallocate" - "dimension" "do" "double" "else" "elseif" "elsewhere" "end" - "enddo" "endfile" "endif" "entry" "equivalence" "exit" - "external" "forall" "format" "function" "goto" "if" - "implicit" "include" "inquire" "integer" "intent" - "interface" "intrinsic" "logical" "module" "namelist" "none" - "nullify" "only" "open" "operator" "optional" "parameter" - "pause" "pointer" "precision" "print" "private" "procedure" - "program" "public" "read" "real" "recursive" "result" "return" - "rewind" "save" "select" "sequence" "stop" "subroutine" - "target" "then" "type" "use" "where" "while" "write" - ;; F95 keywords. - "elemental" "pure") 'words) + "block" "call" "case" "character" "close" "common" "complex" + "contains" "continue" "cycle" "data" "deallocate" + "dimension" "do" "double" "else" "elseif" "elsewhere" "end" + "enddo" "endfile" "endif" "entry" "equivalence" "exit" + "external" "forall" "format" "function" "goto" "if" + "implicit" "include" "inquire" "integer" "intent" + "interface" "intrinsic" "logical" "module" "namelist" "none" + "nullify" "only" "open" "operator" "optional" "parameter" + "pause" "pointer" "precision" "print" "private" "procedure" + "program" "public" "read" "real" "recursive" "result" "return" + "rewind" "save" "select" "sequence" "stop" "subroutine" + "target" "then" "type" "use" "where" "while" "write" + ;; F95 keywords. + "elemental" "pure" + ;; F2003 + "abstract" "associate" "asynchronous" "bind" "class" + "deferred" "enum" "enumerator" "extends" "extends_type_of" + "final" "generic" "import" "non_intrinsic" "non_overridable" + "nopass" "pass" "protected" "same_type_as" "value" "volatile" + ) 'words) "Regexp used by the function `f90-change-keywords'.") (defconst f90-keywords-level-3-re @@ -303,11 +325,16 @@ The options are 'downcase-word, 'upcase-word, 'capitalize-word and nil." '("allocatable" "allocate" "assign" "assignment" "backspace" "close" "deallocate" "dimension" "endfile" "entry" "equivalence" "external" "inquire" "intent" "intrinsic" "nullify" "only" "open" + ;; FIXME operator and assignment should be F2003 procedures? "operator" "optional" "parameter" "pause" "pointer" "print" "private" "public" "read" "recursive" "result" "rewind" "save" "select" "sequence" "target" "write" ;; F95 keywords. - "elemental" "pure") 'words) + "elemental" "pure" + ;; F2003. asynchronous separate. + "abstract" "deferred" "import" "final" "non_intrinsic" "non_overridable" + "nopass" "pass" "protected" "value" "volatile" + ) 'words) "Keyword-regexp for font-lock level >= 3.") (defconst f90-procedures-re @@ -333,7 +360,19 @@ The options are 'downcase-word, 'upcase-word, 'capitalize-word and nil." "sum" "system_clock" "tan" "tanh" "tiny" "transfer" "transpose" "trim" "ubound" "unpack" "verify" ;; F95 intrinsic functions. - "null" "cpu_time") t) + "null" "cpu_time" + ;; F2003. + "move_alloc" "command_argument_count" "get_command" + "get_command_argument" "get_environment_variable" + "selected_char_kind" "wait" "flush" "new_line" + "extends" "extends_type_of" "same_type_as" "bind" + ;; F2003 ieee_arithmetic intrinsic module. + "ieee_support_underflow_control" "ieee_get_underflow_mode" + "ieee_set_underflow_mode" + ;; F2003 iso_c_binding intrinsic module. + "c_loc" "c_funloc" "c_associated" "c_f_pointer" + "c_f_procpointer" + ) t) ;; A left parenthesis to avoid highlighting non-procedures. "[ \t]*(") "Regexp whose first part matches F90 intrinsic procedures.") @@ -368,41 +407,176 @@ The options are 'downcase-word, 'upcase-word, 'capitalize-word and nil." "block" "cyclic" "extrinsic" "new" "onto" "pure" "with") 'words) "Regexp for all HPF keywords, procedures and directives.") -;; Highlighting patterns. +(defconst f90-constants-re + (regexp-opt '( ;; F2003 iso_fortran_env constants. + "iso_fortran_env" + "input_unit" "output_unit" "error_unit" + "iostat_end" "iostat_eor" + "numeric_storage_size" "character_storage_size" + "file_storage_size" + ;; F2003 iso_c_binding constants. + "iso_c_binding" + "c_int" "c_short" "c_long" "c_long_long" "c_signed_char" + "c_size_t" + "c_int8_t" "c_int16_t" "c_int32_t" "c_int64_t" + "c_int_least8_t" "c_int_least16_t" "c_int_least32_t" + "c_int_least64_t" + "c_int_fast8_t" "c_int_fast16_t" "c_int_fast32_t" + "c_int_fast64_t" + "c_intmax_t" "c_intptr_t" + "c_float" "c_double" "c_long_double" + "c_float_complex" "c_double_complex" "c_long_double_complex" + "c_bool" "c_char" + "c_null_char" "c_alert" "c_backspace" "c_form_feed" + "c_new_line" "c_carriage_return" "c_horizontal_tab" + "c_vertical_tab" + "c_ptr" "c_funptr" "c_null_ptr" "c_null_funptr" + "ieee_exceptions" + "ieee_arithmetic" + "ieee_features" + ) 'words) + "Regexp for Fortran intrinsic constants.") + +;; cf f90-looking-at-type-like. +(defun f90-typedef-matcher (limit) + "Search for the start/end of the definition of a derived type, up to LIMIT. +Set the match data so that subexpression 1,2 are the TYPE, and +type-name parts, respectively." + (let (found l) + (while (and (re-search-forward "\\<\\(\\(?:end[ \t]*\\)?type\\)[ \t]*" + limit t) + (not (setq found + (progn + (setq l (match-data)) + (unless (looking-at "\\(is\\>\\|(\\)") + (when (if (looking-at "\\(\\sw+\\)") + (goto-char (match-end 0)) + (re-search-forward + "[ \t]*::[ \t]*\\(\\sw+\\)" + (line-end-position) t)) + ;; 0 is wrong, but we don't use it. + (set-match-data + (append l (list (match-beginning 1) + (match-end 1)))) + t))))))) + found)) (defvar f90-font-lock-keywords-1 (list ;; Special highlighting of "module procedure". - '("\\<\\(module[ \t]*procedure\\)\\>" (1 font-lock-keyword-face)) + '("\\<\\(module[ \t]*procedure\\)\\>\\([^()\n]*::\\)?[ \t]*\\([^&!\n]*\\)" + (1 font-lock-keyword-face) (3 font-lock-function-name-face nil t)) ;; Highlight definition of derived type. - '("\\<\\(\\(?:end[ \t]*\\)?type\\)\\>\\([^()\n]*::\\)?[ \t]*\\(\\sw+\\)" - (1 font-lock-keyword-face) (3 font-lock-function-name-face)) +;;; '("\\<\\(\\(?:end[ \t]*\\)?type\\)\\>\\([^()\n]*::\\)?[ \t]*\\(\\sw+\\)" +;;; (1 font-lock-keyword-face) (3 font-lock-function-name-face)) + '(f90-typedef-matcher + (1 font-lock-keyword-face) (2 font-lock-function-name-face)) ;; Other functions and declarations. - '("\\<\\(\\(?:end[ \t]*\\)?\\(program\\|module\\|function\\|\ + '("\\<\\(\\(?:end[ \t]*\\)?\\(program\\|module\\|function\\|associate\\|\ subroutine\\)\\|use\\|call\\)\\>[ \t]*\\(\\sw+\\)?" (1 font-lock-keyword-face) (3 font-lock-function-name-face nil t)) - "\\<\\(\\(end[ \t]*\\)?\\(interface\\|block[ \t]*data\\)\\|contains\\)\\>") + ;; F2003. + '("\\<\\(use\\)[ \t]*,[ \t]*\\(\\(?:non_\\)?intrinsic\\)[ \t]*::[ \t]*\ +\\(\\sw+\\)" + (1 font-lock-keyword-face) (2 font-lock-keyword-face) + (3 font-lock-function-name-face)) + "\\<\\(\\(end[ \t]*\\)?block[ \t]*data\\|contains\\|\ +end[ \t]*interface\\)\\>" + ;; "abstract interface" is F2003. Must come after previous entry. + '("\\<\\(\\(?:abstract[ \t]*\\)?interface\\)\\>" + ;; [ \t]*\\(\\(\\sw+\\)[ \t]*[^(]\\)?" + ;; (2) messes up "interface operator ()", etc. + (1 font-lock-keyword-face))) ;(2 font-lock-function-name-face nil t))) "This does fairly subdued highlighting of comments and function calls.") +;; NB not explicitly handling this, yet it seems to work. +;; type(...) function foo() +(defun f90-typedec-matcher (limit) + "Search for the declaration of variables of derived type, up to LIMIT. +Set the match data so that subexpression 1,2 are the TYPE(...), +and variable-name parts, respectively." + ;; Matcher functions must return nil only when there are no more + ;; matches within the search range. + (let (found l) + (while (and (re-search-forward "\\<\\(type\\|class\\)[ \t]*(" limit t) + (not + (setq found + (condition-case nil + (progn + ;; Set l after this to just highlight + ;; the "type" part. + (backward-char 1) + ;; Needed for: type( foo(...) ) :: bar + (forward-sexp) + (setq l (list (match-beginning 0) (point))) + (skip-chars-forward " \t") + (when + (re-search-forward + ;; type (foo) bar, qux + (if (looking-at "\\sw+") + "\\([^&!\n]+\\)" + ;; type (foo), stuff :: bar, qux + "::[ \t]*\\([^&!\n]+\\)") + (line-end-position) t) + (set-match-data + (append (list (car l) (match-end 1)) + l (list (match-beginning 1) + (match-end 1)))) + t)) + (error nil)))))) + found)) + (defvar f90-font-lock-keywords-2 (append f90-font-lock-keywords-1 (list ;; Variable declarations (avoid the real function call). - '("^[ \t0-9]*\\(real\\|integer\\|c\\(haracter\\|omplex\\)\\|\ -logical\\|double[ \t]*precision\\|type[ \t]*(\\sw+)\\)\ + ;; NB by accident (?), this correctly fontifies the "integer" in: + ;; integer () function foo () + ;; because "() function foo ()" matches \\3. + ;; The "pure" part does not really belong here, but was added to + ;; exploit that hack. + ;; The "function foo" bit is correctly fontified by keywords-1. + ;; TODO ? actually check for balanced parens in that case. + '("^[ \t0-9]*\\(?:pure\\|elemental\\)?[ \t]*\ +\\(real\\|integer\\|c\\(haracter\\|omplex\\)\\|\ +enumerator\\|generic\\|procedure\\|logical\\|double[ \t]*precision\\)\ \\(.*::\\|[ \t]*(.*)\\)?\\([^&!\n]*\\)" (1 font-lock-type-face t) (4 font-lock-variable-name-face t)) - ;; do, if, select, where, and forall constructs. - '("\\<\\(end[ \t]*\\(do\\|if\\|select\\|forall\\|where\\)\\)\\>\ + ;; Derived type/class variables. + ;; TODO ? If we just highlighted the "type" part, rather than + ;; "type(...)", this could be in the previous expression. And this + ;; would be consistent with integer( kind=8 ), etc. + '(f90-typedec-matcher + (1 font-lock-type-face) (2 font-lock-variable-name-face)) + ;; "real function foo (args)". Must override previous. Note hack + ;; to get "args" unhighlighted again. Might not always be right, + ;; but probably better than leaving them as variables. + ;; NB not explicitly handling this case: + ;; integer( kind=1 ) function foo() + ;; thanks to the happy accident described above. + ;; Not anchored, so don't need to worry about "pure" etc. + '("\\<\\(\\(real\\|integer\\|c\\(haracter\\|omplex\\)\\|\ +logical\\|double[ \t]*precision\\|\ +\\(?:type\\|class\\)[ \t]*([ \t]*\\sw+[ \t]*)\\)[ \t]*\\)\ +\\(function\\)\\>[ \t]*\\(\\sw+\\)[ \t]*\\(([^&!\n]*)\\)" + (1 font-lock-type-face t) (4 font-lock-keyword-face t) + (5 font-lock-function-name-face t) (6 'default t)) + ;; enum (F2003; cf type in -1). + '("\\<\\(enum\\)\\>\\([^()\n]*::\\)?[ \t]*\\(\\sw+\\)" + (1 font-lock-keyword-face) (3 font-lock-function-name-face)) + ;; end do, enum (F2003), if, select, where, and forall constructs. + '("\\<\\(end[ \t]*\\(do\\|if\\|enum\\|select\\|forall\\|where\\)\\)\\>\ \\([ \t]+\\(\\sw+\\)\\)?" (1 font-lock-keyword-face) (3 font-lock-constant-face nil t)) '("^[ \t0-9]*\\(\\(\\sw+\\)[ \t]*:[ \t]*\\)?\\(\\(if\\|\ -do\\([ \t]*while\\)?\\|select[ \t]*case\\|where\\|forall\\)\\)\\>" +do\\([ \t]*while\\)?\\|select[ \t]*\\(?:case\\|type\\)\\|where\\|\ +forall\\)\\)\\>" (2 font-lock-constant-face nil t) (3 font-lock-keyword-face)) ;; Implicit declaration. '("\\<\\(implicit\\)[ \t]*\\(real\\|integer\\|c\\(haracter\\|omplex\\)\ -\\|logical\\|double[ \t]*precision\\|type[ \t]*(\\sw+)\\|none\\)[ \t]*" +\\|enumerator\\|procedure\\|\ +logical\\|double[ \t]*precision\\|type[ \t]*(\\sw+)\\|none\\)[ \t]*" (1 font-lock-keyword-face) (2 font-lock-type-face)) '("\\<\\(namelist\\|common\\)[ \t]*\/\\(\\sw+\\)?\/" (1 font-lock-keyword-face) (2 font-lock-constant-face nil t)) @@ -412,6 +586,10 @@ do\\([ \t]*while\\)?\\|select[ \t]*case\\|where\\|forall\\)\\)\\>" '("\\<\\(exit\\|cycle\\)[ \t]*\\(\\sw+\\)?\\>" (1 font-lock-keyword-face) (2 font-lock-constant-face nil t)) '("\\<\\(case\\)[ \t]*\\(default\\|(\\)" . 1) + ;; F2003 "class default". + '("\\<\\(class\\)[ \t]*default" . 1) + ;; F2003 "type is" in a "select type" block. + '("\\<\\(\\(type\\|class\\)[ \t]*is\\)[ \t]*(" (1 font-lock-keyword-face t)) '("\\<\\(do\\|go[ \t]*to\\)\\>[ \t]*\\([0-9]+\\)" (1 font-lock-keyword-face) (2 font-lock-constant-face)) ;; Line numbers (lines whose first character after number is letter). @@ -424,14 +602,17 @@ do\\([ \t]*while\\)?\\|select[ \t]*case\\|where\\|forall\\)\\)\\>" f90-keywords-level-3-re f90-operators-re (list f90-procedures-re '(1 font-lock-keyword-face keep)) - "\\<real\\>" ; avoid overwriting real defs + "\\<real\\>" ; avoid overwriting real defs + ;; As an attribute, but not as an optional argument. + '("\\<\\(asynchronous\\)[ \t]*[^=]" . 1) )) "Highlights all F90 keywords and intrinsic procedures.") (defvar f90-font-lock-keywords-4 (append f90-font-lock-keywords-3 - (list f90-hpf-keywords-re)) - "Highlights all F90 and HPF keywords.") + (list (cons f90-constants-re 'font-lock-constant-face) + f90-hpf-keywords-re)) + "Highlights all F90 and HPF keywords and constants.") (defvar f90-font-lock-keywords f90-font-lock-keywords-2 @@ -578,7 +759,9 @@ Can be overridden by the value of `font-lock-maximum-decoration'.") (defconst f90-blocks-re (concat "\\(block[ \t]*data\\|" (regexp-opt '("do" "if" "interface" "function" "module" "program" - "select" "subroutine" "type" "where" "forall")) + "select" "subroutine" "type" "where" "forall" + ;; F2003. + "enum" "associate")) "\\)\\>") "Regexp potentially indicating a \"block\" of F90 code.") @@ -586,9 +769,11 @@ Can be overridden by the value of `font-lock-maximum-decoration'.") (regexp-opt '("program" "module" "subroutine" "function") 'paren) "Regexp used to locate the start/end of a \"subprogram\".") +;; "class is" is F2003. (defconst f90-else-like-re - "\\(else\\([ \t]*if\\|where\\)?\\|case[ \t]*\\(default\\|(\\)\\)" - "Regexp matching an ELSE IF, ELSEWHERE, CASE statement.") + "\\(else\\([ \t]*if\\|where\\)?\\|case[ \t]*\\(default\\|(\\)\\|\ +\\(class\\|type\\)[ \t]*is[ \t]*(\\|class[ \t]*default\\)" + "Regexp matching an ELSE IF, ELSEWHERE, CASE, CLASS/TYPE IS statement.") (defconst f90-end-if-re (concat "end[ \t]*" @@ -597,13 +782,27 @@ Can be overridden by the value of `font-lock-maximum-decoration'.") "Regexp matching the end of an IF, SELECT, WHERE, FORALL block.") (defconst f90-end-type-re - "end[ \t]*\\(type\\|interface\\|block[ \t]*data\\)\\>" - "Regexp matching the end of a TYPE, INTERFACE, BLOCK DATA section.") + "end[ \t]*\\(type\\|enum\\|interface\\|block[ \t]*data\\)\\>" + "Regexp matching the end of a TYPE, ENUM, INTERFACE, BLOCK DATA section.") + +(defconst f90-end-associate-re + "end[ \t]*associate\\>" + "Regexp matching the end of an ASSOCIATE block.") +;; This is for a TYPE block, not a variable of derived TYPE. +;; Hence no need to add CLASS for F2003. (defconst f90-type-def-re + ;; type word + ;; type :: word + ;; type, stuff :: word + ;; NOT "type (" "\\<\\(type\\)\\>\\(?:[^()\n]*::\\)?[ \t]*\\(\\sw+\\)" "Regexp matching the definition of a derived type.") +(defconst f90-typeis-re + "\\<\\(class\\|type\\)[ \t]*is[ \t]*(" + "Regexp matching a CLASS/TYPE IS statement.") + (defconst f90-no-break-re (regexp-opt '("**" "//" "=>" ">=" "<=" "==" "/=") 'paren) "Regexp specifying where not to break lines when filling. @@ -622,8 +821,8 @@ characters long.") (concat "^[ \t0-9]*\\<end[ \t]*" (regexp-opt '("do" "if" "forall" "function" "interface" "module" "program" "select" "subroutine" - "type" "where" ) t) - "[ \t]*\\sw*") + "type" "where" "enum" "associate") t) + "\\>") "Regexp matching the end of an F90 \"block\", from the line start. Used in the F90 entry in `hs-special-modes-alist'.") @@ -634,14 +833,24 @@ Used in the F90 entry in `hs-special-modes-alist'.") "^[ \t0-9]*" ; statement number "\\(\\(" "\\(\\sw+[ \t]*:[ \t]*\\)?" ; structure label - "\\(do\\|select[ \t]*case\\|" + "\\(do\\|select[ \t]*\\(case\\|type\\)\\|" ;; See comments in fortran-start-block-re for the problems of IF. "if[ \t]*(\\(.*\\|" ".*\n\\([^if]*\\([^i].\\|.[^f]\\|.\\>\\)\\)\\)\\<then\\|" ;; Distinguish WHERE block from isolated WHERE. "\\(where\\|forall\\)[ \t]*(.*)[ \t]*\\(!\\|$\\)\\)\\)" "\\|" - "program\\|interface\\|module\\|type\\|function\\|subroutine" + ;; Avoid F2003 "type is" in "select type", + ;; and also variables of derived type "type (foo)". + ;; "type, foo" must be a block (?). + "type[ \t,]\\(" + "[^i(!\n\"\& \t]\\|" ; not-i( + "i[^s!\n\"\& \t]\\|" ; i not-s + "is\\sw\\)\\|" + ;; "abstract interface" is F2003. + "program\\|\\(?:abstract[ \t]*\\)?interface\\|module\\|" + ;; "enum", but not "enumerator". + "function\\|subroutine\\|enum[^e]\\|associate" "\\)" "[ \t]*") "Regexp matching the start of an F90 \"block\", from the line start. @@ -656,13 +865,37 @@ Used in the F90 entry in `hs-special-modes-alist'.") ;; Imenu support. +;; FIXME trivial to extend this to enum. Worth it? +(defun f90-imenu-type-matcher () + "Search backward for the start of a derived type. +Set subexpression 1 in the match-data to the name of the type." + (let (found l) + (while (and (re-search-backward "^[ \t0-9]*type[ \t]*" nil t) + (not (setq found + (save-excursion + (goto-char (match-end 0)) + (unless (looking-at "\\(is\\>\\|(\\)") + (or (looking-at "\\(\\sw+\\)") + (re-search-forward + "[ \t]*::[ \t]*\\(\\sw+\\)" + (line-end-position) t)))))))) + found)) + (defvar f90-imenu-generic-expression (let ((good-char "[^!\"\&\n \t]") (not-e "[^e!\n\"\& \t]") - (not-n "[^n!\n\"\& \t]") (not-d "[^d!\n\"\& \t]")) + (not-n "[^n!\n\"\& \t]") (not-d "[^d!\n\"\& \t]") + (not-ib "[^i(!\n\"\& \t]") (not-s "[^s!\n\"\& \t]")) (list '(nil "^[ \t0-9]*program[ \t]+\\(\\sw+\\)" 1) '("Modules" "^[ \t0-9]*module[ \t]+\\(\\sw+\\)[ \t]*\\(!\\|$\\)" 1) - '("Types" "^[ \t0-9]*type[ \t]+\\(\\sw+\\)" 1) + (list "Types" 'f90-imenu-type-matcher 1) + ;; Does not handle: "type[, stuff] :: foo". +;;; (format "^[ \t0-9]*type[ \t]+\\(\\(%s\\|i%s\\|is\\sw\\)\\sw*\\)" +;;; not-ib not-s) +;;; 1) + ;; Can't get the subexpression numbers to match in the two branches. +;;; (format "^[ \t0-9]*type\\([ \t]*,.*\\(::\\)[ \t]*\\(\\sw+\\)\\|[ \t]+\\(\\(%s\\|i%s\\|is\\sw\\)\\sw*\\)\\)" not-ib not-s) +;;; 3) (list "Procedures" (concat @@ -701,7 +934,7 @@ Used in the F90 entry in `hs-special-modes-alist'.") (let (abbrevs-changed) ;; Use the 6th arg (SYSTEM-FLAG) of define-abbrev if possible. ;; A little baroque to quieten the byte-compiler. - (mapcar + (mapc (function (lambda (element) (condition-case nil (apply 'define-abbrev f90-mode-abbrev-table @@ -711,7 +944,9 @@ Used in the F90 entry in `hs-special-modes-alist'.") (append element '(nil 0))))))) '(("`al" "allocate" ) ("`ab" "allocatable" ) + ("`ai" "abstract interface") ("`as" "assignment" ) + ("`asy" "asynchronous" ) ("`ba" "backspace" ) ("`bd" "block data" ) ("`c" "character" ) @@ -728,6 +963,8 @@ Used in the F90 entry in `hs-special-modes-alist'.") ("`el" "else" ) ("`eli" "else if" ) ("`elw" "elsewhere" ) + ("`em" "elemental" ) + ("`e" "enumerator" ) ("`eq" "equivalence" ) ("`ex" "external" ) ("`ey" "entry" ) @@ -750,6 +987,7 @@ Used in the F90 entry in `hs-special-modes-alist'.") ("`pr" "print" ) ("`pi" "private" ) ("`pm" "program" ) + ("`pr" "protected" ) ("`pu" "public" ) ("`r" "real" ) ("`rc" "recursive" ) @@ -761,6 +999,7 @@ Used in the F90 entry in `hs-special-modes-alist'.") ("`ta" "target" ) ("`tr" ".true." ) ("`t" "type" ) + ("`vo" "volatile" ) ("`wh" "where" ) ("`wr" "write" )))) @@ -786,9 +1025,9 @@ Variables controlling indentation style and extra features: `f90-do-indent' Extra indentation within do blocks (default 3). `f90-if-indent' - Extra indentation within if/select case/where/forall blocks (default 3). + Extra indentation within if/select/where/forall blocks (default 3). `f90-type-indent' - Extra indentation within type/interface/block-data blocks (default 3). + Extra indentation within type/enum/interface/block-data blocks (default 3). `f90-program-indent' Extra indentation within program/module/subroutine/function blocks (default 2). @@ -862,9 +1101,9 @@ with no args, if that value is non-nil." Checks from `point-min', or `f90-cache-position', if that is non-nil and lies before point." (let ((beg-pnt - (if (and f90-cache-position (> (point) f90-cache-position)) - f90-cache-position - (point-min)))) + (if (and f90-cache-position (> (point) f90-cache-position)) + f90-cache-position + (point-min)))) (nth 3 (parse-partial-sexp beg-pnt (point))))) (defsubst f90-in-comment () @@ -872,9 +1111,9 @@ and lies before point." Checks from `point-min', or `f90-cache-position', if that is non-nil and lies before point." (let ((beg-pnt - (if (and f90-cache-position (> (point) f90-cache-position)) - f90-cache-position - (point-min)))) + (if (and f90-cache-position (> (point) f90-cache-position)) + f90-cache-position + (point-min)))) (nth 4 (parse-partial-sexp beg-pnt (point))))) (defsubst f90-line-continued () @@ -940,10 +1179,10 @@ NAME is nil if the statement has no label." (list (match-string 3) (match-string 2)))) (defsubst f90-looking-at-select-case () - "Return (\"select\" NAME) if a select-case statement starts after point. + "Return (\"select\" NAME) if a select statement starts after point. NAME is nil if the statement has no label." (if (looking-at "\\(\\(\\sw+\\)[ \t]*:\\)?[ \t]*\ -\\(select\\)[ \t]*case[ \t]*(") +\\(select\\)[ \t]*\\(case\\|type\\)[ \t]*(") (list (match-string 3) (match-string 2)))) (defsubst f90-looking-at-if-then () @@ -963,6 +1202,12 @@ NAME is nil if the statement has no label." (looking-at "then\\>"))) (list struct label)))))) +;; FIXME label? +(defsubst f90-looking-at-associate () + "Return (\"associate\") if an associate block starts after point." + (if (looking-at "\\<\\(associate\\)[ \t]*(") + (list (match-string 1)))) + (defsubst f90-looking-at-where-or-forall () "Return (KIND NAME) if a where or forall block starts after point. NAME is nil if the statement has no label." @@ -977,12 +1222,23 @@ NAME is nil if the statement has no label." (if (looking-at "\\(!\\|$\\)") (list struct label)))))) (defsubst f90-looking-at-type-like () - "Return (KIND NAME) if a type/interface/block-data block starts after point. + "Return (KIND NAME) if a type/enum/interface/block-data starts after point. NAME is non-nil only for type." (cond - ((looking-at f90-type-def-re) - (list (match-string 1) (match-string 2))) - ((looking-at "\\(interface\\|block[ \t]*data\\)\\>") + ((save-excursion + (and (looking-at "\\<type[ \t]*") + (goto-char (match-end 0)) + (not (looking-at "\\(is\\>\\|(\\)")) + (or (looking-at "\\(\\sw+\\)") + (re-search-forward "[ \t]*::[ \t]*\\(\\sw+\\)" + (line-end-position) t)))) + (list "type" (match-string 1))) +;;; ((and (not (looking-at f90-typeis-re)) +;;; (looking-at f90-type-def-re)) +;;; (list (match-string 1) (match-string 2))) + ((looking-at "\\(enum\\|interface\\|block[ \t]*data\\)\\>") + (list (match-string 1) nil)) + ((looking-at "abstract[ \t]*\\(interface\\)\\>") (list (match-string 1) nil)))) (defsubst f90-looking-at-program-block-start () @@ -992,10 +1248,10 @@ NAME is non-nil only for type." ((looking-at "\\(program\\)[ \t]+\\(\\sw+\\)\\>") (list (match-string 1) (match-string 2))) ((and (not (looking-at "module[ \t]*procedure\\>")) - (looking-at "\\(module\\)[ \t]+\\(\\sw+\\)\\>")) + (looking-at "\\(module\\)[ \t]+\\(\\sw+\\)\\>")) (list (match-string 1) (match-string 2))) ((and (not (looking-at "end[ \t]*\\(function\\|subroutine\\)")) - (looking-at "[^!'\"\&\n]*\\(function\\|subroutine\\)[ \t]+\ + (looking-at "[^!'\"\&\n]*\\(function\\|subroutine\\)[ \t]+\ \\(\\sw+\\)")) (list (match-string 1) (match-string 2))))) ;; Following will match an un-named main program block; however @@ -1009,7 +1265,7 @@ NAME is non-nil only for type." (defsubst f90-looking-at-program-block-end () "Return (KIND NAME) if a block with name NAME ends after point." (if (looking-at (concat "end[ \t]*" f90-blocks-re - "?\\([ \t]+\\(\\sw+\\)\\)?\\>")) + "?\\([ \t]+\\(\\sw+\\)\\)?\\>")) (list (match-string 1) (match-string 3)))) (defsubst f90-comment-indent () @@ -1019,16 +1275,16 @@ Used for `comment-indent-function' by F90 mode. `f90-indented-comment-re' (if not trailing code) calls `f90-calculate-indent'. All others return `comment-column', leaving at least one space after code." (cond ((looking-at "!!!") 0) - ((and f90-directive-comment-re - (looking-at f90-directive-comment-re)) 0) - ((looking-at (regexp-quote f90-comment-region)) 0) - ((and (looking-at f90-indented-comment-re) - ;; Don't attempt to indent trailing comment as code. - (save-excursion - (skip-chars-backward " \t") - (bolp))) - (f90-calculate-indent)) - (t (save-excursion + ((and f90-directive-comment-re + (looking-at f90-directive-comment-re)) 0) + ((looking-at (regexp-quote f90-comment-region)) 0) + ((and (looking-at f90-indented-comment-re) + ;; Don't attempt to indent trailing comment as code. + (save-excursion + (skip-chars-backward " \t") + (bolp))) + (f90-calculate-indent)) + (t (save-excursion (skip-chars-backward " \t") (max (if (bolp) 0 (1+ (current-column))) comment-column))))) @@ -1045,10 +1301,10 @@ Comment lines embedded amongst continued lines return 'middle." (setq pcont (if (f90-previous-statement) (f90-line-continued)))) (setq cont (f90-line-continued)) (cond ((and (not pcont) (not cont)) 'single) - ((and (not pcont) cont) 'begin) - ((and pcont (not cont)) 'end) - ((and pcont cont) 'middle) - (t (error "The impossible occurred"))))) + ((and (not pcont) cont) 'begin) + ((and pcont (not cont)) 'end) + ((and pcont cont) 'middle) + (t (error "The impossible occurred"))))) (defsubst f90-indent-line-no () "If `f90-leave-line-no' is nil, left-justify a line number. @@ -1065,9 +1321,9 @@ if all else fails." (save-excursion (not (or (looking-at "end") (looking-at "\\(do\\|if\\|else\\(if\\|where\\)?\ -\\|select[ \t]*case\\|case\\|where\\|forall\\)\\>") - (looking-at "\\(program\\|module\\|interface\\|\ -block[ \t]*data\\)\\>") +\\|select[ \t]*\\(case\\|type\\)\\|case\\|where\\|forall\\)\\>") + (looking-at "\\(program\\|module\\|\ +\\(?:abstract[ \t]*\\)?interface\\|block[ \t]*data\\)\\>") (looking-at "\\(contains\\|\\sw+[ \t]*:\\)") (looking-at f90-type-def-re) (re-search-forward "\\(function\\|subroutine\\)" @@ -1093,10 +1349,10 @@ Does not check type and subprogram indentation." (let ((epnt (line-end-position)) icol cont) (save-excursion (while (and (f90-previous-statement) - (or (progn - (setq cont (f90-present-statement-cont)) - (or (eq cont 'end) (eq cont 'middle))) - (looking-at "[ \t]*[0-9]")))) + (or (progn + (setq cont (f90-present-statement-cont)) + (or (eq cont 'end) (eq cont 'middle))) + (looking-at "[ \t]*[0-9]")))) (setq icol (current-indentation)) (beginning-of-line) (when (re-search-forward "\\(if\\|do\\|select\\|where\\|forall\\)" @@ -1108,23 +1364,29 @@ Does not check type and subprogram indentation." ((or (f90-looking-at-if-then) (f90-looking-at-where-or-forall) (f90-looking-at-select-case)) - (setq icol (+ icol f90-if-indent)))) + (setq icol (+ icol f90-if-indent))) + ((f90-looking-at-associate) + (setq icol (+ icol f90-associate-indent)))) (end-of-line)) (while (re-search-forward - "\\(if\\|do\\|select\\|where\\|forall\\)" epnt t) - (beginning-of-line) + "\\(if\\|do\\|select\\|where\\|forall\\)" epnt t) + (beginning-of-line) (skip-chars-forward " \t0-9") - (cond ((f90-looking-at-do) + (cond ((f90-looking-at-do) (setq icol (+ icol f90-do-indent))) ((or (f90-looking-at-if-then) (f90-looking-at-where-or-forall) (f90-looking-at-select-case)) (setq icol (+ icol f90-if-indent))) + ((f90-looking-at-associate) + (setq icol (+ icol f90-associate-indent))) ((looking-at f90-end-if-re) (setq icol (- icol f90-if-indent))) + ((looking-at f90-end-associate-re) + (setq icol (- icol f90-associate-indent))) ((looking-at "end[ \t]*do\\>") (setq icol (- icol f90-do-indent)))) - (end-of-line)) + (end-of-line)) icol))) (defun f90-calculate-indent () @@ -1135,7 +1397,7 @@ Does not check type and subprogram indentation." (if (not (f90-previous-statement)) ;; If f90-previous-statement returns nil, we must have been ;; called from on or before the first line of the first statement. - (setq icol (if (save-excursion + (setq icol (if (save-excursion ;; f90-previous-statement has moved us over ;; comment/blank lines, so we need to get ;; back to the first code statement. @@ -1146,48 +1408,52 @@ Does not check type and subprogram indentation." 0 ;; No explicit PROGRAM start statement. f90-program-indent)) - (setq cont (f90-present-statement-cont)) - (if (eq cont 'end) - (while (not (eq 'begin (f90-present-statement-cont))) - (f90-previous-statement))) - (cond ((eq cont 'begin) - (setq icol (+ (f90-current-indentation) - f90-continuation-indent))) - ((eq cont 'middle) (setq icol (current-indentation))) - (t (setq icol (f90-current-indentation)) - (skip-chars-forward " \t") - (if (looking-at "[0-9]") - (setq icol (f90-get-correct-indent)) - (cond ((or (f90-looking-at-if-then) - (f90-looking-at-where-or-forall) - (f90-looking-at-select-case) - (looking-at f90-else-like-re)) - (setq icol (+ icol f90-if-indent))) - ((f90-looking-at-do) - (setq icol (+ icol f90-do-indent))) - ((f90-looking-at-type-like) - (setq icol (+ icol f90-type-indent))) - ((or (f90-looking-at-program-block-start) - (looking-at "contains[ \t]*\\($\\|!\\)")) - (setq icol (+ icol f90-program-indent))))) - (goto-char pnt) - (beginning-of-line) - (cond ((looking-at "[ \t]*$")) - ((looking-at "[ \t]*#") ; check for cpp directive - (setq icol 0)) - (t - (skip-chars-forward " \t0-9") - (cond ((or (looking-at f90-else-like-re) - (looking-at f90-end-if-re)) - (setq icol (- icol f90-if-indent))) - ((looking-at "end[ \t]*do\\>") - (setq icol (- icol f90-do-indent))) - ((looking-at f90-end-type-re) - (setq icol (- icol f90-type-indent))) - ((or (looking-at "contains[ \t]*\\(!\\|$\\)") - (f90-looking-at-program-block-end)) - (setq icol (- icol f90-program-indent)))))) - )))) + (setq cont (f90-present-statement-cont)) + (if (eq cont 'end) + (while (not (eq 'begin (f90-present-statement-cont))) + (f90-previous-statement))) + (cond ((eq cont 'begin) + (setq icol (+ (f90-current-indentation) + f90-continuation-indent))) + ((eq cont 'middle) (setq icol (current-indentation))) + (t (setq icol (f90-current-indentation)) + (skip-chars-forward " \t") + (if (looking-at "[0-9]") + (setq icol (f90-get-correct-indent)) + (cond ((or (f90-looking-at-if-then) + (f90-looking-at-where-or-forall) + (f90-looking-at-select-case) + (looking-at f90-else-like-re)) + (setq icol (+ icol f90-if-indent))) + ((f90-looking-at-do) + (setq icol (+ icol f90-do-indent))) + ((f90-looking-at-type-like) + (setq icol (+ icol f90-type-indent))) + ((f90-looking-at-associate) + (setq icol (+ icol f90-associate-indent))) + ((or (f90-looking-at-program-block-start) + (looking-at "contains[ \t]*\\($\\|!\\)")) + (setq icol (+ icol f90-program-indent))))) + (goto-char pnt) + (beginning-of-line) + (cond ((looking-at "[ \t]*$")) + ((looking-at "[ \t]*#") ; check for cpp directive + (setq icol 0)) + (t + (skip-chars-forward " \t0-9") + (cond ((or (looking-at f90-else-like-re) + (looking-at f90-end-if-re)) + (setq icol (- icol f90-if-indent))) + ((looking-at "end[ \t]*do\\>") + (setq icol (- icol f90-do-indent))) + ((looking-at f90-end-type-re) + (setq icol (- icol f90-type-indent))) + ((looking-at f90-end-associate-re) + (setq icol (- icol f90-associate-indent))) + ((or (looking-at "contains[ \t]*\\(!\\|$\\)") + (f90-looking-at-program-block-end)) + (setq icol (- icol f90-program-indent)))))) + )))) icol)) (defun f90-previous-statement () @@ -1200,7 +1466,7 @@ comment." (let (not-first-statement) (beginning-of-line) (while (and (setq not-first-statement (zerop (forward-line -1))) - (looking-at "[ \t0-9]*\\(!\\|$\\|#\\)"))) + (looking-at "[ \t0-9]*\\(!\\|$\\|#\\)"))) not-first-statement)) (defun f90-next-statement () @@ -1210,9 +1476,9 @@ Return nil if no later statement is found." (let (not-last-statement) (beginning-of-line) (while (and (setq not-last-statement - (and (zerop (forward-line 1)) - (not (eobp)))) - (looking-at "[ \t0-9]*\\(!\\|$\\)"))) + (and (zerop (forward-line 1)) + (not (eobp)))) + (looking-at "[ \t0-9]*\\(!\\|$\\)"))) not-last-statement)) (defun f90-beginning-of-subprogram () @@ -1222,7 +1488,7 @@ Return (TYPE NAME), or nil if not found." (let ((count 1) (case-fold-search t) matching-beg) (beginning-of-line) (while (and (> count 0) - (re-search-backward f90-program-block-re nil 'move)) + (re-search-backward f90-program-block-re nil 'move)) (beginning-of-line) (skip-chars-forward " \t0-9") (cond ((setq matching-beg (f90-looking-at-program-block-start)) @@ -1231,7 +1497,7 @@ Return (TYPE NAME), or nil if not found." (setq count (1+ count))))) (beginning-of-line) (if (zerop count) - matching-beg + matching-beg ;; Note this includes the case of an un-named main program, ;; in which case we go to (point-min). (message "No beginning found.") @@ -1242,23 +1508,23 @@ Return (TYPE NAME), or nil if not found." Return (TYPE NAME), or nil if not found." (interactive) (let ((case-fold-search t) - (count 1) + (count 1) matching-end) (end-of-line) (while (and (> count 0) - (re-search-forward f90-program-block-re nil 'move)) + (re-search-forward f90-program-block-re nil 'move)) (beginning-of-line) (skip-chars-forward " \t0-9") (cond ((f90-looking-at-program-block-start) - (setq count (1+ count))) - ((setq matching-end (f90-looking-at-program-block-end)) - (setq count (1- count)))) + (setq count (1+ count))) + ((setq matching-end (f90-looking-at-program-block-end)) + (setq count (1- count)))) (end-of-line)) ;; This means f90-end-of-subprogram followed by f90-start-of-subprogram ;; has a net non-zero effect, which seems odd. ;;; (forward-line 1) (if (zerop count) - matching-end + matching-end (message "No end found.") nil))) @@ -1287,6 +1553,7 @@ Interactively, pushes mark before moving point." (f90-looking-at-do) (f90-looking-at-select-case) (f90-looking-at-type-like) + (f90-looking-at-associate) (f90-looking-at-program-block-start) (f90-looking-at-if-then) (f90-looking-at-where-or-forall))) @@ -1347,6 +1614,7 @@ Interactively, pushes mark before moving point." (f90-looking-at-do) (f90-looking-at-select-case) (f90-looking-at-type-like) + (f90-looking-at-associate) (f90-looking-at-program-block-start) (f90-looking-at-if-then) (f90-looking-at-where-or-forall))) @@ -1387,6 +1655,7 @@ A block is a subroutine, if-endif, etc." (f90-looking-at-do) (f90-looking-at-select-case) (f90-looking-at-type-like) + (f90-looking-at-associate) (f90-looking-at-program-block-start) (f90-looking-at-if-then) (f90-looking-at-where-or-forall)) @@ -1427,13 +1696,13 @@ in the region, or, if already present, remove it." (goto-char beg-region) (beginning-of-line) (if (looking-at (regexp-quote f90-comment-region)) - (delete-region (point) (match-end 0)) + (delete-region (point) (match-end 0)) (insert f90-comment-region)) (while (and (zerop (forward-line 1)) - (< (point) end)) + (< (point) end)) (if (looking-at (regexp-quote f90-comment-region)) - (delete-region (point) (match-end 0)) - (insert f90-comment-region))) + (delete-region (point) (match-end 0)) + (insert f90-comment-region))) (set-marker end nil))) (defun f90-indent-line (&optional no-update) @@ -1451,7 +1720,7 @@ after indenting." (setq no-line-number t) (skip-chars-forward " \t")) (if (looking-at "!") - (setq indent (f90-comment-indent)) + (setq indent (f90-comment-indent)) (and f90-smart-end (looking-at "end") (f90-match-end)) (setq indent (f90-calculate-indent))) @@ -1476,7 +1745,7 @@ If run in the middle of a line, the line is not broken." (beginning-of-line) ; reindent where likely to be needed (f90-indent-line) ; calls indent-line-no, update-line (end-of-line) - (delete-horizontal-space) ; destroy trailing whitespace + (delete-horizontal-space) ; destroy trailing whitespace (let ((string (f90-in-string)) (cont (f90-line-continued))) (and string (not cont) (insert "&")) @@ -1493,17 +1762,17 @@ If run in the middle of a line, the line is not broken." (let ((end-region-mark (copy-marker end-region)) (save-point (point-marker)) (case-fold-search t) - block-list ind-lev ind-curr ind-b cont struct beg-struct end-struct) + block-list ind-lev ind-curr ind-b cont struct beg-struct end-struct) (goto-char beg-region) ;; First find a line which is not a continuation line or comment. (beginning-of-line) (while (and (looking-at "[ \t]*[0-9]*\\(!\\|#\\|[ \t]*$\\)") - (progn (f90-indent-line 'no-update) - (zerop (forward-line 1))) - (< (point) end-region-mark))) + (progn (f90-indent-line 'no-update) + (zerop (forward-line 1))) + (< (point) end-region-mark))) (setq cont (f90-present-statement-cont)) (while (and (or (eq cont 'middle) (eq cont 'end)) - (f90-previous-statement)) + (f90-previous-statement)) (setq cont (f90-present-statement-cont))) ;; Process present line for beginning of block. (setq f90-cache-position (point)) @@ -1514,20 +1783,22 @@ If run in the middle of a line, the line is not broken." (skip-chars-forward " \t0-9") (setq struct nil ind-b (cond ((setq struct (f90-looking-at-do)) f90-do-indent) - ((or (setq struct (f90-looking-at-if-then)) - (setq struct (f90-looking-at-select-case)) - (setq struct (f90-looking-at-where-or-forall)) - (looking-at f90-else-like-re)) - f90-if-indent) - ((setq struct (f90-looking-at-type-like)) - f90-type-indent) - ((or (setq struct (f90-looking-at-program-block-start)) + ((or (setq struct (f90-looking-at-if-then)) + (setq struct (f90-looking-at-select-case)) + (setq struct (f90-looking-at-where-or-forall)) + (looking-at f90-else-like-re)) + f90-if-indent) + ((setq struct (f90-looking-at-type-like)) + f90-type-indent) + ((setq struct (f90-looking-at-associate)) + f90-associate-indent) + ((or (setq struct (f90-looking-at-program-block-start)) (looking-at "contains[ \t]*\\($\\|!\\)")) - f90-program-indent))) + f90-program-indent))) (if ind-b (setq ind-lev (+ ind-lev ind-b))) (if struct (setq block-list (cons struct block-list))) (while (and (f90-line-continued) (zerop (forward-line 1)) - (< (point) end-region-mark)) + (< (point) end-region-mark)) (if (looking-at "[ \t]*!") (f90-indent-to (f90-comment-indent)) (or (= (current-indentation) @@ -1539,47 +1810,51 @@ If run in the middle of a line, the line is not broken." (f90-indent-line-no) (setq f90-cache-position (point)) (cond ((looking-at "[ \t]*$") (setq ind-curr 0)) - ((looking-at "[ \t]*#") (setq ind-curr 0)) - ((looking-at "!") (setq ind-curr (f90-comment-indent))) - ((f90-no-block-limit) (setq ind-curr ind-lev)) - ((looking-at f90-else-like-re) (setq ind-curr - (- ind-lev f90-if-indent))) - ((looking-at "contains[ \t]*\\($\\|!\\)") - (setq ind-curr (- ind-lev f90-program-indent))) - ((setq ind-b - (cond ((setq struct (f90-looking-at-do)) f90-do-indent) - ((or (setq struct (f90-looking-at-if-then)) - (setq struct (f90-looking-at-select-case)) - (setq struct (f90-looking-at-where-or-forall))) - f90-if-indent) - ((setq struct (f90-looking-at-type-like)) - f90-type-indent) - ((setq struct (f90-looking-at-program-block-start)) - f90-program-indent))) - (setq ind-curr ind-lev) - (if ind-b (setq ind-lev (+ ind-lev ind-b))) - (setq block-list (cons struct block-list))) - ((setq end-struct (f90-looking-at-program-block-end)) - (setq beg-struct (car block-list) - block-list (cdr block-list)) - (if f90-smart-end - (save-excursion - (f90-block-match (car beg-struct) (car (cdr beg-struct)) - (car end-struct) (car (cdr end-struct))))) - (setq ind-b - (cond ((looking-at f90-end-if-re) f90-if-indent) - ((looking-at "end[ \t]*do\\>") f90-do-indent) - ((looking-at f90-end-type-re) f90-type-indent) - ((f90-looking-at-program-block-end) - f90-program-indent))) - (if ind-b (setq ind-lev (- ind-lev ind-b))) - (setq ind-curr ind-lev)) - (t (setq ind-curr ind-lev))) + ((looking-at "[ \t]*#") (setq ind-curr 0)) + ((looking-at "!") (setq ind-curr (f90-comment-indent))) + ((f90-no-block-limit) (setq ind-curr ind-lev)) + ((looking-at f90-else-like-re) (setq ind-curr + (- ind-lev f90-if-indent))) + ((looking-at "contains[ \t]*\\($\\|!\\)") + (setq ind-curr (- ind-lev f90-program-indent))) + ((setq ind-b + (cond ((setq struct (f90-looking-at-do)) f90-do-indent) + ((or (setq struct (f90-looking-at-if-then)) + (setq struct (f90-looking-at-select-case)) + (setq struct (f90-looking-at-where-or-forall))) + f90-if-indent) + ((setq struct (f90-looking-at-type-like)) + f90-type-indent) + ((setq struct (f90-looking-at-associate)) + f90-associate-indent) + ((setq struct (f90-looking-at-program-block-start)) + f90-program-indent))) + (setq ind-curr ind-lev) + (if ind-b (setq ind-lev (+ ind-lev ind-b))) + (setq block-list (cons struct block-list))) + ((setq end-struct (f90-looking-at-program-block-end)) + (setq beg-struct (car block-list) + block-list (cdr block-list)) + (if f90-smart-end + (save-excursion + (f90-block-match (car beg-struct) (car (cdr beg-struct)) + (car end-struct) (car (cdr end-struct))))) + (setq ind-b + (cond ((looking-at f90-end-if-re) f90-if-indent) + ((looking-at "end[ \t]*do\\>") f90-do-indent) + ((looking-at f90-end-type-re) f90-type-indent) + ((looking-at f90-end-associate-re) + f90-associate-indent) + ((f90-looking-at-program-block-end) + f90-program-indent))) + (if ind-b (setq ind-lev (- ind-lev ind-b))) + (setq ind-curr ind-lev)) + (t (setq ind-curr ind-lev))) ;; Do the indentation if necessary. (or (= ind-curr (current-column)) - (f90-indent-to ind-curr)) + (f90-indent-to ind-curr)) (while (and (f90-line-continued) (zerop (forward-line 1)) - (< (point) end-region-mark)) + (< (point) end-region-mark)) (if (looking-at "[ \t]*!") (f90-indent-to (f90-comment-indent)) (or (= (current-indentation) @@ -1592,7 +1867,7 @@ If run in the middle of a line, the line is not broken." (set-marker end-region-mark nil) (set-marker save-point nil) (if (fboundp 'zmacs-deactivate-region) - (zmacs-deactivate-region) + (zmacs-deactivate-region) (deactivate-mark)))) (defun f90-indent-subprogram () @@ -1601,15 +1876,15 @@ If run in the middle of a line, the line is not broken." (save-excursion (let ((program (f90-mark-subprogram))) (if program - (progn - (message "Indenting %s %s..." - (car program) (car (cdr program))) - (indent-region (point) (mark) nil) - (message "Indenting %s %s...done" - (car program) (car (cdr program)))) - (message "Indenting the whole file...") - (indent-region (point) (mark) nil) - (message "Indenting the whole file...done"))))) + (progn + (message "Indenting %s %s..." + (car program) (car (cdr program))) + (indent-region (point) (mark) nil) + (message "Indenting %s %s...done" + (car program) (car (cdr program)))) + (message "Indenting the whole file...") + (indent-region (point) (mark) nil) + (message "Indenting the whole file...done"))))) (defun f90-break-line (&optional no-update) "Break line at point, insert continuation marker(s) and indent. @@ -1681,7 +1956,7 @@ Like `join-line', but handles F90 syntax." (interactive "*r") (let ((end-region-mark (copy-marker end-region)) (go-on t) - f90-smart-end f90-auto-keyword-case auto-fill-function) + f90-smart-end f90-auto-keyword-case auto-fill-function) (goto-char beg-region) (while go-on ;; Join as much as possible. @@ -1692,17 +1967,17 @@ Like `join-line', but handles F90 syntax." (f90-join-lines 'forward)) ;; Chop the line if necessary. (while (> (save-excursion (end-of-line) (current-column)) - fill-column) - (move-to-column fill-column) - (f90-find-breakpoint) - (f90-break-line 'no-update)) + fill-column) + (move-to-column fill-column) + (f90-find-breakpoint) + (f90-break-line 'no-update)) (setq go-on (and (< (point) end-region-mark) (zerop (forward-line 1))) f90-cache-position (point))) (setq f90-cache-position nil) (set-marker end-region-mark nil) (if (fboundp 'zmacs-deactivate-region) - (zmacs-deactivate-region) + (zmacs-deactivate-region) (deactivate-mark)))) (defun f90-block-match (beg-block beg-name end-block end-name) @@ -1747,9 +2022,9 @@ Leave point at the end of line." (interactive) (let ((count 1) (top-of-window (window-start)) - (end-point (point)) + (end-point (point)) (case-fold-search t) - matching-beg beg-name end-name beg-block end-block end-struct) + matching-beg beg-name end-name beg-block end-block end-struct) (when (save-excursion (beginning-of-line) (skip-chars-forward " \t0-9") (setq end-struct (f90-looking-at-program-block-end))) (setq end-block (car end-struct) @@ -1772,6 +2047,7 @@ Leave point at the end of line." (f90-looking-at-where-or-forall) (f90-looking-at-select-case) (f90-looking-at-type-like) + (f90-looking-at-associate) (f90-looking-at-program-block-start) ;; Interpret a single END without a block ;; start to be the END of a program block @@ -1816,12 +2092,12 @@ Any other key combination is executed normally." (if (fboundp 'next-command-event) ; XEmacs (setq event (next-command-event) char (and (fboundp 'event-to-character) - (event-to-character event))) + (event-to-character event))) (setq event (read-event) char event)) ;; Insert char if not equal to `?', or if abbrev-mode is off. (if (and abbrev-mode (or (eq char ??) (eq char help-char))) - (f90-abbrev-help) + (f90-abbrev-help) (setq unread-command-events (list event))))) (defun f90-abbrev-help () @@ -1880,16 +2156,16 @@ CHANGE-WORD should be one of 'upcase-word, 'downcase-word, 'capitalize-word." (setq beg (or beg (point-min)) end (or end (point-max))) (let ((keyword-re - (concat "\\(" - f90-keywords-re "\\|" f90-procedures-re "\\|" - f90-hpf-keywords-re "\\|" f90-operators-re "\\)")) - (ref-point (point-min)) - (modified (buffer-modified-p)) + (concat "\\(" + f90-keywords-re "\\|" f90-procedures-re "\\|" + f90-hpf-keywords-re "\\|" f90-operators-re "\\)")) + (ref-point (point-min)) + (modified (buffer-modified-p)) state saveword back-point) (goto-char beg) (unwind-protect - (while (re-search-forward keyword-re end t) - (unless (progn + (while (re-search-forward keyword-re end t) + (unless (progn (setq state (parse-partial-sexp ref-point (point))) (or (nth 3 state) (nth 4 state) ;; GM f90-directive-comment-re? @@ -1897,13 +2173,13 @@ CHANGE-WORD should be one of 'upcase-word, 'downcase-word, 'capitalize-word." (beginning-of-line) (skip-chars-forward " \t0-9") (looking-at "#")))) - (setq ref-point (point) - back-point (save-excursion (backward-word 1) (point)) + (setq ref-point (point) + back-point (save-excursion (backward-word 1) (point)) saveword (buffer-substring back-point ref-point)) - (funcall change-word -1) - (or (string= saveword (buffer-substring back-point ref-point)) - (setq modified t)))) - (or modified (set-buffer-modified-p nil)))))) + (funcall change-word -1) + (or (string= saveword (buffer-substring back-point ref-point)) + (setq modified t)))) + (or modified (set-buffer-modified-p nil)))))) (defun f90-current-defun () diff --git a/lisp/progmodes/flymake.el b/lisp/progmodes/flymake.el index f3c5885d031..6de464b3b0d 100644 --- a/lisp/progmodes/flymake.el +++ b/lisp/progmodes/flymake.el @@ -325,11 +325,6 @@ Return nil if we cannot, non-nil if we can." (or (nth 2 (flymake-get-file-name-mode-and-masks file-name)) 'flymake-get-real-file-name)) -(defcustom flymake-buildfile-dirs '("." ".." "../.." "../../.." "../../../.." "../../../../.." "../../../../../.." "../../../../../../.." "../../../../../../../.." "../../../../../../../../.." "../../../../../../../../../.." "../../../../../../../../../../..") - "Dirs to look for buildfile." - :group 'flymake - :type '(repeat (string))) - (defvar flymake-find-buildfile-cache (flymake-makehash 'equal)) (defun flymake-get-buildfile-from-cache (dir-name) @@ -346,19 +341,15 @@ Return nil if we cannot, non-nil if we can." Buildfile includes Makefile, build.xml etc. Return its file name if found, or nil if not found." (or (flymake-get-buildfile-from-cache source-dir-name) - (let* ((dirs flymake-buildfile-dirs) - (buildfile-dir nil) - (found nil)) - (while (and (not found) dirs) - (setq buildfile-dir (concat source-dir-name (car dirs))) - (when (file-exists-p (expand-file-name buildfile-name buildfile-dir)) - (setq found t)) - (setq dirs (cdr dirs))) - (if found + (let* ((file (locate-dominating-file + source-dir-name + (concat "\\`" (regexp-quote buildfile-name) "\\'")))) + (if file (progn - (flymake-log 3 "found buildfile at %s/%s" buildfile-dir buildfile-name) - (flymake-add-buildfile-to-cache source-dir-name buildfile-dir) - buildfile-dir) + (flymake-log 3 "found buildfile at %s" file) + (setq file (file-name-directory file)) + (flymake-add-buildfile-to-cache source-dir-name file) + file) (progn (flymake-log 3 "buildfile for %s not found" source-dir-name) nil))))) @@ -1277,10 +1268,9 @@ For the format of LINE-ERR-INFO, see `flymake-ler-make-ler'." (defun flymake-goto-file-and-line (file line) "Try to get buffer for FILE and goto line LINE in it." (if (not (file-exists-p file)) - (flymake-log 1 "file %s does not exists" file) - (progn - (find-file file) - (goto-line line)))) + (flymake-log 1 "File %s does not exist" file) + (find-file file) + (goto-line line))) ;; flymake minor mode declarations (defvar flymake-mode-line nil) diff --git a/lisp/progmodes/fortran.el b/lisp/progmodes/fortran.el index d326207d73f..21413e5b43a 100644 --- a/lisp/progmodes/fortran.el +++ b/lisp/progmodes/fortran.el @@ -1,7 +1,8 @@ ;;; fortran.el --- Fortran mode for GNU Emacs ;; Copyright (C) 1986, 1993, 1994, 1995, 1997, 1998, 1999, 2000, 2001, -;; 2002, 2003, 2004, 2005, 2006, 2007, 2008 Free Software Foundation, Inc. +;; 2002, 2003, 2004, 2005, 2006, 2007, 2008 +;; Free Software Foundation, Inc. ;; Author: Michael D. Prange <prange@erl.mit.edu> ;; Maintainer: Glenn Morris <rgm@gnu.org> @@ -55,11 +56,11 @@ ;; silence compiler (defvar dabbrev-case-fold-search) -(defvar font-lock-syntactic-keywords) (defvar gud-find-expr-function) (defvar imenu-case-fold-search) (defvar imenu-syntax-alist) - +(defvar comment-region-function) +(defvar uncomment-region-function) (defgroup fortran nil "Major mode for editing fixed format Fortran code." @@ -78,9 +79,8 @@ :group 'fortran) -;;;###autoload (defcustom fortran-tab-mode-default nil - "*Default tabbing/carriage control style for empty files in Fortran mode. + "Default tabbing/carriage control style for empty files in Fortran mode. A non-nil value specifies tab-digit style of continuation control. A value of nil specifies that continuation lines are marked with a character in column 6." @@ -88,38 +88,47 @@ with a character in column 6." :group 'fortran-indent) (put 'fortran-tab-mode-default 'safe-local-variable 'booleanp) -(defcustom fortran-tab-mode-string "/t" - "*String to appear in mode line in TAB format buffers." +;; TODO add more detail of what tab mode is to doc string. +(defcustom fortran-tab-mode-string + (propertize "/t" 'help-echo "This buffer is in Fortran TAB mode" + 'mouse-face 'mode-line-highlight + 'local-map + (make-mode-line-mouse-map 'mouse-1 + (lambda () + (interactive) + (describe-variable + 'fortran-tab-mode-string)))) + "String to appear in mode line in TAB format buffers." :type 'string :group 'fortran-indent) -(put 'fortran-tab-mode-string 'safe-local-variable 'stringp) +(put 'fortran-tab-mode-string 'risky-local-variable t) (defcustom fortran-do-indent 3 - "*Extra indentation applied to DO blocks." + "Extra indentation applied to DO blocks." :type 'integer :group 'fortran-indent) (put 'fortran-do-indent 'safe-local-variable 'integerp) (defcustom fortran-if-indent 3 - "*Extra indentation applied to IF, SELECT CASE and WHERE blocks." + "Extra indentation applied to IF, SELECT CASE and WHERE blocks." :type 'integer :group 'fortran-indent) (put 'fortran-if-indent 'safe-local-variable 'integerp) (defcustom fortran-structure-indent 3 - "*Extra indentation applied to STRUCTURE, UNION, MAP and INTERFACE blocks." + "Extra indentation applied to STRUCTURE, UNION, MAP and INTERFACE blocks." :type 'integer :group 'fortran-indent) (put 'fortran-structure-indent 'safe-local-variable 'integerp) (defcustom fortran-continuation-indent 5 - "*Extra indentation applied to continuation lines." + "Extra indentation applied to continuation lines." :type 'integer :group 'fortran-indent) (put 'fortran-continuation-indent 'safe-local-variable 'integerp) (defcustom fortran-comment-indent-style 'fixed - "*How to indent comments. + "How to indent comments. nil forces comment lines not to be touched; `fixed' indents to `fortran-comment-line-extra-indent' columns beyond `fortran-minimum-statement-indent-fixed' (if `indent-tabs-mode' nil), or @@ -132,14 +141,14 @@ nil forces comment lines not to be touched; (lambda (value) (memq value '(nil fixed relative)))) (defcustom fortran-comment-line-extra-indent 0 - "*Amount of extra indentation for text within full-line comments." + "Amount of extra indentation for text within full-line comments." :type 'integer :group 'fortran-indent :group 'fortran-comment) (put 'fortran-comment-line-extra-indent 'safe-local-variable 'integerp) (defcustom fortran-comment-line-start "C" - "*Delimiter inserted to start new full-line comment. + "Delimiter inserted to start new full-line comment. You might want to change this to \"*\", for instance." :version "21.1" :type 'string @@ -150,7 +159,7 @@ You might want to change this to \"*\", for instance." ;; filling and doesn't seem to be necessary. (defcustom fortran-comment-line-start-skip "^[CcDd*!]\\(\\([^ \t\n]\\)\\2+\\)?[ \t]*" - "*Regexp to match the start of a full-line comment." + "Regexp to match the start of a full-line comment." :version "21.1" :type 'regexp :group 'fortran-comment) @@ -158,7 +167,7 @@ You might want to change this to \"*\", for instance." (defcustom fortran-directive-re "^[ \t]*#.*" - "*Regexp to match a directive line. + "Regexp to match a directive line. The matching text will be fontified with `font-lock-keyword-face'. The matching line will be given zero indentation." :version "22.1" @@ -167,13 +176,13 @@ The matching line will be given zero indentation." (put 'fortran-directive-re 'safe-local-variable 'stringp) (defcustom fortran-minimum-statement-indent-fixed 6 - "*Minimum statement indentation for fixed format continuation style." + "Minimum statement indentation for fixed format continuation style." :type 'integer :group 'fortran-indent) (put 'fortran-minimum-statement-indent-fixed 'safe-local-variable 'integerp) (defcustom fortran-minimum-statement-indent-tab (max tab-width 6) - "*Minimum statement indentation for TAB format continuation style." + "Minimum statement indentation for TAB format continuation style." :type 'integer :group 'fortran-indent) (put 'fortran-minimum-statement-indent-tab 'safe-local-variable 'integerp) @@ -182,7 +191,7 @@ The matching line will be given zero indentation." ;; of length one rather than a single character. ;; The code in this file accepts either format for compatibility. (defcustom fortran-comment-indent-char " " - "*Single-character string inserted for Fortran comment indentation. + "Single-character string inserted for Fortran comment indentation. Normally a space." :type 'string :group 'fortran-comment) @@ -192,27 +201,27 @@ Normally a space." (= (length value) 1))))) (defcustom fortran-line-number-indent 1 - "*Maximum indentation for Fortran line numbers. + "Maximum indentation for Fortran line numbers. 5 means right-justify them within their five-column field." :type 'integer :group 'fortran-indent) (put 'fortran-line-number-indent 'safe-local-variable 'integerp) (defcustom fortran-check-all-num-for-matching-do nil - "*Non-nil causes all numbered lines to be treated as possible DO loop ends." + "Non-nil causes all numbered lines to be treated as possible DO loop ends." :type 'boolean :group 'fortran) (put 'fortran-check-all-num-for-matching-do 'safe-local-variable 'booleanp) (defcustom fortran-blink-matching-if nil - "*Non-nil causes \\[fortran-indent-line] on ENDIF to blink on matching IF. + "Non-nil causes \\[fortran-indent-line] on ENDIF to blink on matching IF. Also, from an ENDDO statement blink on matching DO [WHILE] statement." :type 'boolean :group 'fortran) (put 'fortran-blink-matching-if 'safe-local-variable 'booleanp) (defcustom fortran-continuation-string "$" - "*Single-character string used for Fortran continuation lines. + "Single-character string used for Fortran continuation lines. In fixed format continuation style, this character is inserted in column 6 by \\[fortran-split-line] to begin a continuation line. Also, if \\[fortran-indent-line] finds this at the beginning of a @@ -225,18 +234,19 @@ appropriate style. Normally $." (= (length value) 1)))) (defcustom fortran-comment-region "c$$$" - "*String inserted by \\[fortran-comment-region] at start of each \ + "String inserted by \\[fortran-comment-region] at start of each \ line in region." :type 'string :group 'fortran-comment) (put 'fortran-comment-region 'safe-local-variable 'stringp) (defcustom fortran-electric-line-number t - "*Non-nil causes line numbers to be moved to the correct column as typed." + "Non-nil causes line numbers to be moved to the correct column as typed." :type 'boolean :group 'fortran) (put 'fortran-electric-line-number 'safe-local-variable 'booleanp) +;; TODO use fortran-line-length, somehow. (defcustom fortran-column-ruler-fixed "0 4 6 10 20 30 40 5\ 0 60 70\n\ @@ -249,6 +259,7 @@ See the variable `fortran-column-ruler-tab' for TAB format mode." :group 'fortran) (put 'fortran-column-ruler-fixed 'safe-local-variable 'stringp) +;; TODO use fortran-line-length, somehow. (defcustom fortran-column-ruler-tab "0 810 20 30 40 5\ 0 60 70\n\ @@ -268,12 +279,39 @@ See the variable `fortran-column-ruler-fixed' for fixed format mode." (put 'fortran-analyze-depth 'safe-local-variable 'integerp) (defcustom fortran-break-before-delimiters t - "*Non-nil causes filling to break lines before delimiters. + "Non-nil causes filling to break lines before delimiters. Delimiters are characters matching the regexp `fortran-break-delimiters-re'." :type 'boolean :group 'fortran) (put 'fortran-break-before-delimiters 'safe-local-variable 'booleanp) +;; TODO 0 as no-limit, as per g77. +(defcustom fortran-line-length 72 + "Maximum number of characters in a line of fixed-form Fortran code. +Characters beyond this point are treated as comments. Setting +this variable directly (after fortran mode is loaded) does not +take effect. Use either \\[customize] (which affects all Fortran +buffers and the default) or the function +`fortran-line-length' (which can also operate on just the current +buffer). This corresponds to the g77 compiler option +`-ffixed-line-length-N'." + :type 'integer + :initialize 'custom-initialize-default + :set (lambda (symbol value) + ;; Do all fortran buffers, and the default. + (fortran-line-length value t)) + :version "23.1" + :group 'fortran) + +(put 'fortran-line-length 'safe-local-variable 'integerp) +(make-variable-buffer-local 'fortran-line-length) + +(defcustom fortran-mode-hook nil + "Hook run when entering Fortran mode." + :type 'hook + :group 'fortran) + + (defconst fortran-break-delimiters-re "[-+*/><=, \t]" "Regexp matching delimiter characters at which lines may be broken. There are certain tokens comprised entirely of characters @@ -289,22 +327,16 @@ characters matching the regexp `fortran-break-delimiters-re' that should not be split by filling. Each element is assumed to be two characters long.") -(defcustom fortran-mode-hook nil - "Hook run when entering Fortran mode." - :type 'hook - :group 'fortran) - - -(defvar fortran-if-start-re "\\(\\(\\sw\\|\\s_\\)+:[ \t]*\\)?if[ \t]*(" +(defconst fortran-if-start-re "\\(\\(\\sw\\|\\s_\\)+:[ \t]*\\)?if[ \t]*(" "Regexp matching the start of an IF statement.") -(defvar fortran-end-prog-re1 +(defconst fortran-end-prog-re1 "end\ \\([ \t]*\\(program\\|subroutine\\|function\\|block[ \t]*data\\)\\>\ \\([ \t]*\\(\\sw\\|\\s_\\)+\\)?\\)?" "Regexp possibly matching the end of a subprogram.") -(defvar fortran-end-prog-re +(defconst fortran-end-prog-re (concat "^[ \t0-9]*" fortran-end-prog-re1) "Regexp possibly matching the end of a subprogram, from the line start. See also `fortran-end-prog-re1'.") @@ -432,11 +464,13 @@ Consists of level 3 plus all other intrinsics not already highlighted.") ;; (We can do so for F90-style). Therefore an unmatched quote in a ;; standard comment will throw fontification off on the wrong track. ;; So we do syntactic fontification with regexps. -(defvar fortran-font-lock-syntactic-keywords - '(("^[cd\\*]" 0 (11)) - ("^[^cd\\*\t\n].\\{71\\}\\([^\n]+\\)" 1 (11))) - "`font-lock-syntactic-keywords' for Fortran. -These get fixed-format comments fontified.") +(defun fortran-font-lock-syntactic-keywords () + "Return a value for `font-lock-syntactic-keywords' in Fortran mode. +This varies according to the value of `fortran-line-length'. +This is used to fontify fixed-format Fortran comments." + `(("^[cd\\*]" 0 (11)) + (,(format "^[^cd\\*\t\n].\\{%d\\}\\([^\n]+\\)" (1- fortran-line-length)) + 1 (11)))) (defvar fortran-font-lock-keywords fortran-font-lock-keywords-1 "Default expressions to highlight in Fortran mode.") @@ -520,7 +554,7 @@ tries to strike a compromise between complexity and flexibility. Used in the Fortran entry in `hs-special-modes-alist'.") (add-to-list 'hs-special-modes-alist - `(fortran-mode ,fortran-start-block-re ,fortran-end-block-re + `(fortran-mode ,fortran-start-block-re ,fortran-end-block-re "^[cC*!]" fortran-end-of-block nil)) @@ -560,7 +594,8 @@ Used in the Fortran entry in `hs-special-modes-alist'.") (let ((map (make-sparse-keymap))) (define-key map ";" 'fortran-abbrev-start) (define-key map "\C-c;" 'fortran-comment-region) - (define-key map "\M-;" 'fortran-indent-comment) + ;; The default comment-dwim does at least as much as this. +;;; (define-key map "\M-;" 'fortran-indent-comment) (define-key map "\M-\n" 'fortran-split-line) (define-key map "\M-\C-n" 'fortran-end-of-block) (define-key map "\M-\C-p" 'fortran-beginning-of-block) @@ -612,6 +647,8 @@ Used in the Fortran entry in `hs-special-modes-alist'.") ["Widen" widen t] "--" ["Temporary column ruler" fortran-column-ruler t] + ;; May not be '72', depending on fortran-line-length, but this + ;; seems ok for a menu item. ["72-column window" fortran-window-create t] ["Full Width Window" (enlarge-window-horizontally (- (frame-width) (window-width))) @@ -642,7 +679,7 @@ Used in the Fortran entry in `hs-special-modes-alist'.") (let (abbrevs-changed) ;; Use the 6th arg (SYSTEM-FLAG) of define-abbrev if possible. ;; Only use `apply' to quieten the byte-compiler. - (mapcar + (mapc (function (lambda (element) (condition-case nil (apply 'define-abbrev fortran-mode-abbrev-table @@ -748,7 +785,7 @@ Variables controlling indentation style and extra features: `fortran-minimum-statement-indent-tab' (TAB format), depending on the continuation format in use. relative indent to `fortran-comment-line-extra-indent' beyond the - indentation for a line of code. + indentation for a line of code. (default 'fixed) `fortran-comment-indent-char' Single-character string to be inserted instead of space for @@ -806,11 +843,16 @@ with no args, if that value is non-nil." ;; (concat "\\(\\)\\(![ \t]*\\|" fortran-comment-line-start-skip "\\)") "\\(\\)\\(?:^[CcDd*]\\|!\\)\\(?:\\([^ \t\n]\\)\\2+\\)?[ \t]*") (set (make-local-variable 'comment-indent-function) 'fortran-comment-indent) + (set (make-local-variable 'comment-region-function) 'fortran-comment-region) + (set (make-local-variable 'uncomment-region-function) + 'fortran-uncomment-region) + (set (make-local-variable 'comment-insert-comment-function) + 'fortran-indent-comment) (set (make-local-variable 'abbrev-all-caps) t) (set (make-local-variable 'normal-auto-fill-function) 'fortran-auto-fill) (set (make-local-variable 'indent-tabs-mode) (fortran-analyze-file-format)) (setq mode-line-process '(indent-tabs-mode fortran-tab-mode-string)) - (set (make-local-variable 'fill-column) 72) + (set (make-local-variable 'fill-column) fortran-line-length) (set (make-local-variable 'fill-paragraph-function) 'fortran-fill-paragraph) (set (make-local-variable 'font-lock-defaults) '((fortran-font-lock-keywords @@ -819,9 +861,9 @@ with no args, if that value is non-nil." fortran-font-lock-keywords-3 fortran-font-lock-keywords-4) nil t ((?/ . "$/") ("_$" . "w")) - fortran-beginning-of-subprogram)) - (set (make-local-variable 'font-lock-syntactic-keywords) - fortran-font-lock-syntactic-keywords) + fortran-beginning-of-subprogram + (font-lock-syntactic-keywords + . (fortran-font-lock-syntactic-keywords)))) (set (make-local-variable 'imenu-case-fold-search) t) (set (make-local-variable 'imenu-generic-expression) fortran-imenu-generic-expression) @@ -834,9 +876,40 @@ with no args, if that value is non-nil." #'fortran-current-defun) (set (make-local-variable 'dabbrev-case-fold-search) 'case-fold-search) (set (make-local-variable 'gud-find-expr-function) 'fortran-gud-find-expr) + (add-hook 'hack-local-variables-hook 'fortran-hack-local-variables nil t) (run-mode-hooks 'fortran-mode-hook)) +(defun fortran-line-length (nchars &optional global) + "Set the length of fixed-form Fortran lines to NCHARS. +This normally only affects the current buffer, which must be in +Fortran mode. If the optional argument GLOBAL is non-nil, it +affects all Fortran buffers, and also the default." + (interactive "p") + (let (new) + (mapc (lambda (buff) + (with-current-buffer buff + (when (eq major-mode 'fortran-mode) + (setq fortran-line-length nchars + fill-column fortran-line-length + new (fortran-font-lock-syntactic-keywords)) + ;; Refontify only if necessary. + (unless (equal new font-lock-syntactic-keywords) + (setq font-lock-syntactic-keywords + (fortran-font-lock-syntactic-keywords)) + (if font-lock-mode (font-lock-mode 1)))))) + (if global + (buffer-list) + (list (current-buffer)))) + (if global + (setq-default fortran-line-length nchars)))) + +(defun fortran-hack-local-variables () + "Fortran mode adds this to `hack-local-variables-hook'." + (fortran-line-length fortran-line-length)) + +(declare-function gud-find-c-expr "gud.el" nil) + (defun fortran-gud-find-expr () ;; Consider \n as punctuation (end of expression). (with-syntax-table fortran-gud-syntax-table @@ -862,33 +935,33 @@ or on a new line inserted before this line if this line is not blank." (beginning-of-line) ;; Recognize existing comments of either kind. (cond ((fortran-find-comment-start-skip 'all) - (goto-char (match-beginning 0)) - (if (bolp) - (fortran-indent-line) - (unless (= (current-column) (fortran-comment-indent)) + (goto-char (match-beginning 0)) + (if (bolp) + (fortran-indent-line) + (unless (= (current-column) (fortran-comment-indent)) (delete-horizontal-space) (indent-to (fortran-comment-indent))))) - ;; No existing comment. - ;; If side-by-side comments are defined, insert one, - ;; unless line is now blank. - ((and comment-start (not (looking-at "[ \t]*$")) - (string-match comment-start-skip (concat " " comment-start))) - (end-of-line) - (delete-horizontal-space) - (indent-to (fortran-comment-indent)) - (insert comment-start)) - ;; Else insert separate-line comment, making a new line if nec. - (t - (if (looking-at "^[ \t]*$") - (delete-horizontal-space) - (beginning-of-line) - (insert ?\n) - (forward-char -1)) - (insert fortran-comment-line-start) - (insert-char (if (stringp fortran-comment-indent-char) - (aref fortran-comment-indent-char 0) - fortran-comment-indent-char) - (- (fortran-calculate-indent) (current-column)))))) + ;; No existing comment. + ;; If side-by-side comments are defined, insert one, + ;; unless line is now blank. + ((and comment-start (not (looking-at "[ \t]*$")) + (string-match comment-start-skip (concat " " comment-start))) + (end-of-line) + (delete-horizontal-space) + (indent-to (fortran-comment-indent)) + (insert comment-start)) + ;; Else insert separate-line comment, making a new line if nec. + (t + (if (looking-at "^[ \t]*$") + (delete-horizontal-space) + (beginning-of-line) + (insert ?\n) + (forward-char -1)) + (insert fortran-comment-line-start) + (insert-char (if (stringp fortran-comment-indent-char) + (aref fortran-comment-indent-char 0) + fortran-comment-indent-char) + (- (fortran-calculate-indent) (current-column)))))) (defun fortran-comment-region (beg-region end-region arg) "Comment every line in the region. @@ -898,7 +971,7 @@ BEG-REGION and END-REGION specify the region boundaries. With non-nil ARG, uncomments the region." (interactive "*r\nP") (let ((end-region-mark (copy-marker end-region)) - (save-point (point-marker))) + (save-point (point-marker))) (goto-char beg-region) (beginning-of-line) (if arg @@ -917,6 +990,11 @@ With non-nil ARG, uncomments the region." (set-marker end-region-mark nil) (set-marker save-point nil))) +;; uncomment-region calls this with 3 args. +(defun fortran-uncomment-region (start end &optional ignored) + "Uncomment every line in the region." + (fortran-comment-region start end t)) + (defun fortran-abbrev-start () "Typing ;\\[help-command] or ;? lists all the Fortran abbrevs. @@ -931,7 +1009,7 @@ Any other key combination is executed normally." ;; Insert char if not equal to `?', or if abbrev-mode is off. (if (and abbrev-mode (or (eq char ??) (eq char help-char) (memq event help-event-list))) - (fortran-abbrev-help) + (fortran-abbrev-help) (push event unread-command-events)))) (defun fortran-abbrev-help () @@ -964,44 +1042,44 @@ The next key typed is executed unless it is SPC." (save-excursion (beginning-of-line) (if (eq (window-start (selected-window)) - (window-point (selected-window))) - (line-beginning-position 2) + (window-point (selected-window))) + (line-beginning-position 2) (point))) nil "Type SPC or any command to erase ruler.")) (defun fortran-window-create () - "Make the window 72 columns wide. + "Make the window `fortran-line-length' (default 72) columns wide. See also `fortran-window-create-momentarily'." (interactive) (let ((window-min-width 2)) (unless (window-full-width-p) - (enlarge-window-horizontally (- (frame-width) - (window-width) 1))) + (enlarge-window-horizontally (- (frame-width) + (window-width) 1))) (let* ((window-edges (window-edges)) - (scroll-bar-width (- (nth 2 window-edges) - (car window-edges) - (window-width)))) - (split-window-horizontally (+ 72 scroll-bar-width))) + (scroll-bar-width (- (nth 2 window-edges) + (car window-edges) + (window-width)))) + (split-window-horizontally (+ fortran-line-length scroll-bar-width))) (other-window 1) (switch-to-buffer " fortran-window-extra" t) (select-window (previous-window)))) (defun fortran-window-create-momentarily (&optional arg) - "Momentarily make the window 72 columns wide. + "Momentarily make the window `fortran-line-length' (default 72) columns wide. Optional ARG non-nil and non-unity disables the momentary feature. See also `fortran-window-create'." (interactive "p") (if (or (not arg) - (= arg 1)) + (= arg 1)) (save-window-excursion - (progn - (condition-case nil - (fortran-window-create) - (error (error "No room for Fortran window"))) - (message "Type SPC to continue editing.") - (let ((char (read-event))) - (or (equal char ?\s) - (setq unread-command-events (list char)))))) + (progn + (condition-case nil + (fortran-window-create) + (error (error "No room for Fortran window"))) + (message "Type SPC to continue editing.") + (let ((char (read-event))) + (or (equal char ?\s) + (setq unread-command-events (list char)))))) (fortran-window-create))) (defun fortran-split-line () @@ -1009,13 +1087,13 @@ See also `fortran-window-create'." (interactive "*") (delete-horizontal-space) (if (save-excursion - (let ((pos (point))) - (beginning-of-line) - (and (fortran-find-comment-start-skip 'all) - (< (match-beginning 0) pos)))) + (let ((pos (point))) + (beginning-of-line) + (and (fortran-find-comment-start-skip 'all) + (< (match-beginning 0) pos)))) (insert ?\n (match-string 0)) (if indent-tabs-mode - (insert ?\n ?\t (fortran-numerical-continuation-char)) + (insert ?\n ?\t (fortran-numerical-continuation-char)) (insert "\n " fortran-continuation-string))) ; space after \n important (fortran-indent-line)) ; when cont string is C, c or * @@ -1051,7 +1129,7 @@ plus one, otherwise return 1. Zero not allowed." (save-excursion (forward-line -1) (if (looking-at "\t[1-9]") - (+ ?1 (% (- (char-after (1+ (point))) ?0) 9)) + (+ ?1 (% (- (char-after (1+ (point))) ?0) 9)) ?1))) (put 'fortran-electric-line-number 'delete-selection t) @@ -1061,27 +1139,27 @@ Auto-indent does not happen if a numeric ARG is used." (interactive "*P") (if (or arg (not fortran-electric-line-number)) (if arg - (self-insert-command (prefix-numeric-value arg)) - (self-insert-command 1)) + (self-insert-command (prefix-numeric-value arg)) + (self-insert-command 1)) (if (or (and (= 5 (current-column)) - (save-excursion - (beginning-of-line) + (save-excursion + (beginning-of-line) ;; In col 5 with only spaces to the left. - (looking-at " \\{5\\}"))) - (and (= (if indent-tabs-mode - fortran-minimum-statement-indent-tab - fortran-minimum-statement-indent-fixed) (current-column)) + (looking-at " \\{5\\}"))) + (and (= (if indent-tabs-mode + fortran-minimum-statement-indent-tab + fortran-minimum-statement-indent-fixed) (current-column)) ;; In col 8 with a single tab to the left. - (eq ?\t (char-after (line-beginning-position))) - (not (or (eq last-command 'fortran-indent-line) - (eq last-command - 'fortran-indent-new-line)))) - (save-excursion - (re-search-backward "[^ \t0-9]" - (line-beginning-position) - t)) ; not a line number - (looking-at "[0-9]")) ; within a line number - (self-insert-command (prefix-numeric-value arg)) + (eq ?\t (char-after (line-beginning-position))) + (not (or (eq last-command 'fortran-indent-line) + (eq last-command + 'fortran-indent-new-line)))) + (save-excursion + (re-search-backward "[^ \t0-9]" + (line-beginning-position) + t)) ; not a line number + (looking-at "[0-9]")) ; within a line number + (self-insert-command (prefix-numeric-value arg)) (skip-chars-backward " \t") (insert last-command-char) (fortran-indent-line)))) @@ -1093,9 +1171,10 @@ Auto-indent does not happen if a numeric ARG is used." ;; match of whitespace, avoiding possible column 73+ stuff. (save-match-data (string-match "^\\s-*\\(\\'\\|\\s<\\)" - (buffer-substring (match-end 0) - (min (line-end-position) - (+ 72 (line-beginning-position))))))) + (buffer-substring (match-end 0) + (min (line-end-position) + (+ fortran-line-length + (line-beginning-position))))))) ;; Note that you can't just check backwards for `subroutine' &c in ;; case of un-marked main programs not at the start of the file. @@ -1106,28 +1185,28 @@ Auto-indent does not happen if a numeric ARG is used." (let ((case-fold-search t)) (beginning-of-line -1) (if (catch 'ok - (while (re-search-backward fortran-end-prog-re nil 'move) - (if (fortran-check-end-prog-re) - (throw 'ok t)))) - (forward-line))))) + (while (re-search-backward fortran-end-prog-re nil 'move) + (if (fortran-check-end-prog-re) + (throw 'ok t)))) + (forward-line))))) (defun fortran-end-of-subprogram () "Move point to the end of the current Fortran subprogram." (interactive) (save-match-data (let ((case-fold-search t)) - (if (save-excursion ; on END - (beginning-of-line) - (and (looking-at fortran-end-prog-re) - (fortran-check-end-prog-re))) - (forward-line) - (beginning-of-line 2) - (catch 'ok - (while (re-search-forward fortran-end-prog-re nil 'move) - (if (fortran-check-end-prog-re) - (throw 'ok t)))) - (goto-char (match-beginning 0)) - (forward-line))))) + (if (save-excursion ; on END + (beginning-of-line) + (and (looking-at fortran-end-prog-re) + (fortran-check-end-prog-re))) + (forward-line) + (beginning-of-line 2) + (catch 'ok + (while (re-search-forward fortran-end-prog-re nil 'move) + (if (fortran-check-end-prog-re) + (throw 'ok t)))) + (goto-char (match-beginning 0)) + (forward-line))))) (defun fortran-previous-statement () "Move point to beginning of the previous Fortran statement. @@ -1138,28 +1217,28 @@ Directive lines are treated as comments." (let (not-first-statement continue-test) (beginning-of-line) (setq continue-test - (and - (not (looking-at fortran-comment-line-start-skip)) + (and + (not (looking-at fortran-comment-line-start-skip)) (not (looking-at fortran-directive-re)) - (or (looking-at - (concat "[ \t]*" - (regexp-quote fortran-continuation-string))) - (looking-at " \\{5\\}[^ 0\n]\\|\t[1-9]")))) + (or (looking-at + (concat "[ \t]*" + (regexp-quote fortran-continuation-string))) + (looking-at " \\{5\\}[^ 0\n]\\|\t[1-9]")))) (while (and (setq not-first-statement (zerop (forward-line -1))) - (or (looking-at fortran-comment-line-start-skip) + (or (looking-at fortran-comment-line-start-skip) (looking-at fortran-directive-re) (looking-at (concat "[ \t]*" (regexp-quote fortran-continuation-string))) - (looking-at "[ \t]*$\\| \\{5\\}[^ 0\n]\\|\t[1-9]") - (looking-at (concat "[ \t]*" comment-start-skip))))) + (looking-at "[ \t]*$\\| \\{5\\}[^ 0\n]\\|\t[1-9]") + (looking-at (concat "[ \t]*" comment-start-skip))))) (cond ((and continue-test - (not not-first-statement)) - (message "Incomplete continuation statement.")) - (continue-test - (fortran-previous-statement)) - ((not not-first-statement) - 'first-statement)))) + (not not-first-statement)) + (message "Incomplete continuation statement.")) + (continue-test + (fortran-previous-statement)) + ((not not-first-statement) + 'first-statement)))) (defun fortran-next-statement () "Move point to beginning of the next Fortran statement. @@ -1170,14 +1249,14 @@ Directive lines are treated as comments." (let (not-last-statement) (beginning-of-line) (while (and (setq not-last-statement - (and (zerop (forward-line 1)) - (not (eobp)))) - (or (looking-at fortran-comment-line-start-skip) + (and (zerop (forward-line 1)) + (not (eobp)))) + (or (looking-at fortran-comment-line-start-skip) (looking-at fortran-directive-re) - (looking-at "[ \t]*$\\| [^ 0\n]\\|\t[1-9]") - (looking-at (concat "[ \t]*" comment-start-skip))))) + (looking-at "[ \t]*$\\| [^ 0\n]\\|\t[1-9]") + (looking-at (concat "[ \t]*" comment-start-skip))))) (if (not not-last-statement) - 'last-statement))) + 'last-statement))) (defun fortran-looking-at-if-then () "Return non-nil if at the start of a line with an IF ... THEN statement." @@ -1262,10 +1341,10 @@ pushes mark before moving point." "From a line matching REGEX, blink matching KEYWORD statement line. Use function FIND-BEGIN to match it." (let ((top-of-window (window-start)) - (end-point (point)) - (case-fold-search t) - matching - message) + (end-point (point)) + (case-fold-search t) + matching + message) (when (save-excursion (beginning-of-line) (skip-chars-forward " \t0-9") @@ -1289,7 +1368,7 @@ Use function FIND-BEGIN to match it." (defun fortran-blink-matching-if () "From an ENDIF or ELSE statement, blink the matching IF statement." (fortran-blink-match "e\\(nd[ \t]*if\\|lse\\([ \t]*if\\)?\\)\\b" - "if" #'fortran-beginning-if)) + "if" #'fortran-beginning-if)) (defun fortran-blink-matching-do () "From an ENDDO statement, blink the matching DO or DO WHILE statement." @@ -1312,27 +1391,27 @@ The marks are pushed." Return point or nil." (let ((case-fold-search t)) (if (save-excursion (beginning-of-line) - (skip-chars-forward " \t0-9") - (looking-at "end[ \t]*do\\b")) - ;; Sitting on one. - (match-beginning 0) + (skip-chars-forward " \t0-9") + (looking-at "end[ \t]*do\\b")) + ;; Sitting on one. + (match-beginning 0) ;; Search for one. (save-excursion - (let ((count 1)) - (while (and (not (zerop count)) - (not (eq (fortran-next-statement) 'last-statement)) - ;; Keep local to subprogram. - (not (and (looking-at fortran-end-prog-re) - (fortran-check-end-prog-re)))) - (skip-chars-forward " \t0-9") - (cond ((looking-at "end[ \t]*do\\b") - (setq count (1- count))) - ((looking-at - "\\(\\(\\sw\\|\\s_\\)+:[ \t]*\\)?do[ \t]+[^0-9]") - (setq count (1+ count))))) - (and (zerop count) - ;; All pairs accounted for. - (point))))))) + (let ((count 1)) + (while (and (not (zerop count)) + (not (eq (fortran-next-statement) 'last-statement)) + ;; Keep local to subprogram. + (not (and (looking-at fortran-end-prog-re) + (fortran-check-end-prog-re)))) + (skip-chars-forward " \t0-9") + (cond ((looking-at "end[ \t]*do\\b") + (setq count (1- count))) + ((looking-at + "\\(\\(\\sw\\|\\s_\\)+:[ \t]*\\)?do[ \t]+[^0-9]") + (setq count (1+ count))))) + (and (zerop count) + ;; All pairs accounted for. + (point))))))) (defun fortran-beginning-do () "Search backwards for first unmatched DO [WHILE]. @@ -1340,28 +1419,28 @@ Return point or nil. Ignores labelled DO loops (ie DO 10 ... 10 CONTINUE)." (let ((case-fold-search t) (dostart-re "\\(\\(\\sw\\|\\s_\\)+:[ \t]*\\)?do[ \t]+[^0-9]")) (if (save-excursion - (beginning-of-line) - (skip-chars-forward " \t0-9") - (looking-at dostart-re)) - ;; Sitting on one. - (match-beginning 0) + (beginning-of-line) + (skip-chars-forward " \t0-9") + (looking-at dostart-re)) + ;; Sitting on one. + (match-beginning 0) ;; Search for one. (save-excursion - (let ((count 1)) - (while (and (not (zerop count)) - (not (eq (fortran-previous-statement) 'first-statement)) - ;; Keep local to subprogram. - (not (and (looking-at fortran-end-prog-re) - (fortran-check-end-prog-re)))) - (skip-chars-forward " \t0-9") - (cond ((looking-at dostart-re) - (setq count (1- count))) + (let ((count 1)) + (while (and (not (zerop count)) + (not (eq (fortran-previous-statement) 'first-statement)) + ;; Keep local to subprogram. + (not (and (looking-at fortran-end-prog-re) + (fortran-check-end-prog-re)))) + (skip-chars-forward " \t0-9") + (cond ((looking-at dostart-re) + (setq count (1- count))) ;; Note labelled loop ends not considered. - ((looking-at "end[ \t]*do\\b") - (setq count (1+ count))))) - (and (zerop count) - ;; All pairs accounted for. - (point))))))) + ((looking-at "end[ \t]*do\\b") + (setq count (1+ count))))) + (and (zerop count) + ;; All pairs accounted for. + (point))))))) (defun fortran-mark-if () "Put mark at end of Fortran IF-ENDIF construct, point at beginning. @@ -1381,103 +1460,103 @@ The marks are pushed." Return point or nil." (let ((case-fold-search t)) (if (save-excursion (beginning-of-line) - (skip-chars-forward " \t0-9") - (looking-at "end[ \t]*if\\b")) - ;; Sitting on one. - (match-beginning 0) + (skip-chars-forward " \t0-9") + (looking-at "end[ \t]*if\\b")) + ;; Sitting on one. + (match-beginning 0) ;; Search for one. The point has been already been moved to first ;; letter on line but this should not cause troubles. (save-excursion - (let ((count 1)) - (while (and (not (zerop count)) - (not (eq (fortran-next-statement) 'last-statement)) - ;; Keep local to subprogram. - (not (and (looking-at fortran-end-prog-re) - (fortran-check-end-prog-re)))) - (skip-chars-forward " \t0-9") - (cond ((looking-at "end[ \t]*if\\b") - (setq count (1- count))) - ((looking-at fortran-if-start-re) - (save-excursion - (if (or - (looking-at ".*)[ \t]*then\\b[ \t]*[^ \t(=a-z0-9]") - (let (then-test) ; multi-line if-then - (while - (and - (zerop (forward-line 1)) - ;; Search forward for then. - (looking-at " \\{5\\}[^ 0\n]\\|\t[1-9]") - (not - (setq then-test - (looking-at - ".*then\\b[ \t]*[^ \t(=a-z0-9]"))))) - then-test)) - (setq count (1+ count))))))) - (and (zerop count) - ;; All pairs accounted for. - (point))))))) + (let ((count 1)) + (while (and (not (zerop count)) + (not (eq (fortran-next-statement) 'last-statement)) + ;; Keep local to subprogram. + (not (and (looking-at fortran-end-prog-re) + (fortran-check-end-prog-re)))) + (skip-chars-forward " \t0-9") + (cond ((looking-at "end[ \t]*if\\b") + (setq count (1- count))) + ((looking-at fortran-if-start-re) + (save-excursion + (if (or + (looking-at ".*)[ \t]*then\\b[ \t]*[^ \t(=a-z0-9]") + (let (then-test) ; multi-line if-then + (while + (and + (zerop (forward-line 1)) + ;; Search forward for then. + (looking-at " \\{5\\}[^ 0\n]\\|\t[1-9]") + (not + (setq then-test + (looking-at + ".*then\\b[ \t]*[^ \t(=a-z0-9]"))))) + then-test)) + (setq count (1+ count))))))) + (and (zerop count) + ;; All pairs accounted for. + (point))))))) (defun fortran-beginning-if () "Search backwards for first unmatched IF-THEN. Return point or nil." (let ((case-fold-search t)) (if (save-excursion - ;; May be sitting on multi-line if-then statement, first - ;; move to beginning of current statement. Note: - ;; `fortran-previous-statement' moves to previous statement - ;; *unless* current statement is first one. Only move - ;; forward if not first-statement. - (if (not (eq (fortran-previous-statement) 'first-statement)) - (fortran-next-statement)) - (skip-chars-forward " \t0-9") - (and - (looking-at fortran-if-start-re) - (save-match-data - (or (looking-at ".*)[ \t]*then\\b[ \t]*[^ \t(=a-z0-9]") - ;; Multi-line if-then. - (let (then-test) - (while + ;; May be sitting on multi-line if-then statement, first + ;; move to beginning of current statement. Note: + ;; `fortran-previous-statement' moves to previous statement + ;; *unless* current statement is first one. Only move + ;; forward if not first-statement. + (if (not (eq (fortran-previous-statement) 'first-statement)) + (fortran-next-statement)) + (skip-chars-forward " \t0-9") + (and + (looking-at fortran-if-start-re) + (save-match-data + (or (looking-at ".*)[ \t]*then\\b[ \t]*[^ \t(=a-z0-9]") + ;; Multi-line if-then. + (let (then-test) + (while (and (zerop (forward-line 1)) - ;; Search forward for then. - (looking-at " \\{5\\}[^ 0\n]\\|\t[1-9]") - (not - (setq then-test - (looking-at - ".*then\\b[ \t]*[^ \t(=a-z0-9]"))))) - then-test))))) - ;; Sitting on one. - (match-beginning 0) + ;; Search forward for then. + (looking-at " \\{5\\}[^ 0\n]\\|\t[1-9]") + (not + (setq then-test + (looking-at + ".*then\\b[ \t]*[^ \t(=a-z0-9]"))))) + then-test))))) + ;; Sitting on one. + (match-beginning 0) ;; Search for one. (save-excursion - (let ((count 1)) - (while (and (not (zerop count)) - (not (eq (fortran-previous-statement) 'first-statement)) - ;; Keep local to subprogram. - (not (and (looking-at fortran-end-prog-re) - (fortran-check-end-prog-re)))) - (skip-chars-forward " \t0-9") - (cond ((looking-at fortran-if-start-re) - (save-excursion - (if (or - (looking-at ".*)[ \t]*then\\b[ \t]*[^ \t(=a-z0-9]") - (let (then-test) ; multi-line if-then - (while - (and - (zerop (forward-line 1)) - ;; Search forward for then. - (looking-at " \\{5\\}[^ 0\n]\\|\t[1-9]") - (not - (setq then-test - (looking-at - (concat ".*then\\b[ \t]*" - "[^ \t(=a-z0-9]")))))) - then-test)) - (setq count (1- count))))) - ((looking-at "end[ \t]*if\\b") - (setq count (1+ count))))) - (and (zerop count) - ;; All pairs accounted for. - (point))))))) + (let ((count 1)) + (while (and (not (zerop count)) + (not (eq (fortran-previous-statement) 'first-statement)) + ;; Keep local to subprogram. + (not (and (looking-at fortran-end-prog-re) + (fortran-check-end-prog-re)))) + (skip-chars-forward " \t0-9") + (cond ((looking-at fortran-if-start-re) + (save-excursion + (if (or + (looking-at ".*)[ \t]*then\\b[ \t]*[^ \t(=a-z0-9]") + (let (then-test) ; multi-line if-then + (while + (and + (zerop (forward-line 1)) + ;; Search forward for then. + (looking-at " \\{5\\}[^ 0\n]\\|\t[1-9]") + (not + (setq then-test + (looking-at + (concat ".*then\\b[ \t]*" + "[^ \t(=a-z0-9]")))))) + then-test)) + (setq count (1- count))))) + ((looking-at "end[ \t]*if\\b") + (setq count (1+ count))))) + (and (zerop count) + ;; All pairs accounted for. + (point))))))) (defun fortran-indent-line () @@ -1487,15 +1566,15 @@ Return point or nil." (save-excursion (beginning-of-line) (if (or (not (= cfi (fortran-current-line-indentation))) - (and (re-search-forward "^[ \t]*[0-9]+" (+ (point) 4) t) - (not (fortran-line-number-indented-correctly-p)))) - (fortran-indent-to-column cfi) - (beginning-of-line) - (if (fortran-find-comment-start-skip) - (fortran-indent-comment)))) + (and (re-search-forward "^[ \t]*[0-9]+" (+ (point) 4) t) + (not (fortran-line-number-indented-correctly-p)))) + (fortran-indent-to-column cfi) + (beginning-of-line) + (if (fortran-find-comment-start-skip) + (fortran-indent-comment)))) ;; Never leave point in left margin. (if (< (current-column) cfi) - (move-to-column cfi)) + (move-to-column cfi)) (and auto-fill-function (> (save-excursion (end-of-line) (current-column)) fill-column) @@ -1510,20 +1589,20 @@ Return point or nil." "Function to use for `normal-auto-fill-function' in Fortran mode." (if (> (current-column) (current-fill-column)) (let ((cfi (fortran-calculate-indent))) - (save-excursion - (beginning-of-line) - (if (or (not (= cfi (fortran-current-line-indentation))) - (and (re-search-forward "^[ \t]*[0-9]+" - (+ (point) 4) t) - (not (fortran-line-number-indented-correctly-p)))) - (fortran-indent-to-column cfi) - (beginning-of-line) - (if (fortran-find-comment-start-skip) - (fortran-indent-comment)))) - (fortran-fill) - ;; Never leave point in left margin. - (if (< (current-column) cfi) - (move-to-column cfi))))) + (save-excursion + (beginning-of-line) + (if (or (not (= cfi (fortran-current-line-indentation))) + (and (re-search-forward "^[ \t]*[0-9]+" + (+ (point) 4) t) + (not (fortran-line-number-indented-correctly-p)))) + (fortran-indent-to-column cfi) + (beginning-of-line) + (if (fortran-find-comment-start-skip) + (fortran-indent-comment)))) + (fortran-fill) + ;; Never leave point in left margin. + (if (< (current-column) cfi) + (move-to-column cfi))))) ;; Historically this was a separate function which advertised itself ;; as reindenting but only did so where `most likely to be necessary'. @@ -1541,21 +1620,21 @@ Return point or nil." (defun fortran-calculate-indent () "Calculates the Fortran indent column based on previous lines." (let (icol first-statement (case-fold-search t) - (fortran-minimum-statement-indent - (if indent-tabs-mode - fortran-minimum-statement-indent-tab - fortran-minimum-statement-indent-fixed))) + (fortran-minimum-statement-indent + (if indent-tabs-mode + fortran-minimum-statement-indent-tab + fortran-minimum-statement-indent-fixed))) (save-excursion (setq first-statement (fortran-previous-statement)) (if first-statement - (setq icol fortran-minimum-statement-indent) + (setq icol fortran-minimum-statement-indent) (if (= (point) (point-min)) (setq icol fortran-minimum-statement-indent) (setq icol (fortran-current-line-indentation))) (skip-chars-forward " \t0-9") (cond ((looking-at "\\(\\(\\sw\\|\\s_\\)+:[ \t]*\\)?if[ \t]*(") (if (or (looking-at ".*)[ \t]*then\\b[ \t]*[^ \t_$(=a-z0-9]") - (let (then-test) ; multi-line if-then + (let (then-test) ; multi-line if-then (while (and (zerop (forward-line 1)) ;; Search forward for then. (looking-at " \\{5\\}[^ 0\n]\\|\t[1-9]") @@ -1591,52 +1670,52 @@ Return point or nil." (beginning-of-line) (cond ((looking-at "[ \t]*$")) ;; Check for directive before comment, so as not to indent. - ((looking-at fortran-directive-re) - (setq fortran-minimum-statement-indent 0 icol 0)) - ((looking-at fortran-comment-line-start-skip) - (cond ((eq fortran-comment-indent-style 'relative) - (setq icol (+ icol fortran-comment-line-extra-indent))) - ((eq fortran-comment-indent-style 'fixed) - (setq icol (+ fortran-minimum-statement-indent - fortran-comment-line-extra-indent)))) - (setq fortran-minimum-statement-indent 0)) - ((or (looking-at (concat "[ \t]*" - (regexp-quote - fortran-continuation-string))) - (looking-at " \\{5\\}[^ 0\n]\\|\t[1-9]")) + ((looking-at fortran-directive-re) + (setq fortran-minimum-statement-indent 0 icol 0)) + ((looking-at fortran-comment-line-start-skip) + (cond ((eq fortran-comment-indent-style 'relative) + (setq icol (+ icol fortran-comment-line-extra-indent))) + ((eq fortran-comment-indent-style 'fixed) + (setq icol (+ fortran-minimum-statement-indent + fortran-comment-line-extra-indent)))) + (setq fortran-minimum-statement-indent 0)) + ((or (looking-at (concat "[ \t]*" + (regexp-quote + fortran-continuation-string))) + (looking-at " \\{5\\}[^ 0\n]\\|\t[1-9]")) (skip-chars-forward " \t") ;; Do not introduce extra whitespace into a broken string. (setq icol (if (fortran-is-in-string-p (point)) 6 (+ icol fortran-continuation-indent)))) - (first-statement) - ((and fortran-check-all-num-for-matching-do - (looking-at "[ \t]*[0-9]+") - (fortran-check-for-matching-do)) - (setq icol (- icol fortran-do-indent))) - (t - (skip-chars-forward " \t0-9") - (cond ((looking-at "end[ \t]*\\(if\\|select\\|where\\)\\b") - (setq icol (- icol fortran-if-indent))) - ((looking-at "else\\(if\\)?\\b") - (setq icol (- icol fortran-if-indent))) + (first-statement) + ((and fortran-check-all-num-for-matching-do + (looking-at "[ \t]*[0-9]+") + (fortran-check-for-matching-do)) + (setq icol (- icol fortran-do-indent))) + (t + (skip-chars-forward " \t0-9") + (cond ((looking-at "end[ \t]*\\(if\\|select\\|where\\)\\b") + (setq icol (- icol fortran-if-indent))) + ((looking-at "else\\(if\\)?\\b") + (setq icol (- icol fortran-if-indent))) ((looking-at "case[ \t]*\\((.*)\\|default\\>\\)") - (setq icol (- icol fortran-if-indent))) - ((looking-at "\\(otherwise\\|else[ \t]*where\\)\\b") - (setq icol (- icol fortran-if-indent))) - ((and (looking-at "continue\\b") - (fortran-check-for-matching-do)) - (setq icol (- icol fortran-do-indent))) - ((looking-at "end[ \t]*do\\b") - (setq icol (- icol fortran-do-indent))) - ((looking-at "end[ \t]*\ + (setq icol (- icol fortran-if-indent))) + ((looking-at "\\(otherwise\\|else[ \t]*where\\)\\b") + (setq icol (- icol fortran-if-indent))) + ((and (looking-at "continue\\b") + (fortran-check-for-matching-do)) + (setq icol (- icol fortran-do-indent))) + ((looking-at "end[ \t]*do\\b") + (setq icol (- icol fortran-do-indent))) + ((looking-at "end[ \t]*\ \\(structure\\|union\\|map\\|interface\\)\\b[ \t]*[^ \t=(a-z]") - (setq icol (- icol fortran-structure-indent))) - ((and (looking-at fortran-end-prog-re1) - (fortran-check-end-prog-re) - (not (= icol fortran-minimum-statement-indent))) - (message "Warning: `end' not in column %d. Probably\ + (setq icol (- icol fortran-structure-indent))) + ((and (looking-at fortran-end-prog-re1) + (fortran-check-end-prog-re) + (not (= icol fortran-minimum-statement-indent))) + (message "Warning: `end' not in column %d. Probably\ an unclosed block." fortran-minimum-statement-indent)))))) (max fortran-minimum-statement-indent icol))) @@ -1650,16 +1729,16 @@ non-indentation text within the comment." (save-excursion (beginning-of-line) (cond ((looking-at fortran-comment-line-start-skip) - (goto-char (match-end 0)) - (skip-chars-forward - (if (stringp fortran-comment-indent-char) - fortran-comment-indent-char - (char-to-string fortran-comment-indent-char)))) - ((or (looking-at " \\{5\\}[^ 0\n]\\|\t[1-9]")) - (goto-char (match-end 0))) - (t - ;; Move past line number. - (skip-chars-forward "[ \t0-9]"))) + (goto-char (match-end 0)) + (skip-chars-forward + (if (stringp fortran-comment-indent-char) + fortran-comment-indent-char + (char-to-string fortran-comment-indent-char)))) + ((or (looking-at " \\{5\\}[^ 0\n]\\|\t[1-9]")) + (goto-char (match-end 0))) + (t + ;; Move past line number. + (skip-chars-forward "[ \t0-9]"))) ;; Move past whitespace. (skip-chars-forward " \t") (current-column))) @@ -1676,48 +1755,48 @@ notes: 1) A non-zero/non-blank character in column 5 indicates a continuation (save-excursion (beginning-of-line) (if (looking-at fortran-comment-line-start-skip) - (if fortran-comment-indent-style - (let* ((char (if (stringp fortran-comment-indent-char) - (aref fortran-comment-indent-char 0) - fortran-comment-indent-char)) - (chars (string ?\s ?\t char))) - (goto-char (match-end 0)) - (skip-chars-backward chars) - (delete-region (point) (progn (skip-chars-forward chars) - (point))) - (insert-char char (- col (current-column))))) + (if fortran-comment-indent-style + (let* ((char (if (stringp fortran-comment-indent-char) + (aref fortran-comment-indent-char 0) + fortran-comment-indent-char)) + (chars (string ?\s ?\t char))) + (goto-char (match-end 0)) + (skip-chars-backward chars) + (delete-region (point) (progn (skip-chars-forward chars) + (point))) + (insert-char char (- col (current-column))))) (if (looking-at "\t[1-9]") - (if indent-tabs-mode - (goto-char (match-end 0)) - (delete-char 2) - (insert-char ?\s 5) - (insert fortran-continuation-string)) - (if (looking-at " \\{5\\}[^ 0\n]") - (if indent-tabs-mode - (progn (delete-char 6) - (insert ?\t (fortran-numerical-continuation-char) 1)) - (forward-char 6)) - (delete-horizontal-space) - ;; Put line number in columns 0-4, or + (if indent-tabs-mode + (goto-char (match-end 0)) + (delete-char 2) + (insert-char ?\s 5) + (insert fortran-continuation-string)) + (if (looking-at " \\{5\\}[^ 0\n]") + (if indent-tabs-mode + (progn (delete-char 6) + (insert ?\t (fortran-numerical-continuation-char) 1)) + (forward-char 6)) + (delete-horizontal-space) + ;; Put line number in columns 0-4, or ;; continuation character in column 5. - (cond ((eobp)) - ((looking-at (regexp-quote fortran-continuation-string)) - (if indent-tabs-mode - (progn - (indent-to - (if indent-tabs-mode - fortran-minimum-statement-indent-tab - fortran-minimum-statement-indent-fixed)) - (delete-char 1) - (insert-char (fortran-numerical-continuation-char) 1)) - (indent-to 5) - (forward-char 1))) - ((looking-at "[0-9]+") - (let ((extra-space (- 5 (- (match-end 0) (point))))) - (if (< extra-space 0) - (message "Warning: line number exceeds 5-digit limit.") - (indent-to (min fortran-line-number-indent extra-space)))) - (skip-chars-forward "0-9"))))) + (cond ((eobp)) + ((looking-at (regexp-quote fortran-continuation-string)) + (if indent-tabs-mode + (progn + (indent-to + (if indent-tabs-mode + fortran-minimum-statement-indent-tab + fortran-minimum-statement-indent-fixed)) + (delete-char 1) + (insert-char (fortran-numerical-continuation-char) 1)) + (indent-to 5) + (forward-char 1))) + ((looking-at "[0-9]+") + (let ((extra-space (- 5 (- (match-end 0) (point))))) + (if (< extra-space 0) + (message "Warning: line number exceeds 5-digit limit.") + (indent-to (min fortran-line-number-indent extra-space)))) + (skip-chars-forward "0-9"))))) ;; Point is now after any continuation character or line number. ;; Put body of statement where specified. (delete-horizontal-space) @@ -1736,20 +1815,20 @@ Do not call if there is no line number." (beginning-of-line) (skip-chars-forward " \t") (and (<= (current-column) fortran-line-number-indent) - (or (= (current-column) fortran-line-number-indent) - (progn (skip-chars-forward "0-9") - (= (current-column) 5)))))) + (or (= (current-column) fortran-line-number-indent) + (progn (skip-chars-forward "0-9") + (= (current-column) 5)))))) (defun fortran-check-for-matching-do () "When called from a numbered statement, return t if matching DO is found. Otherwise return nil." (let ((case-fold-search t) - charnum) + charnum) (save-excursion (beginning-of-line) (when (looking-at "[ \t]*[0-9]+") (skip-chars-forward " \t") - (skip-chars-forward "0") ; skip past leading zeros + (skip-chars-forward "0") ; skip past leading zeros (setq charnum (buffer-substring (point) (progn (skip-chars-forward "0-9") @@ -1776,19 +1855,19 @@ If ALL is nil, only match comments that start in column > 0." ;; (comment-search-forward (line-end-position) t)) (when (or all comment-start-skip) (let ((pos (point)) - (css (if comment-start-skip - (concat fortran-comment-line-start-skip - "\\|" comment-start-skip) - fortran-comment-line-start-skip))) + (css (if comment-start-skip + (concat fortran-comment-line-start-skip + "\\|" comment-start-skip) + fortran-comment-line-start-skip))) (when (re-search-forward css (line-end-position) t) - (if (and (or all (> (match-beginning 0) (line-beginning-position))) - (or (save-match-data - (not (fortran-is-in-string-p (match-beginning 0)))) - ;; Recurse for rest of line. - (fortran-find-comment-start-skip all))) - (point) - (goto-char pos) - nil))))) + (if (and (or all (> (match-beginning 0) (line-beginning-position))) + (or (save-match-data + (not (fortran-is-in-string-p (match-beginning 0)))) + ;; Recurse for rest of line. + (fortran-find-comment-start-skip all))) + (point) + (goto-char pos) + nil))))) ;; From: ralf@up3aud1.gwdg.de (Ralf Fassel) ;; Test if TAB format continuation lines work. @@ -1797,57 +1876,57 @@ If ALL is nil, only match comments that start in column > 0." (save-excursion (goto-char where) (cond - ((bolp) nil) ; bol is never inside a string - ((save-excursion ; comment lines too - (beginning-of-line) - (looking-at fortran-comment-line-start-skip)) nil) + ((bolp) nil) ; bol is never inside a string + ((save-excursion ; comment lines too + (beginning-of-line) + (looking-at fortran-comment-line-start-skip)) nil) (t (let ((parse-state '(0 nil nil nil nil nil 0)) - (quoted-comment-start (if comment-start - (regexp-quote comment-start))) - (not-done t) - parse-limit end-of-line) - ;; Move to start of current statement. - (fortran-next-statement) - (fortran-previous-statement) - ;; Now parse up to WHERE. - (while not-done - (if (or ;; Skip to next line if: - ;; - comment line? - (looking-at fortran-comment-line-start-skip) - ;; - at end of line? - (eolp) - ;; - not in a string and after comment-start? - (and (not (nth 3 parse-state)) - comment-start - (equal comment-start - (char-to-string (preceding-char))))) - (if (> (forward-line) 0) - (setq not-done nil)) - ;; else: - ;; If we are at beginning of code line, skip any - ;; whitespace, labels and tab continuation markers. - (if (bolp) (skip-chars-forward " \t0-9")) - ;; If we are in column <= 5 now, check for continuation char. - (cond ((= 5 (current-column)) (forward-char 1)) - ((and (< (current-column) 5) - (equal fortran-continuation-string - (char-to-string (following-char))) - (forward-char 1)))) - ;; Find out parse-limit from here. - (setq end-of-line (line-end-position)) - (setq parse-limit (min where end-of-line)) - ;; Parse max up to comment-start, if non-nil and in current line. - (if comment-start - (save-excursion - (if (re-search-forward quoted-comment-start end-of-line t) - (setq parse-limit (min (point) parse-limit))))) - ;; Now parse if still in limits. - (if (< (point) where) - (setq parse-state (parse-partial-sexp - (point) parse-limit nil nil parse-state)) - (setq not-done nil)))) - ;; Result. - (nth 3 parse-state)))))) + (quoted-comment-start (if comment-start + (regexp-quote comment-start))) + (not-done t) + parse-limit end-of-line) + ;; Move to start of current statement. + (fortran-next-statement) + (fortran-previous-statement) + ;; Now parse up to WHERE. + (while not-done + (if (or ;; Skip to next line if: + ;; - comment line? + (looking-at fortran-comment-line-start-skip) + ;; - at end of line? + (eolp) + ;; - not in a string and after comment-start? + (and (not (nth 3 parse-state)) + comment-start + (equal comment-start + (char-to-string (preceding-char))))) + (if (> (forward-line) 0) + (setq not-done nil)) + ;; else: + ;; If we are at beginning of code line, skip any + ;; whitespace, labels and tab continuation markers. + (if (bolp) (skip-chars-forward " \t0-9")) + ;; If we are in column <= 5 now, check for continuation char. + (cond ((= 5 (current-column)) (forward-char 1)) + ((and (< (current-column) 5) + (equal fortran-continuation-string + (char-to-string (following-char))) + (forward-char 1)))) + ;; Find out parse-limit from here. + (setq end-of-line (line-end-position)) + (setq parse-limit (min where end-of-line)) + ;; Parse max up to comment-start, if non-nil and in current line. + (if comment-start + (save-excursion + (if (re-search-forward quoted-comment-start end-of-line t) + (setq parse-limit (min (point) parse-limit))))) + ;; Now parse if still in limits. + (if (< (point) where) + (setq parse-state (parse-partial-sexp + (point) parse-limit nil nil parse-state)) + (setq not-done nil)))) + ;; Result. + (nth 3 parse-state)))))) ;; From old version. (defalias 'fortran-auto-fill-mode 'auto-fill-mode) @@ -1855,17 +1934,17 @@ If ALL is nil, only match comments that start in column > 0." (defun fortran-fill () "Fill the current line at an appropriate point(s)." (let* ((auto-fill-function #'fortran-auto-fill) - (opoint (point)) - (bol (line-beginning-position)) - (eol (line-end-position)) - (bos (min eol (+ bol (fortran-current-line-indentation)))) + (opoint (point)) + (bol (line-beginning-position)) + (eol (line-end-position)) + (bos (min eol (+ bol (fortran-current-line-indentation)))) ;; If in a string at fill-column, break it either before the ;; initial quote, or at fill-col (if string is too long). - (quote - (save-excursion - (goto-char bol) - ;; OK to break quotes on comment lines. - (unless (looking-at fortran-comment-line-start-skip) + (quote + (save-excursion + (goto-char bol) + ;; OK to break quotes on comment lines. + (unless (looking-at fortran-comment-line-start-skip) (let (fcpoint start) (move-to-column fill-column) (when (fortran-is-in-string-p (setq fcpoint (point))) @@ -1884,12 +1963,12 @@ If ALL is nil, only match comments that start in column > 0." (- fill-column 6 fortran-continuation-indent)) fcpoint start)))))) - ;; Decide where to split the line. If a position for a quoted - ;; string was found above then use that, else break the line - ;; before/after the last delimiter. - (fill-point - (or quote - (save-excursion + ;; Decide where to split the line. If a position for a quoted + ;; string was found above then use that, else break the line + ;; before/after the last delimiter. + (fill-point + (or quote + (save-excursion ;; If f-b-b-d is t, have an extra column to play with, ;; since delimiter gets shifted to new line. (move-to-column (if fortran-break-before-delimiters @@ -1913,13 +1992,13 @@ If ALL is nil, only match comments that start in column > 0." (or (looking-at fortran-no-break-re) (forward-char))))) ;; Line indented beyond fill-column? - (when (<= (point) bos) + (when (<= (point) bos) (move-to-column (1+ fill-column)) ;; What is this doing??? (or (re-search-forward "[\t\n,'+-/*)=]" eol t) (goto-char bol))) - (if (bolp) - (re-search-forward "[ \t]" opoint t)) + (if (bolp) + (re-search-forward "[ \t]" opoint t)) (point))))) ;; If we are in an in-line comment, don't break unless the ;; line of code is longer than it should be. Otherwise @@ -1928,20 +2007,20 @@ If ALL is nil, only match comments that start in column > 0." ;; Need to use fortran-find-comment-start-skip to make sure that ;; quoted !'s don't prevent a break. (when (and (save-excursion - (beginning-of-line) - (if (not (fortran-find-comment-start-skip)) + (beginning-of-line) + (if (not (fortran-find-comment-start-skip)) t - (goto-char (match-beginning 0)) - (>= (point) fill-point))) - (save-excursion - (goto-char fill-point) - (not (bolp))) - (> (save-excursion - (goto-char opoint) - (current-column)) - (min (1+ fill-column) - (+ (fortran-calculate-indent) - fortran-continuation-indent)))) + (goto-char (match-beginning 0)) + (>= (point) fill-point))) + (save-excursion + (goto-char fill-point) + (not (bolp))) + (> (save-excursion + (goto-char opoint) + (current-column)) + (min (1+ fill-column) + (+ (fortran-calculate-indent) + fortran-continuation-indent)))) (goto-char fill-point) (fortran-break-line) (end-of-line)))) @@ -1949,27 +2028,27 @@ If ALL is nil, only match comments that start in column > 0." (defun fortran-break-line () "Call `fortran-split-line'. Joins continuation lines first, then refills." (let ((bol (line-beginning-position)) - (comment-string - (save-excursion - (if (fortran-find-comment-start-skip) - (delete-and-extract-region - (match-beginning 0) (line-end-position)))))) + (comment-string + (save-excursion + (if (fortran-find-comment-start-skip) + (delete-and-extract-region + (match-beginning 0) (line-end-position)))))) ;; Forward line 1 really needs to go to next non white line. (if (save-excursion (forward-line) - (looking-at " \\{5\\}[^ 0\n]\\|\t[1-9]")) - (progn - (end-of-line) - (delete-region (point) (match-end 0)) - (delete-horizontal-space) - (fortran-fill)) + (looking-at " \\{5\\}[^ 0\n]\\|\t[1-9]")) + (progn + (end-of-line) + (delete-region (point) (match-end 0)) + (delete-horizontal-space) + (fortran-fill)) (fortran-split-line)) (if comment-string - (save-excursion - (goto-char bol) - (end-of-line) - (delete-horizontal-space) - (indent-to (fortran-comment-indent)) - (insert comment-string))))) + (save-excursion + (goto-char bol) + (end-of-line) + (delete-horizontal-space) + (indent-to (fortran-comment-indent)) + (insert comment-string))))) (defun fortran-analyze-file-format () "Return nil if fixed format is used, t if TAB formatting is used. @@ -1979,12 +2058,12 @@ before the end or in the first `fortran-analyze-depth' lines." (save-excursion (goto-char (point-min)) (while (not (or - (eobp) - (eq (char-after) ?\t) - (looking-at " \\{6\\}") - (> i fortran-analyze-depth))) - (forward-line) - (setq i (1+ i))) + (eobp) + (eq (char-after) ?\t) + (looking-at " \\{6\\}") + (> i fortran-analyze-depth))) + (forward-line) + (setq i (1+ i))) (cond ((eq (char-after) ?\t) t) ((looking-at " \\{6\\}") nil) @@ -2026,13 +2105,15 @@ Always returns non-nil (to prevent `fill-paragraph' being called)." (fortran-indent-line))) (defun fortran-strip-sequence-nos (&optional do-space) - "Delete all text in column 72 and up (assumed to be sequence numbers). -Normally also deletes trailing whitespace after stripping such text. -Supplying prefix arg DO-SPACE prevents stripping the whitespace." + "Delete all text in column `fortran-line-length' (default 72) and up. +This is assumed to be sequence numbers. Normally also deletes +trailing whitespace after stripping such text. Supplying prefix +arg DO-SPACE prevents stripping the whitespace." (interactive "*p") (save-excursion (goto-char (point-min)) - (while (re-search-forward "^.\\{72\\}\\(.*\\)" nil t) + (while (re-search-forward (format "^.\\{%d\\}\\(.*\\)" fortran-line-length) + nil t) (replace-match "" nil nil nil 1) (unless do-space (delete-horizontal-space))))) @@ -2043,7 +2124,7 @@ Supplying prefix arg DO-SPACE prevents stripping the whitespace." (save-excursion ;; We must be inside function body for this to work. (fortran-beginning-of-subprogram) - (let ((case-fold-search t)) ; case-insensitive + (let ((case-fold-search t)) ; case-insensitive ;; Search for fortran subprogram start. (if (re-search-forward (concat "^[ \t]*\\(program\\|subroutine\\|function" diff --git a/lisp/progmodes/gdb-ui.el b/lisp/progmodes/gdb-ui.el index ef11668f022..eee68fb2b6f 100644 --- a/lisp/progmodes/gdb-ui.el +++ b/lisp/progmodes/gdb-ui.el @@ -1952,6 +1952,9 @@ static char *magick[] = { (end-of-line)))))) (if (gdb-get-buffer 'gdb-assembler-buffer) (gdb-assembler-custom))) +(declare-function gud-remove "gdb-ui" t t) ; gud-def +(declare-function gud-break "gdb-ui" t t) ; gud-def + (defun gdb-mouse-set-clear-breakpoint (event) "Set/clear breakpoint in left fringe/margin with mouse click." (interactive "e") diff --git a/lisp/progmodes/grep.el b/lisp/progmodes/grep.el index d03f5953ac2..e3ddb392582 100644 --- a/lisp/progmodes/grep.el +++ b/lisp/progmodes/grep.el @@ -1,7 +1,8 @@ ;;; grep.el --- run Grep as inferior of Emacs, parse match messages ;; Copyright (C) 1985, 1986, 1987, 1993, 1994, 1995, 1996, 1997, 1998, 1999, -;; 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008 Free Software Foundation, Inc. +;; 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008 +;; Free Software Foundation, Inc. ;; Author: Roland McGrath <roland@gnu.org> ;; Maintainer: FSF @@ -142,23 +143,23 @@ The following place holders should be present in the string: :version "22.1" :group 'grep) -(defcustom grep-files-aliases '( - ("el" . "*.el") - ("ch" . "*.[ch]") - ("c" . "*.c") - ("h" . "*.h") - ("asm" . "*.[sS]") - ("m" . "[Mm]akefile*") - ("l" . "[Cc]hange[Ll]og*") - ("tex" . "*.tex") - ("texi" . "*.texi") - ) +(defcustom grep-files-aliases + '(("asm" . "*.[sS]") + ("c" . "*.c") + ("cc" . "*.cc") + ("ch" . "*.[ch]") + ("el" . "*.el") + ("h" . "*.h") + ("l" . "[Cc]hange[Ll]og*") + ("m" . "[Mm]akefile*") + ("tex" . "*.tex") + ("texi" . "*.texi")) "*Alist of aliases for the FILES argument to `lgrep' and `rgrep'." :type 'alist :group 'grep) -(defcustom grep-find-ignored-directories '("CVS" ".svn" "{arch}" ".hg" "_darcs" - ".git" ".bzr") +(defcustom grep-find-ignored-directories + vc-directory-exclusion-list "*List of names of sub-directories which `rgrep' shall not recurse into." :type '(repeat string) :group 'grep) @@ -325,6 +326,12 @@ This variable's value takes effect when `grep-compute-defaults' is called.") This variable's value takes effect when `grep-compute-defaults' is called.") ;;;###autoload +(defvar xargs-program "xargs" + "The default xargs program for `grep-find-command'. +See `grep-find-use-xargs'. +This variable's value takes effect when `grep-compute-defaults' is called.") + +;;;###autoload (defvar grep-find-use-xargs nil "Non-nil means that `grep-find' uses the `xargs' utility by default. If `exec', use `find -exec'. @@ -343,6 +350,12 @@ This variable's value takes effect when `grep-compute-defaults' is called.") (defvar grep-regexp-history nil) (defvar grep-files-history '("ch" "el")) +(defvar grep-host-defaults-alist nil + "Default values depending on target host. +`grep-compute-defaults' returns default values for every local or +remote host `grep' runs. These values can differ from host to +host. Once computed, the default values are kept here in order +to avoid computing them again.") ;;;###autoload (defun grep-process-setup () @@ -351,11 +364,16 @@ Set up `compilation-exit-message-function' and run `grep-setup-hook'." (unless (or (not grep-highlight-matches) (eq grep-highlight-matches t)) (grep-compute-defaults)) (when (eq grep-highlight-matches t) - ;; Modify `process-environment' locally bound in `compilation-start' - (setenv "GREP_OPTIONS" (concat (getenv "GREP_OPTIONS") " --color=always")) - ;; for GNU grep 2.5.1 + ;; `setenv' modifies `process-environment' let-bound in `compilation-start' + ;; Any TERM except "dumb" allows GNU grep to use `--color=auto' + (setenv "TERM" "emacs-grep") + ;; `--color=auto' emits escape sequences on a tty rather than on a pipe, + ;; thus allowing to use multiple grep filters on the command line + ;; and to output escape sequences only on the final grep output + (setenv "GREP_OPTIONS" (concat (getenv "GREP_OPTIONS") " --color=auto")) + ;; GREP_COLOR is used in GNU grep 2.5.1, but deprecated in later versions (setenv "GREP_COLOR" "01;31") - ;; for GNU grep 2.5.1-cvs + ;; GREP_COLORS is used in GNU grep 2.5.2 and later versions (setenv "GREP_COLORS" "mt=01;31:fn=:ln=:bn=:se=:ml=:cx=:ne")) (set (make-local-variable 'compilation-exit-message-function) (lambda (status code msg) @@ -371,92 +389,153 @@ Set up `compilation-exit-message-function' and run `grep-setup-hook'." (defun grep-probe (command args &optional func result) (equal (condition-case nil - (apply (or func 'call-process) command args) + (apply (or func 'process-file) command args) (error nil)) (or result 0))) ;;;###autoload (defun grep-compute-defaults () - (unless (or (not grep-use-null-device) (eq grep-use-null-device t)) - (setq grep-use-null-device - (with-temp-buffer - (let ((hello-file (expand-file-name "HELLO" data-directory))) - (not - (and (if grep-command - ;; `grep-command' is already set, so - ;; use that for testing. - (grep-probe grep-command - `(nil t nil "^English" ,hello-file) - #'call-process-shell-command) - ;; otherwise use `grep-program' - (grep-probe grep-program - `(nil t nil "-nH" "^English" ,hello-file))) - (progn - (goto-char (point-min)) - (looking-at - (concat (regexp-quote hello-file) - ":[0-9]+:English"))))))))) - (unless (and grep-command grep-find-command - grep-template grep-find-template) - (let ((grep-options - (concat (if grep-use-null-device "-n" "-nH") - (if (grep-probe grep-program - `(nil nil nil "-e" "foo" ,null-device) - nil 1) - " -e")))) - (unless grep-command - (setq grep-command - (format "%s %s " grep-program grep-options))) - (unless grep-template - (setq grep-template - (format "%s <C> %s <R> <F>" grep-program grep-options))) - (unless grep-find-use-xargs - (setq grep-find-use-xargs - (cond - ((and - (grep-probe find-program `(nil nil nil ,null-device "-print0")) - (grep-probe "xargs" `(nil nil nil "-0" "-e" "echo"))) - 'gnu) - (t - 'exec)))) - (unless grep-find-command - (setq grep-find-command - (cond ((eq grep-find-use-xargs 'gnu) - (format "%s . -type f -print0 | xargs -0 -e %s" - find-program grep-command)) - ((eq grep-find-use-xargs 'exec) - (let ((cmd0 (format "%s . -type f -exec %s" - find-program grep-command))) - (cons - (format "%s {} %s %s" - cmd0 null-device - (shell-quote-argument ";")) - (1+ (length cmd0))))) - (t - (format "%s . -type f -print | xargs %s" - find-program grep-command))))) - (unless grep-find-template - (setq grep-find-template - (let ((gcmd (format "%s <C> %s <R>" - grep-program grep-options))) + ;; Keep default values. + (unless grep-host-defaults-alist + (add-to-list + 'grep-host-defaults-alist + (cons nil + `((grep-command ,grep-command) + (grep-template ,grep-template) + (grep-use-null-device ,grep-use-null-device) + (grep-find-command ,grep-find-command) + (grep-find-template ,grep-find-template) + (grep-find-use-xargs ,grep-find-use-xargs) + (grep-highlight-matches ,grep-highlight-matches))))) + (let* ((host-id + (intern (or (file-remote-p default-directory 'host) "localhost"))) + (host-defaults (assq host-id grep-host-defaults-alist)) + (defaults (assq nil grep-host-defaults-alist))) + ;; There are different defaults on different hosts. They must be + ;; computed for every host once. + (setq grep-command + (or (cadr (assq 'grep-command host-defaults)) + (cadr (assq 'grep-command defaults))) + + grep-template + (or (cadr (assq 'grep-template host-defaults)) + (cadr (assq 'grep-template defaults))) + + grep-use-null-device + (or (cadr (assq 'grep-use-null-device host-defaults)) + (cadr (assq 'grep-use-null-device defaults))) + + grep-find-command + (or (cadr (assq 'grep-find-command host-defaults)) + (cadr (assq 'grep-find-command defaults))) + + grep-find-template + (or (cadr (assq 'grep-find-template host-defaults)) + (cadr (assq 'grep-find-template defaults))) + + grep-find-use-xargs + (or (cadr (assq 'grep-find-use-xargs host-defaults)) + (cadr (assq 'grep-find-use-xargs defaults))) + + grep-highlight-matches + (or (cadr (assq 'grep-highlight-matches host-defaults)) + (cadr (assq 'grep-highlight-matches defaults)))) + + (unless (or (not grep-use-null-device) (eq grep-use-null-device t)) + (setq grep-use-null-device + (with-temp-buffer + (let ((hello-file (expand-file-name "HELLO" data-directory))) + (not + (and (if grep-command + ;; `grep-command' is already set, so + ;; use that for testing. + (grep-probe grep-command + `(nil t nil "^English" ,hello-file) + #'call-process-shell-command) + ;; otherwise use `grep-program' + (grep-probe grep-program + `(nil t nil "-nH" "^English" ,hello-file))) + (progn + (goto-char (point-min)) + (looking-at + (concat (regexp-quote hello-file) + ":[0-9]+:English"))))))))) + (unless (and grep-command grep-find-command + grep-template grep-find-template) + (let ((grep-options + (concat (if grep-use-null-device "-n" "-nH") + (if (grep-probe grep-program + `(nil nil nil "-e" "foo" ,null-device) + nil 1) + " -e")))) + (unless grep-command + (setq grep-command + (format "%s %s " grep-program grep-options))) + (unless grep-template + (setq grep-template + (format "%s <C> %s <R> <F>" grep-program grep-options))) + (unless grep-find-use-xargs + (setq grep-find-use-xargs + (cond + ((and + (grep-probe find-program `(nil nil nil ,null-device "-print0")) + (grep-probe xargs-program `(nil nil nil "-0" "-e" "echo"))) + 'gnu) + (t + 'exec)))) + (unless grep-find-command + (setq grep-find-command (cond ((eq grep-find-use-xargs 'gnu) - (format "%s . <X> -type f <F> -print0 | xargs -0 -e %s" - find-program gcmd)) + (format "%s . -type f -print0 | %s -0 -e %s" + find-program xargs-program grep-command)) ((eq grep-find-use-xargs 'exec) - (format "%s . <X> -type f <F> -exec %s {} %s %s" - find-program gcmd null-device - (shell-quote-argument ";"))) + (let ((cmd0 (format "%s . -type f -exec %s" + find-program grep-command))) + (cons + (format "%s {} %s %s" + cmd0 null-device + (shell-quote-argument ";")) + (1+ (length cmd0))))) (t - (format "%s . <X> -type f <F> -print | xargs %s" - find-program gcmd)))))))) - (unless (or (not grep-highlight-matches) (eq grep-highlight-matches t)) - (setq grep-highlight-matches - (with-temp-buffer - (and (grep-probe grep-program '(nil t nil "--help")) - (progn - (goto-char (point-min)) - (search-forward "--color" nil t)) - t))))) + (format "%s . -type f -print | %s %s" + find-program xargs-program grep-command))))) + (unless grep-find-template + (setq grep-find-template + (let ((gcmd (format "%s <C> %s <R>" + grep-program grep-options))) + (cond ((eq grep-find-use-xargs 'gnu) + (format "%s . <X> -type f <F> -print0 | %s -0 -e %s" + find-program xargs-program gcmd)) + ((eq grep-find-use-xargs 'exec) + (format "%s . <X> -type f <F> -exec %s {} %s %s" + find-program gcmd null-device + (shell-quote-argument ";"))) + (t + (format "%s . <X> -type f <F> -print | %s %s" + find-program xargs-program gcmd)))))))) + (unless (or (not grep-highlight-matches) (eq grep-highlight-matches t)) + (setq grep-highlight-matches + (with-temp-buffer + (and (grep-probe grep-program '(nil t nil "--help")) + (progn + (goto-char (point-min)) + (search-forward "--color" nil t)) + t)))) + + ;; Save defaults for this host. + (setq grep-host-defaults-alist + (delete (assq host-id grep-host-defaults-alist) + grep-host-defaults-alist)) + (add-to-list + 'grep-host-defaults-alist + (cons host-id + `((grep-command ,grep-command) + (grep-template ,grep-template) + (grep-use-null-device ,grep-use-null-device) + (grep-find-command ,grep-find-command) + (grep-find-template ,grep-find-template) + (grep-find-use-xargs ,grep-find-use-xargs) + (grep-highlight-matches ,grep-highlight-matches)))))) (defun grep-tag-default () (or (and transient-mark-mode mark-active @@ -468,7 +547,7 @@ Set up `compilation-exit-message-function' and run `grep-setup-hook'." "")) (defun grep-default-command () - "Compute the default grep command for C-u M-x grep to offer." + "Compute the default grep command for \\[universal-argument] \\[grep] to offer." (let ((tag-default (shell-quote-argument (grep-tag-default))) ;; This a regexp to match single shell arguments. ;; Could someone please add comments explaining it? @@ -521,19 +600,19 @@ Set up `compilation-exit-message-function' and run `grep-setup-hook'." "Run grep, with user-specified args, and collect output in a buffer. While grep runs asynchronously, you can use \\[next-error] (M-x next-error), or \\<grep-mode-map>\\[compile-goto-error] in the grep \ -output buffer, to go to the lines -where grep found matches. +output buffer, to go to the lines where grep +found matches. For doing a recursive `grep', see the `rgrep' command. For running `grep' in a specific directory, see `lgrep'. -This command uses a special history list for its COMMAND-ARGS, so you can -easily repeat a grep command. +This command uses a special history list for its COMMAND-ARGS, so you +can easily repeat a grep command. A prefix argument says to default the argument based upon the current tag the cursor is over, substituting it into the last grep command -in the grep command history (or into `grep-command' -if that history list is empty)." +in the grep command history (or into `grep-command' if that history +list is empty)." (interactive (progn (grep-compute-defaults) @@ -661,8 +740,9 @@ before it is executed. With two \\[universal-argument] prefixes, directly edit and run `grep-command'. Collect output in a buffer. While grep runs asynchronously, you -can use \\[next-error] (M-x next-error), or \\<grep-mode-map>\\[compile-goto-error] -in the grep output buffer, to go to the lines where grep found matches. +can use \\[next-error] (M-x next-error), or \\<grep-mode-map>\\[compile-goto-error] \ +in the grep output buffer, +to go to the lines where grep found matches. This command shares argument histories with \\[rgrep] and \\[grep]." (interactive @@ -703,11 +783,13 @@ This command shares argument histories with \\[rgrep] and \\[grep]." ;; even when async processes aren't supported. (compilation-start (if (and grep-use-null-device null-device) (concat command " " null-device) - command) 'grep-mode)) + command) + 'grep-mode)) (if (eq next-error-last-buffer (current-buffer)) (setq default-directory dir)))))) +(defvar find-name-arg) ; autoloaded ;;;###autoload (defun rgrep (regexp &optional files dir) @@ -721,8 +803,9 @@ before it is executed. With two \\[universal-argument] prefixes, directly edit and run `grep-find-command'. Collect output in a buffer. While find runs asynchronously, you -can use \\[next-error] (M-x next-error), or \\<grep-mode-map>\\[compile-goto-error] -in the grep output buffer, to go to the lines where grep found matches. +can use \\[next-error] (M-x next-error), or \\<grep-mode-map>\\[compile-goto-error] \ +in the grep output buffer, +to go to the lines where grep found matches. This command shares argument histories with \\[lgrep] and \\[grep-find]." (interactive diff --git a/lisp/progmodes/gud.el b/lisp/progmodes/gud.el index 714e06c3a18..4e9d73c0a00 100644 --- a/lisp/progmodes/gud.el +++ b/lisp/progmodes/gud.el @@ -49,17 +49,22 @@ (defvar gdb-macro-info) (defvar gdb-server-prefix) (defvar gdb-show-changed-values) +(defvar gdb-source-window) (defvar gdb-var-list) (defvar gdb-speedbar-auto-raise) +(defvar gud-tooltip-mode) +(defvar hl-line-mode) +(defvar hl-line-sticky-flag) (defvar tool-bar-map) + ;; ====================================================================== ;; GUD commands must be visible in C buffers visited by GUD (defgroup gud nil "Grand Unified Debugger mode for gdb and other debuggers under Emacs. Supported debuggers include gdb, sdb, dbx, xdb, perldb, pdb (Python), jdb." - :group 'unix + :group 'processes :group 'tools) @@ -106,6 +111,9 @@ Used to grey out relevant toolbar icons.") (defvar gdb-ready nil) +(defvar gud-target-name "--unknown--" + "The apparent name of the program being debugged in a gud buffer.") + ;; Use existing Info buffer, if possible. (defun gud-goto-info () "Go to relevant Emacs info node." @@ -294,6 +302,11 @@ Used to grey out relevant toolbar icons.") (defun gud-file-name (f) "Transform a relative file name to an absolute file name. Uses `gud-<MINOR-MODE>-directories' to find the source files." + ;; When `default-directory' is a remote file name, prepend its + ;; remote part to f, which is the local file name. Fortunately, + ;; `file-remote-p' returns exactly this remote file name part (or + ;; nil otherwise). + (setq f (concat (or (file-remote-p default-directory) "") f)) (if (file-exists-p f) (expand-file-name f) (let ((directories (gud-val 'directories)) (result nil)) @@ -305,6 +318,8 @@ Uses `gud-<MINOR-MODE>-directories' to find the source files." (setq directories (cdr directories))) result))) +(declare-function gdb-create-define-alist "gdb-ui" ()) + (defun gud-find-file (file) ;; Don't get confused by double slashes in the name that comes from GDB. (while (string-match "//+" file) @@ -703,6 +718,9 @@ The option \"--fullname\" must be included in this value." (defvar gud-filter-pending-text nil "Non-nil means this is text that has been saved for later in `gud-filter'.") +;; If in gdba mode, gdb-ui is loaded. +(declare-function gdb-restore-windows "gdb-ui" ()) + ;; The old gdb command (text command mode). The new one is in gdb-ui.el. ;;;###autoload (defun gud-gdb (command-line) @@ -1222,10 +1240,6 @@ a better solution in 6.1 upwards.") (setq result (substring result 0 (match-beginning 0)))))) (or result ""))) -(defvar gud-dgux-p (string-match "-dgux" system-configuration) - "Non-nil means to assume the interface approriate for DG/UX dbx. -This was tested using R4.11.") - ;; There are a couple of differences between DG's dbx output and normal ;; dbx output which make it nontrivial to integrate this into the ;; standard dbx-marker-filter (mainly, there are a different number of @@ -1284,9 +1298,6 @@ and source-file directory for your debugger." (gud-irix-p (gud-common-init command-line 'gud-dbx-massage-args 'gud-irixdbx-marker-filter)) - (gud-dgux-p - (gud-common-init command-line 'gud-dbx-massage-args - 'gud-dguxdbx-marker-filter)) (t (gud-common-init command-line 'gud-dbx-massage-args 'gud-dbx-marker-filter))) @@ -2442,9 +2453,6 @@ comint mode, which see." :group 'gud :type 'boolean) -(defvar gud-target-name "--unknown--" - "The apparent name of the program being debugged in a gud buffer.") - ;; Perform initializations common to all debuggers. ;; The first arg is the specified command line, ;; which starts with the program to debug. @@ -2500,7 +2508,10 @@ comint mode, which see." (while (and w (not (eq (car w) t))) (setq w (cdr w))) (if w - (setcar w file))) + (setcar w + (if (file-remote-p default-directory) + (setq file (file-name-nondirectory file)) + file)))) (apply 'make-comint (concat "gud" filepart) program nil (if massage-args (funcall massage-args file args) args)) ;; Since comint clobbered the mode, we don't set it until now. @@ -2591,6 +2602,8 @@ It is saved for when this flag is not set.") (defvar gud-overlay-arrow-position nil) (add-to-list 'overlay-arrow-variable-list 'gud-overlay-arrow-position) +(declare-function gdb-reset "gdb-ui" ()) + (defun gud-sentinel (proc msg) (cond ((null (buffer-name (process-buffer proc))) ;; buffer killed @@ -2660,6 +2673,11 @@ Obeying it means displaying in another window the specified file and line." (setq gud-last-last-frame gud-last-frame gud-last-frame nil))) +(declare-function global-hl-line-highlight "hl-line" ()) +(declare-function hl-line-highlight "hl-line" ()) +(declare-function gdb-display-source-buffer "gdb-ui" (buffer)) +(declare-function gdb-display-buffer "gdb-ui" (buf dedicated &optional size)) + ;; Make sure the file named TRUE-FILE is in a buffer that appears on the screen ;; and that its line LINE is visible. ;; Put the overlay-arrow on the line LINE in that buffer. @@ -2992,6 +3010,12 @@ Link exprs of the form: (t nil))) (t nil)))) + +(declare-function c-langelem-sym "cc-defs" (langelem)) +(declare-function c-langelem-pos "cc-defs" (langelem)) +(declare-function syntax-symbol "gud" (x)) +(declare-function syntax-point "gud" (x)) + (defun gud-find-class (f line) "Find fully qualified class in file F at line LINE. This function uses the `gud-jdb-classpath' (and optional @@ -3377,6 +3401,8 @@ With arg, dereference expr if ARG is positive, otherwise do not derereference." ((xdb pdb) (concat "p " expr)) (sdb (concat expr "/")))) +(declare-function gdb-enqueue-input "gdb-ui" (item)) + (defun gud-tooltip-tips (event) "Show tip for identifier or selection under the mouse. The mouse must either point at an identifier or inside a selected diff --git a/lisp/progmodes/hideshow.el b/lisp/progmodes/hideshow.el index c4804bbcc30..5a784b159d3 100644 --- a/lisp/progmodes/hideshow.el +++ b/lisp/progmodes/hideshow.el @@ -407,11 +407,6 @@ to the variable `mode-line-format'. For example, Note that `mode-line-format' is buffer-local.") ;;--------------------------------------------------------------------------- -;; system dependency - -(defalias 'hs-match-data 'match-data) - -;;--------------------------------------------------------------------------- ;; support functions (defun hs-discard-overlays (from to) @@ -508,8 +503,8 @@ Original match data is restored upon return." (defun hs-hide-comment-region (beg end &optional repos-end) "Hide a region from BEG to END, marking it as a comment. Optional arg REPOS-END means reposition at end." - (let ((beg-eol (progn (goto-char beg) (end-of-line) (point))) - (end-eol (progn (goto-char end) (end-of-line) (point)))) + (let ((beg-eol (progn (goto-char beg) (line-end-position))) + (end-eol (progn (goto-char end) (line-end-position)))) (hs-discard-overlays beg-eol end-eol) (hs-make-overlay beg-eol end-eol 'comment beg end)) (goto-char (if repos-end end beg))) @@ -526,7 +521,7 @@ and then further adjusted to be at the end of the line." (if comment-reg (hs-hide-comment-region (car comment-reg) (cadr comment-reg) end) (when (looking-at hs-block-start-regexp) - (let* ((mdata (hs-match-data t)) + (let* ((mdata (match-data t)) (pure-p (match-end 0)) (p ;; `p' is the point at the end of the block beginning, @@ -536,8 +531,7 @@ and then further adjusted to be at the end of the line." 'identity) pure-p)) ;; whatever the adjustment, we move to eol - (end-of-line) - (point))) + (line-end-position))) (q ;; `q' is the point at the end of the block (progn (hs-forward-sexp mdata 1) @@ -638,7 +632,8 @@ function; and adjust-block-beginning function." hs-forward-sexp-func (or (nth 4 lookup) 'forward-sexp) hs-adjust-block-beginning (nth 5 lookup))) (setq hs-minor-mode nil) - (error "%s Mode doesn't support Hideshow Minor Mode" mode-name))) + (error "%s Mode doesn't support Hideshow Minor Mode" + (format-mode-line mode-name)))) (defun hs-find-block-beginning () "Reposition point at block-start. @@ -652,7 +647,7 @@ Return point, or nil if original point was not in a block." (while (and (re-search-backward hs-block-start-regexp nil t) (not (setq done (< here (save-excursion - (hs-forward-sexp (hs-match-data t) 1) + (hs-forward-sexp (match-data t) 1) (point))))))) (if done (point) @@ -705,7 +700,7 @@ and `case-fold-search' are both t." (if (and c-reg (nth 0 c-reg)) ;; point is inside a comment, and that comment is hidable (goto-char (nth 0 c-reg)) - (end-of-line) + (end-of-line) (when (and (not c-reg) (hs-find-block-beginning) (looking-at hs-block-start-regexp)) @@ -734,12 +729,12 @@ Move point to the beginning of the line, and run the normal hook If `hs-hide-comments-when-hiding-all' is non-nil, also hide the comments." (interactive) (hs-life-goes-on - (message "Hiding all blocks ...") (save-excursion (unless hs-allow-nesting (hs-discard-overlays (point-min) (point-max))) (goto-char (point-min)) - (let ((count 0) + (let ((spew (make-progress-reporter "Hiding all blocks..." + (point-min) (point-max))) (re (concat "\\(" hs-block-start-regexp "\\)" @@ -765,9 +760,9 @@ If `hs-hide-comments-when-hiding-all' is non-nil, also hide the comments." (if (> (count-lines (car c-reg) (nth 1 c-reg)) 1) (hs-hide-block-at-point t c-reg) (goto-char (nth 1 c-reg)))))) - (message "Hiding ... %d" (setq count (1+ count)))))) + (progress-reporter-update spew (point))) + (progress-reporter-done spew))) (beginning-of-line) - (message "Hiding all blocks ... done") (run-hooks 'hs-hide-hook))) (defun hs-show-all () @@ -806,7 +801,7 @@ See documentation for functions `hs-hide-block' and `run-hooks'." (hs-life-goes-on (or ;; first see if we have something at the end of the line - (let ((ov (hs-overlay-at (save-excursion (end-of-line) (point)))) + (let ((ov (hs-overlay-at (line-end-position))) (here (point))) (when ov (goto-char @@ -826,7 +821,7 @@ See documentation for functions `hs-hide-block' and `run-hooks'." ;; ugh, fresh match-data (looking-at hs-block-start-regexp)) (setq p (point) - q (progn (hs-forward-sexp (hs-match-data t) 1) (point))))) + q (progn (hs-forward-sexp (match-data t) 1) (point))))) (when (and p q) (hs-discard-overlays p q) (goto-char (if end q (1+ p))))) @@ -906,9 +901,9 @@ Key bindings: (progn (hs-grok-mode-type) ;; Turn off this mode if we change major modes. - (add-hook 'change-major-mode-hook - 'turn-off-hideshow - nil t) + (add-hook 'change-major-mode-hook + 'turn-off-hideshow + nil t) (easy-menu-add hs-minor-mode-menu) (set (make-local-variable 'line-move-ignore-invisible) t) (add-to-invisibility-spec '(hs . t))) @@ -971,5 +966,5 @@ Key bindings: (provide 'hideshow) -;;; arch-tag: 378b6852-e82a-466a-aee8-d9c73859a65e +;; arch-tag: 378b6852-e82a-466a-aee8-d9c73859a65e ;;; hideshow.el ends here diff --git a/lisp/progmodes/idlw-complete-structtag.el b/lisp/progmodes/idlw-complete-structtag.el index 1c9da9b2a95..22f673149dc 100644 --- a/lisp/progmodes/idlw-complete-structtag.el +++ b/lisp/progmodes/idlw-complete-structtag.el @@ -91,6 +91,8 @@ (require 'idlwave) +(declare-function idlwave-shell-buffer "idlw-shell") + ;; Some variables to identify the previously used structure (defvar idlwave-current-tags-var nil) (defvar idlwave-current-tags-buffer nil) @@ -101,6 +103,7 @@ (defvar idlwave-sint-structtags nil) ;; Create the sintern type for structure talks +(declare-function idlwave-sintern-structtag "idlw-complete-structtag" t t) (idlwave-new-sintern-type 'structtag) ;; Hook the plugin into idlwave diff --git a/lisp/progmodes/idlw-help.el b/lisp/progmodes/idlw-help.el index 8c449041498..147b0afd2e2 100644 --- a/lisp/progmodes/idlw-help.el +++ b/lisp/progmodes/idlw-help.el @@ -42,13 +42,10 @@ ;;; Code: -(defvar idlwave-help-browse-url-available nil +(defvar idlwave-help-browse-url-available t "Whether browse-url is available") -(setq idlwave-help-browse-url-available - (condition-case nil - (require 'browse-url) - (error nil))) +(require 'browse-url) (defgroup idlwave-online-help nil "Online Help options for IDLWAVE mode." @@ -258,6 +255,39 @@ support." (defvar idlwave-help-def-pos) (defvar idlwave-help-args) (defvar idlwave-help-in-header) +(declare-function idlwave-prepare-structure-tag-completion "idlw-complete-structtag") +(declare-function idlwave-all-method-classes "idlwave") +(declare-function idlwave-all-method-keyword-classes "idlwave") +(declare-function idlwave-beginning-of-statement "idlwave") +(declare-function idlwave-best-rinfo-assoc "idlwave") +(declare-function idlwave-class-found-in "idlwave") +(declare-function idlwave-class-or-superclass-with-tag "idlwave") +(declare-function idlwave-completing-read "idlwave") +(declare-function idlwave-current-routine "idlwave") +(declare-function idlwave-downcase-safe "idlwave") +(declare-function idlwave-entry-find-keyword "idlwave") +(declare-function idlwave-expand-keyword "idlwave") +(declare-function idlwave-find-class-definition "idlwave") +(declare-function idlwave-find-inherited-class "idlwave") +(declare-function idlwave-find-struct-tag "idlwave") +(declare-function idlwave-get-buffer-visiting "idlwave") +(declare-function idlwave-in-quote "idlwave") +(declare-function idlwave-make-full-name "idlwave") +(declare-function idlwave-members-only "idlwave") +(declare-function idlwave-popup-select "idlwave") +(declare-function idlwave-routine-source-file "idlwave") +(declare-function idlwave-routines "idlwave") +(declare-function idlwave-sintern-class "idlwave") +(declare-function idlwave-sintern-keyword "idlwave") +(declare-function idlwave-sintern-method "idlwave") +(declare-function idlwave-sintern-routine-or-method "idlwave") +(declare-function idlwave-sintern-sysvar "idlwave" t t);idlwave-new-sintern-type +(declare-function idlwave-sintern-sysvartag "idlwave" t t) +(declare-function idlwave-substitute-link-target "idlwave") +(declare-function idlwave-sys-dir "idlwave") +(declare-function idlwave-this-word "idlwave") +(declare-function idlwave-what-module-find-class "idlwave") +(declare-function idlwave-where "idlwave") (defun idlwave-help-mode () "Major mode for displaying IDL Help. @@ -1317,6 +1347,8 @@ IDL assistant.") (defvar idlwave-help-assistant-help-with-topic-history nil "The history of help topics selected with the minibuffer.") +(defvar idlwave-system-routines) + (defun idlwave-help-assistant-help-with-topic (&optional topic) "Prompt for and provide help with TOPIC." (interactive) diff --git a/lisp/progmodes/idlw-shell.el b/lisp/progmodes/idlw-shell.el index 426b8380f22..20f52fb13b0 100644 --- a/lisp/progmodes/idlw-shell.el +++ b/lisp/progmodes/idlw-shell.el @@ -98,18 +98,6 @@ (eval-when-compile (require 'cl)) (defvar idlwave-shell-have-new-custom nil) -(eval-and-compile - ;; Kludge to allow `defcustom' for Emacs 19. - (condition-case () (require 'custom) (error nil)) - (if (and (featurep 'custom) - (fboundp 'custom-declare-variable) - (fboundp 'defface)) - ;; We've got what we needed - (setq idlwave-shell-have-new-custom t) - ;; We have the old or no custom-library, hack around it! - (defmacro defgroup (&rest args) nil) - (defmacro defcustom (var value doc &rest args) - `(defvar ,var ,value ,doc)))) ;;; Customizations: idlwave-shell group @@ -1322,7 +1310,7 @@ message, independent of what HIDE is set to." (if (or (not (setq buf (get-buffer (idlwave-shell-buffer)))) (not (setq proc (get-buffer-process buf)))) (if (not idlwave-shell-automatic-start) - (error + (error "%s" (substitute-command-keys "You need to first start an IDL shell with \\[idlwave-shell]")) (idlwave-shell-recenter-shell-window) @@ -1474,7 +1462,7 @@ Otherwise just move the line. Move down unless UP is non-nil." (if (and idlwave-shell-arrows-do-history (>= (1+ (save-excursion (end-of-line) (point))) proc-pos)) (comint-previous-input arg) - (previous-line arg)))) + (forward-line (- arg))))) (defun idlwave-shell-up-or-history (&optional arg) "When in last line of process buffer, move to previous input. @@ -2375,7 +2363,7 @@ matter what the settings of that variable." (if (not (idlwave-shell-valid-frame frame)) ;; fixme: errors are dangerous in shell filters. but i think i ;; have never encountered this one. - (error (concat "invalid frame - unable to access file: " (car frame))) + (error "invalid frame - unable to access file: %s" (car frame)) ;;; ;;; buffer : the buffer to display a line in. ;;; select-shell: current buffer is the shell. @@ -3461,12 +3449,12 @@ breakpoint overlays." line (string-to-number (match-string (nth 2 indmap))) file (idlwave-shell-file-name (match-string (nth 3 indmap)))) (if (eq bp-re bp-re55) - (setq count (if (match-string 10) 1 + (setq count (if (match-string 10) 1 (if (match-string 8) (string-to-number (match-string 8)))) condition (match-string 13) disabled (not (null (match-string 15))))) - + ;; Add the breakpoint info to the list (nconc idlwave-shell-bp-alist (list (cons (list file line) @@ -3476,9 +3464,9 @@ breakpoint overlays." count nil condition disabled)))))) (setq idlwave-shell-bp-alist (cdr idlwave-shell-bp-alist)) ;; Update breakpoint data - (if (eq bp-re bp-re54) - (mapcar 'idlwave-shell-update-bp old-bp-alist) - (mapcar 'idlwave-shell-update-bp-command-only old-bp-alist)))) + (if (eq bp-re bp-re54) + (mapc 'idlwave-shell-update-bp old-bp-alist) + (mapc 'idlwave-shell-update-bp-command-only old-bp-alist)))) ;; Update the breakpoint overlays (unless no-show (idlwave-shell-update-bp-overlays)) ;; Return the new list @@ -4530,27 +4518,27 @@ idlwave-shell-electric-debug-mode-map) (if (or (featurep 'easymenu) (load "easymenu" t)) (progn - (easy-menu-define + (easy-menu-define idlwave-mode-debug-menu idlwave-mode-map "IDL debugging menus" idlwave-shell-menu-def) (easy-menu-define idlwave-shell-mode-menu idlwave-shell-mode-map "IDL shell menus" idlwave-shell-menu-def) (save-excursion - (mapcar (lambda (buf) - (set-buffer buf) - (if (eq major-mode 'idlwave-mode) - (progn - (easy-menu-remove idlwave-mode-debug-menu) - (easy-menu-add idlwave-mode-debug-menu)))) - (buffer-list))))) + (mapc (lambda (buf) + (set-buffer buf) + (if (eq major-mode 'idlwave-mode) + (progn + (easy-menu-remove idlwave-mode-debug-menu) + (easy-menu-add idlwave-mode-debug-menu)))) + (buffer-list))))) ;; The Breakpoint Glyph ------------------------------------------------------- (defvar idlwave-shell-bp-glyph nil "The glyphs to mark breakpoint lines in the source code.") -(let ((image-alist +(let ((image-alist '((bp . "/* XPM */ static char * file[] = { \"14 12 3 1\", diff --git a/lisp/progmodes/idlw-toolbar.el b/lisp/progmodes/idlw-toolbar.el index 32a3f2064e4..875b1371f5c 100644 --- a/lisp/progmodes/idlw-toolbar.el +++ b/lisp/progmodes/idlw-toolbar.el @@ -916,21 +916,21 @@ static char * file[] = { (idlwave-toolbar-add)) (buffer-list))) ;; For Emacs, add the key definitions to the mode maps - (mapcar (lambda (x) - (let* ((icon (aref x 0)) - (func (aref x 1)) - (show (aref x 2)) - (help (aref x 3)) - (key (vector 'tool-bar func)) - (def (list 'menu-item - "a" - func - :image (symbol-value icon) - :visible show - :help help))) - (define-key idlwave-mode-map key def) - (define-key idlwave-shell-mode-map key def))) - (reverse idlwave-toolbar))) + (mapc (lambda (x) + (let* ((icon (aref x 0)) + (func (aref x 1)) + (show (aref x 2)) + (help (aref x 3)) + (key (vector 'tool-bar func)) + (def (list 'menu-item + "a" + func + :image (symbol-value icon) + :visible show + :help help))) + (define-key idlwave-mode-map key def) + (define-key idlwave-shell-mode-map key def))) + (reverse idlwave-toolbar))) (setq idlwave-toolbar-visible t))) (defun idlwave-toolbar-remove-everywhere () @@ -947,15 +947,15 @@ static char * file[] = { (idlwave-toolbar-remove)) (buffer-list))) ;; For Emacs, remove the key definitions from the mode maps - (mapcar (lambda (x) - (let* (;;(icon (aref x 0)) - (func (aref x 1)) - ;;(show (aref x 2)) - ;;(help (aref x 3)) - (key (vector 'tool-bar func))) - (define-key idlwave-mode-map key nil) - (define-key idlwave-shell-mode-map key nil))) - idlwave-toolbar)) + (mapc (lambda (x) + (let* (;;(icon (aref x 0)) + (func (aref x 1)) + ;;(show (aref x 2)) + ;;(help (aref x 3)) + (key (vector 'tool-bar func))) + (define-key idlwave-mode-map key nil) + (define-key idlwave-shell-mode-map key nil))) + idlwave-toolbar)) (setq idlwave-toolbar-visible nil))) (defun idlwave-toolbar-toggle (&optional force-on) diff --git a/lisp/progmodes/idlwave.el b/lisp/progmodes/idlwave.el index 77e5c2c285b..8de8c8a3f08 100644 --- a/lisp/progmodes/idlwave.el +++ b/lisp/progmodes/idlwave.el @@ -172,15 +172,12 @@ (require 'timer) (error nil))) -(eval-and-compile - ;; Kludge to allow `defcustom' for Emacs 19. - (condition-case () (require 'custom) (error nil)) - (if (and (featurep 'custom) (fboundp 'custom-declare-variable)) - nil ;; We've got what we needed - ;; We have the old or no custom-library, hack around it! - (defmacro defgroup (&rest args) nil) - (defmacro defcustom (var value doc &rest args) - `(defvar ,var ,value ,doc)))) +(declare-function idlwave-shell-get-path-info "idlw-shell") +(declare-function idlwave-shell-temp-file "idlw-shell") +(declare-function idlwave-shell-is-running "idlw-shell") +(declare-function widget-value "wid-edit" (widget)) +(declare-function comint-dynamic-complete-filename "comint" ()) +(declare-function Info-goto-node "info" (nodename &optional fork)) (defgroup idlwave nil "Major mode for editing IDL .pro files." @@ -2115,15 +2112,11 @@ Returns point if comment found and nil otherwise." (backward-char 1) (point))))) -(defvar transient-mark-mode) -(defvar zmacs-regions) -(defvar mark-active) (defun idlwave-region-active-p () - "Is transient-mark-mode on and the region active? -Works on both Emacs and XEmacs." - (if (featurep 'xemacs) - (and zmacs-regions (region-active-p)) - (and transient-mark-mode mark-active))) + "Should we operate on an active region?" + (if (fboundp 'use-region-p) + (use-region-p) + (region-active-p))) (defun idlwave-show-matching-quote () "Insert quote and show matching quote if this is end of a string." @@ -2827,10 +2820,10 @@ If the optional argument EXPAND is non-nil then the actions in ;; Before indenting, run action routines. ;; (if (and expand idlwave-do-actions) - (mapcar 'idlwave-do-action idlwave-indent-expand-table)) + (mapc 'idlwave-do-action idlwave-indent-expand-table)) ;; (if idlwave-do-actions - (mapcar 'idlwave-do-action idlwave-indent-action-table)) + (mapc 'idlwave-do-action idlwave-indent-action-table)) ;; ;; No longer expand abbrevs on the line. The user can do this ;; manually using expand-region-abbrevs. @@ -3792,7 +3785,7 @@ unless the optional second argument NOINDENT is non-nil." (if (not noindent) (indent-region beg end nil)) (if (stringp prompt) - (message prompt))))) + (message "%s" prompt))))) (defun idlwave-rw-case (string) "Make STRING have the case required by `idlwave-reserved-word-upcase'." @@ -4242,9 +4235,9 @@ blank lines." (defun idlwave-sintern-keyword-list (kwd-list &optional set) "Sintern a set of keywords (file (key . link) (key2 . link2) ...)" - (mapcar (lambda(x) - (setcar x (idlwave-sintern-keyword (car x) set))) - (cdr kwd-list)) + (mapc (lambda(x) + (setcar x (idlwave-sintern-keyword (car x) set))) + (cdr kwd-list)) kwd-list) (defun idlwave-sintern-rinfo-list (list &optional set default-dir) @@ -5560,11 +5553,11 @@ directories and save the routine info. ;; Define the routine info list (insert "\n(setq idlwave-user-catalog-routines\n '(") (let ((standard-output (current-buffer))) - (mapcar (lambda (x) - (insert "\n ") - (prin1 x) - (goto-char (point-max))) - idlwave-user-catalog-routines)) + (mapc (lambda (x) + (insert "\n ") + (prin1 x) + (goto-char (point-max))) + idlwave-user-catalog-routines)) (insert (format "))\n\n;;; %s ends here\n" (file-name-nondirectory idlwave-user-catalog-file))) (goto-char (point-min)) @@ -5604,11 +5597,11 @@ directories and save the routine info. ;; Define the variable which contains a list of all scanned directories (insert "\n(setq idlwave-path-alist\n '(") (let ((standard-output (current-buffer))) - (mapcar (lambda (x) - (insert "\n ") - (prin1 x) - (goto-char (point-max))) - idlwave-path-alist)) + (mapc (lambda (x) + (insert "\n ") + (prin1 x) + (goto-char (point-max))) + idlwave-path-alist)) (insert "))\n") (save-buffer 0) (kill-buffer (current-buffer)))) @@ -6319,12 +6312,12 @@ When TYPE is not specified, both procedures and functions will be considered." (if (null method) (mapcar 'car (idlwave-class-alist)) (let (rtn) - (mapcar (lambda (x) - (and (nth 2 x) - (or (not type) - (eq type (nth 1 x))) - (push (nth 2 x) rtn))) - (idlwave-all-assq method (idlwave-routines))) + (mapc (lambda (x) + (and (nth 2 x) + (or (not type) + (eq type (nth 1 x))) + (push (nth 2 x) rtn))) + (idlwave-all-assq method (idlwave-routines))) (idlwave-uniquify rtn)))) (defun idlwave-all-method-keyword-classes (method keyword &optional type) @@ -6335,13 +6328,13 @@ When TYPE is not specified, both procedures and functions will be considered." (null keyword)) nil (let (rtn) - (mapcar (lambda (x) - (and (nth 2 x) ; non-nil class - (or (not type) ; correct or unspecified type - (eq type (nth 1 x))) - (assoc keyword (idlwave-entry-keywords x)) - (push (nth 2 x) rtn))) - (idlwave-all-assq method (idlwave-routines))) + (mapc (lambda (x) + (and (nth 2 x) ; non-nil class + (or (not type) ; correct or unspecified type + (eq type (nth 1 x))) + (assoc keyword (idlwave-entry-keywords x)) + (push (nth 2 x) rtn))) + (idlwave-all-assq method (idlwave-routines))) (idlwave-uniquify rtn)))) (defun idlwave-members-only (list club) @@ -6785,12 +6778,12 @@ accumulate information on matching completions." (message "Making completion list...") (unless idlwave-completion-help-links ; already set somewhere? - (mapcar (lambda (x) ; Pass link prop through to highlight-linked - (let ((link (get-text-property 0 'link (car x)))) - (if link - (push (cons (car x) link) - idlwave-completion-help-links)))) - list)) + (mapc (lambda (x) ; Pass link prop through to highlight-linked + (let ((link (get-text-property 0 'link (car x)))) + (if link + (push (cons (car x) link) + idlwave-completion-help-links)))) + list)) (let* ((list all-completions) ;; "complete" means, this is already a valid completion (complete (memq spart all-completions)) @@ -7031,7 +7024,7 @@ sort the list before displaying" (select-window win) (eval idlwave-complete-after-success-form)) (set-window-start cwin (point-min))))) - (and message (message message))) + (and message (message "%s" message))) (select-window win)))) (defun idlwave-display-completion-list (list &optional message beg complete) @@ -7062,7 +7055,7 @@ sort the list before displaying" (run-hooks 'idlwave-completion-setup-hook) ;; Display the message - (message (or message "Making completion list...done"))) + (message "%s" (or message "Making completion list...done"))) (defun idlwave-choose (function &rest args) "Call FUNCTION as a completion chooser and pass ARGS to it." @@ -7551,7 +7544,7 @@ The list is cached in `idlwave-class-info' for faster access." If RECORD-LINK is non-nil, the keyword text is copied and a text property indicating the link is added." (let (kwds) - (mapcar + (mapc (lambda (key-list) (let ((file (car key-list))) (mapcar (lambda (key-cons) @@ -7599,6 +7592,7 @@ property indicating the link is added." (defvar idlwave-current-class-tags nil) (defvar idlwave-current-native-class-tags nil) (defvar idlwave-sint-class-tags nil) +(declare-function idlwave-sintern-class-tag "idlwave" t t) (idlwave-new-sintern-type 'class-tag) (add-to-list 'idlwave-complete-special 'idlwave-complete-class-structure-tag) (add-hook 'idlwave-update-rinfo-hook 'idlwave-class-tag-reset) @@ -7657,6 +7651,8 @@ property indicating the link is added." (defvar idlwave-sint-sysvars nil) (defvar idlwave-sint-sysvartags nil) +(declare-function idlwave-sintern-sysvar "idlwave" t t) +(declare-function idlwave-sintern-sysvartag "idlwave" t t) (idlwave-new-sintern-type 'sysvar) (idlwave-new-sintern-type 'sysvartag) (add-to-list 'idlwave-complete-special 'idlwave-complete-sysvar-or-tag) @@ -8277,8 +8273,8 @@ demand _EXTRA in the keyword list." (memq (nth 2 entry) super-classes) ; an inherited class (eq (nth 1 entry) type) ; correct type (eq (car entry) name) ; correct name - (mapcar (lambda (k) (add-to-list 'keywords k)) - (idlwave-entry-keywords entry 'do-link)))) + (mapc (lambda (k) (add-to-list 'keywords k)) + (idlwave-entry-keywords entry 'do-link)))) (setq keywords (idlwave-uniquify keywords))) ;; Return the final list @@ -8437,7 +8433,7 @@ If we do not know about MODULE, just return KEYWORD literally." (if (null keywords) (insert " No keywords accepted.") (setq col 9) - (mapcar + (mapc (lambda (x) (if (>= (+ col 1 (length (car x))) (window-width)) diff --git a/lisp/progmodes/meta-mode.el b/lisp/progmodes/meta-mode.el index d9177637d44..fe826358626 100644 --- a/lisp/progmodes/meta-mode.el +++ b/lisp/progmodes/meta-mode.el @@ -51,7 +51,7 @@ ;; these lines to your startup file: ;; ;; (add-hook 'meta-mode-load-hook -;; '(lambda () (require 'meta-buf))) +;; (lambda () (require 'meta-buf))) ;; ;; The add-on package loaded this way may in turn make use of the ;; mode-hooks provided in this package to activate additional features @@ -124,7 +124,7 @@ ;; ;; This package was begun on February 1, 1997, exactly 20 years after ;; the genesis of TeX took place according to Don Knuth's own account -;; (cf. ``The Errors of TeX'', reprinted in ``Literate Programming'', +;; (cf. ``The Errors of TeX'', reprinted in ``Literate Programming'', ;; Chapter 10, p. 249). What better date could there be to choose? ;; @@ -194,42 +194,42 @@ (list ;; embedded TeX code in btex ... etex (cons (concat "\\(btex\\|verbatimtex\\)" - "[ \t]+\\(.*\\)[ \t]+" + "[ \t\f]+\\(.*\\)[ \t\f]+" "\\(etex\\)") '((1 font-lock-keyword-face) (2 font-lock-string-face) (3 font-lock-keyword-face))) ;; unary macro definitions: def, vardef, let (cons (concat "\\<" macro-keywords-1 "\\>" - "[ \t]+\\(\\sw+\\|\\s_+\\|\\s.+\\)") + "[ \t\f]+\\(\\sw+\\|\\s_+\\|\\s.+\\)") '((1 font-lock-keyword-face) (2 font-lock-function-name-face))) ;; binary macro defintions: <leveldef> x operator y (cons (concat "\\<" macro-keywords-2 "\\>" - "[ \t]+\\(\\sw+\\)" - "[ \t]*\\(\\sw+\\|\\s.+\\)" - "[ \t]*\\(\\sw+\\)") + "[ \t\f]+\\(\\sw+\\)" + "[ \t\f]*\\(\\sw+\\|\\s.+\\)" + "[ \t\f]*\\(\\sw+\\)") '((1 font-lock-keyword-face) (2 font-lock-variable-name-face nil t) (3 font-lock-function-name-face nil t) (4 font-lock-variable-name-face nil t))) ;; variable declarations: numeric, pair, color, ... (cons (concat "\\<" type-keywords "\\>" - "\\([ \t]+\\(\\sw+\\)\\)*") + "\\([ \t\f]+\\(\\sw+\\)\\)*") '((1 font-lock-type-face) (font-lock-match-meta-declaration-item-and-skip-to-next (goto-char (match-end 1)) nil (1 font-lock-variable-name-face nil t)))) ;; argument declarations: expr, suffix, text, ... (cons (concat "\\<" args-keywords "\\>" - "\\([ \t]+\\(\\sw+\\|\\s_+\\)\\)*") + "\\([ \t\f]+\\(\\sw+\\|\\s_+\\)\\)*") '((1 font-lock-type-face) (font-lock-match-meta-declaration-item-and-skip-to-next (goto-char (match-end 1)) nil (1 font-lock-variable-name-face nil t)))) ;; special case of arguments: expr x of y - (cons (concat "\\(expr\\)[ \t]+\\(\\sw+\\)" - "[ \t]+\\(of\\)[ \t]+\\(\\sw+\\)") + (cons (concat "\\(expr\\)[ \t\f]+\\(\\sw+\\)" + "[ \t\f]+\\(of\\)[ \t\f]+\\(\\sw+\\)") '((1 font-lock-type-face) (2 font-lock-variable-name-face) (3 font-lock-keyword-face nil t) @@ -245,7 +245,7 @@ 'font-lock-keyword-face) ;; input, generate (cons (concat "\\<" input-keywords "\\>" - "[ \t]+\\(\\sw+\\)") + "[ \t\f]+\\(\\sw+\\)") '((1 font-lock-keyword-face) (2 font-lock-constant-face))) ;; embedded Metafont/MetaPost code in comments @@ -264,7 +264,7 @@ ;; `forward-sexp'. The list of items is expected to be separated ;; by commas and terminated by semicolons or equals signs. ;; - (if (looking-at "[ \t]*\\(\\sw+\\|\\s_+\\)") + (if (looking-at "[ \t\f]*\\(\\sw+\\|\\s_+\\)") (save-match-data (condition-case nil (save-restriction @@ -272,7 +272,7 @@ (narrow-to-region (point-min) limit) (goto-char (match-end 1)) ;; Move over any item value, etc., to the next item. - (while (not (looking-at "[ \t]*\\(\\(,\\)\\|;\\|=\\|$\\)")) + (while (not (looking-at "[ \t\f]*\\(\\(,\\)\\|;\\|=\\|$\\)")) (goto-char (or (scan-sexps (point) 1) (point-max)))) (goto-char (match-end 2))) (error t))))) @@ -586,7 +586,7 @@ If the list was changed, sort the list and remove duplicates first." (if (and meta-left-comment-regexp (looking-at meta-left-comment-regexp)) (current-column) - (skip-chars-backward "\t ") + (skip-chars-backward "\t\f ") (max (if (bolp) 0 (1+ (current-column))) comment-column))) @@ -605,14 +605,16 @@ If the list was changed, sort the list and remove duplicates first." (defun meta-indent-calculate () "Return the indentation of current line of Metafont or MetaPost source." + ;; Indentation within strings is not considered as Meta* don't allow multi + ;; line strings. (save-excursion (back-to-indentation) (cond - ;; Comments to the left margin. + ;; Comments to the left margin. ((and meta-left-comment-regexp (looking-at meta-left-comment-regexp)) 0) - ;; Comments to the right margin. + ;; Comments to the right margin. ((and meta-right-comment-regexp (looking-at meta-right-comment-regexp)) comment-column) @@ -620,42 +622,117 @@ If the list was changed, sort the list and remove duplicates first." ((and meta-ignore-comment-regexp (looking-at meta-ignore-comment-regexp)) (current-indentation)) + ;; Beginning of buffer. + ((eq (point-at-bol) (point-min)) + 0) ;; Backindent at end of environments. - ((looking-at + ((meta-indent-looking-at-code (concat "\\<" meta-end-environment-regexp "\\>")) - (- (meta-indent-calculate-last) meta-indent-level)) + (- (meta-indent-current-indentation) meta-indent-level)) ;; Backindent at keywords within environments. - ((looking-at + ((meta-indent-looking-at-code (concat "\\<" meta-within-environment-regexp "\\>")) - (- (meta-indent-calculate-last) meta-indent-level)) - (t (meta-indent-calculate-last))))) - -(defun meta-indent-calculate-last () - "Return the indentation of previous line of Metafont or MetaPost source." - (save-restriction - (widen) - (skip-chars-backward "\n\t ") - (move-to-column (current-indentation)) - ;; Ignore comments. - (while (and (looking-at comment-start) (not (bobp))) - (skip-chars-backward "\n\t ") - (if (not (bobp)) - (move-to-column (current-indentation)))) - (cond - ((bobp) 0) - (t (+ (current-indentation) - (meta-indent-level-count) - (cond - ;; Compensate for backindent at end of environments. - ((looking-at - (concat "\\<"meta-end-environment-regexp "\\>")) - meta-indent-level) - ;; Compensate for backindent within environments. - ((looking-at - (concat "\\<" meta-within-environment-regexp "\\>")) - meta-indent-level) - (t 0))))) - )) + (- (meta-indent-current-indentation) meta-indent-level)) + (t (meta-indent-current-indentation))))) + +(defun meta-indent-in-string-p () + "Tell if the point is in a string." + (or (nth 3 (syntax-ppss)) + (eq (get-text-property (point) 'face) font-lock-string-face))) + +(defun meta-indent-looking-at-code (regexp) + "Same as `looking-at' but checks that the point is not in a string." + (unless (meta-indent-in-string-p) + (looking-at regexp))) + +(defun meta-indent-previous-line () + "Go to the previous line of code, skipping comments." + (skip-chars-backward "\n\t\f ") + (move-to-column (current-indentation)) + ;; Ignore comments. + (while (and (looking-at comment-start) (not (bobp))) + (skip-chars-backward "\n\t\f ") + (when (not (bobp)) + (move-to-column (current-indentation))))) + +(defun meta-indent-unfinished-line () + "Tell if the current line of code ends with an unfinished expression." + (save-excursion + (end-of-line) + ;; Skip backward the comments. + (let ((point-not-in-string (point))) + (while (search-backward comment-start (point-at-bol) t) + (unless (meta-indent-in-string-p) + (setq point-not-in-string (point)))) + (goto-char point-not-in-string)) + ;; Search for the end of the previous expression. + (if (search-backward ";" (point-at-bol) t) + (progn (while (and (meta-indent-in-string-p) + (search-backward ";" (point-at-bol) t))) + (if (= (char-after) ?\;) + (forward-char) + (beginning-of-line))) + (beginning-of-line)) + ;; See if the last statement of the line is environment-related, + ;; or exists at all. + (if (meta-indent-looking-at-code + (concat "[ \t\f]*\\($\\|" (regexp-quote comment-start) + "\\|\\<" meta-end-environment-regexp "\\>" + "\\|\\<" meta-begin-environment-regexp "\\>" + "\\|\\<" meta-within-environment-regexp "\\>\\)")) + nil + t))) + +(defun meta-indent-current-indentation () + "Return the indentation wanted for the current line of code." + (+ (meta-indent-current-nesting) + (if (save-excursion + (back-to-indentation) + (and (not (looking-at (concat "\\<" meta-end-environment-regexp "\\>" + "\\|\\<" meta-within-environment-regexp "\\>"))) + (progn (meta-indent-previous-line) + (meta-indent-unfinished-line)))) + meta-indent-level + 0))) + +(defun meta-indent-current-nesting () + "Return the indentation according to the nearest environment keyword." + (save-excursion + (save-restriction + (widen) + (back-to-indentation) + (let ((to-add 0)) + ;; If we found some environment marker backward... + (if (catch 'found + (while (re-search-backward + (concat "(\\|)\\|\\<" meta-end-environment-regexp "\\>" + "\\|\\<" meta-begin-environment-regexp "\\>" + "\\|\\<" meta-within-environment-regexp "\\>") + nil t) + ;; If we aren't in a string or in a comment, we've found something. + (unless (or (meta-indent-in-string-p) + (nth 4 (syntax-ppss))) + (cond ((= (char-after) ?\() + (setq to-add (+ to-add meta-indent-level))) + ((= (char-after) ?\)) + (setq to-add (- to-add meta-indent-level))) + (t (throw 'found t)))))) + (progn + ;; ... then use it to compute the current indentation. + (back-to-indentation) + (+ to-add (current-indentation) (meta-indent-level-count) + ;; Compensate for backindent of end and within keywords. + (if (meta-indent-looking-at-code + (concat "\\<" meta-end-environment-regexp "\\>\\|" + "\\<" meta-within-environment-regexp "\\>")) + meta-indent-level + ;; Compensate for unfinished line. + (if (save-excursion + (meta-indent-previous-line) + (meta-indent-unfinished-line)) + (- meta-indent-level) + 0)))) + 0))))) (defun meta-indent-level-count () "Count indentation change for begin-end commands in the current line." @@ -671,18 +748,12 @@ If the list was changed, sort the list and remove duplicates first." (goto-char (match-beginning 0)) (cond ;; Count number of begin-end keywords within line. - ((looking-at + ((meta-indent-looking-at-code (concat "\\<" meta-begin-environment-regexp "\\>")) (setq count (+ count meta-indent-level))) - ((looking-at + ((meta-indent-looking-at-code (concat "\\<" meta-end-environment-regexp "\\>")) - (setq count (- count meta-indent-level))) - ;; Count number of open-close parentheses within line. - ((looking-at "(") - (setq count (+ count meta-indent-level))) - ((looking-at ")") - (setq count (- count meta-indent-level))) - ))) + (setq count (- count meta-indent-level)))))) count)))) @@ -715,7 +786,7 @@ Returns t unless search stops due to beginning or end of buffer." (concat "\\<" meta-begin-defun-regexp "\\>") nil t arg) (progn (goto-char (match-beginning 0)) (skip-chars-backward "%") - (skip-chars-backward " \t") t))) + (skip-chars-backward " \t\f") t))) (defun meta-end-of-defun (&optional arg) "Move forward to end of a defun in Metafont or MetaPost code. @@ -729,7 +800,7 @@ Returns t unless search stops due to beginning or end of buffer." (concat "\\<" meta-end-defun-regexp "\\>") nil t arg) (progn (goto-char (match-end 0)) (skip-chars-forward ";") - (skip-chars-forward " \t") + (skip-chars-forward " \t\f") (if (looking-at "\n") (forward-line 1)) t))) @@ -797,78 +868,74 @@ The environment marked is the one that contains point or follows point." "Abbrev table used in Metafont or MetaPost mode.") (define-abbrev-table 'meta-mode-abbrev-table ()) -(defvar meta-mode-syntax-table nil +(defvar meta-mode-syntax-table + (let ((st (make-syntax-table))) + ;; underscores are word constituents + (modify-syntax-entry ?_ "w" st) + ;; miscellaneous non-word symbols + (modify-syntax-entry ?# "_" st) + (modify-syntax-entry ?@ "_" st) + (modify-syntax-entry ?$ "_" st) + (modify-syntax-entry ?? "_" st) + (modify-syntax-entry ?! "_" st) + ;; binary operators + (modify-syntax-entry ?& "." st) + (modify-syntax-entry ?+ "." st) + (modify-syntax-entry ?- "." st) + (modify-syntax-entry ?/ "." st) + (modify-syntax-entry ?* "." st) + (modify-syntax-entry ?. "." st) + (modify-syntax-entry ?: "." st) + (modify-syntax-entry ?= "." st) + (modify-syntax-entry ?< "." st) + (modify-syntax-entry ?> "." st) + (modify-syntax-entry ?| "." st) + ;; opening and closing delimiters + (modify-syntax-entry ?\( "()" st) + (modify-syntax-entry ?\) ")(" st) + (modify-syntax-entry ?\[ "(]" st) + (modify-syntax-entry ?\] ")[" st) + (modify-syntax-entry ?\{ "(}" st) + (modify-syntax-entry ?\} "){" st) + ;; comment character + (modify-syntax-entry ?% "<" st) + (modify-syntax-entry ?\n ">" st) + ;; escape character, needed for embedded TeX code + (modify-syntax-entry ?\\ "\\" st) + st) "Syntax table used in Metafont or MetaPost mode.") -(if meta-mode-syntax-table - () - (setq meta-mode-syntax-table (make-syntax-table)) - ;; underscores are word constituents - (modify-syntax-entry ?_ "w" meta-mode-syntax-table) - ;; miscellaneous non-word symbols - (modify-syntax-entry ?# "_" meta-mode-syntax-table) - (modify-syntax-entry ?@ "_" meta-mode-syntax-table) - (modify-syntax-entry ?$ "_" meta-mode-syntax-table) - (modify-syntax-entry ?? "_" meta-mode-syntax-table) - (modify-syntax-entry ?! "_" meta-mode-syntax-table) - ;; binary operators - (modify-syntax-entry ?& "." meta-mode-syntax-table) - (modify-syntax-entry ?+ "." meta-mode-syntax-table) - (modify-syntax-entry ?- "." meta-mode-syntax-table) - (modify-syntax-entry ?/ "." meta-mode-syntax-table) - (modify-syntax-entry ?* "." meta-mode-syntax-table) - (modify-syntax-entry ?. "." meta-mode-syntax-table) - (modify-syntax-entry ?: "." meta-mode-syntax-table) - (modify-syntax-entry ?= "." meta-mode-syntax-table) - (modify-syntax-entry ?< "." meta-mode-syntax-table) - (modify-syntax-entry ?> "." meta-mode-syntax-table) - (modify-syntax-entry ?| "." meta-mode-syntax-table) - ;; opening and closing delimiters - (modify-syntax-entry ?\( "()" meta-mode-syntax-table) - (modify-syntax-entry ?\) ")(" meta-mode-syntax-table) - (modify-syntax-entry ?\[ "(]" meta-mode-syntax-table) - (modify-syntax-entry ?\] ")[" meta-mode-syntax-table) - (modify-syntax-entry ?\{ "(}" meta-mode-syntax-table) - (modify-syntax-entry ?\} "){" meta-mode-syntax-table) - ;; comment character - (modify-syntax-entry ?% "<" meta-mode-syntax-table) - (modify-syntax-entry ?\n ">" meta-mode-syntax-table) - ;; escape character, needed for embedded TeX code - (modify-syntax-entry ?\\ "\\" meta-mode-syntax-table) - ) -(defvar meta-mode-map nil +(defvar meta-mode-map + (let ((map (make-sparse-keymap))) + (define-key map "\C-m" 'reindent-then-newline-and-indent) + ;; Comment Paragraphs: + ;; (define-key map "\M-a" 'backward-sentence) + ;; (define-key map "\M-e" 'forward-sentence) + ;; (define-key map "\M-h" 'mark-paragraph) + ;; (define-key map "\M-q" 'fill-paragraph) + ;; Navigation: + (define-key map "\M-\C-a" 'meta-beginning-of-defun) + (define-key map "\M-\C-e" 'meta-end-of-defun) + (define-key map "\M-\C-h" 'meta-mark-defun) + ;; Indentation: + (define-key map "\M-\C-q" 'meta-indent-defun) + (define-key map "\C-c\C-qe" 'meta-indent-defun) + (define-key map "\C-c\C-qr" 'meta-indent-region) + (define-key map "\C-c\C-qb" 'meta-indent-buffer) + ;; Commenting Out: + (define-key map "\C-c%" 'meta-comment-defun) + ;; (define-key map "\C-uC-c%" 'meta-uncomment-defun) + (define-key map "\C-c;" 'meta-comment-region) + (define-key map "\C-c:" 'meta-uncomment-region) + ;; Symbol Completion: + (define-key map "\M-\t" 'meta-complete-symbol) + ;; Shell Commands: + ;; (define-key map "\C-c\C-c" 'meta-command-file) + ;; (define-key map "\C-c\C-k" 'meta-kill-job) + ;; (define-key map "\C-c\C-l" 'meta-recenter-output) + map) "Keymap used in Metafont or MetaPost mode.") -(if meta-mode-map - () - (setq meta-mode-map (make-sparse-keymap)) - (define-key meta-mode-map "\t" 'meta-indent-line) - (define-key meta-mode-map "\C-m" 'reindent-then-newline-and-indent) - ;; Comment Paragraphs: -; (define-key meta-mode-map "\M-a" 'backward-sentence) -; (define-key meta-mode-map "\M-e" 'forward-sentence) -; (define-key meta-mode-map "\M-h" 'mark-paragraph) -; (define-key meta-mode-map "\M-q" 'fill-paragraph) - ;; Navigation: - (define-key meta-mode-map "\M-\C-a" 'meta-beginning-of-defun) - (define-key meta-mode-map "\M-\C-e" 'meta-end-of-defun) - (define-key meta-mode-map "\M-\C-h" 'meta-mark-defun) - ;; Indentation: - (define-key meta-mode-map "\M-\C-q" 'meta-indent-defun) - (define-key meta-mode-map "\C-c\C-qe" 'meta-indent-defun) - (define-key meta-mode-map "\C-c\C-qr" 'meta-indent-region) - (define-key meta-mode-map "\C-c\C-qb" 'meta-indent-buffer) - ;; Commenting Out: - (define-key meta-mode-map "\C-c%" 'meta-comment-defun) -; (define-key meta-mode-map "\C-uC-c%" 'meta-uncomment-defun) - (define-key meta-mode-map "\C-c;" 'meta-comment-region) - (define-key meta-mode-map "\C-c:" 'meta-uncomment-region) - ;; Symbol Completion: - (define-key meta-mode-map "\M-\t" 'meta-complete-symbol) - ;; Shell Commands: -; (define-key meta-mode-map "\C-c\C-c" 'meta-command-file) -; (define-key meta-mode-map "\C-c\C-k" 'meta-kill-job) -; (define-key meta-mode-map "\C-c\C-l" 'meta-recenter-output) - ) + (easy-menu-define meta-mode-menu meta-mode-map @@ -947,11 +1014,14 @@ The environment marked is the one that contains point or follows point." (make-local-variable 'comment-start) (make-local-variable 'comment-end) (make-local-variable 'comment-multi-line) - (setq comment-start-skip "%+[ \t]*") + (setq comment-start-skip "%+[ \t\f]*") (setq comment-start "%") (setq comment-end "") (setq comment-multi-line nil) + ;; We use `back-to-indentation' but \f is no indentation sign. + (modify-syntax-entry ?\f "_ ") + (make-local-variable 'parse-sexp-ignore-comments) (setq parse-sexp-ignore-comments t) @@ -1033,5 +1103,5 @@ Turning on MetaPost mode calls the value of the variable (provide 'meta-mode) (run-hooks 'meta-mode-load-hook) -;;; arch-tag: ec2916b2-3a83-4cf7-962d-d8019370c006 +;; arch-tag: ec2916b2-3a83-4cf7-962d-d8019370c006 ;;; meta-mode.el ends here diff --git a/lisp/progmodes/mixal-mode.el b/lisp/progmodes/mixal-mode.el index 7d727ff0788..75e6bb52d37 100644 --- a/lisp/progmodes/mixal-mode.el +++ b/lisp/progmodes/mixal-mode.el @@ -1091,15 +1091,19 @@ EXECUTION-TIME holds info about the time it takes, number or string.") (defun mixal-run () "Run mixal file in current buffer, assumes that file has been compiled." (interactive) - (mixvm (concat "mixvm -r -t -d " - (file-name-sans-extension (buffer-file-name))))) + (if (fboundp 'mixvm) + (mixvm (concat "mixvm -r -t -d " + (file-name-sans-extension (buffer-file-name)))) + (error "mixvm.el needs to be loaded to run `mixvm'"))) (defun mixal-debug () "Start mixvm for debugging. Assumes that file has been compiled with debugging support." (interactive) - (mixvm (concat "mixvm " - (file-name-sans-extension (buffer-file-name))))) + (if (fboundp 'mixvm) + (mixvm (concat "mixvm " + (file-name-sans-extension (buffer-file-name)))) + (error "mixvm.el needs to be loaded to run `mixvm'"))) ;;;###autoload (define-derived-mode mixal-mode fundamental-mode "mixal" diff --git a/lisp/progmodes/octave-mod.el b/lisp/progmodes/octave-mod.el index 119dfc9527f..2619c48bf11 100644 --- a/lisp/progmodes/octave-mod.el +++ b/lisp/progmodes/octave-mod.el @@ -52,6 +52,8 @@ (defvar inferior-octave-output-string nil) (defvar inferior-octave-receive-in-progress nil) +(declare-function inferior-octave-send-list-and-digest "octave-inf" (list)) + (defconst octave-maintainer-address "Kurt Hornik <Kurt.Hornik@wu-wien.ac.at>, bug-gnu-emacs@gnu.org" "Current maintainer of the Emacs Octave package.") @@ -63,7 +65,7 @@ All Octave abbrevs start with a grave accent (`).") (unless octave-abbrev-table (define-abbrev-table 'octave-abbrev-table ())) -(let ((ac abbrevs-changed)) +(let ((abbrevs-changed abbrevs-changed)) (define-abbrev octave-abbrev-table "`a" "all_va_args" nil 0 t) (define-abbrev octave-abbrev-table "`b" "break" nil 0 t) (define-abbrev octave-abbrev-table "`cs" "case" nil 0 t) @@ -89,10 +91,10 @@ All Octave abbrevs start with a grave accent (`).") (define-abbrev octave-abbrev-table "`r" "return" nil 0 t) (define-abbrev octave-abbrev-table "`s" "switch" nil 0 t) (define-abbrev octave-abbrev-table "`t" "try" nil 0 t) + (define-abbrev octave-abbrev-table "`u" "until ()" nil 0 t) (define-abbrev octave-abbrev-table "`up" "unwind_protect" nil 0 t) (define-abbrev octave-abbrev-table "`upc" "unwind_protect_cleanup" nil 0 t) - (define-abbrev octave-abbrev-table "`w" "while ()" nil 0 t) - (setq abbrevs-changed ac)) + (define-abbrev octave-abbrev-table "`w" "while ()" nil 0 t)) (defvar octave-comment-char ?# "Character to start an Octave comment.") @@ -103,32 +105,34 @@ All Octave abbrevs start with a grave accent (`).") "Regexp to match the start of an Octave comment up to its body.") (defvar octave-begin-keywords - '("for" "function" "if" "switch" "try" "unwind_protect" "while")) + '("do" "for" "function" "if" "switch" "try" "unwind_protect" "while")) (defvar octave-else-keywords '("case" "catch" "else" "elseif" "otherwise" "unwind_protect_cleanup")) +;; FIXME: only use specific "end" tokens here to avoid confusion when "end" +;; is used in indexing (the real fix is much more complex). (defvar octave-end-keywords - '("end" "endfor" "endfunction" "endif" "endswitch" "end_try_catch" - "end_unwind_protect" "endwhile")) + '("endfor" "endfunction" "endif" "endswitch" "end_try_catch" + "end_unwind_protect" "endwhile" "until")) (defvar octave-reserved-words (append octave-begin-keywords octave-else-keywords octave-end-keywords - '("all_va_args" "break" "continue" "global" "gplot" "gsplot" - "replot" "return")) + '("break" "continue" "end" "global" "persistent" "return")) "Reserved words in Octave.") (defvar octave-text-functions '("casesen" "cd" "chdir" "clear" "diary" "dir" "document" "echo" - "edit_history" "format" "gset" "gshow" "help" "history" "hold" - "load" "ls" "more" "run_history" "save" "set" "show" "type" + "edit_history" "format" "help" "history" "hold" + "load" "ls" "more" "run_history" "save" "type" "which" "who" "whos") - "Text functions in Octave (these names are also reserved).") + "Text functions in Octave.") (defvar octave-variables - '("EDITOR" "EXEC_PATH" "F_DUPFD" "F_GETFD" "F_GETFL" "F_SETFD" - "F_SETFL" "I" "IMAGEPATH" "INFO_FILE" "INFO_PROGRAM" "Inf" "J" - "LOADPATH" "NaN" "OCTAVE_VERSION" "O_APPEND" "O_CREAT" "O_EXCL" + '("DEFAULT_EXEC_PATH" "DEFAULT_LOADPATH" + "EDITOR" "EXEC_PATH" "F_DUPFD" "F_GETFD" "F_GETFL" "F_SETFD" + "F_SETFL" "I" "IMAGE_PATH" "Inf" "J" + "NaN" "OCTAVE_VERSION" "O_APPEND" "O_CREAT" "O_EXCL" "O_NONBLOCK" "O_RDONLY" "O_RDWR" "O_TRUNC" "O_WRONLY" "PAGER" "PS1" "PS2" "PS4" "PWD" "SEEK_CUR" "SEEK_END" "SEEK_SET" "__F_DUPFD__" "__F_GETFD__" "__F_GETFL__" "__F_SETFD__" "__F_SETFL__" "__I__" @@ -136,29 +140,23 @@ All Octave abbrevs start with a grave accent (`).") "__O_CREAT__" "__O_EXCL__" "__O_NONBLOCK__" "__O_RDONLY__" "__O_RDWR__" "__O_TRUNC__" "__O_WRONLY__" "__PWD__" "__SEEK_CUR__" "__SEEK_END__" "__SEEK_SET__" "__argv__" "__e__" "__eps__" - "__error_text__" "__i__" "__inf__" "__j__" "__nan__" "__pi__" + "__i__" "__inf__" "__j__" "__nan__" "__pi__" "__program_invocation_name__" "__program_name__" "__realmax__" "__realmin__" "__stderr__" "__stdin__" "__stdout__" "ans" "argv" - "automatic_replot" "beep_on_error" "completion_append_char" - "default_return_value" "default_save_format" - "define_all_return_values" "do_fortran_indexing" "e" - "echo_executing_commands" "empty_list_elements_ok" "eps" - "error_text" "gnuplot_binary" "gnuplot_has_multiplot" "history_file" - "history_size" "ignore_function_time_stamp" "implicit_str_to_num_ok" - "inf" "nan" "nargin" "ok_to_lose_imaginary_part" - "output_max_field_width" "output_precision" + "beep_on_error" "completion_append_char" + "crash_dumps_octave_core" "default_save_format" + "e" "echo_executing_commands" "eps" + "error_text" "gnuplot_binary" "history_file" + "history_size" "ignore_function_time_stamp" + "inf" "nan" "nargin" "output_max_field_width" "output_precision" "page_output_immediately" "page_screen_output" "pi" - "prefer_column_vectors" "prefer_zero_one_indexing" "print_answer_id_name" "print_empty_dimensions" - "program_invocation_name" "program_name" "propagate_empty_matrices" - "realmax" "realmin" "resize_on_range_error" - "return_last_computed_value" "save_precision" "saving_history" + "program_invocation_name" "program_name" + "realmax" "realmin" "return_last_computed_value" "save_precision" + "saving_history" "sighup_dumps_octave_core" "sigterm_dumps_octave_core" "silent_functions" "split_long_rows" "stderr" "stdin" "stdout" "string_fill_char" "struct_levels_to_print" - "suppress_verbose_help_message" "treat_neg_dim_as_zero" - "warn_assign_as_truth_value" "warn_comma_in_global_decl" - "warn_divide_by_zero" "warn_function_name_clash" - "warn_missing_semicolon" "whitespace_in_literal_matrix") + "suppress_verbose_help_message") "Builtin variables in Octave.") (defvar octave-function-header-regexp @@ -193,22 +191,18 @@ parenthetical grouping.") "Additional Octave expressions to highlight.") (defcustom inferior-octave-buffer "*Inferior Octave*" - "*Name of buffer for running an inferior Octave process." + "Name of buffer for running an inferior Octave process." :type 'string :group 'octave-inferior) (defvar inferior-octave-process nil) -(defvar octave-mode-map nil - "Keymap used in Octave mode.") -(if octave-mode-map - () +(defvar octave-mode-map (let ((map (make-sparse-keymap))) (define-key map "`" 'octave-abbrev-start) (define-key map ";" 'octave-electric-semi) (define-key map " " 'octave-electric-space) (define-key map "\n" 'octave-reindent-then-newline-and-indent) - (define-key map "\t" 'indent-according-to-mode) (define-key map "\e;" 'octave-indent-for-comment) (define-key map "\e\n" 'octave-indent-new-comment-line) (define-key map "\e\t" 'octave-complete-symbol) @@ -245,49 +239,51 @@ parenthetical grouping.") (define-key map "\C-c\C-i\C-s" 'octave-show-process-buffer) (define-key map "\C-c\C-i\C-h" 'octave-hide-process-buffer) (define-key map "\C-c\C-i\C-k" 'octave-kill-process) - (setq octave-mode-map map))) + map) + "Keymap used in Octave mode.") + (defvar octave-mode-menu - (list "Octave" - (list "Lines" - ["Previous Code Line" octave-previous-code-line t] - ["Next Code Line" octave-next-code-line t] - ["Begin of Continuation" octave-beginning-of-line t] - ["End of Continuation" octave-end-of-line t] - ["Split Line at Point" octave-indent-new-comment-line t]) - (list "Blocks" - ["Next Block" octave-forward-block t] - ["Previous Block" octave-backward-block t] - ["Down Block" octave-down-block t] - ["Up Block" octave-backward-up-block t] - ["Mark Block" octave-mark-block t] - ["Close Block" octave-close-block t]) - (list "Functions" - ["Begin of Function" octave-beginning-of-defun t] - ["End of Function" octave-end-of-defun t] - ["Mark Function" octave-mark-defun t] - ["Indent Function" octave-indent-defun t] - ["Insert Function" octave-insert-defun t]) - "-" - (list "Debug" - ["Send Current Line" octave-send-line t] - ["Send Current Block" octave-send-block t] - ["Send Current Function" octave-send-defun t] - ["Send Region" octave-send-region t] - ["Show Process Buffer" octave-show-process-buffer t] - ["Hide Process Buffer" octave-hide-process-buffer t] - ["Kill Process" octave-kill-process t]) - "-" - ["Indent Line" indent-according-to-mode t] - ["Complete Symbol" octave-complete-symbol t] - "-" - ["Toggle Abbrev Mode" abbrev-mode t] - ["Toggle Auto-Fill Mode" auto-fill-mode t] - "-" - ["Submit Bug Report" octave-submit-bug-report t] - "-" - ["Describe Octave Mode" octave-describe-major-mode t] - ["Lookup Octave Index" octave-help t]) + '("Octave" + '("Lines" + ["Previous Code Line" octave-previous-code-line t] + ["Next Code Line" octave-next-code-line t] + ["Begin of Continuation" octave-beginning-of-line t] + ["End of Continuation" octave-end-of-line t] + ["Split Line at Point" octave-indent-new-comment-line t]) + '("Blocks" + ["Next Block" octave-forward-block t] + ["Previous Block" octave-backward-block t] + ["Down Block" octave-down-block t] + ["Up Block" octave-backward-up-block t] + ["Mark Block" octave-mark-block t] + ["Close Block" octave-close-block t]) + '("Functions" + ["Begin of Function" octave-beginning-of-defun t] + ["End of Function" octave-end-of-defun t] + ["Mark Function" octave-mark-defun t] + ["Indent Function" octave-indent-defun t] + ["Insert Function" octave-insert-defun t]) + "-" + '("Debug" + ["Send Current Line" octave-send-line t] + ["Send Current Block" octave-send-block t] + ["Send Current Function" octave-send-defun t] + ["Send Region" octave-send-region t] + ["Show Process Buffer" octave-show-process-buffer t] + ["Hide Process Buffer" octave-hide-process-buffer t] + ["Kill Process" octave-kill-process t]) + "-" + ["Indent Line" indent-according-to-mode t] + ["Complete Symbol" octave-complete-symbol t] + "-" + ["Toggle Abbrev Mode" abbrev-mode t] + ["Toggle Auto-Fill Mode" auto-fill-mode t] + "-" + ["Submit Bug Report" octave-submit-bug-report t] + "-" + ["Describe Octave Mode" octave-describe-major-mode t] + ["Lookup Octave Index" octave-help t]) "Menu for Octave mode.") (defvar octave-mode-syntax-table @@ -316,23 +312,23 @@ parenthetical grouping.") "Syntax table in use in `octave-mode' buffers.") (defcustom octave-auto-indent nil - "*Non-nil means indent line after a semicolon or space in Octave mode." + "Non-nil means indent line after a semicolon or space in Octave mode." :type 'boolean :group 'octave) (defcustom octave-auto-newline nil - "*Non-nil means automatically newline after a semicolon in Octave mode." + "Non-nil means automatically newline after a semicolon in Octave mode." :type 'boolean :group 'octave) (defcustom octave-blink-matching-block t - "*Control the blinking of matching Octave block keywords. + "Control the blinking of matching Octave block keywords. Non-nil means show matching begin of block when inserting a space, newline or semicolon after an else or end keyword." :type 'boolean :group 'octave) (defcustom octave-block-offset 2 - "*Extra indentation applied to statements in Octave block structures." + "Extra indentation applied to statements in Octave block structures." :type 'integer :group 'octave) @@ -352,15 +348,17 @@ newline or semicolon after an else or end keyword." (concat octave-block-begin-regexp "\\|" octave-block-end-regexp)) (defvar octave-block-else-or-end-regexp (concat octave-block-else-regexp "\\|" octave-block-end-regexp)) +;; FIXME: only use specific "end" tokens here to avoid confusion when "end" +;; is used in indexing (the real fix is much more complex). (defvar octave-block-match-alist - '(("for" . ("end" "endfor")) - ("function" . ("end" "endfunction")) - ("if" . ("else" "elseif" "end" "endif")) - ("switch" . ("case" "otherwise" "end" "endswitch")) - ("try" . ("catch" "end" "end_try_catch")) - ("unwind_protect" . ("unwind_protect_cleanup" "end" - "end_unwind_protect")) - ("while" . ("end" "endwhile"))) + '(("do" . ("until")) + ("for" . ("endfor")) + ("function" . ("endfunction")) + ("if" . ("else" "elseif" "endif")) + ("switch" . ("case" "otherwise" "endswitch")) + ("try" . ("catch" "end_try_catch")) + ("unwind_protect" . ("unwind_protect_cleanup" "end_unwind_protect")) + ("while" . ("endwhile"))) "Alist with Octave's matching block keywords. Has Octave's begin keywords as keys and a list of the matching else or end keywords as associated values.") @@ -370,13 +368,13 @@ end keywords as associated values.") "String to insert to start a new Octave comment on an empty line.") (defcustom octave-continuation-offset 4 - "*Extra indentation applied to Octave continuation lines." + "Extra indentation applied to Octave continuation lines." :type 'integer :group 'octave) (defvar octave-continuation-regexp "[^#%\n]*\\(\\\\\\|\\.\\.\\.\\)\\s-*\\(\\s<.*\\)?$") (defcustom octave-continuation-string "\\" - "*Character string used for Octave continuation lines. Normally \\." + "Character string used for Octave continuation lines. Normally \\." :type 'string :group 'octave) @@ -392,27 +390,22 @@ Currently, only builtin variables can be completed.") (list nil octave-function-header-regexp 3)) "Imenu expression for Octave mode. See `imenu-generic-expression'.") -(defcustom octave-mode-startup-message t - "*nil means do not display the Octave mode startup message." - :type 'boolean - :group 'octave) - (defcustom octave-mode-hook nil - "*Hook to be run when Octave mode is started." + "Hook to be run when Octave mode is started." :type 'hook :group 'octave) (defcustom octave-send-show-buffer t - "*Non-nil means display `inferior-octave-buffer' after sending to it." + "Non-nil means display `inferior-octave-buffer' after sending to it." :type 'boolean :group 'octave) (defcustom octave-send-line-auto-forward t - "*Control auto-forward after sending to the inferior Octave process. + "Control auto-forward after sending to the inferior Octave process. Non-nil means always go to the next Octave code line after sending." :type 'boolean :group 'octave) (defcustom octave-send-echo-input t - "*Non-nil means echo input sent to the inferior Octave process." + "Non-nil means echo input sent to the inferior Octave process." :type 'boolean :group 'octave) @@ -423,7 +416,7 @@ Non-nil means always go to the next Octave code line after sending." This mode makes it easier to write Octave code by helping with indentation, doing some of the typing for you (with Abbrev mode) and by -showing keywords, comments, strings, etc. in different faces (with +showing keywords, comments, strings, etc.. in different faces (with Font Lock mode on terminals that support it). Octave itself is a high-level language, primarily intended for numerical @@ -433,7 +426,7 @@ can also be stored in files, and it can be used in a batch mode (which is why you need this mode!). The latest released version of Octave is always available via anonymous -ftp from bevo.che.wisc.edu in the directory `/pub/octave'. Complete +ftp from ftp.octave.org in the directory `/pub/octave'. Complete source and binaries for several popular systems are available. Type \\[list-abbrevs] to display the built-in abbrevs for Octave keywords. @@ -446,43 +439,39 @@ Keybindings Variables you can use to customize Octave mode ============================================== -octave-auto-indent +`octave-auto-indent' Non-nil means indent current line after a semicolon or space. Default is nil. -octave-auto-newline +`octave-auto-newline' Non-nil means auto-insert a newline and indent after a semicolon. Default is nil. -octave-blink-matching-block +`octave-blink-matching-block' Non-nil means show matching begin of block when inserting a space, newline or semicolon after an else or end keyword. Default is t. -octave-block-offset +`octave-block-offset' Extra indentation applied to statements in block structures. Default is 2. -octave-continuation-offset +`octave-continuation-offset' Extra indentation applied to Octave continuation lines. Default is 4. -octave-continuation-string +`octave-continuation-string' String used for Octave continuation lines. Default is a backslash. -octave-mode-startup-message - nil means do not display the Octave mode startup message. - Default is t. - -octave-send-echo-input +`octave-send-echo-input' Non-nil means always display `inferior-octave-buffer' after sending a command to the inferior Octave process. -octave-send-line-auto-forward +`octave-send-line-auto-forward' Non-nil means always go to the next unsent line of Octave code after sending a line to the inferior Octave process. -octave-send-echo-input +`octave-send-echo-input' Non-nil means echo input sent to the inferior Octave process. Turning on Octave mode runs the hook `octave-mode-hook'. @@ -490,19 +479,15 @@ Turning on Octave mode runs the hook `octave-mode-hook'. To begin using this mode for all `.m' files that you edit, add the following lines to your `.emacs' file: - (autoload 'octave-mode \"octave-mod\" nil t) - (setq auto-mode-alist - (cons '(\"\\\\.m$\" . octave-mode) auto-mode-alist)) + (add-to-list 'auto-mode-alist '(\"\\\\.m\\\\'\" . octave-mode)) -To automatically turn on the abbrev, auto-fill and font-lock features, +To automatically turn on the abbrev and auto-fill features, add the following lines to your `.emacs' file as well: (add-hook 'octave-mode-hook (lambda () (abbrev-mode 1) - (auto-fill-mode 1) - (if (eq window-system 'x) - (font-lock-mode 1)))) + (auto-fill-mode 1))) To submit a problem report, enter \\[octave-submit-bug-report] from \ an Octave mode buffer. @@ -638,9 +623,6 @@ the end keyword." (delete-horizontal-space) (insert (concat " " octave-continuation-string)))) -(defvar octave-xemacs-p - (string-match "XEmacs\\|Lucid" emacs-version)) - ;;; Comments (defun octave-comment-region (beg end &optional arg) "Comment or uncomment each line in the region as Octave code. @@ -788,7 +770,7 @@ The new line is properly indented." (octave-reindent-then-newline-and-indent)))) (defun octave-indent-defun () - "Properly indents the Octave function which contains point." + "Properly indent the Octave function which contains point." (interactive) (save-excursion (octave-mark-defun) @@ -871,8 +853,8 @@ does not end in `...' or `\\' or is inside an open parenthesis list." (zerop (forward-line 1))))) (end-of-line))) -(defun octave-scan-blocks (from count depth) - "Scan from character number FROM by COUNT Octave begin-end blocks. +(defun octave-scan-blocks (count depth) + "Scan from point by COUNT Octave begin-end blocks. Returns the character number of the position thus found. If DEPTH is nonzero, block depth begins counting from that value. @@ -910,7 +892,7 @@ With argument, do it that many times. Negative arg -N means move backward across N blocks." (interactive "p") (or arg (setq arg 1)) - (goto-char (or (octave-scan-blocks (point) arg 0) (buffer-end arg)))) + (goto-char (or (octave-scan-blocks arg 0) (buffer-end arg)))) (defun octave-backward-block (&optional arg) "Move backward across one balanced Octave begin-end block. @@ -928,7 +910,7 @@ In Lisp programs, an argument is required." (interactive "p") (let ((inc (if (> arg 0) 1 -1))) (while (/= arg 0) - (goto-char (or (octave-scan-blocks (point) inc -1) + (goto-char (or (octave-scan-blocks inc -1) (buffer-end arg))) (setq arg (- arg inc))))) @@ -948,7 +930,7 @@ In Lisp programs, an argument is required." (interactive "p") (let ((inc (if (> arg 0) 1 -1))) (while (/= arg 0) - (goto-char (or (octave-scan-blocks (point) inc 1) + (goto-char (or (octave-scan-blocks inc 1) (buffer-end arg))) (setq arg (- arg inc))))) @@ -1164,6 +1146,8 @@ otherwise." (defun octave-fill-paragraph (&optional arg) "Fill paragraph of Octave code, handling Octave comments." + ;; FIXME: now that the default fill-paragraph takes care of similar issues, + ;; this seems obsolete. --Stef (interactive "P") (save-excursion (let ((end (progn (forward-paragraph) (point))) @@ -1356,7 +1340,7 @@ Note that all Octave mode abbrevs start with a grave accent." (self-insert-command 1) (let (c) (insert last-command-char) - (if (if octave-xemacs-p + (if (if (featurep 'xemacs) (or (eq (event-to-character (setq c (next-event))) ??) (eq (event-to-character c) help-char)) (or (eq (setq c (read-event)) ??) @@ -1404,7 +1388,7 @@ entered without parens)." ;;; Menu (defun octave-add-octave-menu () - "Adds the `Octave' menu to the menu bar in Octave mode." + "Add the `Octave' menu to the menu bar in Octave mode." (require 'easymenu) (easy-menu-define octave-mode-menu-map octave-mode-map "Menu keymap for Octave mode." octave-mode-menu) @@ -1534,7 +1518,6 @@ code line." 'octave-continuation-offset 'octave-continuation-string 'octave-help-files - 'octave-mode-startup-message 'octave-send-echo-input 'octave-send-line-auto-forward 'octave-send-show-buffer)))) @@ -1543,5 +1526,5 @@ code line." (provide 'octave-mod) -;;; arch-tag: 05f1ce09-be87-4c00-803e-4919ffa26c23 +;; arch-tag: 05f1ce09-be87-4c00-803e-4919ffa26c23 ;;; octave-mod.el ends here diff --git a/lisp/progmodes/prolog.el b/lisp/progmodes/prolog.el index d759ec7df8d..2ad1ee2b653 100644 --- a/lisp/progmodes/prolog.el +++ b/lisp/progmodes/prolog.el @@ -32,7 +32,7 @@ ;;; Code: (defvar comint-prompt-regexp) - +(defvar comint-process-echoes) (defgroup prolog nil "Major mode for editing and running Prolog under Emacs." @@ -240,6 +240,11 @@ rigidly along with this one (not yet)." (defvar inferior-prolog-mode-syntax-table prolog-mode-syntax-table) (defvar inferior-prolog-mode-abbrev-table prolog-mode-abbrev-table) +(declare-function comint-mode "comint") +(declare-function comint-send-string "comint" (process string)) +(declare-function comint-send-region "comint" (process start end)) +(declare-function comint-send-eof "comint" ()) + (define-derived-mode inferior-prolog-mode comint-mode "Inferior Prolog" "Major mode for interacting with an inferior Prolog process. @@ -269,6 +274,12 @@ Return not at end copies rest of line to end and sends it. (defvar inferior-prolog-buffer nil) +(defvar inferior-prolog-flavor 'unknown + "Either a symbol or a buffer position offset by one. +If a buffer position, the flavor has not been determined yet and +it is expected that the process's output has been or will +be inserted at that position plus one.") + (defun inferior-prolog-run (&optional name) (with-current-buffer (make-comint "prolog" (or name prolog-program-name)) (inferior-prolog-mode) @@ -302,12 +313,6 @@ Return not at end copies rest of line to end and sends it. ;; Try again. (inferior-prolog-process)))) -(defvar inferior-prolog-flavor 'unknown - "Either a symbol or a buffer position offset by one. -If a buffer position, the flavor has not been determined yet and -it is expected that the process's output has been or will -be inserted at that position plus one.") - (defun inferior-prolog-guess-flavor (&optional ignored) (save-excursion (goto-char (1+ inferior-prolog-flavor)) diff --git a/lisp/progmodes/ps-mode.el b/lisp/progmodes/ps-mode.el index ea0683a1633..02c81f46ff3 100644 --- a/lisp/progmodes/ps-mode.el +++ b/lisp/progmodes/ps-mode.el @@ -109,7 +109,7 @@ When the figure is finished these values should be replaced." (defcustom ps-mode-print-function (lambda () (let ((lpr-switches nil) - (lpr-command (if (memq system-type '(usg-unix-v dgux hpux irix)) + (lpr-command (if (memq system-type '(usg-unix-v hpux irix)) "lp" "lpr"))) (lpr-buffer))) "*Lisp function to print current buffer as PostScript." @@ -418,7 +418,7 @@ If nil, the following are tried in turn, until success: (define-key ps-mode-map "\C-c\C-o" 'ps-mode-comment-out-region) (define-key ps-mode-map "\C-c\C-k" 'ps-run-kill) (define-key ps-mode-map "\C-c\C-j" 'ps-mode-other-newline) - (define-key ps-mode-map "\C-c\C-c" 'ps-run-clear) + (define-key ps-mode-map "\C-c\C-l" 'ps-run-clear) (define-key ps-mode-map "\C-c\C-b" 'ps-run-buffer) (define-key ps-mode-map ">" 'ps-mode-r-gt) (define-key ps-mode-map "]" 'ps-mode-r-angle) @@ -480,6 +480,9 @@ If nil, the following are tried in turn, until success: (setq i (1+ i))))) + +(declare-function doc-view-minor-mode "doc-view") + ;; PostScript mode. ;;;###autoload @@ -529,7 +532,10 @@ Typing \\<ps-run-mode-map>\\[ps-run-goto-error] when the cursor is at the number t)) (set (make-local-variable 'comment-start) "%") ;; NOTE: `\' has a special meaning in strings only - (set (make-local-variable 'comment-start-skip) "%+[ \t]*")) + (set (make-local-variable 'comment-start-skip) "%+[ \t]*") + ;; enable doc-view-minor-mode => C-c C-c starts viewing the current ps file + ;; with doc-view-mode. + (doc-view-minor-mode 1)) (defun ps-mode-show-version () "Show current version of PostScript mode." diff --git a/lisp/progmodes/python.el b/lisp/progmodes/python.el index 18494681a9d..bef282f5e98 100644 --- a/lisp/progmodes/python.el +++ b/lisp/progmodes/python.el @@ -65,7 +65,6 @@ ;;; Code: (eval-when-compile - (require 'cl) (require 'compile) (require 'comint) (require 'hippie-exp)) @@ -885,10 +884,13 @@ On a comment line, go to end of line." nil) ((eq 'string (syntax-ppss-context s)) ;; Go to start of string and skip it. - (goto-char (nth 8 s)) - (condition-case () ; beware invalid syntax - (progn (forward-sexp) t) - (error (end-of-line)))) + (let ((pos (point))) + (goto-char (nth 8 s)) + (condition-case () ; beware invalid syntax + (progn (forward-sexp) t) + ;; If there's a mismatched string, make sure + ;; we still overall move *forward*. + (error (goto-char pos) (end-of-line))))) ((python-skip-out t s)))) (end-of-line)) (unless comment @@ -983,15 +985,11 @@ don't move and return nil. Otherwise return t." (_ (if (python-comment-line-p) (python-skip-comments/blanks t))) (ci (current-indentation)) - (open (python-open-block-statement-p)) - opoint) + (open (python-open-block-statement-p))) (if (and (zerop ci) (not open)) (not (goto-char point)) (catch 'done - (setq opoint (point)) - (while (and (zerop (python-next-statement)) - (not (= opoint (point)))) - (setq opoint (point)) + (while (zerop (python-next-statement)) (when (or (and open (<= (current-indentation) ci)) (< (current-indentation) ci)) (python-skip-comments/blanks t) @@ -999,7 +997,16 @@ don't move and return nil. Otherwise return t." (throw 'done t))))))) (setq arg (1- arg))) (zerop arg))) - + +(defvar python-which-func-length-limit 40 + "Non-strict length limit for `python-which-func' output.") + +(defun python-which-func () + (let ((function-name (python-current-defun python-which-func-length-limit))) + (set-text-properties 0 (length function-name) nil function-name) + function-name)) + + ;;;; Imenu. (defvar python-recursing) @@ -1216,6 +1223,9 @@ local value.") ;; (modify-syntax-entry ?\" "." st) st)) +;; Autoloaded. +(declare-function compilation-shell-minor-mode "compile" (&optional arg)) + ;; Fixme: This should inherit some stuff from `python-mode', but I'm ;; not sure how much: at least some keybindings, like C-c C-f; ;; syntax?; font-locking, e.g. for triple-quoted strings? @@ -1375,7 +1385,7 @@ buffer for a list of commands.)" ;; seems worth putting in a separate file, and it's probably cleaner ;; to put it in a module. ;; Ensure we're at a prompt before doing anything else. - (python-send-receive "import emacs; print '_emacs_out ()'"))) + (python-send-string "import emacs"))) (if (derived-mode-p 'python-mode) (setq python-buffer (default-value 'python-buffer))) ; buffer-local ;; Without this, help output goes into the inferior python buffer if @@ -1648,6 +1658,8 @@ instance. Assumes an inferior Python is running." ;;;; Info-look functionality. +(declare-function info-lookup-maybe-add-help "info-look" (&rest arg)) + (defun python-after-info-look () "Set up info-look for Python. Used with `eval-after-load'." @@ -1833,22 +1845,33 @@ of current line." (1+ (/ (current-indentation) python-indent))) ;; Fixme: Consider top-level assignments, imports, &c. -(defun python-current-defun () +(defun python-current-defun (&optional length-limit) "`add-log-current-defun-function' for Python." (save-excursion ;; Move up the tree of nested `class' and `def' blocks until we ;; get to zero indentation, accumulating the defined names. - (let ((start t) - accum) - (while (or start (> (current-indentation) 0)) - (setq start nil) - (python-beginning-of-block) - (end-of-line) - (beginning-of-defun) - (if (looking-at (rx (0+ space) (or "def" "class") (1+ space) - (group (1+ (or word (syntax symbol)))))) - (push (match-string 1) accum))) - (if accum (mapconcat 'identity accum "."))))) + (let ((accum) + (length -1)) + (catch 'done + (while (or (null length-limit) + (null (cdr accum)) + (< length length-limit)) + (let ((started-from (point))) + (python-beginning-of-block) + (end-of-line) + (beginning-of-defun) + (when (= (point) started-from) + (throw 'done nil))) + (when (looking-at (rx (0+ space) (or "def" "class") (1+ space) + (group (1+ (or word (syntax symbol)))))) + (push (match-string 1) accum) + (setq length (+ length 1 (length (car accum))))) + (when (= (current-indentation) 0) + (throw 'done nil)))) + (when accum + (when (and length-limit (> length length-limit)) + (setcar accum "..")) + (mapconcat 'identity accum "."))))) (defun python-mark-block () "Mark the block around point. @@ -1947,7 +1970,7 @@ Repeating the command scrolls the completion window." (interactive) (let ((window (get-buffer-window "*Completions*"))) (if (and (eq last-command this-command) - window (window-live-p window) (window-buffer window) + (window-live-p window) (window-buffer window) (buffer-name (window-buffer window))) (with-current-buffer (window-buffer window) (if (pos-visible-in-window-p (point-max) window) @@ -2017,10 +2040,11 @@ the if condition." "Alist of named skeletons for Python mode. Elements are of the form (NAME . EXPANDER-FUNCTION).") -(defvar python-mode-abbrev-table nil +(define-abbrev-table 'python-mode-abbrev-table () "Abbrev table for Python mode. -The default contents correspond to the elements of `python-skeletons'.") -(define-abbrev-table 'python-mode-abbrev-table ()) +The default contents correspond to the elements of `python-skeletons'." + ;; Allow / in abbrevs. + :regexp "\\<\\([[:word:]/]+\\)\\W*") (eval-when-compile ;; Define a user-level skeleton and add it to `python-skeletons' and @@ -2030,8 +2054,9 @@ The default contents correspond to the elements of `python-skeletons'.") (function (intern (concat "python-insert-" name)))) `(progn (add-to-list 'python-skeletons ',(cons name function)) - (if python-use-skeletons - (define-abbrev python-mode-abbrev-table ,name "" ',function nil t)) + (define-abbrev python-mode-abbrev-table ,name "" ',function + :system t :case-fixed t + :enable-function (lambda () python-use-skeletons)) (define-skeleton ,function ,(format "Insert Python \"%s\" template." name) ,@elements))))) @@ -2186,23 +2211,6 @@ without confirmation." (defvar outline-heading-end-regexp) (defvar eldoc-documentation-function) - -;; Stuff to allow expanding abbrevs with non-word constituents. -(defun python-abbrev-pc-hook () - "Set the syntax table before possibly expanding abbrevs." - (remove-hook 'post-command-hook 'python-abbrev-pc-hook t) - (set-syntax-table python-mode-syntax-table)) - -(defvar python-abbrev-syntax-table - (copy-syntax-table python-mode-syntax-table) - "Syntax table used when expanding abbrevs.") - -(defun python-pea-hook () - "Reset the syntax table after possibly expanding abbrevs." - (set-syntax-table python-abbrev-syntax-table) - (add-hook 'post-command-hook 'python-abbrev-pc-hook nil t)) -(modify-syntax-entry ?/ "w" python-abbrev-syntax-table) - (defvar python-mode-running) ;Dynamically scoped var. ;;;###autoload @@ -2270,6 +2278,7 @@ with skeleton expansions for compound statement templates. (set (make-local-variable 'beginning-of-defun-function) 'python-beginning-of-defun) (set (make-local-variable 'end-of-defun-function) 'python-end-of-defun) + (add-hook 'which-func-functions 'python-which-func nil t) (setq imenu-create-index-function #'python-imenu-create-index) (set (make-local-variable 'eldoc-documentation-function) #'python-eldoc-function) @@ -2289,7 +2298,6 @@ with skeleton expansions for compound statement templates. '((< '(backward-delete-char-untabify (min python-indent (current-column)))) (^ '(- (1+ (current-indentation)))))) - (add-hook 'pre-abbrev-expand-hook 'python-pea-hook nil t) (if (featurep 'hippie-exp) (set (make-local-variable 'hippie-expand-try-functions-list) (cons 'python-try-complete hippie-expand-try-functions-list))) diff --git a/lisp/progmodes/sh-script.el b/lisp/progmodes/sh-script.el index d81281dc4f2..e1ad1b585e3 100644 --- a/lisp/progmodes/sh-script.el +++ b/lisp/progmodes/sh-script.el @@ -212,7 +212,6 @@ (defgroup sh nil "Shell programming utilities." - :group 'unix :group 'languages) (defgroup sh-script nil @@ -241,7 +240,7 @@ (wsh . sh) (zsh . ksh88) (rpm . sh)) - "*Alist showing the direct ancestor of various shells. + "Alist showing the direct ancestor of various shells. This is the basis for `sh-feature'. See also `sh-alias-alist'. By default we have the following three hierarchies: @@ -276,7 +275,7 @@ sh Bourne Shell '((ksh . ksh88) (bash2 . bash) (sh5 . sh))) - "*Alist for transforming shell names to what they really are. + "Alist for transforming shell names to what they really are. Use this where the name of the executable doesn't correspond to the type of shell it really is." :type '(repeat (cons symbol symbol)) @@ -302,7 +301,7 @@ shell it really is." (file-name-sans-extension (downcase shell))))) (getenv "SHELL") "/bin/sh") - "*The executable file name for the shell being programmed." + "The executable file name for the shell being programmed." :type 'string :group 'sh-script) @@ -321,7 +320,7 @@ shell it really is." (wksh) ;; -f means don't run .zshrc. (zsh . "-f")) - "*Single argument string for the magic number. See `sh-feature'." + "Single argument string for the magic number. See `sh-feature'." :type '(repeat (cons (symbol :tag "Shell") (choice (const :tag "No Arguments" nil) (string :tag "Arguments") @@ -330,8 +329,8 @@ shell it really is." (defcustom sh-imenu-generic-expression `((sh - . ((nil "^\\s-*\\(function\\s-+\\)?\\([A-Za-z_][A-Za-z_0-9]+\\)\\s-*()" 2)))) - "*Alist of regular expressions for recognizing shell function definitions. + . ((nil "^\\s-*\\(function\\s-+\\)?\\([[:alpha:]_][[:alnum:]_]+\\)\\s-*()" 2)))) + "Alist of regular expressions for recognizing shell function definitions. See `sh-feature' and `imenu-generic-expression'." :type '(alist :key-type (symbol :tag "Shell") :value-type (alist :key-type (choice :tag "Title" @@ -507,7 +506,7 @@ This is buffer-local in every such buffer.") '(shell-dynamic-complete-environment-variable shell-dynamic-complete-command comint-dynamic-complete-filename) - "*Functions for doing TAB dynamic completion." + "Functions for doing TAB dynamic completion." :type '(repeat function) :group 'sh-script) @@ -515,7 +514,7 @@ This is buffer-local in every such buffer.") (defcustom sh-require-final-newline '((csh . t) (pdksh . t)) - "*Value of `require-final-newline' in Shell-Script mode buffers. + "Value of `require-final-newline' in Shell-Script mode buffers. \(SHELL . t) means use the value of `mode-require-final-newline' for SHELL. See `sh-feature'." :type '(repeat (cons (symbol :tag "Shell") @@ -525,12 +524,12 @@ See `sh-feature'." (defcustom sh-assignment-regexp - '((csh . "\\<\\([a-zA-Z0-9_]+\\)\\(\\[.+\\]\\)?[ \t]*[-+*/%^]?=") + '((csh . "\\<\\([[:alnum:]_]+\\)\\(\\[.+\\]\\)?[ \t]*[-+*/%^]?=") ;; actually spaces are only supported in let/(( ... )) - (ksh88 . "\\<\\([a-zA-Z0-9_]+\\)\\(\\[.+\\]\\)?[ \t]*\\([-+*/%&|~^]\\|<<\\|>>\\)?=") - (rc . "\\<\\([a-zA-Z0-9_*]+\\)[ \t]*=") - (sh . "\\<\\([a-zA-Z0-9_]+\\)=")) - "*Regexp for the variable name and what may follow in an assignment. + (ksh88 . "\\<\\([[:alnum:]_]+\\)\\(\\[.+\\]\\)?[ \t]*\\([-+*/%&|~^]\\|<<\\|>>\\)?=") + (rc . "\\<\\([[:alnum:]_*]+\\)[ \t]*=") + (sh . "\\<\\([[:alnum:]_]+\\)=")) + "Regexp for the variable name and what may follow in an assignment. First grouping matches the variable name. This is upto and including the `=' sign. See `sh-feature'." :type '(repeat (cons (symbol :tag "Shell") @@ -546,7 +545,7 @@ sign. See `sh-feature'." (put 'sh-indentation 'safe-local-variable 'integerp) (defcustom sh-remember-variable-min 3 - "*Don't remember variables less than this length for completing reads." + "Don't remember variables less than this length for completing reads." :type 'integer :group 'sh-script) @@ -557,16 +556,16 @@ That command is also used for setting this variable.") (defcustom sh-beginning-of-command - "\\([;({`|&]\\|\\`\\|[^\\]\n\\)[ \t]*\\([/~a-zA-Z0-9:]\\)" - "*Regexp to determine the beginning of a shell command. + "\\([;({`|&]\\|\\`\\|[^\\]\n\\)[ \t]*\\([/~[:alnum:]:]\\)" + "Regexp to determine the beginning of a shell command. The actual command starts at the beginning of the second \\(grouping\\)." :type 'regexp :group 'sh-script) (defcustom sh-end-of-command - "\\([/~a-zA-Z0-9:]\\)[ \t]*\\([;#)}`|&]\\|$\\)" - "*Regexp to determine the end of a shell command. + "\\([/~[:alnum:]:]\\)[ \t]*\\([;#)}`|&]\\|$\\)" + "Regexp to determine the end of a shell command. The actual command ends at the end of the first \\(grouping\\)." :type 'regexp :group 'sh-script) @@ -653,6 +652,7 @@ removed when closing the here document." (shell "cd" "echo" "eval" "set" "shift" "umask" "unset" "wait") (wksh sh-append ksh88 + ;; FIXME: This looks too much like a regexp. --Stef "Xt[A-Z][A-Za-z]*") (zsh sh-append ksh88 @@ -662,7 +662,7 @@ removed when closing the here document." "readonly" "rehash" "sched" "setopt" "source" "suspend" "true" "ttyctl" "type" "unfunction" "unhash" "unlimit" "unsetopt" "vared" "which")) - "*List of all shell builtins for completing read and fontification. + "List of all shell builtins for completing read and fontification. Note that on some systems not all builtins are available or some are implemented as aliases. See `sh-feature'." :type '(repeat (cons (symbol :tag "Shell") @@ -683,7 +683,7 @@ implemented as aliases. See `sh-feature'." (rc "else") (sh "!" "do" "elif" "else" "if" "then" "trap" "type" "until" "while")) - "*List of keywords that may be immediately followed by a builtin or keyword. + "List of keywords that may be immediately followed by a builtin or keyword. Given some confusion between keywords and builtins depending on shell and system, the distinction here has been based on whether they influence the flow of control or syntax. See `sh-feature'." @@ -722,7 +722,7 @@ flow of control or syntax. See `sh-feature'." (zsh sh-append bash "select")) - "*List of keywords not in `sh-leading-keywords'. + "List of keywords not in `sh-leading-keywords'. See `sh-feature'." :type '(repeat (cons (symbol :tag "Shell") (choice (repeat string) @@ -843,18 +843,18 @@ See `sh-feature'.") (defvar sh-font-lock-keywords-var '((csh sh-append shell - ("\\${?[#?]?\\([A-Za-z_][A-Za-z0-9_]*\\|0\\)" 1 + ("\\${?[#?]?\\([[:alpha:]_][[:alnum:]_]*\\|0\\)" 1 font-lock-variable-name-face)) (es sh-append executable-font-lock-keywords - ("\\$#?\\([A-Za-z_][A-Za-z0-9_]*\\|[0-9]+\\)" 1 + ("\\$#?\\([[:alpha:]_][[:alnum:]_]*\\|[0-9]+\\)" 1 font-lock-variable-name-face)) (rc sh-append es) (bash sh-append shell ("\\$(\\(\\sw+\\)" (1 'sh-quoted-exec t) )) (sh sh-append shell ;; Variable names. - ("\\$\\({#?\\)?\\([A-Za-z_][A-Za-z0-9_]*\\|[-#?@!]\\)" 2 + ("\\$\\({#?\\)?\\([[:alpha:]_][[:alnum:]_]*\\|[-#?@!]\\)" 2 font-lock-variable-name-face) ;; Function names. ("^\\(\\sw+\\)[ \t]*(" 1 font-lock-function-name-face) @@ -867,8 +867,8 @@ See `sh-feature'.") (shell ;; Using font-lock-string-face here confuses sh-get-indent-info. ("\\(^\\|[^\\]\\)\\(\\\\\\\\\\)*\\(\\\\\\)$" 3 'sh-escaped-newline) - ("\\\\[^A-Za-z0-9]" 0 font-lock-string-face) - ("\\${?\\([A-Za-z_][A-Za-z0-9_]*\\|[0-9]+\\|[$*_]\\)" 1 + ("\\\\[^[:alnum:]]" 0 font-lock-string-face) + ("\\${?\\([[:alpha:]_][[:alnum:]_]*\\|[0-9]+\\|[$*_]\\)" 1 font-lock-variable-name-face)) (rpm sh-append rpm2 ("%{?\\(\\sw+\\)" 1 font-lock-keyword-face)) @@ -985,7 +985,7 @@ Point is at the beginning of the next line." ;; This looks silly, but it's because `sh-here-doc-re' keeps changing. (re-search-forward sh-here-doc-re limit t)) -(defun sh-quoted-subshell (limit) +(defun sh-font-lock-quoted-subshell (limit) "Search for a subshell embedded in a string. Find all the unescaped \" characters within said subshell, remembering that subshells can nest." @@ -997,46 +997,39 @@ subshells can nest." (eq ?\" (nth 3 (syntax-ppss)))) ;; bingo we have a $( or a ` inside a "" (let ((char (char-after (point))) - (continue t) - (pos (point)) - (data nil) ;; value to put into match-data (and return) - (last nil) ;; last char seen - (bq (equal (match-string 1) "`")) ;; ` state flip-flop - (seen nil) ;; list of important positions - (nest 1)) ;; subshell nesting level - (while (and continue char (<= pos limit)) - ;; unescaped " inside a $( ... ) construct. - ;; state machine time... - ;; \ => ignore next char; - ;; ` => increase or decrease nesting level based on bq flag - ;; ) [where nesting > 0] => decrease nesting - ;; ( [where nesting > 0] => increase nesting - ;; ( [preceeded by $ ] => increase nesting - ;; " [nesting <= 0 ] => terminate, we're done. - ;; " [nesting > 0 ] => remember this, it's not a proper " - ;; FIXME: don't count parens that appear within quotes. - (cond - ((eq ?\\ last) nil) - ((eq ?\` char) (setq nest (+ nest (if bq -1 1)) bq (not bq))) - ((and (> nest 0) (eq ?\) char)) (setq nest (1- nest))) - ((and (eq ?$ last) (eq ?\( char)) (setq nest (1+ nest))) - ((and (> nest 0) (eq ?\( char)) (setq nest (1+ nest))) - ((eq char ?\") - (if (>= 0 nest) (setq continue nil) (push pos seen)))) - ;;(message "POS: %d [%d]" pos nest) - (setq last char - pos (1+ pos) - char (char-after pos)) ) - ;; FIXME: why construct a costly match data to pass to - ;; sh-apply-quoted-subshell rather than apply the highlight - ;; directly here? -- Stef - (when seen - ;;(message "SEEN: %S" seen) - (setq data (list (current-buffer))) - (dolist(P seen) - (setq data (cons P (cons (1+ P) data)))) - (store-match-data data)) - data) )) + ;; `state' can be: double-quote, backquote, code. + (state (if (eq (char-before) ?`) 'backquote 'code)) + ;; Stacked states in the context. + (states '(double-quote))) + (while (and state (progn (skip-chars-forward "^'\\\"`$()" limit) + (< (point) limit))) + ;; unescape " inside a $( ... ) construct. + (case (char-after) + (?\' (skip-chars-forward "^'" limit)) + (?\\ (forward-char 1)) + (?\" (case state + (double-quote (setq state (pop states))) + (t (push state states) (setq state 'double-quote))) + (if state (put-text-property (point) (1+ (point)) + 'syntax-table '(1)))) + (?\` (case state + (backquote (setq state (pop states))) + (t (push state states) (setq state 'backquote)))) + (?\$ (if (not (eq (char-after (1+ (point))) ?\()) + nil + (forward-char 1) + (case state + (t (push state states) (setq state 'code))))) + (?\( (case state + (double-quote nil) + (t (push state states) (setq state 'code)))) + (?\) (case state + (double-quote nil) + (t (setq state (pop states))))) + (t (error "Internal error in sh-font-lock-quoted-subshell"))) + (forward-char 1))) + t)) + (defun sh-is-quoted-p (pos) (and (eq (char-before pos) ?\\) @@ -1092,17 +1085,6 @@ subshells can nest." (goto-char limit) nil) -(defun sh-apply-quoted-subshell () - "Apply the `sh-st-punc' syntax to all the matches in `match-data'. -This is used to flag quote characters in subshell constructs inside strings -\(which should therefore not be treated as normal quote characters\)" - (let ((m (match-data)) a b) - (while m - (setq a (car m) - b (cadr m) - m (cddr m)) - (put-text-property a b 'syntax-table sh-st-punc))) sh-st-punc) - (defconst sh-font-lock-syntactic-keywords ;; A `#' begins a comment when it is unquoted and at the beginning of a ;; word. In the shell, words are separated by metacharacters. @@ -1115,7 +1097,7 @@ This is used to flag quote characters in subshell constructs inside strings ;; change the syntax, so we have to tell syntax-ppss that the states it ;; has just computed will need to be recomputed. (sh-font-lock-flush-syntax-ppss-cache) - ;; Make sure $@ and @? are correctly recognized as sexps. + ;; Make sure $@ and $? are correctly recognized as sexps. ("\\$\\([?@]\\)" 1 ,sh-st-symbol) ;; Find HEREDOC starters and add a corresponding rule for the ender. (sh-font-lock-here-doc @@ -1129,8 +1111,7 @@ This is used to flag quote characters in subshell constructs inside strings (")" 0 (sh-font-lock-paren (match-beginning 0))) ;; highlight (possibly nested) subshells inside "" quoted regions correctly. ;; This should be at the very end because it uses syntax-ppss. - (sh-quoted-subshell - (1 (sh-apply-quoted-subshell) t t)))) + (sh-font-lock-quoted-subshell))) (defun sh-font-lock-syntactic-face-function (state) (let ((q (nth 3 state))) @@ -1151,17 +1132,17 @@ and command `sh-reset-indent-vars-to-global-values'." (defcustom sh-set-shell-hook nil - "*Hook run by `sh-set-shell'." + "Hook run by `sh-set-shell'." :type 'hook :group 'sh-script) (defcustom sh-mode-hook nil - "*Hook run by `sh-mode'." + "Hook run by `sh-mode'." :type 'hook :group 'sh-script) (defcustom sh-learn-basic-offset nil - "*When `sh-guess-basic-offset' should learn `sh-basic-offset'. + "When `sh-guess-basic-offset' should learn `sh-basic-offset'. nil mean: never. t means: only if there seems to be an obvious value. @@ -1173,7 +1154,7 @@ Anything else means: whenever we have a \"good guess\" as to the value." :group 'sh-indentation) (defcustom sh-popup-occur-buffer nil - "*Controls when `sh-learn-buffer-indent' pops the `*indent*' buffer. + "Controls when `sh-learn-buffer-indent' pops the `*indent*' buffer. If t it is always shown. If nil, it is shown only when there are conflicts." :type '(choice @@ -1182,7 +1163,7 @@ are conflicts." :group 'sh-indentation) (defcustom sh-blink t - "*If non-nil, `sh-show-indent' shows the line indentation is relative to. + "If non-nil, `sh-show-indent' shows the line indentation is relative to. The position on the line is not necessarily meaningful. In some cases the line will be the matching keyword, but this is not always the case." @@ -1190,7 +1171,7 @@ always the case." :group 'sh-indentation) (defcustom sh-first-lines-indent 0 - "*The indentation of the first non-blank non-comment line. + "The indentation of the first non-blank non-comment line. Usually 0 meaning first column. Can be set to a number, or to nil which means leave it as is." :type '(choice @@ -1201,17 +1182,17 @@ Can be set to a number, or to nil which means leave it as is." (defcustom sh-basic-offset 4 - "*The default indentation increment. + "The default indentation increment. This value is used for the `+' and `-' symbols in an indentation variable." :type 'integer :group 'sh-indentation) (defcustom sh-indent-comment nil - "*How a comment line is to be indented. + "How a comment line is to be indented. nil means leave it as it is; t means indent it as a normal line, aligning it to previous non-blank non-comment line; -a number means align to that column, e.g. 0 means fist column." +a number means align to that column, e.g. 0 means first column." :type '(choice (const :tag "Leave as is." nil) (const :tag "Indent as a normal line." t) @@ -1246,7 +1227,7 @@ a number means align to that column, e.g. 0 means fist column." :menu-tag "/ Indent left half sh-basic-offset"))) (defcustom sh-indent-for-else 0 - "*How much to indent an `else' relative to its `if'. Usually 0." + "How much to indent an `else' relative to its `if'. Usually 0." :type `(choice (integer :menu-tag "A number (positive=>indent right)" :tag "A number") @@ -1262,41 +1243,41 @@ a number means align to that column, e.g. 0 means fist column." sh-symbol-list)) (defcustom sh-indent-for-fi 0 - "*How much to indent a `fi' relative to its `if'. Usually 0." + "How much to indent a `fi' relative to its `if'. Usually 0." :type `(choice ,@ sh-number-or-symbol-list ) :group 'sh-indentation) (defcustom sh-indent-for-done 0 - "*How much to indent a `done' relative to its matching stmt. Usually 0." + "How much to indent a `done' relative to its matching stmt. Usually 0." :type `(choice ,@ sh-number-or-symbol-list ) :group 'sh-indentation) (defcustom sh-indent-after-else '+ - "*How much to indent a statement after an `else' statement." + "How much to indent a statement after an `else' statement." :type `(choice ,@ sh-number-or-symbol-list ) :group 'sh-indentation) (defcustom sh-indent-after-if '+ - "*How much to indent a statement after an `if' statement. + "How much to indent a statement after an `if' statement. This includes lines after `else' and `elif' statements, too, but does not affect the `else', `elif' or `fi' statements themselves." :type `(choice ,@ sh-number-or-symbol-list ) :group 'sh-indentation) (defcustom sh-indent-for-then 0 - "*How much to indent a `then' relative to its `if'." + "How much to indent a `then' relative to its `if'." :type `(choice ,@ sh-number-or-symbol-list ) :group 'sh-indentation) (defcustom sh-indent-for-do 0 - "*How much to indent a `do' statement. + "How much to indent a `do' statement. This is relative to the statement before the `do', typically a `while', `until', `for', `repeat' or `select' statement." :type `(choice ,@ sh-number-or-symbol-list) :group 'sh-indentation) (defcustom sh-indent-after-do '+ - "*How much to indent a line after a `do' statement. + "How much to indent a line after a `do' statement. This is used when the `do' is the first word of the line. This is relative to the statement before the `do', typically a `while', `until', `for', `repeat' or `select' statement." @@ -1304,7 +1285,7 @@ This is relative to the statement before the `do', typically a :group 'sh-indentation) (defcustom sh-indent-after-loop-construct '+ - "*How much to indent a statement after a loop construct. + "How much to indent a statement after a loop construct. This variable is used when the keyword `do' is on the same line as the loop statement (e.g., `until', `while' or `for'). @@ -1314,7 +1295,7 @@ If the `do' is on a line by itself, then `sh-indent-after-do' is used instead." (defcustom sh-indent-after-done 0 - "*How much to indent a statement after a `done' keyword. + "How much to indent a statement after a `done' keyword. Normally this is 0, which aligns the `done' to the matching looping construct line. Setting it non-zero allows you to have the `do' statement on a line @@ -1323,55 +1304,55 @@ by itself and align the done under to do." :group 'sh-indentation) (defcustom sh-indent-for-case-label '+ - "*How much to indent a case label statement. + "How much to indent a case label statement. This is relative to the line containing the `case' statement." :type `(choice ,@ sh-number-or-symbol-list) :group 'sh-indentation) (defcustom sh-indent-for-case-alt '++ - "*How much to indent statements after the case label. + "How much to indent statements after the case label. This is relative to the line containing the `case' statement." :type `(choice ,@ sh-number-or-symbol-list) :group 'sh-indentation) (defcustom sh-indent-for-continuation '+ - "*How much to indent for a continuation statement." + "How much to indent for a continuation statement." :type `(choice ,@ sh-number-or-symbol-list) :group 'sh-indentation) (defcustom sh-indent-after-open '+ - "*How much to indent after a line with an opening parenthesis or brace. + "How much to indent after a line with an opening parenthesis or brace. For an open paren after a function, `sh-indent-after-function' is used." :type `(choice ,@ sh-number-or-symbol-list) :group 'sh-indentation) (defcustom sh-indent-after-function '+ - "*How much to indent after a function line." + "How much to indent after a function line." :type `(choice ,@ sh-number-or-symbol-list) :group 'sh-indentation) ;; These 2 are for the rc shell: (defcustom sh-indent-after-switch '+ - "*How much to indent a `case' statement relative to the `switch' statement. + "How much to indent a `case' statement relative to the `switch' statement. This is for the rc shell." :type `(choice ,@ sh-number-or-symbol-list) :group 'sh-indentation) (defcustom sh-indent-after-case '+ - "*How much to indent a statement relative to the `case' statement. + "How much to indent a statement relative to the `case' statement. This is for the rc shell." :type `(choice ,@ sh-number-or-symbol-list) :group 'sh-indentation) (defcustom sh-backslash-column 48 - "*Column in which `sh-backslash-region' inserts backslashes." + "Column in which `sh-backslash-region' inserts backslashes." :type 'integer :group 'sh) (defcustom sh-backslash-align t - "*If non-nil, `sh-backslash-region' will align backslashes." + "If non-nil, `sh-backslash-region' will align backslashes." :type 'boolean :group 'sh) @@ -1381,7 +1362,7 @@ This is for the rc shell." "Make a regexp which matches WORD as a word. This specifically excludes an occurrence of WORD followed by punctuation characters like '-'." - (concat word "\\([^-a-z0-9_]\\|$\\)")) + (concat word "\\([^-[:alnum:]_]\\|$\\)")) (defconst sh-re-done (sh-mkword-regexpr "done")) @@ -1543,6 +1524,8 @@ with your script for an edit-interpret-debug cycle." skeleton-filter-function 'sh-feature skeleton-newline-indent-rigidly t sh-indent-supported-here nil) + (set (make-local-variable 'defun-prompt-regexp) + (concat "^\\(function[ \t]\\|[[:alnum:]]+[ \t]+()[ \t]+\\)")) (set (make-local-variable 'parse-sexp-ignore-comments) t) ;; Parse or insert magic number for exec, and set all variables depending ;; on the shell thus determined. @@ -1925,14 +1908,14 @@ variable `sh-make-vars-local' has been set to nil. To revert all these variables to the global values, use command `sh-reset-indent-vars-to-global-values'." (interactive) - (mapcar 'make-local-variable sh-var-list) + (mapc 'make-local-variable sh-var-list) (message "Indentation variables are now local.")) (defun sh-reset-indent-vars-to-global-values () "Reset local indentation variables to the global values. Then, if variable `sh-make-vars-local' is non-nil, make them local." (interactive) - (mapcar 'kill-local-variable sh-var-list) + (mapc 'kill-local-variable sh-var-list) (if sh-make-vars-local (mapcar 'make-local-variable sh-var-list))) @@ -2268,6 +2251,7 @@ STRING This is ignored for the purposes of calculating (setq align-point (point)))) (or (bobp) (forward-char -1)) + ;; FIXME: This charset looks too much like a regexp. --Stef (skip-chars-forward "[a-z0-9]*?") ) ((string-match "[])}]" x) @@ -2476,7 +2460,7 @@ we go to the end of the previous line and do not check for continuations." (if (looking-at "[\"'`]") (sh-safe-forward-sexp) ;; (> (skip-chars-forward "^ \t\n\"'`") 0) - (> (skip-chars-forward "-_a-zA-Z$0-9") 0) + (> (skip-chars-forward "-_$[:alnum:]") 0) )) (buffer-substring start (point)) )) diff --git a/lisp/progmodes/simula.el b/lisp/progmodes/simula.el index 0f9cd70029d..9c2c48f6eda 100644 --- a/lisp/progmodes/simula.el +++ b/lisp/progmodes/simula.el @@ -1615,9 +1615,9 @@ If not nil and not t, move to limit of search and return nil." (simula-install-standard-abbrevs)) ;; Hilit mode support. -(if (and (fboundp 'hilit-set-mode-patterns) - (boundp 'hilit-patterns-alist) - (not (assoc 'simula-mode hilit-patterns-alist))) +(when (fboundp 'hilit-set-mode-patterns) + (when (and (boundp 'hilit-patterns-alist) + (not (assoc 'simula-mode hilit-patterns-alist))) (hilit-set-mode-patterns 'simula-mode '( @@ -1626,7 +1626,7 @@ If not nil and not t, move to limit of search and return nil." ("\"[^\"\n]*\"\\|'.'\\|'![0-9]+!'" nil string) ("\\<\\(ACTIVATE\\|AFTER\\|AND\\|ARRAY\\|AT\\|BEFORE\\|BEGIN\\|BOOLEAN\\|CHARACTER\\|CLASS\\|DELAY\\|DO\\|ELSE\\|END\\|EQ\\|EQV\\|EXTERNAL\\|FALSE\\|FOR\\|GE\\|GO\\|GOTO\\|GT\\|HIDDEN\\|IF\\|IMP\\|IN\\|INNER\\|INSPECT\\|INTEGER\\|IS\\|LABEL\\|LE\\|LONG\\|LT\\|NAME\\|NE\\|NEW\\|NONE\\|NOT\\|NOTEXT\\|OR\\|OTHERWISE\\|PRIOR\\|PROCEDURE\\|PROTECTED\\|QUA\\|REACTIVATE\\|REAL\\|REF\\|SHORT\\|STEP\\|SWITCH\\|TEXT\\|THEN\\|THIS\\|TO\\|TRUE\\|UNTIL\\|VALUE\\|VIRTUAL\\|WHEN\\|WHILE\\)\\>" nil keyword) ("!\\|\\<COMMENT\\>" ";" comment)) - nil 'case-insensitive)) + nil 'case-insensitive))) ;; defuns for submitting bug reports diff --git a/lisp/progmodes/sql.el b/lisp/progmodes/sql.el index 23b46a77523..525973fd583 100644 --- a/lisp/progmodes/sql.el +++ b/lisp/progmodes/sql.el @@ -863,7 +863,7 @@ Based on `comint-mode-map'.") (unless sql-mode-abbrev-table (define-abbrev-table 'sql-mode-abbrev-table nil)) -(mapcar +(mapc ;; In Emacs 22+, provide SYSTEM-FLAG to define-abbrev. '(lambda (abbrev) (let ((name (car abbrev)) diff --git a/lisp/progmodes/vera-mode.el b/lisp/progmodes/vera-mode.el index e0204474db2..17724a17cb3 100644 --- a/lisp/progmodes/vera-mode.el +++ b/lisp/progmodes/vera-mode.el @@ -48,7 +48,7 @@ ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Documentation -;; See comment string of function `vera-mode' or type `C-c C-h' in Emacs. +;; See comment string of function `vera-mode' or type `C-h m' in Emacs. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Installation @@ -77,10 +77,6 @@ ;;; Code: -;; XEmacs handling -(defconst vera-xemacs (string-match "XEmacs" emacs-version) - "Non-nil if XEmacs is used.") - ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Variables ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -122,37 +118,37 @@ If nil, TAB always indents current line." ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Key bindings -(defvar vera-mode-map () +(defvar vera-mode-map + (let ((map (make-sparse-keymap))) + ;; Backspace/delete key bindings. + (define-key map [backspace] 'backward-delete-char-untabify) + (unless (boundp 'delete-key-deletes-forward) ; XEmacs variable + (define-key map [delete] 'delete-char) + (define-key map [(meta delete)] 'kill-word)) + ;; Standard key bindings. + (define-key map "\M-e" 'vera-forward-statement) + (define-key map "\M-a" 'vera-backward-statement) + (define-key map "\M-\C-e" 'vera-forward-same-indent) + (define-key map "\M-\C-a" 'vera-backward-same-indent) + ;; Mode specific key bindings. + (define-key map "\C-c\t" 'indent-according-to-mode) + (define-key map "\M-\C-\\" 'vera-indent-region) + (define-key map "\C-c\C-c" 'vera-comment-uncomment-region) + (define-key map "\C-c\C-f" 'vera-fontify-buffer) + (define-key map "\C-c\C-v" 'vera-version) + (define-key map "\M-\t" 'tab-to-tab-stop) + ;; Electric key bindings. + (define-key map "\t" 'vera-electric-tab) + (define-key map "\r" 'vera-electric-return) + (define-key map " " 'vera-electric-space) + (define-key map "{" 'vera-electric-opening-brace) + (define-key map "}" 'vera-electric-closing-brace) + (define-key map "#" 'vera-electric-pound) + (define-key map "*" 'vera-electric-star) + (define-key map "/" 'vera-electric-slash) + map) "Keymap for Vera Mode.") -(setq vera-mode-map (make-sparse-keymap)) -;; backspace/delete key bindings -(define-key vera-mode-map [backspace] 'backward-delete-char-untabify) -(unless (boundp 'delete-key-deletes-forward) ; XEmacs variable - (define-key vera-mode-map [delete] 'delete-char) - (define-key vera-mode-map [(meta delete)] 'kill-word)) -;; standard key bindings -(define-key vera-mode-map "\M-e" 'vera-forward-statement) -(define-key vera-mode-map "\M-a" 'vera-backward-statement) -(define-key vera-mode-map "\M-\C-e" 'vera-forward-same-indent) -(define-key vera-mode-map "\M-\C-a" 'vera-backward-same-indent) -;; mode specific key bindings -(define-key vera-mode-map "\C-c\t" 'indent-according-to-mode) -(define-key vera-mode-map "\M-\C-\\" 'vera-indent-region) -(define-key vera-mode-map "\C-c\C-c" 'vera-comment-uncomment-region) -(define-key vera-mode-map "\C-c\C-f" 'vera-fontify-buffer) -(define-key vera-mode-map "\C-c\C-v" 'vera-version) -(define-key vera-mode-map "\M-\t" 'tab-to-tab-stop) -;; electric key bindings -(define-key vera-mode-map "\t" 'vera-electric-tab) -(define-key vera-mode-map "\r" 'vera-electric-return) -(define-key vera-mode-map " " 'vera-electric-space) -(define-key vera-mode-map "{" 'vera-electric-opening-brace) -(define-key vera-mode-map "}" 'vera-electric-closing-brace) -(define-key vera-mode-map "#" 'vera-electric-pound) -(define-key vera-mode-map "*" 'vera-electric-star) -(define-key vera-mode-map "/" 'vera-electric-slash) - ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Menu @@ -231,7 +227,7 @@ If nil, TAB always indents current line." (modify-syntax-entry ?\{ "(}" syntax-table) (modify-syntax-entry ?\} "){" syntax-table) ;; comment - (if vera-xemacs + (if (featurep 'xemacs) (modify-syntax-entry ?\/ ". 1456" syntax-table) ; XEmacs (modify-syntax-entry ?\/ ". 124b" syntax-table)) ; Emacs (modify-syntax-entry ?\* ". 23" syntax-table) @@ -600,7 +596,7 @@ Key bindings: ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; XEmacs compatibility -(when vera-xemacs +(when (featurep 'xemacs) (require 'font-lock) (copy-face 'font-lock-reference-face 'font-lock-constant-face) (copy-face 'font-lock-preprocessor-face 'font-lock-builtin-face)) @@ -844,21 +840,19 @@ This function does not modify point or mark." (defsubst vera-re-search-forward (regexp &optional bound noerror) "Like `re-search-forward', but skips over matches in literals." - (store-match-data '(nil nil)) - (while (and (re-search-forward regexp bound noerror) - (vera-skip-forward-literal) - (progn (store-match-data '(nil nil)) - (if bound (< (point) bound) t)))) - (match-end 0)) + (let (ret) + (while (and (setq ret (re-search-forward regexp bound noerror)) + (vera-skip-forward-literal) + (if bound (< (point) bound) t))) + ret)) (defsubst vera-re-search-backward (regexp &optional bound noerror) "Like `re-search-backward', but skips over matches in literals." - (store-match-data '(nil nil)) - (while (and (re-search-backward regexp bound noerror) - (vera-skip-backward-literal) - (progn (store-match-data '(nil nil)) - (if bound (> (point) bound) t)))) - (match-end 0)) + (let (ret) + (while (and (setq ret (re-search-backward regexp bound noerror)) + (vera-skip-backward-literal) + (if bound (> (point) bound) t))) + ret)) (defun vera-forward-syntactic-ws (&optional lim skip-directive) "Forward skip of syntactic whitespace." diff --git a/lisp/progmodes/vhdl-mode.el b/lisp/progmodes/vhdl-mode.el index 13686695f8d..98818ea8354 100644 --- a/lisp/progmodes/vhdl-mode.el +++ b/lisp/progmodes/vhdl-mode.el @@ -125,13 +125,10 @@ ;;; Code: -;; XEmacs handling -(defconst vhdl-xemacs (string-match "XEmacs" emacs-version) - "Non-nil if XEmacs is used.") ;; Emacs 21+ handling -(defconst vhdl-emacs-21 (and (<= 21 emacs-major-version) (not vhdl-xemacs)) +(defconst vhdl-emacs-21 (and (<= 21 emacs-major-version) (not (featurep 'xemacs))) "Non-nil if GNU Emacs 21, 22, ... is used.") -(defconst vhdl-emacs-22 (and (<= 22 emacs-major-version) (not vhdl-xemacs)) +(defconst vhdl-emacs-22 (and (<= 22 emacs-major-version) (not (featurep 'xemacs))) "Non-nil if GNU Emacs 22, ... is used.") (defvar compilation-file-regexp-alist) @@ -1844,13 +1841,13 @@ NOTE: Activate the new setting in a VHDL buffer by using the menu entry ;; add related general customizations (custom-add-to-group 'vhdl-related 'hideshow 'custom-group) -(if vhdl-xemacs +(if (featurep 'xemacs) (custom-add-to-group 'vhdl-related 'paren-mode 'custom-variable) (custom-add-to-group 'vhdl-related 'paren-showing 'custom-group)) (custom-add-to-group 'vhdl-related 'ps-print 'custom-group) (custom-add-to-group 'vhdl-related 'speedbar 'custom-group) (custom-add-to-group 'vhdl-related 'line-number-mode 'custom-variable) -(unless vhdl-xemacs +(unless (featurep 'xemacs) (custom-add-to-group 'vhdl-related 'transient-mark-mode 'custom-variable)) (custom-add-to-group 'vhdl-related 'user-full-name 'custom-variable) (custom-add-to-group 'vhdl-related 'mail-host-address 'custom-variable) @@ -2093,7 +2090,7 @@ Ignore byte-compiler warnings you might see." newstr))) ;; `itimer.el': idle timer bug fix in version 1.09 (XEmacs 21.1.9) -(when (and vhdl-xemacs (string< itimer-version "1.09") +(when (and (featurep 'xemacs) (string< itimer-version "1.09") (not noninteractive)) (load "itimer") (when (string< itimer-version "1.09") @@ -2486,7 +2483,7 @@ conversion." (defun vhdl-show-messages () "Get *Messages* buffer to show recent messages." (interactive) - (display-buffer (if vhdl-xemacs " *Message-Log*" "*Messages*"))) + (display-buffer (if (featurep 'xemacs) " *Message-Log*" "*Messages*"))) (defun vhdl-use-direct-instantiation () "Return whether direct instantiation is used." @@ -2686,7 +2683,7 @@ STRING are replaced by `-' and substrings are converted to lower case." (define-key vhdl-mode-map "\M-\C-u" 'vhdl-backward-up-list) (define-key vhdl-mode-map "\M-\C-a" 'vhdl-backward-same-indent) (define-key vhdl-mode-map "\M-\C-e" 'vhdl-forward-same-indent) - (unless vhdl-xemacs ; would override `M-backspace' in XEmacs + (unless (featurep 'xemacs) ; would override `M-backspace' in XEmacs (define-key vhdl-mode-map "\M-\C-h" 'vhdl-mark-defun)) (define-key vhdl-mode-map "\M-\C-q" 'vhdl-indent-sexp) (define-key vhdl-mode-map "\M-^" 'vhdl-delete-indentation) @@ -2713,7 +2710,7 @@ STRING are replaced by `-' and substrings are converted to lower case." (define-key vhdl-mode-map "\C-c\C-p\C-i" 'vhdl-port-paste-instance) (define-key vhdl-mode-map "\C-c\C-p\C-s" 'vhdl-port-paste-signals) (define-key vhdl-mode-map "\C-c\C-p\M-c" 'vhdl-port-paste-constants) - (if vhdl-xemacs ; `... C-g' not allowed in XEmacs + (if (featurep 'xemacs) ; `... C-g' not allowed in XEmacs (define-key vhdl-mode-map "\C-c\C-p\M-g" 'vhdl-port-paste-generic-map) (define-key vhdl-mode-map "\C-c\C-p\C-g" 'vhdl-port-paste-generic-map)) (define-key vhdl-mode-map "\C-c\C-p\C-z" 'vhdl-port-paste-initializations) @@ -2811,7 +2808,7 @@ STRING are replaced by `-' and substrings are converted to lower case." ;; set up electric character functions to work with ;; `delete-selection-mode' (Emacs) and `pending-delete-mode' (XEmacs) -(mapcar +(mapc (function (lambda (sym) (put sym 'delete-selection t) ; for `delete-selection-mode' (Emacs) @@ -5296,7 +5293,7 @@ argument. The styles are chosen from the `vhdl-style-alist' variable." (or vars (error "ERROR: Invalid VHDL indentation style `%s'" style)) ;; set all the variables - (mapcar + (mapc (function (lambda (varentry) (let ((var (car varentry)) @@ -5395,7 +5392,7 @@ negative, skip forward otherwise." (skip-chars-forward " \t\n")))) ;; XEmacs hack: work around buggy `forward-comment' in XEmacs 21.4+ -(unless (and vhdl-xemacs (string< "21.2" emacs-version)) +(unless (and (featurep 'xemacs) (string< "21.2" emacs-version)) (defalias 'vhdl-forward-comment 'forward-comment)) ;; This is the best we can do in Win-Emacs. @@ -7148,7 +7145,7 @@ ENDPOS is encountered." (actual (vhdl-get-syntactic-context)) (expurgated)) ;; remove the library unit symbols - (mapcar + (mapc (function (lambda (elt) (if (memq (car elt) '(entity configuration package @@ -9098,8 +9095,9 @@ otherwise." (progn (delete-region (point) (progn (end-of-line) (point))) (vhdl-template-insert-date)) (unless noerror - (error (concat "ERROR: Modification date prefix string \"" - vhdl-modify-date-prefix-string "\" not found"))))))) + (error "ERROR: Modification date prefix string \"%s\" not found" + vhdl-modify-date-prefix-string)))))) + (defun vhdl-template-modify-noerror () "Call `vhdl-template-modify' with NOERROR non-nil." @@ -10435,7 +10433,7 @@ with double-quotes is to be inserted. DEFAULT specifies a default string." "Query a decision from the user." (let ((start (point))) (when string (vhdl-insert-keyword (concat string " "))) - (message prompt) + (message "%s" (or prompt "")) (let ((char (read-char))) (delete-region start (point)) (if (and optional (eq char ?\r)) @@ -13013,7 +13011,7 @@ This does background highlighting of translate-off regions.") (defun vhdl-ps-print-init () "Initialize postscript printing." - (if vhdl-xemacs + (if (featurep 'xemacs) (when (boundp 'ps-print-color-p) (vhdl-ps-print-settings)) (make-local-variable 'ps-print-hook) @@ -14064,10 +14062,10 @@ if required." (save-excursion (beginning-of-line) (looking-at "[0-9]+:"))] ["Rescan Directory" vhdl-speedbar-rescan-hierarchy :active (save-excursion (beginning-of-line) (looking-at "[0-9]+:")) - ,(if vhdl-xemacs :active :visible) (not vhdl-speedbar-show-projects)] + ,(if (featurep 'xemacs) :active :visible) (not vhdl-speedbar-show-projects)] ["Rescan Project" vhdl-speedbar-rescan-hierarchy :active (save-excursion (beginning-of-line) (looking-at "[0-9]+:")) - ,(if vhdl-xemacs :active :visible) vhdl-speedbar-show-projects] + ,(if (featurep 'xemacs) :active :visible) vhdl-speedbar-show-projects] ["Save Caches" vhdl-save-caches vhdl-updated-project-list]))) ;; hook-ups (speedbar-add-expansion-list @@ -16189,7 +16187,7 @@ no project is defined." (assoc (car sublist) regexp-alist)) (setq regexp-alist (cons (list (nth 0 sublist) (if (= 0 (nth 1 sublist)) - (if vhdl-xemacs 9 nil) + (if (featurep 'xemacs) 9 nil) (nth 1 sublist)) (nth 2 sublist) (nth 3 sublist)) regexp-alist))) @@ -16989,7 +16987,7 @@ to visually support naming conventions.") (defun vhdl-doc-variable (variable) "Display VARIABLE's documentation in *Help* buffer." (interactive) - (unless vhdl-xemacs + (unless (featurep 'xemacs) (help-setup-xref (list #'vhdl-doc-variable variable) (interactive-p))) (with-output-to-temp-buffer (if (fboundp 'help-buffer) (help-buffer) "*Help*") @@ -17001,7 +16999,7 @@ to visually support naming conventions.") (defun vhdl-doc-mode () "Display VHDL Mode documentation in *Help* buffer." (interactive) - (unless vhdl-xemacs + (unless (featurep 'xemacs) (help-setup-xref (list #'vhdl-doc-mode) (interactive-p))) (with-output-to-temp-buffer (if (fboundp 'help-buffer) (help-buffer) "*Help*") diff --git a/lisp/progmodes/which-func.el b/lisp/progmodes/which-func.el index d498ffd940c..485a5583894 100644 --- a/lisp/progmodes/which-func.el +++ b/lisp/progmodes/which-func.el @@ -76,8 +76,9 @@ :version "20.3") (defcustom which-func-modes - '(emacs-lisp-mode c-mode c++-mode perl-mode cperl-mode makefile-mode - sh-mode fortran-mode f90-mode ada-mode) + '(emacs-lisp-mode c-mode c++-mode perl-mode cperl-mode python-mode + makefile-mode sh-mode fortran-mode f90-mode ada-mode + diff-mode) "List of major modes for which Which Function mode should be used. For other modes it is disabled. If this is equal to t, then Which Function mode is enabled in any major mode that supports it." diff --git a/lisp/progmodes/xscheme.el b/lisp/progmodes/xscheme.el index 41fe71207c9..750ff21304f 100644 --- a/lisp/progmodes/xscheme.el +++ b/lisp/progmodes/xscheme.el @@ -101,17 +101,17 @@ from being inserted into the process-buffer.") (setq-default scheme-mode-line-process '("" xscheme-runlight)) -(mapcar 'make-variable-buffer-local - '(xscheme-expressions-ring - xscheme-expressions-ring-yank-pointer - xscheme-process-filter-state - xscheme-running-p - xscheme-control-g-disabled-p - xscheme-allow-output-p - xscheme-prompt - xscheme-string-accumulator - xscheme-mode-string - scheme-mode-line-process)) +(mapc 'make-variable-buffer-local + '(xscheme-expressions-ring + xscheme-expressions-ring-yank-pointer + xscheme-process-filter-state + xscheme-running-p + xscheme-control-g-disabled-p + xscheme-allow-output-p + xscheme-prompt + xscheme-string-accumulator + xscheme-mode-string + scheme-mode-line-process)) (defgroup xscheme nil "Major mode for editing Scheme and interacting with MIT's C-Scheme." |