* 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'.
(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
;; 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))
)
(< 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)
(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
(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))
)
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)
"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)
(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)))))
(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))))
);; 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
(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)
(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)))
(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
(t
(when (not type-begin)
- (if identifiers
- (add-to-list 'identifiers text)
- (setq identifiers (list text)))))
+ (cl-pushnew text identifiers :test #'equal)))
))
paramlist))
(cond
((listp prj-dir)
- (add-to-list 'prj-dir dir))
+ (cl-pushnew dir prj-dir :test #'equal))
(prj-dir
(setq prj-dir (list dir)))
(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))
(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
;;
(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
(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")
;; 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)
(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))
;; 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)))
(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)
(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)
(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)
(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))
;; 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)))
(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))