[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[elpa] 02/02: * packages/ada-mode: Miscellaneous cleanups.
|
From: |
Stefan Monnier |
|
Subject: |
[elpa] 02/02: * packages/ada-mode: Miscellaneous cleanups. |
|
Date: |
Wed, 15 Oct 2014 21:38:45 +0000 |
monnier pushed a commit to branch master
in repository elpa.
commit 8c4f2e8d783e191f0a4e1ec0dc81bc0aceea4a1a
Author: Stefan Monnier <address@hidden>
Date: Wed Oct 15 17:38:21 2014 -0400
* packages/ada-mode: Miscellaneous cleanups.
* ada-mode/gpr-skel.el (skeleton-hippie-try): Don't quote error name.
* ada-mode/gpr-query.el (gpr-query-get-src-dirs, gpr-query-get-prj-dirs):
Avoid add-to-list on local vars.
(gpr-query-compilation): Use font-lock-ensure when available.
* ada-mode/gnat-inspect.el (gnat-inspect-compilation): Use
font-lock-ensure when available.
* ada-mode/gnat-core.el (gnat-prj-add-prj-dir)
(gnat-prj-parse-emacs-final, gnat-get-paths-1, ada-gnat-make-package-body):
Avoid add-to-list and `set' on local vars.
(gnat-get-paths-1): Don't quote error name.
* ada-mode/ada-wisi.el (ada-wisi-scan-paramlist): Avoid add-to-list on
local var.
* ada-mode/ada-skel.el (ada-skel-hippie-try): Don't quote error name.
* ada-mode/ada-mode.el (ada-format-paramlist): Fix typo.
(ada-case-read-exceptions, ada-case-add-exception, ada-prj-parse-file-1)
(ada-case-merge-exceptions): Avoid add-to-list on local var.
(ada-prj-parse-file-1): Avoid `set' on local var.
(cl-case): Don't quote alternatives.
* ada-mode/ada-gnat-compile.el (ada-gnat-fix-error): Avoid add-to-list on
local var. Simplify.
* ada-mode/ada-build.el (ada-build-prompt-select-prj-file): Remove
unused var `err'.
---
packages/ada-mode/ada-build.el | 4 +-
packages/ada-mode/ada-gnat-compile.el | 21 +++++++------------
packages/ada-mode/ada-mode.el | 32 +++++++++++++++---------------
packages/ada-mode/ada-skel.el | 2 +-
packages/ada-mode/ada-wisi.el | 8 +-----
packages/ada-mode/gnat-core.el | 35 +++++++++++++++++----------------
packages/ada-mode/gnat-inspect.el | 7 +++++-
packages/ada-mode/gpr-query.el | 21 +++++++++++++------
packages/ada-mode/gpr-skel.el | 2 +-
9 files changed, 68 insertions(+), 64 deletions(-)
diff --git a/packages/ada-mode/ada-build.el b/packages/ada-mode/ada-build.el
index 5a5af5f..1cc935f 100644
--- a/packages/ada-mode/ada-build.el
+++ b/packages/ada-mode/ada-build.el
@@ -185,7 +185,7 @@ Returns non-nil if a file is selected, nil otherwise."
(interactive)
(let ((ext (append ada-prj-file-extensions ada-prj-file-ext-extra))
filename)
- (condition-case err
+ (condition-case nil
(setq filename
(read-file-name
"Project file: " ; prompt
@@ -199,7 +199,7 @@ Returns non-nil if a file is selected, nil otherwise."
;; return a directory.
(or (file-accessible-directory-p name)
(member (file-name-extension name) ext)))))
- (err
+ (err ;FIXME: Shouldn't this be `error'?
(setq filename nil))
)
diff --git a/packages/ada-mode/ada-gnat-compile.el
b/packages/ada-mode/ada-gnat-compile.el
index b17ebe9..98f6580 100644
--- a/packages/ada-mode/ada-gnat-compile.el
+++ b/packages/ada-mode/ada-gnat-compile.el
@@ -222,25 +222,20 @@ Prompt user if more than one."
(< pos limit))))
(when (not done)
(let* ((item (get-text-property pos 'ada-secondary-error))
- (unit-file (nth 0 item)))
- (add-to-list 'choices (ada-ada-name-from-file-name
unit-file))
+ (unit-file (nth 0 item))
+ (choice (ada-ada-name-from-file-name unit-file)))
+ (unless (member choice choices) (push choice choices))
(goto-char (1+ pos))
(goto-char (1+ (next-single-property-change (point)
'ada-secondary-error nil limit)))
(when (eolp) (forward-line 1))
))
)));; unless while let
- (cond
- ((= 0 (length choices))
- (setq unit-name nil))
-
- ((= 1 (length choices))
- (setq unit-name (car choices)))
-
- (t ;; multiple choices
- (setq unit-name
- (completing-read "package name: " choices)))
- );; cond
+ (setq unit-name (cond
+ ((= 0 (length choices)) nil)
+ ((= 1 (length choices)) (car choices))
+ (t ;; multiple choices
+ (completing-read "package name: " choices))))
(when unit-name
(pop-to-buffer source-buffer)
diff --git a/packages/ada-mode/ada-mode.el b/packages/ada-mode/ada-mode.el
index 3248e13..cd9460a 100644
--- a/packages/ada-mode/ada-mode.el
+++ b/packages/ada-mode/ada-mode.el
@@ -628,7 +628,7 @@ Function is called with no arguments.")
(ada-goto-open-paren)
(funcall indent-line-function); so new list is indented properly
- (let* ((inibit-modification-hooks t)
+ (let* ((inhibit-modification-hooks t)
(begin (point))
(delend (progn (forward-sexp) (point))); just after matching closing
paren
(end (progn (backward-char) (forward-comment (- (point))) (point)));
end of last parameter-declaration
@@ -938,11 +938,11 @@ Return (cons full-exceptions partial-exceptions)."
(progn
(setq word (substring word 1))
(unless (assoc-string word partial-exceptions t)
- (add-to-list 'partial-exceptions (cons word t))))
+ (push (cons word t) partial-exceptions)))
;; full word exception
(unless (assoc-string word full-exceptions t)
- (add-to-list 'full-exceptions (cons word t))))
+ (push (cons word t) full-exceptions)))
(forward-line 1))
)
@@ -959,7 +959,7 @@ Return (cons full-exceptions partial-exceptions)."
An item in both lists has the RESULT value."
(dolist (item new)
(unless (assoc-string (car item) result t)
- (add-to-list 'result item)))
+ (push item result)))
result)
(defun ada-case-merge-all-exceptions (exceptions)
@@ -983,7 +983,7 @@ replacing current values of `ada-case-full-exceptions',
`ada-case-partial-except
"Add case exception WORD to EXCEPTIONS, replacing current entry, if any."
(if (assoc-string word exceptions t)
(setcar (assoc-string word exceptions t) word)
- (add-to-list 'exceptions (cons word t)))
+ (push (cons word t) exceptions))
exceptions)
(defun ada-case-create-exception (&optional word file-name partial)
@@ -1482,9 +1482,9 @@ Return new value of PROJECT."
(setq project (plist-put project 'case_strict (intern (match-string
2)))))
((string= (match-string 1) "casing")
- (add-to-list 'casing
- (expand-file-name
- (substitute-in-file-name (match-string 2)))))
+ (cl-pushnew (expand-file-name
+ (substitute-in-file-name (match-string 2)))
+ casing :test #'equal))
((string= (match-string 1) "el_file")
(let ((file (expand-file-name (substitute-in-file-name
(match-string 2)))))
@@ -1493,9 +1493,9 @@ Return new value of PROJECT."
(load-file file)))
((string= (match-string 1) "src_dir")
- (add-to-list 'src_dir
- (file-name-as-directory
- (expand-file-name (match-string 2)))))
+ (cl-pushnew (file-name-as-directory
+ (expand-file-name (match-string 2)))
+ src_dir :test #'equal))
((string= (match-string 1) "xref_tool")
(let ((xref (intern (match-string 2))))
@@ -1534,8 +1534,8 @@ Return new value of PROJECT."
);; done reading file
;; process accumulated lists
- (if casing (set 'project (plist-put project 'casing (reverse casing))))
- (if src_dir (set 'project (plist-put project 'src_dir (reverse src_dir))))
+ (if casing (setq project (plist-put project 'casing (reverse casing))))
+ (if src_dir (setq project (plist-put project 'src_dir (reverse src_dir))))
(when parse-final-compiler
;; parse-final-compiler may reference the "current project", so
@@ -2906,9 +2906,9 @@ The paragraph is indented on the first line."
(unless (featurep 'ada-xref-tool)
(cl-case ada-xref-tool
- ((nil 'gnat) (require 'ada-gnat-xref))
- ('gnat_inspect (require 'gnat-inspect))
- ('gpr_query (require 'gpr-query))
+ ((nil gnat) (require 'ada-gnat-xref))
+ (gnat_inspect (require 'gnat-inspect))
+ (gpr_query (require 'gpr-query))
))
(unless (featurep 'ada-compiler)
diff --git a/packages/ada-mode/ada-skel.el b/packages/ada-mode/ada-skel.el
index 48e6b32..dcd21c4 100644
--- a/packages/ada-mode/ada-skel.el
+++ b/packages/ada-mode/ada-skel.el
@@ -419,7 +419,7 @@ it is a name, and use the word before that as the token."
(progn
(ada-skel-expand)
t)
- ('error
+ (error
;; undo hook action if any
(unless (or (eq 't pending-undo-list)
(= undo-len (length pending-undo-list)))
diff --git a/packages/ada-mode/ada-wisi.el b/packages/ada-mode/ada-wisi.el
index 443ad66..1a5815f 100644
--- a/packages/ada-mode/ada-wisi.el
+++ b/packages/ada-mode/ada-wisi.el
@@ -1449,9 +1449,7 @@ Also return cache at start."
(setq param (list (reverse identifiers)
aliased-p in-p out-p not-null-p access-p constant-p
protected-p
type default))
- (if paramlist
- (add-to-list 'paramlist param)
- (setq paramlist (list param)))
+ (cl-pushnew param paramlist :test #'equal)
(setq identifiers nil
aliased-p nil
in-p nil
@@ -1468,9 +1466,7 @@ Also return cache at start."
(t
(when (not type-begin)
- (if identifiers
- (add-to-list 'identifiers text)
- (setq identifiers (list text)))))
+ (cl-pushnew text identifiers :test #'equal)))
))
paramlist))
diff --git a/packages/ada-mode/gnat-core.el b/packages/ada-mode/gnat-core.el
index b0449ee..a9d79ea 100644
--- a/packages/ada-mode/gnat-core.el
+++ b/packages/ada-mode/gnat-core.el
@@ -36,7 +36,7 @@
(cond
((listp prj-dir)
- (add-to-list 'prj-dir dir))
+ (cl-pushnew dir prj-dir :test #'equal))
(prj-dir
(setq prj-dir (list dir)))
@@ -99,7 +99,7 @@ See also `gnat-parse-emacs-final'."
(kill-buffer (gnat-run-buffer-name))); things may have changed, force
re-create
(if (ada-prj-get 'gpr_file project)
- (set 'project (gnat-parse-gpr (ada-prj-get 'gpr_file project) project))
+ (setq project (gnat-parse-gpr (ada-prj-get 'gpr_file project) project))
;; add the compiler libraries to src_dir
(setq project (gnat-get-paths project))
@@ -109,7 +109,7 @@ See also `gnat-parse-emacs-final'."
(defun gnat-get-paths-1 (src-dirs prj-dirs)
"Append list of source and project dirs in current gpr project to SRC-DIRS,
PRJ-DIRS.
-Uses 'gnat list'. Returns new '(src-dirs prj-dirs)."
+Uses 'gnat list'. Returns new (SRC-DIRS PRJ-DIRS)."
(with-current-buffer (gnat-run-buffer)
;; gnat list -v -P can return status 0 or 4; always lists compiler dirs
;;
@@ -128,12 +128,14 @@ Uses 'gnat list'. Returns new '(src-dirs prj-dirs)."
(forward-line 1)
(while (not (looking-at "^$")) ; terminate on blank line
(back-to-indentation) ; skip whitespace forward
- (if (looking-at "<Current_Directory>")
- (add-to-list 'src-dirs (directory-file-name default-directory))
- (add-to-list 'src-dirs
- (expand-file-name ; canonicalize path part
+ (cl-pushnew (if (looking-at "<Current_Directory>")
+ (directory-file-name default-directory)
+ (expand-file-name ; Canonicalize path part.
(directory-file-name
- (buffer-substring-no-properties (point)
(point-at-eol))))))
+ (buffer-substring-no-properties
+ (point) (point-at-eol)))))
+ src-dirs
+ :test #'equal)
(forward-line 1))
;; Project path
@@ -145,17 +147,16 @@ Uses 'gnat list'. Returns new '(src-dirs prj-dirs)."
(while (not (looking-at "^$"))
(back-to-indentation)
(if (looking-at "<Current_Directory>")
- (add-to-list 'prj-dirs ".")
- (add-to-list 'prj-dirs
- (expand-file-name
- (buffer-substring-no-properties (point)
(point-at-eol))))
- (add-to-list 'src-dirs
- (expand-file-name
- (buffer-substring-no-properties (point)
(point-at-eol)))))
+ (cl-pushnew "." prj-dirs :test #'equal)
+ (let ((f (expand-file-name
+ (buffer-substring-no-properties
+ (point) (point-at-eol)))))
+ (cl-pushnew f prj-dirs :test #'equal)
+ (cl-pushnew f src-dirs :test #'equal)))
(forward-line 1))
)
- ('error
+ (error
(pop-to-buffer (current-buffer))
;; search-forward failed
(error "parse gpr failed")
@@ -427,7 +428,7 @@ list."
;; need -f gnat stub option. We won't get here if there is an
;; existing body file.
(save-some-buffers t)
- (add-to-list 'opts "-f")
+ (cl-pushnew "-f" opts :test #'equal)
(with-current-buffer (gnat-run-buffer)
(gnat-run-no-prj
(append (list "stub") opts (list start-file "-cargs") switches)
diff --git a/packages/ada-mode/gnat-inspect.el
b/packages/ada-mode/gnat-inspect.el
index 8017879..5fb2d4b 100644
--- a/packages/ada-mode/gnat-inspect.el
+++ b/packages/ada-mode/gnat-inspect.el
@@ -213,8 +213,12 @@ set compilation-mode with compilation-error-regexp-alist
set to COMP-ERR."
(gnat-inspect-session-send cmd-1 t)
;; at EOB. gnatinspect returns one line per result
(setq result-count (- (line-number-at-pos) 1))
- (font-lock-fontify-buffer)
+ (if (fboundp 'font-lock-ensure)
+ (font-lock-ensure)
+ (font-lock-fontify-buffer))
;; font-lock-fontify-buffer applies compilation-message text properties
+ ;; NOTE: Won't be needed in 24.5 any more, since compilation-next-error
+ ;; will apply compilation-message text properties on the fly.
;; IMPROVEME: for some reason, next-error works, but the font
;; colors are not right (no koolaid!)
(goto-char (point-min))
@@ -226,6 +230,7 @@ set compilation-mode with compilation-error-regexp-alist
set to COMP-ERR."
;; just go there, don't display session-buffer. We have to
;; fetch the compilation-message while in the session-buffer.
(let* ((msg (compilation-next-error 0 nil (point-min)))
+ ;; FIXME: Woah! This is messing with very internal details!
(loc (compilation--message->loc msg)))
(setq file (caar (compilation--loc->file-struct loc))
line (caar (cddr (compilation--loc->file-struct loc)))
diff --git a/packages/ada-mode/gpr-query.el b/packages/ada-mode/gpr-query.el
index ae4ed8e..2ec0771 100644
--- a/packages/ada-mode/gpr-query.el
+++ b/packages/ada-mode/gpr-query.el
@@ -196,9 +196,9 @@ Uses 'gpr_query'. Returns new list."
(gpr-query-session-send "source_dirs" t)
(goto-char (point-min))
(while (not (looking-at gpr-query-prompt))
- (add-to-list 'src-dirs
- (directory-file-name
- (buffer-substring-no-properties (point) (point-at-eol))))
+ (cl-pushnew (directory-file-name
+ (buffer-substring-no-properties (point) (point-at-eol)))
+ src-dirs :test #'equal)
(forward-line 1))
)
src-dirs)
@@ -211,9 +211,9 @@ Uses 'gpr_query'. Returns new list."
(gpr-query-session-send "project_path" t)
(goto-char (point-min))
(while (not (looking-at gpr-query-prompt))
- (add-to-list 'prj-dirs
- (directory-file-name
- (buffer-substring-no-properties (point) (point-at-eol))))
+ (cl-pushnew (directory-file-name
+ (buffer-substring-no-properties (point) (point-at-eol)))
+ prj-dirs :test #'equal)
(forward-line 1))
)
prj-dirs)
@@ -246,6 +246,7 @@ set compilation-mode with compilation-error-regexp-alist
set to COMP-ERR."
(let ((cmd-1 (format "%s %s:%s:%d:%d" cmd identifier file line col))
(result-count 0)
file line column)
+ ;; FIXME: Code duplication with gnat-inspect-compilation!
(with-current-buffer (gpr-query--session-buffer (gpr-query-cached-session))
(compilation-mode)
(setq buffer-read-only nil)
@@ -253,8 +254,13 @@ set compilation-mode with compilation-error-regexp-alist
set to COMP-ERR."
(gpr-query-session-send cmd-1 t)
;; point is at EOB. gpr_query returns one line per result plus prompt
(setq result-count (- (line-number-at-pos) 1))
- (font-lock-fontify-buffer)
+ ;; Won't be needed in 24.5 any more.
+ (if (fboundp 'font-lock-ensure)
+ (font-lock-ensure)
+ (font-lock-fontify-buffer))
;; font-lock-fontify-buffer applies compilation-message text properties
+ ;; NOTE: Won't be needed in 24.5 any more, since compilation-next-error
+ ;; will apply compilation-message text properties on the fly.
;; IMPROVEME: for some reason, next-error works, but the font
;; colors are not right (no koolaid!)
(goto-char (point-min))
@@ -269,6 +275,7 @@ set compilation-mode with compilation-error-regexp-alist
set to COMP-ERR."
;; just go there, don't display session-buffer. We have to
;; fetch the compilation-message while in the session-buffer.
(let* ((msg (compilation-next-error 0 nil (point-min)))
+ ;; FIXME: Woah! This is messing with very internal details!
(loc (compilation--message->loc msg)))
(setq file (caar (compilation--loc->file-struct loc))
line (caar (cddr (compilation--loc->file-struct loc)))
diff --git a/packages/ada-mode/gpr-skel.el b/packages/ada-mode/gpr-skel.el
index eef3b76..9990f09 100644
--- a/packages/ada-mode/gpr-skel.el
+++ b/packages/ada-mode/gpr-skel.el
@@ -219,7 +219,7 @@ it is a name, and use the word before that as the token."
(progn
(skeleton-expand)
t)
- ('error
+ (error
;; undo hook action if any
(unless (= undo-len (if (sequencep pending-undo-list) (length
pending-undo-list) 0))
(undo))