Skip to content

Commit

Permalink
Always print with "print-level" and "print-length" nil
Browse files Browse the repository at this point in the history
This prevents Emacs from inserting "..." in place of very deep or long
data structures, which could corrupt the status file in some cases.
This is done by defining a wrapper function "el-get-print-to-string",
which el-get should use for all "critical" stringification tasks.

As noted in #689.
  • Loading branch information
DarwinAwardWinner committed Mar 29, 2012
1 parent 110e403 commit cb787b2
Show file tree
Hide file tree
Showing 8 changed files with 26 additions and 14 deletions.
15 changes: 13 additions & 2 deletions el-get-core.el
Expand Up @@ -24,6 +24,17 @@
(require 'bytecomp) (require 'bytecomp)
(require 'autoload) (require 'autoload)


(defun el-get-print-to-string (object &optional pretty)
"Return string representation of lisp object.
Unlike the Emacs builtin printing functions, this ignores
`print-level' and `print-length', ensuring that as much as
possible the returned string will be a complete representation of
the original object."
(let (print-level print-length)
(funcall (if pretty #'pp-to-string #'prin1-to-string)
object)))

(defun el-get-verbose-message (format &rest arguments) (defun el-get-verbose-message (format &rest arguments)
(when el-get-verbose (apply 'message format arguments))) (when el-get-verbose (apply 'message format arguments)))


Expand Down Expand Up @@ -362,7 +373,7 @@ makes it easier to conditionally splice a command into the list.
(infile (when stdin (make-temp-file "el-get"))) (infile (when stdin (make-temp-file "el-get")))
(dummy (when infile (dummy (when infile
(with-temp-file infile (with-temp-file infile
(insert (prin1-to-string stdin))))) (insert (el-get-print-to-string stdin)))))
(dummy (message "el-get is waiting for %S to complete" cname)) (dummy (message "el-get is waiting for %S to complete" cname))
(status (apply startf program infile cbuf t args)) (status (apply startf program infile cbuf t args))
(message (plist-get c :message)) (message (plist-get c :message))
Expand Down Expand Up @@ -390,7 +401,7 @@ makes it easier to conditionally splice a command into the list.
(process-put proc :el-get-final-func final-func) (process-put proc :el-get-final-func final-func)
(process-put proc :el-get-start-process-list next) (process-put proc :el-get-start-process-list next)
(when stdin (when stdin
(process-send-string proc (prin1-to-string stdin)) (process-send-string proc (el-get-print-to-string stdin))
(process-send-eof proc)) (process-send-eof proc))
(set-process-sentinel proc 'el-get-start-process-list-sentinel) (set-process-sentinel proc 'el-get-start-process-list-sentinel)
(when filter (set-process-filter proc filter))))) (when filter (set-process-filter proc filter)))))
Expand Down
8 changes: 4 additions & 4 deletions el-get-custom.el
Expand Up @@ -368,14 +368,14 @@ this is the name to fetch in that system"
(if (symbolp e) (if (symbolp e)
(cons (cons
(list 'const (list 'const
(intern (substring (prin1-to-string e) 1))) (intern (substring (el-get-print-to-string e) 1)))
r) r)
r)) r))
el-get-methods el-get-methods
:initial-value nil) :initial-value nil)
(lambda (x y) (lambda (x y)
(string< (prin1-to-string (cadr x)) (string< (el-get-print-to-string (cadr x))
(prin1-to-string (cadr y))))))) (el-get-print-to-string (cadr y)))))))


(group :inline t :format "Source URL: %v" (group :inline t :format "Source URL: %v"
(const :format "" :url) (string :format "%v")) (const :format "" :url) (string :format "%v"))
Expand Down Expand Up @@ -436,7 +436,7 @@ this is the name to fetch in that system"
:inline t :tag "System-Specific Build Recipes" :inline t :tag "System-Specific Build Recipes"
(group :inline t (group :inline t
(symbol :value ,(concat ":build/" (symbol :value ,(concat ":build/"
(prin1-to-string system-type)) (el-get-print-to-string system-type))
:format "Build Tag: %v%h" :format "Build Tag: %v%h"
:doc "Must be of the form `:build/<system-type>', :doc "Must be of the form `:build/<system-type>',
where `<system-type>' is the value of `system-type' on where `<system-type>' is the value of `system-type' on
Expand Down
2 changes: 1 addition & 1 deletion el-get-list-packages.el
Expand Up @@ -130,7 +130,7 @@ matching REGEX with TYPE and ARGS as parameter."
(el-get-describe-princ-button (format " in `%s':\n" file) (el-get-describe-princ-button (format " in `%s':\n" file)
"`\\([^`']+\\)" "`\\([^`']+\\)"
'el-get-help-package-def package))) 'el-get-help-package-def package)))
(prin1 def))) (princ (el-get-print-to-string def))))


(defun el-get-describe (package) (defun el-get-describe (package)
"Generate a description for PACKAGE." "Generate a description for PACKAGE."
Expand Down
5 changes: 3 additions & 2 deletions el-get-status.el
Expand Up @@ -61,9 +61,10 @@
(cons package (list 'status status 'recipe recipe)))) (cons package (list 'status status 'recipe recipe))))
(lambda (p1 p2) (lambda (p1 p2)
(string< (el-get-as-string (car p1)) (string< (el-get-as-string (car p1))
(el-get-as-string (car p2))))))) (el-get-as-string (car p2))))))
print-level print-length)
(with-temp-file el-get-status-file (with-temp-file el-get-status-file
(insert (pp-to-string new-package-status-alist))) (insert (el-get-print-to-string new-package-status-alist 'pretty)))
;; Return the new alist ;; Return the new alist
new-package-status-alist)) new-package-status-alist))


Expand Down
2 changes: 1 addition & 1 deletion el-get.el
Expand Up @@ -842,7 +842,7 @@ itself.")
;; Filepath is dir/file ;; Filepath is dir/file
(let ((filepath (format "%s/%s" dir filename))) (let ((filepath (format "%s/%s" dir filename)))
(with-temp-file filepath (with-temp-file filepath
(insert (prin1-to-string source)))))) (insert (el-get-print-to-string source))))))


;;;###autoload ;;;###autoload
(defun el-get-make-recipes (&optional dir) (defun el-get-make-recipes (&optional dir)
Expand Down
2 changes: 1 addition & 1 deletion recipes/wanderlust.rcp
Expand Up @@ -12,7 +12,7 @@
(append (append
'("apel" "flim" "semi") '("apel" "flim" "semi")
(when (el-get-package-exists-p "bbdb") (list "bbdb")))) (when (el-get-package-exists-p "bbdb") (list "bbdb"))))
"--eval" (prin1-to-string "--eval" (el-get-print-to-string
'(progn (setq wl-install-utils t) '(progn (setq wl-install-utils t)
(setq wl-info-lang "en") (setq wl-info-lang "en")
(setq wl-news-lang "en"))) (setq wl-news-lang "en")))
Expand Down
4 changes: 2 additions & 2 deletions test/el-get-issue-656.el
Expand Up @@ -13,15 +13,15 @@
`((:name a :type test :compile "." :features a :build `((:name a :type test :compile "." :features a :build
(("sh" "-c" ,(format "echo %s > a.el" (("sh" "-c" ,(format "echo %s > a.el"
(shell-quote-argument (shell-quote-argument
(mapconcat #'pp-to-string (mapconcat #'el-get-print-to-string
'((require 'b) '((require 'b)
(provide 'a)) (provide 'a))
"\n"))))) "\n")))))
:depends b) :depends b)
(:name b :type test :compile "." :features nil :build (:name b :type test :compile "." :features nil :build
(("sh" "-c" ,(format "echo %s > b.el" (("sh" "-c" ,(format "echo %s > b.el"
(shell-quote-argument (shell-quote-argument
(pp-to-string (el-get-print-to-string
'(provide 'b))))))))) '(provide 'b)))))))))


;; Ensure both are uninstalled ;; Ensure both are uninstalled
Expand Down
2 changes: 1 addition & 1 deletion test/el-get-issue-672.el
Expand Up @@ -13,7 +13,7 @@
;; Set up the status file with a removed package that has no current ;; Set up the status file with a removed package that has no current
;; recipe available. ;; recipe available.
(with-temp-buffer (with-temp-buffer
(insert (prin1-to-string (insert (el-get-print-to-string
'(:nonexistent-package "removed"))) '(:nonexistent-package "removed")))
(write-file el-get-status-file)) (write-file el-get-status-file))


Expand Down

0 comments on commit cb787b2

Please sign in to comment.