diff --git a/TeXmacs/progs/kernel/texmacs/tm-dialogue-test.scm b/TeXmacs/progs/kernel/texmacs/tm-dialogue-test.scm index 18d88eae73..592c12c834 100644 --- a/TeXmacs/progs/kernel/texmacs/tm-dialogue-test.scm +++ b/TeXmacs/progs/kernel/texmacs/tm-dialogue-test.scm @@ -333,6 +333,62 @@ (recent-files-save) ) ;define +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Tests for legacy migration markers (4466) +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +;; Windows 文件名禁止 < > : " | ? *。标记名含 '>' 时 string-save 静默失败、 +;; url-exists? 永远为 #f,每次启动都重新导入 interactive.scm 的旧 recent-buffer, +;; 表现为「清空最近文件 → 重启 → 全部回来」。 + +(define (windows-illegal-file-name? name) + (not (not (or (string-index name #\<) + (string-index name #\>) + (string-index name #\:) + (string-index name #\") + (string-index name #\|) + (string-index name #\?) + (string-index name #\*) + ) ;or + ) ;not + ) ;not +) ;define + +(define (test-migration-marker-names-portable) + (for-each + (lambda (marker) + (let ((tail (url->system (url-tail (string->url marker))))) + (check (list tail (windows-illegal-file-name? tail)) => (list tail #f)) + ) ;let + ) ;lambda + (list interactive-arg-migration-marker-v1 recent-files-migration-marker-v1) + ) ;for-each +) ;define + +(define (test-migration-marker-round-trip) + ;; 用真实标记文件名的尾部在临时目录落盘:写得出、查得到。旧名在 Windows 上此处必红。 + (let* ((tail (url->system (url-tail (string->url recent-files-migration-marker-v1)))) + (tmp (string-append "/tmp/4466_" tail)) + ) ; + (write-migration-marker tmp) + (check (url-exists? tmp) => #t) + (system-remove (string->url tmp)) + ) ;let* +) ;define + +(define (test-migration-marker-legacy-recognized) + ;; 新旧标记任一存在即视为已迁移,避免 macOS/Linux 已迁移用户再导入一次。 + (let ((new-m "/tmp/4466_marker_new") (old-m "/tmp/4466_marker_old")) + (check (migration-marker-exists? new-m old-m) => #f) + (write-migration-marker old-m) + (check (migration-marker-exists? new-m old-m) => #t) + (system-remove (string->url old-m)) + (write-migration-marker new-m) + (check (migration-marker-exists? new-m old-m) => #t) + (system-remove (string->url new-m)) + ) ;let +) ;define + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Test entry point ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -346,5 +402,8 @@ (test-validation) (test-recent-files-lru-limit) (test-persistence) + (test-migration-marker-names-portable) + (test-migration-marker-round-trip) + (test-migration-marker-legacy-recognized) (check-report) ) ;tm-define diff --git a/TeXmacs/progs/kernel/texmacs/tm-dialogue.scm b/TeXmacs/progs/kernel/texmacs/tm-dialogue.scm index 0f78a2dcbc..fb9c724c2d 100644 --- a/TeXmacs/progs/kernel/texmacs/tm-dialogue.scm +++ b/TeXmacs/progs/kernel/texmacs/tm-dialogue.scm @@ -189,13 +189,32 @@ (define legacy-interactive-arg-file "$TEXMACS_HOME_PATH/system/interactive.scm") -(define interactive-arg-migration-marker-v1 +;; 旧数据迁移标记文件。文件名不能含 '>':Windows 文件名禁止 < > : " | ? *, +;; 原名 xxx.scm->v1 在 Windows 上永远写不出来,于是每次启动都判定「未迁移」, +;; 把 interactive.scm 里的旧 recent-buffer 条目重新导入——用户清空最近文件后 +;; 重启又全部回来(#4466)。macOS/Linux 上旧标记已落盘,继续识别以免重复导入。 + +(define-public interactive-arg-migration-marker-v1 + "$TEXMACS_HOME_PATH/system/interactive.scm.migrated-v1" +) ;define-public + +(define-public legacy-interactive-arg-migration-marker-v1 "$TEXMACS_HOME_PATH/system/interactive.scm->v1" -) ;define +) ;define-public + +(define-public recent-files-migration-marker-v1 + "$TEXMACS_HOME_PATH/system/recent-files.scm.migrated-v1" +) ;define-public -(define recent-files-migration-marker-v1 +(define-public legacy-recent-files-migration-marker-v1 "$TEXMACS_HOME_PATH/system/recent-files.scm->v1" -) ;define +) ;define-public + +;; 迁移是否已完成:新标记或旧标记任一存在即视为完成。 + +(define-public (migration-marker-exists? marker legacy-marker) + (or (url-exists? marker) (url-exists? legacy-marker)) +) ;define-public (define-public (make-empty-state kind) (case kind @@ -850,9 +869,9 @@ ) ;if ) ;define-public -(define (write-migration-marker marker-file) +(define-public (write-migration-marker marker-file) (string-save "migrated\n" (string->url marker-file)) -) ;define +) ;define-public (define (legacy-scm-interactive-assoc-valid? assoc-t) (and (list? assoc-t) (list-and (map pair? assoc-t))) @@ -1072,8 +1091,18 @@ ) ;define (define (maybe-import-legacy-scm-interactive-state) - (let ((need-interactive? (not (url-exists? interactive-arg-migration-marker-v1))) - (need-recent? (not (url-exists? recent-files-migration-marker-v1))) + (let ((need-interactive? + (not (migration-marker-exists? interactive-arg-migration-marker-v1 + legacy-interactive-arg-migration-marker-v1 + ) ;migration-marker-exists? + ) ;not + ) ;need-interactive? + (need-recent? + (not (migration-marker-exists? recent-files-migration-marker-v1 + legacy-recent-files-migration-marker-v1 + ) ;migration-marker-exists? + ) ;not + ) ;need-recent? ) ; (when (and (or need-interactive? need-recent?) (url-exists? legacy-interactive-arg-file) diff --git a/TeXmacs/progs/source/shortcut-edit.scm b/TeXmacs/progs/source/shortcut-edit.scm index 1a78a342c8..5eeb1734a5 100644 --- a/TeXmacs/progs/source/shortcut-edit.scm +++ b/TeXmacs/progs/source/shortcut-edit.scm @@ -22,7 +22,15 @@ (define legacy-user-shortcuts-file "$TEXMACS_HOME_PATH/system/shortcuts.scm") +;; 迁移标记文件名不能含 '>'(Windows 文件名禁止),否则标记永远写不出来, +;; 每次启动都重复导入 shortcuts.scm(同 #4466 的 recent-files 问题)。 +;; 旧标记在 macOS/Linux 上已落盘,继续识别。 + (define user-shortcuts-migration-marker-v1 + "$TEXMACS_HOME_PATH/system/shortcuts.scm.migrated-v1" +) ;define + +(define legacy-user-shortcuts-migration-marker-v1 "$TEXMACS_HOME_PATH/system/shortcuts.scm->v1" ) ;define @@ -188,6 +196,7 @@ (define (maybe-import-legacy-scm-user-shortcuts) (when (and (url-exists? legacy-user-shortcuts-file) (not (url-exists? user-shortcuts-migration-marker-v1)) + (not (url-exists? legacy-user-shortcuts-migration-marker-v1)) ) ;and (and-with legacy-shortcuts (load-legacy-scm-user-shortcuts)