| 1 |
|
|---|
| 2 |
|
|---|
| 3 |
|
|---|
| 4 |
|
|---|
| 5 |
|
|---|
| 6 |
|
|---|
| 7 |
|
|---|
| 8 |
|
|---|
| 9 |
|
|---|
| 10 |
|
|---|
| 11 |
|
|---|
| 12 |
|
|---|
| 13 |
|
|---|
| 14 |
|
|---|
| 15 |
|
|---|
| 16 |
|
|---|
| 17 |
|
|---|
| 18 |
|
|---|
| 19 |
|
|---|
| 20 |
|
|---|
| 21 |
|
|---|
| 22 |
|
|---|
| 23 |
|
|---|
| 24 |
|
|---|
| 25 |
|
|---|
| 26 |
|
|---|
| 27 |
|
|---|
| 28 |
|
|---|
| 29 |
|
|---|
| 30 |
|
|---|
| 31 |
|
|---|
| 32 |
|
|---|
| 33 |
|
|---|
| 34 |
|
|---|
| 35 |
|
|---|
| 36 |
|
|---|
| 37 |
|
|---|
| 38 |
|
|---|
| 39 |
|
|---|
| 40 |
|
|---|
| 41 |
|
|---|
| 42 |
|
|---|
| 43 |
|
|---|
| 44 |
|
|---|
| 45 |
|
|---|
| 46 |
|
|---|
| 47 |
|
|---|
| 48 |
|
|---|
| 49 |
|
|---|
| 50 |
(defvar elint-log-buffer "*Elint*" |
|---|
| 51 |
"*The buffer to insert lint messages in.") |
|---|
| 52 |
|
|---|
| 53 |
|
|---|
| 54 |
|
|---|
| 55 |
|
|---|
| 56 |
|
|---|
| 57 |
(defconst elint-standard-variables |
|---|
| 58 |
'(abbrev-mode auto-fill-function buffer-auto-save-file-name |
|---|
| 59 |
buffer-backed-up buffer-display-count buffer-display-table buffer-display-time buffer-file-coding-system buffer-file-format |
|---|
| 60 |
buffer-file-name buffer-file-number buffer-file-truename |
|---|
| 61 |
buffer-file-type buffer-invisibility-spec buffer-offer-save |
|---|
| 62 |
buffer-read-only buffer-saved-size buffer-undo-list |
|---|
| 63 |
cache-long-line-scans case-fold-search ctl-arrow cursor-type comment-column |
|---|
| 64 |
default-directory defun-prompt-regexp desktop-save-buffer enable-multibyte-characters fill-column fringes-outside-margins goal-column |
|---|
| 65 |
header-line-format indicate-buffer-boundaries indicate-empty-lines |
|---|
| 66 |
left-fringe-width |
|---|
| 67 |
left-margin left-margin-width line-spacing local-abbrev-table local-write-file-hooks major-mode |
|---|
| 68 |
mark-active mark-ring mode-line-buffer-identification |
|---|
| 69 |
mode-line-format mode-line-modified mode-line-process mode-name |
|---|
| 70 |
overwrite-mode |
|---|
| 71 |
point-before-scroll right-fringe-width right-margin-width |
|---|
| 72 |
scroll-bar-width scroll-down-aggressively scroll-up-aggressively selective-display |
|---|
| 73 |
selective-display-ellipses tab-width truncate-lines vc-mode vertical-scroll-bar) |
|---|
| 74 |
"Standard buffer local vars.") |
|---|
| 75 |
|
|---|
| 76 |
(defconst elint-unknown-builtin-args |
|---|
| 77 |
'((while test &rest forms) |
|---|
| 78 |
(insert-before-markers-and-inherit &rest text) |
|---|
| 79 |
(catch tag &rest body) |
|---|
| 80 |
(and &rest args) |
|---|
| 81 |
(funcall func &rest args) |
|---|
| 82 |
(insert &rest args) |
|---|
| 83 |
(vconcat &rest args) |
|---|
| 84 |
(run-hook-with-args hook &rest args) |
|---|
| 85 |
(message-or-box string &rest args) |
|---|
| 86 |
(save-window-excursion &rest body) |
|---|
| 87 |
(append &rest args) |
|---|
| 88 |
(logior &rest args) |
|---|
| 89 |
(progn &rest body) |
|---|
| 90 |
(insert-and-inherit &rest args) |
|---|
| 91 |
(message-box string &rest args) |
|---|
| 92 |
(prog2 x y &rest body) |
|---|
| 93 |
(prog1 first &rest body) |
|---|
| 94 |
(insert-before-markers &rest args) |
|---|
| 95 |
(call-process-region start end program &optional delete |
|---|
| 96 |
destination display &rest args) |
|---|
| 97 |
(concat &rest args) |
|---|
| 98 |
(vector &rest args) |
|---|
| 99 |
(run-hook-with-args-until-success hook &rest args) |
|---|
| 100 |
(track-mouse &rest body) |
|---|
| 101 |
(unwind-protect bodyform &rest unwindforms) |
|---|
| 102 |
(save-restriction &rest body) |
|---|
| 103 |
(quote arg) |
|---|
| 104 |
(make-byte-code &rest args) |
|---|
| 105 |
(or &rest args) |
|---|
| 106 |
(cond &rest clauses) |
|---|
| 107 |
(start-process name buffer program &rest args) |
|---|
| 108 |
(run-hook-with-args-until-failure hook &rest args) |
|---|
| 109 |
(if cond then &rest else) |
|---|
| 110 |
(apply function &rest args) |
|---|
| 111 |
(format string &rest args) |
|---|
| 112 |
(encode-time second minute hour day month year zone &rest args) |
|---|
| 113 |
(min &rest args) |
|---|
| 114 |
(logand &rest args) |
|---|
| 115 |
(logxor &rest args) |
|---|
| 116 |
(max &rest args) |
|---|
| 117 |
(list &rest args) |
|---|
| 118 |
(message string &rest args) |
|---|
| 119 |
(defvar symbol init doc) |
|---|
| 120 |
(call-process program &optional infile destination display &rest args) |
|---|
| 121 |
(with-output-to-temp-buffer bufname &rest body) |
|---|
| 122 |
(nconc &rest args) |
|---|
| 123 |
(save-excursion &rest body) |
|---|
| 124 |
(run-hooks &rest hooks) |
|---|
| 125 |
(/ x y &rest zs) |
|---|
| 126 |
(- x &rest y) |
|---|
| 127 |
(+ &rest args) |
|---|
| 128 |
(* &rest args) |
|---|
| 129 |
(interactive &optional args)) |
|---|
| 130 |
"Those built-ins for which we can't find arguments.") |
|---|
| 131 |
|
|---|
| 132 |
|
|---|
| 133 |
|
|---|
| 134 |
|
|---|
| 135 |
|
|---|
| 136 |
(defsubst elint-make-top-form (form pos) |
|---|
| 137 |
"Create a top form. |
|---|
| 138 |
FORM is the form, and POS is the point where it starts in the buffer." |
|---|
| 139 |
(cons form pos)) |
|---|
| 140 |
|
|---|
| 141 |
(defsubst elint-top-form-form (top-form) |
|---|
| 142 |
"Extract the form from a TOP-FORM." |
|---|
| 143 |
(car top-form)) |
|---|
| 144 |
|
|---|
| 145 |
(defsubst elint-top-form-pos (top-form) |
|---|
| 146 |
"Extract the position from a TOP-FORM." |
|---|
| 147 |
(cdr top-form)) |
|---|
| 148 |
|
|---|
| 149 |
|
|---|
| 150 |
|
|---|
| 151 |
|
|---|
| 152 |
|
|---|
| 153 |
(defsubst elint-make-env () |
|---|
| 154 |
"Create an empty environment." |
|---|
| 155 |
(list (list nil) nil nil)) |
|---|
| 156 |
|
|---|
| 157 |
(defsubst elint-env-add-env (env newenv) |
|---|
| 158 |
"Augment ENV with NEWENV. |
|---|
| 159 |
None of them is modified, and the new env is returned." |
|---|
| 160 |
(list (append (car env) (car newenv)) |
|---|
| 161 |
(append (car (cdr env)) (car (cdr newenv))) |
|---|
| 162 |
(append (car (cdr (cdr env))) (car (cdr (cdr newenv)))))) |
|---|
| 163 |
|
|---|
| 164 |
(defsubst elint-env-add-var (env var) |
|---|
| 165 |
"Augment ENV with the variable VAR. |
|---|
| 166 |
The new environment is returned, the old is unmodified." |
|---|
| 167 |
(cons (cons (list var) (car env)) (cdr env))) |
|---|
| 168 |
|
|---|
| 169 |
(defsubst elint-env-add-global-var (env var) |
|---|
| 170 |
"Augment ENV with the variable VAR. |
|---|
| 171 |
ENV is modified so VAR is seen everywhere. |
|---|
| 172 |
ENV is returned." |
|---|
| 173 |
(nconc (car env) (list (list var))) |
|---|
| 174 |
env) |
|---|
| 175 |
|
|---|
| 176 |
(defsubst elint-env-find-var (env var) |
|---|
| 177 |
"Non-nil if ENV contains the variable VAR. |
|---|
| 178 |
Actually, a list with VAR as a single element is returned." |
|---|
| 179 |
(assq var (car env))) |
|---|
| 180 |
|
|---|
| 181 |
(defsubst elint-env-add-func (env func args) |
|---|
| 182 |
"Augment ENV with the function FUNC, which has the arguments ARGS. |
|---|
| 183 |
The new environment is returned, the old is unmodified." |
|---|
| 184 |
(list (car env) |
|---|
| 185 |
(cons (list func args) (car (cdr env))) |
|---|
| 186 |
(car (cdr (cdr env))))) |
|---|
| 187 |
|
|---|
| 188 |
(defsubst elint-env-find-func (env func) |
|---|
| 189 |
"Non-nil if ENV contains the function FUNC. |
|---|
| 190 |
Actually, a list of (FUNC ARGS) is returned." |
|---|
| 191 |
(assq func (car (cdr env)))) |
|---|
| 192 |
|
|---|
| 193 |
(defsubst elint-env-add-macro (env macro def) |
|---|
| 194 |
"Augment ENV with the macro named MACRO. |
|---|
| 195 |
DEF is the macro definition (a lambda expression or similar). |
|---|
| 196 |
The new environment is returned, the old is unmodified." |
|---|
| 197 |
(list (car env) |
|---|
| 198 |
(car (cdr env)) |
|---|
| 199 |
(cons (cons macro def) (car (cdr (cdr env)))))) |
|---|
| 200 |
|
|---|
| 201 |
(defsubst elint-env-macro-env (env) |
|---|
| 202 |
"Return the macro environment of ENV. |
|---|
| 203 |
This environment can be passed to `macroexpand'." |
|---|
| 204 |
(car (cdr (cdr env)))) |
|---|
| 205 |
|
|---|
| 206 |
(defsubst elint-env-macrop (env macro) |
|---|
| 207 |
"Non-nil if ENV contains MACRO." |
|---|
| 208 |
(assq macro (elint-env-macro-env env))) |
|---|
| 209 |
|
|---|
| 210 |
|
|---|
| 211 |
|
|---|
| 212 |
|
|---|
| 213 |
|
|---|
| 214 |
(defun elint-current-buffer () |
|---|
| 215 |
"Lint the current buffer." |
|---|
| 216 |
(interactive) |
|---|
| 217 |
(elint-clear-log (format "Linting %s" (if (buffer-file-name) |
|---|
| 218 |
(buffer-file-name) |
|---|
| 219 |
(buffer-name)))) |
|---|
| 220 |
(elint-display-log) |
|---|
| 221 |
(mapcar 'elint-top-form (elint-update-env)) |
|---|
| 222 |
|
|---|
| 223 |
|
|---|
| 224 |
|
|---|
| 225 |
|
|---|
| 226 |
(let ((elint-top-form-logged t)) |
|---|
| 227 |
(elint-log-message "\nLinting complete.\n"))) |
|---|
| 228 |
|
|---|
| 229 |
(defun elint-defun () |
|---|
| 230 |
"Lint the function at point." |
|---|
| 231 |
(interactive) |
|---|
| 232 |
(save-excursion |
|---|
| 233 |
(if (not (beginning-of-defun)) |
|---|
| 234 |
(error "Lint what?")) |
|---|
| 235 |
|
|---|
| 236 |
(let ((pos (point)) |
|---|
| 237 |
(def (read (current-buffer)))) |
|---|
| 238 |
(elint-display-log) |
|---|
| 239 |
|
|---|
| 240 |
(elint-update-env) |
|---|
| 241 |
(elint-top-form (elint-make-top-form def pos))))) |
|---|
| 242 |
|
|---|
| 243 |
|
|---|
| 244 |
|
|---|
| 245 |
|
|---|
| 246 |
|
|---|
| 247 |
(defvar elint-buffer-env nil |
|---|
| 248 |
"The environment of a elisp buffer. |
|---|
| 249 |
Will be local in linted buffers.") |
|---|
| 250 |
|
|---|
| 251 |
(defvar elint-buffer-forms nil |
|---|
| 252 |
"The top forms in a buffer. |
|---|
| 253 |
Will be local in linted buffers.") |
|---|
| 254 |
|
|---|
| 255 |
(defvar elint-last-env-time nil |
|---|
| 256 |
"The last time the buffers env was updated. |
|---|
| 257 |
Is measured in buffer-modified-ticks and is local in linted buffers.") |
|---|
| 258 |
|
|---|
| 259 |
(defun elint-update-env () |
|---|
| 260 |
"Update the elint environment in the current buffer. |
|---|
| 261 |
Don't do anything if the buffer hasn't been changed since this |
|---|
| 262 |
function was called the last time. |
|---|
| 263 |
Returns the forms." |
|---|
| 264 |
(if (and (local-variable-p 'elint-buffer-env (current-buffer)) |
|---|
| 265 |
(local-variable-p 'elint-buffer-forms (current-buffer)) |
|---|
| 266 |
(local-variable-p 'elint-last-env-time (current-buffer)) |
|---|
| 267 |
(= (buffer-modified-tick) elint-last-env-time)) |
|---|
| 268 |
|
|---|
| 269 |
elint-buffer-forms |
|---|
| 270 |
|
|---|
| 271 |
(set (make-local-variable 'elint-buffer-forms) (elint-get-top-forms)) |
|---|
| 272 |
(set (make-local-variable 'elint-buffer-env) |
|---|
| 273 |
(elint-init-env elint-buffer-forms)) |
|---|
| 274 |
(set (make-local-variable 'elint-last-env-time) (buffer-modified-tick)) |
|---|
| 275 |
elint-buffer-forms)) |
|---|
| 276 |
|
|---|
| 277 |
(defun elint-get-top-forms () |
|---|
| 278 |
"Collect all the top forms in the current buffer." |
|---|
| 279 |
(save-excursion |
|---|
| 280 |
(let ((tops nil)) |
|---|
| 281 |
(goto-char (point-min)) |
|---|
| 282 |
(while (elint-find-next-top-form) |
|---|
| 283 |
(let ((pos (point))) |
|---|
| 284 |
(condition-case nil |
|---|
| 285 |
(setq tops (cons |
|---|
| 286 |
(elint-make-top-form (read (current-buffer)) pos) |
|---|
| 287 |
tops)) |
|---|
| 288 |
(end-of-file |
|---|
| 289 |
(goto-char pos) |
|---|
| 290 |
(end-of-line) |
|---|
| 291 |
(error "Missing ')' in top form: %s" (buffer-substring pos (point))))) |
|---|
| 292 |
)) |
|---|
| 293 |
(nreverse tops)))) |
|---|
| 294 |
|
|---|
| 295 |
(defun elint-find-next-top-form () |
|---|
| 296 |
"Find the next top form from point. |
|---|
| 297 |
Return nil if there are no more forms, t otherwise." |
|---|
| 298 |
(parse-partial-sexp (point) (point-max) nil t) |
|---|
| 299 |
(not (eobp))) |
|---|
| 300 |
|
|---|
| 301 |
(defun elint-init-env (forms) |
|---|
| 302 |
"Initialize the environment from FORMS." |
|---|
| 303 |
(let ((env (elint-make-env)) |
|---|
| 304 |
form) |
|---|
| 305 |
(while forms |
|---|
| 306 |
(setq form (elint-top-form-form (car forms)) |
|---|
| 307 |
forms (cdr forms)) |
|---|
| 308 |
(cond |
|---|
| 309 |
|
|---|
| 310 |
((memq (car form) '(defvar defconst defcustom)) |
|---|
| 311 |
(setq env (elint-env-add-var env (car (cdr form))))) |
|---|
| 312 |
|
|---|
| 313 |
((memq (car form) '(defun defsubst)) |
|---|
| 314 |
(setq env (elint-env-add-func env (car (cdr form)) |
|---|
| 315 |
(car (cdr (cdr form)))))) |
|---|
| 316 |
|
|---|
| 317 |
((eq (car form) 'defmacro) |
|---|
| 318 |
(setq env (elint-env-add-macro env (car (cdr form)) |
|---|
| 319 |
(cons 'lambda |
|---|
| 320 |
(cdr (cdr form)))) |
|---|
| 321 |
env (elint-env-add-func env (car (cdr form)) |
|---|
| 322 |
(car (cdr (cdr form)))))) |
|---|
| 323 |
|
|---|
| 324 |
|
|---|
| 325 |
((eq (car form) 'require) |
|---|
| 326 |
(let ((name (eval (car (cdr form)))) |
|---|
| 327 |
(file (eval (car (cdr (cdr form)))))) |
|---|
| 328 |
(setq env (elint-add-required-env env name file)))) |
|---|
| 329 |
)) |
|---|
| 330 |
env)) |
|---|
| 331 |
|
|---|
| 332 |
(defun elint-add-required-env (env name file) |
|---|
| 333 |
"Augment ENV with the variables definied by feature NAME in FILE." |
|---|
| 334 |
(condition-case nil |
|---|
| 335 |
(let* ((libname (if (stringp file) |
|---|
| 336 |
file |
|---|
| 337 |
(symbol-name name))) |
|---|
| 338 |
|
|---|
| 339 |
|
|---|
| 340 |
(lib1 (locate-library (concat libname ".el") t)) |
|---|
| 341 |
(lib (if lib1 lib1 (locate-library libname t)))) |
|---|
| 342 |
|
|---|
| 343 |
(message nil) |
|---|
| 344 |
(if lib |
|---|
| 345 |
(save-excursion |
|---|
| 346 |
(set-buffer (find-file-noselect lib)) |
|---|
| 347 |
(elint-update-env) |
|---|
| 348 |
(setq env (elint-env-add-env env elint-buffer-env))) |
|---|
| 349 |
(error "dummy error..."))) |
|---|
| 350 |
(error |
|---|
| 351 |
(ding) |
|---|
| 352 |
(message "Can't get variables from require'd library %s" name))) |
|---|
| 353 |
env) |
|---|
| 354 |
|
|---|
| 355 |
(defun regexp-assoc (regexp alist) |
|---|
| 356 |
"Search for a key matching REGEXP in ALIST." |
|---|
| 357 |
(let ((res nil)) |
|---|
| 358 |
(while (and alist (not res)) |
|---|
| 359 |
(if (and (stringp (car (car alist))) |
|---|
| 360 |
(string-match regexp (car (car alist)))) |
|---|
| 361 |
(setq res (car alist)) |
|---|
| 362 |
(setq alist (cdr alist)))) |
|---|
| 363 |
res)) |
|---|
| 364 |
|
|---|
| 365 |
(defvar elint-top-form nil |
|---|
| 366 |
"The currently linted top form, or nil.") |
|---|
| 367 |
|
|---|
| 368 |
(defvar elint-top-form-logged nil |
|---|
| 369 |
"T if the currently linted top form has been mentioned in the log buffer.") |
|---|
| 370 |
|
|---|
| 371 |
(defun elint-top-form (form) |
|---|
| 372 |
"Lint a top FORM." |
|---|
| 373 |
(let ((elint-top-form form) |
|---|
| 374 |
(elint-top-form-logged nil)) |
|---|
| 375 |
(elint-form (elint-top-form-form form) elint-buffer-env))) |
|---|
| 376 |
|
|---|
| 377 |
|
|---|
| 378 |
|
|---|
| 379 |
|
|---|
| 380 |
|
|---|
| 381 |
(defconst elint-special-forms |
|---|
| 382 |
'((let . elint-check-let-form) |
|---|
| 383 |
(let* . elint-check-let-form) |
|---|
| 384 |
(setq . elint-check-setq-form) |
|---|
| 385 |
(quote . elint-check-quote-form) |
|---|
| 386 |
(cond . elint-check-cond-form) |
|---|
| 387 |
(lambda . elint-check-defun-form) |
|---|
| 388 |
(function . elint-check-function-form) |
|---|
| 389 |
(setq-default . elint-check-setq-form) |
|---|
| 390 |
(defun . elint-check-defun-form) |
|---|
| 391 |
(defsubst . elint-check-defun-form) |
|---|
| 392 |
(defmacro . elint-check-defun-form) |
|---|
| 393 |
(defvar . elint-check-defvar-form) |
|---|
| 394 |
(defconst . elint-check-defvar-form) |
|---|
| 395 |
(defcustom . elint-check-defcustom-form) |
|---|
| 396 |
(macro . elint-check-macro-form) |
|---|
| 397 |
(condition-case . elint-check-condition-case-form)) |
|---|
| 398 |
"Functions to call when some special form should be linted.") |
|---|
| 399 |
|
|---|
| 400 |
(defun elint-form (form env) |
|---|
| 401 |
"Lint FORM in the environment ENV. |
|---|
| 402 |
The environment created by the form is returned." |
|---|
| 403 |
(cond |
|---|
| 404 |
((consp form) |
|---|
| 405 |
(let ((func (cdr (assq (car form) elint-special-forms)))) |
|---|
| 406 |
(if func |
|---|
| 407 |
|
|---|
| 408 |
(funcall func form env) |
|---|
| 409 |
|
|---|
| 410 |
(let* ((func (car form)) |
|---|
| 411 |
(args (elint-get-args func env)) |
|---|
| 412 |
(argsok t)) |
|---|
| 413 |
(cond |
|---|
| 414 |
((eq args 'undefined) |
|---|
| 415 |
(setq argsok nil) |
|---|
| 416 |
(elint-error "Call to undefined function: %s" form)) |
|---|
| 417 |
|
|---|
| 418 |
((eq args 'unknown) nil) |
|---|
| 419 |
|
|---|
| 420 |
(t (setq argsok (elint-match-args form args)))) |
|---|
| 421 |
|
|---|
| 422 |
|
|---|
| 423 |
(if (elint-env-macrop env func) |
|---|
| 424 |
|
|---|
| 425 |
(if argsok |
|---|
| 426 |
(elint-form (macroexpand form (elint-env-macro-env env)) env) |
|---|
| 427 |
env) |
|---|
| 428 |
|
|---|
| 429 |
(let ((fcode (if (symbolp func) |
|---|
| 430 |
(if (fboundp func) |
|---|
| 431 |
(indirect-function func) |
|---|
| 432 |
nil) |
|---|
| 433 |
func))) |
|---|
| 434 |
(if (and (listp fcode) (eq (car fcode) 'macro)) |
|---|
| 435 |
|
|---|
| 436 |
(if argsok |
|---|
| 437 |
(elint-form (macroexpand form) env) |
|---|
| 438 |
env) |
|---|
| 439 |
|
|---|
| 440 |
(elint-forms (cdr form) env)))) |
|---|
| 441 |
)) |
|---|
| 442 |
)) |
|---|
| 443 |
((symbolp form) |
|---|
| 444 |
|
|---|
| 445 |
(if (and (/= (aref (symbol-name form) 0) ?:) |
|---|
| 446 |
(elint-unbound-variable form env)) |
|---|
| 447 |
(elint-warning "Reference to unbound symbol: %s" form)) |
|---|
| 448 |
env) |
|---|
| 449 |
|
|---|
| 450 |
(t env) |
|---|
| 451 |
)) |
|---|
| 452 |
|
|---|
| 453 |
(defun elint-forms (forms env) |
|---|
| 454 |
"Lint the FORMS, accumulating an environment, starting with ENV." |
|---|
| 455 |
|
|---|
| 456 |
(while forms |
|---|
| 457 |
(setq env (elint-form (car forms) env) |
|---|
| 458 |
forms (cdr forms))) |
|---|
| 459 |
env) |
|---|
| 460 |
|
|---|
| 461 |
(defun elint-unbound-variable (var env) |
|---|
| 462 |
"T if VAR is unbound in ENV." |
|---|
| 463 |
(not (or (eq var nil) |
|---|
| 464 |
(eq var t) |
|---|
| 465 |
(elint-env-find-var env var) |
|---|
| 466 |
(memq var elint-standard-variables)))) |
|---|
| 467 |
|
|---|
| 468 |
|
|---|
| 469 |
|
|---|
| 470 |
|
|---|
| 471 |
|
|---|
| 472 |
(defun elint-match-args (arglist argpattern) |
|---|
| 473 |
"Match ARGLIST against ARGPATTERN." |
|---|
| 474 |
|
|---|
| 475 |
(let ((state 'all) |
|---|
| 476 |
(al (cdr arglist)) |
|---|
| 477 |
(ap argpattern) |
|---|
| 478 |
(ok t)) |
|---|
| 479 |
(while |
|---|
| 480 |
(cond |
|---|
| 481 |
((and (null al) (null ap)) nil) |
|---|
| 482 |
((eq (car ap) '&optional) |
|---|
| 483 |
(setq state 'optional) |
|---|
| 484 |
(setq ap (cdr ap)) |
|---|
| 485 |
t) |
|---|
| 486 |
((eq (car ap) '&rest) |
|---|
| 487 |
nil) |
|---|
| 488 |
((or (and (eq state 'all) (or (null al) (null ap))) |
|---|
| 489 |
(and (eq state 'optional) (and al (null ap)))) |
|---|
| 490 |
(elint-error "Wrong number of args: %s, %s" arglist argpattern) |
|---|
| 491 |
(setq ok nil) |
|---|
| 492 |
nil) |
|---|
| 493 |
((and (eq state 'optional) (null al)) |
|---|
| 494 |
nil) |
|---|
| 495 |
(t (setq al (cdr al) |
|---|
| 496 |
ap (cdr ap)) |
|---|
| 497 |
t))) |
|---|
| 498 |
ok)) |
|---|
| 499 |
|
|---|
| 500 |
(defun elint-get-args (func env) |
|---|
| 501 |
"Find the args of FUNC in ENV. |
|---|
| 502 |
Returns `unknown' if we couldn't find arguments." |
|---|
| 503 |
(let ((f (elint-env-find-func env func))) |
|---|
| 504 |
(if f |
|---|
| 505 |
(car (cdr f)) |
|---|
| 506 |
(if (symbolp func) |
|---|
| 507 |
(if (fboundp func) |
|---|
| 508 |
(let ((fcode (indirect-function func))) |
|---|
| 509 |
(if (subrp fcode) |
|---|
| 510 |
(let ((args (get func 'elint-args))) |
|---|
| 511 |
(if args args 'unknown)) |
|---|
| 512 |
(elint-find-args-in-code fcode))) |
|---|
| 513 |
'undefined) |
|---|
| 514 |
(elint-find-args-in-code func))))) |
|---|
| 515 |
|
|---|
| 516 |
(defun elint-find-args-in-code (code) |
|---|
| 517 |
"Extract the arguments from CODE. |
|---|
| 518 |
CODE can be a lambda expression, a macro, or byte-compiled code." |
|---|
| 519 |
(cond |
|---|
| 520 |
((byte-code-function-p code) |
|---|
| 521 |
(aref code 0)) |
|---|
| 522 |
((and (listp code) (eq (car code) 'lambda)) |
|---|
| 523 |
(car (cdr code))) |
|---|
| 524 |
((and (listp code) (eq (car code) 'macro)) |
|---|
| 525 |
(elint-find-args-in-code (cdr code))) |
|---|
| 526 |
(t 'unknown))) |
|---|
| 527 |
|
|---|
| 528 |
|
|---|
| 529 |
|
|---|
| 530 |
|
|---|
| 531 |
|
|---|
| 532 |
(defun elint-check-cond-form (form env) |
|---|
| 533 |
"Lint a cond FORM in ENV." |
|---|
| 534 |
(setq form (cdr form)) |
|---|
| 535 |
(while form |
|---|
| 536 |
(if (consp (car form)) |
|---|
| 537 |
(elint-forms (car form) env) |
|---|
| 538 |
(elint-error "cond clause should be a list: %s" (car form))) |
|---|
| 539 |
(setq form (cdr form))) |
|---|
| 540 |
env) |
|---|
| 541 |
|
|---|
| 542 |
(defun elint-check-defun-form (form env) |
|---|
| 543 |
"Lint a defun/defmacro/lambda FORM in ENV." |
|---|
| 544 |
(setq form (if (eq (car form) 'lambda) (cdr form) (cdr (cdr form)))) |
|---|
| 545 |
(mapcar (function (lambda (p) |
|---|
| 546 |
(or (memq p '(&optional &rest)) |
|---|
| 547 |
(setq env (elint-env-add-var env p))) |
|---|
| 548 |
)) |
|---|
| 549 |
(car form)) |
|---|
| 550 |
(elint-forms (cdr form) env)) |
|---|
| 551 |
|
|---|
| 552 |
(defun elint-check-let-form (form env) |
|---|
| 553 |
"Lint the let/let* FORM in ENV." |
|---|
| 554 |
(let ((varlist (car (cdr form)))) |
|---|
| 555 |
(if (not varlist) |
|---|
| 556 |
(progn |
|---|
| 557 |
(elint-error "Missing varlist in let: %s" form) |
|---|
| 558 |
env) |
|---|
| 559 |
|
|---|
| 560 |
|
|---|
| 561 |
(if (and (= (length varlist) 2) |
|---|
| 562 |
(symbolp (car varlist)) |
|---|
| 563 |
(listp (car (cdr varlist))) |
|---|
| 564 |
(fboundp (car (car (cdr varlist))))) |
|---|
| 565 |
(elint-warning "Suspect varlist: %s" form)) |
|---|
| 566 |
|
|---|
| 567 |
|
|---|
| 568 |
(let ((newenv env)) |
|---|
| 569 |
(mapcar (function (lambda (s) |
|---|
| 570 |
(cond |
|---|
| 571 |
((symbolp s) |
|---|
| 572 |
(setq newenv (elint-env-add-var newenv s))) |
|---|
| 573 |
((and (consp s) (<= (length s) 2)) |
|---|
| 574 |
(elint-form (car (cdr s)) |
|---|
| 575 |
(if (eq (car form) 'let) |
|---|
| 576 |
env |
|---|
| 577 |
newenv)) |
|---|
| 578 |
(setq newenv |
|---|
| 579 |
(elint-env-add-var newenv (car s)))) |
|---|
| 580 |
(t (elint-error |
|---|
| 581 |
"Malformed `let' declaration: %s" s)) |
|---|
| 582 |
))) |
|---|
| 583 |
varlist) |
|---|
| 584 |
|
|---|
| 585 |
|
|---|
| 586 |
(elint-forms (cdr (cdr form)) newenv) |
|---|
| 587 |
)))) |
|---|
| 588 |
|
|---|
| 589 |
(defun elint-check-setq-form (form env) |
|---|
| 590 |
"Lint the setq FORM in ENV." |
|---|
| 591 |
(or (= (mod (length form) 2) 1) |
|---|
| 592 |
(elint-error "Missing value in setq: %s" form)) |
|---|
| 593 |
|
|---|
| 594 |
(let ((newenv env) |
|---|
| 595 |
sym val) |
|---|
| 596 |
(setq form (cdr form)) |
|---|
| 597 |
(while form |
|---|
| 598 |
(setq sym (car form) |
|---|
| 599 |
val (car (cdr form)) |
|---|
| 600 |
form (cdr (cdr form))) |
|---|
| 601 |
(if (symbolp sym) |
|---|
| 602 |
(if (elint-unbound-variable sym newenv) |
|---|
| 603 |
(elint-warning "Setting previously unbound symbol: %s" sym)) |
|---|
| 604 |
(elint-error "Setting non-symbol in setq: %s" sym)) |
|---|
| 605 |
(elint-form val newenv) |
|---|
| 606 |
(if (symbolp sym) |
|---|
| 607 |
(setq newenv (elint-env-add-var newenv sym)))) |
|---|
| 608 |
newenv)) |
|---|
| 609 |
|
|---|
| 610 |
(defun elint-check-defvar-form (form env) |
|---|
| 611 |
"Lint the defvar/defconst FORM in ENV." |
|---|
| 612 |
(if (or (= (length form) 2) |
|---|
| 613 |
(= (length form) 3) |
|---|
| 614 |
(and (= (length form) 4) (stringp (nth 3 form)))) |
|---|
| 615 |
(elint-env-add-global-var (elint-form (nth 2 form) env) |
|---|
| 616 |
(car (cdr form))) |
|---|
| 617 |
(elint-error "Malformed variable declaration: %s" form) |
|---|
| 618 |
env)) |
|---|
| 619 |
|
|---|
| 620 |
(defun elint-check-defcustom-form (form env) |
|---|
| 621 |
"Lint the defcustom FORM in ENV." |
|---|
| 622 |
(if (and (> (length form) 3) |
|---|
| 623 |
|
|---|
| 624 |
(zerop (logand (length form) 1))) |
|---|
| 625 |
(elint-env-add-global-var (elint-form (nth 2 form) env) |
|---|
| 626 |
(car (cdr form))) |
|---|
| 627 |
(elint-error "Malformed variable declaration: %s" form) |
|---|
| 628 |
env)) |
|---|
| 629 |
|
|---|
| 630 |
(defun elint-check-function-form (form env) |
|---|
| 631 |
"Lint the function FORM in ENV." |
|---|
| 632 |
(let ((func (car (cdr-safe form)))) |
|---|
| 633 |
(cond |
|---|
| 634 |
((symbolp func) |
|---|
| 635 |
(or (elint-env-find-func env func) |
|---|
| 636 |
(fboundp func) |
|---|
| 637 |
(elint-warning "Reference to undefined function: %s" form)) |
|---|
| 638 |
env) |
|---|
| 639 |
((and (consp func) (memq (car func) '(lambda macro))) |
|---|
| 640 |
(elint-form func env)) |
|---|
| 641 |
((stringp func) env) |
|---|
| 642 |
(t (elint-error "Not a function object: %s" form) |
|---|
| 643 |
env) |
|---|
| 644 |
))) |
|---|
| 645 |
|
|---|
| 646 |
(defun elint-check-quote-form (form env) |
|---|
| 647 |
"Lint the quote FORM in ENV." |
|---|
| 648 |
env) |
|---|
| 649 |
|
|---|
| 650 |
(defun elint-check-macro-form (form env) |
|---|
| 651 |
"Check the macro FORM in ENV." |
|---|
| 652 |
(elint-check-function-form (list (car form) (cdr form)) env)) |
|---|
| 653 |
|
|---|
| 654 |
(defun elint-check-condition-case-form (form env) |
|---|
| 655 |
"Check the condition-case FORM in ENV." |
|---|
| 656 |
(let ((resenv env)) |
|---|
| 657 |
(if (< (length form) 3) |
|---|
| 658 |
(elint-error "Malformed condition-case: %s" form) |
|---|
| 659 |
(or (symbolp (car (cdr form))) |
|---|
| 660 |
(elint-warning "First parameter should be a symbol: %s" form)) |
|---|
| 661 |
(setq resenv (elint-form (nth 2 form) env)) |
|---|
| 662 |
|
|---|
| 663 |
(let ((newenv (elint-env-add-var env (car (cdr form)))) |
|---|
| 664 |
(errforms (nthcdr 3 form)) |
|---|
| 665 |
errlist) |
|---|
| 666 |
(while errforms |
|---|
| 667 |
(setq errlist (car (car errforms))) |
|---|
| 668 |
(mapcar (function (lambda (s) |
|---|
| 669 |
(or (get s 'error-conditions) |
|---|
| 670 |
(get s 'error-message) |
|---|
| 671 |
(elint-warning |
|---|
| 672 |
"Not an error symbol in error handler: %s" s)))) |
|---|
| 673 |
(cond |
|---|
| 674 |
((symbolp errlist) (list errlist)) |
|---|
| 675 |
((listp errlist) errlist) |
|---|
| 676 |
(t (elint-error "Bad error list in error handler: %s" |
|---|
| 677 |
errlist) |
|---|
| 678 |
nil)) |
|---|
| 679 |
) |
|---|
| 680 |
(elint-forms (cdr (car errforms)) newenv) |
|---|
| 681 |
(setq errforms (cdr errforms)) |
|---|
| 682 |
))) |
|---|
| 683 |
resenv)) |
|---|
| 684 |
|
|---|
| 685 |
|
|---|
| 686 |
|
|---|
| 687 |
|
|---|
| 688 |
|
|---|
| 689 |
|
|---|
| 690 |
|
|---|
| 691 |
|
|---|
| 692 |
(defun elint-error (string &rest args) |
|---|
| 693 |
"Report a linting error. |
|---|
| 694 |
STRING and ARGS are thrown on `format' to get the message." |
|---|
| 695 |
(let ((errstr (apply 'format string args))) |
|---|
| 696 |
(elint-log-message errstr) |
|---|
| 697 |
)) |
|---|
| 698 |
|
|---|
| 699 |
(defun elint-warning (string &rest args) |
|---|
| 700 |
"Report a linting warning. |
|---|
| 701 |
STRING and ARGS are thrown on `format' to get the message." |
|---|
| 702 |
(let ((errstr (apply 'format string args))) |
|---|
| 703 |
(elint-log-message errstr) |
|---|
| 704 |
)) |
|---|
| 705 |
|
|---|
| 706 |
(defun elint-log-message (errstr) |
|---|
| 707 |
"Insert ERRSTR last in the lint log buffer." |
|---|
| 708 |
(save-excursion |
|---|
| 709 |
(set-buffer (elint-get-log-buffer)) |
|---|
| 710 |
(goto-char (point-max)) |
|---|
| 711 |
(or (bolp) (newline)) |
|---|
| 712 |
|
|---|
| 713 |
|
|---|
| 714 |
(if elint-top-form-logged |
|---|
| 715 |
nil |
|---|
| 716 |
(insert |
|---|
| 717 |
(let* ((form (elint-top-form-form elint-top-form)) |
|---|
| 718 |
(top (car form))) |
|---|
| 719 |
(cond |
|---|
| 720 |
((memq top '(defun defsubst)) |
|---|
| 721 |
(format "\n** function %s **\n" (car (cdr form)))) |
|---|
| 722 |
((eq top 'defmacro) |
|---|
| 723 |
(format "\n** macro %s **\n" (car (cdr form)))) |
|---|
| 724 |
((memq top '(defvar defconst)) |
|---|
| 725 |
(format "\n** variable %s **\n" (car (cdr form)))) |
|---|
| 726 |
(t "\n** top level expression **\n")))) |
|---|
| 727 |
(setq elint-top-form-logged t)) |
|---|
| 728 |
|
|---|
| 729 |
(insert errstr) |
|---|
| 730 |
(newline))) |
|---|
| 731 |
|
|---|
| 732 |
(defun elint-clear-log (&optional header) |
|---|
| 733 |
"Clear the lint log buffer. |
|---|
| 734 |
Insert HEADER followed by a blank line if non-nil." |
|---|
| 735 |
(save-excursion |
|---|
| 736 |
(set-buffer (elint-get-log-buffer)) |
|---|
| 737 |
(erase-buffer) |
|---|
| 738 |
(if header |
|---|
| 739 |
(progn |
|---|
| 740 |
(insert header) |
|---|
| 741 |
(newline)) |
|---|
| 742 |
))) |
|---|
| 743 |
|
|---|
| 744 |
(defun elint-display-log () |
|---|
| 745 |
"Display the lint log buffer." |
|---|
| 746 |
(let ((pop-up-windows t)) |
|---|
| 747 |
(display-buffer (elint-get-log-buffer)) |
|---|
| 748 |
(sit-for 0))) |
|---|
| 749 |
|
|---|
| 750 |
(defun elint-get-log-buffer () |
|---|
| 751 |
"Return a log buffer for elint." |
|---|
| 752 |
(let ((buf (get-buffer elint-log-buffer))) |
|---|
| 753 |
(if buf |
|---|
| 754 |
buf |
|---|
| 755 |
(let ((oldbuf (current-buffer))) |
|---|
| 756 |
(prog1 |
|---|
| 757 |
(set-buffer (get-buffer-create elint-log-buffer)) |
|---|
| 758 |
(setq truncate-lines t) |
|---|
| 759 |
(set-buffer oldbuf))) |
|---|
| 760 |
))) |
|---|
| 761 |
|
|---|
| 762 |
|
|---|
| 763 |
|
|---|
| 764 |
|
|---|
| 765 |
|
|---|
| 766 |
|
|---|
| 767 |
(defun elint-initialize () |
|---|
| 768 |
"Initialize elint." |
|---|
| 769 |
(interactive) |
|---|
| 770 |
(mapcar (function (lambda (x) |
|---|
| 771 |
(or (not (symbolp (car x))) |
|---|
| 772 |
(eq (cdr x) 'unknown) |
|---|
| 773 |
(put (car x) 'elint-args (cdr x))))) |
|---|
| 774 |
(elint-find-builtin-args)) |
|---|
| 775 |
(mapcar (function (lambda (x) |
|---|
| 776 |
(put (car x) 'elint-args (cdr x)))) |
|---|
| 777 |
elint-unknown-builtin-args)) |
|---|
| 778 |
|
|---|
| 779 |
|
|---|
| 780 |
(defun elint-find-builtins () |
|---|
| 781 |
"Returns a list of all built-in functions." |
|---|
| 782 |
(let ((subrs nil)) |
|---|
| 783 |
(mapatoms (lambda (s) (if (and (fboundp s) (subrp (symbol-function s))) |
|---|
| 784 |
(setq subrs (cons s subrs))))) |
|---|
| 785 |
subrs |
|---|
| 786 |
)) |
|---|
| 787 |
|
|---|
| 788 |
(defun elint-find-builtin-args (&optional list) |
|---|
| 789 |
"Returns a list of the built-in functions and their arguments. |
|---|
| 790 |
|
|---|
| 791 |
If LIST is nil, call `elint-find-builtins' to get a list of all built-in |
|---|
| 792 |
functions, otherwise use LIST. |
|---|
| 793 |
|
|---|
| 794 |
Each functions is represented by a cons cell: |
|---|
| 795 |
\(function-symbol . args) |
|---|
| 796 |
If no documentation could be found args will be `unknown'." |
|---|
| 797 |
|
|---|
| 798 |
(mapcar (function (lambda (f) |
|---|
| 799 |
(let ((doc (documentation f t))) |
|---|
| 800 |
(if (and doc (string-match "\n\n\\((.*)\\)" doc)) |
|---|
| 801 |
(read (match-string 1 doc)) |
|---|
| 802 |
(cons f 'unknown)) |
|---|
| 803 |
))) |
|---|
| 804 |
(if list list |
|---|
| 805 |
(elint-find-builtins)))) |
|---|
| 806 |
|
|---|
| 807 |
(provide 'elint) |
|---|
| 808 |
|
|---|
| 809 |
|
|---|
| 810 |
|
|---|
| 811 |
|
|---|