├── .gitignore ├── .indium.json ├── canvas-styles.css.map ├── extra-styles.css.map ├── Test-course ├── curlcommand.sh ├── assignments.el ├── Assignments.org └── setup.org ├── canvas-styles.css ├── extra-styles.css ├── canvas-styles.scss ├── Grading-template.org ├── ox-canvashtml.el ├── org-grading.el └── ox-canvashtml.org /.gitignore: -------------------------------------------------------------------------------- 1 | .aider* 2 | /test/ 3 | -------------------------------------------------------------------------------- /.indium.json: -------------------------------------------------------------------------------- 1 | { 2 | "configurations": [ 3 | { 4 | "name": "default", 5 | "type": "node", 6 | "command": "node", 7 | "inspect-brk": true 8 | } 9 | ] 10 | } 11 | -------------------------------------------------------------------------------- /canvas-styles.css.map: -------------------------------------------------------------------------------- 1 | {"version":3,"sourceRoot":"","sources":["canvas-styles.scss"],"names":[],"mappings":"AAGA;EACI;EACA;;;AAGJ;EACI;EACA;EACA;;;AAaJ;EACI;EACA;AACA;AACA;EACA;AACA;AACA;;;AAKJ;EACI;EACA;EACA;EACA;AAKA;;AAJA;EACI,kBA1CM;EA2CN;;AAIJ;EACI;;AAGA;EACA;;AAGJ;EACI;EACA;;AAEJ;EACI;;;AAaR;EACI;EACA;EACA;EACA;;AACA;EACI;EACA;EACA;EACA;EACA;;;AAOR;EAEI;EACA;;;AAGJ;EACI;EACA","file":"canvas-styles.css"} -------------------------------------------------------------------------------- /extra-styles.css.map: -------------------------------------------------------------------------------- 1 | {"version":3,"sourceRoot":"","sources":["extra-styles.scss"],"names":[],"mappings":"AAGA;EACI;EACA;;;AAGJ;EACI;EACA;EACA;;;AAGJ;EACI;;;AAEJ;EACI;;;AAEJ;EACI;;;AAGJ;EACI;EACA;AACA;AACA;EACA;AACA;AACA;;;AAKJ;EACI;EACA;EACA;EACA;AAKA;;AAJA;EACI,kBA1CM;EA2CN;;AAIJ;EACI;;AAGA;EACA;;AAGJ;EACI;EACA;;AAEJ;EACI;;;AAaR;EACI;EACA;EACA;EACA;;AACA;EACI;EACA;EACA;EACA;EACA;;;AAOR;EAEI;EACA;;;AAGJ;EACI;EACA","file":"extra-styles.css"} -------------------------------------------------------------------------------- /Test-course/curlcommand.sh: -------------------------------------------------------------------------------- 1 | curl 'https://inst-fs-yul-prod.inscloudgate.net/files?token=eyJ0eXAiOiJKV1QiLCJhbGciOiJIUzUxMiJ9.eyJpYXQiOjE2MTk3MjI3ODUsInVzZXJfaWQiOiIxMTgzNDAwMDAwMDAwODQ0MTIiLCJyZXNvdXJjZSI6Ii9maWxlcyIsImNhcHR1cmVfdXJsIjoiaHR0cHM6Ly9xLnV0b3JvbnRvLmNhL2FwaS92MS9maWxlcy9jYXB0dXJlIiwiY2FwdHVyZV9wYXJhbXMiOnsiY29udGV4dF90eXBlIjoiQ291cnNlIiwiY29udGV4dF9pZCI6nIjExODM0MDAwMDAwMDE4NDMzMSIsInVzZXJfaWQiOiIxMTgzNDAwMDAwMDAwODQ0MTIiLCJmb2xkZXJfaWQiOm51bGwsInJvb3RfYWNjb3VudF9pZCI6IjExODM0MDAwMDAwMDAwMDAwMSIsInF1b3RhX2V4ZW1wdCI6ZmFsc2UsIm9uX2R1cGxpY2F0ZSI6Im92ZXJ3cml0ZSIsInByb2dyZXNzX2lkIjpudWxsLCJpbmNsdWRlIjpudWxsfSwibGVnYWN5X2FwaV9kZXZlbG9wZXJfa2V5X2lkIjoiMTcwMDAwMDAwMDAwMDE2IiwibGVnYWN5X2FwaV9yb290X2FjY291bnRfaWQiOiIxMTgzNDAwMDAwMDAwMDAwMDEiLCJleHAiOjE2MTk3MjMzODV9.RoDrxgPitSkHY4IQrHWoOqFcJUFJv_ZZU7mk-lLzO__Tg6hMDuk2lE_MV7028uCC7PKvtIlbxvPvjEUkEH8dIQ' -F 'content_type=text/html' -F 'filename=01-intro.html' -F 'file=@~/WDW235/01-intro.html' 2> /dev/null -------------------------------------------------------------------------------- /Test-course/assignments.el: -------------------------------------------------------------------------------- 1 | ((testassignment0 :courseid "184331" :canvasid "601031" :due-at "2021-05-03" :html_url "https://q.utoronto.ca/courses/184331/assignments/601031" :name "test assignment 0" :submission_type "online_upload" :published "t" :submission_url "https://q.utoronto.ca/courses/184331/assignments/601031/submissions?zip=1" :basecommit nil :org_lms_email_comments nil :org_lms_canvas_comments "t" :assignment_number nil :grade_type "letter_grade" :assignment-type "canvas" :directory "test-assignment-0" :rubric nil) (testingagain :courseid "184331" :canvasid "604177" :due-at "2021-05-03" :html_url "https://q.utoronto.ca/courses/184331/assignments/604177" :name "testing again" :submission_type "online_upload" :published "t" :submission_url "https://q.utoronto.ca/courses/184331/assignments/604177/submissions?zip=1" :basecommit nil :org_lms_email_comments nil :org_lms_canvas_comments "t" :assignment_number nil :grade_type "letter_grade" :assignment-type "canvas" :directory "testing-again" :rubric nil)) -------------------------------------------------------------------------------- /canvas-styles.css: -------------------------------------------------------------------------------- 1 | .mygrid { 2 | display: grid; 3 | grid-template-columns: 1fr 1fr; 4 | } 5 | 6 | .mygrid > h1, .mygrid > h2 { 7 | grid-column: 1/-1; 8 | margin-left: auto; 9 | margin-right: auto; 10 | } 11 | 12 | .colflow { 13 | display: grid; 14 | grid-template-columns: repeat(auto-fill, minmax(200px, 1fr)); 15 | /* This is better for small screens, once min() is better supported */ 16 | /* grid-template-columns: repeat(auto-fill, minmax(min(200px, 100%), 1fr)); */ 17 | grid-gap: 1rem; 18 | /* This is the standardized property now, but has slightly less support */ 19 | /* gap: 1rem */ 20 | } 21 | 22 | table { 23 | font-size: 1.2em; 24 | border-spacing: 0 0; 25 | border-collapse: separate; 26 | border: 1px solid grey; 27 | /* zebra striping */ 28 | } 29 | table thead { 30 | background-color: #002a5c; 31 | color: white; 32 | } 33 | table tbody tr:nth-child(odd) { 34 | background-color: #dce6ff; 35 | } 36 | table tbody tr:nth-child(even) { 37 | background-color: #76b4ff; 38 | } 39 | table tbody tr td { 40 | padding-left: 1em; 41 | padding-right: 1em; 42 | } 43 | table a { 44 | color: #7700ee; 45 | } 46 | 47 | #outline-container-course-schedule .outline-3 { 48 | border-radius: 10px; 49 | border: rgba(51, 51, 51, 0.75) 2px solid; 50 | padding-left: 1em; 51 | margin-bottom: 10px; 52 | } 53 | #outline-container-course-schedule .outline-3 .outline-4 { 54 | border: grey solid 1px; 55 | border-radius: 10px; 56 | padding: 1em; 57 | margin-right: 1em; 58 | margin-bottom: 1em; 59 | } 60 | 61 | .content-box { 62 | background-color: var(--ic-brand-primary); 63 | color: #ffffff; 64 | } 65 | 66 | section.outline-2 h2.content-box { 67 | margin-top: 0.25em; 68 | margin-bottom: 0.25em; 69 | } 70 | 71 | /*# sourceMappingURL=canvas-styles.css.map */ 72 | -------------------------------------------------------------------------------- /extra-styles.css: -------------------------------------------------------------------------------- 1 | .mygrid { 2 | display: grid; 3 | grid-template-columns: 1fr 1fr; 4 | } 5 | 6 | .mygrid > h1, .mygrid > h2 { 7 | grid-column: 1/-1; 8 | margin-left: auto; 9 | margin-right: auto; 10 | } 11 | 12 | .box { 13 | column-count: 2; 14 | } 15 | 16 | .outline-text-2 { 17 | column-count: 2; 18 | } 19 | 20 | .box-contents outline-text-2 { 21 | column-count: 2; 22 | } 23 | 24 | .colflow { 25 | display: grid; 26 | grid-template-columns: repeat(auto-fill, minmax(200px, 1fr)); 27 | /* This is better for small screens, once min() is better supported */ 28 | /* grid-template-columns: repeat(auto-fill, minmax(min(200px, 100%), 1fr)); */ 29 | grid-gap: 1rem; 30 | /* This is the standardized property now, but has slightly less support */ 31 | /* gap: 1rem */ 32 | } 33 | 34 | table { 35 | font-size: 1.2em; 36 | border-spacing: 0 0; 37 | border-collapse: separate; 38 | border: 1px solid grey; 39 | /* zebra striping */ 40 | } 41 | table thead { 42 | background-color: #002a5c; 43 | color: white; 44 | } 45 | table tbody tr:nth-child(odd) { 46 | background-color: #dce6ff; 47 | } 48 | table tbody tr:nth-child(even) { 49 | background-color: #76b4ff; 50 | } 51 | table tbody tr td { 52 | padding-left: 1em; 53 | padding-right: 1em; 54 | } 55 | table a { 56 | color: #7700ee; 57 | } 58 | 59 | #outline-container-course-schedule .outline-3 { 60 | border-radius: 10px; 61 | border: rgba(51, 51, 51, 0.75) 2px solid; 62 | padding-left: 1em; 63 | margin-bottom: 10px; 64 | } 65 | #outline-container-course-schedule .outline-3 .outline-4 { 66 | border: grey solid 1px; 67 | border-radius: 10px; 68 | padding: 1em; 69 | margin-right: 1em; 70 | margin-bottom: 1em; 71 | } 72 | 73 | .content-box { 74 | background-color: var(--ic-brand-primary); 75 | color: #ffffff; 76 | } 77 | 78 | section.outline-2 h2.content-box { 79 | margin-top: 0.25em; 80 | margin-bottom: 0.25em; 81 | } 82 | 83 | /*# sourceMappingURL=extra-styles.css.map */ 84 | -------------------------------------------------------------------------------- /Test-course/Assignments.org: -------------------------------------------------------------------------------- 1 | #+SETUPFILE: ./setup.org 2 | #+STARTUP: customtime 3 | #+HUGO_SECTION: assignment 4 | #+HUGO_MENU: :menu main :parent Assignments 5 | #+HUGO_AUTO_SET_LASTMOD: t 6 | #+ORG_LMS_COURSEID: 184331 7 | 8 | 9 | * Test Auto :assignment: 10 | :PROPERTIES: 11 | :ORG_LMS_EMAIL_COMMENTS: t 12 | :ORG_LMS_CANVAS_COMMENTS: t 13 | :ASSIGNMENT_TYPE: canvas 14 | :EXPORT_FILE_NAME: test-auto 15 | :GRADING_STANDARD_ID: nil 16 | :PUBLISH: t 17 | :OL_PUBLISH: t 18 | :ASSIGNMENT_WEIGHT: 0.10 19 | :CANVASID: 600711 20 | :CANVAS_HTML_URL: https://q.utoronto.ca/courses/184331/assignments/600711 21 | :CANVAS_SUBMISSION_URL: https://q.utoronto.ca/courses/184331/assignments/600711/submissions?zip=1 22 | :SUBMISSIONS_DOWNLOAD_URL: https://q.utoronto.ca/courses/184331/assignments/600711/submissions?zip=1 23 | :CANVAS_SUBMISSION_TYPES: (online_upload) 24 | :GRADING_TYPE: letter_grade 25 | :DUE_AT: 2021-05-04T03:59:59Z 26 | :END: 27 | 28 | Maybe there is some content here let's see. 29 | 30 | * Hello again :assignment: 31 | 32 | * hello third :assignment: 33 | :PROPERTIES: 34 | :ORG_LMS_EMAIL_COMMENTS: t 35 | :ORG_LMS_CANVAS_COMMENTS: t 36 | :ASSIGNMENT_TYPE: canvas 37 | :EXPORT_FILE_NAME: hello-third 38 | :GRADING_STANDARD_ID: nil 39 | :OL_PUBLISH: t 40 | :ASSIGNMENT_WEIGHT: 0.10 41 | :ASSIGNMENT_GROUP: Tests9 42 | :CANVASID: 600708 43 | :CANVAS_HTML_URL: https://q.utoronto.ca/courses/184331/assignments/600708 44 | :CANVAS_SUBMISSION_URL: https://q.utoronto.ca/courses/184331/assignments/600708/submissions?zip=1 45 | :SUBMISSIONS_DOWNLOAD_URL: https://q.utoronto.ca/courses/184331/assignments/600708/submissions?zip=1 46 | :CANVAS_SUBMISSION_TYPES: (online_upload) 47 | :GRADING_TYPE: letter_grade 48 | :DUE_AT: 2021-05-07 49 | :END: 50 | once again 51 | 52 | * crugt 53 | #+begin_src emacs-lisp 54 | (org-lms-get-assignment-groups) 55 | #+end_src 56 | 57 | #+RESULTS: 58 | dsfs 59 | 60 | #+begin_src emacs-lisp 61 | 62 | (org-lms-map-assignment-group-from-name "Tests9") 63 | 64 | ;;(org-lms-set-assignment-group `((name . "Tests"))) 65 | #+end_src 66 | 67 | #+RESULTS: 68 | #+begin_src emacs-lisp 69 | 283475 70 | #+end_src 71 | 72 | 73 | #+begin_src emacs-lisp 74 | (--first (string= "hello" it) '("1" "2" "3")) 75 | #+end_src 76 | #+RESULTS: 77 | #+begin_src emacs-lisp 78 | nil 79 | #+end_src 80 | 81 | * Tests 82 | :PROPERTIES: 83 | :CANVASID: 283468 84 | :POSITION: 3 85 | :GROUP_WEIGHT: 0.0 86 | :END: 87 | -------------------------------------------------------------------------------- /canvas-styles.scss: -------------------------------------------------------------------------------- 1 | $brand-color: rgb(0, 42, 92); 2 | $border-color: adjust-color($brand-color,$lightness:10%, $alpha:-0.2); 3 | 4 | .mygrid { 5 | display: grid; 6 | grid-template-columns: 1fr 1fr; 7 | } 8 | 9 | .mygrid>h1, .mygrid>h2 { 10 | grid-column: 1/-1; 11 | margin-left: auto; 12 | margin-right: auto; 13 | } 14 | 15 | .box { 16 | // column-count: 2; 17 | } 18 | .outline-text-2 { 19 | // column-count: 2; 20 | } 21 | .box-contents outline-text-2, { 22 | // column-count: 2; 23 | } 24 | 25 | .colflow { 26 | display: grid; 27 | grid-template-columns: repeat(auto-fill, minmax(200px, 1fr)); 28 | /* This is better for small screens, once min() is better supported */ 29 | /* grid-template-columns: repeat(auto-fill, minmax(min(200px, 100%), 1fr)); */ 30 | grid-gap: 1rem; 31 | /* This is the standardized property now, but has slightly less support */ 32 | /* gap: 1rem */ 33 | } 34 | 35 | 36 | // make tables suck less 37 | table { 38 | font-size: 1.2em; 39 | border-spacing: 0 0; 40 | border-collapse: separate; 41 | border: 1px solid grey; 42 | thead { 43 | background-color: $brand-color; 44 | color: white; 45 | } 46 | /* zebra striping */ 47 | 48 | tbody tr:nth-child(odd) { 49 | background-color: adjust-color($brand-color,$lightness:75%, $hue:10); 50 | 51 | } 52 | tbody tr:nth-child(even) { 53 | background-color: adjust-color($brand-color,$lightness:55%, $hue:0); 54 | } 55 | 56 | tbody tr td { 57 | padding-left: 1em; 58 | padding-right: 1em 59 | } 60 | a { 61 | color: adjust-color(rgb(0, 0, 238), $hue:30) 62 | } 63 | } 64 | 65 | // sections 66 | // section.outline-2 h2 { 67 | // //border-top: 2px solid $border-color; 68 | // margin-top: 1em; 69 | // } 70 | // section.outline-2 { 71 | // border-top: 2px solid $border-color; 72 | // // margin: 1em; 73 | // } 74 | #outline-container-course-schedule .outline-3 { 75 | border-radius: 10px; 76 | border: adjust-color(black, $lightness: 20%, $alpha:-0.25) 2px solid; 77 | padding-left: 1em; 78 | margin-bottom: 10px; 79 | .outline-4 { 80 | border: grey solid 1px; 81 | border-radius: 10px; 82 | padding: 1em; 83 | margin-right: 1em; 84 | margin-bottom: 1em; 85 | } 86 | } 87 | 88 | // #outline-container-course-schedule.dh-block-parent .outline-3 89 | // fat sections 90 | // actually changes thisto my own class maybe, like e.g. "fat" 91 | .content-box { 92 | // background-color: var(--ic-brand-primary-lightened-10); 93 | background-color: var(--ic-brand-primary); 94 | color: #ffffff; 95 | } 96 | 97 | section.outline-2 h2.content-box { 98 | margin-top:0.25em; 99 | margin-bottom: 0.25em; 100 | } 101 | -------------------------------------------------------------------------------- /Grading-template.org: -------------------------------------------------------------------------------- 1 | #+TODO: TODO(t) | READY(r) SENT (s) 2 | #+PROPERTY: GRADE 0 3 | #+ORG_LMS_COURSEID: 35724 4 | #+ORG_LMS_ASSIGNMENTS: ~/src/org-grading/Assignments.org 5 | 6 | This file is currently very messy. When it'sset up properly, it should explain how to use these functions. 7 | 8 | * Setup with new auto-generated assignments. :assignments: 9 | Grab assignments info from the pre-generated ~assignments.el~ file. 10 | 11 | #+begin_src emacs-lisp 12 | (org-lms-setup-grading) 13 | 14 | #+end_src 15 | 16 | | Name (upload here) | Download URL | Inspect | Make Headers | 17 | |----------------------------+--------------+-----------------------+----------------| 18 | | [[https://q.utoronto.ca/courses/64706/assignments/93915][Encountering the Madawaska]] | | [[elisp:(org-lms-canvas-inspect "courses/64706/assignments/93915")][Inspect Original JSON]] | [[elisp:(org-lms-make-headings (alist-get 'EncounteringtheMadawaska org-lms-merged-assignments) org-lms-merged-students)][Make Headlines]] | 19 | | [[https://q.utoronto.ca/courses/64706/assignments/93074][Response Paper 2]] | | [[elisp:(org-lms-canvas-inspect "courses/64706/assignments/93074")][Inspect Original JSON]] | [[elisp:(org-lms-make-headings (alist-get 'ResponsePaper2 org-lms-merged-assignments) org-lms-merged-students)][Make Headlines]] | 20 | | [[https://q.utoronto.ca/courses/64706/assignments/97790][Exam]] | | [[elisp:(org-lms-canvas-inspect "courses/64706/assignments/97790")][Inspect Original JSON]] | [[elisp:(org-lms-make-headings (alist-get 'Exam org-lms-merged-assignments) org-lms-merged-students)][Make Headlines]] | 21 | 22 | ** for when ~setup-grading~ isn't working! 23 | 24 | #+begin_src emacs-lisp 25 | (setq org-lms-merged-students (org-lms-merge-student-lists)) 26 | (setq org-lms-merged-assignments (org-lms-read-assignment-map "~/Wildwater/assignments.el")) 27 | (org-lms-assignments-table) 28 | org-lms-merged-students 29 | (org-lms-merge-student-lists "students.csv") 30 | (org-lms-get-local-students) 31 | (org-lms-get-students) 32 | #+end_src 33 | 34 | #+begin_src emacs-lisp 35 | (org-lms-get-students) 36 | #+end_src 37 | 38 | Doingsome quick filtering on results 39 | #+begin_src emacs-lisp :results code 40 | ;;(org-lms-get-gb-column-data "721") 41 | ;;(org-lms-canvas-request "courses/64706/custom_gradebook_columns" "GET" ) 42 | ;;(org-lms-post-gb-column "nickname") 43 | ;;(org-lms-map-) 44 | 45 | org-lms-merged-assignments 46 | (org-lms-read-assignment-map "~/Wildwater/assignments.el") 47 | (alist-get 'Exam org-lms-merged-assignments) 48 | 49 | (org-) 50 | #+end_src 51 | 52 | 53 | #+begin_src emacs-lisp 54 | 55 | 56 | #+begin_src emacs-lisp :tangle no 57 | (let* ((students org-lms-merged-students) 58 | (ghid 721) 59 | (nnid 723) 60 | (data 61 | (cl-loop for s in students 62 | collect `(("column_id" . ,ghid) ("user_id" . ,(plist-get s :id)) ("content" . ,(plist-get s :github))) 63 | collect `(("column_id" . ,nnid) ("user_id" . ,(plist-get s :id)) ("content" . ,(plist-get s :nickname))) 64 | ))) 65 | ;;(setq data `((("column_id" . "721") ("user_id" . "100120") ("content" . nill)))) 66 | (org-lms-post-gb-column-data `(("column_data" . ,data))) 67 | ;;(write-region (json-encode data) nil "/home/matt/example.json") 68 | ) 69 | #+end_src 70 | 71 | ** Mapping assignments -- data structure 72 | 73 | #+begin_src emacs-lisp :results code 74 | (org-lms-map-assignments (org-lms-get-keyword "ORG_LMS_ASSIGNMENTS") ) 75 | #+end_src 76 | 77 | #+begin_src emacs-lisp 78 | ((EncounteringtheMadawaska :courseid "64706" :canvasid "93915" :due-at "2018-10-23" :html_url "https://q.utoronto.ca/courses/64706/assignments/93915" :name "Encountering the Madawaska" :submission_type "online_upload" :published nil :submission_url "https://q.utoronto.ca/courses/64706/assignments/93915/submissions?zip=1" :grade_type "letter_grade" :assignment-type "canvas" :directory "encountering-the-madawaska" :rubric nil) 79 | (ResponsePaper2 :courseid "64706" :canvasid "93074" :due-at "2018-11-23" :html_url "https://q.utoronto.ca/courses/64706/assignments/93074" :name "Response Paper 2" :submission_type "online_upload" :published "t" :submission_url "https://q.utoronto.ca/courses/64706/assignments/93074/submissions?zip=1" :grade_type "letter_grade" :assignment-type "canvas" :directory "response-paper-2" :rubric "- *Organization* :: \n- *Clarity of Argument* :: \n- *Grammar and Spelling* :: \n- *Grade* :: \n- *See Attached Paper for further Comments* :: \n") 80 | (Exam :courseid "64706" :canvasid "97790" :due-at "2018-12-07" :html_url "https://q.utoronto.ca/courses/64706/assignments/97790" :name "Exam" :submission_type "online_upload" :published "t" :submission_url "https://q.utoronto.ca/courses/64706/assignments/97790/submissions?zip=1" :grade_type "letter_grade" :assignment-type nil :directory "exam" :rubric "*** Part 1 \n- Organization :: \n- Clarity of Argument :: \n- Grammar and Spelling :: \n- Grade for this part :: \n- See Attached Paper for further Comments :: \n*** Part 2\n- Organization :: \n- Clarity of Argument :: \n- Grammar and Spelling :: \n- Grade for this part :: \n- See Attached Paper for further Comments ::\n*** Overall\n- Grade ::\n- Final Comments :: \n")) 81 | #+end_src 82 | 83 | 84 | * COMMENT Set Up Course Properties 85 | 86 | *this stuff is DEPRECATED!* 87 | 88 | To begin with, we have to tell ~org-lms~ a few things about the course and its assignments. This will allows us to talk to the Canvas instance via its API and associate the local info with the hidden keys that the API uses to ingerpret requests. 89 | 90 | The following code does a few things: 91 | 92 | - sets the base URL for all API requests 93 | - retrieves the token from its storage place (probably best to use some other store, but this is the one I was able to get working!) 94 | - sets up the global ~org-lms-courses~ variable, which probably should be stored more centrally somehow. 95 | - gets the local assignment definition, and merges them with the assignments on Canvas 96 | - retrieves the student list from Canvas, and checks for a locally stored student list that may contain extra information (e.g., github logins and nicknames,, often important for Asian students especially) 97 | - generates a table with a number of org-mode links that allow you to interact with the API and also to generate grading subtrees for each assignment 98 | #+begin_src emacs-lisp 99 | (make-local-variable 'org-use-property-inheritance) 100 | (setq org-use-property-inheritance t) 101 | (setq org-lms-baseurl "https://q.utoronto.ca/api/v1/") 102 | (setq org-lms-token (password-store-get "q.utoronto.ca")) 103 | 104 | #+end_src 105 | 106 | | Name (upload here) | Download URL | Inspect | Make Headers | 107 | |--------------------+----------------------+-----------------------+----------------| 108 | | [[https://q.utoronto.ca/courses/64706/assignments/93074][Response Paper 2]] | [[https://q.utoronto.ca/courses/64706/assignments/93074/submissions?zip=1][Download Submissions]] | [[elisp:(org-lms-canvas-inspect "courses/64706/assignments/93074")][Inspect Original JSON]] | [[elisp:(org-lms-make-headings (alist-get 'response2 org-lms-merged-assignments) org-lms-merged-students)][Make Headlines]] | 109 | | [[https://q.utoronto.ca/courses/64706/assignments/88373][Test Assignment]] | [[https://q.utoronto.ca/courses/64706/assignments/88373/submissions?zip=1][Download Submissions]] | [[elisp:(org-lms-canvas-inspect "courses/64706/assignments/88373")][Inspect Original JSON]] | [[elisp:(org-lms-make-headings (alist-get 'test org-lms-merged-assignments) org-lms-merged-students)][Make Headlines]] | 110 | 111 | 112 | #+begin_src emacs-lisp :results code 113 | 114 | (org-lms-get-courses "courses.json") 115 | #+end_src 116 | -------------------------------------------------------------------------------- /Test-course/setup.org: -------------------------------------------------------------------------------- 1 | #+AUTHOR: Matt Price 2 | #+EMAIL: matt.price@utoronto.ca 3 | #+OPTIONS: toc:nil 4 | #+SELECT_TAGS: export 5 | #+EXCLUDE_TAGS: noexport 6 | #+HUGO_BASE_DIR: ~/WDW235/website 7 | #+HUGO_STATIC_IMAGES: Images 8 | #+HUGO_AUTO_SET_LASTMOD: t 9 | #+MACRO: ts (eval(mwp-get-ts+7 'org-mwp-classtimes-calibrate 1)) 10 | #+PROPERTY: header-args :results code 11 | # # #+HTML_CONTAINER: section 12 | #+OPTIONS: ':nil *:t -:t ::t <:t H:4 \n:nil arch:nil 13 | #+OPTIONS: author:nil c:nil creator:nil d:(not "LOGBOOK") date:nil 14 | #+OPTIONS: stat:t tags:t tasks:t tex:t timestamp:t toc:nil todo:t |:t 15 | #+STARTUP: customtime entitiespretty 16 | #+ORG_LMS_COURSEID: 184331 17 | #+ORG_LMS_SECTION: lectures 18 | #+OL_USE_CHITS: nil 19 | #+CSL_STYLE: /home/matt/Zotero/styles/chicago-manual-of-style-16th-edition-inline-notes-for-syllabi.csl 20 | #+PROPERTY: header-args:plantuml :noweb yes :eval no-export :results value file raw 21 | #+OPTIONS: reveal_single_file:t 22 | 23 | * Test a lecture 24 | :PROPERTIES: 25 | :EXPORT_FILE_NAME: test-lecture-01 26 | :ORG_LMS_FILE_URL: https://q.utoronto.ca/courses/184331/files/14333595/file_preview?annotate=0 27 | :END: 28 | 29 | #+begin_src emacs-lisp :exports none 30 | ;;(org-lms-get-single-module (org-lms-map-module-from-name "First Unit")) 31 | (org-lms-export-reveal-wim-to-html t) 32 | #+end_src 33 | 34 | #+RESULTS: 35 | #+begin_src emacs-lisp 36 | (:file_param "file" :progress nil :upload_url "https://inst-fs-yul-prod.inscloudgate.net/files?token=eyJ0eXAiOiJKV1QiLCJhbGciOiJIUzUxMiJ9.eyJpYXQiOjE2MTk3Mzk4MDgsInVzZXJfaWQiOiIxMTgzNDAwMDAwMDAwODQ0MTIiLCJyZXNvdXJjZSI6Ii9maWxlcyIsImNhcHR1cmVfdXJsIjoiaHR0cHM6Ly9xLnV0b3JvbnRvLmNhL2FwaS92MS9maWxlcy9jYXB0dXJlIiwiY2FwdHVyZV9wYXJhbXMiOnsiY29udGV4dF90eXBlIjoiQ291cnNlIiwiY29udGV4dF9pZCI6IjExODM0MDAwMDAwMDE4NDMzMSIsInVzZXJfaWQiOiIxMTgzNDAwMDAwMDAwODQ0MTIiLCJmb2xkZXJfaWQiOiIxMTgzNDAwMDAwMDI4NTQ3NzQiLCJyb290X2FjY291bnRfaWQiOiIxMTgzNDAwMDAwMDAwMDAwMDEiLCJxdW90YV9leGVtcHQiOmZhbHNlLCJvbl9kdXBsaWNhdGUiOiJvdmVyd3JpdGUiLCJwcm9ncmVzc19pZCI6bnVsbCwiaW5jbHVkZSI6bnVsbH0sImxlZ2FjeV9hcGlfZGV2ZWxvcGVyX2tleV9pZCI6IjE3MDAwMDAwMDAwMDAxNiIsImxlZ2FjeV9hcGlfcm9vdF9hY2NvdW50X2lkIjoiMTE4MzQwMDAwMDAwMDAwMDAxIiwiZXhwIjoxNjE5NzQwNDA4fQ.mJdDQAUylf4e24fuiF-qqzUrbNAM-C9d82BWauvYh3z--bAxc_Hk74WGMTkfeyQVmSpcaG1-pMbSxNHluVagwQ" :upload_params 37 | (:filename "test-lecture-01.html" :content_type "text/html") 38 | :location "https://q.utoronto.ca/api/v1/files/14333543?include%5B%5D=enhanced_preview_url" :instfs_uuid "8f09f01c-5f20-4b71-808a-9ad70e855dd2" :id 14333543 :uuid "b0rCKZBJCSF4Jw6yY2URqTb5m2xuDd9cKTYPqKND" :folder_id 2854774 :display_name "test-lecture-01.html" :filename "test-lecture-01.html" :upload_status "success" :content-type "text/html" :url "https://q.utoronto.ca/files/14333543/download?download_frd=1&verifier=b0rCKZBJCSF4Jw6yY2URqTb5m2xuDd9cKTYPqKND" :size 195340 :created_at "2021-04-29T23:43:29Z" :updated_at "2021-04-29T23:43:29Z" :unlock_at nil :locked nil :hidden nil :lock_at nil :hidden_for_user nil :thumbnail_url nil :modified_at "2021-04-29T23:43:29Z" :mime_class "html" :media_entry_id nil :locked_for_user nil :preview_url "/courses/184331/files/14333543/file_preview?annotate=0") 39 | #+end_src 40 | 41 | some stuff 42 | #+RESULTS: 43 | #+begin_src emacs-lisp 44 | (:id 456782 :name "First Unit" :position 1 :unlock_at nil :require_sequential_progress nil :publish_final_grade nil :prerequisite_module_ids nil :published nil :items_count 1 :items_url "https://q.utoronto.ca/api/v1/courses/184331/modules/456782/items") 45 | #+end_src 46 | 47 | * TODO test assignment 0 :assignment: 48 | :PROPERTIES: 49 | :ORG_LMS_EMAIL_COMMENTS: t 50 | :ORG_LMS_CANVAS_COMMENTS: t 51 | :ASSIGNMENT_TYPE: canvas 52 | :DUE_AT: 2021-05-03 53 | :EXPORT_FILE_NAME: test-assignment-0 54 | :GRADING_STANDARD_ID: nil 55 | :PUBLISH: t 56 | :OL_PUBLISH: t 57 | :ASSIGNMENT_WEIGHT: 0.10 58 | :CANVASID: 601031 59 | :MODULE_ITEM_TYPE: Assignment 60 | :MODULE: second new module 61 | :CANVAS_HTML_URL: https://q.utoronto.ca/courses/184331/assignments/601031 62 | :CANVAS_SUBMISSION_URL: https://q.utoronto.ca/courses/184331/assignments/601031/submissions?zip=1 63 | :SUBMISSIONS_DOWNLOAD_URL: https://q.utoronto.ca/courses/184331/assignments/601031/submissions?zip=1 64 | :CANVAS_SUBMISSION_TYPES: (online_upload) 65 | :GRADING_TYPE: letter_grade 66 | :ORG_LMS_FILE_URL: https://q.utoronto.ca/courses/184331/files/14333602/file_preview?annotate=0 67 | :END: 68 | 69 | #+begin_src emacs-lisp 70 | ;;(org-lms-module-item-from-headline) 71 | (org-lms-map-module-from-name (org-entry-get nil "MODULE")) 72 | ;;(org-entry-get nil "MODULE") 73 | #+end_src 74 | 75 | #+RESULTS: 76 | #+begin_src emacs-lisp 77 | 456895 78 | #+end_src 79 | 80 | * testing again :assignment: 81 | :PROPERTIES: 82 | :ORG_LMS_EMAIL_COMMENTS: t 83 | :ORG_LMS_CANVAS_COMMENTS: t 84 | :ASSIGNMENT_TYPE: canvas 85 | :DUE_AT: 2021-05-03 86 | :GRADING_STANDARD_ID: nil 87 | :PUBLISH: t 88 | :EXPORT_FILE_NAME: testing-again 89 | :OL_PUBLISH: t 90 | :ASSIGNMENT_WEIGHT: 0.10 91 | :ORG_LMS_ANNOUNCEMENT_ID: 1195848 92 | :ORG_LMS_FILE_URL: https://q.utoronto.ca/courses/184331/files/14333606/file_preview?annotate=0 93 | :END: 94 | #+begin_verse 95 | :ORG_LMS_ANNOUNCEMENT_URL: https://q.utoronto.ca/courses/184331/discussion_topics/1195848 96 | :ORG_LMS_POSTED_AT: 2021-04-29T21:18:25Z 97 | :CANVASID: 604177 98 | :CANVAS_HTML_URL: https://q.utoronto.ca/courses/184331/assignments/604177 99 | :CANVAS_SUBMISSION_URL: https://q.utoronto.ca/courses/184331/assignments/604177/submissions?zip=1 100 | :SUBMISSIONS_DOWNLOAD_URL: https://q.utoronto.ca/courses/184331/assignments/604177/submissions?zip=1 101 | :CANVAS_SUBMISSION_TYPES: (online_upload) 102 | :GRADING_TYPE: letter_grade 103 | 104 | #+end_verse 105 | ** exporting lectures etc. as files. 106 | 107 | 108 | #+begin_src emacs-lisp 109 | (org-lms--get-valid-subtree) 110 | ;;(org-lms-export-lecture-wim-to-html) 111 | #+end_src 112 | 113 | #+RESULTS: 114 | #+begin_src emacs-lisp 115 | nil 116 | #+end_src 117 | 118 | #+RESULTS: 119 | #+begin_src emacs-lisp 120 | "/home/matt/src/org-grading/Test-course/testing-again.html" 121 | #+end_src 122 | 123 | 124 | ** fooling around modules and headline 125 | #+begin_src emacs-lisp 126 | (org-ml-get-all-properties (org-ml-parse-headline-at (point))) 127 | #+end_src 128 | 129 | #+begin_src emacs-lisp 130 | (let* ((name "second new module") 131 | (newmodule `(("name" . ,name )) )) 132 | (org-lms-set-module newmodule) 133 | ;;(json-encode `(("module" . ,newmodule))) 134 | ) 135 | 136 | #+end_src 137 | 138 | #+RESULTS: 139 | #+begin_src emacs-lisp 140 | (:id 456895 :name "second new module" :position 6 :unlock_at nil :require_sequential_progress nil :publish_final_grade nil :prerequisite_module_ids nil :published nil :items_count 0 :items_url "https://q.utoronto.ca/api/v1/courses/184331/modules/456895/items") 141 | #+end_src 142 | ** modules 143 | 144 | 145 | #+begin_src emacs-lisp 146 | (org-lms-get-single-module-item 2490143 456782) 147 | (org-lms-get-module-items 456782) 148 | (let ((newitem '(:id 2490143 :title "hello third" :position 1 :indent 0 :quiz_lti nil :type "Assignment" :module_id 456782 :html_url "https://q.utoronto.ca/courses/184331/modules/items/2490143" :content_id 600708 :url "https://q.utoronto.ca/api/v1/courses/184331/assignments/600708" :published t :content_details 149 | (:due_at "2021-05-07T03:59:59Z" :points_possible 10.0 :locked_for_user nil)))) 150 | 151 | ) 152 | #+end_src 153 | 154 | #+RESULTS: 155 | #+begin_src emacs-lisp 156 | ((:id 2490143 :title "hello third" :position 1 :indent 0 :quiz_lti nil :type "Assignment" :module_id 456782 :html_url "https://q.utoronto.ca/courses/184331/modules/items/2490143" :content_id 600708 :url "https://q.utoronto.ca/api/v1/courses/184331/assignments/600708" :published t :content_details 157 | (:due_at "2021-05-07T03:59:59Z" :points_possible 10.0 :locked_for_user nil))) 158 | #+end_src 159 | 160 | ** Files 161 | :PROPERTIES: 162 | :EXPORT_FILE_NAME: testing-file-lecture2 163 | :ORG_LMS_FILE_URL: https://q.utoronto.ca/courses/184331/files/14333460/file_preview?annotate=0 164 | :END: 165 | 166 | test test 167 | 168 | ** 169 | #+begin_src emacs-lisp 170 | (save-excursion 171 | ;;(org-backward-heading-same-level nil) 172 | (org-lms-export-reveal-wim-to-html t)) 173 | #+end_src 174 | 175 | #+RESULTS: 176 | #+begin_src emacs-lisp 177 | "all-sbutrees is currently disabled, sorry!" 178 | #+end_src 179 | 180 | ** 181 | Tried a fewother options and all suck, better just forget it for now. 182 | #+begin_src emacs-lisp 183 | (defun do-something-async (value) 184 | "Return `Promise' to resolve the value asynchronously." 185 | (promise-new (lambda (resolve _reject) 186 | (lambda () 187 | (funcall resolve value))))) 188 | 189 | (promise-chain 190 | (do-something-async (lambda () (org-lms-post-new-file 191 | "/home/matt/src/org-grading/Test-course/setup.html" nil 192 | "A fourth folder I made") 193 | (sleep-for 10) 194 | (message "done now"))) 195 | (then (lambda (result) (message "maybe this worked")) ) 196 | ) 197 | #+end_src 198 | #+RESULTS: 199 | #+begin_src emacs-lisp 200 | ;;(org-lms-post-new-file "/home/matt/test.org") 201 | (org-lms-export-reveal-wim-to-html) 202 | #+end_src 203 | ** another one 204 | #+RESULTS: 205 | #+begin_src emacs-lisp 206 | (:file_param "file" :progress nil :upload_url "https://inst-fs-yul-prod.inscloudgate.net/files?token=eyJ0eXAiOiJKV1QiLCJhbGciOiJIUzUxMiJ9.eyJpYXQiOjE2MTk3MzcyNDcsInVzZXJfaWQiOiIxMTgzNDAwMDAwMDAwODQ0MTIiLCJyZXNvdXJjZSI6Ii9maWxlcyIsImNhcHR1cmVfdXJsIjoiaHR0cHM6Ly9xLnV0b3JvbnRvLmNhL2FwaS92MS9maWxlcy9jYXB0dXJlIiwiY2FwdHVyZV9wYXJhbXMiOnsiY29udGV4dF90eXBlIjoiQ291cnNlIiwiY29udGV4dF9pZCI6IjExODM0MDAwMDAwMDE4NDMzMSIsInVzZXJfaWQiOiIxMTgzNDAwMDAwMDAwODQ0MTIiLCJmb2xkZXJfaWQiOm51bGwsInJvb3RfYWNjb3VudF9pZCI6IjExODM0MDAwMDAwMDAwMDAwMSIsInF1b3RhX2V4ZW1wdCI6ZmFsc2UsIm9uX2R1cGxpY2F0ZSI6Im92ZXJ3cml0ZSIsInByb2dyZXNzX2lkIjpudWxsLCJpbmNsdWRlIjpudWxsfSwibGVnYWN5X2FwaV9kZXZlbG9wZXJfa2V5X2lkIjoiMTcwMDAwMDAwMDAwMDE2IiwibGVnYWN5X2FwaV9yb290X2FjY291bnRfaWQiOiIxMTgzNDAwMDAwMDAwMDAwMDEiLCJleHAiOjE2MTk3Mzc4NDd9.s75PJJUgdMKJqvHlNKjpTPpg3N7zvtI4tLPK52gLmBM6-ca0-Inync29UDFTKRLvNHkXLfAli7_vPKzIz5Yeog" :upload_params 207 | (:filename "test.org" :content_type "unknown/unknown") 208 | :location "https://q.utoronto.ca/api/v1/files/14333381?include%5B%5D=enhanced_preview_url" :instfs_uuid "86ea1c8a-a3b6-45d1-8865-9aacf0c5a03c" :id 14333381 :uuid "7LDiDlWCVwhLMqu3LP8K9XdWNUpWQE3Vgx4eFn0I" :folder_id 2854556 :display_name "test.org" :filename "test.org" :upload_status "success" :content-type "application/octet-stream" :url "https://q.utoronto.ca/files/14333381/download?download_frd=1&verifier=7LDiDlWCVwhLMqu3LP8K9XdWNUpWQE3Vgx4eFn0I" :size 76 :created_at "2021-04-29T23:00:47Z" :updated_at "2021-04-29T23:00:47Z" :unlock_at nil :locked nil :hidden nil :lock_at nil :hidden_for_user nil :thumbnail_url nil :modified_at "2021-04-29T23:00:47Z" :mime_class "file" :media_entry_id nil :locked_for_user nil :preview_url "/courses/184331/files/14333381/file_preview?annotate=0") 209 | #+end_src 210 | 211 | some other stuff 212 | #+begin_src emacs-lisp 213 | (org-lms-upload-file-to-storage "~/WDW235/01-intro.html" 214 | '(:file_param "file" :progress nil :upload_url "https://inst-fs-yul-prod.inscloudgate.net/files?token=eyJ0eXAiOiJKV1QiLCJhbGciOiJIUzUxMiJ9.eyJpYXQiOjE2MTk3MjQ0MzgsInVzZXJfaWQiOiIxMTgzNDAwMDAwMDAwODQ0MTIiLCJyZXNvdXJjZSI6Ii9maWxlcyIsImNhcHR1cmVfdXJsIjoiaHR0cHM6Ly9xLnV0b3JvbnRvLmNhL2FwaS92MS9maWxlcy9jYXB0dXJlIiwiY2FwdHVyZV9wYXJhbXMiOnsiY29udGV4dF90eXBlIjoiQ291cnNlIiwiY29udGV4dF9pZCI6IjExODM0MDAwMDAwMDE4NDMzMSIsInVzZXJfaWQiOiIxMTgzNDAwMDAwMDAwODQ0MTIiLCJmb2xkZXJfaWQiOm51bGwsInJvb3RfYWNjb3VudF9pZCI6IjExODM0MDAwMDAwMDAwMDAwMSIsInF1b3RhX2V4ZW1wdCI6ZmFsc2UsIm9uX2R1cGxpY2F0ZSI6Im92ZXJ3cml0ZSIsInByb2dyZXNzX2lkIjpudWxsLCJpbmNsdWRlIjpudWxsfSwibGVnYWN5X2FwaV9kZXZlbG9wZXJfa2V5X2lkIjoiMTcwMDAwMDAwMDAwMDE2IiwibGVnYWN5X2FwaV9yb290X2FjY291bnRfaWQiOiIxMTgzNDAwMDAwMDAwMDAwMDEiLCJleHAiOjE2MTk3MjUwMzh9.dMn-slHqD67v8uo6VXq2nH71tlZwnUhzpjfzgJ7HWk_7agHxUw5CA0wHPPICPLjkOOsUGVWG_YvjE47wJbtvUw" :upload_params 215 | (:filename "01-intro.html" :content_type "text/html"))) 216 | #+end_src 217 | 218 | #+RESULTS: 219 | #+begin_src emacs-lisp 220 | nil 221 | #+end_src 222 | 223 | #+begin_src emacs-lisp 224 | (map-elt '(:file_param "file" :progress nil :upload_url "https://inst-fs-yul-prod.inscloudgate.net/files?token=eyJ0eXAiOiJKV1QiLCJhbGciOiJIUzUxMiJ9.eyJpYXQiOjE2MTk3MjI3ODUsInVzZXJfaWQiOiIxMTgzNDAwMDAwMDAwODQ0MTIiLCJyZXNvdXJjZSI6Ii9maWxlcyIsImNhcHR1cmVfdXJsIjoiaHR0cHM6Ly9xLnV0b3JvbnRvLmNhL2FwaS92MS9maWxlcy9jYXB0dXJlIiwiY2FwdHVyZV9wYXJhbXMiOnsiY29udGV4dF90eXBlIjoiQ291cnNlIiwiY29udGV4dF9pZCI6IjExODM0MDAwMDAwMDE4NDMzMSIsInVzZXJfaWQiOiIxMTgzNDAwMDAwMDAwODQ0MTIiLCJmb2xkZXJfaWQiOm51bGwsInJvb3RfYWNjb3VudF9pZCI6IjExODM0MDAwMDAwMDAwMDAwMSIsInF1b3RhX2V4ZW1wdCI6ZmFsc2UsIm9uX2R1cGxpY2F0ZSI6Im92ZXJ3cml0ZSIsInByb2dyZXNzX2lkIjpudWxsLCJpbmNsdWRlIjpudWxsfSwibGVnYWN5X2FwaV9kZXZlbG9wZXJfa2V5X2lkIjoiMTcwMDAwMDAwMDAwMDE2IiwibGVnYWN5X2FwaV9yb290X2FjY291bnRfaWQiOiIxMTgzNDAwMDAwMDAwMDAwMDEiLCJleHAiOjE2MTk3MjMzODV9.RoDrxgPitSkHY4IQrHWoOqFcJUFJv_ZZU7mk-lLzO__Tg6hMDuk2lE_MV7028uCC7PKvtIlbxvPvjEUkEH8dIQ" :upload_params 225 | (:filename "01-intro.html" :content_type "text/html")) 226 | :upload_params) 227 | #+end_src 228 | 229 | #+RESULTS: 230 | #+begin_src emacs-lisp 231 | (:filename "01-intro.html" :content_type "text/html") 232 | #+end_src 233 | 234 | #+begin_src js 235 | { 236 | "location": "https://q.utoronto.ca/api/v1/files/14331694?include%5B%5D=enhanced_preview_url", 237 | "instfs_uuid": "dd3890ec-af2c-418a-a404-c9e5f95b31dd", 238 | "id": 14331694, 239 | "uuid": "TxId4GNlCG2lfOhmIg30tQ0leLH1IYljC1RGAvev", 240 | "folder_id": 2854556, 241 | "display_name": "01-intro.html", 242 | "filename": "01-intro.html", 243 | "upload_status": "success", 244 | "content-type": "text/html", 245 | "url": "https://q.utoronto.ca/files/14331694/download?download_frd=1&verifier=TxId4GNlCG2lfOhmIg30tQ0leLH1IYljC1RGAvev", 246 | "size": 27240, 247 | "created_at": "2021-04-29T19:28:27Z", 248 | "updated_at": "2021-04-29T19:28:27Z", 249 | "unlock_at": null, 250 | "locked": false, 251 | "hidden": false, 252 | "lock_at": null, 253 | "hidden_for_user": false, 254 | "thumbnail_url": null, 255 | "modified_at": "2021-04-29T19:28:27Z", 256 | "mime_class": "html", 257 | "media_entry_id": null, 258 | "locked_for_user": false, 259 | "preview_url": "/courses/184331/files/14331694/file_preview?annotate=0" 260 | } 261 | #+end_src 262 | -------------------------------------------------------------------------------- /ox-canvashtml.el: -------------------------------------------------------------------------------- 1 | ;; [[file:ox-canvashtml.org::*Requirements][Requirements:1]] 2 | (require 'ox-html) 3 | ;; Requirements:1 ends here 4 | 5 | ;; [[file:ox-canvashtml.org::*Add a link type for internal canvas links][Add a link type for internal canvas links:1]] 6 | ;;; ol-canvas.el - Support for links to man pages in Org mode 7 | (require 'ol) 8 | 9 | (org-link-set-parameters "canvas" 10 | ;;:follow #'org-canvas-open 11 | :follow #'org-id-open 12 | :export #'org-canvas-export 13 | :store #'org-canvas-store-link) 14 | 15 | (defcustom org-canvas-command 'canvas 16 | "The Emacs command to be used to display a canvas page." 17 | :group 'org-link 18 | :type '(choice (const man) (const woman))) 19 | 20 | (defun org-canvas-open (path _) 21 | "Visit the canvas page on PATH. 22 | PATH should be a topic that can be thrown at the man command." 23 | (browse-url path) 24 | ;; (funcall org-canvas-command path) 25 | ) 26 | ;; old version 27 | (defun org-canvas-get-url (id _) 28 | (save-window-excursion 29 | ;; add widen to it 30 | ;;(org-id-open id _) 31 | (let ((m (org-id-find id 'marker))) 32 | (unless m 33 | (error "Cannot find entry with ID \"%s\"" id)) 34 | (pop-to-buffer-same-window (marker-buffer m)) 35 | (save-restriction 36 | (widen) 37 | (goto-char m) 38 | (move-marker m nil) 39 | (org-show-context) 40 | (org-id-goto id) 41 | (or 42 | (org-entry-get nil "CANVAS_HTML_URL") 43 | (org-entry-get nil "ORG_LMS_PREVIEW_URL") 44 | (org-entry-get nil "ORG_LMS_ANNOUNCEMENT_URL") 45 | (org-entry-get nil "MODULE_ITEM_EXTERNAL_URL")))))) 46 | 47 | 48 | (defun org-canvas-store-link () 49 | "Store a link to the current entry, using its ID . 50 | 51 | If before first heading store first title-keyword as description 52 | or filename if no title." 53 | (interactive) 54 | (when (and (buffer-file-name (buffer-base-buffer)) (derived-mode-p 'org-mode) 55 | (and (symbolp 'org-lms-mode) (symbol-value 'org-lms-mode ))) 56 | (let* ((link (concat "canvas:" (org-id-get-create))) 57 | (case-fold-search nil) 58 | 59 | (desc (save-excursion 60 | (org-back-to-heading-or-point-min t) 61 | (cond ((org-before-first-heading-p) 62 | (let ((keywords (org-collect-keywords '("TITLE")))) 63 | (if keywords 64 | (cadr (assoc "TITLE" keywords)) 65 | (file-name-nondirectory 66 | (buffer-file-name (buffer-base-buffer)))))) 67 | ((looking-at org-complex-heading-regexp) 68 | (if (match-end 4) 69 | (match-string 4) 70 | (match-string 0))) 71 | (t link))))) 72 | (org-link-store-props :link link :description desc :type "canvas") 73 | link))) 74 | 75 | 76 | 77 | (defun org-canvas-export (link description format &optional _) 78 | "Export a canvas page link from Org files." 79 | (let ((path (org-canvas-get-url link _)) 80 | (desc (or description link))) 81 | (pcase format 82 | ('html (if path 83 | (format "%s" path desc) 84 | desc)) 85 | ('latex (if path 86 | (format "\\href{%s}{%s}" path desc) 87 | des)) 88 | ('texinfo (if path 89 | (format "@uref{%s,%s}" path desc) 90 | desc)) 91 | ('ascii (if path 92 | (format "%s (%s)" desc path) 93 | desc)) 94 | (t desc)))) 95 | ;; Add a link type for internal canvas links:1 ends here 96 | 97 | ;; [[file:ox-canvashtml.org::*define the derived backend][define the derived backend:1]] 98 | (org-export-define-derived-backend 'canvas-html 'html 99 | :translate-alist '((template . canvas-html-template) 100 | (inner-template . org-canvas-html-inner-template) 101 | (section . org-canvas-html-section) 102 | (headline . org-canvas-html-headline)) 103 | :menu-entry 104 | '(?2 "Export to HTML" 105 | ((?H "As HTML buffer" org-canvas-html-export-as-html) 106 | (?h "As HTML file" org-canvas-html-export-to-html) 107 | (?o "As HTML file and open" 108 | (lambda (a s v b) 109 | (if a (org-canvas-html-export-to-html t s v b) 110 | (org-open-file (org-canvas-html-export-to-html nil s v b))))))) 111 | 112 | ) 113 | ;; define the derived backend:1 ends here 114 | 115 | ;; [[file:ox-canvashtml.org::*Replace the link function so we can update local image links at least][Replace the link function so we can update local image links at least:1]] 116 | (defun org-canvashtml-link (link desc info) 117 | "Transcode a LINK object from Org to HTML. 118 | DESC is the description part of the link, or the empty string. 119 | INFO is a plist holding contextual information. See 120 | `org-export-data'." 121 | (let* ((html-ext (plist-get info :html-extension)) 122 | (dot (when (> (length html-ext) 0) ".")) 123 | (link-org-files-as-html-maybe 124 | (lambda (raw-path info) 125 | ;; Treat links to `file.org' as links to `file.html', if 126 | ;; needed. See `org-html-link-org-files-as-html'. 127 | (cond 128 | ((and (plist-get info :html-link-org-files-as-html) 129 | (string= ".org" 130 | (downcase (file-name-extension raw-path ".")))) 131 | (concat (file-name-sans-extension raw-path) dot html-ext)) 132 | (t raw-path)))) 133 | (type (org-element-property :type link)) 134 | (raw-path (org-element-property :path link)) 135 | ;; Ensure DESC really exists, or set it to nil. 136 | (desc (org-string-nw-p desc)) 137 | (path 138 | (cond 139 | ((member type '("http" "https" "ftp" "mailto" "news")) 140 | (url-encode-url (concat type ":" raw-path))) 141 | ((string= "file" type) 142 | ;; During publishing, turn absolute file names belonging 143 | ;; to base directory into relative file names. Otherwise, 144 | ;; append "file" protocol to absolute file name. 145 | (setq raw-path 146 | (org-export-file-uri 147 | (org-publish-file-relative-name raw-path info))) 148 | ;; Possibly append `:html-link-home' to relative file 149 | ;; name. 150 | (let ((home (and (plist-get info :html-link-home) 151 | (org-trim (plist-get info :html-link-home))))) 152 | (when (and home 153 | (plist-get info :html-link-use-abs-url) 154 | (file-name-absolute-p raw-path)) 155 | (setq raw-path (concat (file-name-as-directory home) raw-path)))) 156 | ;; Maybe turn ".org" into ".html". 157 | (setq raw-path (funcall link-org-files-as-html-maybe raw-path info)) 158 | ;; Add search option, if any. A search option can be 159 | ;; relative to a custom-id, a headline title, a name or 160 | ;; a target. 161 | (let ((option (org-element-property :search-option link))) 162 | (if (not option) raw-path 163 | (let ((path (org-element-property :path link))) 164 | (concat raw-path 165 | "#" 166 | (org-publish-resolve-external-link option path t)))))) 167 | (t raw-path))) 168 | (attributes-plist 169 | (org-combine-plists 170 | ;; Extract attributes from parent's paragraph. HACK: Only 171 | ;; do this for the first link in parent (inner image link 172 | ;; for inline images). This is needed as long as 173 | ;; attributes cannot be set on a per link basis. 174 | (let* ((parent (org-export-get-parent-element link)) 175 | (link (let ((container (org-export-get-parent link))) 176 | (if (and (eq 'link (org-element-type container)) 177 | (org-html-inline-image-p link info)) 178 | container 179 | link)))) 180 | (and (eq link (org-element-map parent 'link #'identity info t)) 181 | (org-export-read-attribute :attr_html parent))) 182 | ;; Also add attributes from link itself. Currently, those 183 | ;; need to be added programmatically before `org-html-link' 184 | ;; is invoked, for example, by backends building upon HTML 185 | ;; export. 186 | (org-export-read-attribute :attr_html link))) 187 | (attributes 188 | (let ((attr (org-html--make-attribute-string attributes-plist))) 189 | (if (org-string-nw-p attr) (concat " " attr) "")))) 190 | (cond 191 | ;; Link type is handled by a special function. 192 | ((org-export-custom-protocol-maybe link desc 'html info)) 193 | ;; Image file. 194 | ((and (plist-get info :html-inline-images) 195 | (org-export-inline-image-p 196 | link (plist-get info :html-inline-image-rules))) 197 | (org-html--format-image path attributes-plist info)) 198 | ;; Radio target: Transcode target's contents and use them as 199 | ;; link's description. 200 | ((string= type "radio") 201 | (let ((destination (org-export-resolve-radio-link link info))) 202 | (if (not destination) desc 203 | (format "%s" 204 | (org-export-get-reference destination info) 205 | attributes 206 | desc)))) 207 | ;; Links pointing to a headline: Find destination and build 208 | ;; appropriate referencing command. 209 | ((member type '("custom-id" "fuzzy" "id")) 210 | (let ((destination (if (string= type "fuzzy") 211 | (org-export-resolve-fuzzy-link link info) 212 | (org-export-resolve-id-link link info)))) 213 | (pcase (org-element-type destination) 214 | ;; ID link points to an external file. 215 | (`plain-text 216 | (let ((fragment (concat "ID-" path)) 217 | ;; Treat links to ".org" files as ".html", if needed. 218 | (path (funcall link-org-files-as-html-maybe 219 | destination info))) 220 | (format "%s" 221 | path fragment attributes (or desc destination)))) 222 | ;; Fuzzy link points nowhere. 223 | (`nil 224 | (format "%s" 225 | (or desc 226 | (org-export-data 227 | (org-element-property :raw-link link) info)))) 228 | ;; Link points to a headline. 229 | (`headline 230 | (let ((href (org-html--reference destination info)) 231 | ;; What description to use? 232 | (desc 233 | ;; Case 1: Headline is numbered and LINK has no 234 | ;; description. Display section number. 235 | (if (and (org-export-numbered-headline-p destination info) 236 | (not desc)) 237 | (mapconcat #'number-to-string 238 | (org-export-get-headline-number 239 | destination info) ".") 240 | ;; Case 2: Either the headline is un-numbered or 241 | ;; LINK has a custom description. Display LINK's 242 | ;; description or headline's title. 243 | (or desc 244 | (org-export-data 245 | (org-element-property :title destination) info))))) 246 | (format "%s" href attributes desc))) 247 | ;; Fuzzy link points to a target or an element. 248 | (_ 249 | (if (and destination 250 | (memq (plist-get info :with-latex) '(mathjax t)) 251 | (eq 'latex-environment (org-element-type destination)) 252 | (eq 'math (org-latex--environment-type destination))) 253 | ;; Caption and labels are introduced within LaTeX 254 | ;; environment. Use "ref" or "eqref" macro, depending on user 255 | ;; preference to refer to those in the document. 256 | (format (plist-get info :html-equation-reference-format) 257 | (org-html--reference destination info)) 258 | (let* ((ref (org-html--reference destination info)) 259 | (org-html-standalone-image-predicate 260 | #'org-html--has-caption-p) 261 | (counter-predicate 262 | (if (eq 'latex-environment (org-element-type destination)) 263 | #'org-html--math-environment-p 264 | #'org-html--has-caption-p)) 265 | (number 266 | (cond 267 | (desc nil) 268 | ((org-html-standalone-image-p destination info) 269 | (org-export-get-ordinal 270 | (org-element-map destination 'link #'identity info t) 271 | info 'link 'org-html-standalone-image-p)) 272 | (t (org-export-get-ordinal 273 | destination info nil counter-predicate)))) 274 | (desc 275 | (cond (desc) 276 | ((not number) "No description for this link") 277 | ((numberp number) (number-to-string number)) 278 | (t (mapconcat #'number-to-string number "."))))) 279 | (format "%s" ref attributes desc))))))) 280 | ;; Coderef: replace link with the reference name or the 281 | ;; equivalent line number. 282 | ((string= type "coderef") 283 | (let ((fragment (concat "coderef-" (org-html-encode-plain-text path)))) 284 | (format "%s" 285 | fragment 286 | (format "class=\"coderef\" onmouseover=\"CodeHighlightOn(this, \ 287 | '%s');\" onmouseout=\"CodeHighlightOff(this, '%s');\"" 288 | fragment fragment) 289 | attributes 290 | (format (org-export-get-coderef-format path desc) 291 | (org-export-resolve-coderef path info))))) 292 | ;; External link with a description part. 293 | ((and path desc) 294 | (format "%s" 295 | (org-html-encode-plain-text path) 296 | attributes 297 | desc)) 298 | ;; External link without a description part. 299 | (path 300 | (let ((path (org-html-encode-plain-text path))) 301 | (format "%s" path attributes path))) 302 | ;; No path, only description. Try to do something useful. 303 | (t 304 | (format "%s" desc))))) 305 | 306 | 307 | (defun org-canvashtml--format-image (source attributes info) 308 | "Return \"img\" tag with given SOURCE and ATTRIBUTES. 309 | SOURCE is a string specifying the location of the image. 310 | ATTRIBUTES is a plist, as returned by 311 | `org-export-read-attribute'. INFO is a plist used as 312 | a communication channel." 313 | ;; (org-html--svg-image source attributes info) 314 | (org-html-close-tag 315 | "img" 316 | (org-html--make-attribute-string 317 | (org-combine-plists 318 | (list :src source 319 | :alt (if (string-match-p "^ltxpng/" source) 320 | (org-html-encode-plain-text 321 | (org-find-text-property-in-string 'org-latex-src source)) 322 | (file-name-nondirectory source))) 323 | attributes)) 324 | info)) 325 | 326 | (defun org-canvashtml--image-rewrite-path (path info) 327 | "Copy local images and pdfs to the static/bundle directory if needed. 328 | Also update the link paths to match those. 329 | 330 | PATH is the path to the image or any other attachment. 331 | 332 | INFO is a plist used as a communication channel." 333 | ;; (message "[ox-hugo attachment DBG] The Hugo section is: %s" (plist-get info :hugo-section)) 334 | ;; (message "[ox-hugo attachment DBG] The Hugo base dir is: %s" (plist-get info :hugo-base-dir)) 335 | (let* ((path-unhexified (url-unhex-string path)) 336 | (path-true (file-truename path-unhexified)) 337 | (dest-dir (or bundle-dir static-dir)) 338 | ret) 339 | (unless (file-directory-p static-dir) 340 | (user-error "Please create the %s directory" static-dir)) 341 | (if (and (file-exists-p path-true) 342 | (member (file-name-extension path-unhexified) exportables) 343 | (file-directory-p dest-dir)) 344 | (progn 345 | ;; Check if `path-true' is already inside `dest-dir'. 346 | (if (string-match (regexp-quote dest-dir) path-true) 347 | (progn 348 | ;; If so, return *only* the path considering the 349 | ;; destination directory as root. 350 | (setq ret (concat "/" (substring path-true (match-end 0))))) 351 | (let* ((file-name-relative-path 352 | (cond 353 | ((string-match "/static/" path-true) 354 | ;; `path-true' is "/foo/static/bar/baz.png", 355 | ;; return "bar/baz.png". 356 | ;; (message "[ox-hugo DBG attch rewrite] path contains static") 357 | ;; If path-true contains "/static/", set the 358 | ;; `dest-dir' to `static-dir' (even if this is a 359 | ;; page bundle). 360 | (setq dest-dir static-dir) 361 | (substring path-true (match-end 0))) 362 | (bundle-dir 363 | (cond 364 | ((string-match (concat "/" (regexp-quote bundle-name) "/") path-true) 365 | ;; This is a page bundle. `bundle-name' is 366 | ;; "", `path-true' is 367 | ;; "/bar//zoo/baz.png", 368 | ;; return "zoo/baz.png". 369 | ;; (message "[ox-hugo DBG attch rewrite BUNDLE 1] bundle-name: %s" bundle-name) 370 | ;; (message "[ox-hugo DBG attch rewrite BUNDLE 1] attch along with Org content: %s" 371 | ;; (substring path-true (match-end 0))) 372 | (substring path-true (match-end 0))) 373 | ((string-match (regexp-quote default-directory) path-true) 374 | ;; This is a page bundle. `default-path' is 375 | ;; "/", `path-true' is 376 | ;; "/bar/baz.png", return 377 | ;; "bar/baz.png". 378 | ;; (message "[ox-hugo DBG attch rewrite BUNDLE 2] attch along with Org content: %s" 379 | ;; (substring path-true (match-end 0))) 380 | (substring path-true (match-end 0))) 381 | (t 382 | ;; This is a page bundle. `default-path' is 383 | ;; "/", `path-true' is 384 | ;; "/foo/bar/baz.png", return "baz.png". 385 | ;; (message "[ox-hugo DBG attch rewrite BUNDLE 3] attch neither in static nor in Org file dir") 386 | (file-name-nondirectory path-unhexified)))) 387 | (t 388 | ;; Else, `path-true' is "/foo/bar/baz.png", 389 | ;; return "ox-hugo/baz.png". "ox-hugo" is the 390 | ;; default value of 391 | ;; `org-hugo-default-static-subdirectory-for-externals'. 392 | ;; (message "[ox-hugo DBG attch rewrite] neither BUNDLE nor contains static") 393 | (concat 394 | (file-name-as-directory org-hugo-default-static-subdirectory-for-externals) 395 | (file-name-nondirectory path-unhexified))))) 396 | (dest-path (concat dest-dir file-name-relative-path)) 397 | (dest-path-dir (file-name-directory dest-path))) 398 | ;; The `dest-dir' would already exist. But if 399 | ;; `file-name-relative-path' is "images/image.png" or 400 | ;; "foo/bar.txt", it's likely that "`dest-dir'/images" 401 | ;; or "`dest-dir'/foo" might not exist. So create those 402 | ;; if needed below. 403 | (unless (file-exists-p dest-path-dir) 404 | (mkdir dest-path-dir :parents)) 405 | ;; (message "[ox-hugo DBG attch rewrite] file-name-relative-path: %s" file-name-relative-path) 406 | ;; (message "[ox-hugo DBG attch rewrite] dest-path: %s" dest-path) 407 | ;; (message "[ox-hugo DBG attch rewrite] dest-path-dir: %s" dest-path-dir) 408 | 409 | ;; Do the copy only if the file to be copied is newer or 410 | ;; doesn't exist in the static dir. 411 | (when (file-newer-than-file-p path-true dest-path) 412 | (message "[ox-hugo] Copied %S to %S" path-true dest-path) 413 | (copy-file path-true dest-path :ok-if-already-exists)) 414 | (setq ret (if (and bundle-dir 415 | (string= bundle-dir dest-dir)) 416 | ;; If attachments are copied to the bundle 417 | ;; directory, don't prefix the path as "/" 418 | ;; as those paths won't exist at the site 419 | ;; base URL. 420 | file-name-relative-path 421 | (concat "/" file-name-relative-path)))))) 422 | (setq ret path)) 423 | ;; (message "[ox-hugo DBG attch rewrite] returned path: %s" ret) 424 | ret)) 425 | ;; Replace the link function so we can update local image links at least:1 ends here 426 | 427 | ;; [[file:ox-canvashtml.org::*Replace the section function][Replace the section function:1]] 428 | ;;;; Section 429 | 430 | (defun org-canvas-html-section (section contents info) 431 | "Transcode a SECTION element from Org to HTML. 432 | CONTENTS holds the contents of the section. INFO is a plist 433 | holding contextual information." 434 | (let ((parent (org-export-get-parent-headline section))) 435 | ;; Before first headline: no container, just return CONTENTS. 436 | (if (not parent) contents 437 | ;; Get div's class and id references. 438 | (let* ((class-num (+ (org-export-get-relative-level parent info) 439 | (1- (plist-get info :html-toplevel-hlevel)))) 440 | (section-number 441 | (and (org-export-numbered-headline-p parent info) 442 | (mapconcat 443 | #'number-to-string 444 | (org-export-get-headline-number parent info) "-")))) 445 | ;; Build return value. 446 | ;; at least for now, we have two special conditions 447 | ;; the CANVAS_NO_INNERDIV property is set; in this case 448 | ;; there's no enclosing foldable section, so the two are incompatible 449 | ;; the second special conditions is that the headline has a 450 | ;; CANVAS_FAT property. BUt that's nothing to worry about here actually -- 451 | ;; nothing to change! 452 | (if (org-element-property :CANVAS_NO_INNERDIV parent) 453 | (format "%s\n" (or contents "")) 454 | (format "
\n%s
\n" 455 | class-num 456 | (or (org-element-property :CUSTOM_ID parent) 457 | section-number 458 | (org-export-get-reference parent info)) 459 | "" ;; for now, moving this to the new div 460 | ;; (when (or (org-element-property :CANVAS_HTML_TOGGLE parent) 461 | ;; (org-export-read-attribute :attr_canvashtml parent :toggle)) 462 | ;; "style=\"display:none;\"") 463 | (or contents ""))))))) 464 | ;; Replace the section function:1 ends here 465 | 466 | ;; [[file:ox-canvashtml.org::*Define some options here][Define some options here:1]] 467 | (defcustom org-canvas-html-css-file 468 | (expand-file-name "canvas-styles.css" default-directory ) 469 | "CSS styles to apply on export to canvas-html") 470 | 471 | (defvar org-canvas-html-fat-classes 472 | "content-box pad-box-mini border border-round" 473 | "Classs that together make a nice fat block element") 474 | (defvar org-canvas-html-toggler-classes 475 | "element_toggler" 476 | "class to turn on toggling in a headline") 477 | 478 | (defun org-canvashtml-toggler-make-aria (id) 479 | "assemble the aria-classes for the element toggler" 480 | (format " aria-controls=\"contents-%s\" aria-label=\"Toggler toggle list visibility\"" 481 | id)) 482 | ;; Define some options here:1 ends here 483 | 484 | ;; [[file:ox-canvashtml.org::*Unfortunately, have to replace the headline function too :-(][Unfortunately, have to replace the headline function too :-(:1]] 485 | ;;;; Headline 486 | 487 | (defun org-canvas-html-headline (headline contents info) 488 | "Transcode a HEADLINE element from Org to HTML. 489 | CONTENTS holds the contents of the headline. INFO is a plist 490 | holding contextual information." 491 | (unless (org-element-property :footnote-section-p headline) 492 | (let* ((numberedp (org-export-numbered-headline-p headline info)) 493 | (numbers (org-export-get-headline-number headline info)) 494 | (level (+ (org-export-get-relative-level headline info) 495 | (1- (plist-get info :html-toplevel-hlevel)))) 496 | (todo (and (plist-get info :with-todo-keywords) 497 | (let ((todo (org-element-property :todo-keyword headline))) 498 | (and todo (org-export-data todo info))))) 499 | (todo-type (and todo (org-element-property :todo-type headline))) 500 | (priority (and (plist-get info :with-priority) 501 | (org-element-property :priority headline))) 502 | (text (org-export-data (org-element-property :title headline) info)) 503 | (tags (and (plist-get info :with-tags) 504 | (org-export-get-tags headline info))) 505 | (full-text (funcall (plist-get info :html-format-headline-function) 506 | todo todo-type priority text tags info)) 507 | (contents (or contents "")) 508 | (id (org-html--reference headline info)) 509 | (fat-classes (when (or (org-export-read-attribute :attr_canvashtml headline :fat) 510 | (org-element-property :CANVAS_HTML_FAT headline) 511 | (org-export-read-attribute :attr_canvashtml headline :fat)) 512 | org-canvas-html-fat-classes)) 513 | (add-toggler (or (org-element-property :CANVAS_HTML_TOGGLE headline) 514 | (org-export-read-attribute :attr_canvashtml headline :toggle))) 515 | (show-toggled (or (org-element-property :CANVAS_HTML_SHOW headline) 516 | (org-export-read-attribute :attr_canvashtml headline :show))) 517 | (formatted-text 518 | (if (plist-get info :html-self-link-headlines) 519 | (format "%s" id full-text) 520 | full-text))) 521 | (if (org-export-low-level-p headline info) 522 | ;; This is a deep sub-tree: export it as a list item. 523 | (let* ((html-type (if numberedp "ol" "ul"))) 524 | (concat 525 | (and (org-export-first-sibling-p headline info) 526 | (apply #'format "<%s class=\"org-%s\">\n" 527 | (make-list 2 html-type))) 528 | (org-html-format-list-item 529 | contents (if numberedp 'ordered 'unordered) 530 | nil info nil 531 | (concat (org-html--anchor id nil nil info) formatted-text)) "\n" 532 | (and (org-export-last-sibling-p headline info) 533 | (format "\n" html-type)))) 534 | ;; Standard headline. Export it as a section. 535 | (let* ((extra-class 536 | 537 | (org-element-property :HTML_CONTAINER_CLASS headline)) 538 | (headline-class (org-element-property :HTML_HEADLINE_CLASS headline)) 539 | (headline-all-classes 540 | (concat (and fat-classes " ") 541 | fat-classes 542 | (and add-toggler " ") 543 | (when add-toggler org-canvas-html-toggler-classes) 544 | (and headline-class " ") 545 | headline-class)) 546 | (first-content (car (org-element-contents headline)))) 547 | 548 | (format "<%s id=\"%s\" class=\"%s\">%s%s\n" 549 | (org-html--container headline info) 550 | (format "outline-container-%s" id) 551 | (concat (format "outline-%d" level) 552 | (and extra-class " ") 553 | extra-class) 554 | (format "\n%s\n" 555 | level 556 | id 557 | (if (not headline-all-classes) "" 558 | (format " class=\"%s\"" headline-all-classes)) 559 | (if (not add-toggler) "" 560 | (org-canvashtml-toggler-make-aria id)) 561 | (concat 562 | (and numberedp 563 | (format 564 | "%s " 565 | level 566 | (concat (mapconcat #'number-to-string numbers ".") "."))) 567 | formatted-text) 568 | level) 569 | ;; When there is no section, pretend there is an 570 | ;; empty one to get the correct
" 578 | id 579 | (when (and add-toggler (not show-toggled)) " style=\"display:none\"")) 580 | (if (eq (org-element-type first-content) 'section) contents 581 | (concat (org-canvas-html-section first-content "" info) contents)) 582 | "
") 583 | 584 | (org-html--container headline info))))))) 585 | ;; Unfortunately, have to replace the headline function too :-(:1 ends here 586 | 587 | ;; [[file:ox-canvashtml.org::*Add the template functions][Add the template functions:1]] 588 | (defun canvas-html-template (contents info) 589 | "Since will in any case be stripped out, 590 | return just the body with an extra CSS tag" 591 | ;; code statically for now 592 | (let* ((rawHtml (concat "\n " 594 | ;; Document contents. 595 | (let ((div (assq 'content (plist-get info :html-divs)))) 596 | (format "<%s id=\"%s\" class=\"%s\">\n" 597 | (nth 1 div) 598 | (nth 2 div) 599 | (plist-get info :html-content-class))) 600 | ;; Document title. 601 | (when (plist-get info :with-title) 602 | (let ((title (and (plist-get info :with-title) 603 | (plist-get info :title))) 604 | (subtitle (plist-get info :subtitle)) 605 | (html5-fancy (org-html--html5-fancy-p info))) 606 | (when title 607 | (format 608 | (if html5-fancy 609 | "
\n

%s

\n%s
" 610 | "

%s%s

\n") 611 | (org-export-data title info) 612 | (if subtitle 613 | (format 614 | (if html5-fancy 615 | "

%s

\n" 616 | (concat "\n" (org-html-close-tag "br" nil info) "\n" 617 | "%s\n")) 618 | (org-export-data subtitle info)) 619 | ""))))) 620 | contents 621 | (format "\n" (nth 1 (assq 'content (plist-get info :html-divs)))) 622 | )) 623 | (tempFile (make-temp-file "canvas-html-export" nil ".html" rawHtml))) 624 | (call-process "juice" nil "*juice-process*" nil "--css" org-canvas-html-css-file tempFile tempFile) 625 | (with-temp-buffer 626 | (insert-file-contents tempFile) 627 | (buffer-string)))) 628 | 629 | (defun org-canvas-html-inner-template (contents info) 630 | "Return body of document string after HTML conversion. 631 | CONTENTS is the transcoded contents string. INFO is a plist 632 | holding export options." 633 | (let* ((rawHtml 634 | (concat 635 | ;; Table of contents. 636 | (let ((depth (plist-get info :with-toc))) 637 | (when depth (org-html-toc depth info))) 638 | ;; Document contents. 639 | contents 640 | ;; Footnotes section. 641 | (org-html-footnote-section info))) 642 | (tempFile (make-temp-file "canvas-html-export" nil ".html" rawHtml))) 643 | (call-process "juice" nil "*juice-process*" nil "--css" org-canvas-html-css-file tempFile tempFile) 644 | (with-temp-buffer 645 | (insert-file-contents tempFile) 646 | (buffer-string)))) 647 | ;; Add the template functions:1 ends here 648 | 649 | ;; [[file:ox-canvashtml.org::*Add the export-to and export-as functions][Add the export-to and export-as functions:1]] 650 | ;;; End-user functions 651 | 652 | ;;;###autoload 653 | (defun org-canvas-html-export-as-html 654 | (&optional async subtreep visible-only body-only ext-plist) 655 | "Export current buffer to an HTML buffer. 656 | 657 | If narrowing is active in the current buffer, only export its 658 | narrowed part. 659 | 660 | If a region is active, export that region. 661 | 662 | A non-nil optional argument ASYNC means the process should happen 663 | asynchronously. The resulting buffer should be accessible 664 | through the `org-export-stack' interface. 665 | 666 | When optional argument SUBTREEP is non-nil, export the sub-tree 667 | at point, extracting information from the headline properties 668 | first. 669 | 670 | When optional argument VISIBLE-ONLY is non-nil, don't export 671 | contents of hidden elements. 672 | 673 | When optional argument BODY-ONLY is non-nil, only write code 674 | between \"\" and \"\" tags. 675 | 676 | EXT-PLIST, when provided, is a property list with external 677 | parameters overriding Org default settings, but still inferior to 678 | file-local settings. 679 | 680 | Export is done in a buffer named \"*Org HTML Export*\", which 681 | will be displayed when `org-export-show-temporary-export-buffer' 682 | is non-nil." 683 | (interactive) 684 | (org-export-to-buffer 'canvas-html "*Org HTML Export*" 685 | async subtreep visible-only body-only ext-plist 686 | (lambda () (set-auto-mode t))) 687 | ;; (save-excursion 688 | ;; (set-buffer (get-buffer "*Org HTML Export*")) 689 | ;; (call-process-region nil nil "python" t t (t nil) nil "-m" "premailer")) 690 | ) 691 | 692 | ;;;###autoload 693 | (defun org-canvas-html-export-to-html 694 | (&optional async subtreep visible-only body-only ext-plist) 695 | "Export current buffer to a HTML file. 696 | 697 | If narrowing is active in the current buffer, only export its 698 | narrowed part. 699 | 700 | If a region is active, export that region. 701 | 702 | A non-nil optional argument ASYNC means the process should happen 703 | asynchronously. The resulting file should be accessible through 704 | the `org-export-stack' interface. 705 | 706 | When optional argument SUBTREEP is non-nil, export the sub-tree 707 | at point, extracting information from the headline properties 708 | first. 709 | 710 | When optional argument VISIBLE-ONLY is non-nil, don't export 711 | contents of hidden elements. 712 | 713 | When optional argument BODY-ONLY is non-nil, only write code 714 | between \"\" and \"\" tags. 715 | 716 | EXT-PLIST, when provided, is a property list with external 717 | parameters overriding Org default settings, but still inferior to 718 | file-local settings. 719 | 720 | Return output file's name." 721 | (interactive) 722 | (let* ((extension (concat 723 | (when (> (length org-html-extension) 0) ".") 724 | (or (plist-get ext-plist :html-extension) 725 | org-html-extension 726 | "html"))) 727 | (file (org-export-output-file-name extension subtreep)) 728 | (org-export-coding-system org-html-coding-system)) 729 | (org-export-to-file 'canvas-html file 730 | async subtreep visible-only body-only ext-plist) 731 | ;; (call-process "juice" nil "*juice-process*" nil file file) 732 | ;;file 733 | )) 734 | ;; Add the export-to and export-as functions:1 ends here 735 | 736 | ;; [[file:ox-canvashtml.org::*Provide the library][Provide the library:1]] 737 | (provide 'ox-canvashtml) 738 | ;; Provide the library:1 ends here 739 | -------------------------------------------------------------------------------- /org-grading.el: -------------------------------------------------------------------------------- 1 | ;;; package -- Summary 2 | 3 | ;;; Commentary: A collection of functions to facilitate grading papers 4 | ;;; and assignments. It is currently somewhat inflexible and assumes a 5 | ;;; very specific workflow; I'd be interested to know whether it's of 6 | ;;; use to anyoneelse. 7 | 8 | ;;; Code: 9 | 10 | ;; require the dependencies 11 | (require 'org) ;; the source of all good! 12 | (require 'org-attach) ;; for attaching files to emails 13 | (require 'cl) ;; may not be necessary anymore in newer Emacsen 14 | (require 'ov) ;; for grade overlays 15 | 16 | 17 | ;; Helper Functions 18 | 19 | ;; I'm using hte namespace `o-g-' for these internal helper functions. 20 | ;; At some liater date should figure out and implement approved best 21 | ;; oractices. 22 | 23 | ;; CSV Parsers 24 | ;; Student information (name, email, etc) is exported from excel or blackboard in the form 25 | ;; of a CSV file. These two functions parse such files 26 | 27 | (defun o-g-parse-csv-file (file) 28 | "Transforms FILE into a list. 29 | Each element of the returned value is itself a list 30 | containing all the elements from one line of the file. 31 | This fn was stolen from somewhere on the web, and assumes 32 | that the file ocntains no header line at the beginning" 33 | (interactive 34 | (list (read-file-name "CSV file: "))) 35 | (let ((buf (find-file-noselect file)) 36 | (result nil)) 37 | (with-current-buffer buf 38 | (goto-char (point-min)) 39 | ;; (let ((header (buffer-substring-no-properties 40 | ;; (line-beginning-position) (line-end-position)))) 41 | ;; (push )) 42 | (while (not (eobp)) 43 | (let ((line (buffer-substring-no-properties 44 | (line-beginning-position) (line-end-position)))) 45 | ;; (let templist (split-string line ",") 46 | ;; ;;(print templist) 47 | ;; ;; (push (cons (car templist) (nth 1 templist) ) result) 48 | ;; ) 49 | (push (cons (nth 0 (split-string line ",")) (nth 1 (split-string line ","))) result) 50 | ) 51 | (forward-line 1))) 52 | (reverse result))) 53 | 54 | (defun o-g-parse-plist-csv-file (file) 55 | "Transforms csv FILE into a list of plists. 56 | Like `parse-csv-file' but each line of the original file is turned 57 | into a plist. Returns a list of plists. Assumes that the first line 58 | of the csv file is a header containing field names. Clumsily coded, 59 | but works." 60 | (interactive 61 | (list (read-file-name "CSV file: "))) 62 | (let ((buf (find-file-noselect file)) 63 | (result nil)) 64 | (with-current-buffer buf 65 | (goto-char (point-min)) 66 | (let ((header-props (split-string (buffer-substring-no-properties 67 | (line-beginning-position) (line-end-position)) ",")) 68 | ) 69 | ;;(message (format "header is: %s" header-props)) ;;(print header) 70 | (while (not (eobp)) 71 | (let ((line (split-string (buffer-substring-no-properties 72 | (line-beginning-position) (line-end-position)) ",")) 73 | (count 0) 74 | (new-plist '())) 75 | ;; ;;(print line) 76 | (while (< count (length line)) 77 | (print (nth count header-props)) 78 | (print (nth count line)) 79 | (setq new-plist (plist-put new-plist (intern (nth count header-props)) 80 | (if (not (equal (nth count line) "false")) 81 | (nth count line) 82 | (message (nth count line)) 83 | ""))) 84 | (setq count (1+ count))) 85 | (push new-plist result) 86 | (forward-line 1)))) 87 | (cdr (reverse result))))) 88 | 89 | ;; Element tree navigation 90 | 91 | (defun o-g-get-parent-headline () 92 | "Acquire the parent headline & return. Used by`org-grading-make-headlines' and `org-grading-attach'" 93 | (save-excursion 94 | (org-mark-subtree) 95 | (re-search-backward "^\\* ") 96 | (nth 4 (org-heading-components)))) 97 | 98 | ;; Minor mode definition. I'm not really using it right now, but it 99 | ;; might be a worthwhile improvement. 100 | (define-minor-mode org-grading-mode 101 | "a mode to get my grading in order" 102 | ;;:keymap (kbd "C-c C-x C-g" . (call-interactively (org-set-property "GRADE"))) 103 | :lighter " Mark" 104 | ) 105 | ;; refers to an obsolete function I can't remember 106 | (add-hook 'org-grading-mode-hook 107 | (lambda () 108 | (add-hook 'org-metareturn-hook 'mwp-insert-grade-template nil 'make-local 109 | ))) 110 | (add-hook 'org-grading-mode-hook 'org-contacts-setup-completion-at-point) 111 | 112 | ;; mail integration. Only tested with mu4e. 113 | (defun o-g-send-subtree-with-attachments () 114 | "org-mime-subtree and HTMLize" 115 | (interactive) 116 | (org-mark-subtree) 117 | (let ((attachments (o-g-attachment-list)) 118 | ;; (subject (mwp-org-get-parent-headline)) 119 | ) 120 | (save-excursion 121 | (org-grading-mime-org-subtree-htmlize attachments)) 122 | ;; (org-mime-send-subtree) 123 | ;; (insert "\nBest,\nMP.\n") 124 | ;; (message-goto-body) 125 | ;; (insert "Hello,\n\nAttached are the comments from your assignment.\n") 126 | ;; (org-mime-htmlize) 127 | ;; (message-goto-to) 128 | ;;(message-send-and-exit) 129 | )) 130 | 131 | 132 | ;; stolen from gnorb, but renamed to avoid conflicts 133 | (defun o-g-attachment-list (&optional id) 134 | "Get a list of files (absolute filenames) attached to the 135 | current heading, or the heading indicated by optional argument ID." 136 | (when (featurep 'org-attach) 137 | (let* ((attach-dir (save-excursion 138 | (when id 139 | (org-id-goto id)) 140 | (org-attach-dir t))) 141 | (files 142 | (mapcar 143 | (lambda (f) 144 | (expand-file-name f attach-dir)) 145 | (org-attach-file-list attach-dir)))) 146 | files))) 147 | 148 | 149 | 150 | ;; MAIN ORG-GRADING UTILITY FUNCTIONS 151 | 152 | ;; attaching files to subtreeds 153 | (defun org-grading-attach () 154 | "Interactively attach a file to a subtree. 155 | 156 | Assumes that the parent headline is the name of a subdirectory, 157 | and that the current headline is the name of a student. Speeds up file choice." 158 | (interactive) 159 | (if (file-exists-p o-g-get-parent-headline ) 160 | (org-attach-attach (read-file-name 161 | (concat "File for student " (nth 4 (org-heading-components)) ":") 162 | (o-g-get-parent-headline) )) 163 | (message "Warning: no such directory %s; not attaching file" o-g-get-parent-headline))) 164 | (defun org-grading-attach ()) 165 | 166 | ;; Used to create grading headlines for each assignment & student 167 | (defun org-grading-make-headings (assignments students) 168 | "Create a set of headlines for grading. 169 | 170 | ASSIGNMENTS is an alist in which the key is the assignment title, 171 | and the value is the grading template. STUDENTS is now assumed to 172 | be a plist, usually generated by `o-g-parse-plist-csv-file', whose 173 | first element is the student name, and whose second is the 174 | student email." 175 | (message "%s" assignments) 176 | (save-excursion 177 | (goto-char (point-max)) 178 | (message "students=%s" students) 179 | (mapcar (lambda (x) 180 | (let ((assignment (car x)) 181 | (template (cdr x))) 182 | (insert (format "\n* %s :ASSIGNMENT:" assignment)) 183 | (let (( afiles (if (file-exists-p assignment) (directory-files assignment nil ) nil))) 184 | (mapcar (lambda (stu) 185 | (let* ((fname (plist-get stu 'First)) 186 | (lname (plist-get stu 'Last)) 187 | (nname (or (unless (equal (plist-get stu 'Nickname) nil) (plist-get stu 'Nickname)) fname)) 188 | (email (plist-get stu 'Email)) 189 | (github (plist-get stu 'github)) 190 | ) 191 | ;;(message "pliste gets:%s %s %s %s" fname lname nname email) 192 | (insert (format "\n** %s %s" nname lname)) 193 | (org-todo 'todo) 194 | (insert template) 195 | (org-set-property "GRADE" "0") 196 | (org-set-property "CHITS" "0") 197 | (org-set-property "NICKNAME" nname) 198 | (org-set-property "FIRSTNAME" fname) 199 | (org-set-property "LASTNAME" lname) 200 | (org-set-property "MAIL_TO" email) 201 | (org-set-property "GITHUB" github) 202 | ;; (org-set-property "MAIL_CC" "matt.price@utoronto.ca") 203 | (org-set-property "MAIL_REPLY" "matt.price@utoronto.ca") 204 | (org-set-property "MAIL_SUBJECT" 205 | (format "Comments on %s Assignment (%s %s)" 206 | (mwp-org-get-parent-headline) nname lname )) 207 | ;; try to attach files, if possible 208 | (let* ((fullnamefiles (remove-if-not (lambda (f) (string-match (concat "\\\(" fname "\\\)\\\([^[:alnum:]]\\\)*" lname) f)) afiles)) 209 | (nicknamefiles (remove-if-not (lambda (f) (string-match (concat "\\\(" nname "\\\)\\\([^[:alnum:]]\\\)*" lname) f)) afiles))) 210 | ;;(message "fullnamefiles is: %s" fullnamefiles) 211 | (if afiles 212 | (if fullnamefiles 213 | (dolist (thisfile fullnamefiles) 214 | ;;(message "value of thisfile is: %s" thisfile) 215 | ;;(message "%s %s" (buffer-file-name) thisfile) 216 | ;;(message "value being passed is: %s"(concat (file-name-directory (buffer-file-name)) assignment "/" thisfile) ) 217 | (org-attach-attach (concat (file-name-directory (buffer-file-name)) assignment "/" thisfile) ) 218 | (message "Attached perfect match for %s" fname)) 219 | (dolist (thisfile nicknamefiles) 220 | (if t 221 | (progn 222 | (org-wattach-attach (concat (file-name-directory (buffer-file-name)) assignment "/" thisfile) ) 223 | (message "No perfect match; attached likely match for %s" nname))))) 224 | (message "No files match name of %s" nname) 225 | (message "warning: no directory %s, not attaching anything" assignment))) 226 | ;; (condition-case nil 227 | 228 | ;; (error (message "Unable to attach file belonging to student %s" nname ))) 229 | (save-excursion 230 | (org-mark-subtree) 231 | 232 | (org-cycle nil)) 233 | )) 234 | students)) ) ) 235 | assignments)) 236 | (org-cycle-hide-drawers 'all)) 237 | 238 | 239 | ;; stolen from xah, http://ergoemacs.org/emacs/elisp_read_file_content.html 240 | (defun o-g-read-lines (filePath) 241 | "Return a list of lines of a file at filePath." 242 | (with-temp-buffer 243 | (insert-file-contents filePath) 244 | (split-string (buffer-string) "\n" t))) 245 | 246 | ;; org make headings, but for github assignments 247 | (defun org-grading-make-headings-from-github (assignments students) 248 | "Create a set of headlines for grading. 249 | 250 | ASSIGNMENTS is an alist in which the key is the assignment title, 251 | and the value is itslef a plist with up to three elements. The 252 | first is the assignment base name, the second is a list of files 253 | to attach, and the third is the grading template. STUDENTS is now 254 | assumed to be a plist, usually generated by 255 | `o-g-parse-plist-csv-file'. Relevant field in the plist are 256 | First, Last, Nickname, Email, github. 257 | 258 | The main innovations vis-a-vis `org-grading-make-headings` are 259 | the structure of the the alist, and the means of attachment 260 | " 261 | (message "%s" assignments) 262 | (save-excursion 263 | (goto-char (point-max)) 264 | (message "students=%s" students) 265 | (mapcar (lambda (x) 266 | (let* ((title (car x)) 267 | (v (cdr x)) 268 | (template (plist-get v :template)) 269 | (basename (plist-get v :basename)) 270 | (filestoget (plist-get v :files)) 271 | (prs (if (plist-get v :prs) 272 | (o-g-read-lines (plist-get v :prs)) 273 | nil)) 274 | ) 275 | (insert (format "\n* %s :ASSIGNMENT:" title)) 276 | ;;(let (( afiles (directory-files (concat title ) nil )))) 277 | (mapcar (lambda (stu) 278 | (let* ((fname (plist-get stu 'First)) 279 | (lname (plist-get stu 'Last)) 280 | (nname (or (plist-get stu 'Nickname) fname)) 281 | (email (plist-get stu 'Email)) 282 | (github (plist-get stu 'github)) 283 | (afiles (ignore-errors (directory-files (concat title "/" basename "-" github )))) 284 | 285 | ) 286 | (message "afiles is: %s" afiles ) 287 | ;;(message "pliste gets:%s %s %s %s" fname lname nname email) 288 | (insert (format "\n** %s %s" (if (string= nname "") 289 | fname 290 | nname) lname)) 291 | (org-todo 'todo) 292 | (insert template) 293 | (org-set-property "GRADE" "0") 294 | (org-set-property "CHITS" "0") 295 | (org-set-property "NICKNAME" nname) 296 | (org-set-property "FIRSTNAME" fname) 297 | (org-set-property "LASTNAME" lname) 298 | (org-set-property "MAIL_TO" email) 299 | (org-set-property "GITHUB" github) 300 | (org-set-property "LOCAL_REPO" (concat title "/" basename "-" github "/" )) 301 | (if prs 302 | (mapcar (lambda (url) 303 | (message "inside lambda") 304 | (if (string-match github url) 305 | (progn 306 | (message "string matched") 307 | ;; one thought would be to add all comments PR's to this 308 | ;; but that would ocmplicate the logic for opening the PR URL 309 | ;; automatically 310 | ;; (org-set-property "COMMENTS_PR" 311 | ;; (concat (org-get-entry (point) "COMMENTS_PR") " " url)) 312 | (org-set-property "COMMENTS_PR" url) 313 | (insert (concat "\nPlease see detailed comments in your github repo: " url)) 314 | ))) 315 | prs) 316 | ) 317 | ;; (org-set-property "MAIL_CC" "matt.price@utoronto.ca") 318 | (org-set-property "MAIL_REPLY" "matt.price@utoronto.ca") 319 | (org-set-property "MAIL_SUBJECT" 320 | (format "Comments on %s Assignment (%s %s)" 321 | (mwp-org-get-parent-headline) nname lname )) 322 | ;; try to attach files, if possible 323 | ;; (let* ((fullnamefiles (remove-if-not (lambda (f) (string-match (concat "\\\(" fname "\\\)\\\([^[:alnum:]]\\\)*" lname) f)) afiles)) 324 | ;; (nicknamefiles (remove-if-not (lambda (f) (string-match (concat "\\\(" nname "\\\)\\\([^[:alnum:]]\\\)*" lname) f)) afiles))) 325 | ;; ;;(message "fullnamefiles is: %s" fullnamefiles) 326 | ;; (if afiles 327 | ;; (if fullnamefiles 328 | ;; (dolist (thisfile fullnamefiles) 329 | ;; ;;(message "value of thisfile is: %s" thisfile) 330 | ;; ;;(message "%s %s" (buffer-file-name) thisfile) 331 | ;; ;;(message "value being passed is: %s"(concat (file-name-directory (buffer-file-name)) title "/" thisfile) ) 332 | ;; (org-attach-attach (concat (file-name-directory (buffer-file-name)) title "/" thisfile) ) 333 | ;; (message "Attached perfect match for %s" name)) 334 | ;; (dolist (thisfile nicknamefiles) 335 | ;; (if t 336 | ;; (progn 337 | ;; (org-attach-attach (concat (file-name-directory (buffer-file-name)) title "/" thisfile) ) 338 | ;; (message "No perfect match; attached likely match for %s" nname))))) 339 | ;; (message "No files match name of %s" nname))) 340 | ;; (let* ((fullnamefiles (remove-if-not (lambda (f) (string-match (concat "\\\(" fname "\\\)\\\([^[:alnum:]]\\\)*" lname) f)) afiles)) 341 | ;; (nicknamefiles (remove-if-not (lambda (f) (string-match (concat "\\\(" nname "\\\)\\\([^[:alnum:]]\\\)*" lname) f)) afiles))) 342 | ;; ;;(message "fullnamefiles is: %s" fullnamefiles) 343 | ;; (if afiles 344 | ;; (if fullnamefiles 345 | ;; (dolist (thisfile fullnamefiles) 346 | ;; ;;(message "value of thisfile is: %s" thisfile) 347 | ;; ;;(message "%s %s" (buffer-file-name) thisfile) 348 | ;; ;;(message "value being passed is: %s"(concat (file-name-directory (buffer-file-name)) title "/" thisfile) ) 349 | ;; (org-attach-attach (concat (file-name-directory (buffer-file-name)) title "/" thisfile) ) 350 | ;; (message "Attached perfect match for %s" name)) 351 | ;; (dolist (thisfile nicknamefiles) 352 | ;; (if t 353 | ;; (progn 354 | ;; (org-attach-attach (concat (file-name-directory (buffer-file-name)) title "/" thisfile) ) 355 | ;; (message "No perfect match; attached likely match for %s" nname))))) 356 | ;; (message "No files match name of %s" nname))) 357 | ;; (condition-case nil 358 | 359 | ;; (error (message "Unable to attach file belonging to student %s" nname ))) 360 | (save-excursion 361 | (org-mark-subtree) 362 | (org-cycle nil)) 363 | ))students) ) ) assignments))) 364 | ;; Mailing functions 365 | 366 | (defun org-grading-mail-all () 367 | (interactive) 368 | "Mail all subtrees marked 'READY' to student recipients." 369 | (message "Mailing all READY subtrees to students") 370 | (org-element-map (org-element-parse-buffer) 'headline 371 | (lambda (item) 372 | ;; (print (nth 0 (org-element-property :todo-keyword item))) 373 | (when (string= (org-element-property :todo-keyword item) "READY") 374 | (save-excursion 375 | (goto-char (org-element-property :begin item)) 376 | ;;(print "sending") 377 | ;;(print item) 378 | (save-excursion 379 | (forward-char) 380 | ;; (save-) 381 | (o-g-send-subtree-with-attachments) 382 | ;; added this line 383 | ;; (if (fboundp 'mu4e-compose-mode) 384 | ;; (mu4e-compose-mode)) 385 | ) 386 | (org-todo "SENT") 387 | )) 388 | ) 389 | ) 390 | (org-cycle-hide-drawers 'all)) 391 | 392 | (defun o-g-send-subtree-with-attachments () 393 | "org-mime-subtree and HTMLize" 394 | (interactive) 395 | ;;(org-mark-subtree) 396 | (message "starting ") 397 | (let ((attachments (mwp-org-attachment-list)) 398 | ;; (subject (mwp-org-get-parent-headline)) 399 | ) 400 | ;;(insert "Hello " (nth 4 org-heading-components) ",\n") 401 | ;;(org-mime-subtree) 402 | ;; (org-mime-send-subtree) 403 | ;; (org-mime-subtree) 404 | (org-grading-mime-org-subtree-htmlize) 405 | ;; (insert "\nBest,\nMP.\n") 406 | ;; (message-goto-body) 407 | ;; (insert "Hello,\n\nAttached are the comments from your assignment.\n") 408 | ;; (message "subject is" ) 409 | ;; (message subject) 410 | ;;(message-to) 411 | ;; (org-mime-htmlize) 412 | ;; (mu4e-compose-mode) 413 | ;; this comes from gnorb 414 | ;; I will reintroduce it if I want to reinstate questions. 415 | ;; (map-y-or-n-p 416 | ;; ;; (lambda (a) (format "Attach %s to outgoing message? " 417 | ;; ;; (file-name-nondirectory a))) 418 | ;; (lambda (a) 419 | ;; (mml-attach-file a (mm-default-file-encoding a) 420 | ;; nil "attachment")) 421 | ;; attachments 422 | ;; '("file" "files" "attach")) 423 | ;; (message "Attachments: %s" attachments) 424 | (dolist (a attachments) (message "Attachment: %s" a) (mml-attach-file a (mm-default-file-encoding a) nil "attachment")) 425 | (message-goto-to) 426 | )) 427 | 428 | 429 | (defun org-grading-mail-all-undone () 430 | (interactive) 431 | "Mail all subtrees marked 'TODO' to student recipients." 432 | (org-element-map (org-element-parse-buffer) 'headline 433 | (lambda (item) 434 | ;; (print (nth 0 (org-element-property :todo-keyword item))) 435 | (when (string= (org-element-property :todo-keyword item) "TODO") 436 | (save-excursion 437 | (goto-char (1+ (org-element-property :begin item)) ) 438 | ;;(print "sending") 439 | ;;(print item) 440 | (save-excursion 441 | (org-grading-send-missing-subtree) 442 | (message-send-and-exit)) 443 | (org-todo "TODO") 444 | )) 445 | ) 446 | )) 447 | 448 | ;; not currently used -- abandoned in favour of a definitions list 449 | (defun org-grading-insert-grade-template () 450 | "simply insert a short grading template after creation of level 2 headline. 451 | I'm actualy not using this right now, but keeping temporarily until I'm sure it won't " 452 | (let ((element (org-element-at-point))) 453 | (save-excursion 454 | (when (and (org-element-type element) 455 | (eq (org-element-property :level element) 2)) 456 | (insert " 457 | | Organization | | 458 | | Clarity of Thesis | | 459 | | Presentation of Evidence | | 460 | | Grammar and Spelling | | 461 | | Style | | 462 | | Citations | | 463 | | Further Comments | | 464 | | Grade | | 465 | 466 | "))))) 467 | 468 | (defun org-grading-send-subtree-with-attachments () 469 | "org-mime-subtree and HTMLize" 470 | (interactive) 471 | (org-mark-subtree) 472 | (let ((attachments (mwp-org-attachment-list)) 473 | (subject (mwp-org-get-parent-headline))) 474 | ;;(insert "Hello " (nth 4 org-heading-components) ",\n") 475 | (org-mime-subtree) 476 | (insert "\nBest,\nMP.\n") 477 | (message-goto-body) 478 | (insert "Hello,\n\nAttached are the comments from your assignment.\n\n") 479 | (insert "At this point I have marked all the papers I know about. If 480 | you have not received a grade for work that you have handed in, 481 | please contact me immediately and we can resolve the situation!.\n\n") 482 | ;; (message "subject is" ) 483 | ;; (message subject) 484 | ;;(message-to) 485 | (org-mime-htmlize) 486 | ;; this comes from gnorb 487 | ;; I will reintroduce it if I want to reinstate questions. 488 | ;; (map-y-or-n-p 489 | ;; ;; (lambda (a) (format "Attach %s to outgoing message? " 490 | ;; ;; (file-name-nondirectory a))) 491 | ;; (lambda (a) 492 | ;; (mml-attach-file a (mm-default-file-encoding a) 493 | ;; nil "attachment")) 494 | ;; attachments 495 | ;; '("file" "files" "attach")) 496 | ;; (message "Attachments: %s" attachments) 497 | (dolist (a attachments) (message "Attachment: %s" a) (mml-attach-file a (mm-default-file-encoding a) nil "attachment")) 498 | (message-goto-to) 499 | )) 500 | 501 | ;; doesn't seem to actually be used... 502 | (defun org-grading-send-missing-subtree () 503 | "org-mime-subtree and HTMLize" 504 | (interactive) 505 | (org-mark-subtree) 506 | (let ((attachments (mwp-org-attachment-list)) 507 | (subject (mwp-org-get-parent-headline))) 508 | ;;(insert "Hello " (nth 4 org-heading-components) ",\n") 509 | (org-mime-subtree) 510 | (insert "\nBest,\nMP.\n") 511 | (message-goto-body) 512 | (insert "Hello,\n\nI have not received a paper from you, and ma sending this email just to let you know.\n\n") 513 | (insert "At this point I have marked all the papers I know about. If 514 | you have not received a grade for work that you have handed in, 515 | please contact me immediately and we can resolve the situation!.\n\n") 516 | (org-mime-htmlize) 517 | ;; this comes from gnorb 518 | ;; I will reintroduce it if I want to reinstate questions. 519 | ;; (map-y-or-n-p 520 | ;; ;; (lambda (a) (format "Attach %s to outgoing message? " 521 | ;; ;; (file-name-nondirectory a))) 522 | ;; (lambda (a) 523 | ;; (mml-attach-file a (mm-default-file-encoding a) 524 | ;; nil "attachment")) 525 | ;; attachments 526 | ;; '("file" "files" "attach")) 527 | ;; (message "Attachments: %s" attachments) 528 | (dolist (a attachments) (message "Attachment: %s" a) (mml-attach-file a (mm-default-file-encoding a) nil "attachment")) 529 | (message-goto-to) 530 | )) 531 | 532 | ;; still imperfect, but good enough for me. 533 | (defun org-grading-overlay-headings () 534 | "Show grades at end of headlines that have a 'GRADE' property." 535 | (interactive) 536 | (require 'ov) 537 | 538 | (org-map-entries 539 | (lambda () 540 | (when (org-entry-get (point) "GRADE") 541 | (ov-clear (- (line-end-position) 1) 542 | (+ 0 (line-end-position))) 543 | (setq ov (make-overlay (- (line-end-position) 1) 544 | (+ 0 (line-end-position)))) 545 | (setq character (buffer-substring (- (line-end-position) 1) (line-end-position))) 546 | (overlay-put 547 | ov 'display 548 | (format "%s GRADE: %s CHITS: %s" character (org-entry-get (point) "GRADE") (org-entry-get (point) "CHITS"))) 549 | (overlay-put ov 'name "grading") 550 | (message "%s" (overlay-get ov "name"))))) 551 | ) 552 | 553 | (defun org-grading-clear-overlays () 554 | "if the overlays become annoying at any point" 555 | (ov-clear) 556 | 557 | ) 558 | 559 | (defun org-grading-set-grade (grade) 560 | "set grade property at point and regenerate overlays" 561 | (interactive "sGrade:") 562 | (org-set-property "GRADE" grade) 563 | (org-grading-clear-overlays) 564 | (org-grading-overlay-headings) ) 565 | 566 | 567 | (defun org-grading-set-all-grades () 568 | "set grade property for all headings on basis of \"- Grade :: \" line. 569 | 570 | Use with caution." 571 | (interactive) 572 | (save-excursion 573 | (goto-char (point-min)) 574 | (while (re-search-forward "- Grade :: \\(.+\\)" nil t ) 575 | (org-set-property "GRADE" (match-string 1)) 576 | ;; (save-excursion 577 | ;; (org-back-to-heading) 578 | ;; (org-set-property) 579 | ;; (org-element-at-point)) 580 | )) 581 | (org-grading-overlay-headings) 582 | 583 | ) 584 | 585 | (defun org-grading-set-all-grades-boolean () 586 | "set grade property for all headings on basis of \"- Grade :: \" line. 587 | 588 | Use with caution." 589 | (interactive) 590 | (save-excursion 591 | (goto-char (point-min)) 592 | (while (re-search-forward "- \\(.*\\)Grade\\(.*\\) :: \\(.+\\)" nil t ) 593 | (let ((grade (match-string 3))) 594 | (if (string-match "pass" grade) 595 | (progn (message grade) 596 | (org-set-property "GRADE" "1")) 597 | )) 598 | 599 | ;;(org-set-property "GRADE" (match-string 1)) 600 | ;; (save-excursion 601 | ;; (org-back-to-heading) 602 | ;; (org-set-property) 603 | ;; (org-element-at-point)) 604 | )) 605 | (org-grading-overlay-headings) 606 | ;;(org-grading-overlay-headings) 607 | 608 | ) 609 | 610 | (defun org-grading-generate-tables () 611 | "Generate a *grade report* buffer with a summary of the graded assignments 612 | Simultaneously write results to results.csv in current directory." 613 | (interactive) 614 | (setq assignments '()) 615 | (setq students '()) 616 | 617 | ;;get assignments 618 | (let ((org-use-tag-inheritance nil)) 619 | (org-map-entries 620 | (lambda () 621 | (add-to-list 'assignments (nth 4 (org-heading-components)) t)) 622 | "ASSIGNMENT")) 623 | 624 | ;; get student names as list of cons cells 625 | (let ((org-use-property-inheritance nil)) 626 | (org-map-entries 627 | (lambda () 628 | (add-to-list 'students (cons (nth 4 (org-heading-components)) '()) t)) 629 | "MAIL_TO={utoronto.ca}")) 630 | ;;loop over entries 631 | ;; this should be improved, returning a plist to be looped over 632 | (dolist (assignment assignments) 633 | (save-excursion 634 | ;; jump to assignment 635 | (org-open-link-from-string (format "[[%s]]" assignment)) 636 | ;; map over entries 637 | (org-map-entries 638 | (lambda () 639 | (let* ((student (car (assoc (nth 4 (org-heading-components)) students)))) 640 | (when student 641 | (setf (cdr (assoc student students)) 642 | (append (cdr (assoc student students)) 643 | (list (org-entry-get (point) "GRADE"))))))) 644 | nil 'tree))) 645 | 646 | (setq gradebook 647 | (append (list (append '("Student") assignments) 648 | 'hline) 649 | students)) 650 | 651 | (write-region (orgtbl-to-csv gradebook nil) nil "results3.csv") 652 | 653 | 654 | ;; I would like to put the gradebook IN the buffer but I can't figure out 655 | ;; a wayt odo it without killing 656 | ;; (org-open-ling-from-string "[[#gradebook]]") 657 | ;;(let ((first-child (car (org-element-contents (org-element-at-point))))) (when (eq ))) 658 | (let ((this-buffer-name (buffer-name))) 659 | (switch-to-buffer-other-window "*grade report*") 660 | (erase-buffer) 661 | (org-mode) 662 | 663 | (insert (orgtbl-to-orgtbl gradebook nil)) 664 | (pop-to-buffer this-buffer-name)) 665 | ;;(pop-to-buffer nil) 666 | ) 667 | 668 | ;; helper function to set grades easily. Unfinished. 669 | (defun org-grading-pass () 670 | "set the current tree to pass" 671 | 672 | (interactive) 673 | (org-set-property "GRADE" "1") 674 | ;;(ov-clear) 675 | (org-grading-overlay-headings) 676 | ) 677 | 678 | (defun org-grading-chit () 679 | "set the current tree to one chit" 680 | 681 | (interactive) 682 | (org-set-property "CHITS" "1") 683 | (ov-clear) 684 | (org-grading-overlay-headings) 685 | ) 686 | 687 | ;; helper functions for github repos 688 | (defun o-g-open-student-repo () 689 | (interactive) 690 | (find-file-other-window (org-entry-get (point) "LOCAL_REPO" ))) 691 | (defun o-g-open-attachment-or-repo () 692 | (interactive) 693 | (let* ((attach-dir (org-attach-dir t)) 694 | (files (org-attach-file-list attach-dir))) 695 | (if (> (length files) 0 ) 696 | (org-attach-open) 697 | (o-g-open-student-repo) 698 | ))) 699 | 700 | 701 | 702 | ;; more helpers 703 | (defun org-grading-mime-org-subtree-htmlize (attachments) 704 | "Create an email buffer of the current subtree. 705 | The buffer will contain both html and in org formats as mime 706 | alternatives. 707 | 708 | The following headline properties can determine the headers. 709 | * subtree heading 710 | :PROPERTIES: 711 | :MAIL_SUBJECT: mail title 712 | :MAIL_TO: person1@gmail.com 713 | :MAIL_CC: person2@gmail.com 714 | :MAIL_BCC: person3@gmail.com 715 | :END: 716 | 717 | The cursor is left in the TO field." 718 | (interactive) 719 | (save-excursion 720 | ;; (funcall org-mime-up-subtree-heading) 721 | (cl-flet ((mp (p) (org-entry-get nil p org-mime-use-property-inheritance))) 722 | (let* ((file (buffer-file-name (current-buffer))) 723 | (subject (or (mp "MAIL_SUBJECT") (nth 4 (org-heading-components)))) 724 | (to (mp "MAIL_TO")) 725 | (cc (mp "MAIL_CC")) 726 | (bcc (mp "MAIL_BCC")) 727 | (addressee (or (mp "NICKNAME") (mp "FIRSTNAME") ) ) 728 | ;; Thanks to Matt Price for improving handling of cc & bcc headers 729 | (other-headers (cond 730 | ((and cc bcc) `((cc . ,cc) (bcc . ,bcc))) 731 | (cc `((cc . ,cc))) 732 | (bcc `((bcc . ,bcc))) 733 | (t nil))) 734 | (subtree-opts (when (fboundp 'org-export--get-subtree-options) 735 | (org-export--get-subtree-options))) 736 | (org-export-show-temporary-export-buffer nil) 737 | (org-major-version (string-to-number 738 | (car (split-string (org-release) "\\.")))) 739 | (org-buf (save-restriction 740 | (org-narrow-to-subtree) 741 | (let ((org-export-preserve-breaks org-mime-preserve-breaks) 742 | ) 743 | (cond 744 | ((= 8 org-major-version) 745 | (org-org-export-as-org 746 | nil t nil 747 | (or org-mime-export-options subtree-opts))) 748 | ((= 9 org-major-version) 749 | (org-org-export-as-org 750 | nil t nil t 751 | (or org-mime-export-options subtree-opts))))))) 752 | (html-buf (save-restriction 753 | (org-narrow-to-subtree) 754 | (org-html-export-as-html 755 | nil t nil t 756 | (or org-mime-export-options subtree-opts)))) 757 | ;; I wrap these bodies in export blocks because in org-mime-compose 758 | ;; they get exported again. This makes each block conditionally 759 | ;; exposed depending on the backend. 760 | (org-body (prog1 761 | (with-current-buffer org-buf 762 | ;; (format "#+BEGIN_EXPORT org\n%s\n#+END_EXPORT" 763 | ;; (buffer-string)) 764 | (buffer-string)) 765 | (kill-buffer org-buf))) 766 | (html-body (prog1 767 | (with-current-buffer html-buf 768 | (format "#+BEGIN_EXPORT html\n%s\n#+END_EXPORT" 769 | (buffer-string)) 770 | ;; (buffer-string) 771 | ) 772 | (kill-buffer html-buf))) 773 | ;; (body (concat org-body "\n" html-body)) 774 | (body org-body)) 775 | (save-restriction 776 | (org-narrow-to-subtree) 777 | (org-grading-mime-compose body file to subject other-headers 778 | (or org-mime-export-options subtree-opts) 779 | addressee)) 780 | (if (eq org-mime-library 'mu4e) 781 | (advice-add 'mu4e~switch-back-to-mu4e-buffer :after 782 | `(lambda () 783 | (switch-to-buffer (get-buffer ,(buffer-name) )) 784 | (advice-remove 'mu4e~switch-back-to-mu4e-buffer "om-temp-advice")) 785 | '((name . "om-temp-advice")))) 786 | (dolist (a attachments) (mml-attach-file a (mm-default-file-encoding a) nil "attachment")) 787 | 788 | (message-goto-to) 789 | (message-send-and-exit) 790 | )))) 791 | 792 | (defun org-grading-mime-compose (body file &optional to subject headers opts addressee) 793 | "Create mail BODY in FILE with TO, SUBJECT, HEADERS and OPTS." 794 | (when org-mime-debug (message "org-mime-compose called => %s %s" file opts)) 795 | (setq body (format "Hello%s, \n\nAttached are the comments from your assignment.\n%s\nBest,\nMP.\n----------\n" (if addressee (concat " " addressee) "") (replace-regexp-in-string "\\`\\(\\*\\)+.*$" "" body))) 796 | (let* ((fmt 'html) 797 | ;; we don't want to convert org file links to html 798 | (org-html-link-org-files-as-html nil) 799 | ;; These are file links in the file that are not images. 800 | (files 801 | (if (fboundp 'org-element-map) 802 | (org-element-map (org-element-parse-buffer) 'link 803 | (lambda (link) 804 | (when (and (string= (org-element-property :type link) "file") 805 | (not (string-match 806 | (cdr (assoc "file" org-html-inline-image-rules)) 807 | (org-element-property :path link)))) 808 | (org-element-property :path link)))) 809 | (message "Warning: org-element-map is not available. File links will not be attached.") 810 | '()))) 811 | (unless (featurep 'message) 812 | (require 'message)) 813 | (cl-case org-mime-library 814 | (mu4e 815 | (mu4e~compose-mail to subject headers nil)) 816 | (t 817 | (message-mail to subject headers nil))) 818 | (message-goto-body) 819 | (cl-labels ((bhook (body fmt) 820 | (let ((hook 'org-mime-pre-html-hook)) 821 | (if (> (eval `(length ,hook)) 0) 822 | (with-temp-buffer 823 | (insert body) 824 | (goto-char (point-min)) 825 | (eval `(run-hooks ',hook)) 826 | (buffer-string)) 827 | body)))) 828 | (let* ((org-link-file-path-type 'absolute) 829 | (org-export-preserve-breaks org-mime-preserve-breaks) 830 | (plain (org-mime--export-string body 'org)) 831 | ;; this makes the html self-containing. 832 | (org-html-htmlize-output-type 'inline-css) 833 | ;; this is an older variable that does not exist in org 9 834 | (org-export-htmlize-output-type 'inline-css) 835 | (html-and-images 836 | (org-mime-replace-images 837 | (org-mime--export-string (bhook body 'html) 'html opts) 838 | file)) 839 | (images (cdr html-and-images)) 840 | (html (org-mime-apply-html-hook (car html-and-images)))) 841 | ;; If there are files that were attached, we should remove the links, 842 | ;; and mark them as attachments. The links don't work in the html file. 843 | (mapc (lambda (f) 844 | (setq html (replace-regexp-in-string 845 | (format "%s" 846 | (regexp-quote f) (regexp-quote f)) 847 | (format "%s (attached)" (file-name-nondirectory f)) 848 | html))) 849 | files) 850 | (insert (org-mime-multipart plain html) 851 | (mapconcat 'identity images "\n")) 852 | ;; Attach any residual files 853 | (mapc (lambda (f) 854 | (when org-mime-debug (message "attaching: %s" f)) 855 | (mml-attach-file f)) 856 | files))))) 857 | 858 | (provide 'org-grading) 859 | ;;; org-grading ends here 860 | -------------------------------------------------------------------------------- /ox-canvashtml.org: -------------------------------------------------------------------------------- 1 | #+PROPERTY: header-args :tangle yes :comments link 2 | * Some background about Quercus CSS 3 | :PROPERTIES: 4 | :header-args: :tangle no 5 | :END: 6 | 7 | Here's a short list of classes & some smaple code to give a bit of a sense of what is possible. 8 | 9 | - there's an ~element toggler~ script that allows elements to toggle display of some other element on click by virtue of ~aria~ attributes. The code looks like this: 10 | 11 | #+begin_quote 12 | aria-label="Toggler toggle list visibility" aria-expanded="true" aria-controls="group_n" 13 | #+end_quote 14 | 15 | Here's some actual (bloated) code: 16 | #+begin_src html :tangle no 17 |

Librarians

18 |