emacs/cocci-ediff.el

   1 ;;; cocci-ediff.el --- ediff support for semantic patches
   2
   3 ;; Copyright (C) 2006-2007 The Cocci Gang
   4
   5 ;; Emacs Lisp Archive Entry
   6 ;; Author: Rene Rydhof Hansen <rrhansen@diku.dk>
   7 ;;         Padioleau Yoann <padator@wanadoo.fr> (modifying the ediff layout)
   8 ;; Version: 0.1
   9 ;; Keywords: coccinelle patch refactoring program transformation
  10 ;; URL: http://www.emn.fr/x-info/coccinelle/
  11
  12
  13 ;;; Ediff and dired support
  14
  15 ;; You must modify the variables `cocci-spatch-path',
  16 ;; `cocci-isofile-path', and `cocci-spatch-args' according to your setup.
  17
  18 ;; Once it is installed you use it by loading a .cocci file (called the
  19 ;; SP), e.g., 'coccinelle/tests/rule17.cocci'. From the buffer containing
  20 ;; the SP you then press `C-cd' (or `M-x cocci-directory') and specify
  21 ;; the directory where your target C files are located, e.g.,
  22 ;; 'coccinelle/tests/rule17/', pick one of the listed C files (place the
  23 ;; cursor on it) and press `E' (or `M-x cocci-ediff-merge'). This will
  24 ;; then run spatch and apply the SP to the chosen C file; when spatch
  25 ;; finishes Ediff will start in a merge session, displaying the original
  26 ;; C file, the spatch'ed file and the result of merging those two. You
  27 ;; can now use Ediff for merging as usual. When you quit Ediff you will
  28 ;; be asked whether or not to replace the original file with the result
  29 ;; of the merge.
  30
  31
  32 (require 'dired)
  33 (require 'dired-x)
  34 (require 'ediff)
  35
  36 (require 'cocci-mode)
  37
  38 ;--------------------------------------------------
  39 ; Defaults
  40 ;--------------------------------------------------
  41
  42 (defvar cocci-spatch-path "~/coccinelle/spatch")
  43 (defvar cocci-isofile-path "~/coccinelle/standard.iso")
  44 (defvar cocci-spatch-args
  45   "-no_show_ctl_text -no_show_transinfo -no_parse_error_msg -no_show_misc")
  46 (defvar cocci-spatch-default-output "/tmp/output.c")
  47 (defvar cocci-save-merge-result nil
  48   "Determines if the result of merging files should be saved.")
  49
  50
  51 ;--------------------------------------------------
  52 ; Key map for Dired under Cocci
  53 ;--------------------------------------------------
  54 (defvar cocci-dired-mode-map
  55   (let ((map (make-sparse-keymap)))
  56     (define-key map "N" 'dired-next-marked-file)
  57     (define-key map "P" 'dired-prev-marked-file)
  58     (define-key map "c" 'cocci-dired-compile-makeok)
  59     (define-key map "\C-c" 'cocci-dired-compile-makeok)
  60     (define-key map "\C-r" 'cocci-dired-run-spatch)
  61     (define-key map "r" 'cocci-dired-compile-spatch)
  62     (define-key map "v" 'cocci-dired-view-file)
  63     (define-key map "V" 'cocci-dired-view-corresponding-file)
  64     (define-key map [(control return)]  'cocci-dired-view-corresponding-file)
  65     (define-key map "*c" 'cocci-dired-mark-c-files)
  66     (define-key map "*C" 'cocci-dired-mark-cocci-files)
  67     (define-key map "*o" 'cocci-dired-mark-ok-files)
  68     (define-key map "*r" 'cocci-dired-mark-expected-files)
  69     (define-key map "*f" 'cocci-dired-mark-failed-files)
  70     (define-key map "T" 'cocci-dired-toggle-terse-mode)
  71     (define-key map "E" 'cocci-ediff-merge)
  72     (define-key map "D" 'cocci-ediff-diff)
  73     map)
  74   "Keymap used for cocci bindings in `dired-mode'.")
  75
  76
  77 ;--------------------------------------------------
  78 ; Internal Variables
  79 ;--------------------------------------------------
  80
  81 (defvar cocci-current-cocci nil
  82   "The current cocci-file")
  83
  84 (defvar cocci-spatch-output nil
  85   "The buffer for spatch output")
  86
  87 (defvar cocci-current-cocci-buffer nil
  88   "The current cocci-filebuffer")
  89
  90 ;--------------------------------------------------
  91 ; Misc helpers
  92 ;--------------------------------------------------
  93
  94 (defun get-spatch-output-buffer ()
  95   (if (buffer-live-p cocci-spatch-output)
  96       cocci-spatch-output
  97     (setq cocci-spatch-output (generate-new-buffer "*Spatch Output*"))))
  98
  99
 100 ;--------------------------------------------------
 101 ; Shell Commands
 102 ;--------------------------------------------------
 103 (defun cocci-spatch-cmd (sp)
 104   "Assembles command line for spatch"
 105   (concat cocci-spatch-path
 106           " -iso_file " cocci-isofile-path
 107 ;         " -compare_with_expected"
 108           " -cocci_file " sp
 109           " " cocci-spatch-args))
 110
 111 (defun cocci-makeok-cmd (sp)
 112   "Assembles command line for make ok"
 113   (concat "make "
 114           " ISOFILE=\"-iso_file " cocci-isofile-path "\""
 115           " SP=" sp
 116           " ARGS=\"" cocci-spatch-args "\""))
 117
 118
 119 ;--------------------------------------------------
 120 ; Misc.
 121 ;--------------------------------------------------
 122 (defun cocci-convert-ends (from to files)
 123   "Convert files (in files) from ending in from to ending to"
 124   (mapcar (lambda (f)
 125             (if (string-match (concat from "$") f)
 126                 (replace-match to t t f)
 127               f))
 128           files))
 129
 130
 131 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 132
 133 (defvar cocci-ediff-windows)
 134 (defvar cocci-ediff-result)
 135 (defvar ediff-buffer-A)
 136 (defvar ediff-buffer-B)
 137 (defvar ediff-buffer-C)
 138
 139 (defvar ediff-show-sp t)
 140
 141 (defun cocci-merge-files (orig-file new-file &optional name-A name-B)
 142   "Invoke ediff to review application of SP and manually perform merge."
 143   (interactive)
 144   (let* ((found nil))
 145     (save-excursion
 146
 147       ;; Set-up
 148       (let ((config (current-window-configuration))
 149             (ediff-default-variant 'default-B)
 150             (ediff-keep-variants t))
 151
 152         ;; Fire up ediff.
 153
 154         (set-buffer (ediff-merge-files orig-file new-file))
 155
 156
 157         ;; Ediff is now set up, and we are in the control buffer.
 158         ;; Do a few further adjustments and take precautions for exit.
 159
 160         (make-local-variable 'cocci-ediff-orig)
 161         (setq cocci-ediff-orig orig-file)
 162
 163         (make-local-variable 'cocci-ediff-windows)
 164         (setq cocci-ediff-windows config)
 165 ;        (make-local-variable 'cocci-ediff-result)
 166 ;        (setq cocci-ediff-result result-buffer)
 167         (make-local-variable 'ediff-quit-hook)
 168         (setq ediff-quit-hook
 169               (lambda ()
 170                 (let ((buffer-A ediff-buffer-A)
 171                       (buffer-B ediff-buffer-B)
 172                       (buffer-C ediff-buffer-C)
 173 ;                     (result cocci-ediff-result)
 174                       (windows cocci-ediff-windows)
 175                       (original cocci-ediff-orig))
 176                   (ediff-cleanup-mess)
 177 ;                 (ediff-janitor)
 178 ;                 (set-buffer result)
 179 ;                 (erase-buffer)
 180 ;                 (insert-buffer buffer-C)
 181                   (kill-buffer buffer-A)
 182                   (kill-buffer buffer-B)
 183                   (when cocci-save-merge-result
 184                     (switch-to-buffer buffer-C)
 185                     (delete-other-windows)
 186                     (ediff-write-merge-buffer-and-maybe-kill buffer-C original))
 187 ;                 (kill-buffer buffer-C)
 188                   (set-window-configuration windows)
 189                   (message "Merge resolved; you may save the buffer"))))
 190         (message "Please resolve merge now; exit ediff when done")
 191         nil))))
 192
 193
 194 ; pad's code
 195 ; merge between ediff-setup-windows-plain-compare and
 196 ; ediff-setup-windows-plain from 'ediff-wind.el'
 197 (defun cocci-ediff-setup-windows-plain (buf-A buf-B buf-C control-buffer)
 198   (ediff-with-current-buffer control-buffer
 199     (setq ediff-multiframe nil))
 200
 201   (ediff-destroy-control-frame control-buffer)
 202   (let ((window-min-height 1)
 203         split-window-function wind-width-or-height
 204         three-way-comparison
 205         wind-A-start wind-B-start wind-A wind-B wind-C)
 206     (ediff-with-current-buffer control-buffer
 207       (setq wind-A-start (ediff-overlay-start
 208                           (ediff-get-value-according-to-buffer-type
 209                            'A ediff-narrow-bounds))
 210             wind-B-start (ediff-overlay-start
 211                           (ediff-get-value-according-to-buffer-type
 212                            'B  ediff-narrow-bounds))
 213             ;; this lets us have local versions of ediff-split-window-function
 214             split-window-function ediff-split-window-function
 215             three-way-comparison ediff-3way-comparison-job))
 216     (delete-other-windows)
 217     (split-window-vertically)
 218     (ediff-select-lowest-window)
 219
 220     ;NEW
 221     (setq lowest-wind (selected-window))
 222
 223     (ediff-setup-control-buffer control-buffer)
 224
 225     ;; go to the upper window and split it betw A, B, and possibly C
 226     (other-window 1)
 227
 228     ;NEW
 229     (split-window-vertically)
 230     (setq this-wind (selected-window))
 231     (other-window 1)
 232     (switch-to-buffer cocci-current-cocci-buffer)
 233     (select-window this-wind)
 234
 235     (switch-to-buffer buf-A)
 236     (setq wind-A (selected-window))
 237
 238     (if three-way-comparison
 239         (setq wind-width-or-height
 240               (/ (if (eq split-window-function 'split-window-vertically)
 241                      (window-height wind-A)
 242                    (window-width wind-A))
 243                  3)))
 244
 245     ;; XEmacs used to have a lot of trouble with display
 246     ;; It did't set things right unless we told it to sit still
 247     ;; 19.12 seems ok.
 248     ;;(if ediff-xemacs-p (sit-for 0))
 249
 250 ;    (funcall split-window-function wind-width-or-height)
 251     (split-window-horizontally)
 252
 253     (if (eq (selected-window) wind-A)
 254         (other-window 1))
 255     (switch-to-buffer buf-B)
 256     (setq wind-B (selected-window))
 257
 258     (if three-way-comparison
 259         (progn
 260           (funcall split-window-function) ; equally
 261           (if (eq (selected-window) wind-B)
 262               (other-window 1))
 263           (switch-to-buffer buf-C)
 264           (setq wind-C (selected-window))))
 265
 266     (ediff-with-current-buffer control-buffer
 267       (setq ediff-window-A wind-A
 268             ediff-window-B wind-B
 269             ediff-window-C wind-C))
 270
 271     ;; It is unlikely that we will want to implement 3way window comparison.
 272     ;; So, only buffers A and B are used here.
 273     (if ediff-windows-job
 274         (progn
 275           (set-window-start wind-A wind-A-start)
 276           (set-window-start wind-B wind-B-start)))
 277
 278     (ediff-select-lowest-window)
 279     (ediff-setup-control-buffer control-buffer)
 280     ))
 281
 282
 283
 284 (defvar old-ediff-setup-function ediff-window-setup-function)
 285
 286 ; pad's code, almost copy paste of rene's cocci-merge-files
 287 (defun cocci-diff-files (orig-file new-file &optional name-A name-B)
 288   "Invoke ediff to review application of SP and manually perform merge."
 289   (interactive)
 290   (let* ((found nil))
 291     (save-excursion
 292
 293       ;; Set-up
 294       (let ((config (current-window-configuration))
 295             (ediff-default-variant 'default-B)
 296             (ediff-keep-variants t)
 297             )
 298
 299         ;; Fire up ediff.
 300
 301
 302
 303         ;NEW, use ediff-files
 304         (setq ediff-window-setup-function 'cocci-ediff-setup-windows-plain)
 305
 306         (set-buffer (ediff-files orig-file new-file))
 307
 308
 309         ;; Ediff is now set up, and we are in the control buffer.
 310         ;; Do a few further adjustments and take precautions for exit.
 311
 312         (make-local-variable 'cocci-ediff-orig)
 313         (setq cocci-ediff-orig orig-file)
 314
 315         (make-local-variable 'cocci-ediff-windows)
 316         (setq cocci-ediff-windows config)
 317 ;        (make-local-variable 'cocci-ediff-result)
 318 ;        (setq cocci-ediff-result result-buffer)
 319         (make-local-variable 'ediff-quit-hook)
 320         (setq ediff-quit-hook
 321               (lambda ()
 322                 (let ((buffer-A ediff-buffer-A)
 323                       (buffer-B ediff-buffer-B)
 324                       (buffer-C ediff-buffer-C)
 325 ;                     (result cocci-ediff-result)
 326                       (windows cocci-ediff-windows)
 327                       (original cocci-ediff-orig))
 328                   (ediff-cleanup-mess)
 329 ;                 (ediff-janitor)
 330 ;                 (set-buffer result)
 331 ;                 (erase-buffer)
 332 ;                 (insert-buffer buffer-C)
 333                   (kill-buffer buffer-A)
 334                   (kill-buffer buffer-B)
 335
 336                   (setq ediff-window-setup-function old-ediff-setup-function)
 337
 338                   (when cocci-save-merge-result
 339                     (switch-to-buffer buffer-C)
 340                     (delete-other-windows)
 341                     (ediff-write-merge-buffer-and-maybe-kill buffer-C original))
 342 ;                 (kill-buffer buffer-C)
 343                   (set-window-configuration windows)
 344                   (message "Merge resolved; you may save the buffer"))))
 345         (message "Please resolve merge now; exit ediff when done")
 346         nil))))
 347
 348
 349 ;----------------------------------------------------------------------
 350 ; Executing "make" and "spatch" commands
 351 ;----------------------------------------------------------------------
 352
 353 (defun cocci-dired-compile-makeok (arg)
 354   "Compiles the marked files in cocci/dired mode. With prefix arg no file
 355 names are substituted (useful for Makefiles)."
 356   (interactive "P")
 357   (if arg
 358       (compile (read-from-minibuffer "Compile command: "
 359                                      (eval compile-command) nil nil
 360                                      '(compile-history . 1)))
 361     (let* ((file-list (cocci-convert-ends ".c" ".ok" (dired-get-marked-files t)))
 362            (command (dired-mark-read-string
 363                      "Make targets %s with: "
 364                      (cocci-makeok-cmd cocci-current-cocci)
 365                      'compile nil file-list)))
 366       (compile (concat command " " (mapconcat 'identity file-list " "))))))
 367
 368 (defun cocci-dired-compile-spatch (&optional arg)
 369   "Runs spatch on current file. Non-nil optional arg to specify command."
 370   (interactive "P")
 371   (if arg
 372       (compile (read-from-minibuffer "Command: "
 373                                      (eval compile-command) nil nil
 374                                      '(compile-history . 1)))
 375     (let ((file (dired-get-filename t))
 376           (command (cocci-spatch-cmd cocci-current-cocci)))
 377       (compile (concat command " " file)))))
 378
 379 (defun cocci-apply-spatch (file &optional sp-file out-buf)
 380   "Applies the current SP to FILE."
 381   (interactive)
 382   (let ((cmd (concat (cocci-spatch-cmd (or sp-file cocci-current-cocci)))))
 383     (shell-command (concat cmd " " file) out-buf)))
 384
 385 (defun cocci-ediff-merge (&optional res-file)
 386   "Use EDiff to review and apply semantic patch."
 387   (interactive)
 388   (let ((file (dired-get-filename t))
 389         (out-buf (get-spatch-output-buffer)))
 390     (message "Applying SP '%s' to file '%s'..."
 391              (file-name-nondirectory cocci-current-cocci)
 392              (file-name-nondirectory file))
 393     (cocci-apply-spatch file cocci-current-cocci out-buf)
 394     (message "Applying SP '%s' to file '%s'... done."
 395              (file-name-nondirectory cocci-current-cocci)
 396              (file-name-nondirectory file))
 397 ;    (ediff-merge-files file (or res-file cocci-spatch-default-output))
 398     (cocci-merge-files file (or res-file cocci-spatch-default-output))))
 399
 400
 401 (defun cocci-ediff-diff (&optional res-file)
 402   "Use EDiff to review and apply semantic patch."
 403   (interactive)
 404   (let ((file (dired-get-filename t))
 405         (out-buf (get-spatch-output-buffer)))
 406     (message "Applying SP '%s' to file '%s'..."
 407              (file-name-nondirectory cocci-current-cocci)
 408              (file-name-nondirectory file))
 409     (cocci-apply-spatch file cocci-current-cocci out-buf)
 410     (message "Applying SP '%s' to file '%s'... done."
 411              (file-name-nondirectory cocci-current-cocci)
 412              (file-name-nondirectory file))
 413 ;    (ediff-merge-files file (or res-file cocci-spatch-default-output))
 414     (cocci-diff-files file (or res-file cocci-spatch-default-output))))
 415
 416 (defun cocci-dired-view-file ()
 417   "In cocci dired, visit the file or directory named on this line
 418 using diff-mode."
 419   (interactive)
 420   (let ((file-name (file-name-sans-versions (dired-get-filename) t))
 421         ;; bind it so that the command works on directories too,
 422         ;; independent of the user's setting
 423         (find-file-run-dired t))
 424     (if (file-exists-p file-name)
 425         (progn
 426           (find-file file-name)
 427           (diff-mode))
 428       (if (file-symlink-p file-name)
 429           (error "File is a symlink to a nonexistent target")
 430         (error "File no longer exists; type `g' to update Dired buffer")))))
 431
 432 (defun cocci-dired-view-corresponding-file ()
 433   "In cocci dired, visit the file or directory named on this line
 434 using diff-mode."
 435   (interactive)
 436   (let* ((file-name
 437           (cocci-corresponding-file
 438            (file-name-sans-versions (dired-get-filename) t)))
 439          (find-file-run-dired t))
 440     (if (file-exists-p file-name)
 441         (progn
 442           (find-file file-name)
 443           (diff-mode))
 444       (if (file-symlink-p file-name)
 445           (error "File is a symlink to a nonexistent target")
 446         (error "File no longer exists; type `g' to update Dired buffer")))))
 447
 448
 449 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 450
 451 (defun cocci-dired-run-spatch (&optional spfile)
 452   "In a dired buffer, runs spatch on marked files with source buffer as SP file"
 453   (interactive)
 454   (when (not spfile) (setq spfile cocci-current-cocci))
 455   (dired-do-shell-command (concat (cocci-spatch-cmd spfile) " ?")
 456                           current-prefix-arg
 457                           (dired-get-marked-files t current-prefix-arg)))
 458
 459 (defun cocci-dired-run-makeok (spfile)
 460   "In a dired buffer, runs 'make ok' on marked files with
 461 source buffer as SP file"
 462   (interactive)
 463   (let ((files (dired-get-marked-files t current-prefix-arg)))
 464     (dired-do-shell-command (concat (cocci-makeok-cmd spfile) " ?")
 465                             current-prefix-arg
 466                             (cocci-convert-ends ".c" ".ok" files))))
 467
 468 (defun cocci-run-makeok (spfile)
 469   "Run 'make ok' in current directory with source buffer as SP file"
 470   (interactive)
 471   (compile (cocci-makeok-cmd (buffer-file-name))))
 472
 473
 474
 475 ;--------------------------------------------------
 476 ; Marking files in Dired under Cocci
 477 ;--------------------------------------------------
 478
 479 (defun cocci-dired-mark-c-files ()
 480   (interactive)
 481   (dired-mark-extension ".c"))
 482
 483 (defun cocci-dired-mark-cocci-files ()
 484   (interactive)
 485   (dired-mark-extension ".cocci"))
 486
 487 (defun cocci-dired-mark-ok-files ()
 488   "Mark all .ok files. In terse mode mark all .c files that have a
 489 corresponding .ok file"
 490   (interactive)
 491   (if (not cocci-dired-terse-mode)
 492       (dired-mark-extension ".ok")
 493     (dired-mark-if (let ((f (dired-get-filename nil t)))
 494                      (and f
 495                           (file-exists-p (cocci-file f 'ok))
 496                           (not (file-directory-p f))))
 497                    "source file(s) with OK result file")))
 498
 499 (defun cocci-dired-mark-failed-files ()
 500   "Mark all .failed files. In terse mode mark all .c files that have a
 501 corresponding .failed file"
 502   (interactive)
 503   (if (not cocci-dired-terse-mode)
 504       (dired-mark-extension ".failed")
 505     (dired-mark-if (let ((f (dired-get-filename nil t)))
 506                      (and f
 507                           (file-exists-p (cocci-file f 'fail))
 508                           (not (file-directory-p f))))
 509                    "source file(s) with FAILED result file")))
 510
 511 (defun cocci-dired-mark-expected-files ()
 512   "Mark all .res files. In terse mode mark all .c files that have a
 513 corresponding .res file"
 514   (interactive)
 515   (if (not cocci-dired-terse-mode)
 516       (dired-mark-extension ".res")
 517     (dired-mark-if (let ((f (dired-get-filename nil t)))
 518                      (and f
 519                           (file-exists-p (cocci-file f 'expected))
 520                           (not (file-directory-p f))))
 521                    "source file(s) with EXPECTED result file")))
 522
 523
 524 ;;; One shot - for counting in README's
 525 ;;; FIXME: remove
 526 (defun cocci-count-status ()
 527   (interactive)
 528   (let (res)
 529     (save-excursion
 530       (beginning-of-buffer)
 531       (let ((ok (count-matches "\\[status\\] ok"))
 532             (sok (count-matches "\\[status\\] spatch-ok"))
 533             (fail (count-matches "\\[status\\] fail"))
 534             (wrong (count-matches "\\[status\\] wrong")))
 535         (setq res (replace-regexp-in-string
 536                  " occurrences"
 537                  ""
 538                  (concat "[ok: " ok "; spatch-ok: " sok
 539                          "; fail: " fail "; wrong: " wrong "]")))))
 540     (insert res)))
 541
 542
 543 ;----------------------------------------------------------------------
 544 ; Cocci Dired - Adapted from VC Dired
 545 ;----------------------------------------------------------------------
 546
 547 (defvar cocci-dired-listing-switches "-al"
 548   "*Switches passed to `ls' for vc-dired.  MUST contain the `l' option.")
 549
 550 (defvar cocci-dired-terse-display t
 551   "*If non-nil, show only source (.c) files in Cocci Dired.")
 552
 553 (defvar cocci-dired-recurse t
 554   "*If non-nil, show directory trees recursively in VC Dired.")
 555
 556 (defvar cocci-directory-exclusion-list '("SCCS" "RCS" "CVS")
 557   "*List of directory names to be ignored when walking directory trees.")
 558
 559 (defvar cocci-dired-switches)
 560 (defvar cocci-dired-terse-mode)
 561 (defvar cocci-dired-mode nil)
 562 (make-variable-buffer-local 'cocci-dired-mode)
 563
 564 ;;; based on vc-dired-mode
 565 (define-derived-mode cocci-dired-mode dired-mode "Dired under Cocci"
 566   "The major mode used in Cocci directory buffers.
 567
 568 It works like Dired, with the current Cocci state of each file being
 569 indicated in the place of the file's link count, owner, group and size.
 570 Subdirectories are also listed, and you may insert them into the buffer
 571 as desired, like in Dired."
 572   ;; define-derived-mode does it for us in Emacs-21, but not in Emacs-20.
 573   ;; We do it here because dired might not be loaded yet
 574   ;; when vc-dired-mode-map is initialized.
 575   (set-keymap-parent cocci-dired-mode-map dired-mode-map)
 576   (make-local-hook 'dired-after-readin-hook)
 577   (add-hook 'dired-after-readin-hook 'cocci-dired-hook nil t)
 578   ;; The following is slightly modified from dired.el,
 579   ;; because file lines look a bit different in vc-dired-mode.
 580   (set (make-local-variable 'dired-move-to-filename-regexp)
 581        (let* ((l "\\([A-Za-z]\\|[^\0-\177]\\)")
 582               ;; In some locales, month abbreviations are as short as 2 letters,
 583               ;; and they can be followed by ".".
 584               (month (concat l l "+\\.?"))
 585               (s " ")
 586               (yyyy "[0-9][0-9][0-9][0-9]")
 587               (dd "[ 0-3][0-9]")
 588               (HH:MM "[ 0-2][0-9]:[0-5][0-9]")
 589               (seconds "[0-6][0-9]\\([.,][0-9]+\\)?")
 590               (zone "[-+][0-2][0-9][0-5][0-9]")
 591               (iso-mm-dd "[01][0-9]-[0-3][0-9]")
 592               (iso-time (concat HH:MM "\\(:" seconds "\\( ?" zone "\\)?\\)?"))
 593               (iso (concat "\\(\\(" yyyy "-\\)?" iso-mm-dd "[ T]" iso-time
 594                            "\\|" yyyy "-" iso-mm-dd "\\)"))
 595               (western (concat "\\(" month s "+" dd "\\|" dd "\\.?" s month "\\)"
 596                                s "+"
 597                                "\\(" HH:MM "\\|" yyyy "\\)"))
 598               (western-comma (concat month s "+" dd "," s "+" yyyy))
 599               ;; Japanese MS-Windows ls-lisp has one-digit months, and
 600               ;; omits the Kanji characters after month and day-of-month.
 601               (mm "[ 0-1]?[0-9]")
 602               (japanese
 603                (concat mm l "?" s dd l "?" s "+"
 604                        "\\(" HH:MM "\\|" yyyy l "?" "\\)")))
 605          ;; the .* below ensures that we find the last match on a line
 606          (concat ".*" s
 607                  "\\(" western "\\|" western-comma "\\|" japanese "\\|" iso "\\)"
 608                  s "+")))
 609   (and (boundp 'cocci-dired-switches)
 610        cocci-dired-switches
 611        (set (make-local-variable 'dired-actual-switches)
 612             cocci-dired-switches))
 613   (set (make-local-variable 'cocci-dired-terse-mode) cocci-dired-terse-display)
 614   (setq cocci-dired-mode t))
 615
 616 (defun cocci-dired-toggle-terse-mode ()
 617   "Toggle terse display in Cocci Dired."
 618   (interactive)
 619   (if (not cocci-dired-mode)
 620       nil
 621     (setq cocci-dired-terse-mode (not cocci-dired-terse-mode))
 622     (if cocci-dired-terse-mode
 623         (cocci-dired-hook)
 624       (revert-buffer))))
 625
 626 (defun cocci-convert-file-ext (file ext)
 627   (concat (file-name-sans-extension file) ext))
 628
 629 (defvar cocci-file-types
 630   '((cocci . ".cocci") (source . ".c") (ok . ".ok")
 631     (fail . ".failed") (expected . ".res"))
 632 "Alist of file name extensions used by Cocci.")
 633
 634 (defun cocci-file (file type)
 635   (let ((ext (cdr (assq type cocci-file-types))))
 636     (if ext
 637         (cocci-convert-file-ext file ext)
 638       (error "cocci-file: requested unknown file type (%s)" type))))
 639
 640 (defun cocci-file-type (file)
 641   (car (rassoc (file-name-extension file t) cocci-file-types)))
 642
 643 (defun cocci-result-type-p (type) (or (eq type 'ok) (eq type 'fail)))
 644
 645 (defun cocci-corresponding-file (file)
 646   (let ((ftype (cocci-file-type file)))
 647     (cond
 648      ((or (eq ftype 'ok) (eq ftype 'fail)) (cocci-file file 'source))
 649      ((eq ftype 'source)
 650       (let ((status (cocci-result-status file)))
 651         (cond
 652          ((eq status 'cocci-ok) (cocci-file file 'ok))
 653          ((eq status 'cocci-fail) (cocci-file file 'fail))
 654          (t (error "No corresponding result file for %s" file)))))
 655      (t (error "No corresponding file for %s" file)))))
 656
 657 (defun cocci-result-status (file)
 658   "For a source file return the Coccinelle result status (if any)."
 659   (let ((ok   (file-exists-p (cocci-file file 'ok)))
 660         (fail (file-exists-p (cocci-file file 'fail)))
 661         (res  (file-exists-p (cocci-file file 'expected))))
 662     (cond
 663      ((and ok fail) 'cocci-conflict)  ; old .ok/.failed files lying around?
 664      (ok            'cocci-ok)        ; found a .ok file
 665      (fail          'cocci-fail)      ; found a .fail file
 666      (res           'cocci-update)    ; found an expected result but no result
 667      (t             'cocci-unknown)))) ; file is not under cocci "control"
 668
 669 (defun cocci-stale-result-file (file &optional src-file)
 670   (when (not src-file) (setq src-file (cocci-file file 'source)))
 671   (and (file-exists-p file)
 672        (or (file-newer-than-file-p cocci-current-cocci file)
 673            (file-newer-than-file-p src-file file))))
 674
 675 ;; Trying to abstract away from files
 676 (defun cocci-stale-result (file &optional result)
 677   "Determine if the result is stale."
 678   (let ((src-file (cocci-file file 'source)))
 679     (if result
 680         (cocci-stale-result-file (cocci-file file result) src-file)
 681       (or (cocci-stale-result-file (cocci-file file 'ok) src-file)
 682           (cocci-stale-result-file (cocci-file file 'fail) src-file)))))
 683
 684 (defun cocci-dired-state-info (file)
 685   (cond
 686    ; a source (.c) file
 687    ((eq (cocci-file-type file) 'source)
 688     (let ((result)
 689           (status (cocci-result-status file)))
 690       (setq result
 691              (cond
 692               ((eq status 'cocci-ok)
 693                (if (cocci-stale-result file 'ok)
 694                    "(ok?)"
 695                  "(ok)"))
 696               ((eq status 'cocci-fail)
 697                (if (cocci-stale-result file 'fail)
 698                    "(fail?)"
 699                  "(fail)"))
 700               ((eq status 'cocci-conflict) "(ok/fail)")
 701               ((eq status 'cocci-update)   "(update)")
 702               ((eq status 'cocci-unknown)  "(unknown)")
 703               (t nil)))
 704       (substring (concat result "        ") 0 10)))
 705    ))
 706
 707 (defun cocci-dired-reformat-line (x)
 708   "Reformat a directory-listing line.
 709 Replace various columns with version control information.
 710 This code, like dired, assumes UNIX -l format."
 711   (beginning-of-line)
 712   (let ((pos (point)) limit perm date-and-file)
 713     (end-of-line)
 714     (setq limit (point))
 715     (goto-char pos)
 716     (when
 717         (or
 718          (re-search-forward  ;; owner and group
 719           "^\\(..[drwxlts-]+ \\) *[0-9]+ [^ ]+ +[^ ]+ +[0-9]+\\( .*\\)"
 720           limit t)
 721          (re-search-forward  ;; only owner displayed
 722           "^\\(..[drwxlts-]+ \\) *[0-9]+ [^ ]+ +[0-9]+\\( .*\\)"
 723           limit t)
 724          (re-search-forward  ;; OS/2 -l format, no links, owner, group
 725           "^\\(..[drwxlts-]+ \\) *[0-9]+\\( .*\\)"
 726           limit t))
 727       (setq perm          (match-string 1)
 728             date-and-file (match-string 2))
 729       (setq x (substring (concat x "          ") 0 10))
 730       (replace-match (concat perm x date-and-file)))))
 731
 732 (defun cocci-dired-hook ()
 733   "Reformat the listing according to version control.
 734 Called by dired after any portion of a cocci-dired buffer has been read in."
 735   (message "Getting status information... ")
 736   (let (subdir filename (buffer-read-only nil) cvs-dir)
 737     (goto-char (point-min))
 738     (while (not (eobp))
 739       (cond
 740        ;; subdir header line
 741        ((setq subdir (dired-get-subdir))
 742         ;; if the backend supports it, get the state
 743         ;; of all files in this directory at once
 744 ;       (let ((backend (vc-responsible-backend subdir)))
 745 ;         (if (vc-find-backend-function backend 'dir-state)
 746 ;             (vc-call-backend backend 'dir-state subdir)))
 747         (forward-line 1)
 748         ;; erase (but don't remove) the "total" line
 749         (delete-region (point) (line-end-position))
 750         ;; Ugly hack to display the current cocci file.
 751         ;; Needed because of hardcoded dired regexps
 752         (when cocci-current-cocci
 753           (insert
 754            (concat
 755             (propertize " " 'display '((margin nil) "  Current cocci file: "))
 756             (propertize " "
 757                         'display
 758                         `((margin nil)
 759                           ,(file-name-nondirectory cocci-current-cocci))))))
 760         (beginning-of-line)
 761         (forward-line 1))
 762        ;; file line
 763        ((setq filename (dired-get-filename nil t))
 764         (cond
 765          ;; subdir
 766          ((file-directory-p filename)
 767           (cond
 768            ((member (file-name-nondirectory filename)
 769                     cocci-directory-exclusion-list)
 770             (let ((pos (point)))
 771               (dired-kill-tree filename)
 772               (goto-char pos)
 773               (dired-kill-line)))
 774            (cocci-dired-terse-mode
 775             ;; Don't show directories in terse mode.  Don't use
 776             ;; dired-kill-line to remove it, because in recursive listings,
 777             ;; that would remove the directory contents as well.
 778             (delete-region (line-beginning-position)
 779                            (progn (forward-line 1) (point))))
 780            ((string-match "\\`\\.\\.?\\'" (file-name-nondirectory filename))
 781             (dired-kill-line))
 782            (t
 783             (cocci-dired-reformat-line nil)
 784             (forward-line 1))))
 785          ;; ordinary file
 786          ;; show only .c in terse mode
 787          ((or (and (eq (cocci-file-type filename) 'source)
 788                    (equal (file-name-sans-versions filename) filename))
 789               (not (and cocci-dired-terse-mode)))
 790           (cocci-dired-reformat-line (cocci-dired-state-info filename))
 791           (forward-line 1))
 792          (t
 793           (dired-kill-line))))
 794        ;; any other line
 795        (t (forward-line 1))))
 796     (cocci-dired-purge))
 797   (message "Getting status information... done"))
 798
 799 (defun cocci-dired-purge ()
 800   "Remove empty subdirs."
 801   (let (subdir)
 802     (goto-char (point-min))
 803     (while (setq subdir (dired-get-subdir))
 804       (forward-line 2)
 805       (if (dired-get-filename nil t)
 806           (if (not (dired-next-subdir 1 t))
 807               (goto-char (point-max)))
 808         (forward-line -2)
 809         (if (not (string= (dired-current-directory) default-directory))
 810             (dired-do-kill-lines t "")
 811           ;; We cannot remove the top level directory.
 812           ;; Just make it look a little nicer.
 813           (forward-line 1)
 814           (kill-line)
 815           (if (not (dired-next-subdir 1 t))
 816               (goto-char (point-max))))))
 817     (goto-char (point-min))))
 818
 819 (defun cocci-dired-buffers-for-dir (dir)
 820   "Return a list of all cocci-dired buffers that currently display DIR."
 821   (let (result)
 822     ;; Check whether dired is loaded.
 823     (when (fboundp 'dired-buffers-for-dir)
 824       (mapcar (lambda (buffer)
 825                 (with-current-buffer buffer
 826                   (if cocci-dired-mode
 827                       (setq result (append result (list buffer))))))
 828               (dired-buffers-for-dir dir)))
 829     result))
 830
 831 (defun cocci-dired-resynch-file (file)
 832   "Update the entries for FILE in any Cocci Dired buffers that list it."
 833   (let ((buffers (cocci-dired-buffers-for-dir (file-name-directory file))))
 834     (when buffers
 835       (mapcar (lambda (buffer)
 836                 (with-current-buffer buffer
 837                   (if (dired-goto-file file)
 838                       ;; bind vc-dired-terse-mode to nil so that
 839                       ;; files won't vanish when they are checked in
 840                       (let ((cocci-dired-terse-mode nil))
 841                         (dired-do-redisplay 1)))))
 842               buffers))))
 843
 844 (defun cocci-directory (dir read-switches)
 845   "Create a buffer in Cocci Dired Mode for directory DIR.
 846
 847 With prefix arg READ-SWITCHES, specify a value to override
 848 `dired-listing-switches' when generating the listing."
 849   (interactive "DDired under Cocci (directory): \nP")
 850   (let ((cocci-dired-switches (concat cocci-dired-listing-switches
 851                                    (if cocci-dired-recurse "R" ""))))
 852     (if read-switches
 853         (setq cocci-dired-switches
 854               (read-string "Dired listing switches: "
 855                            cocci-dired-switches)))
 856     (require 'dired)
 857     (require 'dired-aux)
 858     (switch-to-buffer
 859      (dired-internal-noselect (expand-file-name (file-name-as-directory dir))
 860                               cocci-dired-switches
 861                               'cocci-dired-mode))))
 862
 863
 864
 865 ;--------------------------------------------------
 866 ; Hook
 867 ;--------------------------------------------------
 868
 869 (define-key cocci-mode-map  "\C-cd" 'cocci-directory)
 870
 871 (add-hook 'cocci-mode-hook
 872           (lambda ()
 873             (setq cocci-current-cocci (buffer-file-name))
 874             (setq cocci-current-cocci-buffer (current-buffer))
 875             (setq compile-command (cocci-makeok-cmd cocci-current-cocci))))
 876
 877
 878 (provide 'cocci-ediff)