Replace org-mode-p with usual (eq major-mode 'org-mode) check
[org-mode.git] / BUGFIXING / org-log.el
1 (defun org-agenda-switch-to (&optional delete-other-windows)
2   "Go to the Org-mode file which contains the item at point."
3   (interactive)
4   (let ((cb (current-buffer))
5         (line (org-current-line))
6         (col (current-column))
7         (buf (current-buffer))
8         (pos (point)))
9     (with-current-buffer (get-buffer-create "OrgAgendaGotoLog")
10       (goto-char (point-max))
11       (insert "--------------------------------------------------------\n")
12       (insert (format "This command: %s\n" this-command))
13       (insert (format "Last command: %s\n" last-command))
14       (insert (format "Line/Column/Point: %d/%d/%d\n" line col pos))))
15   (orglog-describe-char (point))
16   (let* ((marker (or (get-text-property (point) 'org-marker)
17                      (org-agenda-error)))
18          (buffer (marker-buffer marker))
19          (pos (marker-position marker)))
20     (switch-to-buffer buffer)
21     (and delete-other-windows (delete-other-windows))
22     (widen)
23     (goto-char pos)
24     (when (eq major-mode 'org-mode)
25       (org-show-context 'agenda)
26       (save-excursion
27         (and (outline-next-heading)
28              (org-flag-heading nil))))
29     (let ((cb (current-buffer))
30           (pos (point)))
31       (with-current-buffer (get-buffer-create "OrgAgendaGotoLog")
32       (goto-char (point-max))
33         (insert (format "Arrived: %s %d\n" cb pos))))))
34
35 (defun org-agenda-goto (&optional highlight)
36   "Go to the Org-mode file which contains the item at point."
37   (interactive)
38   (let ((cb (current-buffer))
39         (line (org-current-line))
40         (col (current-column))
41         (buf (current-buffer))
42         (pos (point)))
43     (with-current-buffer (get-buffer-create "OrgAgendaGotoLog")
44       (goto-char (point-max))
45       (insert "--------------------------------------------------------\n")
46       (insert (format "This command: %s\n" this-command))
47       (insert (format "Last command: %s\n" last-command))
48       (insert (format "Line/Column/Point: %d/%d/%d\n" line col pos))))
49   (orglog-describe-char (point))
50   (let* ((marker (or (get-text-property (point) 'org-marker)
51                      (org-agenda-error)))
52          (buffer (marker-buffer marker))
53          (pos (marker-position marker)))
54     (switch-to-buffer-other-window buffer)
55     (widen)
56     (goto-char pos)
57     (when (eq major-mode 'org-mode)
58       (org-show-context 'agenda)
59       (save-excursion
60         (and (outline-next-heading)
61              (org-flag-heading nil)))) ; show the next heading
62     (run-hooks 'org-agenda-after-show-hook)
63     (and highlight (org-highlight (point-at-bol) (point-at-eol)))
64     (let ((cb (current-buffer))
65           (pos (point)))
66       (with-current-buffer (get-buffer-create "OrgAgendaGotoLog")
67         (goto-char (point-max))
68         (insert (format "Arrived: %s %d\n" cb pos))))))
69
70
71 (defun orglog-describe-char (pos)
72   "Describe the character after POS (interactively, the character after point).
73 The information includes character code, charset and code points in it,
74 syntax, category, how the character is encoded in a file,
75 character composition information (if relevant),
76 as well as widgets, buttons, overlays, and text properties."
77   (interactive "d")
78   (if (>= pos (point-max))
79       (error "No character follows specified position"))
80   (let* ((char (char-after pos))
81          (charset (char-charset char))
82          (composition (find-composition pos nil nil t))
83          (component-chars nil)
84          (display-table (or (window-display-table)
85                             buffer-display-table
86                             standard-display-table))
87          (disp-vector (and display-table (aref display-table char)))
88          (multibyte-p enable-multibyte-characters)
89          (overlays (mapcar #'(lambda (o) (overlay-properties o))
90                            (overlays-at pos)))
91          (char-description (if (not multibyte-p)
92                                (single-key-description char)
93                              (if (< char 128)
94                                  (single-key-description char)
95                                (string-to-multibyte
96                                 (char-to-string char)))))
97          (text-props-desc
98           (let ((tmp-buf (generate-new-buffer " *text-props*")))
99             (unwind-protect
100                 (progn
101                   (describe-text-properties pos tmp-buf)
102                   (with-current-buffer tmp-buf (buffer-string)))
103               (kill-buffer tmp-buf))))
104          item-list max-width unicode)
105
106     (if (or (< char 256)
107             (memq 'mule-utf-8 (find-coding-systems-region pos (1+ pos)))
108             (get-char-property pos 'untranslated-utf-8))
109         (setq unicode (or (get-char-property pos 'untranslated-utf-8)
110                           (encode-char char 'ucs))))
111     (setq item-list
112           `(("character"
113              ,(format "%s (%d, #o%o, #x%x%s)"
114                       (apply 'propertize char-description
115                              (text-properties-at pos))
116                       char char char
117                       (if unicode
118                           (format ", U+%04X" unicode)
119                         "")))
120             ("charset"
121              ,`(insert-text-button
122                 ,(symbol-name charset)
123                 'type 'help-character-set 'help-args '(,charset))
124              ,(format "(%s)" (charset-description charset)))
125             ("code point"
126              ,(let ((split (split-char char)))
127                 `(insert-text-button
128                   ,(if (= (charset-dimension charset) 1)
129                        (format "#x%02X" (nth 1 split))
130                      (format "#x%02X #x%02X" (nth 1 split)
131                              (nth 2 split)))
132                   'action (lambda (&rest ignore)
133                             (list-charset-chars ',charset)
134                             (with-selected-window
135                                 (get-buffer-window "*Character List*" 0)
136                               (goto-char (point-min))
137                               (forward-line 2) ;Skip the header.
138                               (let ((case-fold-search nil))
139                                 (search-forward ,(char-to-string char)
140                                                 nil t))))
141                   'help-echo
142                   "mouse-2, RET: show this character in its character set")))
143             ("syntax"
144              ,(let ((syntax (syntax-after pos)))
145                 (with-temp-buffer
146                   (internal-describe-syntax-value syntax)
147                   (buffer-string))))
148             ("category"
149              ,@(let ((category-set (char-category-set char)))
150                  (if (not category-set)
151                      '("-- none --")
152                    (mapcar #'(lambda (x) (format "%c:%s"
153                                                  x (category-docstring x)))
154                            (category-set-mnemonics category-set)))))
155             ,@(let ((props (aref char-code-property-table char))
156                     ps)
157                 (when props
158                   (while props
159                     (push (format "%s:" (pop props)) ps)
160                     (push (format "%s;" (pop props)) ps))
161                   (list (cons "Properties" (nreverse ps)))))
162             ("to input"
163              ,@(let ((key-list (and (eq input-method-function
164                                         'quail-input-method)
165                                     (quail-find-key char))))
166                  (if (consp key-list)
167                      (list "type"
168                            (mapconcat #'(lambda (x) (concat "\"" x "\""))
169                                       key-list " or ")
170                            "with"
171                            `(insert-text-button
172                              ,current-input-method
173                              'type 'help-input-method
174                              'help-args '(,current-input-method))))))
175             ("buffer code"
176              ,(encoded-string-description
177                (string-as-unibyte (char-to-string char)) nil))
178             ("file code"
179              ,@(let* ((coding buffer-file-coding-system)
180                       (encoded (encode-coding-char char coding)))
181                  (if encoded
182                      (list (encoded-string-description encoded coding)
183                            (format "(encoded by coding system %S)" coding))
184                    (list "not encodable by coding system"
185                          (symbol-name coding)))))
186             ("display"
187              ,(cond
188                (disp-vector
189                 (setq disp-vector (copy-sequence disp-vector))
190                 (dotimes (i (length disp-vector))
191                   (setq char (aref disp-vector i))
192                   (aset disp-vector i
193                         (cons char (describe-char-display
194                                     pos (glyph-char char)))))
195                 (format "by display table entry [%s] (see below)"
196                         (mapconcat
197                          #'(lambda (x)
198                              (format "?%c" (glyph-char (car x))))
199                          disp-vector " ")))
200                (composition
201                 (let ((from (car composition))
202                       (to (nth 1 composition))
203                       (next (1+ pos))
204                       (components (nth 2 composition))
205                       ch)
206                   (setcar composition
207                           (and (< from pos) (buffer-substring from pos)))
208                   (setcar (cdr composition)
209                           (and (< next to) (buffer-substring next to)))
210                   (dotimes (i (length components))
211                     (if (integerp (setq ch (aref components i)))
212                         (push (cons ch (describe-char-display pos ch))
213                               component-chars)))
214                   (setq component-chars (nreverse component-chars))
215                   (format "composed to form \"%s\" (see below)"
216                           (buffer-substring from to))))
217                (t
218                 (let ((display (describe-char-display pos char)))
219                   (if (display-graphic-p (selected-frame))
220                       (if display
221                           (concat
222                            "by this font (glyph code)\n"
223                            (format "     %s (#x%02X)"
224                                    (car display) (cdr display)))
225                         "no font available")
226                     (if display
227                         (format "terminal code %s" display)
228                       "not encodable for terminal"))))))
229             ,@(let ((face
230                      (if (not (or disp-vector composition))
231                          (cond
232                           ((and show-trailing-whitespace
233                                 (save-excursion (goto-char pos)
234                                                 (looking-at "[ \t]+$")))
235                            'trailing-whitespace)
236                           ((and nobreak-char-display unicode (eq unicode '#xa0))
237                            'nobreak-space)
238                           ((and nobreak-char-display unicode (eq unicode '#xad))
239                            'escape-glyph)
240                           ((and (< char 32) (not (memq char '(9 10))))
241                            'escape-glyph)))))
242                 (if face (list (list "hardcoded face"
243                                      `(insert-text-button
244                                        ,(symbol-name face)
245                                        'type 'help-face 'help-args '(,face))))))
246             ,@(let ((unicodedata (and unicode
247                                       (describe-char-unicode-data unicode))))
248                 (if unicodedata
249                     (cons (list "Unicode data" " ") unicodedata)))))
250     (setq max-width (apply #'max (mapcar #'(lambda (x)
251                                              (if (cadr x) (length (car x)) 0))
252                                          item-list)))
253     (with-current-buffer (get-buffer-create "OrgAgendaGotoLog")
254       (goto-char (point-max))
255       (set-buffer-multibyte multibyte-p)
256       (let ((formatter (format "%%%ds:" max-width)))
257         (dolist (elt item-list)
258           (when (cadr elt)
259             (insert (format formatter (car elt)))
260             (dolist (clm (cdr elt))
261               (if (eq (car-safe clm) 'insert-text-button)
262                   (progn (insert " ") (eval clm))
263                 (when (>= (+ (current-column)
264                              (or (string-match "\n" clm)
265                                  (string-width clm))
266                              1)
267                           (window-width))
268                   (insert "\n")
269                   (indent-to (1+ max-width)))
270                 (insert " " clm)))
271             (insert "\n"))))
272       
273       (when overlays
274         (save-excursion
275           (goto-char (point-min))
276           (re-search-forward "character:[ \t\n]+")
277           (let* ((end (+ (point) (length char-description))))
278             (mapc #'(lambda (props)
279                       (let ((o (make-overlay (point) end)))
280                         (while props
281                           (overlay-put o (car props) (nth 1 props))
282                           (setq props (cddr props)))))
283                   overlays))))
284       
285       (when disp-vector
286         (insert
287          "\nThe display table entry is displayed by ")
288         (if (display-graphic-p (selected-frame))
289             (progn
290               (insert "these fonts (glyph codes):\n")
291               (dotimes (i (length disp-vector))
292                 (insert (glyph-char (car (aref disp-vector i))) ?:
293                         (propertize " " 'display '(space :align-to 5))
294                         (if (cdr (aref disp-vector i))
295                             (format "%s (#x%02X)" (cadr (aref disp-vector i))
296                                     (cddr (aref disp-vector i)))
297                           "-- no font --")
298                         "\n")
299                 (let ((face (glyph-face (car (aref disp-vector i)))))
300                   (when face
301                     (insert (propertize " " 'display '(space :align-to 5))
302                             "face: ")
303                     (insert (concat "`" (symbol-name face) "'"))
304                     (insert "\n")))))
305           (insert "these terminal codes:\n")
306           (dotimes (i (length disp-vector))
307             (insert (car (aref disp-vector i))
308                     (propertize " " 'display '(space :align-to 5))
309                     (or (cdr (aref disp-vector i)) "-- not encodable --")
310                     "\n"))))
311       
312       (when composition
313         (insert "\nComposed")
314         (if (car composition)
315             (if (cadr composition)
316                 (insert " with the surrounding characters \""
317                         (car composition) "\" and \""
318                         (cadr composition) "\"")
319               (insert " with the preceding character(s) \""
320                       (car composition) "\""))
321           (if (cadr composition)
322               (insert " with the following character(s) \""
323                       (cadr composition) "\"")))
324         (insert " by the rule:\n\t("
325                 (mapconcat (lambda (x)
326                              (format (if (consp x) "%S" "?%c") x))
327                            (nth 2 composition)
328                            " ")
329                 ")")
330         (insert  "\nThe component character(s) are displayed by ")
331         (if (display-graphic-p (selected-frame))
332             (progn
333               (insert "these fonts (glyph codes):")
334               (dolist (elt component-chars)
335                 (insert "\n " (car elt) ?:
336                         (propertize " " 'display '(space :align-to 5))
337                         (if (cdr elt)
338                             (format "%s (#x%02X)" (cadr elt) (cddr elt))
339                           "-- no font --"))))
340           (insert "these terminal codes:")
341           (dolist (elt component-chars)
342             (insert "\n  " (car elt) ":"
343                     (propertize " " 'display '(space :align-to 5))
344                     (or (cdr elt) "-- not encodable --"))))
345         (insert "\nSee the variable `reference-point-alist' for "
346                 "the meaning of the rule.\n"))
347       
348       (if text-props-desc (insert text-props-desc)))))