| Revision | 304 (tree) |
|---|---|
| Time | 2013-04-27 21:08:53 |
| Author | mhayashi1120 |
improve
trunk/fsvn-env.el (diff) trunk/fsvn-deps.el (diff) trunk/ChangeLog (diff) trunk/fsvn-dev.el (diff)| @@ -54,6 +54,30 @@ | ||
| 54 | 54 | (setq ,val2 ,val1) |
| 55 | 55 | (setq ,val1 TMP))) |
| 56 | 56 | |
| 57 | +;; import from gauche `and-let*' | |
| 58 | +(defmacro fsvn-let* (varlist &rest body) | |
| 59 | + (declare (indent 1) (debug t)) | |
| 60 | + (reduce | |
| 61 | + (lambda (v res) | |
| 62 | + (cond | |
| 63 | + ((atom v) | |
| 64 | + ;; BOUND-VARIABLE | |
| 65 | + `(and ,v ,res)) | |
| 66 | + ((= (length v) 1) | |
| 67 | + ;; (EXPRESSION) | |
| 68 | + `(and ,@v ,res)) | |
| 69 | + ((> (length v) 2) | |
| 70 | + (error "Malformed `fsvn-let*'")) | |
| 71 | + ((not (symbolp (car v))) | |
| 72 | + (error "Malformed `fsvn-let*'")) | |
| 73 | + (t | |
| 74 | + ;; (VARIABLE EXPRESSION) | |
| 75 | + `(let ((,(car v) ,(cadr v))) | |
| 76 | + (and ,(car v) ,res))))) | |
| 77 | + varlist | |
| 78 | + :from-end t | |
| 79 | + :initial-value `(progn ,@body))) | |
| 80 | + | |
| 57 | 81 | (defun fsvn-find-if (pred seq) |
| 58 | 82 | (catch 'found |
| 59 | 83 | (mapc |
| @@ -71,8 +71,8 @@ | ||
| 71 | 71 | `(let ((process-environment (copy-sequence process-environment))) |
| 72 | 72 | (setenv "LC_MESSAGES" "C") |
| 73 | 73 | ,@form)) |
| 74 | + | |
| 74 | 75 | |
| 75 | - | |
| 76 | 76 | ;; access to subversion meta directory |
| 77 | 77 | |
| 78 | 78 | ;; http://svn.collab.net/repos/svn/trunk/subversion/libsvn_wc/adm_files.c |
| @@ -177,25 +177,52 @@ | ||
| 177 | 177 | |
| 178 | 178 | |
| 179 | 179 | (defun fsvn-deps-get-property (propname file) |
| 180 | - (if (version< fsvn-svn-version "1.7") | |
| 181 | - (fsvn-meta--get-properties file propname) | |
| 182 | - (fsvn-get-propget file propname))) | |
| 180 | + (cond | |
| 181 | + ((null fsvn-svn-version) nil) | |
| 182 | + ((version< fsvn-svn-version "1.7") | |
| 183 | + (fsvn-meta--get-properties file propname)) | |
| 184 | + ((and (require 'sqlite3 nil t) (sqlite3-installed-p)) | |
| 185 | + (fsvn-meta--get-properties1.7 file propname)) | |
| 186 | + (t | |
| 187 | + (fsvn-get-propget file propname)))) | |
| 183 | 188 | |
| 184 | 189 | (defun fsvn-deps-file-registered-p (file) |
| 185 | - (if (version< fsvn-svn-version "1.7") | |
| 186 | - (fsvn-meta--text-base-file file) | |
| 187 | - (fsvn-get-info-entry file))) | |
| 190 | + (cond | |
| 191 | + ((null fsvn-svn-version) nil) | |
| 192 | + ((version< fsvn-svn-version "1.7") | |
| 193 | + (fsvn-meta--text-base-file file)) | |
| 194 | + (t | |
| 195 | + (fsvn-get-info-entry file)))) | |
| 188 | 196 | |
| 189 | 197 | (defun fsvn-deps-text-base-file (file) |
| 190 | - (if (version< fsvn-svn-version "1.7") | |
| 191 | - (fsvn-meta--text-base-file file) | |
| 192 | - (let* ((info (fsvn-get-info-entry file)) | |
| 193 | - (checksum (fsvn-xml-info->entry=>wc-info=>checksum$ info)) | |
| 194 | - (root (fsvn-xml-info->entry=>wc-info=>wcroot-abspath$ info))) | |
| 195 | - (expand-file-name | |
| 196 | - (concat "pristine/" (substring checksum 0 2) "/" checksum ".svn-base") | |
| 197 | - (expand-file-name (fsvn-meta-dir-name) root))))) | |
| 198 | + (cond | |
| 199 | + ((null fsvn-svn-version) nil) | |
| 200 | + ((version< fsvn-svn-version "1.7") | |
| 201 | + (fsvn-meta--text-base-file file)) | |
| 202 | + (t | |
| 203 | + (fsvn-deps--text-base-file1.7 file)))) | |
| 198 | 204 | |
| 205 | +(defun fsvn-deps--text-base-file1.7 (file) | |
| 206 | + (let* (checksum root) | |
| 207 | + (cond | |
| 208 | + ((and (require 'sqlite3 nil t) (sqlite3-installed-p)) | |
| 209 | + (let* ((root&atom (fsvn-meta--get-from-nodes "checksum" file)) | |
| 210 | + (raw-checksum (cadr root&atom))) | |
| 211 | + (setq root (car root&atom)) | |
| 212 | + (when (and (stringp raw-checksum) | |
| 213 | + (string-match "\\`[$][^$]+[$]\\([0-9a-fA-F]+\\)" raw-checksum)) | |
| 214 | + (setq checksum (match-string 1 raw-checksum))))) | |
| 215 | + (t | |
| 216 | + (let ((info (fsvn-get-info-entry file))) | |
| 217 | + (setq checksum (fsvn-xml-info->entry=>wc-info=>checksum$ info)) | |
| 218 | + (setq root (fsvn-xml-info->entry=>wc-info=>wcroot-abspath$ info))))) | |
| 219 | + (when (and checksum root) | |
| 220 | + (let ((top (substring checksum 0 2)) | |
| 221 | + (metadir (expand-file-name (fsvn-meta-dir-name) root))) | |
| 222 | + (expand-file-name | |
| 223 | + (concat "pristine/" top "/" checksum ".svn-base") | |
| 224 | + metadir))))) | |
| 225 | + | |
| 199 | 226 | |
| 200 | 227 | |
| 201 | 228 | ;; set bottom of fsvn.el |
| @@ -1,3 +1,9 @@ | ||
| 1 | +2013-04-20 Masahiro Hayashi (林 雅博) <mhayashi1120@gmail.com> | |
| 2 | + | |
| 3 | + * Improve: use sqlite3 stream at critical point (Testing). | |
| 4 | + | |
| 5 | + * Improve: check `fsvn-svn-version' setting. | |
| 6 | + | |
| 1 | 7 | 2013-03-13 Masahiro Hayashi (林 雅博) <mhayashi1120@gmail.com> |
| 2 | 8 | |
| 3 | 9 | * Fix: defmacro before read defun form |
| @@ -259,14 +259,22 @@ | ||
| 259 | 259 | |
| 260 | 260 | |
| 261 | 261 | |
| 262 | +;;TODO | |
| 262 | 263 | (defun fsvn-browse-stash-path () |
| 264 | + "todo difference between git stash" | |
| 263 | 265 | (interactive) |
| 264 | 266 | ) |
| 265 | 267 | |
| 268 | +;;TODO | |
| 266 | 269 | (defun fsvn-browse-stash-pop-path () |
| 267 | 270 | (interactive) |
| 268 | 271 | ) |
| 269 | 272 | |
| 273 | +;;TODO | |
| 274 | +(defun fsvn-browse-stash-drop (stash-id) | |
| 275 | + (interactive) | |
| 276 | + ) | |
| 277 | + | |
| 270 | 278 | (defun fsvn-stash-pop-read-time (directory) |
| 271 | 279 | (let ((times (mapcar |
| 272 | 280 | (lambda (tm) |
| @@ -277,6 +285,7 @@ | ||
| 277 | 285 | ;;TODO stash-push and change and commit files. |
| 278 | 286 | ;; merge with stashed files |
| 279 | 287 | ;; patch and merge?? |
| 288 | +;;TODO patch only working copy is clean | |
| 280 | 289 | (defun fsvn-stash-pop (directory &optional time) |
| 281 | 290 | (let* ((stashdir (fsvn-stash-pop-directory directory time))) |
| 282 | 291 | (unless stashdir |
| @@ -288,7 +297,7 @@ | ||
| 288 | 297 | (unless (directory-files stashdir nil dired-re-no-dot) |
| 289 | 298 | (delete-directory stashdir))))) |
| 290 | 299 | |
| 291 | -(defun fsvn-stash-push (directory) | |
| 300 | +(defun fsvn-stash-push (directory description) | |
| 292 | 301 | (let* ((stashdir (fsvn-stash-pushing-directory directory)) |
| 293 | 302 | (stashdirs (fsvn-stash-pushing-directories stashdir))) |
| 294 | 303 | (unless (file-directory-p stashdir) |
| @@ -321,25 +330,39 @@ | ||
| 321 | 330 | (lambda (sec) |
| 322 | 331 | (fsvn-expand-file (format "%d" sec) dir)) |
| 323 | 332 | (sort |
| 324 | - (remove nil | |
| 325 | - (mapcar | |
| 326 | - (lambda (name) | |
| 327 | - (when (string-match "^[0-9]+$" name) | |
| 328 | - (string-to-number name))) | |
| 329 | - files)) | |
| 333 | + (delq nil | |
| 334 | + (mapcar | |
| 335 | + (lambda (name) | |
| 336 | + (and (string-match "^[0-9]+$" name) | |
| 337 | + (string-to-number name))) | |
| 338 | + files)) | |
| 330 | 339 | '>)))) |
| 331 | 340 | |
| 332 | 341 | (defun fsvn-stash-pop-directory-times (directory) |
| 333 | 342 | (mapcar |
| 334 | 343 | (lambda (file) |
| 335 | - (let ((sec (string-to-number (fsvn-file-name-nondirectory file)))) | |
| 344 | + (let* ((fn (fsvn-file-name-nondirectory file)) | |
| 345 | + (sec (string-to-number fn))) | |
| 336 | 346 | (seconds-to-time sec))) |
| 337 | 347 | (fsvn-stash-pop-directories directory))) |
| 338 | 348 | |
| 339 | -(defun fsvn-stash-hash-directory (directory) | |
| 340 | - (let ((dir (directory-file-name directory))) | |
| 341 | - (fsvn-expand-file (md5 dir) (fsvn-stash-directory)))) | |
| 349 | +(defun fsvn-stash-hash-directory (file) | |
| 350 | + (let ((key (directory-file-name file))) | |
| 351 | + (fsvn-expand-file (md5 key) (fsvn-stash-directory)))) | |
| 342 | 352 | |
| 353 | +;; stash -> | |
| 354 | +;; {rep-uuid} -> | |
| 355 | +;; 1.patch, 1.info | |
| 356 | +;; ... | |
| 357 | +;; 3.patch, 3.info | |
| 358 | + | |
| 359 | +;; info contains: | |
| 360 | +;; path of stashed | |
| 361 | +;; time when stashed | |
| 362 | +;; description of this stash | |
| 363 | + | |
| 364 | +;; TODO any other? property?? | |
| 365 | + | |
| 343 | 366 | (defun fsvn-stash-directory () |
| 344 | 367 | "Backup directory." |
| 345 | 368 | (fsvn-expand-file "stash" fsvn-home-directory)) |
| @@ -362,13 +385,114 @@ | ||
| 362 | 385 | files) |
| 363 | 386 | nil)) |
| 364 | 387 | |
| 365 | - | |
| 388 | +;;TODO !IMPORTANT! how to handle rename rename directory. | |
| 366 | 389 | ;;TODO stash delete and other svn status |
| 367 | 390 | |
| 368 | 391 | ;;TODO |
| 369 | 392 | ;;(add-to-list 'fsvn-temp-directory-dirs "stash") |
| 370 | 393 | |
| 394 | + | |
| 395 | +;; TODO ediff-patch-program | |
| 396 | +;; TODO not recursive copy? should patch? | |
| 397 | + | |
| 371 | 398 | |
| 399 | + | |
| 400 | +(defvar fsvn-sqlite3--connection-pool-size 3) | |
| 401 | +(defvar fsvn-sqlite3--connection-pool nil) | |
| 402 | + | |
| 403 | +;;TODO when file is /hoge/.svn | |
| 404 | +(defun fsvn-meta--get-properties1.7 (file &optional propname) | |
| 405 | + ;; Must check sqlite3.el is installed at invoker | |
| 406 | + (fsvn-let* ((root&atom (fsvn-meta--get-from-nodes "properties" file)) | |
| 407 | + (atom (cadr root&atom)) | |
| 408 | + ((stringp atom)) | |
| 409 | + (props (fsvn-meta-parse-properties atom))) | |
| 410 | + (if propname | |
| 411 | + (cdr (assoc propname props)) | |
| 412 | + props))) | |
| 413 | + | |
| 414 | +(defun fsvn-meta--get-from-nodes (column file) | |
| 415 | + (fsvn-let* ((metadir (fsvn-file-control-directory file)) | |
| 416 | + (stream (fsvn-sqlite3-connect file metadir)) | |
| 417 | + (rootdir (file-name-directory metadir)) | |
| 418 | + (relpath (fsvn-url-relative-name file rootdir)) | |
| 419 | + (relpath (if (equal relpath ".") "" relpath)) | |
| 420 | + (data (fsvn-sqlite3-query | |
| 421 | + stream | |
| 422 | + ;;TODO local_relpath is not key. | |
| 423 | + (concat | |
| 424 | + (format "SELECT %s " column) | |
| 425 | + (format " FROM NODES ") | |
| 426 | + (format " WHERE local_relpath = '%s'" | |
| 427 | + (sqlite3-escape relpath))))) | |
| 428 | + (top (car data)) | |
| 429 | + (atom (nth 0 top))) | |
| 430 | + (list rootdir atom))) | |
| 431 | + | |
| 432 | +(defun fsvn-sqlite3-query (stream query) | |
| 433 | + (sqlite3-stream-execute-query stream query)) | |
| 434 | + | |
| 435 | +(defun fsvn-sqlite3-connect (file &optional metadir) | |
| 436 | + (setq metadir (or metadir (fsvn-file-control-directory file))) | |
| 437 | + (let ((wcdb (expand-file-name "wc.db" metadir))) | |
| 438 | + (catch 'found | |
| 439 | + (unless (file-exists-p wcdb) | |
| 440 | + (throw 'found nil)) | |
| 441 | + (dolist (s fsvn-sqlite3--connection-pool) | |
| 442 | + (cond | |
| 443 | + ((not (sqlite3-stream-alive-p s)) | |
| 444 | + (setq fsvn-sqlite3--connection-pool | |
| 445 | + (delq s fsvn-sqlite3--connection-pool))) | |
| 446 | + ((string= (sqlite3-stream-filename s) wcdb) | |
| 447 | + ;; move top of list | |
| 448 | + (setq fsvn-sqlite3--connection-pool | |
| 449 | + (cons s (delq s fsvn-sqlite3--connection-pool))) | |
| 450 | + (throw 'found s)))) | |
| 451 | + ;; Not found. Connect to file expiring old connection. | |
| 452 | + (when (> (length fsvn-sqlite3--connection-pool) | |
| 453 | + (1- fsvn-sqlite3--connection-pool-size)) | |
| 454 | + (let ((rpool (reverse fsvn-sqlite3--connection-pool))) | |
| 455 | + (sqlite3-stream-close (car rpool)) | |
| 456 | + (setq fsvn-sqlite3--connection-pool | |
| 457 | + (reverse (cdr rpool))))) | |
| 458 | + (let ((stream (let ((inhibit-read-only t)) | |
| 459 | + (sqlite3-stream-open wcdb)))) | |
| 460 | + (setq fsvn-sqlite3--connection-pool | |
| 461 | + (cons stream fsvn-sqlite3--connection-pool)) | |
| 462 | + stream)))) | |
| 463 | + | |
| 464 | +(defun fsvn-meta-parse-properties (text) | |
| 465 | + (unless (string-match "\\`(" text) | |
| 466 | + (error "Not a valid proeprties text")) | |
| 467 | + (unless (string-match "\\`()\\'" text) | |
| 468 | + (let ((start 1) | |
| 469 | + (len (length text)) | |
| 470 | + res) | |
| 471 | + (while (< start len) | |
| 472 | + (let (key val) | |
| 473 | + (unless (string-match "\\([^ ]+\\) " text start) | |
| 474 | + (error "Not a valid property name %s" text)) | |
| 475 | + (setq start (match-end 0)) | |
| 476 | + (setq key (match-string 1 text)) | |
| 477 | + (cond | |
| 478 | + ;;TODO check svn doc. or source. | |
| 479 | + ((eq (string-match "\\([0-9]+\\) " text start) start) | |
| 480 | + (setq start (match-end 0)) | |
| 481 | + (let* ((size (string-to-number (match-string 1 text))) | |
| 482 | + (end (+ start size))) | |
| 483 | + (setq val (substring text start end)) | |
| 484 | + (setq start (1+ end)))) | |
| 485 | + ((eq (string-match "\\([^ ]+\\)\\(?: \\|\)\\'\\)" text start) start) | |
| 486 | + (setq start (match-end 0)) | |
| 487 | + (setq val (match-string 1 text))) | |
| 488 | + (t (error "No matched to value %s" text))) | |
| 489 | + (setq res (cons (cons key val) res)))) | |
| 490 | + (nreverse res)))) | |
| 491 | + | |
| 492 | +;;TODO check recursively with current implementation | |
| 493 | +;; (directory-files-recursively "/home/masa/.emacs.d/") | |
| 494 | + | |
| 495 | + | |
| 372 | 496 | ;; testing |
| 373 | 497 | |
| 374 | 498 | (defconst fsvn-xml-accessor-prefix "fsvn-xml-") |